From ebf24bdac8a15b4dc71d013bfbcb57de995c12bc Mon Sep 17 00:00:00 2001 From: matthiasfabry Date: Thu, 31 Oct 2024 11:55:06 -0400 Subject: [PATCH 1/2] fix binary_history.f90 to ignore spec checks in pgbinary_summary.f90 --- binary/private/binary_history.f90 | 37 ++++++++++++++++--------- binary/private/binary_history_specs.f90 | 21 ++++++++------ binary/private/pgbinary_summary.f90 | 2 +- binary/private/run_binary_support.f90 | 2 +- 4 files changed, 38 insertions(+), 24 deletions(-) diff --git a/binary/private/binary_history.f90 b/binary/private/binary_history.f90 index 8d21fec9a..74e751400 100644 --- a/binary/private/binary_history.f90 +++ b/binary/private/binary_history.f90 @@ -70,7 +70,7 @@ subroutine data_for_binary_history_columns(& integer, intent(out) :: ierr type (binary_info), pointer :: b - integer :: c, int_val, j + integer :: c, int_val, i, j logical :: is_int_val real(dp) :: val @@ -121,7 +121,7 @@ subroutine do_binary_history_info(b, write_flag, ierr) integer, intent(out) :: ierr character (len = strlen) :: fname, dbl_fmt, int_fmt, txt_fmt - integer :: numcols, io, i, col, j, i0, n + integer :: numcols, io, i, nz, col, j, i0, n integer :: num_extra_header_items, num_extra_cols @@ -408,7 +408,8 @@ end subroutine do_col_pass1 subroutine do_col_pass2(j) ! get the column name integer, intent(in) :: j character (len = 100) :: col_name - integer :: c + character (len = 10) :: str + integer :: c, i, ii c = b% binary_history_column_spec(j) col_name = trim(binary_history_column_name(c)) call do_name(j, col_name) @@ -417,9 +418,9 @@ end subroutine do_col_pass2 subroutine do_col_pass3(c) ! get the column value integer, intent(in) :: c - integer :: k, int_val + integer :: i, ii, k, int_val logical :: is_int_val - real(dp) :: val + real(dp) :: val, val1, Ledd, power_photo, frac int_val = 0; val = 0; is_int_val = .false. call binary_history_getval(& b, c, val, int_val, is_int_val, ierr) @@ -520,6 +521,7 @@ subroutine binary_history_getval(b, c, val, int_val, is_int_val, ierr) integer, intent(out) :: int_val logical, intent(out) :: is_int_val integer, intent(out) :: ierr + integer :: k, i include 'formats' @@ -753,7 +755,7 @@ subroutine binary_history_getval(b, c, val, int_val, is_int_val, ierr) end subroutine binary_history_getval - subroutine get_binary_history_specs(b, num, names, specs) + subroutine get_binary_history_specs(b, num, names, specs, report) use utils_lib use utils_def @@ -762,9 +764,11 @@ subroutine get_binary_history_specs(b, num, names, specs) integer, intent(in) :: num character (len = *), intent(in) :: names(:) integer, intent(out) :: specs(:) + logical, intent(in) :: report integer :: i, ierr, n, j, iounit, t character (len = strlen) :: buffer, string + logical :: special_case include 'formats' ierr = 0 @@ -778,15 +782,17 @@ subroutine get_binary_history_specs(b, num, names, specs) j = 0 t = token(iounit, n, j, buffer, string) if (t /= name_token) then - if (len_trim(names(i)) > 0) & + if (len_trim(names(i)) > 0 .and. report) & write(*, *) 'bad value for name of history item ' // trim(names(i)) specs(i) = -1 ierr = 0 cycle end if + special_case = .false. specs(i) = do1_binary_history_spec(& - iounit, t, n, j, string, buffer, ierr) - if (ierr /= 0) then + iounit, t, n, j, string, buffer, report, ierr) + if (ierr /= 0 .or. special_case) then + if (report) write(*, *) 'get_binary_history_specs failed for ' // trim(names(i)) specs(i) = -1 ierr = 0 end if @@ -810,7 +816,10 @@ subroutine get_binary_history_values(b, num, specs, & real(dp), intent(inout) :: values(:) logical, intent(out) :: failed_to_find_value(:) - integer :: i, c, ierr + integer :: i, c, int_val, ierr, n, t, j, iounit + real(dp) :: val + logical :: is_int_val, special_case + character (len = strlen) :: buffer, string include 'formats' ierr = 0 @@ -833,14 +842,16 @@ subroutine get_binary_history_values(b, num, specs, & end subroutine get_binary_history_values logical function get1_binary_hist_value(b, name, val) - ! includes other_history_columns from run_star_extras + ! includes other_history_columns from run_binary_extras use utils_lib, only : integer_dict_lookup type (binary_info), pointer :: b character (len = *) :: name real(dp), intent(out) :: val integer :: i, ierr, num_extra_cols - character (len = 80), pointer, dimension(:) :: extra_col_names - real(dp), pointer, dimension(:) :: extra_col_vals + character (len = 80), pointer, dimension(:) :: & + extra_col_names, binary_col_names + real(dp), pointer, dimension(:) :: & + extra_col_vals, binary_col_vals include 'formats' get1_binary_hist_value = .false. diff --git a/binary/private/binary_history_specs.f90 b/binary/private/binary_history_specs.f90 index 297540bdf..d4581d04c 100644 --- a/binary/private/binary_history_specs.f90 +++ b/binary/private/binary_history_specs.f90 @@ -41,7 +41,7 @@ module binary_history_specs contains recursive subroutine add_binary_history_columns(& - b, level, capacity, spec, history_columns_file, ierr) + b, level, capacity, spec, history_columns_file, report, ierr) use utils_lib use utils_def use const_def, only : mesa_dir @@ -49,10 +49,11 @@ recursive subroutine add_binary_history_columns(& integer, intent(in) :: level integer, intent(inout) :: capacity integer, pointer :: spec(:) + logical, intent(in) :: report character (len = *), intent(in) :: history_columns_file integer, intent(out) :: ierr - integer :: iounit, n, i, t, j, nxt_spec + integer :: iounit, n, i, t, id, j, cnt, ii, nxt_spec character (len = 256) :: buffer, string, filename integer, parameter :: max_level = 20 logical :: bad_item @@ -107,7 +108,7 @@ recursive subroutine add_binary_history_columns(& if (t /= string_token) then call error; return end if - call add_binary_history_columns(b, level + 1, capacity, spec, string, ierr) + call add_binary_history_columns(b, level + 1, capacity, spec, string, report, ierr) if (ierr /= 0) then write(*, *) 'failed for included log columns list ' // trim(string) bad_item = .true. @@ -116,7 +117,7 @@ recursive subroutine add_binary_history_columns(& cycle end if - nxt_spec = do1_binary_history_spec(iounit, t, n, i, string, buffer, ierr) + nxt_spec = do1_binary_history_spec(iounit, t, n, i, string, buffer, report, ierr) if (ierr /= 0) bad_item = .true. if (.not. bad_item) then call insert_spec(nxt_spec, string, ierr) @@ -190,13 +191,14 @@ end subroutine add_binary_history_columns integer function do1_binary_history_spec(& - iounit, t, n, i, string, buffer, ierr) result(spec) + iounit, t, n, i, string, buffer, report, ierr) result(spec) use utils_lib use utils_def use chem_lib - integer :: iounit, t, n, i, j + integer :: iounit, t, n, i, j, id character (len = *) :: string, buffer + logical, intent(in) :: report integer, intent(out) :: ierr ierr = 0 @@ -209,15 +211,16 @@ integer function do1_binary_history_spec(& end if end do - write(*, *) 'bad history list name: ' // trim(string) + if (report) write(*, *) 'bad history list name: ' // trim(string) ierr = -1 end function do1_binary_history_spec - subroutine set_binary_history_columns(b, binary_history_columns_file, ierr) + subroutine set_binary_history_columns(b, binary_history_columns_file, report, ierr) use utils_lib, only : realloc_integer type(binary_info), pointer :: b character (len = *), intent(in) :: binary_history_columns_file + logical, intent(in) :: report integer, intent(out) :: ierr integer :: capacity, cnt, i logical, parameter :: dbg = .false. @@ -235,7 +238,7 @@ subroutine set_binary_history_columns(b, binary_history_columns_file, ierr) if (ierr /= 0) return b% binary_history_column_spec(:) = 0 call add_binary_history_columns(b, 1, capacity, & - b% binary_history_column_spec, binary_history_columns_file, ierr) + b% binary_history_column_spec, binary_history_columns_file, report, ierr) if (ierr /= 0) then if (associated(old_binary_history_column_spec)) & deallocate(old_binary_history_column_spec) diff --git a/binary/private/pgbinary_summary.f90 b/binary/private/pgbinary_summary.f90 index b040207b1..58d8d14f1 100644 --- a/binary/private/pgbinary_summary.f90 +++ b/binary/private/pgbinary_summary.f90 @@ -403,7 +403,7 @@ subroutine show_column(col, num_rows) real(dp) :: val call get_binary_history_specs(& - b, num_rows, Text_Summary_name(:, col), specs) + b, num_rows, Text_Summary_name(:, col), specs, .false.) call get_binary_history_values(& b, num_rows, specs, & is_int_value, int_values, values, failed_to_find_value) diff --git a/binary/private/run_binary_support.f90 b/binary/private/run_binary_support.f90 index d84f375d0..ef6a91c2f 100644 --- a/binary/private/run_binary_support.f90 +++ b/binary/private/run_binary_support.f90 @@ -290,7 +290,7 @@ end subroutine extras_binary_controls call binarydata_init(b, doing_restart) call binary_private_def_init call binary_history_column_names_init(ierr) - call set_binary_history_columns(b, b% job% binary_history_columns_file, ierr) + call set_binary_history_columns(b, b% job% binary_history_columns_file, .true., ierr) ! setup pgbinary if (.not. doing_restart) then From 53da1aff9b1bdce5ee7cfb0069873c25cde3479a Mon Sep 17 00:00:00 2001 From: matthiasfabry Date: Thu, 31 Oct 2024 12:07:38 -0400 Subject: [PATCH 2/2] remove unused variables --- binary/private/binary_history.f90 | 27 +++++++++---------------- binary/private/binary_history_specs.f90 | 4 ++-- 2 files changed, 11 insertions(+), 20 deletions(-) diff --git a/binary/private/binary_history.f90 b/binary/private/binary_history.f90 index 74e751400..32515098f 100644 --- a/binary/private/binary_history.f90 +++ b/binary/private/binary_history.f90 @@ -70,7 +70,7 @@ subroutine data_for_binary_history_columns(& integer, intent(out) :: ierr type (binary_info), pointer :: b - integer :: c, int_val, i, j + integer :: c, int_val, j logical :: is_int_val real(dp) :: val @@ -121,7 +121,7 @@ subroutine do_binary_history_info(b, write_flag, ierr) integer, intent(out) :: ierr character (len = strlen) :: fname, dbl_fmt, int_fmt, txt_fmt - integer :: numcols, io, i, nz, col, j, i0, n + integer :: numcols, io, i, col, j, i0, n integer :: num_extra_header_items, num_extra_cols @@ -408,8 +408,7 @@ end subroutine do_col_pass1 subroutine do_col_pass2(j) ! get the column name integer, intent(in) :: j character (len = 100) :: col_name - character (len = 10) :: str - integer :: c, i, ii + integer :: c c = b% binary_history_column_spec(j) col_name = trim(binary_history_column_name(c)) call do_name(j, col_name) @@ -418,9 +417,9 @@ end subroutine do_col_pass2 subroutine do_col_pass3(c) ! get the column value integer, intent(in) :: c - integer :: i, ii, k, int_val + integer :: k, int_val logical :: is_int_val - real(dp) :: val, val1, Ledd, power_photo, frac + real(dp) :: val int_val = 0; val = 0; is_int_val = .false. call binary_history_getval(& b, c, val, int_val, is_int_val, ierr) @@ -521,7 +520,6 @@ subroutine binary_history_getval(b, c, val, int_val, is_int_val, ierr) integer, intent(out) :: int_val logical, intent(out) :: is_int_val integer, intent(out) :: ierr - integer :: k, i include 'formats' @@ -768,7 +766,6 @@ subroutine get_binary_history_specs(b, num, names, specs, report) integer :: i, ierr, n, j, iounit, t character (len = strlen) :: buffer, string - logical :: special_case include 'formats' ierr = 0 @@ -788,10 +785,9 @@ subroutine get_binary_history_specs(b, num, names, specs, report) ierr = 0 cycle end if - special_case = .false. specs(i) = do1_binary_history_spec(& iounit, t, n, j, string, buffer, report, ierr) - if (ierr /= 0 .or. special_case) then + if (ierr /= 0) then if (report) write(*, *) 'get_binary_history_specs failed for ' // trim(names(i)) specs(i) = -1 ierr = 0 @@ -816,10 +812,7 @@ subroutine get_binary_history_values(b, num, specs, & real(dp), intent(inout) :: values(:) logical, intent(out) :: failed_to_find_value(:) - integer :: i, c, int_val, ierr, n, t, j, iounit - real(dp) :: val - logical :: is_int_val, special_case - character (len = strlen) :: buffer, string + integer :: i, c, ierr include 'formats' ierr = 0 @@ -848,10 +841,8 @@ logical function get1_binary_hist_value(b, name, val) character (len = *) :: name real(dp), intent(out) :: val integer :: i, ierr, num_extra_cols - character (len = 80), pointer, dimension(:) :: & - extra_col_names, binary_col_names - real(dp), pointer, dimension(:) :: & - extra_col_vals, binary_col_vals + character (len = 80), pointer, dimension(:) :: extra_col_names + real(dp), pointer, dimension(:) :: extra_col_vals include 'formats' get1_binary_hist_value = .false. diff --git a/binary/private/binary_history_specs.f90 b/binary/private/binary_history_specs.f90 index d4581d04c..5f9722d22 100644 --- a/binary/private/binary_history_specs.f90 +++ b/binary/private/binary_history_specs.f90 @@ -53,7 +53,7 @@ recursive subroutine add_binary_history_columns(& character (len = *), intent(in) :: history_columns_file integer, intent(out) :: ierr - integer :: iounit, n, i, t, id, j, cnt, ii, nxt_spec + integer :: iounit, n, i, t, j, nxt_spec character (len = 256) :: buffer, string, filename integer, parameter :: max_level = 20 logical :: bad_item @@ -196,7 +196,7 @@ integer function do1_binary_history_spec(& use utils_def use chem_lib - integer :: iounit, t, n, i, j, id + integer :: iounit, t, n, i, j character (len = *) :: string, buffer logical, intent(in) :: report integer, intent(out) :: ierr