OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7main_tri.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i7main_tri (timers, ipari, x, v, ms, nin, itask, 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)

Function/Subroutine Documentation

◆ i7main_tri()

subroutine i7main_tri ( type(timer_) timers,
integer, dimension(npari,ninter) ipari,
x,
v,
ms,
integer nin,
integer itask,
integer, dimension(*) weight,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer retri,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) itab,
integer, dimension(*) kinet,
temp,
integer nrtm_t,
integer, dimension(*) renum,
integer, dimension(nspmd) nsnfiold,
integer eshift,
integer num_imp,
integer, dimension(*) ind_imp,
integer, dimension(*) nodnx_sms,
type(intbuf_struct_) intbuf_tab,
type(h3d_database) h3d_data,
integer, dimension(nixs, *) ixs,
type(multi_fvm_struct), intent(inout) multi_fvm,
type(glob_therm_), intent(in) glob_therm )

Definition at line 60 of file i7main_tri.F.

67C============================================================================
68C M o d u l e s
69C-----------------------------------------------
70 USE timer_mod
71 USE tri7box
72 USE message_mod
73 USE intbufdef_mod
74 USE h3d_mod
75 USE multi_fvm_mod
76 USE inter_sorting_mod
77 use check_sorting_criteria_mod , only : check_sorting_criteria
78 use glob_therm_mod
79 use element_mod , only : nixs
80C-----------------------------------------------
81C I m p l i c i t T y p e s
82C-----------------------------------------------
83#include "implicit_f.inc"
84#include "comlock.inc"
85#include "spmd.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 "units_c.inc"
94#include "task_c.inc"
95#include "timeri_c.inc"
96C common block for global variables in shared memory
97 COMMON /i7mainc/bminma,curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
98 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,NMN_G
99 my_real
100 . bminma(12),curv_max_max
101C-----------------------------------------------
102C D u m m y A r g u m e n t s
103C-----------------------------------------------
104 TYPE(TIMER_) :: TIMERS
105 INTEGER NIN ,ITASK, RETRI, NRTM_T,ESHIFT,
106 . NUM_IMP ,IND_IMP(*),
107 . ITAB(*), KINET(*),
108 . IPARI(NPARI,NINTER),
109 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),
110 . WEIGHT(*), IAD_ELEM(2,*) ,FR_ELEM(*),
111 . RENUM(*), NSNFIOLD(NSPMD), NODNX_SMS(*), IXS(NIXS, *)
112C REAL
113 my_real
114 . x(*), v(*), ms(*),temp(*)
115
116 TYPE(INTBUF_STRUCT_) INTBUF_TAB
117 TYPE(H3D_DATABASE) :: H3D_DATA
118 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
119 TYPE(GLOB_THERM_), INTENT(IN) :: GLOB_THERM
120C-----------------------------------------------
121C L o c a l V a r i a b l e s
122C-----------------------------------------------
123 INTEGER
124 . LOC_PROC,
125 . I, IP0, IP2, IP21, I_SK_OLD, I_STOK1,
126 . ADD1, NB_N_B, NOINT, INACTI, MULTIMP, IGAP, IFQ, ITIED
127 INTEGER
128 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
129 . I_MEM,CAND_N_OLD,IDUM1(1),NMN_L, IVIS2
130 my_real
131 . gap,maxbox,minbox,tzinf,dgaploadp,
132 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
133 . c_maxl,drad,mx,my,mz,dx,dy,dz,sx,sy,sz,sx2,sy2,sz2,
134 . curv_max(nrtm_t),rdum1(1)
135 REAL T1 !elapsed time in smp
136 LOGICAL TYPE18
137 INTEGER :: NRTM,NSN,NMN,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 i_memg = 0
148 nmn_g = 0
149 nmn_l = 0
150C
151
152 nrtm =ipari(4,nin)
153 nsn =ipari(5,nin)
154 nmn =ipari(6,nin)
155 nty =ipari(7,nin)
156 ivis2 =ipari(14,nin)
157 noint =ipari(15,nin)
158 ncont =ipari(18,nin)
159 inacti =ipari(22,nin)
160 multimp =ipari(23,nin)
161 ifq =ipari(31,nin)
162 intth =ipari(47,nin)
163 itied =ipari(85,nin)
164
165 loc_proc=ispmd+1
166 ncontact=multimp*ncont
167
168 type18=.false.
169 IF(nty==7 .AND. inacti==7)type18=.true.
170
171 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
172 . num_imp>0.OR.itied/=0)THEN
173 nsnrold = ipari(24,nin)
174 ELSE
175 nsnrold = 0
176 ENDIF
177
178 gap =intbuf_tab%VARIABLES(gap_index)
179 gapmin=intbuf_tab%VARIABLES(gapmin_index)
180 gapmax=intbuf_tab%VARIABLES(gapmax_index)
181 drad = zero
182 IF(ipari(7,nin)==7) drad =intbuf_tab%VARIABLES(drad_index)
183 dgaploadp= intbuf_tab%VARIABLES(bgapemx_index)
184
185C
186C
187C -------------------------------------------------------------
188C
189 retri = 1
190C
191C -------------------------------------------------------------
192C
193 maxbox = intbuf_tab%VARIABLES(maxbox_index)
194 minbox = intbuf_tab%VARIABLES(minbox_index)
195 tzinf = intbuf_tab%VARIABLES(tzinf_index)
196 bminma(1)=-ep30
197 bminma(2)=-ep30
198 bminma(3)=-ep30
199 bminma(4)=ep30
200 bminma(5)=ep30
201 bminma(6)=ep30
202 bminma(7)=zero
203 bminma(8)=zero
204 bminma(9)=zero
205 bminma(10)=zero
206 bminma(11)=zero
207 bminma(12)=zero
208 curv_max_max = zero
209C
210C -------------------------------------------------------------
211C STORAGE OF OLD CANDIDATES WITH INITIAL PENETRATION
212C OR WITH FRICTION FILTERING
213C -------------------------------------------------------------
214C
215C Barrier in all cases for bminma [and cur_max_max]
216C
217 IF(itask==0)THEN
218 IF(.NOT. ALLOCATED(intbuf_tab%CAND_A)) THEN
219 ALLOCATE(intbuf_tab%CAND_A(nsnrold+nsn+3))
220 ELSEIF(SIZE(intbuf_tab%CAND_A)<nsnrold+nsn+3) THEN
221 DEALLOCATE(intbuf_tab%CAND_A)
222 ALLOCATE(intbuf_tab%CAND_A(nsn+nsnrold+3))
223 ENDIF
224 ENDIF
225
226 CALL my_barrier
227C
228 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
229 . num_imp>0.OR.itied/=0)THEN
230 IF(itask==0)THEN
231 inactii=inacti
232 IF (num_imp>0.AND.
233 . (inacti/=5.AND.inacti/=6.AND.ifq<=0)) THEN
234 inacimp = 0
235 ELSE
236 inacimp = 1
237 ENDIF
238 ip0 = 1
239C MWA = MWAG ON TASK 0
240 i_sk_old = intbuf_tab%I_STOK(1)
241 CALL i7trc(
242 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,
243 2 intbuf_tab%CAND_P,intbuf_tab%FTSAVX,intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,
244 3 intbuf_tab%CAND_A ,intbuf_tab%IFPEN ,inacti ,ifq ,
245 4 num_imp ,ind_imp ,intbuf_tab%STFNS ,nin ,
246 5 nsn ,itied,intbuf_tab%CAND_F )
247C store INACTI as negative
248 IF(i_sk_old==0)inacti=-abs(inacti)
249 intbuf_tab%I_STOK(1)=i_sk_old
250 IF(inactii/=7.AND.inacimp>0)THEN
251 IF (nspmd>1) THEN
252 CALL spmd_get_inacti7(inacti,ipari(22,nin),nin,isendto,
253 . ircvfrom,inactii)
254 ELSE
255 ipari(22,nin) = inacti
256 ENDIF
257 ENDIF
258 ENDIF
259 ELSE
260 i_sk_old=0
261 intbuf_tab%I_STOK(1)=0
262 ENDIF
263C -------------------------------------------------------------
264C DOMAIN BOUNDARY CALCULATION RETURNED IN I7XSAVE
265C -------------------------------------------------------------
266C eshift: offset on cand_e
267 IF(type18)THEN
268 CALL i18xsave(
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*eshift) ,nrtm_t,sx,sy,
273 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l )
274 ELSE
275 CALL i7xsave(
276 1 x ,intbuf_tab%NSV ,intbuf_tab%MSR,nsn ,nmn ,
277 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
278 3 xmaxl ,ymaxl ,zmaxl ,c_maxl,curv_max,
279 4 ipari(39,nin),intbuf_tab%IRECTM(1+4*eshift) ,nrtm_t,sx,sy,
280 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l )
281 ENDIF
282#include "lockon.inc"
283 bminma(1) = max(bminma(1),xmaxl)
284 bminma(2) = max(bminma(2),ymaxl)
285 bminma(3) = max(bminma(3),zmaxl)
286 bminma(4) = min(bminma(4),xminl)
287 bminma(5) = min(bminma(5),yminl)
288 bminma(6) = min(bminma(6),zminl)
289 curv_max_max = max(curv_max_max,c_maxl)
290 bminma(7) = bminma(7)+sx
291 bminma(8) = bminma(8)+sy
292 bminma(9) = bminma(9)+sz
293 bminma(10)= bminma(10)+sx2
294 bminma(11)= bminma(11)+sy2
295 bminma(12)= bminma(12)+sz2
296 nmn_g = nmn_g + nmn_l
297#include "lockoff.inc"
298
299 result = 0
300C BARRIER II_STOK and RESULT
301 CALL my_barrier
302C to keep for case where inacti is modified on p0
303 inacti=ipari(22,nin)
304 IF(itask==0)THEN
305 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
306 + abs(bminma(5)-bminma(2))>2*ep30.OR.
307 + abs(bminma(4)-bminma(1))>2*ep30)THEN
308 CALL ancmsg(msgid=87,anmode=aninfo,
309 . i1=noint,c1='(I7BUCE)')
310 CALL arret(2)
311 END IF
312C
313 bminma(1)=bminma(1)+tzinf+curv_max_max
314 bminma(2)=bminma(2)+tzinf+curv_max_max
315 bminma(3)=bminma(3)+tzinf+curv_max_max
316 bminma(4)=bminma(4)-tzinf-curv_max_max
317 bminma(5)=bminma(5)-tzinf-curv_max_max
318 bminma(6)=bminma(6)-tzinf-curv_max_max
319C Computation of standard deviation of X main
320C use the formula dev = sum(xi )-n.m
321C mean value m by direction
322 mx=bminma(7)/max(nmn_g,1)
323 my=bminma(8)/max(nmn_g,1)
324 mz=bminma(9)/max(nmn_g,1)
325C standard deviation by direction
326C DX=SQRT(BMINMA(10)/MAX(NMN,1)-MX**2)
327C DY=SQRT(BMINMA(11)/MAX(NMN,1)-MY**2)
328C DZ=SQRT(BMINMA(12)/MAX(NMN,1)-MZ**2)
329 dx=sqrt(max(bminma(10)/max(nmn_g,1)-mx**2,zero))
330 dy=sqrt(max(bminma(11)/max(nmn_g,1)-my**2,zero))
331 dz=sqrt(max(bminma(12)/max(nmn_g,1)-mz**2,zero))
332c print*,noint,'var=',dx,dy,dz
333C Computation of new boundary of the domain mean values +/- 2 sigma
334C => 95% of the population for normal distribution
335 bminma(7) = min(mx+2*dx,bminma(1))
336 bminma(8) = min(my+2*dy,bminma(2))
337 bminma(9) = min(mz+2*dz,bminma(3))
338 bminma(10) = max(mx-2*dx,bminma(4))
339 bminma(11) = max(my-2*dy,bminma(5))
340 bminma(12) = max(mz-2*dz,bminma(6))
341C
342 IF(abs(bminma(10)-bminma(7))<em10)THEN
343 bminma(10)=bminma(4)
344 bminma(7)=bminma(1)
345 END IF
346 IF(abs(bminma(11)-bminma(8))<em10)THEN
347 bminma(11)=bminma(5)
348 bminma(8)=bminma(2)
349 END IF
350 IF(abs(bminma(12)-bminma(9))<em10)THEN
351 bminma(12)=bminma(6)
352 bminma(9)=bminma(3)
353 END IF
354
355 IF(nspmd > lrvoxelp)THEN
356 CALL ancmsg(msgid=36,anmode=aninfo,
357 . c1='(I7MAINTRI)')
358 CALL arret(2)
359 END IF
360
361 nsnr = 0
362
363 END IF
364
365
366 IF(nspmd > 1) THEN
367
368 IF(itask==0) crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
369
370 CALL my_barrier
371
372 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
373 CALL spmd_tri7vox0(
374 1 x ,bminma ,ipari(21,nin),nrtm_t,intbuf_tab%STFM(1+eshift),
375 2 tzinf ,curv_max,gapmin ,gapmax,intbuf_tab%GAP_M(1+eshift),
376 3 intbuf_tab%IRECTM(1+4*eshift),gap ,intbuf_tab%VARIABLES(bgapsmx_index),drad,
377 4 dgaploadp )
378
379 CALL my_barrier
380 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
381
382 IF(itask==0)THEN
383C
384C retrieval of remote nodes NSNR stored in XREM
385C
386 IF (multi_fvm%IS_USED .AND. nty == 7 .AND. inacti == 7) THEN
387C Interface type 18 and law151
388 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
389 CALL spmd_tri18_151vox(
390 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
391 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
392 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
393 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
394 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp ,
395 6 num_imp ,nodnx_sms,intbuf_tab%GAP_SL,nty ,idum1 ,
396 7 rdum1 ,rdum1,rdum1,rdum1,idum1 ,idum1 ,idum1, ixs, multi_fvm,
397 8 ipari(72,nin),intbuf_tab%IPARTFRICS)
398 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
399
400
401 ELSE
402 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
403
404 CALL spmd_tri7vox_optimized(
405 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
406 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
407 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
408 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
409 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp ,
410 6 num_imp ,nodnx_sms,intbuf_tab%GAP_SL,nty ,idum1 ,
411 7 rdum1 ,rdum1,rdum1,rdum1,idum1 ,idum1 ,idum1 ,
412 8 ipari(72,nin),intbuf_tab%IPARTFRICS ,itied, ivis2, intbuf_tab%IF_ADH)
413 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
414
415
416 ENDIF
417C
418C local renumbering of old candidates
419C
420 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
421 + ifq>0.OR.num_imp>0.OR.itied/=0)THEN
422 CALL spmd_rnumcd(
423 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin,nsn,
424 2 nsnfiold ,nsnrold)
425 END IF
426 END IF
427 END IF
428
429 cand_n_old = intbuf_tab%I_STOK(1)
430 40 CONTINUE
431C
432 ild = 0
433 nb_n_b = 1
434C
435C Barrier comm spmd_tri7box + BMINMA + Return I7BUCE
436C IF(ITASK == 0) THEN
437c IF(INTBUF_TAB%METRIC%CYCLE0 == 10000) THEN
438c INTBUF_TAB%METRIC%CYCLE0 = 0
439c INTBUF_TAB%METRIC%ALGO = TRY_ALGO_VOXEL
440c ELSE
441c INTBUF_TAB%METRIC%CYCLE0 = INTBUF_TAB%METRIC%CYCLE0+1
442c ENDIF
443C INTBUF_TAB%METRIC%ALGO = ALGO_VOXEL
444C INTBUF_TAB%METRIC%ALGO = ALGO_BUCKET
445C ENDIF
446
447 50 CALL my_barrier
448 IF(itask==0) THEN
449 IF(ALLOCATED( list_remote_s_node ) ) DEALLOCATE( list_remote_s_node )
450 ALLOCATE( list_remote_s_node(nsnr) )
451 remote_s_node = 0
452 ENDIF
453 CALL my_barrier
454! IF REMNODE Then VOXEL
455 IF(ipari(63,nin) ==2 ) intbuf_tab%METRIC%ALGO = algo_voxel
456
457C
458#ifdef MPI
459 IF(itask == 0) intbuf_tab%METRIC%TIC = mpi_wtime()
460#else
461 IF(itask == 0) THEN
462 CALL cpu_time(t1)
463 intbuf_tab%METRIC%TIC = nint(100.0 * t1)
464 ENDIF
465#endif
466 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,30)
467C
468 IF(intbuf_tab%METRIC%ALGO == algo_voxel .OR. intbuf_tab%METRIC%ALGO == try_algo_voxel) THEN
469 CALL i7buce_vox(
470 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
471 2 nmn_g ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
472 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,bminma ,
473 4 tzinf ,maxbox ,minbox ,intbuf_tab%CAND_A,curv_max ,
474 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
475 8 intbuf_tab%STFNS,nin ,intbuf_tab%STFM(1+eshift),ipari(21,nin),intbuf_tab%GAP_S,
476 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
477 b gapmin ,gapmax ,curv_max_max ,num_imp ,intbuf_tab%GAP_SL,
478 c intbuf_tab%GAP_ML(1+eshift),intth ,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
479 d intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,itab , ipari(63,nin),drad ,
480 e itied ,intbuf_tab%CAND_F,dgaploadp,remote_s_node,list_remote_s_node,
481 f nrtm ,glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
482 ELSE
483 CALL i7buce(
484 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
485 2 nmn_g ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
486 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,bminma ,
487 4 tzinf ,maxbox ,minbox ,intbuf_tab%CAND_A,curv_max ,
488 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
489 8 intbuf_tab%STFNS,nin ,intbuf_tab%STFM(1+eshift),ipari(21,nin),intbuf_tab%GAP_S,
490 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
491 b gapmin ,gapmax ,curv_max_max ,num_imp ,intbuf_tab%GAP_SL,
492 c intbuf_tab%GAP_ML(1+eshift),intth ,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
493 d intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,itab , ipari(63,nin),drad ,
494 e itied ,intbuf_tab%CAND_F,dgaploadp,glob_therm%INTHEAT, glob_therm%IDT_THERM, glob_therm%NODADT_THERM)
495
496 ENDIF
497
498 IF (i_mem >= 1 )THEN
499#include "lockon.inc"
500 i_memg = i_mem
501#include "lockoff.inc"
502 ENDIF
503
504C New barrier needed for Dynamic MultiMP
505 CALL my_barrier
506
507#ifdef MPI
508 IF(itask == 0 ) intbuf_tab%METRIC%TOC = mpi_wtime()
509#else
510 IF(itask == 0) THEN
511 CALL cpu_time(t1)
512 intbuf_tab%METRIC%TOC = nint(100.0 * t1)
513 ENDIF
514#endif
515
516
517 IF(i_memg /=0)THEN
518 IF(i_memg == 3 .OR. i_memg == 1) intbuf_tab%METRIC%ALGO = algo_voxel
519C CARE : JINBUF & JBUFIN array are reallocated in
520C UPGRADE_MULTIMP routine !!!!
521
522!$OMP SINGLE
523 multimp = ipari(23,nin) + 4
524 CALL upgrade_multimp(nin,multimp,intbuf_tab)
525!$OMP END SINGLE
526 i_mem = 0
527 i_memg = 0
528 intbuf_tab%I_STOK(1) = cand_n_old
529 multimp=ipari(23,nin)
530 ncontact=multimp*ncont
531 GOTO 40
532 ENDIF
533
534C
535 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,30)
536 IF( itask == 0) THEN
537 IF( intbuf_tab%METRIC%ALGO == try_algo_voxel) THEN ! if test phase
538 intbuf_tab%METRIC%ALGO = try_algo_bucket
539 intbuf_tab%METRIC%TOLD = intbuf_tab%METRIC%TOC - intbuf_tab%METRIC%TIC
540 ELSEIF ( intbuf_tab%METRIC%ALGO == try_algo_bucket) THEN
541 IF( 1.2d0 * (intbuf_tab%METRIC%TOC-intbuf_tab%METRIC%TIC) < intbuf_tab%METRIC%TOLD) THEN
542 intbuf_tab%METRIC%ALGO = algo_bucket
543 WRITE(iout,*) "INFO: DOMAIN",ispmd,
544 . "USES SORT2 FOR CONTACT INTERFACE",noint
545 ELSE
546 intbuf_tab%METRIC%ALGO = algo_voxel
547c WRITE(IOUT,*) "INFO: DOMAIN",ISPMD,
548c . "USES SORT1 FOR CONTACT INTERFACE",NOINT
549 ENDIF
550 ENDIF
551 ENDIF
552C
553#include "lockon.inc"
554 intbuf_tab%VARIABLES(maxbox_index) = min(maxbox,intbuf_tab%VARIABLES(maxbox_index))
555 intbuf_tab%VARIABLES(minbox_index) = min(minbox,intbuf_tab%VARIABLES(minbox_index))
556 intbuf_tab%VARIABLES(tzinf_index) = min(tzinf,intbuf_tab%VARIABLES(tzinf_index))
557 intbuf_tab%VARIABLES(distance_index) = intbuf_tab%VARIABLES(tzinf_index)-gap
558 result = result + ild
559#include "lockoff.inc"
560C--------------------------------------------------------------
561C--------------------------------------------------------------
562 CALL my_barrier
563 IF (result/=0) THEN
564 CALL my_barrier
565 IF (itask==0) THEN
566C useful if we return
567 intbuf_tab%I_STOK(1) = i_sk_old
568 result = 0
569 ENDIF
570 CALL my_barrier
571 ild = 0
572 maxbox = intbuf_tab%VARIABLES(maxbox_index)
573 minbox = intbuf_tab%VARIABLES(minbox_index)
574 tzinf = intbuf_tab%VARIABLES(tzinf_index)
575 GOTO 50
576 ENDIF
577C temporarily set dist to negative for identification in frontier part
578 IF(nspmd>1)THEN
579C single task
580!$OMP SINGLE
581 IF (imonm > 0) CALL startime(timers,26)
582 intbuf_tab%VARIABLES(distance_index) = -intbuf_tab%VARIABLES(distance_index)
583C
584 CALL spmd_tri7gat(
585 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
586 2 ipari(21,nin),nsnr ,multimp ,nty ,ipari(47,nin),
587 3 idum1 ,nsnfiold, ipari , h3d_data ,ipari(72,nin),
588 4 multi_fvm,glob_therm%NODADT_THERM)
589 ipari(24,nin) = nsnr
590C
591 IF (num_imp>0)
592 . CALL imp_rnumcd(intbuf_tab%CAND_N,nin,nsn,num_imp,ind_imp )
593C
594 IF (imonm > 0) CALL stoptime(timers,26)
595!$OMP END SINGLE
596 END IF
597
598 IF(itask==0) THEN
599 IF(ALLOCATED( list_remote_s_node ) ) DEALLOCATE( list_remote_s_node )
600 ENDIF
601 CALL my_barrier
602C
603 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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, cand_a, 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, cand_a, 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:201
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:1550
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:311
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: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_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:3004
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:894
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: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_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48