hm_read_mat119.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_mat119           ../starter/source/materials/mat/mat119/hm_read_mat119.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_mat119(MTAG     ,UPARAM   ,MAXUPARAM,NUPARAM  ,PM       ,
     .                          MATPARAM ,PARMAT   ,NUVAR    ,MAT_ID   ,TITR     ,
     .                          MAXTABL  ,NUMTABL  ,ITABLE   ,UNITAB   ,LSUBMODEL,
     .                          ISRATE   )
C-----------------------------------------------
C   D e s c r i p t i o n
C   =====================
C   READ MAT LAW119 WITH HM READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME            DESCRIPTION                         
C
C     IPM             MATERIAL ARRAY(INTEGER)
C     PM              MATERIAL ARRAY(REAL)
C     UNITAB          UNITS ARRAY
C     ID              MATERIAL ID(INTEGER)
C     TITR            MATERIAL TITLE
C     LSUBMODEL       SUBMODEL STRUCTURE    
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      "param_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(INOUT)  :: NUPARAM,NUVAR,NUMTABL,ISRATE
      INTEGER ,INTENT(IN)   :: MAT_ID,MAXUPARAM,MAXTABL
      INTEGER, DIMENSION(MAXTABL) ,INTENT(INOUT) :: ITABLE
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)::TITR
      my_real ,INTENT(INOUT):: pm(npropm),parmat(100),uparam(maxuparam)
      TYPE (UNIT_TYPE_)      ,INTENT(IN)    :: UNITAB 
      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 FUNC1,FUNC2,IRELOAD
      my_real :: NU,N12,E11,E22,G12,G23,G31,RCOMP,DET,C1,SSP,
     .   A11,A22,A12,A1C,A2C,GC,RHO0,LMIN,DAMP,FSCALE1,FSCALE2,FSCALET,
     .   ecoat,nucoat,tcoat
      LOGICAL IS_AVAILABLE,IS_ENCRYPTED
C-----------------------------------------------
C   S o u r c e   L i n e s
c=======================================================================
      is_encrypted = .false.
      is_available = .false.
 
      CALL hm_option_is_encrypted(is_encrypted)
card1
      CALL hm_get_floatv('MAT_RHO'  ,rho0     ,is_available,lsubmodel,unitab)     
      CALL hm_get_floatv('LMIN'     ,lmin     ,is_available,lsubmodel,unitab)     
card2
      CALL hm_get_floatv('STIFF1'   ,e11      ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('DAMP1'    ,damp     ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('RE'       ,rcomp    ,is_available,lsubmodel,unitab)
card3
      CALL hm_get_intv  ('FUN_L'    ,func1    ,is_available, lsubmodel)
      CALL hm_get_intv  ('FUN_UL'   ,func2    ,is_available, lsubmodel)
      CALL hm_get_floatv('Fcoeft1'  ,fscale1  ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('Fcoeft2'  ,fscale2  ,is_available,lsubmodel,unitab)
      CALL hm_get_intv  ('Ireload'  ,ireload  ,is_available, lsubmodel)
card4
      CALL hm_get_floatv('E22'      ,e22      ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('NU12'     ,n12      ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('G12'      ,g12      ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('Fcoeft22' ,fscalet ,is_available,lsubmodel,unitab)
card5
      CALL hm_get_floatv('ECOAT'    ,ecoat     ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('NUCOAT'   ,nucoat    ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('TCOAT'    ,tcoat     ,is_available,lsubmodel,unitab)
C
      IF (func2 == func1) func2 = 0
C
c-----------------------------------------------------
      pm(1) = rho0
      pm(89)= rho0
c
      israte = -1
      IF (n12 == zero) n12 = 0.19
C--   Values are replaced in create_seatbelt.F when section is available
      IF (e11 == zero) e11 = em20
      IF (e22 == zero) e22 = em20
      IF (g12 == zero) g12 = em20
C
      IF (fscale1 == zero) fscale1 = one
      IF (fscale2 == zero) fscale2 = one
      IF (fscalet == zero) fscalet = em01
 
C--   stiffness of the shell is 1% of the total stiffness
      fscale1 = em02*fscale1
      fscale2 = em02*fscale2
      fscalet = ep02*fscalet
C
C-----------------------------------------------------
      IF (func1 == 0 .and. e11 == zero) THEN
         CALL ancmsg(msgid=306, msgtype=msgerror, anmode=aninfo,
     .               i1=119,
     .               i2=mat_id,
     .               c1=titr,
     .               c2='E11')
      ENDIF
C-----------------------------------------
      IF (rcomp == zero) rcomp = one
      IF (rcomp < em03) THEN
          CALL ancmsg(msgid=1572, msgtype=msgwarning, anmode=aninfo,
     .                i1=mat_id,
     .                c1=titr)
         rcomp = em03
      ENDIF
C--------------------------------------------------------
      IF (nucoat == zero) nucoat = n12
      a1c = ecoat /  (one - nucoat**2)
      a2c = a1c * nucoat
      gc  = ecoat * half / (one + nucoat)
c-----------------------------------------
      uparam(1)  = e11*em02
      uparam(2)  = e22
      uparam(3)  = n12
      uparam(6)  = g12  
      uparam(7)  = zero      ! A11 - calculated by seatbelt
      uparam(8)  = zero      ! A22 - calculated by seatbelt
      uparam(9)  = zero      ! A12 - calculated by seatbelt
      uparam(10) = rcomp                          
      uparam(11) = fscale1                           
      uparam(12) = fscale2  
      uparam(13) = fscalet
      uparam(14) = a1c       ! coating
      uparam(15) = a2c       ! coating
      uparam(16) = tcoat     ! coating
      uparam(18) = zero      ! Xint
      uparam(19) = zero      ! Yint
      uparam(20) = gc
      uparam(21) = ireload
c
      nuparam = 22
      nuvar   = 10
      numtabl = 2
c
      itable(1) = func1                
      itable(2) = func2                
c --------------------------
C--   Values of C1,E11,E22 and N21 are computed in create_seatbelt.F when section is available
C     PARMAT(1) = C1
C     PARMAT(2) = MAX(E11,E22)
C     PARMAT(3) = SQRT(N12*N21)
      parmat(4) = israte
      parmat(5) = zero ! FCUT
c
c---- Definition of internal variables variables for seatbelts
c
      mtag%G_INTVAR = 7
      mtag%G_SLIPRING_ID = 1
      mtag%G_SLIPRING_FRAM_ID = 2
      mtag%G_UPDATE = 1
      mtag%G_ADD_NODE = 5
      mtag%G_POSX = 2
c
c--------------------- 
      CALL init_mat_keyword(matparam,"COMPRESSIBLE")
      CALL init_mat_keyword(matparam,"SMALL_STRAIN") 
      CALL init_mat_keyword(matparam,"INCREMENTAL")
c
      ! Properties compatibility
      CALL init_mat_keyword(matparam,"SHELL_ORTHOTROPIC")
c----------------------------------------
      WRITE(iout,1000) trim(titr),mat_id,119
      WRITE(iout,1100)
      IF (is_encrypted) THEN
        WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
      ELSE
        WRITE(iout,1200) rho0
        IF (func1 == 0) THEN
          WRITE(iout,1300) e11,e22,n12,g12,rcomp,lmin,damp
        ELSE
          WRITE(iout,1400) n12,g12,rcomp,lmin,damp,func1,func2,
     .    fscale1,fscale2,ireload,fscalet
        END IF
        IF (ecoat > zero) THEN
          WRITE(iout,1500) ecoat,nucoat,tcoat
        END IF
      ENDIF
c--------------------------------------
 1000 FORMAT(
     & 5x,a,/,
     & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . . . =',i10/,
     & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . . . =',i10/)
 1100 FORMAT
     &(5x,'ORTHOTROPIC MATERIAL FOR SEATBELTS (LAW119)       ',/,
     & 5x,'-------------------------------------------       ',/)
 1200 FORMAT(
     & 5x,'MASS PER UNIT LENGTH  . . . . . . . . . . . . . .=',1pg20.13/)  
 1300 FORMAT(
     & 5x,'STIFFNESS PER UNIT LENGTH (TENSION) . . . . . . .=',1pg20.13/
     & 5x,'YOUNG MODULUS E22 (TENSION) . . . . . . . . . . .=',1pg20.13/
     & 5x,'POISSON RATIO NU12. . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'SHEAR MODULUS G12 . . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'COMPRESSION REDUCTION FACTOR. . . . . . . . . . . ',/
     & 5x,'     RCOMP=E11C/E11= E22C/E22 . . . . . . . . . .=',1pg20.13/
     & 5x,'MINIMUM LENGTH LMIN. . . . . . . . .. . . . . . .=',1pg20.13/
     & 5x,'DAMPING COEFFICIENT. . . . . . . . .. . . . . . .=',1pg20.13/)
 1400 FORMAT(
     & 5x,'POISSON RATIO NU12. . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'SHEAR MODULUS G12 . . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'COMPRESSION REDUCTION FACTOR. . . . . . . . . . . ',1pg20.13/
     & 5x,'MINIMUM LENGTH LMIN. . . . . . . . .. . . . . . .=',1pg20.13/
     & 5x,'DAMPING COEFFICIENT. . . . . . . . .. . . . . . .=',1pg20.13/
     & 5x,'LOADING CURVE ID. . . . . . . . . . . . . . . . .=',1i10/
     & 5x,'UNLOADING CURVE ID. . . . . . . . . . . . . . . .=',1i10/
     & 5x,'LOADING CURVE SCALE FACTOR. . . . . . . . . . . .=',1pg20.13/
     & 5x,'UNLOADING CURVE SCALE FACTOR. . . . . . . . . . .=',1pg20.13/
     & 5x,'RELOADING FLAG. . . . . . . . . . . . . . . . . .=',1i10/
     & 5x,'TRANSVERSE STIFFNESS SCALE FACTOR . . . . . . . .=',1pg20.13/)
 1500 FORMAT(
     & 5x,'YOUNG MODULUS OF COATING LAYER. . . . . . . . . .=',1pg20.13/
     & 5x,'POISSON RATIO OF COATING LAYER. . . . . . . . . .=',1pg20.13/
     & 5x,'THICKNESS OF COATING LAYER. . . . . . . . . . . .=',1pg20.13/)
C-----------
      RETURN
      END