qrota3.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    qrota3        ../engine/source/output/anim/generate/qrota3.F
!||--- called by ------------------------------------------------------
!||    thquad        ../engine/source/output/th/thquad.F
!||--- uses       -----------------------------------------------------
!||    element_mod   ../common_source/modules/elements/element_mod.F90
!||====================================================================
      SUBROUTINE qrota3(
     1   X,       IXQ,     KCVT,    TENS,
     2   GAMA,    ISORTH)
      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
      END