OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25main_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!|| i25main_tri ../engine/source/interfaces/intsort/i25main_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!|| i25buce ../engine/source/interfaces/intsort/i25buce.F
32!|| i25buce_edg ../engine/source/interfaces/intsort/i25buce_edg.F
33!|| i25gapmsave ../engine/source/interfaces/intsort/i25gapmsave.F
34!|| i25trc_e2s ../engine/source/interfaces/intsort/i25trc_e2s.F
35!|| i25trc_edg ../engine/source/interfaces/intsort/i25trc_edg.F
36!|| i7xsave ../engine/source/interfaces/intsort/i7xsave.f
37!|| my_barrier ../engine/source/system/machine.F
38!|| spmd_rnum25 ../engine/source/mpi/interfaces/spmd_i7tool.F
39!|| spmd_rnum25_edge ../engine/source/mpi/interfaces/spmd_rnum25_edge.F
40!|| spmd_tri25egat ../engine/source/mpi/interfaces/spmd_tri25egat.F
41!|| spmd_tri25gat ../engine/source/mpi/interfaces/spmd_tri25gat.F
42!|| spmd_tri25vox ../engine/source/mpi/interfaces/spmd_tri25vox.F
43!|| spmd_tri25vox0 ../engine/source/mpi/interfaces/spmd_tri25vox0.F
44!|| spmd_tri25vox0_edge ../engine/source/mpi/interfaces/spmd_tri25vox0.F
45!|| startime ../engine/source/system/timer_mod.F90
46!|| stoptime ../engine/source/system/timer_mod.F90
47!|| upgrade_lcand_e2s ../common_source/interf/upgrade_multimp.F
48!|| upgrade_lcand_edg ../common_source/interf/upgrade_multimp.F
49!|| upgrade_multimp ../common_source/interf/upgrade_multimp.F
50!||--- uses -----------------------------------------------------
51!|| check_sorting_criteria_mod ../engine/source/interfaces/intsort/check_sorting_criteria.f90
52!|| h3d_mod ../engine/share/modules/h3d_mod.F
53!|| imp_intbuf ../engine/share/modules/imp_mod_def.f90
54!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
55!|| message_mod ../engine/share/message_module/message_mod.F
56!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
57!|| timer_mod ../engine/source/system/timer_mod.F90
58!|| tri25ebox ../engine/share/modules/tri25ebox.f
59!|| tri7box ../engine/share/modules/tri7box.F
60!||====================================================================
61 SUBROUTINE i25main_tri(TIMERS,
62 1 IPARI ,X ,V ,INTBUF_TAB,
63 2 MS ,NIN ,ITASK ,WEIGHT ,
64 3 ISENDTO ,IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,
65 4 ITAB ,KINET ,TEMP ,RENUM ,
66 5 NSNFIOLD,NUM_IMP ,IND_IMP ,NODNX_SMS,
67 6 H3D_DATA,ESHIFT ,NEDGE_T ,SSHIFT ,NRTM_T ,
68 7 ICODT ,ISKEW ,PARAMETERS,NODADT_THERM)
69C============================================================================
70C M o d u l e s
71C-----------------------------------------------
72 USE timer_mod
73 USE tri25ebox
74 USE tri7box
75 USE message_mod
76 USE imp_intbuf
77 USE intbufdef_mod
78 USE h3d_mod
79 USE parameters_mod
80 use check_sorting_criteria_mod , only : check_sorting_criteria
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 "timeri_c.inc"
95 COMMON /i25mainc/bminma,curv_max_max,result,nsnr,nsnrold,i_memg,i_memg_e,i_memg_s,nmn_g
96 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,I_MEMG_E,I_MEMG_S,NMN_G
97 my_real
98 . BMINMA(6),CURV_MAX_MAX
99C-----------------------------------------------
100C D u m m y A r g u m e n t s
101C-----------------------------------------------
102 TYPE(timer_) :: TIMERS
103 INTEGER NIN ,ITASK, RETRI, NEDGE_T, NRTM_T, SSHIFT, ESHIFT,
104 . num_imp ,ind_imp(*),
105 . itab(*), kinet(*),
106 . ipari(npari,ninter),
107 . isendto(ninter+1,*),ircvfrom(ninter+1,*),
108 . weight(*), iad_elem(2,*) ,fr_elem(*),
109 . renum(*), nsnfiold(nspmd), nodnx_sms(*), icodt(*), iskew(*)
110 INTEGER , INTENT(IN) :: NODADT_THERM
111C REAL
112 my_real
113 . X(3,*), V(*), MS(*),TEMP(*)
114 TYPE(INTBUF_STRUCT_) INTBUF_TAB
115 TYPE(H3D_DATABASE) :: H3D_DATA
116 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
117C-----------------------------------------------
118C L o c a l V a r i a b l e s
119C-----------------------------------------------
120 INTEGER LOC_PROC,IEDGE,NEDGE,IGSTI,ITIED,
121 . i,j, ip0, ip1, ip2, ip21, k11_t, i_sk_old, i_sk_old_e, i_stok1,
122 . add1, noint, inacti, multimp, igap, ifq,
123 . n, nsnf, nsnl, nsnrf, nsnrl,nmn_l, ivis2, igap0, ifsub_carea
124 INTEGER
125 . NCONT, NCONTE, MULNSN, MULNSNE, MULNSNS, INACTII, INACIMP, INTTH,
126 . I_MEM,I_MEME(2),CAND_N_OLD,CAND_E_OLD(2),ILEV,FLAGREMN, LREMNORMAX,
127 . idum1(1), ithk
128
129 INTEGER NEDGE_TOTAL,NEDGE_LOCAL
130 INTEGER :: ISENS
131C REAL
132 my_real
133 . gap,
134 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,drad,
135 . c_maxl,pmax_gap,vmaxdt,marge,tzinf,sx,sy,sz,sx2,sy2,sz2,dgapload,
136 . bminma_old(6),bgapemx,bsav(6)
137 my_real, dimension(:), allocatable :: curv_max
138 INTEGER :: NMN,NRTM,NSN,NTY
139 logical :: need_computation
140C-----------------------------------------------
141 ! --------------
142 ! check if the current interface needs to be sorted
143 call check_sorting_criteria( need_computation,nin,npari,nspmd,
144 . itask,ipari(1,nin),tt,intbuf_tab )
145 if( .not.need_computation ) return
146 allocate(curv_max(nrtm_t) )
147 ! --------------
148 i_mem = 0
149!$OMP SINGLE
150 i_memg = 0
151 nmn_g = 0
152!$OMP END SINGLE NOWAIT
153 nmn_l = 0
154C
155 loc_proc=ispmd+1
156 nrtm = ipari(4,nin)
157 nsn = ipari(5,nin)
158 nmn = ipari(6,nin)
159 nty = ipari(7,nin)
160 ivis2 = ipari(14,nin)
161 noint = ipari(15,nin)
162 ncont = ipari(18,nin)
163 ilev = ipari(20,nin)
164 inacti = ipari(22,nin)
165 ifq = ipari(31,nin)
166 intth = ipari(47,nin)
167 iedge = ipari(58,nin)
168 flagremn= ipari(63,nin)
169 igsti = ipari(34,nin)
170 igap = ipari(21,nin)
171 igap0 = ipari(53,nin)
172 flagremn =ipari(63,nin)
173 lremnormax =ipari(82,nin)
174 nedge = ipari(68,nin)
175!$OMP SINGLE
176 nedge_remote_old = ipari(69,nin)
177 nsnrold = ipari(24,nin)
178!$OMP END SINGLE NOWAIT
179 nconte = ipari(88,nin)
180 ithk = ipari(91,nin)
181 ifsub_carea =0
182 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
183C
184C
185 gap =intbuf_tab%VARIABLES(gap_index)
186 gapmin=intbuf_tab%VARIABLES(gapmin_index)
187 gapmax=intbuf_tab%VARIABLES(gapmax_index)
188 pmax_gap=intbuf_tab%VARIABLES(pmax_index)
189 vmaxdt =intbuf_tab%VARIABLES(vmaxdt_index)
190C
191 drad = zero
192 IF(ipari(47,nin) > 0) drad =intbuf_tab%VARIABLES(drad_index)
193C
194 dgapload =intbuf_tab%VARIABLES(dgapload_index)
195C
196 itied = 0
197C
198C -------------------------------------------------------------
199C
200 retri = 1
201C
202C -------------------------------------------------------------
203C
204 marge = intbuf_tab%VARIABLES(marge_index)
205C
206C -------------------------------------------------------------
207C
208 IF(itask==0) THEN
209 bminma(1)=-ep30
210 bminma(2)=-ep30
211 bminma(3)=-ep30
212 bminma(4)=ep30
213 bminma(5)=ep30
214 bminma(6)=ep30
215 curv_max_max = zero
216 i_sk_old = intbuf_tab%I_STOK(1)
217 intbuf_tab%I_STOK(1) = 0
218 IF(iedge /= 0) ALLOCATE(nsnfieold(nspmd))
219 END IF
220C
221C wait bminma [and cur_max_max]
222C
223 CALL my_barrier
224
225 IF(iedge/=0) THEN
226C
227 inacti = ipari(22,nin)
228 IF(itask==0)THEN
229
230
231 nedge_total = nedge + nedge_remote_old
232 ALLOCATE(intbuf_tab%I25_CAND_A(nedge_total + 3)) ! attention SPMD : NEDGE + NEDGEROLD + 3
233
234 i_sk_old_e = intbuf_tab%I_STOK_E(1)
235 CALL i25trc_edg(
236 1 nedge_total ,i_sk_old_e ,intbuf_tab%CANDS_E2E ,intbuf_tab%CANDM_E2E,
237 2 intbuf_tab%CAND_P ,intbuf_tab%I25_CAND_A ,nin ,nedge,ifq ,
238 3 intbuf_tab%FTSAVX_E ,intbuf_tab%FTSAVY_E ,intbuf_tab%FTSAVZ_E ,intbuf_tab%IFPEN_E)
239
240 intbuf_tab%I_STOK_E(1)=i_sk_old_e
241
242 ALLOCATE(intbuf_tab%I25_CAND_B(nedge_total + 3)) ! attention SPMD : NEDGE + NEDGEROLD + 3
243
244 i_sk_old_e = intbuf_tab%I_STOK_E(2)
245 CALL i25trc_e2s(
246 ! attention SPMD
247 1 nedge_total ,i_sk_old_e ,intbuf_tab%CANDS_E2S,
248 . intbuf_tab%CANDM_E2S,
249 2 intbuf_tab%CAND_PS,intbuf_tab%I25_CAND_B ,nin ,nedge,
250 3 intbuf_tab%LEDGE,ifq ,intbuf_tab%FTSAVX_E2S,
251 4 intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S,intbuf_tab%IFPEN_E2S )
252
253 intbuf_tab%I_STOK_E(2)=i_sk_old_e
254
255
256 ENDIF
257 ELSE ! IEDGE
258 IF(SIZE(intbuf_tab%I_STOK_E) > 1 ) THEN
259! size is 0 or 2
260 intbuf_tab%I_STOK_E(1) = 0
261 intbuf_tab%I_STOK_E(2) = 0
262 ENDIF
263 ENDIF
264C -------------------------------------------------------------
265C Bounds of the domains
266C -------------------------------------------------------------
267
268 CALL i7xsave(
269 1 x ,intbuf_tab%NSV,intbuf_tab%MSR,nsn ,nmn ,
270 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
271 3 xmaxl ,ymaxl ,zmaxl ,c_maxl,curv_max,
272 4 ipari(39,nin),intbuf_tab%IRECTM(1+4*sshift),nrtm_t ,sx ,sy ,
273 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l)
274C ITHK == 1 : main gap should be updated with change in thickness
275 IF(ithk == 1) THEN
276 CALL i25gapmsave(
277 1 intbuf_tab%GAP_M ,intbuf_tab%GAPMSAV ,
278 2 intbuf_tab%MSR ,nrtm , itask)
279 ENDIF
280C
281#include "lockon.inc"
282 bminma(1) = max(bminma(1),xmaxl)
283 bminma(2) = max(bminma(2),ymaxl)
284 bminma(3) = max(bminma(3),zmaxl)
285 bminma(4) = min(bminma(4),xminl)
286 bminma(5) = min(bminma(5),yminl)
287 bminma(6) = min(bminma(6),zminl)
288 curv_max_max = max(curv_max_max,c_maxl)
289 nmn_g = nmn_g + nmn_l
290 result = 0
291#include "lockoff.inc"
292
293C BARRIER II_STOK, II_STOK_E et RESULT
294 CALL my_barrier
295
296C to keep for inacti case is modified on p0
297 IF(itask==0)THEN
298 bsav(1:6)=bminma(1:6) ! pour boite edge to edge
299 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
300 + abs(bminma(5)-bminma(2))>2*ep30.OR.
301 + abs(bminma(4)-bminma(1))>2*ep30)THEN
302 CALL ancmsg(msgid=87,anmode=aninfo,
303 . i1=noint,c1='(I25BUCE)')
304 CALL arret(2)
305 END IF
306C
307 tzinf = marge+max(gap+dgapload,drad)+vmaxdt
308
309 IF(iedge > 0)THEN
310 bgapemx=intbuf_tab%VARIABLES(bgapemx_index)
311 tzinf = max(tzinf,marge+two*bgapemx+dgapload+vmaxdt)
312 ENDIF
313
314 bminma(1)=bminma(1)+tzinf
315 bminma(2)=bminma(2)+tzinf
316 bminma(3)=bminma(3)+tzinf
317 bminma(4)=bminma(4)-tzinf
318 bminma(5)=bminma(5)-tzinf
319 bminma(6)=bminma(6)-tzinf
320
321 IF(nspmd > lrvoxelp)THEN
322 CALL ancmsg(msgid=36,anmode=aninfo,
323 . c1='(I25MAINTRI)')
324 CALL arret(2)
325 END IF
326
327 nsnr = 0
328
329 END IF
330
331 IF(nspmd > 1) THEN
332
333 IF(itask==0) THEN
334 ALLOCATE(crvoxel25(0:lrvoxel25,0:lrvoxel25,1:2,1:nspmd))
335 crvoxel25(0:lrvoxel25,0:lrvoxel25,1:2,loc_proc) = 0
336 ENDIF
337
338 CALL my_barrier
339 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
340 bgapemx=intbuf_tab%VARIABLES(bgapemx_index)
341
342 CALL spmd_tri25vox0(
343 1 x ,bminma ,nrtm_t,intbuf_tab%STFM(1+sshift),marge ,
344 2 curv_max,intbuf_tab%GAP_M(1+sshift),intbuf_tab%IRECTM(1+4*sshift),gap,
345 + intbuf_tab%VARIABLES(bgapsmx_index),
346 3 pmax_gap,vmaxdt,bgapemx,iedge,
347 . intbuf_tab%LEDGE,nedge,nledge,
348 . intbuf_tab%GAPE ,drad ,dgapload)
349
350 CALL spmd_tri25vox0_edge(
351 1 x ,bminma ,nrtm,intbuf_tab%STFE,marge ,
352 2 curv_max,intbuf_tab%GAP_M,intbuf_tab%IRECTM,gap,
353 + intbuf_tab%VARIABLES(bgapsmx_index),
354 3 pmax_gap,vmaxdt,bgapemx,iedge,igap0,
355 . intbuf_tab%LEDGE,nedge,nledge,
356 . intbuf_tab%GAPE,dgapload)
357
358 CALL my_barrier
359 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
360
361 IF(itask==0)THEN
362
363C
364C Get Remote Nodes in Xrem/Irem
365C
366 inacti=0
367 nedge_local = intbuf_tab%NB_INTERNAL_EDGES + intbuf_tab%NB_BOUNDARY_EDGES_LOCAL
368 iedge = ipari(58,nin)
369 IF(imonm > 0) CALL startime(timers,25)
370 CALL spmd_tri25vox(
371 1 intbuf_tab%NSV ,nsn ,x ,v ,ms ,
372 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto ,
373 3 ircvfrom ,iad_elem ,fr_elem ,nsnr ,ipari(21,nin),
374 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
375 5 nsnfiold ,ipari(47,nin),intbuf_tab%IELES,intbuf_tab%AREAS,temp ,
376 6 num_imp ,nodnx_sms ,intbuf_tab%GAP_SL,nty ,intbuf_tab%IRTLM,
377 7 intbuf_tab%TIME_S,intbuf_tab%SECND_FR,intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD ,
378 8 intbuf_tab%NBINFLG,ilev ,intbuf_tab%ICONT_I,ipari(72,nin),intbuf_tab%IPARTFRICS,
379 9 itied ,ivis2 , intbuf_tab%IF_ADH,intbuf_tab%LEDGE,nedge ,
380 a nledge ,intbuf_tab%STFM,nedge_local,intbuf_tab%GAPE,intbuf_tab%GAP_E_L,
381 b intbuf_tab%STFE ,intbuf_tab%EDGE_BISECTOR,intbuf_tab%VTX_BISECTOR,intbuf_tab%ADMSR,
382 . intbuf_tab%IRECTM,
383 d intbuf_tab%EBINFLG,intbuf_tab%MVOISIN,iedge ,icodt , iskew ,
384 e intbuf_tab%IPARTFRIC_E,intbuf_tab%E2S_NOD_NORMAL,ipari(97,nin),intbuf_tab%STIFMSDT_S,
385 . intbuf_tab%STIFMSDT_EDG,
386 f ifsub_carea ,parameters%INTAREAN)
387 IF(imonm > 0) CALL stoptime(timers,25)
388
389C local renumbering of old candidates to collision
390 CALL spmd_rnum25(
391 1 renum ,nin, nsn,nsnfiold ,nsnrold)
392 IF(iedge /= 0) THEN
393 CALL spmd_rnum25_edge(nin,nedge,intbuf_tab%CANDS_E2E,intbuf_tab%I_STOK_E(1),
394 . intbuf_tab%CANDS_E2S,intbuf_tab%I_STOK_E(2))
395 END IF
396
397 IF(ALLOCATED(crvoxel25)) DEALLOCATE(crvoxel25)
398 END IF
399 END IF ! ITASK == 0
400
401C
402 cand_n_old = intbuf_tab%I_STOK(1)
403 40 continue
404C
405C Barrier comm spmd_tri7vox + bminma + return i7buce
406C
407 CALL my_barrier
408C
409 IF (imonm > 0) CALL startime(timers,30)
410C
411C NCONT additional candidates (if all secondary nodes are already impacted, cf i25optcd)
412 multimp = ipari(23,nin)
413 mulnsn = intbuf_tab%S_CAND_N - ncont
414 CALL i25buce(
415 1 x ,v ,intbuf_tab%IRECTM(1+4*sshift),intbuf_tab%NSV,
416 + intbuf_tab%STFNS,
417 2 nmn ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
418 3 gap ,noint ,intbuf_tab%I_STOK(1) ,mulnsn ,bminma ,
419 4 marge ,curv_max ,pmax_gap ,vmaxdt ,
420 5 sshift ,nin ,intbuf_tab%STFM(1+sshift) ,intbuf_tab%GAP_S,
421 6 nsnr ,ncont ,intbuf_tab%GAP_M(1+sshift) ,itask ,intbuf_tab%VARIABLES(bgapsmx_index),
422 7 i_mem ,intbuf_tab%PENE_OLD,itab ,intbuf_tab%NBINFLG,intbuf_tab%MBINFLG,
423 8 ilev ,intbuf_tab%MSEGTYP24,
424 9 flagremn,intbuf_tab%KREMNODE(1+2*sshift),intbuf_tab%REMNODE,
425 a igap ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML(1+sshift),icodt,iskew ,
426 b drad ,dgapload )
427C
428C Upgrade MultiMP
429 IF (i_mem == 2)THEN
430#include "lockon.inc"
431 i_memg = i_mem
432#include "lockoff.inc"
433 ENDIF
434
435C New barrier needed for Dynamic MultiMP
436 CALL my_barrier
437
438 IF(i_memg /=0)THEN
439!$OMP SINGLE
440 multimp = ipari(23,nin) * 1.3
441 CALL upgrade_multimp(nin,multimp,intbuf_tab)
442!$OMP END SINGLE
443 i_mem = 0
444 i_memg = 0
445 intbuf_tab%I_STOK(1)=cand_n_old
446 GOTO 40
447 ENDIF
448
449 IF (imonm > 0) CALL stoptime(timers,30)
450C--------------------------------------------------------------
451C Edges
452C--------------------------------------------------------------
453 IF(iedge==0) GOTO 200
454 inacti = ipari(22,nin)
455 cand_e_old(1:2) = intbuf_tab%I_STOK_E(1:2)
456 bgapemx=intbuf_tab%VARIABLES(bgapemx_index)
457 IF(itask == 0)THEN
458
459 bminma(1)=bsav(1)
460 bminma(2)=bsav(2)
461 bminma(3)=bsav(3)
462 bminma(4)=bsav(4)
463 bminma(5)=bsav(5)
464 bminma(6)=bsav(6)
465
466 tzinf = marge+two*bgapemx+dgapload+vmaxdt
467
468 bminma(1)=bminma(1)+tzinf
469 bminma(2)=bminma(2)+tzinf
470 bminma(3)=bminma(3)+tzinf
471 bminma(4)=bminma(4)-tzinf
472 bminma(5)=bminma(5)-tzinf
473 bminma(6)=bminma(6)-tzinf
474
475 END IF
476C
477#include "lockon.inc"
478 i_meme(1:2)=0
479 i_memg_e = 0
480 i_memg_s = 0
481#include "lockoff.inc"
482C
483 140 continue
484C
485C Barrier comm spmd_tri7vox + bminma + return i7buce
486C
487 CALL my_barrier
488C
489 IF (imonm > 0) CALL startime(timers,30)
490C
491 mulnsne = intbuf_tab%S_CANDM_E2E
492 mulnsns = intbuf_tab%S_CANDM_E2S
493 nedge_local = intbuf_tab%NB_INTERNAL_EDGES + intbuf_tab%NB_BOUNDARY_EDGES_LOCAL
494 CALL i25buce_edg(
495 1 x ,v ,intbuf_tab%IRECTM,inacti ,
496 2 nsn ,nmn ,intbuf_tab%CANDM_E2E,intbuf_tab%CANDS_E2E,
497 3 gap ,noint ,intbuf_tab%I_STOK_E(1) ,mulnsne ,bminma ,
498 4 marge ,vmaxdt ,drad ,
499 5 eshift ,nedge_t ,sshift ,nrtm_t ,intbuf_tab%STFM ,
500 6 intbuf_tab%STFE ,nconte ,intbuf_tab%GAP_M ,itask ,bgapemx,
501 7 i_meme ,itab ,intbuf_tab%MBINFLG,intbuf_tab%EBINFLG,intbuf_tab%I_STOK_E(2),
502 8 mulnsns,ilev ,intbuf_tab%I25_CAND_A ,intbuf_tab%CAND_P ,igap0 ,
503 9 flagremn,intbuf_tab%KREMNODE_EDG ,intbuf_tab%REMNODE_EDG,intbuf_tab%KREMNODE_E2S,
504 . intbuf_tab%REMNODE_E2S,
505 a igap ,intbuf_tab%GAP_ML,iedge ,nedge ,intbuf_tab%MSEGTYP24,
506 b intbuf_tab%LEDGE,intbuf_tab%ADMSR,intbuf_tab%EDGE_BISECTOR,intbuf_tab%VTX_BISECTOR,
507 c intbuf_tab%CANDM_E2S,intbuf_tab%CANDS_E2S,intbuf_tab%I25_CAND_B,intbuf_tab%CAND_PS,intbuf_tab%GAPE,
508 d intbuf_tab%GAP_E_L,nedge_local,ifq , intbuf_tab%FTSAVX_E,intbuf_tab%FTSAVY_E,
509 e intbuf_tab%FTSAVZ_E,intbuf_tab%FTSAVX_E2S,intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S,
510 f intbuf_tab%IFPEN_E,intbuf_tab%IFPEN_E2S,intbuf_tab%S_KREMNODE_EDG ,intbuf_tab%S_REMNODE_EDG,
511 g intbuf_tab%S_KREMNODE_E2S,intbuf_tab%S_REMNODE_E2S,dgapload)
512C
513C Upgrade MultiMP
514 IF (i_meme(1)/=0)THEN
515#include "lockon.inc"
516 i_memg_e = i_meme(1)
517#include "lockoff.inc"
518 ENDIF
519 IF (i_meme(2)/=0)THEN
520#include "lockon.inc"
521 i_memg_s = i_meme(2)
522#include "lockoff.inc"
523 ENDIF
524
525C New barrier needed for Dynamic MultiMP
526 CALL my_barrier
527
528 IF(i_memg_e /=0 .OR. i_memg_s/=0)THEN
529!$OMP SINGLE
530 IF(i_memg_e/=0)THEN
531 ! same as TYPE11: increase > 4 for small interfaces
532 multimp = max(ipari(87,nin) +4,ipari(87,nin)+min(20,(250000/nconte)))
533 CALL upgrade_lcand_edg(nin,multimp,intbuf_tab)
534 END IF
535 IF(i_memg_s/=0)THEN
536 ! same as TYPE11: increase > 4 for small interfaces
537 multimp = max(ipari(89,nin) +4,ipari(89,nin)+min(20,(250000/nconte)))
538 CALL upgrade_lcand_e2s(nin,multimp,intbuf_tab)
539 END IF
540!$OMP END SINGLE
541 i_meme(1:2)= 0
542 i_memg_e = 0
543 i_memg_s = 0
544 intbuf_tab%I_STOK_E(1:2)=cand_e_old(1:2) ! on retrie tout
545 GOTO 140
546 ENDIF
547C
548 IF(itask==0)DEALLOCATE(intbuf_tab%I25_CAND_A,intbuf_tab%I25_CAND_B)
549C
550 IF (imonm > 0) CALL stoptime(timers,30)
551C--------------------------------------------------------------
552 200 CONTINUE
553C--------------------------------------------------------------
554C Negative value in "dist" : tag boundary part
555 IF(nspmd>1)THEN
556!$OMP SINGLE
557 IF (imonm > 0) CALL startime(timers,26)
558 intbuf_tab%VARIABLES(distance_index) = - one
559C
560 CALL spmd_tri25gat(
561 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
562 2 ipari(21,nin),nsnr,multimp ,nty,ipari(47,nin),
563 3 ilev ,nsnfiold,ipari ,nsnrold, renum, h3d_data ,
564 4 ipari(72,nin),flagremn,lremnormax,nrtm ,intbuf_tab%KREMNODE,
565 5 intbuf_tab%REMNODE,ivis2,ipari(97,nin),ifsub_carea ,nodadt_therm)
566 ipari(24,nin) = nsnr
567
568 nedge_remote_old = nedge_remote
569
570 IF(iedge /= 0) THEN
571 CALL spmd_tri25egat(
572 1 result ,nin , nedge,intbuf_tab%CANDS_E2E,intbuf_tab%I_STOK_E(1),
573 2 intbuf_tab%CANDS_E2S,intbuf_tab%I_STOK_E(2),igap,ipari(72,nin),ipari(97,nin))
574 ENDIF
575
576 ipari(69 ,nin) = nedge_remote_old
577C
578 IF (imonm > 0) CALL stoptime(timers,26)
579 IF(iedge /= 0) THEN
580 DEALLOCATE(renum_edge)
581 DEALLOCATE(oldnum_edge)
582 ENDIF
583!$OMP END SINGLE
584 END IF
585 IF(iedge /= 0) THEN
586!$OMP SINGLE
587 DEALLOCATE(nsnfieold)
588!$OMP END SINGLE
589 ENDIF
590C
591 CALL my_barrier
592 if(allocated(curv_max)) deallocate(curv_max)
593 RETURN
594 END
i25buce
subroutine i25buce(x, v, irect, nsv, stfn, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, mulnsn, bminma, marge, curv_max, pmax_gap, vmaxdt, eshift, nin, stf, gap_s, nsnr, ncont, gap_m, itask, bgapsmx, i_mem, pene_old, itab, nbinflg, mbinflg, ilev, msegtyp, flagremnode, kremnod, remnod, igap, gap_s_l, gap_m_l, icodt, iskew, drad, dgapload)
Definition i25buce.F:45
i25gapmsave
subroutine i25gapmsave(gap_m, gapmsav, msr, nrtm, itask)
Definition i25gapmsave.F:32
i25main_tri
subroutine i25main_tri(timers, ipari, x, v, intbuf_tab, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, renum, nsnfiold, num_imp, ind_imp, nodnx_sms, h3d_data, eshift, nedge_t, sshift, nrtm_t, icodt, iskew, parameters, nodadt_therm)
Definition i25main_tri.F:69
i25trc_e2s
subroutine i25trc_e2s(nedge, i_stok, cand_s, cand_m, cand_p, cand_a, nin, nedge_l, ledge, ifq, cand_fx, cand_fy, cand_fz, ifpen)
Definition i25trc_e2s.F:35
i25trc_edg
subroutine i25trc_edg(nedge, i_stok, cand_s, cand_m, cand_p, cand_a, nin, nedge_l, ifq, cand_fx, cand_fy, cand_fz, ifpen)
Definition i25trc_edg.F:34
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:311
message_mod
Definition message_mod.F:1257
parameters_mod
Definition parameters_mod.F:49
tri25ebox::renum_edge
integer, dimension(:), allocatable renum_edge
Definition tri25ebox.F:94
tri25ebox::nedge_remote
integer nedge_remote
Definition tri25ebox.F:75
tri25ebox::crvoxel25
integer, dimension(:,:,:,:), allocatable crvoxel25
Definition tri25ebox.F:72
tri25ebox::nedge_remote_old
integer nedge_remote_old
Definition tri25ebox.F:98
tri25ebox::lrvoxel25
integer, parameter lrvoxel25
Definition tri25ebox.F:71
tri25ebox::oldnum_edge
integer, dimension(:), allocatable oldnum_edge
Definition tri25ebox.F:95
tri25ebox::nsnfieold
integer, dimension(:), allocatable nsnfieold
Definition tri25ebox.F:97
tri7box::lrvoxelp
integer lrvoxelp
Definition tri7box.F:522
spmd_rnum25
subroutine spmd_rnum25(renum, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:322
spmd_rnum25_edge
subroutine spmd_rnum25_edge(nin, nedge, cand_e2e, istok_e2e, cand_e2s, istok_e2s)
Definition spmd_rnum25_edge.F:32
spmd_tri25egat
subroutine spmd_tri25egat(result, nin, nedge, cands_e2e, i_stok_e2e, cands_e2s, i_stok_e2s, igap, intfric, istif_msdt)
Definition spmd_tri25egat.F:35
spmd_tri25gat
subroutine spmd_tri25gat(result, nsn, cand_n, i_stok, nin, igap, nsnr, multimp, ity, intth, ilev, nsnfiold, ipari, nsnrold, renum, h3d_data, intfric, flagremn, lremnormax, nrtm, kremnod, remnod, ivis2, istif_msdt, ifsub_carea, nodadt_therm)
Definition spmd_tri25gat.F:41
spmd_tri25vox0_edge
subroutine spmd_tri25vox0_edge(x, bminmal, nrtm, stfe, marge, curv_max, gap_m, irect, gap, bgapsmx, pmax_gap, vmaxdt, bgapemx, iedge, igap0, ledge, nedge, nledge, gape, dgapload)
Definition spmd_tri25vox0.F:205
spmd_tri25vox0
subroutine spmd_tri25vox0(x, bminmal, nrtm, stf, marge, curv_max, gap_m, irect, gap, bgapsmx, pmax_gap, vmaxdt, bgapemx, iedge, ledge, nedge, nledge, gape, drad, dgapload)
Definition spmd_tri25vox0.F:37
spmd_tri25vox
subroutine spmd_tri25vox(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, ieles, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, intfric, ipartfrics, itied, ivis2, if_adh, ledge, nedge, lndedge, stfm, nedge_local, gape, gap_e_l, stfe, edg_bisector, vtx_bisector, admsr, irect, ebinflg, mvoisin, iedge, icodt, iskew, ipartfric_e, e2s_nod_normal, istif_msdt, stifmsdt_s, stifmsdt_edg, ifsub_carea, intarean)
Definition spmd_tri25vox.F:55
i25buce_edg
subroutine i25buce_edg(x, irect, inacti, nsn, nmn, candm_e2e, cands_e2e, gap, noint, ii_stok, mulnsne, bminma, marge, vmaxdt, drad, eshift, nedge_t, sshift, nrtm_t, stfm, stfn, ncont, gap_m, itask, bgapemx, i_mem, itab, mbinflg, ebinflg, ll_stok, mulnsns, ilev, cand_a, cand_p, igap0, flagremnode, kremnod, remnod, s_remnode_edg, igap, gap_m_l, iedge, nedge, msegtyp, ledge, admsr, edg_bisector, vtx_bisector, candm_e2s, cands_e2s, cand_b, cand_ps, gape, gap_e_l, dgapload, flag_removed_node, s_kremnode_e2s, s_remnode_e2s, kremnode_e2s, remnode_e2s, s_kremnode_edg)
Definition i25buce_edg.F:49
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
upgrade_lcand_edg
subroutine upgrade_lcand_edg(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:1321
upgrade_lcand_e2s
subroutine upgrade_lcand_e2s(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:1523
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48