Line data Source code
1 1 : subroutine extras_controls(id, ierr)
2 : integer, intent(in) :: id
3 : integer, intent(out) :: ierr
4 : type (star_info), pointer :: s
5 1 : ierr = 0
6 1 : call star_ptr(id, s, ierr)
7 1 : if (ierr /= 0) return
8 :
9 : ! this is the place to set any procedure pointers you want to change
10 : ! e.g., other_wind, other_mixing, other_energy (see star_data.inc)
11 :
12 :
13 : ! the extras functions in this file will not be called
14 : ! unless you set their function pointers as done below.
15 : ! otherwise we use a null_ version which does nothing (except warn).
16 :
17 1 : s% extras_startup => extras_startup
18 1 : s% extras_start_step => extras_start_step
19 1 : s% extras_check_model => extras_check_model
20 1 : s% extras_finish_step => extras_finish_step
21 1 : s% extras_after_evolve => extras_after_evolve
22 1 : s% how_many_extra_history_columns => how_many_extra_history_columns
23 1 : s% data_for_extra_history_columns => data_for_extra_history_columns
24 1 : s% how_many_extra_profile_columns => how_many_extra_profile_columns
25 1 : s% data_for_extra_profile_columns => data_for_extra_profile_columns
26 :
27 1 : s% how_many_extra_history_header_items => how_many_extra_history_header_items
28 1 : s% data_for_extra_history_header_items => data_for_extra_history_header_items
29 1 : s% how_many_extra_profile_header_items => how_many_extra_profile_header_items
30 1 : s% data_for_extra_profile_header_items => data_for_extra_profile_header_items
31 :
32 : end subroutine extras_controls
33 :
34 :
35 1 : subroutine extras_startup(id, restart, ierr)
36 : integer, intent(in) :: id
37 : logical, intent(in) :: restart
38 : integer, intent(out) :: ierr
39 : type (star_info), pointer :: s
40 1 : ierr = 0
41 1 : call star_ptr(id, s, ierr)
42 1 : if (ierr /= 0) return
43 : end subroutine extras_startup
44 :
45 :
46 11 : integer function extras_start_step(id)
47 : integer, intent(in) :: id
48 : integer :: ierr
49 : type (star_info), pointer :: s
50 11 : ierr = 0
51 11 : call star_ptr(id, s, ierr)
52 11 : if (ierr /= 0) return
53 11 : extras_start_step = 0
54 11 : end function extras_start_step
55 :
56 :
57 : ! returns either keep_going, retry, or terminate.
58 10 : integer function extras_check_model(id)
59 : integer, intent(in) :: id
60 : integer :: ierr
61 : type (star_info), pointer :: s
62 10 : ierr = 0
63 10 : call star_ptr(id, s, ierr)
64 10 : if (ierr /= 0) return
65 10 : extras_check_model = keep_going
66 : if (.false. .and. s% star_mass_h1 < 0.35d0) then
67 : ! stop when star hydrogen mass drops to specified level
68 : extras_check_model = terminate
69 : write(*, *) 'have reached desired hydrogen mass'
70 : return
71 : end if
72 :
73 :
74 : ! if you want to check multiple conditions, it can be useful
75 : ! to set a different termination code depending on which
76 : ! condition was triggered. MESA provides 9 customizable
77 : ! termination codes, named t_xtra1 .. t_xtra9. You can
78 : ! customize the messages that will be printed upon exit by
79 : ! setting the corresponding termination_code_str value.
80 : ! termination_code_str(t_xtra1) = 'my termination condition'
81 :
82 : ! by default, indicate where (in the code) MESA terminated
83 10 : if (extras_check_model == terminate) s% termination_code = t_extras_check_model
84 10 : end function extras_check_model
85 :
86 :
87 4 : integer function how_many_extra_history_columns(id)
88 : integer, intent(in) :: id
89 : integer :: ierr
90 : type (star_info), pointer :: s
91 4 : ierr = 0
92 4 : call star_ptr(id, s, ierr)
93 4 : if (ierr /= 0) return
94 4 : how_many_extra_history_columns = 0
95 4 : end function how_many_extra_history_columns
96 :
97 :
98 0 : subroutine data_for_extra_history_columns(id, n, names, vals, ierr)
99 : integer, intent(in) :: id, n
100 : character (len=maxlen_history_column_name) :: names(n)
101 : real(dp) :: vals(n)
102 : integer, intent(out) :: ierr
103 : type (star_info), pointer :: s
104 0 : ierr = 0
105 0 : call star_ptr(id, s, ierr)
106 0 : if (ierr /= 0) return
107 :
108 : ! note: do NOT add the extras names to history_columns.list
109 : ! the history_columns.list is only for the built-in history column options.
110 : ! it must not include the new column names you are adding here.
111 :
112 :
113 : end subroutine data_for_extra_history_columns
114 :
115 :
116 2 : integer function how_many_extra_profile_columns(id)
117 : integer, intent(in) :: id
118 : integer :: ierr
119 : type (star_info), pointer :: s
120 2 : ierr = 0
121 2 : call star_ptr(id, s, ierr)
122 2 : if (ierr /= 0) return
123 2 : how_many_extra_profile_columns = 0
124 2 : end function how_many_extra_profile_columns
125 :
126 :
127 0 : subroutine data_for_extra_profile_columns(id, n, nz, names, vals, ierr)
128 : integer, intent(in) :: id, n, nz
129 : character (len=maxlen_profile_column_name) :: names(n)
130 : real(dp) :: vals(nz,n)
131 : integer, intent(out) :: ierr
132 : type (star_info), pointer :: s
133 : integer :: k
134 0 : ierr = 0
135 0 : call star_ptr(id, s, ierr)
136 0 : if (ierr /= 0) return
137 :
138 : ! note: do NOT add the extra names to profile_columns.list
139 : ! the profile_columns.list is only for the built-in profile column options.
140 : ! it must not include the new column names you are adding here.
141 :
142 : ! here is an example for adding a profile column
143 : !if (n /= 1) stop 'data_for_extra_profile_columns'
144 : !names(1) = 'beta'
145 : !do k = 1, nz
146 : ! vals(k,1) = s% Pgas(k)/s% P(k)
147 : !end do
148 :
149 : end subroutine data_for_extra_profile_columns
150 :
151 :
152 1 : integer function how_many_extra_history_header_items(id)
153 : integer, intent(in) :: id
154 : integer :: ierr
155 : type (star_info), pointer :: s
156 1 : ierr = 0
157 1 : call star_ptr(id, s, ierr)
158 1 : if (ierr /= 0) return
159 1 : how_many_extra_history_header_items = 0
160 1 : end function how_many_extra_history_header_items
161 :
162 :
163 0 : subroutine data_for_extra_history_header_items(id, n, names, vals, ierr)
164 : integer, intent(in) :: id, n
165 : character (len=maxlen_history_column_name) :: names(n)
166 : real(dp) :: vals(n)
167 : type(star_info), pointer :: s
168 : integer, intent(out) :: ierr
169 0 : ierr = 0
170 0 : call star_ptr(id,s,ierr)
171 0 : if(ierr/=0) return
172 :
173 : ! here is an example for adding an extra history header item
174 : ! also set how_many_extra_history_header_items
175 : ! names(1) = 'mixing_length_alpha'
176 : ! vals(1) = s% mixing_length_alpha
177 :
178 : end subroutine data_for_extra_history_header_items
179 :
180 :
181 2 : integer function how_many_extra_profile_header_items(id)
182 : integer, intent(in) :: id
183 : integer :: ierr
184 : type (star_info), pointer :: s
185 2 : ierr = 0
186 2 : call star_ptr(id, s, ierr)
187 2 : if (ierr /= 0) return
188 2 : how_many_extra_profile_header_items = 0
189 2 : end function how_many_extra_profile_header_items
190 :
191 :
192 0 : subroutine data_for_extra_profile_header_items(id, n, names, vals, ierr)
193 : integer, intent(in) :: id, n
194 : character (len=maxlen_profile_column_name) :: names(n)
195 : real(dp) :: vals(n)
196 : type(star_info), pointer :: s
197 : integer, intent(out) :: ierr
198 0 : ierr = 0
199 0 : call star_ptr(id,s,ierr)
200 0 : if(ierr/=0) return
201 :
202 : ! here is an example for adding an extra profile header item
203 : ! also set how_many_extra_profile_header_items
204 : ! names(1) = 'mixing_length_alpha'
205 : ! vals(1) = s% mixing_length_alpha
206 :
207 : end subroutine data_for_extra_profile_header_items
208 :
209 :
210 : ! returns either keep_going or terminate.
211 : ! note: cannot request retry; extras_check_model can do that.
212 11 : integer function extras_finish_step(id)
213 : integer, intent(in) :: id
214 : integer :: ierr
215 : type (star_info), pointer :: s
216 11 : ierr = 0
217 11 : call star_ptr(id, s, ierr)
218 11 : if (ierr /= 0) return
219 11 : extras_finish_step = keep_going
220 :
221 : ! to save a profile,
222 : ! s% need_to_save_profiles_now = .true.
223 : ! to update the star log,
224 : ! s% need_to_update_history_now = .true.
225 :
226 : ! see extras_check_model for information about custom termination codes
227 : ! by default, indicate where (in the code) MESA terminated
228 11 : if (extras_finish_step == terminate) s% termination_code = t_extras_finish_step
229 11 : end function extras_finish_step
230 :
231 :
232 1 : subroutine extras_after_evolve(id, ierr)
233 : integer, intent(in) :: id
234 : integer, intent(out) :: ierr
235 : type (star_info), pointer :: s
236 1 : ierr = 0
237 1 : call star_ptr(id, s, ierr)
238 1 : if (ierr /= 0) return
239 : end subroutine extras_after_evolve
|
