31 1 NEL ,NUPARAM,NUVAR ,MFUNC ,KFUNC ,
32 2 NPF ,TF ,TIME ,TIMESTEP,UPARAM ,
33 2 RHO0 ,THKLY ,OFF ,ETSE ,EPSD_PG,
34 3 EPSPXX ,EPSPYY ,EPSPXY ,EPSPYZ ,EPSPZX ,
35 4 DEPSXX ,DEPSYY ,DEPSXY ,DEPSYZ ,DEPSZX ,
36 5 EPSXX ,EPSYY ,EPSXY ,EPSYZ ,EPSZX ,
37 6 SIGOXX ,SIGOYY ,SIGOXY ,SIGOYZ ,SIGOZX ,
38 7 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
39 8 SOUNDSP ,VISCMAX,THK ,PLA ,UVAR ,
40 9 GS ,YLD ,EPSP ,DPLA_I ,ASRATE ,
41 A NVARTMP ,VARTMP ,SIGP ,INLOC ,DPLANL ,
46#include "implicit_f.inc"
95 INTEGER ,
INTENT(IN) :: NEL,NUPARAM, NUVAR,NVARTMP,INLOC
96 my_real ,
INTENT(IN) :: TIME,TIMESTEP,ASRATE
97 my_real ,
DIMENSION(NUPARAM) ,
INTENT(IN) :: UPARAM
98 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: EPSD_PG
99 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: RHO0,THKLY,GS,DPLANL,
100 . EPSPXX,EPSPYY,EPSPXY,EPSPYZ,EPSPZX,
101 . DEPSXX,DEPSYY,DEPSXY,DEPSYZ,DEPSZX,
102 . EPSXX ,EPSYY ,EPSXY ,EPSYZ ,EPSZX ,
103 . SIGOXX,SIGOYY,SIGOXY,SIGOYZ,SIGOZX
104 INTEGER ,
INTENT(IN) :: NPF(*),MFUNC,KFUNC(MFUNC)
105 my_real ,
INTENT(IN) :: TF(*)
106 my_real ,
DIMENSION(NEL),
INTENT(IN) :: LOFF
107 my_real ,
DIMENSION(NEL),
INTENT(INOUT) :: epsp
111 my_real ,
DIMENSION(NEL) ,
INTENT(OUT) :: soundsp,viscmax,etse,
112 . signxx,signyy,signxy,signyz,signzx,dpla_i
116 INTEGER ,
DIMENSION(NEL,NVARTMP) ,
INTENT(INOUT) :: VARTMP
117 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: pla,off,thk,yld
118 my_real ,
DIMENSION(NEL,3) ,
INTENT(INOUT) :: sigp
119 my_real ,
DIMENSION(NEL,NUVAR) ,
INTENT(INOUT) :: uvar
123 INTEGER :: I,J,N,NINDX,NMAX,IADBUF,ICC1,ISRATE,VFLAG
124 my_real :: R,UMR,NUX,A,B,C,S11,S22,S12,P,P2,DEZZ,
125 . SIGZ,S1,S2,S3,VM2,EPST,F,DF,Q2,YLD_I,E1,A11,A21,
126 . G1,G31,NNU11,NU11,,NU31,DEVE1,DEVE2,DEVE3,DEVE4,DPDT,
127 . EPSM1,EPSR11,EPSR21,FISOKIN1,CA1,CB1,CN1,CC1,CP1,
128 . dsxx,dsyy,dsxy,dexx,deyy,dexy,
alpha,yscale,dav
129 INTEGER ,
DIMENSION(MVSIZ) :: INDEX,IPOS,ILEN,IAD,IPOS0
130 my_real ,
DIMENSION(MVSIZ) :: svm,dr,aa,bb,dpla_j,pp,qq,fail,h,hs,
131 . ylo,
zeror,sigexx,sigeyy,sigexy,sigm,epsgm,dfdpla
132 my_real,
DIMENSION(MVSIZ) :: rq
146 icc1 = nint(uparam(10))
149 fisokin1 = uparam(15)
154 israte = nint(uparam(13))
155 vflag = nint(uparam(23))
158 nnu11 = nux / (one - nux)
164 epsgm(i) = uparam(22)
171 iad(1:nel) = npf(kfunc(1)) / 2 + 1
172 ilen(1:nel) = npf(kfunc(1)+1) / 2 - iad(1:nel) - ipos0(1:nel)
174 ylo(1:nel) = yscale * ylo(1:nel)
179 IF (fisokin1 > zero)
THEN
180 signxx(1:nel) = sigoxx(1:nel) - sigp(1:nel,1) + a11*depsxx(1:nel) + a21*depsyy(1:nel)
181 signyy(1:nel) = sigoyy(1:nel) - sigp(1:nel,2) + a21*depsxx(1:nel) + a11*depsyy(1:nel)
182 signxy(1:nel) = sigoxy(1:nel) - sigp(1:nel,3) + g1 *depsxy(1:nel)
184 signxx(1:nel) = sigoxx(1:nel) + a11*depsxx(1:nel) + a21*depsyy(1:nel)
185 signyy(1:nel) = sigoyy(1:nel) + a21*depsxx(1:nel) + a11*depsyy(1:nel)
186 signxy(1:nel) = sigoxy(1:nel) + g1 *depsxy(1:nel)
188 signyz(1:nel) = sigoyz(1:nel) + gs(1:nel) * depsyz(1:nel)
189 signzx(1:nel) = sigozx(1:nel) + gs(1:nel) * depszx(1:nel)
190 sigexx(1:nel) = signxx(1:nel)
191 sigeyy(1:nel) = signyy(1:nel)
192 sigexy(1:nel) = signxy(1:nel)
194 soundsp(1:nel) = sqrt(a11/rho0(1:nel))
195 viscmax(1:nel) = zero
201 epsp(1:nel) = uvar(1:nel,1)
206 dav = (epspxx(i)+epspyy(i))*third
207 deve1 = epspxx(i) - dav
208 deve2 = epspyy(i) - dav
210 deve4 = half*epspxy(i)
211 epsp(i) = half*(deve1**2 + deve2**2 + deve3**2) + deve4**2
212 epsp(i) = sqrt(three*epsp(i))/three_half
213 epsp(i) = asrate*epsp(i) + (one - asrate)*uvar(i,1)
216 ELSEIF (vflag == 2)
THEN
218 epsp(i) = asrate*epsd_pg(i) + (one - asrate)*uvar(i,1)
222 ELSEIF (israte == 0)
THEN
225 dav = (epspxx(i)+epspyy(i))*third
226 deve1 = epspxx(i) - dav
227 deve2 = epspyy(i) - dav
229 deve4 = half*epspxy(i)
230 epsp(i) = half*(deve1**2 + deve2**2 + deve3**2) + deve4**2
234 ELSEIF (vflag == 2)
THEN
236 epsp(i) = half*( abs(epspxx(i)+epspyy(i))
237 . + sqrt( (epspxx(i)-epspyy(i))*(epspxx(i)-epspyy(i))
238 . + epspxy(i)*epspxy(i) ) )
247 epst = half*( epsxx(i)+epsyy(i)
248 . + sqrt( (epsxx(i)-epsyy(i))*(epsxx(i)-epsyy(i))
249 . + epsxy(i)*epsxy(i) ) )
250 fail(i) =
max(zero,
min(one,(epsr21-epst)/(epsr21-epsr11)))
258 ipos(1:nel) = vartmp(1:nel,1)
259 iad(1:nel) = npf(kfunc(1)) / 2 + 1
260 ilen(1:nel) = npf(kfunc(1)+1) / 2 - iad(1:nel) - ipos(1:nel)
261 CALL vinter(tf,iad,ipos,ilen,nel,pla,dfdpla,yld)
262 vartmp(1:nel,1) = ipos(1:nel)
266 IF(cc1 /= zero) rq(1:nel) = one + (cc1*epsp(1:nel))**cp1
268 IF((mfunc > 0) .AND. (ca1 == zero))
THEN
270 ylo(i) = ylo(i) * rq(i)
271 IF (pla(i)>zero)
THEN
272 yld(i) = yscale * yld(i) * rq(i)
273 hs(i) = yscale * dfdpla(i) * rq(i)
275 yld(i) = yscale * yld(i) * rq(i)
280 ELSEIF ((mfunc > 0) .AND. (ca1 /= zero))
THEN
283 ylo(i) = ylo(i) + ca1 * (rq(i)-one)
284 IF (pla(i)>zero)
THEN
286 yld(i) = yscale * yld(i) + (ca1 + cb1*pla(i)) * (rq(i)-one)
287 hs(i) = yscale * dfdpla(i) + cb1 * (rq(i)-one)
289 yld(i) = yscale * yld(i) + (ca1 + cb1*pla(i)**cn1) * (rq(i)-one)
291 hs(i) = yscale * dfdpla(i) + cn1*cb1*(rq(i)-one) * (pla(i)**(cn1-one))
293 hs(i) = yscale * dfdpla(i) + cn1*cb1*(rq(i)-one) / ((pla(i)**(one-cn1)))
297 yld(i) = yscale * yld(i) + ca1 * (rq(i)-one)
305 IF (pla(i)>zero)
THEN
307 yld(i) = (ca1 + cb1*pla(i)) * rq(i)
312 hs(i) = cn1*cb1*rq(i) * (pla(i)**(cn1-one))
314 hs(i) = cn1*cb1*rq(i) / ((pla(i)**(one-cn1)))
325 IF(icc1 == 1) sigm(i) = sigm(i) * rq(i)
326 IF (icc1 /= 1 .and. cn1 /= zero .and. cb1 /= zero)
327 & epsgm(i)=((sigm(i)/rq(i)-ca1)/cb1)**(one/cn1)
328 IF (pla(i)>=epsgm(i))
THEN
332 hs(i) = fail(i)*hs(i)
334 yld(i)= fail(i)*((one-fisokin1)*yld(i)+fisokin1*ylo(i))
335 yld(i) =
max(yld(i),em20)
342 s1=signxx(i)+signyy(i)
343 s2=signxx(i)-signyy(i)
346 bb(i)=three_over_4*s2*s2+3.*s3*s3
347 svm(i)=sqrt(aa(i)+bb(i))
349 dezz = -(depsxx(i)+depsyy(i))*nnu11
350 thk(i) = thk(i) + dezz*thkly(i)*off(i)
358 IF ((svm(i) > yld(i)).AND.(off(i) == one))
THEN
367#include "vectorize.inc"
370 hs(i) =
max(zero,hs(i))
371 dpla_j(i)=(svm(i)-yld(i))/(g31+hs(i))
372 etse(i)= hs(i)/(hs(i)+e1)
373 h(i) = hs(i)*(one-fisokin1)
377#include "vectorize.inc"
381 yld_i =yld(i)+h(i)*dpla_i(i)
382 dr(i) =half*e1*dpla_i(i)/yld_i
383 pp(i) =one/(one + dr(i)*nu11)
384 qq(i) =one/(one + three*dr(i)*nu21)
387 f =aa(i)*p2+bb(i)*q2-yld_i*yld_i
388 df=-(aa(i)*nu11*p2*pp(i)+ three*bb(i)*nu21*q2*qq(i))
389 . *(e1-two*dr(i)*h(i))/yld_i
391 df = sign(
max(abs(df),em20),df)
392 IF(dpla_i(i)>zero)
THEN
393 dpla_j(i)=
max(zero,dpla_i(i)-f/df)
402#include "vectorize.inc"
405 pla(i) = pla(i) + dpla_i(i)
406 s1=(signxx(i)+signyy(i))*pp(i)
407 s2=(signxx(i)-signyy(i))*qq(i)
408 signxx(i)=half*(s1+s2)
409 signyy(i)=half*(s1-s2)
410 signxy(i)=signxy(i)*qq(i)
412 dezz = - nu31*dr(i)*s1/e1
413 thk(i) = thk(i) + dezz*thkly(i)*off(i)
420 IF ((pla(i) > epsm1).AND.(off(i) == one)) off(i) = four_over_5
422 dpdt = dpla_i(i)/
max(em20,timestep)
423 uvar(i,1) = asrate * dpdt + (one - asrate) * uvar(i,1)
430 IF (fisokin1 > zero)
THEN
432 dsxx = sigexx(i) - signxx(i)
433 dsyy = sigeyy(i) - signyy(i)
434 dsxy = sigexy(i) - signxy(i)
435 dexx = (dsxx - nux*dsyy)
436 deyy = (dsyy - nux*dsxx)
437 dexy = two*(one+nux)*dsxy
438 alpha = fisokin1*hs(i)/(e1+hs(i)) * third
439 signxx(i) = signxx(i) + sigp(i,1)
440 signyy(i) = signyy(i) + sigp(i,2)
441 signxy(i) = signxy(i) + sigp(i,3)
442 sigp(i,1) = sigp(i,1) +
alpha*(four*dexx+two*deyy)
443 sigp(i,2) = sigp(i,2) +
alpha*(four*deyy+two*dexx)
444 sigp(i,3) = sigp(i,3) +
alpha*dexy
452 IF (loff(i) == one)
THEN
453 svm(i) = sqrt(signxx(i)*signxx(i)
454 . + signyy(i)*signyy(i)
455 . - signxx(i)*signyy(i)
456 . + three*signxy(i)*signxy(i))
457 dezz =
max(dplanl(i),zero)*half*(signxx(i)+signyy(i))/
max(svm(i),em20)
458 dezz = -nux*((signxx(i)-sigoxx(i)+signyy(i)-sigoyy(i))/e1) - dezz
459 thk(i) = thk(i) + dezz*thkly(i)*off(i)
subroutine sigeps44c(nel, nuparam, nuvar, mfunc, kfunc, npf, tf, time, timestep, uparam, rho0, thkly, off, etse, epsd_pg, epspxx, epspyy, epspxy, epspyz, epspzx, depsxx, depsyy, depsxy, depsyz, depszx, epsxx, epsyy, epsxy, epsyz, epszx, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, signxx, signyy, signxy, signyz, signzx, soundsp, viscmax, thk, pla, uvar, gs, yld, epsp, dpla_i, asrate, nvartmp, vartmp, sigp, inloc, dplanl, loff)