OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law100_upd.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine law100_upd_nht (iout, titr, mat_id, uparam, nfunc, ifunc, func_id, npc, pld, pm)
subroutine law100_upd_ab (iout, titr, mat_id, uparam, nfunc, ifunc, func_id, npc, pld, pm)
subroutine ymax (idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)

Function/Subroutine Documentation

◆ law100_upd_ab()

subroutine law100_upd_ab ( integer iout,
character(len=nchartitle) titr,
integer mat_id,
uparam,
integer nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) func_id,
integer, dimension(*) npc,
pld,
pm )

Definition at line 104 of file law100_upd.F.

106C-----------------------------------------------
107C M o d u l e s
108C-----------------------------------------------
109 USE message_mod
110 USE table_mod
111 USE names_and_titles_mod , ONLY : nchartitle
112 USE law92_nlsqf_mod, ONLY : law92_nlsqf
113C-----------------------------------------------
114C I m p l i c i t T y p e s
115C-----------------------------------------------
116#include "implicit_f.inc"
117C-----------------------------------------------
118C C o m m o n B l o c k s
119C-----------------------------------------------
120#include "param_c.inc"
121C-----------------------------------------------
122C D u m m y A r g u m e n t s
123C-----------------------------------------------
124 CHARACTER(LEN=NCHARTITLE) :: TITR
125 INTEGER MAT_ID,IOUT, NFUNC
126 INTEGER NPC(*), FUNC_ID(*)
127 my_real uparam(*),pld(*),pm(npropm)
128 INTEGER, DIMENSION(NFUNC):: IFUNC
129C-----------------------------------------------
130C L o c a l V a r i a b l e s
131C-----------------------------------------------
132 INTEGER N_NETWORK,N,K,ITEST,II,JJ,NSTART,IC1,IC2,NOGD,NDATA,NMULA,
133 . TAB,NMUL,NTEMP,NPLAS,NVISC(10)
134 my_real
135 . nu,gs,rbulk, d,young,scalefac,
136 . errtol,ave_slope,mu,mu_max,mu_min,dx,lam,beta,
137 . lam_max,lam_min,amula(2)
138 my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch
139 LOGICAL IS_ENCRYPTED
140C====================================================================
141! IDENTIFICATION
142!====================================================================
143 is_encrypted = .false.
144 CALL hm_option_is_encrypted(is_encrypted)
145 tab = 8
146 nstart = 2
147 errtol = fiveem3
148 ic1 = npc(ifunc(1))
149 ic2 = npc(ifunc(1)+1)
150
151 scalefac = uparam(tab +11)
152
153 nogd=(ic2-ic1)/2
154 ndata=nogd
155
156 ALLOCATE (stretch(nogd))
157 ALLOCATE (stress(nogd))
158
159 ave_slope = zero
160 jj=0
161 stretch=zero
162 stress=zero
163 mu=zero
164 rbulk=zero
165 gs=zero
166 lam_max= zero
167 lam_min= zero
168 DO ii = ic1,ic2-2,2
169 jj=jj+1
170 stretch(jj) = pld(ii) + one
171 stress(jj) = scalefac * pld(ii+1)
172 lam_max = max(lam_max, abs(stretch(jj)))
173 ENDDO
174 nogd = jj
175 mu_max = zero
176 mu_min = 1e20
177 DO k = 1, ndata
178 dx = stretch(k) - one
179c avolid dx to be too small
180 IF (dx >= zero) THEN
181 dx = max(dx, em6)
182 ELSE
183!! DX = MIN(DX,-EM6)
184 dx = abs(dx)
185 ENDIF
186 mu_max = max(mu_max, stress(k) / dx)
187 ave_slope = ave_slope + abs(stress(k)) / dx
188 ENDDO
189 ave_slope = ave_slope / (one * ndata)
190 mu= ave_slope
191! initial value
192 lam = max(seven,three*lam_max)
193C
194 nmula = 2
195 amula(1) = max(mu,mu_max)
196 amula(2) = lam
197 itest = uparam(tab +9)
198 !----------------
199 IF(is_encrypted)THEN
200 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
201 ELSE
202 WRITE(iout,1000)
203 WRITE(iout,1001)trim(titr),mat_id
204 ENDIF
205 !----
206 CALL law92_nlsqf(stretch,stress,nmula,nogd,amula,
207 . nstart, errtol,mat_id,titr,itest)
208
209 DEALLOCATE (stretch)
210 DEALLOCATE (stress)
211 nu = uparam( tab+10)
212 mu = amula(1)
213 lam = amula(2)
214 beta = one/lam/lam
215 gs= mu*(one + three*beta /five + eighty19*beta*beta/175.
216 . + 513.*beta**3/875. + 42039.*beta**4/67375.)
217 rbulk=two*gs*(one+nu)
218 . /max(em30,three*(one-two*nu))
219 d= two/rbulk
220 uparam(tab + 6)=mu
221 uparam(tab + 7)=one/d
222 uparam(tab + 8)=beta !LAM
223 n_network = uparam(1)
224 nmul = uparam( 6)
225 ntemp = uparam( 7)
226 nplas = uparam( 8)
227 tab = tab + 10 + nmul + ntemp +nplas
228 DO n = 1, n_network
229 nvisc(n) = uparam(tab + 3)
230 tab = tab + 3 + nvisc(n)
231 ENDDO
232
233 uparam( tab + 1 )=gs
234 uparam( tab + 2 )=rbulk
235C parameter
236 young = two*gs*(one + nu)
237 pm(20) = young
238 pm(21) = nu
239 pm(22) = gs
240 pm(24) = young/(one - nu**2)
241 pm(32) = rbulk
242 pm(100) = rbulk !PARMAT(1)
243!!
244 IF(.NOT.is_encrypted)WRITE(iout,1100)mu,d,lam,gs,rbulk
245c----------------
246c end of optimization loop
247c----------------
248 RETURN
249 1000 FORMAT
250 & (//5x, 'FITTED PARAMETERS FOR HYPERELASTIC_MATERIAL LAW100 ' ,/,
251 & 5x, ' --------------------------------------------------')
252 1001 FORMAT(
253 & 5x,a,/,
254 & 5x, 'MATERIAL NUMBER =',i10,//)
255 1100 FORMAT(
256C
257 & 5x,'TYPE = ARRUDA-BOYCE ',/,
258 & 5x,'MU . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
259 & 5x,'D. . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
260 & 5x,'LAM. . . . . . . . . . . . . . . . . . . .=',1pg20.13/
261 & 5x,'GROUND-STATE SHEAR MODULUS . . . . . . . .=',1pg20.13/
262 & 5x,'BULK MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)
263c-----------
264 RETURN
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:288
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
table_mod
Definition table_mod.F:113

◆ law100_upd_nht()

subroutine law100_upd_nht ( integer iout,
character(len=nchartitle) titr,
integer mat_id,
uparam,
integer nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) func_id,
integer, dimension(*) npc,
pld,
pm )

Definition at line 33 of file law100_upd.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE message_mod
39 USE table_mod
40 USE names_and_titles_mod , ONLY : nchartitle
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 CHARACTER(LEN=NCHARTITLE) :: TITR
53 INTEGER MAT_ID,IOUT, NFUNC
54 INTEGER NPC(*), FUNC_ID(*)
55 my_real
56 . uparam(*),pld(*),pm(npropm)
57 INTEGER, DIMENSION(NFUNC):: IFUNC
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER IDFC,IDFD
62
63 my_real
64 . cmax,dmax,fac1,fac2,sb,rbulk,
65 . nu,g
66C=======================================================================
67 !DIRECTION CHAINE
68 idfc = ifunc(1)
69 idfd = ifunc(2)
70 sb = uparam(4)
71 fac1 = uparam(8+1)
72 fac2 = uparam(8+2)
73
74 CALL func_maxy(idfc,fac1,npc,pld,cmax)
75 CALL func_maxy(idfd,fac2,npc,pld,dmax)
76
77 g = cmax *(sb + one)
78 rbulk= dmax *(one + sb)
79
80 nu = (three*rbulk -two*g)/(three*rbulk + g)/two
81 pm(20)= cmax / two
82 pm(21)= nu
83 pm(22)= g
84 pm(24)= cmax/(one - nu**2) / two
85 pm(32)= rbulk
86 uparam(8+4) = g
87 uparam(8+5) = rbulk
88 RETURN
func_maxy
subroutine func_maxy(idn, fac, npc, pld, maxy)
Definition func_maxy.F:32

◆ ymax()

subroutine ymax ( integer, intent(in) idn,
fac,
integer, dimension(*), intent(in) npc,
intent(in) pld,
stiffmin,
intent(inout) stiffmax,
intent(inout) stiffini,
intent(inout) stiffavg )

Definition at line 273 of file law100_upd.F.

274C-----------------------------------------------
275C M o d u l e s
276C-----------------------------------------------
277 USE message_mod
278 USE table_mod
279C-----------------------------------------------
280C I m p l i c i t T y p e s
281C-----------------------------------------------
282#include "implicit_f.inc"
283C-----------------------------------------------
284C D u m m y A r g u m e n t s
285C-----------------------------------------------
286 INTEGER IDN,NPC(*)
287 my_real pld(*),fac,stiffmin,stiffmax,stiffini,stiffavg
288C-----------------------------------------------
289 INTENT(IN) :: npc,pld,idn
290 INTENT(INOUT) :: stiffmax,stiffini,stiffavg
291C-----------------------------------------------
292C L o c a l V a r i a b l e s
293C-----------------------------------------------
294 INTEGER J,PN1,PN2
295 my_real dydx,dx,dy
296C=======================================================================
297 ! COMPUTE MAXIMUM SLOPE AND INITIAL SLOPE OF FUNCTION
298C=======================================================================
299 pn1 = npc(idn)
300 pn2 = npc(idn+1)
301 stiffini = (pld(pn1+3) - pld(pn1+1))*fac / (pld(pn1+2) - pld(pn1))
302 stiffavg = zero
303 stiffmax = zero
304 stiffmin = ep20
305 DO j = pn1,pn2-4,2
306 dx = pld(j+2) - pld(j)
307 dy = pld(j+3) - pld(j+1)
308 dydx = fac*dy/dx
309 stiffmax = max(stiffmax,dydx)
310 stiffmin = min(stiffmin,dydx)
311 stiffavg = stiffavg + dydx
312 ENDDO
313 stiffavg = stiffavg*two /(pn2-pn1)
314c-----------
315 RETURN
min
#define min(a, b)
Definition macros.h:20