s8zjac_i3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s8zjac_i3 (ksi, eta, zeta, wi, hx, hy, hz, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, jac_i, l_pij, pij, sig, sigl, index, nb, nel)

Function/Subroutine Documentation

s8zjac_i3()

subroutine s8zjac_i3	(		ksi,
			eta,
			zeta,
			wi,
			hx,
			hy,
			hz,
			cj1,
			cj2,
			cj3,
			cj4,
			cj5,
			cj6,
			cj7,
			cj8,
			cj9,
			jac_i,
		integer	l_pij,
			pij,
			sig,
			sigl,
		integer, dimension(*)	index,
		integer	nb,
		integer	nel )

Definition at line 28 of file s8zjac_i3.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER L_PIJ,NEL,INDEX(*),NB
      my_real
     .   ksi,eta,zeta,wi,
     .   hx(4,*), hy(4,*), hz(4,*),  
     .   cj1(*),cj2(*),cj3(*),
     .   cj4(*),cj5(*),cj6(*),
     .   cj7(*),cj8(*),cj9(*),
     .   jac_i(10,*),pij(nel,24),sig(nel,6),sigl(nel,6)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,  J
      my_real
     .   det(mvsiz) ,  dett(mvsiz) ,
     .   aj1(mvsiz),aj2(mvsiz),aj3(mvsiz),
     .   aj4(mvsiz),aj5(mvsiz),aj6(mvsiz),
     .   aj7(mvsiz),aj8(mvsiz),aj9(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)
      my_real
     .   aji1(mvsiz), aji2(mvsiz), aji3(mvsiz),
     .   aji4(mvsiz), aji5(mvsiz), aji6(mvsiz),
     .   aji7(mvsiz), aji8(mvsiz), aji9(mvsiz),
     .   a1pr1(mvsiz),a1pr3(mvsiz),a1pr5(mvsiz),a1pr7(mvsiz),
     .   a4pr1(mvsiz),a4pr3(mvsiz),a4pr5(mvsiz),a4pr7(mvsiz),
     .   a7pr1(mvsiz),a7pr3(mvsiz),a7pr5(mvsiz),a7pr7(mvsiz),
     .   a2ps1(mvsiz),a2ps2(mvsiz),a2ps5(mvsiz),a2ps6(mvsiz),
     .   a5ps1(mvsiz),a5ps2(mvsiz),a5ps5(mvsiz),a5ps6(mvsiz),
     .   a8ps1(mvsiz),a8ps2(mvsiz),a8ps5(mvsiz),a8ps6(mvsiz),
     .   a3pt1(mvsiz),a3pt2(mvsiz),a3pt3(mvsiz),a3pt4(mvsiz),
     .   a6pt1(mvsiz),a6pt2(mvsiz),a6pt3(mvsiz),a6pt4(mvsiz),
     .   a9pt1(mvsiz),a9pt2(mvsiz),a9pt3(mvsiz),a9pt4(mvsiz),
     .   pr(8),ps(8),pt(8),rp, sp, tp, rm, sm, tm,
     .   px1, px2, px3, px4,px5, px6, px7, px8,
     .   py1, py2, py3, py4,py5, py6, py7, py8,
     .   pz1, pz2, pz3, pz4,pz5, pz6, pz7, pz8,
     .   jac_1(10,mvsiz),pij12(24,nel)
C-----------------------------------------------
      DO i=1,nb
       aj1(i)=cj1(i)+hx(3,i)*eta+(hx(2,i)+hx(4,i)*eta)*zeta
       aj2(i)=cj2(i)+hy(3,i)*eta+(hy(2,i)+hy(4,i)*eta)*zeta
       aj3(i)=cj3(i)+hz(3,i)*eta+(hz(2,i)+hz(4,i)*eta)*zeta
C
       aj4(i)=cj4(i)+hx(1,i)*zeta+(hx(3,i)+hx(4,i)*zeta)*ksi
       aj5(i)=cj5(i)+hy(1,i)*zeta+(hy(3,i)+hy(4,i)*zeta)*ksi
       aj6(i)=cj6(i)+hz(1,i)*zeta+(hz(3,i)+hz(4,i)*zeta)*ksi
C
       aj7(i)=cj7(i)+hx(2,i)*ksi+(hx(1,i)+hx(4,i)*ksi)*eta
       aj8(i)=cj8(i)+hy(2,i)*ksi+(hy(1,i)+hy(4,i)*ksi)*eta
       aj9(i)=cj9(i)+hz(2,i)*ksi+(hz(1,i)+hz(4,i)*ksi)*eta
      ENDDO
C
C     JACOBIAN
C
      DO i=1,nb
      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,nb
      det(i)=one_over_512*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
      dett(i)=one_over_512/det(i)
      ENDDO
C      
      IF (l_pij ==0) THEN
      DO i=1,nb
       jac_1(1,i)=dett(i)*jac_59_68(i)
       jac_1(4,i)=dett(i)*jac_67_49(i)
       jac_1(7,i)=dett(i)*jac_48_57(i)
       jac_1(2,i)=dett(i)*jac_38_29(i)
       jac_1(5,i)=dett(i)*jac_19_37(i)
       jac_1(8,i)=dett(i)*jac_27_18(i)
       jac_1(3,i)=dett(i)*jac_26_35(i)
       jac_1(6,i)=dett(i)*jac_34_16(i)
       jac_1(9,i)=dett(i)*jac_15_24(i)
       jac_1(10,i)=det(i)
      ENDDO
#include "vectorize.inc"
          DO j=1,nb
            i = index(j)
            jac_i(1:10,i) = jac_1(1:10,j)
          ENDDO      
      ELSE
C--------calculate Pij----      
      DO i=1,nb
       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------NI,ksi-------
      rp = one + ksi
      sp = one + eta
      tp = one + zeta
      rm = one - ksi
      sm = one - eta
      tm = one - zeta
      pr(1)=-sm*tm
      pr(2)=-pr(1)
      pr(3)= sp*tm
      pr(4)=-pr(3)
      pr(5)=-sm*tp
      pr(6)=-pr(5)
      pr(7)= sp*tp
      pr(8)=-pr(7)
      ps(1)=-rm*tm
      ps(2)=-rp*tm
      ps(3)=-ps(2)
      ps(4)=-ps(1)
      ps(5)=-rm*tp
      ps(6)=-rp*tp
      ps(7)=-ps(6)
      ps(8)=-ps(5)
      pt(1)=-rm*sm
      pt(2)=-rp*sm
      pt(3)=-rp*sp
      pt(4)=-rm*sp
      pt(5)=-pt(1)
      pt(6)=-pt(2)
      pt(7)=-pt(3)
      pt(8)=-pt(4)
cc
      DO i=1,nb
        a1pr1(i)=aji1(i)*pr(1)
        a1pr3(i)=aji1(i)*pr(3)
        a1pr5(i)=aji1(i)*pr(5)
        a1pr7(i)=aji1(i)*pr(7)
        a4pr1(i)=aji4(i)*pr(1)
        a4pr3(i)=aji4(i)*pr(3)
        a4pr5(i)=aji4(i)*pr(5)
        a4pr7(i)=aji4(i)*pr(7)
        a7pr1(i)=aji7(i)*pr(1)
        a7pr3(i)=aji7(i)*pr(3)
        a7pr5(i)=aji7(i)*pr(5)
        a7pr7(i)=aji7(i)*pr(7)
      ENDDO
      DO i=1,nb
        a2ps1(i)=aji2(i)*ps(1)
        a2ps2(i)=aji2(i)*ps(2)
        a2ps5(i)=aji2(i)*ps(5)
        a2ps6(i)=aji2(i)*ps(6)
        a5ps1(i)=aji5(i)*ps(1)
        a5ps2(i)=aji5(i)*ps(2)
        a5ps5(i)=aji5(i)*ps(5)
        a5ps6(i)=aji5(i)*ps(6)
        a8ps1(i)=aji8(i)*ps(1)
        a8ps2(i)=aji8(i)*ps(2)
        a8ps5(i)=aji8(i)*ps(5)
        a8ps6(i)=aji8(i)*ps(6)
      ENDDO
C
      DO i=1,nb
        a3pt1(i)=aji3(i)*pt(1)
        a3pt2(i)=aji3(i)*pt(2)
        a3pt3(i)=aji3(i)*pt(3)
        a3pt4(i)=aji3(i)*pt(4)
        a6pt1(i)=aji6(i)*pt(1)
        a6pt2(i)=aji6(i)*pt(2)
        a6pt3(i)=aji6(i)*pt(3)
        a6pt4(i)=aji6(i)*pt(4)
        a9pt1(i)=aji9(i)*pt(1)
        a9pt2(i)=aji9(i)*pt(2)
        a9pt3(i)=aji9(i)*pt(3)
        a9pt4(i)=aji9(i)*pt(4)
      ENDDO
C
      DO i=1,nb
       px1= a1pr1(i)+a2ps1(i)+a3pt1(i)       
       px2=-a1pr1(i)+a2ps2(i)+a3pt2(i)
       px3= a1pr3(i)-a2ps2(i)+a3pt3(i)
       px4=-a1pr3(i)-a2ps1(i)+a3pt4(i)
       px5= a1pr5(i)+a2ps5(i)-a3pt1(i)
       px6=-a1pr5(i)+a2ps6(i)-a3pt2(i)
       px7= a1pr7(i)-a2ps6(i)-a3pt3(i)
       px8=-a1pr7(i)-a2ps5(i)-a3pt4(i)
C
       py1= a4pr1(i)+a5ps1(i)+a6pt1(i)
       py2=-a4pr1(i)+a5ps2(i)+a6pt2(i)
       py3= a4pr3(i)-a5ps2(i)+a6pt3(i)
       py4=-a4pr3(i)-a5ps1(i)+a6pt4(i)
       py5= a4pr5(i)+a5ps5(i)-a6pt1(i)
       py6=-a4pr5(i)+a5ps6(i)-a6pt2(i)
       py7= a4pr7(i)-a5ps6(i)-a6pt3(i)
       py8=-a4pr7(i)-a5ps5(i)-a6pt4(i)
C
       pz1= a7pr1(i)+a8ps1(i)+a9pt1(i)
       pz2=-a7pr1(i)+a8ps2(i)+a9pt2(i)
       pz3= a7pr3(i)-a8ps2(i)+a9pt3(i)
       pz4=-a7pr3(i)-a8ps1(i)+a9pt4(i)
       pz5= a7pr5(i)+a8ps5(i)-a9pt1(i)
       pz6=-a7pr5(i)+a8ps6(i)-a9pt2(i)
       pz7= a7pr7(i)-a8ps6(i)-a9pt3(i)
       pz8=-a7pr7(i)-a8ps5(i)-a9pt4(i)
C
       pij12(1,i) = px1
       pij12(2,i) = py1
       pij12(3,i) = pz1
       pij12(4,i) = px2
       pij12(5,i) = py2
       pij12(6,i) = pz2
       pij12(7,i) = px3
       pij12(8,i) = py3
       pij12(9,i) = pz3
       pij12(10,i) = px4
       pij12(11,i) = py4
       pij12(12,i) = pz4
       pij12(13,i) = px5
       pij12(14,i) = py5
       pij12(15,i) = pz5
       pij12(16,i) = px6
       pij12(17,i) = py6
       pij12(18,i) = pz6
       pij12(19,i) = px7
       pij12(20,i) = py7
       pij12(21,i) = pz7
       pij12(22,i) = px8
       pij12(23,i) = py8
       pij12(24,i) = pz8
      ENDDO
#include "vectorize.inc"
          DO j=1,nb
            i = index(j)
            pij(i,1:24) = pij12(1:24,j)
          ENDDO      
      END IF !(L_JAC >0) THEN
#include "vectorize.inc"
          DO j=1,nb
            i = index(j)
            sigl(i,1:6) = sig(i,1:6)
          ENDDO      
C
      RETURN