OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22main_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 "parit_c.inc"
#include "timeri_c.inc"
#include "inter22.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i22main_tri (timers, ipari, x, v, 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, ixs, igrbric, ale_connectivity, intbuf_tab, count_remslv, h3d_data, multi_fvm, nodadt_therm)
subroutine i22solid_getminmax (x, ixs, bufbric, nbric, itab, itask, nin)
subroutine i22shell_getminmax (x, irect, nrtm, stfe, itask, itab, eshift, bminma, marge)

Function/Subroutine Documentation

◆ i22main_tri()

subroutine i22main_tri ( type(timer_) timers,
integer, dimension(npari,ninter) ipari,
x,
v,
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,
integer, dimension(nixs,*) ixs,
type (group_), dimension(ngrbric) igrbric,
type(t_ale_connectivity), intent(in) ale_connectivity,
type(intbuf_struct_) intbuf_tab,
integer, dimension(*) count_remslv,
type(h3d_database) h3d_data,
type(multi_fvm_struct), intent(inout) multi_fvm,
integer, intent(in) nodadt_therm )

Definition at line 58 of file i22main_tri.F.

66C============================================================================
67C M o d u l e s
68C-----------------------------------------------
69 USE timer_mod
70 USE tri7box
71 USE i22tri_mod
72 USE message_mod
73 USE intbufdef_mod
74 USE i22bufbric_mod
75 USE h3d_mod
76 USE groupdef_mod
77 USE multi_fvm_mod
78 USE ale_connectivity_mod
79 use check_sorting_criteria_mod , only : check_sorting_criteria
80 use element_mod , only : nixs
81C-----------------------------------------------
82C I m p l i c i t T y p e s
83C-----------------------------------------------
84#include "implicit_f.inc"
85#include "comlock.inc"
86C-----------------------------------------------
87C C o m m o n B l o c k s
88C-----------------------------------------------
89#include "com01_c.inc"
90#include "com04_c.inc"
91#include "com08_c.inc"
92#include "param_c.inc"
93#include "task_c.inc"
94#include "parit_c.inc"
95#include "timeri_c.inc"
96#include "inter22.inc"
97C Common for global variable in memory shared
98 COMMON /i22mainc/bminma_lag,bminma_flu,result,nsnr,nsnrold,i_memg,
99 . curv_max_max
100 INTEGER RESULT,NSNR,NSNROLD,I_MEMG
101 my_real
102 . bminma_lag(6), !Local Lagrangian domain dimensions
103 . bminma_flu(6), !Local fluid domain dimensions
104 . curv_max_max
105C-----------------------------------------------
106C D u m m y A r g u m e n t s
107C-----------------------------------------------
108 TYPE(TIMER_) :: TIMERS
109 INTEGER NIN ,ITASK, RETRI, NRTM_T,ESHIFT,
110 . NUM_IMP ,IND_IMP(*),
111 . ITAB(*), KINET(*),
112 . IPARI(NPARI,NINTER), MWAG(*),
113 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),
114 . WEIGHT(*), IAD_ELEM(2,*) ,FR_ELEM(*),
115 . RENUM(NUMNOD), NSNFIOLD(NSPMD), NODNX_SMS(*),
116 . IXS(NIXS,*),NSHELL, COUNT_REMSLV(*)
117 INTEGER , INTENT(IN) :: NODADT_THERM
118 my_real
119 . x(3,*), v(3,*), ms(*),temp(*)
120 TYPE(INTBUF_STRUCT_) INTBUF_TAB
121 TYPE(H3D_DATABASE) :: H3D_DATA
122 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
123
124C-----------------------------------------------
125 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
126 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
127C-----------------------------------------------
128C L o c a l V a r i a b l e s
129C-----------------------------------------------
130 INTEGER LOC_PROC, P,
131 . I, IP0, IP1, IP2, IP21, I_SK_OLD, I_STOK1,
132 . ADD1, NB_N_B, NOINT, INACTI, MULTIMP, IGAP, IFQ,
133 . IAD, J, NF, NL, I1, I2, REM_P(NSPMD-1)
134 INTEGER ::
135 . NBRIC_G, !number of bricks in the whole model
136 . NBRIC_L, !number of bricks in the domain (not split across threads)
137 . NSHEL_G, !number of facets in the whole model
138 . NSHEL_L, !number of facets in the domain
139 . NSHEL_T, !number of facets in the domain associated with the relevant thread
140 . NSHELR_L !number of remote facets in the domain
141! number of remote facets in the domain (for the current thread)
142 INTEGER
143 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
144 . I_MEM,CAND_N_OLD,IDUM1(1),
145 . ISU1, ISU2, NBF, NBL, IBID, COUNT_CAND, CT,INTFRIC
146 LOGICAL ::
147 . IS_CONTACT
148 my_real
149 . gap,maxbox,minbox,tzinf,
150 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
151 . c_maxl,bid,
152 . curv_max(nrtm_t),rdum1(1), stfe,
153 . bminma_and_r(6), !intersection fluid in local domain and remote lag faces
154 . bminma_and(6), !intersection fluid in local domain and all faces
155 . vel(4), vel_max
156 INTEGER :: NRTM,NSN,NTY,NMN
157 logical :: need_computation
158C-----------------------------------------------
159
160 ! --------------
161 ! check if the current interface needs to be sorted
162 call check_sorting_criteria( need_computation,nin,npari,nspmd,
163 . itask,ipari(1,nin),tt,intbuf_tab )
164 if( .not.need_computation ) return
165 ! --------------
166
167 i_memg = 0
168 i_mem = 0
169 is_contact=.false.
170
171C -------------------------------------------------------------
172C retri criterion
173C -------------------------------------------------------------
174 retri = 1
175C
176C -------------------------------------------------------------
177C INITIALISATIONS
178C -------------------------------------------------------------
179 nrtm =ipari(4,nin)
180 nsn =ipari(5,nin)
181 nmn =ipari(6,nin)
182 nty =ipari(7,nin)
183 noint =ipari(15,nin)
184 ncont =ipari(18,nin)
185 inacti =ipari(22,nin)
186 multimp=ipari(23,nin)
187 ncontact=multimp*ncont
188 !IFQ =IPARI(31,NIN)
189 i_sk_old=0
190 !INTTH = IPARI(47,NIN)
191 nsnrold = 0
192 gap =intbuf_tab%VARIABLES(2)
193 gapmin=intbuf_tab%VARIABLES(13)
194 gapmax=intbuf_tab%VARIABLES(16)
195 intbuf_tab%I_STOK(1)=0 !initialization of the number of candidates (II_STOK = INTBUF_TAB%I_STOK(1))
196
197 !number of elements for the interface (total, domain, thread)
198 !---BRIQUES---!
199 nbric_g = ipari(32,nin)
200 isu1 = ipari(45,nin)
201 nbric_l = igrbric(isu1)%NENTITY
202!no IAD = IPARI(39,NIN) !ddsplit IPARI(39) <- IGRN(3) could change in ddsplit
203 !---SHELL---!
204 nshel_g = ipari(33,nin)
205 nshel_l = ipari(4,nin)
206 !ISU2 = IPARI(46,NIN)
207 !NSHEL_T = IGRN(2,ISU2)
208 nshel_t = nrtm_t
209 !---REMOTES---!
210 nsnr = 0
211 nshelr_l = 0
212 !NSHELR_T = NSNR
213
214 nirect_l = nshel_g !is an upper bound of NSHEL_L+NSHELR_L
215
216C -------------------------------------------------------------
217C ALLOCATIONS
218C -------------------------------------------------------------
219 IF(itask==0)THEN
220 ALLOCATE (irect_l(siz_irect_l,nshel_g))
221 ALLOCATE(xmins(nbric_l))
222 ALLOCATE(ymins(nbric_l))
223 ALLOCATE(zmins(nbric_l))
224 ALLOCATE(xmaxs(nbric_l))
225 ALLOCATE(ymaxs(nbric_l))
226 ALLOCATE(zmaxs(nbric_l))
227 ALLOCATE(nsnr_g(nthread))
228 ALLOCATE(xmine(nshel_l))
229 ALLOCATE(ymine(nshel_l))
230 ALLOCATE(zmine(nshel_l))
231 ALLOCATE(xmaxe(nshel_l))
232 ALLOCATE(ymaxe(nshel_l))
233 ALLOCATE(zmaxe(nshel_l))
234 bminma_lag(1) = -ep30
235 bminma_lag(2) = -ep30
236 bminma_lag(3) = -ep30
237 bminma_lag(4) = ep30
238 bminma_lag(5) = ep30
239 bminma_lag(6) = ep30
240 dx22_min = ep30 !cinematic time step
241 v22_max = zero !cinematic time step
242 dt22_min = ep30 !cinematic time step
243 END IF
244
245 !cinematic time step
246 dx22min_l(itask) = ep30
247 v22max_l(itask) = zero
248
249 CALL my_barrier ! waiting for allocations
250
251 nsnr_g(1:nthread) = 0
252 loc_proc=ispmd+1
253
254C -------------------------------------------------------------
255C INITIALISATION DIMENSIONS DU DOMAINE LAGRANGIEN LOCAL
256C -------------------------------------------------------------
257 maxbox = intbuf_tab%VARIABLES(9)
258 minbox = intbuf_tab%VARIABLES(12)
259 tzinf = intbuf_tab%VARIABLES(8)
260
261C -------------------------------------------------------------
262C calculation of the lagrangian domain bounds of the thread
263C -------------------------------------------------------------
264C eshift: shift of the facet group, from NSHEL_T (thread) to NSHEL_L (local)
265 CALL i22xsave(
266 1 x ,intbuf_tab%NSV ,intbuf_tab%MSR ,nsn ,nmn ,
267 2 itask ,intbuf_tab%XSAV ,xminl ,yminl ,zminl ,
268 3 xmaxl ,ymaxl ,zmaxl ,c_maxl ,curv_max ,
269 4 ipari(39,nin) ,intbuf_tab%IRECTM(1+4*eshift) ,nrtm_t )
270
271#include "lockon.inc"
272 bminma_lag(1) = max(bminma_lag(1),xmaxl)
273 bminma_lag(2) = max(bminma_lag(2),ymaxl)
274 bminma_lag(3) = max(bminma_lag(3),zmaxl)
275 bminma_lag(4) = min(bminma_lag(4),xminl)
276 bminma_lag(5) = min(bminma_lag(5),yminl)
277 bminma_lag(6) = min(bminma_lag(6),zminl)
278#include "lockoff.inc"
279 result = 0
280C barrier II_STOK and RESULT
281 call my_barrier! the BMINMA bounds must be in SPMD_TRI22VOX0, those of the domain and not those of the thread
282 !wait for the contributions of each thread
283
284C to keep for the case where inacti is modified on p0
285 inacti=ipari(22,nin)
286 IF(itask==0)THEN
287 IF(abs(bminma_lag(6)-bminma_lag(3))>2*ep30.OR.
288 + abs(bminma_lag(5)-bminma_lag(2))>2*ep30.OR.
289 + abs(bminma_lag(4)-bminma_lag(1))>2*ep30)THEN
290 CALL ancmsg(msgid=87,anmode=aninfo,
291 . i1=noint,c1='(I22BUCE)')
292 CALL arret(2)
293 END IF
294
295 !extension of the lagrangian domain with TZINF (check calculation of TZINF)
296 if(itask==0.and.ibug22_tri==1)print *,
297 . "applying TZINF extension to lag domain", tzinf
298
299 bminma_lag(1)=bminma_lag(1)+tzinf
300 bminma_lag(2)=bminma_lag(2)+tzinf
301 bminma_lag(3)=bminma_lag(3)+tzinf
302 bminma_lag(4)=bminma_lag(4)-tzinf
303 bminma_lag(5)=bminma_lag(5)-tzinf
304 bminma_lag(6)=bminma_lag(6)-tzinf
305
306 IF(nspmd > lrvoxelp)THEN
307 CALL ancmsg(msgid=36,anmode=aninfo,
308 . c1='(I22MAINTRI)')
309 CALL arret(2)
310 END IF
311 END IF
312
313
314C -------------------------------------------------------------
315C COMMUNICATION BORNES DES DOMAINES LAGRANGIENS
316C BMINMA_LAG_G(1:6) is global model data
317C -------------------------------------------------------------
318 IF(nspmd > 1) THEN
319 IF(itask==0)THEN
320 ALLOCATE(bminma_lag_spmd(6,nspmd))
321 IF(imonm > 0) CALL startime(timers,25)
322 CALL spmd_lagbounds_exch_i22(
323 . bminma_lag_spmd, bminma_lag, isendto ,ircvfrom , nin)
324 IF(imonm > 0) CALL stoptime(timers,25)
325
326 if(itask==0.and.ibug22_tri==1)print *, "BMINMA=",
327 . bminma_lag(4:6),bminma_lag(1:3)
328 j=1
329 !listing all remote proc in REM_P(1:NSPMD-1)
330C -------------------------------------------------------------
331C calculation of the domain dimensions
332C + LAGRANGIENS REMOTES : BMINMA_LAG_R
333C + LAGRANGIEN GLOBAL : BMINMA_LAG_G
334C -------------------------------------------------------------
335 DO p=1,nspmd
336 IF(p==loc_proc)cycle
337 rem_p(j)=p
338 j=j+1
339 END DO
340 p=loc_proc
341 j=nspmd-1
342 !lagrangian bounds for all remote faces
343 bminma_lag_r(4) = minval(bminma_lag_spmd(4,rem_p(1:j)))
344 bminma_lag_r(5) = minval(bminma_lag_spmd(5,rem_p(1:j)))
345 bminma_lag_r(6) = minval(bminma_lag_spmd(6,rem_p(1:j)))
346 bminma_lag_r(1) = maxval(bminma_lag_spmd(1,rem_p(1:j)))
347 bminma_lag_r(2) = maxval(bminma_lag_spmd(2,rem_p(1:j)))
348 bminma_lag_r(3) = maxval(bminma_lag_spmd(3,rem_p(1:j)))
349 !lagrangian bounds for all faces in model
350 bminma_lag_g(4) = min(bminma_lag_r(4),bminma_lag_spmd(4,p))
351 bminma_lag_g(5) = min(bminma_lag_r(5),bminma_lag_spmd(5,p))
352 bminma_lag_g(6) = min(bminma_lag_r(6),bminma_lag_spmd(6,p))
353 bminma_lag_g(1) = max(bminma_lag_r(1),bminma_lag_spmd(1,p))
354 bminma_lag_g(2) = max(bminma_lag_r(2),bminma_lag_spmd(2,p))
355 bminma_lag_g(3) = max(bminma_lag_r(3),bminma_lag_spmd(3,p))
356 !---------------debug--------------!
357 if(itask==0.and.ibug22_tri==1)then
358 print *, ""
359 print *, "TZINF=", tzinf
360 print *, ""
361 print *, "---------------------------------------------------"
362 print *, "CURRENT DOMAIN =", loc_proc
363 print *, "--------BOUNDS FOR CURRENT LAG DOMAIN--------------"
364 print *, " BMINMAL=", bminma_lag(4:6),bminma_lag(1:3)
365 print *, "--------BOUNDS FOR ALL LAG DOMAINS-----------------"
366 DO i=1, nspmd
367 print *, "DOMAIN =", ispmd+1
368 print *, " BMINMAL=",
369 . bminma_lag_spmd(4:6,i),bminma_lag_spmd(1:3,i)
370 END DO
371 print *, "--------BOUNDS FOR AL REMOTE LAG DOMAINS-----------"
372 print *, " BMINMAL=", bminma_lag_r(4:6),bminma_lag_r(1:3)
373 print *, "--------BOUNDS FOR LAG GLOBAL DOMAINS--------------"
374 print *, " BMINMAL=", bminma_lag_g(4:6),bminma_lag_g(1:3)
375 print *, "---------------------------------------------------"
376 !print *, ""
377 end if
378 !---------------debug--------------!
379 END IF
380 ELSE
381 IF(ITASK==0) BMINMA_LAG_G = BMINMA_LAG
382 END IF
383
384C -------------------------------------------------------------
385C calculation of the local fluid domain dimensions (multi-threading)
386C -------------------------------------------------------------
387 !initialization of the fluid domain bounds
388 BMINMA_FLU(1) = -EP30
389 BMINMA_FLU(2) = -EP30
390 BMINMA_FLU(3) = -EP30
391 BMINMA_FLU(4) = EP30
392 BMINMA_FLU(5) = EP30
393 BMINMA_FLU(6) = EP30
394
395
396 !IBUFSSG(IAD)[1:NBRIC_L] is multi-threaded
397 !computing MIN/MAX for 3D fluid elems
398 CALL I22SOLID_GETMINMAX (
399 1 X, IXS, IGRBRIC(ISU1)%ENTITY, NBRIC_L,
400 2 ITAB, ITASK, NIN )
401
402 CALL MY_BARRIER
403
404 !calculation of the fluid domain bounds
405#include "lockon.inc"
406 BMINMA_FLU(1) = MAX(BMINMA_FLU(1),MAXVAL(XMAXS))
407 BMINMA_FLU(2) = MAX(BMINMA_FLU(2),MAXVAL(YMAXS))
408 BMINMA_FLU(3) = MAX(BMINMA_FLU(3),MAXVAL(ZMAXS))
409 BMINMA_FLU(4) = MIN(BMINMA_FLU(4),MINVAL(XMINS))
410 BMINMA_FLU(5) = MIN(BMINMA_FLU(5),MINVAL(YMINS))
411 BMINMA_FLU(6) = MIN(BMINMA_FLU(6),MINVAL(ZMINS))
412#include "lockoff.inc"
413
414 CALL MY_BARRIER ! waiting for fluid local domain bounds definition (multi-threading)
415
416 IF(ITASK==0) THEN
417 BMINMA_FLU(1) = BMINMA_FLU(1)+TZINF
418 BMINMA_FLU(2) = BMINMA_FLU(2)+TZINF
419 BMINMA_FLU(3) = BMINMA_FLU(3)+TZINF
420 BMINMA_FLU(4) = BMINMA_FLU(4)-TZINF
421 BMINMA_FLU(5) = BMINMA_FLU(5)-TZINF
422 BMINMA_FLU(6) = BMINMA_FLU(6)-TZINF
423 !---------------debug--------------!
424.and. if(itask==0ibug22_tri==1)then
425 print *, "--------local fluid domain-------------"
426 print *, " bminmal_flu=", BMINMA_FLU(4:6),BMINMA_FLU(1:3)
427 print *, "---------------------------------------------------"
428 print *, ""
429 end if
430 !---------------debug--------------!
431 END IF
432
433C -------------------------------------------------------------
434C calculation of the min/max of the facets of each thread in the domain
435C -------------------------------------------------------------
436
437 !computing MIN/MAX for 2D elems
438 CALL I22SHELL_GETMINMAX(
439 1 X, INTBUF_TAB%IRECTM(1+4*ESHIFT), NRTM_T, INTBUF_TAB%STFM(1+ESHIFT), ITASK,
440 2 ITAB, ESHIFT, BMINMA_FLU, TZINF )
441
442 CALL MY_BARRIER !XMINE,XMAXE,... must be defined by all threads before going on.
443
444
445C -------------------------------------------------------------
446C search in the other domains for nearby facets
447C of the local fluid domain (remote). allocation of XREM
448C -------------------------------------------------------------
449
450 IF(NSPMD > 1) THEN
451
452 IF(ITASK==0) CRVOXEL(0:LRVOXEL,0:LRVOXEL,LOC_PROC)=0
453 CALL MY_BARRIER ! waiting for crvoxel init.
454.AND. IF (IMONM > 0 ITASK == 0) CALL STARTIME(TIMERS,26)
455
456 CALL SPMD_TRI22VOX0(
457 1 X, BMINMA_FLU , NBRIC_L, IXS, IGRBRIC(ISU1)%ENTITY,
458 2 ITASK, ITAB , XMINS , YMINS, ZMINS ,
459 3 XMAXS, YMAXS , ZMAXS ,BMINMA_LAG_R, IS_CONTACT,
460 4 BMINMA_AND_R )
461
462 CALL MY_BARRIER ! all thread has to mark local domain Voxel before reading it above.
463
464.AND. IF (IMONM > 0 ITASK == 0) CALL STOPTIME(TIMERS,26)
465 IF(ITASK==0)THEN
466 IF (IMONM > 0 ) CALL STARTIME(TIMERS,25)
467 !Contact = True if intersection not zero between local fluid field / distant lag
468 IF(IS_CONTACT) CALL SPMD_TRI22VOX(
469 1 INTBUF_TAB%IRECTM ,NSHEL_L ,X ,V ,BMINMA_AND_R, !send the shells of the domain
470 2 INTBUF_TAB%STFM ,NIN ,ISENDTO ,IRCVFROM ,IAD_ELEM ,
471 3 FR_ELEM ,NSNR ,ITAB ,ITASK )
472
473 IF (IMONM > 0) CALL STOPTIME(TIMERS,25)
474
475 NIRECT_L = NSHEL_L + NSNR !We had an upper one of nshel_l+nshelr_l, we know maintain the exact size because nshelr_l = nsnr (nb candidate remote)
476
477 ELSE
478 !check if there is contact with the intersection of the domains
479
480 END IF
481
482 call MY_BARRIER! wait for the allocation and filling of XREM to fill IRECT_L
483 NSHELR_L = NSNR
484 !NSHELR_T = NSNR
485
486 END IF
487
488
489C -------------------------------------------------------------
490C definition of the global shell array (local + remotes)
491C -------------------------------------------------------------
492C Irect_l (1: 4, :): oven node itab (id): Numero Glolocal for Unicit with Xrem
493C IRECT_L( 5: 8, :) : X-coordinates
494C IRECT_L( 9:12, :) : Y-coordinates
495C IRECT_L(13:16, :) : Z-coordinates
496C IRECT_L(17:19, :) : Minimum X,Y,Z
497C IRECT_L(20:22, :) : Maximum X,Y,Z
498C Irect_l (23, :): Stiffness
499C IRECT_L(24:26, :) : Lagrangian Velocity (mean)
500C IRECT_L( :,1+4*ESHIFT:4*ESHIFT+NRTM_T) : element data on current Thread
501C IRECT_L( :,NRTM+1:NRTM + NSNR) : remotes elements data
502
503! Filling with local data
504 DO I=0,NSHEL_T-1
505 IP1=I+1
506 J = ESHIFT + IP1 !numero global (local+remote)
507 STFE = INTBUF_TAB%STFM(1+ESHIFT+I) ! stiffness in the shell group of the thread
508 IRECT_L(23 , J) = STFE ! Stiffness
509 !IF(STFE==ZERO) CYCLE
510 I1 = 1+4*ESHIFT+4*I
511 I2 = I1+3
512 IRECT_L(1:4 , J) = ITAB(INTBUF_TAB%IRECTM(I1:I2)) ! User Nodes
513 IRECT_L(5:8 , J) = X(1,INTBUF_TAB%IRECTM(I1:I2)) ! X-coordinates
514 IRECT_L(9:12 , J) = X(2,INTBUF_TAB%IRECTM(I1:I2)) ! Y-coordinates
515 IRECT_L(13:16, J) = X(3,INTBUF_TAB%IRECTM(I1:I2)) ! Z-coordinates
516 IRECT_L(17:19, J) = (/XMINE(J),YMINE(J),ZMINE(J)/) ! Minimum X,Y,Z
517 IRECT_L(20:22, J) = (/XMAXE(J),YMAXE(J),ZMAXE(J)/) ! Maximum X,Y,Z
518 IRECT_L(24, J) = SUM(V(1,INTBUF_TAB%IRECTM(I1:I2)))/FOUR ! X-Velocity (mean)
519 IRECT_L(25, J) = SUM(V(2,INTBUF_TAB%IRECTM(I1:I2)))/FOUR ! Y-Velocity (mean)
520 IRECT_L(26, J) = SUM(V(3,INTBUF_TAB%IRECTM(I1:I2)))/FOUR ! Z-Velocity (mean)
521
522 !cinematic time step
523 vel(1) = dot_product(V(1:3,INTBUF_TAB%IRECTM(I1+0)),V(1:3,INTBUF_TAB%IRECTM(I1+0)))
524 vel(2) = dot_product(V(1:3,INTBUF_TAB%IRECTM(I1+1)),V(1:3,INTBUF_TAB%IRECTM(I1+1)))
525 vel(3) = dot_product(V(1:3,INTBUF_TAB%IRECTM(I1+2)),V(1:3,INTBUF_TAB%IRECTM(I1+2)))
526 vel(4) = dot_product(V(1:3,INTBUF_TAB%IRECTM(I1+3)),V(1:3,INTBUF_TAB%IRECTM(I1+3)))
527 vel(1) = SQRT(vel(1))
528 vel(2) = SQRT(vel(2))
529 vel(3) = SQRT(vel(3))
530 vel(4) = SQRT(vel(4))
531 v22max_l(ITASK) = MAX(v22max_l(ITASK), MAXVAL(vel) )
532
533 END DO
534
535! Filling with remote faces data
536 NF = 1+ITASK*NSHELR_L/NTHREAD
537 NL = (ITASK+1)*NSHELR_L/NTHREAD
538 DO I=NF,NL !1,NSNR
539 J = NSHEL_L+I
540 IRECT_L(1:4 , J) = XREM( 1:4,I) ! User Nodes
541 IRECT_L(5:8 , J) = XREM( 5:8,I) ! X-coordinates
542 IRECT_L(9:12 , J) = XREM( 9:12,I) ! Y-coordinates
543 IRECT_L(13:16 , J) = XREM(13:16,I) ! Z-coordinates
544 IRECT_L(17:19 , J) = XREM(17:19,I) ! Minimum X,Y,Z
545 IRECT_L(20:22 , J) = XREM(20:22,I) ! Maximum X,Y,Z
546 IRECT_L(23 , J) = XREM( 23,I) ! Stiffness (necessarily not zero)
547 IRECT_L(24:26 , J) = XREM(24:26,I) ! XYZ-Velocity (mean)
548
549 !missing SPMD cinematic time step
550 END DO
551!
552
553C--------------------------------------------------------------
554C CINEMATIC TIME STEP (MAXIMUM SPEED)
555C--------------------------------------------------------------
556 CALL MY_BARRIER
557#include "lockon.inc"
558 v22_max = MAX(v22_max,v22max_l(ITASK))
559#include "lockoff.inc"
560
561C -------------------------------------------------------------
562
563C -------------------------------------------------------------
564
565 CAND_N_OLD = INTBUF_TAB%I_STOK(1)
566 40 CONTINUE !verifier
567
568 ILD = 0
569 NB_N_B = 1
570
571C -------------------------------------------------------------
572C CALCUL DES DIMENSIONS DOMAINE D'INTERET
573C INTERSECTION DE : {FLUIDE LOCAL} & {LAGRANGIEN GLOBAL}
574C -------------------------------------------------------------
575
576 BMINMA_AND(1) = MIN(BMINMA_FLU(1),BMINMA_LAG_G(1))
577 BMINMA_AND(2) = MIN(BMINMA_FLU(2),BMINMA_LAG_G(2))
578 BMINMA_AND(3) = MIN(BMINMA_FLU(3),BMINMA_LAG_G(3))
579 BMINMA_AND(4) = MAX(BMINMA_FLU(4),BMINMA_LAG_G(4))
580 BMINMA_AND(5) = MAX(BMINMA_FLU(5),BMINMA_LAG_G(5))
581 BMINMA_AND(6) = MAX(BMINMA_FLU(6),BMINMA_LAG_G(6))
582
583c if(itask==0.and.ibug22_tri==1)print *,
584c . "Faire test si dimension negative ",
585c . "=>candidat=0 ! here or in i22trivox
586
587
588 50 CALL MY_BARRIER
589
590 IF (BMINMA_AND(1)-BMINMA_AND(4)<0)GOTO 999
591 IF (BMINMA_AND(2)-BMINMA_AND(5)<0)GOTO 999
592 IF (BMINMA_AND(3)-BMINMA_AND(6)<0)GOTO 999
593
594 ISKIP22 = 0
595
596C -------------------------------------------------------------
597C search for candidate pairs for the interaction
598C -------------------------------------------------------------
599
600 IF (IMONM > 0) CALL STARTIME(TIMERS,30)
601 CALL I22BUCE(
602 1 X ,INTBUF_TAB%IRECTM(1+4*ESHIFT) ,INTBUF_TAB%NSV ,INACTI ,ISKIP22 ,
603 2 NMN ,NSHEL_T ,NSN ,INTBUF_TAB%CAND_E ,INTBUF_TAB%CAND_N ,
604 3 GAP ,NOINT ,INTBUF_TAB%I_STOK(1) ,NCONTACT ,BMINMA_AND ,
605 4 TZINF ,MAXBOX ,MINBOX ,MWAG ,CURV_MAX ,
606 6 NB_N_B ,ESHIFT ,ILD ,IFQ ,IBID ,
607 8 INTBUF_TAB%STFNS ,NIN ,INTBUF_TAB%STFM(1+ESHIFT) ,IPARI(21,NIN) ,
608 A NSHELR_L ,NCONT ,RENUM ,NSNROLD ,
609 B GAPMIN ,GAPMAX ,CURV_MAX_MAX ,NUM_IMP ,
610 C INTTH ,ITASK ,INTBUF_TAB%VARIABLES(7) ,I_MEM ,
611 D IXS ,IGRBRIC(ISU1)%ENTITY ,NBRIC_L ,ITAB ,NSHEL_L ,
612 E ALE_CONNECTIVITY ,IPARI(1,NIN) )
613C
614C Upgrade MultiMP
615 IF (I_MEM == 2)THEN
616#include "lockon.inc"
617 I_MEMG = I_MEM
618#include "lockoff.inc"
619 ENDIF
620C New barrier needed for Dynamic MultiMP
621 CALL MY_BARRIER
622
623 IF(I_MEMG /=0)THEN
624!$OMP SINGLE
625 MULTIMP = IPARI(23,NIN) + 4
626 CALL UPGRADE_MULTIMP(NIN,MULTIMP,INTBUF_TAB)
627!$OMP END SINGLE
628 I_MEM = 0
629 I_MEMG = 0
630 INTBUF_TAB%i_STOK(1) = CAND_N_OLD
631 MULTIMP = IPARI(23,NIN)
632 NCONTACT = MULTIMP*NCONT
633C eshift: shift on cand_e
634 GOTO 40
635 ENDIF
636
637 IF (IMONM > 0) CALL STOPTIME(TIMERS,30)
638C
639 COUNT_CAND = INTBUF_TAB%I_STOK(1)
640 CT = INTBUF_TAB%I_STOK(1)
641#include "lockon.inc"
642 INTBUF_TAB%VARIABLES(9) = MIN(MAXBOX,INTBUF_TAB%VARIABLES(9))
643 INTBUF_TAB%VARIABLES(12) = MIN(MINBOX,INTBUF_TAB%VARIABLES(12))
644 INTBUF_TAB%VARIABLES(8) = MIN(TZINF,INTBUF_TAB%VARIABLES(8))
645 INTBUF_TAB%VARIABLES(5) = INTBUF_TAB%VARIABLES(8)-GAP
646 RESULT = RESULT + ILD
647 LSKYI_COUNT = LSKYI_COUNT+COUNT_CAND*5
648 COUNT_REMSLV(NIN) = COUNT_REMSLV(NIN)+CT
649#include "lockoff.inc"
650
651
652
653C--------------------------------------------------------------
654C--------------------------------------------------------------
655 CALL MY_BARRIER
656 IF (RESULT/=0) THEN
657 CALL MY_BARRIER
658 IF (ITASK==0) THEN
659C utile si on revient
660 INTBUF_TAB%I_STOK(1) = I_SK_OLD
661 RESULT = 0
662 ENDIF
663 CALL MY_BARRIER
664 ILD = 0
665 MAXBOX = INTBUF_TAB%VARIABLES(9)
666 MINBOX = INTBUF_TAB%VARIABLES(12)
667 TZINF = INTBUF_TAB%VARIABLES(8)
668 GOTO 50
669 ENDIF
670C temporarily set dist to - for identification in the boundary part
671 IF(NSPMD>1)THEN
672C mono tache
673!$OMP SINGLE
674 IF (IMONM > 0) CALL STARTIME(TIMERS,26)
675 INTBUF_TAB%VARIABLES(5) = -INTBUF_TAB%VARIABLES(5)
676C
677 INTFRIC = 0
678 CALL SPMD_TRI7GAT(
679 1 RESULT ,NSN ,INTBUF_TAB%CAND_N,INTBUF_TAB%I_STOK(1),NIN,
680 2 IPARI(21,NIN),NSNR,MULTIMP ,NTY,IPARI(47,NIN),
681 3 IDUM1 ,NSNFIOLD, IPARI, H3D_DATA,INTFRIC,
682 4 MULTI_FVM,NODADT_THERM)
683 IPARI(24,NIN) = NSNR
684C
685 IF (NUM_IMP>0)
686 . CALL IMP_RNUMCD(INTBUF_TAB%CAND_N,NIN,NSN,NUM_IMP,IND_IMP )
687C
688 IF (IMONM > 0) CALL STOPTIME(TIMERS,26)
689!$OMP END SINGLE
690 END IF
691
692C--------------------------------------------------------------
693C DEALLOCATE
694C--------------------------------------------------------------
695
696 999 CONTINUE !JUMP IF DOMAINE INTERSECTION VIDE (PAS DE CANDIDATS)
697
698
699 IF(ITASK==0)THEN
700 !DEALLOCATE(IRECT_L)
701 DEALLOCATE(XMINS)
702 DEALLOCATE(YMINS)
703 DEALLOCATE(ZMINS)
704 DEALLOCATE(XMAXS)
705 DEALLOCATE(YMAXS)
706 DEALLOCATE(ZMAXS)
707 DEALLOCATE(NSNR_G)
708 DEALLOCATE(XMINE)
709 DEALLOCATE(YMINE)
710 DEALLOCATE(ZMINE)
711 DEALLOCATE(XMAXE)
712 DEALLOCATE(YMAXE)
713 DEALLOCATE(ZMAXE)
714 IF(ALLOCATED(BMINMA_LAG_SPMD))DEALLOCATE(BMINMA_LAG_SPMD)
715 END IF
716
717 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i22xsave
subroutine i22xsave(x, nsv, msr, nsn, nmn, itask, xsav, xmin, ymin, zmin, xmax, ymax, zmax, c_max, curv_max, icurv, irect, nrtm_t)
Definition i22xsave.F:33
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::ibug22_tri
integer ibug22_tri
Definition cut-cell-search_mod.F:231
i22tri_mod::nirect_l
integer nirect_l
Definition cut-cell-search_mod.F:447
i22tri_mod::siz_irect_l
integer siz_irect_l
Definition cut-cell-search_mod.F:449
i22tri_mod::nsnr_g
integer, dimension(:), allocatable nsnr_g
Definition cut-cell-search_mod.F:452
message_mod
Definition message_mod.F:1257
tri7box::lrvoxelp
integer lrvoxelp
Definition tri7box.F:522
spmd_lagbounds_exch_i22
subroutine spmd_lagbounds_exch_i22(bminmal_spmd, bminmal, isendto, ircvfrom, nin)
Definition spmd_lagbounds_exch_i22.F:35
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

◆ i22shell_getminmax()

subroutine i22shell_getminmax ( x,
integer, dimension(4,nrtm) irect,
integer nrtm,
stfe,
integer itask,
integer, dimension(*) itab,
integer eshift,
bminma,
marge )

Definition at line 822 of file i22main_tri.F.

825C============================================================================
826C M o d u l e s
827C-----------------------------------------------
828 USE tri7box
829 USE i22tri_mod
830C-----------------------------------------------
831C I m p l i c i t T y p e s
832C-----------------------------------------------
833#include "implicit_f.inc"
834C-----------------------------------------------
835C D u m m y A r g u m e n t s
836C-----------------------------------------------
837 INTEGER NRTM,IRECT(4,NRTM), ITASK, ESHIFT
838 my_real
839 . x(3,*), stfe(nrtm), bminma(6), marge
840C-----------------------------------------------
841C L o c a l V a r i a b l e s
842C-----------------------------------------------
843 INTEGER ::
844 . IE, NE, N(4), NRTMR
845
846 my_real ::
847 . xx(4), yy(4), zz(4),
848 . xmin,ymin,zmin,
849 . xmax,ymax,zmax
850 INTEGER TAB(4*NRTM), J, I, ITAB(*)
851 CHARACTER*8 KEY
852C-----------------------------------------------
853
854!---------------debug---------------
855! DO I=0,NRTM-1
856! J = 4*I
857! TAB(J+1:J+4)=ITAB(IRECT(1:4,I+1))
858! END DO
859! KEY="FACETTE0"
860! write(KEY(8:8),'(i1.1)')ISPMD
861! print *, " ...marking node from local shells "
862! print *, KEY//".txt"
863! CALL HM_MARKNOD ( ISPMD,ITASK, TAB, 4*NRTM, KEY//".txt")
864! print *, " ...write OK"
865!---------------debug---------------
866
867!---------------debug---------------
868! !print *, "NRTMR=", NRTMR
869! DO I=0,NRTMR-1
870! J = 4*I
871! TAB(J+1)=ITAB(XREM( 8,I+1))
872! TAB(J+2)=ITAB(XREM(15,I+1))
873! TAB(J+3)=ITAB(XREM(22,I+1))
874! TAB(J+4)=ITAB(XREM(29,I+1))
875! END DO
876! KEY="REMOTE_0"
877! write(KEY(8:8),'(i1.1)')ISPMD
878! print *, " ...marking node from remote shells "
879! print *, KEY//".txt"
880! CALL HM_MARKNOD ( ISPMD,ITASK, TAB, 4*NRTMR, KEY//".txt")
881! print *, " ...write OK"
882!---------------debug---------------
883
884 ! we check in passing that the local faces are near (margin) the local fluid domain (bminma)
885 xmin = bminma(4)-marge
886 ymin = bminma(5)-marge
887 zmin = bminma(6)-marge
888 xmax = bminma(1)+marge
889 ymax = bminma(2)+marge
890 zmax = bminma(3)+marge
891
892 DO ie=1,nrtm
893 IF(stfe(ie)==zero)cycle
894 j = ie+eshift
895 n(1:4) = irect(1:4,ie)
896 !-------------------------------------------!
897 ! Eight X-coordinates of the eight nodes !
898 !-------------------------------------------!
899 xx(1:4) = x(1,n(1:4))
900 xmaxe(j) = maxval(xx)
901 xmine(j) = minval(xx)
902 !-------------------------------------------!
903 ! Eight Y-coordinates of the eight nodes !
904 !-------------------------------------------!
905 yy(1:4) = x(2,n(1:4))
906 ymaxe(j) = maxval(yy)
907 ymine(j) = minval(yy)
908 !-------------------------------------------!
909 ! Eight Z-coordinates of the eight nodes !
910 !-------------------------------------------!
911 zz(1:4) = x(3,n(1:4))
912 zmaxe(j) = maxval(zz)
913 zmine(j) = minval(zz)
914 ENDDO !IB=1,NRTM
915
916 RETURN
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274

◆ i22solid_getminmax()

subroutine i22solid_getminmax ( x,
integer, dimension(nixs,*) ixs,
integer, dimension(nbric) bufbric,
integer nbric,
integer, dimension(*) itab,
integer itask,
integer, intent(in) nin )

Definition at line 729 of file i22main_tri.F.

732C============================================================================
733C-----------------------------------------------
734C M o d u l e s
735C-----------------------------------------------
736 USE i22bufbric_mod
737 USE i22tri_mod
738 use element_mod , only : nixs
739C-----------------------------------------------
740C I m p l i c i t T y p e s
741C-----------------------------------------------
742#include "implicit_f.inc"
743C-----------------------------------------------
744C G l o b a l P a r a m e t e r s
745C-----------------------------------------------
746#include "task_c.inc"
747C-----------------------------------------------
748C C o m m o n B l o c k s
749C-----------------------------------------------
750C
751C-----------------------------------------------
752C D u m m y A r g u m e n t s
753C-----------------------------------------------
754 INTEGER ::
755 . IXS(NIXS,*), NBRIC,ITASK,
756 . BUFBRIC(NBRIC),ITAB(*)
757 INTEGER,INTENT(IN) :: NIN
758
759 my_real ::
760 . x(3,*)
761C-----------------------------------------------
762C L o c a l V a r i a b l e s
763C-----------------------------------------------
764 INTEGER IB, NE, TAB(8*NBRIC)
765 my_real
766 . xx(8), yy(8), zz(8), diag(4)
767 CHARACTER*8 KEY
768 INTEGER I,J, NBF, NBL
769C-----------------------------------------------
770
771!---------------debug---------------
772! DO I=0,NBRIC-1
773! J = 8*I
774! TAB(J+1:J+8)=ITAB(IXS(2:9,I+1))
775! END DO
776! KEY="BRIQUE_0"
777! write(KEY(8:8),'(i1.1)')ISPMD
778! print *, " ...marking node from local bricks "
779! print *, KEY//".txt"
780! CALL HM_MARKNOD ( ISPMD,ITASK, TAB, 8*NBRIC, KEY//".txt")
781! print *, " ...write OK"
782!---------------debug---------------
783
784 nbf = 1+itask*nbric/nthread
785 nbl = (itask+1)*nbric/nthread
786
787 DO ib=nbf,nbl !1,NBRIC
788 ne = bufbric(ib)
789 !-------------------------------------------!
790 ! Eight X-coordinates of the eight nodes !
791 !-------------------------------------------!
792 xx(1:8) = x(1,ixs(2:9,ne))
793 xmaxs(ib)= maxval(xx)
794 xmins(ib)= minval(xx)
795 !-------------------------------------------!
796 ! Eight Y-coordinates of the eight nodes !
797 !-------------------------------------------!
798 yy(1:8) = x(2,ixs(2:9,ne))
799 ymaxs(ib) = maxval(yy)
800 ymins(ib) = minval(yy)
801 !-------------------------------------------!
802 ! Eight Z-coordinates of the eight nodes !
803 !-------------------------------------------!
804 zz(1:8) = x(3,ixs(2:9,ne))
805 zmaxs(ib) = maxval(zz)
806 zmins(ib) = minval(zz)
807 !
808 ENDDO !IB=1,NBRIC
809
810 RETURN