s8zfint3.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/.
!||====================================================================
!||    s8zfint3   ../engine/source/elements/solid/solide8z/s8zfint3.F
!||--- called by ------------------------------------------------------
!||    s8cforc3   ../engine/source/elements/thickshell/solide8c/s8cforc3.F
!||    s8zforc3   ../engine/source/elements/solid/solide8z/s8zforc3.F
!||====================================================================
      SUBROUTINE s8zfint3(
     1   SIG,     SIGOR,   PX1,     PX2,
     2   PX3,     PX4,     PY1,     PY2,
     3   PY3,     PY4,     PZ1,     PZ2,
     4   PZ3,     PZ4,     PX5,     PX6,
     5   PX7,     PX8,     PY5,     PY6,
     6   PY7,     PY8,     PZ5,     PZ6,
     7   PZ7,     PZ8,     PXY1,    PXY2,
     8   PXY3,    PXY4,    PXY5,    PXY6,
     9   PXY7,    PXY8,    PYX1,    PYX2,
     A   PYX3,    PYX4,    PYX5,    PYX6,
     B   PYX7,    PYX8,    PXZ1,    PXZ2,
     C   PXZ3,    PXZ4,    PXZ5,    PXZ6,
     D   PXZ7,    PXZ8,    PZX1,    PZX2,
     E   PZX3,    PZX4,    PZX5,    PZX6,
     F   PZX7,    PZX8,    PYZ1,    PYZ2,
     G   PYZ3,    PYZ4,    PYZ5,    PYZ6,
     H   PYZ7,    PYZ8,    PZY1,    PZY2,
     I   PZY3,    PZY4,    PZY5,    PZY6,
     J   PZY7,    PZY8,    BXY1,    BXY2,
     K   BXY3,    BXY4,    BXY5,    BXY6,
     L   BXY7,    BXY8,    BYX1,    BYX2,
     M   BYX3,    BYX4,    BYX5,    BYX6,
     N   BYX7,    BYX8,    BXZ1,    BXZ2,
     O   BXZ3,    BXZ4,    BXZ5,    BXZ6,
     P   BXZ7,    BXZ8,    BZX1,    BZX2,
     Q   BZX3,    BZX4,    BZX5,    BZX6,
     R   BZX7,    BZX8,    BYZ1,    BYZ2,
     S   BYZ3,    BYZ4,    BYZ5,    BYZ6,
     T   BYZ7,    BYZ8,    BZY1,    BZY2,
     U   BZY3,    BZY4,    BZY5,    BZY6,
     V   BZY7,    BZY8,    F11,     F21,
     W   F31,     F12,     F22,     F32,
     X   F13,     F23,     F33,     F14,
     Y   F24,     F34,     F15,     F25,
     Z   F35,     F16,     F26,     F36,
     1   F17,     F27,     F37,     F18,  
     2   F28,     F38,     VOL,     QVIS,
     3   PP,      EINT,    RHO,     Q,
     4   DEFP,    EPSD,    EPSDM,   SIGM,
     5   EINTM,   RHOM,    QM,      DEFPM,
     6   VOLG,    STI,     STIN,    ICP,
     7   OFF,     VOL0,    VOL0G,   G_PLA,
     8   G_EPSD,  JFAC,    EINTTH,  EINTTHM,
     9   IEXPAN,  NEL,     IDEG,    CONDE,
     A   CONDEN,  MTN,     ISMSTR,  SVIS ,NODADT_THERM,
     B   G_WPLA,  L_WPLA,  G_WPLA_FLAG)
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      "scr18_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: MTN
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER, INTENT(IN) :: NODADT_THERM
      INTEGER ICP,G_PLA,G_EPSD,IEXPAN,NEL,IDEG(*)
C     REAL
      my_real
     .   SIG(NEL,6),SIGOR(NEL,6),
     .   PX1(*), PX2(*), PX3(*), PX4(*),  
     .   PY1(*), PY2(*), PY3(*), PY4(*),  
     .   PZ1(*), PZ2(*), PZ3(*), PZ4(*),  
     .   PX5(*), PX6(*), PX7(*), PX8(*),  
     .   PY5(*), PY6(*), PY7(*), PY8(*),  
     .   PZ5(*), PZ6(*), PZ7(*), PZ8(*),  
     .   PXY1(*),PXY2(*),PXY3(*),PXY4(*),
     .   PXY5(*),PXY6(*),PXY7(*),PXY8(*),
     .   PYX1(*),PYX2(*),PYX3(*),PYX4(*),
     .   PYX5(*),PYX6(*),PYX7(*),PYX8(*),
     .   PXZ1(*),PXZ2(*),PXZ3(*),PXZ4(*),
     .   PXZ5(*),PXZ6(*),PXZ7(*),PXZ8(*),
     .   PZX1(*),PZX2(*),PZX3(*),PZX4(*),
     .   PZX5(*),PZX6(*),PZX7(*),PZX8(*),
     .   PYZ1(*),PYZ2(*),PYZ3(*),PYZ4(*),
     .   PYZ5(*),PYZ6(*),PYZ7(*),PYZ8(*),
     .   PZY1(*),PZY2(*),PZY3(*),PZY4(*),
     .   PZY5(*),PZY6(*),PZY7(*),PZY8(*),
     .   BXY1(*),BXY2(*),BXY3(*),BXY4(*),
     .   BXY5(*),BXY6(*),BXY7(*),BXY8(*),
     .   BYX1(*),BYX2(*),BYX3(*),BYX4(*),
     .   BYX5(*),BYX6(*),BYX7(*),BYX8(*),
     .   BXZ1(*),BXZ2(*),BXZ3(*),BXZ4(*),
     .   BXZ5(*),BXZ6(*),BXZ7(*),BXZ8(*),
     .   BZX1(*),BZX2(*),BZX3(*),BZX4(*),
     .   BZX5(*),BZX6(*),BZX7(*),BZX8(*),
     .   BYZ1(*),BYZ2(*),BYZ3(*),BYZ4(*),
     .   BYZ5(*),BYZ6(*),BYZ7(*),BYZ8(*),
     .   BZY1(*),BZY2(*),BZY3(*),BZY4(*),
     .   BZY5(*),BZY6(*),BZY7(*),BZY8(*),
     .   F11(*),F21(*),F31(*),F12(*),F22(*),F32(*),
     .   F13(*),F23(*),F33(*),F14(*),F24(*),F34(*),
     .   F15(*),F25(*),F35(*),F16(*),F26(*),F36(*),
     .   F17(*),F27(*),F37(*),F18(*),F28(*),F38(*),
     .   VOL(*),QVIS(*),PP(*),
     .   EINT(*),RHO(*),Q(*),DEFPM(*),DEFP(*),
     .   SIGM(NEL,6),EINTM(*),RHOM(*),QM(*),EPSD(*),EPSDM(*),
     .   VOLG(*),STI(*),STIN(*),OFF(*),VOL0(*),VOL0G(*),JFAC(*),
     .   EINTTH(*),EINTTHM(*),CONDE(MVSIZ),CONDEN(MVSIZ)
      INTEGER, INTENT(IN) :: G_WPLA_FLAG
      my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
      my_real,DIMENSION(NEL*G_WPLA_FLAG), INTENT(INOUT) :: g_wpla
      my_real,DIMENSION(NEL*G_WPLA_FLAG), INTENT(IN) :: l_wpla
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J
C     REAL
      my_real
     .   S1(MVSIZ), S2(MVSIZ), S3(MVSIZ),
     .   S4(MVSIZ), S5(MVSIZ), S6(MVSIZ),
     .   P(MVSIZ),FAC(MVSIZ),COEF,FVOL,
     .   QVIS_LOC,VOL_LOC
C-----------------------------------------------
      IF (ICP==1.AND.(ismstr==10.OR.ismstr==12)) THEN
       DO i=1,nel
        qvis_loc = qvis(i)
        fvol=jfac(i)*vol(i)
        s1(i)=(sig(i,1)+svis(i,1)-qvis_loc)*fvol
        s2(i)=(sig(i,2)+svis(i,2)-qvis_loc)*fvol
        s3(i)=(sig(i,3)+svis(i,3)-qvis_loc)*fvol
        s4(i)=(sig(i,4)+svis(i,4))*fvol
        s5(i)=(sig(i,5)+svis(i,5))*fvol
        s6(i)=(sig(i,6)+svis(i,6))*fvol
       ENDDO
      ELSEIF (icp==1) THEN
       coef=third
C------due to degratation of rubber test, will definitively fix w/ real Kt       
       IF (mtn==42.OR.mtn==62.OR.mtn==82)coef=zep3
       DO i=1,nel
        vol_loc = vol(i)
        p(i) =coef*(sig(i,1)+sig(i,2)+sig(i,3)
     .            +svis(i,1)+svis(i,2)+svis(i,3))
        IF (ideg(i)>10) p(i) =qvis(i)
        s1(i)=(sig(i,1)+svis(i,1)-p(i))*vol_loc
        s2(i)=(sig(i,2)+svis(i,2)-p(i))*vol_loc
        s3(i)=(sig(i,3)+svis(i,3)-p(i))*vol_loc
        s4(i)=(sig(i,4)+svis(i,4))*vol_loc
        s5(i)=(sig(i,5)+svis(i,5))*vol_loc
        s6(i)=(sig(i,6)+svis(i,6))*vol_loc
       ENDDO
      ELSE
       DO i=1,nel
        qvis_loc = qvis(i)
        vol_loc = vol(i)
        s1(i)=(sig(i,1)+svis(i,1)-qvis_loc)*vol_loc
        s2(i)=(sig(i,2)+svis(i,2)-qvis_loc)*vol_loc
        s3(i)=(sig(i,3)+svis(i,3)-qvis_loc)*vol_loc
        s4(i)=(sig(i,4)+svis(i,4))*vol_loc
        s5(i)=(sig(i,5)+svis(i,5))*vol_loc
        s6(i)=(sig(i,6)+svis(i,6))*vol_loc
       ENDDO
      ENDIF
       DO i=1,nel
        f11(i)=f11(i)-(s1(i)*px1(i)+s4(i)*pxy1(i)+s6(i)*pxz1(i))
        f21(i)=f21(i)-(s2(i)*py1(i)+s4(i)*pyx1(i)+s5(i)*pyz1(i))
        f31(i)=f31(i)-(s3(i)*pz1(i)+s6(i)*pzx1(i)+s5(i)*pzy1(i))
        f12(i)=f12(i)-(s1(i)*px2(i)+s4(i)*pxy2(i)+s6(i)*pxz2(i))
        f22(i)=f22(i)-(s2(i)*py2(i)+s4(i)*pyx2(i)+s5(i)*pyz2(i))
        f32(i)=f32(i)-(s3(i)*pz2(i)+s6(i)*pzx2(i)+s5(i)*pzy2(i))
        f13(i)=f13(i)-(s1(i)*px3(i)+s4(i)*pxy3(i)+s6(i)*pxz3(i))
        f23(i)=f23(i)-(s2(i)*py3(i)+s4(i)*pyx3(i)+s5(i)*pyz3(i))
        f33(i)=f33(i)-(s3(i)*pz3(i)+s6(i)*pzx3(i)+s5(i)*pzy3(i))
        f14(i)=f14(i)-(s1(i)*px4(i)+s4(i)*pxy4(i)+s6(i)*pxz4(i))
        f24(i)=f24(i)-(s2(i)*py4(i)+s4(i)*pyx4(i)+s5(i)*pyz4(i))
        f34(i)=f34(i)-(s3(i)*pz4(i)+s6(i)*pzx4(i)+s5(i)*pzy4(i))
        f15(i)=f15(i)-(s1(i)*px5(i)+s4(i)*pxy5(i)+s6(i)*pxz5(i))
        f25(i)=f25(i)-(s2(i)*py5(i)+s4(i)*pyx5(i)+s5(i)*pyz5(i))
        f35(i)=f35(i)-(s3(i)*pz5(i)+s6(i)*pzx5(i)+s5(i)*pzy5(i))
        f16(i)=f16(i)-(s1(i)*px6(i)+s4(i)*pxy6(i)+s6(i)*pxz6(i))
        f26(i)=f26(i)-(s2(i)*py6(i)+s4(i)*pyx6(i)+s5(i)*pyz6(i))
        f36(i)=f36(i)-(s3(i)*pz6(i)+s6(i)*pzx6(i)+s5(i)*pzy6(i))
        f17(i)=f17(i)-(s1(i)*px7(i)+s4(i)*pxy7(i)+s6(i)*pxz7(i))
        f27(i)=f27(i)-(s2(i)*py7(i)+s4(i)*pyx7(i)+s5(i)*pyz7(i))
        f37(i)=f37(i)-(s3(i)*pz7(i)+s6(i)*pzx7(i)+s5(i)*pzy7(i))
        f18(i)=f18(i)-(s1(i)*px8(i)+s4(i)*pxy8(i)+s6(i)*pxz8(i))
        f28(i)=f28(i)-(s2(i)*py8(i)+s4(i)*pyx8(i)+s5(i)*pyz8(i))
        f38(i)=f38(i)-(s3(i)*pz8(i)+s6(i)*pzx8(i)+s5(i)*pzy8(i))
       ENDDO
C  
       IF (icp/=1) THEN
        DO i=1,nel
         f11(i)=f11(i)-(s2(i)*bxy1(i)+s3(i)*bxz1(i))
         f21(i)=f21(i)-(s1(i)*byx1(i)+s3(i)*byz1(i))
         f31(i)=f31(i)-(s1(i)*bzx1(i)+s2(i)*bzy1(i))
         f12(i)=f12(i)-(s2(i)*bxy2(i)+s3(i)*bxz2(i))
         f22(i)=f22(i)-(s1(i)*byx2(i)+s3(i)*byz2(i))
         f32(i)=f32(i)-(s1(i)*bzx2(i)+s2(i)*bzy2(i))
         f13(i)=f13(i)-(s2(i)*bxy3(i)+s3(i)*bxz3(i))
         f23(i)=f23(i)-(s1(i)*byx3(i)+s3(i)*byz3(i))
         f33(i)=f33(i)-(s1(i)*bzx3(i)+s2(i)*bzy3(i))
         f14(i)=f14(i)-(s2(i)*bxy4(i)+s3(i)*bxz4(i))
         f24(i)=f24(i)-(s1(i)*byx4(i)+s3(i)*byz4(i))
         f34(i)=f34(i)-(s1(i)*bzx4(i)+s2(i)*bzy4(i))
         f15(i)=f15(i)-(s2(i)*bxy5(i)+s3(i)*bxz5(i))
         f25(i)=f25(i)-(s1(i)*byx5(i)+s3(i)*byz5(i))
         f35(i)=f35(i)-(s1(i)*bzx5(i)+s2(i)*bzy5(i))
         f16(i)=f16(i)-(s2(i)*bxy6(i)+s3(i)*bxz6(i))
         f26(i)=f26(i)-(s1(i)*byx6(i)+s3(i)*byz6(i))
         f36(i)=f36(i)-(s1(i)*bzx6(i)+s2(i)*bzy6(i))
         f17(i)=f17(i)-(s2(i)*bxy7(i)+s3(i)*bxz7(i))
         f27(i)=f27(i)-(s1(i)*byx7(i)+s3(i)*byz7(i))
         f37(i)=f37(i)-(s1(i)*bzx7(i)+s2(i)*bzy7(i))
         f18(i)=f18(i)-(s2(i)*bxy8(i)+s3(i)*bxz8(i))
         f28(i)=f28(i)-(s1(i)*byx8(i)+s3(i)*byz8(i))
         f38(i)=f38(i)-(s1(i)*bzx8(i)+s2(i)*bzy8(i))
        ENDDO
       ENDIF
C----------------------------------------------    /
C   - post-traitement-valeur moyenne au sens a'=(_/  a dv ) /v
      DO i=1,nel
         fac(i) = off(i)*vol(i)/volg(i)
         sigm(i,1) = sigm(i,1) + fac(i) * sigor(i,1)
         sigm(i,2) = sigm(i,2) + fac(i) * sigor(i,2)
         sigm(i,3) = sigm(i,3) + fac(i) * sigor(i,3)
         sigm(i,4) = sigm(i,4) + fac(i) * sigor(i,4)
         sigm(i,5) = sigm(i,5) + fac(i) * sigor(i,5)
         sigm(i,6) = sigm(i,6) + fac(i) * sigor(i,6)
         rhom(i)   = rhom(i)   + fac(i) * rho(i)
         eintm(i)  = eintm(i)  + eint(i)*vol0(i)/vol0g(i)
         IF (g_wpla_flag > 0) g_wpla(i) = g_wpla(i) + l_wpla(i)
         qm(i)     = qm(i)     + fac(i) * q(i)
C
         stin(i)   = stin(i)   + sti(i)
      ENDDO
      IF(nodadt_therm == 1) THEN
        DO i=1,nel
          conden(i)= conden(i)+ conde(i)
        ENDDO
      ENDIF
      IF (iexpan > 0) THEN
        DO i=1,nel
          eintthm(i)= eintthm(i)+ eintth(i)*vol0(i)/vol0g(i)
        ENDDO
      ENDIF
      IF (g_pla > 0) THEN
        DO i=1,nel
          defpm(i)  = defpm(i)  + fac(i) * defp(i)
        ENDDO
      ENDIF
      IF (g_epsd > 0) THEN
        DO i=1,nel
          epsdm(i) = epsdm(i) + fac(i) * epsd(i)
        ENDDO
      ENDIF
      IF (icp == 1) THEN
        DO i=1,nel
          pp(i) = pp(i) + fac(i)* (p(i)-qvis(i))
        ENDDO
      ENDIF
c-----------
      RETURN
      END