42 1 IFLAG,NEL ,PMIN ,OFF ,EINT ,MU ,
43 2 ESPE ,DVOL ,DF ,VNEW ,PSH ,
44 3 PNEW ,DPDM ,DPDE ,EOS_STRUCT )
48 USE eos_param_mod ,
ONLY : eos_param_
49 USE constant_mod ,
ONLY : zero, em15, half, one, three_half, two, three, three100
78 INTEGER,
INTENT(IN) :: IFLAG, NEL
79 my_real,
INTENT(IN) :: PMIN,OFF(NEL),MU(NEL),ESPE(NEL),DVOL(NEL),DF(NEL),VNEW(NEL)
80 my_real,
INTENT(INOUT) :: PNEW(NEL) ,DPDM(NEL),DPDE(NEL),EINT(NEL),PSH(NEL)
81 TYPE(),
INTENT(IN) :: EOS_STRUCT
86 my_real :: P0,GAMMA,E0,AA,BB,DVV,PP,AR0B,B
91 psh(1:nel) = eos_struct%PSH
93 gamma = eos_struct%UPARAM(1)
94 p0 = eos_struct%UPARAM(2)
95 ar0b = eos_struct%UPARAM(3)
96 b = eos_struct%UPARAM(4)
100 pp = (gamma-one)*(one+mu(i))*espe(i) + ar0b*exp(b*log(one+mu(i)))
101 dpdm(i) = (gamma-one)*espe(i)+ar0b*b/(one+mu(i))*exp((b-one)*log(one+mu(i)))+(gamma-one)*df(i)*pp
102 dpde(i) = (gamma-one)*(one+mu(i))
103 pnew(i) =
max(pp,pmin)*off(i)
104 pnew(i) = pnew(i) - psh(i)
107 ELSEIF(iflag == 1)
THEN
109 bb = (gamma-one)*(one+mu(i))
111 aa = ar0b*exp(b*log(one+mu(i)))
112 dvv = half*dvol(i)*df(i) /
max(em15,vnew(i))
113 pnew(i) = (aa + bb*espe(i) ) / (one+bb*dvv)
114 pnew(i) =
max(pnew(i),pmin)*off(i)
115 eint(i) = eint(i) - half*dvol(i)*(pnew(i))
116 pnew(i) = pnew(i) - psh(i)
119 ELSEIF (iflag == 2)
THEN
121 IF (vnew(i) > zero)
THEN
122 pnew(i) = (gamma-one)*(one+mu(i))*espe(i) + ar0b*exp(b*log(one+mu(i)))
123 dpdm(i) = (gamma-one)*espe(i)+ar0b*b/(one+mu(i))*exp((b-one)*log(one+mu(i)))+(gamma-one)*df(i)*pnew(i)
124 dpde(i) = (gamma-one)*(one+mu(i))
125 pnew(i) = pnew(i)-psh(i)
subroutine lszk(iflag, nel, pmin, off, eint, mu, espe, dvol, df, vnew, psh, pnew, dpdm, dpde, eos_struct)