q4rcoor2.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/.
!||====================================================================
!||    q4rcoor2   ../engine/source/elements/solid_2d/quad4/q4rcoor2.F
!||--- called by ------------------------------------------------------
!||    q4forc2    ../engine/source/elements/solid_2d/quad4/q4forc2.F
!||--- calls      -----------------------------------------------------
!||    q4rrota2   ../engine/source/elements/solid_2d/quad4/q4rrota2.F
!||====================================================================
      SUBROUTINE q4rcoor2(
     1   X,       NCP,     Y1,      Y2,
     2   Y3,      Y4,      Z1,      Z2,
     3   Z3,      Z4,      NC1,     NC2,
     4   NC3,     NC4,     NGL,     MAT,
     5   NGEO,    VD2,     R11,     R12,
     6   R13,     R21,     R22,     R23,
     7   R31,     R32,     R33,     GAMA,
     8   Y234,    Y124,    VIS,     V,
     9   VY1,     VY2,     VY3,     VY4,
     A   VZ1,     VZ2,     VZ3,     VZ4,
     B   YAVG,    AY,      EXX,     NEL,
     C   ISORTH)
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, INTENT(IN) :: ISORTH
      INTEGER, INTENT(IN) :: NEL
      INTEGER NC1(*), NC2(*), NC3(*), NC4(*), MAT(*), NGL(*), NGEO(*),
     .        NCP(7,*)
C     REAL
      my_real
     .   X(3,*),Y1(*),Y2(*),Y3(*),Y4(*),Z1(*),Z2(*),Z3(*),Z4(*),VD2(*),
     .    VY1(*),VY2(*),VY3(*),VY4(*),
     .    VZ1(*),VZ2(*),VZ3(*),VZ4(*),
     .   R11(*),R12(*),R13(*),
     .   R21(*),R22(*),R23(*),
     .   R31(*),R32(*),R33(*),GAMA(MVSIZ,6),
     .   y234(*),y124(*),vis(*),v(3,*),yavg(*),exx(*),ay(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,IV
      my_real
     .   SY(MVSIZ) , SZ(MVSIZ) ,
     .   TY(MVSIZ) , TZ(MVSIZ) , 
     .   YL , ZL , SUMA,CS,CT,
     .   G22,G23,G32,G33,
     .   T22,T23,T32,T33,VYG
C-----------------------------------------------
      DO I=1,nel
        ngeo(i)=ncp(6,i)
        ngl(i)=ncp(7,i)
        mat(i)=ncp(1,i)
        nc1(i)=ncp(2,i)
        nc2(i)=ncp(3,i)
        nc3(i)=ncp(4,i)
        nc4(i)=ncp(5,i)
      END DO
C
C----------------------------
C     COORDONNEES NODALES
C----------------------------
      DO i=1,nel
        y1(i)=x(2,nc1(i))
        z1(i)=x(3,nc1(i))
        y2(i)=x(2,nc2(i))
        z2(i)=x(3,nc2(i))
        y3(i)=x(2,nc3(i))
        z3(i)=x(3,nc3(i))
        y4(i)=x(2,nc4(i))
        z4(i)=x(3,nc4(i))
      END DO
      DO i=1,nel
        vy1(i)=v(2,nc1(i))
        vz1(i)=v(3,nc1(i))
        vy2(i)=v(2,nc2(i))
        vz2(i)=v(3,nc2(i))
        vy3(i)=v(2,nc3(i))
        vz3(i)=v(3,nc3(i))
        vy4(i)=v(2,nc4(i))
        vz4(i)=v(3,nc4(i))
      END DO
C-----Exx ia calculated anyway in global system
      IF(n2d==1) THEN
        DO i=1,nel
          yavg(i) = y1(i)+y2(i)+y3(i)+y4(i)
          vyg = vy1(i)+vy2(i)+vy3(i)+vy4(i)
          y234(i)=y2(i)+y3(i)+y4(i)
          y124(i)=y1(i)+y2(i)+y4(i)
C-----constant Exx,
          ay(i) =one/max(em20,yavg(i))
          exx(i) = vyg*ay(i)
         ENDDO
      ENDIF
C---------------------------------------
C     REPERE LOCAL
C---------------------------------------
      DO i=1,nel
        sy(i)=half*(y2(i)+y3(i)-y1(i)-y4(i))
        sz(i)=half*(z2(i)+z3(i)-z1(i)-z4(i))
        ty(i)=half*(y3(i)+y4(i)-y1(i)-y2(i))
        tz(i)=half*(z3(i)+z4(i)-z1(i)-z2(i))
      END DO
C-----------
C     REPERE CONVECTE : Same than the shell
C-----------
      DO i=1,nel
        ct = ty(i)*ty(i)+tz(i)*tz(i)
        cs = sy(i)*sy(i)+sz(i)*sz(i)
        IF(cs /= zero) THEN
          suma = sqrt(ct/max(em20,cs))
          sy(i) = sy(i)*suma + tz(i)
          sz(i) = sz(i)*suma - ty(i)
        ELSEIF(ct /= zero)THEN
          suma = sqrt(cs/max(em20,ct))
          sy(i) = sy(i) + tz(i)*suma
          sz(i) = sz(i) - ty(i)*suma
        END IF 
      ENDDO
      DO i=1,nel
        suma=one/max(sqrt(sy(i)*sy(i)+sz(i)*sz(i)),em20)
        sy(i)=sy(i)*suma
        sz(i)=sz(i)*suma
      ENDDO
      DO i=1,nel
        r11(i)= one
        r21(i)= zero
        r31(i)= zero
        r12(i)= zero
        r22(i)= sy(i)
        r32(i)= sz(i)
        r13(i)= zero
        r23(i)=-sz(i)
        r33(i)= sy(i)
      END DO
C-----------
      DO i=1,nel
        yl=r22(i)*y1(i)+r32(i)*z1(i)
        zl=r23(i)*y1(i)+r33(i)*z1(i)
        y1(i)=yl
        z1(i)=zl
        yl=r22(i)*y2(i)+r32(i)*z2(i)
        zl=r23(i)*y2(i)+r33(i)*z2(i)
        y2(i)=yl
        z2(i)=zl
        yl=r22(i)*y3(i)+r32(i)*z3(i)
        zl=r23(i)*y3(i)+r33(i)*z3(i)
        y3(i)=yl
        z3(i)=zl
        yl=r22(i)*y4(i)+r32(i)*z4(i)
        zl=r23(i)*y4(i)+r33(i)*z4(i)
        y4(i)=yl
        z4(i)=zl
      END DO
C-----------
C     PASSAGE AU REPERE ORTHOTROPE.
C-----------
      IF (isorth /= 0)THEN
        DO i=1,nel
C         Extration de G tq Xortho=Transpose(G) Xcvt
C                                 =Transpose(G) Transpose(R) Xglobal.
          g22=gama(i,2)
          g32=gama(i,3)
          g23=gama(i,5)
          g33=gama(i,6)
C
          yl=g22*y1(i)+g32*z1(i)
          zl=g23*y1(i)+g33*z1(i)
          y1(i)=yl
          z1(i)=zl
          yl=g22*y2(i)+g32*z2(i)
          zl=g23*y2(i)+g33*z2(i)
          y2(i)=yl
          z2(i)=zl
          yl=g22*y3(i)+g32*z3(i)
          zl=g23*y3(i)+g33*z3(i)
          y3(i)=yl
          z3(i)=zl
          yl=g22*y4(i)+g32*z4(i)
          zl=g23*y4(i)+g33*z4(i)
          y4(i)=yl
          z4(i)=zl
C         MATRICE DE PASSAGE GLOBAL -> ORTHOTROPE.
          t22=r22(i)*g22+r23(i)*g32
          t23=r22(i)*g23+r23(i)*g33
          t32=r32(i)*g22+r33(i)*g32
          t33=r32(i)*g23+r33(i)*g33
          r22(i)=t22
          r23(i)=t23
          r32(i)=t32
          r33(i)=t33
        ENDDO
      ENDIF
        CALL q4rrota2(
     1   r22,     r23,     r32,     r33,
     2   vy1,     vy2,     vy3,     vy4,
     3   vz1,     vz2,     vz3,     vz4,
     4   nel)
C-----------
      DO i=1,nel
        vd2(i)=zero
        vis(i)=zero
      END DO
C
      RETURN
      END