44
45
46
49
50
51
52#include "implicit_f.inc"
53
54
55
56#include "com04_c.inc"
57
58
59
60 INTEGER NEL,NUPARAM,NUVAR,NVARTMP,NUMTABL,JTHE,INLOC
61 INTEGER ,DIMENSION(NUMTABL),INTENT(IN) :: ITABLE
62 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
63
65 my_real,
DIMENSION(NUPARAM) ,
INTENT(IN) :: uparam
66 my_real,
DIMENSION(NEL) ,
INTENT(IN) :: rho,off,gs,thkly,
67 . depsxx,depsyy,depsxy,depsyz,depszx,
68 . sigoxx,sigoyy,sigoxy,sigoyz,sigozx,dplanl
69 my_real ,
DIMENSION(NEL) ,
INTENT(OUT) :: soundsp,sigy,et,
70 . signxx,signyy,signxy,signyz,signzx
71 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: pla,dpla,epsd,temp,thk,seq
72 my_real ,
DIMENSION(NEL,NUVAR) ,
INTENT(INOUT) :: uvar
73 INTEGER ,DIMENSION(NEL,NVARTMP) ,INTENT(INOUT) :: VARTMP
74
75 TYPE(TTABLE), DIMENSION(NTABLE) :: TABLE
76 my_real,
DIMENSION(NEL),
INTENT(IN) :: loff
77 INTEGER, INTENT(IN) :: LPLANL, LEPSDNL
78 my_real,
DIMENSION(NEL*LPLANL) ,
INTENT(IN) :: pla_nl
79 my_real,
DIMENSION(NEL*LEPSDNL),
INTENT(IN) :: dpdt_nl
80
81
82
83 INTEGER I,II,NINDX,ITER,NITER,ISMOOTH,
84 . FUNC_YLD,FUNC_TEMP,FUNC_ETA,NDIM_YLD,NDIM_TEMP,NDIM_ETA
85 INTEGER ,DIMENSION(NEL) :: INDEX
86
87 my_real :: young,g,a11,a12,nu,tref,tini,eta,
88 . xrate,xscale,yscale,dtinv,j2,dphi_dlam,
alpha,alphi,
89 . dfdsig2,sig_dfdsig,ddep,asrate
90
91 my_real,
DIMENSION(NEL) ::svm,yld,yld_tref,yld_temp,
92 . sxx,syy,sxy,sigm,
93 . fact_eta,dydx,hardp,hardr,yld_i,hardp_i,hardr_i,dxdyv,dlam,phi,
94 . ftherm,tfac,normxx,normyy,normxy,
95 . szz,dpxx,dpyy,dpxy,dpla_dlam,pla0,dezz
96 my_real,
DIMENSION(NEL,3) :: xvec_eta
97 my_real,
DIMENSION(NEL,4) :: xvec
98 INTEGER, DIMENSION(NEL,3) :: IPOS_ETA
99 INTEGER, DIMENSION(NEL,2) :: IPOS
100!-------------------------------------------------------------------------------
101
102
103
104
105
106
107
108!===============================================================================
109
110
111
112
113
114 young = uparam(1)
115 nu = uparam(2)
116 eta = uparam(3)
117 tref = uparam(4)
118 tini = uparam(5)
119 ismooth = nint(uparam(6))
120 xrate = uparam(7)
121 xscale = uparam(8)
122 yscale = uparam(9)
123 g = uparam(11)
124 a11 = uparam(16)
125 a12 = uparam(17)
126 asrate = uparam(21)
127
128 dtinv = one /
max(em20, timestep)
129 alpha = asrate*timestep
131
132 IF (jthe /= 0) eta = zero
133
134
135 func_yld = itable(1)
136 func_temp = itable(2)
137 func_eta = itable(3)
138 ndim_yld = table(func_yld)%NDIM
139 IF (func_temp > 0) THEN
140 ndim_temp = table(func_temp)%NDIM
141 ENDIF
142 IF (func_eta > 0) THEN
143 ndim_eta = table(func_eta)%NDIM
144 ENDIF
145
146 epsd(1:nel) = uvar(1:nel,1)
147
148
149 DO i = 1,nel
150 pla0(i) = pla(i)
151 dpla(i) = zero
152 et(i) = one
153 hardp(i) = zero
154 dezz(i) = zero
155 ENDDO
156
157
158 IF (jthe == 0) THEN
159
160 IF (time == zero) temp(1:nel) = tini
161
162 IF (eta > zero) THEN
163
164 IF (func_eta > 0) THEN
165 IF (inloc == 0) THEN
166 xvec_eta(1:nel,1) = epsd(1:nel) * xrate
167 ELSE
168 xvec_eta(1:nel,1) = dpdt_nl(1:nel) * xrate
169 ENDIF
170 ipos_eta(1:nel,1) = 1
171 IF (ndim_eta > 1) THEN
172 xvec_eta(1:nel,2) = temp(1:nel)
173 ipos_eta(1:nel,2) = vartmp(1:nel,4)
174 END IF
175 IF (ndim_eta > 2) THEN
176 IF (inloc == 0) THEN
177 xvec_eta(1:nel,3) = pla(1:nel)
178 ELSE
179 xvec_eta(1:nel,3) = pla_nl(1:nel)
180 ENDIF
181 ipos_eta(1:nel,3) = vartmp(1:nel,5)
182 END IF
183 CALL table_vinterp(table(func_eta),nel,nel,ipos_eta,xvec_eta,
184 . fact_eta,dxdyv)
185 IF (ndim_eta > 1) vartmp(1:nel,4) = ipos_eta(1:nel,2)
186 IF (ndim_eta > 2) vartmp(1:nel,5) = ipos_eta(1:nel,3)
187 DO i=1,nel
188 ftherm(i) =
min(eta*fact_eta(i), one)
189 END DO
190 ELSE
191 ftherm(1:nel) =
min(eta, one)
192 END IF
193 END IF
194 ENDIF
195
196
197
198 !=========================================================================
199 DO i=1,nel
200
201 signxx(i) = sigoxx(i) + a11*depsxx(i) + a12*depsyy(i)
202 signyy(i) = sigoyy(i) + a11*depsyy(i) + a12*depsxx(i)
203 signxy(i) = sigoxy(i) + depsxy(i)*g
204 signyz(i) = sigoyz(i) + depsyz(i)*gs(i)
205 signzx(i) = sigozx(i) + depszx(i)*gs(i)
206
207 sigm(i) = (signxx(i) + signyy(i)) * third
208
209 sxx(i) = signxx(i) - sigm(i)
210 syy(i) = signyy(i) - sigm(i)
211 szz(i) = -sigm(i)
212 sxy(i) = signxy(i)
213
214 j2 = half*(sxx(i)**2 + syy(i)**2 + szz(i)**2 + two*sxy(i)**2)
215 svm(i) = sqrt(three*j2)
216 ENDDO
217
218
219 xvec(1:nel,1) = pla(1:nel)
220 xvec(1:nel,2) = epsd(1:nel) * xscale
221 ipos(1:nel,1) = vartmp(1:nel,1)
222 ipos(1:nel,2) = 1
224 . xvec,yld,hardp,hardr)
225 yld(1:nel) = yld(1:nel)*yscale
226 hardp(1:nel) = hardp(1:nel)*yscale
227 vartmp(1:nel,1) = ipos(1:nel,1)
228
229 IF (func_temp > 0) THEN
230 xvec(1:nel,2) = tref
231 ipos(1:nel,1) = vartmp(1:nel,2)
232 ipos(1:nel,2) = vartmp(1:nel,3)
233 CALL table_vinterp(table(func_temp),nel,nel,ipos,xvec,yld_tref,dydx)
234 vartmp(1:nel,2) = ipos(1:nel,1)
235 vartmp(1:nel,3) = ipos(1:nel,2)
236 xvec(1:nel,2) = temp(1:nel)
237 CALL table_vinterp(table(func_temp),nel,nel,ipos,xvec,yld_temp,dydx)
238 tfac(1:nel) = yld_temp(1:nel) / yld_tref(1:nel)
239 yld(1:nel) = yld(1:nel) * tfac(1:nel)
240 hardp(1:nel) = hardp(1:nel) * tfac(1:nel)
241 ELSE
242 tfac(1:nel) = one
243 END IF
244
245
246
247
248 phi(1:nel) = svm(1:nel) - yld(1:nel)
249 nindx = 0
250 DO i=1,nel
251 IF (phi(i) >= zero .AND. off(i) == one) THEN
252 nindx = nindx + 1
253 index(nindx) = i
254 ENDIF
255 ENDDO
256
257
258
259
260
261
262 niter = 3
263
264 IF (nindx > 0) THEN
265
266
267 DO iter = 1,niter
268#include "vectorize.inc"
269
270 DO ii = 1, nindx
271 i = index(ii)
272
273
274
275
276
277
278
279
280
281
282
283
284
285 normxx(i) = three_half*sxx(i)/(
max(svm(i),em20))
286 normyy(i) = three_half*syy(i)/(
max(svm(i),em20))
287 normxy(i) = three*sxy(i)/(
max(svm(i),em20))
288
289
290
291
292
293
294 dfdsig2 = normxx(i) * (a11*normxx(i) + a12*normyy(i))
295 . + normyy(i) * (a11*normyy(i) + a12*normxx(i))
296 . + normxy(i) * normxy(i) * g
297
298
299
300 sig_dfdsig = signxx(i) * normxx(i)
301 . + signyy(i) * normyy(i)
302 . + signxy(i) * normxy(i)
303 dpla_dlam(i) = sig_dfdsig / yld(i)
304
305
306
307 dphi_dlam = - dfdsig2 - hardp(i)*dpla_dlam(i)
308 dphi_dlam = sign(
max(abs(dphi_dlam),em20),dphi_dlam)
309
310
311
312 dlam(i) = - phi(i) / dphi_dlam
313
314
315
316
317 ddep = dpla_dlam(i)*dlam(i)
318
319 dpla(i) =
max(dpla(i) + ddep,zero)
320
321 pla(i) = pla0(i) + dpla(i)
322
323 dpxx(i) = dlam(i)*normxx(i)
324 dpyy(i) = dlam(i)*normyy(i)
325 dpxy(i) = dlam(i)*normxy(i)
326
327 ENDDO
328
329
330
331 xvec(1:nel,1:2) = zero
332 ipos(1:nel,1:2) = 0
333 DO ii = 1, nindx
334 i = index(ii)
335 xvec(ii,1) = pla(i)
336 xvec(ii,2) = epsd(i)
337 ipos(ii,1) = vartmp(i,1)
338 ipos(ii,2) = 1
339 ENDDO
340 CALL table2d_vinterp_log(table(func_yld),ismooth,nel,nindx,ipos,xvec,yld_i,hardp_i,hardr_i)
341 DO ii = 1, nindx
342 i = index(ii)
343 vartmp(i,1) = ipos(ii,1)
344 hardp(i) = hardp_i(ii)*yscale*tfac(i)
345 yld(i) = yld_i(ii)*yscale*tfac(i)
346 ENDDO
347
348
349
350#include "vectorize.inc"
351 DO ii = 1, nindx
352 i = index(ii)
353
354
355 signxx(i) = signxx(i) - a11*dpxx(i) - a12*dpyy(i)
356 signyy(i) = signyy(i) - a12*dpxx(i) - a11*dpyy(i)
357 signxy(i) = signxy(i) - g*dpxy(i)
358
359
360 sigm(i) = (signxx(i) + signyy(i)) * third
361
362
363 sxx(i) = signxx(i) - sigm(i)
364 syy(i) = signyy(i) - sigm(i)
365 szz(i) = -sigm(i)
366 sxy(i) = signxy(i)
367
368
369 j2 = half*(sxx(i)**2 + syy(i)**2 + szz(i)**2 + two*sxy(i)**2)
370 svm(i) = sqrt(three*j2)
371
372
373 phi(i) = svm(i) - yld(i)
374
375
376 IF (inloc == 0) dezz(i) = dezz(i) - dpxx(i) - dpyy(i)
377
378 ENDDO
379
380 ENDDO
381
382
383
384
385
386
387 DO ii = 1, nindx
388 i = index(ii)
389 et(i) = hardp(i) / (hardp(i) + young)
390 ENDDO
391
392
393 IF (jthe == 0 .AND. eta > zero .AND. inloc == 0) THEN
394 DO ii = 1, nindx
395 i = index(ii)
396 temp(i) = temp(i) + ftherm(i)*yld(i)*dpla(i)
397 ENDDO
398 ENDIF
399 ENDIF
400
401
402
403 IF (inloc > 0) THEN
404 DO i = 1,nel
405 IF (loff(i) == one) THEN
406 dezz(i) = -
max(dplanl(i),zero)*half*(signxx(i)+signyy(i))/
max(yld(i),em20)
407 IF (jthe == 0 .AND. eta > zero) THEN
408 temp(i) = temp(i) + ftherm(i)*yld(i)*
max(dplanl(i),zero)
409 ENDIF
410 ENDIF
411 ENDDO
412 ENDIF
413
414
415
416 DO i=1,nel
417
418 seq(i) = svm(i)
419
420 soundsp(i) = sqrt(a11/rho(i))
421
422 sigy(i) = yld(i)
423
424 epsd(i) =
alpha*dpla(i)*dtinv + alphi*epsd(i)
425 uvar(i,1) = epsd(i)
426
427 dezz(i) = -nu*(signxx(i)-sigoxx(i)+signyy(i)-sigoyy(i))/young + dezz(i)
428 thk(i) = thk(i) + dezz(i)*thkly(i)*off(i)
429 ENDDO
430