q4deri2.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/.
!||====================================================================
!||    q4deri2   ../engine/source/elements/solid_2d/quad4/q4deri2.F
!||--- called by ------------------------------------------------------
!||    q4forc2   ../engine/source/elements/solid_2d/quad4/q4forc2.F
!||    q4ke2     ../engine/source/elements/solid_2d/quad4/q4ke2.F
!||====================================================================
      SUBROUTINE q4deri2(
     1   OFFG,    OFF,     KSI,     ETA,
     2   WI,      YAVG,    Y12,     Y34,
     3   Y13,     Y24,     Y14,     Y23,
     4   Z12,     Z34,     Z13,     Z24,
     5   Z14,     Z23,     PY1,     PY2,
     6   PY3,     PY4,     PZ1,     PZ2,
     7   PZ3,     PZ4,     PYC1,    PYC2,
     8   PZC1,    PZC2,    BYZ1,    BYZ2,
     9   BYZ3,    BYZ4,    BZY1,    BZY2,
     A   BZY3,    BZY4,    AIRN,    VOLN,
     B   NU,      NEL,     JHBE)
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: JHBE
C     REAL
      my_real
     .    OFFG(*),OFF(*),KSI,ETA,WI,YAVG(*),
     .    Y12(*),Y34(*),Y13(*),Y24(*),Y14(*),Y23(*),
     .    Z12(*),Z34(*),Z13(*),Z24(*),Z14(*),Z23(*),
     .    PY1(*),PY2(*),PY3(*),PY4(*),
     .    PZ1(*),PZ2(*),PZ3(*),PZ4(*),
     .    PZC1(*),PZC2(*),PYC1(*),PYC2(*),
     .    BYZ1(*),BYZ2(*),BYZ3(*),BYZ4(*),
     .    bzy1(*),bzy2(*),bzy3(*),bzy4(*),
     .    airn(*),voln(*),nu(*)
C-----------------------------------------------
c FUNCTION: 
c ARGUMENTS:  (I: input, O: output, IO: input & output, W: workspace)
c TYPE NAME                FUNCTION
c  I   OFFG               - ELEMENT D/A FLAG, OVERALL
c  IO  OFF                - ELEMENT D/A FLAG, OF POINT
c  I   KSI,ETA,WI         - NATURAL COORDINATES, WEIGHT
c  O   YAVG(*)            - SUMMERY OF "Y" OF THE FOUR NODES
c  I   Y12(*)~Z23(*)      - DIFFERENCE: Yi-Yj, Zi-Zj
c  O   PY1(*)~PZ4(*)      - SHAPE DERIVATIVES (dNi/dY, dNi/dZ)
c  O   AIRN(*)            - W*|J|
c  O   VOLN(*)            - W*|J| FOR PLAIN CASE; r'*W*|J| FOR AXISYMMETRIC CASE
c  O   RX(*)~TZ(*)        - JACOBIAN MATRIX [J]
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .    DNDK1,DNDK2,DNDK3,DNDK4,
     .    DNDE1,DNDE2,DNDE3,DNDE4,
     .    DYDK(MVSIZ),DYDE(MVSIZ),DZDK(MVSIZ),DZDE(MVSIZ),
     .    DET(MVSIZ),YH(MVSIZ),ZH(MVSIZ)
      my_real
     .    QN1,QN2,QN3,QN4,YD,DETI,NU1
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C     4.*(dNi/dK, dNi/dE)
      dndk1 = eta - one
      dndk3 = eta + one
      dndk2 = - dndk1
      dndk4 = - dndk3
      dnde1 = ksi - one
      dnde3 = ksi + one
      dnde2 = - dnde3
      dnde4 = - dnde1
C
      DO i=1,nel
C       4.*(dY/dK, dY/dE, dZ/dK, dZ/dE)
        dydk(i) = (y14(i)-y23(i))*eta-y13(i)+y24(i)
        dyde(i) = (y12(i)+y34(i))*ksi-y13(i)-y24(i)
        dzdk(i) = (z14(i)-z23(i))*eta-z13(i)+z24(i)
        dzde(i) = (z12(i)+z34(i))*eta-z13(i)-z24(i)
C       8.*|J|
        det(i) = (y34(i)*z12(i)-y12(i)*z34(i))*ksi +
     .           (y23(i)*z14(i)-y14(i)*z23(i))*eta +
     .           y13(i)*z24(i)-y24(i)*z13(i)
C       W*|J|
        voln(i) = one_over_8*det(i)*wi
        airn(i) = voln(i)
C       dNi/dY, dNi/dZ
C------add something later for DET=~ zero-----
        deti=half/det(i)
        py1(i) = deti*(dzde(i)*dndk1-dzdk(i)*dnde1)
        py2(i) = deti*(dzde(i)*dndk2-dzdk(i)*dnde2)
        py3(i) = deti*(dzde(i)*dndk3-dzdk(i)*dnde3)
        py4(i) = deti*(dzde(i)*dndk4-dzdk(i)*dnde4)
        pz1(i) = deti*(dydk(i)*dnde1-dyde(i)*dndk1)
        pz2(i) = deti*(dydk(i)*dnde2-dyde(i)*dndk2)
        pz3(i) = deti*(dydk(i)*dnde3-dyde(i)*dndk3)
        pz4(i) = deti*(dydk(i)*dnde4-dyde(i)*dndk4)
      ENDDO
C
      IF(n2d==1) THEN
        IF(jhbe==17) THEN
         DO i=1,nel
            voln(i) = fourth*yavg(i)*voln(i)
         ENDDO
        ENDIF
      ENDIF
C
      DO i=1,nel
        off(i) = offg(i)
        IF(voln(i)<=zero .AND. off(i)/=zero) THEN
          voln(i) = em20
          off(i) =zero
        ENDIF
      ENDDO
C----Assumed strain      
      DO i=1,nel
        byz1(i) = -nu(i)*(pz1(i) - pzc1(i))
        byz2(i) = -nu(i)*(pz2(i) - pzc2(i))
        byz3(i) = -nu(i)*(pz3(i) + pzc1(i))
        byz4(i) = -nu(i)*(pz4(i) + pzc2(i))
        bzy1(i) = -nu(i)*(py1(i) - pyc1(i))
        bzy2(i) = -nu(i)*(py2(i) - pyc2(i))
        bzy3(i) = -nu(i)*(py3(i) + pyc1(i))
        bzy4(i) = -nu(i)*(py4(i) + pyc2(i))
      ENDDO
      DO i=1,nel
        nu1 = one-nu(i)
        py1(i) = pyc1(i) + nu1*(py1(i) - pyc1(i))
        py2(i) = pyc2(i) + nu1*(py2(i) - pyc2(i))
        py3(i) =-pyc1(i) + nu1*(py3(i) + pyc1(i))
        py4(i) =-pyc2(i) + nu1*(py4(i) + pyc2(i))
        pz1(i) = pzc1(i) + nu1*(pz1(i) - pzc1(i))
        pz2(i) = pzc2(i) + nu1*(pz2(i) - pzc2(i))
        pz3(i) =-pzc1(i) + nu1*(pz3(i) + pzc1(i))
        pz4(i) =-pzc2(i) + nu1*(pz4(i) + pzc2(i))
      ENDDO
C
      RETURN
      END