s8ederict3.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s8ederict3 (off, det, ngl, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, hx, hy, hz, aj1, aj2, aj3, aj4, aj5, aj6, aj7, aj8, aj9, smax, nel)

Function/Subroutine Documentation

s8ederict3()

subroutine s8ederict3	(		off,
			det,
		integer, dimension(*)	ngl,
		double precision, dimension(*)	x1,
		double precision, dimension(*)	x2,
		double precision, dimension(*)	x3,
		double precision, dimension(*)	x4,
		double precision, dimension(*)	x5,
		double precision, dimension(*)	x6,
		double precision, dimension(*)	x7,
		double precision, dimension(*)	x8,
		double precision, dimension(*)	y1,
		double precision, dimension(*)	y2,
		double precision, dimension(*)	y3,
		double precision, dimension(*)	y4,
		double precision, dimension(*)	y5,
		double precision, dimension(*)	y6,
		double precision, dimension(*)	y7,
		double precision, dimension(*)	y8,
		double precision, dimension(*)	z1,
		double precision, dimension(*)	z2,
		double precision, dimension(*)	z3,
		double precision, dimension(*)	z4,
		double precision, dimension(*)	z5,
		double precision, dimension(*)	z6,
		double precision, dimension(*)	z7,
		double precision, dimension(*)	z8,
			px1,
			px2,
			px3,
			px4,
			py1,
			py2,
			py3,
			py4,
			pz1,
			pz2,
			pz3,
			pz4,
			hx,
			hy,
			hz,
			aj1,
			aj2,
			aj3,
			aj4,
			aj5,
			aj6,
			aj7,
			aj8,
			aj9,
			smax,
		integer, intent(in)	nel )

Definition at line 34 of file s8ederict3.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      DOUBLE PRECISION X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
     .                 Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
     .                 Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*)
      my_real off(*),det(*),
     .        px1(*), px2(*), px3(*), px4(*),
     .        py1(*), py2(*), py3(*), py4(*),
     .        pz1(*), pz2(*), pz3(*), pz4(*),
     .        hx(mvsiz,4),  hy(mvsiz,4), hz(mvsiz,4),
     .        aj1(*),aj2(*),aj3(*),
     .        aj4(*),aj5(*),aj6(*),
     .        aj7(*),aj8(*),aj9(*),smax(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NGL(*), I, J ,ICOR
C                                                                     12
      my_real  dett(mvsiz) ,
     .         aji1(mvsiz), aji2(mvsiz), aji3(mvsiz),
     .         aji4(mvsiz), aji5(mvsiz), aji6(mvsiz),
     .         aji7(mvsiz), aji8(mvsiz), aji9(mvsiz),
     .         x17(mvsiz) , x28(mvsiz) , x35(mvsiz) , x46(mvsiz),
     .         y17(mvsiz) , y28(mvsiz) , y35(mvsiz) , y46(mvsiz),
     .         z17(mvsiz) , z28(mvsiz) , z35(mvsiz) , z46(mvsiz),
     .         jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
     .         jac_38_29(mvsiz), jac_19_37(mvsiz), jac_27_18(mvsiz),
     .         jac_26_35(mvsiz), jac_34_16(mvsiz), jac_15_24(mvsiz),
     .         aj12(mvsiz), aj45(mvsiz), aj78(mvsiz),
     .         a17(mvsiz) , a28(mvsiz) ,
     .         b17(mvsiz) , b28(mvsiz) ,
     .         c17(mvsiz) , c28(mvsiz)
C-----------------------------------------------
      DO i=1,nel
        x17(i)=x7(i)-x1(i)
        x28(i)=x8(i)-x2(i)
        x35(i)=x5(i)-x3(i)
        x46(i)=x6(i)-x4(i)
        y17(i)=y7(i)-y1(i)
        y28(i)=y8(i)-y2(i)
        y35(i)=y5(i)-y3(i)
        y46(i)=y6(i)-y4(i)
        z17(i)=z7(i)-z1(i)
        z28(i)=z8(i)-z2(i)
        z35(i)=z5(i)-z3(i)
        z46(i)=z6(i)-z4(i)
      ENDDO
C
      DO i=1,nel
        aj4(i)=x17(i)+x28(i)-x35(i)-x46(i)
        aj5(i)=y17(i)+y28(i)-y35(i)-y46(i)
        aj6(i)=z17(i)+z28(i)-z35(i)-z46(i)
        a17(i)=x17(i)+x46(i)
        a28(i)=x28(i)+x35(i)
        b17(i)=y17(i)+y46(i)
        b28(i)=y28(i)+y35(i)
        c17(i)=z17(i)+z46(i)
        c28(i)=z28(i)+z35(i)
      ENDDO
      DO i=1,nel
        aj7(i)=a17(i)+a28(i)
        aj8(i)=b17(i)+b28(i)
        aj9(i)=c17(i)+c28(i)
        aj1(i)=a17(i)-a28(i)
        aj2(i)=b17(i)-b28(i)
        aj3(i)=c17(i)-c28(i)
      ENDDO
C
C     JACOBIAN
C
      DO i=1,nel
        jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
        jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
        jac_38_29(i)=(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
        jac_19_37(i)=( aj1(i)*aj9(i)-aj3(i)*aj7(i))
        jac_27_18(i)=(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
        jac_26_35(i)=( aj2(i)*aj6(i)-aj3(i)*aj5(i))
        jac_34_16(i)=(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
        jac_15_24(i)=( aj1(i)*aj5(i)-aj2(i)*aj4(i))
        jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
      ENDDO
C
      DO i=1,nel
        det(i)=one_over_64*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
      ENDDO
C
      CALL schkjab3(off,     det,     ngl,     nel)
C
      DO i=1,nel
        dett(i)=one_over_64/det(i)
      ENDDO
C
C     INVERSE DE LA MATRICE JACOBIENNE
C
      DO i=1,nel
        aji1(i)=dett(i)*jac_59_68(i)
        aji4(i)=dett(i)*jac_67_49(i)
        aji7(i)=dett(i)*jac_48_57(i)
        aji2(i)=dett(i)*jac_38_29(i)
        aji5(i)=dett(i)*jac_19_37(i)
        aji8(i)=dett(i)*jac_27_18(i)
        aji3(i)=dett(i)*jac_26_35(i)
        aji6(i)=dett(i)*jac_34_16(i)
        aji9(i)=dett(i)*jac_15_24(i)
      ENDDO
C
      DO i=1,nel
        aj12(i)=aji1(i)-aji2(i)
        aj45(i)=aji4(i)-aji5(i)
        aj78(i)=aji7(i)-aji8(i)
      ENDDO
      DO i=1,nel
        px2(i)= aj12(i)-aji3(i)
        py2(i)= aj45(i)-aji6(i)
        pz2(i)= aj78(i)-aji9(i)
        px4(i)=-aj12(i)-aji3(i)
        py4(i)=-aj45(i)-aji6(i)
        pz4(i)=-aj78(i)-aji9(i)
      ENDDO    
      DO i=1,nel
        aj12(i)=aji1(i)+aji2(i)
        aj45(i)=aji4(i)+aji5(i)
        aj78(i)=aji7(i)+aji8(i)
      ENDDO
      DO i=1,nel
        px1(i)=-aj12(i)-aji3(i)
        py1(i)=-aj45(i)-aji6(i)
        pz1(i)=-aj78(i)-aji9(i)
        px3(i)=aj12(i)-aji3(i)
        py3(i)=aj45(i)-aji6(i)
        pz3(i)=aj78(i)-aji9(i)
      ENDDO
C
C mode 1
C 1 1 -1 -1 -1 -1 1 1
       DO i=1,nel
         hx(i,1)=(x1(i)+x2(i)-x3(i)-x4(i)-x5(i)-x6(i)+x7(i)+x8(i))
         hy(i,1)=(y1(i)+y2(i)-y3(i)-y4(i)-y5(i)-y6(i)+y7(i)+y8(i))
         hz(i,1)=(z1(i)+z2(i)-z3(i)-z4(i)-z5(i)-z6(i)+z7(i)+z8(i))
       ENDDO
C mode 2
C 1 -1 -1 1 -1 1 1 -1
       DO i=1,nel
         hx(i,2)=(x1(i)-x2(i)-x3(i)+x4(i)-x5(i)+x6(i)+x7(i)-x8(i))
         hy(i,2)=(y1(i)-y2(i)-y3(i)+y4(i)-y5(i)+y6(i)+y7(i)-y8(i))
         hz(i,2)=(z1(i)-z2(i)-z3(i)+z4(i)-z5(i)+z6(i)+z7(i)-z8(i))
       ENDDO
C mode 3
C 1 -1 1 -1 1 -1 1 -1
       DO i=1,nel
         hx(i,3)=(x1(i)-x2(i)+x3(i)-x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
         hy(i,3)=(y1(i)-y2(i)+y3(i)-y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
         hz(i,3)=(z1(i)-z2(i)+z3(i)-z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
       ENDDO
C mode 4
C -1 1 -1 1 1 -1 1 -1
       DO i=1,nel
         hx(i,4)=(-x1(i)+x2(i)-x3(i)+x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
         hy(i,4)=(-y1(i)+y2(i)-y3(i)+y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
         hz(i,4)=(-z1(i)+z2(i)-z3(i)+z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
       ENDDO
C       
C----surface max mediane-- *16
       DO i=1,nel
         smax(i)= jac_59_68(i)*jac_59_68(i)+jac_67_49(i)*jac_67_49(i)
     .            +jac_48_57(i)*jac_48_57(i)
         smax(i)= max(smax(i),jac_38_29(i)*jac_38_29(i)+jac_19_37(i)*jac_19_37(i)
     .            +jac_27_18(i)*jac_27_18(i))
         smax(i)= max(smax(i),jac_26_35(i)*jac_26_35(i)+jac_34_16(i)*jac_34_16(i)
     .            +jac_15_24(i)*jac_15_24(i))
       ENDDO
       DO i=1,nel
         IF(smax(i)<=zero)THEN
           CALL ancmsg(msgid=173,anmode=aninfo,i1=ngl(i))
           CALL arret(2)
         ENDIF
         smax(i)= one/sqrt(smax(i))
       ENDDO
      RETURN
C
 1000 FORMAT(/' ZERO OR NEGATIVE VOLUME : 3D-ELEMENT NB',i10/)
 2000 FORMAT(/' ZERO OR NEGATIVE VOLUME : DELETE 3D-ELEMENT NB',i10/)