s16sigp3.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/.
!||====================================================================
!||    s16sigp3       ../engine/source/elements/thickshell/solide16/s16sigp3.F
!||--- called by ------------------------------------------------------
!||    s16forc3       ../engine/source/elements/thickshell/solide16/s16forc3.F
!||--- calls      -----------------------------------------------------
!||    s8csigp3       ../engine/source/elements/thickshell/solide8c/s8csigp3.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.F90
!||====================================================================
      SUBROUTINE s16sigp3(LFT,LLT,NEL,NPTR,NLAY,NPTT,ICP,MTN,
     .                    NPE,NIPMAX, PX, PY, PZ, VX, VY, VZ, 
     .                    W_GAUSS,DEFP,PM,MXT,SIG,DT1,
     .                    ELBUF_STR)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod            
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "mvsiz_p.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LFT,LLT, NPTR,NLAY,NPTT,ICR,ICS,ICT,ICP,NEL,
     .        MTN,NPE,NIPMAX,MXT(*)
      my_real
     .  vx(mvsiz,*),vy(mvsiz,*),vz(mvsiz,*),
     .  px(mvsiz,npe,*),py(mvsiz,npe,*),pz(mvsiz,npe,*),
     .  dt1 ,w_gauss(9,9),defp(*),pm(npropm,*),sig(nel,6)
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IL,IS,IT,IR,IP,WI,N, MX
C     REAL
      my_real
     .  dvm(mvsiz), dv(mvsiz,nipmax),fac(mvsiz),dt3,dvp,f,e0(mvsiz)
      TYPE(g_bufel_) ,POINTER :: GBUF
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
C=======================================================================
      gbuf => elbuf_str%GBUF
      is = 1
      DO i=lft,llt
        dvm(i)=zero
      ENDDO
 
      DO it=1,nptt
       DO ir=1,nptr
        DO il=1,nlay
          lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
          ip = ir + ( (il-1) + (it-1)*nlay )*nptr
          wi = w_gauss(ir,nptr)*w_gauss(il,nlay)*w_gauss(it,nptt)
         DO i=lft,llt
           dv(i,ip)=zero
         ENDDO
         DO n=1,npe
          DO i=lft,llt
            dv(i,ip)=dv(i,ip)+px(i,n,ip)*vx(i,n)+py(i,n,ip)*vy(i,n)
     .              +pz(i,n,ip)*vz(i,n)
            dvm(i)=dvm(i)+dv(i,ip)*wi
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO
 
      dt3=third*dt1
      IF (icp == 1) THEN
        DO i=lft,llt
          fac(i)=one
        ENDDO
      ELSEIF (icp == 2) THEN
        mx = mxt(lft)
        DO i=lft,llt
          e0(i)  = pm(20,mx)
        ENDDO
        CALL s8csigp3(sig,e0 ,defp,fac,gbuf%G_PLA,nel)
      ENDIF
C
      DO it=1,nptt
       DO ir=1,nptr
        DO il=1,nlay
          lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
          ip = ir + ( (il-1) + (it-1)*nlay )*nptr
          DO i=lft,llt
            f = lbuf%OFF(i)*fac(i)
            dvp  = dt3*f*(dvm(i)-dv(i,ip))
            IF (dvp > one) THEN
              dvp =zero
              lbuf%OFF(i)=zero
            ENDIF
            lbuf%VOL(i)  = lbuf%VOL(i) *(one- dvp)
            lbuf%EINT(i) = lbuf%EINT(i)*(one- dvp)
          ENDDO 
        ENDDO
       ENDDO
      ENDDO
C-----------
      RETURN
      END SUBROUTINE s16sigp3