s8zderict3.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	s8zderict3 (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, px1h1, px1h2, px1h3, px1h4, px2h1, px2h2, px2h3, px2h4, px3h1, px3h2, px3h3, px3h4, px4h1, px4h2, px4h3, px4h4, hx, hy, hz, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9, smax, nel)

Function/Subroutine Documentation

s8zderict3()

subroutine s8zderict3	(		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,
			px1h1,
			px1h2,
			px1h3,
			px1h4,
			px2h1,
			px2h2,
			px2h3,
			px2h4,
			px3h1,
			px3h2,
			px3h3,
			px3h4,
			px4h1,
			px4h2,
			px4h3,
			px4h4,
			hx,
			hy,
			hz,
			jac1,
			jac2,
			jac3,
			jac4,
			jac5,
			jac6,
			jac7,
			jac8,
			jac9,
			smax,
		integer, intent(in)	nel )

Definition at line 36 of file s8zderict3.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(*)
C     REAL
      my_real
     .   off(*),det(*), 
     .   px1(*), px2(*), px3(*), px4(*),  
     .   py1(*), py2(*), py3(*), py4(*),  
     .   pz1(*), pz2(*), pz3(*), pz4(*),  
     .   px1h1(*), px1h2(*), px1h3(*),px1h4(*),  
     .   px2h1(*), px2h2(*), px2h3(*),px2h4(*),  
     .   px3h1(*), px3h2(*), px3h3(*),px3h4(*),  
     .   px4h1(*), px4h2(*), px4h3(*),px4h4(*),  
     .   hx(mvsiz,4),  hy(mvsiz,4), hz(mvsiz,4),   
     .   jac1(*),jac2(*),jac3(*),
     .   jac4(*),jac5(*),jac6(*),
     .   jac7(*),jac8(*),jac9(*),smax(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NGL(*), I, J ,ICOR
C     REAL
C                                                                     12
      my_real
     .   dett ,   
     .   jaci1, jaci2, jaci3,
     .   jaci4, jaci5, jaci6,
     .   jaci7, jaci8, jaci9,
     .   x17 , x28 , x35 , x46,
     .   y17 , y28 , y35 , y46,
     .   z17 , z28 , z35 , z46,
     .   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),
     .   jaci12, jaci45, jaci78,
     .   x_17_46 , x_28_35 ,
     .   y_17_46 , y_28_35 ,
     .   z_17_46 , z_28_35
C-----------------------------------------------
C
      DO i=1,nel
        x17=x7(i)-x1(i)
        x28=x8(i)-x2(i)
        x35=x5(i)-x3(i)
        x46=x6(i)-x4(i)
        y17=y7(i)-y1(i)
        y28=y8(i)-y2(i)
        y35=y5(i)-y3(i)
        y46=y6(i)-y4(i)
        z17=z7(i)-z1(i)
        z28=z8(i)-z2(i)
        z35=z5(i)-z3(i)
        z46=z6(i)-z4(i)
C
C Jacobian matrix
        jac4(i)=x17+x28-x35-x46
        jac5(i)=y17+y28-y35-y46
        jac6(i)=z17+z28-z35-z46
        x_17_46=x17+x46
        x_28_35=x28+x35
        y_17_46=y17+y46
        y_28_35=y28+y35
        z_17_46=z17+z46
        z_28_35=z28+z35
 
        jac7(i)=x_17_46+x_28_35
        jac8(i)=y_17_46+y_28_35
        jac9(i)=z_17_46+z_28_35
        jac1(i)=x_17_46-x_28_35
        jac2(i)=y_17_46-y_28_35
        jac3(i)=z_17_46-z_28_35
      ENDDO
C
      DO i=1,nel
      jac_59_68(i)=jac5(i)*jac9(i)-jac6(i)*jac8(i)
      jac_67_49(i)=jac6(i)*jac7(i)-jac4(i)*jac9(i)
      jac_38_29(i)=(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
      jac_19_37(i)=( jac1(i)*jac9(i)-jac3(i)*jac7(i))
      jac_27_18(i)=(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
      jac_26_35(i)=( jac2(i)*jac6(i)-jac3(i)*jac5(i))
      jac_34_16(i)=(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
      jac_15_24(i)=( jac1(i)*jac5(i)-jac2(i)*jac4(i))
      jac_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
      END DO
C
      DO i=1,nel
      det(i)=one_over_64*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
      ENDDO
C
      CALL schkjab3(
     1   off,     det,     ngl,     nel)
C
C Jacobian matrix inverse
C
      DO i=1,nel
        dett=one_over_64/det(i)
        jaci1=dett*jac_59_68(i)
        jaci4=dett*jac_67_49(i)
        jaci7=dett*jac_48_57(i)
        jaci2=dett*jac_38_29(i)
        jaci5=dett*jac_19_37(i)
        jaci8=dett*jac_27_18(i)
        jaci3=dett*jac_26_35(i)
        jaci6=dett*jac_34_16(i)
        jaci9=dett*jac_15_24(i)
!
        jaci12=jaci1-jaci2
        jaci45=jaci4-jaci5
        jaci78=jaci7-jaci8
!
        px2(i)= jaci12-jaci3
        py2(i)= jaci45-jaci6
        pz2(i)= jaci78-jaci9
        px4(i)=-jaci12-jaci3
        py4(i)=-jaci45-jaci6
        pz4(i)=-jaci78-jaci9
!
        jaci12=jaci1+jaci2
        jaci45=jaci4+jaci5
        jaci78=jaci7+jaci8
!
        px1(i)=-jaci12-jaci3
        py1(i)=-jaci45-jaci6
        pz1(i)=-jaci78-jaci9
        px3(i)=jaci12-jaci3
        py3(i)=jaci45-jaci6
        pz3(i)=jaci78-jaci9
      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))
         px1h1(i)=px1(i)*hx(i,1)+ py1(i)*hy(i,1)+pz1(i)*hz(i,1)
         px2h1(i)=px2(i)*hx(i,1)+ py2(i)*hy(i,1)+pz2(i)*hz(i,1)
         px3h1(i)=px3(i)*hx(i,1)+ py3(i)*hy(i,1)+pz3(i)*hz(i,1)
         px4h1(i)=px4(i)*hx(i,1)+ py4(i)*hy(i,1)+pz4(i)*hz(i,1)
       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))
         px1h2(i)=px1(i)*hx(i,2)+ py1(i)*hy(i,2)+pz1(i)*hz(i,2)
         px2h2(i)=px2(i)*hx(i,2)+ py2(i)*hy(i,2)+pz2(i)*hz(i,2)
         px3h2(i)=px3(i)*hx(i,2)+ py3(i)*hy(i,2)+pz3(i)*hz(i,2)
         px4h2(i)=px4(i)*hx(i,2)+ py4(i)*hy(i,2)+pz4(i)*hz(i,2)
       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))
         px1h3(i)=px1(i)*hx(i,3)+ py1(i)*hy(i,3)+pz1(i)*hz(i,3)
         px2h3(i)=px2(i)*hx(i,3)+ py2(i)*hy(i,3)+pz2(i)*hz(i,3)
         px3h3(i)=px3(i)*hx(i,3)+ py3(i)*hy(i,3)+pz3(i)*hz(i,3)
         px4h3(i)=px4(i)*hx(i,3)+ py4(i)*hy(i,3)+pz4(i)*hz(i,3)
       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))
         px1h4(i)=px1(i)*hx(i,4)+ py1(i)*hy(i,4)+pz1(i)*hz(i,4)
         px2h4(i)=px2(i)*hx(i,4)+ py2(i)*hy(i,4)+pz2(i)*hz(i,4)
         px3h4(i)=px3(i)*hx(i,4)+ py3(i)*hy(i,4)+pz3(i)*hz(i,4)
         px4h4(i)=px4(i)*hx(i,4)+ py4(i)*hy(i,4)+pz4(i)*hz(i,4)
       ENDDO
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/)