OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
intcrit.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!|| intcrit ../engine/source/interfaces/intsort/intcrit.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| spmd_get_stif ../engine/source/mpi/interfaces/send_cand.F
29!|| spmd_get_stif11 ../engine/source/mpi/interfaces/send_cand.F
30!|| spmd_get_stif20 ../engine/source/mpi/interfaces/send_cand.F
31!|| spmd_get_stif20e ../engine/source/mpi/interfaces/send_cand.F
32!|| spmd_get_stif25 ../engine/source/mpi/interfaces/send_cand.F
33!|| spmd_sync_mmxg2 ../engine/source/mpi/interfaces/spmd_sync_mmxg2.F
34!|| startime ../engine/source/system/timer_mod.F90
35!|| stoptime ../engine/source/system/timer_mod.F90
36!||--- uses -----------------------------------------------------
37!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
38!|| interface_modification_mod ../engine/share/modules/interface_modification_mod.F
39!|| sensor_mod ../common_source/modules/sensor_mod.F90
40!|| timer_mod ../engine/source/system/timer_mod.F90
41!|| tri7box ../engine/share/modules/tri7box.F
42!||====================================================================
43 SUBROUTINE intcrit(TIMERS,
44 1 ERRORS, IPARI ,NEWFRONT,ISENDTO,NSENSOR ,
45 2 IRCVFROM,DT2T ,NELTST ,ITYPTST ,ITAB ,
46 3 XSLV ,XMSR ,VSLV ,VMSR ,INTLIST,
47 4 NBINTC ,SIZE_T ,SENSOR_TAB,DELTA_PMAX_GAP,
48 5 INTBUF_TAB,DELTA_PMAX_GAP_NODE,IDEL7NOK_SAV,MAXDGAP, V )
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
524 END
intcrit
subroutine intcrit(timers, errors, ipari, newfront, isendto, nsensor, ircvfrom, dt2t, neltst, ityptst, itab, xslv, xmsr, vslv, vmsr, intlist, nbintc, size_t, sensor_tab, delta_pmax_gap, intbuf_tab, delta_pmax_gap_node, idel7nok_sav, maxdgap, v)
Definition intcrit.F:49
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