31 1 NEL ,NUPARAM ,NUVAR ,MFUNC ,KFUNC ,
32 2 NPF ,TF ,TIME ,TIMESTEP ,UPARAM ,
33 3 EPSPXX ,EPSPYY ,EPSPXY ,EPSPYZ ,EPSPZX ,
34 4 DEPSXX ,DEPSYY ,DEPSXY ,DEPSYZ ,DEPSZX ,
35 5 SIGOXX ,SIGOYY ,SIGOXY ,SIGOYZ ,SIGOZX ,
36 6 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
37 7 SOUNDSP ,THK ,PLA ,UVAR ,RHO0 ,
38 8 OFF ,ETSE ,THKLY ,SHF ,YLD ,
39 9 HARDM ,SEQ ,EPSP ,ASRATE ,NVARTMP ,
40 A VARTMP ,DPLA ,INLOC ,DPLANL ,LOFF )
44#include "implicit_f.inc"
53 INTEGER NEL, NUPARAM, NUVAR,NVARTMP,INLOC
55 . TIME,TIMESTEP(NEL),UPARAM(NUPARAM),
56 . RHO0(NEL),THKLY(NEL),PLA(NEL),
57 . EPSPXX(NEL),EPSPYY(NEL),
58 . EPSPXY(NEL),EPSPYZ(NEL),EPSPZX(NEL),
59 . DEPSXX(),DEPSYY(NEL),
60 . DEPSXY(NEL),DEPSYZ(NEL),DEPSZX(NEL),
62 . SIGOXY(NEL),SIGOYZ(NEL),SIGOZX(NEL),
63 . shf(*),hardm(nel),seq(nel),dplanl(nel),
65 my_real,
DIMENSION(NEL),
INTENT(IN) :: loff
69 INTEGER,
INTENT(INOUT) :: VARTMP(NEL,NVARTMP)
71 . SIGNXX(NEL),SIGNYY(NEL),
72 . SIGNXY(NEL),SIGNYZ(NEL),SIGNZX(NEL),
73 . SOUNDSP(NEL),ETSE(NEL),(NEL)
78 . uvar(nel,nuvar),off(nel),thk(nel),yld(nel)
82 INTEGER NPF(*), MFUNC, KFUNC(MFUNC)
88 INTEGER I,II,J,NITER,ITER,NINDX,INDEX(MVSIZ),
90 . IAD1(MVSIZ),IPOS1(MVSIZ),ILEN1(MVSIZ),
91 . IAD2(MVSIZ),IPOS2(MVSIZ),ILEN2(MVSIZ)
93 . e11,e22,a11,a22,a12,g12,g13,g23,d13,d23,d33,invd33,
94 . ff,gg,hh,nn,sigy,qr1,cr1,qr2,cr2,nu12,nu13,nu23,
95 . fac,sighl(mvsiz),h(mvsiz),dydx1(mvsiz),dydx2(mvsiz),
96 . y1(mvsiz),y2(mvsiz),dezz(mvsiz),deelzz(mvsiz),
97 . dpxx(mvsiz),dpyy(mvsiz),dpzz(mvsiz),dpxy(mvsiz),
98 . normxx,normyy,normxy,dpla_dlam(mvsiz),dlam,
99 . dphi_dlam(mvsiz),phi(mvsiz),dav,deve1,deve2,
100 . deve3,deve4,dfdsig2,sig_dfdsig,ddep,dpdt
102 .
DIMENSION(:),
ALLOCATABLE :: rate, yfac
134 vp = nint(uparam(30))
139 ALLOCATE(rate(mfunc),yfac(mfunc))
141 rate(i) = uparam(30+i)
142 yfac(i) = uparam(30+mfunc+i)
149 IF (off(i) < one) off(i) = four_over_5*off(i)
150 IF (off(i) < em01) off(i) = zero
161 IF ((itab == 1).AND.(mfunc > 1))
THEN
166 ELSEIF (vp == 3)
THEN
167 dav = (epspxx(i)+epspyy(i))*third
168 deve1 = epspxx(i) - dav
169 deve2 = epspyy(i) - dav
171 deve4 = half*epspxy(i)
172 epsp(i) = half*(deve1**2 + deve2**2 + deve3**2) + deve4**2
173 epsp(i) = sqrt(three*epsp(i))/three_half
174 epsp(i) = asrate*epsp(i) + (one - asrate)*uvar(i,1)
180 IF (epsp(i) >= rate(j)) jj(i) = j
190 . + qr1*(one - exp(-cr1*pla(i)))
191 . + qr2*(one - exp(-cr2*pla(i)))
192 h(i) = qr1*cr1*exp(-cr1*pla(i)) + qr2*cr2*exp(-cr2*pla(i))
199 ipos1(1:nel) = vartmp(1:nel,1)
200 iad1(1:nel) = npf(kfunc(1)) / 2 + 1
201 ilen1(1:nel) = npf(kfunc(1)+1) / 2 - iad1(1:nel) - ipos1(1:nel)
203 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
205 vartmp(1:nel,1) = ipos1(1:nel)
207 yld(1:nel) = yfac(1)*y1(1:nel)
208 h(1:nel) = yfac(1)*dydx1(1:nel)
215 ipos1(i) = vartmp(i,j1)
216 iad1(i) = npf(kfunc(j1)) / 2 + 1
217 ilen1(i) = npf(kfunc(j1)+1) / 2 - iad1(i) - ipos1(i)
219 ipos2(i) = vartmp(i,j2)
220 iad2(i) = npf(kfunc(j2)) / 2 + 1
221 ilen2(i) = npf(kfunc(j2)+1) / 2 - iad2(i) - ipos2(i)
224 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
225 CALL vinter(tf,iad2,ipos2,ilen2,nel,pla,dydx2,y2)
231 y1(i) = y1(i)*yfac(j1)
232 y2(i) = y2(i)*yfac(j2)
233 fac = (epsp(i) - rate(j1))/(rate(j2) - rate(j1))
234 yld(i) = y1(i) + fac*(y2(i)-y1(i))
235 yld(i) =
max(yld(i),em20)
237 dydx1(i) = dydx1(i)*yfac(j1)
238 dydx2(i) = dydx2(i)*yfac(j2)
239 h(i) = dydx1(i)+fac*(dydx2(i)-dydx1(i))
241 vartmp(i,j1) = ipos1(i)
242 vartmp(i,j2) = ipos2(i)
253 signxx(i) = sigoxx(i) + a11*depsxx(i) + a12*depsyy(i)
254 signyy(i) = sigoyy(i) + a12*depsxx(i) + a22*depsyy(i)
255 signxy(i) = sigoxy(i) + g12*depsxy(i)
256 signyz(i) = sigoyz(i) + shf(i)*g23*depsyz(i)
257 signzx(i) = sigozx(i) + shf(i)*g13*depszx(i)
260 sighl(i) = (ff + hh)*signyy(i)**2 + (gg + hh)*signxx(i)**2
261 . - two*hh*signxx(i)*signyy(i) + two*nn*signxy(i)**2
262 sighl(i) = sqrt(
max(zero,sighl(i)))
269 phi(1:nel) = sighl(1:nel) - yld(1:nel)
274 IF ((phi(i)>zero).AND.(off(i) == one))
THEN
289#include "vectorize.inc"
294 ! note : in this part,
the purpose is to compute
for each iteration
307 normyy = (ff*signyy(i) + hh*(signyy(i)-signxx(i)))/(
max(sighl(i),em20))
308 normxy = two*nn*signxy(i)/(
max(sighl(i),em20))
315 dfdsig2 = normxx * (a11*normxx + a12*normyy)
316 . + normyy * (a12*normxx + a22*normyy)
317 . + normxy * normxy * g12
328 sig_dfdsig = signxx(i) * normxx
329 . + signyy(i) * normyy
330 . + signxy(i) * normxy
331 dpla_dlam(i) = sig_dfdsig /
max(yld(i),em20)
337 dphi_dlam(i) = - dfdsig2 - h(i)*dpla_dlam(i)
338 dphi_dlam(i) = sign(
max(abs(dphi_dlam(i)),em20) ,dphi_dlam(i))
341 dlam = -phi(i)/dphi_dlam(i)
344 dpxx(i) = dlam * normxx
345 dpyy(i) = dlam * normyy
346 dpxy(i) = dlam * normxy
349 signxx(i) = signxx(i) - (a11*dpxx(i) + a12*dpyy(i))
350 signyy(i) = signyy(i) - (a22*dpyy(i) + a12*dpxx(i))
351 signxy(i) = signxy(i) - dpxy(i)*g12
354 ddep = dlam*dpla_dlam(i)
355 dpla(i) =
max(zero, dpla(i) + ddep)
356 pla(i) = pla(i) + ddep
359 sighl(i) = (ff+hh)*signyy(i)**2 + (gg+hh)*signxx(i)**2
360 . - two*hh*signxx(i)*signyy(i) + two*nn*signxy(i)**2
361 sighl(i) = sqrt(
max(zero,sighl(i)))
364 dpzz(i) = dpzz(i) - (dpxx(i)+dpyy(i))
370 . + qr1*(one - exp(-cr1*pla(i)))
371 . + qr2*(one - exp(-cr2*pla(i)))
372 h(i) = qr1*cr1*exp(-cr1*pla(i)) + qr2*cr2*exp(-cr2*pla(i))
375 phi(i) = sighl(i) - yld(i)
386 ipos1(1:nel) = vartmp(1:nel,1)
387 iad1(1:nel) = npf(kfunc(1)) / 2 + 1
388 ilen1(1:nel) = npf(kfunc(1)+1) / 2 - iad1(1:nel) - ipos1(1:nel)
390 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
392 vartmp(1:nel,1) = ipos1(1:nel)
394 yld(1:nel) = yfac(1)*y1(1:nel)
395 h(1:nel) = yfac(1)*dydx1(1:nel)
397 phi(1:nel) = sighl(1:nel) - yld(1:nel)
404 ipos1(i) = vartmp(i,j1)
405 iad1(i) = npf(kfunc(j1)) / 2 + 1
406 ilen1(i) = npf(kfunc(j1)+1) / 2 - iad1(i) - ipos1(i)
408 ipos2(i) = vartmp(i,j2)
409 iad2(i) = npf(kfunc(j2)) / 2 + 1
410 ilen2(i) = npf(kfunc(j2)+1) / 2 - iad2(i) - ipos2(i)
413 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
414 CALL vinter(tf,iad2,ipos2,ilen2,nel,pla,dydx2,y2)
420 y1(i) = y1(i)*yfac(j1)
421 y2(i) = y2(i)*yfac(j2)
422 fac = (epsp(i) - rate(j1))/(rate(j2) - rate(j1))
423 yld(i) = y1(i) + fac*(y2(i)-y1(i))
424 yld(i) =
max(yld(i),em20)
426 dydx1(i) = dydx1(i)*yfac(j1)
427 dydx2(i) = dydx2(i)*yfac(j2)
428 h(i) = dydx1(i)+fac*(dydx2(i)-dydx1(i))
430 vartmp(i,j1) = ipos1(i)
431 vartmp(i,j2) = ipos2(i)
433 phi(i) = sighl(i) - yld(i)
439 !
End of the loop over the iterations
449 soundsp(i) = sqrt(
max(a11,a22)/rho0(i))
451 IF (dpla(i)>zero)
THEN
453 etse(i) = h(i) / (h(i) +
max(e11,e22))
459 invd33 = one/
max(em20,d33)
460 deelzz(i) = -(nu13/e11)*(signxx(i)-sigoxx(i)) -(nu23/e22)*(signyy(i)-sigoyy(i))
461 IF ((inloc > 0).AND.(loff(i) == one))
THEN
462 normxx = (gg*signxx(i) + hh*(signxx(i)-signyy(i)))/(
max(sighl(i),em20))
463 normyy = (ff*signyy(i) + hh*(signyy(i)-signxx(i)))/(
max(sighl(i),em20))
464 normxy = two*nn*signxy(i)/(
max(sighl(i),em20))
465 dpzz(i) = -
max(dplanl(i),zero)*(normxx + normyy)
467 dezz(i) = deelzz(i) + dpzz(i)
468 thk(i) = thk(i) + dezz(i)*thkly(i)*off(i)
470 IF ((itab == 1).AND.(mfunc > 1).AND.(vp == 1))
THEN
471 dpdt = dpla(i)/
max(em20,timestep(i))
472 uvar(i,1) = asrate * dpdt + (one - asrate) * uvar(i,1)
476 IF (
ALLOCATED(rate))
DEALLOCATE(rate)
477 IF (
ALLOCATED(yfac))
DEALLOCATE(yfac)
subroutine sigeps93c(nel, nuparam, nuvar, mfunc, kfunc, npf, tf, time, timestep, uparam, epspxx, epspyy, epspxy, epspyz, epspzx, depsxx, depsyy, depsxy, depsyz, depszx, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, signxx, signyy, signxy, signyz, signzx, soundsp, thk, pla, uvar, rho0, off, etse, thkly, shf, yld, hardm, seq, epsp, asrate, nvartmp, vartmp, dpla, inloc, dplanl, loff)