Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010-2019 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 profile
21 :
22 : use star_private_def
23 : use star_profile_def
24 : use const_def, only: dp, strlen
25 : use profile_getval
26 :
27 : implicit none
28 :
29 : private
30 : public :: write_profile_info
31 : public :: set_profile_columns
32 : public :: get_profile_val
33 : public :: do_save_profiles
34 : public :: do_get_data_for_profile_columns
35 : public :: do_get_num_standard_profile_columns
36 :
37 : ! model log priorities
38 : integer, parameter :: delta_priority = 1
39 : integer, parameter :: phase_priority = 2
40 :
41 : contains
42 :
43 1 : recursive subroutine add_profile_columns( &
44 : s, level, capacity, spec, profile_columns_file, report, ierr)
45 : use utils_lib
46 : use utils_def
47 : use chem_def
48 : use chem_lib
49 : use const_def, only: mesa_dir
50 : type (star_info), pointer :: s
51 : integer, intent(in) :: level
52 : integer, intent(inout) :: capacity
53 : integer, pointer :: spec(:)
54 : character (len=*), intent(in) :: profile_columns_file
55 : logical, intent(in) :: report
56 : integer, intent(out) :: ierr
57 :
58 : integer :: iounit, n, i, t, j, k, nxt_spec, spec_err
59 : character (len=strlen) :: buffer, string, filename
60 : integer, parameter :: max_level = 20
61 :
62 : logical :: exists
63 : logical, parameter :: dbg = .false.
64 :
65 : include 'formats'
66 :
67 1 : if (level > max_level) then
68 0 : write(*,*) 'too many levels of nesting for log column files', level
69 0 : ierr = -1
70 0 : return
71 : end if
72 :
73 1 : ierr = 0
74 1 : spec_err = 0
75 :
76 : ! first try local directory
77 1 : filename = profile_columns_file
78 :
79 1 : if(level==1) then ! First pass either the user set the file or we load the defaults
80 1 : if (len_trim(filename) == 0) filename = 'profile_columns.list'
81 :
82 1 : exists=.false.
83 1 : inquire(file=filename,exist=exists)
84 :
85 1 : if(.not.exists) filename = trim(mesa_dir) // '/star/defaults/profile_columns.list'
86 : else
87 : ! User had include '' in their profile_columns.list file, so dont try to load the local one, jump to the defaults
88 0 : if (len_trim(filename) == 0) filename =trim(mesa_dir) // '/star/defaults/profile_columns.list'
89 : end if
90 :
91 1 : open(newunit=iounit, file=trim(filename), action='read', status='old', iostat=ierr)
92 1 : if (ierr /= 0) then
93 0 : write(*,*) 'failed to open ' // trim(profile_columns_file)
94 0 : return
95 : end if
96 :
97 :
98 : if (dbg) then
99 : write(*,'(A)')
100 : write(*,*) 'profile_columns_file <' // trim(filename) // '>'
101 : end if
102 :
103 1 : call count_specs
104 :
105 1 : n = 0
106 1 : i = 0
107 :
108 : do
109 13 : t = token(iounit, n, i, buffer, string)
110 : if (dbg) write(*,*) 'token', t
111 13 : if (t == eof_token) then
112 : if (dbg) write(*,*) 'eof token'
113 : exit
114 : end if
115 12 : if (t /= name_token) then
116 0 : call error; return
117 : end if
118 :
119 0 : select case(string)
120 :
121 : case ('include')
122 0 : t = token(iounit, n, i, buffer, string)
123 : if (dbg) write(*,*) 'include file token', t
124 : if (dbg) write(*,*) 'include file string len', len_trim(string)
125 0 : if (t /= string_token) then
126 0 : call error; return
127 : end if
128 : if (dbg) write(*,*) 'include file <' // trim(string) // '>'
129 0 : call add_profile_columns(s, level+1, capacity, spec, string, report, spec_err)
130 0 : if (spec_err /= 0) then
131 0 : write(*,*) 'failed for included profile columns list: ' // trim(string)
132 0 : ierr = -1; call error; return
133 : end if
134 0 : call count_specs
135 :
136 : case ('add_eps_neu_rates')
137 0 : call insert_spec(eps_neu_rate_offset, 'add_eps_neu_rate', spec_err)
138 0 : if (spec_err /= 0) then
139 0 : ierr = -1; call error; return
140 : end if
141 :
142 : case ('add_eps_nuc_rates')
143 0 : call insert_spec(eps_nuc_rate_offset, 'add_eps_nuc_rate', spec_err)
144 0 : if (spec_err /= 0) then
145 0 : ierr = -1; call error; return
146 : end if
147 :
148 : case ('add_screened_rates')
149 0 : call insert_spec(screened_rate_offset, 'add_screened_rates', spec_err)
150 0 : if (spec_err /= 0) then
151 0 : ierr = -1; call error; return
152 : end if
153 :
154 : case ('add_raw_rates')
155 0 : call insert_spec(raw_rate_offset, 'add_raw_rates', spec_err)
156 0 : if (spec_err /= 0) then
157 0 : ierr = -1; call error; return
158 : end if
159 :
160 : case ('add_abundances')
161 : ! add all of the isos that are in the current net
162 0 : call insert_spec(add_abundances, 'add_abundances', spec_err)
163 0 : if (spec_err /= 0) then
164 0 : ierr = -1; call error; return
165 : end if
166 :
167 : case ('add_log_abundances')
168 : ! add logs of all of the isos that are in the current net
169 0 : call insert_spec(add_log_abundances, 'add_log_abundances', spec_err)
170 0 : if (spec_err /= 0) then
171 0 : ierr = -1; call error; return
172 : end if
173 :
174 : case ('add_reaction_categories') ! add all the reaction categories
175 0 : do k = 1, num_categories
176 0 : call insert_spec(category_offset + k, category_name(k), spec_err)
177 0 : if (spec_err /= 0) then
178 0 : ierr = -1; call error; return
179 : end if
180 : end do
181 :
182 : case default
183 : spec_err = 0
184 12 : nxt_spec = do1_profile_spec(s, iounit, n, i, string, buffer, report, spec_err)
185 24 : if (spec_err /= 0) then
186 0 : ierr = spec_err
187 : else
188 12 : if (nxt_spec > 0) then
189 12 : call insert_spec(nxt_spec, string, spec_err)
190 12 : if (spec_err /= 0) ierr = spec_err
191 : else
192 0 : if (report) &
193 0 : write(*,*) 'failed to recognize item for profile columns: ' // trim(string)
194 0 : ierr = -1
195 : end if
196 : end if
197 : end select
198 :
199 : end do
200 :
201 : if (dbg) write(*,*) 'finished ' // trim(filename)
202 :
203 1 : close(iounit)
204 :
205 2 : if (dbg) then
206 : write(*,'(A)')
207 : write(*,*) 'done add_profile_columns ' // trim(filename)
208 : write(*,'(A)')
209 : end if
210 :
211 :
212 : contains
213 :
214 :
215 1 : subroutine count_specs
216 : integer :: i
217 1 : j = 1
218 1 : do i=1, capacity
219 1 : if (spec(i) == 0) then
220 1 : j = i; exit
221 : end if
222 : end do
223 1 : end subroutine count_specs
224 :
225 :
226 12 : subroutine make_room(ierr)
227 : integer, intent(out) :: ierr
228 12 : if (j < capacity) return
229 0 : capacity = 50 + (3*capacity)/2
230 0 : call realloc_integer(spec,capacity,ierr)
231 0 : spec(j+1:capacity) = 0
232 : end subroutine make_room
233 :
234 :
235 24 : subroutine insert_spec(c, name, ierr)
236 : integer, intent(in) :: c
237 : character (len=*) :: name
238 : integer, intent(out) :: ierr
239 : integer :: i
240 : include 'formats'
241 78 : do i=1,j-1
242 78 : if (spec(i) == c) return
243 : end do
244 12 : call make_room(ierr)
245 12 : if (ierr /= 0) return
246 12 : spec(j) = c
247 : if (dbg) write(*,2) trim(name), spec(j)
248 12 : j = j+1
249 : end subroutine insert_spec
250 :
251 :
252 0 : subroutine error
253 0 : ierr = -1
254 0 : close(iounit)
255 0 : end subroutine error
256 :
257 :
258 : end subroutine add_profile_columns
259 :
260 :
261 1 : subroutine set_profile_columns(id, profile_columns_file, report, ierr)
262 : use utils_lib, only: realloc_integer
263 : integer, intent(in) :: id
264 : character (len=*), intent(in) :: profile_columns_file
265 : logical, intent(in) :: report
266 : integer, intent(out) :: ierr
267 :
268 : type (star_info), pointer :: s
269 : integer :: capacity, cnt, i
270 : logical, parameter :: dbg = .false.
271 : if (dbg) write(*,*) 'set_profile_columns'
272 : ierr = 0
273 1 : call get_star_ptr(id, s, ierr)
274 1 : if (ierr /= 0) return
275 1 : if (associated(s% profile_column_spec)) deallocate(s% profile_column_spec)
276 1 : capacity = 100 ! will increase if needed
277 1 : allocate(s% profile_column_spec(capacity), stat=ierr)
278 1 : if (ierr /= 0) return
279 101 : s% profile_column_spec(:) = 0
280 : call add_profile_columns( &
281 1 : s, 1, capacity, s% profile_column_spec, profile_columns_file, report, ierr)
282 1 : if (ierr /= 0) return
283 : ! delete trailing 0's
284 1 : cnt = capacity+1
285 13 : do i=1, capacity
286 13 : if (s% profile_column_spec(i) == 0) then
287 : cnt = i; exit
288 : end if
289 0 : if (dbg) write(*,*) 'profile col', i, s% profile_column_spec(i)
290 : end do
291 1 : call realloc_integer(s% profile_column_spec, cnt-1, ierr)
292 : if (dbg) write(*,*) 'num profile columns', cnt-1
293 : if (dbg) call mesa_error(__FILE__,__LINE__,'debug: set_profile_columns')
294 1 : end subroutine set_profile_columns
295 :
296 :
297 2 : integer function do_get_num_standard_profile_columns(s) ! not including extra profile columns
298 : use star_def, only: star_info
299 : type (star_info), pointer :: s
300 : integer :: numcols, j, num_specs
301 2 : numcols = 0
302 2 : if (.not. associated(s% profile_column_spec)) then
303 : num_specs = 0
304 : else
305 2 : num_specs = size(s% profile_column_spec, dim=1)
306 : end if
307 26 : do j = 1, num_specs
308 24 : if (s% profile_column_spec(j) == add_abundances .or. &
309 2 : s% profile_column_spec(j) == add_log_abundances) then
310 0 : numcols = numcols + s% species
311 : else if (s% profile_column_spec(j) == raw_rate_offset .or. &
312 : s% profile_column_spec(j) == screened_rate_offset .or. &
313 24 : s% profile_column_spec(j) == eps_nuc_rate_offset .or. &
314 : s% profile_column_spec(j) == eps_neu_rate_offset) then
315 0 : numcols = numcols + s% num_reactions
316 : else
317 24 : numcols = numcols + 1
318 : end if
319 : end do
320 2 : do_get_num_standard_profile_columns = numcols
321 2 : end function do_get_num_standard_profile_columns
322 :
323 :
324 0 : subroutine do_get_data_for_profile_columns(s, nz, &
325 : names, vals, is_int, ierr)
326 : type (star_info), pointer :: s
327 : integer, intent(in) :: nz
328 : character (len=maxlen_profile_column_name), pointer :: names(:) ! (num_profile_columns)
329 : real(dp), pointer :: vals(:,:) ! (nz,num_profile_columns)
330 : logical, pointer :: is_int(:) ! (num_profile_columns) true iff the values in the column are integers
331 : integer, intent(out) :: ierr
332 : character (len=0) :: fname
333 : logical, parameter :: write_flag = .false.
334 : call do_profile_info(s, fname, &
335 0 : write_flag, names, vals, is_int, ierr)
336 2 : end subroutine do_get_data_for_profile_columns
337 :
338 :
339 2 : subroutine write_profile_info(s, fname, ierr)
340 : use chem_def
341 : use net_def ! categories
342 : use rates_def, only: i_rate
343 : type (star_info), pointer :: s
344 : character (len=*) :: fname
345 : integer, intent(out) :: ierr
346 2 : character (len=maxlen_profile_column_name), pointer :: names(:) ! (num_profile_columns)
347 2 : real(dp), pointer :: vals(:,:) ! (nz,num_profile_columns)
348 2 : logical, pointer :: is_int(:)
349 : logical, parameter :: write_flag = .true.
350 2 : names => null()
351 2 : vals => null()
352 2 : is_int => null()
353 : call do_profile_info(s, fname, &
354 2 : write_flag, names, vals, is_int, ierr)
355 2 : end subroutine write_profile_info
356 :
357 :
358 2 : subroutine do_profile_info(s, fname, &
359 : write_flag, names, vals, is_int, ierr)
360 2 : use chem_def
361 : use net_def ! categories
362 : use rates_def, only: i_rate
363 : use ctrls_io, only: write_controls
364 : use write_model, only: do_write_model
365 : use pulse, only: export_pulse_data
366 : use math_lib, only: math_backend
367 : use utils_lib, only: mkdir, folder_exists
368 :
369 : type (star_info), pointer :: s
370 : character (len=*) :: fname
371 : logical, intent(in) :: write_flag
372 : character (len=maxlen_profile_column_name), pointer :: names(:) ! (num_profile_columns)
373 : real(dp), pointer :: vals(:,:) ! (nz,num_profile_columns)
374 : logical, pointer :: is_int(:)
375 : integer, intent(out) :: ierr
376 :
377 2 : real(dp) :: mstar, dt
378 : integer :: io, i, j, jj, nz, col, k, kk, n, species, &
379 : num_specs, numcols, num_extra_cols, num_extra_header_items, num_digits
380 2 : integer, pointer :: chem_id(:)
381 : logical, parameter :: dbg = .false.
382 : character (len=strlen) :: fname1, dbl_fmt, int_fmt, txt_fmt, fname_out, fstring, str
383 : character (len=maxlen_profile_column_name), pointer :: &
384 2 : extra_col_names(:), extra_header_item_names(:)
385 2 : real(dp), pointer :: extra_col_vals(:,:), extra_header_item_vals(:)
386 : type(net_general_info),pointer :: g=>null()
387 :
388 : include "formats"
389 :
390 2 : dbl_fmt = s% profile_dbl_format
391 2 : int_fmt = s% profile_int_format
392 2 : txt_fmt = s% profile_txt_format
393 :
394 : ierr = 0
395 2 : nullify(extra_col_names, extra_col_vals)
396 :
397 2 : call get_net_ptr(s%net_handle, g, ierr)
398 2 : if(ierr/=0) return
399 :
400 2 : nz = s% nz
401 2 : species = s% species
402 2 : chem_id => s% chem_id
403 2 : mstar = s% mstar
404 2 : dt = s% dt
405 2 : if (.not. associated(s% profile_column_spec)) then
406 : num_specs = 0
407 : else
408 2 : num_specs = size(s% profile_column_spec, dim=1)
409 : end if
410 :
411 2 : if (num_specs == 0) then
412 0 : write(*,*) 'WARNING: do not have any output specified for profiles.'
413 0 : return
414 : end if
415 :
416 2 : numcols = do_get_num_standard_profile_columns(s)
417 :
418 2 : num_extra_cols = s% how_many_extra_profile_columns(s% id)
419 2 : if (num_extra_cols > 0) then
420 : allocate( &
421 0 : extra_col_names(num_extra_cols), extra_col_vals(nz,num_extra_cols), stat=ierr)
422 0 : if (ierr /= 0) return
423 0 : extra_col_names(1:num_extra_cols) = 'unknown'
424 0 : extra_col_vals(1:nz,1:num_extra_cols) = -1d99
425 : call s% data_for_extra_profile_columns( &
426 0 : s% id, num_extra_cols, nz, extra_col_names, extra_col_vals, ierr)
427 0 : if (ierr /= 0) then
428 0 : deallocate(extra_col_names, extra_col_vals)
429 0 : return
430 : end if
431 0 : do i=1,num_extra_cols
432 0 : if(trim(extra_col_names(i))=='unknown') then
433 0 : write(*,*) "Warning empty profile name for extra_profile_column ",i
434 : end if
435 : end do
436 : end if
437 :
438 2 : if (.not. write_flag) then
439 :
440 0 : if (associated(names)) then
441 0 : if (size(names,dim=1) < numcols+num_extra_cols) then
442 0 : write(*,2) 'size(names,dim=1)', size(names,dim=1)
443 0 : write(*,2) 'numcols+num_extra_cols', numcols+num_extra_cols
444 0 : write(*,2) 'numcols', numcols
445 0 : write(*,2) 'num_extra_cols', num_extra_cols
446 0 : write(*,*) 'bad size for names in do_profile_info'
447 0 : ierr = -1
448 0 : return
449 : end if
450 : else
451 0 : write(*,*) 'failed to provide names array for do_profile_info'
452 0 : ierr = -1
453 0 : return
454 : end if
455 :
456 0 : if (associated(vals)) then
457 0 : if (size(vals,dim=1) < nz) then
458 0 : write(*,2) 'size(vals,dim=1)', size(vals,dim=1)
459 0 : write(*,2) 'nz', nz
460 0 : write(*,*) 'bad size dim=1 for vals in do_profile_info'
461 0 : ierr = -1
462 0 : return
463 : end if
464 0 : if (size(vals,dim=2) < numcols+num_extra_cols) then
465 0 : write(*,2) 'size(vals,dim=2)', size(vals,dim=2)
466 0 : write(*,2) 'numcols+num_extra_cols', numcols+num_extra_cols
467 0 : write(*,2) 'numcols', numcols
468 0 : write(*,2) 'num_extra_cols', num_extra_cols
469 0 : write(*,*) 'bad size dim=1 for names in do_profile_info'
470 0 : ierr = -1
471 0 : return
472 : end if
473 : else
474 0 : write(*,*) 'failed to provide vals array for do_profile_info'
475 0 : ierr = -1
476 0 : return
477 : end if
478 :
479 : end if
480 :
481 2 : if (write_flag) then
482 2 : if(.not. folder_exists(trim(s% log_directory))) call mkdir(trim(s% log_directory))
483 :
484 2 : if (len_trim(s% profile_data_header_suffix) == 0) then
485 2 : fname1 = fname
486 : else
487 0 : fname1 = trim(fname) // s% profile_data_header_suffix
488 : end if
489 2 : open(newunit=io, file=trim(fname1), action='write', status='replace', iostat=ierr)
490 2 : if (ierr /= 0) then
491 0 : write(*,*) 'failed to open ' // trim(fname1)
492 0 : return
493 : end if
494 :
495 2 : num_extra_header_items = s% how_many_extra_profile_header_items(s% id)
496 2 : if (num_extra_header_items > 0) then
497 : allocate( &
498 : extra_header_item_names(num_extra_header_items), &
499 0 : extra_header_item_vals(num_extra_header_items), stat=ierr)
500 0 : if (ierr /= 0) then
501 : return
502 : end if
503 0 : extra_header_item_names(1:num_extra_header_items) = 'unknown'
504 0 : extra_header_item_vals(1:num_extra_header_items) = -1d99
505 : call s% data_for_extra_profile_header_items( &
506 : s% id, num_extra_header_items, &
507 0 : extra_header_item_names, extra_header_item_vals, ierr)
508 0 : if (ierr /= 0) then
509 0 : deallocate(extra_header_item_names, extra_header_item_vals)
510 0 : return
511 : end if
512 0 : do i=1,num_extra_header_items
513 0 : if(trim(extra_header_item_names(i))=='unknown') then
514 0 : write(*,*) "Warning empty profile name for extra_profile_header ",i
515 : end if
516 : end do
517 : end if
518 :
519 8 : do i=1, 3
520 6 : col = 0
521 6 : call do_integer(i, 'model_number', s% model_number)
522 6 : call do_integer(i, 'num_zones', s% nz)
523 6 : call do_val(i, 'initial_mass', s% initial_mass)
524 6 : call do_val(i, 'initial_z', s% initial_z)
525 6 : call do_val(i, 'star_age', s% star_age)
526 6 : call do_val(i, 'time_step', s% time_step)
527 :
528 6 : if (s% M_center /= 0d0) &
529 0 : call do_val(i, 'M_center', s% M_center)
530 6 : if (s% v_center /= 0d0) &
531 0 : call do_val(i, 'v_center', s% v_center)
532 6 : if (s% R_center /= 0d0) &
533 0 : call do_val(i, 'R_center', s% R_center)
534 6 : if (s% L_center /= 0d0) &
535 0 : call do_val(i, 'L_center', s% L_center)
536 :
537 6 : call do_val(i, 'Teff', s% Teff)
538 6 : call do_val(i, 'photosphere_L', s% photosphere_L)
539 6 : call do_val(i, 'photosphere_r', s% photosphere_r)
540 :
541 6 : call do_val(i, 'center_eta', s% center_degeneracy)
542 6 : call do_val(i, 'center_h1', s% center_h1)
543 6 : call do_val(i, 'center_he3', s% center_he3)
544 6 : call do_val(i, 'center_he4', s% center_he4)
545 6 : call do_val(i, 'center_c12', s% center_c12)
546 6 : call do_val(i, 'center_n14', s% center_n14)
547 6 : call do_val(i, 'center_o16', s% center_o16)
548 6 : call do_val(i, 'center_ne20', s% center_ne20)
549 6 : call do_val(i, 'star_mass', s% star_mass)
550 6 : call do_val(i, 'star_mdot', s% star_mdot)
551 6 : call do_val(i, 'star_mass_h1', s% star_mass_h1)
552 6 : call do_val(i, 'star_mass_he3', s% star_mass_he3)
553 6 : call do_val(i, 'star_mass_he4', s% star_mass_he4)
554 6 : call do_val(i, 'star_mass_c12', s% star_mass_c12)
555 6 : call do_val(i, 'star_mass_n14', s% star_mass_n14)
556 6 : call do_val(i, 'star_mass_o16', s% star_mass_o16)
557 6 : call do_val(i, 'star_mass_ne20', s% star_mass_ne20)
558 6 : call do_val(i, 'he_core_mass', s% he_core_mass)
559 6 : call do_val(i, 'co_core_mass', s% co_core_mass)
560 6 : call do_val(i, 'fe_core_mass', s% fe_core_mass)
561 6 : call do_val(i, 'neutron_rich_core_mass', s% neutron_rich_core_mass)
562 6 : call do_val(i, 'dynamic_time', s% dynamic_timescale)
563 6 : call do_val(i, 'kh_timescale', s% kh_timescale)
564 6 : call do_val(i, 'nuc_timescale', s% nuc_timescale)
565 :
566 6 : call do_val(i, 'power_nuc_burn', s% power_nuc_burn)
567 6 : call do_val(i, 'power_h_burn', s% power_h_burn)
568 6 : call do_val(i, 'power_he_burn', s% power_he_burn)
569 6 : call do_val(i, 'power_neu', s% power_neutrinos)
570 :
571 6 : call do_val(i, 'burn_min1', s% burn_min1)
572 6 : call do_val(i, 'burn_min2', s% burn_min2)
573 :
574 6 : call do_val(i, 'time_seconds', s% time)
575 :
576 6 : call do_string(i, 'version_number', version_number)
577 :
578 6 : if (s% profile_header_include_sys_details) then ! make this optional
579 6 : call do_string(i, 'compiler', compiler_name)
580 6 : call do_string(i, 'build', compiler_version_name)
581 6 : call do_string(i, 'MESA_SDK_version', mesasdk_version_name)
582 6 : call do_string(i, 'math_backend', math_backend)
583 6 : call do_string(i, 'date', date)
584 : end if
585 :
586 6 : call do_val(i, 'msun', msun)
587 6 : call do_val(i, 'rsun', rsun)
588 6 : call do_val(i, 'lsun', lsun)
589 :
590 6 : do j=1,num_extra_header_items
591 6 : call do_val(i, extra_header_item_names(j), extra_header_item_vals(j))
592 : end do
593 :
594 8 : write(io, *)
595 :
596 : end do
597 :
598 2 : write(io, *)
599 :
600 2 : if (num_extra_header_items > 0) &
601 0 : deallocate(extra_header_item_names, extra_header_item_vals)
602 :
603 : end if
604 :
605 8 : do i = 1, 3
606 :
607 6 : if (i==3) then
608 2 : if (s% max_num_profile_zones > 1) then
609 0 : n = min(nz, s% max_num_profile_zones)
610 : else
611 2 : n = nz
612 : end if
613 2 : if (write_flag .and. len_trim(s% profile_data_header_suffix) > 0) then
614 0 : close(io)
615 : open(newunit=io, file=trim(fname), &
616 0 : action='write', status='replace', iostat=ierr)
617 0 : if (ierr /= 0) then
618 0 : write(*,*) 'failed to open ' // trim(fname)
619 0 : return
620 : end if
621 : end if
622 : else
623 : n = 1
624 : end if
625 :
626 3468 : do k=1, n
627 3460 : col = 0
628 3460 : if (n > 1 .and. n < nz) then
629 0 : kk = floor(1.5d0 + dble(nz-1)*dble(k-1)/dble(n-1))
630 : else
631 3460 : kk = k
632 : end if
633 44980 : do j = 1, num_specs
634 41520 : if (s% profile_column_spec(j) == add_abundances .or. &
635 3460 : s% profile_column_spec(j) == add_log_abundances) then
636 0 : do jj = 1, species
637 0 : col = col+1
638 0 : call do_abundance_col(i, j, jj, kk)
639 : end do
640 : else if (s% profile_column_spec(j) == raw_rate_offset .or. &
641 : s% profile_column_spec(j) == screened_rate_offset .or. &
642 41520 : s% profile_column_spec(j) == eps_nuc_rate_offset .or. &
643 : s% profile_column_spec(j) == eps_neu_rate_offset) then
644 0 : do jj = 1, s% num_reactions
645 0 : col = col+1
646 0 : call do_col(i, j, jj, kk)
647 : end do
648 : else
649 41520 : col = col+1
650 41520 : call do_col(i, j, 0, kk)
651 : end if
652 : end do
653 3460 : do j=1,num_extra_cols
654 0 : col = col+1
655 3460 : call do_extra_col(i, j, kk)
656 : end do
657 3466 : if (write_flag) write(io, *)
658 : end do
659 :
660 : end do
661 :
662 2 : if (associated(extra_col_vals)) deallocate(extra_col_vals)
663 2 : if (associated(extra_col_names)) deallocate(extra_col_names)
664 :
665 6 : if (write_flag) then
666 :
667 2 : close(io)
668 :
669 2 : s% most_recent_profile_filename = trim(fname1)
670 :
671 2 : write(str,'(a)') 'save ' // trim(fname1)
672 2 : write(*,'(a)', advance='no') trim(str)
673 2 : call write_to_extra_terminal_output_file(s, str, .false.)
674 :
675 2 : if (s% write_pulse_data_with_profile) then
676 0 : fname_out = trim(fname) // '.' // trim(s% pulse_data_format)
677 : call export_pulse_data(s%id, s%pulse_data_format, fname_out, &
678 : s%add_center_point_to_pulse_data, s%keep_surface_point_for_pulse_data, &
679 0 : s%add_atmosphere_to_pulse_data, ierr)
680 0 : if (ierr /= 0) then
681 0 : write(*,*) 'save_pulsation_info failed to open ' // trim(fname_out)
682 0 : ierr = 0
683 : else
684 0 : write(*,'(a)', advance='no') ' ' // trim(fname_out)
685 : end if
686 : end if
687 :
688 2 : if (s% write_model_with_profile) then
689 0 : fname_out = s% model_data_filename
690 0 : call do_write_model(s% id, fname_out, ierr)
691 0 : if (ierr /= 0) then
692 0 : write(*,*) 'failed to open ' // trim(fname_out)
693 0 : ierr = 0
694 : else
695 0 : write(*,'(a)', advance='no') ' ' // trim(fname_out)
696 : end if
697 : end if
698 :
699 2 : if (s% write_controls_info_with_profile) then
700 0 : fname_out = s% model_controls_filename
701 0 : call write_controls(s, fname_out, ierr)
702 0 : if (ierr /= 0) then
703 0 : write(*,*) 'failed to write ' // trim(fname_out)
704 0 : ierr = 0
705 : else
706 0 : s% most_recent_controls_filename = trim(fname_out)
707 : end if
708 0 : write(*,'(a)', advance='no') ' ' // trim(fname_out)
709 : end if ! write_controls_info_with_profile
710 :
711 2 : num_digits = 1 + log10(dble(max(1,s% model_number)))
712 2 : write(fstring,'( "(a,i",i2.2,".",i2.2,")" )') num_digits, num_digits
713 :
714 2 : write(str,fstring) ' for model ', s% model_number
715 2 : write(*,'(a)') trim(str)
716 2 : call write_to_extra_terminal_output_file(s, str, .false.)
717 :
718 : end if
719 :
720 :
721 : contains
722 :
723 :
724 36 : subroutine do_string(pass, col_name, val)
725 : integer, intent(in) :: pass
726 : character (len=*), intent(in) :: col_name, val
727 : character(len=strlen) :: my_val
728 36 : col = col+1
729 36 : my_val = '"'//trim(val)//'"'
730 36 : if (pass == 1) then
731 12 : write(io, fmt=int_fmt, advance='no') col
732 24 : else if (pass == 2) then
733 12 : write(io, fmt=txt_fmt, advance='no') trim(col_name)
734 12 : else if (pass == 3) then
735 12 : write(io, fmt=txt_fmt, advance='no') adjustr(trim('"'//trim(val)//'"'))
736 : end if
737 2 : end subroutine do_string
738 :
739 :
740 12 : subroutine do_integer(pass, col_name, val)
741 : integer, intent(in) :: pass
742 : character (len=*), intent(in) :: col_name
743 : integer, intent(in) :: val
744 12 : col = col+1
745 12 : if (pass == 1) then
746 4 : write(io, fmt=int_fmt, advance='no') col
747 8 : else if (pass == 2) then
748 4 : write(io, fmt=txt_fmt, advance='no') trim(col_name)
749 4 : else if (pass == 3) then
750 4 : write(io, fmt=int_fmt, advance='no') val
751 : end if
752 12 : end subroutine do_integer
753 :
754 :
755 246 : subroutine do_val(pass, col_name, val)
756 : integer, intent(in) :: pass
757 : character (len=*), intent(in) :: col_name
758 : real(dp), intent(in) :: val
759 246 : real(dp) :: v
760 : include 'formats'
761 246 : col = col+1
762 246 : if (pass == 1) then
763 82 : write(io, fmt=int_fmt, advance='no') col
764 164 : else if (pass == 2) then
765 82 : write(io, fmt=txt_fmt, advance='no') trim(col_name)
766 82 : else if (pass == 3) then
767 82 : v = val
768 82 : if (is_bad_num(v)) then
769 0 : write(*,1) 'bad value for ' // trim(col_name), v
770 0 : if (s% stop_for_bad_nums) call mesa_error(__FILE__,__LINE__,'profile do_val')
771 0 : v = 0
772 : end if
773 82 : write(io, fmt=dbl_fmt, advance='no') v
774 : end if
775 246 : end subroutine do_val
776 :
777 :
778 0 : subroutine do_extra_col(pass, j, k)
779 : use rates_def
780 : integer, intent(in) :: pass, j, k
781 0 : if (pass == 1) then
782 0 : if (write_flag) write(io, fmt=int_fmt, advance='no') col
783 0 : else if (pass == 2) then
784 0 : if (write_flag) then
785 0 : write(io, fmt=txt_fmt, advance='no') trim(extra_col_names(j))
786 : else
787 0 : names(col) = trim(extra_col_names(j))
788 : end if
789 0 : else if (pass == 3) then
790 0 : if (write_flag) then
791 0 : write(io, fmt=dbl_fmt, advance='no') extra_col_vals(k,j)
792 : else
793 0 : vals(k,col) = extra_col_vals(k,j)
794 0 : is_int(col) = .false.
795 : end if
796 : end if
797 0 : end subroutine do_extra_col
798 :
799 :
800 41520 : subroutine do_col(pass, j, jj, k)
801 0 : use rates_def
802 : use profile_getval, only: getval_for_profile
803 : integer, intent(in) :: pass, j, jj, k
804 : integer :: i, c, int_val, ir
805 : real(dp) :: val
806 : logical :: int_flag
807 : character (len=128) :: col_name
808 : logical, parameter :: dbg = .false.
809 : include 'formats'
810 41520 : c = s% profile_column_spec(j) + jj
811 41520 : val = 0; int_val = 0
812 41520 : if (pass == 1) then
813 24 : if (write_flag) write(io, fmt=int_fmt, advance='no') col
814 41496 : else if (pass == 2) then
815 24 : if (c > extra_offset) then
816 0 : i = c - extra_offset
817 0 : col_name = trim(s% profile_extra_name(i))
818 24 : else if (c > eps_neu_rate_offset) then
819 0 : i = c - eps_neu_rate_offset
820 0 : ir = g% reaction_id(i)
821 0 : col_name = 'eps_neu_rate_' // trim(reaction_name(ir))
822 24 : else if (c > eps_nuc_rate_offset) then
823 0 : i = c - eps_nuc_rate_offset
824 0 : ir = g% reaction_id(i)
825 0 : col_name = 'eps_nuc_rate_' // trim(reaction_name(ir))
826 24 : else if (c > screened_rate_offset) then
827 0 : i = c - screened_rate_offset
828 0 : ir = g% reaction_id(i)
829 0 : col_name = 'screened_rate_' // trim(reaction_name(ir))
830 24 : else if (c > raw_rate_offset) then
831 0 : i = c - raw_rate_offset
832 0 : ir = g% reaction_id(i)
833 0 : col_name = 'raw_rate_' // trim(reaction_name(ir))
834 24 : else if (c > diffusion_D_offset) then
835 0 : i = c - diffusion_D_offset
836 0 : col_name = 'diffusion_D_' // trim(chem_isos% name(i))
837 24 : else if (c > diffusion_dX_offset) then
838 0 : i = c - diffusion_dX_offset
839 0 : col_name = 'diffusion_dX_' // trim(chem_isos% name(i))
840 24 : else if (c > log_concentration_offset) then
841 0 : i = c - log_concentration_offset
842 0 : col_name = 'log_concentration_' // trim(chem_isos% name(i))
843 24 : else if (c > log_g_rad_offset) then
844 0 : i = c - log_g_rad_offset
845 0 : col_name = 'log_g_rad_' // trim(chem_isos% name(i))
846 24 : else if (c > v_rad_offset) then
847 0 : i = c - v_rad_offset
848 0 : col_name = 'v_rad_' // trim(chem_isos% name(i))
849 24 : else if (c > extra_diffusion_factor_offset) then
850 0 : i = c - extra_diffusion_factor_offset
851 0 : col_name = 'extra_diffusion_factor_' // trim(chem_isos% name(i))
852 24 : else if (c > edv_offset) then
853 0 : i = c - edv_offset
854 0 : col_name = 'edv_' // trim(chem_isos% name(i))
855 24 : else if (c > typical_charge_offset) then
856 0 : i = c - typical_charge_offset
857 0 : col_name = 'typical_charge_' // trim(chem_isos% name(i))
858 24 : else if (c > ionization_offset) then
859 0 : i = c - ionization_offset
860 0 : col_name = 'ionization_' // trim(chem_isos% name(i))
861 24 : else if (c > xaprev_offset) then
862 0 : i = c - xaprev_offset
863 0 : col_name = 'xaprev_' // trim(chem_isos% name(i))
864 24 : else if (c > xadot_offset) then
865 0 : i = c - xadot_offset
866 0 : col_name = 'xadot_' // trim(chem_isos% name(i))
867 24 : else if (c > log_abundance_offset) then
868 0 : i = c - log_abundance_offset
869 0 : col_name = 'log_' // trim(chem_isos% name(i))
870 24 : else if (c > abundance_offset) then
871 0 : i = c - abundance_offset
872 0 : col_name = trim(chem_isos% name(i))
873 24 : else if (c > category_offset) then
874 6 : i = c - category_offset
875 6 : col_name = trim(category_name(i))
876 : else
877 18 : col_name = trim(profile_column_name(c))
878 : end if
879 24 : if (write_flag) then
880 24 : write(io, fmt=txt_fmt, advance='no') trim(col_name)
881 : else
882 0 : names(col) = trim(col_name)
883 : end if
884 41472 : else if (pass == 3) then
885 41472 : call getval_for_profile(s, c, k, val, int_flag, int_val)
886 41472 : if (write_flag) then
887 41472 : if (int_flag) then
888 3456 : write(io, fmt=int_fmt, advance='no') int_val
889 : else
890 38016 : if (is_bad(val)) val = 1d99
891 38016 : write(io, fmt=dbl_fmt, advance='no') val
892 : end if
893 : else
894 0 : if (int_flag) then
895 0 : vals(k,col) = dble(int_val)
896 0 : is_int(col) = .true.
897 : else
898 0 : vals(k,col) = val
899 0 : is_int(col) = .false.
900 : end if
901 : end if
902 : end if
903 41520 : end subroutine do_col
904 :
905 :
906 0 : subroutine do_abundance_col(pass, j, jj, k)
907 : integer, intent(in) :: pass, j, jj, k
908 0 : real(dp) :: val
909 : logical :: log_abundance
910 : character (len=128) :: col_name
911 : logical, parameter :: dbg = .false.
912 : include 'formats'
913 0 : log_abundance = (s% profile_column_spec(j) == add_log_abundances)
914 0 : if (pass == 1) then
915 0 : if (write_flag) write(io, fmt=int_fmt, advance='no') col
916 0 : else if (pass == 2) then
917 0 : if (log_abundance) then
918 0 : col_name = 'log_'
919 : else
920 0 : col_name = ''
921 : end if
922 0 : col_name = trim(col_name) // trim(chem_isos% name(s% chem_id(jj)))
923 0 : if (write_flag) then
924 0 : write(io, fmt=txt_fmt, advance='no') trim(col_name)
925 : else
926 0 : names(col) = trim(col_name)
927 : end if
928 0 : else if (pass == 3) then
929 0 : val = s% xa(jj,k)
930 0 : if (log_abundance) val = safe_log10(val)
931 0 : if (write_flag) then
932 0 : write(io, fmt=dbl_fmt, advance='no') val
933 : else
934 0 : vals(k,col) = val
935 0 : is_int(col) = .false.
936 : end if
937 : end if
938 41520 : end subroutine do_abundance_col
939 :
940 :
941 : end subroutine do_profile_info
942 :
943 :
944 2 : subroutine do_save_profiles( &
945 : s, ierr)
946 : type (star_info), pointer :: s
947 : integer, intent(out) :: ierr
948 :
949 2 : integer, pointer, dimension(:) :: model_numbers, model_priorities, model_logs
950 : integer :: nz, max_num_mods, num_models, model_profile_number
951 : character (len=strlen) :: fname
952 : integer :: model_priority
953 :
954 : include 'formats'
955 :
956 2 : ierr = 0
957 2 : nz = s% nz
958 :
959 2 : if (.not. s% write_profiles_flag) return
960 3458 : if (.not. s% v_flag) s% v(1:nz) = 0
961 3458 : if (.not. s% u_flag) s% u(1:nz) = 0
962 3458 : if (.not. s% rotation_flag) s% omega(1:nz) = 0
963 :
964 2 : max_num_mods = s% max_num_profile_models
965 2 : if (max_num_mods < 0) max_num_mods = s% model_number
966 2 : model_priority = s% save_profiles_model_priority
967 :
968 : allocate(model_numbers(max_num_mods), model_priorities(max_num_mods), &
969 2 : model_logs(max_num_mods), stat=ierr)
970 2 : if (ierr /= 0) return
971 :
972 2 : write(fname, '(3a)') trim(s% log_directory), '/', trim(s% profiles_index_name)
973 :
974 : call read_profiles_info( &
975 2 : fname, max_num_mods, num_models, model_numbers, model_priorities, model_logs)
976 :
977 : call make_room_for_profile_info( &
978 2 : s% model_number, max_num_mods, num_models, model_numbers, model_priorities, model_logs, ierr)
979 2 : if (ierr /= 0) then
980 0 : call dealloc; return
981 : end if
982 :
983 : call pick_model_profile_number( &
984 2 : max_num_mods, num_models, model_logs, model_profile_number, ierr)
985 2 : if (ierr /= 0) then
986 0 : call dealloc; return
987 : end if
988 :
989 2 : call get_model_profile_filename(s, model_profile_number)
990 :
991 : ! add the new model to the list at the end
992 2 : num_models = num_models+1
993 2 : model_numbers(num_models) = s% model_number
994 2 : model_priorities(num_models) = model_priority
995 2 : model_logs(num_models) = model_profile_number
996 :
997 2 : s% save_profiles_model_priority = delta_priority ! reset it to the default value
998 :
999 : ! write the profiles before adding them to the list
1000 : ! so if user interrupts during write, the index is still okay.
1001 2 : call write_profile_info(s, s% model_profile_filename, ierr)
1002 2 : if (ierr /= 0) then
1003 0 : call dealloc; return
1004 : end if
1005 :
1006 : call write_profiles_list( &
1007 2 : fname, num_models, model_numbers, model_priorities, model_logs, ierr)
1008 2 : if (ierr /= 0) then
1009 0 : call dealloc; return
1010 : end if
1011 :
1012 10 : call dealloc
1013 :
1014 :
1015 : contains
1016 :
1017 2 : subroutine dealloc
1018 2 : deallocate(model_numbers, model_priorities, model_logs)
1019 2 : end subroutine dealloc
1020 :
1021 : end subroutine do_save_profiles
1022 :
1023 :
1024 2 : subroutine write_profiles_list( &
1025 : fname, num_models, model_numbers, model_priorities, model_logs, ierr)
1026 : character (len=*), intent(in) :: fname
1027 : integer, intent(in) :: num_models
1028 : integer, pointer, dimension(:) :: model_numbers, model_priorities, model_logs
1029 : integer, intent(out) :: ierr
1030 : integer :: iounit, i
1031 2 : ierr = 0
1032 : ! write the new list
1033 2 : open(newunit=iounit, file=trim(fname), action='write', iostat=ierr)
1034 2 : if (ierr /= 0) then
1035 0 : write(*, *) 'failed to open ' // trim(fname)
1036 : else
1037 2 : if (num_models == 1) then
1038 1 : write(iounit, *) num_models, &
1039 2 : 'model. lines hold model number, priority, and profile number.'
1040 : else
1041 1 : write(iounit, *) num_models, &
1042 2 : 'models. lines hold model number, priority, and profile number.'
1043 : end if
1044 5 : do i=1, num_models
1045 5 : write(iounit, *) model_numbers(i), model_priorities(i), model_logs(i)
1046 : end do
1047 2 : close(iounit)
1048 : end if
1049 2 : end subroutine write_profiles_list
1050 :
1051 :
1052 2 : subroutine pick_model_profile_number( &
1053 : max_num_mods, num_models, model_logs, model_profile_number, ierr)
1054 : integer, intent(in) :: max_num_mods
1055 : integer, intent(inout) :: num_models
1056 : integer, pointer, dimension(:) :: model_logs
1057 : integer, intent(out) :: model_profile_number, ierr
1058 4 : logical :: in_use(max_num_mods)
1059 : integer :: i
1060 : ! pick log number for the new model
1061 2 : ierr = 0
1062 202 : in_use = .false.
1063 3 : do i=1, num_models
1064 3 : in_use(model_logs(i)) = .true.
1065 : end do
1066 2 : model_profile_number = 0
1067 3 : do i=1, max_num_mods
1068 3 : if (.not. in_use(i)) then
1069 2 : model_profile_number = i; exit
1070 : end if
1071 : end do
1072 2 : if (model_profile_number == 0) then
1073 0 : write(*, *) 'model_profile_number == 0, cannot happen?'
1074 0 : ierr = -1
1075 : return
1076 : end if
1077 2 : end subroutine pick_model_profile_number
1078 :
1079 :
1080 2 : subroutine make_room_for_profile_info( &
1081 : model_number, max_num_mods, num_models, model_numbers, model_priorities, model_logs, ierr)
1082 : integer, intent(in) :: model_number, max_num_mods
1083 : integer, intent(inout) :: num_models
1084 : integer, pointer, dimension(:) :: model_numbers, model_priorities, model_logs
1085 : integer, intent(out) :: ierr
1086 : integer :: i, j, nm
1087 : logical, parameter :: dbg = .false.
1088 : include 'formats'
1089 2 : ierr = 0
1090 : ! delete models with model number greater or equal to current model number
1091 2 : nm = num_models; j = 0
1092 3 : do i=1, nm
1093 3 : if (model_numbers(i) < model_number .and. model_logs(i) <= max_num_mods) then
1094 : ! keep this one
1095 1 : j = j+1
1096 1 : if (j < i) then
1097 0 : model_numbers(j) = model_numbers(i)
1098 0 : model_priorities(j) = model_priorities(i)
1099 0 : model_logs(j) = model_logs(i)
1100 : end if
1101 : end if
1102 : end do
1103 2 : num_models = j
1104 2 : if (num_models == max_num_mods) then ! pick one to delete
1105 : j = 1
1106 0 : do i=2, num_models
1107 : if (dbg) then
1108 : write(*,3) 'model_priorities(i)', i, model_priorities(i)
1109 : write(*,3) 'model_priorities(j)', j, model_priorities(j)
1110 : write(*,3) 'model_numbers(i)', i, model_numbers(i)
1111 : write(*,3) 'model_numbers(j)', j, model_numbers(j)
1112 : write(*,*) 'model_priorities(i) < model_priorities(j)', model_priorities(i) < model_priorities(j)
1113 : write(*,*) 'model_numbers(i) < model_numbers(j)', model_numbers(i) < model_numbers(j)
1114 : end if
1115 0 : if (model_priorities(i) < model_priorities(j)) then
1116 : if (dbg) write(*,3) '1 change j'
1117 : j = i
1118 0 : else if (model_priorities(i) == model_priorities(j) .and. &
1119 : model_numbers(i) < model_numbers(j)) then
1120 : if (dbg) write(*,3) '2 change j'
1121 0 : j = i
1122 : end if
1123 : if (dbg) write(*,3) 'new j', j
1124 0 : if (dbg) write(*,*)
1125 : end do
1126 : ! delete j
1127 : if (dbg) write(*,*) 'delete j', j
1128 0 : do i=j+1, num_models
1129 0 : model_numbers(i-1) = model_numbers(i)
1130 0 : model_priorities(i-1) = model_priorities(i)
1131 0 : model_logs(i-1) = model_logs(i)
1132 : end do
1133 0 : num_models = num_models-1
1134 : end if
1135 2 : end subroutine make_room_for_profile_info
1136 :
1137 :
1138 2 : subroutine read_profiles_info( &
1139 : fname, max_num_mods, num_models, model_numbers, model_priorities, model_logs)
1140 : character (len=*), intent(in) :: fname
1141 : integer, intent(in) :: max_num_mods
1142 : integer, intent(out) :: num_models
1143 : integer, pointer, dimension(:) :: model_numbers, model_priorities, model_logs
1144 : integer :: iounit, i, ierr
1145 2 : num_models = 0
1146 2 : ierr = 0
1147 2 : open(newunit=iounit, file=trim(fname), action='read', status='old', iostat=ierr)
1148 2 : if (ierr == 0) then ! file exists
1149 1 : read(iounit, *, iostat=ierr) num_models
1150 1 : if (ierr == 0) then
1151 1 : if (num_models > max_num_mods) num_models = max_num_mods
1152 2 : do i=1, num_models
1153 1 : read(iounit, *, iostat=ierr) model_numbers(i), model_priorities(i), model_logs(i)
1154 2 : if (ierr /= 0) exit
1155 : end do
1156 : end if
1157 1 : close(iounit)
1158 1 : if (ierr /= 0) num_models = 0
1159 : end if
1160 2 : end subroutine read_profiles_info
1161 :
1162 :
1163 2 : subroutine get_model_profile_filename(s, model_profile_number)
1164 : ! sets s% model_profile_filename and s% model_controls_filename
1165 : type (star_info), pointer :: s
1166 : integer, intent(in) :: model_profile_number
1167 : character (len=strlen) :: profile_prefix, controls_prefix, model_prefix, fstring
1168 : integer :: num_digits
1169 :
1170 2 : profile_prefix = trim(s% log_directory) // '/' // trim(s% profile_data_prefix)
1171 2 : controls_prefix = trim(s% log_directory) // '/' // trim(s% controls_data_prefix)
1172 2 : model_prefix = trim(s% log_directory) // '/' // trim(s% model_data_prefix)
1173 :
1174 2 : num_digits = 1 + log10(dble(max(1,model_profile_number)))
1175 2 : write(fstring,'( "(a,i",i2.2,".",i2.2,",a)" )') num_digits, num_digits
1176 :
1177 : write(s% model_profile_filename, fmt=fstring) &
1178 2 : trim(profile_prefix), model_profile_number, trim(s% profile_data_suffix)
1179 : write(s% model_controls_filename, fmt=fstring) &
1180 2 : trim(controls_prefix), model_profile_number, trim(s% controls_data_suffix)
1181 : write(s% model_data_filename, fmt=fstring) &
1182 2 : trim(model_prefix), model_profile_number, trim(s% model_data_suffix)
1183 :
1184 2 : end subroutine get_model_profile_filename
1185 :
1186 : end module profile
|
