OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inttri.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "macro.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "intstamp_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "warn_c.inc"
#include "units_c.inc"
#include "inter22.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inttri (timers, ipari, x, w, errors, v, ms, in, iad_elem, fr_elem, vr, isendto, irecvfrom, newfront, itask, wag, dt2t, itab, neltst, ityptst, weight, intlist, nbintc, kinet, dretri, islen7, irlen7, islen11, irlen11, temp, igrbric, igrsh3n, eminx, ixs, ixs16, ixs20, islen17, irlen17, irlen7t, islen7t, num_imp, ind_imp, intstamp, thknod, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, renum, nsnfiold, xslv, xmsr, vslv, vmsr, size_t, nodnx_sms, dxancg, ikine, diag_sms, count_remslv, count_remslve, ale_connectivity, ixtg, sensors, delta_pmax_gap, intbuf_tab, delta_pmax_gap_node, iad_frnor, fr_nor, nb25_candt, nb25_impct, nb25_dst1, nb25_dst2, intlist25, iad_fredg, fr_edg, main_proc, nativ_sms, i_opt_stok, multi_fvm, iparg, elbuf_tab, h3d_data, t2main_sms, lskyi_sms_new, forneqs, int7itied, idel7nok_sav, maxdgap, t2fac_sms, icodt, iskew, fskyn25, addcsrect, procnor, inter_struct, sort_comm, renum_siz, nodnx_sms_siz, temp_siz, interfaces, glob_therm, component)

Function/Subroutine Documentation

◆ inttri()

subroutine inttri ( type(timer_), intent(inout) timers,
integer, dimension(npari,*) ipari,
dimension(3*numnod), target x,
dimension(3,numnod), target w,
integer, intent(inout) errors,
dimension(3*numnod), target v,
target ms,
in,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
vr,
integer, dimension(nspmd+1,*) isendto,
integer, dimension(nspmd+1,*) irecvfrom,
integer, dimension(*) newfront,
integer itask,
wag,
dt2t,
integer, dimension(*) itab,
integer neltst,
integer ityptst,
integer, dimension(*) weight,
integer, dimension(*) intlist,
integer nbintc,
integer, dimension(*), target kinet,
dretri,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
temp,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrsh3n) igrsh3n,
eminx,
integer, dimension(*) ixs,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer, dimension(*) num_imp,
integer, dimension(*) ind_imp,
type(intstamp_data), dimension(*) intstamp,
thknod,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
integer, dimension(*) renum,
integer, dimension(nspmd) nsnfiold,
xslv,
xmsr,
vslv,
vmsr,
size_t,
integer, dimension(nodnx_sms_siz) nodnx_sms,
dxancg,
integer, dimension(numnod) ikine,
diag_sms,
integer, dimension(*) count_remslv,
integer, dimension(*) count_remslve,
type(t_ale_connectivity), intent(in) ale_connectivity,
integer, dimension(nixtg,*) ixtg,
type (sensors_), intent(in) sensors,
delta_pmax_gap,
type(intbuf_struct_), dimension(ninter) intbuf_tab,
integer, dimension(*) delta_pmax_gap_node,
integer, dimension(ninter25,*) iad_frnor,
integer, dimension(*) fr_nor,
integer, dimension(parasiz) nb25_candt,
integer, dimension(parasiz) nb25_impct,
integer, dimension(parasiz) nb25_dst1,
integer, dimension(parasiz) nb25_dst2,
integer, dimension(*) intlist25,
integer, dimension(ninter25,*) iad_fredg,
integer, dimension(*) fr_edg,
integer, dimension(*) main_proc,
integer, dimension(*) nativ_sms,
integer, dimension(ninter) i_opt_stok,
type(multi_fvm_struct), intent(inout), target multi_fvm,
integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup) elbuf_tab,
type(h3d_database) h3d_data,
integer, dimension(6,*) t2main_sms,
integer lskyi_sms_new,
forneqs,
integer, intent(in) int7itied,
integer idel7nok_sav,
maxdgap,
t2fac_sms,
integer, dimension(*), intent(in) icodt,
integer, dimension(*), intent(in) iskew,
real*4, dimension(3,*) fskyn25,
integer, dimension(*) addcsrect,
integer, dimension(*) procnor,
type(inter_struct_type), dimension(ninter), intent(inout) inter_struct,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm,
integer, intent(in) renum_siz,
integer, intent(in) nodnx_sms_siz,
integer, intent(in) temp_siz,
type (interfaces_), intent(in) interfaces,
type (glob_therm_), intent(in) glob_therm,
type(component_), dimension(ninter), intent(inout) component )
Parameters
[in,out]errorsnumber of interfaces that could not be sorted

Definition at line 106 of file inttri.F.

133C-----------------------------------------------
134C M o d u l e s
135C-----------------------------------------------
136 USE spmd_mod, ONLY : spmd_barrier
137 USE timer_mod
138 USE elbufdef_mod
139 USE intstamp_mod
140 USE tri7box
141 USE intbufdef_mod
142 USE i22tri_mod
143 USE i22bufbric_mod
144 USE multi_fvm_mod
145 USE h3d_mod
146 USE metric_mod
147 USE groupdef_mod
148 USE ale_connectivity_mod
149 USE inter_struct_mod
150 USE inter_sorting_mod
151 USE sensor_mod
152 USE outputs_mod
153 USE interfaces_mod
154 USE glob_therm_mod
155 USE int18_law151_nsv_shift_mod , ONLY : int18_law151_nsv_shift
156C-----------------------------------------------
157C I m p l i c i t T y p e s
158C-----------------------------------------------
159#include "implicit_f.inc"
160#include "comlock.inc"
161#include "macro.inc"
162C-----------------------------------------------
163C C o m m o n B l o c k s
164C-----------------------------------------------
165#include "com01_c.inc"
166#include "com04_c.inc"
167#include "com08_c.inc"
168#include "impl1_c.inc"
169#include "intstamp_c.inc"
170#include "param_c.inc"
171#include "task_c.inc"
172#include "timeri_c.inc"
173#include "warn_c.inc"
174#include "units_c.inc"
175#include "inter22.inc"
176C-----------------------------------------------
177C D u m m y A r g u m e n t s
178C-----------------------------------------------
179 TYPE(TIMER_), INTENT(inout) :: TIMERS
180 INTEGER, INTENT(INOUT) :: ERRORS !< number of interfaces that could not be sorted
181 INTEGER, INTENT(in) :: NODNX_SMS_SIZ
182 INTEGER IPARI(NPARI,*), IXS(*), IXS16(*), IXS20(*),
183 . ITAB(*),
184 . NEWFRONT(*),NBINTC,INTLIST(*),
185 . ISENDTO(NSPMD+1,*),IRECVFROM(NSPMD+1,*),
186 . ITASK,NELTST ,ITYPTST,WEIGHT(*),
187 . IAD_ELEM(2,*) ,FR_ELEM(*),
188 . ISLEN7, IRLEN7, ISLEN11, IRLEN11, ISLEN17 ,IRLEN17,
189 . IRLEN7T ,ISLEN7T,IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,
190 . IRLEN20E, ISLEN20E,
191 . IND_IMP(*),NUM_IMP(*),RENUM(*), NSNFIOLD(NSPMD),
192 . NODNX_SMS(NODNX_SMS_SIZ),IKINE(NUMNOD),I_MEM,COUNT_REMSLV(*),
193 . COUNT_REMSLVE(*), IXTG(NIXTG,*),DELTA_PMAX_GAP_NODE(*),
194 . IAD_FRNOR(NINTER25,*), FR_NOR(*), IAD_FREDG(NINTER25,*), FR_EDG(*),
195 . NB25_CANDT(PARASIZ), NB25_IMPCT(PARASIZ),
196 . NB25_DST1(PARASIZ), NB25_DST2(PARASIZ), IPARG(NPARG,*),
197 . INTLIST25(*), MAIN_PROC(*), NATIV_SMS(*), I_OPT_STOK(NINTER),
198 . T2MAIN_SMS(6,*), LSKYI_SMS_NEW, IDEL7NOK_SAV,
199 . ADDCSRECT(*), PROCNOR(*)
200 INTEGER, INTENT(IN) :: ICODT(*), ISKEW(*)
201! INT7ITIED : check if an interface type 7 with ITIED /= 0 is used
202! in order to force the communication of a list of candidate nodes
203! INT7ITIED = 0 type 7 + ITIED/=0 not used
204! INT7ITIED = 1 type 7 + ITIED/=0 used
205 INTEGER, INTENT(IN) :: INT7ITIED
206 INTEGER, DIMENSION(*), TARGET :: KINET
207 INTEGER, INTENT(in) :: TEMP_SIZ
208 TYPE(INTSTAMP_DATA) INTSTAMP(*)
209 my_real
210 . wag(*),
211 . vr(3,*),in(*),dt2t,dist, dretri(*), temp(temp_siz), eminx(*),
212 . thknod(*),delta_pmax_gap(ninter),
213 . xslv(18,ninter),xmsr(12,ninter),x21msr(3,nintstamp),
214 . vslv(6,ninter),vmsr(6,ninter),v21msr(3,nintstamp),
215 . size_t(ninter),dxancg(3,*), diag_sms(*),
216 . forneqs(*), maxdgap(ninter), t2fac_sms(*)
217 my_real, TARGET :: x(3*numnod),v(3*numnod),w(3,numnod)
218 my_real, DIMENSION(*), TARGET :: ms
219 real*4 fskyn25(3,*)
220
221 TYPE(INTBUF_STRUCT_),DIMENSION(NINTER) :: INTBUF_TAB
222 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT), TARGET :: MULTI_FVM
223 TYPE(ELBUF_STRUCT_) ,DIMENSION(NGROUP) :: ELBUF_TAB
224 TYPE(H3D_DATABASE) :: H3D_DATA
225 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
226 INTEGER, INTENT(in) :: RENUM_SIZ
227 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT ! structure for interface
228 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
229 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
230 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
231C-----------------------------------------------
232 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
233 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
234 TYPE (glob_therm_) ,INTENT(IN) :: GLOB_THERM
235 type(component_), dimension(ninter), intent(inout) :: component
236C-----------------------------------------------
237C L o c a l V a r i a b l e s
238C-----------------------------------------------
239 INTEGER N, KK,LL, RETRI, NBLIST,NSENSOR,
240 . IAD17, IGN, IGE, NME, NMES,I,J,K,
241 . IDUM, IADI, ISTAMP, NRTM_T, NME_T, NEDGE_T, ESHIFT, SSHIFT, MULTIMP,
242 . ISENS,NBF,NBL,IB, NIN,NSNE_MAX,NFIC,L_FIC,NNOD3,NSNE3,
243 . NBINTC21, SIZE, NRTM_FE_T, NRTM_IGE_T, ITHK
244 my_real pct1, ts,delta_pmax_dgap(ninter),len
245 INTEGER NB_STOK_N(PARASIZ),NB_JLT(PARASIZ),RETRI21(NINTER),NBCUT,
246 . INTLIST21(NINTSTAMP)
247 SAVE nb_stok_n,nb_jlt,nsne_max,nnod3
248 my_real, DIMENSION(:),ALLOCATABLE, TARGET :: xe,ve
249 my_real, DIMENSION(:),ALLOCATABLE, TARGET :: x_ige,v_ige
250 my_real, DIMENSION(:),POINTER :: ptr_x,ptr_v,ptr_ms
251 INTEGER, DIMENSION(:),POINTER :: PTR_KINET
252 my_real :: bid
253 INTEGER :: IBRIC, NBRIC, II, INOD, NODEID, ISU1, IAD, INACTI
254 LOGICAL :: M151_ALLOC, TYPE18
255 SAVE xe,ve,m151_alloc
256 SAVE x_ige,v_ige,max_ige,size_x_ige
257 INTEGER :: MAX_IGE,SIZE_X_IGE
258 INTEGER :: NB_INTER_SORTED ! number of interfaces that need to be sorted
259 INTEGER, DIMENSION(NBINTC) :: LIST_INTER_SORTED ! list of interfaces that need to be sorted
260 INTEGER :: NTY
261C-----------------------------------------------
262 nsensor = sensors%NSENSOR
263C Single region
264 i_mem = 0
265!$OMP SINGLE
266 delta_pmax_gap_node(1:ninter)=0
267
268 IF (imonm > 0) THEN
269 IF(imonm == 2 .AND. nspmd > 1)THEN
270 CALL startime(timers,56)
271 CALL spmd_barrier()
272 CALL stoptime(timers,56)
273 END IF
274 CALL startime(timers,15)
275 ENDIF
276
277 !Init variable globale interface
278 DO kk=1,nbintc
279 n = intlist(kk)
280 delta_pmax_gap(n)=zero
281 maxdgap(n)=-ep30
282 xslv( 1,n)= -ep30
283 xslv( 2,n)= -ep30
284 xslv( 3,n)= -ep30
285 xslv( 4,n)= ep30
286 xslv( 5,n)= ep30
287 xslv( 6,n)= ep30
288 xslv( 7,n)= -ep30
289 xslv( 8,n)= -ep30
290 xslv( 9,n)= -ep30
291 xslv(10,n)= ep30
292 xslv(11,n)= ep30
293 xslv(12,n)= ep30
294 xslv(13,n)= -ep30
295 xslv(14,n)= -ep30
296 xslv(15,n)= -ep30
297 xslv(16,n)= ep30
298 xslv(17,n)= ep30
299 xslv(18,n)= ep30
300
301 xmsr( 1,n)= -ep30
302 xmsr( 2,n)= -ep30
303 xmsr( 3,n)= -ep30
304 xmsr( 4,n)= ep30
305 xmsr( 5,n)= ep30
306 xmsr( 6,n)= ep30
307 xmsr( 7,n)= -ep30
308 xmsr( 8,n)= -ep30
309 xmsr( 9,n)= -ep30
310 xmsr(10,n)= ep30
311 xmsr(11,n)= ep30
312 xmsr(12,n)= ep30
313
314 vslv(1,n)= -ep30
315 vslv(2,n)= -ep30
316 vslv(3,n)= -ep30
317 vslv(4,n)= ep30
318 vslv(5,n)= ep30
319 vslv(6,n)= ep30
320 vmsr(1,n)= -ep30
321 vmsr(2,n)= -ep30
322 vmsr(3,n)= -ep30
323 vmsr(4,n)= ep30
324 vmsr(5,n)= ep30
325 vmsr(6,n)= ep30
326 size_t(n)=zero
327 delta_pmax_dgap(n)=zero
328 END DO
329 ! idem pour interface 21
330 DO kk=1,nintstamp
331 n = intstamp(kk)%NOINTER
332 xslv(1,n)= -ep30
333 xslv(2,n)= -ep30
334 xslv(3,n)= -ep30
335 xslv(4,n)= ep30
336 xslv(5,n)= ep30
337 xslv(6,n)= ep30
338 xmsr(1,n)= -ep30
339 xmsr(2,n)= -ep30
340 xmsr(3,n)= -ep30
341 xmsr(4,n)= ep30
342 xmsr(5,n)= ep30
343 xmsr(6,n)= ep30
344 vslv(1,n)= -ep30
345 vslv(2,n)= -ep30
346 vslv(3,n)= -ep30
347 vslv(4,n)= ep30
348 vslv(5,n)= ep30
349 vslv(6,n)= ep30
350 vmsr(1,n)= -ep30
351 vmsr(2,n)= -ep30
352 vmsr(3,n)= -ep30
353 vmsr(4,n)= ep30
354 vmsr(5,n)= ep30
355 vmsr(6,n)= ep30
356 END DO
357C-----int24 edge pourait etre optimis e apres
358 nsne_max=0
359 max_ige = 0
360 DO kk=1,nbintc
361C
362 n = intlist(kk)
363 nty =ipari(7,n)
364C Look if interface is activated
365 isens = 0
366 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25)
367 . isens = ipari(64,n)
368 IF (isens > 0) THEN ! Interface activated by sensor
369 ts = sensors%SENSOR_TAB(isens)%TSTART
370 ELSE
371 ts = tt
372 ENDIF
373 IF(nty == 24.AND.tt>=ts)THEN
374 nsne_max = max(nsne_max,ipari(55,n))
375C--
376ccc NFIC = 3
377ccc CALL I24XVFIC_UPD(IPARI(1,N),INTBUF_TAB(N),X ,V ,NFIC ,ITAB)
378 END IF
379
380 IF(intbuf_tab(n)%S_NIGE/=0) THEN
381 max_ige = max(max_ige,intbuf_tab(n)%S_NIGE)
382 ENDIF
383 END DO
384 IF (nsne_max>0 ) THEN
385 l_fic=3*(nsne_max+numnod)
386 nnod3 =3*numnod
387 ALLOCATE(xe(l_fic),ve(l_fic))
388 xe(1:nnod3) = x(1:nnod3)
389 ve(1:nnod3) = v(1:nnod3)
390 END IF
391
392 IF(max_ige>0) THEN
393 ALLOCATE( x_ige(3*(numnod+max_ige)) )
394 ALLOCATE( v_ige(3*(numnod+max_ige)) )
395 x_ige(1:3*numnod) = x(1:3*numnod)
396 v_ige(1:3*numnod) = v(1:3*numnod)
397 size_x_ige = 3*(numnod+max_ige)
398 ELSE
399 ALLOCATE( x_ige(0) )
400 ALLOCATE( v_ige(0) )
401 size_x_ige = 0
402 ENDIF
403
404C end of single region
405!$OMP END SINGLE
406
407 ! If law151+int18 : shift NSV array
408 IF( multi_fvm%IS_INT18_LAW151 ) THEN
409 CALL int18_law151_nsv_shift('+',itask,nthread,multi_fvm,ipari,intbuf_tab,npari,ninter,numnod)
410 CALL my_barrier()
411 ENDIF
412
413
414C Inter Type 21 ithe=2 : prepare to communicate tri criteria
415 nbintc21 = 0
416 DO kk=1,nintstamp
417 n = intstamp(kk)%NOINTER
418 IF (ipari(47,n)==2) THEN
419 nbintc21 = nbintc21 + 1
420 intlist21(nbintc21) = kk
421 ENDIF
422 END DO
423
424C Stiffness based on mass and time step for Int 24/25
425C Cyle 1 : update secondary and main nodal masses
426 IF(ncycle == 1 ) THEN
427 DO kk=1,nbintc
428 n = intlist(kk)
429 nty = ipari(7,n)
430 IF (nty == 24 .OR. nty == 25 ) THEN
431 IF(ipari(97,n) > 0.AND.ipari(98,n)==2) THEN
432 CALL intmass_update( n ,ipari(1,n), intbuf_tab(n), ms )
433 ENDIF
434 ENDIF
435 ENDDO
436 ENDIF
437C
438C Critere de retri interface
439C
440 IF(itask==0)CALL startime(timers,120)
441 DO kk=1,nbintc
442 n = intlist(kk)
443 nty = ipari(7,n)
444 inacti = ipari(22,n)
445 type18 = .false.
446 IF(nty == 7 .AND. inacti ==7)type18=.true.
447 IF(imonm > 0 ) THEN
448 IF(itask == 0) CALL int_startime(intbuf_tab(n)%METRIC,i_main_crit_tri)
449 ENDIF
450!$OMP ATOMIC WRITE
451 ipari(29,n) = 0
452!$OMP END ATOMIC
453 nty =ipari(7,n)
454 ! Look if interface is activated
455 isens = 0
456 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
457 IF (isens > 0) THEN ! Interface activated by sensor
458 ts = sensors%SENSOR_TAB(isens)%TSTART
459 ELSE
460 ts = tt
461 ENDIF
462C-----------------------------------------------
463 IF((nty == 7.AND.tt>=ts).OR.nty == 10.OR.nty == 18)THEN
464C-----------------------------------------------
465 i7kglo = 1
466 !IF(INTER18_AUTOPARAM == 1)I7KGLO = 0
467 IF(intbuf_tab(n)%S_NIGE/=0) THEN
468 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
469 ptr_x => x_ige
470 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
471 ptr_v => v_ige
472 ELSEIF (multi_fvm%IS_USED .AND. type18) THEN
473 ptr_x => multi_fvm%X_APPEND
474 ptr_v => multi_fvm%V_APPEND
475 ELSE
476 ptr_x => x
477 ptr_v => v
478 ENDIF
479 CALL i7main_crit_tri(
480 1 ipari ,ptr_x ,n ,
481 2 itask ,ptr_v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
482 3 vmsr(1,n),intbuf_tab(n))
483C-----------------------------------------------
484 ELSEIF(nty == 24.AND.tt>=ts)THEN
485C-----------------------------------------------
486 i7kglo = 1
487C IPARI(4,N) = NRTM ; IPARI(5,N)=NSN
488C-------not necessary but should modify I24BUCE_CRIT
489C NSNE = IPARI(55,N)
490C IF (NSNE >0 ) THEN
491C CALL MY_BARRIER
492C!$OMP SINGLE
493C XE(NNOD3+1:(NNOD3+NSNE3)) = INTBUF_TAB(N)%XFIC(1:NSNE3)
494C VE(NNOD3+1:(NNOD3+NSNE3)) = INTBUF_TAB(N)%VFIC(1:NSNE3)
495C!$OMP END SINGLE
496C CALL I24MAIN_CRIT_TRI(
497C 1 IPARI ,INTBUF_TAB(N),XE ,N ,
498C 2 ITASK ,VE ,XSLV(1,N) ,XMSR(1,N),VSLV(1,N),
499C 3 VMSR(1,N),DELTA_PMAX_GAP(N),DELTA_PMAX_DGAP(N))
500C ELSE
501 CALL i24main_crit_tri(
502 1 ipari ,intbuf_tab(n),x ,n ,
503 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
504 3 vmsr(1,n),delta_pmax_gap(n),delta_pmax_dgap(n),
505 4 delta_pmax_gap_node(n),itab)
506C END IF !(NSNE_MAX>0 ) THEN
507
508C-----------------------------------------------
509 ELSEIF(nty == 25.AND.tt>=ts)THEN
510C-----------------------------------------------
511!$OMP ATOMIC WRITE
512 i7kglo = 1
513!$OMP END ATOMIC
514C IPARI(4,N) = NRTM ; IPARI(5,N)=NSN
515 CALL i25main_crit_tri(
516 1 ipari ,intbuf_tab(n),x ,n ,
517 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
518 3 vmsr(1,n),delta_pmax_gap(n),delta_pmax_dgap(n),
519 4 delta_pmax_gap_node(n),itab)
520C
521C ITHK = 1 : main gap should be modified as per change in thickness
522 ithk = ipari(91,n)
523 IF(ithk == 1) THEN
524 CALL i25main_gap(
525 1 ipari ,intbuf_tab(n) ,n ,itask ,
526 2 thknod, maxdgap(n))
527 ELSE
528!$OMP ATOMIC WRITE
529 maxdgap(n) = zero
530!$OMP END ATOMIC
531 ENDIF
532C
533C-----------------------------------------------
534 ELSEIF(nty == 11.AND.tt>=ts)THEN
535C-----------------------------------------------
536 i7kglo = 1
537 CALL i11main_crit_tri(
538 1 ipari ,x ,n ,
539 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
540 3 vmsr(1,n) ,intbuf_tab(n))
541C-----------------------------------------------
542 ELSEIF(nty == 17)THEN
543C-----------------------------------------------
544 IF(ipari(33,n) == 0)THEN
545C
546 iad17=1
547 DO k=1,n-1
548 nty =ipari(7,k)
549 IF(ipari(7,k) == 17.AND.ipari(33,k) == 0)THEN
550 ign =ipari(36,k)
551 ige =ipari(34,k)
552 nmes =igrbric(ign)%NENTITY
553 nme =igrbric(ige)%NENTITY
554 iad17 = iad17+6*(nme+nmes)
555 END IF
556 END DO
557C
558 i7kglo = 1
559 ign =ipari(36,n)
560 ige =ipari(34,n)
561 nmes =igrbric(ign)%NENTITY
562 nme =igrbric(ige)%NENTITY
563 CALL i17main_crit_tri(
564 1 ipari,intbuf_tab(n),x ,n ,
565 2 itask,igrbric ,eminx(iad17),nme,
566 3 nmes ,xslv(1,n) ,xmsr(1,n) , size_t ,ixs,
567 4 ixs16,ixs20 )
568 END IF
569C-----------------------------------------------
570 ELSEIF(nty == 20)THEN
571C-----------------------------------------------
572 i7kglo = 1
573C IPARI(4,N) = NRTM ; IPARI(5,N)=NSN
574 CALL i20main_crit_tri(
575 1 ipari ,x ,n ,
576 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
577 3 vmsr(1,n),ms ,dxancg ,ikine ,diag_sms ,
578 4 intbuf_tab(n) ,h3d_data)
579C-----------------------------------------------
580 ELSEIF(nty == 22)THEN
581C-----------------------------------------------
582 !
583C-----------------------------------------------
584 ELSEIF(nty == 23)THEN
585C-----------------------------------------------
586 i7kglo = 1
587C IPARI(4,N) = NRTM ; IPARI(5,N)=NSN
588 CALL i7main_crit_tri(
589 1 ipari ,x ,n ,
590 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
591 3 vmsr(1,n),intbuf_tab(n))
592C-----------------------------------------------
593 ENDIF
594C-----------------------------------------------
595 IF(imonm > 0 ) THEN
596 IF(itask == 0) CALL int_stoptime(intbuf_tab(n)%METRIC,i_main_crit_tri)
597 ENDIF
598 ENDDO
599C
600 DO kk=1,nintstamp
601 n = intstamp(kk)%NOINTER
602 isens = ipari(64,n) ! INTERFACE SENSOR NUMBER
603 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
604 ts = sensors%SENSOR_TAB(isens)%TSTART
605 ELSE
606 ts = tt
607 ENDIF
608 x21msr(1:3,kk) = zero
609 v21msr(1:3,kk) = zero
610 IF(tt>=ts)THEN ! INTERFACE SENSOR IS ACTIVATED
611 ipari(29,n) = 0
612 nty =ipari(7,n)
613 i7kglo = 1
614 CALL i21main_gap(
615 1 ipari ,intbuf_tab(n),n ,itask ,
616 2 thknod)
617C
618C remet a 0 le segment main le plus proche (IRTLM): avt barrier
619 CALL i21reset(
620 1 ipari ,intbuf_tab(n),n ,itask )
621C
622 CALL i21main_crit_tri(
623 1 ipari ,intbuf_tab(n),x ,n ,
624 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
625 3 vmsr(1,n),intstamp(kk) ,x21msr(1,kk) ,v21msr(1,kk))
626 ENDIF
627 ENDDO
628C
629 CALL my_barrier
630C
631C Partie non parallele smt
632C
633!$OMP SINGLE
634
635 IF (imonm > 0) THEN
636 CALL stoptime(timers,15)
637 IF(imonm == 2 .AND. nspmd > 1)THEN
638 CALL startime(timers,57)
639 CALL spmd_barrier()
640 CALL stoptime(timers,57)
641 END IF
642 CALL startime(timers,16)
643 ENDIF
644C
645C Communication critere de tri
646C
647 CALL intcrit(timers,
648 1 errors, ipari ,newfront ,isendto ,nsensor ,
649 2 irecvfrom ,dt2t ,neltst ,ityptst ,itab ,
650 3 xslv ,xmsr ,vslv ,vmsr ,intlist ,
651 4 nbintc ,size_t ,sensors%SENSOR_TAB,delta_pmax_gap,
652 5 intbuf_tab,delta_pmax_gap_node,idel7nok_sav,maxdgap,v)
653
654
655C
656C (barriere par interface)
657 IF(nintstamp/=0)THEN
658 CALL i21_icrit(
659 1 intbuf_tab ,ipari ,dt2t ,neltst ,nsensor ,
660 2 ityptst ,xslv ,xmsr ,vslv ,vmsr ,
661 3 intstamp ,x21msr ,v21msr,sensors%SENSOR_TAB,nbintc21 ,
662 4 intlist21)
663 END IF
664C
665 IF (imonm > 0) THEN
666 CALL stoptime(timers,16)
667 CALL startime(timers,17)
668 ENDIF
669
670 IF(tt>zero.AND.int7itied/=0) THEN
671 CALL spmd_i7itied_cand(1,nbintc,ipari,intlist,intbuf_tab)
672 CALL spmd_i7itied_cand(2,nbintc,ipari,intlist,intbuf_tab)
673 ENDIF
674
675C Fin Partie non parallele smt
676!$OMP END SINGLE
677
678 IF(impl_s/=1)THEN
679
680 IF((nspmd>1.AND.itask==0).AND.(h3d_data%N_SCAL_CSE_FRIC > 0.OR.ninefric > 0).AND.tt > zero) THEN
681 CALL spmd_exch_sorting_efric(
682 1 ipari ,intlist ,nbintc ,islen7 ,irlen7 ,
683 2 irlen7t ,islen7t ,irlen20 ,islen20,irlen20t,
684 3 islen20t,intbuf_tab,h3d_data )
685 ENDIF
686 ENDIF
687
688 IF(itask==0)CALL stoptime(timers,120)
689
690 retri = 0
691 ! ------------------------
692 ! new sorting algorithm
693 IF(itask==0) need_to_sort = 0
694 ! find the list of interface (for the moment : type7) that needs to be sorted
695 CALL inter_check_sort( itask,need_to_sort,nbintc,intlist,ipari,nsensor,
696 . intbuf_tab,sensors%SENSOR_TAB,nb_inter_sorted,list_inter_sorted,inter_struct)
697 ! globalize NEED_TO_SORT : 1= one or several interface(s) must be sorted
698 IF(nspmd>1.AND.itask==0) CALL spmd_allglob_isum9(need_to_sort,1)
699 CALL my_barrier()
700
701 ! ------------------------
702
703 ! ------------------------
704 ! explicit part
705 IF(impl_s/=1)THEN
706 ! -----------
707!$OMP SINGLE
708 CALL inter_trc_7( itask,nin,ipari,ind_imp,
709 1 intbuf_tab,nb_inter_sorted,list_inter_sorted,inter_struct)
710!$OMP END SINGLE
711 ! -----------
712 ! inacti exchange for all interfaces
713 IF(need_to_sort>0.AND.need_comm_inacti.AND.nb_inter_7_inacti>0) THEN
714 IF(itask==0) THEN
715 IF(nspmd>1) THEN
716 CALL spmd_get_inacti_global(ipari,nb_inter_sorted,list_inter_sorted,inter_struct)
717 ELSE
718 DO kk=1,nb_inter_sorted
719 n = list_inter_sorted(kk)
720 ipari(22,n) = inter_struct(n)%INACTI
721 ENDDO
722 ENDIF
723 ENDIF
724 CALL my_barrier()
725 ENDIF
726 ! -----------
727 ! prepare the sort
728 CALL inter_prepare_sort( itask,nb_inter_sorted,list_inter_sorted,isendto,irecvfrom,
729 . ipari,iad_elem,fr_elem,x,v,
730 . ms,temp,kinet,nodnx_sms,itab,
731 . weight,intbuf_tab,inter_struct,sort_comm,nodnx_sms_siz,
732 . temp_siz,component )
733 ! -----------
734 ! sorting computation
735 CALL inter_sort(timers, itask,nb_inter_sorted,list_inter_sorted,retri,ipari,
736 1 nsensor,isendto,irecvfrom,intbuf_tab,x,itab,
737 2 renum,nsnfiold,multi_fvm,h3d_data,sensors%SENSOR_TAB,
738 3 inter_struct,sort_comm ,renum_siz,glob_therm)
739 ENDIF
740 ! end : new sorting algorithm
741 ! ------------------------
742
743
744 ! ------------------------
745 ! old sorting algorithm
746C=======================================================================
747C non implicit options-------
748C=======================================================================
749C
750 IF(impl_s/=1)THEN
751
752
753 idum = 0
754 DO kk=1,nbintc
755 n = intlist(kk)
756
757 nty = ipari(7,n)
758 inacti = ipari(22,n)
759 type18=.false.
760 IF(nty==7 .AND. inacti==7)type18=.true.
761
762 IF( imonm > 0 .AND. itask ==0 ) THEN
763 intbuf_tab(n)%METRIC%NOINT = ipari(15,n)
764 intbuf_tab(n)%METRIC%NCONT = ipari(18,n)
765 intbuf_tab(n)%METRIC%MULTIMP = ipari(23,n)
766 intbuf_tab(n)%METRIC%NSNR = max(intbuf_tab(n)%METRIC%NSNR , ipari(24,n))
767 intbuf_tab(n)%METRIC%NSN = ipari(5,n)
768 CALL int_startime(intbuf_tab(n)%METRIC,i_main_tri)
769 ENDIF
770
771 isens = 0
772 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
773 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
774 ts = sensors%SENSOR_TAB(isens)%TSTART
775 ELSE
776 ts = tt
777 ENDIF
778c-----------------------------------------------------------------------
779 IF(type18.OR.(nty==18)) THEN
780c-----------------------------------------------------------------------
781 nrtm_t = ipari(4,n)/nthread
782 eshift = itask*nrtm_t
783 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
784 IF(intbuf_tab(n)%S_NIGE/=0) THEN
785 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
786 ptr_x => x_ige
787 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
788 ptr_v => v_ige
789 ptr_ms => ms(1:numnod)
790 ptr_kinet => kinet(1:numnod)
791 ELSEIF (multi_fvm%IS_USED .AND. type18) THEN
792 ptr_x => multi_fvm%X_APPEND
793 ptr_v => multi_fvm%V_APPEND
794 ptr_ms => multi_fvm%MASS_APPEND
795 ptr_kinet => multi_fvm%KINET_APPEND(1:numnod+numels)
796 ELSE
797 ptr_x => x
798 ptr_v => v
799 ptr_ms => ms(1:numnod)
800 ptr_kinet => kinet(1:numnod)
801 ENDIF
802 CALL i7main_tri(timers,
803 1 ipari ,ptr_x ,ptr_v ,
804 2 ptr_ms ,n ,itask ,wag ,weight ,
805 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
806 4 itab ,ptr_kinet ,temp ,nrtm_t ,renum ,
807 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
808 6 intbuf_tab(n),h3d_data,ixs,multi_fvm,glob_therm)
809c-----------------------------------------------------------------------
810 ELSEIF(nty == 10)THEN
811c-----------------------------------------------------------------------
812 nrtm_t = ipari(4,n)/nthread
813 eshift = itask*nrtm_t
814 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
815 CALL i10main_tri(timers,
816 1 npari ,ipari(1,n),x ,v ,
817 2 ms ,n ,itask ,wag ,weight ,
818 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
819 4 nrtm_t ,renum ,nsnfiold ,eshift ,idum ,
820 5 idum ,nodnx_sms ,itab ,intbuf_tab(n) ,
821 6 h3d_data ,glob_therm)
822c-----------------------------------------------------------------------
823 ELSEIF(nty == 11.AND.tt>=ts)THEN
824c-----------------------------------------------------------------------
825 nrtm_t = ipari(4,n)/nthread
826 eshift = itask*nrtm_t
827 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
828 CALL i11main_tri(timers,
829 1 ipari ,x ,v ,
830 2 ms ,n ,itask ,weight ,isendto ,
831 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
832 4 nrtm_t ,eshift ,nodnx_sms ,renum ,nsnfiold ,
833 5 intbuf_tab(n),temp ,glob_therm%NODADT_THERM)
834c-----------------------------------------------------------------------
835 ELSEIF(nty == 17)THEN
836c-----------------------------------------------------------------------
837 IF(ipari(33,n) == 0)THEN
838C
839 iad17=1
840 DO k=1,n-1
841 nty =ipari(7,k)
842 IF(ipari(7,k) == 17.AND.ipari(33,k) == 0)THEN
843 ign =ipari(36,k)
844 ige =ipari(34,k)
845 nmes =igrbric(ign)%NENTITY
846 nme =igrbric(ige)%NENTITY
847 iad17 = iad17+6*(nme+nmes)
848 END IF
849 END DO
850C
851 ign =ipari(36,n)
852 ige =ipari(34,n)
853 nmes =igrbric(ign)%NENTITY
854 nme =igrbric(ige)%NENTITY
855 nme_t = nme/nthread
856 eshift = itask*nme_t
857 IF(itask==nthread-1)nme_t=nme-(nthread-1)*(nme/nthread)
858 CALL i17main_tri(timers,
859 1 ipari ,intbuf_tab(n),x ,n ,
860 2 itask ,igrbric ,nme ,nmes ,
861 3 eminx(iad17),ixs ,ixs16 ,ixs20 ,weight ,
862 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
863 4 itab ,v ,nme_t ,eshift )
864 END IF
865c-----------------------------------------------------------------------
866 ELSEIF(nty == 20)THEN
867c-----------------------------------------------------------------------
868 nrtm_t = ipari(4,n)/nthread
869 eshift = itask*nrtm_t
870 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
871 CALL i20main_tri(timers,
872 1 ipari ,x ,v ,
873 2 ms ,n ,itask ,wag ,weight ,
874 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
875 4 itab ,kinet ,temp ,nrtm_t ,renum ,
876 5 nsnfiold,eshift ,idum ,idum ,diag_sms,
877 6 nodnx_sms,intbuf_tab(n),h3d_data,glob_therm )
878c-----------------------------------------------------------------------
879 ELSEIF(nty == 22)THEN
880c-----------------------------------------------------------------------
881 nrtm_t = ipari(4,n)/nthread
882 eshift = itask*nrtm_t
883 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
884 CALL i22main_tri(timers,
885 1 ipari ,x ,v ,
886 2 ms ,n ,itask ,wag ,weight ,
887 3 isendto ,irecvfrom ,retri ,iad_elem ,fr_elem ,
888 4 itab ,kinet ,temp ,nrtm_t ,renum ,
889 5 nsnfiold ,eshift ,idum ,idum ,nodnx_sms ,
890 6 ixs ,igrbric ,ale_connectivity ,intbuf_tab(n),
891 7 count_remslv,h3d_data ,multi_fvm,glob_therm%NODADT_THERM)
892
893 CALL i22subvol(
894 1 x ,n ,itask ,ipari(48:50,n) ,itab ,
895 2 ixs ,ixtg ,v ,iparg ,elbuf_tab ,
896 3 w ,igrsh3n ) !OPTIM : mettre avant ecriture animation
897
898 CALL my_barrier
899 IF(itask==0)THEN
900 DEALLOCATE(irect_l)
901 END IF
902 !--------------------------------------------------------------
903 ! CINEMATIC TIME STEP (MINIMUM LENGTH)
904 !--------------------------------------------------------------
905 nbf = 1+itask*nb/nthread
906 nbl = (itask+1)*nb/nthread
907 dx22min_l(itask) = ep30
908 dx22_min = ep30
909 nin = 1
910
911 DO ib = nbf,nbl !1,NBRIC
912 nbcut = brick_list(nin,ib)%NBCUT
913 IF(nbcut==0)cycle
914 DO j=1,12
915 nbcut = brick_list(nin,ib)%Edge(j)%NBCUT
916 IF(nbcut == 0) cycle
917 len = brick_list(nin,ib)%Edge(j)%LEN
918 dx22min_l(itask) = min(dx22min_l(itask), len)
919 ENDDO
920 ENDDO !IB=1,NBRIC
921
922 CALL my_barrier
923
924#include "lockon.inc"
925 dx22_min = min(dx22_min,dx22min_l(itask))
926#include "lockoff.inc"
927
928c-----------------------------------------------------------------------
929 ELSEIF(nty == 23)THEN
930c-----------------------------------------------------------------------
931 nrtm_t = ipari(4,n)/nthread
932 eshift = itask*nrtm_t
933 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
934 CALL i23main_tri(timers,
935 1 ipari ,x ,intbuf_tab(n),v ,
936 2 ms ,n ,itask ,wag ,weight ,
937 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
938 4 itab ,kinet ,nrtm_t ,renum ,
939 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
940 6 h3d_data,multi_fvm,glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
941c-----------------------------------------------------------------------
942 ELSEIF(nty == 24.AND.tt>=ts)THEN
943c-----------------------------------------------------------------------
944c NRTM_T = IPARI(4,N)/NTHREAD
945c ESHIFT = ITASK*NRTM_T
946c IF(ITASK==NTHREAD-1)NRTM_T=IPARI(4,N)-(NTHREAD-1)*NRTM_T
947 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
948 eshift = itask*nrtm_t
949 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
950 + -(nthread-1)*nrtm_t
951 nsne3 = 3*ipari(55,n)
952 IF (nsne3 >0 ) THEN
953 CALL my_barrier
954!$OMP SINGLE
955 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
956 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
957!$OMP END SINGLE
958 CALL i24main_tri(timers,
959 1 ipari ,xe ,ve ,intbuf_tab(n),
960 2 ms ,n ,itask ,wag ,weight ,
961 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
962 4 itab ,kinet ,temp ,nrtm_t ,renum ,
963 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
964 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
965 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
966 ELSE
967 CALL i24main_tri(timers,
968 1 ipari ,x ,v ,intbuf_tab(n),
969 2 ms ,n ,itask ,wag ,weight ,
970 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
971 4 itab ,kinet ,temp ,nrtm_t ,renum ,
972 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
973 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms ,interfaces%PARAMETERS,
974 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
975 END IF !(NSNE >0 ) THEN
976c-----------------------------------------------------------------------
977 ELSEIF(nty == 25.AND.tt>=ts)THEN
978c-----------------------------------------------------------------------
979 nedge_t = ipari(68,n)/nthread
980 eshift = itask*nedge_t
981 IF(itask==nthread-1)nedge_t=ipari(68,n)
982 + -(nthread-1)*nedge_t
983 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
984 sshift = itask*nrtm_t
985 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
986 + -(nthread-1)*nrtm_t
987 CALL i25main_tri(timers,
988 1 ipari ,x ,v ,intbuf_tab(n),
989 2 ms ,n ,itask ,weight ,
990 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
991 4 itab ,kinet ,temp ,renum ,
992 5 nsnfiold,idum ,idum ,nodnx_sms ,
993 6 h3d_data,eshift ,nedge_t ,sshift ,nrtm_t ,
994 7 icodt ,iskew ,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
995C-----------------------------------------------------------------------
996 ENDIF
997 IF(imonm > 0) THEN
998 IF(itask==0) CALL int_stoptime(intbuf_tab(n)%METRIC,i_main_tri)
999 ENDIF
1000
1001C-----------------------------------------------------------------------
1002 ENDDO
1003C
1004 DO kk=1,nintstamp
1005 n = intstamp(kk)%NOINTER
1006 isens = ipari(64,n) ! INTERFACE SENSOR NUMBER
1007 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
1008 ts = sensors%SENSOR_TAB(isens)%TSTART
1009 ELSE
1010 ts = tt
1011 ENDIF
1012 IF(tt>=ts)THEN
1013 retri21(n) = 0
1014 CALL i21main_tri(timers,
1015 1 ipari ,x ,n ,
1016 2 itask ,weight ,retri21(n) ,idum ,idum ,
1017 3 intstamp(kk) ,wag,intbuf_tab(n),nspmd)
1018 IF(retri21(n)==1) retri = 1
1019 ENDIF
1020 ENDDO
1021 ELSE
1022C=======================================================================
1023C implicit options-------
1024C=======================================================================
1025 iadi = 1
1026 DO kk=1,nbintc
1027 n = intlist(kk)
1028 nty = ipari(7,n)
1029
1030 isens = 0
1031 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
1032 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
1033 ts = sensors%SENSOR_TAB(isens)%TSTART
1034 ELSE
1035 ts = tt
1036 ENDIF
1037C
1038 type18 = .false.
1039 inacti = ipari(22,n)
1040 IF(nty == 7 .AND. inacti ==7)type18=.true.
1041C-----------------------------------------------------------------------
1042 IF((nty == 7.AND.tt>=ts).OR.nty == 18)THEN
1043C-----------------------------------------------------------------------
1044 nrtm_t = ipari(4,n)/nthread
1045 eshift = itask*nrtm_t
1046 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1047 IF(intbuf_tab(n)%S_NIGE/=0) THEN
1048 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
1049 ptr_x => x_ige
1050 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
1051 ptr_v => v_ige
1052 ptr_ms => ms(1:numnod)
1053 ptr_kinet => kinet(1:numnod)
1054 ELSEIF (multi_fvm%IS_USED .AND. type18) THEN
1055 ptr_x => multi_fvm%X_APPEND
1056 ptr_v => multi_fvm%V_APPEND
1057 ptr_ms => multi_fvm%MASS_APPEND
1058 ptr_kinet => multi_fvm%KINET_APPEND(1:numnod+numels)
1059 ELSE
1060 ptr_x => x
1061 ptr_v => v
1062 ptr_ms => ms(1:numnod)
1063 ptr_kinet => kinet(1:numnod)
1064 ENDIF
1065 CALL i7main_tri(timers,
1066 1 ipari ,ptr_x ,ptr_v ,
1067 2 ptr_ms ,n ,itask ,wag ,weight ,
1068 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1069 4 itab ,ptr_kinet ,temp ,nrtm_t ,renum ,
1070 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi) ,nodnx_sms ,
1071 6 intbuf_tab(n),h3d_data,ixs,multi_fvm,glob_therm)
1072 iadi = iadi+num_imp(n)
1073c-----------------------------------------------------------------------
1074 ELSEIF(nty == 24.AND.tt>=ts)THEN
1075c-----------------------------------------------------------------------
1076c NRTM_T = IPARI(4,N)/NTHREAD
1077c ESHIFT = ITASK*NRTM_T
1078c IF(ITASK==NTHREAD-1)NRTM_T=IPARI(4,N)-(NTHREAD-1)*NRTM_T
1079 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
1080 eshift = itask*nrtm_t
1081 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
1082 + -(nthread-1)*nrtm_t
1083C------- KINET,MS used for commu remot secnd, for the moment no need.
1084 nsne3 = 3*ipari(55,n)
1085 IF (nsne3 >0 ) THEN
1086 CALL my_barrier
1087!$OMP SINGLE
1088 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
1089 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
1090!$OMP END SINGLE
1091 CALL i24main_tri(timers,
1092 1 ipari ,xe ,ve ,intbuf_tab(n),
1093 2 ms ,n ,itask ,wag ,weight ,
1094 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1095 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1096 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1097 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
1098 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
1099 iadi = iadi+num_imp(n)
1100 ELSE
1101 CALL i24main_tri(timers,
1102 1 ipari ,x ,v ,intbuf_tab(n),
1103 2 ms ,n ,itask ,wag ,weight ,
1104 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1105 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1106 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1107 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
1108 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
1109 iadi = iadi+num_imp(n)
1110 END IF !(NSNE >0 ) THEN
1111c-----------------------------------------------------------------------
1112 ELSEIF(nty == 25.AND.tt>=ts)THEN
1113c-----------------------------------------------------------------------
1114 nedge_t = ipari(68,n)/nthread
1115 eshift = itask*nedge_t
1116 IF(itask==nthread-1)nedge_t=ipari(68,n)
1117 + -(nthread-1)*nedge_t
1118 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
1119 sshift = itask*nrtm_t
1120 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
1121 + -(nthread-1)*nrtm_t
1122C------- KINET,MS used for commu remot secnd, for the moment no need.
1123 CALL i25main_tri(timers,
1124 1 ipari ,x ,v ,intbuf_tab(n),
1125 2 ms ,n ,itask ,weight ,
1126 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1127 4 itab ,kinet ,temp ,renum ,
1128 5 nsnfiold,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1129 6 h3d_data,eshift,nedge_t ,sshift ,nrtm_t ,
1130 7 icodt ,iskew ,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1131 iadi = iadi+num_imp(n)
1132C-----------------------------------------------------------------------
1133 ELSEIF(nty == 10)THEN
1134C-----------------------------------------------------------------------
1135 nrtm_t = ipari(4,n)/nthread
1136 eshift = itask*nrtm_t
1137 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1138 CALL i10main_tri(timers,
1139 1 npari ,ipari(1,n),x ,v ,
1140 2 ms ,n ,itask ,wag ,weight ,
1141 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1142 4 nrtm_t ,renum ,nsnfiold ,eshift ,num_imp(n),
1143 5 ind_imp(iadi) ,nodnx_sms,itab ,intbuf_tab(n) ,
1144 6 h3d_data, glob_therm)
1145 iadi = iadi+num_imp(n)
1146C-----------------------------------------------------------------------
1147 ELSEIF(nty == 11.AND.tt>=ts)THEN
1148C-----------------------------------------------------------------------
1149 nrtm_t = ipari(4,n)/nthread
1150 eshift = itask*nrtm_t
1151 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1152 CALL i11main_tri(timers,
1153 1 ipari ,x ,v ,
1154 2 ms ,n ,itask ,weight ,isendto ,
1155 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
1156 4 nrtm_t ,eshift ,nodnx_sms ,renum ,nsnfiold ,
1157 5 intbuf_tab(n),temp , glob_therm%NODADT_THERM)
1158C-----------------------------------------------------------------------
1159 ELSEIF(nty == 17)THEN
1160C-----------------------------------------------------------------------
1161 IF(ipari(33,n) == 0)THEN
1162 ign =ipari(36,n)
1163 ige =ipari(34,n)
1164 nmes =igrbric(ign)%NENTITY
1165 nme =igrbric(ige)%NENTITY
1166 nme_t = nme/nthread
1167 eshift = itask*nme_t
1168 IF(itask==nthread-1)nme_t=nme-(nthread-1)*(nme/nthread)
1169 CALL i17main_tri(timers,
1170 1 ipari ,intbuf_tab(n),x ,n ,
1171 2 itask ,igrbric ,nme ,nmes ,
1172 3 eminx(iad17),ixs ,ixs16 ,ixs20 ,weight ,
1173 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1174 4 itab ,v ,nme_t ,eshift )
1175 iad17 = iad17+6*(nme+nmes)
1176 END IF
1177C-----------------------------------------------------------------------
1178 ELSEIF(nty == 20)THEN
1179C-----------------------------------------------------------------------
1180 nrtm_t = ipari(4,n)/nthread
1181 eshift = itask*nrtm_t
1182 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1183 CALL i20main_tri(timers,
1184 1 ipari ,x ,v ,
1185 2 ms ,n ,itask ,wag ,weight ,
1186 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1187 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1188 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),diag_sms,
1189 6 nodnx_sms,intbuf_tab(n),h3d_data,glob_therm)
1190
1191 iadi = iadi+num_imp(n)
1192C-----------------------------------------------------------------------
1193 ENDIF
1194C-----------------------------------------------------------------------
1195 ENDDO
1196 ENDIF
1197C=======================================================================
1198C
1199 CALL my_barrier()
1200C
1201C=======================================================================
1202C OPTIMISATION DU TRI A CHAQUE CYCLE, T25
1203C=======================================================================
1204 IF(ninter25 /= 0)THEN
1205 IF(itask == 0) CALL stoptime(timers,17)
1206
1207 IF(idel7nok_sav/=0)THEN
1208 IF(itask == 0) CALL stoptime(timers,2)
1209 IF(itask == 0) CALL startime(timers,8)
1210 CALL i25main_free(timers,itask, ipari ,intbuf_tab ,intlist25, isendto,
1211 2 irecvfrom)
1212C
1213 CALL my_barrier()
1214C
1215 IF(itask == 0) CALL startime(timers,2)
1216 IF(itask == 0) CALL stoptime(timers,8)
1217 END IF
1218
1219 DO kk=1,ninter25
1220 n = intlist25(kk)
1221 nty =ipari(7,n)
1222C--------TEST IF INTERFACE IS ACTIVE WHEN USING SENSOR-----------
1223 isens = 0
1224
1225 IF(imonm > 0) THEN
1226 IF(itask ==0) CALL int_startime(intbuf_tab(n)%METRIC,i_main_opt_tri)
1227 ENDIF
1228
1229 isens = ipari(64,n)
1230 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
1231 ts = sensors%SENSOR_TAB(isens)%TSTART
1232 ELSE
1233 ts = tt
1234 ENDIF
1235C
1236 IF(tt>=ts)THEN
1237C-----------------------------------------------------------------------
1238 CALL i25main_opt_tri(
1239 1 n ,ipari ,intbuf_tab(n),x ,v ,
1240 2 itask ,itab ,kinet ,count_remslv,
1241 3 count_remslve, nb25_candt(itask+1), i_opt_stok(n))
1242
1243 ENDIF
1244C-----------------------------------------------------------------------
1245
1246 IF(imonm > 0) THEN
1247 IF(itask==0) CALL int_stoptime(intbuf_tab(n)%METRIC,i_main_opt_tri)
1248 ENDIF
1249
1250 ENDDO
1251C=======================================================================
1252C
1253C Calcul // des normales
1254C
1255C il FAUT garder une barriere avant i25main_norm !!!
1256 CALL my_barrier
1257C
1258 IF (imon>0 .AND. itask==0) THEN
1259 CALL stoptime(timers,2)
1260 CALL startime(timers,8)
1261 CALL startime(timers,macro_timer_t25norm)
1262 ENDIF
1263
1264 CALL i25main_norm(
1265 1 intlist25,ipari ,intbuf_tab ,itask+1 ,x ,
1266 2 itab ,nsensor,sensors%SENSOR_TAB,iad_frnor,fr_nor ,
1267 3 iad_fredg,fr_edg,iad_elem ,fr_elem ,fskyn25 ,
1268 4 addcsrect,procnor)
1269
1270 CALL my_barrier
1271 IF (imon>0 .AND. itask==0) THEN
1272 CALL stoptime(timers,macro_timer_t25norm)
1273 CALL startime(timers,macro_timer_t25stfe)
1274 ENDIF
1275
1276!$OMP SINGLE
1277 IF(idel7nok_sav > 0) THEN
1278 DO n = 1,ninter25
1279 nin = intlist25(n)
1280 IF(ipari(macro_iedge,nin) > 0) THEN
1281C
1282C Also needed in SMP for resetting STFE !
1283 CALL spmd_get_stif25_edg(
1284 . intbuf_tab(nin)%STFE, ipari(macro_nedge,nin), intbuf_tab(nin)%LEDGE,
1285 . nin , isendto, irecvfrom, intbuf_tab(nin)%MPI_COMM, intbuf_tab(nin)%RANK,
1286 . intbuf_tab(nin)%NSPMD)
1287 ENDIF
1288 ENDDO
1289 ENDIF
1290!$OMP END SINGLE
1291
1292C
1293 IF (imon>0 .AND. itask==0) THEN
1294 CALL stoptime(timers,macro_timer_t25stfe)
1295 CALL stoptime(timers,8)
1296 CALL startime(timers,2)
1297 END IF
1298
1299C=======================================================================
1300 CALL my_barrier
1301C
1302 IF (imon>0 .AND. itask==0) THEN
1303 CALL stoptime(timers,2)
1304 CALL startime(timers,8)
1305 CALL startime(timers,macro_timer_t25sliding)
1306 END IF
1307C
1308C statistique interface
1309 IF (debug(3)>=1.AND.ncycle==0) THEN
1310 nb25_candt(itask+1) = 0
1311 nb25_impct(itask+1) = 0
1312 nb25_dst1(itask+1) = 0
1313 nb25_dst2(itask+1) = 0
1314 ENDIF
1315
1316 CALL i25main_slid(
1317 1 ipari ,iad_elem ,fr_elem ,itab ,sensors%SENSOR_TAB,
1318 2 nsensor ,intlist25,intbuf_tab ,iad_frnor,fr_nor ,
1319 3 x ,v ,ms ,temp ,kinet ,
1320 4 nativ_sms,itask+1 ,nb25_dst2, main_proc,
1321 5 newfront ,isendto ,irecvfrom ,nbintc,
1322 6 intlist ,islen7 ,irlen7 ,irlen7t ,islen7t,
1323 7 nb25_dst1,h3d_data, icodt,iskew,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1324C
1325 CALL my_barrier
1326C
1327 IF (imon>0 .AND. itask==0) THEN
1328 CALL stoptime(timers,macro_timer_t25sliding)
1329 CALL stoptime(timers,8)
1330 CALL startime(timers,2)
1331 END IF
1332
1333 IF(itask == 0) CALL startime(timers,17)
1334C
1335 END IF
1336 ! end : old sorting algorithm
1337 ! ------------------------
1338
1339 ! ------------------------------
1340 ! new sorting algorithm
1341 ! deallocation & wait
1342 CALL my_barrier()
1343 ! ------------------------
1344 ! explicit part
1345 IF(impl_s/=1)THEN
1346 CALL inter_deallocate_wait( itask,nb_inter_sorted,list_inter_sorted,ipari,
1347 1 nsensor,irecvfrom,sensors%SENSOR_TAB,inter_struct,sort_comm )
1348 ENDIF
1349 ! end : new sorting algorithm
1350 ! ------------------------------
1351C=======================================================================
1352C
1353C Partie non parallele
1354C
1355!$OMP SINGLE
1356 IF (imonm > 0) THEN
1357 CALL stoptime(timers,17)
1358 IF(imonm == 2 .AND. nspmd > 1)THEN
1359 CALL startime(timers,58)
1360 CALL spmd_barrier()
1361 CALL stoptime(timers,58)
1362 END IF
1363 END IF
1364 IF (nspmd > 1 .AND. (retri == 1 .OR. ninter25 > 0 ) ) THEN
1365C
1366C Communication after sorting
1367C
1368 IF (imonm > 0) CALL startime(timers,18)
1369 CALL spmd_ifront(
1370 1 ipari ,newfront,isendto ,irecvfrom,
1371 2 nsensor ,nbintc ,intlist ,islen7 ,irlen7 ,
1372 3 islen11 ,irlen11 ,islen17 ,irlen17 ,irlen7t ,
1373 4 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t ,
1374 5 irlen20e,islen20e,sensors%SENSOR_TAB,intbuf_tab, 1 )
1375
1376 IF(nintstamp /= 0.AND.ftempvar21==1) THEN
1377 CALL spmd_ifront_stamp(
1378 1 ipari ,nsensor ,intbuf_tab, retri21,temp ,sensors%SENSOR_TAB,
1379 2 nbintc21,intlist21)
1380 ENDIF
1381
1382C Fin Partie non parallele
1383 IF (imonm > 0) CALL stoptime(timers,18)
1384 ENDIF
1385C
1386 IF (imonm > 0) CALL startime(timers,19)
1387!$OMP END SINGLE
1388C
1389C=======================================================================
1390C OPTIMISATION DU TRI A CHAQUE CYCLE, ALL BUT T25
1391C=======================================================================
1392 DO kk=1,nbintc
1393 n = intlist(kk)
1394 nty =ipari(7,n)
1395C--------TEST IF INTERFACE IS ACTIVE WHEN USING SENSOR-----------
1396 isens = 0
1397
1398
1399 IF(imonm > 0) THEN
1400 IF(itask ==0) CALL int_startime(intbuf_tab(n)%METRIC,i_main_opt_tri)
1401 ENDIF
1402
1403
1404
1405 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
1406 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
1407 ts = sensors%SENSOR_TAB(isens)%TSTART
1408 ELSE
1409 ts = tt
1410 ENDIF
1411
1412 type18 = .false.
1413 inacti = ipari(22,n)
1414 IF(nty == 7 .AND. inacti ==7)type18=.true.
1415C
1416C-----------------------------------------------------------------------
1417 IF(nty == 7.AND.tt>=ts)THEN
1418C-----------------------------------------------------------------------
1419
1420 IF(intbuf_tab(n)%S_NIGE/=0) THEN
1421 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
1422 ptr_x => x_ige
1423 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
1424 ptr_v => v_ige
1425 ELSEIF (multi_fvm%IS_USED .AND. type18) THEN
1426 ptr_x => multi_fvm%X_APPEND
1427 ptr_v => multi_fvm%V_APPEND
1428 ELSE
1429 ptr_x => x
1430 ptr_v => v
1431 ENDIF
1432
1433 CALL i7main_opt_tri(
1434 1 ipari ,ptr_x ,ptr_v,
1435 2 n ,itask ,count_remslv ,intbuf_tab(n),
1436 3 lskyi_sms_new)
1437
1438C-----------------------------------------------------------------------
1439 ELSEIF(nty == 10)THEN
1440C-----------------------------------------------------------------------
1441 CALL i10main_opt_tri(
1442 1 ipari(1,n),x ,v ,
1443 2 n ,itask ,count_remslv ,intbuf_tab(n),lskyi_sms_new)
1444C-----------------------------------------------------------------------
1445 ELSEIF(nty == 11.AND.tt>=ts)THEN
1446C-----------------------------------------------------------------------
1447 CALL i11main_opt_tri(
1448 1 ipari ,intbuf_tab(n),x ,v ,
1449 2 n ,itask ,count_remslv,
1450 3 lskyi_sms_new )
1451C-----------------------------------------------------------------------
1452 ELSEIF(nty == 20)THEN
1453C-----------------------------------------------------------------------
1454 CALL i20main_opt_tri(
1455 1 ipari ,x ,v ,
1456 2 n ,itask ,count_remslv,count_remslve,
1457 3 intbuf_tab(n) )
1458C-----------------------------------------------------------------------
1459 ELSEIF(nty == 22)THEN
1460C-----------------------------------------------------------------------
1461 !
1462C-----------------------------------------------------------------------
1463 ELSEIF(nty == 23)THEN
1464C-----------------------------------------------------------------------
1465 CALL i23main_opt_tri(
1466 1 ipari ,intbuf_tab(n),n ,itask ,
1467 2 count_remslv,x )
1468C-----------------------------------------------------------------------
1469 ELSEIF(nty == 24.AND.tt>=ts)THEN
1470C-----------------------------------------------------------------------
1471 nsne3 = 3*ipari(55,n)
1472 IF (nsne3 >0 ) THEN
1473 CALL my_barrier
1474!$OMP SINGLE
1475 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
1476 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
1477!$OMP END SINGLE
1478 CALL i24main_opt_tri(
1479 1 ipari ,intbuf_tab(n),xe ,ve ,
1480 2 n ,itask ,count_remslv, t2main_sms,lskyi_sms_new)
1481 ELSE
1482 CALL i24main_opt_tri(
1483 1 ipari ,intbuf_tab(n),x ,v ,
1484 2 n ,itask ,count_remslv, t2main_sms,lskyi_sms_new)
1485 ENd IF !(NSNE >0 ) THEN
1486C-----------------------------------------------------------------------
1487 ELSEIF(nty == 25.AND.tt>=ts)THEN
1488C-----------------------------------------------------------------------
1489C CALL I25MAIN_OPT_TRI(
1490C 1 N ,IPARI ,INTBUF_TAB(N),X ,V ,
1491C 2 ITASK ,ITAB ,KINET ,COUNT_REMSLV,
1492C 3 COUNT_REMSLVE, NB25_CANDT(ITASK+1), I_OPT_STOK(N))
1493
1494C-----------------------------------------------------------------------
1495 ENDIF
1496C-----------------------------------------------------------------------
1497
1498 IF(imonm > 0) THEN
1499 IF(itask==0) CALL int_stoptime(intbuf_tab(n)%METRIC,i_main_opt_tri)
1500 ENDIF
1501
1502 ENDDO
1503C
1504 IF (nintstamp/=0) THEN
1505 IF (debug(3)>=1.AND.ncycle==0) THEN
1506 nb_stok_n(itask+1)=0
1507 nb_jlt(itask+1)=0
1508 ENDIF
1509 END IF
1510C
1511 DO kk=1,nintstamp
1512 n = intstamp(kk)%NOINTER
1513C
1514 isens = ipari(64,n) ! INTERFACE SENSOR NUMBER
1515 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
1516 ts = sensors%SENSOR_TAB(isens)%TSTART
1517 ELSE
1518 ts = tt
1519 ENDIF
1520 IF(tt>=ts)THEN ! INTERFACE SENSOR IS ACTIVATED
1521C
1522 CALL i21main_opt_tri(timers,
1523 1 ipari ,intbuf_tab(n),n ,itask ,
1524 2 intstamp(kk),nb_stok_n,nb_jlt)
1525C
1526 ENDIF
1527 ENDDO
1528
1529 IF (nintstamp/=0) THEN
1530 IF (debug(3)>=1) THEN
1531 IF(mod(ncycle+1,debug(3))==0)THEN
1532 IF (nb_jlt(itask+1)==0) THEN
1533 pct1= zero
1534 ELSE
1535 pct1 = hundred - hundred*nb_stok_n(itask+1)/nb_jlt(itask+1)
1536 ENDIF
1537#include "lockon.inc"
1538 WRITE(istdo,'(A,I6,A,I4,A,I4,A,I10,A,I10,2X,F5.2,A)')
1539 . ' NCYCLE = ',ncycle,
1540 . ' NSPMD = ',ispmd+1,
1541 . ' ITASK = ',itask+1,
1542 . ' CANDIDATS = ',nb_jlt(itask+1),
1543 . ' OPT CAND = ',nb_stok_n(itask+1),pct1,'%'
1544#include "lockoff.inc"
1545 nb_stok_n(itask+1)=0
1546 nb_jlt(itask+1)=0
1547 END IF
1548 END IF
1549 ENDIF
1550C
1551C Partie non parallele
1552C
1553 CALL my_barrier()
1554C
1555!$OMP SINGLE
1556 IF (imonm > 0) CALL stoptime(timers,19)
1557 IF (nsne_max>0 ) DEALLOCATE(xe,ve)
1558!$OMP END SINGLE
1559
1560 ! If law151+int18 : shift NSV array
1561 IF( multi_fvm%IS_INT18_LAW151 ) THEN
1562 CALL my_barrier()
1563 CALL int18_law151_nsv_shift('-',itask,nthread,multi_fvm,ipari,intbuf_tab,npari,ninter,numnod)
1564 ENDIF
1565C
1566C=======================================================================
1567C Partie parallele
1568 IF(ninter25 /= 0)THEN
1569C
1570C il FAUT garder une barriere apres i25main_opt_tri !!!
1571 CALL my_barrier()
1572C
1573 IF (imon>0 .AND. itask==0) THEN
1574 CALL stoptime(timers,2)
1575 CALL startime(timers,8)
1576 END IF
1577
1578 CALL i25maind_2(
1579 1 ipari ,itab ,sensors%SENSOR_TAB,intlist25,intbuf_tab ,
1580 2 x ,v ,kinet ,itask+1 ,nb25_dst2,
1581 3 icodt ,iskew ,nsensor )
1582C
1583C CALL MY_BARRIER() ! Barrier vs timer only
1584C
1585 IF (imon>0 .AND. itask==0) THEN
1586 CALL stoptime(timers,8)
1587 CALL startime(timers,2)
1588 END IF
1589C
1590 END IF
1591
1592
1593!$OMP SINGLE
1594
1595 IF ((nspmd > 1 .AND. (retri == 1 .OR. ninter25 > 0 ))) THEN
1596
1597! If ifront is done at this cycle (retri or ninter25>0
1598! and not already terminated because of type25 edge2edge
1599C
1600C Communication apres retri
1601C
1602 IF (imonm > 0) CALL startime(timers,18)
1603
1604 CALL spmd_ifront(
1605 1 ipari ,newfront,isendto ,irecvfrom,
1606 2 nsensor ,nbintc ,intlist ,islen7 ,irlen7 ,
1607 3 islen11 ,irlen11 ,islen17 ,irlen17 ,irlen7t ,
1608 4 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t ,
1609 5 irlen20e,islen20e,sensors%SENSOR_TAB,intbuf_tab, 2)
1610
1611 IF(ninter25e > 0) THEN
1612 CALL spmd_i25front_nor(ipari,
1613 . intbuf_tab,
1614 . intlist25,
1615 . x)
1616 ENDIF
1617
1618
1619C Fin Partie non parallele
1620 IF (imonm > 0) CALL stoptime(timers,18)
1621
1622 ENDIF
1623
1624 DEALLOCATE(x_ige,v_ige)
1625!$OMP END SINGLE
1626
1627 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i10main_tri
subroutine i10main_tri(timers, npari, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, itab, intbuf_tab, h3d_data, glob_therm)
Definition i10main_tri.F:59
i10main_opt_tri
subroutine i10main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
Definition i10opt_opt_tri.F:36
i11main_crit_tri
subroutine i11main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
Definition i11main_crit_tri.F:37
i11main_opt_tri
subroutine i11main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, lskyi_sms_new)
Definition i11main_opt_tri.F:37
i11main_tri
subroutine i11main_tri(timers, ipari, x, v, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, nrtm_t, eshift, nodnx_sms, renum, nsnfiold, intbuf_tab, temp, nodadt_therm)
Definition i11main_tri.F:57
i17main_tri
subroutine i17main_tri(timers, ipari, intbuf_tab, x, nin, itask, igrbric, nme, nmes, eminx, ixs, ixs16, ixs20, weight, isendto, irecvfrom, retri, iad_elem, fr_elem, itab, v, nme_t, esh_t)
Definition i17main_pena.F:159
i17main_crit_tri
subroutine i17main_crit_tri(ipari, intbuf_tab, x, nin, itask, igrbric, eminx, nme, nmes, xslv _l, xmsr_l, size_t, ixs, ixs16, ixs20)
Definition i17main_pena.F:39
i20main_crit_tri
subroutine i20main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, ms, dxancg, ikine, diag_sms, intbuf_tab, h3d_data)
Definition i20main_crit_tri.F:38
i20main_opt_tri
subroutine i20main_opt_tri(ipari, x, v, nin, itask, count_remslv, count_remslve, intbuf_tab)
Definition i20main_opt_tri.F:38
i20main_tri
subroutine i20main_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, diag_sms, nodnx_sms, intbuf_tab, h3d_data, glob_therm)
Definition i20main_tri.F:62
i21_icrit
subroutine i21_icrit(intbuf_tab, ipari, dt2t, neltst, nsensor, ityptst, xslv, xmsr, vslv, vmsr, intstamp, x21msr, v21msr, sensor_tab, nbintc21, intlist21)
Definition i21_icrit.F:40
i21main_crit_tri
subroutine i21main_crit_tri(ipari, intbuf_tab, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intstamp, x21msr, v21msr)
Definition i21main_crit_tri.F:37
i21main_gap
subroutine i21main_gap(ipari, intbuf_tab, nin, itask, thknod)
Definition i21main_gap.F:36
i21main_opt_tri
subroutine i21main_opt_tri(timers, ipari, intbuf_tab, nin, itask, intstamp, nb_stok_n, nb_jlt)
Definition i21main_opt_tri.F:37
i21main_tri
subroutine i21main_tri(timers, ipari, x, nin, itask, weight, retri, num_imp, ind_imp, intstamp, mwag, intbuf_tab, nspmd)
Definition i21main_tri.F:47
i22main_tri
subroutine i22main_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, ixs, igrbric, ale_connectivity, intbuf_tab, count_remslv, h3d_data, multi_fvm, nodadt_therm)
Definition i22main_tri.F:65
i22subvol
subroutine i22subvol(x, nin, itask, ipari, itab, ixs, ixtg, v, iparg, elbuf_tab, w, igrsh3n)
Definition i22subvol.F:40
i23main_opt_tri
subroutine i23main_opt_tri(ipari, intbuf_tab, nin, itask, count_remslv, x)
Definition i23main_opt_tri.F:35
i23main_tri
subroutine i23main_tri(timers, ipari, x, intbuf_tab, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, h3d_data, multi_fvm, intheat, idt_therm, nodadt_therm)
Definition i23main_tri.F:59
i24main_crit_tri
subroutine i24main_crit_tri(ipari, intbuf_tab, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, delta_pmax_gap, delta_pmax_dgap, delta_pmax_gap_node, itab)
Definition i24main_crit_tri.F:37
i24main_opt_tri
subroutine i24main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, t2main_sms, lskyi_sms_new)
Definition i24main_opt_tri.F:35
i24main_tri
subroutine i24main_tri(timers, ipari, x, v, intbuf_tab, 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, h3d_data, t2main_sms, forneqs, t2fac_sms, parameters, intheat, idt_therm, nodadt_therm)
Definition i24main_tri.F:60
i25main_crit_tri
subroutine i25main_crit_tri(ipari, intbuf_tab, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, delta_pmax_gap, delta_pmax_dgap, delta_pmax_gap_node, itab)
Definition i25main_crit_tri.F:37
i25main_free
subroutine i25main_free(timers, itask, ipari, intbuf_tab, intlist25, isendto, irecvfrom)
Definition i25main_free.F:42
i25main_gap
subroutine i25main_gap(ipari, intbuf_tab, nin, itask, thknod, maxdgap)
Definition i25main_gap.F:36
i25main_norm
subroutine i25main_norm(intlist25, ipari, intbuf_tab, jtask, x, itab, nsensor, sensor_tab, iad_frnor, fr_nor, iad_fredg, fr_edg, iad_elem, fr_elem, fskyn25, addcsrect, procnor)
Definition i25main_norm.F:42
i25main_opt_tri
subroutine i25main_opt_tri(nin, ipari, intbuf_tab, x, v, itask, itab, kinet, count_remslv, count_remslve, nb_candt, i_opt_stok)
Definition i25main_opt_tri.F:42
i25main_slid
subroutine i25main_slid(ipari, iad_elem, fr_elem, itab, sensor_tab, nsensor, intlist25, intbuf_tab, iad_frnor, fr_nor, x, v, ms, temp, kinet, nodnx_sms, jtask, nb_dst2, main_proc, newfront, isendto, ircvfrom, nbintc, intlist, islen7, irlen7, irlen7t, islen7t, nb_dst1, h3d_data, icodt, iskew, parameters, nodadt_therm)
Definition i25main_slid.F:59
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
i25maind_2
subroutine i25maind_2(ipari, itab, sensor_tab, intlist25, intbuf_tab, x, v, kinet, jtask, nb_dst2, icodt, iskew, nsensor)
Definition i25maind_2.F:40
i7main_crit_tri
subroutine i7main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
Definition i7main_crit_tri.F:37
i7main_opt_tri
subroutine i7main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
Definition i7main_opt_tri.F:37
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
intcrit
subroutine intcrit(timers, errors, ipari, newfront, isendto, nsensor, ircvfrom, dt2t, neltst, ityptst, itab, xslv, xmsr, vslv, vmsr, intlist, nbintc, size_t, sensor_tab, delta_pmax_gap, intbuf_tab, delta_pmax_gap_node, idel7nok_sav, maxdgap, v)
Definition intcrit.F:49
inter_check_sort
subroutine inter_check_sort(itask, need_to_sort, nbintc, intlist, ipari, nsensor, intbuf_tab, sensor_tab, nb_inter_sorted, list_inter_sorted, inter_struct)
Definition inter_check_sort.F:35
inter_deallocate_wait
subroutine inter_deallocate_wait(itask, nb_inter_sorted, list_inter_sorted, ipari, nsensor, irecvfrom, sensor_tab, inter_struct, sort_comm)
Definition inter_deallocate_wait.F:40
inter_prepare_sort
subroutine inter_prepare_sort(itask, nb_inter_sorted, list_inter_sorted, isendto, irecvfrom, ipari, iad_elem, fr_elem, x, v, ms, temp, kinet, nodnx_sms, itab, weight, intbuf_tab, inter_struct, sort_comm, nodnx_sms_siz, temp_siz, component)
Definition inter_prepare_sort.F:57
inter_sort
subroutine inter_sort(timers, itask, nb_inter_sorted, list_inter_sorted, retri, ipari, nsensor, isendto, irecvfrom, intbuf_tab, x, itab, renum, nsnfiold, multi_fvm, h3d_data, sensor_tab, inter_struct, sort_comm, renum_siz, glob_therm)
Definition inter_sort.F:47
inter_trc_7
subroutine inter_trc_7(itask, nin, ipari, ind_imp, intbuf_tab, nb_inter_sorted, list_inter_sorted, inter_struct)
Definition inter_trc_7.F:35
intmass_update
subroutine intmass_update(nin, ipari, intbuf_tab, ms)
Definition intmass_update.F:34
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
int18_law151_nsv_shift_mod
Definition int18_law151_nsv_shift.F:30
int18_law151_nsv_shift_mod::int18_law151_nsv_shift
subroutine int18_law151_nsv_shift(mode, itask, nthread, multi_fvm, ipari, intbuf_tab, npari, ninter, numnod, opt_int_id)
Definition int18_law151_nsv_shift.F:49
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::nb_inter_7_inacti
integer nb_inter_7_inacti
Definition inter_sorting_mod.F:63
inter_sorting_mod::need_to_sort
integer need_to_sort
Definition inter_sorting_mod.F:62
inter_sorting_mod::need_comm_inacti
logical need_comm_inacti
Definition inter_sorting_mod.F:60
inter_struct_mod
Definition inter_struct_mod.F:49
intstamp_mod
Definition intstamp_mod.F:38
metric_mod
Definition metric_mod.F:42
metric_mod::i_main_tri
integer, parameter i_main_tri
Definition metric_mod.F:54
metric_mod::i_main_opt_tri
integer, parameter i_main_opt_tri
Definition metric_mod.F:55
metric_mod::i_main_crit_tri
integer, parameter i_main_crit_tri
Definition metric_mod.F:53
outputs_mod
Definition outputs_mod.F:59
outputs_mod::ninefric
integer ninefric
Definition outputs_mod.F:65
renum_siz
subroutine renum_siz(ipari, rnum_siz)
Definition renum_siz.F:29
spmd_ifront_stamp
subroutine spmd_ifront_stamp(ipari, nsensor, intbuf_tab, retri, temp, sensor_tab, nbintc21, intlist21)
Definition send_cand.F:1602
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
spmd_exch_sorting_efric
subroutine spmd_exch_sorting_efric(ipari, intlist, nbintc, islen7, irlen7, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, intbuf_tab, h3d_data)
Definition spmd_exch_sorting_efric.F:43
spmd_get_inacti_global
subroutine spmd_get_inacti_global(ipari, nb_inter_sorted, list_inter_sorted, inter_struct)
Definition spmd_get_inacti_global.F:34
spmd_get_stif25_edg
subroutine spmd_get_stif25_edg(stfe, nedge, ledge, nin, isendto, ircvfrom, comm, rank, comsize)
Definition spmd_getstif25_edg.F:36
spmd_i25front_nor
subroutine spmd_i25front_nor(ipari, intbuf_tab, intlist25, x)
Definition spmd_i25front.F:320
spmd_i7itied_cand
subroutine spmd_i7itied_cand(flag, nbintc, ipari, intlist, intbuf_tab)
Definition spmd_i7itied_cand.F:35
spmd_ifront
subroutine spmd_ifront(ipari, newfront, isendto, ircvfrom, nsensor, nbintc, intlist, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, sensor_tab, intbuf_tab, mode)
Definition spmd_ifront.F:46
i21reset
subroutine i21reset(nsn, irtlm, csts)
Definition i21reset.F:29
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
int_stoptime
subroutine int_stoptime(this, event)
Definition timer_interf.F:118
int_startime
subroutine int_startime(this, event)
Definition timer_interf.F:78