hm_read_mat151.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_mat151             ../starter/source/materials/mat/mat151/hm_read_mat151.F
!||--- called by ------------------------------------------------------
!||    hm_read_mat                ../starter/source/materials/mat/hm_read_mat.F90
!||--- calls      -----------------------------------------------------
!||    ancmsg                     ../starter/source/output/message/message.F
!||    hm_get_float_array_index   ../starter/source/devtools/hm_reader/hm_get_float_array_index.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
!||    init_mat_keyword           ../starter/source/materials/mat/init_mat_keyword.F
!||--- uses       -----------------------------------------------------
!||    elbuftag_mod               ../starter/share/modules1/elbuftag_mod.F
!||    inivol_def_mod             ../starter/share/modules1/inivol_mod.F
!||    message_mod                ../starter/share/message_module/message_mod.F
!||    submodel_mod               ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_mat151( MTAG, PM, IPM, ID, TITR, MULTI_FVM, UNITAB, LSUBMODEL, MATPARAM )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE elbuftag_mod
      USE message_mod
      USE multi_fvm_mod
      USE submodel_mod
      USE inivol_def_mod
      USE matparam_def_mod, ONLY : matparam_struct_
      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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
      INTEGER,INTENT(INOUT) :: IPM(NPROPMI)
      INTEGER,INTENT(IN) :: ID
      my_real,INTENT(INOUT) :: pm(npropm)
      TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
      TYPE(mlaw_tag_),INTENT(INOUT) :: MTAG
      TYPE(multi_fvm_struct), INTENT(INOUT) :: MULTI_FVM
      TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
      TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: IS_AVAILABLE
      INTEGER :: NBMAT, MAT_ID  ! Number of declared materials
      INTEGER :: II
      my_real :: frac_vol, sum_frac_vol
      my_real :: vfrac(21)
      my_real :: fac
      INTEGER :: IMID(21)
C-----------------------------------------------
C     B o d y
C-----------------------------------------------
      is_available = .false.
      nbmat = 0
      CALL hm_get_intv('NIP',nbmat,is_available,lsubmodel)
      multi_fvm%NBMAT = max(multi_fvm%NBMAT, nbmat)
 
      IF (nbmat > 21) THEN
         !! Limitation to 20 material
         CALL ancmsg(msgid = 87, msgtype = msgerror, anmode = aninfo)
      ENDIF
 
      ! Storing number of materials
      ipm(20) = nbmat
      pm(20) = nbmat + em01
      matparam%MULTIMAT%NB = nbmat
      ! Multimaterial data
      IF(.NOT.ALLOCATED(matparam%multimat%vfrac))ALLOCATE(matparam%multimat%vfrac(nbmat))
      IF(.NOT.ALLOCATED(matparam%multimat%mid))  ALLOCATE(matparam%multimat%mid(nbmat))
 
      ! Reading submaterial IDS and corresponding volumic fractions
      sum_frac_vol = zero
      DO ii = 1, nbmat
         CALL hm_get_int_array_index('MAT_ID_ARRAY',mat_id,ii,is_available,lsubmodel)
         CALL hm_get_float_array_index('VOL_FRAC_ARRAY',frac_vol,ii,is_available,lsubmodel,unitab)
         ipm(20 + ii) = mat_id
         pm(20 + ii) = frac_vol
         imid(ii) = mat_id
         vfrac(ii) = frac_vol
         sum_frac_vol = sum_frac_vol + frac_vol
         IF (frac_vol < zero .OR. frac_vol > one) THEN
            IF (num_inivol == 0) THEN
               CALL ancmsg(msgid = 1511, msgtype = msgerror, anmode = aninfo, c1 = "ERROR", i1 = id, i2 = mat_id, r1 = frac_vol)
            ELSE
               CALL ancmsg(msgid = 1511, msgtype = msgwarning, anmode = aninfo, c1 = "WARNING", i1 = id, i2 = mat_id, r1 = frac_vol)
            ENDIF
         ENDIF
      ENDDO
 
      ! Warning and Error messages SUM_FRAC_VOL /= 1.0
      IF (abs(one-sum_frac_vol) > em14) THEN
         IF (num_inivol == 0) THEN
            CALL ancmsg(msgid = 1512, msgtype = msgerror, anmode = aninfo, c1 = "ERROR", i1 = id, r1 = sum_frac_vol)
         ELSE
            CALL ancmsg(msgid = 1512, msgtype = msgwarning, anmode = aninfo, c1 = "WARNING", i1 = id, r1 = sum_frac_vol)
            IF(sum_frac_vol == zero)THEN
              pm(20 + 1) = one  !default submaterial is submat #1
              vfrac(1) = one
            ENDIF
         ENDIF
      ENDIF
 
      ! Material Buffer
      mtag%L_FRAC = 1
      mtag%G_DELTAX = 1
      mtag%L_DELTAX = 1
      mtag%G_RHO = 1
      mtag%L_RHO = 1
 
      ! MATPARAM keywords
      CALL init_mat_keyword(matparam,"INCOMPRESSIBLE")
 
      ! Material compatibility with /EOS option
      CALL init_mat_keyword(matparam,"EOS")
 
      ! EOS/Thermo keyword for pressure treatment in elements
      CALL init_mat_keyword(matparam,"HYDRO_EOS")
 
      ! Properties compatibility
      CALL init_mat_keyword(matparam,"SOLID_ISOTROPIC")
 
      ! Multimaterial data
      matparam%multimat%vfrac(1:nbmat) = vfrac(1:nbmat)
      matparam%multimat%mid(1:nbmat) = imid(1:nbmat)
 
      ! Starter listing output
      WRITE(iout,1000) nbmat
      DO ii = 1, nbmat
         WRITE(iout, 1010) matparam%multimat%mid(ii), matparam%multimat%vfrac(ii)
      ENDDO
      
 1000 FORMAT(
     & 5x,'  MULTIFLUID LAW   ',/,
     & 5x,'  --------------  ',/,
     & 5x,'  NUMBER OF MATERIALS. . . . . . .=',i8//)
 1010 FORMAT(
     & 5x,'  MATERIAL ID', i8, ' ; VOLUME FRACTION',1pg20.13/)
      RETURN
 
C-----------------------------------------------
      END SUBROUTINE hm_read_mat151