49
50
51
52#include "implicit_f.inc"
53
54
55
56#include "mvsiz_p.inc"
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
101
102
103
104
105
106
107
108#include "param_c.inc"
109#include "com01_c.inc"
110
111
112
113 INTEGER, INTENT(IN) ::
114 INTEGER NEL0, NUPARAM, NUVAR, NPT0, IPT,IFLAG(*),
115 . NGL(NEL0),MAT(NEL0),IPM(NPROPMI,*),INLOC
116 my_real time,timestep,uparam(*),
117 .
area(nel0),rho0(nel0),eint(nel0,2),
118 . thkly(nel0),pla(nel0),
119 . epspxx(nel0),epspyy(nel0),
120 . epspxy(nel0),epspyz(nel0),epspzx(nel0),
121 . depsxx(nel0),depsyy(nel0),
122 . depsxy(nel0),depsyz(nel0),depszx(nel0),
123 . epsxx(nel0) ,epsyy(nel0) ,
124 . epsxy(nel0) ,epsyz(nel0) ,epszx(nel0) ,
125 . sigoxx(nel0),sigoyy(nel0),
126 . sigoxy(nel0),sigoyz(nel0),sigozx(nel0),
127 . gs(*),vol(nel0),tempel(nel0),
128 . die(nel0),dplanl(nel0)
129 my_real,
DIMENSION(NEL0),
INTENT(IN) :: loff
130
131
132
134 . signxx(nel0),signyy(nel0),
135 . signxy(nel0),signyz(nel0),signzx(nel0),
136 . sigvxx(nel0),sigvyy(nel0),
137 . sigvxy(nel0),sigvyz(nel0),sigvzx(nel0),
138 . soundsp(nel0),viscmax(nel0),etse(nel0)
139
140
141
142 my_real uvar(nel0,nuvar), off(nel0),thk(nel0),yld(nel0)
143
144
145
146 INTEGER NPF(*), MFUNC, KFUNC(MFUNC)
148 EXTERNAL finter
149
150
151
152
153
154
155
156
157
158
159 INTEGER I,J,N,NINDX,
160 . NMAX,INDEX(),
161 . IAD1(MVSIZ),IPOS1(MVSIZ),ILEN1(MVSIZ),
162 . IAD2(MVSIZ),IPOS2(MVSIZ),ILEN2(MVSIZ),
163 . NFUNC, IFUNC(2),MX
165 . e,a1,a2,g,g3,
166 . aa(mvsiz),bb(mvsiz),pp(mvsiz),qq(mvsiz),h(mvsiz),
167 .
168 . cn,
169 . v0, temp(mvsiz),vmc,fac,
170 . vol0,dvm, vm(mvsiz),nu,
171 . nnu2,nu1,nu2,nu3,nu4,
172 . nu5,nu6,svm(mvsiz),
173 . dydx1(mvsiz),dydx2(mvsiz), y1(mvsiz),y2(mvsiz)
175 . dpla(mvsiz),umr, r, cp,dezz,s1, s2,
176 . s3, dpla_j(mvsiz), yld_i,dr(mvsiz), p2,q2,nnu1,
177 . s11,s22,
178 . s12, vm2, a, b, c, sigz, f, df, p,md,
179 . cd,yfac(2),
180 . hl
181 DATA nmax/3/
182
183
184
185
186 mx = mat(1)
187 nfunc = ipm(10,mx)
188 DO j=1,nfunc
189 ifunc(j)=ipm(10+j,mx)
190 ENDDO
191 e = uparam(1)
192 a1 = uparam(2)
193 a2 = uparam(3)
194 g = uparam(4)
195 nu = uparam(5)
196 cd = uparam(6)
197 cn = uparam(7)
198 md = uparam(8)
199 v0 = uparam(9)
200 vmc = uparam(10)
201 cp = uparam(11)
202 yfac(1) = uparam(13)
203 yfac(2) = uparam(14)
204 hl = uparam(15)
205 g3 = three*g
206 nnu1 = nu / (one - nu)
207 nnu2 = nnu1*nnu1
208 nu1 = one/(one - nu)
209 nu2 = one/(one + nu)
210 nu3 = one -nnu1
211 nu4 = one + nnu2 + nnu1
212 nu5 = one + nnu2 - two*nnu1
213 nu6 = half - nnu2 + half*nnu1
214 DO i=1,nel0
215 temp(i) = uparam(12)
216 ENDDO
217
218
219
220 IF(jthe > 0 ) THEN
221 DO i=1,nel0
222 temp(i) = tempel(i)
223 ENDDO
224 ELSE
225 DO i=1,nel0
226 vol0 = vol(i) * rho0(i)
227 vm(i) = uvar(i,2)
228 temp(i) = temp(i) + (eint(i,1)+ eint(i,2) + vm(i)*hl) * cp / vol0
229 ENDDO
230 ENDIF
231
232 DO i=1,nel0
233
234 signxx(i)=sigoxx(i) + a1*depsxx(i) + a2*depsyy(i)
235 signyy(i)=sigoyy(i) + a2*depsxx(i) + a1*depsyy(i)
236 signxy(i)=sigoxy(i) + g *depsxy(i)
237 signyz(i)=sigoyz(i) + gs(i)*depsyz(i)
238 signzx(i)=sigozx(i) + gs(i)*depszx(i)
239 vm(i) = uvar(i,2)
240 dpla(i) = zero
241
242
243 soundsp(i) = sqrt(a1/rho0(i))
244 viscmax(i) = zero
245 etse(i) = one
246
247 ENDDO
248
249 DO i=1,nel0
250 ipos1(i) = nint(uvar(i,3))
251 iad1(i) = npf(ifunc(1)) / 2 + 1
252 ilen1(i) = npf(ifunc(1)+1) / 2 - iad1(i) - ipos1(i)
253 ipos2(i) = nint(uvar(i,4))
254 iad2(i) = npf(ifunc(2)) / 2 + 1
255 ilen2(i) = npf(ifunc(2)+1) / 2 - iad2(i) - ipos2(i)
256 ENDDO
257
258 CALL vinter(tf,iad1,ipos1,ilen1,nel0,pla,dydx1,y1)
259 CALL vinter(tf,iad2,ipos2,ilen2,nel0,pla,dydx2,y2)
260
261 DO i=1,nel0
262 y1(i)=y1(i)*yfac(1)
263 y2(i)=y2(i)*yfac(2)
264 fac = vm(i)/vmc
265 yld(i) = y1(i) + fac*(y2(i)-y1(i))
266 yld(i) =
max(yld(i),em20)
267
268 dydx1(i)=dydx1(i)*yfac(1)
269 dydx2(i)=dydx2(i)*yfac(2)
270 h(i) = (dydx1(i) + fac*(dydx2(i)-dydx1(i)))
271 uvar(i,3) = ipos1(i)
272 uvar(i,4) = ipos2(i)
273 ENDDO
274
275
276
277 IF(iflag(1)==0)THEN
278
279 DO i=1,nel0
280 svm(i)=sqrt(signxx(i)*signxx(i)
281 . +signyy(i)*signyy(i)
282 . -signxx(i)*signyy(i)
283 . +three*signxy(i)*signxy(i))
284 r =
min(one,yld(i)/
max(em20,svm(i)))
285 signxx(i)=signxx(i)*r
286 signyy(i)=signyy(i)*r
287 signxy(i)=signxy(i)*r
288 umr = one - r
289
290 dpla(i) = off(i)*svm(i)*umr/e
291 pla(i) = pla(i) + dpla(i)
292 s1=half*(signxx(i)+signyy(i))
293 IF (inloc == 0) THEN
294 dezz = dpla(i) * half*(signxx(i)+signyy(i)) / yld(i)
295 dezz=-(depsxx(i)+depsyy(i))*nnu1-nu3*dezz
296 thk(i) = thk(i) + dezz*thkly(i)*off(i)
297 ENDIF
298 IF(r<one) etse(i)= h(i)/(h(i)+e)
299 ENDDO
300 ELSEIF(iflag(1)==1)THEN
301
302
303
304 DO i=1,nel0
305 h(i) =
max(zero,h(i))
306 s1=signxx(i)+signyy(i)
307 s2=signxx(i)-signyy(i)
308 s3=signxy(i)
309 aa(i)=fourth*s1*s1
310 bb(i)=three_over_4*s2*s2+three*s3*s3
311 svm(i)=sqrt(aa(i)+bb(i))
312 IF (inloc == 0) THEN
313 dezz = -(depsxx(i)+depsyy(i))*nnu1
314 thk(i) = thk(i) + dezz*thkly(i)*off(i)
315 ENDIF
316 ENDDO
317
318
319
320 nindx=0
321 DO i=1,nel0
322 IF(svm(i)>yld(i).AND.off(i)==one) THEN
323 nindx=nindx+1
324 index(nindx)=i
325 ENDIF
326 ENDDO
327
328 IF(nindx/=0) THEN
329
330
331
332 DO j=1,nindx
333 i=index(j)
334 dpla_j(i)=(svm(i)-yld(i))/(g3+h(i))
335 etse(i)= h(i)/(h(i)+e)
336 ENDDO
337
338 DO n=1,nmax
339#include "vectorize.inc"
340 DO j=1,nindx
341 i=index(j)
342 dpla(i)=dpla_j(i)
343
344 yld_i = yld(i) + h(i)*dpla(i)
345
346 dr(i) =half*e*dpla(i)/yld_i
347 pp(i) =one/(one+dr(i)*nu1)
348 qq(i) =one/(one + three*dr(i)*nu2)
349 p2 =pp(i)*pp(i)
350 q2 =qq(i)*qq(i)
351 f =aa(i)*p2+bb(i)*q2-yld_i*yld_i
352 df =-(aa(i)*nu1*p2*pp(i)+three*bb(i)*nu2*q2*qq(i))
353 . *(e-two*dr(i)*h(i))/yld_i
354 . -two*h(i)*yld_i
355 df = sign(
max(abs(df),em20),df)
356 IF(dpla(i)>zero) THEN
357 dpla_j(i)=
max(zero,dpla(i)-f/df)
358 ELSE
359 dpla_j(i)=zero
360 ENDIF
361 ENDDO
362 ENDDO
363
364
365
366#include "vectorize.inc"
367 DO j=1,nindx
368 i=index(j)
369 pla(i) = pla(i) + dpla(i)
370 s1=(signxx(i)+signyy(i))*pp(i)
371 s2=(signxx(i)-signyy(i))*qq(i)
372 signxx(i)=half*(s1+s2)
373 signyy(i)=half*(s1-s2)
374 signxy(i)=signxy(i)*qq(i)
375 IF (inloc == 0) THEN
376 dezz = - nu3*dr(i)*s1/e
377 thk(i) = thk(i) + dezz*thkly(i)*off(i)
378 ENDIF
379 ENDDO
380 ENDIF
381
382 ELSEIF(iflag(1)==2)THEN
383
384
385
386
387 DO i=1,nel0
388 p = -(signxx(i)+signyy(i))*third
389 s11 = signxx(i)+p
390 s22 = signyy(i)+p
391
392 s12 = signxy(i)
393
394 p2 = p*p
395 vm2= three*(s12*s12 - s11*s22)
396 a = p2*nu4 + vm2
397 vm2= three*p2 + vm2
398 b = p2*nu6
399 c = p2*nu5 - yld(i)*yld(i)
400 r =
min(one,(-b + sqrt(
max(zero,b*b-a*c)))/
max(a ,em20))
401 signxx(i) = s11*r - p
402 signyy(i) = s22*r - p
403 signxy(i) = s12*r
404
405
406 umr = one - r
407 sigz = nnu1*p*umr
408 signxx(i) = signxx(i) + sigz
409 signyy(i) = signyy(i) + sigz
410 svm(i)=sqrt(vm2)
411 dpla(i) = off(i)*svm(i)*umr/g3
412
413 pla(i) = pla(i) + dpla(i)
414 IF (inloc == 0) THEN
415 dezz = dpla(i) * half*(signxx(i)+signyy(i)) / yld(i)
416 dezz=-(depsxx(i)+depsyy(i))*nnu1-nu3*dezz
417 thk(i) = thk(i) + dezz*thkly(i)*off(i)
418 ENDIF
419 IF(r<one) etse(i)= h(i)/(h(i)+e)
420 ENDDO
421 ENDIF
422
423 DO i=1,nel0
424 dvm = zero
425 IF(temp(i)<md) THEN
426 dvm = cn*cd*exp((cn-one)*log(
max(cd*pla(i),em20)))
427 dvm = dvm*exp(-(cd*pla(i))**cn)
428 dvm = dvm*v0*log(md - temp(i) + one)
429 ENDIF
430
431 vm(i) = vm(i) +
max(dvm*dpla(i),zero)
432 vm(i) =
min(vm(i), one)
433
434 IF(jthe > 0 ) die(i) = (vm(i) - uvar(i,2))*hl
435 uvar(i,2) = vm(i)
436 uvar(i,5) = temp(i)
437 uvar(i,1) = pla(i)
438 ENDDO
439
440
441
442
443 IF (inloc > 0) THEN
444 DO i = 1,nel0
445 IF (loff(i) == one) THEN
446 svm(i) = sqrt(signxx(i)*signxx(i) + signyy(i)*signyy(i)
447 . - signxx(i)*signyy(i) + three*signxy(i)*signxy(i))
448 dezz =
max(dplanl(i),zero)*half*(signxx(i)+signyy(i))/
max(svm(i),em20)
449 dezz = -nu*((signxx(i)-sigoxx(i)+signyy(i)-sigoyy(i))/e) - dezz
450 thk(i) = thk(i) + dezz*thkly(i)*off(i)
451 ENDIF
452 ENDDO
453 ENDIF
454
455 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine vinter(tf, iad, ipos, ilen, nel, x, dydx, y)