hm_read_prop_generic.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_prop_generic   ../starter/source/properties/hm_read_prop_generic.F
!||--- called by ------------------------------------------------------
!||    hm_read_properties     ../starter/source/properties/hm_read_properties.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    fretitl2               ../starter/source/starter/freform.F
!||    hm_read_prop28         ../starter/source/properties/xelem/hm_read_prop28.F
!||    hm_read_prop32         ../starter/source/properties/spring/hm_read_prop32.F
!||    hm_read_prop33         ../starter/source/properties/spring/hm_read_prop33.F
!||    hm_read_prop34         ../starter/source/properties/sph/hm_read_prop34.F
!||    hm_read_prop35         ../starter/source/properties/spring/hm_read_prop35.F
!||    hm_read_prop36         ../starter/source/properties/spring/hm_read_prop36.F
!||    hm_read_prop43         ../starter/source/properties/solid/hm_read_prop43.F
!||    hm_read_prop44         ../starter/source/properties/spring/hm_read_prop44.F
!||    hm_read_prop45         ../starter/source/properties/spring/hm_read_prop45.F
!||    hm_read_prop46         ../starter/source/properties/spring/hm_read_prop46.F
!||    hm_read_prop_user      ../starter/source/properties/user_spring_solid/hm_read_prop_user.F
!||    hm_read_prop_user4     ../starter/source/properties/user_spring_solid/hm_read_prop_user4.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
!||    reader_old_mod         ../starter/share/modules1/reader_old_mod.F90
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_prop_generic(
     1                    IGTYP  ,IG      ,IDTITL  ,KEYTYPE  ,GEO      ,
     2                    IGEO   ,LBUFGEO ,BUFGEO  ,IADBUF   ,UNITAB   ,
     3                    ISKN   ,KNOT    ,IAD_KNOT,PROP_TAG ,LSUBMODEL,
     4                    RTRANS ,SUB_ID  ,IUNIT   ,SUB_INDEX,DEFAULTS )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE message_mod
      USE elbuftag_mod            
      USE submodel_mod , ONLY : nsubmod, submodel_data
      USE defaults_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharline
      USE reader_old_mod , ONLY : kline
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr17_c.inc"
#include      "scr19_c.inc"
#include      "units_c.inc"
#include      "param_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
      CHARACTER(LEN=NCHARTITLE),INTENT(IN):: IDTITL
      CHARACTER(LEN=NCHARLINE) :: KEYTYPE
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
      INTEGER,INTENT(IN):: IG,ISKN(LISKN,*),SUB_ID,IUNIT,SUB_INDEX
      my_real  ,INTENT(IN):: rtrans(ntransf,*)
      TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
C     OUTPUT ARGUMENTS
      INTEGER,INTENT(OUT):: IGTYP
C     MODIFIED ARGUMENT
      INTEGER,INTENT(INOUT) :: IGEO(NPROPGI), LBUFGEO, IADBUF, IAD_KNOT
      my_real  ,INTENT(INOUT):: 
     .        geo(npropg), knot(*)
      DOUBLE PRECISION,INTENT(INOUT)::  BUFGEO(*)
      TYPE(prop_tag_) , DIMENSION(0:MAXPROP),INTENT(INOUT) :: PROP_TAG
      TYPE(defaults_), INTENT(IN)  :: DEFAULTS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ISKW,IADFUN,IADMAT,IADPID,IADTAB
      INTEGER I, ILAW,NPG,JCVT,NUVAR(2)
      my_real PARGEO(100),STIF,TTHICK
      my_real QA,QB
      CHARACTER FILNAM*512,CLAW*4
      INTEGER LEN_FILNAM
      CHARACTER(LEN=NCHARTITLE) :: TITR
C=======================================================================
c------------------------------
      DO i = 1,100
       pargeo(i) = zero
      ENDDO
C
      DO i = 1, bgeosize
        bufgeo0(i) = zero
      ENDDO
C
      nuvar(1)= 0
      nuvar(2)= 0
      nuparam = 0
      njfunc  = 0
      njmat   = 0
      njpid   = 0
      njtab  = 0
C
      igeo(1) =ig
      igeo(5) = 4 ! ISMSTR
C
      CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
C
      SELECT CASE(keytype(1:len_trim(keytype)))
 
        CASE ('TYPE28','NSTRAND')              
          igtyp     =28
          CALL hm_read_prop28(iout , nuvar ,pargeo,unitab,ig,
     .                        titr ,igtyp ,prop_tag,lsubmodel,iunit)
 
        CASE ('TYPE32','SPR_PRE')              
          igtyp     =32
          CALL hm_read_prop32(iout , nuvar ,pargeo,unitab,ig,
     .                        igtyp,prop_tag,titr,lsubmodel)
 
        CASE ('TYPE33','KJOINT')
          igtyp     =33
          CALL hm_read_prop33(iout ,nuvar ,pargeo,unitab,
     .                        iunit ,ig    ,titr  ,prop_tag,
     .                        igtyp ,lsubmodel)
 
        CASE ('TYPE34','SPH')
          igtyp     =34
          CALL hm_read_prop34(geo,igeo,iout,nuvar,pargeo,
     .                        qa,qb,iskn,ig,titr,unitab,
     .                        prop_tag,igtyp,lsubmodel)
 
        CASE ('TYPE35','STITCH')
          igtyp     =35
          CALL hm_read_prop35(iout , nuvar ,pargeo,unitab,
     .                        ig,igtyp ,prop_tag,lsubmodel)
 
        CASE ('TYPE36','PREDIT')
          igtyp     =36
          CALL hm_read_prop36(iout , nuvar ,pargeo,unitab,
     .                        iskn,ig,titr,igtyp,prop_tag,geo,
     .                        lsubmodel,sub_index)
        CASE ('USER4')
C--------------------------------------------------
C     rupture property for interface type 2
C          ( not a true user property )
C--------------------------------------------------
          igtyp=37
          CALL hm_read_prop_user4(iout  ,nuvar ,pargeo ,unitab ,lsubmodel)
 
             
        CASE ('TYPE43','CONNECT')
          igtyp=43
          CALL hm_read_prop43(geo     ,igeo     ,iout    ,ig      ,
     .                        nuvar   ,pargeo   ,igtyp ,prop_tag,
     .                        unitab  ,lsubmodel,defaults%SOLID)
 
        CASE ('TYPE44','SPR_CRUS')
          igtyp=44
          CALL hm_read_prop44(iout  ,ig   ,nuvar ,pargeo,
     .                        unitab,iskn  ,igeo ,titr  ,igtyp ,
     .                        prop_tag,lsubmodel ,sub_index,iunit)
 
        CASE ('TYPE45','KJOINT2')              
          igtyp     =45
          CALL hm_read_prop45(iout , nuvar ,pargeo,unitab,igtyp,
     .                        ig,prop_tag,titr,lsubmodel,iunit)
 
        CASE ('TYPE46','SPR_MUSCLE')              
          igtyp     =46
          CALL hm_read_prop46(iout , nuvar ,pargeo,unitab,igtyp,
     .                        ig,prop_tag,titr,lsubmodel,iunit)
 
        CASE ('TYPE29','TYPE30','TYPE31',
     .        'USER1' ,'USER2' ,'USER3')
C--------------------------------------------------
C           HM READING PROPERTY USERnn 
C--------------------------------------------------
          CALL hm_read_prop_user(
     .                 iout    ,nuvar ,pargeo   ,unitab,igtyp,
     .                 ig      ,titr  ,lsubmodel,iunit ,iskn ,
     .                 keytype ,prop_tag)
!
        CASE DEFAULT
          CALL ancmsg(msgid=1647,anmode=aninfo,msgtype=msgerror,
     .    i1=ig,c1='titr',I2=IGTYP) ! This message can not occur !
 
      END SELECT
C
      IGEO(11)=IGTYP
      GEO(12) =IGTYP+EM01
C-----
      LBUFGEO = LBUFGEO + NUPARAM + NJFUNC + NJMAT + NJPID + NJTAB
C
      DO I=1,NUPARAM
        BUFGEO(IADBUF+I-1)=BUFGEO0(I)
      ENDDO
      IADFUN  = IADBUF + NUPARAM
      DO I=1,NJFUNC
        BUFGEO(IADFUN+I-1)=JFUNC(I)
      ENDDO
      IADMAT  = IADFUN + NJFUNC
      DO I=1,NJMAT
        BUFGEO(IADMAT+I-1)=JMAT(I)
      ENDDO
      IADPID  = IADMAT + NJMAT
      DO I=1,NJPID
        BUFGEO(IADPID+I-1)=JPID(I)
      ENDDO
      IADTAB  = IADPID + NJPID
      DO I=1,NJTAB
        BUFGEO(IADTAB+I-1)=JTAB(I)
      ENDDO
C
      ISKW  = NINT(PARGEO(1))
      STIF  = PARGEO(2)
      IFRWV = MAX(IFRWV,NINT(PARGEO(3)))
      NPG   = NINT(PARGEO(4))
      JCVT  = NINT(PARGEO(5))
C
.AND.      IF (ISKW == 0  IGTYP  /=  34) ISKW = 1
      GEO(2)=ISKW
      IGEO(2)=ISKW
      IGEO(4)=NPG
      GEO(3)=STIF
      GEO(8)=5
      GEO(25) = NUVAR(1)
      GEO(26) = NUPARAM
      GEO(27) = IADBUF
      GEO(28) = NJFUNC
      GEO(29) = IADFUN
      GEO(30) = NJMAT
      GEO(31) = IADMAT
      GEO(32) = NJPID
      GEO(33) = IADPID
      GEO(35) = NUVAR(2)
      GEO(36) = NJTAB
      GEO(37) = IADTAB
C
      IGEO(16) = JCVT
      IGEO(27) = NUVAR(1)
      IGEO(28) = NUVAR(2) 
      IGEO(52) = NUPARAM
      IGEO(53) = NJFUNC
      IGEO(54) = NJMAT
      IGEO(55) = NJPID
      IGEO(56) = NJTAB
      IGEO(57) = IADBUF
      IGEO(58) = IADFUN
      IGEO(59) = IADMAT
      IGEO(60) = IADPID
      IGEO(61) = IADTAB
C-----------
      IADBUF  = IADTAB + NJTAB
C-----------
.and..or..and.      IF (IGTYP > 28  IGTYP < 32   IGTYP > 36  IGTYP < 43) THEN   ! prop user
          PROP_TAG(IGTYP)%G_SIG  = 6
          PROP_TAG(IGTYP)%G_VOL  = 1
          PROP_TAG(IGTYP)%G_EINT = 1
          PROP_TAG(IGTYP)%G_OFF  = 1
          PROP_TAG(IGTYP)%G_FILL = 1
          PROP_TAG(IGTYP)%L_SIG  = 6
          PROP_TAG(IGTYP)%L_VOL  = 1
          PROP_TAG(IGTYP)%L_EINT = 1
          PROP_TAG(IGTYP)%L_OFF  = 1
          PROP_TAG(IGTYP)%NUVAR  = IGEO(27)  !  User solid property
          IGEO(4) = 1    ! NPT
          PROP_TAG(IGTYP)%L_SIG  = 6
          PROP_TAG(IGTYP)%L_VOL  = 1
          PROP_TAG(IGTYP)%L_EINT = 1
      ENDIF ! IF (IGTYP)
C-----------
      RETURN
 
      RETURN
      END