33 1 NEL ,NUPARAM,NUVAR ,MFUNC ,KFUNC ,
34 2 NPF ,TF ,TIME ,TIMESTEP,UPARAM ,
35 3 RHO0 ,RHO ,VOLUME ,EINT ,
36 4 EPSPXX ,EPSPYY ,EPSPZZ ,EPSPXY ,EPSPYZ ,EPSPZX ,
37 5 DEPSXX ,DEPSYY ,DEPSZZ ,DEPSXY ,DEPSYZ ,DEPSZX ,
38 6 EPSXX ,EPSYY ,EPSZZ ,EPSXY ,EPSYZ ,EPSZX ,
39 7 SIGOXX ,SIGOYY ,SIGOZZ ,SIGOXY ,SIGOYZ ,SIGOZX ,
40 8 SIGNXX ,SIGNYY ,SIGNZZ ,SIGNXY ,SIGNYZ ,SIGNZX ,
41 9 SOUNDSP,VISCMAX,UVAR ,OFF ,NGL ,IPM ,
42 A MAT ,EPSP ,IPLA ,YLD ,PLA , ETSE ,
47#include "implicit_f.inc"
96 INTEGER NEL, NUPARAM, NUVAR,IPLA,
97 . NGL(NEL),MAT(NEL),(NPROPMI,*)
100 . RHO(NEL),RHO0(NEL),VOLUME(NEL),EINT(NEL),
101 . EPSPXX(NEL),EPSPYY(NEL),EPSPZZ(NEL),
102 . EPSPXY(NEL),EPSPYZ(NEL),EPSPZX(NEL),
103 . DEPSXX(NEL),DEPSYY(NEL),DEPSZZ(),
104 . DEPSXY(NEL),DEPSYZ(NEL),DEPSZX(NEL),
105 . EPSXX(NEL) ,EPSYY(NEL) ,EPSZZ(NEL) ,
106 . EPSXY(NEL) ,EPSYZ(NEL) ,EPSZX(NEL) ,
107 . sigoxx(nel),sigoyy(nel),sigozz(nel),
109 . signxx(nel),signyy(nel),signzz(nel),
110 . signxy(nel),signyz(nel),signzx(nel),
111 . epsp(nel),etse(nel),amu(nel)
116 . soundsp(nel),viscmax(nel)
121 . uvar(nel,nuvar), off(nel), yld(nel),pla(nel)
125 INTEGER NPF(*), MFUNC, KFUNC(MFUNC)
127 . finter,finter2, tf(*)
128 EXTERNAL finter,finter2
140 INTEGER I,J,J1,J2,,IYLDT,IRATE,NCC,NCT,NFUNC,VP,IADBUF
141 INTEGER (NEL),IAD1(NEL), ILEN1(NEL),
142 . IPOS2(),IAD2(NEL), ILEN2(NEL),IFUNC(),
144 my_real ET, EC, C1T, GT,NU, CP, PC,PT,RPCT,EPSP0,
145 . DAV,DPLA,FAC,EPD,VM,
146 . R,FISOKIN,YRATE,HKIN ,SIGPXX,SIGPYY,
147 . SIGPZZ,SIGPXY,SIGPYZ,SIGPZX,DSXX,DSYY,DSZZ,
148 . DSXY,DSYZ,DSZX,DF,SIGY,DTINV
149 my_real ,
DIMENSION(MFUNC):: YFAC,RATE0
150 my_real ,
DIMENSION(NEL) ::
151 . yc ,yt ,h ,dydx2 ,dydx1 ,dpla1 ,
152 . p0 ,p ,hc ,ht ,rate ,
alpha,
153 . y1 ,y2 ,e ,c1 ,g , g2 ,g3,
154 . sigexx ,sigeyy ,sigezz ,sigexy ,sigeyz ,sigezx
163 iadbuf = ipm(7,mat(1))
164 irate = nint(uparam(iadbuf ))
165 et = uparam(iadbuf +1)
166 gt = uparam(iadbuf +4)
168 nu = uparam(iadbuf +5)
169 pc = uparam(iadbuf +6)
170 pt = uparam(iadbuf +7)
171 epsp0 = uparam(iadbuf +8)
172 cp = uparam(iadbuf +9)
173 ncc = nint(uparam(iadbuf + 10))
174 nct = nint(uparam(iadbuf + 11))
175 fisokin = uparam(iadbuf + 12)
178 nfunc = ipm(10,mat(1))
180 ifunc(i) = ipm(10+i,mat(1))
181 yfac(i) = uparam(iadbuf + 12 + i )
182 rate0(i) = uparam(iadbuf + 12 + nfunc + i )
185 sigy = uparam(iadbuf + 13 + 2*mfunc)
186 vp = nint(uparam(iadbuf + 14 + 2*mfunc))
187 ec = uparam(iadbuf + 15 + 2*mfunc)
188 rpct = uparam(iadbuf + 16 + 2*mfunc)
210 c1t = et/three/(one - two*nu)
215 c1t =
max(c1t,ec/three/(one - two*nu))
216 IF(pc == zero .and. pt == zero .AND. abs(p(i)) < em10)
THEN
218 ELSEIF(p(i) <= - rpct * pt)
THEN
220 ELSEIF(p(i) >= rpct *pc)
THEN
223 fac = rpct *(pc + pt)
224 fac = (rpct * pc - p(i))/fac
225 e(i) = fac*et + (one -fac)*ec
230 g(i) = half*e(i)/( one + nu)
233 c1(i) = e(i)/three/(one - two*nu)
239 IF (fisokin > zero )
THEN
241 sigoxx(i) = sigoxx(i) - uvar(i, 2)
242 sigoyy(i) = sigoyy(i) - uvar(i, 3)
243 sigozz(i) = sigozz(i) - uvar(i, 4)
244 sigoxy(i) = sigoxy(i) - uvar(i, 5)
245 sigoyz(i) = sigoyz(i) - uvar(i, 6)
246 sigozx(i) = sigozx(i) - uvar(i, 7)
252 p0(i) = -(sigoxx(i)+sigoyy(i)+sigozz(i))*third
253 dav = (depsxx(i)+depsyy(i)+depszz(i))*third
254 signxx(i)=sigoxx(i) + p0(i) + g2(i)*(depsxx(i)-dav)
255 signyy(i)=sigoyy(i) + p0(i) + g2(i)*(depsyy(i)-dav)
256 signzz(i)=sigozz(i) + p0(i) + g2(i)*(depszz(i)-dav)
257 signxy(i)=sigoxy(i) + g(i) *depsxy(i)
258 signyz(i)=sigoyz(i) + g(i) *depsyz(i)
259 signzx(i)=sigozx(i) + g(i) *depszx(i)
261 soundsp(i) = sqrt((c1t + four*g(i)/three)/rho0(i))
264 sigexx(i) = signxx(i)
265 sigeyy(i) = signyy(i)
266 sigezz(i) = signzz(i)
267 sigexy(i) = signxy(i)
269 sigezx(i) = signzx(i)
279 ipos1(i) = nint(uvar(i,8))
280 iad1(i) = npf(ifunc(1)) / 2+ 1
282 ipos2(i) = nint(uvar(i,9))
283 iad2(i) = npf(ifunc(2)) / 2 + 1
284 ilen2(i) = npf(ifunc(2) + 1) / 2 - iad2(i)-ipos2(i)
291 CALL vinter(tf,iad2,ipos2,ilen2,nel,pla,dydx2,yt)
293 IF(fisokin == zero)
THEN
297 hc(i)=dydx1(i)*yfac(1)
298 ht(i)=dydx2(i)*yfac(2)
300 ELSEIF(fisokin == one )
THEN
302 hc(i)=dydx1(i)*yfac(1)
303 ht(i)=dydx2(i)*yfac(2)
304 yc(i)=tf(npf(ifunc(1)) + 1)
305 yt(i)=tf(npf(ifunc(2)) + 1)
308 yc(i) =
max(em20, yc(i))
309 yt(i) =
max(em20, yt(i))
315 yc(i) =
max(yc(i),em20)
316 yt(i) =
max(yt(i),em20)
317 hc(i) = dydx1(i)*yfac(1)
318 ht(i) = dydx2(i)*yfac(2)
320 y1(i)=yfac(1)*tf(npf(ifunc(1))+1)
321 y2(i)=yfac(2)*tf(npf(ifunc(2))+1)
322 yc(i) = (one - fisokin) * yc(i) + fisokin * y1(i)
323 yt(i) = (one - fisokin) * yt(i) + fisokin * y2(i)
332 IF(epsp(i) >= rate0(j))jjc(i) = j
337 rate(i)=(epsp(i) - fac)/(rate0(jjc(i)+1 ) - fac)
342 ipos1(i) = nint(uvar(i,7+j1 ))
343 iad1(i) = npf(ifunc(j1)) / 2 + 1
344 ilen1(i) = npf(ifunc(j1)+1) / 2 - iad1(i)-ipos1(i)
345 ipos2(i) = nint(uvar(i,7+j2))
346 iad2(i) = npf(ifunc(j2)) / 2 + 1
347 ilen2(i) = npf(ifunc(j2)+1) / 2 - iad2(i)-ipos2(i)
349 uvar(i,7+j1) = ipos1(i)
350 uvar(i,7+j2) = ipos2(i)
352 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
353 CALL vinter(tf,iad2,ipos2,ilen2,nel,pla,dydx2,y2)
355 IF (fisokin == zero)
THEN
362 yc(i) =(y1(i) + fac*(y2(i)-y1(i)))
363 yc(i) =
max(yc(i),em20)
364 dydx1(i)=dydx1(i)*yfac(j1)
365 dydx2(i)=dydx2(i)*yfac(j2)
366 hc(i) = (dydx1(i) + fac*(dydx2(i)-dydx1(i)))
368 ELSEIF (fisokin == one )
THEN
373 dydx1(i)=dydx1(i)*yfac(j1)
374 dydx2(i)=dydx2(i)*yfac(j2)
375 hc(i) =(dydx1(i) + fac*(dydx2(i)-dydx1(i)))
377 y1(i)=yfac(j1)*tf(npf(ifunc(j1)) + 1)
378 y2(i)=yfac(j2)*tf(npf(ifunc(j2)) + 1)
379 yc(i) = (y1(i) + fac*(y2(i)-y1(i)))
380 yc(i) =
max(em20,yc(i))
389 yc(i) = (y1(i) + fac*(y2(i)-y1(i)))
390 yc(i) =
max(yc(i),em20)
391 dydx1(i)=dydx1(i)*yfac(j1)
392 dydx2(i)=dydx2(i)*yfac(j2)
393 hc(i) = (dydx1(i) + fac*(dydx2(i)-dydx1(i)))
395 y1(i)=yfac(j1)*tf(npf(ifunc(j1))+1)
396 y2(i)=yfac(j2)*tf(npf(ifunc(j2))+1)
397 yc(i) = (one - fisokin) * yc(i) +
398 . fisokin * (y1(i) + fac*(y2(i)-y1(i)))
406 IF (epsp(i)>=rate0(ncc + j))jjt(i)=ncc+j
411 rate(i)=(epsp(i) - fac)/( rate0(jjt(i)+1)- fac)
416 ipos1(i) = nint(uvar(i,7+j1))
417 iad1(i) = npf(ifunc(j1)) / 2 + 1
418 ilen1(i) = npf(ifunc(j1)+1) / 2 - iad1(i)-ipos1(i)
419 ipos2(i) = nint(uvar(i,7+j2))
420 iad2(i) = npf(ifunc(j2)) / 2 + 1
421 ilen2(i) = npf(ifunc(j2)+1) / 2 - iad2(i)-ipos2(i)
423 uvar(i,7+j1) = ipos1(i)
424 uvar(i,7+j2) = ipos2(i)
426 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
427 CALL vinter(tf,iad2,ipos2,ilen2,nel,pla,dydx2,y2)
429 IF (fisokin == zero)
THEN
436 yt(i) =(y1(i) + fac*(y2(i)-y1(i)))
437 yt(i) =
max(yt(i),em20)
438 dydx1(i)=dydx1(i)*yfac(j1)
439 dydx2(i)=dydx2(i)*yfac(j2)
440 ht(i) = (dydx1(i) + fac*(dydx2(i)-dydx1(i)))
442 ELSEIF (fisokin == one )
THEN
447 dydx1(i)=dydx1(i)*yfac(j1)
448 dydx2(i)=dydx2(i)*yfac(j2)
449 ht(i) =(dydx1(i) + fac*(dydx2(i)-dydx1(i)))
451 y1(i)=yfac(j1)*tf(npf(ifunc(j1)) + 1)
452 y2(i)=yfac(j2)*tf(npf(ifunc(j2)) + 1)
453 yt(i) = (y1(i) + fac*(y2(i)-y1(i)))
454 yt(i) =
max(em20,yt(i))
463 yt(i) = (y1(i) + fac*(y2(i)-y1(i)))
464 yt(i) =
max(yt(i),em20)
465 dydx1(i)=dydx1(i)*yfac(j1)
466 dydx2(i)=dydx2(i)*yfac(j2)
467 ht(i) = (dydx1(i) + fac*(dydx2(i)-dydx1(i)))
469 y1(i)=yfac(j1)*tf(npf(ifunc(j1))+1)
470 y2(i)=yfac(j2)*tf(npf(ifunc(j2))+1)
471 yt(i) = (one - fisokin) * yt(i) +
472 . fisokin * (y1(i) + fac*(y2(i)-y1(i)))
481 yrate = yfac(3)*finter(ifunc(3),epsp(i),npf,tf,df)
485 yrate = yfac(4)*finter(ifunc(4),epsp(i),npf,tf,df)
493 p(i) = c1(i) * amu(i)
494 IF(pc == zero .AND. pt == zero .AND. abs(p(i)) < em10)
THEN
495 yld(i) =
max(yc(i), em20)
497 ELSEIF(p(i) <= -pt)
THEN
498 yld(i) =
max(yt(i),em20)
500 ELSEIF(p(i) >= pc)
THEN
501 yld(i) =
max(yc(i), em20)
505 fac = (pc - p(i))/fac
506 yld(i) = fac*yt(i) + (one -fac)*yc(i)
507 yld(i) =
max(em20,yld(i))
508 h(i) = fac*ht(i) + (one -fac)*hc(i)
520 epd =
max(em20,epsp(i)/epsp0)
521 yrate = one + exp(cp*log(epd))
522 yld(i) = yld(i)*yrate
526 ELSEIF(irate == 2)
THEN
528 epd =
max(em20,epsp(i)/epsp0)
529 yrate = one + cp*log(epd)
530 yld(i) = yld(i)*yrate
541 dtinv = timestep/
max(em20, timestep**2)
543 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
544 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
546 r =
min(one,yld(i)/
max(vm,em20))
547 epd = (one - r)*vm/
max(g3(i)+h(i),em20)
549 epd =
max(em20,epd/epsp0)
550 yrate = one + exp(cp*log(epd))
551 IF(sigy == zero)
THEN
552 yld(i) = yld(i)*yrate
555 yld(i) = yld(i) + sigy*(yrate - one)
561 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
562 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
564 r =
min(one,yld(i)/
max(vm,em20))
565 signxx(i)=signxx(i)*r-p(i)
566 signyy(i)=signyy(i)*r-p(i)
567 signzz(i)=signzz(i)*r-p(i)
568 signxy(i)=signxy(i)*r
569 signyz(i)=signyz(i)*r
570 signzx(i)=signzx(i)*r
571 pla(i)=pla(i) + (one - r)*vm/
max(g3(i) + h(i),em20)
573 dpla1(i) = (one - r)*vm/
max(g3(i)+h(i),em20)
578 dtinv = timestep/
max(em20, timestep**2)
580 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
581 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
583 r =
min(one,yld(i)/
max(vm,em20))
584 epd = (one-r)*vm/
max(g3(i),em20)
586 epd =
max(em20,epd/epsp0)
587 yrate = one + exp(cp*log(epd))
588 IF(sigy == zero)
THEN
589 yld(i) = yld(i)*yrate
592 yld(i) = yld(i) + sigy*(yrate - one)
597 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
598 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
600 r =
min(one,yld(i)/
max(vm,em20))
601 signxx(i)=signxx(i)*r-p(i)
602 signyy(i)=signyy(i)*r-p(i)
603 signzz(i)=signzz(i)*r-p(i)
604 signxy(i)=signxy(i)*r
605 signyz(i)=signyz(i)*r
606 signzx(i)=signzx(i)*r
607 pla(i)=pla(i) + (one-r)*vm/
max(g3(i),em20)
609 dpla1(i) = (one-r)*vm/
max(g3(i),em20)
611 ELSEIF (ipla == 1)
THEN
614 dtinv = timestep/
max(em20, timestep**2)
616 vm = half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
617 . + signxy(i)**2+signyz(i)**2+signzx(i)**2
619 r =
min(one,yld(i)/
max(vm,em20))
621 epd = (one - r)*vm/
max(g3(i)+h(i),em20)
623 epd =
max(em20,epd/epsp0)
624 yrate = one + exp(cp*log(epd))
625 IF (sigy == zero)
THEN
626 yld(i) = yld(i)*yrate
629 yld(i) = yld(i) + sigy*(yrate - one)
635 vm = three*(half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
636 . + signxy(i)**2+signyz(i)**2+signzx(i)**2)
637 IF (vm > yld(i)*yld(i))
THEN
641 dpla = (one - r)*vm /
max(g3(i)+h(i),em20)
643 yld(i) =
max(yld(i) + (one-fisokin)*dpla*h(i), zero)
644 r =
min(one, yld(i) / vm)
646 signxx(i) = signxx(i)*r
647 signyy(i) = signyy(i)*r
648 signzz(i) = signzz(i)*r
649 signxy(i) = signxy(i)*r
650 signyz(i) = signyz(i)*r
651 signzx(i) = signzx(i)*r
652 pla(i) = pla(i) + dpla
659 signxx(i) = signxx(i) - p(i)
660 signyy(i) = signyy(i) - p(i)
661 signzz(i) = signzz(i) - p(i)
670 IF(fisokin > zero)
THEN
672 dsxx = sigexx(i) - signxx(i) - p(i)
673 dsyy = sigeyy(i) - signyy(i) - p(i)
674 dszz = sigezz(i) - signzz(i) - p(i)
675 dsxy = sigexy(i) - signxy(i)
676 dsyz = sigeyz(i) - signyz(i)
677 dszx = sigezx(i) - signzx(i)
679 hkin = two_third*fisokin*h(i)
680 alpha(i) = hkin/(g2(i)+hkin)
681 sigpxx =
alpha(i)*dsxx
682 sigpyy =
alpha(i)*dsyy
683 sigpzz =
alpha(i)*dszz
684 sigpxy =
alpha(i)*dsxy
685 sigpyz =
alpha(i)*dsyz
686 sigpzx =
alpha(i)*dszx
688 uvar(i, 2) = uvar(i, 2) + sigpxx
689 uvar(i, 3) = uvar(i, 3) + sigpyy
690 uvar(i, 4) = uvar(i, 4) + sigpzz
691 uvar(i, 5) = uvar(i, 5) + sigpxy
692 uvar(i, 6) = uvar(i, 6) + sigpyz
693 uvar(i, 7) = uvar(i, 7) + sigpzx
695 signxx(i) = signxx(i) + uvar(i, 2)
696 signyy(i) = signyy(i) + uvar(i, 3)
697 signzz(i) = signzz(i) + uvar(i, 4)
698 signxy(i) = signxy(i) + uvar(i, 5)
699 signyz(i) = signyz(i) + uvar(i, 6)
700 signzx(i) = signzx(i) + uvar(i, 7)
704 IF (impl_s > zero)
THEN
706 IF(dpla1(i) > zero) etse(i)= h(i)/g2(i)