46
47
48
49#include "implicit_f.inc"
50
51
52
53#include "mvsiz_p.inc"
54#include "param_c.inc"
55#include "scr17_c.inc"
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100 INTEGER ,INTENT(IN) :: IEOS
101 INTEGER NEL, NUPARAM, NUVAR,IPT,NVARTMP,
102 . NGL(NEL),MAT(NEL),IPM(NPROPMI,*), IPLA,IEXPAN,
103 . ISRATE
105 . time,timestep,uparam(nuparam),
106 . rho(nel),rho0(nel),volume(nel),eint(nel),
107 . epspxx(nel),epspyy(nel),epspzz(nel),
108 . epspxy(nel),epspyz(nel),epspzx(nel),
109 . depsxx(nel),depsyy(nel),depszz(nel),
110 . depsxy(nel),depsyz(nel),depszx(nel),
111 . epsxx(nel) ,epsyy(nel) ,epszz(nel) ,
112 . epsxy(nel) ,epsyz(nel) ,epszx(nel) ,
113 . sigoxx(nel),sigoyy(nel),sigozz(nel),
114 . sigoxy(nel),sigoyz(nel),sigozx(nel),
115 . epsp(nel),amu(nel), asrate
116 my_real,
DIMENSION(MVSIZ) ,
INTENT(IN) :: dpdm
117
118
119
121 . signxx(nel),signyy(nel),signzz
122 . signxy(nel),signyz(nel),signzx(nel),
123 . sigvxx(nel),sigvyy(nel),sigvzz(nel),
124 . sigvxy(nel),sigvyz(nel),sigvzx(nel),
125 . soundsp(nel),viscmax(nel),sigy(nel),
126 . pla(nel),dpla1(mvsiz)
127 INTEGER :: VARTMP(NEL,NVARTMP)
128
129
130
132 . uvar(nel,nuvar), off(nel)
133 my_real,
DIMENSION(NEL),
INTENT(INOUT) ::
134 . et
135
136
137
138 INTEGER NPF(*),MFUNC,KFUNC(MFUNC)
140 . tf(*)
141
142
143
144 INTEGER I,IADBUF,ICC,VFLAG,IPOS(MVSIZ),IAD(MVSIZ),ILEN(MVSIZ),IDEV
146 . e,nu,p,dav,vm,r,epst,e1,e2,e3,e4,e5,e6,c,cd,d,
147 . y,yp,e42,e52
148 . g,g2,g3,epsgm,epmax,smax(mvsiz),fail(mvsiz),
149 . epsr1,epsr2,yld(mvsiz),h(mvsiz),dfdpla(mvsiz),
150 . ca,cb,cn,cc,cp,dpla,yscale,dpdt
151
152
153
154
155 e = uparam(1)
156 nu = uparam(2)
157 ca = uparam(3)
158 smax(1:nel) = uparam(4)
159 epmax = uparam(5)
160 epsr1 = uparam(6)
161 epsr2 = uparam(7)
162 cb = uparam(8)
163 cn = uparam(9)
164 icc = nint(uparam(10))
165 cc = uparam(11)
166 cp = uparam(12)
167 g = uparam(16)
168 g2 = uparam(17)
169 g3 = uparam(18)
170 bulk = uparam(19)
171 epsgm = uparam(22)
172 vflag = nint(uparam(23))
173 yscale = uparam(24)
174
175
176
177 idev = vflag-2
178 IF ((vflag == 2) .OR. (vflag == 3)) THEN
180 . epspxx ,epspyy ,epspzz ,epspxy ,epspyz ,
181 . epspzx )
182 ENDIF
183
184
185
186 DO i=1,nel
187 p = -(sigoxx(i)+sigoyy(i)+sigozz(i))* third
188 dav = (depsxx(i)+depsyy(i)+depszz(i)) * third
189 signxx(i) = sigoxx(i)+p+g2*(depsxx(i)-dav)
190 signyy(i) = sigoyy(i)+p+g2*(depsyy(i)-dav)
191 signzz(i) = sigozz(i)+p+g2*(depszz(i)-dav)
192 signxy(i) = sigoxy(i)+g *depsxy(i)
193 signyz(i) = sigoyz(i)+g *depsyz(i)
194 signzx(i) = sigozx(i)+g *depszx(i)
195 viscmax(i) = zero
196 dpla1(i) = zero
197 ENDDO
198
199
200
201
202 DO i=1,nel
203
204 dav = (epsxx(i)+epsyy(i)+epszz(i)) * third
205 e1 = epsxx(i) - dav
206 e2 = epsyy(i) - dav
207 e3 = epszz(i) - dav
208 e4 = half*epsxy(i)
209 e5 = half*epsyz(i)
210 e6 = half*epszx(i)
211
212
213
214
215
216
217 e42 = e4*e4
218 e52 = e5*e5
219 e62 = e6*e6
220 c = - e1*e1 - e2*e2 - e3*e3 - e42 - e52 - e62
221 d = - e1*e2*e3 + e1*e52 + e2*e62 + e3*e42
222 & - two*e4*e5*e6
223 cd = c*third
224 epst = sqrt(-cd)
225 epst2 = epst * epst
226 y = (epst2 + c)* epst + d
227 IF(abs(y)>em8)THEN
228 epst = onep75 * epst
229 epst2 = epst * epst
230 y = (epst2 + c)* epst + d
231 yp = three*epst2 + c
232 IF(yp/=zero)epst = epst - y/yp
233 epst2 = epst * epst
234 y = (epst2 + c)* epst + d
235 yp = three*epst2 + c
236 IF(yp/=zero)epst = epst - y/yp
237 epst2 = epst * epst
238 y = (epst2 + c)* epst + d
239 yp = three*epst2 + c
240 IF(yp/=zero)epst = epst - y/yp
241 epst2 = epst * epst
242 y = (epst2 + c)* epst + d
243 yp = three*epst2 + c
244 IF(yp/=zero)epst = epst - y/yp
245 epst = epst + dav
246 ENDIF
247
248
249
250 fail(i) =
max(zero,
min(one,
251 . (epsr2-epst)/(epsr2-epsr1) ))
252
253 ENDDO
254
255
256
257 IF (mfunc > 0) THEN
258 ipos(1:nel) = vartmp(1:nel,1)
259 iad(1:nel) = npf(kfunc(1)) / 2 + 1
260 ilen(1:nel) = npf(kfunc(1)+1) / 2 - iad(1:nel) - ipos(1:nel)
261 CALL vinter(tf,iad,ipos,ilen,nel,pla,dfdpla,yld)
262 vartmp(1:nel,1) = ipos(1:nel)
263 ENDIF
264
265 IF (ipla /= 2) THEN
266 DO i=1,nel
267 rq = one
268 IF (cc /= zero) rq = one + (cc*epsp(i))**cp
269 IF (icc == 1) smax(i) = smax(i)*rq
270 IF (pla(i) > zero) THEN
271 IF ((mfunc > 0) .AND. (ca == zero)) THEN
272 yld(i) = yscale * yld(i) * rq
273 h(i) = fail(i) * (yscale*dfdpla(i)*rq)
274 ELSEIF ((mfunc > 0) .AND. (ca > zero)) THEN
275 yld(i) = yscale * yld(i)
276 . + (ca + cb*pla(i)**cn) * (rq-one)
277 h(i) = fail(i) * (yscale*dfdpla(i) + cn*cb*(rq-one)/(pla(i)**(one-cn)))
278 ELSE
279 yld(i) = (ca + cb*pla(i)**cn) * rq
280 h(i) = fail(i)*cn*cb*rq/(pla(i)**(one-cn))
281 ENDIF
282 yld(i) = fail(i) *
min(smax(i),yld(i))
283 ELSE
284 IF ((mfunc > 0) .AND. (ca == zero)) THEN
285 yld(i) = fail(i) * yscale * yld(i) * rq
286 ELSEIF ((mfunc > 0) .AND. (ca > zero)) THEN
287 yld(i) = fail(i) * (yscale * yld(i) + ca * (rq-one))
288 ELSE
289 yld(i) = fail(i) * ca * rq
290 ENDIF
291 h(i) = e
292 ENDIF
293 IF (pla(i) >= epsgm) THEN
294 yld(i) = fail(i) * smax(i)
295 h(i) = zero
296 ENDIF
297 sigy(i) = yld(i)
298 IF (pla(i) >= epmax) yld(i) = zero
299 ENDDO
300 ELSE
301 DO i=1,nel
302 rq = one
303 IF (cc /= zero) rq = one + (cc*epsp(i))**cp
304 IF (icc == 1) smax(i) = smax(i)*rq
305 IF (pla(i) > zero) THEN
306 IF ((mfunc > 0) .AND. (ca == zero)) THEN
307 yld(i) = yscale * yld(i) * rq
308 h(i) = fail(i)*(yscale*dfdpla(i)*rq)
309 ELSEIF ((mfunc > 0) .AND. (ca > zero)) THEN
310 yld(i) = yscale * yld(i)
311 . + (ca + cb*pla(i)**cn) * (rq-one)
312 h(i) = fail(i)* (yscale*dfdpla(i) + cn*cb*(rq-one)/(pla(i)**(one-cn)))
313 ELSE
314 yld(i) = (ca + cb*pla(i)**cn) * rq
315 h(i) = fail(i)*cn*cb*rq/(pla(i)**(one-cn))
316 ENDIF
317 yld(i) = fail(i) *
min(smax(i),yld(i))
318 ELSE
319 IF ((mfunc > 0) .AND. (ca == zero)) THEN
320 yld(i) = fail(i) * yscale * yld(i) * rq
321 ELSEIF ((mfunc > 0) .AND. (ca > zero)) THEN
322 yld(i) = fail(i) * (yscale * yld(i) + ca * (rq-one))
323 ELSE
324 yld(i) = fail(i) * ca * rq
325 ENDIF
326 h(i) = e
327 ENDIF
328 IF (pla(i) >= epsgm) THEN
329 yld(i) = fail(i) * smax(i)
330 yld(i) = zero
331 ENDIF
332 sigy(i) = yld(i)
333 IF (pla(i) >= epmax) yld(i)=zero
334 ENDDO
335 ENDIF
336
337
338
339
340 IF (ipla == 0) THEN
341 DO i = 1,nel
342 vm = half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
343 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
344 vm = sqrt(three*vm)
345 r =
min(one,yld(i)/
max(vm,em20))
346 signxx(i) = signxx(i)*r
347 signyy(i) = signyy(i)*r
348 signzz(i) = signzz(i)*r
349 signxy(i) = signxy(i)*r
350 signyz(i) = signyz(i)*r
351 signzx(i) = signzx(i)*r
352 pla(i) = pla(i) + (one -r)*vm/
max(g3+h(i),em20)
353 dpla1(i) = (one -r)*vm/
max(g3+h(i),em20)
354 ENDDO
355 ELSEIF (ipla == 2) THEN
356 DO i = 1,nel
357 vm = half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
358 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
359 vm = sqrt(three*vm)
360 r =
min(one,yld(i)/
max(vm,em20))
361 signxx(i) = signxx(i)*r
362 signyy(i) = signyy(i)*r
363 signzz(i) = signzz(i)*r
364 signxy(i) = signxy(i)*r
365 signyz(i) = signyz(i)*r
366 signzx(i) = signzx(i)*r
367 pla(i) = pla(i) + (one -r)*vm/
max(g3,em20)
368 dpla1(i) = (one -r)*vm/
max(g3,em20)
369 ENDDO
370 ELSEIF (ipla == 1) THEN
371 DO i = 1,nel
372 vm = half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
373 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
374 vm = sqrt(three*vm)
375 r =
min(one,yld(i)/
max(vm,em20))
376
377 dpla = (one - r)*vm/
max(g3+h(i),em20)
378
379 yld(i) = yld(i) + dpla*h(i)
380 IF (pla(i) >= epmax) yld(i)=zero
381 r =
min(one,yld(i)/
max(vm,em20))
382 signxx(i
383 signyy(i) = signyy(i)*r
384 signzz(i) = signzz(i)*r
385 signxy(i) = signxy(i)*r
386 signyz(i) = signyz(i)*r
387 signzx(i) = signzx(i)*r
388 pla(i) = pla(i) + dpla
389 dpla1(i) = dpla
390 ENDDO
391 ENDIF
392
393
394 IF (ieos == 0) THEN
395 DO i = 1, nel
396
397 p = bulk * amu(i)
398 signxx(i) = signxx(i) - p
399 signyy(i) = signyy(i) - p
400 signzz(i) = signzz(i) - p
401 signxy(i) = signxy(i)
402 signyz(i) = signyz(i)
403 signzx(i) = signzx(i)
404 soundsp(i) = sqrt((bulk + four*g/three)/rho0(i))
405 ENDDO
406 ELSE
407
408
409
410 DO i = 1, nel
411 soundsp(i) = sqrt((dpdm(i) + four*g/three)/rho0(i))
412 ENDDO
413 END IF
414
415 IF (vflag == 1) THEN
416 DO i=1,nel
417 dpdt = dpla1(i) /
max(em20,timestep)
418 epsp(i) = asrate * dpdt + (one - asrate) * epsp(i)
419 ENDDO
420 ENDIF
421
422 DO i=1,nel
423 sigy(i) =
max(sigy(i),yld(i))
424 IF (dpla1(i) > zero) THEN
425 et(i) = h(i) / (h(i) + e)
426 ELSE
427 et(i) = one
428 ENDIF
429 ENDDO
430
431 RETURN
subroutine mstrain_rate(nel, israte, asrate, epsd, idev, ep1, ep2, ep3, ep4, ep5, ep6)
subroutine vinter(tf, iad, ipos, ilen, nel, x, dydx, y)