OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i16crit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "task_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i16crit (x, nsv, nelem, nsn, eminx, nme, itask, xsav, ixs, ixs16, ixs20, ixs10, v, a, xmsrg, xslvg)
subroutine i16box (lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, ixs16, size, xmsr, index, xsav)
subroutine i20box (lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, ixs20, size, xmsr, index, xsav)
subroutine i10box (lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, ixs10, size, xmsr, index, xsav)
subroutine i8box (lft, llt, nelem, eminx, nmef, nmel, x, v, a, ixs, size, xmsr, index, xsav)

Function/Subroutine Documentation

◆ i10box()

subroutine i10box ( integer lft,
integer llt,
integer, dimension(*) nelem,
eminx,
integer nmef,
integer nmel,
x,
v,
a,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
size,
xmsr,
integer, dimension(*) index,
xsav )

Definition at line 855 of file i16crit.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ i16box()

subroutine i16box ( integer lft,
integer llt,
integer, dimension(*) nelem,
eminx,
integer nmef,
integer nmel,
x,
v,
a,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
size,
xmsr,
integer, dimension(*) index,
xsav )

Definition at line 223 of file i16crit.F.

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
iface
integer function iface(ip, n)
Definition iface.F:35

◆ i16crit()

subroutine i16crit ( x,
integer, dimension(*) nsv,
integer, dimension(*) nelem,
integer nsn,
eminx,
integer nme,
integer itask,
xsav,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(6,*) ixs10,
v,
a,
dimension(7) xmsrg,
dimension(7) xslvg )

Definition at line 35 of file i16crit.F.

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
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

◆ i20box()

subroutine i20box ( integer lft,
integer llt,
integer, dimension(*) nelem,
eminx,
integer nmef,
integer nmel,
x,
v,
a,
integer, dimension(nixs,*) ixs,
integer, dimension(12,*) ixs20,
size,
xmsr,
integer, dimension(*) index,
xsav )

Definition at line 528 of file i16crit.F.

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

◆ i8box()

subroutine i8box ( integer lft,
integer llt,
integer, dimension(*) nelem,
eminx,
integer nmef,
integer nmel,
x,
v,
a,
integer, dimension(nixs,*) ixs,
size,
xmsr,
integer, dimension(*) index,
xsav )

Definition at line 976 of file i16crit.F.

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