33 integer,
parameter :: n_Tonly = 100
34 double precision :: HI_fraction_chromosphere(n_Tonly)
35 double precision :: T_H_fraction_K(n_Tonly)
36 double precision :: ionization_He_abundance = 0.1d0
37 double precision :: ionization_Rfactor_norm = 2.3d0
38 double precision,
allocatable :: prom_T_table(:)
39 double precision,
allocatable :: prom_p_table(:)
40 double precision,
allocatable :: prom_T_eos_table(:)
41 double precision,
allocatable :: prom_Y_eos_table(:,:)
42 double precision :: Te_table_min, Te_table_max, inv_Te_table_step
43 double precision :: Te_low_iz_He=5413.d0
44 double precision :: Y_table_min, Y_table_max
45 double precision :: ionization_H_energy_unit = 0.d0
51 double precision :: ionization_HeI_energy_unit = 0.d0
52 double precision :: ionization_HeII_energy_unit = 0.d0
53 double precision,
dimension(:),
allocatable :: Rfactor_table
54 double precision,
dimension(:),
allocatable :: Y_table
55 double precision,
dimension(:),
allocatable :: eps_ion_H_table
56 double precision,
dimension(:),
allocatable :: Te_H_table
57 double precision,
dimension(:),
allocatable :: iz_H_table
60 integer,
parameter :: ionization_mode_chromosphere = 1
65 integer,
parameter :: ionization_mode_prominence = 2
70 integer,
parameter :: ionization_mode_flare = 3
71 integer,
parameter :: n_prom_T = 10
72 integer,
parameter :: n_prom_p = 7
73 integer,
parameter :: n_prom_eos = 4000
74 integer :: ionization_table_mode = ionization_mode_chromosphere
96 logical :: ionization_initialized = .false.
97 logical :: ionization_include_energy = .false.
100 logical :: pi_newton_warned = .false.
102 double precision,
parameter :: prom_T_K(n_prom_T) = (/ &
103 6000.d0, 7000.d0, 8000.d0, 9000.d0, 10000.d0, &
104 12000.d0, 15000.d0, 20000.d0, 25000.d0, 30000.d0 /)
106 double precision,
parameter :: prom_p_cgs(n_prom_p) = (/ &
107 0.03d0, 0.05d0, 0.10d0, 0.30d0, 0.50d0, 0.70d0, 1.00d0 /)
111 double precision,
parameter :: &
112 prom_iz_H_data(n_prom_T,n_prom_p) = reshape((/ &
114 0.53d0, 0.59d0, 0.65d0, 0.73d0, 0.80d0, &
115 0.90d0, 0.95d0, 0.98d0, 0.99d0, 1.00d0, &
117 0.40d0, 0.47d0, 0.56d0, 0.69d0, 0.79d0, &
118 0.91d0, 0.96d0, 0.98d0, 0.99d0, 1.00d0, &
120 0.25d0, 0.32d0, 0.47d0, 0.67d0, 0.81d0, &
121 0.93d0, 0.97d0, 0.99d0, 0.99d0, 1.00d0, &
123 0.10d0, 0.17d0, 0.41d0, 0.69d0, 0.85d0, &
124 0.96d0, 0.98d0, 0.99d0, 1.00d0, 1.00d0, &
126 0.06d0, 0.14d0, 0.38d0, 0.70d0, 0.87d0, &
127 0.97d0, 0.99d0, 1.00d0, 1.00d0, 1.00d0, &
129 0.04d0, 0.12d0, 0.36d0, 0.70d0, 0.88d0, &
130 0.97d0, 0.99d0, 1.00d0, 1.00d0, 1.00d0, &
132 0.03d0, 0.10d0, 0.34d0, 0.71d0, 0.89d0, &
133 0.98d0, 0.99d0, 1.00d0, 1.00d0, 1.00d0 /), &
134 (/ n_prom_t, n_prom_p /))
139 double precision,
parameter :: HI_fraction_flare(n_Tonly) = (/ &
140 9.9999877d-1, 9.9999877d-1, 9.9999877d-1, 9.9999877d-1, 9.9999877d-1, &
141 9.9999877d-1, 9.9999877d-1, 9.9999877d-1, 9.9999877d-1, 9.9999877d-1, &
142 9.9999877d-1, 9.9999890d-1, 9.9998024d-1, 9.9992560d-1, 9.9968205d-1, &
143 9.9899492d-1, 9.9682125d-1, 9.9069732d-1, 9.8273722d-1, 9.5165553d-1, &
144 8.8401513d-1, 7.5808722d-1, 6.3272201d-1, 4.7164997d-1, 1.6497967d-1, &
145 8.6151552d-2, 4.9787498d-2, 2.3629016d-2, 1.1010071d-2, 7.7663095d-3, &
146 5.7739222d-3, 4.1811404d-3, 3.4427999d-3, 2.9108183d-3, 2.2295092d-3, &
147 1.9451997d-3, 1.4754925d-3, 1.1849689d-3, 9.1381928d-4, 7.1369446d-4, &
148 6.3154203d-4, 5.4204957d-4, 4.6800799d-4, 4.1090740d-4, 3.4051796d-4, &
149 2.9397681d-4, 2.5497294d-4, 2.0900410d-4, 1.7267453d-4, 1.3474650d-4, &
150 1.0894726d-4, 8.6230407d-5, 7.0545733d-5, 5.8882317d-5, 4.9311732d-5, &
151 3.9687148d-5, 3.1954017d-5, 2.6460585d-5, 2.1367807d-5, 1.7836169d-5, &
152 1.4207015d-5, 1.2022741d-5, 9.9158901d-6, 8.5561393d-6, 7.1994135d-6, &
153 6.1326905d-6, 5.0944881d-6, 4.3131760d-6, 3.6080551d-6, 3.0571391d-6, &
154 2.5778758d-6, 2.1649433d-6, 1.7960119d-6, 1.4711565d-6, 1.1832833d-6, &
155 9.3858978d-7, 7.4227325d-7, 5.8536296d-7, 4.6590828d-7, 3.8339449d-7, &
156 3.2851748d-7, 2.8778528d-7, 2.5213506d-7, 2.2042234d-7, 1.9440791d-7, &
157 1.7116454d-7, 1.5143655d-7, 1.3390303d-7, 1.1879927d-7, 1.0569364d-7, &
158 9.4140342d-8, 8.3767251d-8, 7.4822295d-8, 6.6863923d-8, 5.9836421d-8, &
159 5.3685738d-8, 4.8177839d-8, 4.3423310d-8, 3.9109303d-8, 1.0188512d-8 /)
163 data t_h_fraction_k /2.1000005d+03, 2.2349495d+03, 2.3785708d+03, 2.5314199d+03, 2.6940928d+03, &
164 2.8672190d+03, 3.0514692d+03, 3.2475613d+03, 3.4562544d+03, 3.6783584d+03, &
165 3.9147351d+03, 4.1662998d+03, 4.4340322d+03, 4.7189697d+03, 5.0222153d+03, &
166 5.3449502d+03, 5.6884248d+03, 6.0539712d+03, 6.4430083d+03, 6.8570420d+03, &
167 7.2976860d+03, 7.7666460d+03, 8.2657383d+03, 8.7969062d+03, 9.3622090d+03, &
168 9.9638330d+03, 1.0604130d+04, 1.1285561d+04, 1.2010781d+04, 1.2782619d+04, &
169 1.3604041d+04, 1.4478250d+04, 1.5408652d+04, 1.6398826d+04, 1.7452648d+04, &
170 1.8574172d+04, 1.9767766d+04, 2.1038082d+04, 2.2390010d+04, 2.3828838d+04, &
171 2.5360100d+04, 2.6989764d+04, 2.8724182d+04, 3.0570023d+04, 3.2534518d+04, &
172 3.4625215d+04, 3.6850262d+04, 3.9218293d+04, 4.1738543d+04, 4.4420699d+04, &
173 4.7275266d+04, 5.0313219d+04, 5.3546391d+04, 5.6987395d+04, 6.0649453d+04, &
174 6.4546914d+04, 6.8694758d+04, 7.3109148d+04, 7.7807289d+04, 8.2807258d+04, &
175 8.8128625d+04, 9.3791852d+04, 9.9819000d+04, 1.0623346d+05, 1.1306024d+05, &
176 1.2032560d+05, 1.2805797d+05, 1.3628709d+05, 1.4504503d+05, 1.5436592d+05, &
177 1.6428561d+05, 1.7484295d+05, 1.8607852d+05, 1.9803609d+05, 2.1076208d+05, &
178 2.2430608d+05, 2.3872045d+05, 2.5406084d+05, 2.7038703d+05, 2.8776234d+05, &
179 3.0625456d+05, 3.2593475d+05, 3.4688000d+05, 3.6917081d+05, 3.9289406d+05, &
180 4.1814181d+05, 4.4501247d+05, 4.7360988d+05, 5.0404450d+05, 5.3643488d+05, &
181 5.7090725d+05, 6.0759431d+05, 6.4663956d+05, 6.8819319d+05, 7.3241712d+05, &
182 7.7948294d+05, 8.2957412d+05, 8.8288331d+05, 9.3961919d+05, 1.0000000d+06 /
186 data hi_fraction_chromosphere /1.0000000d+00, 1.0000000d+00, 1.0000000d+00, 1.0000000d+00, 1.0000000d+00, &
187 1.0000000d+00, 1.0000000d+00, 9.9999928d-01, 9.9999774d-01, 9.9999624d-01, &
188 9.9999428d-01, 9.9999219d-01, 9.9998862d-01, 9.9998313d-01, 9.9997944d-01, &
189 9.9995774d-01, 1.0000324d+00, 9.9822283d-01, 9.6391600d-01, 8.8995951d-01, &
190 8.0025935d-01, 7.4219799d-01, 7.1378660d-01, 6.9565988d-01, 6.7326778d-01, &
191 6.5032905d-01, 6.2487972d-01, 5.9925246d-01, 5.7028764d-01, 5.3673893d-01, &
192 4.9144468d-01, 4.4332290d-01, 3.9158964d-01, 3.4621361d-01, 2.7826238d-01, &
193 1.9633104d-01, 1.2593637d-01, 8.1383914d-02, 5.0944358d-02, 2.8770180d-02, &
194 1.4449068d-02, 7.6071853d-03, 4.3617180d-03, 2.7694483d-03, 1.8341533d-03, &
195 1.2467797d-03, 8.6159195d-04, 6.0232455d-04, 4.2862241d-04, 3.0666622d-04, &
196 2.2256430d-04, 1.6328457d-04, 1.2179965d-04, 9.2065704d-05, 7.0357783d-05, &
197 5.4168402d-05, 4.2026968d-05, 3.2807184d-05, 2.5801779d-05, 2.0414085d-05, &
198 1.6271379d-05, 1.3041737d-05, 1.0538992d-05, 8.5329248d-06, 6.9645471d-06, &
199 5.7069005d-06, 4.7155136d-06, 3.9203474d-06, 3.2734958d-06, 2.7415674d-06, &
200 2.2911979d-06, 1.9045801d-06, 1.5692771d-06, 1.2782705d-06, 1.0281080d-06, &
201 8.1567373d-07, 6.4200310d-07, 5.0668103d-07, 4.0577518d-07, 3.3245340d-07, &
202 2.8006056d-07, 2.4119515d-07, 2.1033340d-07, 1.8429903d-07, 1.6189058d-07, &
203 1.4264889d-07, 1.2616209d-07, 1.1193421d-07, 9.9408616d-08, 8.8335305d-08, &
204 7.8593857d-08, 7.0042269d-08, 6.2532941d-08, 5.5898361d-08, 5.0049657d-08, &
205 4.4888207d-08, 4.0317172d-08, 3.6192560d-08, 3.2330732d-08, 2.9387850d-08 /
214 double precision,
intent(in) :: he_abundance, rfactor_norm
215 character(len=*),
intent(in),
optional :: table_name
216 character(len=32) :: selected_table
217 logical,
intent(in),
optional :: include_energy
218 double precision,
parameter :: erg_to_joule = 1.0
d-7
219 double precision :: energy_unit
221 if (ionization_initialized)
then
222 call mpistop(
"ionization_degree_init called more than once")
225 if (he_abundance < 0.d0)
call mpistop(
"negative He abundance")
226 if (rfactor_norm <= 0.d0)
call mpistop(
"invalid Rfactor normalization")
228 ionization_he_abundance = he_abundance
229 ionization_rfactor_norm = rfactor_norm
231 ionization_include_energy = .false.
232 if (
present(include_energy)) ionization_include_energy = include_energy
234 selected_table =
"chromosphere"
235 if (
present(table_name)) selected_table = trim(adjustl(table_name))
237 select case (trim(selected_table))
238 case (
"chromosphere")
239 ionization_table_mode = ionization_mode_chromosphere
241 ionization_table_mode = ionization_mode_flare
243 ionization_table_mode = ionization_mode_prominence
246 "Unknown ionization table. Use 'chromosphere', 'flare', "// &
250 if (ionization_include_energy .and. &
252 call mpistop(
"Ionization energy is supported only for T-only tables "// &
253 "('chromosphere' and 'flare'), not for the pressure-dependent "// &
254 "'prominence' table.")
257 if (ionization_include_energy)
then
259 call mpistop(
"invalid units for hydrogen ionization energy")
268 ionization_h_energy_unit = 13.6d0 * energy_unit
269 ionization_hei_energy_unit = 24.59d0 * energy_unit
270 ionization_heii_energy_unit = 54.42d0 * energy_unit
272 ionization_h_energy_unit = 0.d0
273 ionization_hei_energy_unit = 0.d0
274 ionization_heii_energy_unit = 0.d0
277 select case (ionization_table_mode)
278 case (ionization_mode_chromosphere)
279 call ionization_build_temperature_table(hi_fraction_chromosphere)
280 case (ionization_mode_flare)
281 call ionization_build_temperature_table(hi_fraction_flare)
282 case (ionization_mode_prominence)
283 call ionization_build_prominence_table()
285 ionization_initialized = .true.
288 subroutine ionization_build_temperature_table(HI_fraction)
291 double precision,
intent(in) :: hi_fraction(n_tonly)
292 double precision :: fact1, fact2, fact3
293 double precision :: dl1, dl2, te_table_step
294 double precision :: iz_h_source(n_tonly)
295 integer :: i, j, n_interpolated_table
298 n_interpolated_table=4000
301 iz_h_source=1.d0-hi_fraction
303 allocate(te_h_table(1:n_interpolated_table))
304 allocate(iz_h_table(1:n_interpolated_table))
308 te_table_step = (t_h_fraction_k(n_tonly)-t_h_fraction_k(1)) &
309 /dble(n_interpolated_table-1)
311 te_h_table(1) = t_h_fraction_k(1)
312 iz_h_table(1) = iz_h_source(1)
314 te_h_table(n_interpolated_table) = t_h_fraction_k(n_tonly)
315 iz_h_table(n_interpolated_table) = iz_h_source(n_tonly)
317 do i=2,n_interpolated_table
318 te_h_table(i) = te_h_table(i-1)+te_table_step
321 if(te_h_table(i) < t_h_fraction_k(j+1))
then
322 if(j.eq. n_tonly-1)
then
323 fact1 = (te_h_table(i)-t_h_fraction_k(j+1)) &
324 /(t_h_fraction_k(j)-t_h_fraction_k(j+1))
326 fact2 = (te_h_table(i)-t_h_fraction_k(j)) &
327 /(t_h_fraction_k(j+1)-t_h_fraction_k(j))
329 iz_h_table(i) = iz_h_source(j)*fact1 + &
330 iz_h_source(j+1)*fact2
333 dl1 = iz_h_source(j+1)-iz_h_source(j)
334 dl2 = iz_h_source(j+2)-iz_h_source(j+1)
335 jump = (max(dabs(dl1),dabs(dl2)) > &
336 2.d0*min(dabs(dl1),dabs(dl2)))
340 fact1 = (te_h_table(i)-t_h_fraction_k(j+1)) &
341 /(t_h_fraction_k(j)-t_h_fraction_k(j+1))
343 fact2 = (te_h_table(i)-t_h_fraction_k(j)) &
344 /(t_h_fraction_k(j+1)-t_h_fraction_k(j))
346 iz_h_table(i) = iz_h_source(j)*fact1 + &
347 iz_h_source(j+1)*fact2
350 fact1 = ((te_h_table(i)-t_h_fraction_k(j+1)) &
351 * (te_h_table(i)-t_h_fraction_k(j+2))) &
352 / ((t_h_fraction_k(j)-t_h_fraction_k(j+1)) &
353 * (t_h_fraction_k(j)-t_h_fraction_k(j+2)))
355 fact2 = ((te_h_table(i)-t_h_fraction_k(j)) &
356 * (te_h_table(i)-t_h_fraction_k(j+2))) &
357 / ((t_h_fraction_k(j+1)-t_h_fraction_k(j)) &
358 * (t_h_fraction_k(j+1)-t_h_fraction_k(j+2)))
360 fact3 = ((te_h_table(i)-t_h_fraction_k(j)) &
361 * (te_h_table(i)-t_h_fraction_k(j+1))) &
362 / ((t_h_fraction_k(j+2)-t_h_fraction_k(j)) &
363 * (t_h_fraction_k(j+2)-t_h_fraction_k(j+1)))
365 iz_h_table(i) = iz_h_source(j)*fact1 + &
366 iz_h_source(j+1)*fact2 + iz_h_source(j+2)*fact3
374 te_table_min=te_h_table(1)
375 te_table_max=te_h_table(n_interpolated_table)
376 inv_te_table_step = &
377 dble(n_interpolated_table-1)/(te_table_max-te_table_min)
379 call ionization_build_eos_table()
380 end subroutine ionization_build_temperature_table
382 subroutine ionization_build_prominence_table()
387 double precision :: pressure_unit_cgs
388 double precision ::
dt, rfactor
391 call mpistop(
"invalid units for prominence ionization table")
402 allocate(prom_t_table(n_prom_t))
403 allocate(prom_p_table(n_prom_p))
404 allocate(prom_t_eos_table(n_prom_eos))
405 allocate(prom_y_eos_table(n_prom_eos,n_prom_p))
408 prom_p_table = prom_p_cgs/pressure_unit_cgs
410 dt = (1.d6 - 2.1000005d3) / dble(n_prom_eos-1)
411 do it = 1, n_prom_eos
412 prom_t_eos_table(
it) = &
417 do it = 1, n_prom_eos
419 prom_y_eos_table(
it,ip) = &
420 rfactor*prom_t_eos_table(
it)
424 call ionization_check_prominence_y_table()
425 end subroutine ionization_build_prominence_table
427 subroutine ionization_prominence_pressure_bracket(p, ip, weight)
428 double precision,
intent(in) :: p
429 integer,
intent(out) :: ip
430 double precision,
intent(out) :: weight
433 double precision :: p_use
435 p_use = min(prom_p_table(n_prom_p), &
436 max(prom_p_table(1), p))
438 if (p_use <= prom_p_table(1))
then
442 else if (p_use >= prom_p_table(n_prom_p))
then
449 if (p_use <= prom_p_table(j+1))
then
451 weight = (p_use-prom_p_table(j)) / &
452 (prom_p_table(j+1)-prom_p_table(j))
456 end subroutine ionization_prominence_pressure_bracket
462 integer,
intent(in) :: ixi^
l, ixo^
l
463 double precision,
intent(in) :: te(ixi^s)
464 double precision,
intent(out) :: iz_h(ixo^s), iz_he(ixo^s)
466 double precision :: rtmp
468 {
do ix^db=ixomin^db,ixomax^db\}
469 call ionization_state_from_temperature_scalar( &
470 te(ix^
d), rtmp, iz_h(ix^
d), iz_he(ix^
d))
474 subroutine ionization_h_degree_temperature_scalar(T, iz_H)
477 double precision,
intent(in) :: t
478 double precision,
intent(out) :: iz_h
482 if (.not.
allocated(te_h_table) .or. &
483 .not.
allocated(iz_h_table))
then
484 call mpistop(
"temperature-only ionization table is not initialized")
487 if (t < te_table_min)
then
489 else if (t >= te_table_max)
then
492 i = int((t-te_table_min)*inv_te_table_step) + 1
493 i = max(1, min(
size(te_h_table)-1, i))
495 iz_h = iz_h_table(i) + &
496 (t-te_h_table(i)) * &
497 (iz_h_table(i+1)-iz_h_table(i)) * &
501 iz_h = min(1.d0, max(0.d0, iz_h))
502 end subroutine ionization_h_degree_temperature_scalar
504 subroutine ionization_h_degree_prominence_scalar(T, p, iz_H)
507 double precision,
intent(in) :: t, p
508 double precision,
intent(out) :: iz_h
511 double precision :: weight_t, weight_p
512 double precision :: iz_low, iz_high
514 if (.not.
allocated(prom_t_table) .or. &
515 .not.
allocated(prom_p_table))
then
516 call mpistop(
"prominence ionization table is not initialized")
519 call ionization_prominence_pressure_bracket(p, ip, weight_p)
521 if (t <= prom_t_table(1))
then
524 else if (t >= prom_t_table(n_prom_t))
then
530 if (t <= prom_t_table(j+1))
then
536 weight_t = (t-prom_t_table(it)) / &
537 (prom_t_table(it+1)-prom_t_table(it))
540 if (it == 1 .and. weight_t == 0.d0)
then
541 iz_h = (1.d0-weight_p)*prom_iz_h_data(1,ip) + &
542 weight_p*prom_iz_h_data(1,ip+1)
544 iz_low = (1.d0-weight_p)*prom_iz_h_data(it,ip) + &
545 weight_p*prom_iz_h_data(it,ip+1)
547 iz_high = (1.d0-weight_p)*prom_iz_h_data(it+1,ip) + &
548 weight_p*prom_iz_h_data(it+1,ip+1)
550 iz_h = (1.d0-weight_t)*iz_low + weight_t*iz_high
553 iz_h = min(1.d0, max(0.d0, iz_h))
554 end subroutine ionization_h_degree_prominence_scalar
558 double precision,
intent(in) :: rho, p
559 double precision,
intent(out) :: t, rfactor
560 double precision,
intent(out),
optional :: iz_h, iz_he
562 double precision :: y
563 double precision :: iz_h_loc, iz_he_loc
565 if (.not. ionization_initialized)
then
566 call mpistop(
"ionization tables are not initialized")
569 if (rho <= 0.d0 .or. p <= 0.d0)
then
570 select case (ionization_table_mode)
571 case (ionization_mode_chromosphere, ionization_mode_flare)
573 case (ionization_mode_prominence)
574 t = prom_t_eos_table(1)
579 select case (ionization_table_mode)
580 case (ionization_mode_chromosphere, ionization_mode_flare)
581 call ionization_invert_y_scalar(y, t)
583 case (ionization_mode_prominence)
584 call ionization_invert_y_prominence_scalar(y, p, t)
587 call mpistop(
"invalid ionization table mode")
593 if (
present(iz_h)) iz_h = iz_h_loc
594 if (
present(iz_he)) iz_he = iz_he_loc
597 subroutine ionization_he_degree_scalar(T, iz_He)
600 double precision,
intent(in) :: t
601 double precision,
intent(out) :: iz_he
603 if (t < te_low_iz_he)
then
610 iz_he = min(1.d0, max(0.d0, iz_he))
611 end subroutine ionization_he_degree_scalar
616 double precision,
intent(in) :: t, p
617 double precision,
intent(out) :: rfactor
618 double precision,
intent(out),
optional :: iz_h, iz_he
620 double precision :: iz_h_loc, iz_he_loc
622 select case (ionization_table_mode)
623 case (ionization_mode_chromosphere, ionization_mode_flare)
624 call ionization_h_degree_temperature_scalar(t, iz_h_loc)
626 case (ionization_mode_prominence)
627 call ionization_h_degree_prominence_scalar( &
631 call mpistop(
"invalid ionization table mode")
634 call ionization_he_degree_scalar(t, iz_he_loc)
636 iz_h_loc = min(1.d0, max(0.d0, iz_h_loc))
637 iz_he_loc = min(1.d0, max(0.d0, iz_he_loc))
639 rfactor = ionization_rfactor_from_degrees( &
642 if (
present(iz_h)) iz_h = iz_h_loc
643 if (
present(iz_he)) iz_he = iz_he_loc
649 integer,
parameter :: max_iter = 80
650 double precision,
intent(in) :: rho, t
651 double precision,
intent(out) :: p, rfactor
654 double precision :: plo, phi, pmid
655 double precision :: rlo, rhi, rmid
656 double precision :: fhi, fmid, scale
658 if (.not. ionization_initialized)
then
659 call mpistop(
"ionization pressure solver called before initialization")
661 if (rho <= 0.d0 .or. t <= 0.d0)
then
662 call mpistop(
"invalid rho or T in ionization pressure solver")
666 call ionization_state_from_temperature_scalar(t, rfactor)
672 plo = prom_p_table(1)
681 phi = prom_p_table(n_prom_p)
692 do iter = 1, max_iter
693 pmid = 0.5d0*(plo+phi)
695 fmid = pmid-rho*rmid*t
696 scale = max(abs(pmid), abs(rho*rmid*t), tiny(1.d0))
698 if (abs(fmid) <= 1.d-12*scale)
then
704 if (fmid > 0.d0)
then
711 call mpistop(
"pressure-dependent EOS solve did not converge")
715 integer,
intent(in) :: ixi^l, ixo^l
716 double precision,
intent(in) :: rho(ixi^s), p(ixi^s)
717 double precision,
intent(out) :: t(ixi^s), rfactor(ixi^s)
718 double precision,
intent(out),
optional :: iz_h(ixi^s), iz_he(ixi^s)
720 double precision :: iz_h_loc, iz_he_loc
723 {
do ix^db=ixomin^db,ixomax^db\}
725 rfactor(ix^d), iz_h_loc, iz_he_loc)
727 if (
present(iz_h)) iz_h(ix^d) = iz_h_loc
728 if (
present(iz_he)) iz_he(ix^d) = iz_he_loc
732 subroutine ionization_invert_y_scalar(y, T)
734 double precision,
intent(in) :: y
735 double precision,
intent(out) :: t
737 integer :: ilo, ihi, imid, n
738 double precision :: denom
740 if (.not.
allocated(y_table) .or. .not.
allocated(rfactor_table))
then
741 call mpistop(
"ionization_invert_y_scalar: EOS tables are not initialized")
747 call mpistop(
"ionization_invert_y_scalar: EOS table has fewer than 2 points")
755 if (y < y_table_min)
then
756 if (rfactor_table(1) > 0.d0)
then
757 t = max(tiny(1.d0), y/rfactor_table(1))
764 if (y >= y_table_max)
then
765 if (rfactor_table(n) > 0.d0)
then
766 t = y/rfactor_table(n)
776 do while (ihi - ilo > 1)
778 if (y >= y_table(imid))
then
785 denom = y_table(ilo+1) - y_table(ilo)
787 if (denom <= max(tiny(denom), 1.d-12*dabs(y_table(ilo))))
then
788 call mpistop(
"ionization_invert_y_scalar: non-increasing Y_table interval")
791 t = te_h_table(ilo) + (y - y_table(ilo)) * &
792 (te_h_table(ilo+1) - te_h_table(ilo))/denom
793 end subroutine ionization_invert_y_scalar
795 subroutine ionization_state_from_temperature_scalar(T, Rfactor, iz_H, iz_He)
798 double precision,
intent(in) :: t
799 double precision,
intent(out) :: rfactor
800 double precision,
intent(out),
optional :: iz_h, iz_he
801 double precision :: iz_h_loc, iz_he_loc
804 call mpistop(
"temperature-only ionization state requested "// &
805 "for a pressure-dependent table")
808 select case (ionization_table_mode)
809 case (ionization_mode_chromosphere, ionization_mode_flare)
810 call ionization_h_degree_temperature_scalar(t, iz_h_loc)
812 call ionization_he_degree_scalar(t, iz_he_loc)
814 rfactor = ionization_rfactor_from_degrees( &
817 if (
present(iz_h)) iz_h = iz_h_loc
818 if (
present(iz_he)) iz_he = iz_he_loc
819 end subroutine ionization_state_from_temperature_scalar
821 subroutine ionization_check_prominence_y_table()
826 do it = 1, n_prom_eos-1
827 if (prom_y_eos_table(it+1,ip) <= &
828 prom_y_eos_table(it,ip))
then
829 call mpistop(
"prominence EOS Y(T,p) is not monotonic")
833 end subroutine ionization_check_prominence_y_table
835 subroutine ionization_invert_y_prominence_scalar(y, p, T)
838 double precision,
intent(in) :: y, p
839 double precision,
intent(out) :: t
841 integer :: ip, ilo, ihi, imid
842 double precision :: wp, ylo, yhi, ymid
843 double precision :: ymin, ymax, rend, denom
845 if (.not.
allocated(prom_y_eos_table))
then
846 call mpistop(
"prominence EOS inversion table is missing")
849 call ionization_prominence_pressure_bracket(p, ip, wp)
851 ymin = (1.d0-wp)*prom_y_eos_table(1,ip) + &
852 wp*prom_y_eos_table(1,ip+1)
854 ymax = (1.d0-wp)*prom_y_eos_table(n_prom_eos,ip) + &
855 wp*prom_y_eos_table(n_prom_eos,ip+1)
858 t = prom_t_eos_table(1)
863 rend = ymin/prom_t_eos_table(1)
864 t = max(tiny(1.d0), y/rend)
869 rend = ymax/prom_t_eos_table(n_prom_eos)
877 do while (ihi-ilo > 1)
879 ymid = (1.d0-wp)*prom_y_eos_table(imid,ip) + &
880 wp*prom_y_eos_table(imid,ip+1)
889 ylo = (1.d0-wp)*prom_y_eos_table(ilo,ip) + &
890 wp*prom_y_eos_table(ilo,ip+1)
892 yhi = (1.d0-wp)*prom_y_eos_table(ilo+1,ip) + &
893 wp*prom_y_eos_table(ilo+1,ip+1)
896 if (denom <= max(tiny(denom),1.d-12*abs(ylo)))
then
897 call mpistop(
"invalid prominence EOS inversion interval")
900 t = prom_t_eos_table(ilo) + (y-ylo) * &
901 (prom_t_eos_table(ilo+1)-prom_t_eos_table(ilo)) / &
903 end subroutine ionization_invert_y_prominence_scalar
905 subroutine ionization_build_eos_table()
908 double precision :: iz_h, iz_he
910 if (.not.
allocated(te_h_table) .or. .not.
allocated(iz_h_table))
then
911 call mpistop(
"ionization_build_eos_table: ionization tables are not initialized")
914 if (
allocated(rfactor_table))
deallocate(rfactor_table)
915 if (
allocated(y_table))
deallocate(y_table)
916 if (
allocated(eps_ion_h_table))
deallocate(eps_ion_h_table)
921 call mpistop(
"ionization_build_eos_table: Te_H_table has fewer than 2 points")
924 allocate(rfactor_table(1:n))
925 allocate(y_table(1:n))
926 if (ionization_include_energy)
allocate(eps_ion_h_table(1:n))
929 call ionization_state_from_temperature_scalar( &
930 te_h_table(i), rfactor_table(i), iz_h, iz_he)
931 y_table(i) = rfactor_table(i)*te_h_table(i)
932 if (ionization_include_energy)
then
933 eps_ion_h_table(i) = ionization_eps_ion_of_degrees(iz_h, iz_he)
937 y_table_min = y_table(1)
938 y_table_max = y_table(n)
940 call ionization_check_y_table()
941 end subroutine ionization_build_eos_table
943 subroutine ionization_check_y_table()
947 if (.not.
allocated(y_table))
then
948 call mpistop(
"ionization_check_y_table: Y_table is not allocated")
951 if (
size(y_table) < 2)
then
952 call mpistop(
"ionization_check_y_table: Y_table has fewer than 2 points")
955 do i = 1,
size(y_table)-1
956 if (y_table(i+1) <= y_table(i))
then
957 call mpistop(
"ionization_check_y_table: Y(T)=Rfactor(T)*T is not strictly increasing")
960 end subroutine ionization_check_y_table
962 double precision function ionization_rfactor_from_degrees(iz_H, iz_He)
963 double precision,
intent(in) :: iz_h, iz_he
965 ionization_rfactor_from_degrees = &
966 (1.d0 + iz_h + ionization_he_abundance * &
967 (1.d0 + iz_he*(1.d0 + iz_he))) / ionization_rfactor_norm
968 end function ionization_rfactor_from_degrees
976 double precision function ionization_eps_ion_of_degrees(iz_H, iz_He)
result(eps_ion)
977 double precision,
intent(in) :: iz_h, iz_he
979 eps_ion = ionization_h_energy_unit*iz_h &
980 + ionization_he_abundance * ( ionization_hei_energy_unit*iz_he &
981 + ionization_heii_energy_unit*iz_he*iz_he )
982 end function ionization_eps_ion_of_degrees
985 double precision,
intent(in) :: t
986 double precision,
intent(out) :: rfactor
988 call ionization_state_from_temperature_scalar(t, rfactor)
993 ionization_table_mode == ionization_mode_chromosphere .or. &
994 ionization_table_mode == ionization_mode_flare
997 logical function ionization_includes_energy()
998 ionization_includes_energy = ionization_include_energy
999 end function ionization_includes_energy
1001 double precision function ionization_eint_table_value(i, invgam)
1002 integer,
intent(in) :: i
1003 double precision,
intent(in) :: invgam
1005 ionization_eint_table_value = &
1006 y_table(i)*invgam + eps_ion_h_table(i)
1007 end function ionization_eint_table_value
1009 subroutine ionization_check_eint_table(invgam)
1011 double precision,
intent(in) :: invgam
1013 double precision :: eps1, eps2
1015 if (.not. ionization_include_energy)
return
1016 if (.not.
allocated(eps_ion_h_table))
then
1017 call mpistop(
"ionization-energy table is not initialized")
1019 if (invgam <= 0.d0)
then
1020 call mpistop(
"invalid inverse gamma minus one for ionization EOS")
1023 do i = 1,
size(y_table)-1
1024 eps1 = ionization_eint_table_value(i, invgam)
1025 eps2 = ionization_eint_table_value(i+1, invgam)
1026 if (eps2 <= eps1)
then
1027 call mpistop(
"ionization specific-energy table is not monotonic")
1030 end subroutine ionization_check_eint_table
1032 subroutine ionization_invert_eint_scalar(eps, invgam, T)
1035 double precision,
intent(in) :: eps, invgam
1036 double precision,
intent(out) :: t
1038 integer :: ilo, ihi, imid, n, iter
1039 double precision :: eps_min, eps_max, eps_lo, eps_hi, denom
1040 double precision :: eps_eval, slope, rfactor, iz_h, iz_he, tnew
1042 if (.not. ionization_include_energy .or. &
1043 .not.
allocated(eps_ion_h_table))
then
1044 call mpistop(
"ionization-energy EOS is not initialized")
1046 if (invgam <= 0.d0)
then
1047 call mpistop(
"invalid inverse gamma minus one in energy inversion")
1051 eps_min = ionization_eint_table_value(1, invgam)
1052 eps_max = ionization_eint_table_value(n, invgam)
1054 if (eps < eps_min)
then
1057 t = max(tiny(1.d0), &
1058 (eps-eps_ion_h_table(1))/(rfactor_table(1)*invgam))
1062 if (eps >= eps_max)
then
1063 t = max(tiny(1.d0), &
1064 (eps-eps_ion_h_table(n))/(rfactor_table(n)*invgam))
1070 do while (ihi-ilo > 1)
1072 if (eps >= ionization_eint_table_value(imid, invgam))
then
1079 eps_lo = ionization_eint_table_value(ilo, invgam)
1080 eps_hi = ionization_eint_table_value(ilo+1, invgam)
1081 denom = eps_hi-eps_lo
1082 if (denom <= max(tiny(denom), 1.
d-12*abs(eps_lo)))
then
1083 call mpistop(
"invalid ionization-energy inversion interval")
1086 t = te_h_table(ilo) + (eps-eps_lo) * &
1087 (te_h_table(ilo+1)-te_h_table(ilo))/denom
1092 slope = denom/(te_h_table(ilo+1)-te_h_table(ilo))
1094 call ionization_state_from_temperature_scalar( &
1095 t, rfactor, iz_h, iz_he)
1096 eps_eval = rfactor*t*invgam + ionization_eps_ion_of_degrees(iz_h, iz_he)
1097 if (abs(eps_eval-eps) <= &
1098 1.
d-12*max(abs(eps), tiny(1.d0)))
exit
1099 tnew = t-(eps_eval-eps)/slope
1100 t = max(te_h_table(ilo), min(te_h_table(ilo+1), tnew))
1102 if (iter > 3 .and. .not. pi_newton_warned .and.
mype == 0)
then
1103 pi_newton_warned = .true.
1104 write(*,*)
"WARNING: PI eint->T Newton inversion did not fully converge ", &
1105 "in 3 iterations; using the last iterate (interval-clamped). ", &
1106 "Further occurrences are not reported."
1108 end subroutine ionization_invert_eint_scalar
1111 rho, eint, invgam, T, p, Rfactor, iz_H, iz_He)
1113 double precision,
intent(in) :: rho, eint, invgam
1114 double precision,
intent(out) :: t, p, rfactor
1115 double precision,
intent(out),
optional :: iz_h, iz_he
1116 double precision :: iz_h_loc, iz_he_loc
1118 if (.not. ionization_include_energy) &
1119 call mpistop(
"ionization-energy EOS is not enabled")
1121 call mpistop(
"ionization-energy EOS requires a T-only table")
1122 if (rho <= 0.d0 .or. eint <= 0.d0) &
1123 call mpistop(
"invalid rho or eint in ionization EOS")
1124 call ionization_invert_eint_scalar(eint/rho, invgam, t)
1125 call ionization_state_from_temperature_scalar( &
1126 t, rfactor, iz_h_loc, iz_he_loc)
1128 if (
present(iz_h)) iz_h = iz_h_loc
1129 if (
present(iz_he)) iz_he = iz_he_loc
1133 rho, T, invgam, p, eint, Rfactor, iz_H, iz_He)
1135 double precision,
intent(in) :: rho, t, invgam
1136 double precision,
intent(out) :: p, eint, rfactor
1137 double precision,
intent(out),
optional :: iz_h, iz_he
1138 double precision :: iz_h_loc, iz_he_loc
1140 if (rho <= 0.d0 .or. t <= 0.d0 .or. invgam <= 0.d0)
then
1141 call mpistop(
"invalid state in rho,T ionization EOS mapping")
1144 if (ionization_include_energy)
then
1146 call mpistop(
"ionization energy requires a T-only ionization table")
1148 call ionization_state_from_temperature_scalar( &
1149 t, rfactor, iz_h_loc, iz_he_loc)
1151 eint = rho*(rfactor*t*invgam + &
1152 ionization_eps_ion_of_degrees(iz_h_loc, iz_he_loc))
1159 if (
present(iz_h)) iz_h = iz_h_loc
1160 if (
present(iz_he)) iz_he = iz_he_loc
1163 subroutine ionization_get_eps_derivative_t( &
1164 T, invgam, eps, deps_dT, dq_dT_out)
1166 double precision,
intent(in) :: t, invgam
1167 double precision,
intent(out) :: eps, deps_dt
1168 double precision,
intent(out),
optional :: dq_dt_out
1171 double precision :: rfactor, iz_h, iz_he, q, dq_dt, depsion_dt
1173 if (.not. ionization_include_energy)
then
1174 call mpistop(
"ionization-energy derivative requested while disabled")
1177 call mpistop(
"ionization-energy derivative requires a T-only table")
1179 if (t <= 0.d0 .or. invgam <= 0.d0)
then
1180 call mpistop(
"invalid state in ionization-energy derivative")
1183 n =
size(te_h_table)
1184 call ionization_state_from_temperature_scalar(t, rfactor, iz_h, iz_he)
1186 eps = q*invgam + ionization_eps_ion_of_degrees(iz_h, iz_he)
1188 if (t < te_table_min)
then
1189 dq_dt = rfactor_table(1)
1191 else if (t >= te_table_max)
then
1192 dq_dt = rfactor_table(n)
1195 i = int((t-te_table_min)*inv_te_table_step) + 1
1196 i = max(1, min(n-1, i))
1197 dq_dt = (y_table(i+1)-y_table(i)) / &
1198 (te_h_table(i+1)-te_h_table(i))
1199 depsion_dt = (eps_ion_h_table(i+1)-eps_ion_h_table(i)) / &
1200 (te_h_table(i+1)-te_h_table(i))
1203 deps_dt = dq_dt*invgam + depsion_dt
1204 if (deps_dt <= 0.d0)
then
1205 call mpistop(
"non-positive heat capacity in ionization EOS")
1207 if (
present(dq_dt_out)) dq_dt_out = dq_dt
1208 end subroutine ionization_get_eps_derivative_t
1211 double precision,
intent(in) :: t, invgam
1212 double precision,
intent(out) :: csound2
1214 double precision :: rfactor, q, eps, deps_dt, dq_dt
1216 call ionization_get_eps_derivative_t( &
1217 t, invgam, eps, deps_dt, dq_dt)
1218 call ionization_state_from_temperature_scalar(t, rfactor)
1220 csound2 = q*(1.d0+dq_dt/deps_dt)
subroutine, public mpistop(message)
Exit MPI-AMRVAC with an error message.
Module for physical and numeric constants.
double precision, parameter const_ev
PI (partial-ionisation) ionisation-degree backend for the eos% family.
logical function, public ionization_is_temperature_only()
subroutine, public ionization_get_state(ixil, ixol, rho, p, t, rfactor, iz_h, iz_he)
subroutine, public ionization_get_state_scalar(rho, p, t, rfactor, iz_h, iz_he)
subroutine, public ionization_get_p_eint_from_rho_t(rho, t, invgam, p, eint, rfactor, iz_h, iz_he)
subroutine, public ionization_degree_init(he_abundance, rfactor_norm, table_name, include_energy)
subroutine, public ionization_solve_p_rfactor(rho, t, p, rfactor)
subroutine, public ionization_degree_from_temperature(ixil, ixol, te, iz_h, iz_he)
Array interface for T -> ionization degrees. Used by get_Rfactor_tonly_PI (mod_eos_PI) to build the n...
subroutine, public ionization_get_state_from_eint(rho, eint, invgam, t, p, rfactor, iz_h, iz_he)
subroutine, public ionization_state_tp(t, p, rfactor, iz_h, iz_he)
subroutine, public ionization_get_csound2_t(t, invgam, csound2)
subroutine, public ionization_get_rfactor_from_temperature(t, rfactor)
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer it
Number of time steps taken.
double precision unit_numberdensity
Physical scaling factor for number density.
double precision unit_pressure
Physical scaling factor for pressure.
integer mype
The rank of the current MPI task.
double precision dt
global time step
double precision, dimension(:), allocatable, parameter d
double precision unit_temperature
Physical scaling factor for temperature.
logical si_unit
Use SI units (.true.) or use cgs units (.false.)