31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49!
50
51
52
53
54
55
56
57#include "implicit_f.inc"
58#include "comlock.inc"
59
60
61
62#include "com04_c.inc"
63#include "param_c.inc"
64#include "com06_c.inc"
65#include "com08_c.inc"
66#include "vect01_c.inc"
67#include "scr06_c.inc"
68
69
70
71 INTEGER MAT(NEL), IFLAG, NEL
73 . off(nel) ,eint(nel) ,mu(nel) ,
74 . mu2(nel) ,espe(nel) ,dvol(nel) ,df(nel) ,
75 . vnew(nel) ,pnew(nel) ,dpdm(nel),
76 . dpde(nel) ,theta(nel)
77 my_real,
INTENT(INOUT) :: psh(nel)
78 my_real,
INTENT(IN) :: sig(nel,6)
79
80
81
82 INTEGER I, MX
84 my_real :: r_gas,a0,a1,a2,a3,a4,cp(nel),cv
85 my_real :: temp, fun, dfun, tol, error, incr
87 INTEGER :: ITER, MAX_ITER
88
89
90
91 max_iter = 50
92 tol = em05
93 cp(1:nel)=zero
94
95 IF(iflag == 0) THEN
96 mx = mat(1)
97 rho0 = pm(1 ,mx)
98 r_gas = pm(106,mx)
99 p0 = pm(31,mx)
100 psh(1:nel) = pm(88,mx)
101 a0 = pm(32,mx)
102 a1 = pm(33,mx)
103 a2 = pm(34,mx)
104 a3 = pm(35,mx)
105 a4 = pm(36,mx)
106
107 DO i=1,nel
108
109 rho = rho0 * (one + mu(i))
110 pold=-third*(sig(i,1)+sig(i,2)+sig(i,3))
111 temp = pold/rho/r_gas
112 iter = 0
113 error = huge(zero)
114 DO WHILE(error > tol .AND. iter < max_iter)
115
116
117 fun = a0 * temp + half * a1 * temp**2 + third * a2 * temp**3 +
118 . fourth * a3 * temp**4 + one_fifth * a4 * temp**5 - r_gas * temp - espe(i) / rho0
119 IF (abs(fun) < tol) EXIT
120 dfun = a0 + a1 * temp + a2 * temp**2 + a3 * temp**3 + a4 * temp**4 - r_gas
121 incr = - fun / dfun
122 temp = temp + incr
123 error = abs(incr / temp)
124 iter = iter + 1
125 ENDDO
126
127 theta(i) = temp
128 cp(i) = a0 + a1 * temp + a2 * temp**2 + a3 * temp**3 + a4 * temp**4
129 ENDDO
130 DO i=1,nel
131 cv = cp(i) - r_gas
132 gamma = cp(i)/cv
133 dpdm(i) = rho0*gamma*r_gas*theta(i)
134 dpde(i) = gamma*(one+mu(i))
135 pnew(i) = rho0*(one+mu(i))*r_gas*theta(i)
136 pnew(i) = pnew(i)-psh(i)
137 ENDDO
138
139
140 ELSEIF(iflag == 1) THEN
141 mx = mat(1)
142 rho0 = pm(1 ,mx)
143 r_gas = pm(106,mx)
144 p0 = pm(31,mx)
145 psh(1:nel) = pm(88,mx)
146 a0 = pm(32,mx)
147 a1 = pm(33,mx)
148 a2 = pm(34,mx)
149 a3 = pm(35,mx)
150 a4 = pm(36,mx)
151 r_gas = pm(106,mx)
152
153 DO i=1,nel
154
155 rho = rho0 * (one + mu(i))
156 pold=-third*(sig(i,1)+sig(i,2)+sig(i,3))
157 temp = pold/rho/r_gas
158 iter = 0
159 error = huge(zero)
160 DO WHILE(error > tol .AND. iter < max_iter)
161
162
163 fun = a0 * temp + half * a1 * temp**2 + third * a2 * temp**3 +
164 . fourth * a3 * temp**4 + one_fifth * a4 * temp**5 - r_gas * temp - espe(i) / rho0
165 IF (abs(fun) < tol) EXIT
166 dfun = a0 + a1 * temp + a2 * temp**2 + a3 * temp**3 + a4 * temp**4 - r_gas
167 incr = - fun / dfun
168 temp = temp + incr
169 error = abs(incr / temp)
170 iter = iter + 1
171 ENDDO
172
173 theta(i) = temp
174 cp(i) = a0 + a1 * temp + a2 * temp**2 + a3 * temp**3 + a4 * temp**4
175 ENDDO
176 DO i=1,nel
177 pnew(i) = rho0*(one+mu(i))*r_gas*theta(i)
178 eint(i) = eint(i) - half*dvol(i)*pnew(i)
179 pnew(i) = pnew(i)-psh(i)
180 cv = cp(i) - r_gas
181 gamma = cp(i)/cv
182 dpde(i) = gamma*(one+mu(i))
183 ENDDO
184
185 ELSEIF (iflag == 2) THEN
186 mx = mat(1)
187 rho0 = pm(1 ,mx)
188 r_gas = pm(106,mx)
189 p0 = pm(31,mx)
190 psh(1:nel) = pm(88,mx)
191 a0 = pm(32,mx)
192 a1 = pm(33,mx)
193 a2 = pm(34,mx)
194 a3 = pm(35,mx)
195 a4 = pm(36,mx)
196
197 DO i=1,nel
198
199 rho = rho0 * (one + mu(i))
200 pold=-third*(sig(i,1)+sig(i,2)+sig(i,3))
201 temp = pold/rho/r_gas
202 iter = 0
203 error = huge(zero)
204 DO WHILE(error > tol .AND. iter < max_iter)
205
206
207 fun = a0 * temp + half * a1 * temp**2 + third * a2 * temp**3 +
208 . fourth * a3 * temp**4 + one_fifth * a4 * temp**5 - r_gas * temp - espe(i) / rho0
209 IF (abs(fun) < tol) EXIT
210 dfun = a0 + a1 * temp + a2 * temp**2 + a3 * temp**3 + a4 * temp**4 - r_gas
211 incr = - fun / dfun
212 temp = temp + incr
213 error = abs(incr / temp)
214 iter = iter + 1
215 ENDDO
216
217 theta(i) = temp
218 cp(i) = a0 + a1 * temp + a2 * temp**2 + a3 * temp**3 + a4 * temp**4
219 ENDDO
220 DO i=1, nel
221 IF (vnew(i) > zero) THEN
222 cv = cp(i) - r_gas
223 gamma = cp(i)/cv
224 dpdm(i) = rho0*gamma*r_gas*theta(i)
225 dpde(i) = gamma*(one+mu(i))
226 pnew(i) = rho0*(one+mu(i))*r_gas*theta(i)
227 ENDIF
228 ENDDO
229
230 ENDIF
231
232 RETURN