hm_read_mat21.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/.
!||====================================================================
!||    hm_read_mat21            ../starter/source/materials/mat/mat021/hm_read_mat21.F
!||--- called by ------------------------------------------------------
!||    hm_read_mat              ../starter/source/materials/mat/hm_read_mat.F90
!||--- calls      -----------------------------------------------------
!||    ancmsg                   ../starter/source/output/message/message.F
!||    hm_get_floatv            ../starter/source/devtools/hm_reader/hm_get_floatv.F
!||    hm_get_floatv_dim        ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
!||    hm_get_intv              ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_is_encrypted   ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
!||    init_mat_keyword         ../starter/source/materials/mat/init_mat_keyword.F
!||--- uses       -----------------------------------------------------
!||    elbuftag_mod             ../starter/share/modules1/elbuftag_mod.F
!||    message_mod              ../starter/share/message_module/message_mod.F
!||    submodel_mod             ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_mat21(
     .           LSUBMODEL ,MTAG     ,UNITAB   ,IPM  ,PM,
     .           MAT_ID    ,TITR     ,MATPARAM )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE elbuftag_mod            
      USE message_mod
      USE submodel_mod
      USE matparam_def_mod
      USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   READ MAT LAW21 WITH HM READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C     UNITAB          UNITS ARRAY
C     MAT_ID          MATERIAL ID(INTEGER)
C     TITR            MATERIAL TITLE
C     LSUBMODEL       SUBMODEL STRUCTURE    
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      "units_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
      INTEGER, INTENT(IN)                          :: MAT_ID
      INTEGER, DIMENSION(NPROPMI) ,INTENT(INOUT)   :: IPM
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)             :: TITR
      my_real, DIMENSION(NPROPM)  ,INTENT(INOUT)   :: pm
      TYPE(submodel_data), DIMENSION(*),INTENT(IN) :: LSUBMODEL
      TYPE(mlaw_tag_), INTENT(INOUT)               :: MTAG
      TYPE(matparam_struct_) ,INTENT(INOUT)        :: MATPARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
      INTEGER :: I,ILAW,IFUNC
      my_real :: rho0,rhor,e,nu,a0,a1,a2,amx,c1,fac_y,pmin,pext,bunl,xmumx,e0,g,pstar,delta,fscal_unit
      CHARACTER*64 :: chain      
C=======================================================================
      is_encrypted   = .false.
      is_available = .false.
      ilaw   = 21
      pstar  = -infinity  
!---
      CALL hm_option_is_encrypted(is_encrypted)
!
      CALL hm_get_floatv('MAT_RHO'      ,rho0       ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('Refer_Rho'    ,rhor       ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_E'        ,e          ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_NU'       ,nu         ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_A0'       ,a0         ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_A1'       ,a1         ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_A2'       ,a2         ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_AMAX'     ,amx        ,is_available, lsubmodel, unitab)
      CALL hm_get_intv  ('FUN_A1'       ,ifunc      ,is_available,lsubmodel)
      CALL hm_get_floatv('MAT_BULK'     ,c1         ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('PFscale'      ,fac_y      ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_PC'       ,pmin       ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('PEXT'         ,pext       ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_K_UNLOAD' ,bunl       ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_SIG'      ,xmumx      ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv_dim('PFscale'  ,fscal_unit ,is_available, lsubmodel, unitab)
!---
      IF (rhor==zero) rhor=rho0
      pm(1) = rhor
      pm(89)= rho0
!
      e0=zero
      IF(pmin==zero) pmin  =-infinity
 
      IF(bunl==zero) bunl  = c1      
      IF(amx==zero)  amx   = ep20
      IF(xmumx == zero)xmumx=ep20
 
      IF(a1 < zero .AND. a2 == zero)THEN
        chain='INVERTED YIELD SURFACE. CHECK A1 SIGN.                          '
        CALL ancmsg(msgid=829, msgtype=msgwarning, anmode=aninfo, i1=21, i2=mat_id, c1='WARNING', c2=titr, c3=chain)
      ENDIF
 
      IF(a2 < zero)THEN
        chain='UNTYPICAL YIELD SURFACE. CHECK A2 SIGN.                         '
        CALL ancmsg(msgid=829, msgtype=msgwarning, anmode=aninfo, i1=21, i2=mat_id, c1='WARNING', c2=titr, c3=chain)
      ENDIF
 
      IF(c1<=zero) THEN
        chain='TENSILE BULK MODULUS IS LOWER OR EQUAL TO 0.                    '      
        CALL ancmsg(msgid=829, msgtype=msgerror, anmode=aninfo, i1=21, i2=mat_id, c1='ERROR', c2=titr, c3=chain)
      END IF
 
      IF(bunl==zero) THEN
        chain='UNLOADING BULK MODULUS HAS NO USER VALUE. IT IS SET TO C1'
        bunl  = c1
        CALL ancmsg(msgid=829, msgtype=msgwarning, anmode=aninfo, i1=21, i2=mat_id, c1='WARNING', c2=titr, c3=chain)
      ENDIF
 
      IF(a2==zero.AND.a1/=zero)THEN   !(A2=A1=ZERO => error message)
        pstar=-a0/a1 
      ELSEIF(a2/=zero)THEN
        delta = a1*a1-four*a0*a2
        !Si intersection avec l'axe
        IF(delta >= zero)THEN
          delta=sqrt(delta)
          pstar = (-a1+delta)/two/a2
        ELSE
        !  PSTAR = -A1/TWO/A2 !no let user do what he wants 
          pstar = -infinity
          chain='YIELD SURFACE HAS NO ROOT.                                     '      
          CALL ancmsg(msgid=829, msgtype=msgwarning, anmode=aninfo, i1=21, i2=mat_id, c1='WARNING', c2=titr, c3=chain)
        ENDIF
      ELSE
        !do nothing let user do what he wants
      ENDIF
C      
      IF (fac_y == zero) fac_y = one*fscal_unit
      g=e/(two*(one + nu))
C
      pm(20)=e
      pm(21)=nu
      pm(22)=g
      pm(23)=e0     
      pm(31)=zero
      pm(32)=c1
      pm(33)=zero
      pm(34)=zero
      pm(35)=bunl
      pm(36)=xmumx
      pm(37)=pmin
      pm(38)=a0
      pm(39)=a1
      pm(40)=a2
      pm(41)=amx
      pm(42)=fac_y
      pm(43)=pext      
      pm(44)=pstar             
      ipm(11)=ifunc
C-----------
C     Formulation for solid elements time step computation.
      ipm(252)= 2
      pm(105) = two*g/(c1+four_over_3*g) ! =(1-2*Nu)/(1-Nu)
c-------------------
      WRITE(iout,1100) trim(titr),mat_id,21
      WRITE(iout,1000)
      IF (is_encrypted) THEN
        WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
      ELSE
        WRITE(iout,1200) rho0,rhor
        WRITE(iout,1300)e,nu,g
        WRITE(iout,1400)a0,a1,a2,amx
        WRITE(iout,1500)ifunc,fac_y,c1,bunl,xmumx,pmin,pext,pstar
      ENDIF
C
C---- Definition des variables internes (stockage elementaire)
c
      mtag%G_PLA   = 1
      mtag%G_EPSQ  = 1
      mtag%G_MU    = 1 !unloading history (volumetric plastic strain)
c
      mtag%L_PLA   = 1     ! /TH(VPLA)
      mtag%L_EPSQ  = 1     ! /TH(EPSP)
      mtag%L_MU    = 1 !unloading history
c
      ! MATPARAM keywords
      CALL init_mat_keyword(matparam,"ELASTO_PLASTIC")
 
      ! Material compatibility with /EOS option
      CALL init_mat_keyword(matparam,"EOS")
 
      ! EOS/Thermo keyword for pressure treatment in elements
      CALL init_mat_keyword(matparam,"HYDRO_EOS")
c
      ! Properties compatibility
      CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
      CALL init_mat_keyword(matparam,"SPH")
c
c-------------------
      RETURN
c-------------------
 1000 FORMAT(
     & 5x,40h  soil & concrete                       ,/,
     & 5x,40h  ---------------                       ,//)
 1100 FORMAT(/
     & 5x,a,/,
     & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
     & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
 1200 FORMAT(
     & 5x,'INITIAL DENSITY . . . . . . . . . . . .=',1pg20.13/,
     & 5x,'REFERENCE DENSITY  .  . . . . . . . . .=',1pg20.13/)
 1300 FORMAT(
     & 5x,40hyoung'S MODULUS . . . . . . . . . . . .=,E12.4/,
     & 5X,40HPOISSON's ratio . . . . . . . . . . . .=,e12.4/,
     & 5x,40hshear modulus . . . . . . . . . . . . .=,e12.4//)
 1400 FORMAT(
     & 5x,40hyield coefficient a0. . . . . . . . . .=,e12.4/,
     & 5x,40hyield coefficient a1. . . . . . . . . .=,e12.4/,
     & 5x,40hyield coefficient a2. . . . . . . . . .=,e12.4/,
     & 5x,40ha-max . . . . . . . . . . . . . . . . .=,e12.4//)
 1500 FORMAT(
     & 5x,40hpressure FUNCTION number. . . . . . . .=,i8/,
     & 5x,40hpressure FUNCTION scale factor. . . . .=,e12.4/,
     & 5x,40htensile bulk. . . . . . . . . . . . . .=,e12.4/,
     & 5x,40hunloading bulk. . . . . . . . . . . . .=,e12.4/,
     & 5x,40hmax volumic compression . . . . . . . .=,e12.4/,
     & 5x,40hfracture pressure . . . . . . . . . . .=,e12.4/,
     & 5x,40hexternal pressure . . . . . . . . . . .=,e12.4/,
     & 5x,40hyield surface pressure root . . . . . .=,e12.4//)
c-------------------
      RETURN
      END