OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i16crit.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!|| i16crit ../engine/source/interfaces/int16/i16crit.F
25!||--- called by ------------------------------------------------------
26!|| i16main ../engine/source/interfaces/int16/i16main.F
27!||--- calls -----------------------------------------------------
28!|| i10box ../engine/source/interfaces/int16/i16crit.F
29!|| i16box ../engine/source/interfaces/int16/i16crit.F
30!|| i20box ../engine/source/interfaces/int16/i16crit.F
31!|| i8box ../engine/source/interfaces/int16/i16crit.f
32!||--- uses -----------------------------------------------------
33!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
34!||====================================================================
35 SUBROUTINE i16crit(
36 1 X ,NSV ,NELEM ,NSN ,EMINX ,
37 2 NME ,ITASK ,XSAV ,IXS ,IXS16 ,
38 3 IXS20 ,IXS10 ,V ,A ,XMSRG,
39 4 XSLVG )
40C-----------------------------------------------
41 USE intbufdef_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "com08_c.inc"
56#include "task_c.inc"
57 COMMON /i16tmp/SIZE
58 my_real
59 . SIZE
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 my_real, DIMENSION(7) :: xmsrg
64 my_real, DIMENSION(7) :: xslvg
65 INTEGER NSN,NMN,ITASK,NME,
66 . NSV(*),NELEM(*),IXS(NIXS,*),IXS16(8,*),IXS20(12,*),
67 . ixs10(6,*)
68 my_real
69 . x(3,*),v(3,*),a(3,*),xsav(3,*),eminx(6,*)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER NSNF,NMEF,NSNL,NMEL,I, J, II, K,I16,I20,LFT16,LLT16,
74 . LFT20,LLT20,LFT8,LLT8,LFT10,LLT10,I8,I10,
75 . INDEX16(MVSIZ),INDEX20(MVSIZ),INDEX8(MVSIZ),INDEX10(MVSIZ)
76 my_real
77 . xmsr(6),xslv(6),size_t ,xx,yy,zz
78C-----------------------------------------------
79C S o u r c e L i n e s
80C-----------------------------------------------
81 nsnf = 1 + itask*nsn / nthread
82 nsnl = (itask+1)*nsn / nthread
83 nmef = 1 + itask*nme / nthread
84 nmel = (itask+1)*nme / nthread
85C--------------------------------------------------------------
86C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
87C--------------------------------------------------------------
88 xslv(1) = -ep30
89 xslv(2) = -ep30
90 xslv(3) = -ep30
91 xslv(4) = ep30
92 xslv(5) = ep30
93 xslv(6) = ep30
94 xmsr(1) = -ep30
95 xmsr(2) = -ep30
96 xmsr(3) = -ep30
97 xmsr(4) = ep30
98 xmsr(5) = ep30
99 xmsr(6) = ep30
100C
101 size_t = zero
102C
103 DO i=nsnf,nsnl
104 j=nsv(i)
105 xx=x(1,j)+dt2*(v(1,j)+dt12*a(1,j))
106 yy=x(2,j)+dt2*(v(2,j)+dt12*a(2,j))
107 zz=x(3,j)+dt2*(v(3,j)+dt12*a(3,j))
108 xslv(1)=max(xslv(1),xx-xsav(1,j))
109 xslv(2)=max(xslv(2),yy-xsav(2,j))
110 xslv(3)=max(xslv(3),zz-xsav(3,j))
111 xslv(4)=min(xslv(4),xx-xsav(1,j))
112 xslv(5)=min(xslv(5),yy-xsav(2,j))
113 xslv(6)=min(xslv(6),zz-xsav(3,j))
114 END DO
115C------------------------------------
116C CALCUL DES BORNES DES ELEMENTS
117C------------------------------------
118 DO i=nmef,nmel
119 eminx(1,i) = ep30
120 eminx(2,i) = ep30
121 eminx(3,i) = ep30
122 eminx(4,i) = -ep30
123 eminx(5,i) = -ep30
124 eminx(6,i) = -ep30
125 ENDDO
126C
127 lft16=1
128 llt16=0
129 lft20=1
130 llt20=0
131 lft8 =1
132 llt8 =0
133 lft10=1
134 llt10=0
135 DO i=nmef,nmel
136 i8 = nelem(i)
137 i10 = i8-numels8
138 i20 = i10-numels10
139 i16 = i20-numels20
140 IF(i16>=1.AND.i16<=numels16)THEN
141 llt16=llt16+1
142 index16(llt16)=i
143 IF(llt16==mvsiz-1)THEN
144 CALL i16box(
145 1 lft16,llt16 ,nelem,eminx,nmef ,nmel ,
146 2 x ,v ,a ,ixs ,ixs16,size_t,
147 3 xmsr ,index16,xsav )
148 llt16=0
149 ENDIF
150 ELSEIF(i20>=1.AND.i20<=numels20)THEN
151 llt20=llt20+1
152 index20(llt20)=i
153 IF(llt20==mvsiz-1)THEN
154 CALL i20box(
155 1 lft20,llt20 ,nelem,eminx,nmef ,nmel ,
156 2 x ,v ,a ,ixs ,ixs20,size_t,
157 3 xmsr ,index20,xsav )
158 llt20=0
159 ENDIF
160 ELSEIF(i10>=1)THEN
161 llt10=llt10+1
162 index10(llt10)=i
163 IF(llt10==mvsiz-1)THEN
164 CALL i10box(
165 1 lft10,llt10 ,nelem,eminx,nmef ,nmel ,
166 2 x ,v ,a ,ixs ,ixs10,size_t,
167 3 xmsr ,index10,xsav )
168 llt10=0
169 ENDIF
170 ELSEIF(i8>=1)THEN
171 llt8=llt8+1
172 index8(llt8)=i
173 IF(llt8==mvsiz-1)THEN
174 CALL i8box(
175 1 lft8 ,llt8 ,nelem,eminx,nmef ,nmel ,
176 2 x ,v ,a ,ixs ,size_t,
177 3 xmsr ,index8 ,xsav )
178 llt8=0
179 ENDIF
180 ENDIF
181 END DO
182 IF(llt16>0)CALL i16box(
183 1 lft16,llt16 ,nelem,eminx,nmef ,nmel ,
184 2 x ,v ,a ,ixs ,ixs16,size_t,
185 3 xmsr ,index16,xsav )
186 IF(llt20>0)CALL i20box(
187 1 lft20,llt20 ,nelem,eminx,nmef ,nmel ,
188 2 x ,v ,a ,ixs ,ixs20,size_t,
189 3 xmsr ,index20,xsav )
190 IF(llt8>0)CALL i8box(
191 1 lft8 ,llt8 ,nelem,eminx,nmef ,nmel ,
192 2 x ,v ,a ,ixs ,size_t,
193 3 xmsr ,index8 ,xsav )
194 IF(llt10>0)CALL i10box(
195 1 lft10,llt10 ,nelem,eminx,nmef ,nmel ,
196 2 x ,v ,a ,ixs ,ixs10,size_t,
197 3 xmsr ,index10,xsav )
198C
199#include "lockon.inc"
200 xslvg(1)=max(xslvg(1),xslv(1))
201 xslvg(2)=max(xslvg(2),xslv(2))
202 xslvg(3)=max(xslvg(3),xslv(3))
203 xslvg(4)=min(xslvg(4),xslv(4))
204 xslvg(5)=min(xslvg(5),xslv(5))
205 xslvg(6)=min(xslvg(6),xslv(6))
206 xmsrg(1)=max(xmsrg(1),xmsr(1))
207 xmsrg(2)=max(xmsrg(2),xmsr(2))
208 xmsrg(3)=max(xmsrg(3),xmsr(3))
209 xmsrg(4)=min(xmsrg(4),xmsr(4))
210 xmsrg(5)=min(xmsrg(5),xmsr(5))
211 xmsrg(6)=min(xmsrg(6),xmsr(6))
212 SIZE = SIZE + size_t
213#include "lockoff.inc"
214C
215 RETURN
216 END
217!||====================================================================
218!|| i16box ../engine/source/interfaces/int16/i16crit.F
219!||--- called by ------------------------------------------------------
220!|| i16crit ../engine/source/interfaces/int16/i16crit.F
221!|| i17crit ../engine/source/interfaces/int17/i17crit.F
222!||====================================================================
223 SUBROUTINE i16box(LFT ,LLT ,NELEM,EMINX,NMEF,NMEL,
224 2 X ,V ,A ,IXS ,IXS16,SIZE,
225 3 XMSR,INDEX,XSAV )
226C-----------------------------------------------
227C I m p l i c i t T y p e s
228C-----------------------------------------------
229#include "implicit_f.inc"
230C-----------------------------------------------
231C C o m m o n B l o c k s
232C-----------------------------------------------
233#include "com04_c.inc"
234#include "com08_c.inc"
235C-----------------------------------------------
236C D u m m y A r g u m e n t s
237C-----------------------------------------------
238 INTEGER LFT ,LLT,NMEF,NMEL,
239 . IXS(NIXS,*),IXS16(8,*),NELEM(*),INDEX(*)
240C REAL
241 my_real
242 . X(3,*),V(3,*),A(3,*),EMINX(6,*),SIZE,XMSR(*),XSAV(3,*)
243C-----------------------------------------------
244C L o c a l V a r i a b l e s
245C-----------------------------------------------
246 INTEGER I,J,K,L,NE,IFACE,IDIR,IPERM(8,2),N16
247 my_real
248 . an,ax,bn,bx,cn,cx,dx,dn,d4,d8,x1,x2,x3,x4,
249 . x9,x10,x11,x12,xc,xx,xn
250 DATA iperm / 2, 3, 4, 5, 1, 2, 3, 4,
251 2 6, 7, 8, 9, 5, 6, 7, 8/
252C
253C-----------------------------------------------
254C/*
255C
256C ( 7)8==============(14)6=============( 6)7
257C //| //|
258C // | //||
259C // | // ||
260C // | // ||
261C // | // ||
262C (15)7 | (13)5 ||
263C // | // ||
264C // ( 3)4--------------(10)2------//-----( 2)3
265C // / // //
266C // / // //
267C // / // //
268C ( 8)9==============(16)8=============( 5)6 //
269C || / || //
270C || (11)3 (C) || ( 9)1
271C || / || //
272C || / || //
273C || / || //
274C || / ||//
275C ||/ ||/
276C ( 4)5==============(12)4=============( 1)2
277C
278C*/
279C---------------------------------------------------------
280C MONODIM
281C---------------------------------------------------------
282C
283C x
284C / \
285C / (2)
286C (3)
287C /
288C /
289C (1)
290C
291C N1 = -0.5 (1-r)r dN1/dr = r - 0.5
292C N2 = 0.5 (1+r)r dN2/dr = r + 0.5
293C N3 = (1-r^2) dN3/dr = - 2 r
294C
295C x = N1 x1 + N2 x2 + N3 x3
296C x = -0.5 (1-r)r x1 + 0.5 (1+r)r x2 + (1-r^2) x3
297C 2 x = (x1 + x2 - 2 x3) r^2 + (x2-x1) r + 2 x3
298C
299C 0) recherche du point xmax
300C
301C dx/dr = (r - 0.5) x1 + (r + 0.5) x2 - 2 r x3 = 0
302C r = 0.5 (x1 - x2) / (x1 + x2 - 2 x3)
303C
304C 2 x (x1 + x2 - 2 x3) = (x1 + x2 - 2 x3)^2 r^2
305C + (x2-x1)(x1 + x2 - 2 x3) r
306C + 2 (x1 + x2 - 2 x3)x3
307C
308C 2 x (x1 + x2 - 2 x3) = - 0.25 (x1 - x2)^2
309C + 2 (x1 + x2 - 2 x3)x3
310C
311C x = x3 - 0.125 (x1 - x2)^2 / (x1 + x2 - 2 x3)
312C
313C------------------------------------------------------------
314C solution 0 => x < x3 - 0.125 (x1 - x2)^2 / (x1 + x2 - 2 x3)
315C si x3 -> (x1 + x2)/ 2 x -> infini
316C------------------------------------------------------------
317C
318C 1) recherche du point xmax entre 1 et 2
319C
320C si r > 1
321C => x = x2
322C
323C si r < -1
324C => x = x1
325C
326C si -1 < r < 1
327C => -1/4 < 0.125 (x1 - x2) / (x1 + x2 - 2 x3) < 1/4
328C
329C (x - x3)/(x1 - x2) = - 0.125 (x1 - x2) / (x1 + x2 - 2 x3)
330C -1/4 < (x - x3)/ < 1/4
331C
332C si x2 > x1 x3 -1/4 (x2 - x1) < x < x3 + 1/4 (x2 - x1)
333C si x2 < x1 x3 -1/4 (x2 - x1) > x > x3 + 1/4 (x2 - x1)
334C
335C => x3 - 1/4 |x2 - x1| < x < x3 + 1/4 |x2 - x1|
336C
337C------------------------------------------------------------
338C solution 1 => x < max (x1 , x2 , x3 + 1/4 |x2 - x1|)
339C------------------------------------------------------------
340C
341C 2) recherche de la position de x3 la + defavorable
342C
343C x = x3 - 0.125 (x1 - x2)^2 / (x1 + x2 - 2 x3)
344C dx/dx3 = 1 - 0.25 (x1 - x2)^2 / (x1 + x2 - 2 x3)^2 = 0
345C (2 x3 - x1 - x2 )^2 = 0.25 (x2 - x1)^2
346C si x2 > x1 et x3 > (x1 + x2)/2 ou
347C si x2 < x1 et x3 < (x1 + x2)/2
348C (2 x3 - x1 - x2 ) = 0.5 (x2 - x1)
349C x3 = (x1 + x2)/2 + (x2 - x1)/4
350C si x2 > x1 et x3 < (x1 + x2)/2 ou
351C si x2 < x1 et x3 > (x1 + x2)/2
352C pas de solution
353C
354C si x3 < (x1 + x2)/2 + (x2 - x1)/4
355C => x < max (x1 , x2 ) et
356C => x > min (x1 , x2 ) => verifie par solution 1 et 2
357C
358C si x3 = (x1 + x2)/2 + (x2 - x1)/4
359C x = x3 + 0.125 (x1 - x2)^2 / (2 x3 - x1 - x2 )
360C x = (x1 + x2)/2 + (x2 - x1)/4
361C + 0.125 (x1 - x2)^2 / (2 ((x1 + x2)/2 + (x2 - x1)/4) - x1 - x2)
362C x = (x1 + x2)/2 + (x2 - x1)/4
363C + 0.25 (x2 - x1)^2 / (x2 - x1)
364C si x2 > x1 => x = x2
365C si x2 < x1 => x = x1
366C
367C et x < x3 + 1/4 |x2 - x1|
368C
369C si x3 = x2
370C x = x3 + 0.125 (x1 - x2)^2 / (2 x3 - x1 - x2 )
371C x = x3 + 0.125 (x1 - x2)^2 / (x2 - x1)
372C x = x3 +- 1/8 |x1 - x2| = x2 +- 1/8 |x1 - x2|
373C
374C si (x1 + x2)/2 + (x2 - x1)/4 < x3 < max(x1,x2)
375C x < max(x1,x2) + 1/8 |x1 - x2|
376C et x < x3 + 1/4 |x1 - x2|
377C
378C si x3 > max(x1,x2)
379C x < x3 + 1/8 |x1 - x2|
380C------------------------------------------------------------
381C solution 2 => x < max (x1 , x2 , x3) + 1/8 |x2 - x1|
382C------------------------------------------------------------
383C solution 1 : x < max (x1 , x2 , x3 + 1/4 |x2 - x1|)
384C------------------------------------------------------------
385C => x < min (solution 1,solution 2)
386C------------------------------------------------------------
387C
388C 3) solution exacte (solution 0 bornee par solution 1)
389C
390C solution 0 :
391C x = x3 - 0.125 (x1 - x2)^2 / (x1 + x2 - 2 x3)
392C solution 1 :
393C x < max (x1 , x2 , x3 + 1/4 |x2 - x1|)
394C------------------------------------------------------------
395C solution 3 => x < min (solution 1,solution 0)
396C------------------------------------------------------------
397C s = (x1+x2)/2 d = |x2-x1|
398C-------------------------------------------------------------------------
399C x3 x min x max
400C-------------------------------------------------------------------------
401C -inf < x3 < s - d/4 x3 + d^2 / 16(x3-s) max(x1,x2)
402C s - d/4 < x3 < s + d/4 min(x1,x2) max(x1,x2)
403C s + d/4 < x3 < +inf min(x1,x2) x3 + d^2 / 16(x3-s)
404C-------------------------------------------------------------------------
405C---------------------------------------------------------
406C BIDIM ( pas resolu )
407C---------------------------------------------------------
408C
409C-----------------------------------------------
410C i ri si ti Ni
411C--------------------------------------------------------------------
412C 1 -1 -1 -1 1/4(1-r)(1-t)(-r-t-1)
413C 2 -1 -1 +1 1/4(1-r)(1+t)(-r+t-1)
414C 3 +1 -1 +1 1/4(1+r)(1+t)(+r+t-1)
415C 4 +1 -1 -1 1/4(1+r)(1-t)(+r-t-1)
416C 9 -1 -1 0 1/2(1-t^2)(1-r)
417C 10 0 -1 +1 1/2(1-r^2) (1+t)
418C 11 +1 -1 0 1/2(1-t^2)(1+r)
419C 12 0 -1 -1 1/2(1-r^2) (1-t)
420C
421C x = N1 x1 + N2 x2 + N3 x3 + N4 x4
422C + N9 x9 + N10 x10 + N11 x11 + N12 x12
423C
424C 0) recherche du point xmax
425C
426C dx/dr = -1/4(1-t)(-2r-t) x1
427C -1/4(1+t)(-2r+t) x2
428C +1/4(1+t)(+2r+t) x3
429C +1/4(1-t)(+2r-t) x4
430C -1/2(1-t^2) x9
431C -r(1+t) x10
432C +1/2(1-t^2) x11
433C -r(1-t) x12 = 0
434C dx/dt = -1/4(1-r)(-2t-r) x1
435C +1/4(1-r)(+2t-r) x2
436C +1/4(1+r)(+2t+r) x3
437C +1/4(1+r)(-2t+r) x4
438C -t(1-r) x9
439C +1/2(1-r^2) x10
440C -t(1+r) x11
441C -1/2(1-r^2) x12 = 0
442C------------------------------------
443C CALCUL DES BORNES DES ELEMENTS
444C------------------------------------
445 DO iface=1,2
446C-----------------------------------------------------------------------
447C Face 1 2 3 4 ou 5 6 7 8
448C-----------------------------------------------------------------------
449 DO idir=1,3
450C-----------------------------------------------------------------------
451C X Y ou Z
452C-----------------------------------------------------------------------
453 DO l=lft,llt
454 i = index(l)
455 ne = nelem(i)
456 n16= ne - numels8 - numels10 - numels20
457C
458 j = ixs(iperm(1,iface),ne)
459 x1 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
460 xmsr(idir) =max(xmsr(idir) ,x1-xsav(idir,j))
461 xmsr(idir+3)=min(xmsr(idir+3),x1-xsav(idir,j))
462 j = ixs(iperm(2,iface),ne)
463 x2 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
464 xmsr(idir) =max(xmsr(idir) ,x2-xsav(idir,j))
465 xmsr(idir+3)=min(xmsr(idir+3),x2-xsav(idir,j))
466 j = ixs(iperm(3,iface),ne)
467 x3 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
468 xmsr(idir) =max(xmsr(idir) ,x3-xsav(idir,j))
469 xmsr(idir+3)=min(xmsr(idir+3),x3-xsav(idir,j))
470 j = ixs(iperm(4,iface),ne)
471 x4 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
472 xmsr(idir) =max(xmsr(idir) ,x4-xsav(idir,j))
473 xmsr(idir+3)=min(xmsr(idir+3),x4-xsav(idir,j))
474 j = ixs16(iperm(5,iface),n16)
475 x9 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
476 xmsr(idir) =max(xmsr(idir) ,x9-xsav(idir,j))
477 xmsr(idir+3)=min(xmsr(idir+3),x9-xsav(idir,j))
478 j = ixs16(iperm(6,iface),n16)
479 x10= x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
480 xmsr(idir) =max(xmsr(idir) ,x10-xsav(idir,j))
481 xmsr(idir+3)=min(xmsr(idir+3),x10-xsav(idir,j))
482 j = ixs16(iperm(7,iface),n16)
483 x11= x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
484 xmsr(idir) =max(xmsr(idir) ,x11-xsav(idir,j))
485 xmsr(idir+3)=min(xmsr(idir+3),x11-xsav(idir,j))
486 j = ixs16(iperm(8,iface),n16)
487 x12= x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
488 xmsr(idir) =max(xmsr(idir) ,x12-xsav(idir,j))
489 xmsr(idir+3)=min(xmsr(idir+3),x12-xsav(idir,j))
490C
491 xc = half*(x9+x10+x11+x12) - fourth*(x1+x2+x3+x4)
492C
493 d4 = fourth * abs(x1-x2)
494 an = min( x1 , x2 , x9-d4 )
495 ax = max( x1 , x2 , x9+d4 )
496C
497 d4 = fourth * abs(x3-x4)
498 bn = min( x3 , x4 , x11-d4 )
499 bx = max( x3 , x4 , x11+d4 )
500C
501 d4 = fourth * abs(x12-x10)
502 cn = min( x12 , x10 , xc-d4 )
503 cx = max( x12 , x10 , xc+d4 )
504C
505 d8 = one_over_8 * max( ax-bn , bx-an )
506 d4 = d8 + d8
507 dn = max(min( an , bn , cn-d4 ),min(an , bn , cn) - d8 )
508 dx = min(max( ax , bx , cx+d4 ),max( ax , bx , cx) + d8 )
509C
510 eminx(idir,i) = min( eminx(idir,i) , dn )
511 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
512C
513 SIZE = SIZE + dx - dn
514C
515 ENDDO
516 ENDDO
517 ENDDO
518C--------------------------------------------------------------
519C
520 RETURN
521 END
522!||====================================================================
523!|| i20box ../engine/source/interfaces/int16/i16crit.F
524!||--- called by ------------------------------------------------------
525!|| i16crit ../engine/source/interfaces/int16/i16crit.F
526!|| i17crit ../engine/source/interfaces/int17/i17crit.F
527!||====================================================================
528 SUBROUTINE i20box(LFT ,LLT ,NELEM,EMINX,NMEF,NMEL,
529 2 X ,V ,A ,IXS ,IXS20,SIZE,
530 3 XMSR,INDEX,XSAV )
531C-----------------------------------------------
532C I m p l i c i t T y p e s
533C-----------------------------------------------
534#include "implicit_f.inc"
535C-----------------------------------------------
536C C o m m o n B l o c k s
537C-----------------------------------------------
538#include "com04_c.inc"
539#include "com08_c.inc"
540C-----------------------------------------------
541C D u m m y A r g u m e n t s
542C-----------------------------------------------
543 INTEGER LFT ,LLT,NMEF,NMEL,
544 . IXS(NIXS,*),IXS20(12,*),NELEM(*),INDEX(*)
545C REAL
546 my_real
547 . X(3,*),V(3,*),A(3,*),EMINX(6,*),SIZE,XMSR(*),XSAV(3,*)
548C-----------------------------------------------
549C L o c a l V a r i a b l e s
550C-----------------------------------------------
551 INTEGER I,J,K,L,NE,IDIR,N20
552 my_real
553 . AN12,AX12,AN34,AX34,AN56,AX56,AN78,AX78,CN,CX,DX,DN,D4,D8,
554 . x1,x2,x3,x4,x5,x6,x7,x8,
555 . x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,xc,xx,xn
556C------------------------------------
557C CALCUL DES BORNES DES ELEMENTS
558C------------------------------------
559C-----------------------------------------------------------------------
560C Face 1 2 3 4 ou 5 6 7 8
561C-----------------------------------------------------------------------
562 DO idir=1,3
563C-----------------------------------------------------------------------
564C X Y ou Z
565C-----------------------------------------------------------------------
566 DO l=lft,llt
567 i = index(l)
568 ne = nelem(i)
569 n20= ne - numels8 - numels10
570C-----------------------------------------------------------------------
571 j = ixs(2,ne)
572 x1 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
573 xmsr(idir) =max(xmsr(idir) ,x1-xsav(idir,j))
574 xmsr(idir+3)=min(xmsr(idir+3),x1-xsav(idir,j))
575 j = ixs(3,ne)
576 x2 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
577 xmsr(idir) =max(xmsr(idir) ,x2-xsav(idir,j))
578 xmsr(idir+3)=min(xmsr(idir+3),x2-xsav(idir,j))
579 j = ixs(4,ne)
580 x3 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
581 xmsr(idir) =max(xmsr(idir) ,x3-xsav(idir,j))
582 xmsr(idir+3)=min(xmsr(idir+3),x3-xsav(idir,j))
583 j = ixs(5,ne)
584 x4 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
585 xmsr(idir) =max(xmsr(idir) ,x4-xsav(idir,j))
586 xmsr(idir+3)=min(xmsr(idir+3),x4-xsav(idir,j))
587 j = ixs(6,ne)
588 x5 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
589 xmsr(idir) =max(xmsr(idir) ,x5-xsav(idir,j))
590 xmsr(idir+3)=min(xmsr(idir+3),x5-xsav(idir,j))
591 j = ixs(7,ne)
592 x6 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
593 xmsr(idir) =max(xmsr(idir) ,x6-xsav(idir,j))
594 xmsr(idir+3)=min(xmsr(idir+3),x6-xsav(idir,j))
595 j = ixs(8,ne)
596 x7 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
597 xmsr(idir) =max(xmsr(idir) ,x7-xsav(idir,j))
598 xmsr(idir+3)=min(xmsr(idir+3),x7-xsav(idir,j))
599 j = ixs(9,ne)
600 x8 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
601 xmsr(idir) =max(xmsr(idir) ,x8-xsav(idir,j))
602 xmsr(idir+3)=min(xmsr(idir+3),x8-xsav(idir,j))
603C
604 j = ixs20(1,n20)
605 IF(j/=0)THEN
606 x9 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
607 xmsr(idir) =max(xmsr(idir) ,x9-xsav(idir,j))
608 xmsr(idir+3)=min(xmsr(idir+3),x9-xsav(idir,j))
609 ELSE
610 x9=0.5*(x(idir,ixs(2,ne))+x(idir,ixs(3,ne)))
611 ENDIF
612 j = ixs20(2,n20)
613 IF(j/=0)THEN
614 x10 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
615 xmsr(idir) =max(xmsr(idir) ,x10-xsav(idir,j))
616 xmsr(idir+3)=min(xmsr(idir+3),x10-xsav(idir,j))
617 ELSE
618 x10=0.5*(x(idir,ixs(3,ne))+x(idir,ixs(4,ne)))
619 ENDIF
620 j = ixs20(3,n20)
621 IF(j/=0)THEN
622 x11 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
623 xmsr(idir) =max(xmsr(idir) ,x11-xsav(idir,j))
624 xmsr(idir+3)=min(xmsr(idir+3),x11-xsav(idir,j))
625 ELSE
626 x11=0.5*(x(idir,ixs(4,ne))+x(idir,ixs(5,ne)))
627 ENDIF
628 j = ixs20(4,n20)
629 IF(j/=0)THEN
630 x12 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
631 xmsr(idir) =max(xmsr(idir) ,x12-xsav(idir,j))
632 xmsr(idir+3)=min(xmsr(idir+3),x12-xsav(idir,j))
633 ELSE
634 x12=0.5*(x(idir,ixs(5,ne))+x(idir,ixs(2,ne)))
635 ENDIF
636 j = ixs20(5,n20)
637 IF(j/=0)THEN
638 x13 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
639 xmsr(idir) =max(xmsr(idir) ,x13-xsav(idir,j))
640 xmsr(idir+3)=min(xmsr(idir+3),x13-xsav(idir,j))
641 ELSE
642 x13=0.5*(x(idir,ixs(2,ne))+x(idir,ixs(6,ne)))
643 ENDIF
644 j = ixs20(6,n20)
645 IF(j/=0)THEN
646 x14 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
647 xmsr(idir) =max(xmsr(idir) ,x14-xsav(idir,j))
648 xmsr(idir+3)=min(xmsr(idir+3),x14-xsav(idir,j))
649 ELSE
650 x14=0.5*(x(idir,ixs(3,ne))+x(idir,ixs(6,ne)))
651 ENDIF
652 j = ixs20(7,n20)
653 IF(j/=0)THEN
654 x15 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
655 xmsr(idir) =max(xmsr(idir) ,x15-xsav(idir,j))
656 xmsr(idir+3)=min(xmsr(idir+3),x15-xsav(idir,j))
657 ELSE
658 x15=0.5*(x(idir,ixs(4,ne))+x(idir,ixs(8,ne)))
659 ENDIF
660 j = ixs20(8,n20)
661 IF(j/=0)THEN
662 x16 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
663 xmsr(idir) =max(xmsr(idir) ,x16-xsav(idir,j))
664 xmsr(idir+3)=min(xmsr(idir+3),x16-xsav(idir,j))
665 ELSE
666 x16=0.5*(x(idir,ixs(5,ne))+x(idir,ixs(9,ne)))
667 ENDIF
668 j = ixs20(9,n20)
669 IF(j/=0)THEN
670 x17 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
671 xmsr(idir) =max(xmsr(idir) ,x17-xsav(idir,j))
672 xmsr(idir+3)=min(xmsr(idir+3),x17-xsav(idir,j))
673 ELSE
674 x17=0.5*(x(idir,ixs(6,ne))+x(idir,ixs(7,ne)))
675 ENDIF
676 j = ixs20(10,n20)
677 IF(j/=0)THEN
678 x18 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
679 xmsr(idir) =max(xmsr(idir) ,x18-xsav(idir,j))
680 xmsr(idir+3)=min(xmsr(idir+3),x18-xsav(idir,j))
681 ELSE
682 x18=0.5*(x(idir,ixs(7,ne))+x(idir,ixs(8,ne)))
683 ENDIF
684 j = ixs20(11,n20)
685 IF(j/=0)THEN
686 x19 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
687 xmsr(idir) =max(xmsr(idir) ,x19-xsav(idir,j))
688 xmsr(idir+3)=min(xmsr(idir+3),x19-xsav(idir,j))
689 ELSE
690 x19=0.5*(x(idir,ixs(8,ne))+x(idir,ixs(9,ne)))
691 ENDIF
692 j = ixs20(12,n20)
693 IF(j/=0)THEN
694 x20 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
695 xmsr(idir) =max(xmsr(idir) ,x20-xsav(idir,j))
696 xmsr(idir+3)=min(xmsr(idir+3),x20-xsav(idir,j))
697 ELSE
698 x20=0.5*(x(idir,ixs(6,ne))+x(idir,ixs(9,ne)))
699 ENDIF
700C
701C-----------------------------------------------------------------------
702C Face 1 2 3 4
703C-----------------------------------------------------------------------
704 xc = half*(x9+x10+x11+x12) - fourth*(x1+x2+x3+x4)
705C
706 d4 = fourth * abs(x1-x2)
707 an12 = min( x1 , x2 , x9-d4 )
708 ax12 = max( x1 , x2 , x9+d4 )
709C
710 d4 = fourth * abs(x3-x4)
711 an34 = min( x3 , x4 , x11-d4 )
712 ax34 = max( x3 , x4 , x11+d4 )
713C
714 d4 = fourth * abs(x12-x10)
715 cn = min( x12 , x10 , xc-d4 )
716 cx = max( x12 , x10 , xc+d4 )
717C
718 d8 = one_over_8 * max( ax12-an34 , ax34-an12 )
719 d4 = d8 + d8
720 dn = max(min(an12 , an34 , cn-d4 ),
721 . min(an12 , an34 , cn) - d8 )
722 dx = min(max(ax12 , ax34 , cx+d4 ),
723 . max(ax12 , ax34 , cx) + d8 )
724C
725 eminx(idir,i) = min( eminx(idir,i) , dn )
726 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
727C-----------------------------------------------------------------------
728C Face 5 6 7 8
729C-----------------------------------------------------------------------
730 xc = half*(x17+x18+x19+x20) - fourth*(x5+x6+x7+x8)
731C
732 d4 = fourth * abs(x5-x6)
733 an56 = min( x5 , x6 , x17-d4 )
734 ax56 = max( x5 , x6 , x17+d4 )
735C
736 d4 = fourth * abs(x7-x8)
737 an78 = min( x7 , x8 , x19-d4 )
738 ax78 = max( x7 , x8 , x19+d4 )
739C
740 d4 = fourth * abs(x20-x18)
741 cn = min( x20 , x18 , xc-d4 )
742 cx = max( x20 , x18 , xc+d4 )
743C
744 d8 = one_over_8 * max( ax56-an78 , ax78-an56 )
745 d4 = d8 + d8
746 dn = max(min(an56 , an78 , cn-d4 ),
747 . min(an56 , an78 , cn) - d8 )
748 dx = min(max(ax56 , ax78 , cx+d4 ),
749 . max(ax56 , ax78 , cx) + d8 )
750C
751 eminx(idir,i) = min( eminx(idir,i) , dn )
752 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
753C-----------------------------------------------------------------------
754C Face 1 2 6 5
755C-----------------------------------------------------------------------
756 xc = half*(x9+x14+x17+x13) - fourth*(x1+x2+x6+x5)
757C
758 d4 = fourth * abs(x13-x14)
759 cn = min( x13 , x14 , xc-d4 )
760 cx = max( x13 , x14 , xc+d4 )
761C
762 d8 = one_over_8 * max( ax12-an56 , ax56-an12 )
763 d4 = d8 + d8
764 dn = max(min(an12 , an56 , cn-d4 ),
765 . min(an12 , an56 , cn) - d8 )
766 dx = min(max(ax12 , ax56 , cx+d4 ),
767 . max(ax12 , ax56 , cx) + d8 )
768C
769 eminx(idir,i) = min( eminx(idir,i) , dn )
770 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
771C-----------------------------------------------------------------------
772C Face 3 4 8 7
773C-----------------------------------------------------------------------
774 xc = half*(x11+x15+x19+x16) - fourth*(x3+x4+x8+x7)
775C
776 d4 = fourth * abs(x16-x15)
777 cn = min( x15 , x16 , xc-d4 )
778 cx = max( x15 , x16 , xc+d4 )
779C
780 d8 = one_over_8 * max( ax34-an78 , ax78-an34 )
781 d4 = d8 + d8
782 dn = max(min(an34 , an78 , cn-d4 ),
783 . min(an34 , an78 , cn) - d8 )
784 dx = min(max(ax34 , ax78 , cx+d4 ),
785 . max(ax34 , ax78 , cx) + d8 )
786C
787 eminx(idir,i) = min( eminx(idir,i) , dn )
788 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
789C-----------------------------------------------------------------------
790C Face 4 1 5 8
791C-----------------------------------------------------------------------
792 xc = half*(x12+x13+x20+x16) - fourth*(x4+x1+x5+x8)
793C
794 d4 = fourth * abs(x4-x1)
795 an12 = min( x4 , x1 , x12-d4 )
796 ax12 = max( x4 , x1 , x12+d4 )
797C
798 d4 = fourth * abs(x8-x5)
799 an34 = min( x8 , x5 , x20-d4 )
800 ax34 = max( x8 , x5 , x20+d4 )
801C
802 d4 = fourth * abs(x16-x13)
803 cn = min( x16 , x13 , xc-d4 )
804 cx = max( x16 , x13 , xc+d4 )
805C
806 d8 = one_over_8 * max( ax12-an34 , ax34-an12 )
807 d4 = d8 + d8
808 dn = max(min(an12 , an34 , cn-d4 ),
809 . min(an12 , an34 , cn) - d8 )
810 dx = min(max(ax12 , ax34 , cx+d4 ),
811 . max(ax12 , ax34 , cx) + d8 )
812C
813 eminx(idir,i) = min( eminx(idir,i) , dn )
814 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
815C-----------------------------------------------------------------------
816C Face 3 2 6 7
817C-----------------------------------------------------------------------
818 xc = half*(x10+x14+x18+x15) - fourth*(x3+x2+x6+x7)
819C
820 d4 = fourth * abs(x3-x2)
821 an12 = min( x3 , x2 , x10-d4 )
822 ax12 = max( x3 , x2 , x10+d4 )
823C
824 d4 = fourth * abs(x7-x6)
825 an34 = min( x7 , x6 , x18-d4 )
826 ax34 = max( x7 , x6 , x18+d4 )
827C
828 d4 = fourth * abs(x15-x14)
829 cn = min( x15 , x14 , xc-d4 )
830 cx = max( x15 , x14 , xc+d4 )
831C
832 d8 = one_over_8* max( ax12-an34 , ax34-an12 )
833 d4 = d8 + d8
834 dn = max(min(an12 , an34 , cn-d4 ),
835 . min(an12 , an34 , cn) - d8 )
836 dx = min(max(ax12 , ax34 , cx+d4 ),
837 . max(ax12 , ax34 , cx) + d8 )
838C
839 eminx(idir,i) = min( eminx(idir,i) , dn )
840 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
841C-----------------------------------------------------------------------
842 SIZE = SIZE + dx - dn
843C
844 ENDDO
845 ENDDO
846C--------------------------------------------------------------
847C
848 RETURN
849 END
850!||====================================================================
851!|| i10box ../engine/source/interfaces/int16/i16crit.f
852!||--- called by ------------------------------------------------------
853!|| i16crit ../engine/source/interfaces/int16/i16crit.F
854!||====================================================================
855 SUBROUTINE i10box(LFT ,LLT ,NELEM,EMINX,NMEF,NMEL,
856 2 X ,V ,A ,IXS ,IXS10,SIZE,
857 3 XMSR,INDEX,XSAV )
858C-----------------------------------------------
859C I m p l i c i t T y p e s
860C-----------------------------------------------
861#include "implicit_f.inc"
862C-----------------------------------------------
863C C o m m o n B l o c k s
864C-----------------------------------------------
865#include "com04_c.inc"
866#include "com08_c.inc"
867C-----------------------------------------------
868C D u m m y A r g u m e n t s
869C-----------------------------------------------
870 INTEGER LFT ,LLT,NMEF,NMEL,
871 . IXS(NIXS,*),IXS10(6,*),NELEM(*),INDEX(*)
872C REAL
873 my_real
874 . X(3,*),V(3,*),A(3,*),EMINX(6,*),SIZE,XMSR(*),XSAV(3,*)
875C-----------------------------------------------
876C L o c a l V a r i a b l e s
877C-----------------------------------------------
878 INTEGER I,J,K,L,NE,IDIR,N10
879 my_real
880 . an12,ax12,an34,ax34,an56,ax56,an78,ax78,cn,cx,dx,dn,d4,d8,
881 . x1,x2,x3,x4,x5,x6,x7,x8,
882 . x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,xc,xx,xn
883C------------------------------------
884C CALCUL DES BORNES DES ELEMENTS
885C------------------------------------
886C-----------------------------------------------------------------------
887C Face 1 2 3 4 ou 5 6 7 8
888C-----------------------------------------------------------------------
889 DO idir=1,3
890C-----------------------------------------------------------------------
891C X Y ou Z
892C-----------------------------------------------------------------------
893 DO l=lft,llt
894 i = index(l)
895 ne = nelem(i)
896 n10= ne - numels8
897C-----------------------------------------------------------------------
898 j = ixs(2,ne)
899 x1 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
900 xmsr(idir) =max(xmsr(idir) ,x1-xsav(idir,j))
901 xmsr(idir+3)=min(xmsr(idir+3),x1-xsav(idir,j))
902 j = ixs(4,ne)
903 x2 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
904 xmsr(idir) =max(xmsr(idir) ,x2-xsav(idir,j))
905 xmsr(idir+3)=min(xmsr(idir+3),x2-xsav(idir,j))
906 j = ixs(6,ne)
907 x3 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
908 xmsr(idir) =max(xmsr(idir) ,x3-xsav(idir,j))
909 xmsr(idir+3)=min(xmsr(idir+3),x3-xsav(idir,j))
910 j = ixs(7,ne)
911 x4 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
912 xmsr(idir) =max(xmsr(idir) ,x4-xsav(idir,j))
913 xmsr(idir+3)=min(xmsr(idir+3),x4-xsav(idir,j))
914C
915 j = ixs10(1,n10)
916 x5 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
917 xmsr(idir) =max(xmsr(idir) ,x5-xsav(idir,j))
918 xmsr(idir+3)=min(xmsr(idir+3),x5-xsav(idir,j))
919 j = ixs10(2,n10)
920 x6 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
921 xmsr(idir) =max(xmsr(idir) ,x6-xsav(idir,j))
922 xmsr(idir+3)=min(xmsr(idir+3),x6-xsav(idir,j))
923 j = ixs10(3,n10)
924 x7 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
925 xmsr(idir) =max(xmsr(idir) ,x7-xsav(idir,j))
926 xmsr(idir+3)=min(xmsr(idir+3),x7-xsav(idir,j))
927 j = ixs10(4,n10)
928 x8 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
929 xmsr(idir) =max(xmsr(idir) ,x8-xsav(idir,j))
930 xmsr(idir+3)=min(xmsr(idir+3),x8-xsav(idir,j))
931 j = ixs10(5,n10)
932 x9 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
933 xmsr(idir) =max(xmsr(idir) ,x9-xsav(idir,j))
934 xmsr(idir+3)=min(xmsr(idir+3),x9-xsav(idir,j))
935 j = ixs10(6,n10)
936 x10 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
937 xmsr(idir) =max(xmsr(idir) ,x10-xsav(idir,j))
938 xmsr(idir+3)=min(xmsr(idir+3),x10-xsav(idir,j))
939C-----------------------------------------------------------------------
940 xx=max(x1,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,x9,x10)
941 xn=min(x1,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,x9,x10)
942 eminx(idir,i) = min( eminx(idir,i) , xn )
943 eminx(idir+3,i) = max( eminx(idir+3,i), xx )
944C-----------------------------------------------------------------------
945C Face 1 2 3 4
946C-----------------------------------------------------------------------
947 xc = (two*(x5+x6+x7) - (x1+x2+x3))* third
948 eminx(idir,i) = min( eminx(idir,i) , xc )
949 eminx(idir+3,i) = max( eminx(idir+3,i), xc )
950C
951 xc = (two*(x5+x8+x9) - (x1+x2+x4))*third
952 eminx(idir,i) = min( eminx(idir,i) , xc )
953 eminx(idir+3,i) = max( eminx(idir+3,i), xc )
954C
955 xc = (two*(x6+x9+x10) - (x2+x3+x4)) * third
956 eminx(idir,i) = min( eminx(idir,i) , xc )
957 eminx(idir+3,i) = max( eminx(idir+3,i), xc )
958C
959 xc = (two*(x7+x8+x10) - (x3+x1+x4)) * third
960 eminx(idir,i) = min( eminx(idir,i) , xc )
961 eminx(idir+3,i) = max( eminx(idir+3,i), xc )
962C
963C-----------------------------------------------------------------------
964C
965 ENDDO
966 ENDDO
967C--------------------------------------------------------------
968C
969 RETURN
970 END
971!||====================================================================
972!|| i8box ../engine/source/interfaces/int16/i16crit.F
973!||--- called by ------------------------------------------------------
974!|| i16crit ../engine/source/interfaces/int16/i16crit.F
975!||====================================================================
976 SUBROUTINE i8box(LFT ,LLT ,NELEM,EMINX,NMEF,NMEL,
977 2 X ,V ,A ,IXS ,SIZE,
978 3 XMSR,INDEX,XSAV )
979C-----------------------------------------------
980C I m p l i c i t T y p e s
981C-----------------------------------------------
982#include "implicit_f.inc"
983C-----------------------------------------------
984C C o m m o n B l o c k s
985C-----------------------------------------------
986#include "com08_c.inc"
987C-----------------------------------------------
988C D u m m y A r g u m e n t s
989C-----------------------------------------------
990 INTEGER LFT ,LLT,NMEF,NMEL,
991 . IXS(NIXS,*),NELEM(*),INDEX(*)
992C REAL
993 my_real
994 . X(3,*),V(3,*),A(3,*),EMINX(6,*),SIZE,XMSR(*),XSAV(3,*)
995C-----------------------------------------------
996C L o c a l V a r i a b l e s
997C-----------------------------------------------
998 INTEGER I,J,K,L,NE,IDIR,N10
999 my_real
1000 . AN12,AX12,AN34,AX34,AN56,AX56,AN78,AX78,CN,CX,DX,DN,D4,D8,
1001 . X1,X2,X3,X4,X5,X6,X7,X8,XC,XX,XN
1002C------------------------------------
1003C CALCUL DES BORNES DES ELEMENTS
1004C------------------------------------
1005C-----------------------------------------------------------------------
1006C Face 1 2 3 4 ou 5 6 7 8
1007C-----------------------------------------------------------------------
1008 DO idir=1,3
1009C-----------------------------------------------------------------------
1010C X Y ou Z
1011C-----------------------------------------------------------------------
1012 DO l=lft,llt
1013 i = index(l)
1014 ne = nelem(i)
1015C-----------------------------------------------------------------------
1016 j = ixs(2,ne)
1017 x1 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1018 xmsr(idir) =max(xmsr(idir) ,x1-xsav(idir,j))
1019 xmsr(idir+3)=min(xmsr(idir+3),x1-xsav(idir,j))
1020 j = ixs(3,ne)
1021 x2 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1022 xmsr(idir) =max(xmsr(idir) ,x2-xsav(idir,j))
1023 xmsr(idir+3)=min(xmsr(idir+3),x2-xsav(idir,j))
1024 j = ixs(4,ne)
1025 x3 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1026 xmsr(idir) =max(xmsr(idir) ,x3-xsav(idir,j))
1027 xmsr(idir+3)=min(xmsr(idir+3),x3-xsav(idir,j))
1028 j = ixs(5,ne)
1029 x4 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1030 xmsr(idir) =max(xmsr(idir) ,x4-xsav(idir,j))
1031 xmsr(idir+3)=min(xmsr(idir+3),x4-xsav(idir,j))
1032 j = ixs(6,ne)
1033 x5 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1034 xmsr(idir) =max(xmsr(idir) ,x5-xsav(idir,j))
1035 xmsr(idir+3)=min(xmsr(idir+3),x5-xsav(idir,j))
1036 j = ixs(7,ne)
1037 x6 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1038 xmsr(idir) =max(xmsr(idir) ,x6-xsav(idir,j))
1039 xmsr(idir+3)=min(xmsr(idir+3),x6-xsav(idir,j))
1040 j = ixs(8,ne)
1041 x7 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1042 xmsr(idir) =max(xmsr(idir) ,x7-xsav(idir,j))
1043 xmsr(idir+3)=min(xmsr(idir+3),x7-xsav(idir,j))
1044 j = ixs(9,ne)
1045 x8 = x(idir,j)+dt2*(v(idir,j)+dt12*a(idir,j))
1046 xmsr(idir) =max(xmsr(idir) ,x8-xsav(idir,j))
1047 xmsr(idir+3)=min(xmsr(idir+3),x8-xsav(idir,j))
1048C
1049
1050 dx=max(x1,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 )
1051 dn=min(x1,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 )
1052C
1053 eminx(idir,i) = min( eminx(idir,i) , dn )
1054 eminx(idir+3,i) = max( eminx(idir+3,i), dx )
1055C
1056 SIZE = SIZE + dx - dn
1057C
1058 ENDDO
1059 ENDDO
1060C--------------------------------------------------------------
1061C
1062 RETURN
1063 END
my_real
#define my_real
Definition cppsort.cpp:32
i16crit
subroutine i16crit(x, nsv, nelem, nsn, eminx, nme, itask, xsav, ixs, ixs16, ixs20, ixs10, v, a, xmsrg, xslvg)
Definition i16crit.F:40
i16box
subroutine i16box(lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, ixs16, size, xmsr, index, xsav)
Definition i16crit.F:226
i20box
subroutine i20box(lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, ixs20, size, xmsr, index, xsav)
Definition i16crit.F:531
i10box
subroutine i10box(lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, ixs10, size, xmsr, index, xsav)
Definition i16crit.F:858
i8box
subroutine i8box(lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, size, xmsr, index, xsav)
Definition i16crit.F:979
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21