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 103 of file law100_upd.F.

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

◆ 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 . cmin,cmax,cini,cavg,dmin,dmax,dini,davg,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 271 of file law100_upd.F.

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