29 1 (iflag,nel, pm ,off ,eint ,mu ,mu2 ,
30 2 espe ,dvol ,df ,vnew ,mat ,psh ,
58#include "implicit_f.inc"
67#include "vect01_c.inc"
72 INTEGER MAT(NEL), IFLAG, NEL
74 . off(nel) ,eint(nel) ,mu(nel) ,
75 . mu2(nel) ,espe(nel) ,dvol(nel) ,df(nel) ,
76 . vnew(nel) ,pnew(nel) ,dpdm(nel),
78 my_real,
INTENT(INOUT) :: psh(nel)
83 my_real :: p0,gamma,t0,e0,sph,aa, bb, dvv, pp, pstar, pc
92 psh(1:nel) = pm(88,mx)
97 pp = -gamma*pstar-psh(i) + (gamma-one)*(one+mu(i))*espe(i)
98 dpdm(i) = (gamma-one) *espe(i)+(gamma-one)*(one+mu(i))*df(i)*df(i)*(pp+psh(i) )
99 dpde(i) = (gamma-one)*(one+mu(i))
100 pnew(i) =
max(pp,pc-psh(i))*off(i)
103 ELSEIF(iflag == 1)
THEN
108 psh(1:nel) = pm(88,mx)
113 aa = -gamma*pstar-psh(i)
114 bb = (gamma-one)*(one+mu(i))
115 dpde(i) = (gamma-one)*(one+mu(i))
116 dvv = half*dvol(i)*df(i) /
max(em15,vnew(i))
117 pnew(i) = (aa+bb*(espe(i)-psh(i) *dvv))/(one+bb*dvv)
118 pnew(i) =
max(pnew(i),pc-psh(i) )*off(i)
119 eint(i) = eint(i) - half*dvol(i)*(pnew(i)+psh(i) )
122 ELSEIF(iflag == 2)
THEN
127 psh(1:nel) = pm(88,mx)
132 IF (vnew(i) > zero)
THEN
133 pnew(i) = (gamma-one)*(one+mu(i))*espe(i) - gamma*pstar
134 pnew(i) =
max(pnew(i),pc)*off(i)
136 dpdm(i) = (gamma-one)*(espe(i)+pnew(i)*df(i))
137 dpde(i) = (gamma-one)*(one+mu(i))
138 pnew(i) = pnew(i)-psh(i)
subroutine stiffgas(iflag, nel, pm, off, eint, mu, mu2, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde)