OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inttri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| inttri ../engine/source/interfaces/intsort/inttri.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| i10main_opt_tri ../engine/source/interfaces/intsort/i10opt_opt_tri.F
29!|| i10main_tri ../engine/source/interfaces/intsort/i10main_tri.F
30!|| i11main_crit_tri ../engine/source/interfaces/intsort/i11main_crit_tri.F
31!|| i11main_opt_tri ../engine/source/interfaces/intsort/i11main_opt_tri.F
32!|| i11main_tri ../engine/source/interfaces/intsort/i11main_tri.F
33!|| i17main_crit_tri ../engine/source/interfaces/int17/i17main_pena.F
34!|| i17main_tri ../engine/source/interfaces/int17/i17main_pena.F
35!|| i20main_crit_tri ../engine/source/interfaces/intsort/i20main_crit_tri.F
36!|| i20main_opt_tri ../engine/source/interfaces/intsort/i20main_opt_tri.F
37!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
38!|| i21_icrit ../engine/source/interfaces/intsort/i21_icrit.F
39!|| i21main_crit_tri ../engine/source/interfaces/intsort/i21main_crit_tri.F
40!|| i21main_gap ../engine/source/interfaces/int21/i21main_gap.F
41!|| i21main_opt_tri ../engine/source/interfaces/intsort/i21main_opt_tri.F
42!|| i21main_tri ../engine/source/interfaces/intsort/i21main_tri.F
43!|| i21reset ../engine/source/interfaces/int21/i21reset.f
44!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
45!|| i22subvol ../engine/source/interfaces/int22/i22subvol.F
46!|| i23main_opt_tri ../engine/source/interfaces/intsort/i23main_opt_tri.F
47!|| i23main_tri ../engine/source/interfaces/intsort/i23main_tri.F
48!|| i24main_crit_tri ../engine/source/interfaces/intsort/i24main_crit_tri.F
49!|| i24main_opt_tri ../engine/source/interfaces/intsort/i24main_opt_tri.F
50!|| i24main_tri ../engine/source/interfaces/intsort/i24main_tri.F
51!|| i25main_crit_tri ../engine/source/interfaces/intsort/i25main_crit_tri.F
52!|| i25main_free ../engine/source/interfaces/intsort/i25main_free.F
53!|| i25main_gap ../engine/source/interfaces/int25/i25main_gap.F
54!|| i25main_norm ../engine/source/interfaces/int25/i25main_norm.F
55!|| i25main_opt_tri ../engine/source/interfaces/intsort/i25main_opt_tri.F
56!|| i25main_slid ../engine/source/interfaces/int25/i25main_slid.f
57!|| i25main_tri ../engine/source/interfaces/intsort/i25main_tri.F
58!|| i25maind_2 ../engine/source/interfaces/int25/i25maind_2.F
59!|| i7main_crit_tri ../engine/source/interfaces/intsort/i7main_crit_tri.F
60!|| i7main_opt_tri ../engine/source/interfaces/intsort/i7main_opt_tri.F
61!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
62!|| int18_law151_nsv_shift ../common_source/interf/int18_law151_nsv_shift.f
63!|| int_startime ../engine/source/system/timer_interf.F
64!|| int_stoptime ../engine/source/system/timer_interf.F
65!|| intcrit ../engine/source/interfaces/intsort/intcrit.F
66!|| inter_check_sort ../engine/source/interfaces/generic/inter_check_sort.F
67!|| inter_deallocate_wait ../engine/source/interfaces/generic/inter_deallocate_wait.F
68!|| inter_prepare_sort ../engine/source/interfaces/generic/inter_prepare_sort.F
69!|| inter_sort ../engine/source/interfaces/generic/inter_sort.F
70!|| inter_trc_7 ../engine/source/interfaces/int07/inter_trc_7.F
71!|| intmass_update ../engine/source/interfaces/interf/intmass_update.F
72!|| my_barrier ../engine/source/system/machine.F
73!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
74!|| spmd_barrier ../engine/source/mpi/spmd_mod.F90
75!|| spmd_exch_sorting_efric ../engine/source/mpi/interfaces/spmd_exch_sorting_efric.F
76!|| spmd_get_inacti_global ../engine/source/mpi/interfaces/spmd_get_inacti_global.F
77!|| spmd_get_stif25_edg ../engine/source/mpi/interfaces/spmd_getstif25_edg.f
78!|| spmd_i25front_nor ../engine/source/mpi/interfaces/spmd_i25front.F
79!|| spmd_i7itied_cand ../engine/source/mpi/interfaces/spmd_i7itied_cand.F
80!|| spmd_ifront ../engine/source/mpi/interfaces/spmd_ifront.F
81!|| spmd_ifront_stamp ../engine/source/mpi/interfaces/send_cand.F
82!|| startime ../engine/source/system/timer_mod.F90
83!|| stoptime ../engine/source/system/timer_mod.F90
84!||--- uses -----------------------------------------------------
85!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
86!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
87!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
88!|| groupdef_mod ../common_source/modules/groupdef_mod.f
89!|| h3d_mod ../engine/share/modules/h3d_mod.F
90!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
91!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
92!|| int18_law151_nsv_shift_mod ../common_source/interf/int18_law151_nsv_shift.F
93!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
94!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
95!|| inter_struct_mod ../engine/share/modules/inter_struct_mod.F
96!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.f90
97!|| intstamp_mod ../engine/share/modules/intstamp_mod.F
98!|| metric_mod ../common_source/modules/interfaces/metric_mod.F
99!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
100!|| outputs_mod ../common_source/modules/outputs_mod.F
101!|| sensor_mod ../common_source/modules/sensor_mod.f90
102!|| spmd_mod ../engine/source/mpi/spmd_mod.f90
103!|| timer_mod ../engine/source/system/timer_mod.F90
104!|| tri7box ../engine/share/modules/tri7box.F
105!||====================================================================
106 SUBROUTINE inttri(TIMERS,
107 1 IPARI ,X ,W , ERRORS,
108 2 V ,MS ,IN ,IAD_ELEM ,
109 3 FR_ELEM ,VR ,ISENDTO ,IRECVFROM,
110 4 NEWFRONT ,ITASK ,WAG ,DT2T ,
111 5 ITAB ,NELTST ,ITYPTST ,WEIGHT ,
112 6 INTLIST ,NBINTC ,KINET ,DRETRI ,
113 7 ISLEN7 ,IRLEN7 ,ISLEN11 ,IRLEN11 ,
114 8 TEMP ,IGRBRIC ,IGRSH3N ,EMINX ,
115 9 IXS ,IXS16 ,IXS20 ,ISLEN17 ,
116 A IRLEN17 ,IRLEN7T ,ISLEN7T ,NUM_IMP ,
117 B IND_IMP ,INTSTAMP,THKNOD ,IRLEN20 ,
118 C ISLEN20 ,IRLEN20T,ISLEN20T,IRLEN20E ,
119 D ISLEN20E ,RENUM ,NSNFIOLD,XSLV ,
120 E XMSR ,VSLV ,VMSR ,SIZE_T ,
121 F NODNX_SMS,DXANCG ,IKINE ,DIAG_SMS ,
122 G COUNT_REMSLV, COUNT_REMSLVE,ALE_CONNECTIVITY,
123 H IXTG ,SENSORS ,DELTA_PMAX_GAP ,
124 I INTBUF_TAB ,DELTA_PMAX_GAP_NODE,
125 . IAD_FRNOR,FR_NOR,
126 J NB25_CANDT,NB25_IMPCT,NB25_DST1,NB25_DST2,INTLIST25,
127 K IAD_FREDG,FR_EDG,MAIN_PROC,NATIV_SMS,I_OPT_STOK ,
128 L MULTI_FVM,IPARG ,ELBUF_TAB, H3D_DATA ,T2MAIN_SMS,
129 M LSKYI_SMS_NEW,FORNEQS,INT7ITIED,IDEL7NOK_SAV,MAXDGAP,
130 N T2FAC_SMS,ICODT,ISKEW,FSKYN25,ADDCSRECT,PROCNOR,
131 O INTER_STRUCT,SORT_COMM,RENUM_SIZ,NODNX_SMS_SIZ,TEMP_SIZ,
132 P INTERFACES,GLOB_THERM,component)
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
151 USE sensor_mod
152 USE outputs_mod
153 USE interfaces_mod
154 USE glob_therm_mod
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
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
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 !
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
1628 END
1629C
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
subroutine i10main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
subroutine i11main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
subroutine i11main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, lskyi_sms_new)
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
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)
subroutine i17main_crit_tri(ipari, intbuf_tab, x, nin, itask, igrbric, eminx, nme, nmes, xslv _l, xmsr_l, size_t, ixs, ixs16, ixs20)
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)
subroutine i20main_opt_tri(ipari, x, v, nin, itask, count_remslv, count_remslve, intbuf_tab)
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
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
subroutine i21main_crit_tri(ipari, intbuf_tab, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intstamp, x21msr, v21msr)
subroutine i21main_gap(ipari, intbuf_tab, nin, itask, thknod)
Definition i21main_gap.F:36
subroutine i21main_opt_tri(timers, ipari, intbuf_tab, nin, itask, intstamp, nb_stok_n, nb_jlt)
subroutine i21main_tri(timers, ipari, x, nin, itask, weight, retri, num_imp, ind_imp, intstamp, mwag, intbuf_tab, nspmd)
Definition i21main_tri.F:47
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
subroutine i22subvol(x, nin, itask, ipari, itab, ixs, ixtg, v, iparg, elbuf_tab, w, igrsh3n)
Definition i22subvol.F:40
subroutine i23main_opt_tri(ipari, intbuf_tab, nin, itask, count_remslv, x)
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
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)
subroutine i24main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, t2main_sms, lskyi_sms_new)
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
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)
subroutine i25main_free(timers, itask, ipari, intbuf_tab, intlist25, isendto, irecvfrom)
subroutine i25main_gap(ipari, intbuf_tab, nin, itask, thknod, maxdgap)
Definition i25main_gap.F:36
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)
subroutine i25main_opt_tri(nin, ipari, intbuf_tab, x, v, itask, itab, kinet, count_remslv, count_remslve, nb_candt, i_opt_stok)
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)
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
subroutine i25maind_2(ipari, itab, sensor_tab, intlist25, intbuf_tab, x, v, kinet, jtask, nb_dst2, icodt, iskew, nsensor)
Definition i25maind_2.F:40
subroutine i7main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
subroutine i7main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
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
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
subroutine inter_check_sort(itask, need_to_sort, nbintc, intlist, ipari, nsensor, intbuf_tab, sensor_tab, nb_inter_sorted, list_inter_sorted, inter_struct)
subroutine inter_deallocate_wait(itask, nb_inter_sorted, list_inter_sorted, ipari, nsensor, irecvfrom, sensor_tab, inter_struct, sort_comm)
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)
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
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
subroutine intmass_update(nin, ipari, intbuf_tab, ms)
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)
Definition inttri.F:133
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
type(brick_entity), dimension(:,:), allocatable, target brick_list
subroutine int18_law151_nsv_shift(mode, itask, nthread, multi_fvm, ipari, intbuf_tab, npari, ninter, numnod, opt_int_id)
integer, parameter i_main_tri
Definition metric_mod.F:54
integer, parameter i_main_opt_tri
Definition metric_mod.F:55
integer, parameter i_main_crit_tri
Definition metric_mod.F:53
integer ninefric
Definition outputs_mod.F:65
subroutine spmd_ifront_stamp(ipari, nsensor, intbuf_tab, retri, temp, sensor_tab, nbintc21, intlist21)
Definition send_cand.F:1602
subroutine spmd_allglob_isum9(v, len)
subroutine spmd_exch_sorting_efric(ipari, intlist, nbintc, islen7, irlen7, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, intbuf_tab, h3d_data)
subroutine spmd_get_inacti_global(ipari, nb_inter_sorted, list_inter_sorted, inter_struct)
subroutine spmd_get_stif25_edg(stfe, nedge, ledge, nin, isendto, ircvfrom, comm, rank, comsize)
subroutine spmd_i25front_nor(ipari, intbuf_tab, intlist25, x)
subroutine spmd_i7itied_cand(flag, nbintc, ipari, intlist, intbuf_tab)
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
subroutine i21reset(nsn, irtlm, csts)
Definition i21reset.F:29
subroutine my_barrier
Definition machine.F:31
subroutine startime(event, itask)
Definition timer.F:93
subroutine stoptime(event, itask)
Definition timer.F:135
subroutine int_stoptime(this, event)
subroutine int_startime(this, event)