MPI-AMRVAC 3.2
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
Loading...
Searching...
No Matches
mod_eos_PI_tables.t
Go to the documentation of this file.
1!=============================================================================
2!> PI (partial-ionisation) ionisation-degree backend for the eos% family.
3!>
4!> The physics library behind mod_eos_PI (the eos_type='PI' adapter): given the
5!> thermodynamic state it returns the hydrogen/helium ionisation degrees, the
6!> R-factor (mean inverse molecular weight) and -- in energy mode -- the
7!> ionisation energy. Standalone: depends only on mod_global_parameters /
8!> mod_constants / mod_comm_lib, never on mod_eos*, so eos% -> ionisation is
9!> acyclic. The analogue for PI of mod_eos_LTE_tables for LTE.
10!>
11!> Three interchangeable tables (eos%pi_table), selected at init:
12!> chromosphere -- T-only H I/H fraction, Carlsson & Leenaarts (2012, A&A 539 A39)
13!> flare -- T-only H I/H fraction, Hong, Carlsson & Ding (2022, A&A 661 A77)
14!> prominence -- (T,p) H ionisation, Heinzel et al. (2015, A&A 579 A16) +
15!> Gunar et al. (2025, A&A 699 A89); model A, side illumination, L=500 km.
16!> Hydrogen ionisation is tabulated (interpolated to a 4000-point fine grid);
17!> helium is a semi-analytic Saha-like fit. The R-factor is
18!> R = (1 + iz_H + A_He*(1 + iz_He*(1 + iz_He))) / Rfactor_norm,
19!> with Rfactor_norm = 2 + 3*A_He set by the adapter so R -> 1 at full ionisation
20!> under the FI code-unit normalisation. Energy mode folds 13.6 eV per ionised H
21!> into eint. The map Y(T) = R(T)*T = p/rho is monotonic, so (rho,p) -> T inverts
22!> by bisection (T-only) or pressure-bisection (prominence); energy mode inverts
23!> eint -> T by Newton.
24!>
25!> Public API: ionization_degree_init (once, after units) + the state-query
26!> routines consumed by mod_eos_PI (get_state[_scalar], state_Tp, solve_p_Rfactor,
27!> get_state_from_eint, get_p_eint_from_rho_T, get_eps_derivative_T,
28!> get_csound2_T, the predicates and the legacy degree-from-temperature shim).
29!=============================================================================
31 implicit none
32 private
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
46 !> He ionisation-energy units (code units per ionised electron), set in
47 !> ionization_degree_init when energy mode is on. The two stages match the
48 !> electron-count model used by the R-factor (electrons per He =
49 !> iz_He*(1+iz_He) = iz_He + iz_He**2): first stage iz_He at chi_HeI, second
50 !> stage iz_He**2 at chi_HeII. Zero in no-energy mode.
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
58 ! chromosphere: T-only ionization table based on
59 ! Carlsson & Leenaarts (2012, A&A, 539, A39).
60 integer, parameter :: ionization_mode_chromosphere = 1
61 ! prominence: pressure-dependent prominence ionization table based on
62 ! Heinzel et al. (2015, A&A, 579, A16) and
63 ! Gunar et al. (2025, A&A, 699, A89). The bundled table uses model A,
64 ! side illumination, and the L = 500 km voxel from the latter work.
65 integer, parameter :: ionization_mode_prominence = 2
66 ! flare: T-only hydrogen H I/H fraction table for flaring chromosphere
67 ! conditions from Hong, Carlsson & Ding (2022, A&A, 661, A77). It is
68 ! handled by the same T-only H-fraction machinery as the chromosphere
69 ! table.
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
75 ! Initialize
77 ! Current rho,p -> complete EOS state
78 public :: ionization_get_state
80 ! Prescribed T,p -> Rfactor and optional ionization degrees
81 public :: ionization_state_tp
82 ! Prescribed rho,T -> consistent pthermal and Rfactor
84 ! T-only cooling callback and mode query
90 ! ionization_includes_energy, ionization_get_eps_derivative_T,
91 ! ionization_check_eint_table and ionization_state_from_temperature_scalar
92 ! are PRIVATE: only ever called inside this module (no external importer in
93 ! src/), so they are not part of the backend's public surface.
94 ! Legacy compatibility API (used by get_Rfactor_tonly_PI in mod_eos_PI)
96 logical :: ionization_initialized = .false.
97 logical :: ionization_include_energy = .false.
98 !> One-shot guard so a non-converged eint->T Newton inversion warns once
99 !> (rank 0) instead of spamming every offending cell every substep.
100 logical :: pi_newton_warned = .false.
101
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 /)
105
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 /)
108
109 ! First index: temperature. Second index: pressure.
110 ! Data are ordered one complete temperature column per pressure.
111 double precision, parameter :: &
112 prom_iz_H_data(n_prom_T,n_prom_p) = reshape((/ &
113 ! p = 0.03 dyn cm^-2
114 0.53d0, 0.59d0, 0.65d0, 0.73d0, 0.80d0, &
115 0.90d0, 0.95d0, 0.98d0, 0.99d0, 1.00d0, &
116 ! p = 0.05 dyn cm^-2
117 0.40d0, 0.47d0, 0.56d0, 0.69d0, 0.79d0, &
118 0.91d0, 0.96d0, 0.98d0, 0.99d0, 1.00d0, &
119 ! p = 0.10 dyn cm^-2
120 0.25d0, 0.32d0, 0.47d0, 0.67d0, 0.81d0, &
121 0.93d0, 0.97d0, 0.99d0, 0.99d0, 1.00d0, &
122 ! p = 0.30 dyn cm^-2
123 0.10d0, 0.17d0, 0.41d0, 0.69d0, 0.85d0, &
124 0.96d0, 0.98d0, 0.99d0, 1.00d0, 1.00d0, &
125 ! p = 0.50 dyn cm^-2
126 0.06d0, 0.14d0, 0.38d0, 0.70d0, 0.87d0, &
127 0.97d0, 0.99d0, 1.00d0, 1.00d0, 1.00d0, &
128 ! p = 0.70 dyn cm^-2
129 0.04d0, 0.12d0, 0.36d0, 0.70d0, 0.88d0, &
130 0.97d0, 0.99d0, 1.00d0, 1.00d0, 1.00d0, &
131 ! p = 1.00 dyn cm^-2
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 /))
135
136 ! H I/H population fraction from Hong, Carlsson & Ding
137 ! (2022, A&A, 661, A77). Its temperature grid is identical to
138 ! T_H_fraction_K.
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 /)
160
161 ! Common temperature grid for the T-only H-fraction tables. The
162 ! Carlsson & Leenaarts (2012) and Hong et al. (2022) grids coincide.
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 /
183
184 ! Chromospheric H I/H fraction from
185 ! Carlsson, M., & Leenaarts, J. 2012, A&A, 539, A39.
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 /
206
207 contains
208
209 subroutine ionization_degree_init(He_abundance, Rfactor_norm, table_name, include_energy)
212 use mod_constants, only: const_ev
213 use mod_comm_lib, only: mpistop
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.0d-7
219 double precision :: energy_unit
220
221 if (ionization_initialized) then
222 call mpistop("ionization_degree_init called more than once")
223 end if
224
225 if (he_abundance < 0.d0) call mpistop("negative He abundance")
226 if (rfactor_norm <= 0.d0) call mpistop("invalid Rfactor normalization")
227
228 ionization_he_abundance = he_abundance
229 ionization_rfactor_norm = rfactor_norm
230 te_low_iz_he = 5413.d0/unit_temperature
231 ionization_include_energy = .false.
232 if (present(include_energy)) ionization_include_energy = include_energy
233
234 selected_table = "chromosphere"
235 if (present(table_name)) selected_table = trim(adjustl(table_name))
236
237 select case (trim(selected_table))
238 case ("chromosphere")
239 ionization_table_mode = ionization_mode_chromosphere
240 case ("flare")
241 ionization_table_mode = ionization_mode_flare
242 case ("prominence")
243 ionization_table_mode = ionization_mode_prominence
244 case default
245 call mpistop( &
246 "Unknown ionization table. Use 'chromosphere', 'flare', "// &
247 "or 'prominence'.")
248 end select
249
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.")
255 end if
256
257 if (ionization_include_energy) then
258 if (unit_numberdensity <= 0.d0 .or. unit_pressure <= 0.d0) then
259 call mpistop("invalid units for hydrogen ionization energy")
260 end if
261 ! eV -> code-units-per-particle factor (const_eV is erg/eV; in SI the
262 ! pressure unit is in joule, so convert erg->joule first).
263 if (si_unit) then
264 energy_unit = const_ev*erg_to_joule*unit_numberdensity/unit_pressure
265 else
267 end if
268 ionization_h_energy_unit = 13.6d0 * energy_unit ! chi_H
269 ionization_hei_energy_unit = 24.59d0 * energy_unit ! chi_He I
270 ionization_heii_energy_unit = 54.42d0 * energy_unit ! chi_He II
271 else
272 ionization_h_energy_unit = 0.d0
273 ionization_hei_energy_unit = 0.d0
274 ionization_heii_energy_unit = 0.d0
275 end if
276
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()
284 end select
285 ionization_initialized = .true.
286 end subroutine ionization_degree_init
287
288 subroutine ionization_build_temperature_table(HI_fraction)
290
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
296 logical :: jump
297
298 n_interpolated_table=4000
299
300 ! The source tables store H I/H; the EOS uses H II/H.
301 iz_h_source=1.d0-hi_fraction
302
303 allocate(te_h_table(1:n_interpolated_table))
304 allocate(iz_h_table(1:n_interpolated_table))
305 te_h_table=zero
306 iz_h_table=zero
307
308 te_table_step = (t_h_fraction_k(n_tonly)-t_h_fraction_k(1)) &
309 /dble(n_interpolated_table-1)
310
311 te_h_table(1) = t_h_fraction_k(1)
312 iz_h_table(1) = iz_h_source(1)
313
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)
316
317 do i=2,n_interpolated_table
318 te_h_table(i) = te_h_table(i-1)+te_table_step
319 do j=1,n_tonly-1
320 ! Second order interpolation except at the outer edge or a jump.
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))
325
326 fact2 = (te_h_table(i)-t_h_fraction_k(j)) &
327 /(t_h_fraction_k(j+1)-t_h_fraction_k(j))
328
329 iz_h_table(i) = iz_h_source(j)*fact1 + &
330 iz_h_source(j+1)*fact2
331 exit
332 else
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)))
337 end if
338
339 if(jump) then
340 fact1 = (te_h_table(i)-t_h_fraction_k(j+1)) &
341 /(t_h_fraction_k(j)-t_h_fraction_k(j+1))
342
343 fact2 = (te_h_table(i)-t_h_fraction_k(j)) &
344 /(t_h_fraction_k(j+1)-t_h_fraction_k(j))
345
346 iz_h_table(i) = iz_h_source(j)*fact1 + &
347 iz_h_source(j+1)*fact2
348 exit
349 else
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)))
354
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)))
359
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)))
364
365 iz_h_table(i) = iz_h_source(j)*fact1 + &
366 iz_h_source(j+1)*fact2 + iz_h_source(j+2)*fact3
367 exit
368 end if
369 end if
370 end do
371 end do
372
373 te_h_table=te_h_table/unit_temperature
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)
378
379 call ionization_build_eos_table()
380 end subroutine ionization_build_temperature_table
381
382 subroutine ionization_build_prominence_table()
384 use mod_comm_lib, only: mpistop
385
386 integer :: it, ip
387 double precision :: pressure_unit_cgs
388 double precision :: dt, rfactor
389
390 if (unit_temperature <= 0.d0 .or. unit_pressure <= 0.d0) then
391 call mpistop("invalid units for prominence ionization table")
392 end if
393
394 if (si_unit) then
395 ! unit_pressure is Pa; 1 Pa = 10 dyn cm^-2.
396 pressure_unit_cgs = 10.d0*unit_pressure
397 else
398 ! In cgs mode unit_pressure is already dyn cm^-2.
399 pressure_unit_cgs = unit_pressure
400 end if
401
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))
406
407 prom_t_table = prom_t_k/unit_temperature
408 prom_p_table = prom_p_cgs/pressure_unit_cgs
409
410 dt = (1.d6 - 2.1000005d3) / dble(n_prom_eos-1)
411 do it = 1, n_prom_eos
412 prom_t_eos_table(it) = &
413 (2.1000005d3 + dble(it-1)*dt)/unit_temperature
414 end do
415
416 do ip = 1, n_prom_p
417 do it = 1, n_prom_eos
418 call ionization_state_tp(prom_t_eos_table(it), prom_p_table(ip), rfactor)
419 prom_y_eos_table(it,ip) = &
420 rfactor*prom_t_eos_table(it)
421 end do
422 end do
423
424 call ionization_check_prominence_y_table()
425 end subroutine ionization_build_prominence_table
426
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
431
432 integer :: j
433 double precision :: p_use
434
435 p_use = min(prom_p_table(n_prom_p), &
436 max(prom_p_table(1), p))
437
438 if (p_use <= prom_p_table(1)) then
439 ip = 1
440 weight = 0.d0
441 return
442 else if (p_use >= prom_p_table(n_prom_p)) then
443 ip = n_prom_p-1
444 weight = 1.d0
445 return
446 end if
447
448 do j = 1, n_prom_p-1
449 if (p_use <= prom_p_table(j+1)) then
450 ip = j
451 weight = (p_use-prom_p_table(j)) / &
452 (prom_p_table(j+1)-prom_p_table(j))
453 return
454 end if
455 end do
456 end subroutine ionization_prominence_pressure_bracket
457
458 !> Array interface for T -> ionization degrees. Used by get_Rfactor_tonly_PI
459 !> (mod_eos_PI) to build the no-energy chromosphere/flare R-factor block.
460 subroutine ionization_degree_from_temperature(ixI^L,ixO^L,Te,iz_H,iz_He)
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)
465 integer :: ix^d
466 double precision :: rtmp
467
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))
471 {end do\}
473
474 subroutine ionization_h_degree_temperature_scalar(T, iz_H)
475 use mod_comm_lib, only: mpistop
476
477 double precision, intent(in) :: t
478 double precision, intent(out) :: iz_h
479
480 integer :: i
481
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")
485 end if
486
487 if (t < te_table_min) then
488 iz_h = 0.d0
489 else if (t >= te_table_max) then
490 iz_h = 1.d0
491 else
492 i = int((t-te_table_min)*inv_te_table_step) + 1
493 i = max(1, min(size(te_h_table)-1, i))
494
495 iz_h = iz_h_table(i) + &
496 (t-te_h_table(i)) * &
497 (iz_h_table(i+1)-iz_h_table(i)) * &
498 inv_te_table_step
499 end if
500
501 iz_h = min(1.d0, max(0.d0, iz_h))
502 end subroutine ionization_h_degree_temperature_scalar
503
504 subroutine ionization_h_degree_prominence_scalar(T, p, iz_H)
505 use mod_comm_lib, only: mpistop
506
507 double precision, intent(in) :: t, p
508 double precision, intent(out) :: iz_h
509
510 integer :: it, ip, j
511 double precision :: weight_t, weight_p
512 double precision :: iz_low, iz_high
513
514 if (.not. allocated(prom_t_table) .or. &
515 .not. allocated(prom_p_table)) then
516 call mpistop("prominence ionization table is not initialized")
517 end if
518
519 call ionization_prominence_pressure_bracket(p, ip, weight_p)
520
521 if (t <= prom_t_table(1)) then
522 it = 1
523 weight_t = 0.d0
524 else if (t >= prom_t_table(n_prom_t)) then
525 iz_h = 1.d0
526 return
527 else
528 it = 1
529 do j = 1, n_prom_t-1
530 if (t <= prom_t_table(j+1)) then
531 it = j
532 exit
533 end if
534 end do
535
536 weight_t = (t-prom_t_table(it)) / &
537 (prom_t_table(it+1)-prom_t_table(it))
538 end if
539
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)
543 else
544 iz_low = (1.d0-weight_p)*prom_iz_h_data(it,ip) + &
545 weight_p*prom_iz_h_data(it,ip+1)
546
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)
549
550 iz_h = (1.d0-weight_t)*iz_low + weight_t*iz_high
551 end if
552
553 iz_h = min(1.d0, max(0.d0, iz_h))
554 end subroutine ionization_h_degree_prominence_scalar
555
556 subroutine ionization_get_state_scalar(rho, p, T, Rfactor, iz_H, iz_He)
557 use mod_comm_lib, only: mpistop
558 double precision, intent(in) :: rho, p
559 double precision, intent(out) :: t, rfactor
560 double precision, intent(out), optional :: iz_h, iz_he
561
562 double precision :: y
563 double precision :: iz_h_loc, iz_he_loc
564
565 if (.not. ionization_initialized) then
566 call mpistop("ionization tables are not initialized")
567 end if
568
569 if (rho <= 0.d0 .or. p <= 0.d0) then
570 select case (ionization_table_mode)
571 case (ionization_mode_chromosphere, ionization_mode_flare)
572 t = te_h_table(1)
573 case (ionization_mode_prominence)
574 t = prom_t_eos_table(1)
575 end select
576 else
577 y = p/rho
578
579 select case (ionization_table_mode)
580 case (ionization_mode_chromosphere, ionization_mode_flare)
581 call ionization_invert_y_scalar(y, t)
582
583 case (ionization_mode_prominence)
584 call ionization_invert_y_prominence_scalar(y, p, t)
585
586 case default
587 call mpistop("invalid ionization table mode")
588 end select
589 end if
590
591 call ionization_state_tp( t, p, rfactor, iz_h_loc, iz_he_loc)
592
593 if (present(iz_h)) iz_h = iz_h_loc
594 if (present(iz_he)) iz_he = iz_he_loc
595 end subroutine ionization_get_state_scalar
596
597 subroutine ionization_he_degree_scalar(T, iz_He)
599
600 double precision, intent(in) :: t
601 double precision, intent(out) :: iz_he
602
603 if (t < te_low_iz_he) then
604 iz_he = 1.0084814d-4
605 else
606 iz_he = 1.d0 - &
607 10.d0**(0.322571d0-5.96d-5*t*unit_temperature)
608 end if
609
610 iz_he = min(1.d0, max(0.d0, iz_he))
611 end subroutine ionization_he_degree_scalar
612
613 subroutine ionization_state_tp(T, p, Rfactor, iz_H, iz_He)
614 use mod_comm_lib, only: mpistop
615
616 double precision, intent(in) :: t, p
617 double precision, intent(out) :: rfactor
618 double precision, intent(out), optional :: iz_h, iz_he
619
620 double precision :: iz_h_loc, iz_he_loc
621
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)
625
626 case (ionization_mode_prominence)
627 call ionization_h_degree_prominence_scalar( &
628 t, p, iz_h_loc)
629
630 case default
631 call mpistop("invalid ionization table mode")
632 end select
633
634 call ionization_he_degree_scalar(t, iz_he_loc)
635
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))
638
639 rfactor = ionization_rfactor_from_degrees( &
640 iz_h_loc, iz_he_loc)
641
642 if (present(iz_h)) iz_h = iz_h_loc
643 if (present(iz_he)) iz_he = iz_he_loc
644 end subroutine ionization_state_tp
645
646 subroutine ionization_solve_p_rfactor(rho, T, p, Rfactor)
647 use mod_comm_lib, only: mpistop
648
649 integer, parameter :: max_iter = 80
650 double precision, intent(in) :: rho, t
651 double precision, intent(out) :: p, rfactor
652
653 integer :: iter
654 double precision :: plo, phi, pmid
655 double precision :: rlo, rhi, rmid
656 double precision :: fhi, fmid, scale
657
658 if (.not. ionization_initialized) then
659 call mpistop("ionization pressure solver called before initialization")
660 end if
661 if (rho <= 0.d0 .or. t <= 0.d0) then
662 call mpistop("invalid rho or T in ionization pressure solver")
663 end if
664
666 call ionization_state_from_temperature_scalar(t, rfactor)
667 p = rho*rfactor*t
668 return
669 end if
670
671 ! Low-pressure clamp branch
672 plo = prom_p_table(1)
673 call ionization_state_tp(t, plo, rlo)
674 p = rho*rlo*t
675 if (p <= plo) then
676 rfactor = rlo
677 return
678 end if
679
680 ! High-pressure clamp branch
681 phi = prom_p_table(n_prom_p)
682 call ionization_state_tp(t, phi, rhi)
683 p = rho*rhi*t
684 if (p >= phi) then
685 rfactor = rhi
686 return
687 end if
688
689 ! Bracket is guaranteed: the two clamp branches above return whenever
690 ! f(p)=p-rho*R(p)*T does NOT change sign across [plo,phi], so reaching here
691 ! implies f(plo)<0 and f(phi)>0 -- a sign change, hence a root for bisection.
692 do iter = 1, max_iter
693 pmid = 0.5d0*(plo+phi)
694 call ionization_state_tp(t, pmid, rmid)
695 fmid = pmid-rho*rmid*t
696 scale = max(abs(pmid), abs(rho*rmid*t), tiny(1.d0))
697
698 if (abs(fmid) <= 1.d-12*scale) then
699 p = pmid
700 rfactor = rmid
701 return
702 end if
703
704 if (fmid > 0.d0) then
705 phi = pmid
706 else
707 plo = pmid
708 end if
709 end do
710
711 call mpistop("pressure-dependent EOS solve did not converge")
712 end subroutine ionization_solve_p_rfactor
713
714 subroutine ionization_get_state(ixI^L, ixO^L, rho, p, T, Rfactor, iz_H, iz_He)
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)
719
720 double precision :: iz_h_loc, iz_he_loc
721 integer :: ix^d
722
723 {do ix^db=ixomin^db,ixomax^db\}
724 call ionization_get_state_scalar(rho(ix^d), p(ix^d), t(ix^d), &
725 rfactor(ix^d), iz_h_loc, iz_he_loc)
726
727 if (present(iz_h)) iz_h(ix^d) = iz_h_loc
728 if (present(iz_he)) iz_he(ix^d) = iz_he_loc
729 {end do\}
730 end subroutine ionization_get_state
731
732 subroutine ionization_invert_y_scalar(y, T)
733 use mod_comm_lib, only: mpistop
734 double precision, intent(in) :: y
735 double precision, intent(out) :: t
736
737 integer :: ilo, ihi, imid, n
738 double precision :: denom
739
740 if (.not. allocated(y_table) .or. .not. allocated(rfactor_table)) then
741 call mpistop("ionization_invert_y_scalar: EOS tables are not initialized")
742 end if
743
744 n = size(y_table)
745
746 if (n < 2) then
747 call mpistop("ionization_invert_y_scalar: EOS table has fewer than 2 points")
748 end if
749
750 if (y <= 0.d0) then
751 t = te_h_table(1)
752 return
753 end if
754
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))
758 else
759 t = te_h_table(1)
760 end if
761 return
762 end if
763
764 if (y >= y_table_max) then
765 if (rfactor_table(n) > 0.d0) then
766 t = y/rfactor_table(n)
767 else
768 t = te_h_table(n)
769 end if
770 return
771 end if
772
773 ilo = 1
774 ihi = n
775
776 do while (ihi - ilo > 1)
777 imid = (ilo + ihi)/2
778 if (y >= y_table(imid)) then
779 ilo = imid
780 else
781 ihi = imid
782 end if
783 end do
784
785 denom = y_table(ilo+1) - y_table(ilo)
786
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")
789 end if
790
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
794
795 subroutine ionization_state_from_temperature_scalar(T, Rfactor, iz_H, iz_He)
796 use mod_comm_lib, only: mpistop
797
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
802
803 if (.not. ionization_is_temperature_only()) then
804 call mpistop("temperature-only ionization state requested "// &
805 "for a pressure-dependent table")
806 end if
807
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)
811 end select
812 call ionization_he_degree_scalar(t, iz_he_loc)
813
814 rfactor = ionization_rfactor_from_degrees( &
815 iz_h_loc, iz_he_loc)
816
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
820
821 subroutine ionization_check_prominence_y_table()
822 use mod_comm_lib, only: mpistop
823 integer :: it, ip
824
825 do ip = 1, n_prom_p
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")
830 end if
831 end do
832 end do
833 end subroutine ionization_check_prominence_y_table
834
835 subroutine ionization_invert_y_prominence_scalar(y, p, T)
836 use mod_comm_lib, only: mpistop
837
838 double precision, intent(in) :: y, p
839 double precision, intent(out) :: t
840
841 integer :: ip, ilo, ihi, imid
842 double precision :: wp, ylo, yhi, ymid
843 double precision :: ymin, ymax, rend, denom
844
845 if (.not. allocated(prom_y_eos_table)) then
846 call mpistop("prominence EOS inversion table is missing")
847 end if
848
849 call ionization_prominence_pressure_bracket(p, ip, wp)
850
851 ymin = (1.d0-wp)*prom_y_eos_table(1,ip) + &
852 wp*prom_y_eos_table(1,ip+1)
853
854 ymax = (1.d0-wp)*prom_y_eos_table(n_prom_eos,ip) + &
855 wp*prom_y_eos_table(n_prom_eos,ip+1)
856
857 if (y <= 0.d0) then
858 t = prom_t_eos_table(1)
859 return
860 end if
861
862 if (y < ymin) then
863 rend = ymin/prom_t_eos_table(1)
864 t = max(tiny(1.d0), y/rend)
865 return
866 end if
867
868 if (y >= ymax) then
869 rend = ymax/prom_t_eos_table(n_prom_eos)
870 t = y/rend
871 return
872 end if
873
874 ilo = 1
875 ihi = n_prom_eos
876
877 do while (ihi-ilo > 1)
878 imid = (ilo+ihi)/2
879 ymid = (1.d0-wp)*prom_y_eos_table(imid,ip) + &
880 wp*prom_y_eos_table(imid,ip+1)
881
882 if (y >= ymid) then
883 ilo = imid
884 else
885 ihi = imid
886 end if
887 end do
888
889 ylo = (1.d0-wp)*prom_y_eos_table(ilo,ip) + &
890 wp*prom_y_eos_table(ilo,ip+1)
891
892 yhi = (1.d0-wp)*prom_y_eos_table(ilo+1,ip) + &
893 wp*prom_y_eos_table(ilo+1,ip+1)
894
895 denom = yhi-ylo
896 if (denom <= max(tiny(denom),1.d-12*abs(ylo))) then
897 call mpistop("invalid prominence EOS inversion interval")
898 end if
899
900 t = prom_t_eos_table(ilo) + (y-ylo) * &
901 (prom_t_eos_table(ilo+1)-prom_t_eos_table(ilo)) / &
902 denom
903 end subroutine ionization_invert_y_prominence_scalar
904
905 subroutine ionization_build_eos_table()
906 use mod_comm_lib, only: mpistop
907 integer :: i, n
908 double precision :: iz_h, iz_he
909
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")
912 end if
913
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)
917
918 n = size(te_h_table)
919
920 if (n < 2) then
921 call mpistop("ionization_build_eos_table: Te_H_table has fewer than 2 points")
922 end if
923
924 allocate(rfactor_table(1:n))
925 allocate(y_table(1:n))
926 if (ionization_include_energy) allocate(eps_ion_h_table(1:n))
927
928 do i = 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)
934 end if
935 end do
936
937 y_table_min = y_table(1)
938 y_table_max = y_table(n)
939
940 call ionization_check_y_table()
941 end subroutine ionization_build_eos_table
942
943 subroutine ionization_check_y_table()
944 use mod_comm_lib, only: mpistop
945 integer :: i
946
947 if (.not. allocated(y_table)) then
948 call mpistop("ionization_check_y_table: Y_table is not allocated")
949 end if
950
951 if (size(y_table) < 2) then
952 call mpistop("ionization_check_y_table: Y_table has fewer than 2 points")
953 end if
954
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")
958 end if
959 end do
960 end subroutine ionization_check_y_table
961
962 double precision function ionization_rfactor_from_degrees(iz_H, iz_He)
963 double precision, intent(in) :: iz_h, iz_he
964
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
969
970 !> Ionisation energy per nH (code units) from the H/He degrees -- the energy
971 !> analogue of ionization_Rfactor_from_degrees, and the single source for the
972 !> ion-energy term in eint. The He electron-count model matches the R-factor:
973 !> electrons per He = iz_He*(1+iz_He) = iz_He (first stage, chi_HeI) + iz_He**2
974 !> (second stage, chi_HeII), so p and eint derive from the SAME iz_H,iz_He.
975 !> All *_energy_unit are 0 in no-energy mode, so this returns 0 there.
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
978
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
983
985 double precision, intent(in) :: t
986 double precision, intent(out) :: rfactor
987
988 call ionization_state_from_temperature_scalar(t, rfactor)
990
993 ionization_table_mode == ionization_mode_chromosphere .or. &
994 ionization_table_mode == ionization_mode_flare
996
997 logical function ionization_includes_energy()
998 ionization_includes_energy = ionization_include_energy
999 end function ionization_includes_energy
1000
1001 double precision function ionization_eint_table_value(i, invgam)
1002 integer, intent(in) :: i
1003 double precision, intent(in) :: invgam
1004
1005 ionization_eint_table_value = &
1006 y_table(i)*invgam + eps_ion_h_table(i)
1007 end function ionization_eint_table_value
1008
1009 subroutine ionization_check_eint_table(invgam)
1010 use mod_comm_lib, only: mpistop
1011 double precision, intent(in) :: invgam
1012 integer :: i
1013 double precision :: eps1, eps2
1014
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")
1018 end if
1019 if (invgam <= 0.d0) then
1020 call mpistop("invalid inverse gamma minus one for ionization EOS")
1021 end if
1022
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")
1028 end if
1029 end do
1030 end subroutine ionization_check_eint_table
1031
1032 subroutine ionization_invert_eint_scalar(eps, invgam, T)
1033 use mod_comm_lib, only: mpistop
1034 use mod_global_parameters, only: mype
1035 double precision, intent(in) :: eps, invgam
1036 double precision, intent(out) :: t
1037
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
1041
1042 if (.not. ionization_include_energy .or. &
1043 .not. allocated(eps_ion_h_table)) then
1044 call mpistop("ionization-energy EOS is not initialized")
1045 end if
1046 if (invgam <= 0.d0) then
1047 call mpistop("invalid inverse gamma minus one in energy inversion")
1048 end if
1049
1050 n = size(y_table)
1051 eps_min = ionization_eint_table_value(1, invgam)
1052 eps_max = ionization_eint_table_value(n, invgam)
1053
1054 if (eps < eps_min) then
1055 ! Below the tabulated eion energy range this is floor/illegal-state
1056 ! recovery, not a strictly conservative EOS inversion.
1057 t = max(tiny(1.d0), &
1058 (eps-eps_ion_h_table(1))/(rfactor_table(1)*invgam))
1059 return
1060 end if
1061
1062 if (eps >= eps_max) then
1063 t = max(tiny(1.d0), &
1064 (eps-eps_ion_h_table(n))/(rfactor_table(n)*invgam))
1065 return
1066 end if
1067
1068 ilo = 1
1069 ihi = n
1070 do while (ihi-ilo > 1)
1071 imid = (ilo+ihi)/2
1072 if (eps >= ionization_eint_table_value(imid, invgam)) then
1073 ilo = imid
1074 else
1075 ihi = imid
1076 end if
1077 end do
1078
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")
1084 end if
1085
1086 t = te_h_table(ilo) + (eps-eps_lo) * &
1087 (te_h_table(ilo+1)-te_h_table(ilo))/denom
1088
1089 ! The tabulated value supplies a close initial guess. Correct it against
1090 ! the actual interpolated ionization state so rho,eint -> T and
1091 ! rho,T -> eint remain mutually consistent inside each table interval.
1092 slope = denom/(te_h_table(ilo+1)-te_h_table(ilo))
1093 do iter = 1, 3
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))
1101 end do
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."
1107 end if
1108 end subroutine ionization_invert_eint_scalar
1109
1111 rho, eint, invgam, T, p, Rfactor, iz_H, iz_He)
1112 use mod_comm_lib, only: mpistop
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
1117
1118 if (.not. ionization_include_energy) &
1119 call mpistop("ionization-energy EOS is not enabled")
1120 if (.not. ionization_is_temperature_only()) &
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)
1127 p = rho*rfactor*t
1128 if (present(iz_h)) iz_h = iz_h_loc
1129 if (present(iz_he)) iz_he = iz_he_loc
1130 end subroutine ionization_get_state_from_eint
1131
1133 rho, T, invgam, p, eint, Rfactor, iz_H, iz_He)
1134 use mod_comm_lib, only: mpistop
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
1139
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")
1142 end if
1143
1144 if (ionization_include_energy) then
1145 if (.not. ionization_is_temperature_only()) then
1146 call mpistop("ionization energy requires a T-only ionization table")
1147 end if
1148 call ionization_state_from_temperature_scalar( &
1149 t, rfactor, iz_h_loc, iz_he_loc)
1150 p = rho*rfactor*t
1151 eint = rho*(rfactor*t*invgam + &
1152 ionization_eps_ion_of_degrees(iz_h_loc, iz_he_loc))
1153 else
1154 call ionization_solve_p_rfactor(rho, t, p, rfactor)
1155 call ionization_state_tp(t, p, rfactor, iz_h_loc, iz_he_loc)
1156 eint = p*invgam
1157 end if
1158
1159 if (present(iz_h)) iz_h = iz_h_loc
1160 if (present(iz_he)) iz_he = iz_he_loc
1162
1163 subroutine ionization_get_eps_derivative_t( &
1164 T, invgam, eps, deps_dT, dq_dT_out)
1165 use mod_comm_lib, only: mpistop
1166 double precision, intent(in) :: t, invgam
1167 double precision, intent(out) :: eps, deps_dt
1168 double precision, intent(out), optional :: dq_dt_out
1169
1170 integer :: i, n
1171 double precision :: rfactor, iz_h, iz_he, q, dq_dt, depsion_dt
1172
1173 if (.not. ionization_include_energy) then
1174 call mpistop("ionization-energy derivative requested while disabled")
1175 end if
1176 if (.not. ionization_is_temperature_only()) then
1177 call mpistop("ionization-energy derivative requires a T-only table")
1178 end if
1179 if (t <= 0.d0 .or. invgam <= 0.d0) then
1180 call mpistop("invalid state in ionization-energy derivative")
1181 end if
1182
1183 n = size(te_h_table)
1184 call ionization_state_from_temperature_scalar(t, rfactor, iz_h, iz_he)
1185 q = rfactor*t
1186 eps = q*invgam + ionization_eps_ion_of_degrees(iz_h, iz_he)
1187
1188 if (t < te_table_min) then
1189 dq_dt = rfactor_table(1)
1190 depsion_dt = 0.d0
1191 else if (t >= te_table_max) then
1192 dq_dt = rfactor_table(n)
1193 depsion_dt = 0.d0
1194 else
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))
1201 end if
1202
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")
1206 end if
1207 if (present(dq_dt_out)) dq_dt_out = dq_dt
1208 end subroutine ionization_get_eps_derivative_t
1209
1210 subroutine ionization_get_csound2_t(T, invgam, csound2)
1211 double precision, intent(in) :: t, invgam
1212 double precision, intent(out) :: csound2
1213
1214 double precision :: rfactor, q, eps, deps_dt, dq_dt
1215
1216 call ionization_get_eps_derivative_t( &
1217 t, invgam, eps, deps_dt, dq_dt)
1218 call ionization_state_from_temperature_scalar(t, rfactor)
1219 q = rfactor*t
1220 csound2 = q*(1.d0+dq_dt/deps_dt)
1221 end subroutine ionization_get_csound2_t
1222
1223end module mod_eos_pi_tables
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.)