Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2013 Pablo Marchant & 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 binary_def
21 :
22 : use star_lib
23 : use star_def
24 : use const_def, only: dp, strlen
25 : use binary_pgbinary
26 :
27 : implicit none
28 :
29 : real(dp) :: initial_binary_period ! (seconds)
30 : real(dp) :: min_binary_period ! (seconds)
31 :
32 : real(dp) :: initial_mass(2) ! (msun)
33 :
34 : integer, parameter :: maxlen_binary_history_column_name = 80
35 : integer, parameter :: binary_num_xtra_vals = 30
36 : integer, parameter :: binary_num_x_ctrls = 100
37 :
38 : ! time_step limit identifiers
39 : integer, parameter :: b_Tlim_comp = 1
40 : integer, parameter :: b_Tlim_roche = b_Tlim_comp + 1
41 : integer, parameter :: b_Tlim_jorb = b_Tlim_roche + 1
42 : integer, parameter :: b_Tlim_env = b_Tlim_jorb + 1
43 : integer, parameter :: b_Tlim_sep = b_Tlim_env + 1
44 : integer, parameter :: b_Tlim_ecc = b_Tlim_sep + 1
45 : integer, parameter :: b_Tlim_dm = b_Tlim_ecc + 1
46 : integer, parameter :: b_numTlim = b_Tlim_dm
47 :
48 : character (len=24) :: binary_dt_why_str(b_numTlim) ! indicates the reason for the timestep choice
49 :
50 : !interfaces for procedure pointers
51 : abstract interface
52 :
53 : subroutine other_rlo_mdot_interface(binary_id, rlo_mdot, ierr)
54 : use const_def, only: dp
55 : implicit none
56 : integer, intent(in) :: binary_id
57 : real(dp), intent(out) :: rlo_mdot
58 : integer, intent(out) :: ierr
59 : end subroutine other_rlo_mdot_interface
60 :
61 : integer function other_check_implicit_rlo_interface(binary_id, new_mdot)
62 : use const_def, only: dp
63 : implicit none
64 : integer, intent(in) :: binary_id
65 : real(dp), intent(out) :: new_mdot
66 : end function other_check_implicit_rlo_interface
67 :
68 : subroutine other_implicit_function_to_solve_interface(binary_id, function_to_solve, use_sum, detachment, ierr)
69 : use const_def, only: dp
70 : implicit none
71 : integer, intent(in) :: binary_id
72 : real(dp), intent(out) :: function_to_solve
73 : logical, intent(out) :: use_sum, detachment
74 : integer, intent(out) :: ierr
75 : end subroutine other_implicit_function_to_solve_interface
76 :
77 : subroutine other_tsync_interface(id, sync_type, Ftid, qratio, m, r_phot, osep, t_sync, ierr)
78 : use const_def, only: dp, strlen
79 : implicit none
80 : integer, intent(in) :: id
81 : character (len=strlen), intent(in) :: sync_type
82 : real(dp), intent(in) :: Ftid
83 : real(dp), intent(in) :: qratio
84 : real(dp), intent(in) :: m
85 : real(dp), intent(in) :: r_phot
86 : real(dp), intent(in) :: osep
87 : real(dp), intent(out) :: t_sync
88 : integer, intent(out) :: ierr
89 : end subroutine other_tsync_interface
90 :
91 : subroutine other_sync_spin_to_orbit_interface(id, nz, osep, qratio, rl, dt_next, Ftid, sync_type, sync_mode, ierr)
92 : use const_def, only: dp, strlen
93 : implicit none
94 : integer, intent(in) :: id
95 : integer, intent(in) :: nz
96 : real(dp), intent(in) :: osep
97 : real(dp), intent(in) :: qratio
98 : real(dp), intent(in) :: rl
99 : real(dp), intent(in) :: dt_next
100 : real(dp), intent(in) :: Ftid
101 : character (len=strlen), intent(in) :: sync_type
102 : character (len=strlen), intent(in) :: sync_mode
103 : integer, intent(out) :: ierr
104 : end subroutine other_sync_spin_to_orbit_interface
105 :
106 : subroutine other_mdot_edd_interface(binary_id, mdot_edd, mdot_edd_eta, ierr)
107 : use const_def, only: dp
108 : implicit none
109 : integer, intent(in) :: binary_id
110 : real(dp), intent(out) :: mdot_edd
111 : real(dp), intent(out) :: mdot_edd_eta
112 : integer, intent(out) :: ierr
113 : end subroutine other_mdot_edd_interface
114 :
115 : subroutine other_adjust_mdots_interface(binary_id, ierr)
116 : implicit none
117 : integer, intent(in) :: binary_id
118 : integer, intent(out) :: ierr
119 : end subroutine other_adjust_mdots_interface
120 :
121 : subroutine other_accreted_material_j_interface(binary_id, ierr)
122 : implicit none
123 : integer, intent(in) :: binary_id
124 : integer, intent(out) :: ierr
125 : end subroutine other_accreted_material_j_interface
126 :
127 : subroutine other_jdot_interface(binary_id, ierr)
128 : implicit none
129 : integer, intent(in) :: binary_id
130 : integer, intent(out) :: ierr
131 : end subroutine other_jdot_interface
132 :
133 : subroutine other_binary_wind_transfer_interface(binary_id, s_i, ierr)
134 : implicit none
135 : integer, intent(in) :: binary_id, s_i
136 : integer, intent(out) :: ierr
137 : end subroutine other_binary_wind_transfer_interface
138 :
139 : subroutine other_edot_interface(binary_id, ierr)
140 : implicit none
141 : integer, intent(in) :: binary_id
142 : integer, intent(out) :: ierr
143 : end subroutine other_edot_interface
144 :
145 : subroutine other_CE_init_interface(binary_id, restart, ierr)
146 : implicit none
147 : integer, intent(in) :: binary_id
148 : logical, intent(in) :: restart
149 : integer, intent(out) :: ierr
150 : end subroutine other_CE_init_interface
151 :
152 : subroutine other_CE_rlo_mdot_interface(binary_id, rlo_mdot, ierr)
153 : use const_def, only: dp
154 : implicit none
155 : integer, intent(in) :: binary_id
156 : real(dp), intent(out) :: rlo_mdot
157 : integer, intent(out) :: ierr
158 : end subroutine other_CE_rlo_mdot_interface
159 :
160 : integer function other_CE_binary_evolve_step_interface(binary_id)
161 : implicit none
162 : integer, intent(in) :: binary_id
163 : end function other_CE_binary_evolve_step_interface
164 :
165 : integer function other_CE_binary_finish_step_interface(binary_id)
166 : implicit none
167 : integer, intent(in) :: binary_id
168 : end function other_CE_binary_finish_step_interface
169 :
170 : integer function extras_binary_startup_interface(binary_id,restart,ierr)
171 : implicit none
172 : integer, intent(in) :: binary_id
173 : integer, intent(out) :: ierr
174 : logical,intent(in) :: restart
175 : end function extras_binary_startup_interface
176 :
177 : integer function extras_binary_start_step_interface(binary_id, ierr)
178 : implicit none
179 : integer, intent(in) :: binary_id
180 : integer, intent(out) :: ierr
181 : end function extras_binary_start_step_interface
182 :
183 : integer function extras_binary_check_model_interface(binary_id)
184 : implicit none
185 : integer, intent(in) :: binary_id
186 : end function extras_binary_check_model_interface
187 :
188 : integer function extras_binary_finish_step_interface(binary_id)
189 : implicit none
190 : integer, intent(in) :: binary_id
191 : end function extras_binary_finish_step_interface
192 :
193 : subroutine extras_binary_after_evolve_interface(binary_id, ierr)
194 : implicit none
195 : integer, intent(in) :: binary_id
196 : integer, intent(out) :: ierr
197 : end subroutine extras_binary_after_evolve_interface
198 :
199 : subroutine other_binary_photo_write_interface(binary_id, iounit)
200 : implicit none
201 : integer, intent(in) :: binary_id, iounit
202 : end subroutine other_binary_photo_write_interface
203 :
204 : subroutine other_binary_photo_read_interface(binary_id, iounit, ierr)
205 : implicit none
206 : integer, intent(in) :: binary_id, iounit
207 : integer, intent(out) :: ierr
208 : end subroutine other_binary_photo_read_interface
209 :
210 : subroutine other_e2_interface(id, e2, ierr)
211 : use const_def, only: dp
212 : implicit none
213 : integer, intent(in) :: id
214 : real(dp),intent (out) :: e2
215 : integer, intent(out) :: ierr
216 : end subroutine other_e2_interface
217 :
218 : subroutine other_pgbinary_plots_info_interface(id, ierr)
219 : implicit none
220 : integer, intent(in) :: id
221 : integer, intent(out) :: ierr
222 : end subroutine other_pgbinary_plots_info_interface
223 :
224 : end interface
225 :
226 : type binary_job_controls
227 : include "binary_job_controls.inc"
228 : end type binary_job_controls
229 :
230 : type binary_info
231 : !binary id
232 : integer :: binary_id ! unique identifier for each binary_info instance
233 : logical :: in_use
234 :
235 : integer :: extra_binary_terminal_iounit
236 :
237 : type (binary_job_controls) :: job
238 : include 'binary_data.inc'
239 : include 'binary_controls.inc'
240 :
241 : type (pgbinary_controls) :: pg
242 : end type binary_info
243 :
244 : logical :: have_initialized_binary_handles = .false.
245 : integer, parameter :: max_binary_handles = 10 ! this can be increased as necessary
246 : type (binary_info), target, save :: binary_handles(max_binary_handles)
247 : ! gfortran seems to require "save" here. at least it did once upon a time.
248 :
249 :
250 : contains
251 :
252 2 : subroutine binary_ptr(binary_id, b, ierr)
253 : integer, intent(in) :: binary_id
254 : type (binary_info), pointer, intent(inout) :: b
255 : integer, intent(out) :: ierr
256 1 : call get_binary_ptr(binary_id, b, ierr)
257 1 : end subroutine binary_ptr
258 :
259 :
260 1 : subroutine get_binary_ptr(binary_id, b, ierr)
261 : integer, intent(in) :: binary_id
262 : type (binary_info), pointer :: b
263 : integer, intent(out) :: ierr
264 1 : if (binary_id < 1 .or. binary_id > max_binary_handles) then
265 0 : ierr = -1
266 0 : return
267 : end if
268 1 : b => binary_handles(binary_id)
269 1 : ierr = 0
270 : end subroutine get_binary_ptr
271 :
272 :
273 0 : logical function is_donor(b, s)
274 : type (binary_info), pointer :: b
275 : type (star_info), pointer :: s
276 0 : is_donor = (s% id == b% d_i)
277 0 : end function is_donor
278 :
279 0 : subroutine init_binary_data
280 :
281 0 : end subroutine init_binary_data
282 :
283 0 : end module binary_def
|
