36 1 NEL , NUPARAM, NUVAR , NFUNC , IFUNC , NPF ,
37 2 TF , TIME , TIMESTEP, UPARAM, RHO0 , RHO ,
39 4 EPSPXX , EPSPYY , EPSPZZ , EPSPXY, EPSPYZ, EPSPZX,
40 5 DEPSXX , DEPSYY , DEPSZZ , DEPSXY, DEPSYZ, DEPSZX,
41 6 EPSXX , EPSYY , EPSZZ , EPSXY , EPSYZ , EPSZX ,
42 7 SIGOXX , SIGOYY , SIGOZZ , SIGOXY, SIGOYZ, SIGOZX,
43 8 SIGNXX , SIGNYY , SIGNZZ , SIGNXY, SIGNYZ, SIGNZX,
44 9 SIGVXX , SIGVYY , SIGVZZ , SIGVXY, SIGVYZ, SIGVZX,
45 A SOUNDSP, VISCMAX, UVAR , OFF ,
46 B UVARBID, ISMSTR , MFXX , MFXY , MFXZ , MFYX ,
47 C MFYY , MFYZ , MFZX , MFZY , MFZZ )
51#include "implicit_f.inc"
60 INTEGER NEL, NUPARAM, NUVAR,ISMSTR
64 . TIME , TIMESTEP , UPARAM(NUPARAM),
65 . RHO (NEL), RHO0 (NEL), VOLUME(NEL), EINT(NEL),
66 . EPSPXX(NEL), EPSPYY(NEL), EPSPZZ(NEL),
67 . EPSPXY(NEL), EPSPYZ(NEL), EPSPZX(NEL),
68 . DEPSXX(NEL), DEPSYY(NEL), DEPSZZ(NEL),
69 . DEPSXY(NEL), DEPSYZ(NEL), DEPSZX(NEL),
70 . EPSXX (NEL), EPSYY (NEL), EPSZZ (NEL),
71 . EPSXY (NEL), EPSYZ (NEL), EPSZX (NEL),
72 . sigoxx(nel), sigoyy(nel), sigozz(nel),
73 . sigoxy(nel), sigoyz(nel), sigozx(nel),
74 . mfxx(nel) , mfxy(nel), mfxz(nel),
75 . mfyx(nel) , mfyy(nel), mfyz(nel),
76 . mfzx(nel) , mfzy(nel), mfzz(nel)
81 . signxx(nel), signyy(nel), signzz(nel),
82 . signxy(nel), signyz(nel), signzx(nel),
83 . sigvxx(nel), sigvyy(nel), sigvzz(nel),
84 . sigvxy(nel), sigvyz(nel), sigvzx(nel),
85 . soundsp(nel), viscmax(nel),
86 . den1,den2,den3,den1d,den2d,
87 . den3d,old1,old2,old3,old4,old5,old6
92 . uvar(nel,nuvar), off(nel)
96 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
103 INTEGER MFUNC,IUNLOAD
105 INTEGER I,J,L,N,M,MDIR,NROT
106 INTEGER K(MVSIZ,3),K1(MVSIZ,3),KF(MVSIZ,3)
107 INTEGER KF1(MVSIZ,3),KUN(MVSIZ,3)
108 INTEGER IFLAG,ITOTAL,IMSTA
109 INTEGER NFUNC1,NFUNCUL,NFUNCP,NPCURVE,KCOMPAIR
110 INTEGER KRECOVER,KDECAY
111 LOGICAL TOTAL,,JACOBI,UNLOADING
116 . strain(mvsiz,3),rate(mvsiz,3),ratem(mvsiz),
118 . dsigma(mvsiz,3),decay,tensioncut,
119 . amin,amax,tolerance,lamda,efinal,epsfin,efactor,
120 . a(3,3),sn(3,3),earj(3),
121 . psc(mvsiz,3),ear(mvsiz,3),
122 . ebr(mvsiz,3),ecr(mvsiz,3),
123 . psn(mvsiz,3),ean(mvsiz,3),
124 . ebn(mvsiz,3),ecn(mvsiz,3),
126 . dpra(3,3),dprao(3,3),dprad(3,3),
127 . av(6,mvsiz),earv(3,mvsiz),dirprv(3,3,mvsiz),
128 . sigprv(3,mvsiz),ei(mvsiz),
129 . e0,vt,vc,rv,kkk,ggg,
130 . beta,hyster,ratedamp,theta,
131 . p0,relaxp,maxpres,phi,gamma,
132 . pair(mvsiz),volumer(mvsiz),
136 . psn1(mvsiz,3),psn2(mvsiz,3),
137 . edot0(mvsiz,3),edots(mvsiz,3),
138 . edotl(mvsiz,3),edotu(mvsiz,3),
139 . exponas,exponbs,funload,runload,
140 . e12(mvsiz),e23(mvsiz),e31(mvsiz),
141 . a11(mvsiz),a12(mvsiz),a13(mvsiz),a22(mvsiz),
142 . a23(mvsiz),a33(mvsiz),detc(mvsiz),
143 . v12(mvsiz),v23(mvsiz),v31(mvsiz),
144 . d11(mvsiz),d12(mvsiz),d44(mvsiz),
145 . emax(mvsiz),eyn(mvsiz,3),
146 . huge,small,tiny,shift,pscale
149 . ar1(6),dar1(6),ar2(6),dar2(6),dar3(3),earjd(3),
150 . tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,ad(3,3),
151 . aa(mvsiz),sigmax(mvsiz),esecant(mvsiz,3),
152 . tmp0p,tmp1p,tmp2p,tmp3p,tmp4p,tmp5p,tmp6p, dti
171 ratedamp = uparam(10)
172 krecover = uparam(11)
177 kcompair = uparam(14)
192 tensioncut= uparam(27)
197 viscosity = uparam(31)
198 tolerance = uparam(32)
208 edot(i) =uparam(nuparam-nfunc1+i)
209 alpha(i)=uparam(nuparam-nfunc1*2+i)
218 IF(itotal==2.OR.itotal==3) total=.false.
297 av(4,i)=epsxy(i)*half
298 av(5,i)=epsyz(i)*half
299 av(6,i)=epszx(i)*half
304 av(4,i)=depsxy(i)*half
305 av(5,i)=depsyz(i)*half
306 av(6,i)=depszx(i)*half
323 dirprv(n,j,i)=dpra(n,j)
333 CALL valpvec(av,earv,dirprv,nel)
342 dprao(l,n)=uvar(i,16+m)
349 dpra(n,j)=dirprv(n,j,i)
356 CALL checkaxes(dprao,dpra,amin,amax,unchanged,tolerance)
357 IF(.NOT.unchanged)
THEN
362 IF(n==l) sn(n,l)= uvar(i,n+3*(m-1))
366 CALL dreh(sn,dprao,1,1,1)
368 CALL dreh(sn,dpra ,1,1,0)
370 uvar(i,n+3*(m-1)) = sn(n,n)
379 IF(n==l) sn(n,l)= uvar(i,n+3*(m-1)+25)
382 CALL dreh(sn,dprao ,1,1,1)
383 CALL dreh(sn,dpra ,1,1,0)
385 uvar(i,n+3*(m-1)+25) = sn(n,n)
417 ear(i,1)= sign(one,epsxx(i)+epsyy(i)+epszz(i))*sqrt(
418 & (epsxx(i)-epsyy(i))**two+
419 & (epsyy(i)-epszz(i))**two+
420 & (epszz(i)-epsxx(i))**two+
421 & two*(epsxy(i)**two+epsyz(i)**two+epszx(i)**two))/sqrt(two)
423 ecr(i,1)= sign(one,depsxx(i)+depsyy(i)+depszz(i))*sqrt(
424 & (depsxx(i)-depsyy(i))**two+
425 & (depsyy(i)-depszz(i))**two+
426 & (depszz(i)-depsxx(i))**two+
427 & ((depsxy(i))**two+(depsyz(i))**two+(depszx(i))**two
435 IF(timestep<=zero)
THEN
443 IF( total) ecr(i,j)=ear(i,j)-uvar(i,j)
444 IF(.NOT.total) ear(i,j)=ecr(i,j)+uvar(i,j)
445 ebr(i,j)=ecr(i,j)*dti
451 IF(ismstr==0.OR.ismstr==2.OR.ismstr==4)
THEN
452 el(i,j)=exp(ear(i,j))
455 ebn(i,j)=ebr(i,j)*el(i,j)
456 ecn(i,j)=el(i,j)*(one-exp(-ecr(i,j)))
457 ELSEIF(ismstr==10.OR.ismstr==12)
THEN
458 el(i,j)=sqrt(ear(i,j)+one)
469 ebn(i,j)=uvar(i,j+6)+(ebn(i,j)-uvar(i,j+6))*ratedamp
478 volumer(i)=el(i,1)*el(i,2)*el(i,3)
483 IF (kcompair==1.AND.volumer(i)<one)
THEN
484 npcurve=ifunc(nfuncp)
485 IF (volumer(i)-phi>small)
THEN
487 pair(i)=-finter(npcurve,volumer(i),npf,tf,df)
488 pair(i)=pair(i)*pscale
490 pair(i)=p0*(volumer(i)-one)/(volumer(i)-phi)
496 pair(i)=exp(-relaxp*time)*
max(pair(i),-maxpres)
498 ELSEIF (kcompair==2.AND.volumer(i)<one)
THEN
499 npcurve=ifunc(nfuncp)
500 pair(i)=-finter(npcurve,volumer(i),npf,tf,df)
515 strain(i,j)=-ean(i,j)
516 rate(i,j)=abs(ebn(i,j))
519 IF((ean(i,j)<zero.AND.ebn(i,j)>zero).OR.
520 & (ean(i,j)>zero.AND.ebn(i,j)<zero))unloading=.true.
522 psn1(i,j)=-
alpha(1)*finter(ifunc(1),strain(i,j),npf,tf,df)
529 IF(edot0(i,j)<edot(1)) edot0(i,j)=edot(1)
530 IF(unloading.AND.iunload/=0)
THEN
533 IF (abs(runload-edot(1))<em20)
THEN
535 & (finter(ifunc(nfuncul),strain(i,j),npf,tf,df1
539 edotu(i,j)=edot0(i,j)
541 edotl(i,j)=
max(runload,edots(i,j))
543 IF(edotu(i,j)<edots(i,j))edotu(i,j)=edots(i,j)
544 IF(edotu(i,j)>edotl(i,j))edotu(i,j)=edotl(i,j)
547 & finter(ifunc(1),strain(i,j),npf,tf,df1)
548 eyn(i,j)=
alpha(1)*df1
550 & (finter(ifunc(nfuncul),strain(i,j),npf,tf,df2))
552 psn(i,j)=psn2(i,j)+(psn1(i,j)-psn2(i,j))*
553 & (one-((
min(one,(edotu(i,j)-edots(i,j))/
554 & (
max(tiny,edotl(i,j)-edots(i,j)))))**exponas))**exponbs
556 IF(abs(edotu(i,j)-edots(i,j))>tiny.AND.
557 & abs(psn(i,j)-psn1(i,j))>tiny)visc(i,j)=
558 & abs((psn(i,j)-psn1(i,j))/(edotu(i,j)-edots(i,j)))
560 visc(i,j)=
min(visc(i,j),viscosity)
561 psn(i,j)=psn1(i,j)-visc(i,j)*(edotu(i,j
566 IF(unloading) kun(i,j)=nfunc1
572 & finter(ifunc(kun(i,j)+1),strain(i,j)+shift,npf,tf,df)
581 IF(edot0(i,j)<=edot(l))
GOTO 10
589 psn2(i,j)=-
alpha(k(i,j))*
590 & finter(ifunc(kf(i,j)),strain(i,j)+shift,npf,tf,df2)
592 kf1(i,j)=
max(1,l-1)+kun(i,j)
593 edotl(i,j)=edot(k(i,j))
594 edots(i,j)=edot(k1(i,j))
595 psn1(i,j)=-
alpha(k1(i,j))*
596 & finter(ifunc(kf1(i,j)),strain(i,j)+shift,npf,tf,df1)
598 eyn(i,j)=
alpha(l)*df2
600 eyn(i,j)=
alpha(k1(i,j))*df1
603 psn(i,j)=psn2(i,j)+(psn1(i,j)-psn2(i,j))*
604 & (one-((
min(one,(edot0(i,j)-edots(i,j))/
605 & (
max(tiny,edotl(i,j)-edots(i,j)))))**exponas))
608 IF(abs(edot0(i,j)-edots(i,j))>tiny.AND.
609 & abs(psn(i,j)-psn1(i,j))>tiny)visc(i,j)=
610 & abs((psn(i,j)-psn1(i,j))/(edot0(i,j)-edots(i,j)))
612 visc(i,j)=
min(visc(i,j),viscosity)
613 psn(i,j)=psn1(i,j)-visc(i,j)*(edot0(i,j)-edots(i,j))
627 IF(ean(i,j)<zero)
THEN
629 IF(krecover==0.AND.ecn(i,j)<zero)
630 & uvar(i,j+25)=uvar(i,j+25)+abs(ecn(i,j))
632 IF(krecover==1)uvar(i,j+25)=uvar(i,j+25)-ecn(i,j)
633 IF(ebn(i,j)<zero)
THEN
634 decay =
min(one,hyster*(one-exp(-beta*uvar(i,j+25))))
639 & psn(i,j)=psn(i,j)*(one-decay)
641 IF(kdecay==1.AND.ecn(i,j)<zero)
642 & psn(i,j)=psn(i,j)*(one-decay)
644 IF(kdecay==2.AND.ecn(i,j)>zero)
645 & psn(i,j)=psn(i,j)*(one-decay)
648 dsigma(i,j)=psn(i,j)-uvar(i,j+3)
653 IF(abs(ecn(i,j))>tiny)
THEN
654 eyn(i,j)=abs(dsigma(i,j)/ecn(i,j))
663 IF(sign(one,(ebn(i,j)/(uvar(i,j+6)+tiny)))/=one)
664 & eyn(i,j)=uvar(i,j+9)
668 eyn(i,j)=eyn(i,j)*theta+uvar(i,j+9)*(one-theta)
673 IF(itotal==0.OR.itotal==2)
THEN
676 IF(ean(i,j)>=zero)
THEN
678 tmp1=exp(-lamda*(volumer(i)-1.+epsfin))
679 ei(i)=efinal+(e0-efinal)*(1-tmp1)
680 tmp2=lamda*(efinal-e0)*tmp1
681 eyn(i,j)=
max(ei(i),tmp2)
683 psn(i,j)=ei(i)*ean(i,j)
687 uvar(i,j+12)=vt/ei(i)
690 ELSEIF(itotal==-1)
THEN
695 ei(i)=
max(uvar(i,10),uvar(i,11),uvar(i,12))
697 psn(i,j)=ei(i)*ean(i,j)
698 uvar(i,j+12)=vt/ei(i)
701 ELSEIF(itotal==-2)
THEN
704 IF(ean(i,j)>zero)
THEN
706 ei(i)=
max(uvar(i,10),uvar(i,11),uvar(i,12))
708 psn(i,j)=uvar(i,j+3)+ei(i)*ecn(i,j)
709 uvar(i,j+12)=vt/ei(i)
719 sigmax(i)=-(
min(psn(i,1),psn(i,2),psn(i,3))-
720 .
max(psn(i,1),psn(i,2),psn(i,3)))
724 esecant(i,j)=0.4*abs(psn(i,j))/
max(tiny,abs(strain(i,j)))
725 IF (esecant(i,j)<=sigmax(i))
THEN
726 tmp1=0.2*(sigmax(i)-esecant(i,j))
727 psn(i,j)=psn(i,j)+tmp1*ean(i,j)
728 eyn(i,j)=
max(eyn(i,j),(one+tmp1)*esecant(i,j))
735 tmp0=
max(eyn(i,j),uvar(i,j+9))
749 d11(i)=emax(i)*(one-vt)/(one+vt)/(one-two*vt)
750 d12(i)=emax(i)*vt/(one+vt)/(one-two*vt)
755 signxx(i)=d11(i)*epsxx(i)+d12(i)*epsyy(i)+d12(i)*epszz(i)
756 signyy(i)=d12(i)*epsxx(i)+d11(i)*epsyy(i)+d12(i)*epszz(i)
757 signzz(i)=d12(i)*epsxx(i)+d12(i)*epsyy(i)+d11(i)*epszz(i)
758 signxy(i)=d44(i)*epsxy(i)
759 signyz(i)=d44(i)*epsyz(i)
760 signzx(i)=d44(i)*epszx(i)
761 soundsp(i) = sqrt(d11(i)/rho0(i))
764 & d11(i)*depsxx(i)+d12(i)*depsyy(i)+d12(i)*depszz(i)
766 & d12(i)*depsxx(i)+d11(i)*depsyy(i)+d12(i)*depszz(i)
768 & d12(i)*depsxx(i)+d12(i)*depsyy(i)+d11(i)*depszz(i)
769 signxy(i)=sigoxy(i)+d44(i)*depsxy(i)
770 signyz(i)=sigoyz(i)+d44(i)*depsyz(i)
771 signzx(i)=sigozx(i)+d44(i)*depszx(i)
772 soundsp(i) = sqrt(d11(i)/rho0(i))
781 IF(vt+vc<=two*tiny)
THEN
787 psc(i,1)=eyn(i,1)*ecn(i,1)
788 psc(i,2)=eyn(i,2)*ecn(i,2)
789 psc(i,3)=eyn(i,3)*ecn(i,3)
792 e12(i)=(ean(i,1)+ean(i,2))/two
793 e23(i)=(ean(i,2)+ean(i,3))/two
794 e31(i)=(ean(i,3)+ean(i,1))/two
795 v12(i)=vc+(vt-vc)*(one-exp(-rv*abs(e12(i))))*
796 & (sign(one,e12(i))+one)/two
797 v23(i)=vc+(vt-vc)*(one-exp(-rv*abs(e23(i))))*
798 & (sign(one,e23(i))+one)/two
799 v31(i)=vc+(vt-vc)*(one-exp(-rv*abs(e31(i))))*
800 & (sign(one,e31(i))+one)/two
802 detc(i)=one-v23(i)*v23(i)-v31(i)*v31(i)-v12(i)*v12(i)-
803 & two*v12(i)*v31(i)*v23(i)
804 a11(i)=(one-v23(i)*v23(i))
805 a12(i)=(v12(i)+v23(i)*v31(i))
806 a13(i)=(v31(i)+v23(i)*v12(i))
807 a22(i)=(one-v31(i)*v31(i))
808 a23(i)=(v23(i)+v31(i)*v12(i))
809 a33(i)=(one-v12(i)*v12(i))
810 psc(i,1)=(a11(i)*psn(i,1)+a12(i)*psn(i,2)+a13(i)*psn(i,3))/
812 psc(i,2)=(a12(i)*psn(i,1)+a22(i)*psn(i,2)+a23(i)*psn(i,3))/
814 psc(i,3)=(a13(i)*psn(i,1)+a23(i)*psn(i,2)+a33(i)*psn(i,3))/
817 uvar(i,13)=theta*v23(i)/ei(i)+(one-theta)*uvar(i,13)
818 uvar(i,14)=theta*v31(i)/ei(i)+(one-theta)*uvar(i,14)
819 uvar(i,15)=theta*v12(i)/ei(i)+(one-theta)*uvar(i,15)
820 detc(i)=one/(eyn(i,1)*eyn(i,2)*eyn(i,3))-
821 & uvar(i,13)*uvar(i,13)/eyn(i,1)-
822 & uvar(i,14)*uvar(i,14)/eyn(i,2)-
823 & uvar(i,15)*uvar(i,15)/eyn(i,3)-
824 & 2*uvar(i,13)*uvar(i,14)*uvar(i,15)
825 a11(i)=one/(eyn(i,2)*eyn(i,3))-uvar(i,13)*uvar(i,13)
826 a12(i)=uvar(i,15)/eyn(i,3)+uvar(i,13)*uvar(i,14)
827 a13(i)=uvar(i,14)/eyn(i,2)+uvar(i,13)*uvar(i,15)
828 a22(i)=one/(eyn(i,1)*eyn(i,3))-uvar(i,14)*uvar(i,14)
829 a23(i)=uvar(i,13)/eyn(i,1)+uvar(i,14)*uvar(i,15)
830 a33(i)=one/(eyn(i,1)*eyn(i,2))-uvar(i,15)*uvar(i,15)
832 psc(i,1)=((a11(i)*ecn(i,1)+a12(i)*ecn(i,2)+a13(i)*ecn(i,3))
834 psc(i,2)=((a12(i)*ecn(i,1)+a22(i)*ecn(i,2)+a23(i)*ecn(i,3))
836 psc(i,3)=((a13(i)*ecn(i,1)
842 IF(off(i)==zero.OR.psn(i,j)>abs(tensioncut))
THEN
851 IF(ismstr==0.OR.ismstr==2.OR.ismstr==4)
THEN
856 psc(i,1)=psc(i,1)/den1
857 psc(i,2)=psc(i,2)/den2
858 psc(i,3)=psc(i,3)/den3
859 eyn(i,1)=eyn(i,1)/den1
860 eyn(i,2)=eyn(i,2)/den2
861 eyn(i,3)=eyn(i,3)/den3
862 ELSEIF(ismstr==10.OR.ismstr==12)
THEN
864 den1=el(i,1)/volumer(i)
865 den2=el(i,2)/volumer(i)
866 den3=el(i,3)/volumer(i)
867 psc(i,1)=psc(i,1)*den1
868 psc(i,2)=psc(i,2)*den2
869 psc(i,3)=psc(i,3)*den3
870 eyn(i,1)=eyn(i,1)*den1
871 eyn(i,2)=eyn(i,2)*den2
872 eyn(i,3)=eyn(i,3)*den3
875 IF (kcompair==2)
THEN
878 tmp3=
min(el(i,1),el(i,2),el(i,3))
879 IF (tmp0<one.AND.tmp3<one
880 & .AND.tmp3>tmp0.AND.abs(tmp0-tmp3)>em6)
THEN
881 tmp2=volumer(i)**(1./3.)-volumer(i)
882 tmp4=(tmp3-tmp0)/tmp2
890 sigprv(j,i)=psc(i,j)+aa(i)*(pair(i)-psc(i,j))
896 sigprv(j,i)=psc(i,j)+pair(i)
902 signxx(i) = dirprv(1,1,i)*dirprv(1,1,i)*sigprv(1,i)
903 & + dirprv(1,2,i)*dirprv(1,2,i)*sigprv(2,i)
904 & + dirprv(1,3,i)*dirprv(1,3,i)*sigprv(3,i)
905 signyy(i) = dirprv(2,2,i)*dirprv(2,2,i)*sigprv(2,i)
906 & + dirprv(2,3,i)*dirprv(2,3,i)*sigprv(3,i)
907 & + dirprv(2,1,i)*dirprv(2,1,i)*sigprv(1,i)
908 signzz(i) = dirprv(3,3,i)*dirprv(3,3,i)*sigprv(3,i)
909 & + dirprv(3,1,i)*dirprv(3,1,i)*sigprv(1,i)
910 & + dirprv(3,2,i)*dirprv(3,2,i)*sigprv(2,i)
911 signxy(i) = dirprv(1,1,i)*dirprv(2,1,i)*sigprv(1,i)
912 & + dirprv(1,2,i)*dirprv(2,2,i)*sigprv(2,i)
913 & + dirprv(1,3,i)*dirprv(2,3,i)*sigprv(3,i)
914 signyz(i) = dirprv(2,2,i)*dirprv(3,2,i)*sigprv(2,i)
915 & + dirprv(2,3,i)*dirprv(3,3,i)*sigprv(3,i)
916 & + dirprv(2,1,i)*dirprv(3,1,i)*sigprv(1,i)
917 signzx(i) = dirprv(3,3,i)*dirprv(1,3,i)*sigprv(3,i)
918 & + dirprv(3,1,i)*dirprv(1,1,i)*sigprv(1,i)
919 & + dirprv(3,2,i)*dirprv(1,2,i)*sigprv(2,i)
925 signxx(i)=signxx(i)+sigoxx(i)
926 signyy(i)=signyy(i)+sigoyy(i)
927 signzz(i)=signzz(i)+sigozz(i)
928 signxy(i)=signxy(i)+sigoxy(i)
929 signyz(i)=signyz(i)+sigoyz(i)
930 signzx(i)=signzx(i)+sigozx(i)
936 emax(i)=
max(ei(i),eyn(i,1),eyn(i,2),eyn(i,3))
942 epsxy(i) = dirprv(1,1,i)*dirprv(2,1,i)*ean(i,1)
943 & + dirprv(1,2,i)*dirprv(2,2,i)*ean(i,2)
944 & + dirprv(1,3,i)*dirprv(2,3,i)*ean(i,3)
945 epsyz(i) = dirprv(2,2,i)*dirprv(3,2,i)*ean(i,2)
946 & + dirprv(2,3,i)*dirprv(3,3,i)*ean(i,3)
947 & + dirprv(2,1,i)*dirprv(3,1,i)*ean(i,1)
948 epszx(i) = dirprv(3,3,i)*dirprv(1,3,i)*ean(i,3)
949 & + dirprv(3,1,i)*dirprv(1,1,i)*ean(i,1)
950 & + dirprv(3,2,i)*dirprv(1,2,i)*ean(i,2)
953 esecant(i,1)=0.5*abs(signxy(i))/
max(tiny
954 esecant(i,2)=0.5*abs(signyz(i))/
max(tiny,abs(epsyz(i)))
955 esecant(i,3)=0.5*abs(signzx(i))/
max(tiny,abs(epszx(i)))
956 sigmax(i)=
max(0.5*ei(i),sigmax(i))
957 IF (esecant(i,1)<=sigmax(i))
THEN
958 tmp1=0.1*(sigmax(i)-esecant(i,1))
959 signxy(i)=signxy(i)+tmp1*epsxy(i)
961 IF (esecant(i,2)<=sigmax(i))
THEN
962 tmp1=0.1*(sigmax(i)-esecant(i,2))
963 signyz(i)=signyz(i)+tmp1*epsyz(i)
965IF (esecant(i,3)<=sigmax(i))
THEN
966 tmp1=0.1*(sigmax(i)-esecant(i,3))
967 signzx(i)=signzx(i)+tmp1*epszx(i)
972 kkk=emax(i)/(three*(one-two*
max(vc,vt)))
973 ggg=emax(i)/(two*(one+
max(vc,vt)))
974 soundsp(i)=sqrt((kkk+four_over_3*ggg)/rho0(i))
975 viscmax(i)=
max(visc(i,1),visc(i,2),visc(i,3))