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