pri224.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	pri224 (sig3d, epstot, eps, dir3d, ang)

Function/Subroutine Documentation

pri224()

subroutine pri224	(		sig3d,
			epstot,
			eps,
			dir3d,
			ang )

Definition at line 28 of file pri224.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real
     .   sig3d(*), epstot(*), eps(*), dir3d(*), ang(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .   sig(4), dir(2), vec(3), cc, bb, cr, ss1, ss2, orm, s11, s21,
     .   s31, s12, s22, s32, s13, s23, s33, a11, a12, a13, a21, a22,
     .   a23, a31, a32, a33
C-----------------------------------------------
      sig(1)=sig3d(2)
      sig(2)=sig3d(3)
      sig(4)=sig3d(5)
      cc=(sig(1)+sig(2))*half
      bb=(sig(1)-sig(2))*half
      cr=sqrt(bb**2+sig(4)**2)
      ss1=cc+cr
      ss2=cc-cr
C
      dir(1)=sig(4)
      dir(2)=ss1-sig(1)
      orm=dir(1)*dir(1)+dir(2)*dir(2)
      orm=sqrt(orm)
      IF(orm<em8)THEN
      dir(1)=one
      dir(2)=zero
      ELSE
      dir(1)=dir(1)/orm
      dir(2)=dir(2)/orm
      ENDIF
C . . . . . . . . . . . .
C     ROTATION EPS EPSTOT
C . . . . . . . . . . . .
      s11=one
      s21=zero
      s31=zero
      s12=zero    
      s22=dir(1)
      s32=dir(2)
      s13=zero
      s23=-dir(2)
      s33=dir(1)
C
      a11=sig3d(1)*s11+sig3d(4)*s21+sig3d(6)*s31
      a12=sig3d(1)*s12+sig3d(4)*s22+sig3d(6)*s32
      a13=sig3d(1)*s13+sig3d(4)*s23+sig3d(6)*s33
      a21=sig3d(4)*s11+sig3d(2)*s21+sig3d(5)*s31
      a22=sig3d(4)*s12+sig3d(2)*s22+sig3d(5)*s32
      a23=sig3d(4)*s13+sig3d(2)*s23+sig3d(5)*s33
      a31=sig3d(6)*s11+sig3d(5)*s21+sig3d(3)*s31
      a32=sig3d(6)*s12+sig3d(5)*s22+sig3d(3)*s32
      a33=sig3d(6)*s13+sig3d(5)*s23+sig3d(3)*s33
C      SIG3D(1)=S11*A11+S21*A21+S31*A31
C      SIG3D(2)=S12*A12+S22*A22+S32*A32
C      SIG3D(3)=S13*A13+S23*A23+S33*A33
      sig3d(4)=s11*a12+s21*a22+s31*a32
      sig3d(5)=s12*a13+s22*a23+s32*a33
      sig3d(6)=s11*a13+s21*a23+s31*a33
C
      eps(4)=half*eps(4)
      eps(5)=half*eps(5)
      eps(6)=half*eps(6)      
      a11=eps(1)*s11+eps(4)*s21+eps(6)*s31
      a12=eps(1)*s12+eps(4)*s22+eps(6)*s32
      a13=eps(1)*s13+eps(4)*s23+eps(6)*s33
      a21=eps(4)*s11+eps(2)*s21+eps(5)*s31
      a22=eps(4)*s12+eps(2)*s22+eps(5)*s32
      a23=eps(4)*s13+eps(2)*s23+eps(5)*s33
      a31=eps(6)*s11+eps(5)*s21+eps(3)*s31
      a32=eps(6)*s12+eps(5)*s22+eps(3)*s32
      a33=eps(6)*s13+eps(5)*s23+eps(3)*s33
      eps(1)=s11*a11+s21*a21+s31*a31
      eps(2)=s12*a12+s22*a22+s32*a32
      eps(3)=s13*a13+s23*a23+s33*a33
C      EPS(4)=S11*A12+S21*A22+S31*A32
C      EPS(5)=S12*A13+S22*A23+S32*A33
C      EPS(6)=S11*A13+S21*A23+S31*A33
C      EPS(4)=2.*EPS(4)
C      EPS(5)=2.*EPS(5)
C      EPS(6)=2.*EPS(6)
C
      epstot(4)=half*epstot(4)
      epstot(5)=half*epstot(5)
      epstot(6)=half*epstot(6)      
      a11=epstot(1)*s11+epstot(4)*s21+epstot(6)*s31
      a12=epstot(1)*s12+epstot(4)*s22+epstot(6)*s32
      a13=epstot(1)*s13+epstot(4)*s23+epstot(6)*s33
      a21=epstot(4)*s11+epstot(2)*s21+epstot(5)*s31
      a22=epstot(4)*s12+epstot(2)*s22+epstot(5)*s32
      a23=epstot(4)*s13+epstot(2)*s23+epstot(5)*s33
      a31=epstot(6)*s11+epstot(5)*s21+epstot(3)*s31
      a32=epstot(6)*s12+epstot(5)*s22+epstot(3)*s32
      a33=epstot(6)*s13+epstot(5)*s23+epstot(3)*s33
      epstot(1)=s11*a11+s21*a21+s31*a31
      epstot(2)=s12*a12+s22*a22+s32*a32
      epstot(3)=s13*a13+s23*a23+s33*a33
C      EPSTOT(4)=S11*A12+S21*A22+S31*A32
C      EPSTOT(5)=S12*A13+S22*A23+S32*A33
C      EPSTOT(6)=S11*A13+S21*A23+S31*A33
C      EPSTOT(4)=2.*EPSTOT(4)
C      EPSTOT(5)=2.*EPSTOT(5)
C      EPSTOT(6)=2.*EPSTOT(6)
C
      vec(1)=ang(2)*ang(6)-ang(5)*ang(3)
      vec(2)=ang(3)*ang(4)-ang(6)*ang(1)
      vec(3)=ang(1)*ang(5)-ang(4)*ang(2)
C
      dir3d(1)=dir(1)*ang(4)+dir(2)*vec(1)
      dir3d(2)=dir(1)*ang(5)+dir(2)*vec(2)
      dir3d(3)=dir(1)*ang(6)+dir(2)*vec(3)
C
      RETURN