44
45
46
47 USE root_finding_algo_mod
48 USE output_mod, ONLY : output_
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86#include "implicit_f.inc"
87#include "comlock.inc"
88
89
90
91#include "com01_c.inc"
92#include "com06_c.inc"
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
135 INTEGER NEL, NUPARAM, NUVAR
136
138 . time,timestep,uparam(nuparam),
139 . rho(nel),rho0(nel),volume(nel),
140 . sigoxx(nel),sigoyy(nel),sigozz(nel),
141 . deltvol(nel)
142
144 . signxx(nel),signyy(nel),signzz(nel),
145 . signxy(nel),signyz(nel),signzx(nel),
146 . sigvxx(nel),sigvyy(nel),sigvzz(nel),
147 . sigvxy(nel),sigvyz(nel),sigvzx(nel),
148 . soundsp(nel),viscmax(nel),eint(nel),bfrac(nel),temp(nel)
149
150 my_real,
INTENT(INOUT) :: uvar(nel,nuvar)
151
152
153
154 my_real ar,br,r1r,r2r,r3r,cvr,etar,
155 . ap,bp,r1p,r2p,r3p,cvp,etap,
156 . epsil,ftol, tmp,
157 . i_,b_,x_,g1,d_,y_,g2,
158 . z_,g_,c_,e_,figmax,fg1max,fg2min,
159 . cappa,chi,ccrit,tol,cv,dedv,
160 . artvisc,dt,pres,fc,cburn,enq,shear,vol_rel,dvol_rel
161 my_real oldfc,tem1,tem2,chydro,chydro2,dpdmu,dpde,heat
162 my_real mt,pold,er,wfextt,wr,wp_coef
163 integer itrmax,i_reac,i
165 my_real,
dimension(25) :: funct_parameter
166
167
168
169
170 wfextt=zero
171 if (time == zero) then
172 do i=1,nel
173 uvar(i,1) = zero
174 uvar(i,2) = uparam(39)
175 uvar(i,3) = uparam(14)
176 uvar(i,4) = one
177 uvar(i,5) = zero
178 uvar(i,6) = zero
179 uvar(i,7) = one
180 enddo
181 endif
182
183 i_reac = int(uparam(1))
184 itrmax = int(uparam(18))
185 dt = timestep
186 ar = uparam(2)
187 br = uparam(3)
188 r1r = uparam(4)
189 r2r = uparam(5)
190 r3r = uparam(6)
191 wr = uparam(7)
192 cvr = uparam(14)
193 ap = uparam(8)
194 bp = uparam(9)
195 r1p = uparam(10)
196 r2p = uparam(11)
197 r3p = uparam(12)
198 wp_coef = uparam(13)
199 cvp = uparam(15)
200 enq = uparam(16)
201 epsil = uparam(17)
202 ftol = uparam(19)
203 i_ = uparam(20)
204 b_ = uparam(21)
205 x_ = uparam(22)
206 g1 = uparam(23)
207 d_ = uparam(24)
208 y_ = uparam(25)
209 cappa = uparam(26)
210 chi = uparam(27)
211 tol = uparam(28)
212 ccrit = uparam(29)
213 g2 = uparam(30)
214 c_ = uparam(31)
215 e_ = uparam(32)
216 g_ = uparam(33)
217 z_ = uparam(34)
218 figmax = uparam(35)
219 fg1max = uparam(36)
220 fg2min = uparam(37)
221 shear = uparam(38)
222
223
224 funct_parameter(1:25) = zero
225 funct_parameter(1) = ar
226 funct_parameter(2) = br
227 funct_parameter(3) = r1r
228 funct_parameter(4) = r2r
229 funct_parameter(5) = r3r
230 funct_parameter(6) = cvr
231
232
233
234
235
236
237
238 funct_parameter(13) = ap
239 funct_parameter(14) = bp
240 funct_parameter(15) = r1p
241 funct_parameter(16) = r2p
242 funct_parameter(17) = r3p
243 funct_parameter(18) = cvp
244
245
246
247
248
249
250
251
252
253 do i=1,nel
254 vol_rel = rho0(i) / rho(i)
255 pres = -(sigoxx(i)+sigoyy(i)+sigozz(i)) * third
256 pold = pres
257 artvisc = zero
258 mt=rho(i)*volume(i)
259 IF (time > zero .AND. iale + ieuler > 0) THEN
260 uvar(i, 1) = uvar(i, 1) / mt
261 uvar(i, 1) =
max(zero,
min(uvar(i, 1), one))
262 ENDIF
263 fc = uvar(i,1)
264 cv = uvar(i,3)
265 tmp = uparam(39)
266 if(time > zero .AND. mt > em20) tmp = eint(i)/(mt*cv)
267 dvol_rel = vol_rel - uvar(i,4)
268 dedv = uvar(i,5)
269 etap = uvar(i,6)
270 etar = uvar(i,7)
271
272
273
274
275 oldfc = fc
276
277
278 tem1 = (pres+dedv+artvisc) / cv
279 tmp = tmp - tem1*dvol_rel
280 heat=zero
281 dpdmu=zero
282 dpde=zero
284 . ap ,bp ,r1p ,r2p ,r3p ,cvp ,etap,
285 . dpdmu,dpde,ftol,enq,
286 . tmp,heat,vol_rel ,fc,cv,dedv,pres, beta,funct_parameter)
287
288
289 tem2 = (pres+dedv+artvisc) / cv ! (cv si:j/m3/k = pa/k)
290 tmp = tmp - half*(tem2-tem1)*dvol_rel
292 . ap ,bp ,r1p ,r2p ,r3p ,cvp ,etap,
293 . dpdmu,dpde,ftol,enq,
294 . tmp,heat,vol_rel ,fc,cv,dedv,pres, beta,funct_parameter)
295
296
297
298 if (i_reac == 1)
CALL burn_fraction_ireac1(i_,b_,x_,g1,d_,y_,cappa,artvisc,dt,pres,etar,fc,cburn,oldfc)
299
300 if (i_reac == 2)
CALL burn_fraction_ireac2(i_,b_,x_,g1,d_,y_,g2,z_,g_,c_,e_,figmax,fg1max,fg2min,
301 . cappa,chi,ccrit,tol,artvisc,dt,pres,etar,fc,cburn,oldfc)
302 tmp = tmp + (fc - oldfc) * heat/cv
303
304 chydro2 = dpdmu + abs(pres)*(vol_rel*vol_rel)*dpde + onep33*shear
305 chydro2=
max(chydro2,
max(wr+one,wp_coef+one)*abs(pres)/
max(em30,rho(i)))
306 chydro = sqrt(chydro2)
307
308
309
310 soundsp(i) =
max(chydro,cburn)
311 viscmax(i) = zero
312
313 signxx(i) = -pres
314 signyy(i) = -pres
315 signzz(i) = -pres
316 signxy(i) = zero
317 signyz(i) = zero
318 signzx(i) = zero
319
320 sigvxx(i) = zero
321 sigvyy(i) = zero
322 sigvzz(i) = zero
323 sigvxy(i) = zero
324 sigvyz(i) = zero
325 sigvzx(i) = zero
326
327 uvar(i,1) = fc
328 uvar(i,2) = tmp
329 uvar(i,3) = cv
330 uvar(i,4) = vol_rel
331 uvar(i,5) = dedv
332 uvar(i,6) = etap
333 uvar(i,7) = etar
334
335 bfrac(i) = fc
336 uvar(i,8) = one - beta
337
338 er=mt*cv*tmp + half*(pres+pold)*deltvol(i)
339 wfextt=wfextt+er-eint(i)
340 eint(i)=mt*cv*tmp + half*(pres+pold)*deltvol(i)
341
342 temp(i) = tmp
343 enddo
344
345
346 output%TH%WFEXT=output%TH%WFEXT+wfextt
347
348 RETURN
subroutine burn_fraction_ireac2(i_, b_, x_, g1, d_, y_, g2, z_, g_, c_, e_, figmax, fg1max, fg2min, cappa, chi, ccrit, tol, artvisc, dt, pres, etar, fc, cburn, oldfc)
subroutine burn_fraction_ireac1(i_, b_, x_, g1, d_, y_, cappa, artvisc, dt, pres, etar, fc, cburn, oldfc)
subroutine mixture_equilibrium(ar, br, r1r, r2r, r3r, cvr, etar, ap, bp, r1p, r2p, r3p, cvp, etap, dpdmu, dpde, ftol, enq, tmp, heat, vol_rel, fc, cv, dedv, pres, beta, funct_parameter)