OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_sort_07.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 inter_sort_07 (timers, ipari, x, nin, itask, isendto, ircvfrom, retri, itab, nrtm_t, renum, renum_siz, nsnfiold, eshift, multi_fvm, intbuf_tab, h3d_data, inter_struct, sort_comm, intheat, idt_therm, nodadt_therm)

Function/Subroutine Documentation

◆ inter_sort_07()

subroutine inter_sort_07 ( type(timer_), intent(inout) timers,
integer, dimension(npari,ninter), intent(inout) ipari,
intent(in) x,
integer, intent(in) nin,
integer, intent(in) itask,
integer, dimension(ninter+1,nspmd+1), intent(in) isendto,
integer, dimension(ninter+1,nspmd+1), intent(in) ircvfrom,
integer, intent(inout) retri,
integer, dimension(numnod), intent(in) itab,
integer, intent(in) nrtm_t,
integer, dimension(renum_siz), intent(inout) renum,
integer, intent(in) renum_siz,
integer, dimension(nspmd), intent(inout) nsnfiold,
integer, intent(in) eshift,
type(multi_fvm_struct), intent(inout) multi_fvm,
type(intbuf_struct_) intbuf_tab,
type(h3d_database) h3d_data,
type(inter_struct_type), dimension(ninter), intent(inout) inter_struct,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm,
integer, intent(in) intheat,
integer, intent(in) idt_therm,
integer, intent(in) nodadt_therm )

Definition at line 52 of file inter_sort_07.F.

56!$COMMENT
57! INTER_SORT_07 description
58! sort computation for interface TYP07
59! INTER_SORT_07 organization :
60!
61!$ENDCOMMENT
62C============================================================================
63C M o d u l e s
64C-----------------------------------------------
65 USE timer_mod
66 USE tri7box
67 USE command_line_args_mod
68 USE message_mod
69 USE intbufdef_mod
70 USE h3d_mod
71 USE multi_fvm_mod
72 USE inter_struct_mod
73 USE inter_sorting_mod
74 USE intbufdef_mod
75 USE inter7_collision_detection_mod
76 use check_sorting_criteria_mod , only : check_sorting_criteria
77C-----------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80#include "implicit_f.inc"
81#include "comlock.inc"
82#include "spmd.inc"
83C-----------------------------------------------
84C C o m m o n B l o c k s
85C-----------------------------------------------
86#include "com01_c.inc"
87#include "com04_c.inc"
88#include "com08_c.inc"
89#include "param_c.inc"
90#include "units_c.inc"
91#include "task_c.inc"
92#include "timeri_c.inc"
93C common pour variable globale en memoire partagee
94 COMMON /i7mainc/curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
95 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,NMN_G
96 my_real :: curv_max_max
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 TYPE(TIMER_), INTENT(inout) :: TIMERS
101 INTEGER, INTENT(in) :: RENUM_SIZ ! size of RENUM
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 ! position
113
114 TYPE(INTBUF_STRUCT_) INTBUF_TAB
115 TYPE(H3D_DATABASE) :: H3D_DATA
116 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
117 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT ! structure for interface
118 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
119C-----------------------------------------------
120C L o c a l V a r i a b l e s
121C-----------------------------------------------
122 INTEGER
123 . LOC_PROC,
124 . I, IP0, IP1, IP2, IP21, I_SK_OLD, I_STOK1,
125 . ADD1, NB_N_B, NOINT, INACTI, MULTIMP, IGAP, IFQ, ITIED
126 INTEGER
127 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
128 . I_MEM,CAND_N_OLD,IDUM1(1),NMN_L, IVIS2,NUM_IMP
129 my_real
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)
134 my_real :: dgaploadp
135 REAL T1 !elapsed time in smp
136 LOGICAL TYPE18
137 INTEGER :: FIRST, LAST
138 INTEGER :: NSN,NMN,NTY,NRTM
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 ! --------------
147
148 num_imp = 0
149
150 i_mem = 0
151 i_memg = 0
152 nmn_g = 0
153 nmn_l = 0
154C
155 nrtm =ipari(4,nin)
156 nsn =ipari(5,nin)
157 nmn =ipari(6,nin)
158 nty =ipari(7,nin)
159 ivis2 =ipari(14,nin)
160 noint =ipari(15,nin)
161 ncont =ipari(18,nin)
162 inacti =ipari(22,nin)
163 multimp =ipari(23,nin)
164 ifq =ipari(31,nin)
165 intth =ipari(47,nin)
166 itied =ipari(85,nin)
167
168 loc_proc=ispmd+1
169 ncontact=multimp*ncont
170
171 type18=.false.
172 IF(nty==7 .AND. inacti==7)type18=.true.
173
174 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
175 . itied/=0)THEN
176 nsnrold = ipari(24,nin)
177 ELSE
178 nsnrold = 0
179 ENDIF
180
181 gap =intbuf_tab%VARIABLES(gap_index)
182 gapmin=intbuf_tab%VARIABLES(gapmin_index)
183 gapmax=intbuf_tab%VARIABLES(gapmax_index)
184 drad = zero
185 IF(ipari(7,nin)==7) drad =intbuf_tab%VARIABLES(drad_index)
186 dgaploadp= intbuf_tab%VARIABLES(bgapemx_index)
187C -------------------------------------------------------------
188 retri = 1
189C -------------------------------------------------------------
190 maxbox = intbuf_tab%VARIABLES(maxbox_index)
191 minbox = intbuf_tab%VARIABLES(minbox_index)
192 tzinf = intbuf_tab%VARIABLES(tzinf_index)
193 curv_max_max = zero
194
195 CALL my_barrier
196
197 i_sk_old = inter_struct(nin)%I_SK_OLD
198!$OMP SINGLE
199 nsnr = 0
200 curv_max_max = inter_struct(nin)%CURV_MAX_MAX
201 result = 0
202 nmn_g = inter_struct(nin)%NMN_G
203!$OMP END SINGLE
204
205 IF(nspmd > 1) THEN
206 ! ---------------------------
207 IF(itask==0)THEN
208 ! ---------------------------
209 ! send/rcv the secondary node data
210 CALL spmd_cell_exchange(timers, nin,isendto,ircvfrom,nsn,nsnr,ipari(21,nin),
211 1 ifq,inacti,nsnfiold,ipari(47,nin),nty, intbuf_tab%stfns, intbuf_tab%nsv,
212 2 nrtm, x,
213 2 itied,nmn,inter_struct,sort_comm, got_preview)
214C
215 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
216 + ifq>0.OR.itied/=0)THEN
217 CALL spmd_rnumcd(
218 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin,nsn,
219 2 nsnfiold ,nsnrold)
220 END IF
221 ! ---------------------------
222 ENDIF
223 END IF
224 ! Voxel remote secondary nodes
225 ! ---------------------------
226 cand_n_old = intbuf_tab%I_STOK(1)
227 40 CONTINUE
228C
229 ild = 0
230 nb_n_b = 1
231
232 50 CALL my_barrier
233 IF(itask==0) THEN
234 IF(ALLOCATED( list_remote_s_node ) ) DEALLOCATE( list_remote_s_node )
235 ALLOCATE( list_remote_s_node(nsnr) )
236 remote_s_node = 0
237 ENDIF
238 CALL my_barrier
239
240 IF(ipari(63,nin) ==2 ) intbuf_tab%METRIC%ALGO = algo_voxel
241
242#ifdef MPI
243 IF(itask == 0) intbuf_tab%METRIC%TIC = mpi_wtime()
244#else
245 IF(itask == 0) THEN
246 CALL cpu_time(t1)
247 intbuf_tab%METRIC%TIC = nint(100.0 * t1)
248 ENDIF
249#endif
250 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,30)
251C
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)
268
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)
274
275
276 CALL i7buce_vox(
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)
289
290 ELSE
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)
295 CALL i7buce(
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),drad ,
306 e itied ,intbuf_tab%CAND_F,dgaploadp,intheat, idt_therm, nodadt_therm)
307
308 ENDIF
309
310 IF (i_mem >= 1 )THEN
311#include "lockon.inc"
312 i_memg = i_mem
313#include "lockoff.inc"
314 ENDIF
315
316C New barrier needed for Dynamic MultiMP
317 CALL my_barrier
318
319#ifdef MPI
320 IF(itask == 0 ) intbuf_tab%METRIC%TOC = mpi_wtime()
321#else
322 IF(itask == 0) THEN
323 CALL cpu_time(t1)
324 intbuf_tab%METRIC%TOC = nint(100.0 * t1)
325 ENDIF
326#endif
327
328
329 IF(i_memg /=0)THEN
330 IF(i_memg == 3 .OR. i_memg == 1) intbuf_tab%METRIC%ALGO = algo_voxel
331C CARE : JINBUF & JBUFIN array are reallocated in
332C UPGRADE_MULTIMP routine !!!!
333
334!$OMP SINGLE
335 multimp = ipari(23,nin) + 4
336 CALL upgrade_multimp(nin,multimp,intbuf_tab)
337!$OMP END SINGLE
338 i_mem = 0
339 i_memg = 0
340 intbuf_tab%I_STOK(1) = cand_n_old
341 multimp=ipari(23,nin)
342 ncontact=multimp*ncont
343 GOTO 40
344 ENDIF
345
346C
347 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,30)
348 IF( itask == 0) THEN
349 IF( intbuf_tab%METRIC%ALGO == try_algo_voxel) THEN ! if test phase
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
357 ELSE
358 intbuf_tab%METRIC%ALGO = algo_voxel
359c WRITE(IOUT,*) "INFO: DOMAIN",ISPMD,
360c . "USES SORT1 FOR CONTACT INTERFACE",NOINT
361 ENDIF
362 ENDIF
363 ENDIF
364C
365#include "lockon.inc"
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"
372C--------------------------------------------------------------
373C--------------------------------------------------------------
374 CALL my_barrier
375 IF (result/=0) THEN
376 CALL my_barrier
377 IF (itask==0) THEN
378C utile si on revient
379 intbuf_tab%I_STOK(1) = i_sk_old
380 result = 0
381 ENDIF
382 CALL my_barrier
383 ild = 0
384 maxbox = intbuf_tab%VARIABLES(maxbox_index)
385 minbox = intbuf_tab%VARIABLES(minbox_index)
386 tzinf = intbuf_tab%VARIABLES(tzinf_index)
387 GOTO 50
388 ENDIF
389C mise a - de dist temporairement pour reperage dans partie frontiere
390 IF(nspmd>1)THEN
391C mono tache
392!$OMP SINGLE
393 IF (imonm > 0) CALL startime(timers,26)
394 intbuf_tab%VARIABLES(distance_index) = -intbuf_tab%VARIABLES(distance_index)
395C
396 CALL spmd_tri7gat(
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)
401 ipari(24,nin) = nsnr
402
403 IF (imonm > 0) CALL stoptime(timers,26)
404!$OMP END SINGLE
405 END IF
406
407 IF(itask==0) THEN
408 IF(ALLOCATED( list_remote_s_node ) ) DEALLOCATE( list_remote_s_node )
409 ENDIF
410 CALL my_barrier
411
412 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
min
#define min(a, b)
Definition macros.h:20
mpi_wtime
double precision function mpi_wtime()
Definition mpi.f:561
command_line_args_mod
Definition command_line_args.F:31
command_line_args_mod::got_preview
integer got_preview
Definition command_line_args.F:32
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
inter_struct_mod
Definition inter_struct_mod.F:49
message_mod
Definition message_mod.F:1249
renum_siz
subroutine renum_siz(ipari, rnum_siz)
Definition renum_siz.F:29
spmd_cell_exchange
subroutine spmd_cell_exchange(timers, nin, isendto, ircvfrom, nsn, nsnr, igap, ifq, inacti, nsnfiold, intth, ityp, stfns, nsv, nrtm, x, itied, nmn, inter_struct, sort_comm, got_preview)
Definition spmd_cell_exchange.F:48
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
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