OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iniend.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine iniend (inscr, x, ixs, ixc, pm, geo, ipari, noin, intc, itab, ms, npby, lpby, mwa, ikine, in, stifint, id, titr, intbuf_tab, stifintr)
subroutine iniend2d (ipari, noin, ms, intbuf_tab)

Function/Subroutine Documentation

◆ iniend()

subroutine iniend ( integer, dimension(*) inscr,
x,
integer, dimension(*) ixs,
integer, dimension(*) ixc,
pm,
geo,
integer, dimension(*) ipari,
integer noin,
integer, dimension(*) intc,
integer, dimension(*) itab,
ms,
integer, dimension(*) npby,
integer, dimension(*) lpby,
integer, dimension(*) mwa,
integer, dimension(*) ikine,
in,
stifint,
integer id,
character(len=nchartitle) titr,
type(intbuf_struct_) intbuf_tab,
stifintr )

Definition at line 39 of file iniend.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE front_mod
49 USE intbufdef_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "units_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NOIN
64 INTEGER INSCR(*), IXS(*), IXC(*), IPARI(*), INTC(*),
65 . ITAB(*), NPBY(*), LPBY(*), MWA(*), IKINE(*)
66C REAL
67 my_real
68 . x(*), pm(*), geo(*), ms(*), in(*), stifint(*),stifintr(*)
69 INTEGER ID
70 CHARACTER(LEN=NCHARTITLE) :: TITR
71
72 TYPE(INTBUF_STRUCT_) INTBUF_TAB
73C-----------------------------------------------
74C F u n c t i o n
75C-----------------------------------------------
76 INTEGER NLOCAL
77 EXTERNAL nlocal
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER NRTS, NRTM, NSN, NMN, NTY, NST, NMT, IBUC, NOINT,
82 . IWPENE, I, INCREM, P,
83 . ILEV,ICOR,II,JJ,NIR,K,N,L,N1,N2,N3,N4,INACTI,IGSTI
84 integer j
85C REAL
86 my_real
87 . xmas1, xmas2,stfn,stfr
88C=======================================================================
89 iwpene = 0
90 nrts =ipari(3)
91 nrtm =ipari(4)
92 nsn =ipari(5)
93 nmn =ipari(6)
94 nty =ipari(7)
95 nst =ipari(8)
96 nmt =ipari(9)
97 ibuc =ipari(12)
98 noint =ipari(15)
99 inacti=ipari(22)
100 icor =ipari(58)
101C
102 IF (nspmd > 1) THEN
103C les interfaces type 7 sont distribuees, les autres centralisees sur P0
104 increm = 1
105C pas de NSN defini en type 16 et interface non spmd compatible
106 IF(nty==16.OR.nty==17) RETURN
107C
108 IF(nty==7.OR.nty==10.OR.nty==11.OR.
109 . nty==20.OR.nty==21.OR.nty==22.OR.
110 . nty==23.OR.nty==24.OR.nty==25) increm = 100
111C
112 IF(nty==8) THEN
113 DO p=1,nspmd
114 DO i=1,nsn
115 !Comment ne donner les SECONDARYs qu'aux procs
116
117 CALL ifrontplus(intbuf_tab%NSV(i),p)
118 END DO
119 ENDDO
120C
121 ELSEIF(nty/=2) THEN
122 IF(increm==1)THEN
123 DO i=1,nsn
124 CALL ifrontplus(intbuf_tab%NSV(i),1)
125 END DO
126 DO i=1,nmn
127 CALL ifrontplus(intbuf_tab%MSR(i),1)
128 END DO
129 ENDIF
130C interface ALE -> c. c. traitees par P0
131 IF(nty==1.OR.nty==9.OR.nty==12)THEN
132 increm = 10
133 DO i=1,nsn
134 !set FLAGKIN to 1 for boundary node with
135 !kinematic constraints (old FRONT TAG=10)
136 flagkin(intbuf_tab%NSV(i)) = 1
137 END DO
138 DO i=1,nmn
139 flagkin(intbuf_tab%MSR(i)) = 1
140 END DO
141 ENDIF
142 ELSE
143 IF (n2d==0) THEN
144 nir = 4
145 ELSE
146 nir = 2
147 ENDIF
148 DO ii=1,nsn
149 l = intbuf_tab%IRTLM(ii)
150 n = intbuf_tab%NSV(ii)
151 DO p = 1, nspmd
152 IF (nlocal(n,p)==0) THEN
153 GO TO 200
154 ENDIF
155c pas d optimisation possible
156 100 DO jj=1,nir
157 k = intbuf_tab%IRECTM((l-1)*4+jj)
158 CALL ifrontplus(k,p)
159 ENDDO
160c optimisation possible
161 200 CONTINUE
162 ENDDO
163 ENDDO
164 ENDIF
165 ENDIF
166C
167C
168 IF(nty==6) THEN
169C
170 !flushed between 2 domain decomposition
171 intbuf_tab%LNSV(1:nst) = 0
172 intbuf_tab%LMSR(1:nmt) = 0
173 intbuf_tab%STFNS(1:nsn) = 0
174
175 WRITE(iout,2001)noint,nty
176 CALL inint0(x,intbuf_tab%IRECTS,intbuf_tab%NSEGS,intbuf_tab%LNSV,intbuf_tab%NSV,
177 1 intbuf_tab%MSR,intbuf_tab%ILOCM,nmn,nsn,nrts,intbuf_tab%S_IRECTS,intbuf_tab%S_LNSV)
178 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
179 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM,intbuf_tab%S_LMSR)
180 CALL i6sti3(intbuf_tab%IRECTS,intbuf_tab%STFS,nrts,intbuf_tab%STFNS,nsn,
181 1 intbuf_tab%NSV,xmas1,ms,npby,lpby,noint,itab,id,titr)
182 CALL i6sti3(intbuf_tab%IRECTM,intbuf_tab%STFM,nrtm,intbuf_tab%STFNM,nmn,
183 1 intbuf_tab%MSR,xmas2,ms,npby,lpby,noint,itab,id,titr)
184 intbuf_tab%VARIABLES(4)= min(xmas1,xmas2)
185 CALL invoi3(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
186 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nmn,
187 2 itab,id,titr,nrtm)
188 CALL invoi3(x,intbuf_tab%IRECTS,intbuf_tab%LNSV,intbuf_tab%NSV,intbuf_tab%MSR,
189 1 intbuf_tab%ILOCM,intbuf_tab%IRTLS,intbuf_tab%NSEGS,nmn,nsn,
190 2 itab,id,titr,nrts)
191 WRITE(iout,2002)
192 CALL i6pen3
193 1 (x ,intbuf_tab%IRECTM,intbuf_tab%MSR,intbuf_tab%NSV ,intbuf_tab%ILOCS,
194 2 intbuf_tab%IRTLM,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%VARIABLES(2),nsn ,
195 3 itab ,iwpene ,intbuf_tab%FCONT,icor ,id,
196 4 inacti ,titr)
197 WRITE(iout,2003)
198 CALL i6pen3
199 1 (x ,intbuf_tab%IRECTS,intbuf_tab%NSV,intbuf_tab%MSR ,intbuf_tab%ILOCM,
200 2 intbuf_tab%IRTLS,intbuf_tab%CSTM,intbuf_tab%IRTLOS,intbuf_tab%VARIABLES(2),nmn ,
201 3 itab ,iwpene ,intbuf_tab%FCONT,icor ,id,
202 4 inacti ,titr)
203C
204 ENDIF
205C
206 IF(iwpene/=0) THEN
207 CALL ancmsg(msgid=342,
208 . msgtype=msgwarning,
209 . anmode=aninfo_blind_1,
210 . i1=id,
211 . c1=titr,
212 . i2=iwpene)
213 ENDIF
214C
215C Init MMASS int 2
216C
217 IF (nty == 2) THEN
218 ilev = ipari(20)
219 DO ii = 1, nmn
220 i = intbuf_tab%MSR(ii)
221 intbuf_tab%NMAS(ii) = ms(i)
222 IF (iroddl == 1) intbuf_tab%NMAS(nmn+ii) = in(i)
223 ENDDO
224 IF (ilev == 10 .OR. ilev == 11 .OR. ilev == 12 .OR.
225 . ilev == 20 .OR. ilev == 21 .OR. ilev == 22) THEN
226 DO ii = 1, nsn
227 i = intbuf_tab%NSV(ii)
228 intbuf_tab%SMAS(ii) = ms(i)
229 IF (iroddl == 1) intbuf_tab%SINER(ii) = in(i)
230 ENDDO
231 ELSEIF (ilev == 25) THEN
232 igsti = ipari(58)
233 DO ii = 1, nsn
234 i = intbuf_tab%NSV(ii) ! NSV
235 l = intbuf_tab%IRTLM(ii) ! IRTL
236C
237 intbuf_tab%SMAS(ii) = ms(i)
238 IF (iroddl == 1) intbuf_tab%SINER(ii) = in(i)
239 n1 = intbuf_tab%IRECTM((l-1)*4+1)
240 n2 = intbuf_tab%IRECTM((l-1)*4+2)
241 n3 = intbuf_tab%IRECTM((l-1)*4+3)
242 n4 = intbuf_tab%IRECTM((l-1)*4+4)
243 IF (n3 == n4) THEN
244 stfn=third*(stifint(n1)+stifint(n2)+stifint(n3))
245 ELSE
246 stfn=fourth*(stifint(n1)+stifint(n2)+stifint(n3)+stifint(n4))
247 ENDIF
248 SELECT CASE (igsti)
249 CASE (2) ! mean stiffness (default)
250 stfn = half*(stfn+stifint(i))
251 CASE (3) ! max stiffness (default)
252 stfn = max(stfn,stifint(i))
253 CASE (4) ! min stiffness (default)
254 stfn = min(stfn,stifint(i))
255 CASE (5) ! min stiffness (default)
256 stfn = stfn*stifint(i) / (stfn+stifint(i))
257 CASE DEFAULT ! MAIN stiffness
258 CONTINUE
259 END SELECT
260 intbuf_tab%SPENALTY(ii) = stfn*intbuf_tab%STFAC(1)
261 ENDDO
262 ELSEIF (ilev == 26) THEN
263 igsti = ipari(58)
264 DO ii = 1, nsn
265 i = intbuf_tab%NSV(ii) ! NSV
266 l = intbuf_tab%IRTLM(ii) ! IRTL
267C
268 intbuf_tab%SMAS(ii) = ms(i)
269 IF (iroddl == 1) intbuf_tab%SINER(ii) = in(i)
270 n1 = intbuf_tab%IRECTM((l-1)*4+1)
271 n2 = intbuf_tab%IRECTM((l-1)*4+2)
272 n3 = intbuf_tab%IRECTM((l-1)*4+3)
273 n4 = intbuf_tab%IRECTM((l-1)*4+4)
274 IF (n3 == n4) THEN
275 stfn=third*(stifint(n1)+stifint(n2)+stifint(n3))
276 ELSE
277 stfn=fourth*(stifint(n1)+stifint(n2)+stifint(n3)+stifint(n4))
278 ENDIF
279 SELECT CASE (igsti)
280 CASE (2) ! mean stiffness (default)
281 stfn = half*(stfn+stifint(i))
282 CASE (3) ! max stiffness (default)
283 stfn = max(stfn,stifint(i))
284 CASE (4) ! min stiffness (default)
285 stfn = min(stfn,stifint(i))
286 CASE (5) ! min stiffness (default)
287 stfn = stfn*stifint(i) / (stfn+stifint(i))
288 CASE DEFAULT ! MAIN stiffness
289 CONTINUE
290 END SELECT
291 intbuf_tab%SPENALTY(ii) = stfn
292 ENDDO
293 ELSEIF ((ilev == 27).OR.(ilev == 28)) THEN
294 igsti = ipari(58)
295 DO ii = 1, nsn
296 i = intbuf_tab%NSV(ii) ! NSV
297 l = intbuf_tab%IRTLM(ii) ! IRTL
298C
299 intbuf_tab%SMAS(ii) = ms(i)
300 IF (iroddl == 1) intbuf_tab%SINER(ii) = in(i)
301 n1 = intbuf_tab%IRECTM((l-1)*4+1)
302 n2 = intbuf_tab%IRECTM((l-1)*4+2)
303 n3 = intbuf_tab%IRECTM((l-1)*4+3)
304 n4 = intbuf_tab%IRECTM((l-1)*4+4)
305 IF (n3 == n4) THEN
306 stfn=third*(stifint(n1)+stifint(n2)+stifint(n3))
307 stfr=third*(stifintr(n1)+stifintr(n2)+stifintr(n3))
308 ELSE
309 stfn=fourth*(stifint(n1)+stifint(n2)+stifint(n3)+stifint(n4))
310 stfr=fourth*(stifintr(n1)+stifintr(n2)+stifintr(n3)+stifintr(n4))
311 ENDIF
312 SELECT CASE (igsti)
313 CASE (2) ! mean stiffness (default)
314 stfn = half*(stfn+stifint(i))
315 stfr = half*(stfr+stifintr(i))
316 CASE (3) ! max stiffness (default)
317 stfn = max(stfn,stifint(i))
318 stfr = max(stfr,stifintr(i))
319 CASE (4) ! min stiffness (default)
320 stfn = min(stfn,stifint(i))
321 stfr = min(stfr,stifintr(i))
322 CASE (5) ! min stiffness (default)
323 stfn = stfn*stifint(i) / max(em20,(stfn+stifint(i)))
324 stfr = stfr*stifintr(i) / max(em20,(stfr+stifintr(i)))
325 CASE DEFAULT ! MAIN stiffness
326 CONTINUE
327 END SELECT
328 intbuf_tab%SPENALTY(ii) = stfn*intbuf_tab%STFAC(1)
329 intbuf_tab%STFR_PENALTY(ii) = stfr*intbuf_tab%STFAC(1)
330 ENDDO
331 ENDIF
332 ENDIF
333C-----------
334 RETURN
335C-----------------------------------------------------------------------
336 2001 FORMAT(//,1x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i10/
337 + ,1x,'INTERFACE TYPE. . . . . . . . . . . . . . .',i6/)
338 2002 FORMAT(//
339 +' SECONDARY NEAREST NEAREST MAIN NODES SECONDARY '/
340 +' NODE MAIN SEGMENT S T')
341 2003 FORMAT(//
342 +' MAIN NEAREST NEAREST SECONDARY NODES MAIN'/
343 +' NODE SECONDARY SEGMENT S T')
344C-----------------------------------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
i6pen3
subroutine i6pen3(x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, iwpene, peni, icor, id, inacti, titr)
Definition i6pen3.F:39
i6sti3
subroutine i6sti3(irect, stf, nrt, stfn, nsn, nsv, xmas, ms, npby, lpby, noint, itab, id, titr)
Definition i6sti3.F:37
inint0
subroutine inint0(x, irect, nseg, nod2seg, nsv, msr, iloc, nmn, nsn, nrt, sirect, s_n2seg)
Definition inint0.F:32
invoi3
subroutine invoi3(x, irect, lmsr, msr, nsv, iloc, irtl, nseg, nsn, nmn, itab, id, titr, nrt)
Definition invoi3.F:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
front_mod
Definition front_mod.F:84
front_mod::flagkin
integer, dimension(:), allocatable flagkin
Definition front_mod.F:105
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ iniend2d()

subroutine iniend2d ( integer, dimension(*) ipari,
integer noin,
ms,
type(intbuf_struct_) intbuf_tab )

Definition at line 357 of file iniend.F.

358C-----------------------------------------------
359C M o d u l e s
360C-----------------------------------------------
361 USE front_mod
362 USE intbufdef_mod
363C-----------------------------------------------
364C I m p l i c i t T y p e s
365C-----------------------------------------------
366#include "implicit_f.inc"
367C-----------------------------------------------
368C C o m m o n B l o c k s
369C-----------------------------------------------
370#include "com01_c.inc"
371C-----------------------------------------------
372C D u m m y A r g u m e n t s
373C-----------------------------------------------
374 INTEGER :: NOIN
375 INTEGER :: IPARI(*)
376 my_real :: ms(*)
377
378 TYPE(INTBUF_STRUCT_) INTBUF_TAB
379C-----------------------------------------------
380C F u n c t i o n
381C-----------------------------------------------
382 INTEGER NLOCAL
383 EXTERNAL nlocal
384C-----------------------------------------------
385C L o c a l V a r i a b l e s
386C-----------------------------------------------
387 INTEGER NRTS, NRTM, NSN, NMN, NTY, NOINT, I, INCREM, P, II,JJ,NIR,K,N,L
388C=======================================================================
389 nrts =ipari(3)
390 nrtm =ipari(4)
391 nsn =ipari(5)
392 nmn =ipari(6)
393 nty =ipari(7)
394 noint =ipari(15)
395C
396 IF(nspmd>1) THEN
397C les interfaces type 7 sont distribuees, les autres centralisees sur P0
398 increm = 1
399 IF(nty==7.OR.nty==10.OR.nty==11.OR.nty==22) increm = 100
400C
401 IF(nty/=2) THEN
402 IF(increm==1)THEN
403 DO i=1,nsn
404 CALL ifrontplus(intbuf_tab%NSV(i),1)
405 END DO
406 DO i=1,nmn
407 CALL ifrontplus(intbuf_tab%MSR(i),1)
408 END DO
409 ENDIF
410C interface ALE -> c. c. traitees par P0
411 IF(nty==1.OR.nty==9.OR.nty==12)THEN
412 increm = 10
413 DO i=1,nsn
414 !set FLAGKIN to 1 for boundary node with
415 !kinematic constraints (old FRONT TAG=10)
416 flagkin(intbuf_tab%NSV(i)) = 1
417 END DO
418 DO i=1,nmn
419 flagkin(intbuf_tab%MSR(i)) = 1
420 END DO
421 ENDIF
422 ELSE
423 IF (n2d==0) THEN
424 nir = 4
425 ELSE
426 nir = 2
427 ENDIF
428 DO ii=1,nsn
429 l = intbuf_tab%IRTLM(ii)
430 n = intbuf_tab%NSV(ii)
431 DO p = 1, nspmd
432 IF (nlocal(n,p)==0) THEN
433 GO TO 200
434 ENDIF
435C pas d optimisation possible
436 100 DO jj=1,nir
437 k = intbuf_tab%IRECTM((l-1)*4+jj)
438 CALL ifrontplus(k,p)
439 ENDDO
440C optimisation possible
441 200 CONTINUE
442 ENDDO
443 ENDDO
444 ENDIF
445 ENDIF
446C
447C Init MMASS / MINER int 2
448C
449 IF (nty == 2) THEN
450 DO ii = 1, nmn
451 i = intbuf_tab%MSR(ii)
452 intbuf_tab%NMAS(ii) = ms(i)
453 ENDDO
454 ENDIF
455C
456 RETURN