OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law92_upd.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| law92_upd ../starter/source/materials/mat/mat092/law92_upd.F
25!||--- called by ------------------------------------------------------
26!|| updmat ../starter/source/materials/updmat.F
27!||--- calls -----------------------------------------------------
28!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
29!|| law92_nlsqf ../starter/source/materials/mat/mat092/law92_nlsqf.f90
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!|| table_mod ../starter/share/modules1/table_mod.F
33!||====================================================================
34 SUBROUTINE law92_upd(IOUT,TITR ,MAT_ID,UPARAM,NFUNC,NFUNCT,
35 . IFUNC, FUNC_ID,NPC ,PLD ,PM,IPM)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40 USE table_mod
41 USE names_and_titles_mod , ONLY : nchartitle
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "param_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 CHARACTER(LEN=NCHARTITLE) :: TITR
54 INTEGER MAT_ID,IOUT
55 INTEGER ,INTENT(IN) :: NFUNC
56 INTEGER ,INTENT(IN) :: NFUNCT
57 INTEGER NPC(*), FUNC_ID(NFUNCT), IPM(NPROPMI)
58 my_real uparam(*),pld(*),pm(npropm)
59 INTEGER, DIMENSION(NFUNC):: IFUNC
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER N,K,ITEST,II,JJ,NSTART,IC1,IC2,NOGD,NDATA,NMULA,IFC
64 my_real e,nu,gs,rbulk,d,young,errtol,ave_slope,mu,mu_max,mu_min,dx,
65 . lam,beta,lam_max,lam_min,scalefac,amula(2)
66 my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch!
67 LOGICAL IS_ENCRYPTED
68C====================================================================
69! IDENTIFICATION
70!====================================================================
71 is_encrypted = .false.
72 CALL hm_option_is_encrypted(is_encrypted)
73 !!
74 nstart = 2
75 errtol = fiveem3
76 ifc = ifunc(1)
77 ic1 = npc(ifc)
78 ic2 = npc(ifc+1)
79 scalefac = uparam(14)
80 nogd=(ic2-ic1)/2
81 ndata=nogd
82c
83 ALLOCATE (stretch(nogd))
84 ALLOCATE (stress(nogd))
85c
86 ave_slope = zero
87 jj=0
88 stretch=zero
89 stress=zero
90 mu=zero
91 rbulk=zero
92 gs=zero
93 lam_max= zero
94 lam_min= zero
95c
96 DO ii = ic1,ic2-2,2
97 jj=jj+1
98 stretch(jj) = pld(ii) + one
99 stress(jj) = scalefac * pld(ii+1)
100 lam_max = max(lam_max, abs(stretch(jj)))
101 ENDDO
102c
103 nogd = jj
104 mu_max = zero
105 mu_min = 1e20
106 DO k = 1, ndata
107 dx = stretch(k) - one
108c avolid dx to be too small
109 IF (dx >= zero) THEN
110 dx = max(dx, em6)
111 ELSE
112 dx = abs(dx)
113 ENDIF
114 mu_max = max(mu_max, stress(k) / dx)
115 ave_slope = ave_slope + abs(stress(k)) / dx
116 ENDDO
117c
118 ave_slope = ave_slope / (one * ndata)
119 mu= ave_slope
120c initial value
121 lam = max(seven,three*lam_max)
122C
123 nmula = 2
124 amula(1) = max(mu,mu_max)
125 amula(2) = lam
126 itest = uparam(12)
127 !----------------
128 IF(is_encrypted)THEN
129 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
130 ELSE
131 WRITE(iout,1000)
132 WRITE(iout,1001)trim(titr),mat_id
133 ENDIF
134 !----
135c------------------------------------------------------
136 CALL law92_nlsqf(stretch,stress,nmula,nogd,amula,
137 . nstart, errtol,mat_id,titr,itest)
138c------------------------------------------------------
139 DEALLOCATE (stretch)
140 DEALLOCATE (stress)
141 nu = uparam(11)
142 mu = amula(1)
143 lam = amula(2)
144 beta = one/lam/lam
145 gs = mu*(one + three*beta /five + eighty19*beta*beta/175.
146 . + 513.*beta**3/875. + 42039.*beta**4/67375.)
147 rbulk=two*gs*(one+nu)
148 . /max(em30,three*(one-two*nu))
149 d= two/rbulk
150 uparam(1)=mu
151 uparam(2)=d
152 uparam(3)=lam
153 uparam(4)=gs
154 uparam(5)=rbulk
155c parameters
156 young = two*gs*(one + nu)
157 pm(20) = young
158 pm(21) = nu
159 pm(22) = gs
160 pm(24) = young/(one - nu**2)
161 pm(32) = rbulk
162 pm(100) = rbulk !PARMAT(1)
163C-----------
164C Formulation for solid elements time step computation.
165 ipm(252)= 2
166 pm(105) = two*gs/(rbulk + four_over_3*gs)
167C
168 IF(.NOT.is_encrypted) WRITE(iout,1100)mu,d,lam,gs,rbulk
169c----------------
170c end of optimization loop
171c----------------
172 RETURN
173c----------------
174 1000 FORMAT
175 & (//5x, 'FITTED PARAMETERS FOR HYPERELASTIC_MATERIAL LAW92 ' ,/,
176 & 5x, ' --------------------------------------------------')
177 1001 FORMAT(
178 & 5x,a,/,
179 & 5x, 'MATERIAL NUMBER =',i10,//)
180 1100 FORMAT(
181C
182 & 5x,'ARRUDA-BOYCE LAW',/,
183 & 5x,'MU . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
184 & 5x,'D. . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
185 & 5x,'LAM. . . . . . . . . . . . . . . . . . . .=',1pg20.13/
186 & 5x,'INITIAL SHEAR MODULUS. . . . . . . . . . .=',1pg20.13/
187 & 5x,'BULK MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)
188c-----------
189 RETURN
190 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
law92_upd
subroutine law92_upd(iout, titr, mat_id, uparam, nfunc, nfunct, ifunc, func_id, npc, pld, pm, ipm)
Definition law92_upd.F:36
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