45
46
47
48 USE constant_mod ,
ONLY : zero, em15, half, one, two, three, three100
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 IMPLICIT NONE
73#include "my_real.inc"
74
75
76
77 INTEGER,INTENT(IN) :: IFLAG, NEL
78 my_real,
INTENT(IN) :: off(nel),mu(nel),mu2(nel),espe(nel),dvol(nel),df(nel),vnew(nel)
79 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, dvv, pp, pstar
87
88
89
90 gamma = eos_struct%UPARAM(1)
91 p0 = eos_struct%UPARAM(2)
92 pstar = eos_struct%UPARAM(3)
93 psh(1:nel) = eos_struct%PSH
94 e0 = eos_struct%E0
95
96 IF(iflag == 0) THEN
97 DO i=1,nel
98 pp = -gamma*pstar-psh(i) + (gamma-one)*(one+mu(i))*espe(i)
99 dpdm(i) = (gamma-one) *espe(i)+(gamma-one)*(one+mu(i))*df(i)*df(i)*(pp+psh(i) )
100 dpde(i) = (gamma-one)*(one+mu(i))
101 pnew(i) =
max(pp,pmin-psh(i))*off(i)
102 ENDDO
103
104 ELSEIF(iflag == 1) THEN
105 DO i=1,nel
106 aa = -gamma*pstar-psh(i)
107 bb = (gamma-one)*(one+mu(i))
108 dpde(i) = (gamma-one)*(one+mu(i))
109 dvv = half*dvol(i)*df(i) /
max(em15,vnew(i))
110 pnew(i) = (aa+bb*(espe(i)-psh(i) *dvv))/(one+bb*dvv)
111 pnew(i) =
max(pnew(i),pmin-psh(i) )*off(i)
112 eint(i) = eint(i) - half*dvol(i)*(pnew(i)+psh(i) )
113 ENDDO
114
115 ELSEIF(iflag == 2) THEN
116 DO i=1, nel
117 IF (vnew(i) > zero) THEN
118 pnew(i) = (gamma-one)*(one+mu(i))*espe(i) - gamma*pstar
119 pnew(i) =
max(pnew(i),pmin)*off(i)
120
121 dpdm(i) = (gamma-one)*(espe(i)+pnew(i)*df(i))
122 dpde(i) = (gamma-one)*(one+mu(i))
123 pnew(i) = pnew(i)-psh(i)
124 ENDIF
125 ENDDO
126 ENDIF
127
128 RETURN