Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2019 The MESA Team
4 : !
5 : ! This program is free software: you can redistribute it and/or modify
6 : ! it under the terms of the GNU Lesser General Public License
7 : ! as published by the Free Software Foundation,
8 : ! either version 3 of the License, or (at your option) any later version.
9 : !
10 : ! This program is distributed in the hope that it will be useful,
11 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
12 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 : ! See the GNU Lesser General Public License for more details.
14 : !
15 : ! You should have received a copy of the GNU Lesser General Public License
16 : ! along with this program. If not, see <https://www.gnu.org/licenses/>.
17 : !
18 : ! ***********************************************************************
19 :
20 : module star_data_def
21 :
22 : use rates_def, only: rates_reaction_id_max, other_screening_interface, other_rate_get_interface
23 : use utils_def, only: integer_dict
24 : use chem_def, only: num_categories, iso_name_length
25 : use const_def, only: sp, dp, qp, i8, strlen, max_extra_inlists
26 : use rates_def, only: maxlen_reaction_Name
27 : use eos_def, only: EoS_General_Info
28 : use kap_def, only: Kap_General_Info
29 : use net_def, only: Net_General_Info, other_net_derivs_interface
30 : use colors_def, only: max_num_color_files, max_num_bcs_per_file
31 : use auto_diff, only: auto_diff_real_star_order1
32 : use star_pgstar, only: pgstar_controls
33 :
34 : implicit none
35 :
36 : include "star_data_def.inc"
37 : include "star_job_controls_params.inc"
38 : type star_job_controls
39 : include "star_job_controls.inc"
40 : include "star_job_controls_dev.inc"
41 : real(dp) :: &
42 : step_loop_timing, after_step_timing, before_step_timing, &
43 : check_time_start, check_time_end, elapsed_time, &
44 : check_step_loop_timing, check_after_step_timing, check_before_step_timing
45 : integer(i8) :: time0, time1, clock_rate, time0_extra, time1_extra, time0_initial
46 : end type star_job_controls
47 :
48 : type star_info
49 :
50 : include "star_data.inc"
51 :
52 : ! handles
53 : integer :: eos_handle
54 : integer :: kap_handle
55 : integer :: net_handle
56 :
57 : ! star id
58 : integer :: id ! unique identifier for each star_info instance
59 :
60 : ! Name of the main inlist used
61 : character(len=strlen) :: inlist_fname
62 :
63 : ! private
64 : logical :: in_use
65 : logical :: do_burn, do_mix
66 : logical :: used_extra_iter_in_solver_for_accretion
67 : integer :: retry_cnt, redo_cnt
68 : type(EoS_General_Info), pointer :: eos_rq ! from call eos_ptr(s% eos_handle,s% eos_rq,ierr)
69 : type(Kap_General_Info), pointer :: kap_rq ! from call kap_ptr(s% kap_handle,s% kap_rq,ierr)
70 : type(Net_General_Info), pointer :: net_rq ! from call net_ptr(s% net_handle,s% net_rq, ierr)
71 :
72 : ! parameters for create pre ms -- set in run_star before calling star_create_pre_ms_model
73 : real(dp) :: pre_ms_T_c, pre_ms_guess_rho_c, &
74 : pre_ms_d_log10_P, pre_ms_logT_surf_limit, pre_ms_logP_surf_limit
75 : integer :: pre_ms_initial_zfracs, pre_ms_relax_num_steps
76 : logical :: pre_ms_change_net, pre_ms_dump_missing_heaviest
77 : character(len=net_name_len) :: pre_ms_new_net_name
78 :
79 : ! parameters for create initial model
80 : real(dp) :: &
81 : radius_in_cm_for_create_initial_model, &
82 : mass_in_gm_for_create_initial_model, &
83 : center_logP_1st_try_for_create_initial_model, &
84 : entropy_1st_try_for_create_initial_model, &
85 : abs_e01_tolerance_for_create_initial_model, &
86 : abs_e02_tolerance_for_create_initial_model
87 : integer :: initial_zfracs_for_create_initial_model, &
88 : max_tries_for_create_initial_model
89 : integer :: initial_model_relax_num_steps
90 : real(dp) :: initial_model_eps
91 : logical :: initial_model_change_net, initial_dump_missing_heaviest
92 : character(len=net_name_len) :: initial_model_new_net_name
93 :
94 : ! extra profile entries for developer debugging
95 : real(dp), dimension(:, :), pointer :: profile_extra ! (nz,max_num_profile_extras)
96 : character(len=64) :: profile_extra_name(max_num_profile_extras)
97 :
98 : ! controls
99 : type(star_job_controls) :: job ! separate type to avoid name clashes
100 : include "star_controls.inc"
101 : include "star_controls_dev.inc"
102 :
103 : type(pgstar_controls) :: pg
104 :
105 : end type star_info
106 :
107 : logical :: have_initialized_star_handles = .false.
108 : integer, parameter :: max_star_handles = 10 ! this can be increased as necessary
109 : type(star_info), target, save :: star_handles(max_star_handles)
110 : ! gfortran seems to require "save" here. at least it did once upon a time.
111 :
112 : contains
113 :
114 404 : subroutine star_ptr(id, s, ierr)
115 : integer, intent(in) :: id
116 : type(star_info), pointer, intent(inout) :: s
117 : integer, intent(out) :: ierr
118 202 : call get_star_ptr(id, s, ierr)
119 202 : end subroutine star_ptr
120 :
121 280 : subroutine get_star_ptr(id, s, ierr)
122 : integer, intent(in) :: id
123 : type(star_info), pointer :: s
124 : integer, intent(out) :: ierr
125 280 : if (id < 1 .or. id > max_star_handles) then
126 0 : ierr = -1
127 0 : return
128 : end if
129 280 : s => star_handles(id)
130 280 : ierr = 0
131 : end subroutine get_star_ptr
132 :
133 2 : subroutine result_reason_init
134 2 : result_reason_str(result_reason_normal) = 'normal'
135 2 : result_reason_str(dt_is_zero) = 'dt_is_zero'
136 2 : result_reason_str(nonzero_ierr) = 'nonzero_ierr'
137 2 : result_reason_str(hydro_failed_to_converge) = 'hydro_failed'
138 2 : result_reason_str(do_burn_failed) = 'do_burn_failed'
139 2 : result_reason_str(diffusion_failed) = 'element_diffusion_failed'
140 2 : result_reason_str(too_many_steps_for_burn) = 'too_many_steps_for_burn'
141 2 : result_reason_str(too_many_steps_for_diffusion) = 'too_many_steps_for_diffusion'
142 2 : result_reason_str(too_many_steps_for_hydro) = 'too_many_steps_for_hydro'
143 2 : result_reason_str(adjust_mesh_failed) = 'adjust_mesh_failed'
144 2 : result_reason_str(adjust_mass_failed) = 'adjust_mass_failed'
145 2 : result_reason_str(core_dump_model_number) = 'core_dump_model_number'
146 2 : result_reason_str(timestep_limits) = 'cannot find acceptable model'
147 2 : result_reason_str(variable_change_limits) = 'variable_change_limits'
148 2 : result_reason_str(explicit_hydro_failed) = 'explicit_hydro_failed'
149 2 : result_reason_str(abs_rel_run_E_err) = 'abs_rel_run_E_err'
150 2 : result_reason_str(forced_stop) = 'forced_stop'
151 2 : end subroutine result_reason_init
152 :
153 1 : subroutine do_star_def_init(mesa_dir_init, ierr)
154 : character(len=*), intent(in) :: mesa_dir_init
155 : integer, intent(out) :: ierr
156 1 : ierr = 0
157 1 : call result_reason_init
158 1 : end subroutine do_star_def_init
159 :
160 0 : end module star_data_def
|