hm_read_prop_user4.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_prop_user4 (iout, nuvar, pargeo, unitab, lsubmodel)

Function/Subroutine Documentation

hm_read_prop_user4()

subroutine hm_read_prop_user4	(	integer, intent(in)	iout,
		integer	nuvar,
			pargeo,
		type (unit_type_), intent(in)	unitab,
		type (submodel_data), dimension(nsubmod)	lsubmodel )

Definition at line 37 of file hm_read_prop_user4.F.

C-----------------------------------------------
C     This routine may be used for user defined rupture property 
C     for interface type 2
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE message_mod
      USE submodel_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C----------+---------+---+---+--------------------------------------------
C VAR      | SIZE    |TYP| RW| DEFINITION
C----------+---------+---+---+--------------------------------------------
C IIN      |  1      | I | R | INPUT FILE UNIT (D00 file) 
C IOUT     |  1      | I | R | OUTPUT FILE UNIT (L00 file)
C NUVAR    |  1      | I | W | NUMBER OF USER ELEMENT VARIABLES
C----------+---------+---+---+--------------------------------------------
C PARGEO   |  *      | F | W | 1)SKEW NUMBER
C          |         |   |   | 2)STIFNESS FOR INTERFACE
C          |         |   |   | 3)FRONT WAVE OPTION
C          |         |   |   | 4)... not yet used
C----------+---------+---+---+--------------------------------------------
C
C     This subroutine read the user geometry parameters.
C
C     The geometry datas has to bee stored in radioss storage 
C     with the function SET_U_GEO(value_index,value). 
C
C     If some standard radioss functions (time function or 
C     x,y function) are used, this function IDs has to 
C     bee stored with the function SET_U_PNU(func_index,func_id,KFUNC).
C
C     If this property refers to a user material, this 
C     material IDs has to bee stored with the function 
C     SET_U_PNU(mat_index,mat_id,KMAT).
C
C     If this property refers to a user property, this 
C     sub-property IDs has to bee stored with the function 
C     SET_U_PNU(sub_prop_index,sub_prop_id,KMAT).
C
C     SET_U_GEO and SET_U_PNU return 0 if no error 
C     SET_U_GEO and SET_U_PNU return the maximum allowed index 
C     if index is larger than this maximum
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: IOUT
      INTEGER NUVAR
      my_real   
     .        pargeo(*)
 
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
      TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER SET_U_PNU,SET_U_GEO
C-----------------------------------------------
C   P a r a m e t e r s
C-----------------------------------------------
      INTEGER KFUNC,KMAT,KPROP
      parameter(kfunc=29)
      parameter(kmat=31)
      parameter(kprop=33)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IERROR,IDEBUG,IFUNN,IFUNT,IFUNS,IRUPT,IFILTR
      my_real
     .  scal_f,scal_d,scal_sr,dnmax,dtmax,alpha,rupt,debug,filtr
!
      LOGICAL IS_AVAILABLE
C=======================================================================
C---  CARD1 :  
!!      READ(IIN,ERR=999,FMT='(4F20.0)')SCAL_F,SCAL_D,SCAL_SR,ALPHA
C---  CARD2 :  
!!      READ(IIN,ERR=999,FMT='(6I10,2F20.0)')IRUPT,IDEBUG,IFILTR,IFUNS,
!!     .                                     IFUNN,IFUNT,DNMAX,DTMAX
C---
      is_available = .false.
!---
C---  CARD1 :
      CALL hm_get_floatv('F_scale_stress',scal_f,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('F_scale_strrate',scal_sr,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('F_scale_dist',scal_d,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
C---  CARD2 :
      CALL hm_get_intv('RUPT',irupt,is_available,lsubmodel)
      CALL hm_get_intv('DEBUG',idebug,is_available,lsubmodel)
      CALL hm_get_intv('LFILTR',ifiltr,is_available,lsubmodel)
      CALL hm_get_intv('FUNCT_ID_sr',ifuns,is_available,lsubmodel)
      CALL hm_get_intv('FUNCT_ID_sn',ifunn,is_available,lsubmodel)
      CALL hm_get_intv('FUNCT_ID_st',ifunt,is_available,lsubmodel)
      CALL hm_get_floatv('MAX_N_DIST',dnmax,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('MAX_T_DIST',dtmax,is_available,lsubmodel,unitab)
!---
      IF (scal_f  == 0.0) scal_f  = one
      IF (scal_d  == 0.0) scal_d  = one
      IF (scal_sr == 0.0) scal_sr = one
      IF (dnmax == 0.0) dnmax = ep20
      IF (dtmax == 0.0) dtmax = ep20
      IF (ifiltr == 1) THEN
        IF (alpha  == zero) alpha  = one
        alpha = min(alpha,one)
        alpha = max(alpha,zero)
      ENDIF
      IF (ifunn == 0 .OR. ifunt == 0) GOTO 999
C
      rupt  = irupt
      debug = idebug
      filtr = ifiltr
C
      ierror = set_u_geo( 2,scal_f)
      ierror = set_u_geo( 3,scal_d)
      ierror = set_u_geo( 4,scal_sr)
      ierror = set_u_geo( 5,dnmax)
      ierror = set_u_geo( 6,dtmax)
      ierror = set_u_geo( 7,alpha)
      ierror = set_u_geo( 8,rupt)
      ierror = set_u_geo( 9,debug)
      ierror = set_u_geo(10,filtr)
C
      ierror = set_u_pnu(1,ifunn,kfunc)
      ierror = set_u_pnu(2,ifunt,kfunc)
      ierror = set_u_pnu(3,ifuns,kfunc)
C
C     this is the number of user variables per secnd node used in engine:
C
      nuvar = 2
C------------------------------
      WRITE(iout,1000)
      WRITE(iout,1100) scal_f,scal_d,scal_sr,alpha,
     .     dnmax,dtmax,ifunn,ifunt,ifuns,irupt,ifiltr,idebug
C------------------------------
      RETURN
999   WRITE(iout,*)' **ERROR IN USER INTERFACE PROPERTY INPUT'
      CALL my_exit(2)
C-----
 1000 FORMAT(
     . '      USER INTERFACE RUPTURE PARAMETERS '/
     . '      ----------------------  '/)
 1100 FORMAT(/10x,'SCAL_F . . . . . . . . . .',1pg20.13
     .       /10x,'SCAL_DISP. . . . . . . . .',1pg20.13
     .       /10x,'SCAL_SR  . . . . . . . . .',1pg20.13
     .       /10x,'FILTERING COEFF. . . . . .',1pg20.13
     .       /10x,'DN_MAX . . . . . . . . . .',1pg20.13
     .       /10x,'DT_MAX . . . . . . . . . .',1pg20.13
     .       /10x,'IFUNN    . . . . . . . .',i10
     .       /10x,'IFUNT    . . . . . . . .',i10
     .       /10x,'IFUNS    . . . . . . . .',i10
     .       /10x,'IRUPT    . . . . . . . .',i10
     .       /10x,'IFILTR   . . . . . . . .',i10
     .       /10x,'IDEBUG . . . . . . . . .',i10//)
C=======================================================================
      RETURN