i2cin_rot27.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i2cin_rot27 (stbrk, rs, rm, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, dpara, dwdu, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir, betax, betay)

Function/Subroutine Documentation

i2cin_rot27()

subroutine i2cin_rot27	(		stbrk,
			rs,
			rm,
			x1,
			y1,
			z1,
			x2,
			y2,
			z2,
			x3,
			y3,
			z3,
			x4,
			y4,
			z4,
			dpara,
			dwdu,
			e1x,
			e1y,
			e1z,
			e2x,
			e2y,
			e2z,
			e3x,
			e3y,
			e3z,
		integer	nir,
			betax,
			betay )

Definition at line 30 of file i2cin_rot27.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
        INTEGER NIR
        my_real
     .     stbrk,rs(3),rm(3),dpara(7),x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,dwdu,
     .     e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,betax,betay
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C     REAL
        my_real
     .     r(3),
     .     x12,x22,x32,x42,y12,y22,y32,y42,z12,z22,z32,z42,
     .     xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
     .     b1,b2,b3,c1,c2,c3,det,bb1,bb2,bb3,cc1,cc2,cc3,
     .     mloc(3,3),mloc2(3,3),mglob(3,3),pass(3,3),tpass(3,3),
     .     vect_sx,vect_sy,vect_sz,surf,ratio,l12_2,l23_2,l34_2,l41_2
C=======================================================================
C
        r(1)=rs(1)-rm(1)
        r(2)=rs(2)-rm(2)
        r(3)=rs(3)-rm(3)
C
        x12=x1*x1
        x22=x2*x2
        x32=x3*x3
        x42=x4*x4
        y12=y1*y1
        y22=y2*y2
        y32=y3*y3
        y42=y4*y4
        z12=z1*z1
        z22=z2*z2
        z32=z3*z3
        z42=z4*z4
        xx=x12 + x22 + x32 + x42
        yy=y12 + y22 + y32 + y42
        zz=z12 + z22 + z32 + z42
        xy=x1*y1 + x2*y2 + x3*y3 + x4*y4
        yz=y1*z1 + y2*z2 + y3*z3 + y4*z4
        zx=z1*x1 + z2*x2 + z3*x3 + z4*x4
        zzz=xx+yy
        xxx=yy+zz
        yyy=zz+xx
        xy2=xy*xy
        yz2=yz*yz
        zx2=zx*zx
        det= xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2
     .               - two*xy*yz*zx
C
C --- VECT_SURF = 0.5*(X1^X2 + X2^X3 + X3^X4 +X4^X1)
C
        IF (nir == 4) THEN
          vect_sx = y1*z2+y2*z3+y3*z4+y4*z1-z1*y2-z2*y3-z3*y4-z4*y1
          vect_sy = z1*x2+z2*x3+z3*x4+z4*x1-x1*z2-x2*z3-x3*z4-x4*z1
          vect_sz = x1*y2+x2*y3+x3*y4+x4*y1-y1*x2-y2*x3-y3*x4-y4*x1
        ELSE
          vect_sx = y1*z2+y2*z3+y3*z1-z1*y2-z2*y3-z3*y1
          vect_sy = z1*x2+z2*x3+z3*x1-x1*z2-x2*z3-x3*z1
          vect_sz = x1*y2+x2*y3+x3*y1-y1*x2-y2*x3-y3*x1
        ENDIF
C
        surf = sqrt(vect_sx*vect_sx+vect_sy*vect_sy+vect_sz*vect_sz)
C
        l12_2 = (x2-x1)**2+(y2-y1)**2+(z2-z1)**2
        l23_2 = (x3-x2)**2+(y3-y2)**2+(z3-z2)**2
        l34_2 = (x4-x3)**2+(y4-y3)**2+(z4-z3)**2
        l41_2 = (x1-x4)**2+(y1-y4)**2+(z1-z4)**2
C
C --- RATIO = h / Lmax = 0.5*S/Lmax2
C--> in case of triangle RATIO=h/l and in case of rectangle RATIO = 2*h/L
        ratio = surf / max(l12_2,l23_2,l34_2,l41_2)
C
C      IF (ABS(DET) < 1e-8) print *,"ATTENTION D < 1e-8",DET,RATIO,XX,YY
C
        IF (ratio > 5e-3) THEN
C-- standard situation
          det = one/det
          b1=zzz*yyy-yz2
          b2=xxx*zzz-zx2
          b3=yyy*xxx-xy2
          c3=zzz*xy+yz*zx
          c1=xxx*yz+zx*xy
          c2=yyy*zx+xy*yz
          betax = one
          betay = one
        ELSEIF (yy < xx) THEN
C-- nodes are nearly aligned on local X axis - DET = 0 - switch to 1D formulation
          det = one
          b1=zero
          b2=one/xx
          b3=one/xx
          c3=zero
          c1=zero
          c2=zero
          betax = zero
          betay = one
        ELSE
C-- nodes are nearly aligned on local Y axis - DET = 0 - switch to 1D formulation
          det = one
          b1=one/yy
          b2=zero
          b3=one/yy
          c3=zero
          c1=zero
          c2=zero
          betax = one
          betay = zero
        ENDIF
C
        bb1=b1*b1
        bb2=b2*b2
        bb3=b3*b3
        cc1=c1*c1
        cc2=c2*c2
        cc3=c3*c3
C
        dwdu=det*sqrt(max(bb1*(yy+zz)+cc3*(zz+xx)+cc2*(xx+yy),
     .                    bb2*(zz+xx)+cc1*(xx+yy)+cc3*(yy+zz),
     .                    bb3*(xx+yy)+cc2*(yy+zz)+cc1*(zz+xx)))
C
        stbrk=sqrt((r(1)*r(1)+r(2)*r(2)+r(3)*r(3)))*dwdu
C
C     Matrix M-1 must be stored in global skew for i2vit3
C
        mloc(1,1)=b1
        mloc(1,2)=c3
        mloc(1,3)=c2
        mloc(2,1)=c3
        mloc(2,2)=b2
        mloc(2,3)=c1
        mloc(3,1)=c2
        mloc(3,2)=c1
        mloc(3,3)=b3
C
        pass(1,1) = e1x
        pass(1,2) = e2x
        pass(1,3) = e3x
        pass(2,1) = e1y
        pass(2,2) = e2y
        pass(2,3) = e3y
        pass(3,1) = e1z
        pass(3,2) = e2z
        pass(3,3) = e3z
C
        tpass(1,1) = e1x
        tpass(1,2) = e1y
        tpass(1,3) = e1z
        tpass(2,1) = e2x
        tpass(2,2) = e2y
        tpass(2,3) = e2z
        tpass(3,1) = e3x
        tpass(3,2) = e3y
        tpass(3,3) = e3z
C
        mloc2(1:3,1:3) = matmul(mloc(1:3,1:3),tpass(1:3,1:3))
        mglob(1:3,1:3) = matmul(pass(1:3,1:3),mloc2(1:3,1:3))
C
        dpara(1)=det
        dpara(2)=mglob(1,1)
        dpara(3)=mglob(2,2)
        dpara(4)=mglob(3,3)
        dpara(5)=mglob(2,3)
        dpara(6)=mglob(1,3)
        dpara(7)=mglob(1,2)
C
C-----------
        RETURN