hm_read_visc_lprony.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_visc_lprony (visc, ivisc, mat_id, unitab, lsubmodel)

Function/Subroutine Documentation

hm_read_visc_lprony()

subroutine hm_read_visc_lprony	(	type (visc_param_), intent(inout)	visc,
		integer, intent(in)	ivisc,
		integer, intent(in)	mat_id,
		type (unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel )

Definition at line 37 of file hm_read_visc_lprony.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE visc_param_mod
      USE unitab_mod
      USE message_mod
      USE submodel_mod
      USE hm_option_read_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 UPARAM   | NUPARAM | F | W | USER FAILURE MODEL PARAMETER ARRAY
C MAXUPARAM|  1      | I | R | MAXIMUM SIZE OF UPARAM 
C NUPARAM  |  1      | I | W | SIZE OF UPARAM =< MAXUPARAM
C NUVAR    |  1      | I | W | NUMBER OF USER  VARIABLES
C----------+---------+---+---+--------------------------------------------
C IFUNC    | NFUNC   | I | W | FUNCTION NUMBER ARRAY
C MAXFUNC  |  1      | I | R | MAXIMUM SIZE OF IFUNC
C NFUNC    |  1      | I | W | SIZE OF IFUNC =< MAXFUNC
C----------+---------+---+---+--------------------------------------------
#include      "units_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: IVISC,MAT_ID
      TYPE (VISC_PARAM_)  ,INTENT(INOUT) :: VISC
      TYPE (UNIT_TYPE_)   ,INTENT(IN) ::UNITAB 
      TYPE(SUBMODEL_DATA) ,DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NUPARAM,NIPARAM,NUVAR,NPRONY,IMOD,IVISC_FLAG,FORM
      INTEGER :: FctID_G,FctID_K,ITAB,ISHAPE,
     .           FctID_Gs,FctID_Ks,FctID_Gl,FctID_Kl
      my_real :: gama(100),tau(100)
C      
      LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
C=======================================================================
      is_encrypted = .false.
      is_available = .false.
 
      CALL hm_option_is_encrypted(is_encrypted)
C======================================   
      visc%ILAW = ivisc
C     
      !  initialization
      gama(1:100) = zero
      tau(1:100)  = zero
C
      ! 1st Card - Flags and prony order 
      CALL hm_get_intv   ('Model_Order' ,nprony ,is_available,lsubmodel) 
      CALL hm_get_intv   ('FORM'        ,form   ,is_available,lsubmodel) 
      CALL hm_get_intv   ('FLAG_VISC'   ,ivisc_flag   ,is_available,lsubmodel)
C
      IF(ivisc_flag == 0) ivisc_flag = 1
      IF(form == 0) form = 1
      IF (nprony == 0)CALL ancmsg(msgid=2026,msgtype=msgerror,
     .                            anmode=aninfo_blind_1,i1=mat_id)    
      ! =======================================================================================
      ! Classical input
      ! =======================================================================================
      !  -> Itab = 0 ! classical input of prony series
     
      IF (nprony > 0) THEN
          DO i=1,nprony
            CALL hm_get_float_array_index('GAMAI' ,gama(i)  ,i,is_available,lsubmodel,unitab)
            CALL hm_get_float_array_index('TAUI'  ,tau(i) ,i,is_available,lsubmodel,unitab)
          ENDDO
      ENDIF
c-------------------------------------------------
c     Storing parameters in UPARAM / IPARAM tables
c-------------------------------------------------
      nuvar   = (1 + nprony)*6
      niparam = 3
      nuparam = 2*nprony
      ALLOCATE (visc%UPARAM(nuparam))
      ALLOCATE (visc%IPARAM(niparam))
      visc%NUVAR     = nuvar
      visc%NUPARAM   = nuparam
      visc%NIPARAM   = niparam
      visc%IPARAM(1) = nprony
      visc%IPARAM(2) = form
      visc%IPARAM(3) = ivisc_flag
      DO i=1,nprony 
        visc%UPARAM(i)          = gama(i)
        visc%UPARAM(nprony + i) = tau(i)  
      ENDDO   
c-----------------------------------------------------------------------
c     Output
c-----------------------------------------------------------------------
      IF (is_encrypted)THEN                                
        WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
      ELSE 
        IF(nprony > 0) THEN
         WRITE(iout,1000)
          DO i=1,nprony
            WRITE(iout,1100) i
            WRITE(iout,1200) gama(i),tau(i)
          ENDDO
          write(iout,1300) ivisc_flag
          write(iout,1400) form
        ENDIF 
      ENDIF                
C-----------        
 1000 FORMAT(
     & 5x,'  PRONY SERIES MODEL  :'         ,/,
     & 5x,' --------------------- '         ,/)
 
 1100 FORMAT(
     & 5x,'ORDER OF PRONY SERIES . . . . . . . . . . . . . . . . . . . . . . . . =',i10/)    
 1200 FORMAT(
     & 5x,'SHEAR RELAXATION RATIO   . . . . . . . . . . . . . . . . . . . . . . .= '1pg20.13/
     & 5x,'RELAXATION TIME . . . . .  . . . . . . . . . . . . . . . . . . . . . .=',1pg20.13) 
 1300 FORMAT(/
     & 5x,'VISCOUS STRESS FORMULATION . . . . . . . . . . . . . . . . . . . . . . =',i8 /
     &10x,' 1 : TOTAL VISCOUS STRESS '/,
     &10x,' 2 : DEVIATORIC VISCOUS STRESS IS DEVIATORIC' )     
 1400 FORMAT(/
     & 5x,'FLAG FOR VISCOUS RIGIDITY . . . . . . . . . . . . . . . . . . . . . . =',i8 /
     &10x,' 1 : ADDED VISCOSITY   '/,
     &10x,' 2 : SUBSTRUCTED VISCOSITY' )     
      RETURN