law90_upd.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/.
!||====================================================================
!||    law90_upd              ../starter/source/materials/mat/mat090/law90_upd.F
!||--- called by ------------------------------------------------------
!||    updmat                 ../starter/source/materials/updmat.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    func_slope             ../starter/source/tools/curve/func_slope.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||    table_mod              ../starter/share/modules1/table_mod.F
!||====================================================================
      SUBROUTINE law90_upd(IOUT,TITR,MAT_ID,UPARAM,IPM, FUNC_ID,NPC,PLD,PM,
     .                     NFUNCT)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE table_mod
      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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE)  :: TITR
      INTEGER ,INTENT(IN) :: NFUNCT
      INTEGER MAT_ID,IOUT,ID_F1,ID_F2
      INTEGER NPC(*), FUNC_ID(NFUNCT), IPM(NPROPMI)
      my_real 
     .         uparam(*),pld(*),pm(npropm)
!      TYPE(TTABLE) TABLE(*)
      TARGET ipm
      INTEGER, DIMENSION(:), POINTER :: IFUNC
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NFUNC,I,J
      INTEGER IPRINT, LP,IndexDesign0
 
      my_real 
     .      stiff,stiffc,stifft, emax_curve, emin_curve,eini_curve,
     .     stiffmin,stiffmax,stiffini,stfavg,scalefac,e0,
     .     epsmax,ec_max,emax,g,c1,nu
 
      COMMON /mincfprt/iprint, lp
      COMMON /index_sqp/indexdesign0
C=======================================================================
      nfunc =  ipm(10)
      ifunc => ipm(10+1:10+nfunc)
C=======================================================================
c
           emax_curve = zero
           emin_curve = ep20
           eini_curve = zero
           epsmax = one
          DO j = 1, nfunc 
              scalefac= uparam(10 + nfunc + j )  
              CALL func_slope(ifunc(j),scalefac,npc,pld,stiffmin,stiffmax,stiffini,stfavg)  
              emax_curve = max(emax_curve,  stiffmax )
              emin_curve = min(emin_curve,  stiffmin)
              eini_curve = max(eini_curve, stiffini)
          ENDDO ! NFUNC 
          e0 = uparam(1) 
          IF(e0 < eini_curve) THEN
             e0 = eini_curve
             uparam(1) = e0   
             CALL ancmsg(msgid=865, msgtype=msgwarning, anmode=aninfo_blind_1,
     .                 i1=mat_id,
     .                 c1=titr,
     .                 r1=e0)
          ENDIF   
          IF(emax_curve <= e0) THEN
            emax = e0
          ELSE  
           emax = min(emax_curve,hundred*e0 ) !
          ENDIF 
          ec_max = max(e0,emax)  
          uparam(11 + 2*nfunc) = emax
          uparam(12 + 2*nfunc) = epsmax
          nu = uparam(5)
          c1 = e0/three/(one - two*nu)
          g  = half*e0/(one + nu) 
          pm(20) = e0
          pm(22) = g
          pm(24) = ec_max
          pm(32) = c1     
!
         WRITE(iout,1000)
         WRITE(iout,1001) trim(titr),mat_id,90   
         WRITE(iout,1002) emax       
         WRITE(iout,1003) ec_max       
c----------------
      RETURN
1000  FORMAT(
     & 5x,'  TABULATED NON LINEAR VISCO ELASTIC LAW',/,
     & 5x,' ----------------------------- --------',//)
1001  FORMAT(/
     & 5x,a,/,
     & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10/,
     & 5x,'MATERIAL LAW. . . . . . . . . . . . . .=',i10/)
1002   FORMAT(
     & 5x,'MAXIMUM YOUNG''S MODULUS. . . . . . . .=',1pg20.13/)
1003   FORMAT(
     & 5x,'YOUNG''S MODULUS FOR HG COMPUTE . . . .=',1pg20.13/)
 
      END