OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11main_tri.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11main_tri (timers, ipari, x, v, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, nrtm_t, eshift, nodnx_sms, renum, nsnfiold, intbuf_tab, temp, nodadt_therm)

Function/Subroutine Documentation

◆ i11main_tri()

subroutine i11main_tri ( type(timer_), intent(inout) timers,
integer, dimension(npari,ninter) ipari,
x,
v,
ms,
integer nin,
integer, intent(in) itask,
integer, dimension(*) weight,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer retri,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) itab,
integer nrtm_t,
integer eshift,
integer, dimension(*) nodnx_sms,
integer, dimension(*) renum,
integer, dimension(nspmd) nsnfiold,
type(intbuf_struct_) intbuf_tab,
temp,
integer, intent(in) nodadt_therm )

Definition at line 51 of file i11main_tri.F.

57C============================================================================
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE timer_mod
62 USE message_mod
63 USE tri7box
64 USE intbufdef_mod
65 use check_sorting_criteria_mod , only : check_sorting_criteria
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70#include "comlock.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "com08_c.inc"
77#include "param_c.inc"
78#include "task_c.inc"
79#include "timeri_c.inc"
80 COMMON /i11mainc/bminma,result,nrtsr,i_memg,nsnrold
81 INTEGER RESULT,NRTSR,I_MEMG,NSNROLD
82 my_real
83 . bminma(6)
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
88 INTEGER, INTENT(IN) :: ITASK
89 INTEGER NIN , RETRI, NRTM_T, ESHIFT
90 INTEGER IPARI(NPARI,NINTER), ITAB(*),
91 . WEIGHT(*), IAD_ELEM(2,*) ,FR_ELEM(*),
92 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),NODNX_SMS(*),
93 . RENUM(*),NSNFIOLD(NSPMD)
94 INTEGER ,INTENT(IN) :: NODADT_THERM
95C REAL
96 my_real
97 . x(*), v(3,*), ms(*),temp(*)
98
99 TYPE(INTBUF_STRUCT_) INTBUF_TAB
100C-----------------------------------------------
101C L o c a l V a r i a b l e s
102C-----------------------------------------------
103 INTEGER MULTIMP,
104 . I, ILD, I_SK_OLD,
105 . NB_N_B, NOINT,
106 . NCONT, NCONTACT,I_MEM,CAND_N_OLD,
107 . LOC_PROC,I_SK_NEW,NFT,JLT,I_STOK,IFORM
108 INTEGER, DIMENSION(:), ALLOCATABLE :: OLDINBUF1, OLDINBUF2
109C REAL
110 my_real
111 . gap, maxbox, minbox, tzinf,
112 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, inacti,drad,dgapload
113 INTEGER :: NMN, NSN,NTY,NRTS,NRTM
114 logical :: need_computation
115C-----------------------------------------------
116
117 ! --------------
118 ! check if the current interface needs to be sorted
119 call check_sorting_criteria( need_computation,nin,npari,nspmd,
120 . itask,ipari(1,nin),tt,intbuf_tab )
121 if( .not.need_computation ) return
122 ! --------------
123
124 i_mem = 0
125 i_memg = 0
126C
127 loc_proc=ispmd+1
128 nrts =ipari(3,nin)
129 nrtm =ipari(4,nin)
130 nsn =ipari(5,nin)
131 nmn =ipari(6,nin)
132 nty =ipari(7,nin)
133 noint =ipari(15,nin)
134 multimp =ipari(23,nin)
135 ncont =ipari(18,nin)
136 iform =ipari(30,nin)
137 ncontact=multimp*ncont
138C
139 IF(iform == 2)THEN
140 nsnrold = ipari(24,nin)
141 ELSE
142 nsnrold = 0
143 ENDIF
144C
145 gap = intbuf_tab%VARIABLES(2)
146 drad =intbuf_tab%VARIABLES(24)
147 dgapload =intbuf_tab%VARIABLES(46)
148 retri=1
149C -------------------------------------------------------------
150C
151 maxbox = intbuf_tab%VARIABLES(9)
152 minbox = intbuf_tab%VARIABLES(12)
153 tzinf = intbuf_tab%VARIABLES(8)
154 bminma(1)=-ep30
155 bminma(2)=-ep30
156 bminma(3)=-ep30
157 bminma(4)=ep30
158 bminma(5)=ep30
159 bminma(6)=ep30
160C no modification of INACTI: so no comm
161C
162 CALL my_barrier
163 IF (itask == 0) THEN
164 IF(iform == 2)THEN
165 IF(SIZE(intbuf_tab%ADCCM) < nrtm) THEN
166 DEALLOCATE(intbuf_tab%ADCCM)
167 ALLOCATE (intbuf_tab%ADCCM(nrtm))
168 ENDIF
169 DO i=1,nrtm
170 intbuf_tab%ADCCM(i) = 0
171 ENDDO
172 DO i=1,2*ncontact
173 intbuf_tab%CHAIN(i) = 0
174 ENDDO
175 ENDIF
176 ENDIF
177C
178 CALL my_barrier
179 IF (itask == 0) THEN
180 i_stok = intbuf_tab%I_STOK(1)
181 i_sk_new = 0
182 i_sk_old = i_stok
183 intbuf_tab%I_STOK(1)=0
184C
185 IF(iform == 2)THEN
186 DO nft=0, i_sk_old - 1 , nvsiz
187 jlt = min( nvsiz, i_sk_old - nft )
188
189 CALL i11trc(
190 1 i_sk_new ,intbuf_tab%CAND_N, intbuf_tab%CAND_E, intbuf_tab%FTSAVX, intbuf_tab%FTSAVY,
191 2 intbuf_tab%FTSAVZ,iform , intbuf_tab%ADCCM , intbuf_tab%CHAIN , ncontact,
192 . itab,jlt, nft,intbuf_tab%IFPEN,intbuf_tab%STFS,nin,nrts)
193
194 ENDDO
195 intbuf_tab%I_STOK(1) = i_sk_new
196 ELSE
197 i_sk_old=0
198 ENDIF
199 ENDIF
200C BARRIER BMINMA
201 CALL my_barrier
202C -------------------------------------------------------------
203C CALCULATION BORNE DOMAINE REMONTE IN I7XSAVE
204C -------------------------------------------------------------
205C Backup of XSAV (BUFIN Table (JD (19)))
206 CALL i10xsave(
207 1 x ,intbuf_tab%NSV ,intbuf_tab%MSR,nsn ,nmn ,
208 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
209 3 xmaxl ,ymaxl ,zmaxl )
210#include "lockon.inc"
211 bminma(1) = max(bminma(1),xmaxl)
212 bminma(2) = max(bminma(2),ymaxl)
213 bminma(3) = max(bminma(3),zmaxl)
214 bminma(4) = min(bminma(4),xminl)
215 bminma(5) = min(bminma(5),yminl)
216 bminma(6) = min(bminma(6),zminl)
217#include "lockoff.inc"
218 result = 0
219C barrier II_STOK and RESULT
220 CALL my_barrier
221C -------------------------------------------------------------
222C to keep for case where inacti is modified on p0
223 inacti=ipari(22,nin)
224 IF(itask==0)THEN
225 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
226 + abs(bminma(5)-bminma(2))>2*ep30.OR.
227 + abs(bminma(4)-bminma(1))>2*ep30)THEN
228 CALL ancmsg(msgid=87,anmode=aninfo,
229 . i1=noint,c1='(I7BUCE)')
230 CALL arret(2)
231 END IF
232C
233 bminma(1)=bminma(1)+tzinf
234 bminma(2)=bminma(2)+tzinf
235 bminma(3)=bminma(3)+tzinf
236 bminma(4)=bminma(4)-tzinf
237 bminma(5)=bminma(5)-tzinf
238 bminma(6)=bminma(6)-tzinf
239
240 IF(nspmd > lrvoxelp)THEN
241 CALL ancmsg(msgid=36,anmode=aninfo,
242 . c1='(I11MAINTRI)')
243 CALL arret(2)
244 END IF
245
246 END IF
247
248 nrtsr = 0
249
250 IF(nspmd > 1) THEN
251
252 IF(itask==0) crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
253
254 CALL my_barrier
255
256 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
257 CALL spmd_tri11vox0(
258 1 x ,bminma ,ipari(21,nin),nrtm_t , intbuf_tab%STFM(1+eshift),
259 2 tzinf ,intbuf_tab%IRECTM(1+2*eshift),gap,intbuf_tab%GAP_M(1+eshift),
260 3 intbuf_tab%VARIABLES(13) ,intbuf_tab%VARIABLES(7),drad,dgapload)
261
262 CALL my_barrier
263 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
264 IF(itask==0)THEN
265C
266C recovery of remote nodes NSNR stored in XREM
267C
268 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
269 CALL spmd_tri11vox(
270 1 intbuf_tab%IRECTS,nrts ,x ,v ,ms ,
271 2 bminma ,weight ,intbuf_tab%STFS,nin ,isendto ,
272 3 ircvfrom ,iad_elem ,fr_elem ,nrtsr ,ipari(22,nin),
273 4 intbuf_tab%GAP_S ,intbuf_tab%PENIS , itab ,ipari(21,nin),tzinf ,
274 5 nodnx_sms ,intbuf_tab%GAP_SL,nsnfiold,iform ,ipari(47,nin),
275 6 intbuf_tab%IELEC,intbuf_tab%AREAS ,temp ,ipari(36,nin),intbuf_tab%ADDSUBS,
276 7 intbuf_tab%LISUBS,ipari(72,nin),intbuf_tab%IPARTFRICS,intbuf_tab%INFLG_SUBS)
277 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
278
279
280c 300 continue
281C
282C Local renumeration of former candidates
283C
284 IF(iform == 2) THEN
285 CALL spmd_rnumcd11(
286 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin, nrts,
287 2 nsnfiold ,nsnrold ,intbuf_tab%ADCCM,intbuf_tab%CHAIN,
288 3 intbuf_tab%CAND_E,ncontact,nrtm)
289
290 ENDIF
291 END IF
292 END IF
293C -------------------------------------------------------------
294
295C -------------------------------------------------------------
296 cand_n_old = intbuf_tab%I_STOK(1)
297 40 CONTINUE
298
299 IF(itask==0)THEN
300 IF(iform == 2) THEN
301 IF (ALLOCATED(oldinbuf1)) DEALLOCATE(oldinbuf1)
302 IF (ALLOCATED(oldinbuf2)) DEALLOCATE(oldinbuf2)
303
304 ALLOCATE(oldinbuf1(nrtm), oldinbuf2(2*ncontact))
305
306 oldinbuf1(1:nrtm) = 0
307 oldinbuf2(1:2*ncontact) = 0
308
309 DO i=1,nrtm
310 oldinbuf1(i) = intbuf_tab%ADCCM(i)
311 ENDDO
312 DO i=1,2*ncontact
313 oldinbuf2(i) = intbuf_tab%CHAIN(i)
314 ENDDO
315 ENDIF
316 ENDIF
317 ild = 0
318 nb_n_b = 1
319C
320C Barrier Commp SPMD_TRI11BOX + BMINMA + RETURN I7BUCE
321C
322 50 CALL my_barrier
323 !IF(NRTM_T/=0.OR.ITASK==0)
324c CALL I11BUCE(
325c 1 X ,INTBUF_TAB%IRECTS ,INTBUF_TAB%IRECTM(1+2*ESHIFT) ,NRTS ,NMN ,
326c 2 NRTM_T,NSN ,INTBUF_TAB%CAND_E,INTBUF_TAB%CAND_N,GAP ,
327c 3 NOINT ,INTBUF_TAB%I_STOK(1),TZINF ,MAXBOX ,MINBOX ,
328c 4 NB_N_B,ESHIFT ,ILD ,BMINMA ,NCONTACT ,
329c 6 INTBUF_TAB%ADCCM(1+ESHIFT) ,INTBUF_TAB%CHAIN,NIN ,ITAB ,NRTSR ,
330c 7 NCONT ,INTBUF_TAB%GAP_S ,INTBUF_TAB%STFS,INTBUF_TAB%PENIS,IPARI(21,NIN),
331c 8 INTBUF_TAB%STFM(1+ESHIFT),IPARI(42,NIN),I_MEM , ITASK ,IFORM ,
332c 9 INTBUF_TAB%IFPEN ,DRAD)
333 CALL i11buce_vox(
334 1 x ,intbuf_tab%IRECTS ,intbuf_tab%IRECTM(1+2*eshift) ,nrts ,nmn ,
335 2 nrtm_t,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,gap ,
336 3 noint ,intbuf_tab%I_STOK(1),tzinf ,maxbox ,minbox ,
337 4 nb_n_b,eshift ,ild ,bminma ,ncontact ,
338 6 intbuf_tab%ADCCM(1+eshift) ,intbuf_tab%CHAIN,nin ,itab ,nrtsr ,
339 7 ncont ,intbuf_tab%GAP_S ,intbuf_tab%STFS,intbuf_tab%PENIS,ipari(21,nin),
340 8 intbuf_tab%STFM(1+eshift),ipari(42,nin),i_mem , itask ,iform ,
341 9 intbuf_tab%IFPEN ,drad, intbuf_tab%GAP_M(1+eshift), intbuf_tab%GAP_SL,
342 1 intbuf_tab%GAP_ML(1+eshift),intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(7), gap,
343 2 ipari(63,nin),intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,dgapload)
344
345C Upgrade MultiMP
346 IF (i_mem == 2)THEN
347#include "lockon.inc"
348 i_memg = i_mem
349#include "lockoff.inc"
350 ENDIF
351
352C New barrier needed for Dynamic MultiMP
353 CALL my_barrier
354
355 IF(i_memg /=0)THEN
356 IF (iform == 2)THEN
357 IF(itask == 0) THEN
358 DO i=1,nrtm
359 intbuf_tab%ADCCM(i)= oldinbuf1(i)
360 ENDDO
361 DO i=1,2*ncontact
362 intbuf_tab%CHAIN(i)= oldinbuf2(i)
363 ENDDO
364 DEALLOCATE(oldinbuf1,oldinbuf2)
365 ENDIF
366c /---------------/
367 CALL my_barrier
368c /---------------/
369 ENDIF
370C CARE : JINBUF & JBUFIN array are reallocated in
371C UPGRADE_MULTIMP routine !!!!
372!$OMP SINGLE
373 ! I increase > 4 for small interfaces
374 multimp = max(ipari(23,nin) +4,ipari(23,nin)+min(20,(250000/ncont)))
375 CALL upgrade_multimp(nin,multimp,intbuf_tab)
376C WRITE(6,*) "UPGRADE_MULTIMP",ISPMD,NOINT
377c WRITE(6,*) ISPMD,NOINT,"NMN,NSN=",NMN,NSN
378c WRITE(6,*) ISPMD,NOINT,"NRTS,NRTSR=", NRTS,NRTSR
379c WRITE(6,*) ISPMD,NOINT,"NSNROLD=",NSNROLD
380c WRITE(6,*) ISPMD,NOINT,"NCONT=",NCONT
381c WRITE(6,*) ISPMD,NOINT,"I_STOK=",INTBUF_TAB%I_STOK(1)
382c CALL FLUSH(6)
383c IF(MULTIMP > 200) STOP
384!$OMP END SINGLE
385 i_mem = 0
386 i_memg = 0
387 intbuf_tab%I_STOK(1)=cand_n_old
388 multimp=ipari(23,nin)
389 ncontact=multimp*ncont
390 GOTO 40
391 ENDIF
392
393#include "lockon.inc"
394 intbuf_tab%VARIABLES(9) = min(maxbox,intbuf_tab%VARIABLES(9))
395 intbuf_tab%VARIABLES(12) = min(minbox,intbuf_tab%VARIABLES(12))
396 intbuf_tab%VARIABLES(8) = min(tzinf,intbuf_tab%VARIABLES(8))
397 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-gap
398 result = result + ild
399#include "lockoff.inc"
400C--------------------------------------------------------------
401C--------------------------------------------------------------
402 CALL my_barrier
403 IF (result/=0) THEN
404 CALL my_barrier
405 IF (itask==0) THEN
406 intbuf_tab%I_STOK(1) = i_sk_old
407 result = 0
408 ENDIF
409 CALL my_barrier
410 ild = 0
411 maxbox = intbuf_tab%VARIABLES(9)
412 minbox = intbuf_tab%VARIABLES(12)
413 tzinf = intbuf_tab%VARIABLES(8)
414 GOTO 50
415 ENDIF
416 IF(nspmd>1)THEN
417C mono tache
418!$OMP SINGLE
419 IF (imonm > 0) CALL startime(timers,26)
420C
421 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
422 CALL spmd_tri11gat(
423 1 result ,nrts ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
424 2 ipari(22,nin),nrtsr,multimp ,ipari(21,nin),ipari(47,nin),
425 2 ipari(36,nin),ipari(72,nin),nodadt_therm)
426
427C save additional candidates in IPARI(24)
428 ipari(24,nin) = nrtsr
429C
430 IF (imonm > 0) CALL stoptime(timers,26)
431!$OMP END SINGLE
432 ENDIF
433
434 IF (ALLOCATED(oldinbuf1)) DEALLOCATE(oldinbuf1)
435 IF (ALLOCATED(oldinbuf2)) DEALLOCATE(oldinbuf2)
436C
437 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i10xsave
subroutine i10xsave(x, nsv, msr, nsn, nmn, itask, xsav, xmin, ymin, zmin, xmax, ymax, zmax)
Definition i10xsave.F:34
i11buce_vox
subroutine i11buce_vox(x, irects, irectm, nrts, nmn, nrtm, nsn, cand_m, cand_s, maxgap, noint, ii_stok, tzinf, maxbox, minbox, nb_n_b, eshift, ild, bminma, ncontact, addcm, chaine, nin, itab, nrtsr, ncont, gap_s, stifs, penis, igap, stifm, iauto, i_mem, itask, iform, ifpen, drad, gap_m, gap_s_l, gap_m_l, gapmin, bgapsmx, gap, flagremnode, kremnode, remnode, dgapload)
Definition i11buce.F:48
i11trc
subroutine i11trc(i_stok, cand_n, cand_e, cand_fx, cand_fy, cand_fz, mfrot, addcm, chaine, nsn4, itab, jlt, nft, ifpen, stfs, nin, nrts)
Definition i11trc.F:34
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
tri7box::crvoxel
integer, dimension(0:lrvoxel, 0:lrvoxel) crvoxel
Definition tri7box.F:56
tri7box::lrvoxelp
integer lrvoxelp
Definition tri7box.F:522
tri7box::lrvoxel
integer lrvoxel
Definition tri7box.F:54
spmd_rnumcd11
subroutine spmd_rnumcd11(cand_n, renum, ii_stok, nin, nrts, nsnfiold, nsnrold, addcm, chaine, cand_m, nsn4, nrtm)
Definition spmd_i7tool.F:387
spmd_tri11vox
subroutine spmd_tri11vox(irects, nrts, x, v, ms, bminmal, weight, stifs, nin, isendto, ircvfrom, iad_elem, fr_elem, nrtsr, inacti, gap_s, penis, itab, igap, tzinf, nodnx_sms, gap_s_l, nsnfiold, iform, intth, ielec, areas, temp, nisub, addsubs, lisubs, intfric, ipartfrics, inflg_subs)
Definition spmd_int.F:4396
spmd_tri11gat
subroutine spmd_tri11gat(result, nrts, cand_s, i_stok, nin, inacti, nrtsr, multimp, igap, intth, nisub, intfric, nodadt_therm)
Definition spmd_int.F:4920
spmd_tri11vox0
subroutine spmd_tri11vox0(x, bminmal, igap, nrtm, stf, tzinf, irectm, gap, gap_m, gapmin, bgapsmx, drad, dgapload)
Definition spmd_int.F:4245
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:895
arret
subroutine arret(nn)
Definition arret.F:86
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48