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