law104_upd.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/.
!||====================================================================
!||    law104_upd         ../starter/source/materials/mat/mat104/law104_upd.F
!||--- called by ------------------------------------------------------
!||    updmat             ../starter/source/materials/updmat.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    elbuftag_mod       ../starter/share/modules1/elbuftag_mod.F
!||    message_mod        ../starter/share/message_module/message_mod.f
!||====================================================================
      SUBROUTINE law104_upd(IFAILG  ,NUPARAM ,NUPARF  ,UPARAM  ,UPARF   ,
     .                      NLOC_DMG,IMAT    ,MLAW_TAG,IPM     ,MATPARAM)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE nlocal_reg_mod
      USE elbuftag_mod 
      USE matparam_def_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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 IFAILG,NUPARAM,NUPARF,IMAT,IPM(NPROPMI,*)
      my_real, DIMENSION(NUPARF) , INTENT(IN)  :: uparf
      my_real, DIMENSION(NUPARAM), INTENT(INOUT) :: uparam
      TYPE (NLOCAL_STR_) :: NLOC_DMG 
      TYPE(mlaw_tag_),INTENT(INOUT)    :: MLAW_TAG
      TYPE(matparam_struct_) ,INTENT(INOUT)    :: MATPARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ILOC,IGURSON
      my_real 
     .  q1,q2,q3,epn,as,kw,f0,fc,fr,rlen,hkhi
C=======================================================================
       igurson = 0
      IF (ifailg == 1) THEN
        iloc  = matparam%NLOC
        !IGURSON = 0  no damage (default) 
        IF (iloc == 0) THEN
          igurson = 1 ! local damage
        ELSEIF (iloc == 1) THEN
          igurson = 2 ! Non local Forest (Micromorphic)
        ELSEIF (iloc == 2) THEN
          igurson = 3 ! Non local (Peerling)
          mlaw_tag%NUVAR = mlaw_tag%NUVAR + 1
        ENDIF
        ipm(8,imat) = mlaw_tag%NUVAR
        ! Gurson yield criterion parameters
        q1    = uparf(2) 
        q2    = uparf(3) 
        q3    = uparf(4) 
        ! Trigger plastic strain for damage nucleation
        epn   = uparf(5) 
        ! Nucleation rate
        as    = uparf(6) 
        ! Nahshon-Hutchinson shear parameter
        kw    = uparf(7) 
        ! Void volume fraction at fracture
        fr    = uparf(8)
        ! Critical void volume fraction 
        fc    = uparf(9)
        ! Initial void volume fraction
        f0    = uparf(10)
        ! Non-local internal length
        rlen  = uparf(11)
        ! Micromorphic penalty parameter
        hkhi  = uparf(12)
c
        ! Storage of the non-local internal length
        IF (iloc>0) THEN
          nloc_dmg%LEN(imat) = max(nloc_dmg%LEN(imat), rlen)
          CALL get_lemax(nloc_dmg%LE_MAX(imat),nloc_dmg%LEN(imat))
          mlaw_tag%G_PLANL  = 1
          mlaw_tag%L_PLANL  = 1
          mlaw_tag%G_EPSDNL = 1
          mlaw_tag%L_EPSDNL = 1
        ENDIF
c
        ! Tag for damage output
        ! -> Number of output modes (stored in DMG(NEL,I), I>1)
        matparam%NMOD  = 5
        ! Total number of damage outputs
        ! -> DMG(NEL,1) = Global damage output 
        ! -> DMG(NEL,2:NMOD+1) = Damage modes output
        mlaw_tag%G_DMG = 1 + matparam%NMOD
        mlaw_tag%L_DMG = 1 + matparam%NMOD
        ! -> Modes allocation and definition
        ALLOCATE(matparam%MODE(matparam%NMOD))
        matparam%MODE(1) = "Void growth volume fraction fg"
        matparam%MODE(2) = "Nucleation volume fraction fn"
        matparam%MODE(3) = "Shear growth volume fraction fsh"
        matparam%MODE(4) = "Total void volume fraction ft"
        matparam%MODE(5) = "Effective void volume fraction f*"
c
        ! Storage of damage parameters
        uparam(30) = igurson
        uparam(31) = q1
        uparam(32) = q2
        uparam(33) = q3
        uparam(34) = epn
        uparam(35) = as
        uparam(36) = kw
        uparam(37) = fr
        uparam(38) = fc
        uparam(39) = f0
        uparam(40) = hkhi 
      ENDIF
c-----------
      RETURN
      END