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 KD(50), JD(50), JFI, KFI, MULTIMP,
104 . I, ILD, I_SK_OLD, I_STOK1,
105 . ADD1, NB_N_B, NOINT,
106 . NCONT, NCONTACT,I_MEM,CAND_N_OLD,
107 . LOC_PROC, KD11_T,I_SK_NEW,NFT,JLT,J,I_STOK,IADFIN,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 pas de modification de INACTI : donc pas de comm
161C
162 CALL my_barrier
163 IF (itask == 0) THEN
164 IF(iform == 2)THEN
165 DO i=1,nrtm
166 intbuf_tab%ADCCM(i) = 0
167 ENDDO
168 DO i=1,2*ncontact
169 intbuf_tab%CHAIN(i) = 0
170 ENDDO
171 ENDIF
172 ENDIF
173C
174 CALL my_barrier
175 IF (itask == 0) THEN
176 i_stok = intbuf_tab%I_STOK(1)
177 i_sk_new = 0
178 i_sk_old = i_stok
179 intbuf_tab%I_STOK(1)=0
180C
181 IF(iform == 2)THEN
182 DO nft=0, i_sk_old - 1 , nvsiz
183 jlt = min( nvsiz, i_sk_old - nft )
184
185 CALL i11trc(
186 1 i_sk_new ,intbuf_tab%CAND_N, intbuf_tab%CAND_E, intbuf_tab%FTSAVX, intbuf_tab%FTSAVY,
187 2 intbuf_tab%FTSAVZ,iform , intbuf_tab%ADCCM , intbuf_tab%CHAIN , ncontact,
188 . itab,jlt, nft,intbuf_tab%IFPEN,intbuf_tab%STFS,nin,nrts)
189
190 ENDDO
191 intbuf_tab%I_STOK(1) = i_sk_new
192 ELSE
193 i_sk_old=0
194 ENDIF
195 ENDIF
196C BARRIER BMINMA
197 CALL my_barrier
198C -------------------------------------------------------------
199C CALCUL BORNE DOMAINE REMONTE DANS I7XSAVE
200C -------------------------------------------------------------
201C sauvegarde de XSAV (tableau BUFIN(JD(19)))
202 CALL i10xsave(
203 1 x ,intbuf_tab%NSV ,intbuf_tab%MSR,nsn ,nmn ,
204 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
205 3 xmaxl ,ymaxl ,zmaxl )
206#include "lockon.inc"
207 bminma(1) = max(bminma(1),xmaxl)
208 bminma(2) = max(bminma(2),ymaxl)
209 bminma(3) = max(bminma(3),zmaxl)
210 bminma(4) = min(bminma(4),xminl)
211 bminma(5) = min(bminma(5),yminl)
212 bminma(6) = min(bminma(6),zminl)
213#include "lockoff.inc"
214 result = 0
215C BARRIER II_STOK et RESULT
216 CALL my_barrier
217C -------------------------------------------------------------
218C a conserver pour cas inacti est modifie sur p0
219 inacti=ipari(22,nin)
220 IF(itask==0)THEN
221 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
222 + abs(bminma(5)-bminma(2))>2*ep30.OR.
223 + abs(bminma(4)-bminma(1))>2*ep30)THEN
224 CALL ancmsg(msgid=87,anmode=aninfo,
225 . i1=noint,c1='(I7BUCE)')
226 CALL arret(2)
227 END IF
228C
229 bminma(1)=bminma(1)+tzinf
230 bminma(2)=bminma(2)+tzinf
231 bminma(3)=bminma(3)+tzinf
232 bminma(4)=bminma(4)-tzinf
233 bminma(5)=bminma(5)-tzinf
234 bminma(6)=bminma(6)-tzinf
235
236 IF(nspmd > lrvoxelp)THEN
237 CALL ancmsg(msgid=36,anmode=aninfo,
238 . c1='(I11MAINTRI)')
239 CALL arret(2)
240 END IF
241
242 END IF
243
244 nrtsr = 0
245
246 IF(nspmd > 1) THEN
247
248 IF(itask==0) crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
249
250 CALL my_barrier
251
252 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
253
254 CALL spmd_tri11vox0(
255 1 x ,bminma ,ipari(21,nin),nrtm_t , intbuf_tab%STFM(1+eshift),
256 2 tzinf ,intbuf_tab%IRECTM(1+2*eshift),gap,intbuf_tab%GAP_M(1+eshift),
257 3 intbuf_tab%VARIABLES(13) ,intbuf_tab%VARIABLES(7),drad,dgapload)
258
259 CALL my_barrier
260 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
261 IF(itask==0)THEN
262C
263C recuperation des noeuds remote NSNR stockes dans XREM
264C
265 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
266 CALL spmd_tri11vox(
267 1 intbuf_tab%IRECTS,nrts ,x ,v ,ms ,
268 2 bminma ,weight ,intbuf_tab%STFS,nin ,isendto ,
269 3 ircvfrom ,iad_elem ,fr_elem ,nrtsr ,ipari(22,nin),
270 4 intbuf_tab%GAP_S ,intbuf_tab%PENIS , itab ,ipari(21,nin),tzinf ,
271 5 nodnx_sms ,intbuf_tab%GAP_SL,nsnfiold,iform ,ipari(47,nin),
272 6 intbuf_tab%IELEC,intbuf_tab%AREAS ,temp ,ipari(36,nin),intbuf_tab%ADDSUBS,
273 7 intbuf_tab%LISUBS,ipari(72,nin),intbuf_tab%IPARTFRICS,intbuf_tab%INFLG_SUBS)
274 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
275
276
277c 300 continue
278C
279C renumerotation locale des anciens candidats
280C
281 IF(iform == 2) THEN
282 CALL spmd_rnumcd11(
283 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin, nrts,
284 2 nsnfiold ,nsnrold ,intbuf_tab%ADCCM,intbuf_tab%CHAIN,
285 3 intbuf_tab%CAND_E,ncontact,nrtm)
286
287 ENDIF
288 END IF
289 END IF
290C -------------------------------------------------------------
291
292C -------------------------------------------------------------
293 cand_n_old = intbuf_tab%I_STOK(1)
294 40 CONTINUE
295
296 IF(itask==0)THEN
297 IF(iform == 2) THEN
298 IF (ALLOCATED(oldinbuf1)) DEALLOCATE(oldinbuf1)
299 IF (ALLOCATED(oldinbuf2)) DEALLOCATE(oldinbuf2)
300
301 ALLOCATE(oldinbuf1(nrtm), oldinbuf2(2*ncontact))
302
303 oldinbuf1(1:nrtm) = 0
304 oldinbuf2(1:2*ncontact) = 0
305
306 DO i=1,nrtm
307 oldinbuf1(i) = intbuf_tab%ADCCM(i)
308 ENDDO
309 DO i=1,2*ncontact
310 oldinbuf2(i) = intbuf_tab%CHAIN(i)
311 ENDDO
312 ENDIF
313 ENDIF
314 ild = 0
315 nb_n_b = 1
316C
317C Barrier comm spmd_tri11box + BMINMA + Retour I7BUCE
318C
319 50 CALL my_barrier
320 !IF(NRTM_T/=0.OR.ITASK==0)
321c CALL I11BUCE(
322c 1 X ,INTBUF_TAB%IRECTS ,INTBUF_TAB%IRECTM(1+2*ESHIFT) ,NRTS ,NMN ,
323c 2 NRTM_T,NSN ,INTBUF_TAB%CAND_E,INTBUF_TAB%CAND_N,GAP ,
324c 3 NOINT ,INTBUF_TAB%I_STOK(1),TZINF ,MAXBOX ,MINBOX ,
325c 4 NB_N_B,ESHIFT ,ILD ,BMINMA ,NCONTACT ,
326c 6 INTBUF_TAB%ADCCM(1+ESHIFT) ,INTBUF_TAB%CHAIN,NIN ,ITAB ,NRTSR ,
327c 7 NCONT ,INTBUF_TAB%GAP_S ,INTBUF_TAB%STFS,INTBUF_TAB%PENIS,IPARI(21,NIN),
328c 8 INTBUF_TAB%STFM(1+ESHIFT),IPARI(42,NIN),I_MEM , ITASK ,IFORM ,
329c 9 INTBUF_TAB%IFPEN ,DRAD)
330 CALL i11buce_vox(
331 1 x ,intbuf_tab%IRECTS ,intbuf_tab%IRECTM(1+2*eshift) ,nrts ,nmn ,
332 2 nrtm_t,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,gap ,
333 3 noint ,intbuf_tab%I_STOK(1),tzinf ,maxbox ,minbox ,
334 4 nb_n_b,eshift ,ild ,bminma ,ncontact ,
335 6 intbuf_tab%ADCCM(1+eshift) ,intbuf_tab%CHAIN,nin ,itab ,nrtsr ,
336 7 ncont ,intbuf_tab%GAP_S ,intbuf_tab%STFS,intbuf_tab%PENIS,ipari(21,nin),
337 8 intbuf_tab%STFM(1+eshift),ipari(42,nin),i_mem , itask ,iform ,
338 9 intbuf_tab%IFPEN ,drad, intbuf_tab%GAP_M(1+eshift), intbuf_tab%GAP_SL,
339 1 intbuf_tab%GAP_ML(1+eshift),intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(7), gap,
340 2 ipari(63,nin),intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,dgapload)
341
342C Upgrade MultiMP
343 IF (i_mem == 2)THEN
344#include "lockon.inc"
345 i_memg = i_mem
346#include "lockoff.inc"
347 ENDIF
348
349C New barrier needed for Dynamic MultiMP
350 CALL my_barrier
351
352 IF(i_memg /=0)THEN
353 IF (iform == 2)THEN
354 IF(itask == 0) THEN
355 DO i=1,nrtm
356 intbuf_tab%ADCCM(i)= oldinbuf1(i)
357 ENDDO
358 DO i=1,2*ncontact
359 intbuf_tab%CHAIN(i)= oldinbuf2(i)
360 ENDDO
361 DEALLOCATE(oldinbuf1,oldinbuf2)
362 ENDIF
363c /---------------/
364 CALL my_barrier
365c /---------------/
366 ENDIF
367C CARE : JINBUF & JBUFIN array are reallocated in
368C UPGRADE_MULTIMP routine !!!!
369!$OMP SINGLE
370 ! I increase > 4 for small interfaces
371 multimp = max(ipari(23,nin) +4,ipari(23,nin)+min(20,(250000/ncont)))
372 CALL upgrade_multimp(nin,multimp,intbuf_tab)
373C WRITE(6,*) "UPGRADE_MULTIMP",ISPMD,NOINT
374c WRITE(6,*) ISPMD,NOINT,"NMN,NSN=",NMN,NSN
375c WRITE(6,*) ISPMD,NOINT,"NRTS,NRTSR=", NRTS,NRTSR
376c WRITE(6,*) ISPMD,NOINT,"NSNROLD=",NSNROLD
377c WRITE(6,*) ISPMD,NOINT,"NCONT=",NCONT
378c WRITE(6,*) ISPMD,NOINT,"I_STOK=",INTBUF_TAB%I_STOK(1)
379c CALL FLUSH(6)
380c IF(MULTIMP > 200) STOP
381!$OMP END SINGLE
382 i_mem = 0
383 i_memg = 0
384 intbuf_tab%I_STOK(1)=cand_n_old
385 multimp=ipari(23,nin)
386 ncontact=multimp*ncont
387 GOTO 40
388 ENDIF
389
390#include "lockon.inc"
391 intbuf_tab%VARIABLES(9) = min(maxbox,intbuf_tab%VARIABLES(9))
392 intbuf_tab%VARIABLES(12) = min(minbox,intbuf_tab%VARIABLES(12))
393 intbuf_tab%VARIABLES(8) = min(tzinf,intbuf_tab%VARIABLES(8))
394 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-gap
395 result = result + ild
396#include "lockoff.inc"
397C--------------------------------------------------------------
398C--------------------------------------------------------------
399 CALL my_barrier
400 IF (result/=0) THEN
401 CALL my_barrier
402 IF (itask==0) THEN
403 intbuf_tab%I_STOK(1) = i_sk_old
404 result = 0
405 ENDIF
406 CALL my_barrier
407 ild = 0
408 maxbox = intbuf_tab%VARIABLES(9)
409 minbox = intbuf_tab%VARIABLES(12)
410 tzinf = intbuf_tab%VARIABLES(8)
411 GOTO 50
412 ENDIF
413 IF(nspmd>1)THEN
414C mono tache
415!$OMP SINGLE
416 IF (imonm > 0) CALL startime(timers,26)
417C
418 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
419 CALL spmd_tri11gat(
420 1 result ,nrts ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
421 2 ipari(22,nin),nrtsr,multimp ,ipari(21,nin),ipari(47,nin),
422 2 ipari(36,nin),ipari(72,nin),nodadt_therm)
423
424C sauvegarde des candidats additionnels dans IPARI(24)
425 ipari(24,nin) = nrtsr
426C
427 IF (imonm > 0) CALL stoptime(timers,26)
428!$OMP END SINGLE
429 ENDIF
430
431 IF (ALLOCATED(oldinbuf1)) DEALLOCATE(oldinbuf1)
432 IF (ALLOCATED(oldinbuf2)) DEALLOCATE(oldinbuf2)
433C
434 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:1249
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:4400
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:4925
spmd_tri11vox0
subroutine spmd_tri11vox0(x, bminmal, igap, nrtm, stf, tzinf, irectm, gap, gap_m, gapmin, bgapsmx, drad, dgapload)
Definition spmd_int.F:4249
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
arret
subroutine arret(nn)
Definition arret.F:87
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