law100__upd_8F_source.html

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/.

!||====================================================================

!||    law100_upd_nht         ../starter/source/materials/mat/mat100/law100_upd.F

!||--- called by ------------------------------------------------------

!||    updmat                 ../starter/source/materials/updmat.F

!||--- calls      -----------------------------------------------------

!||    func_maxy              ../starter/source/tools/curve/func_maxy.F

!||--- uses       -----------------------------------------------------

!||    message_mod            ../starter/share/message_module/message_mod.F

!||    table_mod              ../starter/share/modules1/table_mod.F

!||====================================================================


      SUBROUTINE law100_upd_nht(IOUT, TITR,MAT_ID,UPARAM,NFUNC,

     .                        IFUNC, FUNC_ID , NPC   , PLD , PM)

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 MAT_ID,IOUT, NFUNC

      INTEGER NPC(*), FUNC_ID(*)

      my_real

     .         uparam(*),pld(*),pm(npropm)

      INTEGER, DIMENSION(NFUNC):: IFUNC

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER IDFC,IDFD


      my_real

     .      cmin,cmax,cini,cavg,dmin,dmax,dini,davg,fac1,fac2,sb,rbulk,

     .      nu,g

C=======================================================================

      !DIRECTION CHAINE

      idfc = ifunc(1)

      idfd = ifunc(2)

      sb   = uparam(4)

      fac1 = uparam(8+1)

      fac2 = uparam(8+2)


      CALL func_maxy(idfc,fac1,npc,pld,cmax)

      CALL func_maxy(idfd,fac2,npc,pld,dmax)


      g    = cmax *(sb + one)

      rbulk= dmax *(one + sb)


      nu = (three*rbulk -two*g)/(three*rbulk + g)/two

      pm(20)= cmax / two

      pm(21)= nu

      pm(22)= g

      pm(24)= cmax/(one - nu**2) / two

      pm(32)= rbulk

      uparam(8+4)  = g

      uparam(8+5)  = rbulk

      RETURN


      END

cc

c

!||====================================================================

!||    law100_upd_ab            ../starter/source/materials/mat/mat100/law100_upd.F

!||--- called by ------------------------------------------------------

!||    updmat                   ../starter/source/materials/updmat.F

!||--- calls      -----------------------------------------------------

!||    hm_option_is_encrypted   ../starter/source/devtools/hm_reader/hm_option_is_encrypted.f

!||    law92_nlsqf              ../starter/source/materials/mat/mat092/law92_nlsqf.F90

!||--- uses       -----------------------------------------------------

!||    message_mod              ../starter/share/message_module/message_mod.F

!||    table_mod                ../starter/share/modules1/table_mod.F

!||====================================================================


      SUBROUTINE law100_upd_ab(IOUT,TITR    ,MAT_ID,UPARAM,NFUNC,

     .                      IFUNC, FUNC_ID,NPC   ,PLD   ,PM)

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 MAT_ID,IOUT, NFUNC

      INTEGER NPC(*), FUNC_ID(*)

      my_real uparam(*),pld(*),pm(npropm)

      INTEGER, DIMENSION(NFUNC):: IFUNC

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER N_NETWORK,N,K,ITEST,ICHECK,II,JJ,NSTART,IC1,IC2,NOGD,NDATA,NMULA,

     .        TAB,NMUL,NTEMP,NPLAS,NVISC(10)

      my_real

     .   e,nu,gs,rbulk, d,young,scalefac,

     .   errtol,ave_slope,mu,mu_max,mu_min,dx,lam,beta,

     .   lam_max,lam_min,amula(2)

      my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch

      LOGICAL  IS_ENCRYPTED

C====================================================================

!       IDENTIFICATION

!====================================================================

       is_encrypted = .false.

       CALL hm_option_is_encrypted(is_encrypted)

       tab = 8

       nstart = 2

       errtol = fiveem3

       ic1 = npc(ifunc(1))

       ic2 = npc(ifunc(1)+1)


       scalefac = uparam(tab +11)


       nogd=(ic2-ic1)/2

       ndata=nogd


       ALLOCATE (stretch(nogd))

       ALLOCATE (stress(nogd))


       ave_slope = zero

       jj=0

       stretch=zero

       stress=zero

       mu=zero

       rbulk=zero

       gs=zero

       lam_max= zero

       lam_min= zero

       DO ii = ic1,ic2-2,2

            jj=jj+1

            stretch(jj) = pld(ii)  + one

            stress(jj)  = scalefac * pld(ii+1)

            lam_max = max(lam_max, abs(stretch(jj)))

       ENDDO

       nogd = jj

       mu_max = zero

       mu_min = 1e20

       DO k = 1, ndata

        dx = stretch(k) - one

c       avolid dx to be too small

        IF (dx >= zero) THEN

          dx = max(dx, em6)

        ELSE

!!          DX = MIN(DX,-EM6)

            dx = abs(dx)

        ENDIF

        mu_max = max(mu_max, stress(k)  / dx)

        ave_slope = ave_slope + abs(stress(k))  / dx

       ENDDO

       ave_slope = ave_slope / (one * ndata)

       mu= ave_slope

! initial value

       lam = max(seven,three*lam_max)

C

       nmula  = 2

       amula(1) = max(mu,mu_max)

       amula(2) = lam

       itest  =  uparam(tab +9)

      !----------------

        IF(is_encrypted)THEN

          WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'

       ELSE

         WRITE(iout,1000)

         WRITE(iout,1001)trim(titr),mat_id

       ENDIF

      !----

        CALL law92_nlsqf(stretch,stress,nmula,nogd,amula,

     .                   nstart, errtol,mat_id,titr,itest)


        DEALLOCATE (stretch)

        DEALLOCATE (stress)

        nu  =  uparam( tab+10)

        mu  = amula(1)

        lam = amula(2)

        beta = one/lam/lam

        gs= mu*(one +  three*beta /five + eighty19*beta*beta/175.

     .         + 513.*beta**3/875. + 42039.*beta**4/67375.)

        rbulk=two*gs*(one+nu)

     .        /max(em30,three*(one-two*nu))

        d= two/rbulk

        uparam(tab + 6)=mu

        uparam(tab + 7)=one/d

        uparam(tab + 8)=beta !LAM

        n_network = uparam(1)

        nmul    = uparam( 6)

        ntemp   = uparam( 7)

        nplas   = uparam( 8)

        tab = tab + 10 + nmul + ntemp +nplas

        DO n = 1, n_network

          nvisc(n) = uparam(tab + 3)

          tab = tab + 3 + nvisc(n)

        ENDDO


        uparam( tab + 1 )=gs

        uparam( tab + 2 )=rbulk

C parameter

        young  = two*gs*(one + nu)

        pm(20) = young

        pm(21) = nu

        pm(22) = gs

        pm(24) = young/(one - nu**2)

        pm(32) = rbulk

        pm(100) = rbulk  !PARMAT(1)

!!

        IF(.NOT.is_encrypted)WRITE(iout,1100)mu,d,lam,gs,rbulk

c----------------

c     end of optimization loop

c----------------

      RETURN

 1000 FORMAT

     & (//5x, 'FITTED PARAMETERS FOR HYPERELASTIC_MATERIAL LAW100 ' ,/,

     &    5x, ' --------------------------------------------------')

 1001 FORMAT(

     & 5x,a,/,

     &    5x, 'MATERIAL NUMBER =',i10,//)

 1100 FORMAT(

C

     & 5x,'TYPE = ARRUDA-BOYCE ',/,

     & 5x,'MU . . . . . . . . . . . . . . . . . . . .=',1pg20.13/

     & 5x,'D. . . . . . . . . . . . . . . . . . . . .=',1pg20.13/

     & 5x,'LAM. . . . . . . . . . . . . . . . . . . .=',1pg20.13/

     & 5x,'GROUND-STATE SHEAR MODULUS . . . . . . . .=',1pg20.13/

     & 5x,'BULK MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)

c-----------

      RETURN


      END

c=================================================================================

!||====================================================================

!||    ymax          ../starter/source/materials/mat/mat100/law100_upd.F

!||--- uses       -----------------------------------------------------

!||    message_mod   ../starter/share/message_module/message_mod.F

!||    table_mod     ../starter/share/modules1/table_mod.F

!||====================================================================


      SUBROUTINE ymax(IDN,FAC,NPC,PLD,STIFFMIN,STIFFMAX,STIFFINI,STIFFAVG)

C-----------------------------------------------

C   M o d u l e s

C-----------------------------------------------

      USE message_mod

      USE table_mod

C-----------------------------------------------

C   I m p l i c i t   T y p e s

C-----------------------------------------------

#include      "implicit_f.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER IDN,NPC(*)

      my_real PLD(*),FAC,STIFFMIN,STIFFMAX,STIFFINI,STIFFAVG

C-----------------------------------------------

      INTENT(IN)    :: npc,pld,idn

      INTENT(INOUT)   :: stiffmax,stiffini,stiffavg

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER I,J,K,ID,NP1,NP2,K1,PN1,PN2

      my_real DYDX,DX,DY

C=======================================================================

          ! COMPUTE MAXIMUM SLOPE AND INITIAL SLOPE OF FUNCTION

C=======================================================================

          pn1 = npc(idn)

          pn2 = npc(idn+1)

          stiffini = (pld(pn1+3) - pld(pn1+1))*fac / (pld(pn1+2) - pld(pn1))

          stiffavg = zero

          stiffmax = zero

          stiffmin = ep20

          DO j = pn1,pn2-4,2

            dx = pld(j+2) - pld(j)

            dy = pld(j+3) - pld(j+1)

            dydx = fac*dy/dx

            stiffmax = max(stiffmax,dydx)

            stiffmin = min(stiffmin,dydx)

            stiffavg = stiffavg + dydx

          ENDDO

          stiffavg = stiffavg*two /(pn2-pn1)

c-----------

      RETURN


      END


my_real
#define my_real
Definition cppsort.cpp:32

func_maxy
subroutine func_maxy(idn, fac, npc, pld, maxy)
Definition func_maxy.F:32

hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284

law100_upd_ab
subroutine law100_upd_ab(iout, titr, mat_id, uparam, nfunc, ifunc, func_id, npc, pld, pm)
Definition law100_upd.F:105

law100_upd_nht
subroutine law100_upd_nht(iout, titr, mat_id, uparam, nfunc, ifunc, func_id, npc, pld, pm)
Definition law100_upd.F:35

ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272

min
#define min(a, b)
Definition macros.h:20

max
#define max(a, b)
Definition macros.h:21

message_mod
Definition message_mod.F:1249

names_and_titles_mod
Definition names_and_titles_mod.F:997

names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003

table_mod
Definition table_mod.F:112

starter
program starter
Definition starter.F:39