28 SUBROUTINE gruneisen(IFLAG , NEL ,PM ,OFF ,EINT ,MU ,MU2 ,
29 2 ESPE , DVOL ,DF ,VNEW ,MAT ,RHO0,
30 3 PNEW , DPDM ,DPDE ,PSH ,
52#include "implicit_f.inc"
60 INTEGER,
INTENT(IN) :: NUMMAT
61 INTEGER,
INTENT(IN) :: NPROPM
62 INTEGER,
INTENT(IN) :: IFLAG
63 INTEGER,
INTENT(IN) :: NEL
64 INTEGER,
INTENT(IN) :: MAT(NEL)
65 my_real,
INTENT(IN) :: pm(npropm,nummat)
74 my_real,
INTENT(INOUT) :: eint(nel)
75 my_real,
INTENT(INOUT) :: psh(nel)
76 my_real,
INTENT(INOUT) :: pnew(nel
77 my_real,
INTENT(INOUT) :: dpde(nel)
78 my_real,
INTENT(INOUT) :: dpdm(nel)
83, FF, FG, FAC, XX, DFF, DFG, FAC1, PP
84 my_real CC(NEL),S1(NEL),S2(NEL),S3(NEL),G0(NEL),GA(NEL),PC(NEL)
106 IF(mu(i) > zero)
THEN
107 xx= mu(i)/(one+mu(i))
108 ff=one+(one-half*g0(i))*mu(i)-half*ga(i)*mu2(i)
109 fg=one-(s1(i)-one+s2(i)*xx+s3(i)*xx*xx)*mu(i)
111 dff=one-half*g0(i)-ga(i)*mu(i)
112 dfg=one-s1(i)+xx*(-two*s2(i)+xx*(s2(i)-three*s3(i))+two*s3(i)*xx*xx)
113 fac1=fac*(one+mu(i)*(dff/ff-two*dfg/fg))
115 aa=fac*rho0(i)*cc(i)*cc(i)*mu(i)
117 pp=
max(aa+bb*espe(i),pc(i))*off(i)
118 dpdm(i)=fac1*rho0(i)*cc(i)*cc(i)+pp*df(i)*df(i)*bb+ga(i)*espe(i)
120 pnew(i) =
max(pp,pc(i))*off(i)
121 pnew(i) = pnew(i) - psh(i)
124 ELSEIF(iflag == 1)
THEN
142 IF(mu(i) > zero)
THEN
143 xx= mu(i)/(one+mu(i))
144 ff=one+(one-half*g0(i))*mu(i)-half*ga(i)*mu2(i)
145 fg=one-(s1(i)-one+s2(i)*xx+s3(i)*xx*xx)*mu(i)
148 aa=fac*rho0(i)*cc(i)*cc(i)*mu(i)
151 dvv=half*dvol(i)*df(i) /
max(em15,vnew(i))
152 pnew(i)=(aa+bb*espe(i))/(one+bb*dvv)
153 pnew(i)=
max(pnew(i),pc(i))*off(i)
154 eint(i)=eint(i) - half*dvol(i)*pnew(i)
155 pnew(i) = pnew(i) - psh(i)
158 ELSEIF(iflag == 2)
THEN
173 IF (vnew(i) > zero)
THEN
176 IF(mu(i) > zero)
THEN
177 xx= mu(i)/(one+mu(i))
178 ff=one+(one-half*g0(i))*mu(i)-half*ga(i)*mu2(i)
179 fg=one-(s1(i)-one+s2(i)*xx+s3(i)*xx*xx)*mu(i)
181 dff=one-half*g0(i)-ga(i)*mu(i)
182 dfg=one-s1(i)+xx*(-two*s2(i)+xx*(s2(i)-three*s3(i))+two*s3
183 fac1=fac*(one+mu(i)*(dff/ff-two*dfg/fg))
185 aa=fac*rho0(i)*cc(i)*cc(i)*mu(i)
187 pnew(i)=
max(aa+bb*espe(i),pc(i))*off(i)
188 dpdm(i)=fac1*rho0(i)*cc(i)*cc(i)+pnew(i)*df(i)*df(i)*bb+ga(i)*espe(i)
190 pnew(i)=pnew(i)-psh(i)
subroutine gruneisen(iflag, nel, pm, off, eint, mu, mu2, espe, dvol, df, vnew, mat, rho0, pnew, dpdm, dpde, psh, nummat, npropm)