OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22main_tri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| check_sorting_criteria ../engine/source/interfaces/intsort/check_sorting_criteria.F90
31!|| i22buce ../engine/source/interfaces/intsort/i22buce.F
32!|| i22shell_getminmax ../engine/source/interfaces/intsort/i22main_tri.F
33!|| i22solid_getminmax ../engine/source/interfaces/intsort/i22main_tri.F
34!|| i22xsave ../engine/source/interfaces/intsort/i22xsave.F
35!|| imp_rnumcd ../engine/source/implicit/imp_int_k.F
36!|| my_barrier ../engine/source/system/machine.F
37!|| spmd_lagbounds_exch_i22 ../engine/source/mpi/interfaces/spmd_lagbounds_exch_i22.F
38!|| spmd_tri22vox ../engine/source/mpi/interfaces/spmd_tri22vox.F
39!|| spmd_tri22vox0 ../engine/source/mpi/interfaces/spmd_tri22vox0.F
40!|| spmd_tri7gat ../engine/source/mpi/interfaces/spmd_int.F
41!|| startime ../engine/source/system/timer_mod.F90
42!|| stoptime ../engine/source/system/timer_mod.F90
43!|| upgrade_multimp ../common_source/interf/upgrade_multimp.F
44!||--- uses -----------------------------------------------------
45!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
46!|| check_sorting_criteria_mod ../engine/source/interfaces/intsort/check_sorting_criteria.F90
47!|| element_mod ../common_source/modules/elements/element_mod.F90
48!|| groupdef_mod ../common_source/modules/groupdef_mod.F
49!|| h3d_mod ../engine/share/modules/h3d_mod.F
50!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
51!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
52!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
53!|| message_mod ../engine/share/message_module/message_mod.F
54!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
55!|| timer_mod ../engine/source/system/timer_mod.F90
56!|| tri7box ../engine/share/modules/tri7box.F
57!||====================================================================
58 SUBROUTINE i22main_tri(TIMERS,
59 1 IPARI ,X ,V ,
60 2 MS ,NIN ,ITASK ,MWAG ,WEIGHT ,
61 3 ISENDTO ,IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,
62 4 ITAB ,KINET ,TEMP ,NRTM_T ,RENUM ,
63 5 NSNFIOLD,ESHIFT ,NUM_IMP ,IND_IMP ,NODNX_SMS ,
64 6 IXS ,IGRBRIC ,ALE_CONNECTIVITY,INTBUF_TAB,
65 7 COUNT_REMSLV ,H3D_DATA,MULTI_FVM,NODADT_THERM)
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 if(itask==0.and.ibug22_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 IF (imonm > 0 .AND. 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 IF (imonm > 0 .AND. 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
718 END
719
720!||====================================================================
721!|| i22solid_getminmax ../engine/source/interfaces/intsort/i22main_tri.F
722!||--- called by ------------------------------------------------------
723!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
724!||--- uses -----------------------------------------------------
725!|| element_mod ../common_source/modules/elements/element_mod.F90
726!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
727!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.f
728!||====================================================================
729 SUBROUTINE i22solid_getminmax(
730 1 X, IXS, BUFBRIC, NBRIC,
731 2 ITAB, ITASK, NIN )
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
811 END SUBROUTINE
812C-----------------------------------------------
813
814!||====================================================================
815!|| i22shell_getminmax ../engine/source/interfaces/intsort/i22main_tri.F
816!||--- called by ------------------------------------------------------
817!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
818!||--- uses -----------------------------------------------------
819!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
820!|| tri7box ../engine/share/modules/tri7box.F
821!||====================================================================
822 SUBROUTINE i22shell_getminmax(
823 1 X, IRECT, NRTM, STFE, ITASK,
824 2 ITAB, ESHIFT, BMINMA, MARGE )
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
917 END SUBROUTINE
918C-----------------------------------------------
919
i22buce
subroutine i22buce(x, irect, nsv, inacti, iskip, nmn, nshel_t, nsn, cand_e, cand_b, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, mwag, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, nshelr_l, ncont, renum, nsnrold, gapmin, gapmax, curv_max_max, num_imp, intth, itask, bgapsmx, i_mem, ixs, bufbric, nbric, itab, nshel_l, ale_connectivity, ipari)
Definition i22buce.F:56
i22shell_getminmax
subroutine i22shell_getminmax(x, irect, nrtm, stfe, itask, itab, eshift, bminma, marge)
Definition i22main_tri.F:825
i22main_tri
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)
Definition i22main_tri.F:66
i22solid_getminmax
subroutine i22solid_getminmax(x, ixs, bufbric, nbric, itab, itask, nin)
Definition i22main_tri.F:732
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
imp_rnumcd
subroutine imp_rnumcd(cand_n, nin, nsn, num_imp, index)
Definition imp_int_k.F:1550
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
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
i22tri_mod::iskip22
integer iskip22
Definition cut-cell-search_mod.F:520
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_tri7gat
subroutine spmd_tri7gat(result, nsn, cand_n, i_stok, nin, igap, nsnr, multimp, ity, intth, ilev, nsnfiold, ipari, h3d_data, intfric, multi_fvm, nodadt_therm)
Definition spmd_int.F:3004
spmd_lagbounds_exch_i22
subroutine spmd_lagbounds_exch_i22(bminmal_spmd, bminmal, isendto, ircvfrom, nin)
Definition spmd_lagbounds_exch_i22.F:35
spmd_tri22vox0
subroutine spmd_tri22vox0(x, bminma_flu_l, nbric, ixs, bufbric, itask, itab, xmins, ymins, zmins, xmaxs, ymaxs, zmaxs, bminma_lag_r, is_contact, bminma_and)
Definition spmd_tri22vox0.F:37
spmd_tri22vox
subroutine spmd_tri22vox(irectm, nrtm, x, v, bminmal, stife, nin, isendto, ircvfrom, iad_elem, fr_elem, nshelr, itab, itask)
Definition spmd_tri22vox.F:42
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
nl
character *2 function nl()
Definition message.F:2360
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