43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "com01_c.inc"
51#include "param_c.inc"
52
53
54
55
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 INTEGER, INTENT(IN) :: JTHE
95 INTEGER, INTENT(IN) :: JLAG
96 INTEGER NEL, NUPARAM, NUVAR
98 . time,timestep,uparam(nuparam),
99 . rho(nel),rho0(nel),volume(nel),eint(nel),
100 . epspxx(nel),epspyy(nel),epspzz(nel),
101 . epspxy(nel),epspyz(nel),epspzx(nel),
102 . depsxx(nel),depsyy(nel),depszz(nel),
103 . depsxy(nel),depsyz(nel),depszx(nel),
104 . epsxx(nel) ,epsyy(nel) ,epszz(nel) ,
105 . epsxy(nel) ,epsyz(nel) ,epszx(nel) ,
106 . sigoxx(nel),sigoyy(nel),sigozz(nel),
107 . sigoxy(nel),sigoyz(nel),sigozx(nel)
108
109
110
112 . signxx(nel),signyy(nel),signzz(nel),
113 . signxy(nel),signyz(nel),signzx(nel),
114 . sigvxx(nel),sigvyy(nel),sigvzz(nel),
115 . sigvxy(nel),sigvyz(nel),sigvzx(nel),
116 . soundsp(nel),viscmax(nel),yld(nel) ,
117 . pla(nel),dep(nel),etse(nel)
118
119
120
121 my_real :: uvar(nel,nuvar), off(nel)
122 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: fheat
123 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: temp
124
125
126
127 INTEGER I,II,J,K,NITER,NINDX
128 INTEGER INDX(NEL)
130 . tol,lamda,res,dres,sqr2inv,seq,yldp,dav,nu,young,shear,g2,
131 . bulk,qvoce,bvoce,kswift,kvoce,kswiftp,kvocep,expv,
132 . k0,
alpha,an,eps0,nn,deps0,epsp0
133 . eta,cp,tini,tref,tmelt,mtemp,depsad,seff,geff,f_eps,gss,
134 . ggsig,g2gsig,p12,p22,p33,g12,g22,g33,omega,plap0
136 . gsig(6),psig(6),f_epsp(nel),f_temp(nel),svm(nel)
137 . dlam(nel),dlamin(nel),plap(nel),dheat(nel),
138 . sigtrxx(nel),sigtryy(nel),sigtrzz(nel),
139 . sigtrxy(nel),sigtryz(nel),sigtrzx(nel)
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186 young = uparam(1)
187 nu = uparam(2)
188 shear = young*half/(one+nu)
189 g2 = two*shear
190 lamda = young*nu/(one+nu)/(one-two*nu)
191 bulk = young*third/(one-two*nu)
192
193 p12 = uparam(3)
194 p22 = uparam(4)
195 p33 = uparam(5)
196 g12 = uparam(6)
197 g22 = uparam(7)
198 g33 = uparam(8)
199 qvoce = uparam(9)
200 bvoce = uparam(10)
201 k0 = uparam(11)
203
204 an = uparam(13)
205 eps0 = uparam(14)
206 nn = uparam(15)
207 cepsp = uparam(16)
208 deps0 = uparam(17)
209 cepspn = cepsp
210
211 eta = uparam(18)
212 cp = uparam(19)
213 tini = uparam(20)
214 tref = uparam(21)
215 tmelt = uparam(22)
216 mtemp = uparam(23)
217 depsad = uparam(24)
218
219
220
221 IF (isigi == 0 .and. time == zero) THEN
222 DO i=1,nel
223 f_temp(i)=
min(one,
max(zero,((tini-tref)/(tmelt-tref))**mtemp))
224 f_temp(i)= one - f_temp(i)
226 yld(i) = f_eps * f_temp(i)
227 uvar(i,2) = yld(i)
228 ENDDO
229 ENDIF
230
231 DO i=1,nel
232 pla(i) = uvar(i,1)
233 yld(i) = uvar(i,2)
234 plap(i) = zero
235 dlam(i) = zero
236 dep(i) = zero
237 ENDDO
238
239
240
241 DO i=1,nel
242 dav = depsxx(i) + depsyy(i) + depszz(i)
243 signxx(i) = sigoxx(i) + depsxx(i)*g2 + lamda*dav
244 signyy(i) = sigoyy(i) + depsyy(i)*g2 + lamda*dav
245 signzz(i) = sigozz(i) + depszz(i)*g2 + lamda*dav
246 signxy(i) = sigoxy(i) + depsxy(i)*shear
247 signyz(i) = sigoyz(i) + depsyz(i)*shear
248 signzx(i) = sigozx(i) + depszx(i)*shear
249 sigtrxx(i) = signxx(i)
250 sigtryy(i) = signyy(i)
251 sigtrzz(i) = signzz(i)
252 sigtrxy(i) = signxy(i)
253 sigtryz(i) = signyz(i)
254 sigtrzx(i) = signzx(i)
255
256 svm(i) = sqrt(signxx(i)*signxx(i)
257 . + signyy(i)*signyy(i)*p22
258 . + signzz(i)*signzz(i)*(one+two*p12+p22)
259 . + signxy(i)*signxy(i)*p33
260 . + signyz(i)*signyz(i)*three
261 . + signzx(i)*signzx(i)*three
262 . + signxx(i)*signyy(i)*two*p12
263 . - signzz(i)*signyy(i)*two*(p12+p22)
264 . - signxx(i)*signzz(i)*two*(one+p12))
265 ENDDO
266
267
268
269 nindx = 0
270 DO i=1,nel
271 IF (svm(i) > yld(i)) THEN
272 nindx = nindx + 1
273 indx(nindx) = i
274 ENDIF
275 ENDDO
276
277
278
279 DO ii=1,nindx
280 i = indx(ii)
281
282
283
284 tol = 0.00001
285 sqr2inv = one/sqr2
286 niter = 5
287 cepspn = cepsp
288 IF( cepspn == zero )THEN
289 dlamin(i) = uvar(i,4) + em10
290 ELSE
291 dlamin(i) = five*em4*timestep*exp((em4)/cepspn)
292 ENDIF
293
294 dlam(i) = uvar(i,4) + em9
295 dlam(i) =
max(dlam(i), dlamin(i))
296
297 plap(i) = dlam(i) / timestep
298 f_temp(i) = ((temp(i)-tref)/(tmelt-tref))**mtemp
299 f_temp(i) =
min(one,
max(zero, f_temp(i)))
300 f_temp(i) = one - f_temp(i)
301
302
303 psig(1) = signxx(i) + signyy(i)*p12-signzz(i)*(one+p12)
304 psig(2) = signxx(i)*p12 + signyy(i)*p22-signzz(i)*(p12+p22)
305 psig(3) =-signxx(i)*(one+p12)- signyy(i)*(p12+p22)
306 . + signzz(i)*(one+two*p12+p22)
307 psig(4) = signxy(i)*p33
308 psig(5) = signyz(i)*three
309 psig(6) = signzx(i)*three
310
311 ggsig = dlam(i)*shear/svm(i)
312 g2gsig = ggsig*two
313 signxx(i) = sigtrxx(i) - psig(1)*g2gsig
314 signyy(i) = sigtryy(i) - psig(2)*g2gsig
315 signzz(i) = sigtrzz(i) - psig(3)*g2gsig
316 signxy(i) = sigtrxy(i) - psig(4)*ggsig
317 signyz(i) = sigtryz(i) - psig(5)*ggsig
318 signzx(i) = sigtrzx(i) - psig(6)*ggsig
319
320
321
322 DO k=1,niter
323
324 seff = sqrt(signxx(i)*signxx(i)
325 . + signyy(i)*signyy(i)*p22
326 . + signzz(i)*signzz(i)*(one+two*p12+p22)
327 . + signxy(i)*signxy(i)*p33
328 . + signyz(i)*signyz(i)*three
329 . + signzx(i)*signzx(i)*three
330 . + signxx(i)*signyy(i)*two*p12
331 . - signzz(i)*signyy(i)*two*(p12+p22)
332 . - signxx(i)*signzz(i)*two*(one+p12))
333 seff =
max(em20,seff)
334
335 geff = sqrt(signxx(i)*signxx(i)
336 . + signyy(i)*signyy(i)*g22
337 . + signzz(i)*signzz(i)*(one+two*g12+g22)
338 . + signxy(i)*signxy(i)*g33
339 . + signyz(i)*signyz(i)*three
340 . + signzx(i)*signzx(i)*three
341 . + signxx(i)*signyy(i)*two*g12
342 . - signzz(i)*signyy(i)*two*(g12+g22)
343 . - signxx(i)*signzz(i)*two*(one+g12))
344 geff =
max(em20,geff)
345
346 gss = geff/seff
347
348
349 psig(1) = signxx(i) + signyy(i)*p12 - signzz(i)*(one+p12)
350 psig(2) = signxx(i)*p12 + signyy(i)*p22 - signzz(i)*(p12+p22
351 psig(3) =-signxx(i)*(one+p12) - signyy(i)*(p12+p22)
352 . + signzz(i)*(one+two*p12+p22)
353 psig(4) = signxy(i)*p33
354 psig(5) = signyz(i)*three
355 psig(6) = signzx(i)*three
356
357 gsig(1) = signxx(i) + signyy(i)*g12 - signzz(i)*(one+g12)
358 gsig(2) = signxx(i)*g12 + signyy(i)*g22 - signzz(i)*(g12+g22)
359 gsig(3) =-signxx(i)*(one+g12) - signyy(i)*(g12+g22)
360 . + signzz(i)*(one+two*g12+g22)
361 gsig(4) = signxy(i)*g33
362 gsig(5) = signyz(i)*three
363 gsig(6) = signzx(i)*three
364
365
366 expv = exp(-bvoce*pla(i))
367 kswift = an*(pla(i) + eps0)**nn
368 kvoce = k0 + qvoce*(one - expv)
370 uvar(i,2) = f_eps*f_temp(i)
371 yld(i) = uvar(i,2)
372
373 f_epsp(i) = one + cepspn*log(plap(i)/deps0
374 kswiftp = kswift*nn / (pla(i) + eps0)
375 kvocep = qvoce*bvoce*expv
377 yldp = yldp * f_temp(i) * f_epsp(i)
378 yldp = yldp + yld(i) * cepspn / dlam(i)
379 yld(i) = uvar(i,2) * f_epsp(i)
380
381 res = seff - yld(i)
382
383
384 IF ( (abs(res) < tol*uvar(i,2)) .and.
385 + (yld(i) > uvar(i,2)*(one-tol)) .and.
386 + ( plap(i) > deps0 ) .and.
387 + (abs(plap(i)-plap0) < plap0 *tol)
388 + ) EXIT
389
390
391
392 dres = psig(1)*gsig(1) + psig(2)*gsig(2) + psig(3)*gsig(3)
393 . + half*(psig(4)*gsig(4)+psig(5)*gsig(5)+psig(6)*gsig(6))
394 dres = dres / (seff*geff)
395 dres = -g2 * dres - yldp * gss
396 dlam(i) = dlam(i) - res / dres
397 uvar(i,4) = dlam(i)
398
399 IF ( (abs(res) < tol*uvar(i,2)) .and.
400 + (gss*dlam(i) / timestep < deps0) ) THEN
401 cepspn = zero
402 dlam(i) = uvar(i,4) + em10
403 dlamin(i) = em20
404 END IF
405
406 plap0 = plap(i)
407 dlam(i) =
max(dlam(i), dlamin(i))
408 dep(i) = dlam(i) * gss
409 pla(i) = uvar(i,1) + dep(i)
410 plap(i) = dep(i) / timestep
411 uvar(i,4) = dlam(i)
412
413 ggsig = dlam(i)*shear/geff
414 g2gsig = ggsig*two
415 signxx(i) = sigtrxx(i) - gsig(1)*g2gsig
416 signyy(i) = sigtryy(i) - gsig(2)*g2gsig
417 signzz(i) = sigtrzz(i) - gsig(3)*g2gsig
418 signxy(i) = sigtrxy(i) - gsig(4)*ggsig
419 signyz(i) = sigtryz(i) - gsig(5)*ggsig
420 signzx(i) = sigtrzx(i) - gsig(6)*ggsig
421
422
423 END DO
424
425
426 ENDDO
427
428
429
430
431 DO ii=1,nindx
432 i = indx(ii)
433 IF (plap(i) <= deps0)THEN
434 omega = zero
435 ELSEIF (plap(i) > depsad) THEN
436 omega = one
437 ELSE
438 omega = ((plap(i)-deps0)**2 )*
439 . (three*depsad - two*plap(i) - deps0)
440 . /((depsad-deps0)**3)
441 ENDIF
442 dheat(i) = eta*omega*yld(i)*dep(i)
443 ENDDO
444
445 IF (jthe < 0 .AND. jlag /= 0) THEN
446 DO ii=1,nindx
447 i = indx(ii)
448 fheat(i) = fheat(i) + dheat(i)*volume(i)
449 ENDDO
450 ELSE
451 DO ii=1,nindx
452 i = indx(ii)
453 temp(i) = temp(i) + dheat(i) / (rho0(i)*cp)
454 ENDDO
455 ENDIF
456
457 DO i=1,nel
458 uvar(i,1) = pla(i)
459 uvar(i,2) = yld(i)
460 uvar(i,3) = plap(i)
461 uvar(i,4) = dlam(i)
462 etse(i) = one
463 soundsp(i)= sqrt((bulk+four_over_3*shear)/rho0(i))
464 viscmax(i)= zero
465 ENDDO
466
467 RETURN