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 . curv_max(nrtm_t),bminma_old(6),bgapemx,bsav(6)
137 INTEGER :: NMN,NRTM,NSN,NTY
138 logical :: need_computation
139C-----------------------------------------------
140 ! --------------
141 ! check if the current interface needs to be sorted
142 call check_sorting_criteria( need_computation,nin,npari,nspmd,
143 . itask,ipari(1,nin),tt,intbuf_tab )
144 if( .not.need_computation ) return
145 ! --------------
146 i_mem = 0
147!$OMP SINGLE
148 i_memg = 0
149 nmn_g = 0
150!$OMP END SINGLE NOWAIT
151 nmn_l = 0
152C
153 loc_proc=ispmd+1
154 nrtm = ipari(4,nin)
155 nsn = ipari(5,nin)
156 nmn = ipari(6,nin)
157 nty = ipari(7,nin)
158 ivis2 = ipari(14,nin)
159 noint = ipari(15,nin)
160 ncont = ipari(18,nin)
161 ilev = ipari(20,nin)
162 inacti = ipari(22,nin)
163 ifq = ipari(31,nin)
164 intth = ipari(47,nin)
165 iedge = ipari(58,nin)
166 flagremn= ipari(63,nin)
167 igsti = ipari(34,nin)
168 igap = ipari(21,nin)
169 igap0 = ipari(53,nin)
170 flagremn =ipari(63,nin)
171 lremnormax =ipari(82,nin)
172 nedge = ipari(68,nin)
173!$OMP SINGLE
174 nedge_remote_old = ipari(69,nin)
175 nsnrold = ipari(24,nin)
176!$OMP END SINGLE NOWAIT
177 nconte = ipari(88,nin)
178 ithk = ipari(91,nin)
179 ifsub_carea =0
180 IF(ipari(36,nin)> 0.AND.parameters%INTCAREA > 0) ifsub_carea = 1
181C
182C
183 gap =intbuf_tab%VARIABLES(gap_index)
184 gapmin=intbuf_tab%VARIABLES(gapmin_index)
185 gapmax=intbuf_tab%VARIABLES(gapmax_index)
186 pmax_gap=intbuf_tab%VARIABLES(pmax_index)
187 vmaxdt =intbuf_tab%VARIABLES(vmaxdt_index)
188C
189 drad = zero
190 IF(ipari(47,nin) > 0) drad =intbuf_tab%VARIABLES(drad_index)
191C
192 dgapload =intbuf_tab%VARIABLES(dgapload_index)
193C
194 itied = 0
195C
196C -------------------------------------------------------------
197C
198 retri = 1
199C
200C -------------------------------------------------------------
201C
202 marge = intbuf_tab%VARIABLES(marge_index)
203C
204C -------------------------------------------------------------
205C
206 IF(itask==0) THEN
207 bminma(1)=-ep30
208 bminma(2)=-ep30
209 bminma(3)=-ep30
210 bminma(4)=ep30
211 bminma(5)=ep30
212 bminma(6)=ep30
213 curv_max_max = zero
214 i_sk_old = intbuf_tab%I_STOK(1)
215 intbuf_tab%I_STOK(1) = 0
216 IF(iedge /= 0) ALLOCATE(nsnfieold(nspmd))
217 END IF
218C
219C wait bminma [and cur_max_max]
220C
221 CALL my_barrier
222
223 IF(iedge/=0) THEN
224C
225 inacti = ipari(22,nin)
226 IF(itask==0)THEN
227
228
229 nedge_total = nedge + nedge_remote_old
230 ALLOCATE(intbuf_tab%I25_CAND_A(nedge_total + 3)) ! attention SPMD : NEDGE + NEDGEROLD + 3
231
232 i_sk_old_e = intbuf_tab%I_STOK_E(1)
233 CALL i25trc_edg(
234 1 nedge_total ,i_sk_old_e ,intbuf_tab%CANDS_E2E ,intbuf_tab%CANDM_E2E,
235 2 intbuf_tab%CAND_P ,intbuf_tab%I25_CAND_A ,nin ,nedge,ifq ,
236 3 intbuf_tab%FTSAVX_E ,intbuf_tab%FTSAVY_E ,intbuf_tab%FTSAVZ_E ,intbuf_tab%IFPEN_E)
237
238 intbuf_tab%I_STOK_E(1)=i_sk_old_e
239
240 ALLOCATE(intbuf_tab%I25_CAND_B(nedge_total + 3)) ! attention SPMD : NEDGE + NEDGEROLD + 3
241
242 i_sk_old_e = intbuf_tab%I_STOK_E(2)
243 CALL i25trc_e2s(
244 ! attention SPMD
245 1 nedge_total ,i_sk_old_e ,intbuf_tab%CANDS_E2S,
246 . intbuf_tab%CANDM_E2S,
247 2 intbuf_tab%CAND_PS,intbuf_tab%I25_CAND_B ,nin ,nedge,
248 3 intbuf_tab%LEDGE,ifq ,intbuf_tab%FTSAVX_E2S,
249 4 intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S,intbuf_tab%IFPEN_E2S )
250
251 intbuf_tab%I_STOK_E(2)=i_sk_old_e
252
253
254 ENDIF
255 ELSE ! IEDGE
256 IF(SIZE(intbuf_tab%I_STOK_E) > 1 ) THEN
257! size is 0 or 2
258 intbuf_tab%I_STOK_E(1) = 0
259 intbuf_tab%I_STOK_E(2) = 0
260 ENDIF
261 ENDIF
262C -------------------------------------------------------------
263C Bounds of the domains
264C -------------------------------------------------------------
265 CALL i7xsave(
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*sshift),nrtm_t ,sx ,sy ,
270 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l)
271C ITHK == 1 : main gap should be updated with change in thickness
272 IF(ithk == 1) THEN
273 CALL i25gapmsave(
274 1 intbuf_tab%GAP_M ,intbuf_tab%GAPMSAV ,
275 2 intbuf_tab%MSR ,nrtm , itask)
276 ENDIF
277C
278#include "lockon.inc"
279 bminma(1) = max(bminma(1),xmaxl)
280 bminma(2) = max(bminma(2),ymaxl)
281 bminma(3) = max(bminma(3),zmaxl)
282 bminma(4) = min(bminma(4),xminl)
283 bminma(5) = min(bminma(5),yminl)
284 bminma(6) = min(bminma(6),zminl)
285 curv_max_max = max(curv_max_max,c_maxl)
286 nmn_g = nmn_g + nmn_l
287 result = 0
288#include "lockoff.inc"
289
290C BARRIER II_STOK, II_STOK_E et RESULT
291 CALL my_barrier
292
293C a conserver pour cas inacti est modifie sur p0
294 IF(itask==0)THEN
295 bsav(1:6)=bminma(1:6) ! pour boite edge to edge
296 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
297 + abs(bminma(5)-bminma(2))>2*ep30.OR.
298 + abs(bminma(4)-bminma(1))>2*ep30)THEN
299 CALL ancmsg(msgid=87,anmode=aninfo,
300 . i1=noint,c1='(I25BUCE)')
301 CALL arret(2)
302 END IF
303C
304 tzinf = marge+max(gap+dgapload,drad)+vmaxdt
305
306 IF(iedge > 0)THEN
307 bgapemx=intbuf_tab%VARIABLES(bgapemx_index)
308 tzinf = max(tzinf,marge+two*bgapemx+dgapload+vmaxdt)
309 ENDIF
310
311 bminma(1)=bminma(1)+tzinf
312 bminma(2)=bminma(2)+tzinf
313 bminma(3)=bminma(3)+tzinf
314 bminma(4)=bminma(4)-tzinf
315 bminma(5)=bminma(5)-tzinf
316 bminma(6)=bminma(6)-tzinf
317
318 IF(nspmd > lrvoxelp)THEN
319 CALL ancmsg(msgid=36,anmode=aninfo,
320 . c1='(I25MAINTRI)')
321 CALL arret(2)
322 END IF
323
324 nsnr = 0
325
326 END IF
327
328 IF(nspmd > 1) THEN
329
330 IF(itask==0) THEN
331 ALLOCATE(crvoxel25(0:lrvoxel25,0:lrvoxel25,1:2,1:nspmd))
332 crvoxel25(0:lrvoxel25,0:lrvoxel25,1:2,loc_proc) = 0
333 ENDIF
334
335 CALL my_barrier
336 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
337 bgapemx=intbuf_tab%VARIABLES(bgapemx_index)
338
339 CALL spmd_tri25vox0(
340 1 x ,bminma ,nrtm_t,intbuf_tab%STFM(1+sshift),marge ,
341 2 curv_max,intbuf_tab%GAP_M(1+sshift),intbuf_tab%IRECTM(1+4*sshift),gap,
342 + intbuf_tab%VARIABLES(bgapsmx_index),
343 3 pmax_gap,vmaxdt,bgapemx,iedge,
344 . intbuf_tab%LEDGE,nedge,nledge,
345 . intbuf_tab%GAPE ,drad ,dgapload)
346
347 CALL spmd_tri25vox0_edge(
348 1 x ,bminma ,nrtm,intbuf_tab%STFE,marge ,
349 2 curv_max,intbuf_tab%GAP_M,intbuf_tab%IRECTM,gap,
350 + intbuf_tab%VARIABLES(bgapsmx_index),
351 3 pmax_gap,vmaxdt,bgapemx,iedge,igap0,
352 . intbuf_tab%LEDGE,nedge,nledge,
353 . intbuf_tab%GAPE,dgapload)
354
355 CALL my_barrier
356 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
357
358 IF(itask==0)THEN
359
360C
361C Get remote nodes in XREM/IREM
362C
363 inacti=0
364 nedge_local = intbuf_tab%NB_INTERNAL_EDGES + intbuf_tab%NB_BOUNDARY_EDGES_LOCAL
365 iedge = ipari(58,nin)
366 IF(imonm > 0) CALL startime(timers,25)
367 CALL spmd_tri25vox(
368 1 intbuf_tab%NSV ,nsn ,x ,v ,ms ,
369 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto ,
370 3 ircvfrom ,iad_elem ,fr_elem ,nsnr ,ipari(21,nin),
371 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
372 5 nsnfiold ,ipari(47,nin),intbuf_tab%IELES,intbuf_tab%AREAS,temp ,
373 6 num_imp ,nodnx_sms ,intbuf_tab%GAP_SL,nty ,intbuf_tab%IRTLM,
374 7 intbuf_tab%TIME_S,intbuf_tab%SECND_FR,intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD ,
375 8 intbuf_tab%NBINFLG,ilev ,intbuf_tab%ICONT_I,ipari(72,nin),intbuf_tab%IPARTFRICS,
376 9 itied ,ivis2 , intbuf_tab%IF_ADH,intbuf_tab%LEDGE,nedge ,
377 a nledge ,intbuf_tab%STFM,nedge_local,intbuf_tab%GAPE,intbuf_tab%GAP_E_L,
378 b intbuf_tab%STFE ,intbuf_tab%EDGE_BISECTOR,intbuf_tab%VTX_BISECTOR,intbuf_tab%ADMSR,
379 . intbuf_tab%IRECTM,
380 d intbuf_tab%EBINFLG,intbuf_tab%MVOISIN,iedge ,icodt , iskew ,
381 e intbuf_tab%IPARTFRIC_E,intbuf_tab%E2S_NOD_NORMAL,ipari(97,nin),intbuf_tab%STIFMSDT_S,
382 . intbuf_tab%STIFMSDT_EDG,
383 f ifsub_carea ,parameters%INTAREAN)
384 IF(imonm > 0) CALL stoptime(timers,25)
385
386C local renumbering of old candidates to collision
387 CALL spmd_rnum25(
388 1 renum ,nin, nsn,nsnfiold ,nsnrold)
389 IF(iedge /= 0) THEN
390 CALL spmd_rnum25_edge(nin,nedge,intbuf_tab%CANDS_E2E,intbuf_tab%I_STOK_E(1),
391 . intbuf_tab%CANDS_E2S,intbuf_tab%I_STOK_E(2))
392 END IF
393
394 IF(ALLOCATED(crvoxel25)) DEALLOCATE(crvoxel25)
395 END IF
396 END IF ! ITASK == 0
397
398C
399 cand_n_old = intbuf_tab%I_STOK(1)
400 40 continue
401C
402C Barrier comm spmd_tri7vox + BMINMA + Retour I7BUCE
403C
404 CALL my_barrier
405C
406 IF (imonm > 0) CALL startime(timers,30)
407C
408C NCONT additional candidates (if all secondary nodes are already impacted, cf i25optcd)
409 multimp = ipari(23,nin)
410 mulnsn = intbuf_tab%S_CAND_N - ncont
411 CALL i25buce(
412 1 x ,v ,intbuf_tab%IRECTM(1+4*sshift),intbuf_tab%NSV,
413 + intbuf_tab%STFNS,
414 2 nmn ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
415 3 gap ,noint ,intbuf_tab%I_STOK(1) ,mulnsn ,bminma ,
416 4 marge ,curv_max ,pmax_gap ,vmaxdt ,
417 5 sshift ,nin ,intbuf_tab%STFM(1+sshift) ,intbuf_tab%GAP_S,
418 6 nsnr ,ncont ,intbuf_tab%GAP_M(1+sshift) ,itask ,intbuf_tab%VARIABLES(bgapsmx_index),
419 7 i_mem ,intbuf_tab%PENE_OLD,itab ,intbuf_tab%NBINFLG,intbuf_tab%MBINFLG,
420 8 ilev ,intbuf_tab%MSEGTYP24,
421 9 flagremn,intbuf_tab%KREMNODE(1+2*sshift),intbuf_tab%REMNODE,
422 a igap ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML(1+sshift),icodt,iskew ,
423 b drad ,dgapload )
424C
425C Upgrade MultiMP
426 IF (i_mem == 2)THEN
427#include "lockon.inc"
428 i_memg = i_mem
429#include "lockoff.inc"
430 ENDIF
431
432C New barrier needed for Dynamic MultiMP
433 CALL my_barrier
434
435 IF(i_memg /=0)THEN
436!$OMP SINGLE
437 multimp = ipari(23,nin) * 1.3
438 CALL upgrade_multimp(nin,multimp,intbuf_tab)
439!$OMP END SINGLE
440 i_mem = 0
441 i_memg = 0
442 intbuf_tab%I_STOK(1)=cand_n_old
443 GOTO 40
444 ENDIF
445
446 IF (imonm > 0) CALL stoptime(timers,30)
447C--------------------------------------------------------------
448C Edges
449C--------------------------------------------------------------
450 IF(iedge==0) GOTO 200
451 inacti = ipari(22,nin)
452 cand_e_old(1:2) = intbuf_tab%I_STOK_E(1:2)
453 bgapemx=intbuf_tab%VARIABLES(bgapemx_index)
454 IF(itask == 0)THEN
455
456 bminma(1)=bsav(1)
457 bminma(2)=bsav(2)
458 bminma(3)=bsav(3)
459 bminma(4)=bsav(4)
460 bminma(5)=bsav(5)
461 bminma(6)=bsav(6)
462
463 tzinf = marge+two*bgapemx+dgapload+vmaxdt
464
465 bminma(1)=bminma(1)+tzinf
466 bminma(2)=bminma(2)+tzinf
467 bminma(3)=bminma(3)+tzinf
468 bminma(4)=bminma(4)-tzinf
469 bminma(5)=bminma(5)-tzinf
470 bminma(6)=bminma(6)-tzinf
471
472 END IF
473C
474 i_meme(1:2)=0
475 i_memg_e = 0
476 i_memg_s = 0
477C
478 140 continue
479C
480C Barrier comm spmd_tri7vox + BMINMA + Retour I7BUCE
481C
482 CALL my_barrier
483C
484 IF (imonm > 0) CALL startime(timers,30)
485C
486 mulnsne = intbuf_tab%S_CANDM_E2E
487 mulnsns = intbuf_tab%S_CANDM_E2S
488 nedge_local = intbuf_tab%NB_INTERNAL_EDGES + intbuf_tab%NB_BOUNDARY_EDGES_LOCAL
489 CALL i25buce_edg(
490 1 x ,v ,intbuf_tab%IRECTM,inacti ,
491 2 nsn ,nmn ,intbuf_tab%CANDM_E2E,intbuf_tab%CANDS_E2E,
492 3 gap ,noint ,intbuf_tab%I_STOK_E(1) ,mulnsne ,bminma ,
493 4 marge ,vmaxdt ,drad ,
494 5 eshift ,nedge_t ,sshift ,nrtm_t ,intbuf_tab%STFM ,
495 6 intbuf_tab%STFE ,nconte ,intbuf_tab%GAP_M ,itask ,bgapemx,
496 7 i_meme ,itab ,intbuf_tab%MBINFLG,intbuf_tab%EBINFLG,intbuf_tab%I_STOK_E(2),
497 8 mulnsns,ilev ,intbuf_tab%I25_CAND_A ,intbuf_tab%CAND_P ,igap0 ,
498 9 flagremn,intbuf_tab%KREMNODE_EDG ,intbuf_tab%REMNODE_EDG,intbuf_tab%KREMNODE_E2S,
499 . intbuf_tab%REMNODE_E2S,
500 a igap ,intbuf_tab%GAP_ML,iedge ,nedge ,intbuf_tab%MSEGTYP24,
501 b intbuf_tab%LEDGE,intbuf_tab%ADMSR,intbuf_tab%EDGE_BISECTOR,intbuf_tab%VTX_BISECTOR,
502 c intbuf_tab%CANDM_E2S,intbuf_tab%CANDS_E2S,intbuf_tab%I25_CAND_B,intbuf_tab%CAND_PS,intbuf_tab%GAPE,
503 d intbuf_tab%GAP_E_L,nedge_local,ifq , intbuf_tab%FTSAVX_E,intbuf_tab%FTSAVY_E,
504 e intbuf_tab%FTSAVZ_E,intbuf_tab%FTSAVX_E2S,intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S,
505 f intbuf_tab%IFPEN_E,intbuf_tab%IFPEN_E2S,intbuf_tab%S_KREMNODE_EDG ,intbuf_tab%S_REMNODE_EDG,
506 g intbuf_tab%S_KREMNODE_E2S,intbuf_tab%S_REMNODE_E2S,dgapload)
507C
508C Upgrade MultiMP
509 IF (i_meme(1)/=0)THEN
510#include "lockon.inc"
511 i_memg_e = i_meme(1)
512#include "lockoff.inc"
513 ENDIF
514 IF (i_meme(2)/=0)THEN
515#include "lockon.inc"
516 i_memg_s = i_meme(2)
517#include "lockoff.inc"
518 ENDIF
519
520C New barrier needed for Dynamic MultiMP
521 CALL my_barrier
522
523 IF(i_memg_e /=0 .OR. i_memg_s/=0)THEN
524!$OMP SINGLE
525 IF(i_memg_e/=0)THEN
526 ! same as TYPE11: increase > 4 for small interfaces
527 multimp = max(ipari(87,nin) +4,ipari(87,nin)+min(20,(250000/nconte)))
528 CALL upgrade_lcand_edg(nin,multimp,intbuf_tab)
529 END IF
530 IF(i_memg_s/=0)THEN
531 ! same as TYPE11: increase > 4 for small interfaces
532 multimp = max(ipari(89,nin) +4,ipari(89,nin)+min(20,(250000/nconte)))
533 CALL upgrade_lcand_e2s(nin,multimp,intbuf_tab)
534 END IF
535!$OMP END SINGLE
536 i_meme(1:2)= 0
537 i_memg_e = 0
538 i_memg_s = 0
539 intbuf_tab%I_STOK_E(1:2)=cand_e_old(1:2) ! on retrie tout
540 GOTO 140
541 ENDIF
542C
543 IF(itask==0)DEALLOCATE(intbuf_tab%I25_CAND_A,intbuf_tab%I25_CAND_B)
544C
545 IF (imonm > 0) CALL stoptime(timers,30)
546C--------------------------------------------------------------
547 200 CONTINUE
548C--------------------------------------------------------------
549C Negative value in "dist" : tag boundary part
550 IF(nspmd>1)THEN
551!$OMP SINGLE
552 IF (imonm > 0) CALL startime(timers,26)
553 intbuf_tab%VARIABLES(distance_index) = - one
554C
555 CALL spmd_tri25gat(
556 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
557 2 ipari(21,nin),nsnr,multimp ,nty,ipari(47,nin),
558 3 ilev ,nsnfiold,ipari ,nsnrold, renum, h3d_data ,
559 4 ipari(72,nin),flagremn,lremnormax,nrtm ,intbuf_tab%KREMNODE,
560 5 intbuf_tab%REMNODE,ivis2,ipari(97,nin),ifsub_carea ,nodadt_therm)
561 ipari(24,nin) = nsnr
562
563 nedge_remote_old = nedge_remote
564
565 IF(iedge /= 0) THEN
566 CALL spmd_tri25egat(
567 1 result ,nin , nedge,intbuf_tab%CANDS_E2E,intbuf_tab%I_STOK_E(1),
568 2 intbuf_tab%CANDS_E2S,intbuf_tab%I_STOK_E(2),igap,ipari(72,nin),ipari(97,nin))
569 ENDIF
570
571 ipari(69 ,nin) = nedge_remote_old
572C
573 IF (imonm > 0) CALL stoptime(timers,26)
574 IF(iedge /= 0) THEN
575 DEALLOCATE(renum_edge)
576 DEALLOCATE(oldnum_edge)
577 ENDIF
578!$OMP END SINGLE
579 END IF
580 IF(iedge /= 0) THEN
581!$OMP SINGLE
582 DEALLOCATE(nsnfieold)
583!$OMP END SINGLE
584 ENDIF
585C
586 CALL my_barrier
587 RETURN
588 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:308
message_mod
Definition message_mod.F:1249
parameters_mod
Definition parameters_mod.F:49
tri25ebox::renum_edge
integer, dimension(:), allocatable renum_edge
Definition tri25ebox.F:92
tri25ebox::nedge_remote
integer nedge_remote
Definition tri25ebox.F:73
tri25ebox::crvoxel25
integer, dimension(:,:,:,:), allocatable crvoxel25
Definition tri25ebox.F:70
tri25ebox::nedge_remote_old
integer nedge_remote_old
Definition tri25ebox.F:96
tri25ebox::lrvoxel25
integer, parameter lrvoxel25
Definition tri25ebox.F:69
tri25ebox::oldnum_edge
integer, dimension(:), allocatable oldnum_edge
Definition tri25ebox.F:93
tri25ebox::nsnfieold
integer, dimension(:), allocatable nsnfieold
Definition tri25ebox.F:95
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:207
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:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
upgrade_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