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 (output, 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 (output_) output,
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 108 of file inttri.F.

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