45
46
47
49 USE eos_param_mod , ONLY : eos_param_
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73 IMPLICIT NONE
74#include "my_real.inc"
75
76
77
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
82
83
84
85 INTEGER I
86 my_real :: p0,gamma,e0,aa,bb,pp,pstar,v0
87 my_real :: q,q_,rho0,num,denom,unpmu,b,rho
88
89
90
91 e0 = eos_struct%E0
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)
100
101 IF(iflag == 0) THEN
102 DO i=1,nel
103 unpmu = one+mu(i)
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)
110 ENDDO
111
112 ELSEIF(iflag == 1) THEN
113 DO i=1,nel
114 eint(i) = eint(i) - half*dvol(i)*(pnew(i)+psh(i))
115 unpmu = one+mu(i)
116 rho = unpmu*rho0
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
121 dpde(i) = bb
122 pnew(i) = (aa+bb*eint(i)/v0)/(one+bb*dvol(i)/two/v0)
123 pnew(i) =
max(pnew(i),-gamma*pstar)*off(i)
124 ENDDO
125
126 ELSEIF(iflag == 2) THEN
127 DO i=1, nel
128 IF (vnew(i) > zero) THEN
129 unpmu = one+mu(i)
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
136 ENDIF
137 ENDDO
138
139 ENDIF
140
141 RETURN