hm_read_visc_lprony.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_visc_lprony        ../starter/source/materials/visc/hm_read_visc_lprony.F
!||--- called by ------------------------------------------------------
!||    hm_read_visc               ../starter/source/materials/visc/hm_read_visc.F
!||--- 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_intv                ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_is_encrypted     ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod         ../starter/share/modules1/hm_option_read_mod.f
!||    message_mod                ../starter/share/message_module/message_mod.F
!||    submodel_mod               ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_visc_lprony(
     .           VISC     ,IVISC   ,MAT_ID   ,UNITAB  ,LSUBMODEL)
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
      END