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_lib
21 :
22 : use const_def, only: dp
23 :
24 : implicit none
25 :
26 : contains
27 :
28 3 : subroutine run1_binary(tst, &
29 : ! star extras
30 : extras_controls, &
31 : ! binary extras
32 : extras_binary_controls, &
33 : ierr, &
34 : inlist_fname_arg)
35 :
36 : use run_binary_support, only: do_run1_binary
37 : use binary_def, only: init_binary_data
38 : use star_def, only: star_info
39 :
40 : logical, intent(in) :: tst
41 :
42 : interface
43 :
44 : subroutine extras_controls(id, ierr)
45 : implicit none
46 : integer, intent(in) :: id
47 : integer, intent(out) :: ierr
48 : end subroutine extras_controls
49 :
50 : subroutine extras_binary_controls(binary_id, ierr)
51 : implicit none
52 : integer :: binary_id
53 : integer, intent(out) :: ierr
54 : end subroutine extras_binary_controls
55 :
56 : end interface
57 :
58 : integer, intent(out) :: ierr
59 : character (len=*) :: inlist_fname_arg
60 : optional inlist_fname_arg
61 :
62 0 : call init_binary_data
63 :
64 : call do_run1_binary(tst, &
65 : ! star extras
66 : extras_controls, &
67 : ! binary extras
68 : extras_binary_controls, &
69 : ierr, &
70 0 : inlist_fname_arg)
71 :
72 0 : end subroutine run1_binary
73 :
74 0 : subroutine binary_set_ignore_rlof_flag(binary_id, ignore_rlof_flag, ierr)
75 0 : use binary_utils, only:set_ignore_rlof_flag
76 : integer, intent(in) :: binary_id
77 : logical, intent(in) :: ignore_rlof_flag
78 : integer, intent(out) :: ierr
79 :
80 : ierr = 0
81 0 : call set_ignore_rlof_flag(binary_id, ignore_rlof_flag, ierr)
82 0 : end subroutine binary_set_ignore_rlof_flag
83 :
84 0 : subroutine binary_set_point_mass_i(binary_id, point_mass_i, ierr)
85 0 : use binary_utils, only:set_point_mass_i
86 : integer, intent(in) :: binary_id
87 : integer, intent(in) :: point_mass_i
88 : integer, intent(out) :: ierr
89 :
90 : ierr = 0
91 0 : call set_point_mass_i(binary_id, point_mass_i, ierr)
92 0 : end subroutine binary_set_point_mass_i
93 :
94 0 : subroutine binary_set_m1(binary_id, m1, ierr)
95 0 : use binary_utils, only:set_m1
96 : integer, intent(in) :: binary_id
97 : real(dp), intent(in) :: m1
98 : integer, intent(out) :: ierr
99 :
100 : ierr = 0
101 0 : call set_m1(binary_id, m1, ierr)
102 0 : end subroutine binary_set_m1
103 :
104 0 : subroutine binary_set_m2(binary_id, m2, ierr)
105 0 : use binary_utils, only:set_m2
106 : integer, intent(in) :: binary_id
107 : real(dp), intent(in) :: m2
108 : integer, intent(out) :: ierr
109 :
110 : ierr = 0
111 0 : call set_m2(binary_id, m2, ierr)
112 0 : end subroutine binary_set_m2
113 :
114 0 : subroutine binary_set_period_eccentricity(binary_id, period, eccentricity, ierr)
115 0 : use binary_utils, only:set_period_eccentricity
116 : integer, intent(in) :: binary_id
117 : real(dp), intent(in) :: period ! in seconds
118 : real(dp), intent(in) :: eccentricity
119 : integer, intent(out) :: ierr
120 0 : call set_period_eccentricity(binary_id, period, eccentricity, ierr)
121 0 : end subroutine binary_set_period_eccentricity
122 :
123 0 : subroutine binary_set_separation_eccentricity(binary_id, separation, eccentricity, ierr)
124 0 : use binary_utils, only:set_separation_eccentricity
125 : integer, intent(in) :: binary_id
126 : real(dp), intent(in) :: separation ! in cm
127 : real(dp), intent(in) :: eccentricity
128 : integer, intent(out) :: ierr
129 0 : call set_separation_eccentricity(binary_id, separation, eccentricity, ierr)
130 :
131 0 : end subroutine binary_set_separation_eccentricity
132 :
133 0 : real(dp) function binary_eval_rlobe(m1, m2, a)
134 0 : use binary_utils, only:eval_rlobe
135 : real(dp), intent(in) :: m1, m2, a
136 : ! Roche lobe size for star of mass m1 with a
137 : ! companion of mass m2 at separation a, according to
138 : ! the approximation of Eggleton 1983, apj 268:368-369
139 0 : binary_eval_rlobe = eval_rlobe(m1, m2, a)
140 0 : end function binary_eval_rlobe
141 :
142 0 : subroutine binary_eval_mdot_edd(binary_id, mdot_edd, mdot_edd_eta, ierr)
143 0 : use binary_mdot, only:eval_mdot_edd
144 : integer, intent(in) :: binary_id
145 : integer, intent(out) :: ierr
146 : real(dp), intent(out) :: mdot_edd, mdot_edd_eta
147 0 : call eval_mdot_edd(binary_id, mdot_edd, mdot_edd_eta, ierr)
148 0 : end subroutine binary_eval_mdot_edd
149 :
150 0 : subroutine binary_eval_accreted_material_j(binary_id, ierr)
151 0 : use binary_mdot, only:eval_accreted_material_j
152 : integer, intent(in) :: binary_id
153 : integer, intent(out) :: ierr
154 0 : call eval_accreted_material_j(binary_id, ierr)
155 0 : end subroutine binary_eval_accreted_material_j
156 :
157 0 : subroutine binary_eval_wind_xfer_fractions(binary_id, ierr)
158 0 : use binary_wind, only:eval_wind_xfer_fractions
159 : integer, intent(in) :: binary_id
160 : integer, intent(out) :: ierr
161 0 : call eval_wind_xfer_fractions(binary_id, ierr)
162 0 : end subroutine binary_eval_wind_xfer_fractions
163 :
164 :
165 0 : subroutine binary_get_control_namelist(binary_id, name, val, ierr)
166 0 : use binary_ctrls_io, only: get_binary_control
167 : use binary_def, only: binary_info, binary_ptr
168 : integer, intent(in) :: binary_id
169 : character(len=*),intent(in) :: name
170 : character(len=*),intent(out) :: val
171 : integer, intent(out) :: ierr
172 : type (binary_info), pointer :: b
173 :
174 : ierr = 0
175 0 : call binary_ptr(binary_id, b, ierr)
176 0 : if(ierr/=0) return
177 0 : call get_binary_control(b, name, val, ierr)
178 :
179 0 : end subroutine binary_get_control_namelist
180 :
181 0 : subroutine binary_set_control_namelist(binary_id, name, val, ierr)
182 0 : use binary_ctrls_io, only: set_binary_control
183 : use binary_def, only: binary_info, binary_ptr
184 : integer, intent(in) :: binary_id
185 : character(len=*),intent(in) :: name
186 : character(len=*),intent(in) :: val
187 : integer, intent(out) :: ierr
188 : type (binary_info), pointer :: b
189 :
190 : ierr = 0
191 0 : call binary_ptr(binary_id, b, ierr)
192 0 : if(ierr/=0) return
193 0 : call set_binary_control(b, name, val, ierr)
194 :
195 0 : end subroutine binary_set_control_namelist
196 :
197 :
198 0 : subroutine binary_get_star_job_namelist(binary_id, name, val, ierr)
199 0 : use binary_job_ctrls_io, only: get_binary_job
200 : use binary_def, only: binary_info, binary_ptr
201 : integer, intent(in) :: binary_id
202 : character(len=*),intent(in) :: name
203 : character(len=*),intent(out) :: val
204 : integer, intent(out) :: ierr
205 : type (binary_info), pointer :: b
206 :
207 : ierr = 0
208 0 : call binary_ptr(binary_id, b, ierr)
209 0 : if(ierr/=0) return
210 0 : call get_binary_job(b, name, val, ierr)
211 :
212 0 : end subroutine binary_get_star_job_namelist
213 :
214 0 : subroutine binary_set_star_job_namelist(binary_id, name, val, ierr)
215 0 : use binary_job_ctrls_io, only: set_binary_job
216 : use binary_def, only: binary_info, binary_ptr
217 : integer, intent(in) :: binary_id
218 : character(len=*),intent(in) :: name
219 : character(len=*),intent(in) :: val
220 : integer, intent(out) :: ierr
221 : type (binary_info), pointer :: b
222 :
223 : ierr = 0
224 0 : call binary_ptr(binary_id, b, ierr)
225 0 : if(ierr/=0) return
226 0 : call set_binary_job(b, name, val, ierr)
227 :
228 0 : end subroutine binary_set_star_job_namelist
229 :
230 0 : real(dp) function binary_compute_k_div_T(binary_id, is_donor, has_convective_envelope, ierr)
231 0 : use binary_def, only: binary_info, binary_ptr
232 : use binary_tides, only: k_div_T
233 : use star_def, only: star_info
234 : integer, intent(in) :: binary_id
235 : logical, intent(in) :: is_donor
236 : type(star_info), pointer :: s
237 : logical, intent(in) :: has_convective_envelope
238 : integer, intent(out) :: ierr
239 : type (binary_info), pointer :: b
240 :
241 : ierr = 0
242 0 : call binary_ptr(binary_id, b, ierr)
243 0 : if(ierr/=0) return
244 :
245 0 : if(is_donor) then
246 0 : s => b% s_donor
247 : else
248 0 : s => b% s_accretor
249 : end if
250 :
251 0 : binary_compute_k_div_T = k_div_T(b, s, has_convective_envelope, ierr)
252 :
253 0 : end function binary_compute_k_div_T
254 :
255 3 : real(dp) function binary_L2_mass_loss_fraction(donor_mass, accretor_mass, mass_transfer_rate, orbital_separation, &
256 : disk_alpha, disk_mu, ierr)
257 0 : use binary_disk, only: eval_L2_mass_loss_fraction
258 : real(dp), intent(in) :: donor_mass ! [M_sun]
259 : real(dp), intent(in) :: accretor_mass ! [M_sun]
260 : real(dp), intent(in) :: mass_transfer_rate ! [M_sun/yr]
261 : real(dp), intent(in) :: orbital_separation ! [R_sun]
262 : real(dp), intent(in) :: disk_alpha ! disk alpha viscosity parameter (dimensionless)
263 : real(dp), intent(in) :: disk_mu ! disk mean molecular weight (dimensionless)
264 : integer, intent(out) :: ierr
265 :
266 : call eval_L2_mass_loss_fraction(donor_mass, accretor_mass, mass_transfer_rate, orbital_separation, &
267 : disk_alpha, disk_mu, &
268 3 : binary_L2_mass_loss_fraction, ierr)
269 3 : end function binary_L2_mass_loss_fraction
270 :
271 : end module binary_lib
272 :
|
