OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24main_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 "impl1_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i24main_tri (timers, ipari, x, v, intbuf_tab, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, h3d_data, t2main_sms, forneqs, t2fac_sms, parameters, intheat, idt_therm, nodadt_therm)

Function/Subroutine Documentation

◆ i24main_tri()

subroutine i24main_tri ( type(timer_) timers,
integer, dimension(npari,ninter) ipari,
x,
v,
type(intbuf_struct_) intbuf_tab,
ms,
integer nin,
integer itask,
integer, dimension(*) mwag,
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, dimension(*) kinet,
temp,
integer nrtm_t,
integer, dimension(numnod) renum,
integer, dimension(nspmd) nsnfiold,
integer eshift,
integer num_imp,
integer, dimension(*) ind_imp,
integer, dimension(*) nodnx_sms,
type(h3d_database) h3d_data,
integer, dimension(6,*) t2main_sms,
forneqs,
t2fac_sms,
type (parameters_), intent(in) parameters,
integer, intent(in) intheat,
integer, intent(in) idt_therm,
integer, intent(in) nodadt_therm )

Definition at line 52 of file i24main_tri.F.

60C============================================================================
61C M o d u l e s
62C-----------------------------------------------
63 USE timer_mod
64 USE tri7box
65 USE message_mod
66 USE imp_intbuf
67 USE intbufdef_mod
68 USE h3d_mod
69 USE parameters_mod
70 use check_sorting_criteria_mod , only : check_sorting_criteria
71 USE timer_mod
72C-----------------------------------------------
73C I m p l i c i t T y p e s
74C-----------------------------------------------
75#include "implicit_f.inc"
76#include "comlock.inc"
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com01_c.inc"
81#include "com04_c.inc"
82#include "com08_c.inc"
83#include "param_c.inc"
84#include "task_c.inc"
85#include "timeri_c.inc"
86#include "impl1_c.inc"
87C common pour variable globale en memoire partagee
88 COMMON /i7mainc/bminma,curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
89 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,NMN_G
90 my_real
91 . bminma(6),curv_max_max
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 TYPE(TIMER_) :: TIMERS
96 INTEGER NIN ,ITASK, RETRI, NRTM_T,ESHIFT,
97 . NUM_IMP ,IND_IMP(*),
98 . ITAB(*), KINET(*),
99 . IPARI(NPARI,NINTER), MWAG(*),
100 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),
101 . WEIGHT(*), IAD_ELEM(2,*) ,FR_ELEM(*),
102 . RENUM(NUMNOD), NSNFIOLD(NSPMD), NODNX_SMS(*), T2MAIN_SMS(6,*)
103 INTEGER, INTENT(IN) :: INTHEAT
104 INTEGER, INTENT(IN) :: IDT_THERM
105 INTEGER , INTENT(IN) :: NODADT_THERM
106C REAL
107 my_real
108 . x(3,*), v(*), ms(*),temp(*),t2fac_sms(*)
109 TYPE(INTBUF_STRUCT_) INTBUF_TAB
110 TYPE(H3D_DATABASE) :: H3D_DATA
111 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
112C-----------------------------------------------
113C L o c a l V a r i a b l e s
114C-----------------------------------------------
115 INTEGER LOC_PROC,IEDGE,IGSTI,
116 . I, IP0, IP1, IP2, IP21, K11_T, I_SK_OLD, I_STOK1,
117 . ADD1, NB_N_B, NOINT, INACTI, MULTIMP, IGAP, IFQ ,
118 . INTNITSCHE,IFSUB_CAREA
119 INTEGER
120 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
121 . I_MEM,CAND_N_OLD,ILEV,FLAGREMN, NRTSE ,NMN_L
122C REAL
123 my_real
124 . gap,maxbox,minbox,dgapload,
125 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
126 . c_maxl,pmax_gap,vmaxdt,marge,tzinf,sx,sy,sz,sx2,sy2,sz2,
127 . curv_max(nrtm_t),bminma_old(6),forneqs(*)
128C
129 INTEGER, DIMENSION(:),ALLOCATABLE :: CAND_A
130 INTEGER :: NMN, NSN,NRTM,NTY,NSNE
131 SAVE cand_a
132 logical :: need_computation
133C-----------------------------------------------
134 ! --------------
135 ! check if the current interface needs to be sorted
136 call check_sorting_criteria( need_computation,nin,npari,nspmd,
137 . itask,ipari(1,nin),tt,intbuf_tab )
138 if( .not.need_computation ) return
139 ! --------------
140
141 i_mem = 0
142 i_memg = 0
143 nmn_g = 0
144 nmn_l = 0
145C
146 loc_proc=ispmd+1
147 nrtm = ipari(4,nin)
148 nsn = ipari(5,nin)
149 nmn = ipari(6,nin)
150 nty = ipari(7,nin)
151 noint = ipari(15,nin)
152 ncont = ipari(18,nin)
153 ilev = ipari(20,nin)
154 inacti = ipari(22,nin)
155 multimp = ipari(23,nin)
156 ncontact= multimp*ncont
157 ifq = ipari(31,nin)
158 intth = ipari(47,nin)
159 iedge = ipari(58,nin)
160 flagremn= ipari(63,nin)
161 igsti = ipari(34,nin)
162 nrtse = ipari(52,nin)
163 nsne = ipari(55,nin)
164 intnitsche = ipari(86,nin)
165 ifsub_carea =0
166 IF(parameters%INTCAREA > 0) ifsub_carea = 1
167
168 nsnrold = ipari(24,nin)
169
170 gap =intbuf_tab%VARIABLES(gap_index)
171 gapmin=intbuf_tab%VARIABLES(gapmin_index)
172 gapmax=intbuf_tab%VARIABLES(gapmax_index)
173 pmax_gap=intbuf_tab%VARIABLES(pmax_index)
174 vmaxdt =intbuf_tab%VARIABLES(vmaxdt_index)
175C
176
177C
178C -------------------------------------------------------------
179C
180 retri = 1
181C
182C -------------------------------------------------------------
183C
184 maxbox = intbuf_tab%VARIABLES(maxbox_index)
185 minbox = intbuf_tab%VARIABLES(minbox_index)
186 marge = intbuf_tab%VARIABLES(marge_index)
187 dgapload = intbuf_tab%VARIABLES(bgapemx_index)
188 bminma(1)=-ep30
189 bminma(2)=-ep30
190 bminma(3)=-ep30
191 bminma(4)=ep30
192 bminma(5)=ep30
193 bminma(6)=ep30
194 curv_max_max = zero
195C
196C -------------------------------------------------------------
197C STOCKAGE DES ANCIENS CANDIDATS AVEC PENE INITIALE
198C OU AVEC DU FILTRAGE DE FROTTEMENT
199C -------------------------------------------------------------
200 CALL my_barrier
201
202 IF(itask==0)THEN
203 ALLOCATE (cand_a(nsn+nsnrold+3))
204 cand_a(1:nsn+nsnrold+3)=0
205 i_sk_old = intbuf_tab%I_STOK(1)
206 CALL i24trc(
207 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,cand_a,
208 2 nin, nsn,intbuf_tab%IRTLM,intbuf_tab%NSV,itab,
209 2 intbuf_tab%MSEGLO,intbuf_tab%MSEGTYP24)
210 intbuf_tab%I_STOK(1)=i_sk_old
211 ENDIF
212
213C
214C Barriere dans tous les cas pour bminma [et cur_max_max]
215C
216 CALL my_barrier
217C -------------------------------------------------------------
218C CALCUL BORNE DOMAINE REMONTE DANS I7XSAVE
219C -------------------------------------------------------------
220C eshift : decalage sur cand_e
221 CALL i7xsave(
222 1 x ,intbuf_tab%NSV,intbuf_tab%MSR,nsn ,nmn ,
223 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
224 3 xmaxl ,ymaxl ,zmaxl ,c_maxl,curv_max,
225 4 ipari(39,nin),intbuf_tab%IRECTM(1+4*eshift),nrtm_t ,sx ,sy ,
226 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l)
227#include "lockon.inc"
228 bminma(1) = max(bminma(1),xmaxl)
229 bminma(2) = max(bminma(2),ymaxl)
230 bminma(3) = max(bminma(3),zmaxl)
231 bminma(4) = min(bminma(4),xminl)
232 bminma(5) = min(bminma(5),yminl)
233 bminma(6) = min(bminma(6),zminl)
234 curv_max_max = max(curv_max_max,c_maxl)
235 nmn_g = nmn_g + nmn_l
236#include "lockoff.inc"
237
238 result = 0
239C BARRIER II_STOK et RESULT
240 CALL my_barrier
241C a conserver pour cas inacti est modifie sur p0
242 IF(itask==0)THEN
243 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
244 + abs(bminma(5)-bminma(2))>2*ep30.OR.
245 + abs(bminma(4)-bminma(1))>2*ep30)THEN
246 CALL ancmsg(msgid=87,anmode=aninfo,
247 . i1=noint,c1='(I24BUCE)')
248 CALL arret(2)
249 END IF
250C
251 tzinf = marge+max(gap+dgapload,pmax_gap)+curv_max_max
252
253 bminma(1)=bminma(1)+tzinf
254 bminma(2)=bminma(2)+tzinf
255 bminma(3)=bminma(3)+tzinf
256 bminma(4)=bminma(4)-tzinf
257 bminma(5)=bminma(5)-tzinf
258 bminma(6)=bminma(6)-tzinf
259
260 IF(nspmd > lrvoxelp)THEN
261 CALL ancmsg(msgid=36,anmode=aninfo,
262 . c1='(I24MAINTRI)')
263 CALL arret(2)
264 END IF
265
266 nsnr = 0
267 IF (impl_s >0 .AND. ncycle>0 .AND. inconv==1) THEN
268 bminma_old(1)=intbuf_tab%BMINMA_IMP(1)
269 bminma_old(2)=intbuf_tab%BMINMA_IMP(2)
270 bminma_old(3)=intbuf_tab%BMINMA_IMP(3)
271 bminma_old(4)=intbuf_tab%BMINMA_IMP(4)
272 bminma_old(5)=intbuf_tab%BMINMA_IMP(5)
273 bminma_old(6)=intbuf_tab%BMINMA_IMP(6)
274C
275 intbuf_tab%BMINMA_IMP(1)=bminma(1)
276 intbuf_tab%BMINMA_IMP(2)=bminma(2)
277 intbuf_tab%BMINMA_IMP(3)=bminma(3)
278 intbuf_tab%BMINMA_IMP(4)=bminma(4)
279 intbuf_tab%BMINMA_IMP(5)=bminma(5)
280 intbuf_tab%BMINMA_IMP(6)=bminma(6)
281C
282 bminma(1)=max(bminma(1),bminma_old(1))
283 bminma(2)=max(bminma(2),bminma_old(2))
284 bminma(3)=max(bminma(3),bminma_old(3))
285 bminma(4)=min(bminma(4),bminma_old(4))
286 bminma(5)=min(bminma(5),bminma_old(5))
287 bminma(6)=min(bminma(6),bminma_old(6))
288 END IF
289 END IF
290
291
292 IF(nspmd > 1) THEN
293
294 IF(itask==0) crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
295c goto 150
296 CALL my_barrier
297 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
298
299 CALL spmd_tri24vox0(
300 1 x ,bminma ,nrtm_t,intbuf_tab%STFM(1+eshift),marge ,
301 2 curv_max,intbuf_tab%GAP_M(1+eshift),intbuf_tab%IRECTM(1+4*eshift),gap,
302 + intbuf_tab%VARIABLES(bgapsmx_index),
303 3 pmax_gap,vmaxdt ,dgapload )
304
305 CALL my_barrier
306 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
307
308 IF(itask==0)THEN
309C
310C recuperation des noeuds remote NSNR stockes dans XREM
311C
312
313 inacti=0
314 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
315
316 CALL spmd_tri24vox(
317 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
318 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
319 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
320 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
321 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp,
322 6 num_imp ,nodnx_sms,intbuf_tab%STIF_OLD,nty ,
323 7 intbuf_tab%IRTLM,intbuf_tab%TIME_S,intbuf_tab%SECND_FR,intbuf_tab%PENE_OLD,
324 8 intbuf_tab%STIF_OLD , intbuf_tab%NBINFLG,ilev ,intbuf_tab%ICONT_I ,
325 9 intbuf_tab%XFIC ,intbuf_tab%VFIC ,ipari(59,nin),nsne,intbuf_tab%IS2SE,
326 a intbuf_tab%IRTSE, intbuf_tab%IS2PT,intbuf_tab%ISEGPT,intbuf_tab%MSFIC,nrtse,
327 b intbuf_tab%IS2ID,intbuf_tab%ISPT2,ipari(72,nin),intbuf_tab%IPARTFRICS,t2main_sms,
328 c intnitsche ,forneqs ,t2fac_sms ,ipari(97,nin) ,intbuf_tab%STIFMSDT_S,
329 d ifsub_carea ,parameters%INTAREAN)
330 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
331
332C
333C renumerotation locale des anciens candidats
334C
335ccc IF(NUM_IMP>0)THEN
336 CALL spmd_rnumcd(
337 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin, nsn,
338 2 nsnfiold ,nsnrold)
339ccc END IF
340 END IF
341 END IF
342C
343 cand_n_old = intbuf_tab%I_STOK(1)
344 40 continue
345C
346 ild = 0
347 nb_n_b = 1
348C
349C Barrier comm spmd_tri7vox + BMINMA + Retour I7BUCE
350C
351 50 CALL my_barrier
352C
353 IF (imonm > 0) CALL startime(timers,30)
354C
355 CALL i24buce(
356 1 x ,v ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV,
357 + intbuf_tab%STFNS,
358 2 nmn ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
359 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,bminma ,
360 4 marge ,curv_max ,pmax_gap ,vmaxdt ,nb_n_b ,
361 5 eshift ,ild ,nin ,intbuf_tab%STFM(1+eshift) ,intbuf_tab%GAP_S,
362 6 nsnr ,ncont ,intbuf_tab%GAP_M(1+eshift) ,itask ,intbuf_tab%VARIABLES(bgapsmx_index),
363 7 i_mem ,intbuf_tab%PENE_OLD,itab ,intbuf_tab%NBINFLG,intbuf_tab%MBINFLG,
364 8 ilev ,intbuf_tab%MSEGTYP24,intbuf_tab%EDGE8L2 ,iedge ,intbuf_tab%ISEADD,
365 9 intbuf_tab%ISEDGE,intbuf_tab%CAND_T,flagremn,intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE ,
366 a cand_a,renum,nsnrold,intbuf_tab%IRTSE,intbuf_tab%IS2SE,nsne ,dgapload,
367 b intheat,idt_therm,nodadt_therm)
368C
369C Upgrade MultiMP
370 IF (i_mem == 2)THEN
371#include "lockon.inc"
372 i_memg = i_mem
373#include "lockoff.inc"
374 ENDIF
375
376C New barrier needed for Dynamic MultiMP
377 CALL my_barrier
378
379 IF(i_memg /=0)THEN
380C CARE : JINBUF & JBUFIN array are reallocated in
381C UPGRADE_MULTIMP routine !!!!
382!$OMP SINGLE
383 multimp = ipari(23,nin) * 1.3
384 CALL upgrade_multimp(nin,multimp,intbuf_tab)
385!$OMP END SINGLE
386 i_mem = 0
387 i_memg = 0
388 intbuf_tab%I_STOK(1)=cand_n_old
389 multimp=ipari(23,nin)
390 ncontact=multimp*ncont
391 GOTO 40
392 ENDIF
393
394 IF (imonm > 0) CALL stoptime(timers,30)
395C
396#include "lockon.inc"
397 result = result + ild
398#include "lockoff.inc"
399C--------------------------------------------------------------
400C--------------------------------------------------------------
401 CALL my_barrier
402 IF (result/=0) THEN
403 CALL my_barrier
404 IF (itask==0) THEN
405C utile si on revient
406 intbuf_tab%I_STOK(1) = i_sk_old
407 result = 0
408 ENDIF
409 CALL my_barrier
410 ild = 0
411 GOTO 50
412 ENDIF
413C mise a - de dist temporairement pour reperage dans partie frontiere
414 IF(nspmd>1)THEN
415C mono tache
416!$OMP SINGLE
417 IF (imonm > 0) CALL startime(timers,26)
418 intbuf_tab%VARIABLES(distance_index) = - one
419C
420 CALL spmd_tri24gat(
421 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
422 2 ipari(21,nin),nsnr,multimp ,nty,ipari(47,nin),
423 3 ilev ,ipari(59,nin) ,h3d_data ,ipari(72,nin) ,intnitsche,
424 4 ipari(97,nin) ,ifsub_carea,nodadt_therm)
425 ipari(24,nin) = nsnr
426C
427 IF (nty==24.AND.result==0.AND.impl_s>0.AND.igsti==6) THEN
428 stif_oldfi(nin)%P(1,1:nsnr)=stif_oldfi(nin)%P(2,1:nsnr)
429 END IF
430C
431 IF (imonm > 0) CALL stoptime(timers,26)
432!$OMP END SINGLE
433 END IF
434 IF(itask==0)DEALLOCATE(cand_a)
435C
436 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i24buce
subroutine i24buce(x, v, irect, nsv, stfn, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, marge, curv_max, pmax_gap, vmaxdt, nb_n_b, eshift, ild, nin, stf, gap_s, nsnr, ncont, gap_m, itask, bgapsmx, i_mem, pene_old, itab, nbinflg, mbinflg, ilev, msegtyp, edge_l2, iedge, iseadd, isedge, cand_t, flagremnode, kremnod, remnod, cand_a, renum, nsnrold, irtse, is2se, nsne, dgapload, intheat, idt_therm, nodadt_therm)
Definition i24buce.F:45
i24trc
subroutine i24trc(nsn, i_stok, cand_n, cand_e, cand_a, nin, nsnl, irtlm, nsv, itab, mseglo, msegtyp)
Definition i7trc.F:664
i7xsave
subroutine i7xsave(x, nsv, msr, nsn, nmn, itask, xsav, xmin, ymin, zmin, xmax, ymax, zmax, c_max, curv_max, icurv, irect, nrtm_t, sx, sy, sz, sx2, sy2, sz2, nmn_l)
Definition i7xsave.F:40
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
parameters_mod
Definition parameters_mod.F:49
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545
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_rnumcd
subroutine spmd_rnumcd(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:162
spmd_tri24vox
subroutine spmd_tri24vox(nsv, nsn, x, v, ms, bminmal, weight, stifn, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, i24_irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, xfic, vfic, iedge4, nsne, is2se, irtse, is2pt, isegpt, msfic, nrtse, is2id, ispt2, intfric, ipartfrics, t2main_sms, intnitsche, forneqs, t2fac_sms, istif_msdt, stifmsdt_s, ifsub_carea, intarean)
Definition spmd_int.F:1394
spmd_tri24vox0
subroutine spmd_tri24vox0(x, bminmal, nrtm, stf, marge, curv_max, gap_m, irect, gap, bgapsmx, pmax_gap, vmaxdt, dgapload)
Definition spmd_int.F:5538
spmd_tri24gat
subroutine spmd_tri24gat(result, nsn, cand_n, i_stok, nin, igap, nsnr, multimp, ity, intth, ilev, iedge4, h3d_data, intfric, intnitsche, istif_msdt, ifsub_carea, nodadt_therm)
Definition spmd_int.F:2224
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