hm_read_mat79.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_mat79            ../starter/source/materials/mat/mat079/hm_read_mat79.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_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_mat79(
     .     UPARAM   ,MAXUPARAM,NUPARAM  ,NUVAR    ,NFUNC    ,
     .     MAXFUNC  ,IFUNC    ,PARMAT   ,MAT_ID   ,PM       ,
     .     ISRATE   ,MTAG     ,TITR     ,UNITAB   ,LSUBMODEL,
     .     MATPARAM )
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C   READ MAT LAW79 WITH HM READER 
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE message_mod
      USE submodel_mod
      USE matparam_def_mod    
      USE elbuftag_mod
      USE names_and_titles_mod , ONLY : nchartitle
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 
      my_real, INTENT(INOUT)                :: PARMAT(100), UPARAM(MAXUPARAM), PM(NPROPM)
      INTEGER, INTENT(INOUT)                :: IFUNC(MAXFUNC), NFUNC, MAXFUNC, MAXUPARAM, 
     .     NUPARAM, NUVAR, ISRATE
      INTEGER, INTENT(IN)                    :: MAT_ID
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)       :: TITR
      TYPE(submodel_data),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-----------------------------------------------
      INTEGER MATS,IFLAG1,IFLAG2,ITEMAX,IDEL
      my_real
     .        SHEAR, AA, BB, MM, NN, CC, EPS0, SIGFMAX, TMAX, HEL, PHEL,
     .        D1, D2, K1, K2, K3, BETA, YOUNG, NU, RHO0, RHOR, ASRATE,
     .        epsmax
      LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
C-----------------------------------------------
C     S o u r c e 
C-----------------------------------------------
 
      is_encrypted = .false.
      is_available = .false.
 
      CALL hm_option_is_encrypted(is_encrypted)
C----------------------------------------------------------------
C     #RhoO rho_ref
      CALL hm_get_floatv('MAT_RHO'    ,rho0        ,is_available, lsubmodel, unitab)
      CALL hm_get_floatv('Refer_Rho'  ,rhor        ,is_available, lsubmodel, unitab)
C----------------------------------------------------------------
C     #G
      CALL hm_get_floatv('tau_shear', shear, is_available, lsubmodel, unitab)
C----------------------------------------------------------------
C     #a b m n
      CALL hm_get_floatv('MAT_A', aa, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_B', bb, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_M', mm, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_N', nn, is_available, lsubmodel, unitab)
C----------------------------------------------------------------
C     #c epsp_0 sigma_f_max
      CALL hm_get_floatv('MAT_C', cc, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_Epsilon_F', eps0, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_SIG1max_t', sigfmax, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_FCUT', asrate, is_available, lsubmodel, unitab)
C----------------------------------------------------------------
C     #T HEL PHEL
      CALL hm_get_floatv('MAT_T0', tmax, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_E', hel, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_EPS', phel, is_available, lsubmodel, unitab)
C----------------------------------------------------------------
C     #D1 D2 IDEL EPSMAX
      CALL hm_get_floatv('D1' , d1, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('D2' , d2, is_available, lsubmodel, unitab)
      CALL hm_get_intv  ('IDEL',idel, is_available, lsubmodel)
      CALL hm_get_floatv('EPSMAX',epsmax, is_available, lsubmodel, unitab)
C----------------------------------------------------------------
C     #K1 K2 K3 BETA
      CALL hm_get_floatv('K1', k1, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('K2', k2, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('K3', k3, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('MAT_Beta', beta, is_available, lsubmodel, unitab)
     
      nuvar = 2
      pm(1) = rhor
      pm(89) = rho0
 
C     Memory allocation flags
      mtag%G_EPSD = 1
      mtag%L_EPSD = 1
      mtag%G_PLA  = 1
      mtag%L_PLA  = 1
      mtag%G_DMG  = 1
      mtag%L_DMG  = 1
C
      !----------------------------------------------------------
      ! Activation of strain-rate filtering
      IF (asrate /= zero) THEN
        israte = 1
      ELSE
        israte = 0
      ENDIF
      ! Check flag for element deletion
      idel = min(idel,3)
      idel = max(0,idel)
      ! Critical plastic strain
      IF (epsmax == zero) epsmax = infinity
      !----------------------------------------------------------
C----------
C DEFAULT
C----------
      IF(cc==zero)   eps0 = one
      IF(sigfmax==zero) sigfmax=infinity
C--------
C ERRORS
C--------
      IF(phel > hel) THEN
         CALL ancmsg(msgid=907,
     .               msgtype=msgerror,
     .               anmode=aninfo,
     .               i1=mat_id,
     .               c1=titr)
      ENDIF
      IF(shear <= zero)THEN
         CALL ancmsg(msgid=908,
     .               msgtype=msgerror,
     .               anmode=aninfo,
     .               i1=mat_id,
     .               c1=titr)
      ENDIF
      IF(k1 <= zero)THEN
         CALL ancmsg(msgid=909,
     .               msgtype=msgerror,
     .               anmode=aninfo,
     .               i1=mat_id,
     .               c1=titr)
      ENDIF
      IF(eps0 <= zero)THEN
         CALL ancmsg(msgid=910,
     .               msgtype=msgerror,
     .               anmode=aninfo,
     .               i1=mat_id,
     .               c1=titr)
      ENDIF
      IF(beta < zero .OR. beta > one)THEN
         CALL ancmsg(msgid=911,
     .               msgtype=msgerror,
     .               anmode=aninfo,
     .               i1=mat_id,
     .               c1=titr)
      ENDIF
C
      
C           
      uparam(1) = shear
      uparam(2) = two*shear
      uparam(3) = aa
      uparam(4) = bb
      uparam(5) = mm
      uparam(6) = nn
      uparam(7) = cc
      uparam(8) = eps0
      uparam(9) = sigfmax
      uparam(10)= tmax/phel
      uparam(11)= phel
      uparam(12)= three_half*(hel-phel)
      uparam(13)= d1
      uparam(14)= d2
      uparam(15)= k1
      uparam(16)= k2
      uparam(17)= k3
      uparam(18)= beta
      uparam(19)= idel
      uparam(20)= epsmax
      nuparam= 20
C
      nu=(three*k1-two*shear)/(six*k1+two*shear)
      young=nine*k1*shear/(three*k1+shear)
      parmat(1) = k1
      parmat(2) = young
      parmat(3) = nu
      parmat(4) = israte
      parmat(5) = asrate
C
      ! Properties compatibility  
      CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC") 
      CALL init_mat_keyword(matparam,"SPH")       
C
      WRITE(iout, 900) trim(titr),mat_id,79
      WRITE(iout,1000)
      IF(is_encrypted)THEN
        WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
      ELSE
       WRITE(iout,1050) rho0
       WRITE(iout,1100) shear, aa, bb, mm, nn, cc, eps0, sigfmax
       WRITE(iout,1200) tmax, hel, phel, d1, d2, idel, epsmax
       WRITE(iout,1300) k1, k2, k3, beta
       WRITE(iout,1400) young, nu 
       IF (israte > 0) WRITE(iout,1500) asrate
      ENDIF
C 
      RETURN
C
  900 FORMAT(/
     & 5x,a,/,
     & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . .=',i10/,
     & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . .=',i10/)
 1000 FORMAT(
     &  5x,'  JOHNSON HOLMQUIST MATERIAL',/,
     &  5x,'  --------------------------',//)
 1050 FORMAT(
     & 5x,'INITIAL DENSITY . . . . . . . . . . . . . .=',1pg20.13/)  
 1100 FORMAT(
     &  5x,'SHEAR MODULUS . . . . . . . . . . . . . . .=',1pg20.13/,
     &  5x,'INTACT STRENGTH CONSTANT (A). . . . . . . .=',1pg20.13/,
     &  5x,'FRACTURED STRENGTH CONSTANT (B) . . . . . .=',1pg20.13/,
     &  5x,'FRACTURED STRENGTH EXPONENT (M) . . . . . .=',1pg20.13/,
     &  5x,'INTACT STRENGTH EXPONENT (N). . . . . . . .=',1pg20.13/,
     &  5x,'STRAIN RATE COEFFICIENT (C) . . . . . . . .=',1pg20.13/,
     &  5x,'REFERENCE STRAIN RATE . . . . . . . . . . .=',1pg20.13/,
     &  5x,'MAXIMUM NORMALIZED FRACTURED STRENGTH . . .=',1pg20.13//)
 1200 FORMAT(
     &  5x,'MAXIMUM PRESSURE TENSILE STRENGTH . . . . .=',1pg20.13/,
     &  5x,'HUGONIOT ELASTIC LIMIT (HEL). . . . . . . .=',1pg20.13/,
     &  5x,'PRESSURE AT HUGONIOT ELASTIC LIMIT. . . . .=',1pg20.13/,
     &  5x,'DAMAGE CONSTANT (D1). . . . . . . . . . . .=',1pg20.13/,
     &  5x,'DAMAGE EXPONENT (D2). . . . . . . . . . . .=',1pg20.13/,
     &  5x,'ELEMENT DELETION FLAG (IDEL). . . . . . . .=',i10/,
     &  5x,'  IDEL = 0: NO ELEMENT DELETION                        ',/,
     &  5x,'  IDEL = 1: ELEMENT DELETION IN TENSION ONLY           ',/,
     &  5x,'  IDEL = 2: ELEMENT DELETION IF PLASTIC STRAIN > EPSMAX',/,
     &  5x,'  IDEL = 3: ELEMENT DELETION IF DAMAGE = 1.0           ',/,
     &  5x,'CRITICAL PLASTIC STRAIN (EPSMAX). . . . . .=',1pg20.13/)
 1300 FORMAT(
     &  5x,'BULK MODULUS (K1) . . . . . . . . . . . . .=',1pg20.13/
     &  5x,'pressure coefficient (k2) . . . . . . . . .=',1PG20.13/
     &  5X,'pressure coefficient(k3) . . . . . . . . .=',1PG20.13/
     &  5X,'bulking pressure coefficient(beta) . . . .=',1PG20.13)
 1400 FORMAT(
     &  5X,'young',1h','s modulus . . . . . . . . . . . . . .=',1PG20.13/,
     &  5X,'poisson',1H','S RATIO . . . . . . . . . . . . . .=',1pg20.13/)
 1500 FORMAT(
     &  5x,'STRAIN RATE FILTERING FREQUENCY . . . . . .=',1pg20.13/)
C
      END