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, NPG, JCVT, NUVAR(2)
      my_real PARGEO(100), STIF
      my_real QA,QB
      CHARACTER FILNAM*512,CLAW*4
      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 ,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)
 
        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,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
      IF (iskw == 0 .AND. 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-----------
      IF (igtyp > 28 .and. igtyp < 32 .or.  igtyp > 36 .and. 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