Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010-2022 Pablo Marchant, Matthias Fabry & 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 :
21 : module binary_photos
22 :
23 : use const_def, only: dp
24 : use math_lib
25 : use star_lib
26 : use star_def
27 : use binary_def
28 : use utils_lib
29 :
30 : implicit none
31 :
32 : contains
33 :
34 0 : subroutine do_saves_for_binary(b, ierr)
35 : type(binary_info), pointer :: b
36 : integer, intent(out) :: ierr
37 : integer :: iounit
38 : character (len = strlen) :: str_photo, filename, iomsg, report_str
39 :
40 0 : call string_for_model_number('x', b% model_number, b% photo_digits, str_photo)
41 :
42 0 : filename = trim(trim(b% photo_directory) // '/b_' // str_photo)
43 0 : report_str = trim('save ' // filename)
44 : open(newunit = iounit, file = trim(filename), action = 'write', &
45 0 : status = 'replace', iostat = ierr, iomsg = iomsg, form = 'unformatted')
46 0 : if (ierr /= 0) then
47 0 : write(*, *) 'failed in do_saves_for_binary', trim(filename)
48 0 : return
49 : end if
50 0 : call binary_photo_write(b% binary_id, iounit)
51 0 : close(iounit)
52 :
53 0 : if (b% have_star_1) then
54 0 : filename = trim(trim(b% s1% photo_directory) // '/1_' // str_photo)
55 0 : call star_save_for_restart(b% s1% id, filename, ierr)
56 0 : report_str = trim(trim(report_str) // ', ' // filename)
57 : end if
58 0 : if (b% have_star_2) then
59 0 : filename = trim(trim(b% s2% photo_directory) // '/2_' // str_photo)
60 0 : call star_save_for_restart(b% s2% id, filename, ierr)
61 0 : report_str = trim(trim(report_str) // ', ' // filename)
62 : end if
63 0 : if (ierr /= 0) then
64 0 : write(*, *) 'failed in do_saves_for_binary'
65 0 : return
66 : end if
67 :
68 0 : write(*, *) trim(trim(report_str) // ' for model'), b% model_number
69 :
70 : end subroutine do_saves_for_binary
71 :
72 0 : subroutine binary_photo_write(binary_id, iounit)
73 : integer, intent(in) :: binary_id, iounit
74 : type(binary_info), pointer :: b
75 :
76 : integer :: ierr, k, len_history_col_spec
77 :
78 : ierr = 0
79 0 : call binary_ptr(binary_id, b, ierr)
80 0 : if (ierr /= 0) then
81 0 : write(*, *) 'failed in binary_ptr'
82 0 : return
83 : end if
84 :
85 0 : write(iounit) star_def_version
86 :
87 : write(iounit, iostat = ierr) &
88 0 : b% binary_age, b% binary_age_old, &
89 0 : b% model_number, b% model_number_old, &
90 0 : b% mtransfer_rate, b% mtransfer_rate_old, &
91 0 : b% angular_momentum_j, b% angular_momentum_j_old, &
92 0 : b% separation, b% separation_old, &
93 0 : b% eccentricity, b% eccentricity_old, &
94 0 : b% rl_relative_gap(1), b% rl_relative_gap_old(1), &
95 0 : b% rl_relative_gap(2), b% rl_relative_gap_old(2), &
96 0 : b% r(1), b% r_old(1), &
97 0 : b% r(2), b% r_old(2), &
98 0 : b% rl(1), b% rl_old(1), &
99 0 : b% rl(2), b% rl_old(2), &
100 0 : b% m(1), b% m_old(1), &
101 0 : b% m(2), b% m_old(2), &
102 0 : b% dt, b% dt_old, &
103 0 : b% env(1), b% env_old(1), &
104 0 : b% env(2), b% env_old(2), &
105 0 : b% eq_initial_bh_mass, &
106 0 : b% period, b% period_old, &
107 0 : b% max_timestep, b% max_timestep_old, &
108 0 : b% change_factor, b% change_factor_old, &
109 0 : b% min_binary_separation, &
110 0 : b% using_jdot_mb(1), b% using_jdot_mb_old(1), &
111 0 : b% using_jdot_mb(2), b% using_jdot_mb_old(2), &
112 0 : b% d_i, b% d_i_old, b% a_i, b% a_i_old, &
113 0 : b% point_mass_i, b% point_mass_i_old, &
114 0 : b% ignore_rlof_flag, b% ignore_rlof_flag_old, &
115 0 : b% model_twins_flag, b% model_twins_flag_old, &
116 0 : b% dt_why_reason, b% dt_why_reason_old, &
117 0 : b% have_star_1, b% have_star_2, &
118 0 : b% CE_flag, b% CE_flag_old, &
119 0 : b% CE_init, b% CE_init_old, &
120 0 : b% CE_nz, b% CE_initial_radius, b% CE_initial_separation, b% CE_initial_Mdonor, &
121 0 : b% CE_initial_Maccretor, b% CE_initial_age, b% CE_initial_model_number, &
122 0 : b% CE_b_initial_age, b% CE_b_initial_model_number, &
123 0 : b% CE_num1, b% CE_num1_old, &
124 0 : b% CE_num2, b% CE_num2_old, &
125 0 : b% CE_lambda1, b% CE_lambda1_old, &
126 0 : b% CE_lambda2, b% CE_lambda2_old, &
127 0 : b% CE_Ebind1, b% CE_Ebind1_old, &
128 0 : b% CE_Ebind2, b% CE_Ebind2_old, &
129 0 : b% CE_years_detached, b% CE_years_detached_old, &
130 0 : b% generations, &
131 0 : b% ixtra(:), b% ixtra_old(:), &
132 0 : b% xtra(:), b% xtra_old(:), &
133 0 : b% lxtra(:), b% lxtra_old(:)
134 :
135 0 : if (associated(b% binary_history_column_spec)) then
136 0 : len_history_col_spec = size(b% binary_history_column_spec)
137 0 : write(iounit) len_history_col_spec
138 0 : write(iounit) b% binary_history_column_spec(1:len_history_col_spec)
139 : else
140 0 : write(iounit) 0 ! len_log_col_spec
141 : end if
142 : write(iounit) &
143 0 : b% number_of_binary_history_columns, b% model_number_of_binary_history_values, &
144 0 : b% need_to_set_binary_history_names_etc
145 0 : if (b% number_of_binary_history_columns > 0) then
146 0 : write(iounit) b% binary_history_value_is_integer(1:b% number_of_binary_history_columns)
147 0 : do k = 1, b% number_of_binary_history_columns
148 0 : write(iounit) b% binary_history_names(k)
149 : end do
150 : end if
151 :
152 0 : if (b% CE_init) then
153 : write(iounit, iostat = ierr) &
154 0 : b% CE_m(:), b% CE_entropy(:), b% CE_U_in(:), b% CE_U_out(:), b% CE_Omega_in(:), b% CE_Omega_out(:)
155 : end if
156 :
157 0 : call b% other_binary_photo_write(binary_id, iounit)
158 :
159 0 : if (ierr /= 0) stop "error in binary_photo_write"
160 :
161 : end subroutine binary_photo_write
162 :
163 0 : subroutine binary_load_photo(b, photo_filename, ierr)
164 : type(binary_info), pointer :: b
165 : character (len = strlen) :: photo_filename
166 : integer, intent(out) :: ierr
167 : integer :: iounit, version
168 :
169 : open(newunit = iounit, file = trim(photo_filename), action = 'read', &
170 0 : status = 'old', iostat = ierr, form = 'unformatted')
171 0 : if (ierr /= 0) then
172 0 : write(*, *) 'failed to open ' // trim(photo_filename)
173 0 : return
174 : end if
175 :
176 0 : read(iounit, iostat = ierr) version
177 0 : if (ierr /= 0) then
178 0 : write(*, *) 'failed to read version number'
179 0 : return
180 : end if
181 0 : if (version /= star_def_version) then
182 : write(*, '(/,a,/)') ' FAILURE: the restart data' // &
183 0 : ' is from a previous version of the code and is no longer usable.'
184 0 : ierr = -1
185 0 : return
186 : end if
187 :
188 0 : call binary_photo_read(b% binary_id, iounit, ierr)
189 0 : if (ierr /= 0) then
190 0 : write(*, *) 'failed in binary_photo_read'
191 0 : return
192 : end if
193 :
194 0 : close(iounit)
195 :
196 : end subroutine binary_load_photo
197 :
198 0 : subroutine binary_photo_read(binary_id, iounit, ierr)
199 : integer, intent(in) :: binary_id, iounit
200 : integer, intent(out) :: ierr
201 : type(binary_info), pointer :: b
202 : integer :: nz, k, len_history_col_spec
203 :
204 : ierr = 0
205 0 : call binary_ptr(binary_id, b, ierr)
206 0 : if (ierr /= 0) then
207 0 : write(*, *) 'failed in binary_ptr'
208 0 : return
209 : end if
210 : read(iounit, iostat = ierr) &
211 0 : b% binary_age, b% binary_age_old, &
212 0 : b% model_number, b% model_number_old, &
213 0 : b% mtransfer_rate, b% mtransfer_rate_old, &
214 0 : b% angular_momentum_j, b% angular_momentum_j_old, &
215 0 : b% separation, b% separation_old, &
216 0 : b% eccentricity, b% eccentricity_old, &
217 0 : b% rl_relative_gap(1), b% rl_relative_gap_old(1), &
218 0 : b% rl_relative_gap(2), b% rl_relative_gap_old(2), &
219 0 : b% r(1), b% r_old(1), &
220 0 : b% r(2), b% r_old(2), &
221 0 : b% rl(1), b% rl_old(1), &
222 0 : b% rl(2), b% rl_old(2), &
223 0 : b% m(1), b% m_old(1), &
224 0 : b% m(2), b% m_old(2), &
225 0 : b% dt, b% dt_old, &
226 0 : b% env(1), b% env_old(1), &
227 0 : b% env(2), b% env_old(2), &
228 0 : b% eq_initial_bh_mass, &
229 0 : b% period, b% period_old, &
230 0 : b% max_timestep, b% max_timestep_old, &
231 0 : b% change_factor, b% change_factor_old, &
232 0 : b% min_binary_separation, &
233 0 : b% using_jdot_mb(1), b% using_jdot_mb_old(1), &
234 0 : b% using_jdot_mb(2), b% using_jdot_mb_old(2), &
235 0 : b% d_i, b% d_i_old, b% a_i, b% a_i_old, &
236 0 : b% point_mass_i, b% point_mass_i_old, &
237 0 : b% ignore_rlof_flag, b% ignore_rlof_flag_old, &
238 0 : b% model_twins_flag, b% model_twins_flag_old, &
239 0 : b% dt_why_reason, b% dt_why_reason_old, &
240 0 : b% have_star_1, b% have_star_2, &
241 0 : b% CE_flag, b% CE_flag_old, &
242 0 : b% CE_init, b% CE_init_old, &
243 0 : b% CE_nz, b% CE_initial_radius, b% CE_initial_separation, b% CE_initial_Mdonor, &
244 0 : b% CE_initial_Maccretor, b% CE_initial_age, b% CE_initial_model_number, &
245 0 : b% CE_b_initial_age, b% CE_b_initial_model_number, &
246 0 : b% CE_num1, b% CE_num1_old, &
247 0 : b% CE_num2, b% CE_num2_old, &
248 0 : b% CE_lambda1, b% CE_lambda1_old, &
249 0 : b% CE_lambda2, b% CE_lambda2_old, &
250 0 : b% CE_Ebind1, b% CE_Ebind1_old, &
251 0 : b% CE_Ebind2, b% CE_Ebind2_old, &
252 0 : b% CE_years_detached, b% CE_years_detached_old, &
253 0 : b% generations, &
254 0 : b% ixtra(:), b% ixtra_old(:), &
255 0 : b% xtra(:), b% xtra_old(:), &
256 0 : b% lxtra(:), b% lxtra_old(:)
257 :
258 0 : read(iounit, iostat = ierr) len_history_col_spec
259 0 : if (failed('len_history_col_spec')) return
260 0 : if (len_history_col_spec > 0) then
261 0 : allocate(b% binary_history_column_spec(len_history_col_spec), stat = ierr)
262 0 : if (failed('alloc binary_history_column_spec')) return
263 0 : read(iounit, iostat = ierr) b% binary_history_column_spec(1:len_history_col_spec)
264 0 : if (failed('read binary_history_column_spec')) return
265 : end if
266 :
267 : read(iounit, iostat = ierr) &
268 0 : b% number_of_binary_history_columns, b% model_number_of_binary_history_values, &
269 0 : b% need_to_set_binary_history_names_etc
270 0 : if (failed('number_of_binary_history_columns')) return
271 :
272 0 : if (b% number_of_binary_history_columns > 0) then
273 :
274 0 : allocate(b% binary_history_value_is_integer(b% number_of_binary_history_columns), stat = ierr)
275 0 : if (failed('alloc history_value_is_integer')) return
276 0 : read(iounit, iostat = ierr) b% binary_history_value_is_integer(1:b% number_of_binary_history_columns)
277 0 : if (failed('read history_value_is_integer')) return
278 :
279 0 : allocate(b% binary_history_names(b% number_of_binary_history_columns), stat = ierr)
280 0 : if (failed('alloc history_names')) return
281 0 : do k = 1, b% number_of_binary_history_columns
282 0 : read(iounit, iostat = ierr) b% binary_history_names(k)
283 0 : if (failed('read history_names')) return
284 : end do
285 :
286 : ! rebuild the history_names_dict
287 0 : do k = 1, b% number_of_binary_history_columns
288 0 : call integer_dict_define(b% binary_history_names_dict, b% binary_history_names(k), k, ierr)
289 0 : if (failed('integer_dict_define history_names_dict')) return
290 : end do
291 0 : call integer_dict_create_hash(b% binary_history_names_dict, ierr)
292 0 : if (failed('integer_dict_create_hash history_names_dict')) return
293 :
294 : end if
295 :
296 0 : if (b% CE_flag .and. b% CE_init) then
297 0 : nz = b% CE_nz
298 : allocate(b% CE_m(nz), b% CE_entropy(4 * nz), &
299 0 : b% CE_U_in(4 * nz), b% CE_U_out(4 * nz), b% CE_Omega_in(4 * nz), b% CE_Omega_out(4 * nz), stat = ierr)
300 0 : if (ierr /= 0) stop "error during allocation in binary_photo_read"
301 : read(iounit, iostat = ierr) &
302 0 : b% CE_m(:), b% CE_entropy(:), b% CE_U_in(:), b% CE_U_out(:), b% CE_Omega_in(:), b% CE_Omega_out(:)
303 : end if
304 :
305 0 : call b% other_binary_photo_read(binary_id, iounit, ierr)
306 :
307 0 : if (ierr /= 0) stop "error in binary_photo_read"
308 :
309 : contains
310 :
311 0 : logical function failed(str)
312 : character (len = *), intent(in) :: str
313 0 : if (ierr /= 0) then
314 0 : write(*, *) 'read_binary_photo failed for ' // trim(str)
315 0 : failed = .true.
316 0 : return
317 : end if
318 0 : failed = .false.
319 : end function failed
320 :
321 : end subroutine binary_photo_read
322 :
323 : end module binary_photos
324 :
|
