OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7main_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!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
25!||--- called by ------------------------------------------------------
26!|| imp_tripi ../engine/source/implicit/imp_int_k.F
27!|| inttri ../engine/source/interfaces/intsort/inttri.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../engine/source/output/message/message.F
30!|| arret ../engine/source/system/arret.f
31!|| check_sorting_criteria ../engine/source/interfaces/intsort/check_sorting_criteria.F90
32!|| i18xsave ../engine/source/interfaces/int18/i18xsave.F
33!|| i7buce ../engine/source/interfaces/intsort/i7buce.F
34!|| i7buce_vox ../engine/source/interfaces/intsort/i7buce.F
35!|| i7trc ../engine/source/interfaces/intsort/i7trc.f
36!|| i7xsave ../engine/source/interfaces/intsort/i7xsave.F
37!|| imp_rnumcd ../engine/source/implicit/imp_int_k.F
38!|| my_barrier ../engine/source/system/machine.F
39!|| spmd_get_inacti7 ../engine/source/mpi/interfaces/send_cand.F
40!|| spmd_rnumcd ../engine/source/mpi/interfaces/spmd_i7tool.F
41!|| spmd_tri18_151vox ../engine/source/mpi/interfaces/spmd_int.F
42!|| spmd_tri7gat ../engine/source/mpi/interfaces/spmd_int.F
43!|| spmd_tri7vox0 ../engine/source/mpi/interfaces/spmd_int.F
44!|| spmd_tri7vox_optimized ../engine/source/mpi/interfaces/spmd_tri7vox_optimized.F
45!|| startime ../engine/source/system/timer_mod.F90
46!|| stoptime ../engine/source/system/timer_mod.F90
47!|| upgrade_multimp ../common_source/interf/upgrade_multimp.F
48!||--- uses -----------------------------------------------------
49!|| check_sorting_criteria_mod ../engine/source/interfaces/intsort/check_sorting_criteria.F90
50!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
51!|| h3d_mod ../engine/share/modules/h3d_mod.F
52!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
53!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
54!|| message_mod ../engine/share/message_module/message_mod.F
55!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
56!|| timer_mod ../engine/source/system/timer_mod.F90
57!|| tri7box ../engine/share/modules/tri7box.F
58!||====================================================================
59 SUBROUTINE i7main_tri(TIMERS,
60 1 IPARI ,X ,V ,
61 2 MS ,NIN ,ITASK ,MWAG ,WEIGHT ,
62 3 ISENDTO ,IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,
63 4 ITAB ,KINET ,TEMP ,NRTM_T ,RENUM ,
64 5 NSNFIOLD,ESHIFT ,NUM_IMP ,IND_IMP ,NODNX_SMS,
65 6 INTBUF_TAB,H3D_DATA,IXS,MULTI_FVM,GLOB_THERM)
66C============================================================================
67C M o d u l e s
68C-----------------------------------------------
69 USE timer_mod
70 USE tri7box
71 USE message_mod
72 USE intbufdef_mod
73 USE h3d_mod
74 USE multi_fvm_mod
75 USE inter_sorting_mod
76 use check_sorting_criteria_mod , only : check_sorting_criteria
77 use glob_therm_mod
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82#include "comlock.inc"
83#include "spmd.inc"
84C-----------------------------------------------
85C C o m m o n B l o c k s
86C-----------------------------------------------
87#include "com01_c.inc"
88#include "com04_c.inc"
89#include "com08_c.inc"
90#include "param_c.inc"
91#include "units_c.inc"
92#include "task_c.inc"
93#include "timeri_c.inc"
94C common block for global variables in shared memory
95 COMMON /i7mainc/bminma,curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
96 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,NMN_G
97 my_real
98 . BMINMA(12),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, NRTM_T,ESHIFT,
104 . NUM_IMP ,IND_IMP(*),
105 . ITAB(*), KINET(*),
106 . IPARI(NPARI,NINTER), MWAG(*),
107 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),
108 . weight(*), iad_elem(2,*) ,fr_elem(*),
109 . renum(*), nsnfiold(nspmd), nodnx_sms(*), ixs(nixs, *)
110C REAL
111 my_real
112 . x(*), v(*), ms(*),temp(*)
113
114 TYPE(intbuf_struct_) INTBUF_TAB
115 TYPE(H3D_DATABASE) :: H3D_DATA
116 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
117 TYPE(glob_therm_), INTENT(IN) :: GLOB_THERM
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER
122 . loc_proc,
123 . i, ip0, ip1, ip2, ip21, i_sk_old, i_stok1,
124 . add1, nb_n_b, noint, inacti, multimp, igap, ifq, itied
125 INTEGER
126 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
127 . i_mem,cand_n_old,idum1(1),nmn_l, ivis2
128 my_real
129 . gap,maxbox,minbox,tzinf,dgaploadp,
130 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
131 . c_maxl,drad,mx,my,mz,dx,dy,dz,sx,sy,sz,sx2,sy2,sz2,
132 . curv_max(nrtm_t),rdum1(1)
133 REAL T1 !elapsed time in smp
134 LOGICAL TYPE18
135 INTEGER :: NRTM,NSN,NMN,NTY
136 logical :: need_computation
137C-----------------------------------------------
138 ! --------------
139 ! check if the current interface needs to be sorted
140 call check_sorting_criteria( need_computation,nin,npari,nspmd,
141 . itask,ipari(1,nin),tt,intbuf_tab )
142 if( .not.need_computation ) return
143 ! --------------
144 i_mem = 0
145 i_memg = 0
146 nmn_g = 0
147 nmn_l = 0
148C
149
150 nrtm =ipari(4,nin)
151 nsn =ipari(5,nin)
152 nmn =ipari(6,nin)
153 nty =ipari(7,nin)
154 ivis2 =ipari(14,nin)
155 noint =ipari(15,nin)
156 ncont =ipari(18,nin)
157 inacti =ipari(22,nin)
158 multimp =ipari(23,nin)
159 ifq =ipari(31,nin)
160 intth =ipari(47,nin)
161 itied =ipari(85,nin)
162
163 loc_proc=ispmd+1
164 ncontact=multimp*ncont
165
166 type18=.false.
167 IF(nty==7 .AND. inacti==7)type18=.true.
168
169 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
170 . num_imp>0.OR.itied/=0)THEN
171 nsnrold = ipari(24,nin)
172 ELSE
173 nsnrold = 0
174 ENDIF
175
176 gap =intbuf_tab%VARIABLES(gap_index)
177 gapmin=intbuf_tab%VARIABLES(gapmin_index)
178 gapmax=intbuf_tab%VARIABLES(gapmax_index)
179 drad = zero
180 IF(ipari(7,nin)==7) drad =intbuf_tab%VARIABLES(drad_index)
181 dgaploadp= intbuf_tab%VARIABLES(bgapemx_index)
182
183C
184C
185C -------------------------------------------------------------
186C
187 retri = 1
188C
189C -------------------------------------------------------------
190C
191 maxbox = intbuf_tab%VARIABLES(maxbox_index)
192 minbox = intbuf_tab%VARIABLES(minbox_index)
193 tzinf = intbuf_tab%VARIABLES(tzinf_index)
194 bminma(1)=-ep30
195 bminma(2)=-ep30
196 bminma(3)=-ep30
197 bminma(4)=ep30
198 bminma(5)=ep30
199 bminma(6)=ep30
200 bminma(7)=zero
201 bminma(8)=zero
202 bminma(9)=zero
203 bminma(10)=zero
204 bminma(11)=zero
205 bminma(12)=zero
206 curv_max_max = zero
207C
208C -------------------------------------------------------------
209C STORAGE OF OLD CANDIDATES WITH INITIAL PENETRATION
210C OR WITH FRICTION FILTERING
211C -------------------------------------------------------------
212C
213C Barrier in all cases for bminma [and cur_max_max]
214C
215 CALL my_barrier
216C
217 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
218 . num_imp>0.OR.itied/=0)THEN
219 IF(itask==0)THEN
220 inactii=inacti
221 IF (num_imp>0.AND.
222 . (inacti/=5.AND.inacti/=6.AND.ifq<=0)) THEN
223 inacimp = 0
224 ELSE
225 inacimp = 1
226 ENDIF
227 ip0 = 1
228 ip1 = ip0 + nsn + nsnrold + 3
229C MWA = MWAG ON TASK 0
230 i_sk_old = intbuf_tab%I_STOK(1)
231 CALL i7trc(
232 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,
233 2 intbuf_tab%CAND_P,intbuf_tab%FTSAVX,intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,
234 3 mwag(ip0) ,intbuf_tab%IFPEN ,inacti ,ifq ,
235 4 num_imp ,ind_imp ,intbuf_tab%STFNS ,nin ,
236 5 nsn ,itied,intbuf_tab%CAND_F )
237C store INACTI as negative
238 IF(i_sk_old==0)inacti=-abs(inacti)
239 intbuf_tab%I_STOK(1)=i_sk_old
240 IF(inactii/=7.AND.inacimp>0)THEN
241 IF (nspmd>1) THEN
242 CALL spmd_get_inacti7(inacti,ipari(22,nin),nin,isendto,
243 . ircvfrom,inactii)
244 ELSE
245 ipari(22,nin) = inacti
246 ENDIF
247 ENDIF
248 ENDIF
249 ELSE
250 i_sk_old=0
251 intbuf_tab%I_STOK(1)=0
252 ENDIF
253C -------------------------------------------------------------
254C DOMAIN BOUNDARY CALCULATION RETURNED IN I7XSAVE
255C -------------------------------------------------------------
256C eshift: offset on cand_e
257 IF(type18)THEN
258 CALL i18xsave(
259 1 x ,intbuf_tab%NSV ,intbuf_tab%MSR,nsn ,nmn ,
260 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
261 3 xmaxl ,ymaxl ,zmaxl ,c_maxl,curv_max,
262 4 ipari(39,nin),intbuf_tab%IRECTM(1+4*eshift) ,nrtm_t,sx,sy,
263 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l )
264 ELSE
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*eshift) ,nrtm_t,sx,sy,
270 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l )
271 ENDIF
272#include "lockon.inc"
273 bminma(1) = max(bminma(1),xmaxl)
274 bminma(2) = max(bminma(2),ymaxl)
275 bminma(3) = max(bminma(3),zmaxl)
276 bminma(4) = min(bminma(4),xminl)
277 bminma(5) = min(bminma(5),yminl)
278 bminma(6) = min(bminma(6),zminl)
279 curv_max_max = max(curv_max_max,c_maxl)
280 bminma(7) = bminma(7)+sx
281 bminma(8) = bminma(8)+sy
282 bminma(9) = bminma(9)+sz
283 bminma(10)= bminma(10)+sx2
284 bminma(11)= bminma(11)+sy2
285 bminma(12)= bminma(12)+sz2
286 nmn_g = nmn_g + nmn_l
287#include "lockoff.inc"
288
289 result = 0
290C BARRIER II_STOK and RESULT
291 CALL my_barrier
292C to keep for case where inacti is modified on p0
293 inacti=ipari(22,nin)
294 IF(itask==0)THEN
295 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
296 + abs(bminma(5)-bminma(2))>2*ep30.OR.
297 + abs(bminma(4)-bminma(1))>2*ep30)THEN
298 CALL ancmsg(msgid=87,anmode=aninfo,
299 . i1=noint,c1='(I7BUCE)')
300 CALL arret(2)
301 END IF
302C
303 bminma(1)=bminma(1)+tzinf+curv_max_max
304 bminma(2)=bminma(2)+tzinf+curv_max_max
305 bminma(3)=bminma(3)+tzinf+curv_max_max
306 bminma(4)=bminma(4)-tzinf-curv_max_max
307 bminma(5)=bminma(5)-tzinf-curv_max_max
308 bminma(6)=bminma(6)-tzinf-curv_max_max
309C Computation of standard deviation of X main
310C use the formula dev = sum(xi )-n.m
311C mean value m by direction
312 mx=bminma(7)/max(nmn_g,1)
313 my=bminma(8)/max(nmn_g,1)
314 mz=bminma(9)/max(nmn_g,1)
315C standard deviation by direction
316C DX=SQRT(BMINMA(10)/MAX(NMN,1)-MX**2)
317C DY=SQRT(BMINMA(11)/MAX(NMN,1)-MY**2)
318C DZ=SQRT(BMINMA(12)/MAX(NMN,1)-MZ**2)
319 dx=sqrt(max(bminma(10)/max(nmn_g,1)-mx**2,zero))
320 dy=sqrt(max(bminma(11)/max(nmn_g,1)-my**2,zero))
321 dz=sqrt(max(bminma(12)/max(nmn_g,1)-mz**2,zero))
322c print*,noint,'var=',dx,dy,dz
323C Computation of new boundary of the domain mean values +/- 2 sigma
324C => 95% of the population for normal distribution
325 bminma(7) = min(mx+2*dx,bminma(1))
326 bminma(8) = min(my+2*dy,bminma(2))
327 bminma(9) = min(mz+2*dz,bminma(3))
328 bminma(10) = max(mx-2*dx,bminma(4))
329 bminma(11) = max(my-2*dy,bminma(5))
330 bminma(12) = max(mz-2*dz,bminma(6))
331C
332 IF(abs(bminma(10)-bminma(7))<em10)THEN
333 bminma(10)=bminma(4)
334 bminma(7)=bminma(1)
335 END IF
336 IF(abs(bminma(11)-bminma(8))<em10)THEN
337 bminma(11)=bminma(5)
338 bminma(8)=bminma(2)
339 END IF
340 IF(abs(bminma(12)-bminma(9))<em10)THEN
341 bminma(12)=bminma(6)
342 bminma(9)=bminma(3)
343 END IF
344
345 IF(nspmd > lrvoxelp)THEN
346 CALL ancmsg(msgid=36,anmode=aninfo,
347 . c1='(I7MAINTRI)')
348 CALL arret(2)
349 END IF
350
351 nsnr = 0
352
353 END IF
354
355
356 IF(nspmd > 1) THEN
357
358 IF(itask==0) crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
359
360 CALL my_barrier
361
362 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
363 CALL spmd_tri7vox0(
364 1 x ,bminma ,ipari(21,nin),nrtm_t,intbuf_tab%STFM(1+eshift),
365 2 tzinf ,curv_max,gapmin ,gapmax,intbuf_tab%GAP_M(1+eshift),
366 3 intbuf_tab%IRECTM(1+4*eshift),gap ,intbuf_tab%VARIABLES(bgapsmx_index),drad,
367 4 dgaploadp )
368
369 CALL my_barrier
370 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
371
372 IF(itask==0)THEN
373C
374C retrieval of remote nodes NSNR stored in XREM
375C
376 IF (multi_fvm%IS_USED .AND. nty == 7 .AND. inacti == 7) THEN
377C Interface type 18 and law151
378 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
379 CALL spmd_tri18_151vox(
380 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
381 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
382 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
383 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
384 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp ,
385 6 num_imp ,nodnx_sms,intbuf_tab%GAP_SL,nty ,idum1 ,
386 7 rdum1 ,rdum1,rdum1,rdum1,idum1 ,idum1 ,idum1, ixs, multi_fvm,
387 8 ipari(72,nin),intbuf_tab%IPARTFRICS)
388 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
389
390
391 ELSE
392 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
393
394 CALL spmd_tri7vox_optimized(
395 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
396 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
397 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
398 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
399 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp ,
400 6 num_imp ,nodnx_sms,intbuf_tab%GAP_SL,nty ,idum1 ,
401 7 rdum1 ,rdum1,rdum1,rdum1,idum1 ,idum1 ,idum1 ,
402 8 ipari(72,nin),intbuf_tab%IPARTFRICS ,itied, ivis2, intbuf_tab%IF_ADH)
403 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
404
405
406 ENDIF
407C
408C local renumbering of old candidates
409C
410 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
411 + ifq>0.OR.num_imp>0.OR.itied/=0)THEN
412 CALL spmd_rnumcd(
413 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin,nsn,
414 2 nsnfiold ,nsnrold)
415 END IF
416 END IF
417 END IF
418
419 cand_n_old = intbuf_tab%I_STOK(1)
420 40 CONTINUE
421C
422 ild = 0
423 nb_n_b = 1
424C
425C Barrier comm spmd_tri7box + BMINMA + Return I7BUCE
426C IF(ITASK == 0) THEN
427c IF(INTBUF_TAB%METRIC%CYCLE0 == 10000) THEN
428c INTBUF_TAB%METRIC%CYCLE0 = 0
429c INTBUF_TAB%METRIC%ALGO = TRY_ALGO_VOXEL
430c ELSE
431c INTBUF_TAB%METRIC%CYCLE0 = INTBUF_TAB%METRIC%CYCLE0+1
432c ENDIF
433C INTBUF_TAB%METRIC%ALGO = ALGO_VOXEL
434C INTBUF_TAB%METRIC%ALGO = ALGO_BUCKET
435C ENDIF
436
437 50 CALL my_barrier
438 IF(itask==0) THEN
439 IF(ALLOCATED( list_remote_s_node ) ) DEALLOCATE( list_remote_s_node )
440 ALLOCATE( list_remote_s_node(nsnr) )
441 remote_s_node = 0
442 ENDIF
443 CALL my_barrier
444! IF REMNODE Then VOXEL
445 IF(ipari(63,nin) ==2 ) intbuf_tab%METRIC%ALGO = algo_voxel
446
447C
448#ifdef MPI
449 IF(itask == 0) intbuf_tab%METRIC%TIC = mpi_wtime()
450#else
451 IF(itask == 0) THEN
452 CALL cpu_time(t1)
453 intbuf_tab%METRIC%TIC = nint(100.0 * t1)
454 ENDIF
455#endif
456 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,30)
457C
458 IF(intbuf_tab%METRIC%ALGO == algo_voxel .OR. intbuf_tab%METRIC%ALGO == try_algo_voxel) THEN
459 CALL i7buce_vox(
460 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
461 2 nmn_g ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
462 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,bminma ,
463 4 tzinf ,maxbox ,minbox ,mwag ,curv_max ,
464 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
465 8 intbuf_tab%STFNS,nin ,intbuf_tab%STFM(1+eshift),ipari(21,nin),intbuf_tab%GAP_S,
466 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
467 b gapmin ,gapmax ,curv_max_max ,num_imp ,intbuf_tab%GAP_SL,
468 c intbuf_tab%GAP_ML(1+eshift),intth ,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
469 d intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,itab , ipari(63,nin),drad ,
470 e itied ,intbuf_tab%CAND_F,dgaploadp,remote_s_node,list_remote_s_node,
471 f nrtm ,glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
472 ELSE
473 CALL i7buce(
474 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
475 2 nmn_g ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
476 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,bminma ,
477 4 tzinf ,maxbox ,minbox ,mwag ,curv_max ,
478 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
479 8 intbuf_tab%STFNS,nin ,intbuf_tab%STFM(1+eshift),ipari(21,nin),intbuf_tab%GAP_S,
480 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
481 b gapmin ,gapmax ,curv_max_max ,num_imp ,intbuf_tab%GAP_SL,
482 c intbuf_tab%GAP_ML(1+eshift),intth ,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
483 d intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,itab , ipari(63,nin),drad ,
484 e itied ,intbuf_tab%CAND_F,dgaploadp,glob_therm%INTHEAT, glob_therm%IDT_THERM, glob_therm%NODADT_THERM)
485
486 ENDIF
487
488 IF (i_mem >= 1 )THEN
489#include "lockon.inc"
490 i_memg = i_mem
491#include "lockoff.inc"
492 ENDIF
493
494C New barrier needed for Dynamic MultiMP
495 CALL my_barrier
496
497#ifdef MPI
498 IF(itask == 0 ) intbuf_tab%METRIC%TOC = mpi_wtime()
499#else
500 IF(itask == 0) THEN
501 CALL cpu_time(t1)
502 intbuf_tab%METRIC%TOC = nint(100.0 * t1)
503 ENDIF
504#endif
505
506
507 IF(i_memg /=0)THEN
508 IF(i_memg == 3 .OR. i_memg == 1) intbuf_tab%METRIC%ALGO = algo_voxel
509C CARE : JINBUF & JBUFIN array are reallocated in
510C UPGRADE_MULTIMP routine !!!!
511
512!$OMP SINGLE
513 multimp = ipari(23,nin) + 4
514 CALL upgrade_multimp(nin,multimp,intbuf_tab)
515!$OMP END SINGLE
516 i_mem = 0
517 i_memg = 0
518 intbuf_tab%I_STOK(1) = cand_n_old
519 multimp=ipari(23,nin)
520 ncontact=multimp*ncont
521 GOTO 40
522 ENDIF
523
524C
525 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,30)
526 IF( itask == 0) THEN
527 IF( intbuf_tab%METRIC%ALGO == try_algo_voxel) THEN ! if test phase
528 intbuf_tab%METRIC%ALGO = try_algo_bucket
529 intbuf_tab%METRIC%TOLD = intbuf_tab%METRIC%TOC - intbuf_tab%METRIC%TIC
530 ELSEIF ( intbuf_tab%METRIC%ALGO == try_algo_bucket) THEN
531 IF( 1.2d0 * (intbuf_tab%METRIC%TOC-intbuf_tab%METRIC%TIC) < intbuf_tab%METRIC%TOLD) THEN
532 intbuf_tab%METRIC%ALGO = algo_bucket
533 WRITE(iout,*) "INFO: DOMAIN",ispmd,
534 . "USES SORT2 FOR CONTACT INTERFACE",noint
535 ELSE
536 intbuf_tab%METRIC%ALGO = algo_voxel
537c WRITE(IOUT,*) "INFO: DOMAIN",ISPMD,
538c . "USES SORT1 FOR CONTACT INTERFACE",NOINT
539 ENDIF
540 ENDIF
541 ENDIF
542C
543#include "lockon.inc"
544 intbuf_tab%VARIABLES(maxbox_index) = min(maxbox,intbuf_tab%VARIABLES(maxbox_index))
545 intbuf_tab%VARIABLES(minbox_index) = min(minbox,intbuf_tab%VARIABLES(minbox_index))
546 intbuf_tab%VARIABLES(tzinf_index) = min(tzinf,intbuf_tab%VARIABLES(tzinf_index))
547 intbuf_tab%VARIABLES(distance_index) = intbuf_tab%VARIABLES(tzinf_index)-gap
548 result = result + ild
549#include "lockoff.inc"
550C--------------------------------------------------------------
551C--------------------------------------------------------------
552 CALL my_barrier
553 IF (result/=0) THEN
554 CALL my_barrier
555 IF (itask==0) THEN
556C useful if we return
557 intbuf_tab%I_STOK(1) = i_sk_old
558 result = 0
559 ENDIF
560 CALL my_barrier
561 ild = 0
562 maxbox = intbuf_tab%VARIABLES(maxbox_index)
563 minbox = intbuf_tab%VARIABLES(minbox_index)
564 tzinf = intbuf_tab%VARIABLES(tzinf_index)
565 GOTO 50
566 ENDIF
567C temporarily set dist to negative for identification in frontier part
568 IF(nspmd>1)THEN
569C single task
570!$OMP SINGLE
571 IF (imonm > 0) CALL startime(timers,26)
572 intbuf_tab%VARIABLES(distance_index) = -intbuf_tab%VARIABLES(distance_index)
573C
574 CALL spmd_tri7gat(
575 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
576 2 ipari(21,nin),nsnr ,multimp ,nty ,ipari(47,nin),
577 3 idum1 ,nsnfiold, ipari , h3d_data ,ipari(72,nin),
578 4 multi_fvm,glob_therm%NODADT_THERM)
579 ipari(24,nin) = nsnr
580C
581 IF (num_imp>0)
582 . CALL imp_rnumcd(intbuf_tab%CAND_N,nin,nsn,num_imp,ind_imp )
583C
584 IF (imonm > 0) CALL stoptime(timers,26)
585!$OMP END SINGLE
586 END IF
587
588 IF(itask==0) THEN
589 IF(ALLOCATED( list_remote_s_node ) ) DEALLOCATE( list_remote_s_node )
590 ENDIF
591 CALL my_barrier
592C
593 RETURN
594 END
i18xsave
subroutine i18xsave(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 i18xsave.F:34
i7buce
subroutine i7buce(x, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, mwag, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, curv_max_max, num_imp, gap_s_l, gap_m_l, intth, itask, bgapsmx, i_mem, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, intheat, idt_therm, nodadt_therm)
Definition i7buce.F:47
i7buce_vox
subroutine i7buce_vox(x, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, mwag, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, curv_max_max, num_imp, gap_s_l, gap_m_l, intth, itask, bgapsmx, i_mem, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, remote_s_node, list_remote_s_node, total_nb_nrtm, intheat, idt_therm, nodadt_therm)
Definition i7buce.F:207
i7main_tri
subroutine i7main_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, intbuf_tab, h3d_data, ixs, multi_fvm, glob_therm)
Definition i7main_tri.F:66
i7trc
subroutine i7trc(nsn, i_stok, cand_n, cand_e, cand_p, cand_fx, cand_fy, cand_fz, cand_a, ifpen, inacti, ifq, num_imp, ind_imp, stfns, nin, nsnl, itied, cand_f)
Definition i7trc.F:38
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
imp_rnumcd
subroutine imp_rnumcd(cand_n, nin, nsn, num_imp, index)
Definition imp_int_k.F:1542
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mpi_wtime
double precision function mpi_wtime()
Definition mpi.f:561
h3d_mod
Definition h3d_mod.F:308
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::list_remote_s_node
integer, dimension(:), allocatable list_remote_s_node
Definition inter_sorting_mod.F:81
inter_sorting_mod::remote_s_node
integer remote_s_node
Definition inter_sorting_mod.F:80
message_mod
Definition message_mod.F:1249
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_get_inacti7
subroutine spmd_get_inacti7(inacti, ipari22, nin, isendto, ircvfrom, inactii)
Definition send_cand.F:58
spmd_rnumcd
subroutine spmd_rnumcd(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:162
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:3002
spmd_tri18_151vox
subroutine spmd_tri18_151vox(nsv, nsn, x, v, ms, bminmal, weight, stifn, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, ixs, multi_fvm, intfric, ipartfrics)
Definition spmd_int.F:893
spmd_tri7vox0
subroutine spmd_tri7vox0(x, bminmal, igap, nrtm, stf, tzinf, curv_max, gapmin, gapmax, gap_m, irect, gap, bgapsmx, drad, dgapload)
Definition spmd_int.F:58
spmd_tri7vox_optimized
subroutine spmd_tri7vox_optimized(nsv, nsn, x, v, ms, bminmal, weight, stifn, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, intfric, ipartfrics, itied, ivis2, if_adh)
Definition spmd_tri7vox_optimized.F:48
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48