m27elas.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/.
!||====================================================================
!||    m27elas     ../engine/source/materials/mat/mat027/m27elas.F
!||--- called by ------------------------------------------------------
!||    sigeps27c   ../engine/source/materials/mat/mat027/sigeps27c.F
!||====================================================================
      SUBROUTINE m27elas(JFT    ,JLT    ,PM     ,SIG    ,IMAT  ,
     2                   DEPSXX ,DEPSYY ,DEPSXY ,DEPSYZ ,DEPSZX,
     3                   DAMT   ,CRAK   ,SHF    ,NEL    )
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JFT, JLT,IMAT,NEL
C     REAL
      my_real
     . pm(npropm,*),damt(nel,2),crak(nel,2),shf(*),
     . depsxx(mvsiz),depsyy(mvsiz),depsxy(mvsiz),depsyz(mvsiz),
     . depszx(mvsiz)
      my_real, INTENT(INOUT) :: sig(nel,5)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     . e(mvsiz),nu(mvsiz),g(mvsiz),de1(mvsiz),de2(mvsiz),
     . eel1(mvsiz),eel2(mvsiz),eel3(mvsiz),eel4(mvsiz),eel5(mvsiz),
     . a11(mvsiz),a22(mvsiz),a12(mvsiz),epst1(mvsiz),epst2(mvsiz),
     . epsm1(mvsiz),epsm2(mvsiz),dmax1(mvsiz),dmax2(mvsiz),
     . scale1,scale2
C-----------------------------------------------
#include "vectorize.inc" 
      DO i=jft,jlt
        e(i)     = pm(20,imat)
        nu(i)    = pm(21,imat)
        g(i)     = pm(22,imat)
        epst1(i) = pm(60,imat)
        epst2(i) = pm(61,imat)
        epsm1(i) = pm(62,imat)
        epsm2(i) = pm(63,imat)
        dmax1(i) = pm(64,imat)
        dmax2(i) = pm(65,imat)
      ENDDO
C--------------------------------------
C     ANCIENNES DEFORMATIONS ELASTIQUES
C     ANCIEN DOMMAGE EFFECTIF:
C        SIG>0  => DE =1-D
C        SIG<0  => DE =1
C--------------------------------------
#include "vectorize.inc" 
      DO i=jft,jlt
        de1(i)  = one - max(zero,sign(damt(i,1),sig(i,1)))
        de2(i)  = one - max(zero,sign(damt(i,2),sig(i,2)))
        scale1  =(half
     .  +sign(half,de1(i)-one))*(half+sign(half,de2(i)-one))
        eel1(i) = (sig(i,1)/de1(i)-nu(i)*sig(i,2)*scale1)/e(i)
        eel2(i) = (sig(i,2)/de2(i)-nu(i)*sig(i,1)*scale1)/e(i)
        eel3(i) =  sig(i,3)/de1(i)/de2(i)/g(i)
        eel4(i) =  sig(i,4)/max(de2(i)*g(i)*shf(i),em30)
        eel5(i) =  sig(i,5)/max(de1(i)*g(i)*shf(i),em30)
      ENDDO
C----------------------------------------
C     NOUVELLES DEFORMATIONS "ELASTIQUES"
C----------------------------------------
      DO i=jft,jlt
        eel1(i) = eel1(i)+depsxx(i)
        eel2(i) = eel2(i)+depsyy(i)
        eel3(i) = eel3(i)+depsxy(i)
        eel4(i) = eel4(i)+depsyz(i)
        eel5(i) = eel5(i)+depszx(i)
      ENDDO
C----------------------------------------
C     NOUVEAU DOMMAGE DES ELEMENTS CASSES
C----------------------------------------
      DO i=jft,jlt
        IF (damt(i,1) /= zero) THEN
          crak(i,1) = crak(i,1) + depsxx(i)
          damt(i,1) = max(damt(i,1),crak(i,1)/(epsm1(i)-epst1(i)))
          damt(i,1) = min(damt(i,1),dmax1(i))
        ENDIF
      ENDDO
C
      DO i=jft,jlt
        IF (damt(i,2) /= zero) THEN
          crak(i,2) = crak(i,2) + depsyy(i)
          damt(i,2) = max(damt(i,2),crak(i,2)/(epsm2(i)-epst2(i)))
          damt(i,2) = min(damt(i,2),dmax2(i))
        ENDIF
      ENDDO
C-----------------------------
C     CONTRAINTES "ELASTIQUES"
C-----------------------------
      DO i=jft,jlt
        de1(i) = one - max(zero,sign(damt(i,1),sig(i,1)))
        de2(i) = one - max(zero,sign(damt(i,2),sig(i,2)))
        scale1 =(half
     .     +sign(half,de1(i)-one))*(half+sign(half,de2(i)-one))
        scale2 = one-nu(i)*nu(i)*scale1
        a11(i) = e(i)*de1(i)/scale2
        a22(i) = e(i)*de2(i)/scale2
        a12(i) = nu(i)*a11(i)*scale1
      ENDDO
C
      DO i=jft,jlt
        sig(i,1) = a11(i)*eel1(i)+a12(i)*eel2(i)
        sig(i,2) = a12(i)*eel1(i)+a22(i)*eel2(i)
        sig(i,3) = de1(i)*de2(i)*g(i)*eel3(i)
        sig(i,4) = de2(i)*g(i)*shf(i)*eel4(i)
        sig(i,5) = de1(i)*g(i)*shf(i)*eel5(i)
      ENDDO
C
      RETURN
      END