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_tidal_deformation_switch_function_interface(id, k, omega_in, f_switch, ierr)
146 : use const_def, only: dp
147 : implicit none
148 : integer, intent(in) :: id, k
149 : real(dp), intent(in) :: omega_in
150 : real(dp), intent(out) :: f_switch
151 : integer, intent(out) :: ierr
152 : end subroutine other_tidal_deformation_switch_function_interface
153 :
154 : subroutine other_CE_init_interface(binary_id, restart, ierr)
155 : implicit none
156 : integer, intent(in) :: binary_id
157 : logical, intent(in) :: restart
158 : integer, intent(out) :: ierr
159 : end subroutine other_CE_init_interface
160 :
161 : subroutine other_CE_rlo_mdot_interface(binary_id, rlo_mdot, ierr)
162 : use const_def, only: dp
163 : implicit none
164 : integer, intent(in) :: binary_id
165 : real(dp), intent(out) :: rlo_mdot
166 : integer, intent(out) :: ierr
167 : end subroutine other_CE_rlo_mdot_interface
168 :
169 : integer function other_CE_binary_evolve_step_interface(binary_id)
170 : implicit none
171 : integer, intent(in) :: binary_id
172 : end function other_CE_binary_evolve_step_interface
173 :
174 : integer function other_CE_binary_finish_step_interface(binary_id)
175 : implicit none
176 : integer, intent(in) :: binary_id
177 : end function other_CE_binary_finish_step_interface
178 :
179 : integer function extras_binary_startup_interface(binary_id,restart,ierr)
180 : implicit none
181 : integer, intent(in) :: binary_id
182 : integer, intent(out) :: ierr
183 : logical,intent(in) :: restart
184 : end function extras_binary_startup_interface
185 :
186 : integer function extras_binary_start_step_interface(binary_id, ierr)
187 : implicit none
188 : integer, intent(in) :: binary_id
189 : integer, intent(out) :: ierr
190 : end function extras_binary_start_step_interface
191 :
192 : integer function extras_binary_check_model_interface(binary_id)
193 : implicit none
194 : integer, intent(in) :: binary_id
195 : end function extras_binary_check_model_interface
196 :
197 : integer function extras_binary_finish_step_interface(binary_id)
198 : implicit none
199 : integer, intent(in) :: binary_id
200 : end function extras_binary_finish_step_interface
201 :
202 : subroutine extras_binary_after_evolve_interface(binary_id, ierr)
203 : implicit none
204 : integer, intent(in) :: binary_id
205 : integer, intent(out) :: ierr
206 : end subroutine extras_binary_after_evolve_interface
207 :
208 : subroutine other_binary_photo_write_interface(binary_id, iounit)
209 : implicit none
210 : integer, intent(in) :: binary_id, iounit
211 : end subroutine other_binary_photo_write_interface
212 :
213 : subroutine other_binary_photo_read_interface(binary_id, iounit, ierr)
214 : implicit none
215 : integer, intent(in) :: binary_id, iounit
216 : integer, intent(out) :: ierr
217 : end subroutine other_binary_photo_read_interface
218 :
219 : subroutine other_e2_interface(id, e2, ierr)
220 : use const_def, only: dp
221 : implicit none
222 : integer, intent(in) :: id
223 : real(dp),intent (out) :: e2
224 : integer, intent(out) :: ierr
225 : end subroutine other_e2_interface
226 :
227 : subroutine other_pgbinary_plots_info_interface(id, ierr)
228 : implicit none
229 : integer, intent(in) :: id
230 : integer, intent(out) :: ierr
231 : end subroutine other_pgbinary_plots_info_interface
232 :
233 : end interface
234 :
235 : type binary_job_controls
236 : include "binary_job_controls.inc"
237 : end type binary_job_controls
238 :
239 : type binary_info
240 : !binary id
241 : integer :: binary_id ! unique identifier for each binary_info instance
242 : logical :: in_use
243 :
244 : integer :: extra_binary_terminal_iounit
245 :
246 : type (binary_job_controls) :: job
247 : include 'binary_data.inc'
248 : include 'binary_controls.inc'
249 :
250 : type (pgbinary_controls) :: pg
251 : end type binary_info
252 :
253 : logical :: have_initialized_binary_handles = .false.
254 : integer, parameter :: max_binary_handles = 10 ! this can be increased as necessary
255 : type (binary_info), target, save :: binary_handles(max_binary_handles)
256 : ! gfortran seems to require "save" here. at least it did once upon a time.
257 :
258 :
259 : contains
260 :
261 2 : subroutine binary_ptr(binary_id, b, ierr)
262 : integer, intent(in) :: binary_id
263 : type (binary_info), pointer, intent(inout) :: b
264 : integer, intent(out) :: ierr
265 1 : call get_binary_ptr(binary_id, b, ierr)
266 1 : end subroutine binary_ptr
267 :
268 :
269 1 : subroutine get_binary_ptr(binary_id, b, ierr)
270 : integer, intent(in) :: binary_id
271 : type (binary_info), pointer :: b
272 : integer, intent(out) :: ierr
273 1 : if (binary_id < 1 .or. binary_id > max_binary_handles) then
274 0 : ierr = -1
275 0 : return
276 : end if
277 1 : b => binary_handles(binary_id)
278 1 : ierr = 0
279 : end subroutine get_binary_ptr
280 :
281 :
282 0 : logical function is_donor(b, s)
283 : type (binary_info), pointer :: b
284 : type (star_info), pointer :: s
285 0 : is_donor = (s% id == b% d_i)
286 0 : end function is_donor
287 :
288 0 : subroutine init_binary_data
289 :
290 0 : end subroutine init_binary_data
291 :
292 0 : end module binary_def
|
