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_job_ctrls_io
21 :
22 : use const_def, only: dp
23 : use binary_def
24 :
25 : implicit none
26 :
27 : include "binary_job_controls.inc"
28 :
29 : namelist /binary_job/ &
30 : show_binary_log_description_at_start, &
31 : binary_history_columns_file, &
32 : warn_binary_extra, &
33 : inlist_names, &
34 : ! extra files (Maybe overkill with so few inlist parameters)
35 : read_extra_binary_job_inlist, extra_binary_job_inlist_name, &
36 : evolve_both_stars, &
37 : relax_primary_to_th_eq, &
38 : log_Lnuc_div_L_for_relax_primary_to_th_eq, &
39 : min_age_for_relax_primary_to_th_eq, &
40 : max_steps_for_relax_primary_to_th_eq, &
41 : no_history_during_relax_primary_to_th_eq, &
42 : reset_age_for_relax_primary_to_th_eq, &
43 : tsync_for_relax_primary_to_th_eq, &
44 : change_ignore_rlof_flag, &
45 : change_initial_ignore_rlof_flag, &
46 : new_ignore_rlof_flag, &
47 : change_model_twins_flag, &
48 : change_initial_model_twins_flag, &
49 : new_model_twins_flag, &
50 : change_point_mass_i, &
51 : change_initial_point_mass_i, &
52 : new_point_mass_i, &
53 : change_m1, &
54 : change_initial_m1, &
55 : new_m1, &
56 : change_m2, &
57 : change_initial_m2, &
58 : new_m2, &
59 : change_separation_eccentricity, &
60 : change_initial_separation_eccentricity, &
61 : change_period_eccentricity, &
62 : change_initial_period_eccentricity, &
63 : new_separation, &
64 : new_period, &
65 : new_eccentricity, &
66 : pgbinary_flag
67 :
68 : contains
69 :
70 :
71 0 : subroutine do_read_binary_job(b, filename, ierr)
72 : use utils_namelist, only: read_namelist, missing_namelist_error
73 : type (binary_info), pointer :: b
74 : character(*), intent(in) :: filename
75 : integer, intent(out) :: ierr
76 :
77 0 : call set_default_binary_job_controls
78 0 : call read_namelist(filename, read_binary_job_file, "binary_job", ierr, missing_namelist_error)
79 :
80 0 : if (ierr /= 0) return
81 :
82 0 : call store_binary_job_controls(b)
83 : end subroutine do_read_binary_job
84 :
85 0 : subroutine read_binary_job_file(unit, iostat, iomsg, extra_inlists, extra_inlists_mask)
86 : use const_def, only: strlen
87 : use utils_namelist, only: max_extra_inlists
88 :
89 : integer, intent(in) :: unit
90 : integer, intent(out) :: iostat
91 : character(len=strlen), intent(out) :: iomsg
92 : character(len=strlen), dimension(max_extra_inlists), intent(out) :: extra_inlists
93 : logical, dimension(max_extra_inlists), intent(out) :: extra_inlists_mask
94 :
95 : integer :: i
96 :
97 0 : read_extra_binary_job_inlist(:) = .false.
98 :
99 0 : read(unit, nml=binary_job, iostat=iostat, iomsg=iomsg)
100 :
101 0 : if (iostat /= 0) then
102 : return
103 : end if
104 :
105 0 : do i=1, max_extra_inlists
106 0 : extra_inlists(i) = extra_binary_job_inlist_name(i)
107 0 : extra_inlists_mask(i) = read_extra_binary_job_inlist(i)
108 : end do
109 :
110 : end subroutine read_binary_job_file
111 :
112 0 : subroutine store_binary_job_controls(b)
113 : type (binary_info), pointer :: b
114 :
115 0 : b% job% show_binary_log_description_at_start = show_binary_log_description_at_start
116 0 : b% job% binary_history_columns_file = binary_history_columns_file
117 0 : b% job% warn_binary_extra = warn_binary_extra
118 0 : b% job% inlist_names(:) = inlist_names(:)
119 :
120 0 : b% job% evolve_both_stars = evolve_both_stars
121 0 : b% job% relax_primary_to_th_eq = relax_primary_to_th_eq
122 0 : b% job% log_Lnuc_div_L_for_relax_primary_to_th_eq = log_Lnuc_div_L_for_relax_primary_to_th_eq
123 0 : b% job% min_age_for_relax_primary_to_th_eq = min_age_for_relax_primary_to_th_eq
124 0 : b% job% max_steps_for_relax_primary_to_th_eq = max_steps_for_relax_primary_to_th_eq
125 0 : b% job% no_history_during_relax_primary_to_th_eq = no_history_during_relax_primary_to_th_eq
126 0 : b% job% reset_age_for_relax_primary_to_th_eq = reset_age_for_relax_primary_to_th_eq
127 0 : b% job% tsync_for_relax_primary_to_th_eq = tsync_for_relax_primary_to_th_eq
128 :
129 0 : b% job% change_ignore_rlof_flag = change_ignore_rlof_flag
130 0 : b% job% change_initial_ignore_rlof_flag = change_initial_ignore_rlof_flag
131 0 : b% job% new_ignore_rlof_flag = new_ignore_rlof_flag
132 0 : b% job% change_model_twins_flag = change_model_twins_flag
133 0 : b% job% change_initial_model_twins_flag = change_initial_model_twins_flag
134 0 : b% job% new_model_twins_flag = new_model_twins_flag
135 0 : b% job% change_point_mass_i = change_point_mass_i
136 0 : b% job% change_initial_point_mass_i = change_initial_point_mass_i
137 0 : b% job% new_point_mass_i = new_point_mass_i
138 0 : b% job% change_m1 = change_m1
139 0 : b% job% change_initial_m1 = change_initial_m1
140 0 : b% job% new_m1 = new_m1
141 0 : b% job% change_m2 = change_m2
142 0 : b% job% change_initial_m2 = change_initial_m2
143 0 : b% job% new_m2 = new_m2
144 0 : b% job% change_separation_eccentricity = change_separation_eccentricity
145 0 : b% job% change_initial_separation_eccentricity = change_initial_separation_eccentricity
146 0 : b% job% change_period_eccentricity = change_period_eccentricity
147 0 : b% job% change_initial_period_eccentricity = change_initial_period_eccentricity
148 0 : b% job% new_separation = new_separation
149 0 : b% job% new_period = new_period
150 0 : b% job% new_eccentricity = new_eccentricity
151 0 : b% job% pgbinary_flag = pgbinary_flag
152 :
153 0 : end subroutine store_binary_job_controls
154 :
155 :
156 0 : subroutine set_default_binary_job_controls
157 : include 'binary_job.defaults'
158 0 : end subroutine set_default_binary_job_controls
159 :
160 :
161 0 : subroutine set_binary_job_controls_for_writing(b, ierr)
162 : type (binary_info), pointer :: b
163 : integer, intent(out) :: ierr
164 :
165 0 : ierr = 0
166 :
167 0 : show_binary_log_description_at_start = b% job% show_binary_log_description_at_start
168 0 : binary_history_columns_file = b% job% binary_history_columns_file
169 0 : warn_binary_extra = b% job% warn_binary_extra
170 0 : inlist_names(:) = b% job% inlist_names(:)
171 :
172 0 : evolve_both_stars = b% job% evolve_both_stars
173 0 : evolve_both_stars = b% job% evolve_both_stars
174 0 : relax_primary_to_th_eq = b% job% relax_primary_to_th_eq
175 0 : log_Lnuc_div_L_for_relax_primary_to_th_eq = b% job% log_Lnuc_div_L_for_relax_primary_to_th_eq
176 0 : min_age_for_relax_primary_to_th_eq = b% job% min_age_for_relax_primary_to_th_eq
177 0 : max_steps_for_relax_primary_to_th_eq = b% job% max_steps_for_relax_primary_to_th_eq
178 0 : no_history_during_relax_primary_to_th_eq = b% job% no_history_during_relax_primary_to_th_eq
179 0 : reset_age_for_relax_primary_to_th_eq = b% job% reset_age_for_relax_primary_to_th_eq
180 0 : tsync_for_relax_primary_to_th_eq = b% job% tsync_for_relax_primary_to_th_eq
181 :
182 0 : change_ignore_rlof_flag = b% job% change_ignore_rlof_flag
183 0 : change_initial_ignore_rlof_flag = b% job% change_initial_ignore_rlof_flag
184 0 : new_ignore_rlof_flag = b% job% new_ignore_rlof_flag
185 0 : change_model_twins_flag = b% job% change_model_twins_flag
186 0 : change_initial_model_twins_flag = b% job% change_initial_model_twins_flag
187 0 : new_model_twins_flag = b% job% new_model_twins_flag
188 0 : change_point_mass_i = b% job% change_point_mass_i
189 0 : change_initial_point_mass_i = b% job% change_initial_point_mass_i
190 0 : new_point_mass_i = b% job% new_point_mass_i
191 0 : change_m1 = b% job% change_m1
192 0 : change_initial_m1 = b% job% change_initial_m1
193 0 : new_m1 = b% job% new_m1
194 0 : change_m2 = b% job% change_m2
195 0 : change_initial_m2 = b% job% change_initial_m2
196 0 : new_m2 = b% job% new_m2
197 0 : change_separation_eccentricity = b% job% change_separation_eccentricity
198 0 : change_initial_separation_eccentricity = b% job% change_initial_separation_eccentricity
199 0 : change_period_eccentricity = b% job% change_period_eccentricity
200 0 : change_initial_period_eccentricity = b% job% change_initial_period_eccentricity
201 0 : new_separation = b% job% new_separation
202 0 : new_period = b% job% new_period
203 0 : new_eccentricity = b% job% new_eccentricity
204 0 : pgbinary_flag = b% job% pgbinary_flag
205 :
206 0 : end subroutine set_binary_job_controls_for_writing
207 :
208 :
209 0 : subroutine do_write_binary_job(b, filename, ierr)
210 : type (binary_info), pointer :: b
211 : character(*), intent(in) :: filename
212 : integer, intent(out) :: ierr
213 : integer :: io
214 : ierr = 0
215 0 : call set_binary_job_controls_for_writing(b, ierr)
216 0 : if (ierr /= 0) return
217 0 : open(newunit=io, file=trim(filename), action='write', status='replace', iostat=ierr)
218 0 : if (ierr /= 0) then
219 0 : write(*,*) 'failed to open ' // trim(filename)
220 0 : return
221 : end if
222 0 : write(io, nml=binary_job, iostat=ierr)
223 0 : close(io)
224 : end subroutine do_write_binary_job
225 :
226 :
227 0 : subroutine get_binary_job(b, name, val, ierr)
228 : use utils_lib, only: StrUpCase
229 : type (binary_info), pointer :: b
230 : character(len=*),intent(in) :: name
231 : character(len=*), intent(out) :: val
232 : integer, intent(out) :: ierr
233 :
234 0 : character(len(name)) :: upper_name
235 : character(len=512) :: str
236 : integer :: iounit,iostat,ind,i
237 :
238 :
239 : ! First save current controls
240 0 : call set_binary_job_controls_for_writing(b, ierr)
241 0 : if(ierr/=0) return
242 :
243 : ! Write namelist to temporary file
244 0 : open(newunit=iounit,status='scratch')
245 0 : write(iounit,nml=binary_job)
246 0 : rewind(iounit)
247 :
248 : ! Namelists get written in capitals
249 0 : upper_name = StrUpCase(name)
250 0 : val = ''
251 : ! Search for name inside namelist
252 : do
253 0 : read(iounit,'(A)',iostat=iostat) str
254 0 : ind = index(str,trim(upper_name))
255 0 : if( ind /= 0 ) then
256 0 : val = str(ind+len_trim(upper_name)+1:len_trim(str)-1) ! Remove final comma and starting =
257 0 : do i=1,len(val)
258 0 : if(val(i:i)=='"') val(i:i) = ' '
259 : end do
260 : exit
261 : end if
262 0 : if(is_iostat_end(iostat)) exit
263 : end do
264 :
265 0 : if(len_trim(val) == 0 .and. ind==0 ) ierr = -1
266 :
267 0 : close(iounit)
268 :
269 0 : end subroutine get_binary_job
270 :
271 0 : subroutine set_binary_job(b, name, val, ierr)
272 : type (binary_info), pointer :: b
273 : character(len=*), intent(in) :: name, val
274 0 : character(len=len(name)+len(val)+14) :: tmp
275 : integer, intent(out) :: ierr
276 :
277 : ! First save current controls
278 0 : call set_binary_job_controls_for_writing(b, ierr)
279 0 : if(ierr/=0) return
280 :
281 0 : tmp=''
282 0 : tmp = '&binary_job '//trim(name)//'='//trim(val)//' /'
283 :
284 : ! Load into namelist
285 0 : read(tmp, nml=binary_job)
286 :
287 : ! Add to star
288 0 : call store_binary_job_controls(b)
289 0 : if(ierr/=0) return
290 :
291 : end subroutine set_binary_job
292 :
293 :
294 : end module binary_job_ctrls_io
295 :
|
