s8zdericto3.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	s8zdericto3 (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, jac_i, nel, ismstr)

Function/Subroutine Documentation

s8zdericto3()

subroutine s8zdericto3	(		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,
			jac_i,
		integer, intent(in)	nel,
		integer, intent(in)	ismstr )

Definition at line 33 of file s8zdericto3.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
      INTEGER, INTENT(IN) :: ISMSTR
      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(*),jac_i(10,mvsiz)
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(mvsiz) ,   
     .   jaci1, jaci2, jaci3,
     .   jaci4, jaci5, jaci6,
     .   jaci7, jaci8, jaci9,
     .   x17 , x28 , x35 , x46,
     .   y17 , y28 , y35 , y46,
     .   z17 , z28 , z35 , z46,
     .   jac_59_68, jac_67_49, jac_48_57,
     .   jac_38_29, jac_19_37, jac_27_18,
     .   jac_26_35, jac_34_16, jac_15_24,
     .   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
        jaci1=jac_i(1,i)
        jaci4=jac_i(4,i)
        jaci7=jac_i(7,i)
        jaci2=jac_i(2,i)
        jaci5=jac_i(5,i)
        jaci8=jac_i(8,i)
        jaci3=jac_i(3,i)
        jaci6=jac_i(6,i)
        jaci9=jac_i(9,i)
        det(i) =jac_i(10,i)
C
        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
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       
       IF (ismstr/=11) RETURN
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       
        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
C
C     JACOBIAN
C
        jac_59_68=jac5(i)*jac9(i)-jac6(i)*jac8(i)
        jac_67_49=jac6(i)*jac7(i)-jac4(i)*jac9(i)
        jac_38_29=(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
        jac_19_37=( jac1(i)*jac9(i)-jac3(i)*jac7(i))
        jac_27_18=(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
        jac_26_35=( jac2(i)*jac6(i)-jac3(i)*jac5(i))
        jac_34_16=(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
        jac_15_24=( jac1(i)*jac5(i)-jac2(i)*jac4(i))
        jac_48_57=jac4(i)*jac8(i)-jac5(i)*jac7(i)
C----surface max mediane-- *16
        smax(i)= jac_59_68*jac_59_68+jac_67_49*jac_67_49
     .            +jac_48_57*jac_48_57
        smax(i)= max(smax(i),jac_38_29*jac_38_29+jac_19_37*jac_19_37
     .            +jac_27_18*jac_27_18)
        smax(i)= max(smax(i),jac_26_35*jac_26_35+jac_34_16*jac_34_16
     .            +jac_15_24*jac_15_24)
       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