hm_read_prop20.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_prop20           ../starter/source/properties/thickshell/hm_read_prop20.f
!||--- called by ------------------------------------------------------
!||    hm_read_properties       ../starter/source/properties/hm_read_properties.F
!||--- 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
!||--- uses       -----------------------------------------------------
!||    defaults_mod             ../starter/source/modules/defaults_mod.F90
!||    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_prop20(GEO,IGEO,PROP_TAG ,MULTI_FVM,IGTYP,IG,TITR,UNITAB,LSUBMODEL,
     .                          DEFAULTS_SOLID)
C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   READ PROPERTY TYPE01 WITH HM READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME            DESCRIPTION                         
C
C     IGEO            PROPERTY ARRAY(INTEGER)
C     GEO             PROPERTY ARRAY(REAL)
C     UNITAB          UNITS ARRAY
C     IG              PROPERTY ID(INTEGER)
C     TITR          MATERIAL TITLE
C     LSUBMODEL       SUBMODEL STRUCTURE    
C-----------------------------------------------
C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE message_mod         
      USE submodel_mod
      USE elbuftag_mod            
      USE multi_fvm_mod
      USE defaults_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      "tablen_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C INPUT ARGUMENTS
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
      INTEGER,INTENT(IN)::IG,IGTYP
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)::TITR
      TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
C MODIFIED ARGUMENT
      INTEGER,INTENT(INOUT)::IGEO(*)
      my_real,
     .  INTENT(INOUT)::geo(*)
      TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
      TYPE(multi_fvm_struct) :: MULTI_FVM
      TYPE(solid_defaults_), INTENT(IN) :: DEFAULTS_SOLID
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C     REAL
      INTEGER IHBE,ISMSTR,IPLAST,ICPRE,ICSTR,IINT,JCVT,
     .   npg,npt,nptr,npts,nptt, istrain,iet,ihbe_old,id,
     .   nly
      INTEGER     IHBE_DS,ISST_DS,ICONTROL_D,ICONTROL
      my_real
     .    cvis,qa,qb,qh,vns1,vns2,dtmin,vdefmin,vdefmax,aspmax,asptet 
      LOGICAL IS_AVAILABLE, IS_ENCRYPTED
C=======================================================================
      is_encrypted = .false.
      is_available = .false.
C-----hide and removed flags:
      iplast = 2                              
      id = ig
C---- will branch later     
      icpre = 0  
      istrain =1 
      jcvt = 0
!--- defaults values      
      ihbe_ds=  defaults_solid%ISOLID
      isst_ds=  defaults_solid%ISMSTR
      icontrol_d=defaults_solid%ICONTROL
C--------------------------------------------------
C EXTRACT DATA (IS OPTION CRYPTED)
C--------------------------------------------------
      CALL hm_option_is_encrypted(is_encrypted)
C--------------------------------------------------
C EXTRACT DATAS (INTEGER VALUES)
C--------------------------------------------------
      CALL hm_get_intv('ISOLID',ihbe,is_available,lsubmodel)
      CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
c      CALL HM_GET_INTV('Icpre',ICPRE,IS_AVAILABLE,LSUBMODEL)
c      CALL HM_GET_INTV('Istrain',ISTRAIN,IS_AVAILABLE,LSUBMODEL)
      CALL hm_get_intv('Icstr',icstr,is_available,lsubmodel)
      CALL hm_get_intv('Inpts_R',nptr,is_available,lsubmodel)
      CALL hm_get_intv('Inpts_S',npts,is_available,lsubmodel)
      CALL hm_get_intv('Inpts_T',nptt,is_available,lsubmodel)
      CALL hm_get_intv('NBP',npt,is_available,lsubmodel)
      CALL hm_get_intv('Iint',iint,is_available,lsubmodel)
      CALL hm_get_intv('Icontrol',icontrol,is_available,lsubmodel)
C--------------------------------------------------
C EXTRACT DATAS (REAL VALUES)
C--------------------------------------------------
      CALL hm_get_floatv('qa',qa,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('qb',qb,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('dn',cvis,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('deltaT_min',dtmin,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('vdef_min',vdefmin,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('vdef_max',vdefmax,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('ASP_max',aspmax,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('COL_min',asptet,is_available,lsubmodel,unitab)
C-------for lecture check 
c         WRITE(IOUT,2100)IG,IHBE,ISMSTR,IPLAST,IINT,ICPRE,ICSTR,CVIS,QA,QB,
c     .                   DTMIN,ISTRAIN,NPTR,NPTS,NPTT
C-----------------------
C---   Default values
C-----------------------
C
C  ihbe
      IF (ihbe == 0) ihbe = ihbe_ds      
      IF (ihbe /= 14 .AND. ihbe /= 15 .AND. ihbe /= 16) THEN    
        CALL ancmsg(msgid=549,
     .              msgtype=msgerror,
     .              anmode=aninfo_blind_1,
     .              i1=ig,
     .              c1=titr,
     .              i2=ihbe,
     .              i3=20)
      ENDIF                                                    
C
C   jcvt
C 
      IF (ihbe == 14 .OR. ihbe == 15) jcvt = 2 
      IF (ihbe == 16) jcvt = 1        
C
C  smstr
C
      IF (ismstr == 0) ismstr=isst_ds    
      IF (ismstr == 0) ismstr=4          
      IF (isst_ds == -2.OR.ismstr<0) ismstr=4          
c       IF(GEO( 3)/=ZERO.AND.IGEO( 5)== 0)IGEO( 5)=NINT(GEO( 3))
C
C  icpre/icstr
C
C      ICPRE = 0  
      IF (ihbe == 14 .AND. icstr == 0) icstr = 10
      IF (icstr > 111) icstr=0
      IF (ihbe == 14 .AND.
     .    (icstr /= 1.AND.icstr /= 10.AND.icstr /= 100)) THEN
         CALL ancmsg(msgid=677,
     .               msgtype=msgerror,
     .               anmode=aninfo_blind_1,
     .               i1=ig,
     .               c1=titr,
     .               i2=icstr)
      END IF
C
C  iint
C     
      IF (ihbe == 16) THEN 
        IF (iint == 0) iint = 1    ! gauss integration
      ELSEIF (ihbe == 14 .OR. ihbe == 15) THEN 
        iint = 1
      ENDIF
C
C  npt
C
      nly = 0  
      SELECT CASE (ihbe)
      CASE(15)                                             
        IF (npt == 0) npt = 3                              
        IF (npt < 1 .OR. npt > 9)  THEN                    
          CALL ancmsg(msgid=563,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=ig,
     .                c1=titr,
     .                i2=npt,
     .                i3=ihbe)
        ENDIF                                              
        npg = npt
        nly = npt
      CASE(14,16)                                          
c        NPT = NPTR*100+NPTS*10+ NPTT   
        IF (npt == 0) THEN
         npt = 222
         nptr = 2 
         npts = 2
         nptt = 2     
        END IF         
        npg = nptr*npts*nptt 
        nly = 0  
        IF (ihbe == 14) THEN
          SELECT CASE(icstr)
            CASE(1)
              nly = nptt
            CASE(10)
              nly = npts
            CASE(100)
              nly = nptr
          END SELECT 
        ELSE
          nly = npts
        ENDIF
                                    
        IF (ihbe == 14 .AND.                               
     .     (nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.     
     .      nptr > 9 .OR. npts > 9 .OR. nptt > 9)) THEN   
          CALL ancmsg(msgid=563,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=ig,
     .                c1=titr,
     .                i2=npt,
     .                i3=ihbe)
        ELSEIF (ihbe == 16 .AND.                           
     .     (nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.     
     .      nptr > 3 .OR. npts > 9 .OR. nptt > 3)) THEN   
          CALL ancmsg(msgid=563,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=ig,
     .                c1=titr,
     .                i2=npt,
     .                i3=ihbe)
        ENDIF                                              
      END SELECT 
!     
      IF (icontrol==0) icontrol=icontrol_d
      IF (icontrol>1) icontrol=0
C                                 
C  viscosity
C
      IF (ihbe /= 15) THEN
        cvis = zero
      ELSEIF (cvis == zero) THEN
        cvis = em01
      ENDIF
C igeo(31)  flag for default qa qb for law 70 can be used for other law
      IF(qa == zero .AND. qb == zero) igeo(31) = 1
      IF (qa == zero) qa = onep1         
      IF (qb == zero) qb = fiveem2      
      igeo(4)  = npt                                  
      igeo(5)  = ismstr               
      igeo(9)  = iplast-1                                       
      igeo(10) = ihbe 
      igeo(12) = istrain                                       
      igeo(13) = icpre                                 
      igeo(14) = icstr                                 
      igeo(15) = iint                                 
      igeo(16) = jcvt-1  
      igeo(30) = nly
      igeo(97) = icontrol
C
      geo(13)  = cvis        
      geo(14)  = qa
      geo(15)  = qb
      geo(172) = dtmin
      geo(190)= vdefmin
      geo(191)= vdefmax
      geo(192)= aspmax
      geo(193)= asptet
 
C----------------------
      IF(.NOT.is_encrypted)THEN
        IF(igeo(31) == 1) THEN   
         WRITE(iout,1100)ig,ihbe,ismstr,iint,icstr,cvis,qa,qb,
     .                   dtmin,istrain,icontrol
        ELSE
         WRITE(iout,1000)ig,ihbe,ismstr,iint,icstr,cvis,qa,qb,
     .                   dtmin,istrain,icontrol
        ENDIF
        IF((vdefmin+vdefmax+aspmax+asptet)>zero) THEN
          IF (vdefmax==zero) vdefmax=ep10
          IF (aspmax==zero) aspmax=ep10
          WRITE(iout,3000) vdefmin,vdefmax,aspmax,asptet 
        END IF          
       IF (npt > 200) THEN
        WRITE(iout,1001) npg,npt
       ELSE
        WRITE(iout,1002) npg
       ENDIF  
      ELSE
       WRITE(iout,1099) ig
      ENDIF
 
C
C----Initialization in lecgeo:
       prop_tag(igtyp)%G_SIG  = 6
       prop_tag(igtyp)%L_SIG  = 6
       prop_tag(igtyp)%G_EINT = 1
       prop_tag(igtyp)%G_QVIS = 1
       prop_tag(igtyp)%L_EINT = 1
       prop_tag(igtyp)%G_VOL  = 1
       prop_tag(igtyp)%L_VOL  = 1
       prop_tag(igtyp)%L_QVIS = 1
       IF (multi_fvm%IS_USED)  prop_tag(igtyp)%G_MOM = 3
       prop_tag(igtyp)%G_FILL = 1
       prop_tag(igtyp)%L_STRA = 6 
        igeo(1) =ig
        igeo(11)=igtyp
        igeo(17)=0
        geo(12)= igtyp + 0.1
C        IF(GEO(171)/=ZERO.AND.IGEO(10)== 0)IGEO(10)=NINT(GEO(171))
C---
      RETURN
C---
 1000 FORMAT(
     & 5x,'STANDARD THICK SHELL PROPERTY SET'/,
     & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
     & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
     & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
     & 5x,'INTEGRATION FORMULATION FLAG. . . .  . =',i10/,
     & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
     & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
     & 5x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13/,
     & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
     & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
     & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
     & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
 1099 FORMAT(
     & 5x,'STANDARD THICK SHELL PROPERTY SET'/,
     & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i8/,
     & 5x,'CONFIDENTIAL DATA'//)
 
 1100 FORMAT(
     & 5x,'STANDARD THICK SHELL PROPERTY SET'/,
     & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
     & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
     & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
     & 5x,'INTEGRATION FORMULATION FLAG. . . .  . =',i10/,
     & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
     & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
     & 5x,'DEFAULT VALUE FOR QUADRATIC BULK. . . . ',/,
     & 5x,'     VISCOSITY (QA) WILL BE USED. . . .=',1pg20.13/,
     & 5x,'EXCEPT IN CASE LAW 70 WHERE QA = 0.     ',/,
     & 5x,'DEFAULT VALUE FOR LINEAR BULK . . . . . ',/,
     & 5x,'     VISCOSITY (QB) WILL BE USED . . . =',1pg20.13/,
     & 5x,'EXCEPT IN CASE LAW 70 WHERE QB = 0.     ',/,
     & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
     & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
     & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
 1001 FORMAT(
     & 5x,'NUMBER OF INTEGRATION POINTS. .  . .  .=',i3,
     &    ' (',i3,')'/)
 1002 FORMAT(
     & 5x,'NUMBER OF INTEGRATION POINTS. .  . .  .=',i10/) 
 3000 FORMAT(
     & 5x,'SOLID MINIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
     & 5x,'SOLID MAXIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
     & 5x,'SOLID MAXIMUM ASPECT RATIO.............=',1pg20.13/,
     & 5x,'SOLID MINIMUM COLLAPSE RATIO...........=',1pg20.13/)
C
 
      END SUBROUTINE hm_read_prop20