42 1 IFLAG ,NEL ,PMIN ,OFF ,EINT ,MU ,
43 2 ESPE ,DVOL ,VNEW ,PSH ,
44 3 PNEW ,DPDM ,DPDE ,EOS_STRUCT)
49 USE eos_param_mod ,
ONLY : eos_param_
78 INTEGER,
INTENT(IN) :: IFLAG, NEL
79 my_real,
INTENT(IN) :: PMIN, OFF(NEL) ,MU(NEL) , ESPE(NEL) ,DVOL(NEL) ,VNEW(NEL)
80 my_real,
INTENT(INOUT) :: PSH(NEL), PNEW(NEL) ,DPDM(NEL), DPDE(NEL), EINT(NEL)
81 TYPE(eos_param_),
INTENT(IN) :: EOS_STRUCT
86 my_real :: P0,GAMMA,E0,AA,BB,PP,PSTAR,V0
87 my_real :: Q,Q_,RHO0,NUM,DENOM,UNPMU,B,RHO
92 psh(1:nel) = eos_struct%PSH
93 gamma = eos_struct%UPARAM(1)
94 p0 = eos_struct%UPARAM(2)
95 pstar = eos_struct%UPARAM(3)
96 q = eos_struct%UPARAM(4)
97 q_ = eos_struct%UPARAM(5)
98 b = eos_struct%UPARAM(6)
99 rho0 = eos_struct%UPARAM(7)
104 denom = (one-rho0*b*unpmu)
105 num = (espe(i)-rho0*q)
106 pp = (gamma-one)*unpmu*num/denom - gamma*pstar
107 dpde(i) = (gamma-one)*unpmu / denom
108 dpdm(i) = (gamma-one)*num/denom/denom + dpde(i)*(pp+psh(i))/unpmu/unpmu
109 pnew(i) =
max(pp,-gamma*pstar)*off(i)
112 ELSEIF(iflag == 1)
THEN
114 eint(i) = eint(i) - half*dvol(i)*(pnew(i)+psh(i))
117 v0 = vnew(i)*rho/rho0
118 denom = (vnew(i)/v0-rho0*b)
119 aa = (gamma-one)*(-rho0*q/denom)-gamma*pstar
120 bb = (gamma-one)/ denom
122 pnew(i) = (aa+bb*eint(i)/v0)/(one+bb*dvol(i)/two/v0)
123 pnew(i) =
max(pnew(i),-gamma*pstar)*off(i)
126 ELSEIF(iflag == 2)
THEN
128 IF (vnew(i) > zero)
THEN
130 denom = (one-rho0*b*unpmu)
131 num = (espe(i)-rho0*q)
132 pnew(i) = -psh(i) + (gamma-one)*unpmu*num/denom - gamma*pstar
133 pnew(i) =
max(pnew(i),
max(pmin, -gamma*pstar))*off(i)
134 dpde(i) = (gamma-one)*unpmu / denom
135 dpdm(i) = (gamma-one)*num/denom/denom + dpde(i)*(pnew(i)+psh(i))/unpmu/unpmu
subroutine nasg(iflag, nel, pmin, off, eint, mu, espe, dvol, vnew, psh, pnew, dpdm, dpde, eos_struct)