OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
intcrit.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "task_c.inc"
#include "warn_c.inc"
#include "units_c.inc"
#include "timeri_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ intcrit()

subroutine intcrit ( type(timer_) timers,
integer, intent(inout) errors,
integer, dimension(npari,*) ipari,
integer, dimension(*) newfront,
integer, dimension(ninter+1,*) isendto,
integer, intent(in) nsensor,
integer, dimension(ninter+1,*) ircvfrom,
dt2t,
integer neltst,
integer ityptst,
integer, dimension(*) itab,
xslv,
xmsr,
vslv,
vmsr,
integer, dimension(*) intlist,
integer nbintc,
size_t,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
delta_pmax_gap,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) delta_pmax_gap_node,
integer idel7nok_sav,
maxdgap,
dimension(3,numnod), intent(in) v )
Parameters
[in,out]errorsnumber of errors (vmaxdt too high, ...)

Definition at line 43 of file intcrit.F.

49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE timer_mod
53 USE intbufdef_mod
54 USE interface_modification_mod
55 USE sensor_mod
56 USE tri7box
57C----6---------------------------------------------------------------7---------8
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "param_c.inc"
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "com08_c.inc"
68#include "task_c.inc"
69#include "warn_c.inc"
70#include "units_c.inc"
71#include "timeri_c.inc"
72#include "sms_c.inc"
73C-----------------------------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 TYPE(TIMER_) :: TIMERS
77 my_real, intent(in) :: v(3,numnod)
78 INTEGER, INTENT(INOUT) :: ERRORS !< number of errors (vmaxdt too high, ...)
79 INTEGER ,INTENT(IN) :: NSENSOR
80 INTEGER IPARI(NPARI,*),
81 . NELTST,ITYPTST,NBINTC,INTLIST(*),NEWFRONT(*), ITAB(*),
82 . ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*),DELTA_PMAX_GAP_NODE(*),IDEL7NOK_SAV
83 my_real :: dt2t
84 my_real :: xslv(18,*), xmsr(12,*), vslv(6,*), vmsr(6,*),
85 . size_t(*),delta_pmax_gap(*),maxdgap(ninter)
86
87 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
88 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 LOGICAL, DIMENSION(NINTER) :: FORCE_COMPUTATION
93 INTEGER I,J,KK,IGN,IGE,JJ, NSN, NMN,
94 . IAD,K,N,IADD,ICOMP,NTY,NME,NMES,NMET,
95 . NBNEW, LISTNEW(NBINTC), ISENS, INTERACT,DELTA_PMAX_GAP_NOD
96 INTEGER :: JMAX
97 my_real
98 . xx,xy,xz,dist0,vx,vy,vz,gapinf,vv,dti,vmaxdt,
99 . startt, stopt, minbox,tzinfl,gapsup,pmax_gap,
100 . marge0,tzinf(nbintc),criterl(nbintc),ts ,
101 . xxp,xyp,xzp,xxg,xyg,xzg,d0,d1,d2,d3,d4,d5,d6,d7,d8,
102 . delta_pmax_gap_sav(ninter)
103C-----------------------------------------------
104C F u n c t i o n s
105C-----------------------------------------------
106 IF(debug(3)>=1) THEN
107 delta_pmax_gap_sav(1:ninter)=delta_pmax_gap(1:ninter)
108 delta_pmax_gap_nod=0
109 ENDIF
110 force_computation(1:ninter) = .false.
111C
112C Precalcul des interfaces utiles
113C
114 nbnew = 0
115 DO kk=1,nbintc
116 i = intlist(kk)
117 nty =ipari(7,i)
118C
119 interact = 0
120 isens = 0
121 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 21.OR.
122 . nty == 5.OR.nty == 19.OR.nty == 25) isens = ipari(64,i)
123 IF (isens > 0) THEN
124 ts = sensor_tab(isens)%TSTART
125 IF (tt>=ts) interact = 1
126 stopt = huge(stopt)
127 ELSE
128 startt = intbuf_tab(i)%VARIABLES(3)
129 stopt = intbuf_tab(i)%VARIABLES(11)
130 IF (startt<=tt.AND.tt<=stopt) interact = 1
131 ENDIF
132C
133 IF(interact/=0.OR.(nty==25 .AND. tt <= stopt)) THEN
134 nbnew = nbnew + 1
135 listnew(nbnew) = i
136 tzinf(nbnew) = intbuf_tab(i)%VARIABLES(8)
137 IF(nsnfi_flag(i)==1)THEN
138 nsnfi(i)%P(1:nspmd)=nsnfi_sav(i)%P(1:nspmd)
139 DEALLOCATE(nsnfi_sav(i)%P)
140
141 nsnsi(i)%P(1:nspmd)=nsnsi_sav(i)%P(1:nspmd)
142 DEALLOCATE(nsnsi_sav(i)%P)
143
144 nsnfi_flag(i)=0
145 ENDIF
146 ENDIF
147
148 ! when INTERACT == 0 and NSNFI_FLAG==1 is a change in state of Sensors,
149 ! Sensor was just deactivated but SPMD Buffers where not cleaned.
150 ! Sav buffers NSNFI/NSNSI Buffers & clean the original once.
151
152 IF(interact == 0 .AND.nsnfi_flag(i)==0.AND.nty/=25)THEN
153 ALLOCATE(nsnsi_sav(i)%P(nspmd))
154 ALLOCATE(nsnfi_sav(i)%P(nspmd))
155 nsnsi_sav(i)%P(1:nspmd) = nsnsi(i)%P(1:nspmd)
156 nsnfi_sav(i)%P(1:nspmd) = nsnfi(i)%P(1:nspmd)
157 nsnfi_flag(i)=1
158 nsnfi(i)%P(1:nspmd) = 0
159 nsnsi(i)%P(1:nspmd) = 0
160 ENDIF
161C
162 ENDDO
163C
164C Communication si SPMD
165C
166 IF(nspmd>1)THEN
167 IF (imonm > 0) CALL startime(timers,27)
168 CALL spmd_sync_mmxg2(
169 1 isendto,ircvfrom,newfront,xslv ,xmsr ,
170 2 vslv ,vmsr ,listnew ,nbnew ,tzinf ,
171 3 size_t ,ipari , delta_pmax_gap ,maxdgap)
172 IF (imonm > 0) CALL stoptime(timers,27)
173 END IF
174C
175 DO kk=1,nbnew
176 i = listnew(kk)
177 nty=ipari(7,i)
178 IF (nty/=24.AND.nty/=25)THEN
179 intbuf_tab(i)%VARIABLES(8)=tzinf(kk)
180 ENDIF
181
182 IF(nty==25.AND.newfront(i)==-2) force_computation(i) = .true.
183C
184C Comm supplementaire sur partie stiffness
185C
186 IF(nspmd>1) THEN
187 IF (newfront(i)<0)THEN
188 IF(nty==7.OR.nty==10.OR.nty==23.OR.nty==24) THEN
189 CALL spmd_get_stif(
190 1 newfront(i) ,intbuf_tab(i)%I_STOK(1) ,
191 2 intbuf_tab(i)%CAND_N,intbuf_tab(i)%STFNS,
192 3 ipari(5,i),i,isendto,ircvfrom,intbuf_tab(i)%NSV,
193 4 itab)
194 ELSEIF(nty==11) THEN
195 CALL spmd_get_stif11(
196 1 newfront(i) ,intbuf_tab(i)%I_STOK(1),
197 2 intbuf_tab(i)%CAND_N, intbuf_tab(i)%STFS,
198 3 ipari(3,i),i,isendto,ircvfrom,intbuf_tab(i)%IRECTS,
199 4 itab)
200 ELSEIF(nty==20) THEN
201 CALL spmd_get_stif20(
202 1 newfront(i) ,intbuf_tab(i)%I_STOK(1) ,
203 2 intbuf_tab(i)%CAND_N,intbuf_tab(i)%STFA,
204 3 ipari(5,i),i,isendto,ircvfrom,intbuf_tab(i)%NSV,
205 4 itab,intbuf_tab(i)%NLG)
206 CALL spmd_get_stif20e(
207 1 newfront(i) ,nint(intbuf_tab(i)%VARIABLES(20)) ,
208 2 intbuf_tab(i)%LCAND_S,intbuf_tab(i)%STFS,
209 3 ipari(53,i),i,isendto,ircvfrom,intbuf_tab(i)%IXLINS,
210 4 itab, intbuf_tab(i)%NLG )
211 ELSEIF(nty==25) THEN
212 CALL spmd_get_stif25(
213 1 newfront(i) , intbuf_tab(i)%STFNS,ipari(5,i),
214 3 i,isendto,ircvfrom,intbuf_tab(i)%NSV,
215 4 itab)
216 ENDIF
217 ENDIF
218 ELSE
219 newfront(i) = 0
220 ENDIF
221
222C=======================================================================
223 IF(nty == 17)THEN
224C=======================================================================
225 IF(ipari(33,i) == 0)THEN
226C penser a faire le cumul des SIZE_T
227C
228 ign = ipari(36,i)
229 ige = ipari(34,i)
230c NMES= IGROUP(2,IGN)
231c NME = IGROUP(2,IGE)
232 nmes= ipari(5,i)
233 nme = ipari(4,i)
234 nmet= nme+nmes
235C formula tion changed NME+NMES instead of NME and et 6 au lieu de 18
236 tzinf(kk) = intbuf_tab(i)%VARIABLES(4) * size_t(i) / nmet / 6
237 intbuf_tab(i)%VARIABLES(8) = tzinf(kk)
238 minbox = intbuf_tab(i)%VARIABLES(5) * size_t(i) / nmet / 6
239 intbuf_tab(i)%VARIABLES(12) = minbox
240C
241 xx = max(xslv(1,i)-xmsr(4,i),xmsr(1,i)-xslv(4,i),zero)
242 xy = max(xslv(2,i)-xmsr(5,i),xmsr(2,i)-xslv(5,i),zero)
243 xz = max(xslv(3,i)-xmsr(6,i),xmsr(3,i)-xslv(6,i),zero)
244 dist0 = xx**2 + xy**2 + xz**2
245C
246C Te st sur pas de temps sur l'interface
247C
248 IF(dist0>=tzinf(kk)**2.OR.kforsms/=0) THEN
249C DIST = -1
250 intbuf_tab(i)%VARIABLES(5)= -intbuf_tab(i)%VARIABLES(5)
251 IF(debug(3)>=1.AND.ncycle/=0) THEN
252 WRITE(istdo,'(A,I10,A,I8,A,I4)')
253 . '** NEW SORT FOR INTERFACE NUMBER ',
254 . ipari(15,i), ' AT CYCLE ',ncycle,' ON PROC',ispmd+1
255 WRITE(iout,'(A,I10,A,I8,A,I4)')
256 . '** NEW SORT FOR INTERFACE NUMBER ',
257 . ipari(15,i), ' AT CYCLE ',ncycle,' ON PROC',ispmd+1
258 ENDIF
259 ENDIF
260 ENDIF
261C=======================================================================
262 ELSEIF(nty == 24)THEN
263C=======================================================================
264c deplacement relatif
265 xx = max(xslv(1,i)-xmsr(4,i),xmsr(1,i)-xslv(4,i),zero)
266 xy = max(xslv(2,i)-xmsr(5,i),xmsr(2,i)-xslv(5,i),zero)
267 xz = max(xslv(3,i)-xmsr(6,i),xmsr(3,i)-xslv(6,i),zero)
268c deplacement relatif + gap
269c XXG = MAX(XSLV(7,I)-XMSR(10,I),XMSR(7,I)-XSLV(10,I),ZERO)
270c XYG = MAX(XSLV(8,I)-XMSR(11,I),XMSR(8,I)-XSLV(11,I),ZERO)
271c XZG = MAX(XSLV(9,I)-XMSR(12,I),XMSR(9,I)-XSLV(12,I),ZERO)
272c deplacement relatif + pene-gap (PENE_OLD(3,i))
273c XXP = MAX(XSLV(13,I)-XMSR(4,I),XMSR(1,I)-XSLV(16,I),ZERO)
274c XYP = MAX(XSLV(14,I)-XMSR(5,I),XMSR(2,I)-XSLV(17,I),ZERO)
275c XZP = MAX(XSLV(15,I)-XMSR(6,I),XMSR(3,I)-XSLV(18,I),ZERO)
276c
277c DEPLA_MAX = SQRT(XX**2+XY*2+XZ*2) + MAX(gap,pene-gap)
278c
279c D0 = SQRT(XX**2+XY**2+XZ**2)
280c D1 = SQRT(XXG**2+XYG**2+XZG**2)
281c D2 = SQRT(XXP**2+XYP**2+XZP**2)
282c D3 = XXG+XY+XZ
283c D4 = XX+XYG+XZ
284c D5 = XX+XY+XZG
285c D6 = XXP+XY+XZ
286c D7 = XX+XYP+XZ
287c D8 = XX+XY+XZP
288c
289c DEPLA_MAX + MAX(gap,pene-gap) <
290c min(D0+max(gapmax,penmax), max(D1,D2) , max(D3:D8))
291
292 d0 = sqrt(xx**2+xy**2+xz**2)
293c D1 = SQRT(XXG**2+XYG**2+XZG**2)
294c D2 = SQRT(XXP**2+XYP**2+XZP**2)
295c D3 = XXG+XY+XZ
296c D4 = XX+XYG+XZ
297c D5 = XX+XY+XZG
298c D6 = XXP+XY+XZ
299c D7 = XX+XYP+XZ
300c D8 = XX+XY+XZP
301
302 vx = max(vslv(1,i)-vmsr(4,i),vmsr(1,i)-vslv(4,i),zero)
303 vy = max(vslv(2,i)-vmsr(5,i),vmsr(2,i)-vslv(5,i),zero)
304 vz = max(vslv(3,i)-vmsr(6,i),vmsr(3,i)-vslv(6,i),zero)
305 vv = sqrt(vx**2+vy**2+vz**2)
306
307 tzinfl = intbuf_tab(i)%VARIABLES(8)
308 gapsup = intbuf_tab(i)%VARIABLES(2)
309
310C--------
311C
312c VMAXDT can be optimize : VMAXDT is a local overestimate of relative
313c velocity between local main nodes and ALL secnd nodes
314c (no need to communicate VMAXDT in SPMD)
315 vmaxdt = onep01*vv*dt1
316 intbuf_tab(i)%VARIABLES(24) = vmaxdt
317 ! MARGE0 defined at starter I24BUC1 as BUMULT * DD
318 ! where BUMULT is a an arbitrary parameter
319 ! DD = average length of edges of main segments
320 marge0 = intbuf_tab(i)%VARIABLES(25)
321
322 pmax_gap = intbuf_tab(i)%VARIABLES(23)
323
324
325 ! D0 = maximum relative displacements between main and secondary
326 ! MARGE0 = some kind of safety margin, we already have the possible candidates within this margin
327 ! DELTA_PMAX_GAP = related to penetration
328 dist0 = marge0 - onep01*(d0 + vmaxdt + delta_pmax_gap(i))
329
330 intbuf_tab(i)%VARIABLES(5) = dist0
331
332 IF(dist0<=zero.OR.kforsms/=0) THEN
333C DIST = -1
334 intbuf_tab(i)%VARIABLES(5) = -one
335c
336
337 IF(debug(3)>=1) THEN
338
339 IF(delta_pmax_gap_sav(i) == delta_pmax_gap(i)) delta_pmax_gap_nod=delta_pmax_gap_node(i)
340
341 WRITE(istdo,'(A,I10,A,I8,A,F20.10,A,F20.10,A,F20.10,A,
342 . F20.10,A,F14.7,A,F20.10,A,I10,A,I4)')
343 . '** NEW SORT INTERFACE ',ipari(15,i),' CYCLE ',
344 . ncycle,' T',tt,' DIST0 ',dist0,' : MARGE0',marge0,
345 . ' D0',d0,' VMAXDT ', vmaxdt ,' DELTA_PMAX_GAP ',delta_pmax_gap(i),' NODE: ',delta_pmax_gap_nod,' PROC',
346 . ispmd+1
347
348c WRITE(IOUT,'(A,I10,A,I8,A,F14.10,A,F14.10,A,F14.10,A,
349c . F20.10,A,F14.7,A,F20.10,A,I4)')
350 WRITE(iout,*)
351 . '** NEW SORT INTERFACE ',ipari(15,i),' CYCLE ',
352 . ncycle,' T',tt,' DIST0',dist0,' : MARGE0',marge0,
353 . ' D0',d0,' VMAXDT ', vmaxdt ,' DELTA_PMAX_GAP ',delta_pmax_gap(i),' NODE: ',delta_pmax_gap_nod,' PROC',
354 . ispmd+1
355 ENDIF
356 ENDIF
357C=======================================================================
358 ELSEIF(nty == 25)THEN
359C=======================================================================
360c deplacement relatif
361 xx = max(xslv(1,i)-xmsr(4,i),xmsr(1,i)-xslv(4,i),zero)
362 xy = max(xslv(2,i)-xmsr(5,i),xmsr(2,i)-xslv(5,i),zero)
363 xz = max(xslv(3,i)-xmsr(6,i),xmsr(3,i)-xslv(6,i),zero)
364
365 d0 = sqrt(xx**2+xy**2+xz**2)
366 vx = max(vslv(1,i)-vmsr(4,i),vmsr(1,i)-vslv(4,i),zero)
367 vy = max(vslv(2,i)-vmsr(5,i),vmsr(2,i)-vslv(5,i),zero)
368 vz = max(vslv(3,i)-vmsr(6,i),vmsr(3,i)-vslv(6,i),zero)
369 vv = sqrt(vx**2+vy**2+vz**2)
370
371 tzinfl = intbuf_tab(i)%VARIABLES(8)
372 gapsup = intbuf_tab(i)%VARIABLES(2)
373
374C--------
375C
376c VMAXDT can be optimize : VMAXDT is a local overestimate of relative
377c velocity between local main nodes and ALL secnd nodes
378c (no need to communicate VMAXDT in SPMD)
379 vmaxdt = onep01*vv*dt1
380! If VMAXDT > MARGE0, the run is likely diverging.
381! At next cycle DIST0 should also be negative, triggering
382! a new collision detection search.
383 intbuf_tab(i)%VARIABLES(24) = vmaxdt
384 marge0 = intbuf_tab(i)%VARIABLES(25) !starter value i25buc_vox1.F
385
386 dist0 = marge0 - onep01*(d0 + vmaxdt + maxdgap(i))
387
388 intbuf_tab(i)%VARIABLES(5) = dist0
389
390
391
392 IF(vmaxdt > five * marge0) THEN
393 ! assuming that MARGE0 is identical on all processors
394 errors = errors + 1
395 IF(ispmd == 0) THEN
396 WRITE(istdo,'(A,I10)') "ERROR: NODAL VELOCITY IS TOO HIGH
397 . FOR INTERFACE",ipari(15,i)
398 WRITE(iout,'(A,I10)') "ERROR: NODAL VELOCITY IS TOO HIGH
399 . FOR INTERFACE",ipari(15,i)
400 ENDIF
401 nsn = ipari(5,i)
402 nmn = ipari(6,i)
403 d1 = zero
404 jmax = 1
405 DO jj=1,nsn
406 j=intbuf_tab(i)%NSV(jj)
407 IF(intbuf_tab(i)%STFNS(jj)/=zero .AND. j<=numnod .AND. j > 0) THEN
408 vx = v(1,j)
409 vy = v(2,j)
410 vz = v(3,j)
411 IF( sqrt(vx**2+vy**2+vz**2) > d1) THEN
412 d1 = sqrt(vx**2+vy**2+vz**2)
413 jmax = j
414 ENDIF
415 ENDIF
416 END DO
417 DO jj=1,nmn
418 j=intbuf_tab(i)%MSR(jj)
419 IF(j>0 .AND. j <= numnod) THEN
420 vx = v(1,j)
421 vy = v(2,j)
422 vz = v(3,j)
423 IF( sqrt(vx**2+vy**2+vz**2) > d1) THEN
424 d1 = sqrt(vx**2+vy**2+vz**2)
425 jmax = j
426 ENDIF
427 ENDIF
428 ENDDO
429 IF(d1 > five * marge0 /two ) THEN
430 WRITE(istdo,*) "ERROR: NODAL VELOCITY IS TOO HIGH FOR NODE",itab(jmax),d1
431 WRITE(iout,*) "ERROR: NODAL VELOCITY IS TOO HIGH FOR NODE",itab(jmax),d1
432 ENDIF
433 intbuf_tab(i)%VARIABLES(24) = marge0
434 ENDIF
435
436
437 IF(dist0<=zero.OR.kforsms/=0.OR.force_computation(i)) THEN
438C DIST = -1
439 intbuf_tab(i)%VARIABLES(5) = -one
440c
441 IF(debug(3)>=1) THEN
442
443 WRITE(istdo,'(A,I10,A,I8,A,F20.10,A,F20.10,A,F20.10,A,
444 . F20.10,A,F14.7,A,I4)')
445 . '** NEW SORT INTERFACE ',ipari(15,i),' CYCLE ',
446 . ncycle,' T',tt,' DIST0 ',dist0,' : MARGE0',marge0,
447 . ' D0',d0,' VMAXDT ', vmaxdt ,' PROC',ispmd+1
448
449c WRITE(IOUT,'(A,I10,A,I8,A,F14.10,A,F14.10,A,F14.10,A,
450c . F20.10,A,F14.7,A,F20.10,A,I4)')
451 WRITE(iout,*)
452 . '** NEW SORT INTERFACE ',ipari(15,i),' CYCLE ',
453 . ncycle,' T',tt,' DIST0',dist0,' : MARGE0',marge0,
454 . ' D0',d0,' VMAXDT ', vmaxdt ,' PROC',ispmd+1
455 ENDIF
456 ENDIF
457C=======================================================================
458 ELSE ! all other NTYP
459C=======================================================================
460c a optimiser pour l'interface type 7 (cf type 24)
461 xx = max(xslv(1,i)-xmsr(4,i),xmsr(1,i)-xslv(4,i),zero)
462 xy = max(xslv(2,i)-xmsr(5,i),xmsr(2,i)-xslv(5,i),zero)
463 xz = max(xslv(3,i)-xmsr(6,i),xmsr(3,i)-xslv(6,i),zero)
464
465 vx = max(vslv(1,i)-vmsr(4,i),vmsr(1,i)-vslv(4,i),zero)
466 vy = max(vslv(2,i)-vmsr(5,i),vmsr(2,i)-vslv(5,i),zero)
467 vz = max(vslv(3,i)-vmsr(6,i),vmsr(3,i)-vslv(6,i),zero)
468 vv = sqrt(vx**2+vy**2+vz**2)
469
470 tzinfl = intbuf_tab(i)%VARIABLES(8)
471 gapsup = intbuf_tab(i)%VARIABLES(2)
472
473C--------
474C
475C maj dist = tzinf - gap (recalculee en fct de tzinf modifie en SPMD)
476C
477 tzinfl = intbuf_tab(i)%VARIABLES(8)
478 IF(nty==23)THEN
479 intbuf_tab(i)%VARIABLES(5) = tzinfl-sqrt(three)*gapsup
480 ELSE
481 intbuf_tab(i)%VARIABLES(5) = tzinfl-gapsup
482 END IF
483C
484 dist0 = intbuf_tab(i)%VARIABLES(5) - sqrt(xx**2+xy**2+xz**2)
485C
486C Test sur pas de temps sur l'interface
487C
488 IF (vv/=zero) THEN
489 gapinf =intbuf_tab(i)%VARIABLES(6)
490 IF (gapinf==zero) gapinf = intbuf_tab(i)%VARIABLES(2)
491 dti = zep9*gapinf/vv
492 IF(dti<dt2t) THEN
493 dt2t = dti
494 neltst = ipari(15,i)
495 ityptst = 10
496 ENDIF
497 ENDIF
498C--------
499
500 IF(dist0<=zero.OR.kforsms/=0) THEN
501C DIST = -1
502 intbuf_tab(i)%VARIABLES(5) = -one
503 IF(debug(3)>=1.AND.ncycle/=0) THEN
504 WRITE(istdo,'(A,I10,A,I4,A,I8,A,I4,A,I4,A,F20.10,A,F20.10,A,F20.10)')
505 . '** NEW SORT FOR INTERFACE NUMBER ',
506 . ipari(15,i),' TYPE ',nty,
507 . ' AT CYCLE ',ncycle,' ON PROC',ispmd+1,' I19FLAG ',ipari(7,i),
508 . ' DIST0 ',dist0,' TZINF ',intbuf_tab(i)%VARIABLES(8),' GAP ',
509 . intbuf_tab(i)%VARIABLES(2)
510
511 WRITE(iout,'(A,I10,A,I4,A,I8,A,I4,A,I4,A,F20.10,A,F20.10,A,F20.10)')
512 . '** NEW SORT FOR INTERFACE NUMBER ',
513 . ipari(15,i),' TYPE ',nty,
514 . ' AT CYCLE ',ncycle,' ON PROC',ispmd+1,' I19FLAG ',ipari(7,i),
515 . ' DIST0 ',dist0,' TZINF ',intbuf_tab(i)%VARIABLES(8),' GAP ',
516 . intbuf_tab(i)%VARIABLES(2)
517 ENDIF
518 ENDIF
519C=======================================================================
520 ENDIF
521 ENDDO
522C
523 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
interface_modification_mod
Definition interface_modification_mod.F:33
interface_modification_mod::nsnsi_sav
type(int_pointer), dimension(:), allocatable nsnsi_sav
Definition interface_modification_mod.F:35
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi_sav
type(int_pointer), dimension(:), allocatable nsnfi_sav
Definition tri7box.F:440
tri7box::nsnfi_flag
integer, dimension(:), allocatable nsnfi_flag
Definition tri7box.F:530
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_get_stif20
subroutine spmd_get_stif20(newfront, i_stok, cand_n, stfa, nsn, nin, isendto, ircvfrom, nsv, itab, nlg)
Definition send_cand.F:424
spmd_get_stif20e
subroutine spmd_get_stif20e(newfront, i_stok, cand_s, stfs, nlinsa, nin, isendto, ircvfrom, ixlins, itab, nlg)
Definition send_cand.F:708
spmd_get_stif11
subroutine spmd_get_stif11(newfront, i_stok, cand_s, stfs, nrts, nin, isendto, ircvfrom, irects, itab)
Definition send_cand.F:566
spmd_get_stif
subroutine spmd_get_stif(newfront, i_stok, cand_n, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
Definition send_cand.F:156
spmd_get_stif25
subroutine spmd_get_stif25(newfront, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
Definition send_cand.F:297
spmd_sync_mmxg2
subroutine spmd_sync_mmxg2(isendto, ircvfrom, newfront, xslv_l, xmsr_l, vslv_l, vmsr_l, intlist, nintc, tzinf, size_t, ipari, delta_pmax_gap, maxdgap)
Definition spmd_sync_mmxg2.F:34
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135