├── src ├── modules │ ├── init │ │ ├── set_gravity_grid.f90 │ │ ├── set_IC.f90 │ │ ├── init.f90 │ │ ├── set_energy_vectors.f90 │ │ ├── define_grid.f90 │ │ └── parameters.f90 │ ├── time_step │ │ ├── eval_dt.f90 │ │ └── RK_rhs.f90 │ ├── states │ │ ├── Source.f90 │ │ ├── PLM_rec.f90 │ │ ├── Apply_BC.f90 │ │ └── Reconstruction.f90 │ ├── nonlinear_system_solver │ │ ├── System_H.f90 │ │ ├── System_implicit_adv_H.f90 │ │ ├── r1mpyq.f90 │ │ ├── System_HeH.f90 │ │ ├── System_implicit_adv_HeH.f90 │ │ ├── qrfac.f90 │ │ ├── System_HeH_TR.f90 │ │ ├── T_equation.f90 │ │ ├── System_implicit_adv_HeH_TR.f90 │ │ ├── r1updt.f90 │ │ ├── qform.f90 │ │ ├── enorm.f90 │ │ ├── hybrd1.f90 │ │ ├── fdjac1.f90 │ │ ├── dogleg.f90 │ │ └── dpmpar.f90 │ ├── functions │ │ ├── grav_field.f90 │ │ ├── UW_conversions.f90 │ │ ├── cross_sec.f90 │ │ └── utilities.f90 │ ├── radiation │ │ ├── J_inc.f90 │ │ ├── sed_read.f90 │ │ ├── ionization_equilibrium.f90 │ │ └── util_ion_eq.f90 │ ├── files_IO │ │ ├── write_output.f90 │ │ ├── load_IC.f90 │ │ ├── write_setup_report.f90 │ │ └── input_read.f90 │ ├── flux │ │ ├── speed_estimate_HLLC.f90 │ │ ├── speed_estimate_ROE.f90 │ │ └── Num_Fluxes.f90 │ └── post_process │ │ └── post_process_adv.f90 └── utils │ ├── params_table.txt │ ├── glob.py │ └── gen_file.py ├── LICENCE.md ├── eta_approx.py ├── run_ATES.sh ├── README.md ├── ATES_plots.py └── ATES_main.f90 /src/modules/init/set_gravity_grid.f90: -------------------------------------------------------------------------------- 1 | module gravity_grid_construction 2 | ! Pre-evaluate gravity on cell centers and at interfaces 3 | 4 | use global_parameters 5 | use grav_func 6 | 7 | contains 8 | 9 | subroutine set_gravity_grid 10 | ! Subroutine to evaluate the gravitational potential on 11 | ! cell centers and edges 12 | 13 | ! Evaluate gravity at cell centers 14 | Gphi_c = (/ ( phi(r(j)), j = 1-Ng,N+Ng) /) 15 | 16 | ! Evaluate gravity at cell interfaces 17 | Gphi_i = (/ ( phi(r_edg(j)), j = 1-Ng,N+Ng) /) 18 | 19 | ! End of subroutine 20 | end subroutine set_gravity_grid 21 | 22 | ! End of module 23 | end module gravity_grid_construction 24 | -------------------------------------------------------------------------------- /src/modules/time_step/eval_dt.f90: -------------------------------------------------------------------------------- 1 | module eval_time_step 2 | 3 | use global_parameters 4 | 5 | implicit none 6 | 7 | contains 8 | 9 | subroutine eval_dt(W,dt) 10 | ! Subroutine to evaluate the time step according to the CFL condition 11 | real*8, dimension(1-Ng:N+Ng,3), intent(in) :: W 12 | real*8, dimension(1-Ng:N+Ng) :: rho,v,p,cs 13 | real*8 :: alpha 14 | real*8, intent(out) :: dt 15 | 16 | ! Extract physical variables 17 | rho = W(:,1) 18 | v = W(:,2) 19 | p = W(:,3) 20 | 21 | ! Evaluate sound speed 22 | cs = sqrt(g*p/rho) 23 | 24 | ! Maximum eigenvalue 25 | alpha = maxval(abs(v) + cs) 26 | 27 | ! Evaluate time step according to CFL condition 28 | dt = CFL*minval(dr_j/(abs(v) + cs)) 29 | 30 | ! End of subroutine 31 | end subroutine eval_dt 32 | 33 | ! End of module 34 | end module eval_time_step -------------------------------------------------------------------------------- /src/modules/states/Source.f90: -------------------------------------------------------------------------------- 1 | module source_func 2 | ! Subroutine to evaluate the source function 3 | ! (gravitational + geometrical) 4 | 5 | use global_parameters 6 | use Conversion 7 | use grav_func 8 | 9 | implicit none 10 | 11 | contains 12 | 13 | subroutine source(j,dr,dAp,dAm,dV,u,WR,WL,S) 14 | integer, intent(in) :: j 15 | real*8, intent(in) :: dr,dAp,dAm,dV 16 | real*8, intent(in) :: u(3),WR(3),WL(3) 17 | real*8 :: rhoL,rhoR 18 | real*8 :: pC 19 | real*8, intent(out) :: S(3) 20 | 21 | !--- Extract physical quantities ---! 22 | 23 | ! Density 24 | rhoL = WR(1) 25 | rhoR = WL(1) 26 | 27 | ! Central ressure 28 | pC = (g-1.0)*(u(3)-0.5*u(2)*u(2)/u(1)) 29 | 30 | !--- Evaluare source term ---! 31 | 32 | S(1) = 0.0 33 | S(2) = - 0.5*(rhoL + rhoR)*(Gphi_i(j) - Gphi_i(j-1))/dr 34 | S(3) = 0.0 35 | 36 | ! Add source term explicitly if PLM is used 37 | if (use_plm) S(2) = S(2) + (dAp-dAm)/dV*pC 38 | 39 | ! End of subroutine 40 | end subroutine source 41 | 42 | ! End of module 43 | end module source_func 44 | -------------------------------------------------------------------------------- /LICENCE.md: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 Andrea Caldiroli 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/System_H.f90: -------------------------------------------------------------------------------- 1 | module System_H 2 | ! Ionization equilibrium system with only H 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine ion_system_H(Neq,x,fvec,iflag,params) 11 | 12 | integer :: Neq,iflag 13 | real*8 :: x(Neq),fvec(Neq) 14 | real*8 :: g_hi ! Photoionization rates 15 | real*8 :: b_hi ! Collisional ionization rates 16 | real*8 :: a_hii ! Recombination rates 17 | real*8 :: params(25) 18 | real*8 :: n_h,n_e 19 | real*8 :: n_hi,n_hii 20 | 21 | ! Coefficients of the system 22 | 23 | g_hi = params(1) ! = P_HI 24 | a_hii = params(2) ! = rchiiB 25 | n_h = params(3) ! = nh 26 | b_hi = params(4) ! = a_ion_HI 27 | 28 | ! Species densities 29 | n_hi = (1.0-x(1))*n_h 30 | n_hii = x(1)*n_h 31 | 32 | ! Electron density 33 | n_e = n_hii 34 | 35 | ! System of equations 36 | fvec(1) = n_hi*g_hi + (n_hi*b_hi - a_hii*n_hii)*n_e 37 | 38 | ! End of subroutine 39 | end subroutine ion_system_H 40 | 41 | ! End of module 42 | end module System_H 43 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/System_implicit_adv_H.f90: -------------------------------------------------------------------------------- 1 | module System_implicit_adv_H 2 | ! Ionization equilibrium system with both H and He 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine adv_implicit_H(Neq,x,fvec,iflag,params) 11 | 12 | integer :: Neq,iflag 13 | real*8 :: x(Neq),fvec(Neq) 14 | real*8 :: xhi_old 15 | real*8 :: ghi 16 | real*8 :: xhi,xhii,xe 17 | real*8 :: c1 18 | real*8 :: n_h 19 | real*8 :: ahii 20 | real*8 :: ionhi 21 | real*8 :: params(25) 22 | 23 | 24 | ! Coefficients of the system 25 | c1 = params(1) ! = dr/v 26 | xhi_old = params(2) ! = nhi/nh 27 | n_h = params(3) ! = nh 28 | ghi = params(4) ! = P_HI 29 | ahii = params(5) ! = rchiiB 30 | ionhi = params(6) ! = a_ion_HI 31 | 32 | ! Substitutions 33 | xhi = x(1) 34 | xhii = 1.0 - x(1) 35 | 36 | ! Electron density 37 | xe = xhii 38 | 39 | ! System of equations 40 | fvec(1) = xhi_old - x(1) & 41 | + c1*(-(ghi+ionhi*xe*n_h)*xhi + ahii*xhii*xe*n_h) 42 | 43 | ! End of subroutine 44 | end subroutine adv_implicit_H 45 | 46 | ! End of module 47 | end module System_implicit_adv_H 48 | -------------------------------------------------------------------------------- /src/modules/functions/grav_field.f90: -------------------------------------------------------------------------------- 1 | module grav_func 2 | ! Expression for the gravitational field and for its derivative 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | !-------------------------------------------------------! 11 | 12 | ! Gravitational field strenght (function) 13 | double precision function phi(r_in) 14 | real*8, intent(in) :: r_in 15 | 16 | phi = -b0/r_in & 17 | -b0*Mrapp/(atilde-r_in) & 18 | -b0*(1.0+Mrapp)/(2.0*atilde**3.0)* & 19 | (atilde*Mrapp/(1.0+Mrapp)-r_in)**2.0 20 | 21 | ! End of function 22 | end function phi 23 | 24 | !-------------------------------------------------------! 25 | 26 | ! Gravitational field gradient 27 | double precision function Dphi(r_in) 28 | real*8, intent(in) :: r_in 29 | 30 | DPhi = b0/r_in**2.0 & 31 | -b0*Mrapp/(atilde-r_in)**2.0 & 32 | +b0*(1.0 + Mrapp)/atilde**3.0* & 33 | (atilde*Mrapp/(1.0+Mrapp)-r_in) 34 | 35 | ! End of function 36 | end function Dphi 37 | 38 | ! End of module 39 | end module grav_func 40 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/r1mpyq.f90: -------------------------------------------------------------------------------- 1 | subroutine r1mpyq(m,n,a,lda,v,w) 2 | integer m,n,lda 3 | double precision a(lda,n),v(n),w(n) 4 | 5 | integer i,j,nmj,nm1 6 | double precision cos,one,sin,temp 7 | data one /1.0d0/ 8 | 9 | nm1 = n - 1 10 | if (nm1 .lt. 1) go to 50 11 | do 20 nmj = 1, nm1 12 | j = n - nmj 13 | if (dabs(v(j)) .gt. one) cos = one/v(j) 14 | if (dabs(v(j)) .gt. one) sin = dsqrt(one-cos**2) 15 | if (dabs(v(j)) .le. one) sin = v(j) 16 | if (dabs(v(j)) .le. one) cos = dsqrt(one-sin**2) 17 | do 10 i = 1, m 18 | temp = cos*a(i,j) - sin*a(i,n) 19 | a(i,n) = sin*a(i,j) + cos*a(i,n) 20 | a(i,j) = temp 21 | 10 continue 22 | 20 continue 23 | 24 | do 40 j = 1, nm1 25 | if (dabs(w(j)) .gt. one) cos = one/w(j) 26 | if (dabs(w(j)) .gt. one) sin = dsqrt(one-cos**2) 27 | if (dabs(w(j)) .le. one) sin = w(j) 28 | if (dabs(w(j)) .le. one) cos = dsqrt(one-sin**2) 29 | do 30 i = 1, m 30 | temp = cos*a(i,j) + sin*a(i,n) 31 | a(i,n) = -sin*a(i,j) + cos*a(i,n) 32 | a(i,j) = temp 33 | 30 continue 34 | 40 continue 35 | 50 continue 36 | return 37 | 38 | end 39 | -------------------------------------------------------------------------------- /src/utils/params_table.txt: -------------------------------------------------------------------------------- 1 | 55Cnce 0.168 0.025 2000.0 0.0156 0.930 27.220 28.160 2 | GJ1214b 0.248 0.019 560.0 0.0147 0.170 26.200 27.020 3 | GJ3470b 0.409 0.045 706.0 0.0357 0.540 27.580 28.110 4 | GJ436b 0.346 0.072 634.0 0.0291 0.470 26.520 27.460 5 | GJ9827b 0.153 0.012 1147.0 0.0200 0.730 26.850 27.810 6 | GJ9827c 0.120 0.009 794.0 0.0418 0.730 26.850 27.810 7 | GJ9827d 0.196 0.018 665.0 0.0596 0.730 26.850 27.810 8 | HAT-P-11b 0.439 0.081 879.0 0.0524 0.800 27.750 28.330 9 | HAT-P-20b 1.101 8.312 944.0 0.0390 0.930 28.030 28.430 10 | HD149026b 0.741 0.282 1760.0 0.0410 1.090 27.720 28.600 11 | HD189733b 1.193 1.237 1183.0 0.0330 0.940 28.420 28.680 12 | HD209458b 1.401 0.720 1450.0 0.0480 1.200 26.390 27.830 13 | HD97658b 0.195 0.028 744.0 0.0851 0.910 27.250 28.070 14 | LHS1140b 0.144 0.019 217.0 0.0941 0.180 26.130 26.960 15 | LHS1140c 0.103 0.005 407.0 0.0269 0.180 26.130 26.960 16 | WASP-10b 1.027 2.914 1015.0 0.0360 0.650 28.300 28.510 17 | WASP-18b 1.231 10.030 2449.0 0.0200 1.220 26.820 28.120 18 | WASP-38b 1.202 3.272 1252.0 0.0830 1.620 28.120 28.260 19 | WASP-43b 1.020 2.044 1366.0 0.0153 0.720 27.840 28.310 20 | WASP-69b 1.066 0.265 995.0 0.0460 0.850 28.260 28.620 21 | WASP-77b 1.235 1.695 1701.0 0.0240 0.940 28.220 28.640 22 | WASP-8b 1.088 2.329 930.0 0.0838 1.180 28.530 28.800 23 | WASP-80b 1.017 0.586 811.0 0.0360 0.650 27.700 28.210 24 | -------------------------------------------------------------------------------- /src/modules/radiation/J_inc.f90: -------------------------------------------------------------------------------- 1 | module J_incident 2 | ! Energy-dependent incident spectrum 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | double precision function J_inc(E) 11 | real*8, intent(in) :: E 12 | real*8 :: Lrapp,J_X,J_EUV 13 | real*8 :: JEUVnorm,JXnorm 14 | real*8 :: P1 15 | 16 | ! Substitution 17 | P1 = PLind + 1.0 18 | 19 | ! Ratio of luminosities 20 | Lrapp = 10.0**(LX-LEUV) 21 | 22 | ! X-ray Flux 23 | J_X = Lrapp*J_XUV/(1.0+Lrapp) 24 | 25 | ! EUV flux 26 | J_EUV = J_XUV/(1.0+Lrapp) 27 | 28 | ! Normalizations for different power-law index 29 | if (PLind.eq.(-1.0)) then 30 | 31 | JEUVnorm = J_EUV/log(e_mid/e_low) 32 | if (thereis_Xray) then 33 | JXnorm = J_X/log(e_top/e_mid) 34 | else 35 | JXnorm = 0.0 36 | endif 37 | 38 | else 39 | 40 | JEUVnorm = J_EUV*P1/(e_mid**P1 - e_low**P1) 41 | if (thereis_Xray) then 42 | JXnorm = J_X*P1/(e_top**P1 - e_mid**P1) 43 | else 44 | JXnorm = 0.0 45 | endif 46 | 47 | endif 48 | 49 | ! Parametrization of incident spectrum 50 | if(E.lt.e_mid) then 51 | J_inc = JEUVnorm*E**PLind 52 | else 53 | J_inc = JXnorm*E**PLind 54 | endif 55 | 56 | end function 57 | 58 | ! End of module 59 | end module J_incident 60 | 61 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/System_HeH.f90: -------------------------------------------------------------------------------- 1 | module System_HeH 2 | ! Ionization equilibrium system with both H and He 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine ion_system_HeH(N_eq,x,fvec,iflag,params) 11 | 12 | integer :: N_eq,iflag 13 | real*8 :: x(N_eq),fvec(N_eq) 14 | real*8 :: g_hi,g_hei,g_heii ! Photoionization rates 15 | real*8 :: b_hi,b_hei,b_heii ! Collisional ionization rates 16 | real*8 :: a_hii,a_heii,a_heiii ! Recombination rates 17 | real*8 :: params(25) 18 | real*8 :: n_h,n_he,n_e 19 | real*8 :: n_hi,n_hii 20 | real*8 :: n_hei,n_heii,n_heiii 21 | 22 | ! Coefficients of the system 23 | 24 | g_hi = params(1) ! = P_HI 25 | g_hei = params(2) ! = P_HeI 26 | g_heii = params(3) ! = P_HeII 27 | a_hii = params(4) ! = rchiiB 28 | a_heii = params(5) ! = rcheiiB 29 | a_heiii = params(6) ! = rcheiiiB 30 | n_h = params(7) ! = nh 31 | n_he = params(8) ! = nhe 32 | b_hi = params(9) ! = a_ion_HI 33 | b_hei = params(10) ! = a_ion_HeI 34 | b_heii = params(11) ! = a_ion_HeII 35 | 36 | ! Species densities 37 | n_hi = (1.0-x(1))*n_h 38 | n_hii = x(1)*n_h 39 | n_hei = (1.0 - x(2) - x(3))*n_he 40 | n_heii = x(2)*n_he 41 | n_heiii = x(3)*n_he 42 | 43 | ! Electron density 44 | n_e = n_hii + n_heii + 2.0*n_heiii 45 | 46 | 47 | ! System of equations 48 | fvec(1) = n_hi*g_hi + (n_hi*b_hi - a_hii*n_hii)*n_e 49 | fvec(2) = n_hei*g_hei + (n_hei*b_hei - a_heii*n_heii)*n_e 50 | fvec(3) = n_heii*g_heii + (n_heii*b_heii - a_heiii*n_heiii)*n_e 51 | 52 | return 53 | 54 | ! End of subroutine 55 | end subroutine ion_system_HeH 56 | 57 | ! End of module 58 | end module System_HeH 59 | -------------------------------------------------------------------------------- /src/modules/init/set_IC.f90: -------------------------------------------------------------------------------- 1 | module initial_conditions 2 | ! Set general initial conditions (isothermal atmosphere) 3 | 4 | use global_parameters 5 | use grav_func 6 | 7 | implicit none 8 | 9 | contains 10 | 11 | subroutine set_IC(W,T,f_sp) 12 | ! Subroutine to set IC for the model 13 | 14 | integer :: j,i_rhalf 15 | real*8 :: r_half, minrho 16 | real*8 :: b0_eff 17 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: W 18 | real*8, dimension(1-Ng:N+Ng), intent(out) :: T 19 | real*8, dimension(1-Ng:N+Ng,6), intent(out) :: f_sp 20 | 21 | 22 | !--- Set initial conditions for thermodynamic variables ---! 23 | 24 | ! Density 25 | b0_eff = 1.0d0 ! Change if the planet b0 is too low - only for IC 26 | do 27 | W(:,1) = (/ (rho_bc*exp(b0_eff*(-Gphi_c(j) + Gphi_c(0))), & 28 | j = 1-Ng,N+Ng) /) 29 | 30 | ! Calculate minimum of density profile 31 | r_half = 0.5e0*(r_max + 1.0e0) 32 | i_rhalf = minloc(abs(r-r_half), dim = 1) 33 | minrho = W(i_rhalf,1) 34 | 35 | if (minrho .gt. 1.0e-8) then 36 | b0_eff = b0_eff + 0.2 37 | else 38 | exit 39 | endif 40 | 41 | enddo 42 | 43 | ! Write b0_eff to output 44 | write(*,'(A31,F5.1,A7)') ' (set_IC.f90) Using b0_eff =',b0_eff,' for IC' 45 | write(*,*) 46 | 47 | ! Fix density in outer layers 48 | where (W(:,1).lt.(1.0e-8)) W(:,1) = 1.0e-8 49 | 50 | ! Velocity 51 | W(:,2) = 0.5*(r-r(0)) 52 | 53 | ! Pressure 54 | W(:,3) = (1.0 + dp_bc)*W(:,1)/rho_bc 55 | 56 | ! Temperature 57 | T = 1.0 58 | 59 | ! Ionized fractions 60 | f_sp(:,1) = (1.0 - dp_bc)/(1.0 + 4.0*HeH) ! HI 61 | f_sp(:,2) = dp_bc/(1.0 + 4.0*HeH) ! HII 62 | f_sp(:,3) = HeH*(1.0 - dp_bc)/(1.0 + 4.0*HeH) ! HeI 63 | f_sp(:,4) = 1.0d-10*HeH/(1.0 + 4.0*HeH) ! HeII 64 | f_sp(:,5) = 0.0 ! HeIII 65 | f_sp(:,6) = 0.0 ! HeITR 66 | 67 | ! End of subroutine 68 | end subroutine set_IC 69 | 70 | ! End of module 71 | end module initial_conditions 72 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/System_implicit_adv_HeH.f90: -------------------------------------------------------------------------------- 1 | module System_implicit_adv_HeH 2 | ! Ionization equilibrium system with both H and He 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine adv_implicit_HeH(N_eq,x,fvec,iflag,params) 11 | 12 | integer :: N_eq,iflag 13 | real*8 :: x(N_eq),fvec(N_eq) 14 | real*8 :: xhi_old,xhei_old,xheiii_old 15 | real*8 :: ghi,ghei,gheii 16 | real*8 :: xhi,xhii 17 | real*8 :: xhei,xheii,xheiii 18 | real*8 :: xe 19 | real*8 :: c1 20 | real*8 :: n_h 21 | real*8 :: ahii,aheii,aheiii 22 | real*8 :: ionhi,ionhei,ionheii 23 | real*8 :: params(25) 24 | 25 | ! Coefficients of the system 26 | 27 | c1 = params(1) ! = dr/v 28 | xhi_old = params(2) ! = nhi/nhe 29 | xhei_old = params(3) ! = nheii/nhe 30 | xheiii_old = params(4) ! = nheiii/nhe 31 | n_h = params(5) ! = nh 32 | ghi = params(6) ! = P_HI 33 | ghei = params(7) ! = P_HeI = nh 34 | gheii = params(8) ! = P_HeII = nhe 35 | ahii = params(9) ! = rchiiB 36 | aheii = params(10) ! = rcheiiB 37 | aheiii = params(11) ! = rcheiiiB 38 | ionhi = params(12) ! = a_ion_HI 39 | ionhei = params(13) ! = a_ion_HeI 40 | ionheii = params(14) ! = a_ion_HEII 41 | 42 | ! Substitutions 43 | xhi = x(1) 44 | xhii = 1.0 - x(1) 45 | xhei = x(2) 46 | xheii = 1.0 - x(2) - x(3) 47 | xheiii = x(3) 48 | 49 | ! Electron density 50 | xe = xhii + HeH*(xheii + 2.0*xheiii) 51 | 52 | ! System of equations 53 | fvec(1) = xhi_old - xhi & 54 | + c1*(-(ghi+ionhi)*xhi + ahii*xhii*xe*n_h) 55 | 56 | fvec(2) = xhei_old - xhei & 57 | + c1*(-(ghei+ionhei)*xhei + aheii*xheii*xe*n_h) 58 | 59 | fvec(3) = xheiii_old - xheiii & 60 | + c1*((gheii+ionheii)*xheii - aheiii*xheiii*xe*n_h) 61 | 62 | ! End of subroutine 63 | end subroutine adv_implicit_HeH 64 | 65 | ! End of module 66 | end module System_implicit_adv_HeH 67 | -------------------------------------------------------------------------------- /src/modules/states/PLM_rec.f90: -------------------------------------------------------------------------------- 1 | module PLM_reconstruction 2 | ! Piecewise linear reconstruction 3 | 4 | use global_parameters 5 | use Conversion 6 | 7 | implicit none 8 | 9 | contains 10 | 11 | subroutine PLM_rec(u_in,WL_rec,WR_rec) 12 | integer :: j,k 13 | real*8, dimension(1-Ng:N+Ng,3),intent(in) :: u_in 14 | real*8 :: x(-1:1) 15 | real*8 :: W(-1:1,3) 16 | real*8, dimension(3) :: sp,sm,sd,sc 17 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: WL_rec,WR_rec 18 | 19 | do j = 2-Ng,N+Ng-1 20 | 21 | ! Extract stencil grid 22 | x = r(j-1:j+1) 23 | 24 | ! Convert to local primitive variables (2nd order conversion) 25 | do k = j-1,j+1 26 | call U_to_W_comp(u_in(k,:),W(k-j,:)) 27 | enddo 28 | 29 | ! Compute derivative approximations 30 | sp = (W(1,:) - W(0,:))/(x(1)-x(0)) 31 | sm = (W(0,:) - W(-1,:))/(x(0)-x(-1)) 32 | sd = (W(1,:) - W(-1,:))/(x(1)-x(-1)) 33 | 34 | ! Compute limited slope with MC limiter 35 | call Minmod_MC(sp,sm,sd,sc) 36 | 37 | ! Compute recontructed boundary values 38 | WL_rec(j,:) = W(0,:) + 0.5*sc*(x(1)-x(0)) 39 | WR_rec(j-1,:) = W(0,:) - 0.5*sc*(x(0)-x(-1)) 40 | 41 | enddo 42 | 43 | ! End of subroutine 44 | end subroutine PLM_rec 45 | 46 | !-------------------------------------------- 47 | 48 | ! Minmod generalized slope limiter 49 | 50 | subroutine Minmod_MC(a,b,c,d) 51 | real*8, dimension(1,3), intent(in) :: a,b,c 52 | real*8 :: v_arg(3) 53 | real*8 :: theta = 2.0 54 | integer :: i 55 | 56 | real*8, dimension(1,3), intent(out) :: d 57 | 58 | ! Generalized Minmod limiter (Kappeli 2016) 59 | 60 | do i = 1,3 61 | 62 | ! Limiter arguments 63 | v_arg(1) = theta*a(1,i) 64 | v_arg(2) = theta*b(1,i) 65 | v_arg(3) = c(1,i) 66 | 67 | if (maxval(v_arg).lt.(0.0)) then 68 | d(1,i) =maxval(v_arg) 69 | elseif (minval(v_arg).gt.(0.0)) then 70 | d(1,i) = minval(v_arg) 71 | else 72 | d(1,i) = 0.0 73 | endif 74 | enddo 75 | 76 | ! End of subroutine 77 | end subroutine Minmod_MC 78 | 79 | ! End of module 80 | end module PLM_reconstruction 81 | -------------------------------------------------------------------------------- /src/modules/functions/UW_conversions.f90: -------------------------------------------------------------------------------- 1 | module Conversion 2 | ! Conversion conservative-primitive variables subroutines 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | !-----------------------------------------------------------! 11 | 12 | ! Conservative to primitive (one component) 13 | subroutine U_to_W_comp(U_in,W_out) 14 | real*8, intent(in) :: U_in(3) 15 | real*8, intent(out) :: W_out(3) 16 | 17 | W_out(1) = U_in(1) 18 | W_out(2) = U_in(2)/U_in(1) 19 | W_out(3) = (g-1.0)*(U_in(3)-0.5*U_in(2)*U_in(2)/U_in(1)) 20 | 21 | end subroutine U_to_W_comp 22 | 23 | !-----------------------------------------------------------! 24 | 25 | ! Conservative to primitive (one component) 26 | subroutine W_to_U_comp(W_in,U_out) 27 | real*8, intent(in) :: W_in(3) 28 | real*8, intent(out) :: U_out(3) 29 | 30 | U_out(1) = W_in(1) 31 | U_out(2) = W_in(1)*W_in(2) 32 | U_out(3) = 0.5*W_in(1)*W_in(2)**2.0 + W_in(3)/(g-1.0) 33 | 34 | end subroutine W_to_U_comp 35 | 36 | !-----------------------------------------------------------! 37 | 38 | ! Primitive to conservative 39 | subroutine W_to_U(W_in,U_out) 40 | real*8, intent(in) :: W_in(1-Ng:N+Ng,3) 41 | real*8, intent(out) :: U_out(1-Ng:N+Ng,3) 42 | 43 | U_out(:,1) = W_in(:,1) 44 | U_out(:,2) = W_in(:,1)*W_in(:,2) 45 | U_out(:,3) = 0.5*W_in(:,1)*W_in(:,2)**2.0 & 46 | + W_in(:,3)/(g-1.0) 47 | 48 | end subroutine W_to_U 49 | 50 | !-----------------------------------------------------------! 51 | 52 | ! Conservative to primitive 53 | subroutine U_to_W(U_in,W_out) 54 | real*8, intent(in) :: U_in(1-Ng:N+Ng,3) 55 | real*8, intent(out) :: W_out(1-Ng:N+Ng,3) 56 | 57 | W_out(:,1) = U_in(:,1) 58 | W_out(:,2) = U_in(:,2)/U_in(:,1) 59 | W_out(:,3) = (g-1.0)* & 60 | (U_in(:,3)-0.5*U_in(:,2)*U_in(:,2)/U_in(:,1)) 61 | 62 | end subroutine U_to_W 63 | 64 | !-----------------------------------------------------------! 65 | 66 | ! End of module 67 | end module Conversion 68 | -------------------------------------------------------------------------------- /src/modules/time_step/RK_rhs.f90: -------------------------------------------------------------------------------- 1 | module RK_integration 2 | ! Evaluate RK right hand side (convection + source) 3 | 4 | use global_parameters 5 | use Numerical_Fluxes 6 | use source_func 7 | 8 | implicit none 9 | 10 | contains 11 | 12 | subroutine RK_rhs(u_in,WL,WR,alpha,dF,S) 13 | real*8, dimension(1-Ng:N+Ng,3), intent(in) :: u_in 14 | real*8, dimension(1-Ng:N+Ng,3), intent(in) :: WL,WR 15 | real*8, intent(in) :: alpha 16 | integer :: j 17 | real*8 :: dr 18 | real*8 :: rp,rm 19 | real*8 :: dAp,dAm 20 | real*8 :: dV 21 | real*8, dimension(3) :: Fp,Fm 22 | real*8 :: dF3p 23 | real*8 :: pL,pR 24 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: dF 25 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: S 26 | 27 | do j = 2-Ng,N+Ng 28 | 29 | ! Substitutions 30 | dr = dr_j(j) 31 | rp = r_edg(j) 32 | rm = r_edg(j-1) 33 | dAp = rp*rp 34 | dAm = rm*rm 35 | dV = (dAp*rp - dAm*rm)/3.0 36 | 37 | ! Evaluate numerical fluxes 38 | if (j.eq.(2-Ng)) then 39 | 40 | ! Use flux from previous step 41 | call Num_flux(WL(j-1,:),WR(j-1,:),Fm,alpha,pL) 42 | else 43 | 44 | Fm = Fp 45 | pL = pR 46 | endif 47 | 48 | ! Evaluate flux at the right interface 49 | call Num_flux(WL(j,:),WR(j,:),Fp,alpha,pR) 50 | 51 | ! Evaluate source 52 | call source(j,dr,dAp,dAm,dV, & 53 | u_in(j,:),WR(j-1,:),WL(j,:),S(j,:)) 54 | 55 | ! Evaluate flux differences 56 | dF(j,1) = (dAp*Fp(1) - dAm*Fm(1))/dV 57 | dF(j,2) = (dAp*Fp(2) - dAm*Fm(2))/dV 58 | 59 | ! Correct for WENO3 discretization 60 | if (use_weno3) dF(j,2) = dF(j,2) + (pR - pL)/dr 61 | 62 | dF3p = dAp*Fp(1)*(Gphi_i(j) - Gphi_c(j)) & 63 | - dAm*Fm(1)*(Gphi_i(j-1) - Gphi_c(j)) 64 | dF(j,3) = (dAp*Fp(3) - dAm*Fm(3) + dF3p)/dV 65 | 66 | enddo 67 | 68 | ! End of subroutine 69 | end subroutine RK_rhs 70 | 71 | ! End of module 72 | end module RK_integration 73 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/qrfac.f90: -------------------------------------------------------------------------------- 1 | subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) 2 | integer m,n,lda,lipvt 3 | integer ipvt(lipvt) 4 | logical pivot 5 | double precision a(lda,n),rdiag(n),acnorm(n),wa(n) 6 | 7 | integer i,j,jp1,k,kmax,minmn 8 | double precision ajnorm,epsmch,one,p05,sum,temp,zero 9 | double precision dpmpar,enorm 10 | data one,p05,zero /1.0d0,5.0d-2,0.0d0/ 11 | 12 | 13 | epsmch = dpmpar(1) 14 | 15 | do 10 j = 1, n 16 | acnorm(j) = enorm(m,a(1,j)) 17 | rdiag(j) = acnorm(j) 18 | wa(j) = rdiag(j) 19 | if (pivot) ipvt(j) = j 20 | 10 continue 21 | 22 | minmn = min0(m,n) 23 | do 110 j = 1, minmn 24 | if (.not.pivot) go to 40 25 | 26 | kmax = j 27 | do 20 k = j, n 28 | if (rdiag(k) .gt. rdiag(kmax)) kmax = k 29 | 20 continue 30 | if (kmax .eq. j) go to 40 31 | do 30 i = 1, m 32 | temp = a(i,j) 33 | a(i,j) = a(i,kmax) 34 | a(i,kmax) = temp 35 | 30 continue 36 | rdiag(kmax) = rdiag(j) 37 | wa(kmax) = wa(j) 38 | k = ipvt(j) 39 | ipvt(j) = ipvt(kmax) 40 | ipvt(kmax) = k 41 | 40 continue 42 | 43 | ajnorm = enorm(m-j+1,a(j,j)) 44 | if (ajnorm .eq. zero) go to 100 45 | if (a(j,j) .lt. zero) ajnorm = -ajnorm 46 | do 50 i = j, m 47 | a(i,j) = a(i,j)/ajnorm 48 | 50 continue 49 | a(j,j) = a(j,j) + one 50 | 51 | jp1 = j + 1 52 | if (n .lt. jp1) go to 100 53 | do 90 k = jp1, n 54 | sum = zero 55 | do 60 i = j, m 56 | sum = sum + a(i,j)*a(i,k) 57 | 60 continue 58 | temp = sum/a(j,j) 59 | do 70 i = j, m 60 | a(i,k) = a(i,k) - temp*a(i,j) 61 | 70 continue 62 | if (.not.pivot .or. rdiag(k) .eq. zero) go to 80 63 | temp = a(j,k)/rdiag(k) 64 | rdiag(k) = rdiag(k)*dsqrt(dmax1(zero,one-temp**2)) 65 | if (p05*(rdiag(k)/wa(k))**2 .gt. epsmch) go to 80 66 | rdiag(k) = enorm(m-j,a(jp1,k)) 67 | wa(k) = rdiag(k) 68 | 80 continue 69 | 90 continue 70 | 100 continue 71 | rdiag(j) = -ajnorm 72 | 110 continue 73 | return 74 | 75 | end 76 | -------------------------------------------------------------------------------- /src/modules/files_IO/write_output.f90: -------------------------------------------------------------------------------- 1 | module output_write 2 | ! Write the output to the standard output files 3 | 4 | use global_parameters 5 | 6 | contains 7 | 8 | subroutine write_output(rho,v,p,T,heat,cool,eta, & 9 | nhi,nhii,nhei,nheii,nheiii,nheiTR,flag) 10 | 11 | character(len = 2) :: flag 12 | integer :: j 13 | real*8, dimension(1-Ng:N+Ng), intent(in) :: rho,v,p,T 14 | real*8, dimension(1-Ng:N+Ng), intent(in) :: heat,cool 15 | real*8, dimension(1-Ng:N+Ng), intent(in) :: eta 16 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhi,nhii 17 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhei,nheii,nheiii 18 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nheiTR 19 | 20 | 21 | !---- Write thermodynamic profiles ----! 22 | 23 | if (flag.eq.'eq') then 24 | open(unit = 2, file = './output/Hydro_ioniz.txt') 25 | else ! Change output file after postprocessing 26 | open(unit = 2, file = './output/Hydro_ioniz_adv.txt') 27 | endif 28 | 29 | do j = 1-Ng,N+Ng 30 | write(2,*) r(j), & ! Rad. dist. 31 | rho(j)*n0, & ! Density 32 | v(j)*v0, & ! Velocity 33 | p(j)*p0, & ! Pressure 34 | T(j)*T0, & ! Temperature 35 | heat(j)*q0, & ! Rad. heat. 36 | cool(j)*q0 ! Rad. cool. 37 | enddo 38 | close(2) 39 | 40 | !---- Write ionization profiles ----! 41 | if (flag.eq.'eq') then 42 | open(unit = 3, file = './output/Ion_species.txt') 43 | else ! Change output file after postprocessing 44 | open(unit = 3, file = './output/Ion_species_adv.txt') 45 | endif 46 | 47 | do j = 1-Ng,N+Ng 48 | 49 | write(3,*) r(j), & ! Rad. dist. 50 | nhi(j)*n0, & ! HI 51 | nhii(j)*n0, & ! HII 52 | nhei(j)*n0, & ! HeI 53 | nheii(j)*n0, & ! HeII 54 | nheiii(j)*n0, & ! HeIII 55 | nheiTR(j)*n0 ! HeITR 56 | enddo 57 | close(3) 58 | 59 | ! End of subroutine 60 | end subroutine write_output 61 | 62 | ! End of module 63 | end module output_write 64 | -------------------------------------------------------------------------------- /src/modules/files_IO/load_IC.f90: -------------------------------------------------------------------------------- 1 | module IC_load 2 | ! Module to load previous ICs, stored in the following files: 3 | ! - Hydro_ioniz_IC.txt 4 | ! - Ion_species_IC.txt 5 | 6 | use global_parameters 7 | 8 | implicit none 9 | 10 | contains 11 | 12 | subroutine load_IC(rho,v,p,T,f_sp,W) 13 | 14 | ! Integer variables 15 | integer :: j 16 | 17 | ! Thermodynamic loading variables 18 | real*8, dimension(1-Ng:N+Ng) :: nhi_l,nhii_l 19 | real*8, dimension(1-Ng:N+Ng) :: nhei_l,nheii_l,nheiii_l,nheiTR_l 20 | 21 | ! Auxiliary temporary variable 22 | real*8 :: tmp 23 | 24 | ! Output variables 25 | real*8, dimension(1-Ng:N+Ng), intent(out) :: rho,v,p,T 26 | real*8, dimension(1-Ng:N+Ng,6), intent(out) :: f_sp 27 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: W 28 | 29 | 30 | !-------------------------------------! 31 | 32 | ! Load thermodynamic variables 33 | open(unit = 1, file = 'output/Hydro_ioniz_IC.txt') 34 | do j = 1-Ng,N+Ng 35 | read(1,*) tmp, tmp, v(j), p(j), T(j), tmp, tmp 36 | enddo 37 | close(1) 38 | 39 | ! Adimensionalize 40 | v = v/v0 41 | p = p/p0 42 | T = T/T0 43 | 44 | ! Load ionization profiles 45 | open(unit = 2, file = 'output/Ion_species_IC.txt') 46 | do j = 1-Ng,N+Ng 47 | read(2,*) r(j), & ! Rad. 48 | nhi_l(j), & ! HI 49 | nhii_l(j), & ! HII 50 | nhei_l(j), & ! HeI 51 | nheii_l(j), & ! HeII 52 | nheiii_l(j), & ! HeIII 53 | nheiTR_l(j) 54 | enddo 55 | close(2) 56 | 57 | 58 | ! Construct mass density profile (adimensional) 59 | rho = (nhi_l + nhii_l + 4.0*(nhei_l + nheii_l + nheiii_l))/n0 60 | 61 | ! Construct the ration n/rho 62 | f_sp(:,1) = nhi_l/(rho*n0) ! HI 63 | f_sp(:,2) = nhii_l/(rho*n0) ! HII 64 | f_sp(:,3) = nhei_l/(rho*n0) ! HeI 65 | f_sp(:,4) = nheii_l/(rho*n0) ! HeII 66 | f_sp(:,5) = nheiii_l/(rho*n0) ! HeIII 67 | f_sp(:,6) = nheiTR_l/(rho*n0) 68 | 69 | ! Construct matrix of primitive profiles 70 | W(:,1) = rho 71 | W(:,2) = v 72 | W(:,3) = p 73 | 74 | ! End of subroutine 75 | end subroutine load_IC 76 | 77 | ! End of module 78 | end module IC_load 79 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/System_HeH_TR.f90: -------------------------------------------------------------------------------- 1 | module System_HeH_TR 2 | ! Ionization equilibrium system with both H and He 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine ion_system_HeH_TR(Neq,x,fvec,iflag,params) 11 | 12 | integer :: Neq,iflag 13 | real*8 :: x(Neq),fvec(Neq) 14 | real*8 :: g_hi,g_hei,g_heii,g_heiTR ! Photoionization rates 15 | real*8 :: b_hi,b_hei,b_heii ! Collisional ionization rates 16 | real*8 :: A31,q13,q31a,q31b,Q31 17 | real*8 :: a_hii,a_heii,a_heiii,a_heiTR ! Recombination rates 18 | real*8 :: params(25) 19 | real*8 :: n_h,n_he,n_e 20 | real*8 :: n_hi,n_hii 21 | real*8 :: n_hei,n_heii,n_heiii,n_heiTR,n_heiSI 22 | 23 | ! Coefficients of the system 24 | 25 | g_hi = params(1) ! = P_HI 26 | g_hei = params(2) ! = P_HeI 27 | g_heii = params(3) ! = P_HeII 28 | a_hii = params(4) ! = rchiiB 29 | a_heii = params(5) ! = rcheiiB 30 | a_heiii = params(6) ! = rcheiiiB 31 | n_h = params(7) ! = nh 32 | n_he = params(8) ! = nhe 33 | b_hi = params(9) ! = a_ion_HI 34 | b_hei = params(10) ! = a_ion_HeI 35 | b_heii = params(11) ! = a_ion_HeII 36 | 37 | ! Triplet parameters 38 | a_heiTR = params(12) ! = rcheiTR 39 | A31 = params(13) ! = A31 40 | g_heiTR = params(14) ! = P_HeITR 41 | q13 = params(15) ! = q13 42 | q31a = params(16) ! = q31a 43 | q31b = params(17) ! = q31b 44 | Q31 = params(18) ! = Q31 45 | 46 | 47 | ! Species densities 48 | n_hi = (1.0-x(1))*n_h 49 | n_hii = x(1)*n_h 50 | n_hei = (1.0 - x(2) - x(3))*n_he 51 | n_heii = x(2)*n_he 52 | n_heiii = x(3)*n_he 53 | n_heiSI = (1.0 - x(2) - x(3) - x(4))*n_he 54 | n_heiTR = x(4)*n_he 55 | 56 | 57 | ! Electron density 58 | n_e = n_hii + n_heii + 2.0*n_heiii 59 | 60 | ! System of equations 61 | fvec(1) = n_hi*g_hi - a_hii*n_hii*n_e 62 | 63 | ! New equation for hei - sum of the two equations of Oklopcic 64 | fvec(2) = n_heii*(a_heiTR + a_heii)*n_e & 65 | - n_heiSI*g_hei & 66 | - n_heiTR*g_heiTR 67 | 68 | fvec(3) = n_heii*g_heii - a_heiii*n_heiii*n_e 69 | 70 | fvec(4) = - n_heiTR*g_heiTR & 71 | + n_e*( n_heii*a_heiTR & 72 | + n_heiSI*q13 & 73 | - n_heiTR*(q31a + q31b)) & 74 | - n_heiTR*(A31 + n_hi*Q31) 75 | 76 | return 77 | 78 | ! End of subroutine 79 | end subroutine ion_system_HeH_TR 80 | 81 | ! End of module 82 | end module System_HeH_TR 83 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/T_equation.f90: -------------------------------------------------------------------------------- 1 | module equation_T 2 | ! Equation for temperature at the steady state 3 | 4 | use global_parameters 5 | use utils, only : calc_ne 6 | use Cooling_Coefficients 7 | 8 | implicit none 9 | 10 | contains 11 | 12 | subroutine T_equation(N_T_eq,x,fvec,iflag,params) 13 | 14 | integer :: N_T_eq,iflag 15 | real*8 :: x(N_T_eq),fvec(N_T_eq) 16 | real*8 :: params(25) 17 | real*8 :: nhi,nhii 18 | real*8 :: nhei,nheii,nheiii 19 | real*8 :: ne 20 | real*8 :: mum,mup 21 | real*8 :: rhov 22 | real*8 :: coeff 23 | real*8 :: dr 24 | real*8 :: Told,heaold 25 | real*8 :: reco,coio,brem,coex,cool 26 | real*8 :: TT 27 | 28 | ! Parameters 29 | nhi = params(1) 30 | nhii = params(2) 31 | nhei = params(3) 32 | nheii = params(4) 33 | nheiii = params(5) 34 | mup = params(6) 35 | mum = params(7) 36 | rhov = params(8) 37 | coeff = params(9) 38 | dr = params(10) 39 | Told = params(11) 40 | heaold = params(12) 41 | 42 | ! Free electron density 43 | if (thereis_He) then 44 | ne = nhii + nheii + 2.0*nheiii 45 | else 46 | ne = nhii 47 | endif 48 | 49 | ! Substitutions 50 | TT = x(1)*T0 51 | 52 | !--- Evaluate cooling rates ---! 53 | 54 | ! Cooling rate 55 | reco = rec_cool_HII_func(TT)*nhii & ! HII 56 | + rec_cool_HeII_func(TT)*nheii & ! HeII 57 | + rec_cool_HeIII_func(TT)*nheiii ! HeIII 58 | 59 | !-- Collisional ionization --! 60 | 61 | ! Cooling rate 62 | coio = 2.179e-11*ion_coeff_HI_func(TT)*nhi & ! HI 63 | + 3.940e-11*ion_coeff_HeI_func(TT)*nhei & ! HeI 64 | + kb_erg*631515.0*ion_coeff_HeII_func(TT)*nheii ! HeII 65 | 66 | !-- Bremsstrahlung --! 67 | 68 | ! Cooling rate 69 | brem = 1.426e-27*sqrt(TT)* & 70 | (ih**2.0*GF_func(TT,ih)*nhii + & ! HII 71 | ihe**2.0*GF_func(TT,ihe)*(nheii + nheiii)) ! He 72 | 73 | !-- Collisional excitation --! 74 | 75 | ! Collisional excitation 76 | coex = coex_rate_HI_func(TT)*nhi & ! HI 77 | + coex_rate_HeI_func(TT)*nhei & ! HeI 78 | + coex_rate_HeII_func(TT)*nheii ! HeII 79 | 80 | ! Total cooling rate in erg/(s cm^3) 81 | cool = ne*(brem + coex + reco + coio)/q0 82 | 83 | ! Equation 84 | fvec(1) = mum*rhov*x(1) - mup*rhov*Told & 85 | - (g-1.0)*(coeff*x(1) + mup*mum*dr*(heaold - cool)) 86 | 87 | ! End of subroutine 88 | end subroutine T_equation 89 | 90 | ! End of module 91 | end module equation_T 92 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/System_implicit_adv_HeH_TR.f90: -------------------------------------------------------------------------------- 1 | module System_implicit_adv_HeH_TR 2 | ! Ionization equilibrium system with both H and He 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine adv_implicit_HeH_TR(Neq,x,fvec,iflag,params) 11 | 12 | integer :: Neq,iflag 13 | real*8 :: x(Neq),fvec(Neq) 14 | real*8 :: xhi_old,xhei_old,xheiii_old,xheiTR_old 15 | real*8 :: ghi,ghei,gheii,gheiTR 16 | real*8 :: xhi,xhii 17 | real*8 :: xhei,xheii,xheiii 18 | real*8 :: xheiTR, xheiS 19 | real*8 :: xe 20 | real*8 :: c1 21 | real*8 :: n_h 22 | real*8 :: ahii,aheii,aheiii,aheiTR 23 | real*8 :: ionhi,ionhei,ionheii 24 | real*8 :: params(25) 25 | real*8 :: A31,q13,q31a,q31b,Q31 26 | 27 | ! Coefficients of the system 28 | c1 = params(1) ! = dr/v 29 | xhi_old = params(2) ! = nhi/nhe 30 | xhei_old = params(3) ! = nheii/nhe 31 | xheiii_old = params(4) ! = nheiii/nhe 32 | n_h = params(5) ! = nh 33 | ghi = params(6) ! = P_HI 34 | ghei = params(7) ! = P_HeI 35 | gheii = params(8) ! = P_HeII 36 | ahii = params(9) ! = rchiiB 37 | aheii = params(10) ! = rcheiiB 38 | aheiii = params(11) ! = rcheiiiB 39 | ionhi = params(12) ! = a_ion_HI 40 | ionhei = params(13) ! = a_ion_HeI 41 | ionheii = params(14) ! = a_ion_HEII 42 | aheiTR = params(15) ! = rcheiTR 43 | A31 = params(16) ! = A31 44 | gheiTR = params(17) ! = P_HeITR 45 | q13 = params(18) ! = q13 46 | q31a = params(19) ! = q31a 47 | q31b = params(20) ! = q31b 48 | Q31 = params(21) ! = Q31 49 | xheiTR_old = params(22) ! = nheiTR/nh 50 | 51 | ! Substitutions 52 | xhi = x(1) 53 | xhii = 1.0 - x(1) 54 | xhei = x(2) 55 | xheii = 1.0 - x(2) - x(3) 56 | xheiii = x(3) 57 | xheiS = x(2) - x(4) 58 | xheiTR = x(4) 59 | 60 | ! Electron density 61 | xe = xhii + HeH*(xheii + 2.0*xheiii) 62 | 63 | ! System of equations 64 | fvec(1) = xhi_old - xhi + c1*( & 65 | - (ghi + ionhi*xe*n_h)*xhi & 66 | + ahii*xhii*xe*n_h) 67 | 68 | fvec(2) = xhei_old - xhei + c1*( & 69 | xheii*(aheiTR + aheii)*xe*n_h & 70 | - xheiS*ghei - xheiTR*gheiTR) 71 | 72 | fvec(3) = xheiii_old - xheiii + c1*( & 73 | (gheii + ionheii*xe*n_h)*xheii & 74 | - aheiii*xheiii*xe*n_h) 75 | 76 | fvec(4) = xheiTR_old - xheiTR + c1*( & 77 | - gheiTR*xheiTR & 78 | + (xheii*aheiTR + xheiS*q13 & 79 | - xheiTR*(q31a + q31b))*xe*n_h & 80 | - xheiTR*(A31 + xhi*Q31*n_h)) 81 | 82 | ! End of subroutine 83 | end subroutine adv_implicit_HeH_TR 84 | 85 | ! End of module 86 | end module System_implicit_adv_HeH_TR 87 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/r1updt.f90: -------------------------------------------------------------------------------- 1 | subroutine r1updt(m,n,s,ls,u,v,w,sing) 2 | integer m,n,ls 3 | logical sing 4 | double precision s(ls),u(m),v(n),w(m) 5 | 6 | integer i,j,jj,l,nmj,nm1 7 | double precision cos,cotan,giant,one,p5,p25,sin,tan,tau,temp, & 8 | zero 9 | double precision dpmpar 10 | data one,p5,p25,zero /1.0d0,5.0d-1,2.5d-1,0.0d0/ 11 | 12 | giant = dpmpar(3) 13 | 14 | jj = (n*(2*m - n + 1))/2 - (m - n) 15 | 16 | l = jj 17 | do 10 i = n, m 18 | w(i) = s(l) 19 | l = l + 1 20 | 10 continue 21 | 22 | nm1 = n - 1 23 | if (nm1 .lt. 1) go to 70 24 | do 60 nmj = 1, nm1 25 | j = n - nmj 26 | jj = jj - (m - j + 1) 27 | w(j) = zero 28 | if (v(j) .eq. zero) go to 50 29 | 30 | if (dabs(v(n)) .ge. dabs(v(j))) go to 20 31 | cotan = v(n)/v(j) 32 | sin = p5/dsqrt(p25+p25*cotan**2) 33 | cos = sin*cotan 34 | tau = one 35 | if (dabs(cos)*giant .gt. one) tau = one/cos 36 | go to 30 37 | 20 continue 38 | tan = v(j)/v(n) 39 | cos = p5/dsqrt(p25+p25*tan**2) 40 | sin = cos*tan 41 | tau = sin 42 | 30 continue 43 | 44 | v(n) = sin*v(j) + cos*v(n) 45 | v(j) = tau 46 | 47 | l = jj 48 | do 40 i = j, m 49 | temp = cos*s(l) - sin*w(i) 50 | w(i) = sin*s(l) + cos*w(i) 51 | s(l) = temp 52 | l = l + 1 53 | 40 continue 54 | 50 continue 55 | 60 continue 56 | 70 continue 57 | 58 | do 80 i = 1, m 59 | w(i) = w(i) + v(n)*u(i) 60 | 80 continue 61 | 62 | sing = .false. 63 | if (nm1 .lt. 1) go to 140 64 | do 130 j = 1, nm1 65 | if (w(j) .eq. zero) go to 120 66 | 67 | if (dabs(s(jj)) .ge. dabs(w(j))) go to 90 68 | cotan = s(jj)/w(j) 69 | sin = p5/dsqrt(p25+p25*cotan**2) 70 | cos = sin*cotan 71 | tau = one 72 | if (dabs(cos)*giant .gt. one) tau = one/cos 73 | go to 100 74 | 90 continue 75 | tan = w(j)/s(jj) 76 | cos = p5/dsqrt(p25+p25*tan**2) 77 | sin = cos*tan 78 | tau = sin 79 | 100 continue 80 | 81 | l = jj 82 | do 110 i = j, m 83 | temp = cos*s(l) + sin*w(i) 84 | w(i) = -sin*s(l) + cos*w(i) 85 | s(l) = temp 86 | l = l + 1 87 | 110 continue 88 | 89 | w(j) = tau 90 | 120 continue 91 | 92 | if (s(jj) .eq. zero) sing = .true. 93 | jj = jj + (m - j + 1) 94 | 130 continue 95 | 140 continue 96 | 97 | l = jj 98 | do 150 i = n, m 99 | s(l) = w(i) 100 | l = l + 1 101 | 150 continue 102 | if (s(jj) .eq. zero) sing = .true. 103 | return 104 | 105 | end 106 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/qform.f90: -------------------------------------------------------------------------------- 1 | subroutine qform(m,n,q,ldq,wa) 2 | integer m,n,ldq 3 | double precision q(ldq,m),wa(m) 4 | ! ********** 5 | 6 | ! subroutine qform 7 | 8 | ! this subroutine proceeds from the computed qr factorization of 9 | ! an m by n matrix a to accumulate the m by m orthogonal matrix 10 | ! q from its factored form. 11 | 12 | ! the subroutine statement is 13 | 14 | ! subroutine qform(m,n,q,ldq,wa) 15 | 16 | ! where 17 | 18 | ! m is a positive integer input variable set to the number 19 | ! of rows of a and the order of q. 20 | 21 | ! n is a positive integer input variable set to the number 22 | ! of columns of a. 23 | 24 | ! q is an m by m array. on input the full lower trapezoid in 25 | ! the first min(m,n) columns of q contains the factored form. 26 | ! on output q has been accumulated into a square matrix. 27 | 28 | ! ldq is a positive integer input variable not less than m 29 | ! which specifies the leading dimension of the array q. 30 | 31 | ! wa is a work array of length m. 32 | 33 | ! subprograms called 34 | 35 | ! fortran-supplied ... min0 36 | 37 | ! argonne national laboratory. minpack project. march 1980. 38 | ! burton s. garbow, kenneth e. hillstrom, jorge j. more 39 | 40 | ! ********** 41 | integer i,j,jm1,k,l,minmn,np1 42 | double precision one,sum,temp,zero 43 | data one,zero /1.0d0,0.0d0/ 44 | 45 | !zero out upper triangle of q in the first min(m,n) columns. 46 | 47 | minmn = min0(m,n) 48 | if (minmn .lt. 2) go to 30 49 | do 20 j = 2, minmn 50 | jm1 = j - 1 51 | do 10 i = 1, jm1 52 | q(i,j) = zero 53 | 10 continue 54 | 20 continue 55 | 30 continue 56 | 57 | !initialize remaining columns to those of the identity matrix. 58 | 59 | np1 = n + 1 60 | if (m .lt. np1) go to 60 61 | do 50 j = np1, m 62 | do 40 i = 1, m 63 | q(i,j) = zero 64 | 40 continue 65 | q(j,j) = one 66 | 50 continue 67 | 60 continue 68 | 69 | !accumulate q from its factored form. 70 | 71 | do 120 l = 1, minmn 72 | k = minmn - l + 1 73 | do 70 i = k, m 74 | wa(i) = q(i,k) 75 | q(i,k) = zero 76 | 70 continue 77 | q(k,k) = one 78 | if (wa(k) .eq. zero) go to 110 79 | do 100 j = k, m 80 | sum = zero 81 | do 80 i = k, m 82 | sum = sum + q(i,j)*wa(i) 83 | 80 continue 84 | temp = sum/wa(k) 85 | do 90 i = k, m 86 | q(i,j) = q(i,j) - temp*wa(i) 87 | 90 continue 88 | 100 continue 89 | 110 continue 90 | 120 continue 91 | return 92 | 93 | !last card of subroutine qform. 94 | 95 | end 96 | -------------------------------------------------------------------------------- /src/modules/states/Apply_BC.f90: -------------------------------------------------------------------------------- 1 | module BC_Apply 2 | ! Implementation of boundary conditions 3 | 4 | use global_parameters 5 | use Conversion 6 | 7 | implicit none 8 | 9 | contains 10 | 11 | subroutine Apply_BC(u_in,u_out) 12 | ! Boundary conditions for conservative variables 13 | 14 | real*8, intent(in) :: u_in(1-Ng:N+Ng,3) 15 | real*8 :: W(1-Ng:N+Ng,3) 16 | real*8, intent(out) :: u_out(1-Ng:N+Ng,3) 17 | 18 | ! Convert to primitive variables 19 | call U_to_W(u_in,W) 20 | 21 | ! Apply bc to W's 22 | call Apply_BC_W(W,W) 23 | 24 | ! Return to conservaive variables 25 | call W_to_U(W,u_out) 26 | 27 | ! End of subroutine 28 | end subroutine Apply_BC 29 | 30 | !------------------------------------------! 31 | 32 | subroutine BC_component_constrho(W_in,index) 33 | ! Component-wise BC in case of zero-velocity gradient 34 | ! at the lower boundary 35 | 36 | real*8, intent(inout) :: W_in(1-Ng:N+Ng,3) 37 | integer, intent(in) :: index 38 | 39 | ! Save into output vector 40 | W_in(index,1) = rho_bc 41 | W_in(index,2) = max(W_in(1,2),0.0) 42 | W_in(index,3) = 1.0 + dp_bc 43 | 44 | ! End of subroutine 45 | end subroutine BC_component_constrho 46 | 47 | !------------------------------------------! 48 | 49 | subroutine Apply_BC_W(W_in,W_out) 50 | ! Boundary conditions for primitive variables 51 | 52 | real*8, intent(in) :: W_in(1-Ng:N+Ng,3) 53 | integer :: k 54 | real*8, intent(out) :: W_out(1-Ng:N+Ng,3) 55 | 56 | ! Copy input vector 57 | W_out = W_in 58 | 59 | ! BC with constant rho at lower boundary 60 | do k = 1,Ng 61 | call BC_component_constrho(W_out,1-k) 62 | enddo 63 | 64 | do k = 1,Ng 65 | ! Upper boundary 66 | W_out(N+k,:) = W_out(N,:) 67 | if (use_weno3) W_out(N+k,:) = 2.0*W_out(N+k-1,:) - W_out(N+k-2,:) 68 | enddo 69 | 70 | ! End of subroutine 71 | end subroutine Apply_BC_W 72 | 73 | !------------------------------------------! 74 | 75 | subroutine Rec_BC(WL_in,WR_in,WL_out,WR_out) 76 | ! Boundary conditions for reconstructed variables 77 | 78 | real*8, dimension(1-Ng:N+Ng,3), intent(in) :: WL_in, WR_in 79 | integer :: k 80 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: WL_out, WR_out 81 | 82 | WL_out = WL_in 83 | WR_out = WR_in 84 | 85 | ! Lower boundary 86 | call BC_component_constrho(WR_out,1-Ng) 87 | 88 | ! BC with constant density at lower boundary 89 | do k = 1,Ng 90 | call BC_component_constrho(WL_out,1-k) 91 | enddo 92 | 93 | ! Upper boundary 94 | do k = 1,Ng 95 | WR_out(N+k,:) = WR_out(N,:) 96 | if (use_weno3) WR_out(N+k,:) = 2.0*WR_out(N+k-1,:) - WR_out(N+k-2,:) 97 | enddo 98 | 99 | WL_out(N+2,:) = WL_out(N+1,:) 100 | if (use_weno3) WL_out(N+2,:) = 2.0*WL_out(N+1,:) - WL_out(N,:) 101 | 102 | ! End of subroutine 103 | end subroutine Rec_BC 104 | 105 | ! End of module 106 | end module BC_Apply 107 | -------------------------------------------------------------------------------- /src/utils/glob.py: -------------------------------------------------------------------------------- 1 | # Definition of global variables 2 | 3 | try: 4 | import tkinter as tk # python 3 5 | from tkinter import ttk 6 | except ImportError: # python 2 7 | import Tkinter as tk 8 | from Tkinter import ttk 9 | 10 | def init(): 11 | 12 | # Globals allocation 13 | global f_table 14 | global widgets, frame_list, lbl_spectrum 15 | global pl_names,sp_type,grid_type,num_flux,rec_meth 16 | global pl_params_list,pl_params 17 | global empty_lbl, PLind_spfile_lbl,resc_lbl 18 | global appx_meth 19 | global onlyEUV_var,LoadIC_var,He23S_var,onlyPP_var,force_var 20 | global MJ,RJ,AU,Msun,Gc,mu,kb 21 | global hp_eV,c_light 22 | global current_spec 23 | global elow,emid,ehigh,ephot 24 | global EUV_band_lbl,Xray_band_lbl 25 | 26 | # Widget dictionaries 27 | widgets = {} 28 | 29 | # List of physical parameters 30 | pl_names = [] 31 | appxmth = [] 32 | pl_params = { 'Rp' : [], 33 | 'Mp' : [], 34 | 'T0' : [], 35 | 'LX' : [], 36 | 'LEUV' : [], 37 | 'a' : [], 38 | 'Ms' : []} 39 | 40 | # lit of specific planetary parameters 41 | pl_params_list = ['Rp', 42 | 'Mp', 43 | 'T0', 44 | 'LX', 45 | 'LEUV', 46 | 'a', 47 | 'Ms'] 48 | 49 | 50 | # --- Predefined inputs --- # 51 | 52 | # Spectrum evaluation 53 | sp_type = ['Load from file..', 54 | 'Power-law', 55 | 'Monochromatic'] 56 | 57 | # Grid_types 58 | grid_type = ['Uniform','Mixed','Stretched'] 59 | 60 | # Numerical fluxes 61 | num_flux = ['HLLC', 62 | 'ROE', 63 | 'LLF'] 64 | 65 | # Reconstruction Methods 66 | rec_meth = ['PLM', 'WENO3'] 67 | 68 | # 3D approximation method 69 | appx_meth = ['Mdot/4','Rate/2 + Mdot/2', 70 | 'Rate/4 + Mdot','alpha = '] 71 | 72 | # Empty labels 73 | empty_lbl = { 'rho' : u'\u03C1\u209A: ', 74 | 'b0' : u'\u03B2\u2080 = ', 75 | 'phi' : u'log(\u03A6\u209A) = ', 76 | 'rochel' : 'Roche lobe: '} 77 | 78 | # List of frames 79 | frame_list = ['Planet_params', 80 | 'Stellar_params', 81 | 'Others_params', 82 | 'Bands_info', 83 | 'Derived_parameters', 84 | 'Numerical_params', 85 | 'Tick_options', 86 | 'Buttons'] 87 | 88 | # Current spectrum type 89 | current_spec = [] 90 | 91 | # Labels for EUV info bands 92 | EUV_band_lbl = u"EUV band:\n" + \ 93 | u"[100,912] \u212B \u2263 [13.6,124] eV" 94 | Xray_band_lbl = u"X-ray band:\n" + \ 95 | u"[10,100] \u212B \u2263 [124,1240] eV" 96 | 97 | # Define useful constants 98 | MJ = 1.898e30 # Jupiter mass (g) 99 | RJ = 6.9911e9 # Jupiter radius (cm) 100 | AU = 1.495978707e13 # Astronomical unit (cm) 101 | Msun = 1.989e33 # Sun mass (g) 102 | Gc = 6.67259e-8 # Gravitational constant 103 | mu = 1.673e-24 # Proton mass 104 | kb = 1.38e-16 # Boltzmann constant 105 | hp_eV = 4.1357e-15 # Planck constant in eV 106 | c_light = 2.99792458e10 # Speed of light in cm/s 107 | 108 | # ---- 109 | -------------------------------------------------------------------------------- /src/modules/init/init.f90: -------------------------------------------------------------------------------- 1 | module Initialization 2 | ! Initialize the simulation: 3 | ! - Set global options (thread number, time loop counter, initial 4 | ! initial momentum variation) 5 | ! - Construct spatial grid 6 | ! - Construct energy grids for ionization equilibrium 7 | ! - Construct initial conditions (load or set) 8 | 9 | use global_parameters 10 | use grid_construction 11 | use energy_vectors_construct 12 | use gravity_grid_construction 13 | use initial_conditions 14 | use Conversion 15 | use BC_Apply 16 | use omp_lib 17 | use IC_load 18 | use initial_conditions 19 | 20 | implicit none 21 | 22 | contains 23 | 24 | subroutine init(W,u,f_sp) 25 | ! Initialize the simulation setup 26 | 27 | integer :: n_omp_threads 28 | real*8, dimension(1-Ng:N+Ng) :: rho,v,p,T 29 | real*8, dimension(1-Ng:N+Ng,6),intent(out) :: f_sp 30 | real*8, dimension(1-Ng:N+Ng,3),intent(out) :: W,u 31 | 32 | write(*,*) '(init.f90) Initializing the simulation..' 33 | 34 | !---- Global options ----! 35 | 36 | ! Set the number of threads used 37 | n_omp_threads = omp_get_max_threads() 38 | if (n_omp_threads .gt. 4) n_omp_threads = 4 ! Limits to a maximum of 4 threads 39 | call omp_set_num_threads(n_omp_threads) 40 | write(*,'(A12,I2,A12)') ' - Using',n_omp_threads,' OMP threads' 41 | 42 | ! Loop parameters 43 | count = 0 44 | du = 1.0 45 | dtu = 1.0 46 | 47 | !------------------------------------------------! 48 | 49 | ! Construction of radial grid 50 | write(*,*) ' - Constructing the spatial grid..' 51 | call define_grid 52 | 53 | !------------------------------------------------! 54 | 55 | ! Construction of energy grid 56 | write(*,*) ' - Precalculating energy grid, cross section and flux vector..' 57 | call set_energy_vectors 58 | 59 | !------------------------------------------------! 60 | 61 | ! Pre-evaluate gravity at grid center and edges 62 | write(*,*) ' - Precalculating the gravitational potential..' 63 | call set_gravity_grid 64 | 65 | !------------------------------------------------! 66 | 67 | !---- Initial conditions ----! 68 | 69 | if (.not. do_load_IC) then 70 | 71 | ! Set IC to isothermal atmosphere 72 | write(*,*) ' - Setting the default, isothermal IC..' 73 | call set_IC(W,T,f_sp) 74 | 75 | else ! Load existing initial conditions 76 | 77 | write(*,*) ' - Loading IC from file..' 78 | ! Load thermodynamic profiles 79 | call load_IC(rho,v,p,T,f_sp,W) 80 | 81 | ! Change starting loop counting index 82 | count = 1 83 | endif 84 | 85 | !------------------------------------------------! 86 | 87 | ! Apply BC to initial condition 88 | call W_to_U(W,u) 89 | call Apply_BC(u,u) 90 | 91 | write(*,*) '(init.f90) Done.' 92 | 93 | ! End of subroutine 94 | end subroutine init 95 | 96 | ! End of module 97 | end module Initialization 98 | -------------------------------------------------------------------------------- /eta_approx.py: -------------------------------------------------------------------------------- 1 | import numpy as np 2 | import matplotlib.pyplot as plt 3 | 4 | 5 | #-------------------------------------------------------------- 6 | 7 | 8 | def etaeff(Frho,Kphi): 9 | 10 | # Requires in input F,Kphi NOT in log10 11 | 12 | # Def of sigmoid function 13 | def sigmoid(phi,beta): 14 | 15 | phi0 = 10.0**13.22 16 | y = 1.0/(1.0 + (phi/phi0)**beta) 17 | 18 | return y 19 | 20 | 21 | # Parameters 22 | Fmin = 10.0**2.0 23 | 24 | # Evaluate rescaled flux-to-density ratio 25 | Ftilde2 = Frho/Fmin 26 | 27 | # Coefficient and exponents 28 | A = 1.682*abs(np.log10(Ftilde2))**0.2802 - 5.488 29 | 30 | 31 | alpha = 0.02489*(Ftilde2)**(-0.0860)\ 32 | - 0.01007*(Ftilde2)**(-0.9543) 33 | 34 | eta0 = -0.03973*abs(np.log10(Ftilde2))**2.173 - 0.01359 35 | 36 | 37 | beta = - 0.01799*(Ftilde2)**0.1723\ 38 | - 3.38751*(Ftilde2)**0.0140 39 | 40 | sigma = sigmoid(Kphi,beta) 41 | 42 | # Approximate value of log10(eta_eff) 43 | eta = A*Kphi**alpha*sigma + eta0*(1.0-sigma) 44 | 45 | return eta 46 | 47 | #--------------------------------------------------------------- 48 | 49 | # Physical constants 50 | 51 | MJ = 1.898e30 # Jupiter mass (g) 52 | RJ = 6.9911e9 # Jupiter radius (cm) 53 | AU = 1.495978707e13 # Astronomical unit (cm) 54 | Msun = 1.989e33 # Sun mass (g) 55 | Gc = 6.67259e-8 # Gravitational constant 56 | mu = 1.673e-24 # Proton mass 57 | kb = 1.38e-16 # Boltzmann constant 58 | 59 | # Jovian constants 60 | 61 | rhoJ = MJ/(4.0/3.0*np.pi*RJ**3.0) 62 | xiJ = (MJ/(3.0*Msun))**(1.0/3.0)*AU/RJ 63 | phiJ = Gc*MJ/RJ 64 | 65 | #------------------- 66 | 67 | # Read input data from terminal 68 | Rp = float(input('Planetary radius [R_J]: ')) 69 | Mp = float(input('Planetary mass [M_J]: ')) 70 | a = float(input('Orbital distance [AU]: ')) 71 | Ms = float(input('Parent star mass [M_sun]: ')) 72 | LX = float(input('Log10 of X-ray luminosity [erg/s]: ')) 73 | LEUV = float(input('Log10 of EUV luminosity [erg/s]: ')) 74 | 75 | #------------------- 76 | 77 | # Derived parameters 78 | rhop = Mp/Rp**3.0*rhoJ 79 | phi = Mp/Rp*phiJ 80 | xi = (Mp/Ms)**(1.0/3.0)*a/Rp*xiJ 81 | K = 1.0 - 3.0/(2.0*xi) + 1.0/(2.0*xi**3.0) 82 | FXUV = (10.0**LX + 10.0**LEUV)/(4.0*np.pi*a*a*AU*AU) 83 | Kphi = K*phi 84 | Frho = FXUV/rhop 85 | 86 | #------------------- 87 | 88 | # Warning conditions if input values are outside of validity range: 89 | 90 | # F/rho range 91 | if (Frho < 10.0**2.0 or Frho > 10.0**6.0): 92 | 93 | print('\n !!! WARNING: F/rho value (%6.4e) outside of validity range [1e2,1e6].' 94 | %(Frho), 95 | '\n eta_eff and Mdot values may not be accurate') 96 | 97 | # K*phi range 98 | if (Kphi < 10.0**12.17 or Kphi > 10.0**13.29): 99 | print('\n !!! WARNING: K*phi value (%5.2f) outside of validity range [12.17, 13.29].' 100 | %(np.log10(Kphi)), 101 | '\n eta_eff and Mdot values may not be accurate') 102 | 103 | #------------------- 104 | 105 | # Evaluate approximate eta_eff and Mdot 106 | 107 | eta_eff = 10.0**etaeff(Frho,Kphi) 108 | Mdot_eff = np.log10(3.0*eta_eff*FXUV/(4.0*Gc*K*rhop)) 109 | 110 | # Print to terminal 111 | print(' ') 112 | print('OUTPUT:') 113 | print(' ') 114 | print('Value of eta_eff: %6.4e' %(eta_eff)) 115 | print('Value of log10(Mdot): %5.2f' %(Mdot_eff)) 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | -------------------------------------------------------------------------------- /src/modules/radiation/sed_read.f90: -------------------------------------------------------------------------------- 1 | module sed_reader 2 | ! Module containing the subroutine for reading the numerical SED 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | !---------------------------------------------------! 11 | 12 | subroutine read_sed 13 | ! Subroutine to read the numerical SED from file. 14 | ! The file has to be formatted in two columns: 15 | ! 1) bin central wavelength [Angstrom] 16 | ! 2) flux at the planet surface [erg cm^{-2} s^{-2} A^{-1}] 17 | ! Data have to be order with increasing wavelength 18 | 19 | integer :: io 20 | integer :: j,skip 21 | real*8 :: e_top_read 22 | real*8 :: dum_w,dum_f,dum_e 23 | real*8 :: LEUV_int,LX_int,Df_int 24 | real*8, dimension(:), allocatable :: wave_c 25 | 26 | write(*,*) '(sed_read.f90) Reading the numerical spectrum..' 27 | 28 | ! Open file to read number of lines to be skipped 29 | ! according to the selected energy interval 30 | open(unit = 1, file = sed_file, status = 'old') 31 | 32 | ! Extend to 4.8 eV if He triplet is included 33 | if (thereis_HeITR) e_low = e_th_HeTR 34 | 35 | ! Set highest energy in SED 36 | e_top_read = e_top 37 | if (.not.thereis_Xray) e_top_read = e_mid 38 | 39 | ! Initialize counters 40 | Nl = 0 41 | skip = 0 42 | 43 | ! Read through file 44 | do 45 | ! Read wavelength and flux 46 | read(1,*,iostat = io) dum_w,dum_f 47 | 48 | ! Convert wavelength to eV 49 | dum_e = hp_eV*c_light/(dum_w*1e-8) 50 | 51 | ! Add one line to skip if current energy > e_top_read 52 | ! and keep reading 53 | if (dum_e .gt. e_top_read) then 54 | skip = skip + 1 55 | cycle 56 | endif 57 | 58 | ! if current energy < e_low quit loop 59 | if (dum_e .lt. e_low .or. io .lt. 0) exit 60 | 61 | ! Update number of selected points 62 | Nl = Nl + 1 63 | 64 | enddo 65 | 66 | ! Return to the beginning of the file 67 | rewind (unit = 1) 68 | 69 | ! Allocate energy vectors 70 | allocate(wave_c(Nl)) 71 | allocate(F_XUV(Nl)) 72 | allocate(e_v(Nl),de_v(Nl)) 73 | 74 | ! Read lines to be skipped 75 | do j = 1,skip; read(1,*) dum_w,dum_f; enddo 76 | 77 | ! Read lines of desired energy interval 78 | do j = 1,Nl 79 | read(1,*) wave_c(j),F_XUV(j) 80 | enddo 81 | 82 | ! Close SED file 83 | close(1) 84 | write(*,*) ' (sed_read.f90) Done.' 85 | 86 | ! Convert wavelength to energy 87 | e_v = hp_eV*c_light/(wave_c*1e-8) 88 | 89 | ! Calculate energy bins width 90 | de_v(1) = -0.5*(e_v(2) - e_v(1)) 91 | de_v(2:Nl-1) = -0.5*(e_v(3:Nl) - e_v(1:Nl-2)) 92 | de_v(Nl) = -0.5*(e_v(Nl) - e_v(Nl-1)) 93 | 94 | ! Rescale from F_lambda to F_E 95 | F_XUV = F_XUV*hp_eV*c_light*1.0e8/e_v**2.0e0 96 | 97 | ! Calculate LEUV and LX luminosities 98 | LEUV_int = 0.0 99 | LX_int = 0.0 100 | do j = 1,Nl 101 | 102 | ! Skip if energy is below ionization threshold 103 | if (e_v(j) .lt. e_th_HI) exit 104 | 105 | ! Integrate F(E) w.r.t. energy 106 | Df_int = de_v(j)*F_XUV(j)*4.0e0*pi*a_orb*a_orb 107 | 108 | ! Update separately EUV and X-ray luminosities 109 | if (e_v(j) .lt. e_mid) then 110 | LEUV_int = LEUV_int + Df_int 111 | else 112 | LX_int = LX_int + Df_int 113 | endif 114 | 115 | enddo 116 | 117 | ! Convert to log10 118 | LX = log10(LX_int) 119 | LEUV = log10(LEUV_int) 120 | 121 | deallocate(wave_c) 122 | 123 | ! End of subroutine 124 | end subroutine read_sed 125 | 126 | ! End of module 127 | end module sed_reader 128 | -------------------------------------------------------------------------------- /src/modules/states/Reconstruction.f90: -------------------------------------------------------------------------------- 1 | module Reconstruction_step 2 | ! Collection of reconstruction procedure subroutine 3 | 4 | use global_parameters 5 | use BC_Apply 6 | use PLM_reconstruction 7 | use Conversion 8 | 9 | implicit none 10 | 11 | contains 12 | 13 | subroutine Reconstruct(u_in,WL_out,WR_out) 14 | 15 | integer :: j,k 16 | real*8, dimension(1-Ng:N+Ng,3), intent(in) :: u_in 17 | real*8, dimension(1-Ng:N+Ng,3) :: WL,WR 18 | real*8, dimension(1-Ng:N+Ng,3), intent(out) :: WL_out, WR_out 19 | 20 | ! ESWENO3 variables 21 | real*8, dimension(1-Ng:N+Ng,3) :: W,dW 22 | real*8, dimension(3) :: dWp,dWm 23 | real*8, dimension(3) :: b0,b1 24 | real*8, dimension(3) :: tau 25 | real*8, dimension(3) :: S0,S1 26 | real*8 :: rm,rp 27 | real*8, dimension(1-Ng:N+Ng) :: dV,C1,C2,D1,D2 28 | 29 | select case (rec_method) 30 | 31 | !-----------------------------------------------! 32 | 33 | case ('PLM') ! Piecewise linear reconstruction 34 | 35 | call PLM_rec(u_in,WL,WR) 36 | 37 | ! Apply BC to reconstructed variables 38 | call Rec_BC(WL,WR,WL_out,WR_out) 39 | 40 | case ('WENO3') ! ESWENO3 Reconstruction 41 | 42 | ! Convert to primitive variables 43 | call U_to_W(u_in,W) 44 | 45 | ! Evaluate jumps at interfaces 46 | dW(1-Ng:N+Ng-1,:) = W(2-Ng:N+Ng,:) - W(1-Ng:N+Ng-1,:) 47 | dW(N+Ng,:) = 0.0 48 | 49 | ! Calculate cell volumes 50 | do j = 0, N+1 51 | rp = r_edg(j) 52 | rm = r_edg(j-1) 53 | dV(j) = (rp*rp*rp - rm*rm*rm) 54 | enddo 55 | dV(1-Ng) = dV(2-Ng) 56 | dV(N+Ng) = dV(N+Ng-1) 57 | 58 | 59 | ! Evaluate reconstruction geometry-dependent coefficients 60 | do j = 1-Ng,N+Ng-1 61 | C1(j) = dV(j+1)/(dV(j) + dV(j+1)) 62 | C2(j) = 1.0 - C1(j) 63 | enddo 64 | 65 | do j = 2-Ng,N+Ng-1 66 | D1(j) = dV(j+1)/(dV(j) + dV(j-1)) 67 | D2(j) = dV(j-1)/(dV(j) + dV(j+1)) 68 | enddo 69 | 70 | ! Construct smoothness indicators and reconstructed values 71 | do j = 0,N+1 72 | 73 | dWp = dW(j,:) 74 | dWm = dW(j-1,:) 75 | 76 | do k = 1,3 77 | b0(k) = dWp(k)*dWp(k) + dr_j(j)*dr_j(j) 78 | b1(k) = dWm(k)*dWm(k) + dr_j(j)*dr_j(j) 79 | enddo 80 | 81 | tau = dWp - dWm 82 | S0 = 1.0 + tau*tau/b0 83 | S1 = 1.0 + tau*tau/b1 84 | 85 | WL(j,:) = W(j,:) & 86 | + (S0*C1(j)*dWp + D1(j)*S1*C1(j-1)*dWm) & 87 | /(S0 + D1(j)*S1) 88 | 89 | WR(j-1,:) = W(j,:) & 90 | - (D2(j)*S0*C2(j)*dWp + S1*C2(j-1)*dWm) & 91 | /(D2(j)*S0 + S1) 92 | enddo 93 | 94 | ! Apply BC to reconstructed variables 95 | call Rec_BC(WL,WR,WL_out,WR_out) 96 | 97 | end select 98 | 99 | ! End of subroutine 100 | end subroutine Reconstruct 101 | 102 | ! End of module 103 | end module Reconstruction_step 104 | -------------------------------------------------------------------------------- /src/modules/functions/cross_sec.f90: -------------------------------------------------------------------------------- 1 | module Cross_sections 2 | ! Energy-dependent photoionization cross sections (1e-18 cm^2) 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | !----- Hydrogenic atoms -----! 11 | 12 | double precision function sigma(E,Z) 13 | real*8, intent(in) :: Z,E 14 | real*8 :: E_0,eps,cut 15 | 16 | ! Ionization treshold 17 | E_0 = 13.6*Z*Z 18 | 19 | if (E.gt.E_0) then ! For E > E_th 20 | 21 | ! Substitution 22 | eps = sqrt(E/E_0-1.0) 23 | 24 | ! Cross section value 25 | sigma = 6.3/(Z*Z)*(E_0/E)**4.0 & 26 | *exp(4.0-4.0*atan(eps)/eps) & 27 | /(1.0-exp(-2.0*pi/eps)) 28 | 29 | else 30 | ! Cross section value 31 | sigma = 6.3/(Z*Z) 32 | 33 | endif 34 | 35 | ! Correct if E = E_th 36 | cut = 0.99999*E_0 37 | 38 | if(E.lt.cut) sigma = 0.0 39 | 40 | ! End of function 41 | end function 42 | 43 | !---------------------------------------- 44 | 45 | !----- HeI -----! 46 | 47 | double precision function sigma_HeI(E) 48 | real*8,intent(in) :: E 49 | real*8 :: eth 50 | 51 | ! Ionization treshold 52 | eth = 24.6*0.999 53 | 54 | if (E.ge.eth) then ! if E > E_th 55 | sigma_HeI = 0.6935/((E*1.0d-2)**1.82+(E*1.0d-2)**3.23) 56 | else 57 | sigma_Hei = 0.0 58 | endif 59 | 60 | ! End of function 61 | end function sigma_HeI 62 | 63 | !---------------------------------------- 64 | 65 | ! HeI(23S) triplet photoionization cross section 66 | ! Fit of data from Norcross (1971) 67 | ! Note: Oklopcic calculations include HeITR only in the 68 | ! range [4.8-13.6] eV 69 | 70 | double precision function sigma_HeI23S(E) 71 | real*8, intent(in) :: E 72 | real*8 :: logE,logsigma 73 | real*8 :: a1,c1,a2,c2,a3,c3 74 | real*8 :: x1,x2,x3,x4,x5 75 | real*8 :: y3,y4,m 76 | 77 | ! Intervals of power laws 78 | x1 = log10(hp_eV*c_light/(2593.01*1e-8))*0.9999 79 | x2 = log10(hp_eV*c_light/(1655.63*1e-8)) 80 | x3 = log10(hp_eV*c_light/(357.340*1e-8)) 81 | x4 = log10(hp_eV*c_light/(271.940*1e-8)) 82 | x5 = log10(hp_eV*c_light/(209.490*1e-8))*1.0001 83 | 84 | ! Coefficients of fit 85 | a1 = -0.8134 86 | a2 = -1.772 87 | a3 = -3.039 88 | c1 = 1.240 89 | c2 = c1 + x2*(a1-a2) ! For continuity of the broken PL 90 | c3 = 5.470 91 | y3 = a2*x3 + c2 92 | y4 = a3*x4 + c3 93 | m = (y4-y3)/(x4-x3) 94 | 95 | ! Log of current energy 96 | logE = log10(E) 97 | 98 | if (logE .lt. x1 .or. logE .gt. x5) then 99 | sigma_HeI23S = 0.0 100 | return 101 | endif 102 | 103 | ! Value of log10 of cross section from the fit 104 | if (logE .le. x2) logsigma = a1*logE + c1 105 | if (logE .gt. x2 .and. logE .le. x3) logsigma = a2*logE + c2 106 | if (logE .gt. x3 .and. logE .lt. x4) logsigma = m*(logE - x3) + y3 107 | if (logE .ge. x4) logsigma = a3*logE + c3 108 | 109 | ! Return value 110 | sigma_HeI23S = 10.0**logsigma 111 | 112 | ! End of function 113 | end function sigma_HeI23S 114 | 115 | !---------------------------------------- 116 | 117 | ! End of module 118 | end module Cross_sections -------------------------------------------------------------------------------- /src/modules/flux/speed_estimate_HLLC.f90: -------------------------------------------------------------------------------- 1 | module S_estimate_HLLC 2 | ! Estimate for left, middle and right velocities based on 3 | ! the hybrid method of Toro (2009) [ch. 9.5] 4 | 5 | use global_parameters 6 | 7 | implicit none 8 | 9 | contains 10 | 11 | subroutine speed_estimate_HLLC(WL,WR,SL,SR,S_star) 12 | real*8, intent(in) :: WL(3), WR(3) 13 | 14 | real*8 :: rhoL,uL,pL,cL 15 | real*8 :: rhoR,uR,pR,cR 16 | real*8 :: rho_bar,c_bar 17 | real*8 :: Q,Q_user 18 | real*8 :: p_min,p_max,p_star 19 | real*8 :: z,pLR 20 | real*8 :: AL,BL,AR,BR,gL,gR 21 | real*8 :: qL,qR,u_star 22 | 23 | real*8, intent(out) :: SL,SR,S_star 24 | 25 | ! Exctract left state 26 | rhoL = WL(1) 27 | uL = WL(2) 28 | pL = WL(3) 29 | 30 | ! Exctract right state 31 | rhoR = WR(1) 32 | uR = WR(2) 33 | pR = WR(3) 34 | 35 | ! Sound speed 36 | cL = sqrt(g*pL/rhoL) 37 | cR = sqrt(g*pR/rhoR) 38 | 39 | ! Average density and sound speed 40 | rho_bar = 0.5*(rhoL+rhoR) 41 | c_bar = 0.5*(cL+cR) 42 | 43 | !-------------------------------------------------------------! 44 | 45 | ! Substitutions 46 | p_min = min(pL,pR) 47 | p_max = max(pL,pR) 48 | 49 | Q = p_max/p_min 50 | Q_user = 2.0 51 | 52 | ! Initial PVRS guess 53 | p_star = 0.5*(pL+pR)-0.5*(uR-uL)*rho_bar*c_bar 54 | u_star = 0.5*(uL+uR)-0.5*(pR-pL)/(c_bar*rho_bar) 55 | 56 | ! Construct middle state approximation 57 | if(Q.gt.Q_user) then ! PVRS 58 | 59 | if(p_star.le.p_min) then ! TRRS 60 | 61 | ! Subs 62 | z = 0.5*(g-1.0)/g 63 | pLR = (pL/pR)**z 64 | 65 | p_star = sqrt((cL+cR-0.5*(g-1.0)*(uR-uL))/ & 66 | (cL/pL**z + cR/pR**z)) 67 | u_star = (pLR*uL/cL+uR/cR & 68 | + 2.0*(pLR-1.0)/(g-1.0))/ & 69 | (pLR/cL+1.0/cR) 70 | 71 | elseif(p_star.ge.p_max) then ! TSRS 72 | 73 | ! Subs 74 | AL = 2.0/((g+1.0)*rhoL) 75 | BL = (g-1.0)/(g+1.0)*pL 76 | AR = 2.0/((g+1.0)*rhoR) 77 | BR = (g-1.0)/(g+1.0)*pR 78 | 79 | p_star = max(0.0, p_star) 80 | gL = sqrt(AL/(p_star + BL)) 81 | gR = sqrt(AR/(p_star + BR)) 82 | 83 | p_star = (gL*pL+gR*pR-uR+uL)/(gL+gR) 84 | u_star = 0.5*(uL+uR)+ & 85 | 0.5*((p_star-pR)*gR-(p_star-pL)*gL) 86 | 87 | endif 88 | endif 89 | 90 | !-------------------------------------------------------------! 91 | 92 | ! Construct speed estimates 93 | 94 | ! qL 95 | if(p_star .lt. pL) then 96 | qL = 1.0 97 | else 98 | qL = sqrt(1.0 + 0.5*(g-1.0)/g*(p_star/pL-1.0)) 99 | endif 100 | 101 | ! qR 102 | if(p_star .lt. pR) then 103 | qR = 1.0 104 | else 105 | qR = sqrt(1.0 + 0.5*(g-1.0)/g*(p_star/pR-1.0)) 106 | endif 107 | 108 | ! Speed estimates 109 | SL = uL-cL*qL 110 | SR = uR+cR*qR 111 | 112 | ! Use S_star approximation from Batten et al. 113 | S_star = (pR - PL + rhoL*uL*(SL-uL) - rhoR*uR*(SR-uR))/ & 114 | (rhoL*(SL-uL) - rhoR*(SR-uR)) 115 | 116 | ! End of subroutine 117 | end subroutine speed_estimate_HLLC 118 | 119 | ! End of module 120 | end module S_estimate_HLLC 121 | -------------------------------------------------------------------------------- /src/modules/flux/speed_estimate_ROE.f90: -------------------------------------------------------------------------------- 1 | module S_estimate_ROE 2 | ! Estimate for left and right velocities for the Roe method 3 | ! based on Toro (2009) [ch. 11.3-4] 4 | 5 | use global_parameters 6 | 7 | implicit none 8 | 9 | contains 10 | 11 | subroutine speed_estimate_ROE(WL,WR,u_star,cL_star,cR_star) 12 | real*8, intent(in) :: WL(3), WR(3) 13 | real*8 :: rhoL,uL,pL,cL 14 | real*8 :: rhoR,uR,pR,cR 15 | real*8 :: rho_bar,c_bar 16 | real*8 :: Q,Q_user 17 | real*8 :: p_min,p_max,p_star 18 | real*8 :: z,pLR 19 | real*8 :: AL,BL,AR,BR,gL,gR 20 | real*8 :: rhoL_star,rhoR_star 21 | real*8, intent(out) :: u_star,cL_star,cR_star 22 | 23 | ! Exctract left state 24 | rhoL = WL(1) 25 | uL = WL(2) 26 | pL = WL(3) 27 | 28 | ! Exctract right state 29 | rhoR = WR(1) 30 | uR = WR(2) 31 | pR = WR(3) 32 | 33 | ! Sound speed 34 | cL = sqrt(g*pL/rhoL) 35 | cR = sqrt(g*pR/rhoR) 36 | 37 | ! Average density and sound speed 38 | rho_bar = 0.5*(rhoL+rhoR) 39 | c_bar = 0.5*(cL+cR) 40 | 41 | !-------------------------------------------------------------! 42 | 43 | ! Substitutions 44 | p_min = min(pL,pR) 45 | p_max = max(pL,pR) 46 | 47 | Q = p_max/p_min 48 | Q_user = 2.0 49 | 50 | ! Initial PVRS guess 51 | p_star = 0.5*(pL+pR)-0.5*(uR-uL)*rho_bar*c_bar 52 | u_star = 0.5*(uL+uR)-0.5*(pR-pL)/(c_bar*rho_bar) 53 | rhoL_star = rhoL + (p_star-pL)/(cL*cL) 54 | rhoR_star = rhoR + (p_star-pR)/(cR*cR) 55 | 56 | ! Construct middle state approximation 57 | if(Q.gt.Q_user) then ! PVRS 58 | 59 | if(p_star.le.p_min) then ! TRRS 60 | 61 | ! Subs 62 | z = 0.5*(g-1.0)/g 63 | pLR = (pL/pR)**z 64 | 65 | p_star = sqrt((cL+cR-0.5*(g-1.0)*(uR-uL))/ & 66 | (cL/pL**z + cR/pR**z)) 67 | u_star = (pLR*uL/cL+uR/cR & 68 | +2.0*(pLR-1.0)/(g-1.0))/ & 69 | (pLR/cL+1.0/cR) 70 | 71 | rhoL_star = rhoL*(p_star/pL)**(1.0/g) 72 | rhoR_star = rhoR*(p_star/pR)**(1.0/g) 73 | 74 | elseif(p_star.ge.p_max) then ! TSRS 75 | 76 | ! Subs 77 | AL = 2.0/((g+1.0)*rhoL) 78 | BL = (g-1.0)/(g+1.0)*pL 79 | AR = 2.0/((g+1.0)*rhoR) 80 | BR = (g-1.0)/(g+1.0)*pR 81 | 82 | p_star = max(0.0, p_star) 83 | gL = sqrt(AL/(p_star + BL)) 84 | gR = sqrt(AR/(p_star + BR)) 85 | 86 | p_star = (gL*pL+gR*pR-uR+uL)/(gL+gR) 87 | u_star = 0.5*(uL+uR)+ & 88 | 0.5*((p_star-pR)*gR-(p_star-pL)*gL) 89 | 90 | rhoL_star = (p_star/pL + (g-1.0)/(g+1.0))/ & 91 | ((g-1.0)/(g+1.0)*p_star/pL+1.0) 92 | rhoR_star = (p_star/pR + (g-1.0)/(g+1.0))/ & 93 | ((g-1.0)/(g+1.0)*p_star/pR+1.0) 94 | 95 | endif 96 | endif 97 | 98 | !-------------------------------------------------------------! 99 | 100 | ! Construct sound speed estimates 101 | cL_star = sqrt(g*p_star/rhoL_star) 102 | cR_star = sqrt(g*p_star/rhoR_star) 103 | 104 | ! End of subroutine 105 | end subroutine speed_estimate_ROE 106 | 107 | ! End of module 108 | end module S_estimate_ROE 109 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/enorm.f90: -------------------------------------------------------------------------------- 1 | double precision function enorm(n,x) 2 | integer n 3 | double precision x(n) 4 | ! ********** 5 | 6 | ! function enorm 7 | 8 | ! given an n-vector x, this function calculates the 9 | ! euclidean norm of x. 10 | 11 | ! the euclidean norm is computed by accumulating the sum of 12 | ! squares in three different sums. the sums of squares for the 13 | ! small and large components are scaled so that no overflows 14 | ! occur. non-destructive underflows are permitted. underflows 15 | ! and overflows do not occur in the computation of the unscaled 16 | ! sum of squares for the intermediate components. 17 | ! the definitions of small, intermediate and large components 18 | ! depend on two constants, rdwarf and rgiant. the main 19 | ! restrictions on these constants are that rdwarf**2 not 20 | ! underflow and rgiant**2 not overflow. the constants 21 | ! given here are suitable for every known computer. 22 | 23 | ! the function statement is 24 | 25 | ! double precision function enorm(n,x) 26 | 27 | ! where 28 | 29 | ! n is a positive integer input variable. 30 | 31 | ! x is an input array of length n. 32 | 33 | ! subprograms called 34 | 35 | ! fortran-supplied ... dabs,dsqrt 36 | 37 | ! argonne national laboratory. minpack project. march 1980. 38 | ! burton s. garbow, kenneth e. hillstrom, jorge j. more 39 | 40 | ! ********** 41 | integer i 42 | double precision agiant,floatn,one,rdwarf,rgiant,s1,s2,s3,xabs,& 43 | x1max,x3max,zero 44 | data one,zero,rdwarf,rgiant /1.0d0,0.0d0,3.834d-20,1.304d19/ 45 | s1 = zero 46 | s2 = zero 47 | s3 = zero 48 | x1max = zero 49 | x3max = zero 50 | floatn = n 51 | agiant = rgiant/floatn 52 | do 90 i = 1, n 53 | xabs = dabs(x(i)) 54 | if (xabs .gt. rdwarf .and. xabs .lt. agiant) go to 70 55 | if (xabs .le. rdwarf) go to 30 56 | 57 | !sum for large components. 58 | 59 | if (xabs .le. x1max) go to 10 60 | s1 = one + s1*(x1max/xabs)**2 61 | x1max = xabs 62 | go to 20 63 | 10 continue 64 | s1 = s1 + (xabs/x1max)**2 65 | 20 continue 66 | go to 60 67 | 30 continue 68 | 69 | !sum for small components. 70 | 71 | if (xabs .le. x3max) go to 40 72 | s3 = one + s3*(x3max/xabs)**2 73 | x3max = xabs 74 | go to 50 75 | 40 continue 76 | if (xabs .ne. zero) s3 = s3 + (xabs/x3max)**2 77 | 50 continue 78 | 60 continue 79 | go to 80 80 | 70 continue 81 | 82 | !sum for intermediate components. 83 | 84 | s2 = s2 + xabs**2 85 | 80 continue 86 | 90 continue 87 | 88 | !calculation of norm. 89 | 90 | if (s1 .eq. zero) go to 100 91 | enorm = x1max*dsqrt(s1+(s2/x1max)/x1max) 92 | go to 130 93 | 100 continue 94 | if (s2 .eq. zero) go to 110 95 | if (s2 .ge. x3max) & 96 | enorm = dsqrt(s2*(one+(x3max/s2)*(x3max*s3))) 97 | if (s2 .lt. x3max) & 98 | enorm = dsqrt(x3max*((s2/x3max)+(x3max*s3))) 99 | go to 120 100 | 110 continue 101 | enorm = x3max*dsqrt(s3) 102 | 120 continue 103 | 130 continue 104 | return 105 | 106 | !last card of function enorm. 107 | 108 | end 109 | -------------------------------------------------------------------------------- /src/modules/files_IO/write_setup_report.f90: -------------------------------------------------------------------------------- 1 | module setup_report 2 | ! Contains subroutine to write the setup of the current 3 | ! simulation to file 4 | 5 | use global_parameters 6 | 7 | implicit none 8 | contains 9 | 10 | ! ------------------------------ ! 11 | 12 | subroutine write_setup_report 13 | ! Write summary of the current simulation setup to file 14 | 15 | write(*,*) '(write_setup_report.f90) Writing the setup report on ATES.out..' 16 | 17 | write(outfile,*) '######## Simulation for ', p_name, ' ########' 18 | write(outfile,*) ' ' 19 | write(outfile,*) ' ----- Planetary parameters ----- ' 20 | write(outfile,*) ' ' 21 | write(outfile,1) & 22 | ' - Planet mass: ', Mp/MJ, ' [M_J], ', Mp/M_earth, ' [M_earth]' 23 | write(outfile,2) & 24 | ' - Planet radius: ', R0/RJ, ' [R_J], ', R0/R_earth, ' [R_earth]' 25 | write(outfile,3) ' - Orbital distance: ', a_orb/AU, ' [AU]' 26 | write(outfile,4) ' - Equilibrium temperature: ', T0, ' [K]' 27 | write(outfile,5) ' - Jeans parameter (beta_0): ', b0 28 | write(outfile,15) & 29 | ' - Log surface gravitational potential: ', log10(Gc*Mp/R0), ' erg/g' 30 | write(outfile,*) ' ' 31 | write(outfile,*) ' ----- Stellar parameters ----- ' 32 | write(outfile,*) ' ' 33 | write(outfile,6) ' - Star mass: ', Mstar/Msun, ' [M_sun]' 34 | write(outfile,7) ' - Log EUV luminosity: ', LEUV, ' [erg/s]' 35 | write(outfile,8) ' - Log X-ray luminosity: ', LX, ' [erg/s]' 36 | write(outfile,9) & 37 | ' - Log XUV flux at the planet distance: ', log10(J_XUV), ' [erg/(cm^2 s)]' 38 | write(outfile,*) 39 | write(outfile,*) ' ----- Simulation setup parameters -----' 40 | write(outfile,*) 41 | write(outfile,10) & 42 | ' - Upper boundary of the domain: ', r_max, ' [R_p]' 43 | if (thereis_He) then 44 | write(outfile,11) & 45 | ' - Simulating a H/He atmosphere with',' He/H ratio of ', HeH 46 | if (thereis_HeITR) & 47 | write(outfile,*) '- Including helium triplet chemistry' 48 | else 49 | write(outfile,*) '- Simulating a pure H atmosphere' 50 | endif 51 | if (do_read_sed) & 52 | write(outfile,*) & 53 | ' - Spectrum read from external file: ', sed_file 54 | if (is_PL_sed) & 55 | write(outfile,12) & 56 | ' - Using power-law spectrum ', 'with index ', PLind 57 | if (is_monochr) & 58 | write(outfile,13) & 59 | ' - Using monochromatic radiation with energy ', e_low 60 | if (appx_mth.eq.'alpha') then 61 | write(outfile,14) ' - 2D approximation used: alpha =, with alpha = ',a_tau 62 | else 63 | write(outfile,*) '- 2D approximation used: ', appx_mth 64 | endif 65 | write(outfile,*) 66 | write(outfile,*) '----- Numerical parameters -----' 67 | write(outfile,*) 68 | write(outfile,*) '- Grid type: ', grid_type 69 | write(outfile,*) '- Numerical flux: ', flux 70 | write(outfile,*) '- Reconstruction method: ', rec_method 71 | write(outfile,*) 72 | if (.not.do_load_IC) & 73 | write(outfile,*) '----- Starting a new simulation ----- ' 74 | if (do_load_IC) & 75 | write(outfile,*) '----- Continuing existing simulation ----- ' 76 | if (do_only_pp) & 77 | write(outfile,*) '- Evaluating post processing only' 78 | if (force_start) & 79 | write(outfile,*) '- Forcing the simulation for the first 1000 steps' 80 | 81 | 1 format(A16,F5.3,A8,F8.5,A10) 82 | 2 format(A18,F5.3,A8,F8.5,A10) 83 | 3 format(A21,F6.4,A5) 84 | 4 format(A28,F6.1,A4) 85 | 5 format(A29,F7.2) 86 | 6 format(A14,F5.3,A8) 87 | 7 format(A23,F6.3,A8) 88 | 8 format(A25,F6.3,A8) 89 | 9 format(A40,F5.3,A15) 90 | 10 format(A33,F5.2,A6) 91 | 11 format(A36,A15,F8.6) 92 | 12 format(A28,A11,F5.2) 93 | 13 format(A45,F7.2) 94 | 14 format(A48,F6.3) 95 | 15 format(A40,F5.2,A6) 96 | 97 | write(*,*) '(write_setup_report.f90) Done.' 98 | 99 | end subroutine write_setup_report 100 | 101 | 102 | 103 | ! End of module 104 | end module setup_report 105 | -------------------------------------------------------------------------------- /src/modules/functions/utilities.f90: -------------------------------------------------------------------------------- 1 | module utils 2 | ! Collection of auxiliary subroutines 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | ! ------------------------------------------------------! 11 | 12 | subroutine calc_ne(nhii,nheii,nheiii,ne) 13 | ! Calculate the free electron density 14 | 15 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhii 16 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nheii,nheiii 17 | real*8, dimension(1-Ng:N+Ng), intent(out) :: ne 18 | 19 | if (thereis_He) then 20 | ne = nhii + nheii + 2.0*nheiii 21 | else 22 | ne = nhii 23 | endif 24 | 25 | end subroutine calc_ne 26 | 27 | ! ------------------------------------------------------! 28 | 29 | subroutine calc_ntot(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_tot) 30 | ! Calculate the total atomic number density 31 | 32 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhi,nhii 33 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhei,nheii,nheiii,nheiTR 34 | real*8, dimension(1-Ng:N+Ng), intent(out) :: n_tot 35 | 36 | if (thereis_He) then 37 | n_tot = nhi + nhii + nhei + nheii + nheiii 38 | if (thereis_HeITR) n_tot = n_tot + nheiTR 39 | else 40 | n_tot = nhi + nhii 41 | endif 42 | 43 | end subroutine calc_ntot 44 | 45 | ! ------------------------------------------------------! 46 | 47 | subroutine calc_rho(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_out) 48 | ! Calculate the total mass density (adimensional) 49 | 50 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhi,nhii 51 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhei,nheii,nheiii,nheiTR 52 | real*8, dimension(1-Ng:N+Ng), intent(out) :: n_out 53 | 54 | if (thereis_He) then 55 | n_out = nhi + nhii + 4.0*(nhei + nheii + nheiii) 56 | if (thereis_HeITR) n_out = n_out + 4.0*nheiTR 57 | else 58 | n_out = nhi + nhii 59 | endif 60 | 61 | end subroutine calc_rho 62 | 63 | ! ------------------------------------------------------! 64 | 65 | subroutine calc_column_dens(nhi,nhei,nheii,nheiTR,N1,N15,N2,NTR) 66 | ! Calculates the column densities for given ionization profiles 67 | ! by method of rectangles 68 | 69 | integer :: j 70 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhi 71 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhei,nheii,nheiTR 72 | real*8 :: dr 73 | real*8, dimension(1-Ng:N+Ng), intent(out) :: N1 74 | real*8, dimension(1-Ng:N+Ng), intent(out) :: N15,N2,NTR 75 | 76 | ! Initialize outputs 77 | N1 = 0.0 78 | N15 = 0.0 79 | N2 = 0.0 80 | NTR = 0.0 81 | 82 | ! Outer point 83 | N1(N+Ng) = dr_j(N+Ng)*R0*nhi(N+Ng) 84 | if (thereis_He) then 85 | 86 | N15(N+Ng) = dr_j(N+Ng)*R0*nhei(N+Ng) 87 | N2(N+Ng) = dr_j(N+Ng)*R0*nheii(N+Ng) 88 | if(thereis_HeITR) NTR(N+Ng) = dr_j(N+Ng)*R0*nheiTR(N+Ng) 89 | 90 | endif 91 | 92 | do j = N+Ng-1,1-Ng,-1 93 | 94 | ! Spacing 95 | dr = dr_j(j)*R0 96 | 97 | ! Evaluate new column densities by integration 98 | N1(j) = N1(j+1) + nhi(j)*dr ! HI 99 | 100 | if (thereis_He) then 101 | N15(j) = N15(j+1) + nhei(j)*dr ! HeI 102 | N2(j) = N2(j+1) + nheii(j)*dr ! HeII 103 | if(thereis_HeITR) NTR(j) = NTR(j+1) + nheiTR(j)*dr ! HeI triplet 104 | endif 105 | 106 | enddo 107 | 108 | ! End of subroutine 109 | end subroutine calc_column_dens 110 | 111 | ! ------------------------------------------------------! 112 | 113 | subroutine calc_mmw(nh,nhe,ne,mmw) 114 | ! Calculate the mean molecular weight for a certain ionization profile 115 | 116 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nh,nhe,ne 117 | real*8, dimension(1-Ng:N+Ng), intent(out) :: mmw 118 | 119 | if (thereis_He) then 120 | mmw = (nh + 4.0*nhe)/(nh + nhe + ne) 121 | else 122 | mmw = nh/(nh + ne) 123 | endif 124 | 125 | ! End of subroutine 126 | end subroutine calc_mmw 127 | 128 | ! End of module 129 | end module utils 130 | -------------------------------------------------------------------------------- /src/modules/init/set_energy_vectors.f90: -------------------------------------------------------------------------------- 1 | module energy_vectors_construct 2 | ! Construct energy grid for the computation of radiative 3 | ! contributions and radiative equilibrium 4 | 5 | use global_parameters 6 | use sed_reader 7 | use J_incident 8 | use Cross_sections 9 | 10 | implicit none 11 | 12 | contains 13 | 14 | subroutine set_energy_vectors 15 | ! Subroutine to construct the energy grid 16 | 17 | integer :: i,j 18 | integer, parameter :: num_HI = 50 19 | integer, parameter :: num_HeI = 50 20 | integer, parameter :: num_HeII = 50 21 | integer, parameter :: num_X = 50 22 | 23 | real*8 :: e_min, e_max 24 | real*8, dimension(:), allocatable :: dum_E,dum_F,dum_dE 25 | real*8 :: temp1,temp2 26 | 27 | ! Set the energy band of the spectrum 28 | if (is_PL_sed) then 29 | 30 | ! Add points for He triplet if included 31 | NlTR = 0 32 | if (thereis_HeITR) NlTR = 20 33 | Nl = Nl_fix + NlTR 34 | 35 | ! Allocate vectors 36 | allocate(e_v(Nl),de_v(Nl)) 37 | allocate(s_hi(Nl), s_hei(Nl),s_heii(Nl)) 38 | allocate(F_XUV(Nl)) 39 | 40 | ! --- Construct energy grid --- ! 41 | 42 | ! Points between 4.8 eV and 13.6 eV if HeI triplet is included 43 | if (thereis_HeITR) then 44 | do j = 1,NlTR 45 | e_v(j) = e_th_HeTR* & 46 | (e_th_HI/e_th_HeTR)**((j-1.0)/(NlTR*1.0)) 47 | enddo 48 | endif 49 | 50 | ! Pure-HI grid [13.6 eV, 24.6 eV] 51 | e_min = e_th_HI 52 | e_max = e_th_HeI 53 | do j = 1,num_HI 54 | e_v(NlTR + j) = & 55 | e_min*(e_max/e_min)**((j-1.0)/(num_HI*1.0)) 56 | enddo 57 | 58 | ! HI+HeI grid [24.6 eV, 54.4 eV] 59 | e_min = e_th_HeI 60 | e_max = e_th_HeII 61 | do j = 1,num_HeI 62 | e_v(NlTR + num_HI + j) = & 63 | e_min*(e_max/e_min)**((j-1.0)/(num_HeI*1.0)) 64 | enddo 65 | 66 | ! HI+HeI+HeII grid [54.4 eV,124 eV] 67 | e_min = e_th_HeII 68 | e_max = e_mid 69 | do j = 1,num_HeII 70 | e_v(NlTR + num_HI + num_HeI + j) = & 71 | e_min*(e_max/e_min)**((j-1.0)/(num_HeII*1.0)) 72 | enddo 73 | 74 | ! X-ray grid [124 eV, e_XUV_top] 75 | e_min = e_mid 76 | e_max = e_top 77 | do j = 1,num_X 78 | e_v(NlTR + num_HI + num_HeI + num_HeII + j) = & 79 | e_min*(e_max/e_min)**((j-1.0)/(num_X*1.0)) 80 | enddo 81 | 82 | ! Construct bin width 83 | de_v(1) = 0.5*(e_v(2) - e_v(1)) 84 | de_v(2:Nl-1) = 0.5*(e_v(3:Nl) - e_v(1:Nl-2)) 85 | de_v(Nl) = 0.5*(e_v(Nl) - e_v(Nl-1)) 86 | 87 | else if (is_monochr) then ! If monochromatic radiation 88 | 89 | ! Set only one wavelength 90 | Nl = 1 91 | 92 | ! Allocate vectors 93 | allocate(e_v(Nl),de_v(Nl)) 94 | allocate(s_hi(Nl), s_hei(Nl),s_heii(Nl)) 95 | allocate(F_XUV(Nl)) 96 | 97 | ! Define the only energy value according to the input 98 | e_v(1) = e_low 99 | de_v(1) = 1.0 100 | 101 | ! Define the total flux at this energy 102 | F_XUV(1) = 10.0**LEUV/(4.0*pi*a_orb**2.0) 103 | 104 | else if (do_read_sed) then ! If read sed 105 | 106 | ! Read the SED file 107 | call read_sed 108 | 109 | ! Flip energy vectors 110 | allocate(dum_E(Nl),dum_F(Nl),dum_dE(Nl)) 111 | 112 | dum_E = e_v 113 | dum_F = F_XUV 114 | dum_dE = de_v 115 | 116 | do i = 1,Nl 117 | e_v(i) = dum_E(Nl-i+1) 118 | F_XUV(i) = dum_F(Nl-i+1) 119 | de_v(i) = dum_dE(Nl-i+1) 120 | enddo 121 | 122 | deallocate(dum_E,dum_F,dum_dE) 123 | endif 124 | 125 | 126 | ! Calculate the integrated value of the flux 127 | J_XUV = (10.0**LX + 10.0**LEUV)/(4.0*pi*a_orb**2.0) 128 | 129 | ! HI photoioiniz. cross section 130 | s_hi = (/ (sigma(e_v(i),ih), i = 1,Nl) /) 131 | 132 | ! HeI photoioiniz. cross section 133 | s_hei = (/ (sigma_hei(e_v(i)), i = 1,Nl) /) 134 | 135 | ! HeII photoioiniz. cross section 136 | s_heii = (/ (sigma(e_v(i),ihe), i = 1,Nl) /) 137 | 138 | ! HeI triplet photoioiniz. cross section 139 | s_heiTR = (/ (sigma_HeI23S(e_v(i)), i = 1,Nl) /) 140 | 141 | ! -------------------------------------------------- 142 | 143 | ! Incident flux 144 | if (is_PL_sed) then 145 | 146 | if (appx_mth.eq.'Rate/2 + Mdot/2') then 147 | 148 | F_XUV = (/ (0.5e0*J_inc(e_v(i)), i = 1,Nl) /) 149 | 150 | elseif (appx_mth.eq.'Rate/4 + Mdot') then 151 | 152 | F_XUV = (/ (0.25e0*J_inc(e_v(i)), i = 1,Nl) /) 153 | 154 | else 155 | 156 | F_XUV = (/ (J_inc(e_v(i)), i = 1,Nl) /) 157 | 158 | endif 159 | 160 | else 161 | 162 | if (appx_mth.eq.'Rate/2 + Mdot/2') then 163 | 164 | F_XUV = 0.5e0*F_XUV 165 | 166 | elseif (appx_mth.eq.'Rate/4 + Mdot') then 167 | 168 | F_XUV = 0.25e0*F_XUV 169 | 170 | endif 171 | 172 | endif 173 | 174 | ! End of subroutine 175 | end subroutine set_energy_vectors 176 | 177 | ! End of module 178 | end module energy_vectors_construct 179 | 180 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/hybrd1.f90: -------------------------------------------------------------------------------- 1 | subroutine hybrd1(fcn,n,x,fvec,tol,info,wa,lwa,params) 2 | integer n,info,lwa 3 | double precision tol 4 | double precision x(n),fvec(n),wa(lwa),params(25) 5 | external fcn 6 | ! ********** 7 | 8 | ! subroutine hybrd1 9 | 10 | ! the purpose of hybrd1 is to find a zero of a system of 11 | ! n nonlinear functions in n variables by a modification 12 | ! of the powell hybrid method. this is done by using the 13 | ! more general nonlinear equation solver hybrd. the user 14 | ! must provide a subroutine which calculates the functions. 15 | ! the jacobian is then calculated by a forward-difference 16 | ! approximation. 17 | 18 | ! the subroutine statement is 19 | 20 | ! subroutine hybrd1(fcn,n,x,fvec,tol,info,wa,lwa) 21 | 22 | ! where 23 | 24 | ! fcn is the name of the user-supplied subroutine which 25 | ! calculates the functions. fcn must be declared 26 | ! in an external statement in the user calling 27 | ! program, and should be written as follows. 28 | 29 | ! subroutine fcn(n,x,fvec,iflag) 30 | ! integer n,iflag 31 | ! double precision x(n),fvec(n) 32 | ! ---------- 33 | ! calculate the functions at x and 34 | ! return this vector in fvec. 35 | ! --------- 36 | ! return 37 | ! end 38 | 39 | ! the value of iflag should not be changed by fcn unless 40 | ! the user wants to terminate execution of hybrd1. 41 | ! in this case set iflag to a negative integer. 42 | 43 | ! n is a positive integer input variable set to the number 44 | ! of functions and variables. 45 | 46 | ! x is an array of length n. on input x must contain 47 | ! an initial estimate of the solution vector. on output x 48 | ! contains the final estimate of the solution vector. 49 | 50 | ! fvec is an output array of length n which contains 51 | ! the functions evaluated at the output x. 52 | 53 | ! tol is a nonnegative input variable. termination occurs 54 | ! when the algorithm estimates that the relative error 55 | ! between x and the solution is at most tol. 56 | 57 | ! info is an integer output variable. if the user has 58 | ! terminated execution, info is set to the (negative) 59 | ! value of iflag. see description of fcn. otherwise, 60 | ! info is set as follows. 61 | 62 | ! info = 0 improper input parameters. 63 | 64 | ! info = 1 algorithm estimates that the relative error 65 | ! between x and the solution is at most tol. 66 | 67 | ! info = 2 number of calls to fcn has reached or exceeded 68 | ! 200*(n+1). 69 | 70 | ! info = 3 tol is too small. no further improvement in 71 | ! the approximate solution x is possible. 72 | 73 | ! info = 4 iteration is not making good progress. 74 | 75 | ! wa is a work array of length lwa. 76 | 77 | ! lwa is a positive integer input variable not less than 78 | ! (n*(3*n+13))/2. 79 | 80 | ! subprograms called 81 | 82 | ! user-supplied ...... fcn 83 | 84 | ! minpack-supplied ... hybrd 85 | 86 | ! argonne national laboratory. minpack project. march 1980. 87 | ! burton s. garbow, kenneth e. hillstrom, jorge j. more 88 | 89 | ! ********** 90 | integer index,j,lr,maxfev,ml,mode,mu,nfev,nprint 91 | double precision epsfcn,factor,one,xtol,zero 92 | data factor,one,zero /1.0d2,1.0d0,0.0d0/ 93 | info = 0 94 | 95 | !check the input parameters for errors. 96 | 97 | if (n .le. 0 .or. tol .lt. zero .or. lwa .lt. (n*(3*n + 13))/2) & 98 | go to 20 99 | 100 | !call hybrd. 101 | 102 | maxfev = 200*(n + 1) 103 | xtol = tol 104 | ml = n - 1 105 | mu = n - 1 106 | epsfcn = zero 107 | mode = 2 108 | do 10 j = 1, n 109 | wa(j) = one 110 | 10 continue 111 | nprint = 0 112 | lr = (n*(n + 1))/2 113 | index = 6*n + lr 114 | call hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn,wa(1),mode, & 115 | factor,nprint,info,nfev,wa(index+1),n,wa(6*n+1),lr, & 116 | wa(n+1),wa(2*n+1),wa(3*n+1),wa(4*n+1),wa(5*n+1),params) 117 | if (info .eq. 5) info = 4 118 | 20 continue 119 | return 120 | 121 | !last card of subroutine hybrd1. 122 | 123 | end 124 | -------------------------------------------------------------------------------- /run_ATES.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Executable bash script to run the ATES code 4 | 5 | echo '==============================================' 6 | echo '| |' 7 | echo '| |' 8 | echo '| WELCOME TO ATES-2.0 |' 9 | echo '| |' 10 | echo '| |' 11 | echo '==============================================' 12 | echo '' 13 | echo 'For instruction on how to use, please consult' 14 | echo ' https://github.com/AndreaCaldiroli/ATES-Code' 15 | #------- Directories -------# 16 | 17 | # Current directory 18 | PWD=$(pwd) 19 | 20 | # Main program directory 21 | DIR_MAIN="$PWD" 22 | 23 | # Source files directory 24 | DIR_SRC="$PWD/src" 25 | 26 | # Mod files directory 27 | DIR_MOD="$DIR_SRC/mod" 28 | 29 | # Utilities directory 30 | DIR_UTILS="$DIR_SRC/utils" 31 | 32 | # Modules directories 33 | DIR_FILES="$DIR_SRC/modules/files_IO" 34 | DIR_FLUX="$DIR_SRC/modules/flux" 35 | DIR_FUNC="$DIR_SRC/modules/functions" 36 | DIR_INIT="$DIR_SRC/modules/init" 37 | DIR_NLSOLVE="$DIR_SRC/modules/nonlinear_system_solver" 38 | DIR_PPC="$DIR_SRC/modules/post_process" 39 | DIR_RAD="$DIR_SRC/modules/radiation" 40 | DIR_STAT="$DIR_SRC/modules/states" 41 | DIR_TIME="$DIR_SRC/modules/time_step" 42 | 43 | #------- Cleaning old files -------# 44 | 45 | # Clean old executable 46 | rm -f $DIR_MAIN/*.x 47 | 48 | # Clean .mod files 49 | if [ ! -d $DIR_MOD ]; then 50 | mkdir $DIR_MOD 51 | fi 52 | rm -f $DIR_MOD/*.mod 53 | 54 | #------- Call python interface to create input file -------# 55 | 56 | TABLE_FILE="$DIR_UTILS/params_table.txt" 57 | 58 | if [ ! -f "$TABLE_FILE" ]; then 59 | python3 -W ignore "$DIR_UTILS/gen_file.py" 60 | mv "params_table.txt" "$DIR_UTILS/params_table.txt" 61 | fi 62 | 63 | python3 -W ignore "$DIR_UTILS/ATES_interface_main.py" 64 | 65 | #------- Check input parameters -------# 66 | 67 | INPUT_FILE="$DIR_MAIN/input.inp" 68 | 69 | # Check if input parameters file exists 70 | echo "Searching for the input parameters file..." 71 | if [ -f "$INPUT_FILE" ]; then 72 | echo "Input file found. Proceeding..." 73 | else # Abort if no input.inp exists 74 | 75 | echo "Unable to find a valid input file." 76 | echo "Please create one through ATES interface." 77 | exit 1 78 | fi 79 | 80 | # Create output directory if it doesn't exists 81 | if [ ! -d "$DIR_MAIN/output" ]; then 82 | mkdir "$DIR_MAIN/output" 83 | fi 84 | 85 | #------- Executing fortran file -------# 86 | 87 | # Define compiler string 88 | if [[ $1 = "--ifort" ]]; then 89 | comp_str="ifort -O3 -xHost -module "$DIR_MOD" -qopenmp -no-wrap-margin" 90 | elif [[ $1 = "--ifx" ]]; then 91 | comp_str="ifx -O3 -xHost -module "$DIR_MOD" -qopenmp -no-wrap-margin" 92 | else 93 | comp_str="gfortran -O3 -J"$DIR_MOD" -I"$DIR_MOD" -fopenmp" 94 | fi 95 | 96 | # Define string with order of compilation 97 | str=" $comp_str \ 98 | $DIR_INIT/parameters.f90\ 99 | $DIR_FILES/input_read.f90\ 100 | $DIR_FILES/load_IC.f90\ 101 | $DIR_FILES/write_output.f90\ 102 | $DIR_FILES/write_setup_report.f90\ 103 | $DIR_FUNC/grav_field.f90\ 104 | $DIR_FUNC/cross_sec.f90\ 105 | $DIR_FUNC/UW_conversions.f90\ 106 | $DIR_FUNC/utilities.f90\ 107 | $DIR_NLSOLVE/dogleg.f90\ 108 | $DIR_NLSOLVE/enorm.f90\ 109 | $DIR_NLSOLVE/hybrd1.f90\ 110 | $DIR_NLSOLVE/qform.f90\ 111 | $DIR_NLSOLVE/r1mpyq.f90\ 112 | $DIR_NLSOLVE/System_HeH.f90\ 113 | $DIR_NLSOLVE/System_HeH_TR.f90\ 114 | $DIR_NLSOLVE/System_implicit_adv_HeH.f90\ 115 | $DIR_NLSOLVE/System_implicit_adv_HeH_TR.f90\ 116 | $DIR_NLSOLVE/dpmpar.f90\ 117 | $DIR_NLSOLVE/fdjac1.f90\ 118 | $DIR_NLSOLVE/hybrd.f90\ 119 | $DIR_NLSOLVE/qrfac.f90\ 120 | $DIR_NLSOLVE/r1updt.f90\ 121 | $DIR_NLSOLVE/System_H.f90\ 122 | $DIR_NLSOLVE/System_implicit_adv_H.f90 123 | $DIR_RAD/sed_read.f90\ 124 | $DIR_RAD/J_inc.f90\ 125 | $DIR_RAD/Cool_coeff.f90\ 126 | $DIR_RAD/util_ion_eq.f90\ 127 | $DIR_RAD/ionization_equilibrium.f90\ 128 | $DIR_NLSOLVE/T_equation.f90\ 129 | $DIR_PPC/post_process_adv.f90\ 130 | $DIR_STAT/Apply_BC.f90\ 131 | $DIR_STAT/PLM_rec.f90\ 132 | $DIR_STAT/Source.f90\ 133 | $DIR_STAT/Reconstruction.f90\ 134 | $DIR_FLUX/speed_estimate_HLLC.f90\ 135 | $DIR_FLUX/speed_estimate_ROE.f90\ 136 | $DIR_FLUX/Num_Fluxes.f90\ 137 | $DIR_TIME/RK_rhs.f90\ 138 | $DIR_TIME/eval_dt.f90\ 139 | $DIR_INIT/define_grid.f90\ 140 | $DIR_INIT/set_energy_vectors.f90\ 141 | $DIR_INIT/set_gravity_grid.f90\ 142 | $DIR_INIT/set_IC.f90\ 143 | $DIR_INIT/init.f90" 144 | 145 | # Compile 146 | $str $DIR_MAIN/ATES_main.f90 -o $DIR_MAIN/ATES.x 147 | 148 | # ... and execute 149 | $DIR_MAIN/ATES.x 150 | 151 | # Print when execution is over 152 | echo " 153 | ----- ATES shutdown -----" 154 | echo '==============================================' 155 | -------------------------------------------------------------------------------- /src/modules/init/define_grid.f90: -------------------------------------------------------------------------------- 1 | module grid_construction 2 | ! Constructs radial grid, edges and sized of grids 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine define_grid 11 | integer :: j 12 | integer,parameter :: N_low = 50 13 | integer :: N_up = N - N_low 14 | real*8 :: drc = 2.0e-4 15 | real*8 :: x0,x1 16 | real*8 :: f,df 17 | real*8 :: tol = 1.0 18 | real*8 :: q 19 | real*8 :: dr 20 | 21 | select case (grid_type) 22 | 23 | case ('Uniform') 24 | !------ Uniform spaced grid ------! 25 | 26 | ! Grid spacing 27 | dr = (r_max-1.0)/(1.0*N) 28 | 29 | ! Lower ghost cells 30 | r(1-Ng) = 1.0 31 | 32 | ! Loop for others cell centers 33 | do j = 2-Ng,N+Ng 34 | r(j) = r(j-1) + dr 35 | enddo 36 | 37 | !-------------------------------------------------- 38 | 39 | case ('Stretched') 40 | 41 | !------ Regular stretched grid ------! 42 | r = (/ (r_max**((j-1+Ng)*1.0/(N*1.0 + 2.0*Ng - 1.0) ), j = 1-Ng,N+Ng) /) 43 | 44 | !-------------------------------------------------- 45 | 46 | case ('Mixed') 47 | 48 | !------ Mixed grid ------! 49 | ! Constructed with N_low uniform spaced points 50 | ! and N_up points in a stretched grid 51 | 52 | ! Lower ghost cells 53 | r(1-Ng) = 1.0 - drc 54 | r(2-Ng) = 1.0 55 | 56 | ! Grid centers in the uniform region 57 | do j = 1,N_low 58 | r(j) = r(j-1) + drc 59 | enddo 60 | 61 | ! Solve for the region of stretched grid 62 | ! Solves the equation f(x) = 0 using 63 | ! Newton-Raphson method with 64 | ! 65 | ! f(x) = (1-x^N)/(1-x) - (r_up-r_low)/dr 66 | ! 67 | ! x = stretch parameter 68 | ! r_up, r_low = upper and lower boundary 69 | ! of the domain 70 | ! dr = starting grid dimension 71 | 72 | ! Initial guess 73 | x0 = 1.01 74 | 75 | do while(tol.ge.(1.0e-8)) 76 | 77 | ! Evaluate function and its derivative 78 | 79 | ! Auxiliary constant 80 | q = (r_max-r(N_low))/drc 81 | 82 | ! Function 83 | f = (1.0-x0**(1.0*N_up))/(1.0-x0) - q 84 | 85 | ! Analytic function derivative 86 | df = (f + q - N_up*x0**(N_up-1.0))/(1.0-x0) 87 | 88 | ! Guess of solution 89 | x1 = x0 - f/df 90 | 91 | ! Evaluate tolerance 92 | tol = abs(x1-x0) 93 | 94 | ! Update point for the next step 95 | x0 = x1 96 | 97 | ! End of while loop 98 | enddo 99 | 100 | ! Construct stretched grid 101 | do j = N_low + 1,N 102 | r(j) = r(j-1) + x0**(1.0*j - N_low -1)*drc 103 | enddo 104 | 105 | ! Add ghost points at the top of the domain 106 | do j = 1,Ng 107 | r(N+j) = 2.0*r(N+j-1) - r(N+j-2) 108 | enddo 109 | 110 | !-------------------------------------------------- 111 | 112 | end select 113 | 114 | !--- Cell edges r_{j+1/2} ---! 115 | 116 | ! Cell edges (N+2*Ng-1 points) - r_edg(j) = r_{j+1/2} 117 | r_edg(1-Ng:N+Ng-1) = 0.5*(r(1-Ng:N+Ng-1) + r(2-Ng:N+Ng)) 118 | r_edg(N+Ng) = 2.0*r_edg(N+Ng-1) - r_edg(N+Ng-2) 119 | 120 | !--- Cell dimensions r_{j+1/2} - r_{j-1/2} --- ! 121 | ! Cell size (N+2*Ng points) - dr(j) = dimension of cell j 122 | dr_j(2-Ng:N+Ng-1) = r_edg(3-Ng:N+Ng) - r_edg(2-Ng:N+Ng-1) 123 | dr_j(1-Ng) = dr_j(2-Ng) 124 | dr_j(N+Ng) = dr_j(N+Ng-1) 125 | 126 | 127 | ! Do a smoothing of the mixed-type grid 128 | if (grid_type .eq. 'Mixed') then 129 | 130 | do j = 50,2-Ng,-1 131 | dr_j(j) = 0.25*(dr_j(j-1) + 2.0*dr_j(j) + dr_j(j+1)) 132 | enddo 133 | 134 | r(2-Ng) = 1.0 135 | r(1-Ng) = r(2-Ng) - 0.5*(dr_j(1-Ng) + dr_j(2-Ng)) 136 | 137 | do j = 3-Ng,N+Ng 138 | r(j) = r(j-1) + 0.5*(dr_j(j) + dr_j(j-1)) 139 | enddo 140 | 141 | ! Rescale to [1,r_max] 142 | r = (r-1)/(r(N+Ng) - 1.0)*(r_max - 1.0) + 1.0 143 | 144 | ! Re-eval edges and cell size 145 | 146 | ! Cell edges (N+2*Ng-1 points) - r_edg(j) = r_{j+1/2} 147 | r_edg(1-Ng:N+Ng-1) = 0.5*(r(1-Ng:N+Ng-1) + r(2-Ng:N+Ng)) 148 | r_edg(N+Ng) = 2.0*r_edg(N+Ng-1) - r_edg(N+Ng-2) 149 | 150 | !--- Cell dimensions r_{j+1/2} - r_{j-1/2} --- ! 151 | ! Cell size (N+2*Ng points) - dr(j) = dimension of cell j 152 | dr_j(2-Ng:N+Ng-1) = r_edg(3-Ng:N+Ng) - r_edg(2-Ng:N+Ng-1) 153 | dr_j(1-Ng) = dr_j(2-Ng) 154 | dr_j(N+Ng) = dr_j(N+Ng-1) 155 | 156 | endif 157 | 158 | !-----------------------------! 159 | 160 | ! Select relevant domain for constant momentum 161 | do j = 1-Ng,N+Ng 162 | if(r(j).ge.r_esc) goto 111 163 | enddo 164 | 165 | 111 j_min = j 166 | 167 | ! End of subroutine 168 | end subroutine define_grid 169 | 170 | ! End of module 171 | end module grid_construction 172 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/fdjac1.f90: -------------------------------------------------------------------------------- 1 | subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn,& 2 | wa1,wa2,params) 3 | integer n,ldfjac,iflag,ml,mu 4 | double precision epsfcn 5 | double precision x(n),fvec(n),fjac(ldfjac,n),wa1(n),wa2(n), & 6 | params(11) 7 | ! ********** 8 | 9 | ! subroutine fdjac1 10 | 11 | ! this subroutine computes a forward-difference approximation 12 | ! to the n by n jacobian matrix associated with a specified 13 | ! problem of n functions in n variables. if the jacobian has 14 | ! a banded form, then function evaluations are saved by only 15 | ! approximating the nonzero terms. 16 | 17 | ! the subroutine statement is 18 | 19 | ! subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, 20 | ! wa1,wa2) 21 | 22 | ! where 23 | 24 | ! fcn is the name of the user-supplied subroutine which 25 | ! calculates the functions. fcn must be declared 26 | ! in an external statement in the user calling 27 | ! program, and should be written as follows. 28 | 29 | ! subroutine fcn(n,x,fvec,iflag) 30 | ! integer n,iflag 31 | ! double precision x(n),fvec(n) 32 | ! ---------- 33 | ! calculate the functions at x and 34 | ! return this vector in fvec. 35 | ! ---------- 36 | ! return 37 | ! end 38 | 39 | ! the value of iflag should not be changed by fcn unless 40 | ! the user wants to terminate execution of fdjac1. 41 | ! in this case set iflag to a negative integer. 42 | 43 | ! n is a positive integer input variable set to the number 44 | ! of functions and variables. 45 | 46 | ! x is an input array of length n. 47 | 48 | ! fvec is an input array of length n which must contain the 49 | ! functions evaluated at x. 50 | 51 | ! fjac is an output n by n array which contains the 52 | ! approximation to the jacobian matrix evaluated at x. 53 | 54 | ! ldfjac is a positive integer input variable not less than n 55 | ! which specifies the leading dimension of the array fjac. 56 | 57 | ! iflag is an integer variable which can be used to terminate 58 | ! the execution of fdjac1. see description of fcn. 59 | 60 | ! ml is a nonnegative integer input variable which specifies 61 | ! the number of subdiagonals within the band of the 62 | ! jacobian matrix. if the jacobian is not banded, set 63 | ! ml to at least n - 1. 64 | 65 | ! epsfcn is an input variable used in determining a suitable 66 | ! step length for the forward-difference approximation. this 67 | ! approximation assumes that the relative errors in the 68 | ! functions are of the order of epsfcn. if epsfcn is less 69 | ! than the machine precision, it is assumed that the relative 70 | ! errors in the functions are of the order of the machine 71 | ! precision. 72 | 73 | ! mu is a nonnegative integer input variable which specifies 74 | ! the number of superdiagonals within the band of the 75 | ! jacobian matrix. if the jacobian is not banded, set 76 | ! mu to at least n - 1. 77 | 78 | ! wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at 79 | ! least n, then the jacobian is considered dense, and wa2 is 80 | ! not referenced. 81 | 82 | ! subprograms called 83 | 84 | ! minpack-supplied ... dpmpar 85 | 86 | ! fortran-supplied ... dabs,dmax1,dsqrt 87 | 88 | ! argonne national laboratory. minpack project. march 1980. 89 | ! burton s. garbow, kenneth e. hillstrom, jorge j. more 90 | 91 | ! ********** 92 | integer i,j,k,msum 93 | double precision eps,epsmch,h,temp,zero 94 | double precision dpmpar 95 | data zero /0.0d0/ 96 | 97 | !epsmch is the machine precision. 98 | 99 | epsmch = dpmpar(1) 100 | 101 | eps = dsqrt(dmax1(epsfcn,epsmch)) 102 | msum = ml + mu + 1 103 | if (msum .lt. n) go to 40 104 | 105 | !computation of dense approximate jacobian. 106 | 107 | do 20 j = 1, n 108 | temp = x(j) 109 | h = eps*dabs(temp) 110 | if (h .eq. zero) h = eps 111 | x(j) = temp + h 112 | call fcn(n,x,wa1,iflag,params) 113 | if (iflag .lt. 0) go to 30 114 | x(j) = temp 115 | do 10 i = 1, n 116 | fjac(i,j) = (wa1(i) - fvec(i))/h 117 | 10 continue 118 | 20 continue 119 | 30 continue 120 | go to 110 121 | 40 continue 122 | 123 | !computation of banded approximate jacobian. 124 | 125 | do 90 k = 1, msum 126 | do 60 j = k, n, msum 127 | wa2(j) = x(j) 128 | h = eps*dabs(wa2(j)) 129 | if (h .eq. zero) h = eps 130 | x(j) = wa2(j) + h 131 | 60 continue 132 | call fcn(n,x,wa1,iflag,params) 133 | if (iflag .lt. 0) go to 100 134 | do 80 j = k, n, msum 135 | x(j) = wa2(j) 136 | h = eps*dabs(wa2(j)) 137 | if (h .eq. zero) h = eps 138 | do 70 i = 1, n 139 | fjac(i,j) = zero 140 | if (i .ge. j - mu .and. i .le. j + ml) & 141 | fjac(i,j) = (wa1(i) - fvec(i))/h 142 | 70 continue 143 | 80 continue 144 | 90 continue 145 | 100 continue 146 | 110 continue 147 | return 148 | 149 | !last card of subroutine fdjac1. 150 | 151 | end 152 | 153 | -------------------------------------------------------------------------------- /src/utils/gen_file.py: -------------------------------------------------------------------------------- 1 | # Planet names 2 | pl_names = ["55Cnce", # 55Cnce 3 | "GJ1214b", # GJ1214b 4 | "GJ3470b" , # GJ3470b 5 | "GJ436b", # GJ436b 6 | "GJ9827b", # GJ9827b 7 | "GJ9827c", # GJ9827c 8 | "GJ9827d", # GJ9827d 9 | "HAT-P-11b", # HAT-P-11b 10 | "HAT-P-20b", # HAT-P-20b 11 | "HD149026b", # HD149026b 12 | "HD189733b", # HD189733b 13 | "HD209458b", # HD209458b 14 | "HD97658b", # HD97658b 15 | "LHS1140b", # LHS1140b 16 | "LHS1140c", # LHS1140c 17 | "WASP-10b", # WASP-10b 18 | "WASP-18b", # WASP-18b 19 | "WASP-38b", # WASP-38b 20 | "WASP-43b", # WASP-43b 21 | "WASP-69b", # WASP-69b 22 | "WASP-77b", # WASP-77b 23 | "WASP-8b", # WASP-8b 24 | "WASP-80b"] # WASP-80b 25 | 26 | 27 | # Planet radius 28 | Rp = [0.168, # 55Cnce 29 | 0.248, # GJ1214b 30 | 0.409, # GJ3470b 31 | 0.346, # GJ436b 32 | 0.153, # GJ9827b 33 | 0.120, # GJ9827c 34 | 0.196, # GJ9827d 35 | 0.439, # HAT-P-11b 36 | 1.101, # HAT-P-20b 37 | 0.741, # HD149026b 38 | 1.193, # HD189733b 39 | 1.401, # HD209458b 40 | 0.195, # HD97658b 41 | 0.144, # LHS1140b 42 | 0.103, # LHS1140c 43 | 1.027, # WASP-10b 44 | 1.231, # WASP-18b 45 | 1.202, # WASP-38b 46 | 1.020, # WASP-43b 47 | 1.066, # WASP-69b 48 | 1.235, # WASP-77b 49 | 1.088, # WASP-8b 50 | 1.017] # WASP-80b 51 | 52 | 53 | # Planet mass 54 | Mp = [0.0255, # 55Cnce, 55 | 0.0191, # GJ1214b 56 | 0.0450, # GJ3470b 57 | 0.0717, # GJ436b 58 | 0.0121, # GJ9827b 59 | 0.00856, # GJ9827c 60 | 0.01838, # GJ9827d 61 | 0.0808, # HAT-P-11b 62 | 8.312, # HAT-P-20b 63 | 0.282, # HD149026b 64 | 1.237, # HD189733b 65 | 0.720, # HD209458b 66 | 0.0283, # HD97658b 67 | 0.01937, # LHS1140b 68 | 0.00545, # LHS1140c 69 | 2.914, # WASP-10b 70 | 10.03, # WASP-18b 71 | 3.272, # WASP-38b 72 | 2.044, # WASP-43b 73 | 0.265, # WASP-69b 74 | 1.695, # WASP-77b 75 | 2.329, # WASP-8b 76 | 0.586] # WASP-80b 77 | 78 | 79 | # Planet surface temperature 80 | T0 = [2000, # 55Cnce 81 | 560, # GJ1214b 82 | 706, # GJ3470b 83 | 634, # GJ436b 84 | 1147, # GJ9827b 85 | 794, # GJ9827c 86 | 665, # GJ9827d 87 | 879, # HAT-P-11b 88 | 944, # HAT-P-20b 89 | 1760, # HD149026b 90 | 1183, # HD189733b 91 | 1450, # HD209458b 92 | 744, # HD97658b 93 | 217, # LHS1140b 94 | 407, # LHS1140c 95 | 1015, # WASP-10b 96 | 2449, # WASP-18b 97 | 1252, # WASP-38b 98 | 1366, # WASP-43b 99 | 995, # WASP-69b 100 | 1701, # WASP-77b 101 | 930, # WASP-8b 102 | 811] # WASP-80b 103 | 104 | 105 | 106 | # Log10 stellar X-ray luminosity 107 | LX = [27.22, # 55Cnce 108 | 26.20, # GJ1214b 109 | 27.58, # GJ3470b 110 | 26.52, # GJ436b 111 | 26.85, # GJ9827b 112 | 26.85, # GJ9827c 113 | 26.85, # GJ9827d 114 | 27.75, # HAT-P-11b 115 | 28.03, # HAT-P-20b 116 | 27.72, # HD149026b 117 | 28.42, # HD189733b 118 | 26.39, # HD209458b 119 | 27.25, # HD97658b 120 | 26.13, # LHS1140b 121 | 26.13, # LHS1140c 122 | 28.30, # WASP-10b 123 | 26.82, # WASP-18b 124 | 28.12, # WASP-38b 125 | 27.84, # WASP-43b 126 | 28.26, # WASP-69b 127 | 28.22, # WASP-77b 128 | 28.53, # WASP-8b 129 | 27.70] # WASP-80b 130 | 131 | 132 | 133 | # Log10 stellar X-ray luminosity 134 | LEUV = [28.16, # 55Cnce 135 | 27.02, # GJ1214b 136 | 28.11, # GJ3470b 137 | 27.46, # GJ436b 138 | 27.81, # GJ9827b 139 | 27.81, # GJ9827c 140 | 27.81, # GJ9827d 141 | 28.33, # HAT-P-11b 142 | 28.43, # HAT-P-20b 143 | 28.60, # HD149026b 144 | 28.68, # HD189733b 145 | 27.83, # HD209458b 146 | 28.07, # HD97658b 147 | 26.96, # LHS1140b 148 | 26.96, # LHS1140c 149 | 28.51, # WASP-10b 150 | 28.12, # WASP-18b 151 | 28.26, # WASP-38b 152 | 28.31, # WASP-43b 153 | 28.62, # WASP-69b 154 | 28.64, # WASP-77b 155 | 28.80, # WASP-8b 156 | 28.21] # WASP-80b 157 | 158 | 159 | # Planet orbital distance 160 | a = [0.0156, # 55Cnce 161 | 0.0147, # GJ1214b 162 | 0.0357, # GJ3470b 163 | 0.0291, # GJ436b 164 | 0.0200, # GJ9827b 165 | 0.0418, # GJ9827c 166 | 0.0596, # GJ9827d 167 | 0.0524, # HAT-P-11b 168 | 0.0390, # HAT-P-20b 169 | 0.0410, # HD149026b 170 | 0.0330, # HD189733b 171 | 0.0480, # HD209458b 172 | 0.0851, # HD97658b 173 | 0.0941, # LHS1140b 174 | 0.0269, # LHS1140c 175 | 0.0360, # WASP-10b 176 | 0.0200, # WASP-18b 177 | 0.0830, # WASP-38b 178 | 0.0153, # WASP-43b 179 | 0.0460, # WASP-69b 180 | 0.0240, # WASP-77b 181 | 0.0838, # WASP-8b 182 | 0.0360] # WASP-80b 183 | 184 | 185 | 186 | # Stellar masses 187 | Ms = [0.93, # 55Cnce 188 | 0.17, # GJ1214b 189 | 0.54, # GJ3470b 190 | 0.47, # GJ436b 191 | 0.73, # GJ9827b 192 | 0.73, # GJ9827c 193 | 0.73, # GJ9827d 194 | 0.80, # HAT-P-11b 195 | 0.93, # HAT-P-20b 196 | 1.09, # HD149026b 197 | 0.94, # HD189733b 198 | 1.20, # HD209458b 199 | 0.91, # HD97658b 200 | 0.18, # LHS1140b 201 | 0.18, # LHS1140c 202 | 0.65, # WASP-10b 203 | 1.22, # WASP-18b 204 | 1.62, # WASP-38b 205 | 0.72, # WASP-43b 206 | 0.85, # WASP-69b 207 | 0.94, # WASP-77b 208 | 1.18, # WASP-8b 209 | 0.65] # WASP-80b 210 | 211 | 212 | # Write to file 213 | with open('params_table.txt', 'w') as f: 214 | 215 | for j in range(len(Rp)): 216 | f.write(("%s\t%5.3f\t%6.3f\t" 217 | "%6.1f\t%6.4f\t%5.3f\t" 218 | "%6.3f\t%6.3f\n") 219 | 220 | %(pl_names[j], 221 | Rp[j], 222 | Mp[j], 223 | T0[j], 224 | a[j], 225 | Ms[j], 226 | LX[j], 227 | LEUV[j]) 228 | ) 229 | 230 | 231 | 232 | 233 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/dogleg.f90: -------------------------------------------------------------------------------- 1 | subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) 2 | integer n,lr 3 | double precision delta 4 | double precision r(lr),diag(n),qtb(n),x(n),wa1(n),wa2(n) 5 | ! ********** 6 | 7 | ! subroutine dogleg 8 | 9 | ! given an m by n matrix a, an n by n nonsingular diagonal 10 | ! matrix d, an m-vector b, and a positive number delta, the 11 | ! problem is to determine the convex combination x of the 12 | ! gauss-newton and scaled gradient directions that minimizes 13 | ! (a*x - b) in the least squares sense, subject to the 14 | ! restriction that the euclidean norm of d*x be at most delta. 15 | 16 | ! this subroutine completes the solution of the problem 17 | ! if it is provided with the necessary information from the 18 | ! qr factorization of a. that is, if a = q*r, where q has 19 | ! orthogonal columns and r is an upper triangular matrix, 20 | ! then dogleg expects the full upper triangle of r and 21 | ! the first n components of (q transpose)*b. 22 | 23 | ! the subroutine statement is 24 | 25 | ! subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) 26 | 27 | ! where 28 | 29 | ! n is a positive integer input variable set to the order of r. 30 | 31 | ! r is an input array of length lr which must contain the upper 32 | ! triangular matrix r stored by rows. 33 | 34 | ! lr is a positive integer input variable not less than 35 | ! (n*(n+1))/2. 36 | 37 | ! diag is an input array of length n which must contain the 38 | ! diagonal elements of the matrix d. 39 | 40 | ! qtb is an input array of length n which must contain the first 41 | ! n elements of the vector (q transpose)*b. 42 | 43 | ! delta is a positive input variable which specifies an upper 44 | ! bound on the euclidean norm of d*x. 45 | 46 | ! x is an output array of length n which contains the desired 47 | ! convex combination of the gauss-newton direction and the 48 | ! scaled gradient direction. 49 | 50 | ! wa1 and wa2 are work arrays of length n. 51 | 52 | ! subprograms called 53 | 54 | ! minpack-supplied ... dpmpar,enorm 55 | 56 | ! fortran-supplied ... dabs,dmax1,dmin1,dsqrt 57 | 58 | ! argonne national laboratory. minpack project. march 1980. 59 | ! burton s. garbow, kenneth e. hillstrom, jorge j. more 60 | 61 | ! ********** 62 | integer i,j,jj,jp1,k,l 63 | double precision alpha,bnorm,epsmch,gnorm,one,qnorm,sgnorm,sum,& 64 | temp,zero 65 | double precision dpmpar,enorm 66 | data one,zero /1.0d0,0.0d0/ 67 | 68 | !epsmch is the machine precision. 69 | 70 | epsmch = dpmpar(1) 71 | 72 | !first, calculate the gauss-newton direction. 73 | 74 | jj = (n*(n + 1))/2 + 1 75 | do 50 k = 1, n 76 | j = n - k + 1 77 | jp1 = j + 1 78 | jj = jj - k 79 | l = jj + 1 80 | sum = zero 81 | if (n .lt. jp1) go to 20 82 | do 10 i = jp1, n 83 | sum = sum + r(l)*x(i) 84 | l = l + 1 85 | 10 continue 86 | 20 continue 87 | temp = r(jj) 88 | if (temp .ne. zero) go to 40 89 | l = j 90 | do 30 i = 1, j 91 | temp = dmax1(temp,dabs(r(l))) 92 | l = l + n - i 93 | 30 continue 94 | temp = epsmch*temp 95 | if (temp .eq. zero) temp = epsmch 96 | 40 continue 97 | x(j) = (qtb(j) - sum)/temp 98 | 50 continue 99 | 100 | !test whether the gauss-newton direction is acceptable. 101 | 102 | do 60 j = 1, n 103 | wa1(j) = zero 104 | wa2(j) = diag(j)*x(j) 105 | 60 continue 106 | qnorm = enorm(n,wa2) 107 | if (qnorm .le. delta) go to 140 108 | 109 | !the gauss-newton direction is not acceptable. 110 | !next, calculate the scaled gradient direction. 111 | 112 | l = 1 113 | do 80 j = 1, n 114 | temp = qtb(j) 115 | do 70 i = j, n 116 | wa1(i) = wa1(i) + r(l)*temp 117 | l = l + 1 118 | 70 continue 119 | wa1(j) = wa1(j)/diag(j) 120 | 80 continue 121 | 122 | !calculate the norm of the scaled gradient and test for 123 | !the special case in which the scaled gradient is zero. 124 | 125 | gnorm = enorm(n,wa1) 126 | sgnorm = zero 127 | alpha = delta/qnorm 128 | if (gnorm .eq. zero) go to 120 129 | 130 | !calculate the point along the scaled gradient 131 | !at which the quadratic is minimized. 132 | 133 | do 90 j = 1, n 134 | wa1(j) = (wa1(j)/gnorm)/diag(j) 135 | 90 continue 136 | l = 1 137 | do 110 j = 1, n 138 | sum = zero 139 | do 100 i = j, n 140 | sum = sum + r(l)*wa1(i) 141 | l = l + 1 142 | 100 continue 143 | wa2(j) = sum 144 | 110 continue 145 | temp = enorm(n,wa2) 146 | sgnorm = (gnorm/temp)/temp 147 | 148 | !test whether the scaled gradient direction is acceptable. 149 | 150 | alpha = zero 151 | if (sgnorm .ge. delta) go to 120 152 | 153 | !the scaled gradient direction is not acceptable. 154 | !finally, calculate the point along the dogleg 155 | !at which the quadratic is minimized. 156 | 157 | bnorm = enorm(n,qtb) 158 | temp = (bnorm/gnorm)*(bnorm/qnorm)*(sgnorm/delta) 159 | temp = temp - (delta/qnorm)*(sgnorm/delta)**2 & 160 | + dsqrt((temp-(delta/qnorm))**2 & 161 | +(one-(delta/qnorm)**2)*(one-(sgnorm/delta)**2)) 162 | alpha = ((delta/qnorm)*(one - (sgnorm/delta)**2))/temp 163 | 120 continue 164 | 165 | !form appropriate convex combination of the gauss-newton 166 | !direction and the scaled gradient direction. 167 | 168 | temp = (one - alpha)*dmin1(sgnorm,delta) 169 | do 130 j = 1, n 170 | x(j) = temp*wa1(j) + alpha*x(j) 171 | 130 continue 172 | 140 continue 173 | return 174 | 175 | !last card of subroutine dogleg. 176 | 177 | end 178 | -------------------------------------------------------------------------------- /src/modules/init/parameters.f90: -------------------------------------------------------------------------------- 1 | module global_parameters 2 | ! Definition of global parameters and vectors 3 | 4 | implicit none 5 | 6 | integer, parameter :: outfile = 99 ! Unit number of report file 7 | integer, parameter :: N = 500 ! Number of computational cells 8 | integer, parameter :: Ng = 2 ! Number of ghost cells 9 | integer, parameter :: Nl_fix = 200 ! Number of default energy bins 10 | integer :: Nl, NlTR ! Number of points for energy integrations 11 | integer :: N_eq ! Numbers of equations in NL solver 12 | integer :: lwa ! Working array length for NL solver 13 | integer :: info ! Output info variable of NL solver 14 | integer :: j_min 15 | integer :: count 16 | 17 | character(len = 9), parameter :: inp_file = 'input.inp' 18 | character(len = :), allocatable :: p_name 19 | character(len = :), allocatable :: grid_type 20 | character(len = :), allocatable :: flux 21 | character(len = :), allocatable :: rec_method 22 | character(len = :), allocatable :: appx_mth 23 | character(len = :), allocatable :: sp_type 24 | character(len = :), allocatable :: sed_file 25 | 26 | logical :: is_mom_const = .false. ! Is momentum constant within tolerance 27 | logical :: is_zero_dt = .false. ! Is time derivative really zero 28 | logical :: force_start = .false. ! Force to do first 1000 iterations 29 | logical :: do_only_pp = .false. ! Do only the post processing 30 | logical :: do_load_IC = .false. ! Load existing IC 31 | logical :: thereis_He = .false. ! Is He included in computations 32 | logical :: do_read_sed = .false. ! Is numerical SED read from file 33 | logical :: is_monochr = .false. ! Is monochromatic radiation selected 34 | logical :: is_PL_sed = .false. ! Is the SED a power law 35 | logical :: thereis_Xray = .false. ! Include only EUV band 36 | logical :: thereis_HeITR = .false. ! Include calculations for He triplet 37 | logical :: use_weno3 = .false. ! Use WENO3 reconstruction 38 | logical :: use_plm = .false. ! Use PLM reconstruction 39 | 40 | !------- Global constants -------! 41 | 42 | ! Physical constants 43 | real*8,parameter :: pi = 3.1415926536 ! pi 44 | real*8,parameter :: kb_erg = 1.38e-16 ! Boltzmann constant in CGS units 45 | real*8,parameter :: kb_eV = 8.6167e-05 ! Boltzmann constant (eV/K) 46 | real*8,parameter :: mu = 1.673e-24 ! Hydrogen mass (g) 47 | real*8,parameter :: g = 1.666666666667 ! Polytropic index 48 | real*8,parameter :: Gc = 6.67259e-8 ! Gravitational constant (CGS) 49 | real*8,parameter :: erg2eV = 6.241509075e11 ! 1 erg measured in eV 50 | real*8,parameter :: hp_erg = 6.62620e-27 ! Planck constant in CGS units 51 | real*8,parameter :: hp_eV = 4.1357e-15 ! Planck constant (eV*s) 52 | real*8,parameter :: c_light = 2.99792458e10 ! Speed of light in cm/s 53 | real*8,parameter :: parsec = 3.08567758147e18 ! 1 pc in cm 54 | real*8,parameter :: AU = 1.495978707e13 ! Astronomical unit 55 | real*8,parameter :: RJ = 6.9911e9 ! Jupiter radius (cm) 56 | real*8,parameter :: MJ = 1.898e30 ! Jupiter mass (g) 57 | real*8,parameter :: Msun = 1.989e33 ! Sun mass (g) 58 | real*8,parameter :: R_earth = 6.3725e8 ! Earth radius (cm) 59 | real*8,parameter :: M_earth = 5.9726e27 ! Earth mass (g) 60 | real*8,parameter :: ih = 1.0 ! Atomic number of Hydrogen 61 | real*8,parameter :: ihe = 2.0 ! Atomic number of Helium 62 | 63 | ! -- - Energy constants 64 | 65 | ! Energy intervals 66 | real*8 :: e_top 67 | real*8 :: e_mid 68 | real*8 :: e_low 69 | 70 | ! Threshold energies 71 | real*8,parameter :: e_th_HI = 13.6 ! Threshold for HI ionization 72 | real*8,parameter :: e_th_HeI = 24.6 ! Threshold for HeI ionization 73 | real*8,parameter :: e_th_HeII = 54.4 ! Threshold for HeII ionization 74 | real*8,parameter :: e_th_HeTR = 4.80 ! Threshold for HeI triplet ionization 75 | 76 | ! Numerical constants 77 | real*8,parameter :: CFL = 0.6 ! CFL number 78 | real*8,parameter :: du_th = 1.0e-3 ! Escape momentum variation 79 | real*8,parameter :: dtu_th = 1.0d-8 ! Threshold variation of time deriv. 80 | real*8 :: du ! Initial momentum variation 81 | real*8 :: dtu ! Norm of time derivative 82 | 83 | !------- Planetary parameters -------! 84 | 85 | real*8 :: n0 ! Density at lower boundary (cm^-3) 86 | real*8 :: R0 ! Planetary radius (cm) 87 | real*8 :: Mp ! Planet mass (g) 88 | real*8 :: T0 ! Temperature at lower boundary (K) 89 | real*8 :: LX ! Log10 X-Ray luminosity (erg/s) 90 | real*8 :: LEUV ! Log10 EUV luminosity (erg/s) 91 | real*8 :: J_XUV ! Bolometric star XUV flux (erg/cm^2*s) 92 | real*8 :: Mstar ! Mass of companion star 93 | real*8 :: Mrapp ! Ratio M_star/M_p 94 | real*8 :: atilde ! Orbital radius in unit of R0 (a/R0) 95 | real*8 :: r_esc ! Escape radius for constant momentum 96 | real*8 :: a_orb ! Orbital distance 97 | real*8 :: r_max ! Maximum radius = Roche Lobe dimension 98 | real*8 :: HeH ! He/H ratio 99 | real*8 :: rho_bc ! Adimensional number density at origin 100 | real*8 :: a_tau ! Rate correction coefficient 101 | real*8 :: PLind ! Index of spectral power law 102 | real*8 :: dp_bc ! Boundary condition for pressure 103 | 104 | !------- Normalizations -------! 105 | 106 | real*8 :: v0 ! Velocity normalization 107 | real*8 :: t_s ! Time normalization 108 | real*8 :: p0 ! Pressure normalization 109 | real*8 :: q0 ! Scale normalization 110 | real*8 :: b0 ! Jeans parameter at planet surface 111 | 112 | !------- Global vectors -------! 113 | 114 | real*8, dimension(:), allocatable :: e_v, de_v 115 | real*8, dimension(:), allocatable :: s_hi,s_hei,s_heii,s_heiTR 116 | real*8, dimension(:), allocatable :: F_XUV 117 | real*8, dimension(1-Ng:N+Ng) :: r,r_edg,dr_j 118 | real*8, dimension(1-Ng:N+Ng) :: Gphi_c,Gphi_i 119 | 120 | ! NL solver vectors 121 | real*8, dimension(:), allocatable :: sys_sol, sys_x 122 | real*8, dimension(:), allocatable :: wa 123 | 124 | contains 125 | 126 | ! End of module 127 | end module global_parameters 128 | -------------------------------------------------------------------------------- /src/modules/nonlinear_system_solver/dpmpar.f90: -------------------------------------------------------------------------------- 1 | double precision function dpmpar(i) 2 | integer i 3 | ! ********** 4 | 5 | ! Function dpmpar 6 | 7 | ! This function provides double precision machine parameters 8 | ! when the appropriate set of data statements is activated (by 9 | ! removing the c from column 1) and all other data statements are 10 | ! rendered inactive. Most of the parameter values were obtained 11 | ! from the corresponding Bell Laboratories Port Library function. 12 | 13 | ! The function statement is 14 | 15 | ! double precision function dpmpar(i) 16 | 17 | ! where 18 | 19 | ! i is an integer input variable set to 1, 2, or 3 which 20 | ! selects the desired machine parameter. If the machine has 21 | ! t base b digits and its smallest and largest exponents are 22 | ! emin and emax, respectively, then these parameters are 23 | 24 | ! dpmpar(1) = b**(1 - t), the machine precision, 25 | 26 | ! dpmpar(2) = b**(emin - 1), the smallest magnitude, 27 | 28 | ! dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. 29 | 30 | ! Argonne National Laboratory. MINPACK Project. November 1996. 31 | ! Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' 32 | 33 | ! ********** 34 | integer mcheps(4) 35 | integer minmag(4) 36 | integer maxmag(4) 37 | double precision dmach(3) 38 | equivalence (dmach(1),mcheps(1)) 39 | equivalence (dmach(2),minmag(1)) 40 | equivalence (dmach(3),maxmag(1)) 41 | 42 | ! Machine constants for the IBM 360/370 series, 43 | ! the Amdahl 470/V6, the ICL 2900, the Itel AS/6, 44 | ! the Xerox Sigma 5/7/9 and the Sel systems 85/86. 45 | 46 | ! data mcheps(1),mcheps(2) / z34100000, z00000000 / 47 | ! data minmag(1),minmag(2) / z00100000, z00000000 / 48 | ! data maxmag(1),maxmag(2) / z7fffffff, zffffffff / 49 | 50 | ! Machine constants for the Honeywell 600/6000 series. 51 | 52 | ! data mcheps(1),mcheps(2) / o606400000000, o000000000000 / 53 | ! data minmag(1),minmag(2) / o402400000000, o000000000000 / 54 | ! data maxmag(1),maxmag(2) / o376777777777, o777777777777 / 55 | 56 | ! Machine constants for the CDC 6000/7000 series. 57 | 58 | ! data mcheps(1) / 15614000000000000000b / 59 | ! data mcheps(2) / 15010000000000000000b / 60 | 61 | ! data minmag(1) / 00604000000000000000b / 62 | ! data minmag(2) / 00000000000000000000b / 63 | 64 | ! data maxmag(1) / 37767777777777777777b / 65 | ! data maxmag(2) / 37167777777777777777b / 66 | 67 | ! Machine constants for the PDP-10 (KA processor). 68 | 69 | ! data mcheps(1),mcheps(2) / "114400000000, "000000000000 / 70 | ! data minmag(1),minmag(2) / "033400000000, "000000000000 / 71 | ! data maxmag(1),maxmag(2) / "377777777777, "344777777777 / 72 | 73 | ! Machine constants for the PDP-10 (KI processor). 74 | 75 | ! data mcheps(1),mcheps(2) / "104400000000, "000000000000 / 76 | ! data minmag(1),minmag(2) / "000400000000, "000000000000 / 77 | ! data maxmag(1),maxmag(2) / "377777777777, "377777777777 / 78 | 79 | ! Machine constants for the PDP-11. 80 | 81 | ! data mcheps(1),mcheps(2) / 9472, 0 / 82 | ! data mcheps(3),mcheps(4) / 0, 0 / 83 | 84 | ! data minmag(1),minmag(2) / 128, 0 / 85 | ! data minmag(3),minmag(4) / 0, 0 / 86 | 87 | ! data maxmag(1),maxmag(2) / 32767, -1 / 88 | ! data maxmag(3),maxmag(4) / -1, -1 / 89 | 90 | ! Machine constants for the Burroughs 6700/7700 systems. 91 | 92 | ! data mcheps(1) / o1451000000000000 / 93 | ! data mcheps(2) / o0000000000000000 / 94 | 95 | ! data minmag(1) / o1771000000000000 / 96 | ! data minmag(2) / o7770000000000000 / 97 | 98 | ! data maxmag(1) / o0777777777777777 / 99 | ! data maxmag(2) / o7777777777777777 / 100 | 101 | ! Machine constants for the Burroughs 5700 system. 102 | 103 | ! data mcheps(1) / o1451000000000000 / 104 | ! data mcheps(2) / o0000000000000000 / 105 | 106 | ! data minmag(1) / o1771000000000000 / 107 | ! data minmag(2) / o0000000000000000 / 108 | 109 | ! data maxmag(1) / o0777777777777777 / 110 | ! data maxmag(2) / o0007777777777777 / 111 | 112 | ! Machine constants for the Burroughs 1700 system. 113 | 114 | ! data mcheps(1) / zcc6800000 / 115 | ! data mcheps(2) / z000000000 / 116 | 117 | ! data minmag(1) / zc00800000 / 118 | ! data minmag(2) / z000000000 / 119 | 120 | ! data maxmag(1) / zdffffffff / 121 | ! data maxmag(2) / zfffffffff / 122 | 123 | ! Machine constants for the Univac 1100 series. 124 | 125 | ! data mcheps(1),mcheps(2) / o170640000000, o000000000000 / 126 | ! data minmag(1),minmag(2) / o000040000000, o000000000000 / 127 | ! data maxmag(1),maxmag(2) / o377777777777, o777777777777 / 128 | 129 | ! Machine constants for the Data General Eclipse S/200. 130 | 131 | ! Note - it may be appropriate to include the following card - 132 | ! static dmach(3) 133 | 134 | ! data minmag/20k,3*0/,maxmag/77777k,3*177777k/ 135 | ! data mcheps/32020k,3*0/ 136 | 137 | ! Machine constants for the Harris 220. 138 | 139 | ! data mcheps(1),mcheps(2) / '20000000, '00000334 / 140 | ! data minmag(1),minmag(2) / '20000000, '00000201 / 141 | ! data maxmag(1),maxmag(2) / '37777777, '37777577 / 142 | 143 | ! Machine constants for the Cray-1. 144 | 145 | ! data mcheps(1) / 0376424000000000000000b / 146 | ! data mcheps(2) / 0000000000000000000000b / 147 | 148 | ! data minmag(1) / 0200034000000000000000b / 149 | ! data minmag(2) / 0000000000000000000000b / 150 | 151 | ! data maxmag(1) / 0577777777777777777777b / 152 | ! data maxmag(2) / 0000007777777777777776b / 153 | 154 | ! Machine constants for the Prime 400. 155 | 156 | ! data mcheps(1),mcheps(2) / :10000000000, :00000000123 / 157 | ! data minmag(1),minmag(2) / :10000000000, :00000100000 / 158 | ! data maxmag(1),maxmag(2) / :17777777777, :37777677776 / 159 | 160 | ! Machine constants for the VAX-11. 161 | 162 | ! data mcheps(1),mcheps(2) / 9472, 0 / 163 | ! data minmag(1),minmag(2) / 128, 0 / 164 | ! data maxmag(1),maxmag(2) / -32769, -1 / 165 | 166 | ! Machine constants for IEEE machines. 167 | 168 | data dmach(1) /2.22044604926d-16/ 169 | data dmach(2) /2.22507385852d-308/ 170 | data dmach(3) /1.79769313485d+308/ 171 | 172 | dpmpar = dmach(i) 173 | return 174 | 175 | !Last card of function dpmpar. 176 | 177 | end 178 | -------------------------------------------------------------------------------- /src/modules/radiation/ionization_equilibrium.f90: -------------------------------------------------------------------------------- 1 | module ionization_equilibrium 2 | ! Evaluate the ionization structure and the heating and cooling functions for a given temperature 3 | 4 | use global_parameters 5 | use utils 6 | use utils_ion_eq 7 | use System_HeH ! Equilibrium equations 8 | use System_HeH_TR 9 | use System_H 10 | 11 | implicit none 12 | 13 | contains 14 | 15 | subroutine ioniz_eq(T_in,n_in,f_sp_in,n_out, & 16 | f_sp_out,heat_out,cool_out,q) 17 | 18 | integer :: j 19 | 20 | real*8, dimension(1-Ng:N+Ng), intent(in) :: T_in,n_in 21 | real*8, dimension(1-Ng:N+Ng,6), intent(in) :: f_sp_in 22 | 23 | real*8, dimension(1-Ng:N+Ng) :: T_K ! Dimensional temperature 24 | real*8, dimension(1-Ng:N+Ng) :: nh,nhi,nhii, & ! Species densities 25 | nhe,nhei,nheii,nheiii,nheiTR, & 26 | ne,n_in_dim 27 | 28 | ! Photo ionization rates 29 | real*8, dimension(1-Ng:N+Ng) :: P_HI,P_HeI,P_HeII,P_HeITR 30 | 31 | ! Heating, cooling 32 | real*8, dimension(1-Ng:N+Ng) :: heat,cool 33 | 34 | ! Recombination coefficients 35 | real*8, dimension(1-Ng:N+Ng) :: rchiiB,rcheiiB,rcheiiiB,rcheiTR 36 | 37 | real*8, dimension(1-Ng:N+Ng) :: q13,q31a,q31b 38 | real*8 :: A31,Q31 39 | 40 | ! Ionization coefficients 41 | real*8, dimension(1-Ng:N+Ng) :: a_ion_HI,a_ion_HeI,a_ion_HeII 42 | 43 | ! Equilibrium system setup 44 | real*8 :: tol,dpmpar 45 | real*8, dimension(25) :: params 46 | 47 | ! Output density 48 | real*8, dimension(1-Ng:N+Ng),intent(out) :: n_out 49 | 50 | ! Output heating,cooling and absorbed energy 51 | real*8, dimension(1-Ng:N+Ng),intent(out) :: heat_out,cool_out,q 52 | 53 | ! Output species fractions 54 | real*8, dimension(1-Ng:N+Ng,6),intent(out) :: f_sp_out 55 | 56 | !----------------------------------------------------------! 57 | ! Global parameters 58 | 59 | ! Numerical tolerance for system solution 60 | tol = sqrt(dpmpar(1)) 61 | 62 | !----------------------------------! 63 | 64 | ! Preliminary profiles exctraction 65 | 66 | ! Dimensional total number density profile and temperature 67 | n_in_dim = n_in*n0 68 | T_K = T_in*T0 69 | 70 | ! Extract species profiles 71 | nhi = f_sp_in(:,1)*n_in_dim ! HI 72 | nhii = f_sp_in(:,2)*n_in_dim ! HII 73 | if (thereis_He) then 74 | 75 | nhei = f_sp_in(:,3)*n_in_dim ! HeI 76 | nheii = f_sp_in(:,4)*n_in_dim ! HeII 77 | nheiii = f_sp_in(:,5)*n_in_dim ! HeIII 78 | nheiTR = f_sp_in(:,6)*n_in_dim ! HeITR 79 | 80 | else 81 | 82 | ! Enforce condition of zero helium 83 | nhei = 0.0 84 | nheii = 0.0 85 | nheiii = 0.0 86 | nheiTR = 0.0 87 | 88 | endif 89 | 90 | ! Total number densities 91 | nh = nhi + nhii 92 | nhe = nhei + nheii + nheiii 93 | 94 | ! Free electron density (assuming overall neutrality) 95 | call calc_ne(nhii,nheii,nheiii,ne) 96 | 97 | !----------------------------------! 98 | 99 | !---- Photoionization and photoheating ----! 100 | 101 | if (thereis_He) then 102 | call PH_heat_HHe(nhi,nhei,nheii,nheiTR, & 103 | P_HI,P_HeI,P_HeII,P_HeITR,heat,q) 104 | else 105 | call PH_heat_H(nhi,P_HI,heat,q) 106 | endif 107 | 108 | 109 | !----------------------------------! 110 | 111 | ! Evaluate cooling rates and recombination/collisional 112 | ! ionization rates 113 | 114 | call eval_cool(T_K,nhi,nhii,nhei,nheii,nheiii, & 115 | rchiiB,rcheiiB,rcheiiiB, & 116 | a_ion_HI,a_ion_HeI,a_ion_HeII,cool) 117 | 118 | if (thereis_HeITR) then 119 | call HeITR_coeffs(T_K,rcheiTR,rcheiiB,A31,q13,q31a,q31b,Q31) 120 | ! NOTE: rcheiiB is alpha1 from Oklopcic - being overwritten 121 | endif 122 | 123 | !----------------------------------! 124 | 125 | ! Ionization equilibrium system solution 126 | 127 | if (.not.thereis_He) then ! If no helium 128 | 129 | do j = N+Ng,1-Ng,-1 130 | 131 | ! Ionization equilibrium system setup 132 | params(1) = P_HI(j) 133 | params(2) = rchiiB(j) 134 | params(3) = nh(j) 135 | params(4) = a_ion_HI(j) 136 | 137 | ! Initial guess 138 | if (count.le.0) then 139 | if(r(j).le.(1.5))then 140 | sys_x(1) = r(j)-0.5 141 | else 142 | sys_x(1) = 1.0 143 | endif 144 | else 145 | 146 | sys_x(1) = nhii(j)/nh(j) 147 | 148 | endif 149 | 150 | ! Call hybrd1 routine (from minpack) 151 | call hybrd1(ion_system_H,N_eq,sys_x,sys_sol, & 152 | tol,info,wa,lwa,params) 153 | 154 | ! Extract solution profiles 155 | nhi(j) = nh(j)*(1.0 - sys_x(1)) 156 | nhii(j) = nh(j)*sys_x(1) 157 | 158 | enddo 159 | 160 | nhei = 0.0 161 | nheii = 0.0 162 | nheiii = 0.0 163 | nheiTR = 0.0 164 | 165 | else ! If there is helium 166 | 167 | do j = N+Ng,1-Ng,-1 168 | 169 | ! System coefficients 170 | params(1) = P_HI(j) 171 | params(2) = P_HeI(j) 172 | params(3) = P_HeII(j) 173 | params(4) = rchiiB(j) 174 | params(5) = rcheiiB(j) 175 | params(6) = rcheiiiB(j) 176 | params(7) = nh(j) 177 | params(8) = nhe(j) 178 | params(9) = a_ion_HI(j) 179 | params(10) = a_ion_HeI(j) 180 | params(11) = a_ion_HeII(j) 181 | 182 | ! Add more if HeITR is present 183 | if (thereis_HeITR) then 184 | params(12) = rcheiTR(j) 185 | params(13) = A31 186 | params(14) = P_HeITR(j) 187 | params(15) = q13(j) 188 | params(16) = q31a(j) 189 | params(17) = q31b(j) 190 | params(18) = Q31 191 | endif 192 | 193 | ! Initial guess 194 | if (count .eq. 0) then 195 | if (j .eq. N+Ng) then 196 | sys_x(1) = 1.0 197 | sys_x(2) = 1.0 198 | sys_x(3) = 1.0 199 | if (thereis_HeITR) sys_x(4) = 0.01 200 | else 201 | sys_x(1) = nhii(j+1)/nh(j+1) 202 | sys_x(2) = nheii(j+1)/nhe(j+1) 203 | sys_x(3) = nheiii(j+1)/nhe(j+1) 204 | if (thereis_HeITR) & 205 | sys_x(4) = nheiTR(j+1)/nhe(j+1) 206 | endif 207 | else 208 | sys_x(1) = nhii(j)/nh(j) 209 | sys_x(2) = nheii(j)/nhe(j) 210 | sys_x(3) = nheiii(j)/nhe(j) 211 | if (thereis_HeITR) sys_x(4) = nheiTR(j)/nhe(j) 212 | endif 213 | 214 | ! Call hybrd1 routine (from minpack) 215 | if (thereis_HeITR) then 216 | call hybrd1(ion_system_HeH_TR,N_eq,sys_x,sys_sol, & 217 | tol,info,wa,lwa,params) 218 | else 219 | call hybrd1(ion_system_HeH,N_eq,sys_x,sys_sol, & 220 | tol,info,wa,lwa,params) 221 | endif 222 | 223 | ! Extract solution profiles 224 | nhi(j) = nh(j)*(1.0 - sys_x(1)) 225 | nhii(j) = nh(j)*sys_x(1) 226 | nhei(j) = nhe(j)*(1.0 - sys_x(2) - sys_x(3)) 227 | nheii(j) = nhe(j)*sys_x(2) 228 | nheiii(j) = nhe(j)*sys_x(3) 229 | if (thereis_HeITR) nheiTR(j) = nhe(j)*sys_x(4) 230 | 231 | enddo 232 | 233 | endif 234 | 235 | 236 | ! Density with atomic numbers 237 | call calc_rho(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_out) 238 | 239 | ! Abundancies profiles 240 | f_sp_out(:,1) = nhi/n_out 241 | f_sp_out(:,2) = nhii/n_out 242 | f_sp_out(:,3) = nhei/n_out 243 | f_sp_out(:,4) = nheii/n_out 244 | f_sp_out(:,5) = nheiii/n_out 245 | f_sp_out(:,6) = nheiTR/n_out 246 | 247 | ! Adimensional number density profile 248 | n_out = n_out/n0 249 | 250 | ! Adimensional heating and cooling rates 251 | heat_out = heat/q0 252 | cool_out = cool/q0 253 | 254 | ! Adjust value of pressure boundary condition 255 | dp_bc = (nhii(1-Ng) + nheii(1-Ng) + 2.0*nheiii(1-Ng))/n0 256 | 257 | ! End of subroutine 258 | end subroutine ioniz_eq 259 | 260 | ! End of module 261 | end module ionization_equilibrium 262 | -------------------------------------------------------------------------------- /src/modules/flux/Num_Fluxes.f90: -------------------------------------------------------------------------------- 1 | module Numerical_Fluxes 2 | ! Collection of numerical flux functions 3 | 4 | use global_parameters 5 | use Conversion 6 | use S_estimate_HLLC 7 | use S_estimate_ROE 8 | 9 | implicit none 10 | 11 | contains 12 | 13 | ! Subroutine for the numerical flux 14 | subroutine Num_flux(WL,WR,NF,alpha,p_out) 15 | 16 | real*8,intent(in) :: WL(3),WR(3),alpha 17 | real*8 :: uL(3),uR(3) 18 | real*8 :: FL(3),FR(3) 19 | real*8 :: rhoL,vL,pL,aL,EL,HL,SL,phiL 20 | real*8 :: rhoR,vR,pR,aR,ER,HR,SR,phiR 21 | real*8 :: S_star 22 | real*8 :: usL(3),usR(3) 23 | real*8 :: s,rho_avg,v_avg,H_avg,a_avg 24 | real*8 :: l1,l2,l3 25 | real*8 :: l1L,l1R,l3L,l3R 26 | real*8 :: v_star,aL_star,aR_star 27 | real*8 :: drho,dvel,dp 28 | real*8 :: a1,a2,a3 29 | real*8, dimension(3) :: K1,K2,K3 30 | real*8, intent(out) :: NF(3),p_out 31 | 32 | ! Exctract left state 33 | rhoL = WL(1) 34 | vL = WL(2) 35 | pL = WL(3) 36 | EL = 0.5*rhoL*vL*vL + pL/(g-1.0) 37 | HL = (EL+pL)/rhoL 38 | aL = sqrt(g*pL/rhoL) 39 | 40 | ! Exctract right state 41 | rhoR = WR(1) 42 | vR = WR(2) 43 | pR = WR(3) 44 | ER = 0.5*rhoR*vR*vR + pR/(g-1.0) 45 | HR = (ER+pR)/rhoR 46 | aR = sqrt(g*pR/rhoR) 47 | 48 | ! Evaluate numerical flux 49 | select case(flux) 50 | 51 | case ('LLF') ! Local Lax Friedrichs 52 | 53 | ! Evaluate physical left and right flux 54 | call Phys_flux(WL,FL) 55 | call Phys_flux(WR,FR) 56 | 57 | ! Maximum eigenvalue between adjacent cells 58 | a1 = max(abs(vL+aL),abs(vR+aR)) 59 | 60 | ! Get vector of conservative variables 61 | call W_to_U_comp(WL,uL) 62 | call W_to_U_comp(WR,uR) 63 | 64 | ! Evaluate numerical flux 65 | NF = 0.5*(FL + FR - a1*(uR-uL)) 66 | 67 | ! Output pressure 68 | p_out = 0.5*(pR + pL) 69 | 70 | !----------------------------------------------! 71 | 72 | case('HLLC') ! HLLC solver 73 | 74 | call W_to_U_comp(WL,uL) 75 | call W_to_U_comp(WR,uR) 76 | 77 | ! Speed estimates 78 | SL = min(0.0,min(vL-aL, vR-aR)) 79 | SR = max(0.0,max(vL+aL, vR+aR)) 80 | phiL = rhoL*(SL-vL) 81 | phiR = rhoR*(SR-vR) 82 | S_star = (pR - pL + phiL*vL - phiR*vR)/(phiL - phiR) 83 | 84 | ! HLLC state approximation 85 | 86 | ! Left state 87 | usL(1) = 1.0 88 | usL(2) = S_star 89 | usL(3) = EL/rhoL + (S_star-vL)*(S_star + pL/phiL) 90 | usL = rhoL*(SL-vL)/(SL-S_star)*usL 91 | 92 | ! Right state 93 | usR(1) = 1.0 94 | usR(2) = S_star 95 | usR(3) = ER/rhoR + (S_star-vR)*(S_star + pR/phiR) 96 | usR = rhoR*(SR-vR)/(SR-S_star)*usR 97 | 98 | ! Evaluate HLLC flux 99 | 100 | if(SL.ge.(0.0)) then 101 | 102 | call Phys_flux(WL,NF) 103 | p_out = pL 104 | 105 | elseif(SL.lt.(0.0).and.S_star.ge.(0.0)) then 106 | 107 | call Phys_flux(WL,NF) 108 | NF = NF + SL * (usL-uL) 109 | p_out = pL 110 | 111 | elseif(S_star.lt.(0.0).and.SR.ge.(0.0)) then 112 | 113 | call Phys_flux(WR,NF) 114 | NF = NF + SR * (usR-uR) 115 | p_out = pR 116 | else 117 | call Phys_flux(WR,NF) 118 | p_out = pR 119 | 120 | endif 121 | 122 | !----------------------------------------------! 123 | 124 | case ('ROE') 125 | 126 | ! Construct averaged states 127 | 128 | ! Auxiliary parameter 129 | s = sqrt(rhoL)/(sqrt(rhoL)+sqrt(rhoR)) 130 | 131 | ! Density 132 | rho_avg = sqrt(rhoL*rhoR) 133 | 134 | ! Velocity 135 | v_avg = s*vL + (1.0-s)*vR 136 | 137 | ! Entalpy 138 | H_avg = s*HL + (1.0-s)*HR 139 | 140 | ! Sound speed 141 | a_avg = sqrt((g-1.0)*(H_avg-0.5*v_avg*v_avg)) 142 | 143 | !---------------------------------! 144 | 145 | ! Average eigenvalues 146 | 147 | l1 = v_avg - a_avg 148 | l2 = v_avg 149 | l3 = v_avg + a_avg 150 | 151 | !---------------------------------! 152 | 153 | ! Entropy correction 154 | 155 | ! Evaluate the approximate velocities 156 | call speed_estimate_ROE(WL,WR,v_star,aL_star,aR_star) 157 | 158 | ! Intermediate eigenvalues 159 | l1L = vL - aL 160 | l1R = v_star - aL_star 161 | l3L = v_star + aR_star 162 | l3R = vR + aR 163 | 164 | ! Modify the eigenvalues if a rarefaction is present 165 | 166 | ! Left rarefaction 167 | if (l1L.lt.(0.0).and.l1R.gt.(0.0)) then 168 | l1 = l1L*(l1R-l1)/(l1R-l1L) 169 | endif 170 | 171 | ! Right rarefaction 172 | if (l3L.lt.(0.0).and.l3R.gt.(0.0)) then 173 | l3 = l3R*(l3-l3L)/(l3R-l3L) 174 | endif 175 | 176 | !---------------------------------! 177 | 178 | ! Averaged eigenevectors 179 | 180 | ! K1 181 | K1(1) = 1.0 182 | K1(2) = v_avg - a_avg 183 | K1(3) = H_avg - v_avg*a_avg 184 | 185 | ! K2 186 | K2(1) = 1.0 187 | K2(2) = v_avg 188 | K2(3) = 0.5*v_avg*v_avg 189 | 190 | ! K3 191 | K3(1) = 1.0 192 | K3(2) = v_avg + a_avg 193 | K3(3) = H_avg + v_avg*a_avg 194 | 195 | !---------------------------------! 196 | 197 | ! Evaluate the conserved-variables differences 198 | drho = rhoR - rhoL 199 | dvel = vR - vL 200 | dp = pR - PL 201 | 202 | ! Evaluate the expansion coefficients 203 | a1 = 0.5/a_avg**2.0*(dp - rho_avg*a_avg*dvel) 204 | a2 = drho - dp/a_avg**2.0 205 | a3 = 0.5/a_avg**2.0*(dp + rho_avg*a_avg*dvel) 206 | 207 | !---------------------------------! 208 | 209 | ! Evaluate the left and right fluxes 210 | call Phys_flux(WL,FL) 211 | call Phys_flux(WR,FR) 212 | 213 | ! Evaluate the flux at interface ( eq.[11.29] Toro ) 214 | NF = 0.5*(FR+FL) & 215 | - 0.5*(a1*abs(l1)*K1 + a2*abs(l2)*K2 + a3*abs(l3)*K3) 216 | 217 | ! Output pressure 218 | p_out = 0.5*(pR + pL) 219 | 220 | end select 221 | 222 | ! End of subroutine 223 | end subroutine Num_flux 224 | 225 | !-----------------------------------------------------------! 226 | 227 | ! Subroutine to compute the physical flux function 228 | subroutine Phys_flux(W,PF) 229 | 230 | real*8, intent(in) :: W(3) 231 | real*8 :: rho,v,p,E 232 | real*8, intent(out) :: PF(3) 233 | 234 | ! Get physical variables 235 | rho = W(1) 236 | v = W(2) 237 | p = W(3) 238 | E = 0.5*rho*v*v + p/(g-1.0) 239 | 240 | ! Output exact flux vector 241 | PF(1) = rho*v 242 | PF(2) = rho*v*v 243 | PF(3) = v*(E+p) 244 | 245 | ! Add pressure for PLM discretization 246 | if (use_plm) PF(2) = PF(2) + p 247 | 248 | ! End of subroutine 249 | end subroutine Phys_flux 250 | 251 | ! End of module 252 | end module Numerical_Fluxes 253 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The ATES code 2 | 3 | UPDATE 22/09/23 4 | 5 | A new version of ATES (v2.0) is now available. The main updates to version 1.0 include: 6 | * The possibility to use numerical power spectra instead of power-laws; 7 | * The possibility to include the chemistry of HeI triplet state; 8 | * Improved computational speed for each timestep; 9 | * An updated, user friendly interface 10 | * A pdf manual (currently still in production) 11 | 12 | This ATES version includes also TPM (Transmission Probability Module), a python script that can be used to calculate the expected transmission feature for the Ly-alpha and the He-10830A lines directly from ATES outputs. 13 | The new features of ATES and the TPM are described in [[3]](#3). 14 | 15 | ---------------------------------------------------------------------------- 16 | 17 | The ATES code has been created to perform hydrodynamical simulations of the atmospheric mass loss from irradiated exoplanets. For a detailed description of the code, we refer to [[1]](#1) In the following we describe the code organization and how to run. 18 | For any question or if you notice any bug please write an email to 19 | 20 | ## Requirements 21 | 22 | The code can be compiled with both `gfortran` (tested successfully in version 9.3.0 and newer) and `ifort` (tested on the 2021.2.0 and the 2021.5.0 versions). For the compiler choice, see below. 23 | A basic installation of `python3` is required. The following libraries are used: `numpy,tkinter,os,shutil,matplotlib,sys,time`. 24 | 25 | ## Installation 26 | 27 | The code doesn't require any special installation, and can be directly downloaded from the Github page or, in alternative, the repository can be cloned via 28 | 29 | git clone https://github.com/AndreaCaldiroli/ATES-Code 30 | 31 | The first version of ATES is still available and can be downloaded through 32 | 33 | git clone --branch 1.0 https://github.com/AndreaCaldiroli/ATES-Code 34 | 35 | ## Directories and files 36 | 37 | The main directory (`$MAIN`) of the code consists of the following elements: 38 | * the main code file `$MAIN/ATES_main.f90`; 39 | * the bash script `$MAIN/run_ATES.sh` that takes care of the compilation and the execution of the code; 40 | * the `$MAIN/src` directory, where all the code modules are stored. 41 | * the `$MAIN/ATES_plots.py` python3 file for live plots. 42 | * the `$MAIN/eta_approx.py` python3 file with the approximate function of the effective efficiency from Appendix A in [[2]](#2). 43 | 44 | The `$MAIN/src` directory contains three major sudirectories: 45 | * the `$MAIN/src/utils` folder contains the python3 files dedicated for the creatioin of the input interface; 46 | * the `$MAIN/src/modules` folder contains all the `.f90` files for all the subroutines of the code; 47 | * the `$MAIN/src/mod` folder stores the `.mod` files. 48 | 49 | In the `$MAIN/src/modules` subdirectory, the code's modules are subdivided as follows: 50 | * `$MAIN/src/modules/files_IO` : subroutines for the input/output management (read input parameters, load initial conditions, write the simulation output); 51 | * `$MAIN/src/modules/flux` : library with the implemented numerical flux functions and wavespeed estimates; 52 | * `$MAIN/src/modules/functions` : various useful functions; 53 | * `$MAIN/src/modules/init` : subroutines for the initialization of the code (allocate global vectors and variables, set initial conditions); 54 | * `$MAIN/src/modules/nonlinear_system_solver` : subroutines from MINPACK (https://www.netlib.org/minpack/) and definition of the photoionization equilibrium system; 55 | * `$MAIN/src/modules/post_process` : subroutine for the post processing; 56 | * `$MAIN/src/modules/radiation` : subroutines related to the radiation; 57 | * `$MAIN/src/modules/states`: subroutines for the hydrodynamical reconstruction step, boundary conditions and source terms; 58 | * `$MAIN/src/modules/time_step` : evaluation of the right hand side of the Runge-Kutta integrator. 59 | 60 | 61 | ## Using the code 62 | 63 | Once exctracted, it is necessary to give execution permission to the `$MAIN/run_program.sh` file: 64 | 65 | chmod +x $MAIN/run_ATES.sh 66 | 67 | In order to run the code, the bash file must be executed. By default, ATES is compiled with gfortran. In the terminal, it is sufficient to execute: 68 | 69 | .$MAIN/run_ATES.sh 70 | 71 | To force the use of the `ifort` compiler, run the following command: 72 | 73 | .$MAIN/run_ATES.sh --ifort 74 | 75 | The user is asked to insert the physical parameters of the system to be simulated. See [[1]](#1) for a detailed explanation of such parameters. If a system is not available in the precompiled archive (which is stored in `$MAIN/src/utils/params_table.txt`), it is possible to add it to the default list for later simulations by using the `Add planet` button. 76 | 77 | The code is executed by pressing the `Done` button. In the terminal, the current iteration number and the fractional variation of the momentum over the selected domain of interest, i.e.: 78 | 79 | $$ \dfrac{\Delta \dot{M} }{\dot{M}} := \dfrac{\max\dot{M} - \min\dot{M}}{\min\dot{M}} \quad \text{for} \quad r>r_{esc} $$ 80 | 81 | For planetary simulations, as explained in [[1]](#1), it is suggested to use the PLM reconstruction procedure when starting the simulation from general initial conditions and stop the simulation manually when $\Delta \dot{M}/\dot{M} \lesssim 0.5-1$. Then, restart the simulation using the previous outputs as initial condition (see below) and using the WENO3 reconstruction method instead. 82 | 83 | 84 | 85 | ## Output files 86 | 87 | The code writes the current output of the simulations on two file saved in the `$MAIN/output` directory. The `$MAIN/output/Hydro_ioniz.txt` file stores the hydrodynamical variables, which are saved in column vectors in the following order: 88 | 1. radial distance (in unit of the planetary radius) 89 | 2. mass density (in unit of the proton mass) 90 | 3. velocity (in cm/s) 91 | 4. pressure (in CGS units) 92 | 5. Temperature (in Kelvin) 93 | 6. Radiative heating rate (in CGS units) 94 | 7. Radiative cooling rate (in CGS units) 95 | 8. Heating efficiency (adimensional) 96 | 97 | 98 | The ionization profiles are saved in the `$MAIN/output/Ion_species.txt` file. The columns of the file correspond to the number densities of HI, HII, HeI, HeII, HeIII in . 99 | 100 | The post-processed profile are written on the `$MAIN/output/Hydro_ioniz_adv.txt` and `$MAIN/output/Ion_species_adv.txt` files. The data are formatted as the `$MAIN/output/Hydro_ioniz.txt` and `$MAIN/output/Ion_species.txt` files. 101 | 102 | If the `Load IC` flag is active in the input window, the code automatically chooses the last saved `$MAIN/output/Hydro_ioniz.txt` and `$MAIN/output/Ion_species.txt`files in the `$MAIN/output` directory and copies them onto two new files named, by default,`$MAIN/output/Hydro_ioniz_IC.txt` and `$MAIN/output/Ion_species_IC.txt`, which are loaded by the code. For the writing/reading formats consult the `$MAIN/src/modules/file_IO/load_IC.f90` and `$MAIN/src/modules/file_IO/write_output.f90` files. 103 | 104 | ## Plotting results 105 | 106 | The `$MAIN/ATES_plots.py` file can be used to plot the current status of the simulation or to follow the evolution of the profiles with a live animation. The script can be executed with the following syntax: 107 | 108 | python3 $MAIN/ATES_plots.py --live n 109 | 110 | The `--live n` arguments are optional, and can therefore be omitted. If so, the content of the current `$MAIN/output/Hydro_ioniz.txt` and `$MAIN/output/Ion_species.txt` is plotted. If only the `--live` flag is used, the figure is updated by default every 4 seconds with the content of the current output files (which ATES, by defaults, overwrites every 1000th temporal iteration). To set the time update interval, specify the `n` argument with the desired number of seconds between the updates. Finally, a second figure with the post-processed profiles is created if the corresponding files (`$MAIN/output/Hydro_ioniz_adv.txt`and `$MAIN/output/Ion_species_adv.txt`) are found in the `$MAIN/output` directory. 111 | 112 | ## Approximate effective efficiency function 113 | 114 | The file `$MAIN/eta_approx.py` contains the approximate expression for the effective efficiency presented in [[2]](#2). The file can be simply run as: 115 | 116 | python3 $MAIN/eta_approx.py 117 | 118 | The user must provide the planetary parameters directly through the terminal window. The approximate values of the effective efficiency and the mass loss rate are printed as outputs. 119 | 120 | ## References 121 | [1] 122 | Caldiroli, A., Haardt, F., Gallo, E., Spinelli, R., Malsky, I., Rauscher, E., 2021, "Irradiation-driven escape of primordial planetary atmospheres I. The ATES photoionization hydrodynamics code", A&A, 655, A30 (2021). 123 | 124 | [2] 125 | Caldiroli, A., Haardt, F., Gallo, E., Spinelli, R., Malsky, I., Rauscher, E., 2021, "Irradiation-driven escape of primordial planetary atmospheres II. Evaporation efficiency of sub-Neptunes through hot Jupiters", A&A, 663, A122, (2022). 126 | 127 | [3] Biassoni, F., Caldiroli, A., Gallo, E., Haardt, F., Spinelli, R., and Borsa, F., 2023, "Self-Consistent Modeling of Metastable Helium Exoplanet Transits", A&A, 682, A115 (2024) 128 | 129 | 130 | -------------------------------------------------------------------------------- /src/modules/files_IO/input_read.f90: -------------------------------------------------------------------------------- 1 | module Read_input 2 | ! Read input planetary parameters adn define 3 | 4 | use global_parameters 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | subroutine input_read 11 | ! Subroutine to read the input file and assign names and values 12 | ! to global constants 13 | 14 | character(len = :), allocatable :: str 15 | character(len = 250) :: line 16 | 17 | ! ----- Read planetary parameters from input file ----- ! 18 | 19 | ! Open file for reading 20 | write(*,*) '(input_read.f90) Reading the input.inp file..' 21 | open(unit = 11, file = inp_file) 22 | 23 | ! --- Go line by line and read 24 | 25 | ! Planet name 26 | read(11,'(A)') line 27 | p_name = get_word(line, 3) 28 | 29 | ! Log10 of n0 30 | read(11,'(A)') line 31 | str = get_word(line, 7) 32 | read(str,*) n0 33 | 34 | ! Planet radius 35 | read(11,'(A)') line 36 | str = get_word(line, 4) 37 | read(str,*) R0 38 | 39 | ! Planet mass 40 | read(11,'(A)') line 41 | str = get_word(line, 4) 42 | read(str,*) Mp 43 | 44 | ! Equilibrium temperature 45 | read(11,'(A)') line 46 | str = get_word(line, 4) 47 | read(str,*) T0 48 | 49 | ! Orbital distance 50 | read(11,'(A)') line 51 | str = get_word(line, 4) 52 | read(str,*) a_orb 53 | 54 | ! Escape radius 55 | read(11,'(A)') line 56 | str = get_word(line, 4) 57 | read(str,*) r_esc 58 | 59 | ! He/H number ratio 60 | read(11,'(A)') line 61 | str = get_word(line, 4) 62 | read(str,*) HeH 63 | if (HeH .gt. 0.0e0) thereis_He = .true. 64 | 65 | ! 2D approximate method 66 | read(11,'(A)') line 67 | appx_mth = get_word(line, 4) 68 | 69 | ! Read alpha if selected 70 | if (appx_mth .eq. 'alpha') then 71 | str = get_word(line, 6) 72 | read(str,*) a_tau 73 | else 74 | a_tau = 0.0 75 | endif 76 | 77 | ! Correct appx_meth keywords 78 | if (appx_mth .eq. 'Rate/4') appx_mth = 'Rate/4 + Mdot' 79 | if (appx_mth .eq. 'Rate/2') appx_mth = 'Rate/2 + Mdot/2' 80 | 81 | ! Parent star mass 82 | read(11,'(A)') line 83 | str = get_word(line, 5) 84 | read(str,*) Mstar 85 | 86 | ! Spectrum type 87 | read(11,'(A)') line 88 | sp_type = get_word(line, 3) 89 | 90 | ! Next read properties of spectrum 91 | select case (sp_type) 92 | 93 | case ('Load') ! Load from file 94 | read(11,'(A)') line 95 | sed_file = get_word(line, 3) 96 | do_read_sed = .true. 97 | 98 | case ('Power-law') 99 | read(11,'(A)') line 100 | str = get_word(line, 3) 101 | read(str,*) PLind 102 | is_PL_sed = .true. 103 | 104 | case ('Monochromatic') 105 | 106 | ! Set corresponding logical to true 107 | is_monochr = .true. 108 | 109 | ! Read photon enerrgy 110 | read(11,'(A)') line 111 | str = get_word(line, 4) 112 | read(str,*) e_low 113 | 114 | ! Remove helium if monochromatic and 115 | ! photon energy lower than helium ionization threshold 116 | if (e_low .lt. e_th_HeI) thereis_He = .false. 117 | 118 | end select 119 | 120 | ! Only EUV status 121 | read(11,'(A)') line 122 | str = get_word(line, 4) 123 | if (str .eq. 'False') thereis_Xray = .true. 124 | 125 | ! If not monochromatic, read energy bands 126 | if (.not. is_monochr ) then 127 | 128 | if (.not.thereis_Xray) then 129 | 130 | ! Read e_low 131 | read(11,'(A)') line 132 | str = get_word(line, 4) 133 | read(str,*) e_low 134 | 135 | ! Read e_mid 136 | str = get_word(line, 6) 137 | read(str,*) e_mid 138 | 139 | ! Set e_top to default 140 | e_top = 1.24e3 141 | 142 | else 143 | ! Read e_low 144 | read(11,'(A)') line 145 | str = get_word(line, 4) 146 | read(str,*) e_low 147 | 148 | ! Read e_mid 149 | str = get_word(line, 6) 150 | read(str,*) e_mid 151 | 152 | ! Read e_top 153 | str = get_word(line, 8) 154 | read(str,*) e_top 155 | 156 | endif 157 | 158 | endif 159 | 160 | ! Read X-ray luminosity if included 161 | if (thereis_Xray) then 162 | read(11,'(A)') line 163 | str = get_word(line, 6) 164 | read(str,*) LX 165 | else 166 | LX = 0.0 167 | endif 168 | 169 | ! Read LEUV luminosity 170 | read(11,'(A)') line 171 | str = get_word(line, 6) 172 | read(str,*) LEUV 173 | 174 | ! Read grid type 175 | read(11,'(A)') line 176 | grid_type = get_word(line, 3) 177 | 178 | ! Read numerical flux 179 | read(11,'(A)') line 180 | flux = get_word(line, 3) 181 | 182 | ! Read reconstruction scheme 183 | read(11,'(A)') line 184 | rec_method = get_word(line, 3) 185 | if (rec_method.eq.'WENO3') use_weno3 = .true. 186 | if (rec_method.eq.'PLM') use_plm = .true. 187 | 188 | ! Include He23S 189 | read(11,'(A)') line 190 | str = get_word(line, 3) 191 | if (str .eq. 'True') thereis_HeITR = .true. 192 | 193 | ! Remove HeITR chemistry if He is not included 194 | if (.not. thereis_He) thereis_HeITR = .false. 195 | 196 | ! IC status 197 | read(11,'(A)') line 198 | str = get_word(line, 3) 199 | if (str .eq. 'True') do_load_IC = .true. 200 | 201 | ! Do only post-processing 202 | read(11,'(A)') line 203 | str = get_word(line, 4) 204 | if (str .eq. 'True') then 205 | do_only_pp = .true. 206 | force_start = .false. ! Set to false to avoid overlap 207 | endif 208 | 209 | ! Force start of sim. 210 | read(11,'(A)') line 211 | str = get_word(line, 3) 212 | if (str .eq. 'True') then 213 | force_start = .true. 214 | do_only_pp = .false. ! Set to false to avoid overlap 215 | endif 216 | 217 | close(unit = 1) 218 | write(*,*) '(input_read.f90) Done' 219 | 220 | !------ Definition of physical parameters ------! 221 | 222 | n0 = 10.0**(n0) 223 | R0 = R0*RJ 224 | Mp = Mp*MJ 225 | a_orb = a_orb*AU 226 | Mstar = Mstar*Msun 227 | Mrapp = Mstar/Mp 228 | atilde = a_orb/R0 229 | r_max = (3.0*Mrapp)**(-1.0/3.0)*atilde 230 | 231 | !------ Normalization constants ------! 232 | 233 | rho_bc = (1.0 + 4.0*HeH)/(1.0 + HeH) 234 | v0 = sqrt(kb_erg*T0/mu) 235 | t_s = R0/v0 236 | p0 = n0*mu*v0*v0 237 | q0 = n0*mu*v0*v0*v0/R0 238 | b0 = (Gc*Mp*mu)/(kb_erg*T0*R0) 239 | dp_bc = 1.0e-10 240 | 241 | !------ Allocations ------! 242 | 243 | ! Allocate variables according to composition 244 | if (.not.thereis_He) then 245 | N_eq = 1 246 | else 247 | if (thereis_HeITR) then 248 | N_eq = 4 249 | else 250 | N_eq = 3 251 | endif 252 | endif 253 | 254 | lwa = (N_eq*(3*N_eq+13))/2 255 | allocate (sys_sol(N_eq)) 256 | allocate (sys_x(N_eq)) 257 | allocate (wa(lwa)) 258 | 259 | ! End of subroutine 260 | end subroutine input_read 261 | 262 | ! ------------------------------------------------------- ! 263 | 264 | function get_word(string_in,n_word) 265 | ! Function to read the nth_word in the current string 266 | ! "Words" are separated by spaces 267 | 268 | character(len = *), intent(in) :: string_in 269 | integer, intent(in) :: n_word 270 | 271 | character(len = :), allocatable :: string 272 | character(len = 300) :: c_string 273 | character :: p_char,c_char 274 | integer :: counter 275 | integer :: c_word_counter 276 | integer :: str_len 277 | 278 | character(len = :), allocatable :: get_word 279 | 280 | ! Initialize counters and strings 281 | counter = 1 282 | c_word_counter = 0 283 | string = trim(string_in) 284 | str_len = len(string) 285 | p_char = '' 286 | c_char = '' 287 | c_string = '' 288 | 289 | ! Loop inside the string 290 | do while (counter .ge. 0 .and. counter .le. str_len) 291 | 292 | ! Characters 293 | if (counter .ge. 2) then ! Skip if its the first iteration 294 | p_char = string(counter - 1:counter - 1) 295 | endif 296 | c_char = string(counter:counter) 297 | 298 | ! If a character is found 299 | if (c_char .ne. '') then 300 | 301 | ! Attach character to current string 302 | c_string = trim(c_string) // c_char 303 | 304 | ! Update counter and continue 305 | counter = counter + 1 306 | 307 | continue 308 | 309 | else 310 | 311 | ! If it's a first space after a character 312 | if (p_char .ne. '') then 313 | 314 | ! Update word counter 315 | c_word_counter = c_word_counter + 1 316 | 317 | ! Exit from loop if word counter 318 | ! is equal to n_word in input 319 | if (c_word_counter .eq. n_word) then 320 | get_word = trim(c_string) 321 | return 322 | endif 323 | 324 | ! Reset current string 325 | c_string = '' 326 | 327 | ! Update counter 328 | counter = counter + 1 329 | 330 | else ! If multiple spaces 331 | 332 | counter = counter + 1 333 | continue 334 | endif 335 | 336 | endif 337 | 338 | ! If last character, return 339 | if (counter .eq. str_len) then 340 | 341 | ! Update string 342 | c_char = string(counter:counter) 343 | c_string = trim(c_string) // c_char 344 | 345 | ! Update word counter 346 | c_word_counter = c_word_counter + 1 347 | 348 | ! Exit from loop if word counter 349 | ! is equal to n_word in input 350 | if (c_word_counter .eq. n_word) then 351 | get_word = trim(c_string) 352 | return 353 | endif 354 | endif 355 | 356 | enddo ! End of while loop 357 | 358 | ! End of get_word function 359 | end function 360 | 361 | ! End of module 362 | end module Read_input 363 | -------------------------------------------------------------------------------- /src/modules/radiation/util_ion_eq.f90: -------------------------------------------------------------------------------- 1 | module utils_ion_eq 2 | 3 | use global_parameters 4 | use utils 5 | use Cooling_Coefficients ! Various functions for cooling coefficients 6 | use omp_lib ! OMP libraries 7 | 8 | ! Move here photoionization and photoheating 9 | ! Two subroutines for H and He+H 10 | 11 | implicit none 12 | 13 | contains 14 | 15 | ! ------------------------------------------------------------- ! 16 | 17 | subroutine PH_heat_H(nhi,P_HI,heat,q) 18 | ! Computes photoionization rates and heating rates for 19 | ! an atmosphere composed of H and He 20 | 21 | integer :: i,j 22 | 23 | real*8, dimension(1-Ng:N+Ng),intent(in) :: nhi 24 | 25 | ! Dummy zero 26 | real*8, dimension(1-Ng:N+Ng), parameter :: nhei = 0.0, nheii = 0.0 27 | real*8, dimension(1-Ng:N+Ng), parameter :: nheiii = 0.0, nheiTR = 0.0 28 | real*8, dimension(1-Ng:N+Ng) :: N15, N2, NTR 29 | 30 | real*8 :: dr ! Grid spacing 31 | real*8 :: PIR_1 ! Photoionization rates 32 | real*8 :: Hea_1 ! Heating rates 33 | real*8 :: q_abs ! Absorbed energy 34 | 35 | ! Integral variables 36 | real*8, dimension(Nl) :: tauE 37 | real*8, dimension(Nl) :: int_f,int_1,int_q,int_H 38 | 39 | ! Column densities 40 | real*8, dimension(1-Ng:N+Ng) :: N1 41 | 42 | ! Photo ionization rates 43 | real*8, dimension(1-Ng:N+Ng),intent(out) :: P_HI 44 | 45 | ! Heating efficiency 46 | real*8, dimension(1-Ng:N+Ng),intent(out) :: q 47 | 48 | ! Heating rate 49 | real*8, dimension(1-Ng:N+Ng),intent(out) :: heat 50 | 51 | !----------------------------------! 52 | 53 | ! Evaluate the column density 54 | call calc_column_dens(nhi,nhei,nheii,nheiTR,N1,N15,N2,NTR) 55 | 56 | ! Evaluate photoionization rates and photoheating rates 57 | do j = 1-Ng,N+Ng 58 | 59 | ! Initialization of integrands 60 | Hea_1 = 0.0 61 | PIR_1 = 0.0 62 | q_abs = 0.0 63 | 64 | tauE = s_hi*N1(j)*1.0e-18 65 | 66 | ! Initial integrands 67 | int_f = F_XUV*exp(-tauE)/(1.0 + a_tau*tauE) 68 | int_H = int_f*(1.0-e_th_HI/e_v)*s_hi*nhi(j) 69 | int_1 = int_f*s_hi/e_v 70 | int_q = int_f*s_hi*nhi(j) 71 | 72 | ! Value of integrals 73 | Hea_1 = sum(int_H*de_v) 74 | PIR_1 = sum(int_1*de_v) 75 | q_abs = sum(int_q*de_v) 76 | 77 | ! Multiply for the dimensional coefficient 78 | heat(j) = Hea_1*1.0e-18 79 | P_HI(j) = PIR_1*1.0e-18*erg2eV 80 | q(j) = Hea_1/q_abs 81 | 82 | enddo 83 | 84 | end subroutine PH_heat_H 85 | 86 | ! ------------------------------------------------------------- ! 87 | 88 | subroutine PH_heat_HHe(nhi,nhei,nheii,nheiTR, & 89 | P_HI,P_HeI,P_HeII,P_HeITR,heat,q) 90 | ! Computes photoionization rates and heating rates for 91 | ! an atmosphere composed of H and He 92 | 93 | integer :: i,j 94 | 95 | real*8, dimension(1-Ng:N+Ng),intent(in) :: nhi,nhei,nheii 96 | real*8, dimension(1-Ng:N+Ng),intent(in) :: nheiTR 97 | real*8, dimension(1-Ng:N+Ng) :: nheiS 98 | real*8, dimension(1-Ng:N+Ng) :: N1,N15,N2,NTR 99 | 100 | real*8 :: PIR_1,PIR_15,PIR_2,PIR_TR ! Photoionization rates 101 | real*8 :: Hea_1 ! Heating rates 102 | real*8 :: q_abs ! Absorbed energy 103 | 104 | ! Integral variables 105 | real*8, dimension(Nl) :: tauE 106 | real*8, dimension(Nl) :: int_f,int_1,int_15,int_2,int_TR 107 | real*8, dimension(Nl) :: int_q,int_H 108 | 109 | ! Photo ionization rates 110 | real*8, dimension(1-Ng:N+Ng), intent(out) :: P_HI 111 | real*8, dimension(1-Ng:N+Ng), intent(out) :: P_HeI,P_HeII,P_HeITR 112 | 113 | ! Heating efficiency 114 | real*8, dimension(1-Ng:N+Ng),intent(out) :: q 115 | 116 | ! Heating rate 117 | real*8, dimension(1-Ng:N+Ng),intent(out) :: heat 118 | 119 | !----------------------------------! 120 | 121 | ! Use nheiS as variable 122 | nheiS = nhei 123 | if (thereis_HeITR) nheiS = nhei - nheiTR 124 | 125 | ! Evaluate the column density 126 | call calc_column_dens(nhi,nheiS,nheii,nheiTR,N1,N15,N2,NTR) 127 | 128 | !----------------------------------! 129 | !$OMP PARALLEL DO & 130 | !$OMP SHARED ( P_HI,P_HeI,P_HeII,P_HeITR,heat,q ) & 131 | !$OMP PRIVATE ( Hea_1,PIR_1,PIR_15,PIR_2,PIR_TR, & 132 | !$OMP int_1,int_15,int_2,int_TR,int_f,int_H, & 133 | !$OMP int_q,q_abs,tauE,j) 134 | 135 | do j = 1-Ng,N+Ng 136 | 137 | Hea_1 = 0.0 138 | PIR_1 = 0.0 139 | PIR_15 = 0.0 140 | PIR_2 = 0.0 141 | PIR_TR = 0.0 142 | q_abs = 0.0 143 | 144 | ! Calculate optical depth 145 | tauE = (s_hi*N1(j) + s_hei*N15(j) + s_heii*N2(j))*1.0e-18 146 | if (thereis_HeITR) tauE = tauE + s_heiTR*NTR(j)*1.0e-18 147 | 148 | ! Calculate photoionization integrals 149 | int_f = F_XUV*exp(-tauE)/(1.0 + a_tau*tauE) 150 | int_1 = int_f*s_hi/e_v 151 | int_15 = int_f*s_hei/e_v 152 | int_2 = int_f*s_heii/e_v 153 | if (thereis_HeITR) int_TR = int_f*s_heiTR/e_v 154 | 155 | ! Photoheating integral 156 | int_H = int_f*( & 157 | (1.0-e_th_HI/e_v)*s_hi*nhi(j) + & 158 | (1.0-e_th_HeI/e_v)*s_hei*nheiS(j) + & 159 | (1.0-e_th_HeII/e_v)*s_heii*nheii(j)) 160 | 161 | ! Absorbed energy integral 162 | int_q = int_f*(s_hi*nhi(j) + & 163 | s_hei*nheiS(j) + & 164 | s_heii*nheii(j)) 165 | 166 | ! Midpoint rule for integrals 167 | PIR_1 = sum(int_1*de_v) 168 | PIR_15 = sum(int_15*de_v) 169 | PIR_2 = sum(int_2*de_v) 170 | if(thereis_HeITR) PIR_TR = sum(int_TR*de_v) 171 | Hea_1 = sum(int_H*de_v) 172 | q_abs = sum(int_q*de_v) 173 | 174 | !$OMP CRITICAL 175 | ! Save into vector 176 | P_HI(j) = PIR_1*1.0e-18*erg2eV 177 | P_HeI(j) = PIR_15*1.0e-18*erg2eV 178 | P_HeII(j) = PIR_2*1.0e-18*erg2eV 179 | P_HeITR(j) = PIR_TR*1.0e-18*erg2eV 180 | heat(j) = Hea_1*1.0e-18 181 | q(j) = Hea_1/q_abs 182 | !$OMP END CRITICAL 183 | 184 | enddo 185 | !$OMP END PARALLEL DO 186 | 187 | ! End of subroutine 188 | end subroutine PH_heat_HHe 189 | 190 | !----------------------------------! 191 | 192 | subroutine eval_cool(T_K,nhi,nhii,nhei,nheii,nheiii, & 193 | rchiiB,rcheiiB,rcheiiiB, & 194 | a_ion_HI,a_ion_HeI,a_ion_HeII,cool) 195 | 196 | ! Evaluate the cooling rate contributions to energy and 197 | ! rate equations 198 | 199 | integer :: j 200 | 201 | real*8, dimension(1-Ng:N+Ng),intent(in) :: nhi,nhii, & 202 | nhei,nheii,nheiii 203 | 204 | ! Dimensional temperature 205 | real*8, dimension(1-Ng:N+Ng),intent(in) :: T_K 206 | 207 | real*8, dimension(1-Ng:N+Ng) :: brem,coex,coio,reco ! Cooling rates 208 | real*8, dimension(1-Ng:N+Ng) :: ne ! Electron number density 209 | real*8, dimension(1-Ng:N+Ng) :: GF_H,GF_He ! Gaunt factors 210 | 211 | ! Recombination rate coefficients 212 | real*8, dimension(1-Ng:N+Ng),intent(out) :: rchiiB, & 213 | rcheiiB, & 214 | rcheiiiB 215 | 216 | ! Recombination cooling coefficients 217 | real*8, dimension(1-Ng:N+Ng) :: coeff_rec_cool_HII, & 218 | coeff_rec_cool_HeII, & 219 | coeff_rec_cool_HeIII 220 | 221 | ! Ionization coefficients 222 | real*8, dimension(1-Ng:N+Ng),intent(out) :: a_ion_HI, & 223 | a_ion_HeI, & 224 | a_ion_HeII 225 | 226 | real*8, dimension(1-Ng:N+Ng) :: coeff_coex_rate_HI, & 227 | coeff_coex_rate_HeI, & 228 | coeff_coex_rate_HeII 229 | 230 | ! Heating, cooling 231 | real*8, dimension(1-Ng:N+Ng),intent(out) :: cool 232 | 233 | ! Free electron density 234 | call calc_ne(nhii,nheii,nheiii,ne) 235 | 236 | 237 | !-- Recombination --! 238 | 239 | ! Rate coefficients 240 | call rec_HII_B(T_K,rchiiB) ! HII 241 | call rec_HeII_B(T_K,rcheiiB) ! HeII 242 | call rec_HeIII_B(T_K,rcheiiiB) ! HeIII 243 | 244 | ! Cooling rate coefficients 245 | call rec_cool_HII(T_K,coeff_rec_cool_HII) 246 | call rec_cool_HeII(T_K,coeff_rec_cool_HeII) 247 | call rec_cool_HeIII(T_K,coeff_rec_cool_HeIII) 248 | 249 | ! Cooling rate 250 | reco = coeff_rec_cool_HII*nhii & ! HII 251 | + coeff_rec_cool_HeII*nheii & ! HeII 252 | + coeff_rec_cool_HeIII*nheiii ! HeIII 253 | 254 | !-- Collisional ionization --! 255 | 256 | ! Rate coefficients 257 | call ion_coeff_HI(T_K,a_ion_HI) ! HI 258 | call ion_coeff_HeI(T_K,a_ion_HeI) ! HeI 259 | call ion_coeff_HeII(T_K,a_ion_HeII) ! HeII 260 | 261 | ! Cooling rate 262 | coio = 2.179e-11*a_ion_HI*nhi & ! HI 263 | + 3.940e-11*a_ion_HeI*nhei & ! HeI 264 | + 8.715e-11*a_ion_HeII*nheii ! HeII 265 | 266 | !-- Bremsstrahlung --! 267 | 268 | ! Gaunt factors 269 | call GF(T_K,ih,GF_H) 270 | call GF(T_K,ihe,GF_He) 271 | 272 | ! Cooling rate 273 | brem = 1.426e-27*sqrt(T_K)* & 274 | (ih**2.0*GF_H*nhii + & ! HII 275 | ihe**2.0*GF_He*(nheii + nheiii)) ! He 276 | 277 | !-- Collisional excitation --! 278 | 279 | ! Rate coefficients 280 | call coex_rate_HI(T_K,coeff_coex_rate_HI) ! HI 281 | call coex_rate_HeI(T_K,coeff_coex_rate_HeI) ! HeI 282 | call coex_rate_HeII(T_K,coeff_coex_rate_HeII) ! HeII 283 | 284 | ! Cooling rate 285 | coex = coeff_coex_rate_HI*nhi & ! HI 286 | + coeff_coex_rate_HeI*nhei & ! HeI 287 | + coeff_coex_rate_HeII*nheii ! HeII 288 | 289 | ! Total cooling rate 290 | cool = ne*(brem + coex + reco + coio) 291 | 292 | ! End of subroutine 293 | end subroutine eval_cool 294 | 295 | !----------------------------------! 296 | 297 | ! Various coefficients for HeI triplet chemistry 298 | subroutine HeITR_coeffs(T_K,rcheiTR,rcheii,A31,q13,q31a,q31b,Q31) 299 | 300 | ! Dimensional temperature 301 | real*8, dimension(1-Ng:N+Ng),intent(in) :: T_K 302 | 303 | real*8, intent(out) :: A31,Q31 304 | real*8, dimension(1-Ng:N+Ng), intent(out) :: rcheiTR,rcheii, & 305 | q13,q31a,q31b 306 | 307 | call rec_HeII_23S(T_K,rcheiTR) 308 | call rec_HeII_11S(T_K,rcheii) 309 | call coex_HeI_1S_23S(T_K,q13) 310 | call coex_HeI_23S_21S(T_K,q31a) 311 | call coex_HeI_23S_21P(T_K,q31b) 312 | A31 = 1.272e-4 313 | Q31 = 5.00e-10 314 | 315 | ! End of subroutine 316 | end subroutine HeITR_coeffs 317 | 318 | ! End of module 319 | end module utils_ion_eq 320 | -------------------------------------------------------------------------------- /src/modules/post_process/post_process_adv.f90: -------------------------------------------------------------------------------- 1 | module post_processing 2 | ! Subroutine to correct the output ionization profiles 3 | ! taking into account the ionization term 4 | 5 | use global_parameters 6 | use utils 7 | use System_implicit_adv_H 8 | use System_implicit_adv_HeH 9 | use System_implicit_adv_HeH_TR 10 | use Cooling_Coefficients 11 | use utils_ion_eq 12 | use output_write 13 | use equation_T 14 | 15 | implicit none 16 | 17 | 18 | contains 19 | 20 | subroutine post_process_adv(rho,v,p,T_in,heat,cool,eta, & 21 | nhi_in,nhii_in, & 22 | nhei_in,nheii_in,nheiii_in, & 23 | nheiTR_in) 24 | 25 | 26 | real*8, dimension(1-Ng:N+Ng), intent(in) :: rho,v,p,T_in 27 | real*8, dimension(1-Ng:N+Ng), intent(in) :: heat,cool 28 | real*8, dimension(1-Ng:N+Ng), intent(in) :: eta 29 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhi_in,nhii_in 30 | real*8, dimension(1-Ng:N+Ng), intent(in) :: nhei_in,nheii_in, & 31 | nheiii_in,nheiTR_in 32 | 33 | integer i,j,k 34 | 35 | real*8, dimension(1-Ng:N+Ng) :: T_K,p_out,T_out ! Dimensional temperature 36 | real*8, dimension(1-Ng:N+Ng) :: nh,nhe,ne,n_tot 37 | 38 | ! Dummy variable 39 | real*8, dimension(1-Ng:N+Ng) :: dum_v 40 | 41 | ! Photo ionization rates 42 | real*8, dimension(1-Ng:N+Ng) :: P_HI,P_HeI,P_HeII,P_HeITR 43 | 44 | ! Recombination coefficients 45 | real*8, dimension(1-Ng:N+Ng) :: rchiiB,rcheiiB,rcheiiiB,rcheiTR 46 | 47 | real*8, dimension(1-Ng:N+Ng) :: q13,q31a,q31b 48 | real*8 :: A31,Q31 49 | 50 | ! Ionization coefficients 51 | real*8, dimension(1-Ng:N+Ng) :: a_ion_HI,a_ion_HeI,a_ion_HeII 52 | 53 | ! Heating, cooling 54 | real*8, dimension(1-Ng:N+Ng) :: theat,tcool 55 | 56 | ! Updated species densities 57 | real*8, dimension(1-Ng:N+Ng) :: nhi,nhii 58 | real*8, dimension(1-Ng:N+Ng) :: nhei,nheii,nheiii,nheiTR,nheiS 59 | real*8, dimension(1-Ng:N+Ng) :: mmw 60 | real*8, dimension(1-Ng:N+Ng) :: nhi_w,nhii_w 61 | real*8, dimension(1-Ng:N+Ng) :: nhei_w,nheii_w,nheiii_w,nheiTR_w 62 | 63 | 64 | 65 | real*8 :: TT ! Temperature component 66 | real*8 :: PIR_1,PIR_15,PIR_2,PIR_TR ! Photoionization rates 67 | real*8 :: deltal ! Optical depth 68 | real*8 :: dr ! Grid spacing 69 | real*8 :: iup_1,ilo_1, & ! Photoheating integral variables 70 | iup_15,ilo_15, & 71 | iup_2,ilo_2, & 72 | iup_TR,ilo_TR, & 73 | iup_f,ilo_f 74 | real*8 :: elo,eup ! Energy parameters 75 | real*8 :: tol,dpmpar ! Equilibrium system setup 76 | real*8 :: Hea_1 ! Heating rates 77 | real*8 :: brem,coex,coio,reco ! Cooling rates 78 | real*8 :: iup_H,ilo_H ! Heating rate integral variables 79 | 80 | 81 | ! Substitution in the ODE solution 82 | real*8 :: As 83 | 84 | 85 | real*8, dimension(25) :: params 86 | real*8, dimension(12) :: paramsT 87 | 88 | real*8 :: rhop,rhom,vp,mum,mup,vm 89 | real*8 :: sys_sol_T(1), sys_x_T(1) 90 | real*8 :: wa_T(8) 91 | 92 | 93 | !----------------------------------------------------------! 94 | 95 | ! Global parameters 96 | 97 | ! Numerical tolerance for system solution 98 | tol = sqrt(dpmpar(1)) 99 | 100 | !----------------------------------! 101 | 102 | ! Preliminary profiles extraction 103 | 104 | ! Dimensional total number density profile and temperature 105 | T_K = T_in*T0 106 | 107 | ! Initialize vectors 108 | nhi = nhi_in*n0 109 | nhii = nhii_in*n0 110 | if (thereis_He) then 111 | nhei = nhei_in*n0 112 | nheii = nheii_in*n0 113 | nheiii = nheiii_in*n0 114 | if (thereis_HeITR) nheiTR = nheiTR_in*n0 115 | endif 116 | !----------------------------------! 117 | 118 | ! Iterate the post processing 119 | do k = 1,10 ! Usually 10 gives a good convergence 120 | 121 | ! Use singlet if included 122 | nheiS = nhei 123 | if (thereis_HeITR) nheiS = nhei - nheiTR 124 | nh = nhi + nhii 125 | nhe = nheiS + nheii + nheiii 126 | if (thereis_HeITR) nhe = nhe + nheiTR 127 | 128 | ! Free electron density (assuming overall neutrality) 129 | call calc_ne(nhii,nheii,nheiii,ne) 130 | 131 | ! Calculate the photoionization rates 132 | 133 | if (thereis_He) then 134 | call PH_heat_HHe(nhi,nhei,nheii,nheiTR, & 135 | P_HI,P_HeI,P_HeII,P_HeITR,dum_v,dum_v) 136 | else 137 | call PH_heat_H(nhi,P_HI,dum_v,dum_v) 138 | endif 139 | 140 | !---- Recombination rates ----! 141 | 142 | call eval_cool(T_K,nhi,nhii,nhei,nheii,nheiii, & 143 | rchiiB,rcheiiB,rcheiiiB, & 144 | a_ion_HI,a_ion_HeI,a_ion_HeII,dum_v) 145 | 146 | 147 | if (thereis_HeITR) then 148 | call HeITR_coeffs(T_K,rcheiTR,rcheiiB,A31,q13,q31a,q31b,Q31) 149 | ! NOTE: rcheiiB is alpha1 from Oklopcic - being overwritten 150 | 151 | endif 152 | 153 | !----------------------------------! 154 | 155 | ! Evolve species including the advection term in the 156 | ! ODE form 157 | ! Note: we are using point values here instead of 158 | ! volume averages; they agree up to O(dr^2) 159 | 160 | ! The ionization fraction at the inner boundary are taken 161 | ! from the input vectors (completely neutral atmosphere) 162 | 163 | 164 | ! Loop to solve the differential equation 165 | ! It is implicitly assumed that the velocity fields does 166 | ! not change by including the advection term 167 | 168 | 169 | 170 | if (.not.thereis_He) then 171 | 172 | do j = 2-Ng,N+Ng 173 | 174 | ! Substitutions 175 | dr = (r(j) - r(j-1))*R0 176 | As = dr/(v(j-1)*v0) 177 | 178 | ! Advection coeff. 179 | params(1) = As 180 | params(2) = nhi(j-1)/nh(j-1) 181 | params(3) = nh(j) 182 | params(4) = P_HI(j) 183 | params(5) = rchiiB(j) 184 | params(6) = a_ion_HI(j) 185 | 186 | ! Initial guess of solution 187 | sys_x(1) = nhi(j)/nh(j) 188 | 189 | ! Call hybrd1 routine (from minpack) 190 | call hybrd1(adv_implicit_H,N_eq,sys_x,sys_sol, & 191 | tol,info,wa,lwa,params) 192 | 193 | ! Extract solution profiles 194 | nhi(j) = sys_x(1)*nh(j) 195 | nhii(j) = (1.0 - sys_x(1))*nh(j) 196 | 197 | enddo 198 | 199 | ! Force condition of zero helium 200 | nhei = 0.0 201 | nheii = 0.0 202 | nheiii = 0.0 203 | nheiTR = 0.0 204 | 205 | else 206 | 207 | do j = 2-Ng,N+Ng 208 | 209 | ! Substitutions 210 | dr = (r(j) - r(j-1))*R0 211 | As = dr/(v(j-1)*v0) 212 | 213 | ! Advection coeff. 214 | params(1) = As 215 | params(2) = nhi(j-1)/nh(j-1) 216 | params(3) = nhei(j-1)/nhe(j-1) 217 | params(4) = nheiii(j-1)/nhe(j-1) 218 | params(5) = nh(j) 219 | params(6) = P_HI(j) 220 | params(7) = P_HeI(j) 221 | params(8) = P_HeII(j) 222 | params(9) = rchiiB(j) 223 | params(10) = rcheiiB(j) 224 | params(11) = rcheiiiB(j) 225 | params(12) = a_ion_HI(j) 226 | params(13) = a_ion_HeI(j) 227 | params(14) = a_ion_HeII(j) 228 | 229 | ! Add more if HeITR is present 230 | if (thereis_HeITR) then 231 | params(15) = rcheiTR(j) 232 | params(16) = A31 233 | params(17) = P_HeITR(j) 234 | params(18) = q13(j) 235 | params(19) = q31a(j) 236 | params(20) = q31b(j) 237 | params(21) = Q31 238 | params(22) = nheiTR(j-1)/nhe(j-1) 239 | endif 240 | 241 | ! Initial guess of solution 242 | sys_x(1) = nhi(j)/nh(j) 243 | sys_x(2) = nhei(j)/nhe(j) 244 | sys_x(3) = nheiii(j)/nhe(j) 245 | if (thereis_HeITR) sys_x(4) = nheiTR(j)/nhe(j) 246 | 247 | ! Call hybrd1 routine (from minpack) 248 | if (thereis_HeITR) then 249 | call hybrd1(adv_implicit_HeH_TR,N_eq,sys_x,sys_sol, & 250 | tol,info,wa,lwa,params) 251 | else 252 | call hybrd1(adv_implicit_HeH,N_eq,sys_x,sys_sol, & 253 | tol,info,wa,lwa,params) 254 | endif 255 | 256 | ! Extract solution profiles 257 | nhi(j) = sys_x(1)*nh(j) 258 | nhii(j) = (1.0 - sys_x(1))*nh(j) 259 | nhei(j) = sys_x(2)*nhe(j) 260 | nheii(j) = (1.0 - sys_x(2) - sys_x(3))*nhe(j) 261 | nheiii(j) = sys_x(3)*nhe(j) 262 | if (thereis_HeITR) then 263 | nheiTR(j) = sys_x(4)*nhe(j) 264 | else 265 | nheiTR(j) = 0.0 266 | endif 267 | 268 | enddo 269 | 270 | endif ! End if thereis_He 271 | 272 | 273 | !--------------------------------------------------------- 274 | 275 | !------- Fix stationarity of new pressure profile -------! 276 | 277 | !---- Update densities and temperature ----! 278 | 279 | ! Number densities 280 | nheiS = nhei 281 | if (thereis_HeITR) nheiS = nhei - nheiTR 282 | nh = nhi + nhii 283 | nhe = nheiS + nheii + nheiii 284 | if (thereis_HeITR) nhe = nhe + nheiTR 285 | 286 | ! Total number density 287 | call calc_ntot(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_tot) 288 | 289 | ! Free electron density (assuming overall neutrality) 290 | call calc_ne(nhii,nheii,nheiii,ne) 291 | 292 | !----------------------------------! 293 | 294 | !---- Update photoheating rate ----! 295 | 296 | if (thereis_He) then 297 | call PH_heat_HHe(nhi,nhei,nheii,nheiTR, & 298 | dum_v,dum_v,dum_v,dum_v,theat,dum_v) 299 | else 300 | call PH_heat_H(nhi,dum_v,theat,dum_v) 301 | endif 302 | 303 | ! Adimensionalize 304 | theat = theat/q0 305 | 306 | !----------------------------------! 307 | 308 | !---- Solve stationary energy equation ----! 309 | ! This procedure uses the same velocity profile and 310 | ! the ionization profile after the advection correction 311 | 312 | ! Initialize temperature at ghost cells 313 | T_out = T_K/T0 314 | 315 | ! Calculate mean molecular weight 316 | call calc_mmw(nh,nhe,ne,mmw) 317 | 318 | do j = 3-Ng,N+Ng ! Start from first computational cell 319 | 320 | ! Substitutions 321 | rhop = rho(j) 322 | rhom = rho(j-1) 323 | vm = v(j-1) 324 | vp = v(j) 325 | dr = r(j) - r(j-1) 326 | mum = mmw(j-1) 327 | mup = mmw(j) 328 | 329 | !--- Solve equation for temperature implicitly ---! 330 | 331 | ! Parameters 332 | paramsT(1) = nhi(j) 333 | paramsT(2) = nhii(j) 334 | paramsT(3) = nhei(j) 335 | paramsT(4) = nheii(j) 336 | paramsT(5) = nheiii(j) 337 | paramsT(6) = mmw(j) 338 | paramsT(7) = mmw(j-1) 339 | paramsT(8) = rhop*vp 340 | paramsT(9) = mum*vp*(rhop-rhom) 341 | paramsT(10) = dr 342 | paramsT(11) = T_out(j-1) 343 | paramsT(12) = theat(j) 344 | 345 | ! Initial guess of solution 346 | sys_x_T(1) = T_out(j) 347 | 348 | ! Call hybrd1 routine (from minpack) 349 | call hybrd1(T_equation,1,sys_x_T,sys_sol_T, & 350 | tol,info,wa_T,8,paramsT) 351 | 352 | ! Extract solution profiles 353 | T_out(j) = sys_x_T(1) 354 | 355 | enddo 356 | 357 | ! Update pressure and temperature 358 | p_out = (n_tot + ne)/n0*T_out 359 | T_K = T_out*T0 360 | 361 | enddo ! End loop on post processing 362 | 363 | ! ---------------------------- ! 364 | 365 | !---- Update cooling rates ----! 366 | 367 | call eval_cool(T_K,nhi,nhii,nhei,nheii,nheiii, & 368 | dum_v,dum_v,dum_v, & 369 | dum_v,dum_v,dum_v,tcool) 370 | 371 | ! Adimensionalize 372 | tcool = tcool/q0 373 | 374 | !----------------------------------! 375 | 376 | ! Adimensionalize ion densities before writing 377 | nhi_w = nhi/n0 378 | nhii_w = nhii/n0 379 | nhei_w = nhei/n0 380 | nheii_w = nheii/n0 381 | nheiii_w = nheiii/n0 382 | nheiTR_w = nheiTR/n0 383 | 384 | !----------------------------------! 385 | 386 | ! Write updated thermodynamic and ionization profiles 387 | call write_output(rho,v,p_out,T_out,theat,tcool,eta, & 388 | nhi_w,nhii_w,nhei_w,nheii_w,nheiii_w, & 389 | nheiTR_w,'ad') 390 | 391 | ! End of subroutine 392 | end subroutine post_process_adv 393 | 394 | ! End of module 395 | end module post_processing 396 | -------------------------------------------------------------------------------- /ATES_plots.py: -------------------------------------------------------------------------------- 1 | import numpy as np 2 | import os 3 | import matplotlib.pyplot as plt 4 | import time 5 | import sys 6 | 7 | # Parse options for animated plots 8 | if len(sys.argv) == 1: animate = 'False' 9 | if len(sys.argv) == 2: animate = 'True'; sec = 4 10 | if len(sys.argv) == 3: animate = 'True'; sec = float(sys.argv[2]) 11 | 12 | # ------------------------------------------------------------------ 13 | 14 | # Useful functions 15 | 16 | # Read word_number-th word from string_in 17 | def get_word(string_in,word_number): 18 | 19 | # Initialize counters and string 20 | count = 0 21 | c_string = '' 22 | c_word_counter = 0 23 | string = string_in.strip() 24 | 25 | # Keep reading through string 26 | while count >= 0 and count <= len(string): 27 | 28 | if count == len(string): 29 | out_word = c_string 30 | c_word_counter += 1 31 | # Return word 32 | if c_word_counter == word_number: 33 | return out_word 34 | 35 | # If blank space or at the end of the string 36 | if string[count:count+1] != ' ': 37 | 38 | c_string += string[count:count+1] 39 | count += 1 40 | else: 41 | 42 | 43 | if string[count-1:count] != ' ' or count == len(string): 44 | # Update counters and get word 45 | out_word = c_string 46 | c_word_counter += 1 47 | # Reset reading string 48 | c_string = '' 49 | # Return word 50 | # Update counter 51 | count += 1 52 | if c_word_counter == word_number: 53 | return out_word 54 | else: 55 | count += 1 56 | continue 57 | 58 | # -------------------------------------------------------------------- 59 | # Phisical constants 60 | kb = 1.38e-16 # Boltzmann constant in CGS units 61 | mu = 1.673e-24 # Hydrogen atom mass (g) 62 | gam = 5.0/3.0 # Polytropic index 63 | RJ = 6.9911e9 64 | 65 | 66 | # LOAD DATA 67 | 68 | # Planetary parameters 69 | # Get planetary radius from the input.inp file 70 | with open("input.inp",'r') as f: 71 | 72 | data = f.readline() 73 | num = 1 74 | while data: 75 | data = f.readline() 76 | if num == 2: 77 | R0 = float(get_word(data,4))*RJ 78 | if num == 8: 79 | appx_mth = get_word(data,4) 80 | if appx_mth == 'Rate/2': appx_mth = 'Rate/2 + Mdot/2' 81 | if appx_mth == 'Rate/4': appx_mth = 'Rate/4 + Mdot' 82 | num += 1 83 | 84 | f.close() 85 | 86 | # Hydro profiles 87 | r,rho,v,p,T,heat,cool = \ 88 | np.loadtxt('./output/Hydro_ioniz.txt',unpack = True) 89 | rho = rho*mu 90 | 91 | # Load our ionization profiles 92 | r,nhi,nhii,nhei,nheii,nheiii,nheiTR = \ 93 | np.loadtxt('./output/Ion_species.txt',unpack = True) 94 | 95 | 96 | #-------------------------------------------------- 97 | 98 | # Adimensionalization parameters 99 | N = r.size # Number of cells 100 | vlim = 1.2*v.max()*1e-5 101 | if v.max() < 0 : 102 | vlim = 15.0 103 | 104 | # Internal energy 105 | Eint = p[:]/(gam -1.0) 106 | 107 | # Ion densities and fractions 108 | nh = nhi[:] + nhii[:] # Total hydrogen density 109 | nhe = nhei[:] + nheii[:] + nheiii[:] # Total helium density 110 | ne = nhii[:] + nheii[:] + 2.*nheiii[:] # Free electron density 111 | fhi = nhi[:]/nh[:] # HI fraction 112 | fhii = nhii[:]/nh[:] # HII fraction 113 | fhei = nhei[:]/nhe[:] # HeI fraction 114 | fheii = nheii[:]/nhe[:] # HeII fraction 115 | fheiii = nheiii[:]/nhe[:] # HeIII fraction 116 | fheiTR = nheiTR[:]/nhe[:] # HeITR fraction 117 | 118 | # Spherical momentum 119 | mom = 4.*np.pi*v[:]*rho[:]*r[:]**2.*R0**2. 120 | lgmom = np.zeros(N) 121 | for j in range(N): 122 | if mom[j] > 0: 123 | lgmom[j] = np.log10(mom[j]) 124 | else: 125 | lgmom[j] = -20.0 126 | 127 | # Minimum for momentum plot 128 | mom_inf = lgmom.min() 129 | if mom_inf == -20: mom_inf = 0.8*lgmom[200] 130 | 131 | # Correct mass flux for the current 3D approximation method 132 | mom_out = lgmom[-20] 133 | if appx_mth.strip() == "Rate/2 + Mdot/2": 134 | mom_out = mom_out + np.log10(0.5) 135 | if appx_mth.strip() == "Mdot/4": 136 | mom_out = mom_out + np.log10(0.25) 137 | 138 | 139 | #----------------------------------------------------# 140 | 141 | #------- Hydro plot -------# 142 | 143 | fig, ax = plt.subplots(2,4) 144 | fig.set_size_inches(11, 7) 145 | fig.subplots_adjust(left = 0.05, 146 | bottom = 0.08, 147 | right = 0.97, 148 | top = 0.93, 149 | hspace = 0.30, 150 | wspace = 0.31) 151 | 152 | # Density 153 | rho_line, = ax[0,0].semilogy(r,rho) 154 | ax[0,0].set_xlim([r[0],r[-1]]) 155 | ax[0,0].set_title('Density [g cm$^{-3}$]', fontdict={'weight':'bold'}) 156 | ax[0,0].set_xlabel('r/R$_P$') 157 | 158 | 159 | # Velocity 160 | v_line, = ax[0,1].semilogy(r,v*1e-5) 161 | ax[0,1].set_xlim([r[0],r[-1]]) 162 | ax[0,1].set_ylim([1.e-3,vlim]) 163 | ax[0,1].set_title('Velocity [km s$^{-1}$]', fontdict={'weight':'bold'}) 164 | ax[0,1].set_xlabel('r/R$_P$') 165 | 166 | # Pressure 167 | p_line, = ax[0,2].semilogy(r,p) 168 | ax[0,2].set_xlim([r[0],r[-1]]) 169 | ax[0,2].set_title('Pressure [erg cm$^{-3}$]', fontdict={'weight':'bold'}) 170 | ax[0,2].set_xlabel('r/R$_P$') 171 | 172 | # Temperature 173 | T_line, = ax[0,3].plot(r,T) 174 | ax[0,3].set_xlim([r[0],r[-1]]) 175 | ax[0,3].set_title('Temperature [K]', fontdict={'weight':'bold'}) 176 | ax[0,3].set_xlabel('r/R$_P$') 177 | 178 | # Momentum 179 | mom_line, = ax[1,0].plot(r,lgmom) 180 | ax[1,0].set_xlim([r[0],r[-1]]) 181 | ax[1,0].set_title('Log10 Momentum [g s$^{-1}$]', fontdict={'weight':'bold'}) 182 | ax[1,0].set_xlabel('r/R$_P$') 183 | ax[1,0].set_ylim([mom_inf, 1.2*lgmom.max()]) 184 | 185 | # Ionization densities 186 | nhi_line, = ax[1,1].semilogy(r,nhi,label = '$n_{HI}$') 187 | nhii_line, = ax[1,1].semilogy(r,nhii,label = '$n_{HII}$') 188 | nhei_line, = ax[1,1].semilogy(r,nhei,label = '$n_{HeI}$') 189 | nheii_line, = ax[1,1].semilogy(r,nheii,label = '$n_{HeII}$') 190 | nheiii_line, = ax[1,1].semilogy(r,nheiii,label = '$n_{HeIII}$') 191 | nheiTR_line, = ax[1,1].semilogy(r,nheiTR,label = '$n_{HeI3}$', color = '#5baca7') 192 | ax[1,1].set_title('Ion densities [cm$^{-3}$]', fontdict={'weight':'bold'}) 193 | ax[1,1].set_xlim([r[0],r[-1]]) 194 | ax[1,1].set_xlabel('r/R$_P$') 195 | ax[1,1].legend(loc = 'upper right') 196 | 197 | 198 | # H fractions 199 | fhi_line, = ax[1,2].plot(r,fhi,label = '$f_{HI}$') 200 | fhii_line, = ax[1,2].plot(r,fhii,label = '$f_{HII}$') 201 | ax[1,2].set_title('H fractions', fontdict={'weight':'bold'}) 202 | ax[1,2].set_xlim([r[0],r[-1]]) 203 | ax[1,2].set_ylim([0,1]) 204 | ax[1,2].set_xlabel('r/R$_P$') 205 | ax[1,2].legend(loc = 'best') 206 | 207 | # He fractions 208 | fhei_line, = ax[1,3].plot(r,fhei,label = '$f_{HeI}$') 209 | fheii_line, = ax[1,3].plot(r,fheii,label = '$f_{HeII}$') 210 | fheiii_line, = ax[1,3].plot(r,fheiii,label = '$f_{HeIII}$') 211 | fheiTR_line, = ax[1,3].plot(r,fheiTR,label = '$f_{HeI3}$', color = '#5baca7') 212 | ax[1,3].set_title('He fractions', fontdict={'weight':'bold'}) 213 | ax[1,3].set_xlim([r[0],r[-1]]) 214 | ax[1,3].set_ylim([0,1]) 215 | ax[1,3].set_xlabel('r/R$_P$') 216 | ax[1,3].legend(loc = 'best') 217 | 218 | 219 | #------------------------------------------------------------ 220 | 221 | # Plot post processed data if the files are there 222 | 223 | # Get file paths 224 | cdir = os.getcwd() 225 | adv_hydro = cdir + "/output/Hydro_ioniz_adv.txt" 226 | adv_ioniz = cdir + "/output/Ion_species_adv.txt" 227 | 228 | # Make second figure if _adv files are there 229 | if os.path.isfile(adv_hydro) and os.path.isfile(adv_ioniz): 230 | 231 | 232 | # Hydro profiles 233 | r,rho,v,p,T,heat,cool = \ 234 | np.loadtxt('./output/Hydro_ioniz_adv.txt',unpack = True) 235 | rho = rho*mu 236 | 237 | # Load our ionization profiles 238 | r,nhi,nhii,nhei,nheii,nheiii,nheiTR = \ 239 | np.loadtxt('./output/Ion_species_adv.txt',unpack = True) 240 | 241 | 242 | #-------------------------------------------------- 243 | 244 | 245 | # Ion densities and fractions 246 | nh = nhi[:] + nhii[:] # Total hydrogen density 247 | nhe = nhei[:] + nheii[:] + nheiii[:] # Total helium density 248 | fhi = nhi[:]/nh[:] # HI fraction 249 | fhii = nhii[:]/nh[:] # HII fraction 250 | fhei = nhei[:]/nhe[:] # HeI fraction 251 | fheii = nheii[:]/nhe[:] # HeII fraction 252 | fheiii = nheiii[:]/nhe[:] # HeIII fraction 253 | fheiTR = nheiTR[:]/nhe[:] # HeITR fraction 254 | 255 | #----------------------------------------------------# 256 | 257 | # Add Post-processed profiles 258 | 259 | # Pressure 260 | ax[0,2].semilogy(r,p,'--') 261 | 262 | # Temperature 263 | ax[0,3].plot(r,T,'--') 264 | 265 | # Ionization densities 266 | ax[1,1].semilogy(r,nhi,'--',label = '$n_{HI}$',color = '#1f77b4') 267 | ax[1,1].semilogy(r,nhii,'--',label = '$n_{HII}$',color = '#ff7f0e') 268 | ax[1,1].semilogy(r,nhei,'--',label = '$n_{HeI}$',color = '#2ca02c') 269 | ax[1,1].semilogy(r,nheii,'--',label = '$n_{HeII}$',color = '#d62728') 270 | ax[1,1].semilogy(r,nheiii,'--',label = '$n_{HeIII}$',color = '#9467bd') 271 | ax[1,1].semilogy(r,nheiTR,'--',label = '$n_{HeI3}$', color = '#5baca7') 272 | 273 | # H fractions 274 | ax[1,2].plot(r,fhi,'--',label = '$f_{HI}$',color = '#1f77b4') 275 | ax[1,2].plot(r,fhii,'--',label = '$f_{HII}$',color = '#ff7f0e') 276 | 277 | # He fractions 278 | ax[1,3].plot(r,fhei,'--',label = '$f_{HeI}$',color = '#1f77b4') 279 | ax[1,3].plot(r,fheii,'--',label = '$f_{HeII}$',color = '#ff7f0e') 280 | ax[1,3].plot(r,fheiii,'--',label = '$f_{HeIII}$',color = '#2ca02c') 281 | ax[1,3].plot(r,fheiTR,'--',label = '$f_{HeI3}$', color = '#5baca7') 282 | 283 | # Print the mass loss rate 284 | print("2D approximation method: ", appx_mth.strip()) 285 | print("Log10 of mass-loss-rate = ", mom_out) 286 | 287 | if animate == 'False': 288 | plt.show() 289 | else: 290 | plt.show(block = False) 291 | 292 | #----------------------------------------------------# 293 | 294 | 295 | # Update plot every 5 seconds if --live option is set 296 | if animate == 'True': 297 | k = 1 298 | while k > 0: 299 | 300 | # Hydro profiles 301 | r,rho,v,p,T,heat,cool = \ 302 | np.loadtxt('./output/Hydro_ioniz.txt',unpack = True) 303 | rho = rho*mu 304 | 305 | # Load our ionization profiles 306 | r,nhi,nhii,nhei,nheii,nheiii,nheiTR = \ 307 | np.loadtxt('./output/Ion_species.txt',unpack = True) 308 | 309 | # Spherical momentum 310 | mom = 4.*np.pi*v[:]*rho[:]*r[:]**2.*R0**2. 311 | lgmom = np.zeros(N) 312 | for j in range(N): 313 | if mom[j] > 0: 314 | lgmom[j] = np.log10(mom[j]) 315 | else: 316 | lgmom[j] = -20.0 317 | 318 | # Ion densities and fractions 319 | nh = nhi[:] + nhii[:] # Total hydrogen density 320 | nhe = nhei[:] + nheii[:] + nheiii[:] # Total helium density 321 | ne = nhii[:] + nheii[:] + 2.*nheiii[:] # Free electron density 322 | fhi = nhi[:]/nh[:] # HI fraction 323 | fhii = nhii[:]/nh[:] # HII fraction 324 | fhei = nhei[:]/nhe[:] # HeI fraction 325 | fheii = nheii[:]/nhe[:] # HeII fraction 326 | fheiii = nheiii[:]/nhe[:] # HeIII fraction 327 | fheiTR = nheiTR[:]/nhe[:] # HeIII fraction 328 | 329 | # Update data for plot 330 | rho_line.set_ydata(rho) 331 | v_line.set_ydata(v*1e-5) 332 | p_line.set_ydata(p) 333 | T_line.set_ydata(T) 334 | mom_line.set_ydata(lgmom) 335 | nhi_line.set_ydata(nhi) 336 | nhii_line.set_ydata(nhii) 337 | nhei_line.set_ydata(nhei) 338 | nheii_line.set_ydata(nheii) 339 | nheiii_line.set_ydata(nheiii) 340 | nheiTR_line.set_ydata(nheiTR) 341 | fhi_line.set_ydata(fhi) 342 | fhii_line.set_ydata(fhii) 343 | fhei_line.set_ydata(fhei) 344 | fheii_line.set_ydata(fheii) 345 | fheiii_line.set_ydata(fheiii) 346 | fheiTR_line.set_ydata(fheiTR) 347 | 348 | # Update axis limits 349 | 350 | vlim = 1.2*v.max()*1e-5 351 | if v.max() < 0 : 352 | vlim = 15.0 353 | 354 | # Minimum for momentum plot 355 | mom_inf = lgmom.min() 356 | if mom_inf == -20: mom_inf = 0.8*lgmom[200] 357 | ax[0,1].set_ylim([1.e-3,vlim]) 358 | ax[0,3].set_ylim(0.8*T.min(),1.2*T.max()) 359 | ax[1,0].set_ylim([mom_inf, 1.2*lgmom.max()]) 360 | 361 | fig.canvas.draw() 362 | fig.canvas.flush_events() 363 | 364 | # Wait 5 seconds before next update 365 | time.sleep(sec) 366 | k = k + 1 367 | 368 | # ------------------------------------------------------------------- ! 369 | 370 | 371 | -------------------------------------------------------------------------------- /ATES_main.f90: -------------------------------------------------------------------------------- 1 | program Hydro_ioniz 2 | 3 | use global_parameters 4 | use Read_input 5 | use Initialization 6 | use setup_report 7 | use eval_time_step 8 | use utils 9 | use Conversion 10 | use ionization_equilibrium 11 | use Reconstruction_step 12 | use RK_integration 13 | use BC_Apply 14 | use output_write 15 | use post_processing 16 | use ionization_equilibrium 17 | 18 | implicit none 19 | 20 | ! Logical variables 21 | logical :: l_isnan = .false. 22 | 23 | ! Integers variables 24 | integer :: j,k 25 | 26 | ! Timing variables 27 | integer :: n_hrs 28 | integer :: n_min 29 | real*8 :: start, finish 30 | real*8 :: exec_time 31 | real*8 :: n_sec 32 | real*8 :: dum 33 | 34 | ! Momentum variables 35 | real*8, dimension(1-Ng:N+Ng) :: mom 36 | real*8 :: mom_max,mom_min 37 | 38 | ! Maximum eigenvalue 39 | real*8 :: alpha 40 | 41 | ! Temporal step 42 | real*8 :: dt 43 | 44 | ! Mdot value 45 | real*8 :: Mdot 46 | 47 | ! Vectors of thermodynamical variables 48 | real*8, dimension(1-Ng:N+Ng) :: rho,v,E,p,T,cs 49 | real*8, dimension(1-Ng:N+Ng) :: heat,cool 50 | real*8, dimension(1-Ng:N+Ng) :: eta 51 | real*8, dimension(1-Ng:N+Ng) :: nhi,nhii 52 | real*8, dimension(1-Ng:N+Ng) :: nhei,nheii,nheiii 53 | real*8, dimension(1-Ng:N+Ng) :: nheiTR 54 | real*8, dimension(1-Ng:N+Ng) :: ne,n_tot 55 | real*8, dimension(1-Ng:N+Ng,6) :: f_sp 56 | 57 | ! Conservative and primitive vectors 58 | real*8, dimension(1-Ng:N+Ng,3) :: u,u1,u2,u_old 59 | real*8, dimension(1-Ng:N+Ng,3) :: W,WL,WR 60 | 61 | ! Flux and source vectors 62 | real*8, dimension(1-Ng:N+Ng,3) :: dF,S 63 | 64 | !------------------------------------------------! 65 | 66 | ! Open output report file 67 | open(unit = outfile, file = 'ATES.out') 68 | 69 | !------------------------------------------------! 70 | 71 | ! Read planetary parameters from file 72 | call input_read 73 | 74 | !------------------------------------------------! 75 | 76 | ! Initialize simulations 77 | call init(W,u,f_sp) 78 | 79 | !------------------------------------------------! 80 | 81 | ! Generate report of the current setup 82 | call write_setup_report 83 | 84 | !---------------------------------------------------! 85 | 86 | ! Close outfile 87 | close(unit = outfile) 88 | 89 | !------------------------------------------------! 90 | 91 | !---- Start computation ----! 92 | 93 | ! Get starting time 94 | write(*,*) '(ATES_main.f90) Starting time integration..' 95 | start = omp_get_wtime() 96 | 97 | !------ Main temporal loop ------! 98 | do while( .not.is_mom_const .or. force_start) 99 | 100 | !---- Time step evaluation ----! 101 | call eval_dt(W,dt) 102 | 103 | !-------------------------------------------------! 104 | 105 | !--- Thermodynamic evolution ---! 106 | 107 | ! Save previous step solution 108 | u_old = u 109 | 110 | ! FIRST RK STEP 111 | 112 | ! Reconstruct u+_{j+1/2}, u-_{j+1/2} 113 | call Reconstruct(u,WL,WR) 114 | 115 | ! Evaluate flux difference and source terms 116 | call RK_rhs(u,WL,WR,alpha,dF,S) 117 | 118 | u1 = u - dt*(dF - S) 119 | 120 | ! Apply boundary conditions 121 | call Apply_BC(u1,u1) 122 | 123 | !---------------------------- 124 | 125 | ! SECOND RK STEP 126 | 127 | ! Reconstruct u+_{j+1/2}, u-_{j+1/2} 128 | call Reconstruct(u1,WL,WR) 129 | 130 | ! Evaluate flux difference and source terms 131 | call RK_rhs(u1,WL,WR,alpha,dF,S) 132 | 133 | ! Advance in time 134 | u2 = (3.0*u + u1 - dt*(dF - S))/4.0 135 | 136 | ! Apply boundary conditions 137 | call Apply_BC(u2,u2) 138 | 139 | !---------------------------- 140 | 141 | ! THIRD RK STEP 142 | 143 | ! Reconstruct u+_{j+1/2}, u-_{j+1/2} 144 | call Reconstruct(u2,WL,WR) 145 | 146 | ! Evaluate flux difference and source terms 147 | call RK_rhs(u2,WL,WR,alpha,dF,S) 148 | 149 | ! Advance in time 150 | u = (u + 2.0*(u2 - dt*(dF - S)))/3.0 151 | 152 | ! Apply boundary conditions 153 | call Apply_BC(u,u) 154 | 155 | !------------------------------------------------! 156 | 157 | !---- Ionization Equilibrium ----! 158 | 159 | ! Extract primitive variables 160 | call U_to_W(u,W) 161 | rho = W(:,1) 162 | v = W(:,2) 163 | p = W(:,3) 164 | 165 | ! Evaluate species densities 166 | nhi = rho*f_sp(:,1) 167 | nhii = rho*f_sp(:,2) 168 | if (thereis_He) then 169 | nhei = rho*f_sp(:,3) 170 | nheii = rho*f_sp(:,4) 171 | nheiii = rho*f_sp(:,5) 172 | if (thereis_HeITR) nheiTR = rho*f_sp(:,6) 173 | endif 174 | call calc_ne(nhii,nheii,nheiii,ne) 175 | 176 | ! Total number density 177 | call calc_ntot(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_tot) 178 | 179 | ! Temperature profile 180 | T = p/(n_tot + ne) 181 | 182 | ! Evaluate ionization equilibrium 183 | call ioniz_eq(T,rho,f_sp,rho,f_sp,heat,cool,eta) 184 | 185 | !Evaluate partial densities 186 | nhi = rho*f_sp(:,1) 187 | nhii = rho*f_sp(:,2) 188 | if (thereis_He) then 189 | nhei = rho*f_sp(:,3) 190 | nheii = rho*f_sp(:,4) 191 | nheiii = rho*f_sp(:,5) 192 | if (thereis_HeITR) nheiTR = rho*f_sp(:,6) 193 | endif 194 | call calc_ne(nhii,nheii,nheiii,ne) 195 | 196 | ! Total number density 197 | call calc_ntot(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_tot) 198 | 199 | ! Evaluate updated pressure 200 | p = (n_tot + ne)*T 201 | 202 | ! Convert to primitive profiles 203 | W(:,1) = rho 204 | W(:,2) = v 205 | W(:,3) = p 206 | 207 | ! Revert to conservative 208 | call W_to_U(W,u) 209 | 210 | !------------------------------------------------! 211 | 212 | ! Evolve solution in time due to source terms 213 | ! using a forward Euler step 214 | 215 | u(:,3) = u(:,3) + dt*(heat - cool) 216 | 217 | call Apply_BC(u,u) 218 | 219 | !------------------------------------------------! 220 | 221 | ! Convert to physical variables and extract profiles 222 | call U_to_W(u,W) 223 | rho = W(:,1) 224 | v = W(:,2) 225 | p = W(:,3) 226 | E = u(:,3) 227 | 228 | ! Evaluate ionized densities and electron density 229 | nhi = rho*f_sp(:,1) 230 | nhii = rho*f_sp(:,2) 231 | if (thereis_He) then 232 | nhei = rho*f_sp(:,3) 233 | nheii = rho*f_sp(:,4) 234 | nheiii = rho*f_sp(:,5) 235 | if (thereis_HeITR) nheiTR = rho*f_sp(:,6) 236 | endif 237 | call calc_ne(nhii,nheii,nheiii,ne) 238 | 239 | ! Total number density 240 | call calc_ntot(nhi,nhii,nhei,nheii,nheiii,nheiTR,n_tot) 241 | 242 | ! Temperature profile 243 | T = p/(n_tot + ne) 244 | 245 | ! Evaluate momentum 246 | mom = rho*v*r*r 247 | 248 | !---------------------------------------------------! 249 | 250 | !--- Loop counters and escape condition ---! 251 | 252 | ! Update counter 253 | count = count + 1 254 | 255 | ! Maximum and minimum value for momentum 256 | mom_max = maxval(abs(mom(j_min:N))) 257 | mom_min = minval(abs(mom(j_min:N))) 258 | 259 | ! Evaluate relative momentum variation 260 | du = abs((mom_max-mom_min)/mom_min) 261 | 262 | ! Evaluate variation of time derivative 263 | u(:,2) = u(:,2) + 1.0e-16 ! To avoid division by zero 264 | 265 | ! --- Infty-norm 266 | dtu = max(maxval(abs(1.0-u(j_min:N,1)/u_old(j_min:N,1))), & 267 | maxval(abs(1.0-u(j_min:N,2)/u_old(j_min:N,2)))) 268 | dtu = max(maxval(abs(1.0-u(j_min:N,3)/u_old(j_min:N,3))), & 269 | dtu) 270 | 271 | ! Adjust logical for loop if necessary 272 | is_mom_const = du .lt. du_th 273 | is_zero_dt = dtu .lt. dtu_th 274 | 275 | ! Write to standard output 276 | write(*,*) count,du !,dtu 277 | 278 | !---------------------------------------------------! 279 | 280 | ! Detect NaNs 281 | do j = 1-Ng,N+Ng 282 | do k = 1,3 283 | dum = u(j,k) 284 | if (dum.ne.dum) then 285 | write(*,*) 286 | write(*,'(A20,F8.6)') 'NaN detected at r = ',r(j) 287 | write(*,'(A6,E13.6)') 'rho = ',W(j,1)*n0 288 | write(*,'(A4,E13.6)') 'v = ',W(j,2)*v0/1.0e5 289 | write(*,'(A4,E13.6)') 'p = ',W(j,3)*p0 290 | write(*,'(A4,F8.1)') 'T = ',T(j)*T0 291 | write(*,'(A6,E13.6)') 'nhi = ',nhi(j)*n0 292 | write(*,'(A7,E13.6)') 'nhii = ',nhii(j)*n0 293 | write(*,'(A7,E13.6)') 'nhei = ',nhei(j)*n0 294 | write(*,'(A8,E13.6)') 'nheii = ',nheii(j)*n0 295 | write(*,'(A9,E13.6)') 'nheiii = ',nheiii(j)*n0 296 | write(*,'(A9,E13.6)') 'nheiTR = ',nheiTR(j)*n0 297 | l_isnan = .true. 298 | endif 299 | enddo 300 | enddo 301 | if(l_isnan) exit 302 | 303 | !---------------------------------------------------! 304 | 305 | !--- Write to files every 1000th iteration---! 306 | if (mod(count,1000).eq.1) then 307 | 308 | ! Write thermodynamic and ionization profiles 309 | call write_output(rho,v,p,T,heat,cool,eta, & 310 | nhi,nhii,nhei,nheii,nheiii, & 311 | nheiTR,'eq') 312 | 313 | endif 314 | 315 | ! Exit from temporal loop if only post processing has to be done 316 | if (do_only_pp) exit 317 | 318 | ! Force continue for the first 1000 loops if force_start is enabled 319 | if (force_start) force_start = count .le. 1000 320 | 321 | !---------------------------------------------------! 322 | 323 | ! End of temporal while loop 324 | enddo 325 | write(*,*) '(ATES_main.f90) Time integration done.' 326 | 327 | !---------------------------------------------------! 328 | 329 | ! Write final thermodynamic and ionization profiles 330 | write(*,*) '(ATES_main.f90) Writing final results to file..' 331 | call write_output(rho,v,p,T,heat,cool,eta, & 332 | nhi,nhii,nhei,nheii,nheiii,nheiTR,'eq') 333 | 334 | !---------------------------------------------------! 335 | 336 | ! Post processing to include advection 337 | write(*,*) '(ATES_main.f90) Starting the post processing routine..' 338 | 339 | call post_process_adv(rho,v,p,T,heat,cool,eta, & 340 | nhi,nhii,nhei,nheii,nheiii,nheiTR) 341 | 342 | write(*,*) '(ATES_main.f90) Post processing routine done.' 343 | 344 | !---------------------------------------------------! 345 | 346 | ! Get CPU time 347 | finish = omp_get_wtime() 348 | 349 | ! Write final execution time 350 | exec_time = finish - start 351 | n_hrs = floor(exec_time/3600.0) 352 | n_min = floor((exec_time - 3600.0*n_hrs)/60.0) 353 | n_sec = exec_time - 3600.0*n_hrs - 60.0*n_min 354 | 355 | write(*,*) ' ' 356 | write(*,100) 'Execution Time = ', n_hrs,' h ', & 357 | n_min,' m ', & 358 | n_sec,' s' 359 | 100 format (A17,I2,A3,I2,A3,F8.5,A2) 360 | 361 | !---------------------------------------------------! 362 | 363 | ! Choose index to evaluate Mdot far enough from the top boundary 364 | j = N - 20 365 | 366 | ! Evaluate steady state log of Mdot 367 | Mdot = log10(4.0*pi*rho(j)*v(j)*r(j)*r(j)*n0*v0*mu*R0*R0) 368 | 369 | ! Correct for the 2D approximation used 370 | if (appx_mth.eq.'Rate/2 + Mdot/2') Mdot = Mdot - log10(2.0) 371 | if (appx_mth.eq.'Mdot/4') Mdot = Mdot - log10(4.0) 372 | 373 | 374 | ! Write Mdot in output 375 | write(*,*) ' ' 376 | write(*,*) '----- Results -----' 377 | write(*,*) ' ' 378 | write(*,*) '---> 2D approximate method: ', appx_mth 379 | write(*,101) ' ---> Log10 of steady-state Mdot = ', Mdot, ' g/s' 380 | 381 | ! Write Mdot to report file 382 | open(unit = outfile, file = 'ATES.out', access = 'append' ) 383 | write(outfile,101) ' ' 384 | write(outfile,102) ' - Log10 of steady-state Mdot = ', Mdot, ' g/s' 385 | close(unit = outfile) 386 | 387 | 101 format (A35,F5.2,A4) 388 | 102 format (A32,F5.2,A4) 389 | 390 | !---------------------------------------------------! 391 | 392 | ! End of program 393 | end program Hydro_ioniz 394 | --------------------------------------------------------------------------------