qrota3.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	qrota3 (x, ixq, kcvt, tens, gama, isorth)

Function/Subroutine Documentation

qrota3()

subroutine qrota3	(		x,
		integer, dimension(nixq)	ixq,
		integer	kcvt,
			tens,
			gama,
		integer, intent(in)	isorth )

Definition at line 30 of file qrota3.F.

      use element_mod , only : nixq
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-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: ISORTH
      my_real
     .   x(3,*),tens(6),gama(6)
      INTEGER IXQ(NIXQ), KCVT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .      
     .   y1, y2, y3, y4,
     .   z1, z2, z3, z4,
     .   
     .   r22,r23,r32,r33,
     .   g22,g33,g23,g32,
     .   t22,t33,t23,t32,
     .   
     .   sy,sz,ty,tz,ct,cs,suma,
     .   t1,t2,t3,t4,s1,s2,s4
      INTEGER NC1, NC2, NC3, NC4
C-----------------------------------------------
        nc1=ixq(2)
        nc2=ixq(3)
        nc3=ixq(4)
        nc4=ixq(5)
C----------------------------
C     NODE COORDINATES
C----------------------------
        y1=x(2,nc1)
        z1=x(3,nc1)
        y2=x(2,nc2)
        z2=x(3,nc2)
        y3=x(2,nc3)
        z3=x(3,nc3)
        y4=x(2,nc4)
        z4=x(3,nc4)
C-----------
C       convected frame
C-----------
        sy=half*(y2+y3-y1-y4)
        sz=half*(z2+z3-z1-z4)
        ty=half*(y3+y4-y1-y2)
        tz=half*(z3+z4-z1-z2)
        ct = ty*ty+tz*tz
        cs = sy*sy+sz*sz
        IF(cs /= zero) THEN
          suma = sqrt(ct/max(em20,cs))
          sy = sy*suma + tz
          sz = sz*suma - ty
        ELSEIF(ct /= zero)THEN
          suma = sqrt(cs/max(em20,ct))
          sy = sy + tz*suma
          sz = sz - ty*suma
        END IF 
        suma=one/max(sqrt(sy*sy+sz*sz),em20)
        sy=sy*suma
        sz=sz*suma
C-----------
C       TRANSFORMATION MATRIX GLOBAL -> CONVECTED
C-----------
        r22= sy
        r32=-sz
        r23= sz
        r33= sy
c
        IF (isorth /= 0) THEN
          IF (kcvt == 0) THEN
            g22=gama(1)
            g32=gama(2)
            g23=gama(4)
            g33=gama(5)
C-----------
c       TRANSFORMATION MATRIX GLOBAL -> ORTHOTROPIC.
C-----------
            t22=r22*g22+r23*g32
            t23=r22*g23+r23*g33
            t32=r32*g22+r33*g32
            t33=r32*g23+r33*g33
            r22=t22
            r23=t23
            r32=t32
            r33=t33
          ELSEIF (kcvt /=0) THEN
            g22=gama(2)
            g32=gama(3)
            g23=gama(5)
            g33=gama(6)
            t22=r22*g22+r23*g32
            t23=r22*g23+r23*g33
            t32=r32*g22+r33*g32
            t33=r32*g23+r33*g33
C-----------
c       TRANSFORMATION MATRIX ORTHOTROPIC -> GLOBAL
C-----------
            r22=t22
            r23=t23
            r32=t32
            r33=t33
          ENDIF             
        END IF
C-----------
C       SIZE(TENS)=6 STORED AS SOLIDS BUT ONLY USE 1, 2 and 4
C-----------
        s1=tens(1)
        s2=tens(2)
        s4=tens(4)
C-----------
        IF (kcvt == 0) THEN
C-----------
C      Rotation from GLOBAL FRAME TO CONVECTED OR ORTHO 
C-----------
          t1=s1*r22+s4*r23
          t2=s4*r32+s2*r33
          t3=s1*r32+s4*r33
          t4=s4*r22+s2*r23
          tens(1)=r22*t1+r23*t4
          tens(2)=r32*t3+r33*t2
          tens(4)=r22*t3+r23*t2
        ELSE
C-----------
C      Rotation from CONVECTE FRAME OR ORTHO TO GLOBAL FRAME
C-----------
          t1=s1*r22-s4*r23
          t2=-s4*r32+s2*r33
          t3=-s1*r32+s4*r33
          t4=s4*r22-s2*r23
          tens(1)=r22*t1-r23*t4
          tens(2)=-r32*t3+r33*t2
          tens(4)=r22*t3-r23*t2
        ENDIF
C-----------
      RETURN