hm_preread_properties.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_preread_properties       ../starter/source/properties/hm_preread_properties.F
!||--- called by ------------------------------------------------------
!||    contrl                      ../starter/source/starter/contrl.F
!||--- calls      -----------------------------------------------------
!||    hm_get_int_array_2indexes   ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
!||    hm_get_int_array_index      ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
!||    hm_get_intv                 ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_read_key          ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start             ../starter/source/devtools/hm_reader/hm_option_start.f
!||--- uses       -----------------------------------------------------
!||    defaults_mod                ../starter/source/modules/defaults_mod.F90
!||    hm_option_read_mod          ../starter/share/modules1/hm_option_read_mod.F
!||    stack_var_mod               ../starter/share/modules1/stack_var_mod.F
!||    submodel_mod                ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_preread_properties(IGEO,NSPHSOL,NPLY,NSUB,NISUB,LSUBMODEL,DEFAULTS)
C============================================================================
C-----------------------------------------------
C   A n a l y s e   M o d u l e
C-----------------------------------------------
      USE stack_var_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE defaults_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield, ncharkey, ncharline
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      "com04_c.inc"
#include      "param_c.inc"
#include      "scr03_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IGEO(NPROPGI,*),NSPHSOL
      TYPE(submodel_data) LSUBMODEL(*)
      INTEGER ,DIMENSION (NUMGEO + NUMSTACK) :: NPLY,NSUB,NISUB
      TYPE(DEFAULTS_), INTENT(IN)            :: DEFAULTS             
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IG, IGTYP, ISMSTR, NIP, J, IR1X, IR1Y, IR1Z, IREP,
     .   IR2X, IR2Y, IR2Z, ISHEAR, IRX, IROT, IMODE, IP, ISTRAIN,I8PT,
     .   ISK,ITU,IRB,IHON,IHBE,IPLAST,ITHK,IBID,IHBEOUTP,K,N,LAMINATE,
     .   IGFLU, IDS, NSHELL, NSHSUP, NSHINF, FLGBADI, NBADI,UID,
     .   NSST_D, NSST_DS, NPSH, ICPRE, ICSTR ,NPTS,ISEN,ISORTH,
     .   NSPHDIR, ID_SENS,D1,D2,D3,N1,N2,N3,INTRULE,NN,NS,NIS, NUMS,
     .   NLAM,NINTS,IFRAM,CPT,INUM,ID,IS,LAMINAT
      DATA nshell /0/, nshsup /0/, nshinf /0/
      my_real
     .    fn, ft, dx, angl,pun,htest,hclos,cvis,rbid,vx,vy,vz,
     .    knot1,knot2,knot3,r5(5),dn
      CHARACTER(LEN=NCHARTITLE) :: IDTITL
      CHARACTER(LEN=NCHARLINE) :: KEY, SOLVERKEYWORD
      CHARACTER(LEN=NCHARFIELD) :: STRING
      CHARACTER :: CHROT*7,MESS*40
      INTEGER ISH3N,ITET4,IPLAS,NPT,ISROT,NP,LAMIN,NSUB_STACK,NISUB_STACK,NPLY_STACK,NPLY_SUB,ITET4_D
      LOGICAL IS_AVAILABLE
     
!!      TYPE(STACK_INFO_ ) , DIMENSION(:), POINTER :: STACK_INFO
C=======================================================================
 
      ALLOCATE(numgeostack(numgeo + numstack))
      numgeostack(:) = 0     ! global variable - STACK_VAR_MOD
      nprop_stack = 0        ! global variable - STACK_VAR_MOD
C
      nsub(:) = 0
      nisub(:) = 0
      nply(:) = 0
      itet4_d= defaults%SOLID%ITETRA4
C--------------------------------------------------
      is_available = .false.
C--------------------------------------------------
C START BROWSING MODEL PARTS
C--------------------------------------------------
      CALL hm_option_start('PROPERTY')
C--------------------------------------------------
C BROWSING MODEL PROPERTIES 1->HM_NUMGEO
C--------------------------------------------------
      numeltg6 = 0
      i = 0
      DO cpt=1,hm_numgeo
        i = i + 1
        key = ''
        solverkeyword = ''
        idtitl = ''
C--------------------------------------------------
C EXTRACT DATAS OF /PART/... LINE
C--------------------------------------------------
        CALL hm_option_read_key(lsubmodel,
     .                       option_id = ig,
     .                       keyword2 = key)
C--------------------------------------------------
        SELECT CASE(key(1:len_trim(key)))
          CASE ('TYPE0','VOID')
C--------------------------------------------------
C         HM READING PROPERTY TYPE0 (VOID)
C--------------------------------------------------
          CASE ('TYPE1','TYPE01','SHELL','TYPE9','TYPE09','SH_ORTH','TYPE11','SH_SANDW',
     .          'SH_FABR','TYPE16')
C--------------------------------------------------
C         HM READING PROPERTY TYPE1 (SHELL)
C--------------------------------------------------
           CALL hm_get_intv('Ishell',ihbe,is_available,lsubmodel)
           CALL hm_get_intv('ISMSTR',ismstr,is_available,lsubmodel)
           CALL hm_get_intv('ISH3',ish3n,is_available,lsubmodel)
           CALL hm_get_intv('CVIS',cvis,is_available,lsubmodel)
           IF(ish3n==31.AND.numeltg>0) numeltg6 = 1
           
          CASE ('TYPE17','STACK')
C--------------------------------------------------
C      HM READING PROPERTY TYPE17 (SHELL)
C-------------------------------------------------- 
            igtyp=17
            nprop_stack = nprop_stack + 1
            numgeostack(i) = nprop_stack  
C
           CALL hm_get_intv('laminateconfig'    ,lamin, is_available, lsubmodel)
c
           nsub_stack = 0
           nisub_stack = 0 
           nply_stack = 0
           IF (lamin  > 0) THEN
             CALL hm_get_intv('sublaminateidlistmax' ,nsub_stack,  is_available, lsubmodel)
             CALL hm_get_intv('interfacepairsize'    ,nisub_stack,  is_available, lsubmodel)
            
             DO is = 1,nsub_stack
                CALL hm_get_int_array_index('plyidlistmax',nply_sub,is,is_available,lsubmodel)
                nply_stack = nply_stack + nply_sub
             END DO
c
           ELSE  ! property defined by a list of plies
             CALL hm_get_intv('plyidlistmax' ,nply_stack ,is_available ,lsubmodel)
           END IF  
           nply(nprop_stack) = nply_stack
           nsub(nprop_stack) = nsub_stack
           nisub(nprop_stack)= nisub_stack 
C--------------------------------------------------
C          HM READING PROPERTY TYPE14,6 (SOLID)
C--------------------------------------------------
          CASE ('TYPE6','SOL_ORTH')
           CALL hm_get_intv('Itetra4',itet4,is_available,lsubmodel)
           IF(itet4 == 0)  itet4 = itet4_d
           IF(itet4 == 1)iisrot = 1
           CALL hm_get_intv('Ndir',nsphdir,is_available,lsubmodel)
           igeo(1,i) =ig
           igeo(37,i)=nsphdir
           IF(nsphdir/=0)nsphsol=1
C--------------------------------------------------
C          HM READING PROPERTY TYPE51 (SHELL)
C--------------------------------------------------
          CASE ('TYPE51')
            nprop_stack    = nprop_stack + 1
            numgeostack(i) = nprop_stack
c  
           CALL hm_get_intv('laminateconfig'    ,laminate, is_available, lsubmodel)
           IF (laminate > 0) THEN
             CALL hm_get_intv('sublaminateidlistmax' ,nlam,  is_available, lsubmodel)
             CALL hm_get_intv('interfacepairsize'    ,nints,  is_available, lsubmodel)
             nsub(nprop_stack)  = nlam
             nisub(nprop_stack) = nints
             DO is = 1,nlam
               CALL hm_get_int_array_2indexes('plyidlistmax',np,is,1,is_available,lsubmodel)
               nply(nprop_stack) = nply(nprop_stack) + np
             END DO
           ELSE
             CALL hm_get_intv('plyidlistmax'      ,np,  is_available, lsubmodel)
             nply(nprop_stack) = nply(nprop_stack) + np
           END IF
C-------------------------------------------------
C         HM READING PROPERTY TYPE14 (SOLID)
C--------------------------------------------------
          CASE ('TYPE14','SOLID')
           CALL hm_get_intv('I_rot',itet4,is_available,lsubmodel)
           IF(itet4 == 0)  itet4 = itet4_d
           IF(itet4 == 1)iisrot = 1
           CALL hm_get_intv('Ndir',nsphdir,is_available,lsubmodel)
           igeo(1,i) =ig
           igeo(37,i)=nsphdir
           IF(nsphdir/=0)nsphsol=1
C--------------------------------------------------
          CASE ('PCOMPP')
            igtyp=52
C--------------------------------------------------
          CASE ('TYPE29','TYPE30','TYPE31',
     .          'USER1' ,'USER2' ,'USER3')
            iisrot = 1
C--------------------------------------------------
        END SELECT
      ENDDO
c-----------------------------------------------------------------------
c     stack object prelecture
c-----------------------------------------------------------------------
C
      IF(numstack > 0) THEN
           CALL hm_option_start('/STACK')
           DO 700 i=1,numstack 
            CALL hm_option_read_key(lsubmodel,option_id = ig,keyword2 = key)
            nprop_stack = nprop_stack + 1
            numgeostack(numgeo + i) = nprop_stack
            CALL hm_get_intv('laminateconfig'    ,laminate, is_available, lsubmodel)
            CALL hm_get_intv('laminateconfig'    ,lamin   , is_available, lsubmodel)
                   
            IF (laminate > 0) THEN                                                            
              CALL hm_get_intv('sublaminateidlistmax' ,nlam,  is_available, lsubmodel)        
              CALL hm_get_intv('interfacepairsize'    ,nints,  is_available, lsubmodel) 
              nsub(nprop_stack)  = nlam                                                       
              nisub(nprop_stack) = nints                                                      
              DO is = 1,nlam                                                                  
                CALL hm_get_int_array_2indexes('plyidlistmax',np,is,1,is_available,lsubmodel) 
                nply(nprop_stack) = nply(nprop_stack) + np                                    
              END DO                                                                          
            ELSE                                                                              
              CALL hm_get_intv('plyidlistmax'      ,np,  is_available, lsubmodel)             
              nply(nprop_stack) = nply(nprop_stack) + np                                   
            END IF                                                                            
C          
 700      CONTINUE
      ENDIF
      
c-----------
C
C Table allocation for type17,51 and 52
C 
      IF(nprop_stack > 0) THEN
         ALLOCATE(stack_info(nprop_stack))
         DO nums=1,nprop_stack
            nn  = nply(nums)
            ns  = nsub(nums)
            nis = nisub(nums)
             NULLIFY(stack_info(nums)%PID,stack_info(nums)%MID,
     .                stack_info(nums)%MID_IP,
     .                stack_info(nums)%SUB,stack_info(nums)%ISUB,
     .                stack_info(nums)%THK,stack_info(nums)%ANG,
     .                stack_info(nums)%POS,stack_info(nums)%DIR,
     .                stack_info(nums)%THKLY,stack_info(nums)%WEIGHT)
    
             IF(nn > 0 ) THEN
                 ALLOCATE(stack_info(nums)%PID(nn),stack_info(nums)%MID(nn),
     .                     stack_info(nums)%MID_IP(nn),
     .                     stack_info(nums)%THK(nn),stack_info(nums)%ANG(nn),
     .                     stack_info(nums)%POS(nn),stack_info(nums)%DIR(nn),
     .                     stack_info(nums)%THKLY(nn),stack_info(nums)%WEIGHT(nn)) 
                 stack_info(nums)%PID(1:nn)= 0     
                 stack_info(nums)%MID(1:nn)= 0
                 stack_info(nums)%MID_IP(1:nn)= 0
                 stack_info(nums)%THK(1:nn)= zero
                 stack_info(nums)%ANG(1:nn)= zero
                 stack_info(nums)%POS(1:nn)= zero
                 stack_info(nums)%THKLY(1:nn)= one   
                 stack_info(nums)%WEIGHT(1:nn)= one 
             ENDIF
             IF(ns  > 0)THEN
               ALLOCATE(stack_info(nums)%SUB(2*ns))
               stack_info(nums)%SUB(1:2*ns)= 0  
             ENDIF  
             IF(nis > 0)THEN
              ALLOCATE(stack_info(nums)%ISUB(3*nis))
              stack_info(nums)%ISUB(1:3*nis)= 0
             ENDIF 
          ENDDO 
         ELSE
            ALLOCATE(stack_info(0))
         ENDIF ! NPROP_STACK       
      RETURN
      END