hm_read_mat151.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_mat151 (mtag, pm, ipm, id, titr, multi_fvm, unitab, lsubmodel, matparam)

Function/Subroutine Documentation

hm_read_mat151()

subroutine hm_read_mat151	(	type(mlaw_tag_), intent(inout)	mtag,
		dimension(npropm), intent(inout)	pm,
		integer, dimension(npropmi), intent(inout)	ipm,
		integer, intent(in)	id,
		character(len=nchartitle), intent(in)	titr,
		type(multi_fvm_struct), intent(inout)	multi_fvm,
		type (unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel,
		type(matparam_struct_), intent(inout)	matparam )

Definition at line 39 of file hm_read_mat151.F.

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)
      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
      IF (sum_frac_vol /= one) 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-----------------------------------------------