53 1 IRCVFROM,RETRI,ITAB,NRTM_T,RENUM,RENUM_SIZ,
54 2 NSNFIOLD,ESHIFT,MULTI_FVM,INTBUF_TAB,H3D_DATA,
55 3 INTER_STRUCT,SORT_COMM,INTHEAT, IDT_THERM, NODADT_THERM)
75 USE inter7_collision_detection_mod
76 use check_sorting_criteria_mod ,
only : check_sorting_criteria
80#include "implicit_f.inc"
92#include "timeri_c.inc"
94 COMMON /i7mainc/curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
95 INTEGER RESULT,,NSNROLD,I_MEMG,NMN_G
96 my_real :: CURV_MAX_MAX
100 TYPE(timer_),
INTENT(inout) :: TIMERS
101 INTEGER,
INTENT(in) :: RENUM_SIZ
102 INTEGER,
INTENT(in) :: NIN ,ITASK,NRTM_T,ESHIFT
103 INTEGER,
INTENT(inout) :: RETRI
104 INTEGER,
INTENT(IN) :: INTHEAT
105 INTEGER,
INTENT(IN) :: IDT_THERM
106 INTEGER,
INTENT(IN) :: NODADT_THERM
107 INTEGER,
DIMENSION(NUMNOD),
INTENT(in) :: ITAB
108 INTEGER,
DIMENSION(NPARI,NINTER),
INTENT(inout) :: IPARI
109 INTEGER,
DIMENSION(NINTER+1,NSPMD+1),
INTENT(in) :: ISENDTO,IRCVFROM
110 INTEGER,
DIMENSION(RENUM_SIZ),
INTENT(inout) :: RENUM
111 INTEGER,
DIMENSION(NSPMD),
INTENT(inout) :: NSNFIOLD
112 my_real,
DIMENSION(3*NUMNOD),
INTENT(in) :: x
114 TYPE(intbuf_struct_) INTBUF_TAB
116 TYPE(MULTI_FVM_STRUCT),
INTENT(INOUT) :: MULTI_FVM
124 . I, IP0, IP1, IP2, IP21, I_SK_OLD, I_STOK1,
125 . add1, nb_n_b, noint, inacti, multimp, igap, ifq, itied
127 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
128 . I_MEM,CAND_N_OLD,IDUM1(1),NMN_L, IVIS2,NUM_IMP
130 . gap,maxbox,minbox,tzinf,
131 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
132 . c_maxl,drad,mx,my,mz,dx,dy,dz,sx,sy,sz,sx2,sy2,sz2,
133 . curv_max(nrtm_t),rdum1(1)
137 INTEGER :: FIRST, LAST
138 INTEGER :: NSN,NMN,NTY,NRTM
139 logical :: need_computation
143 call check_sorting_criteria( need_computation,nin,npari,nspmd,
144 . itask,ipari(1,nin),tt,intbuf_tab )
145 if( .not.need_computation )
return
162 inacti =ipari(22,nin)
163 multimp =ipari(23,nin)
169 ncontact=multimp*ncont
172 IF(nty==7 .AND. inacti==7)type18=.true.
174 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
176 nsnrold = ipari(24,nin)
181 gap =intbuf_tab%VARIABLES(gap_index)
182 gapmin=intbuf_tab%VARIABLES(gapmin_index)
183 gapmax=intbuf_tab%VARIABLES(gapmax_index)
185 IF(ipari(7,nin)==7) drad =intbuf_tab%VARIABLES(drad_index)
186 dgaploadp= intbuf_tab%VARIABLES
190 maxbox = intbuf_tab%VARIABLES(maxbox_index)
191 minbox = intbuf_tab%VARIABLES(minbox_index)
192 tzinf = intbuf_tab%VARIABLES(tzinf_index)
197 i_sk_old = inter_struct(nin)%I_SK_OLD
200 curv_max_max = inter_struct(nin)%CURV_MAX_MAX
202 nmn_g = inter_struct(nin)%NMN_G
211 1 ifq,inacti,nsnfiold,ipari(47,nin),nty, intbuf_tab%stfns, intbuf_tab%nsv,
213 2 itied,nmn,inter_struct,sort_comm, got_preview)
215 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
216 + ifq>0.OR.itied/=0)
THEN
218 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin,nsn,
226 cand_n_old = intbuf_tab%I_STOK(1)
234 IF(
ALLOCATED( list_remote_s_node ) )
DEALLOCATE( list_remote_s_node )
235 ALLOCATE( list_remote_s_node(nsnr) )
240 IF(ipari(63,nin) ==2 ) intbuf_tab%METRIC%ALGO = algo_voxel
243 IF(itask == 0) intbuf_tab%METRIC%TIC =
mpi_wtime()
247 intbuf_tab%METRIC%TIC = nint(100.0 * t1)
250 IF (imonm > 0 .AND. itask == 0)
CALL startime(timers,30)
252 IF(got_preview == 1)
THEN
253 CALL inter7_collision_detection(
254 1 x ,intbuf_tab%IRECTM,intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
255 2 nrtm ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
256 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,inter_struct(nin)%BOX_LIMIT_MAIN,
257 4 tzinf ,inter_struct(nin)%CAND_A ,inter_struct(nin)%CURV_MAX,
renum_siz,
258 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
259 8 intbuf_tab%STFM,ipari(21,nin),intbuf_tab%GAP_S,
260 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M,
261 b gapmin ,gapmax ,num_imp ,intbuf_tab%GAP_SL,
262 c intbuf_tab%GAP_ML,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
263 d intbuf_tab%KREMNODE,intbuf_tab%REMNODE, ipari(63,nin),drad ,
264 e itied ,intbuf_tab%CAND_F,dgaploadp,
265 f inter_struct(nin)%SIZE_CAND_A,
266 . intbuf_tab%S_KREMNODE, intbuf_tab%S_REMNODE, nspmd, numnod, inter_struct(nin),
267 . intheat, idt_therm, nodadt_therm)
269 ELSE IF(intbuf_tab%METRIC%ALGO == algo_voxel .OR. intbuf_tab%METRIC%ALGO == try_algo_voxel)
THEN
270 first = 1 + itask*(nrtm/nthread)
271 last = first + nrtm_t - 1
272 IF(itask==nthread-1) last=nrtm
273 curv_max(1:nrtm_t) = inter_struct(nin)%CURV_MAX(first:last)
277 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
278 2 nmn_g ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
279 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,inter_struct(nin)%BOX_LIMIT_MAIN ,
280 4 tzinf ,maxbox ,minbox ,inter_struct(nin)%CAND_A ,curv_max ,
281 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
282 8 intbuf_tab%STFNS,nin ,intbuf_tab%STFM(1+eshift),ipari(21,nin),intbuf_tab%GAP_S,
283 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
284 b gapmin ,gapmax ,curv_max_max ,num_imp ,intbuf_tab%GAP_SL,
285 c intbuf_tab%GAP_ML(1+eshift),intth ,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
286 d intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,itab , ipari(63,nin),drad ,
287 e itied ,intbuf_tab%CAND_F,dgaploadp,remote_s_node,list_remote_s_node,
288 f nrtm,intheat,idt_therm,nodadt_therm)
291 first = 1 + itask*(nrtm/nthread)
292 last = first + nrtm_t - 1
293 IF(itask==nthread-1) last=nrtm
294 curv_max(1:nrtm_t) = inter_struct(nin)%CURV_MAX(first:last)
296 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,inacti ,intbuf_tab%CAND_P,
297 2 nmn_g ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
298 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,inter_struct(nin)%BOX_LIMIT_MAIN ,
299 4 tzinf ,maxbox ,minbox ,inter_struct(nin)%CAND_A ,curv_max ,
300 6 nb_n_b ,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
301 8 intbuf_tab%STFNS,nin ,intbuf_tab%STFM(1+eshift),ipari(21,nin),intbuf_tab%GAP_S,
302 a nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
303 b gapmin ,gapmax ,curv_max_max ,num_imp ,intbuf_tab%GAP_SL,
304 c intbuf_tab%GAP_ML(1+eshift),intth ,itask , intbuf_tab%VARIABLES(bgapsmx_index),i_mem ,
305 d intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,itab , ipari(63,nin
306 e itied ,intbuf_tab%CAND_F,dgaploadp,intheat, idt_therm, nodadt_therm)
313#include "lockoff.inc"
320 IF(itask == 0 ) intbuf_tab%METRIC%TOC =
mpi_wtime()
324 intbuf_tab%METRIC%TOC = nint(100.0 * t1)
330 IF(i_memg == 3 .OR. i_memg == 1) intbuf_tab%METRIC%ALGO = algo_voxel
335 multimp = ipari(23,nin) + 4
340 intbuf_tab%I_STOK(1) = cand_n_old
341 multimp=ipari(23,nin)
342 ncontact=multimp*ncont
347 IF (imonm > 0 .AND. itask == 0)
CALL stoptime(timers,30)
349 IF( intbuf_tab%METRIC%ALGO == try_algo_voxel)
THEN
350 intbuf_tab%METRIC%ALGO = try_algo_bucket
351 intbuf_tab%METRIC%TOLD = intbuf_tab%METRIC%TOC - intbuf_tab%METRIC%TIC
352 ELSEIF ( intbuf_tab%METRIC%ALGO == try_algo_bucket)
THEN
353 IF( 1.2d0 * (intbuf_tab%METRIC%TOC-intbuf_tab%METRIC%TIC) < intbuf_tab%METRIC%TOLD)
THEN
354 intbuf_tab%METRIC%ALGO = algo_bucket
355 WRITE(iout,*)
"INFO: DOMAIN",ispmd,
356 .
"USES SORT2 FOR CONTACT INTERFACE",noint
358 intbuf_tab%METRIC%ALGO = algo_voxel
366 intbuf_tab%VARIABLES(maxbox_index) =
min(maxbox,intbuf_tab%VARIABLES(maxbox_index))
367 intbuf_tab%VARIABLES(minbox_index) =
min(minbox,intbuf_tab%VARIABLES(minbox_index))
368 intbuf_tab%VARIABLES(tzinf_index) =
min(tzinf,intbuf_tab%VARIABLES(tzinf_index))
369 intbuf_tab%VARIABLES(distance_index) = intbuf_tab%VARIABLES(tzinf_index)-gap
370 result = result + ild
371#include "lockoff.inc"
379 intbuf_tab%I_STOK(1) = i_sk_old
384 maxbox = intbuf_tab%VARIABLES(maxbox_index)
385 minbox = intbuf_tab%VARIABLES(minbox_index)
386 tzinf = intbuf_tab%VARIABLES(tzinf_index)
393 IF (imonm > 0)
CALL startime(timers,26)
394 intbuf_tab%VARIABLES(distance_index) = -intbuf_tab%VARIABLES(distance_index)
397 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
398 2 ipari(21,nin),nsnr ,multimp ,nty ,ipari(47,nin),
399 3 idum1 ,nsnfiold, ipari , h3d_data ,ipari(72,nin),
400 4 multi_fvm,nodadt_therm)
403 IF (imonm > 0)
CALL stoptime(timers,26)
408 IF(
ALLOCATED( list_remote_s_node ) )
DEALLOCATE( list_remote_s_node )
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)
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)