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 44 of file intcrit.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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