Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2015 Bill Paxton, 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 mod_other_binary_extras
21 :
22 :
23 : implicit none
24 :
25 : private warn_run_star_extras
26 : public
27 :
28 : contains
29 :
30 0 : integer function null_extras_binary_startup(binary_id,restart,ierr)
31 : use binary_def, only : binary_info, binary_ptr
32 : use star_def, only : keep_going
33 : use const_def, only: dp
34 : type (binary_info), pointer :: b
35 : integer, intent(in) :: binary_id
36 : integer, intent(out) :: ierr
37 : logical, intent(in) :: restart
38 :
39 0 : null_extras_binary_startup = keep_going
40 0 : call binary_ptr(binary_id, b, ierr)
41 : if (ierr /= 0) then ! failure in binary_ptr
42 : return
43 : end if
44 :
45 0 : end function null_extras_binary_startup
46 :
47 0 : integer function null_extras_binary_start_step(binary_id,ierr)
48 0 : use binary_def, only : binary_info, binary_ptr
49 : use star_def, only : keep_going
50 : use const_def, only: dp
51 : type (binary_info), pointer :: b
52 : integer, intent(in) :: binary_id
53 : integer, intent(out) :: ierr
54 :
55 0 : null_extras_binary_start_step = keep_going
56 0 : call binary_ptr(binary_id, b, ierr)
57 : if (ierr /= 0) then ! failure in binary_ptr
58 : return
59 : end if
60 :
61 0 : end function null_extras_binary_start_step
62 :
63 : !Return either keep_going, retry or terminate
64 0 : integer function null_extras_binary_check_model(binary_id)
65 0 : use binary_def, only : binary_info, binary_ptr
66 : use star_def, only : keep_going
67 : use const_def, only: dp
68 : type (binary_info), pointer :: b
69 : integer, intent(in) :: binary_id
70 : integer :: ierr
71 0 : call binary_ptr(binary_id, b, ierr)
72 : if (ierr /= 0) then ! failure in binary_ptr
73 : return
74 : end if
75 : null_extras_binary_check_model = keep_going
76 :
77 0 : end function null_extras_binary_check_model
78 :
79 :
80 : ! returns either keep_going or terminate.
81 : ! note: cannot request retry; extras_binary_check_model can do that.
82 0 : integer function null_extras_binary_finish_step(binary_id)
83 0 : use binary_def, only : binary_info, binary_ptr
84 : use star_def, only : keep_going
85 : use const_def, only: dp
86 : type (binary_info), pointer :: b
87 : integer, intent(in) :: binary_id
88 : integer :: ierr
89 0 : call binary_ptr(binary_id, b, ierr)
90 : if (ierr /= 0) then ! failure in binary_ptr
91 : return
92 : end if
93 : null_extras_binary_finish_step = keep_going
94 :
95 0 : end function null_extras_binary_finish_step
96 :
97 :
98 :
99 0 : subroutine null_extras_binary_after_evolve(binary_id, ierr)
100 0 : use binary_def, only : binary_info, binary_ptr
101 : use const_def, only: dp
102 : type (binary_info), pointer :: b
103 : integer, intent(in) :: binary_id
104 : integer, intent(out) :: ierr
105 0 : call binary_ptr(binary_id, b, ierr)
106 0 : if (ierr /= 0) then ! failure in binary_ptr
107 : return
108 : end if
109 :
110 0 : end subroutine null_extras_binary_after_evolve
111 :
112 0 : integer function null_how_many_extra_binary_history_columns(binary_id)
113 0 : use binary_def, only : binary_info, binary_ptr
114 : use const_def, only: dp
115 : integer, intent(in) :: binary_id
116 : type (binary_info), pointer :: b
117 : integer :: ierr
118 0 : call binary_ptr(binary_id, b, ierr)
119 0 : if (ierr /= 0) then ! failure in binary_ptr
120 : return
121 : end if
122 0 : null_how_many_extra_binary_history_columns=0
123 :
124 0 : call warn_run_star_extras(b% warn_binary_extra)
125 :
126 0 : end function null_how_many_extra_binary_history_columns
127 :
128 0 : subroutine null_data_for_extra_binary_history_columns(binary_id, n, extra_names, vals, ierr)
129 0 : use binary_def, only : binary_info, binary_ptr, maxlen_binary_history_column_name
130 : use const_def, only: dp
131 : integer, intent(in) :: binary_id
132 : integer, intent(in) :: n
133 : character (len=maxlen_binary_history_column_name) :: extra_names(n)
134 : real(dp) :: vals(n)
135 : integer, intent(out) :: ierr
136 : type (binary_info), pointer :: b
137 0 : call binary_ptr(binary_id, b, ierr)
138 0 : if (ierr /= 0) then ! failure in binary_ptr
139 : return
140 : end if
141 :
142 0 : call warn_run_star_extras(b% warn_binary_extra)
143 :
144 0 : end subroutine null_data_for_extra_binary_history_columns
145 :
146 :
147 0 : integer function null_how_many_extra_binary_history_header_items(binary_id)
148 0 : use const_def, only: dp
149 : integer, intent(in) :: binary_id
150 0 : null_how_many_extra_binary_history_header_items = 0
151 0 : end function null_how_many_extra_binary_history_header_items
152 :
153 0 : subroutine null_data_for_extra_binary_history_header_items( &
154 : binary_id, n, extra_names, vals, ierr)
155 : use binary_def, only : binary_info, binary_ptr, maxlen_binary_history_column_name
156 : use const_def, only: dp
157 : type (binary_info), pointer :: b
158 : integer, intent(in) :: binary_id, n
159 : character (len=maxlen_binary_history_column_name) :: extra_names(n)
160 : real(dp) :: vals(n)
161 : integer, intent(out) :: ierr
162 : ierr = 0
163 0 : call binary_ptr(binary_id, b, ierr)
164 0 : if (ierr /= 0) then
165 0 : write(*,*) 'failed in binary_ptr'
166 : return
167 : end if
168 0 : end subroutine null_data_for_extra_binary_history_header_items
169 :
170 :
171 0 : subroutine warn_run_star_extras(warn)
172 : logical, intent(in) :: warn
173 :
174 0 : if(warn) then
175 0 : write(*,*) "WARNING: run_binary_extras has changed"
176 0 : write(*,*) "and you are calling a null version of this routine"
177 0 : write(*,*) "If you had customized your run_binary_extras.f file those functions are not being called"
178 0 : write(*,*) "See $MESA_DIR/binary/work/src/run_binary_extras.f for what you need to do now"
179 0 : write(*,*) "To disable this warning set warn_run_binary_extra=.false. in your binary_job inlist"
180 0 : write(*,*) "run_star_extras has also changed, so set warn_run_star_extra=.false. in star1's star_job inlist"
181 0 : write(*,*) "MESA exited due to run_binary_extras warning."
182 0 : stop
183 : end if
184 :
185 0 : end subroutine warn_run_star_extras
186 :
187 :
188 : end module mod_other_binary_extras
189 :
|
