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