From b554b328c83e1f1cb9ff1b51e8a7bf788def40bb Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Fri, 14 Jun 2024 13:07:53 -0400 Subject: [PATCH 01/13] fix: modern_diag_manager use the correct date in file name for static files (#1540) --- diag_manager/diag_manager.F90 | 2 +- diag_manager/fms_diag_file_object.F90 | 29 +++-- diag_manager/fms_diag_object.F90 | 13 +- test_fms/diag_manager/Makefile.am | 7 +- test_fms/diag_manager/test_prepend_date.F90 | 124 ++++++++++++++++++++ test_fms/diag_manager/test_prepend_date.sh | 87 ++++++++++++++ 6 files changed, 244 insertions(+), 18 deletions(-) create mode 100644 test_fms/diag_manager/test_prepend_date.F90 create mode 100755 test_fms/diag_manager/test_prepend_date.sh diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index eeab1a5227..ab94fe6901 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -4210,7 +4210,7 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) END IF if (use_modern_diag) then - CALL fms_diag_object%init(diag_subset_output) + CALL fms_diag_object%init(diag_subset_output, time_init) endif if (.not. use_modern_diag) then CALL parse_diag_table(DIAG_SUBSET=diag_subset_output, ISTAT=mystat, ERR_MSG=err_msg_local) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 060dfd8c3a..612e080db1 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -35,7 +35,7 @@ module fms_diag_file_object_mod get_base_second, time_unit_list, time_average, time_rms, time_max, time_min, time_sum, & time_diurnal, time_power, time_none, avg_name, no_units, pack_size_str, & middle_time, begin_time, end_time, MAX_STR_LEN, index_gridtype, latlon_gridtype, & - null_gridtype, flush_nc_files + null_gridtype, flush_nc_files, diag_init_time use time_manager_mod, only: time_type, operator(>), operator(/=), operator(==), get_date, get_calendar_type, & VALID_CALENDAR_TYPES, operator(>=), date_to_string, & OPERATOR(/), OPERATOR(+), operator(<) @@ -259,9 +259,13 @@ logical function fms_diag_files_object_init (files_array) !> Set the start_time of the file to the base_time and set up the *_output variables obj%done_writing_data = .false. - obj%start_time = get_base_time() - obj%last_output = get_base_time() - obj%model_time = get_base_time() + + !! Set this to the time passed in to diag_manager_init + !! This will be the base_time if nothing was passed in + !! This time is appended to the filename if the prepend_date namelist is .True. + obj%start_time = diag_init_time + obj%last_output = diag_init_time + obj%model_time = diag_init_time obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit()) obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit()) @@ -1003,20 +1007,21 @@ end subroutine define_new_subaxis !! So it needs to make sure that the start_time is the same for each variable. The initial value is the base_time subroutine add_start_time(this, start_time) class(fmsDiagFile_type), intent(inout) :: this !< The file object - TYPE(time_type), intent(in) :: start_time !< Start time to add to the fileobj + TYPE(time_type), intent(in) :: start_time !< Start time passed into register_diag_field - !< If the start_time sent in is equal to the base_time return because - !! this%start_time was already set to the base_time - if (start_time .eq. get_base_time()) return + !< If the start_time sent in is equal to the diag_init_time return because + !! this%start_time was already set to the diag_init_time + if (start_time .eq. diag_init_time) return - if (this%start_time .ne. get_base_time()) then - !> If the this%start_time is not equal to the base_time from the diag_table - !! this%start_time was already updated so make sure it is the same or error out + if (this%start_time .ne. diag_init_time) then + !> If the this%start_time is not equal to the diag_init_time from the diag_table + !! this%start_time was already updated so make sure it is the same for the current variable + !! or error out if (this%start_time .ne. start_time)& call mpp_error(FATAL, "The variables associated with the file:"//this%get_file_fname()//" have"& &" different start_time") else - !> If the this%start_time is equal to the base_time, + !> If the this%start_time is equal to the diag_init_time, !! simply update it with the start_time and set up the *_output variables this%model_time = start_time this%start_time = start_time diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 70141a0077..a1fc92cc31 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -22,7 +22,7 @@ module fms_diag_object_mod &DIAG_FIELD_NOT_FOUND, diag_not_registered, max_axes, TWO_D_DOMAIN, & &get_base_time, NULL_AXIS_ID, get_var_type, diag_not_registered, & &time_none, time_max, time_min, time_sum, time_average, time_diurnal, & - &time_power, time_rms, r8, NO_DOMAIN + &time_power, time_rms, r8, NO_DOMAIN, diag_init_time USE time_manager_mod, ONLY: set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),& & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, & @@ -118,14 +118,23 @@ module fms_diag_object_mod !! Reads the diag_table.yaml and fills in the yaml object !! Allocates the diag manager object arrays for files, fields, and buffers !! Initializes variables -subroutine fms_diag_object_init (this,diag_subset_output) +subroutine fms_diag_object_init (this,diag_subset_output, time_init) class(fmsDiagObject_type) :: this !< Diag mediator/controller object integer :: diag_subset_output !< Subset of the diag output? + INTEGER, DIMENSION(6), OPTIONAL, INTENT(IN) :: time_init !< Model time diag_manager initialized + #ifdef use_yaml if (this%initialized) return ! allocate(diag_objs(get_num_unique_fields())) CALL diag_yaml_object_init(diag_subset_output) + + !! Doing this here, because the base_time is not set until the yaml is parsed + !! if time_init is present, it will be set in diag_manager_init + if (.not. present(time_init)) then + diag_init_time = get_base_time() + endif + this%axes_initialized = fms_diag_axis_object_init(this%diag_axis) this%files_initialized = fms_diag_files_object_init(this%FMS_diag_files) this%fields_initialized = fms_diag_fields_object_init(this%FMS_diag_fields) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index df5a8a19fa..a224eb2451 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \ check_time_min check_time_max check_time_sum check_time_avg test_diag_diurnal check_time_diurnal \ check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \ check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \ - test_dm_weights + test_dm_weights test_prepend_date # This is the source code for the test. test_output_every_freq_SOURCES = test_output_every_freq.F90 @@ -64,6 +64,7 @@ check_subregional_SOURCES = check_subregional.F90 test_var_masks_SOURCES = test_var_masks.F90 check_var_masks_SOURCES = check_var_masks.F90 test_multiple_send_data_SOURCES = test_multiple_send_data.F90 +test_prepend_date_SOURCES = test_prepend_date.F90 TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ @@ -73,7 +74,7 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ TESTS = test_diag_manager2.sh test_time_none.sh test_time_min.sh test_time_max.sh test_time_sum.sh \ test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh test_cell_measures.sh \ test_subregional.sh test_var_masks.sh test_multiple_send_data.sh test_output_every_freq.sh \ - test_dm_weights.sh test_flush_nc_file.sh + test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh testing_utils.mod: testing_utils.$(OBJEXT) @@ -81,7 +82,7 @@ testing_utils.mod: testing_utils.$(OBJEXT) EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_time_none.sh test_time_min.sh test_time_max.sh \ test_time_sum.sh test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh \ test_cell_measures.sh test_subregional.sh test_var_masks.sh test_multiple_send_data.sh \ - test_flush_nc_file.sh test_dm_weights.sh test_output_every_freq.sh + test_flush_nc_file.sh test_dm_weights.sh test_output_every_freq.sh test_prepend_date.sh if USING_YAML skipflag="" diff --git a/test_fms/diag_manager/test_prepend_date.F90 b/test_fms/diag_manager/test_prepend_date.F90 new file mode 100644 index 0000000000..24a5ae2986 --- /dev/null +++ b/test_fms/diag_manager/test_prepend_date.F90 @@ -0,0 +1,124 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +!> @brief This programs tests diag manager when the init date is prepended to the file name +program test_prepend_date + + use fms_mod, only: fms_init, fms_end, string + use diag_manager_mod, only: diag_axis_init, send_data, diag_send_complete, diag_manager_set_time_end, & + register_diag_field, diag_manager_init, diag_manager_end, register_static_field, & + diag_axis_init + use time_manager_mod, only: time_type, operator(+), JULIAN, set_time, set_calendar_type, set_date + use mpp_mod, only: FATAL, mpp_error, input_nml_file + use fms2_io_mod, only: FmsNetcdfFile_t, open_file, close_file, read_data, get_dimension_size + use platform_mod, only: r4_kind + + implicit none + + integer :: id_var0, id_var2, id_var1 !< diag field ids + integer :: id_axis1 !< Id for axis + logical :: used !< for send_data calls + integer :: ntimes = 48 !< Number of time steps + real :: vdata !< Buffer to store the data + type(time_type) :: Time !< "Model" time + type(time_type) :: Time_step !< Time step for the "simulation" + integer :: i !< For do loops + logical :: pass_diag_time = .True. !< .True. if passing the time to diag_manager_init + + integer :: io_status !< Status when reading the namelist + + namelist / test_prepend_date_nml / pass_diag_time + + call fms_init + + read (input_nml_file, test_prepend_date_nml, iostat=io_status) + if (io_status > 0) call mpp_error(FATAL,'=>test_prepend_date: Error reading input.nml') + + call set_calendar_type(JULIAN) + + ! This is going to be different from the base_date + if (pass_diag_time) then + call diag_manager_init(time_init=(/2, 1, 1, 0, 0, 0/)) + else + call diag_manager_init() + endif + + Time = set_date(2,1,1,0,0,0) + Time_step = set_time (3600,0) !< 1 hour + call diag_manager_set_time_end(set_date(2,1,3,0,0,0)) + + id_axis1 = diag_axis_init('dummy_axis', (/real(1.)/), "mullions", "X") + id_var0 = register_diag_field ('ocn_mod', 'var0', Time) + id_var2 = register_static_field ('ocn_mod', 'var2', (/id_axis1/)) + + ! This is a different start_time, should lead to a crash if the variable is in the diag table yaml + id_var1 = register_diag_field ('ocn_mod', 'var1', set_date(2,1,6,0,0,0)) + + used = send_data(id_var2, real(123.456)) + do i = 1, ntimes + Time = Time + Time_step + vdata = real(i) + + used = send_data(id_var0, vdata, Time) !< Sending data every hour! + + call diag_send_complete(Time_step) + enddo + + call diag_manager_end(Time) + + call check_output() + call fms_end + + contains + + !< @brief Check the diag manager output + subroutine check_output() + type(FmsNetcdfFile_t) :: fileobj !< Fms2io fileobj + integer :: var_size !< Size of the variable reading + real(kind=r4_kind), allocatable :: var_data(:) !< Buffer to read variable data to + integer :: j !< For looping + + if (.not. open_file(fileobj, "00020101.test_non_static.nc", "read")) & + call mpp_error(FATAL, "Error opening file:00020101.test_non_static.nc to read") + + call get_dimension_size(fileobj, "time", var_size) + if (var_size .ne. 48) call mpp_error(FATAL, "The dimension of time in the file:test_0days is not the "//& + "correct size!") + allocate(var_data(var_size)) + var_data = -999.99 + + call read_data(fileobj, "var0", var_data) + do j = 1, var_size + if (var_data(j) .ne. real(j, kind=r4_kind)) call mpp_error(FATAL, "The variable data for var1 at time level:"//& + string(j)//" is not the correct value!") + enddo + + call close_file(fileobj) + + if (.not. open_file(fileobj, "00020101.test_static.nc", "read")) & + call mpp_error(FATAL, "Error opening file:00020101.test_static.nc to read") + + call read_data(fileobj, "var2", var_data(1)) + if (var_data(1) .ne. real(123.456, kind=r4_kind)) call mpp_error(FATAL, & + "The variable data for var2 is not the correct value!") + + call close_file(fileobj) + + end subroutine check_output +end program test_prepend_date diff --git a/test_fms/diag_manager/test_prepend_date.sh b/test_fms/diag_manager/test_prepend_date.sh new file mode 100755 index 0000000000..13bbf7c77a --- /dev/null +++ b/test_fms/diag_manager/test_prepend_date.sh @@ -0,0 +1,87 @@ +#!/bin/sh + +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS is free software: you can redistribute it and/or modify it under +#* the terms of the GNU Lesser General Public License as published by +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# Set common test settings. +. ../test-lib.sh + +if [ -z "${skipflag}" ]; then +# create and enter directory for in/output files +output_dir + +cat <<_EOF > diag_table.yaml +title: test_prepend_date +base_date: 1 1 1 0 0 0 +diag_files: +- file_name: test_non_static + time_units: hours + unlimdim: time + freq: 1 hours + varlist: + - module: ocn_mod + var_name: var0 + reduction: average + kind: r4 +- file_name: test_static + time_units: hours + unlimdim: time + freq: -1 hours + varlist: + - module: ocn_mod + var_name: var2 + reduction: none + kind: r4 +_EOF + +# remove any existing files that would result in false passes during checks +rm -f *.nc +my_test_count=1 +printf "&diag_manager_nml \n use_modern_diag=.true. \n/" | cat > input.nml +test_expect_success "Running diag_manager and checking that the date was prepended correctly (test $my_test_count)" ' + mpirun -n 1 ../test_prepend_date +' + +cat <<_EOF > diag_table.yaml +title: test_prepend_date +base_date: 1 1 1 0 0 0 +diag_files: +- file_name: test_non_static + time_units: hours + unlimdim: time + freq: 1 hours + varlist: + - module: ocn_mod + var_name: var0 + reduction: average + kind: r4 + - module: ocn_mod + var_name: var1 + reduction: average + kind: r4 +_EOF + +printf "&diag_manager_nml \n use_modern_diag=.true. \n/ \n &test_prepend_date_nml \n pass_diag_time=.false. \n /" | cat > input.nml + +test_expect_failure "Running diag_manager with fields that have a different start time (test $my_test_count)" ' + mpirun -n 1 ../test_prepend_date +' + +fi +test_done From c056f78f6d8d58f271cd162c3a03f367f2886248 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Fri, 14 Jun 2024 13:08:44 -0400 Subject: [PATCH 02/13] chore: change log and version updates for 2024.01.02 patch (#1546) --- CHANGELOG.md | 19 +++++++++++++++++++ CMakeLists.txt | 2 +- configure.ac | 2 +- libFMS/Makefile.am | 2 +- 4 files changed, 22 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3359cc8743..eaa76d0282 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,25 @@ and this project uses `yyyy.rr[.pp]`, where `yyyy` is the year a patch is releas `rr` is a sequential release number (starting from `01`), and an optional two-digit sequential patch number (starting from `01`). +## [2024.01.02] - 2024-06-14 + +### Known Issues +- Diag Manager Rewrite: + - Expected output file changes: + - If the model run time is less than the output frequency, old diag_manager would write a specific value (9.96921e+36). The new diag_manager will not, so only fill values will be present. + - A `scalar_axis` dimension will not be added to scalar variables + - The `average_*` variables will no longer be added as they are non-standard conventions + - Attributes added via `diag_field_add_attributes` in the old code were saved as `NF90_FLOAT` regardless of precision, but will now be written as the precision that is passed in + - Subregional output will have a global attribute `is_subregional = True` set for non-global history files. + - The `grid_type` and `grid_tile` global attributes will no longer be added for all files, and some differences may be seen in the exact order of the `associated_files` attribute + +- DIAG_MANAGER: When using the `do_diag_field_log` nml option, the output log file may be ovewritten if using a multiple root pe's +- BUILD(HDF5): HDF5 version 1.14.3 generates floating point exceptions, and will cause errors if FMS is built with FPE traps enabled. +- GCC: version 14.1.0 is unsupported due to a bug with strings that has come up previously in earlier versions. This will be caught by the configure script, but will cause compilation errors if using other build systems. + +### Fixed +- DIAG_MANAGER: Fixes incorrect dates being appended to static file names + ## [2024.01.01] - 2024-05-30 ### Known Issues diff --git a/CMakeLists.txt b/CMakeLists.txt index 8dca1bdcf5..7076227a85 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,7 +26,7 @@ set(CMAKE_Fortran_FLAGS_DEBUG) # Define the CMake project project(FMS - VERSION 2024.01.01 + VERSION 2024.01.02 DESCRIPTION "GFDL FMS Library" HOMEPAGE_URL "https://www.gfdl.noaa.gov/fms" LANGUAGES C Fortran) diff --git a/configure.ac b/configure.ac index b48a5c5f65..ca1fc49696 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.69]) # Initialize with name, version, and support email address. AC_INIT([GFDL FMS Library], - [2024.01.01-dev], + [2024.01.02], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) diff --git a/libFMS/Makefile.am b/libFMS/Makefile.am index 1ab8d13920..133ddfa665 100644 --- a/libFMS/Makefile.am +++ b/libFMS/Makefile.am @@ -28,7 +28,7 @@ lib_LTLIBRARIES = libFMS.la # These linker flags specify libtool version info. # See http://www.gnu.org/software/libtool/manual/libtool.html#Libtool-versioning # for information regarding incrementing `-version-info`. -libFMS_la_LDFLAGS = -version-info 19:1:0 +libFMS_la_LDFLAGS = -version-info 19:2:0 # Add the convenience libraries to the FMS library. libFMS_la_LIBADD = $(top_builddir)/platform/libplatform.la From cc51e1f14a0ac4b8c0b7a9b5da718b71a6504607 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall Date: Fri, 14 Jun 2024 13:58:00 -0400 Subject: [PATCH 03/13] chore: append -dev to version number --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index ca1fc49696..3abdcc0119 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.69]) # Initialize with name, version, and support email address. AC_INIT([GFDL FMS Library], - [2024.01.02], + [2024.01.02-dev], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) From 0c778563c3820a8c375728ac47dc34bc94dc946b Mon Sep 17 00:00:00 2001 From: Jesse Lentz <42011922+J-Lentz@users.noreply.github.com> Date: Fri, 21 Jun 2024 08:50:19 -0400 Subject: [PATCH 04/13] feat: Enable use of `verbose` option in `time_interp_external2` calls from `data_override` (#1516) --- data_override/include/data_override.inc | 146 +++++++++++++----------- 1 file changed, 79 insertions(+), 67 deletions(-) diff --git a/data_override/include/data_override.inc b/data_override/include/data_override.inc index a7385677d8..84c22e9527 100644 --- a/data_override/include/data_override.inc +++ b/data_override/include/data_override.inc @@ -857,7 +857,7 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data_out,time,override,data ! record fieldname, gridname in override_array override_array(curr_position)%fieldname = fieldname_code override_array(curr_position)%gridname = gridname - id_time = init_external_field(filename,fieldname,verbose=.false.) + id_time = init_external_field(filename,fieldname,verbose=debug_data_override) if(id_time<0) call mpp_error(FATAL,'data_override:field not found in init_external_field 1') override_array(curr_position)%t_index = id_time else !curr_position >0 @@ -871,7 +871,7 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data_out,time,override,data if_multi1: if (multifile) then id_time_prev = -1 if_prev1: if (trim(prevfilename) /= '') then - id_time_prev = init_external_field(prevfilename,fieldname,verbose=.false.) + id_time_prev = init_external_field(prevfilename,fieldname,verbose=debug_data_override) dims = get_external_field_size(id_time) prev_dims = get_external_field_size(id_time_prev) ! check consistency of spatial dims @@ -884,7 +884,7 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data_out,time,override,data endif if_prev1 id_time_next = -1 if_next1: if (trim(nextfilename) /= '') then - id_time_next = init_external_field(nextfilename,fieldname,verbose=.false.) + id_time_next = init_external_field(nextfilename,fieldname,verbose=debug_data_override) dims = get_external_field_size(id_time) next_dims = get_external_field_size(id_time_next) ! check consistency of spatial dims @@ -916,17 +916,17 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data_out,time,override,data prev_dims = get_external_field_size(id_time_prev) if (timelast_record) then if (id_time_next<0) call mpp_error(FATAL,'data_override:next file needed with multifile') if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') - call time_interp_external_bridge(id_time, id_time_next,time,data_out,verbose=.false.) + call time_interp_external_bridge(id_time, id_time_next,time,data_out,verbose=debug_data_override) else ! first_record < time < last_record, do not use bridge - call time_interp_external(id_time,time,data_out,verbose=.false.) + call time_interp_external(id_time,time,data_out,verbose=debug_data_override) endif if_time2 else ! standard behavior - call time_interp_external(id_time,time,data_out,verbose=.false.) + call time_interp_external(id_time,time,data_out,verbose=debug_data_override) endif if_multi2 @@ -1159,7 +1159,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d endif if_multi3 !--- we always only pass data on compute domain - id_time = init_external_field(filename,fieldname,domain=domain,verbose=.false., & + id_time = init_external_field(filename,fieldname,domain=domain,verbose=debug_data_override, & use_comp_domain=use_comp_domain, nwindows=nwindows, ongrid=ongrid) ! if using consecutive files for data_override, get time axis for previous and next files @@ -1168,7 +1168,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d id_time_prev = -1 if_prev4:if (trim(prevfilename) /= '') then id_time_prev = init_external_field(prevfilename,fieldname,domain=domain, & - verbose=.false.,use_comp_domain=use_comp_domain, & + verbose=debug_data_override,use_comp_domain=use_comp_domain, & nwindows = nwindows, ongrid=ongrid) dims = get_external_field_size(id_time) prev_dims = get_external_field_size(id_time_prev) @@ -1183,7 +1183,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d id_time_next = -1 if_next4: if (trim(nextfilename) /= '') then id_time_next = init_external_field(nextfilename,fieldname,domain=domain, & - verbose=.false.,use_comp_domain=use_comp_domain, & + verbose=debug_data_override,use_comp_domain=use_comp_domain, & nwindows = nwindows, ongrid=ongrid) dims = get_external_field_size(id_time) next_dims = get_external_field_size(id_time_next) @@ -1205,7 +1205,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d override_array(curr_position)%nt_index = id_time_next else !ongrid=false id_time = init_external_field(filename,fieldname,domain=domain, axis_names=axis_names,& - axis_sizes=axis_sizes, verbose=.false.,override=.true.,use_comp_domain=use_comp_domain, & + axis_sizes=axis_sizes, verbose=debug_data_override,override=.true.,use_comp_domain=use_comp_domain, & nwindows = nwindows) ! if using consecutive files for data_override, get time axis for previous and next files @@ -1214,7 +1214,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d id_time_prev = -1 if_prev5: if (trim(prevfilename) /= '') then id_time_prev = init_external_field(prevfilename,fieldname,domain=domain, axis_names=axis_names,& - axis_sizes=axis_sizes, verbose=.false.,override=.true.,use_comp_domain=use_comp_domain, & + axis_sizes=axis_sizes, verbose=debug_data_override,override=.true.,use_comp_domain=use_comp_domain, & nwindows = nwindows) prev_dims = get_external_field_size(id_time_prev) allocate(data_table(index1)%time_prev_records(prev_dims(4))) @@ -1223,7 +1223,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d id_time_next = -1 if_next5: if (trim(nextfilename) /= '') then id_time_next = init_external_field(nextfilename,fieldname,domain=domain, axis_names=axis_names,& - axis_sizes=axis_sizes, verbose=.false.,override=.true.,use_comp_domain=use_comp_domain, & + axis_sizes=axis_sizes, verbose=debug_data_override,override=.true.,use_comp_domain=use_comp_domain, & nwindows = nwindows) next_dims = get_external_field_size(id_time_next) allocate(data_table(index1)%time_next_records(next_dims(4))) @@ -1475,7 +1475,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d if (timelast_record) then ! next file must be init and time must be between last record of current file and @@ -1484,14 +1484,14 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') ! bridge with next file - call time_interp_external_bridge(id_time,id_time_next,time,return_data(:,:,1),verbose=.false., & + call time_interp_external_bridge(id_time,id_time_next,time,return_data(:,:,1),verbose=debug_data_override, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=debug_data_override, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time6 else ! standard behavior - call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=debug_data_override, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi6 @@ -1512,8 +1512,9 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d 'data_override: time_interp_external_bridge should only be called to bridge with previous file') ! bridge with previous file call time_interp_external_bridge(id_time_prev,id_time,time,& - return_data(startingi:endingi,startingj:endingj,1),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + return_data(startingi:endingi,startingj:endingj,1), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) elseif (time>last_record) then ! next file must be init and time must be between last record of current file and ! first record of next file @@ -1522,15 +1523,18 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d 'data_override: time_interp_external_bridge should only be called to bridge with next file') ! bridge with next file call time_interp_external_bridge(id_time,id_time_next,time,& - return_data(startingi:endingi,startingj:endingj,1),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + return_data(startingi:endingi,startingj:endingj,1), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,1),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,1), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) endif if_time7 else ! standard behavior - call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,1),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,1), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi7 end if @@ -1550,20 +1554,20 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d prev_dims = get_external_field_size(id_time_prev) if (timelast_record) then if (id_time_next<0) call mpp_error(FATAL,'data_override:next file needed with multifile') if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') - call time_interp_external_bridge(id_time,id_time_next,time,return_data,verbose=.false., & + call time_interp_external_bridge(id_time,id_time_next,time,return_data,verbose=debug_data_override, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=debug_data_override, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time8 else ! standard behavior - call time_interp_external(id_time,time,return_data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=debug_data_override, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi8 @@ -1581,22 +1585,26 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d if (timelast_record) then if (id_time_next<0) call mpp_error(FATAL,'data_override:next file needed with multifile') if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') call time_interp_external_bridge(id_time,id_time_next,time,& - return_data(startingi:endingi,startingj:endingj,:),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + return_data(startingi:endingi,startingj:endingj,:), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,:),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,:), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) endif if_time9 else ! standard behavior - call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,:),verbose=.false., & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,:), & + verbose=debug_data_override,is_in=is_in,ie_in=ie_in, & + js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi9 end if @@ -1616,23 +1624,25 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d prev_dims = get_external_field_size(id_time_prev) if (timelast_record) then if (id_time_next<0) call mpp_error(FATAL,'data_override:next file needed with multifile') if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') - call time_interp_external_bridge(id_time,id_time_next,time,return_data(:,:,1),verbose=.false., & + call time_interp_external_bridge(id_time,id_time_next,time,return_data(:,:,1), & + verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time10 else ! standard behavior - call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi10 @@ -1654,29 +1664,31 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d prev_dims = get_external_field_size(id_time_prev) if (timelast_record) then if (id_time_next<0) call mpp_error(FATAL,'data_override:next file needed with multifile') if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') - call time_interp_external_bridge(id_time,id_time_next,time,return_data(:,:,1),verbose=.false., & - horz_interp=override_array(curr_position)%horz_interp(window_id), & - mask_out =mask_out(:,:,1), & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external_bridge(id_time,id_time_next,time,return_data(:,:,1), & + verbose=debug_data_override, & + horz_interp=override_array(curr_position)%horz_interp(window_id), & + mask_out =mask_out(:,:,1), & + is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & - horz_interp=override_array(curr_position)%horz_interp(window_id), & - mask_out =mask_out(:,:,1), & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external(id_time,time,return_data(:,:,1),verbose=debug_data_override, & + horz_interp=override_array(curr_position)%horz_interp(window_id), & + mask_out =mask_out(:,:,1), & + is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time11 else ! standard behavior - call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & - horz_interp=override_array(curr_position)%horz_interp(window_id), & - mask_out =mask_out(:,:,1), & - is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) + call time_interp_external(id_time,time,return_data(:,:,1),verbose=debug_data_override, & + horz_interp=override_array(curr_position)%horz_interp(window_id), & + mask_out =mask_out(:,:,1), & + is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi11 where(mask_out(:,:,1)) @@ -1701,23 +1713,23 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d prev_dims = get_external_field_size(id_time_prev) if (timelast_record) then if (id_time_next<0) call mpp_error(FATAL,'data_override:next file needed with multifile') if (time>data_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') - call time_interp_external_bridge(id_time,id_time_next,time,return_data,verbose=.false., & + call time_interp_external_bridge(id_time,id_time_next,time,return_data,verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time12 else ! standard behavior - call time_interp_external(id_time,time,return_data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi12 @@ -1736,7 +1748,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d prev_dims = get_external_field_size(id_time_prev) if (timedata_table(index1)%time_next_records(1)) call mpp_error(FATAL, & 'data_override: time_interp_external_bridge should only be called to bridge with next file') - call time_interp_external_bridge(id_time,id_time_next,time,return_data,verbose=.false., & + call time_interp_external_bridge(id_time,id_time_next,time,return_data,verbose=debug_data_override, & horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else ! first_record <= time <= last_record, do not use bridge - call time_interp_external(id_time,time,return_data,verbose=.false., & - horz_interp=override_array(curr_position)%horz_interp(window_id), & + call time_interp_external(id_time,time,return_data,verbose=debug_data_override, & + horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time13 else ! standard behavior - call time_interp_external(id_time,time,return_data,verbose=.false., & - horz_interp=override_array(curr_position)%horz_interp(window_id), & + call time_interp_external(id_time,time,return_data,verbose=debug_data_override, & + horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi13 From 98ea776c7c501cde4f7003867ce626175afb102e Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Fri, 21 Jun 2024 08:53:28 -0400 Subject: [PATCH 05/13] fix: cmake debug target changes and update ci (#1532) --- .github/workflows/github_cmake_gnu.yml | 3 ++- CMakeLists.txt | 10 ++-------- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/.github/workflows/github_cmake_gnu.yml b/.github/workflows/github_cmake_gnu.yml index de71dcbbdf..8512d5fa8a 100644 --- a/.github/workflows/github_cmake_gnu.yml +++ b/.github/workflows/github_cmake_gnu.yml @@ -15,10 +15,11 @@ jobs: omp-flags: [ -DOPENMP=on, -DOPENMP=off ] libyaml-flag: [ "", -DWITH_YAML=on ] io-flag: [ "", -DUSE_DEPRECATED_IO=on ] + build-type: [ "-DCMAKE_BUILD_TYPE=Release", "-DCMAKE_BUILD_TYPE=Debug" ] container: image: ghcr.io/noaa-gfdl/fms/fms-ci-rocky-gnu:13.2.0 env: - CMAKE_FLAGS: "${{ matrix.omp-flags }} ${{ matrix.io-flag }} ${{ matrix.libyaml-flag }} -D64BIT=on" + CMAKE_FLAGS: "${{ matrix.build-type }} ${{ matrix.omp-flags }} ${{ matrix.io-flag }} ${{ matrix.libyaml-flag }} -D64BIT=on" steps: - name: Checkout code uses: actions/checkout@v4 diff --git a/CMakeLists.txt b/CMakeLists.txt index 8dca1bdcf5..5711269c71 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -21,9 +21,6 @@ cmake_minimum_required(VERSION 3.12 FATAL_ERROR) -# add build type for debug, overrides default flags (set with $FCFLAGS, $CFLAGS) -set(CMAKE_Fortran_FLAGS_DEBUG) - # Define the CMake project project(FMS VERSION 2024.01.01 @@ -339,11 +336,8 @@ foreach(kind ${kinds}) target_compile_definitions(${libTgt}_f PRIVATE "${fms_defs}") target_compile_definitions(${libTgt}_f PRIVATE "${${kind}_defs}") - string(TOLOWER ${CMAKE_BUILD_TYPE} build_type) - if (NOT build_type STREQUAL debug) - set_target_properties(${libTgt}_f PROPERTIES COMPILE_FLAGS - "${${kind}_flags}") - endif() + set_target_properties(${libTgt}_f PROPERTIES COMPILE_FLAGS "${${kind}_flags}") + set_target_properties(${libTgt}_f PROPERTIES Fortran_MODULE_DIRECTORY ${moduleDir}) From 6ac3002997ea22d1ba256ebc44309bb2f8dc7675 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Mon, 24 Jun 2024 13:08:21 -0400 Subject: [PATCH 06/13] fix: add return status optional argument to coupler_types_send_data (#1530) --- coupler/coupler_types.F90 | 41 ++++++++++++++++++-- test_fms/coupler/test_atmos_ocean_fluxes.F90 | 3 +- test_fms/coupler/test_coupler.sh | 20 ++++++++++ test_fms/coupler/test_coupler_types.F90 | 31 +++++++++++++-- 4 files changed, 86 insertions(+), 9 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 515eb8ed8f..ab616ed981 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -2944,10 +2944,12 @@ end subroutine CT_set_diags_3d !> @brief Write out all diagnostics of elements of a coupler_2d_bc_type - !! TODO this should really be a function in order to return the status of send_data call - subroutine CT_send_data_2d(var, Time) + subroutine CT_send_data_2d(var, Time, return_statuses) type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write type(time_type), intent(in) :: time !< The current model time + logical, allocatable, optional, intent(out) :: return_statuses(:,:) !< Return status of send data calls + !! first index is index of boundary condition + !! second index is field/value within that boundary condition integer :: m, n logical :: used @@ -2966,18 +2968,33 @@ subroutine CT_send_data_2d(var, Time) ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out if(associated(var%bc) .or. var%num_bcs .lt. 1) then + + ! allocate array for returned send data statuses + if( present(return_statuses) .and. var%num_bcs .gt. 0) then + allocate(return_statuses(var%num_bcs, var%bc(1)%num_fields)) + endif + do n = 1, var%num_bcs do m = 1, var%bc(n)%num_fields if (var%bc(n)%field(m)%id_diag > 0) then used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) + if(allocated(return_statuses)) return_statuses(n,m) = used endif enddo enddo + else if(associated(var%bc_r4)) then + + ! allocate array for returned send data statuses + if( present(return_statuses) .and. var%num_bcs .gt. 0) then + allocate(return_statuses(var%num_bcs, var%bc_r4(1)%num_fields)) + endif + do n = 1, var%num_bcs do m = 1, var%bc_r4(n)%num_fields if (var%bc_r4(n)%field(m)%id_diag > 0) then used = send_data(var%bc_r4(n)%field(m)%id_diag, var%bc_r4(n)%field(m)%values, Time) + if(allocated(return_statuses)) return_statuses(n,m) = used endif enddo enddo @@ -2988,10 +3005,12 @@ subroutine CT_send_data_2d(var, Time) end subroutine CT_send_data_2d !> @brief Write out all diagnostics of elements of a coupler_3d_bc_type - !! TODO this should really be a function in order to return the status of send_data call - subroutine CT_send_data_3d(var, Time) + subroutine CT_send_data_3d(var, Time, return_statuses) type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write type(time_type), intent(in) :: time !< The current model time + logical, allocatable, optional, intent(out) :: return_statuses(:,:) !< Return status of send data calls + !! first index is index of boundary condition + !! second index is field/value within that boundary condition integer :: m, n logical :: used @@ -3010,18 +3029,32 @@ subroutine CT_send_data_3d(var, Time) ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out if(associated(var%bc) .or. var%num_bcs .lt. 1) then + + ! allocate array for returned send data statuses + if( present(return_statuses) .and. var%num_bcs .gt. 0) then + allocate(return_statuses(var%num_bcs, var%bc(1)%num_fields)) + endif + do n = 1, var%num_bcs do m = 1, var%bc(n)%num_fields if (var%bc(n)%field(m)%id_diag > 0) then used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) + if(allocated(return_statuses)) return_statuses(n,m) = used endif enddo enddo else if(associated(var%bc_r4)) then + + ! allocate array for returned send data statuses + if( present(return_statuses) .and. var%num_bcs .gt. 0) then + allocate(return_statuses(var%num_bcs, var%bc_r4(1)%num_fields)) + endif + do n = 1, var%num_bcs do m = 1, var%bc_r4(n)%num_fields if (var%bc_r4(n)%field(m)%id_diag > 0) then used = send_data(var%bc_r4(n)%field(m)%id_diag, var%bc_r4(n)%field(m)%values, Time) + if(allocated(return_statuses)) return_statuses(n,m) = used endif enddo enddo diff --git a/test_fms/coupler/test_atmos_ocean_fluxes.F90 b/test_fms/coupler/test_atmos_ocean_fluxes.F90 index 80a8294251..742ac4c50f 100644 --- a/test_fms/coupler/test_atmos_ocean_fluxes.F90 +++ b/test_fms/coupler/test_atmos_ocean_fluxes.F90 @@ -23,7 +23,7 @@ !! @description This program tests the two main subroutines in atmos_ocean_fluxes. program test_atmos_ocean_fluxes - use fms_mod, only: fms_init + use fms_mod, only: fms_init, fms_end use coupler_types_mod, only: coupler_1d_bc_type use field_manager_mod, only: fm_exists, fm_get_value use fm_util_mod, only: fm_util_get_real_array @@ -81,6 +81,7 @@ program test_atmos_ocean_fluxes call test_atmos_ocean_fluxes_init !> checking gas_fluxes, gas_fields_atm, and gas_fields_ice have been initialized correctly call test_coupler_1d_bc_type + call fms_end contains !-------------------------------------- diff --git a/test_fms/coupler/test_coupler.sh b/test_fms/coupler/test_coupler.sh index 030a33269a..4512cca557 100755 --- a/test_fms/coupler/test_coupler.sh +++ b/test_fms/coupler/test_coupler.sh @@ -26,6 +26,7 @@ # Set common test settings. . ../test-lib.sh +rm -f input.nml touch input.nml # diag_table for test @@ -112,6 +113,25 @@ test_expect_success "coupler types interfaces (r8_kind)" ' mpirun -n 4 ./test_coupler_types_r8 ' +# delete lines from the table to make sure we see the difference in the send_data return status +sed -i '8,12{d}' diag_table +sed -i '10,13{d}' diag_table.yaml +sed -i '18,25{d}' diag_table.yaml +cat <<_EOF > input.nml +&test_coupler_types_nml + fail_return_status=.true. +/ +_EOF + + +test_expect_success "coupler types interfaces - check send_data return vals (r4_kind)" ' + mpirun -n 4 ./test_coupler_types_r4 +' + +test_expect_success "coupler types interfaces - check send_data return vals (r8_kind)" ' + mpirun -n 4 ./test_coupler_types_r8 +' + mkdir RESTART test_expect_success "coupler register restart 2D(r4_kind)" ' diff --git a/test_fms/coupler/test_coupler_types.F90 b/test_fms/coupler/test_coupler_types.F90 index 8beb9f4695..4204f768b6 100644 --- a/test_fms/coupler/test_coupler_types.F90 +++ b/test_fms/coupler/test_coupler_types.F90 @@ -31,7 +31,7 @@ program test_coupler_types use fms_mod, only: fms_init, fms_end, stdout, string -use mpp_mod, only: mpp_error, mpp_pe, mpp_root_pe, FATAL, mpp_sync, mpp_init +use mpp_mod, only: mpp_error, mpp_pe, mpp_root_pe, FATAL, mpp_sync, mpp_init, input_nml_file use mpp_domains_mod, only: domain2d, mpp_define_domains, mpp_define_io_domain, mpp_get_data_domain, domain1D use mpp_domains_mod, only: mpp_domains_set_stack_size use coupler_types_mod, only: coupler_3d_bc_type, coupler_2d_bc_type, coupler_1d_bc_type @@ -70,6 +70,12 @@ program test_coupler_types character(len=128) :: chksum_2d, chksum_3d real(FMS_CP_TEST_KIND_), allocatable :: expected_2d(:,:), expected_3d(:,:,:) integer :: err, ncid, dim1D, varid, day +logical, allocatable :: return_stats(:,:) + +logical :: fail_return_status = .false. !< if true checks for one of the coupler_type_send_data calls to fail and + !! return a false value + +NAMELIST /test_coupler_types_nml/ fail_return_status call fms_init call time_manager_init @@ -77,6 +83,9 @@ program test_coupler_types call mpp_init call set_calendar_type(JULIAN) +read(input_nml_file, test_coupler_types_nml, iostat=err) +if(err > 0) call mpp_error(FATAL, "test_coupler_types:: error reading test input nml") + ! basic domain set up nlat=60; nlon=60; nz=12 layout = (/2, 2/) @@ -216,8 +225,22 @@ program test_coupler_types time_t = set_date(1, 1, day) call coupler_type_increment_data(bc_2d_cp, bc_2d_new) ! increment _new with cp call coupler_type_increment_data(bc_3d_cp, bc_3d_new) - call coupler_type_send_data(bc_2d_new, time_t) - call coupler_type_send_data(bc_3d_new, time_t) + call coupler_type_send_data(bc_2d_new, time_t, return_stats) + if( fail_return_status ) then + if( ALL(return_stats) ) call mpp_error(FATAL, "test_coupler_types:: send_data calls returned true, "// & + "expected false return value from incorrect diag_table") + else + if( .not. ALL(return_stats) ) call mpp_error(FATAL, & + "test_coupler_types:: coupler_type_send_data returned false with valid diag_table") + endif + call coupler_type_send_data(bc_3d_new, time_t, return_stats) + if( fail_return_status ) then + if( ALL(return_stats) ) call mpp_error(FATAL, "test_coupler_types:: send_data calls returned true, "// & + "expected false return value from incorrect diag_table") + else + if( .not. ALL(return_stats) ) call mpp_error(FATAL, & + "test_coupler_types:: coupler_type_send_data returned false with valid diag_table") + endif enddo time_t = set_date(1, 2, 1) call diag_manager_end(time_t) @@ -314,4 +337,4 @@ subroutine check_field_data_3d(bc_3d, expected) enddo end subroutine check_field_data_3d -end program \ No newline at end of file +end program From 7d565dbb8956bded32961e3cf0e5bb5b049c18da Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Mon, 24 Jun 2024 13:43:03 -0400 Subject: [PATCH 07/13] fix: append root pe number to diag_field_log.out file name (#1497) --- diag_manager/diag_manager.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index ab94fe6901..be448fcfb6 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -246,6 +246,7 @@ MODULE diag_manager_mod USE fms_diag_outfield_mod, ONLY: fmsDiagOutfieldIndex_type, fmsDiagOutfield_type USE fms_diag_fieldbuff_update_mod, ONLY: fieldbuff_update, fieldbuff_copy_missvals, & & fieldbuff_copy_fieldvals + USE fms_string_utils_mod, ONLY: string USE netcdf, ONLY: NF90_INT, NF90_FLOAT, NF90_CHAR @@ -4224,7 +4225,7 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) ! open diag field log file IF ( do_diag_field_log.AND.mpp_pe().EQ.mpp_root_pe() ) THEN - open(newunit=diag_log_unit, file='diag_field_log.out', action='WRITE') + open(newunit=diag_log_unit, file='diag_field_log.out.'//string(mpp_pe()), action='WRITE') WRITE (diag_log_unit,'(777a)') & & 'Module', FIELD_LOG_SEPARATOR, 'Field', FIELD_LOG_SEPARATOR, & & 'Long Name', FIELD_LOG_SEPARATOR, 'Units', FIELD_LOG_SEPARATOR, & From eeedbab8ece4d68ff81d2cebcc350f659cc12982 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Tue, 25 Jun 2024 14:00:58 -0400 Subject: [PATCH 08/13] feat: add separate error log file for mpp_error (#1544) --- mpp/include/mpp_comm_mpi.inc | 2 + mpp/include/mpp_util.inc | 30 ++++++++++++ mpp/include/mpp_util_mpi.inc | 12 ++++- mpp/mpp.F90 | 6 ++- test_fms/fms/Makefile.am | 2 +- test_fms/mpp/Makefile.am | 10 ++-- test_fms/mpp/test_stdlog.F90 | 94 ++++++++++++++++++++++++++++++++++++ test_fms/mpp/test_stdlog.sh | 52 ++++++++++++++++++++ 8 files changed, 200 insertions(+), 8 deletions(-) create mode 100644 test_fms/mpp/test_stdlog.F90 create mode 100755 test_fms/mpp/test_stdlog.sh diff --git a/mpp/include/mpp_comm_mpi.inc b/mpp/include/mpp_comm_mpi.inc index d7fd2352ae..155cc722a8 100644 --- a/mpp/include/mpp_comm_mpi.inc +++ b/mpp/include/mpp_comm_mpi.inc @@ -111,6 +111,7 @@ if (t_level == 3) return call mpp_init_logfile() + call mpp_init_warninglog() if (present(alt_input_nml_path)) then call read_input_nml(alt_input_nml_path=alt_input_nml_path) else @@ -205,6 +206,7 @@ subroutine mpp_exit() call mpp_sync() call FLUSH( out_unit ) + close(warn_unit) if( pe.EQ.root_pe )then write( out_unit,'(/a,i6,a)' ) 'Tabulating mpp_clock statistics across ', npes, ' PEs...' diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index f8458806e6..027c72469c 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -119,6 +119,36 @@ end do end if end subroutine mpp_init_logfile + + !> Opens the warning log file, called during mpp_init + subroutine mpp_init_warninglog() + integer :: p + logical :: exist + character(len=11) :: this_pe + if( pe.EQ.root_pe )then + write(this_pe,'(a,i6.6,a)') '.',p,'.out' + inquire( file=trim(warnfile)//this_pe, exist=exist ) + if(exist)then + open(newunit=warn_unit, file=trim(warnfile)//this_pe, status='REPLACE' ) + else + open(newunit=warn_unit, file=trim(warnfile)//this_pe, status='NEW' ) + endif + end if + end subroutine mpp_init_warninglog + + !> @brief This function returns unit number for the warning log + !! if on the root pe, otherwise returns the etc_unit value (usually /dev/null) + function warnlog() + integer :: warnlog + if(.not. module_is_initialized) call mpp_error(FATAL, "mpp_mod: warnlog cannot be called before mpp_init") + if(root_pe .eq. pe) then + warnlog = warn_unit + else + warnlog = etc_unit + endif + return + end function warnlog + !##################################################################### subroutine mpp_set_warn_level(flag) integer, intent(in) :: flag diff --git a/mpp/include/mpp_util_mpi.inc b/mpp/include/mpp_util_mpi.inc index 7d235be83b..688a9c9311 100644 --- a/mpp/include/mpp_util_mpi.inc +++ b/mpp/include/mpp_util_mpi.inc @@ -60,13 +60,21 @@ subroutine mpp_error_basic( errortype, errormsg ) !$OMP CRITICAL (MPP_ERROR_CRITICAL) select case( errortype ) case(NOTE) - if(pe==root_pe)write( out_unit,'(a)' )trim(text) + if(pe==root_pe) then + write( out_unit,'(a)' )trim(text) + write( warn_unit,'(a)' )trim(text) + endif case default errunit = stderr() write( errunit, '(/a/)' )trim(text) - if(pe==root_pe)write( out_unit,'(/a/)' )trim(text) + if(pe==root_pe) then + write( out_unit,'(/a/)' )trim(text) + write( warn_unit,'(/a/)' )trim(text) + endif if( errortype.EQ.FATAL .OR. warnings_are_fatal )then FLUSH(out_unit) + FLUSH(warn_unit) + close(warn_unit) #ifdef __INTEL_COMPILER ! Get traceback and return quietly for correct abort call TRACEBACKQQ(user_exit_code=-1) diff --git a/mpp/mpp.F90 b/mpp/mpp.F90 index e12a5d63ae..078c99b955 100644 --- a/mpp/mpp.F90 +++ b/mpp/mpp.F90 @@ -202,7 +202,7 @@ module mpp_mod public :: mpp_init_test_read_namelist, mpp_init_test_etc_unit, mpp_init_test_requests_allocated !--- public interface from mpp_util.h ------------------------------ - public :: stdin, stdout, stderr, stdlog, lowercase, uppercase, mpp_error, mpp_error_state + public :: stdin, stdout, stderr, stdlog, warnlog, lowercase, uppercase, mpp_error, mpp_error_state public :: mpp_set_warn_level, mpp_sync, mpp_sync_self, mpp_pe public :: mpp_npes, mpp_root_pe, mpp_set_root_pe, mpp_declare_pelist public :: mpp_get_current_pelist, mpp_set_current_pelist, mpp_get_current_pelist_name @@ -1273,7 +1273,9 @@ module mpp_mod logical :: mpp_record_timing_data=.TRUE. type(clock),save :: clocks(MAX_CLOCKS) integer :: log_unit, etc_unit - character(len=32) :: configfile='logfile' + integer :: warn_unit !< unit number of the warning log + character(len=32), parameter :: configfile='logfile' + character(len=32), parameter :: warnfile='warnfile' !< base name for warninglog (appends "..out") integer :: peset_num=0, current_peset_num=0 integer :: world_peset_num !. +!*********************************************************************** + +!> @file +!! @brief Unit test for the stdlog and checking warning log functionality +!! @author Ryan Mulhall +!! @email gfdl.climate.model.info@noaa.gov +program test_stdlog + use mpp_mod, only : mpp_init, mpp_init_test_peset_allocated, stdlog + use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, FATAL, WARNING, NOTE + use fms_mod, only : input_nml_file, check_nml_error + + integer :: log_unit !< Stores the returned standard log unit number + integer :: warn_unit + integer :: pe !< pe value + integer :: root_pe !< root pe value + integer :: ierr !< Error code + + integer :: test_num = 1 + namelist / test_stdlog_nml / test_num + + call mpp_init() + + read(input_nml_file, nml=test_stdlog_nml, iostat=io) + ierr = check_nml_error(io, 'test_stdlog_nml') + + pe = mpp_pe() + root_pe = mpp_root_pe() + log_unit = stdlog() + + print * , "running test num: ", test_num + + select case(test_num) + case(1) + call test_write(.false.) + case(2) + call test_write(.true.) + case(3) + call check_write() + end select + + call MPI_FINALIZE(ierr) + + contains + + subroutine test_write(do_error_test) + logical, intent(in) :: do_error_test !< causes a fatal error to check output if true + + write(log_unit, *) "asdf" + call mpp_error(NOTE, "test note output") + call mpp_error(WARNING, "test warning output") + if(do_error_test) call mpp_error(FATAL, "test fatal output") + end subroutine test_write + + subroutine check_write() + integer :: i, ref_num, u_num_warn + character(len=128) :: line + character(len=23), parameter :: warn_fname = 'warnfile.000000.out.old' + character(len=128) :: ref_line(4) + + ref_line(1) = "NOTE from PE 0: MPP_DOMAINS_SET_STACK_SIZE: stack size set to 32768." + ref_line(2) = "NOTE from PE 0: test note output" + ref_line(3) = "WARNING from PE 0: test warning output" + ref_line(4) = "FATAL from PE 0: test fatal output" + open(newunit=u_num_warn, file=warn_fname, status="old", action="read") + ref_num = 1 + do i=1, 7 + read(u_num_warn, '(A)') line + if (trim(line) == '') cycle + if(trim(line) .ne. trim(ref_line(ref_num))) call mpp_error(FATAL, "warnfile output does not match reference data"& + //"reference line:"//ref_line(ref_num) & + //"output line:"//line) + ref_num = ref_num + 1 + enddo + close(u_num_warn) + end subroutine check_write + +end program test_stdlog \ No newline at end of file diff --git a/test_fms/mpp/test_stdlog.sh b/test_fms/mpp/test_stdlog.sh new file mode 100755 index 0000000000..191ff93bcc --- /dev/null +++ b/test_fms/mpp/test_stdlog.sh @@ -0,0 +1,52 @@ +#!/bin/sh + +#*********************************************************************** +# GNU Lesser General Public License +# +# This file is part of the GFDL Flexible Modeling System (FMS). +# +# FMS is free software: you can redistribute it and/or modify it under +# the terms of the GNU Lesser General Public License as published by +# the Free Software Foundation, either version 3 of the License, or (at +# your option) any later version. +# +# FMS is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with FMS. If not, see . +#*********************************************************************** + +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/mpp directory. + +# Ryan Mulhall 02/2021 + +# Set common test settings. +. ../test-lib.sh + +output_dir + +# ensure input.nml file present +cat <<_EOF > input.nml +&test_stdlog_nml + test_num = 1 +/ +_EOF +# Run test with one processor +test_expect_success "test stdlog and stdwarn" ' + mpirun -n 2 ../test_stdlog +' +sed -i 's/1/2/' input.nml +test_expect_failure "test stdlog and stdwarn with fatal output" ' + mpirun -n 2 ../test_stdlog +' +# move file so we don't overwrite +mv warnfile.*.out warnfile.000000.out.old +sed -i 's/2/3/' input.nml +test_expect_success "check stdwarn output" ' + mpirun -n 1 ../test_stdlog +' +test_done From 7d8aa2102316e2bd5df25a7e7b14aee42c8f060f Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Fri, 28 Jun 2024 10:33:01 -0400 Subject: [PATCH 09/13] fix: set is_allocated in all horiz_interp_type_new routines and rename SPHERICA constant (#1538) --- horiz_interp/horiz_interp.F90 | 4 +- horiz_interp/horiz_interp_bicubic.F90 | 2 +- horiz_interp/horiz_interp_bilinear.F90 | 2 +- horiz_interp/horiz_interp_conserve.F90 | 2 +- horiz_interp/horiz_interp_spherical.F90 | 2 +- horiz_interp/horiz_interp_type.F90 | 4 +- horiz_interp/include/horiz_interp.inc | 10 +- horiz_interp/include/horiz_interp_bicubic.inc | 8 +- .../include/horiz_interp_bicubic_r4.fh | 4 +- .../include/horiz_interp_bicubic_r8.fh | 4 +- .../include/horiz_interp_bilinear.inc | 4 + .../include/horiz_interp_conserve.inc | 12 ++ .../include/horiz_interp_spherical.inc | 2 + libFMS.F90 | 3 +- test_fms/horiz_interp/test_horiz_interp.F90 | 104 +++++++++++++----- 15 files changed, 116 insertions(+), 51 deletions(-) diff --git a/horiz_interp/horiz_interp.F90 b/horiz_interp/horiz_interp.F90 index 820e9079b9..07df2b7a69 100644 --- a/horiz_interp/horiz_interp.F90 +++ b/horiz_interp/horiz_interp.F90 @@ -49,7 +49,7 @@ module horiz_interp_mod use mpp_mod, only: input_nml_file, WARNING, mpp_pe, mpp_root_pe use constants_mod, only: pi use horiz_interp_type_mod, only: horiz_interp_type, assignment(=) -use horiz_interp_type_mod, only: CONSERVE, BILINEAR, SPHERICA, BICUBIC +use horiz_interp_type_mod, only: CONSERVE, BILINEAR, SPHERICAL, BICUBIC use horiz_interp_conserve_mod, only: horiz_interp_conserve_init, horiz_interp_conserve use horiz_interp_conserve_mod, only: horiz_interp_conserve_new, horiz_interp_conserve_del use horiz_interp_bilinear_mod, only: horiz_interp_bilinear_init, horiz_interp_bilinear @@ -294,7 +294,7 @@ subroutine horiz_interp_del ( Interp ) call horiz_interp_bilinear_del(Interp ) case (BICUBIC) call horiz_interp_bicubic_del(Interp ) - case (SPHERICA) + case (SPHERICAL) call horiz_interp_spherical_del(Interp ) end select diff --git a/horiz_interp/horiz_interp_bicubic.F90 b/horiz_interp/horiz_interp_bicubic.F90 index 25ac5c1a54..b4e8778cd1 100644 --- a/horiz_interp/horiz_interp_bicubic.F90 +++ b/horiz_interp/horiz_interp_bicubic.F90 @@ -47,7 +47,7 @@ module horiz_interp_bicubic_mod use mpp_mod, only: mpp_error, FATAL, stdout, mpp_pe, mpp_root_pe use fms_mod, only: write_version_number - use horiz_interp_type_mod, only: horiz_interp_type + use horiz_interp_type_mod, only: horiz_interp_type, BICUBIC use constants_mod, only: PI use platform_mod, only: r4_kind, r8_kind diff --git a/horiz_interp/horiz_interp_bilinear.F90 b/horiz_interp/horiz_interp_bilinear.F90 index 318d2c039b..2fe80b9895 100644 --- a/horiz_interp/horiz_interp_bilinear.F90 +++ b/horiz_interp/horiz_interp_bilinear.F90 @@ -32,7 +32,7 @@ module horiz_interp_bilinear_mod use mpp_mod, only: mpp_error, FATAL, stdout, mpp_pe, mpp_root_pe use fms_mod, only: write_version_number use constants_mod, only: PI - use horiz_interp_type_mod, only: horiz_interp_type, stats + use horiz_interp_type_mod, only: horiz_interp_type, stats, BILINEAR use platform_mod, only: r4_kind, r8_kind use axis_utils2_mod, only: nearest_index diff --git a/horiz_interp/horiz_interp_conserve.F90 b/horiz_interp/horiz_interp_conserve.F90 index b1b04a1b34..5f345e9769 100644 --- a/horiz_interp/horiz_interp_conserve.F90 +++ b/horiz_interp/horiz_interp_conserve.F90 @@ -44,7 +44,7 @@ module horiz_interp_conserve_mod use fms_mod, only: write_version_number use grid2_mod, only: get_great_circle_algorithm use constants_mod, only: PI - use horiz_interp_type_mod, only: horiz_interp_type + use horiz_interp_type_mod, only: horiz_interp_type, CONSERVE implicit none diff --git a/horiz_interp/horiz_interp_spherical.F90 b/horiz_interp/horiz_interp_spherical.F90 index 128b7fd47d..28110d343b 100644 --- a/horiz_interp/horiz_interp_spherical.F90 +++ b/horiz_interp/horiz_interp_spherical.F90 @@ -36,7 +36,7 @@ module horiz_interp_spherical_mod use fms_mod, only : write_version_number use fms_mod, only : check_nml_error use constants_mod, only : pi - use horiz_interp_type_mod, only : horiz_interp_type, stats + use horiz_interp_type_mod, only : horiz_interp_type, stats, SPHERICAL implicit none private diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90 index 7f8b300a99..e87870698c 100644 --- a/horiz_interp/horiz_interp_type.F90 +++ b/horiz_interp/horiz_interp_type.F90 @@ -38,10 +38,10 @@ module horiz_interp_type_mod ! parameter to determine interpolation method integer, parameter :: CONSERVE = 1 integer, parameter :: BILINEAR = 2 - integer, parameter :: SPHERICA = 3 + integer, parameter :: SPHERICAL = 3 integer, parameter :: BICUBIC = 4 -public :: CONSERVE, BILINEAR, SPHERICA, BICUBIC +public :: CONSERVE, BILINEAR, SPHERICAL, BICUBIC public :: horiz_interp_type, stats, assignment(=) !> @} diff --git a/horiz_interp/include/horiz_interp.inc b/horiz_interp/include/horiz_interp.inc index ec0540b442..036b87a268 100644 --- a/horiz_interp/include/horiz_interp.inc +++ b/horiz_interp/include/horiz_interp.inc @@ -120,7 +120,7 @@ deallocate(lon_src_1d, lat_src_1d, lon_dst_1d, lat_dst_1d) endif case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL nlon_in = size(lon_in(:)); nlat_in = size(lat_in(:)) nlon_out = size(lon_out(:)); nlat_out = size(lat_out(:)) allocate(lon_src(nlon_in,nlat_in), lat_src(nlon_in,nlat_in)) @@ -246,7 +246,7 @@ deallocate(lon_src_1d,lat_src_1d) endif case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL nlon_in = size(lon_in(:)); nlat_in = size(lat_in(:)) allocate(lon_src(nlon_in,nlat_in), lat_src(nlon_in,nlat_in)) do i = 1, nlon_in @@ -329,7 +329,7 @@ end if case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL call horiz_interp_spherical_new ( Interp, lon_in, lat_in, lon_out, lat_out, & num_nbrs, max_dist, src_modulo ) case ("bilinear") @@ -409,7 +409,7 @@ call horiz_interp_bilinear_new ( Interp, lon_in, lat_in, lon_dst, lat_dst, & verbose, src_modulo ) case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL call horiz_interp_spherical_new ( Interp, lon_in, lat_in, lon_dst, lat_dst, & num_nbrs, max_dist, src_modulo) case default @@ -454,7 +454,7 @@ case(BICUBIC) call horiz_interp_bicubic(Interp,data_in, data_out, verbose, mask_in, mask_out, & missing_value, missing_permit ) - case(SPHERICA) + case(SPHERICAL) call horiz_interp_spherical(Interp,data_in, data_out, verbose, mask_in, mask_out, & missing_value ) case default diff --git a/horiz_interp/include/horiz_interp_bicubic.inc b/horiz_interp/include/horiz_interp_bicubic.inc index 5ff567dbb8..e4f180c657 100644 --- a/horiz_interp/include/horiz_interp_bicubic.inc +++ b/horiz_interp/include/horiz_interp_bicubic.inc @@ -190,6 +190,8 @@ ! xf > xcu, no valid boundary point') enddo enddo + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp%interp_method = BICUBIC end subroutine HORIZ_INTERP_BICUBIC_NEW_1D_S_ !> @brief Creates a new @ref horiz_interp_type @@ -343,11 +345,13 @@ ! xcu, no valid boundary point') enddo enddo + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp%interp_method = BICUBIC end subroutine HORIZ_INTERP_BICUBIC_NEW_1D_ !> @brief Perform bicubic horizontal interpolation - subroutine HORIZ_INTERP_BICUBIC_NEW_( Interp, data_in, data_out, verbose, mask_in, mask_out, missing_value, & + subroutine HORIZ_INTERP_BICUBIC_( Interp, data_in, data_out, verbose, mask_in, mask_out, missing_value, & & missing_permit) type (horiz_interp_type), intent(in) :: Interp real(FMS_HI_KIND_), intent(in), dimension(:,:) :: data_in @@ -427,7 +431,7 @@ enddo enddo return - end subroutine HORIZ_INTERP_BICUBIC_NEW_ + end subroutine HORIZ_INTERP_BICUBIC_ !--------------------------------------------------------------------------- diff --git a/horiz_interp/include/horiz_interp_bicubic_r4.fh b/horiz_interp/include/horiz_interp_bicubic_r4.fh index 1d3b148480..bc9c0037d7 100644 --- a/horiz_interp/include/horiz_interp_bicubic_r4.fh +++ b/horiz_interp/include/horiz_interp_bicubic_r4.fh @@ -30,8 +30,8 @@ #undef HORIZ_INTERP_BICUBIC_NEW_1D_ #define HORIZ_INTERP_BICUBIC_NEW_1D_ horiz_interp_bicubic_new_1d_r4 -#undef HORIZ_INTERP_BICUBIC_NEW_ -#define HORIZ_INTERP_BICUBIC_NEW_ horiz_interp_bicubic_r4 +#undef HORIZ_INTERP_BICUBIC_ +#define HORIZ_INTERP_BICUBIC_ horiz_interp_bicubic_r4 #undef BCUINT_ #define BCUINT_ bcuint_r4 diff --git a/horiz_interp/include/horiz_interp_bicubic_r8.fh b/horiz_interp/include/horiz_interp_bicubic_r8.fh index d269767726..e37a234bf5 100644 --- a/horiz_interp/include/horiz_interp_bicubic_r8.fh +++ b/horiz_interp/include/horiz_interp_bicubic_r8.fh @@ -30,8 +30,8 @@ #undef HORIZ_INTERP_BICUBIC_NEW_1D_ #define HORIZ_INTERP_BICUBIC_NEW_1D_ horiz_interp_bicubic_new_1d_r8 -#undef HORIZ_INTERP_BICUBIC_NEW_ -#define HORIZ_INTERP_BICUBIC_NEW_ horiz_interp_bicubic_r8 +#undef HORIZ_INTERP_BICUBIC_ +#define HORIZ_INTERP_BICUBIC_ horiz_interp_bicubic_r8 #undef BCUINT_ #define BCUINT_ bcuint_r8 diff --git a/horiz_interp/include/horiz_interp_bilinear.inc b/horiz_interp/include/horiz_interp_bilinear.inc index 9e352d9c31..f178ebec1c 100644 --- a/horiz_interp/include/horiz_interp_bilinear.inc +++ b/horiz_interp/include/horiz_interp_bilinear.inc @@ -191,6 +191,8 @@ ' data required between latitudes:', glt_min, glt_max, & ' data set is between latitudes:', lat_in(1), lat_in(nlat_in) endif + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = BILINEAR return @@ -396,6 +398,8 @@ enddo enddo + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = BILINEAR end subroutine !####################################################################### diff --git a/horiz_interp/include/horiz_interp_conserve.inc b/horiz_interp/include/horiz_interp_conserve.inc index 0ec17fcacd..1d2212dabc 100644 --- a/horiz_interp/include/horiz_interp_conserve.inc +++ b/horiz_interp/include/horiz_interp_conserve.inc @@ -215,6 +215,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l endif !----------------------------------------------------------------------- + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = CONSERVE + end subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ !####################################################################### @@ -384,6 +387,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l deallocate(i_src, j_src, i_dst, j_dst, xgrid_area, dst_area ) + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = CONSERVE + end subroutine HORIZ_INTERP_CONSERVE_NEW_1DX2D_ !####################################################################### @@ -493,6 +499,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l deallocate(i_src, j_src, i_dst, j_dst, xgrid_area, dst_area) + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = CONSERVE + end subroutine HORIZ_INTERP_CONSERVE_NEW_2DX1D_ !####################################################################### @@ -600,6 +609,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l deallocate(i_src, j_src, i_dst, j_dst, xgrid_area, dst_area ) + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = CONSERVE + end subroutine HORIZ_INTERP_CONSERVE_NEW_2DX2D_ !######################################################################## diff --git a/horiz_interp/include/horiz_interp_spherical.inc b/horiz_interp/include/horiz_interp_spherical.inc index cc00a4264e..f848622a7c 100644 --- a/horiz_interp/include/horiz_interp_spherical.inc +++ b/horiz_interp/include/horiz_interp_spherical.inc @@ -188,6 +188,8 @@ Interp%nlon_src = map_src_xsize; Interp%nlat_src = map_src_ysize Interp%nlon_dst = map_dst_xsize; Interp%nlat_dst = map_dst_ysize + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = SPHERICAL return diff --git a/libFMS.F90 b/libFMS.F90 index 42879958f5..9180be32f5 100644 --- a/libFMS.F90 +++ b/libFMS.F90 @@ -414,8 +414,7 @@ module fms fms_horiz_interp_del => horiz_interp_del, fms_horiz_interp_init => horiz_interp_init, & fms_horiz_interp_end => horiz_interp_end use horiz_interp_type_mod, only: FmsHorizInterp_type => horiz_interp_type, & - assignment(=), CONSERVE, BILINEAR, SPHERICA, BICUBIC, & - fms_horiz_interp_type_stats => stats + assignment(=), fms_horiz_interp_type_stats => stats !! used via horiz_interp ! horiz_interp_bicubic_mod, horiz_interp_bilinear_mod ! horiz_interp_conserve_mod, horiz_interp_spherical_mod diff --git a/test_fms/horiz_interp/test_horiz_interp.F90 b/test_fms/horiz_interp/test_horiz_interp.F90 index fd0d077a91..c56cf931f8 100644 --- a/test_fms/horiz_interp/test_horiz_interp.F90 +++ b/test_fms/horiz_interp/test_horiz_interp.F90 @@ -38,9 +38,12 @@ program horiz_interp_test use fms_mod, only : check_nml_error, fms_init use horiz_interp_mod, only : horiz_interp_init, horiz_interp_new, horiz_interp_del use horiz_interp_mod, only : horiz_interp, horiz_interp_type -use horiz_interp_spherical_mod, only: horiz_interp_spherical_wght -use horiz_interp_type_mod, only: SPHERICA +use horiz_interp_type_mod, only: SPHERICAL use constants_mod, only : constants_init, PI +use horiz_interp_bilinear_mod, only: horiz_interp_bilinear_new +use horiz_interp_spherical_mod, only: horiz_interp_spherical_wght, horiz_interp_spherical_new +use horiz_interp_bicubic_mod, only: horiz_interp_bicubic_new +use horiz_interp_conserve_mod, only: horiz_interp_conserve_new use platform_mod implicit none @@ -957,28 +960,30 @@ subroutine test_horiz_interp_conserve !> Tests the assignment overload for horiz_interp_type !! creates some new instances of the derived type for the different methods !! and tests equality of fields after initial weiht calculations + !! Also tests creating the types via the method-specific *_new routines to ensure + !! they can be created/deleted without allocation errors. subroutine test_assignment() type(horiz_interp_type) :: Interp_new1, Interp_new2, Interp_cp, intp_3 - !! grid data points - real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_in_1D, lon_in_1D - real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_2D, lon_in_2D - !! output data points - real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_out_1D, lon_out_1D - real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_out_2D, lon_out_2D - real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_out_bil, lon_out_bil - real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_bil, lon_in_bil - !! array sizes and number of lat/lon per index - real(HI_TEST_KIND_) :: nlon_in, nlat_in - real(HI_TEST_KIND_) :: nlon_out, nlat_out - real(HI_TEST_KIND_) :: dlon_src, dlat_src, dlon_dst, dlat_dst - !! parameters for lon/lat setup - real(HI_TEST_KIND_) :: lon_src_beg = 0._lkind, lon_src_end = 360._lkind - real(HI_TEST_KIND_) :: lat_src_beg = -90._lkind, lat_src_end = 90._lkind - real(HI_TEST_KIND_) :: lon_dst_beg = 0.0_lkind, lon_dst_end = 360._lkind - real(HI_TEST_KIND_) :: lat_dst_beg = -90._lkind, lat_dst_end = 90._lkind - real(HI_TEST_KIND_) :: D2R = real(PI,HI_TEST_KIND_)/180._lkind - real(HI_TEST_KIND_) :: R2D = 180._lkind/real(PI,HI_TEST_KIND_) - real(HI_TEST_KIND_), parameter :: SMALL = 1.0e-10_lkind + real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_in_1D, lon_in_1D !< 1D grid data points + real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_2D, lon_in_2D !< 2D grid data points + real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_out_1D, lon_out_1D !< 1D grid output points + real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_out_2D, lon_out_2D !< 2D grid output points + integer :: nlon_in, nlat_in !< array sizes for input grids + integer :: nlon_out, nlat_out !< array sizes for output grids + real(HI_TEST_KIND_) :: dlon_src, dlat_src, dlon_dst, dlat_dst !< lon/lat size per data point + real(HI_TEST_KIND_) :: lon_src_beg = 0._lkind, lon_src_end = 360._lkind!< source grid starting/ending + !! longitudes + real(HI_TEST_KIND_) :: lat_src_beg = -90._lkind, lat_src_end = 90._lkind !< source grid starting/ending + !! latitudes + real(HI_TEST_KIND_) :: lon_dst_beg = 0.0_lkind, lon_dst_end = 360._lkind !< destination grid + !! starting/ending longitudes + real(HI_TEST_KIND_) :: lat_dst_beg = -90._lkind, lat_dst_end = 90._lkind !< destination grid + !! starting/ending latitudes + real(HI_TEST_KIND_) :: D2R = real(PI,HI_TEST_KIND_)/180._lkind !< radians per degree + real(HI_TEST_KIND_) :: R2D = 180._lkind/real(PI,HI_TEST_KIND_) !< degrees per radian + real(HI_TEST_KIND_), allocatable :: lon_src_1d(:), lat_src_1d(:) !< src data used for bicubic test + real(HI_TEST_KIND_), allocatable :: lon_dst_1d(:), lat_dst_1d(:) !< destination data used for bicubic test + ! set up longitude and latitude of source/destination grid. dlon_src = (lon_src_end-lon_src_beg)/real(ni_src, lkind) @@ -1062,6 +1067,15 @@ subroutine test_assignment() call horiz_interp_del(Interp_new1) call horiz_interp_del(Interp_new2) call horiz_interp_del(Interp_cp) + ! test deletion after direct calls + call horiz_interp_conserve_new(Interp_new1, lon_in_1d, lat_in_1d, lon_out_1d, lat_out_1d) + call horiz_interp_del(Interp_new1) + call horiz_interp_conserve_new(Interp_new1, lon_in_1d, lat_in_1d, lon_out_2d, lat_out_2d) + call horiz_interp_del(Interp_new1) + call horiz_interp_conserve_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_1d, lat_out_1d) + call horiz_interp_del(Interp_new1) + call horiz_interp_conserve_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_2d, lat_out_2d) + call horiz_interp_del(Interp_new1) ! bicubic only works with 1d src ! 1dx1d @@ -1084,6 +1098,28 @@ subroutine test_assignment() call horiz_interp_del(Interp_new1) call horiz_interp_del(Interp_new2) call horiz_interp_del(Interp_cp) + ! test deletion after direct calls + ! this set up is usually done within horiz_interp_new + nlon_in = size(lon_in_1d(:))-1; nlat_in = size(lat_in_1d(:))-1 + nlon_out = size(lon_out_1d(:))-1; nlat_out = size(lat_out_1d(:))-1 + allocate(lon_src_1d(nlon_in), lat_src_1d(nlat_in)) + allocate(lon_dst_1d(nlon_out), lat_dst_1d(nlat_out)) + do i = 1, nlon_in + lon_src_1d(i) = (lon_in_1d(i) + lon_in_1d(i+1)) * 0.5_lkind + enddo + do j = 1, nlat_in + lat_src_1d(j) = (lat_in_1d(j) + lat_in_1d(j+1)) * 0.5_lkind + enddo + do i = 1, nlon_out + lon_dst_1d(i) = (lon_out_1d(i) + lon_out_1d(i+1)) * 0.5_lkind + enddo + do j = 1, nlat_out + lat_dst_1d(j) = (lat_out_1d(j) + lat_out_1d(j+1)) * 0.5_lkind + enddo + call horiz_interp_bicubic_new(Interp_new1, lon_src_1d, lat_src_1d, lon_out_2d, lat_out_2d) + call horiz_interp_del(Interp_new1) + call horiz_interp_bicubic_new(Interp_new1, lon_src_1d, lat_src_1d, lon_dst_1d, lat_dst_1d) + call horiz_interp_del(Interp_new1) deallocate(lon_out_2D, lat_out_2D, lon_in_2D, lat_in_2D) allocate(lon_out_2D(ni_dst, nj_dst), lat_out_2D(ni_dst, nj_dst)) @@ -1117,11 +1153,14 @@ subroutine test_assignment() call horiz_interp_del(Interp_new1) call horiz_interp_del(Interp_new2) call horiz_interp_del(Interp_cp) + ! check deletion after direct calls + call horiz_interp_spherical_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_2d, lat_out_2d) + call horiz_interp_del(Interp_new1) ! bilinear ! 1dx1d - call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_in_1D, lat_in_1D, interp_method="bilinear") - call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_in_1D, lat_in_1D, interp_method="bilinear") + call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_out_1D, lat_out_1D, interp_method="bilinear") + call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_out_1D, lat_out_1D, interp_method="bilinear") Interp_cp = Interp_new1 call mpp_error(NOTE,"testing horiz_interp_type assignment 1x1d bilinear") call check_type_eq(Interp_cp, Interp_new2) @@ -1130,8 +1169,8 @@ subroutine test_assignment() call horiz_interp_del(Interp_new2) call horiz_interp_del(Interp_cp) ! 1dx2d - call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_in_2D, lat_in_2D, interp_method="bilinear") - call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_in_2D, lat_in_2D, interp_method="bilinear") + call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_out_2D, lat_out_2D, interp_method="bilinear") + call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_out_2D, lat_out_2D, interp_method="bilinear") Interp_cp = Interp_new1 call mpp_error(NOTE,"testing horiz_interp_type assignment 1x2d bilinear") call check_type_eq(Interp_cp, Interp_new2) @@ -1160,8 +1199,8 @@ subroutine test_assignment() call horiz_interp_del(Interp_new2) call horiz_interp_del(Interp_cp) ! 2dx2d - call horiz_interp_new(Interp_new1, lon_in_2D, lat_in_2D, lon_in_2D, lat_in_2D, interp_method="bilinear") - call horiz_interp_new(Interp_new2, lon_in_2D, lat_in_2D, lon_in_2D, lat_in_2D, interp_method="bilinear") + call horiz_interp_new(Interp_new1, lon_in_2D, lat_in_2D, lon_out_2D, lat_out_2D, interp_method="bilinear") + call horiz_interp_new(Interp_new2, lon_in_2D, lat_in_2D, lon_out_2D, lat_out_2D, interp_method="bilinear") Interp_cp = Interp_new1 call mpp_error(NOTE,"testing horiz_interp_type assignment 1x2d bilinear") call check_type_eq(Interp_cp, Interp_new2) @@ -1169,6 +1208,11 @@ subroutine test_assignment() call horiz_interp_del(Interp_new1) call horiz_interp_del(Interp_new2) call horiz_interp_del(Interp_cp) + ! check deletion after direct calls + call horiz_interp_bilinear_new(Interp_new1, lon_in_1d, lat_in_1d, lon_out_2d, lat_out_2d) + call horiz_interp_del(Interp_new1) + call horiz_interp_bilinear_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_2d, lat_out_2d) + call horiz_interp_del(Interp_new1) end subroutine !> helps assignment test with derived type comparisons @@ -1230,7 +1274,7 @@ subroutine check_type_eq(interp_1, interp_2) call mpp_error(FATAL, "Invalid value for copied horiz_interp_type field: mask_in") endif !! only set during spherical - if(interp_1%interp_method .eq. SPHERICA) then + if(interp_1%interp_method .eq. SPHERICAL) then if( interp_2%horizInterpReals4_type%max_src_dist .ne. interp_1%horizInterpReals4_type%max_src_dist) & call mpp_error(FATAL, "Invalid value for copied horiz_interp_type field: max_src_dist") endif @@ -1292,7 +1336,7 @@ subroutine check_type_eq(interp_1, interp_2) endif !! only set during spherical - if(interp_1%interp_method .eq. SPHERICA) then + if(interp_1%interp_method .eq. SPHERICAL) then if( interp_2%horizInterpReals8_type%max_src_dist .ne. interp_1%horizInterpReals8_type%max_src_dist) & call mpp_error(FATAL, "Invalid value for copied horiz_interp_type field: max_src_dist") endif From ca592ef8f47c246f4dc56d348d62235bd0ceaa9d Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Fri, 28 Jun 2024 16:52:58 -0400 Subject: [PATCH 10/13] fix: typo in pe variable name for mpp_init_warninglog (#1550) --- mpp/include/mpp_util.inc | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index 027c72469c..a86fcba626 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -122,11 +122,10 @@ !> Opens the warning log file, called during mpp_init subroutine mpp_init_warninglog() - integer :: p logical :: exist character(len=11) :: this_pe if( pe.EQ.root_pe )then - write(this_pe,'(a,i6.6,a)') '.',p,'.out' + write(this_pe,'(a,i6.6,a)') '.',pe,'.out' inquire( file=trim(warnfile)//this_pe, exist=exist ) if(exist)then open(newunit=warn_unit, file=trim(warnfile)//this_pe, status='REPLACE' ) From 8bf0739afa3078a650c2a9d503716ed46fc65183 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Thu, 11 Jul 2024 14:36:51 -0400 Subject: [PATCH 11/13] chore: changelog and version updates for 2024.02 release (#1551) --- CHANGELOG.md | 25 +++++++++++++++++++++++++ CMakeLists.txt | 2 +- configure.ac | 2 +- libFMS/Makefile.am | 2 +- 4 files changed, 28 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index eaa76d0282..8f7cbe6066 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,31 @@ and this project uses `yyyy.rr[.pp]`, where `yyyy` is the year a patch is releas `rr` is a sequential release number (starting from `01`), and an optional two-digit sequential patch number (starting from `01`). +## [2024.02] - 2024-07-11 + +### Known Issues +- Diag Manager Rewrite: See [below](#20240102---2024-06-14) for known output file differences regarding the new diag manager. The new diag_manager is disabled by default, so this differences will only be present if `use_modern_diag` is set to true in the `diag_manager_nml`. +- BUILD(HDF5): HDF5 version 1.14.3 generates floating point exceptions, and will cause errors if FMS is built with FPE traps enabled. FPE traps are turned on when using the debug target in mkmf. +- GCC: version 14.1.0 is unsupported due to a bug with strings that has come up previously in earlier versions. This will be caught by the configure script, but will cause compilation errors if using other build systems. + +### Added +- TIME_INTERP: Enables use of `verbose` option in `time_interp_external2` calls from `data_override`. The option is enabled in `data_override_nml` by setting `debug_data_override` to true. (#1516) +- COUPLER: Adds optional argument to `coupler_types_send_data` routine that contains the return statuses for any calls made to the diag_manager's `send_data` routine. (#1530) +- MPP: Adds a separate error log file `warnfile..out` that only holds output from any `mpp_error` calls made during a run (#1544) +### Changed +- DIAG_MANAGER: The `diag_field_log.out` output file of all registered fields will now include the PE number of the root PE at the time of writing (ie. diag_field_log.out.0). This is to prevent overwritting the file in cases where the root PE may change. (#1497) + +### Fixed +- CMAKE: Fixes real kind flags being overwritten when using the Debug release type (#1532) +- HORIZ_INTERP: Fixes allocation issues when using method-specific horiz_interp_new routines (such as `horiz_interp_bilinear_new`) by setting `is_allocated` and the `method_type` during initialization for each method. (#1538) + + +### Tag Commit Hashes +- 2024.02-alpha1 5757c7813f1170efd28f5a4206395534894095b4 +- 2024.02-alpha2 5757c7813f1170efd28f5a4206395534894095b4 +- 2024.02-beta1 ca592ef8f47c246f4dc56d348d62235bd0ceaa9d +- 2024.02-beta2 ca592ef8f47c246f4dc56d348d62235bd0ceaa9d + ## [2024.01.02] - 2024-06-14 ### Known Issues diff --git a/CMakeLists.txt b/CMakeLists.txt index 029bb25c2f..2ca5c652ae 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -23,7 +23,7 @@ cmake_minimum_required(VERSION 3.12 FATAL_ERROR) # Define the CMake project project(FMS - VERSION 2024.01.02 + VERSION 2024.02.0 DESCRIPTION "GFDL FMS Library" HOMEPAGE_URL "https://www.gfdl.noaa.gov/fms" LANGUAGES C Fortran) diff --git a/configure.ac b/configure.ac index 3abdcc0119..699ab66a97 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.69]) # Initialize with name, version, and support email address. AC_INIT([GFDL FMS Library], - [2024.01.02-dev], + [2024.02], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) diff --git a/libFMS/Makefile.am b/libFMS/Makefile.am index 133ddfa665..507d428451 100644 --- a/libFMS/Makefile.am +++ b/libFMS/Makefile.am @@ -28,7 +28,7 @@ lib_LTLIBRARIES = libFMS.la # These linker flags specify libtool version info. # See http://www.gnu.org/software/libtool/manual/libtool.html#Libtool-versioning # for information regarding incrementing `-version-info`. -libFMS_la_LDFLAGS = -version-info 19:2:0 +libFMS_la_LDFLAGS = -version-info 20:0:0 # Add the convenience libraries to the FMS library. libFMS_la_LIBADD = $(top_builddir)/platform/libplatform.la From 369e92ddd42143919d40e1a180777cf0315cc44d Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 11 Jul 2024 16:15:13 -0400 Subject: [PATCH 12/13] chore: append -dev to version number (#1553) --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 699ab66a97..a2699db3e5 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.69]) # Initialize with name, version, and support email address. AC_INIT([GFDL FMS Library], - [2024.02], + [2024.02-dev], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) From 77382e3ad690c0cb8b8a7200a032609de4351d19 Mon Sep 17 00:00:00 2001 From: Jesse Lentz <42011922+J-Lentz@users.noreply.github.com> Date: Wed, 17 Jul 2024 10:11:11 -0400 Subject: [PATCH 13/13] docs: remove diag table schema and update markdown files (#1543) --- diag_manager/README.md | 8 +- diag_manager/diag_yaml_format.md | 6 ++ diag_manager/schema.diag | 141 ------------------------------- 3 files changed, 11 insertions(+), 144 deletions(-) delete mode 100644 diag_manager/schema.diag diff --git a/diag_manager/README.md b/diag_manager/README.md index 60ab87bbd5..ddf0dac681 100644 --- a/diag_manager/README.md +++ b/diag_manager/README.md @@ -1,4 +1,4 @@ -The purpose of this document is to document the differences between the old diag manager and the new (modern) diag manager. +The purpose of this document is to document the differences between the old diag manager and the new (modern) diag manager. ## Contents - [1. Diag Table Format](README.md#1-diag-table-format) @@ -10,7 +10,9 @@ The purpose of this document is to document the differences between the old diag - [7. History files data output "changes"](README.md#7-history-files-data-output-changes) ### 1. Diag Table Format -The modern diag manager uses a YAML format instead of the legacy ascii table. A description of the YAML diag table can be found [here](diag_yaml_format.md). +The modern diag manager uses a YAML format instead of the legacy ascii table. A description of the YAML diag table can +be found [here](diag_yaml_format.md). A formal specification, in the form of a JSON schema, can be found in the +[gfdl_msd_schemas](https://github.com/NOAA-GFDL/gfdl_msd_schemas) repository on Github. ### 2. Scalar Axis The old diag manager was adding a `scalar_axis` dimension of size 1 for scalar variables @@ -70,7 +72,7 @@ This time_bounds variable is refernced as a variable attribute of time: ### 4. Subregional Files #### A. `is_subregional` global attribute: -Subregional files will have a global NetCDF attribute `is_subregional = True` set for non-global history files. This attribute will be used in PP tools. +Subregional files will have a global NetCDF attribute `is_subregional = True` set for non-global history files. This attribute will be used in PP tools. #### B. Subregional dimension names: In some cases, the old diag manager was adding `sub0X` to the dimension names where X is a number greater than 1. This was causing problems in PP tools that were expecting the dimension to have `sub01` in the name. The new diag manager will not have this problem. diff --git a/diag_manager/diag_yaml_format.md b/diag_manager/diag_yaml_format.md index 63ed4630c0..d8221956d5 100644 --- a/diag_manager/diag_yaml_format.md +++ b/diag_manager/diag_yaml_format.md @@ -14,6 +14,7 @@ The purpose of this document is to explain the diag_table yaml format. - [2.5 Global Meta Data Section](diag_yaml_format.md#25-global-meta-data-section) - [2.6 Sub_region Section](diag_yaml_format.md#26-sub_region-section) - [3. More examples](diag_yaml_format.md#3-more-examples) +- [4. Schema](diag_yaml_format.md#4-schema) ### 1. Converting from legacy ascii diag_table format @@ -340,3 +341,8 @@ diag_files: unlimdim: records write_file: false ``` + +### 4. Schema +A formal specification of the file format, in the form of a JSON schema, can be +found in the [gfdl_msd_schemas](https://github.com/NOAA-GFDL/gfdl_msd_schemas) +repository on Github. diff --git a/diag_manager/schema.diag b/diag_manager/schema.diag deleted file mode 100644 index b232577ff9..0000000000 --- a/diag_manager/schema.diag +++ /dev/null @@ -1,141 +0,0 @@ -{ - "$schema": "http://json-schema.org/draft-04/schema#", - "type": "object", - "required": ["title", "base_date"], - "additionalProperties": false, - "properties": { - "title": { - "type": "string" - }, - "base_date": { - "type": "string" - }, - "diag_files": { - "type": "array", - "items": { - "type": "object", - "required": ["file_name", "freq", "time_units", "unlimdim"], - "additionalProperties": false, - "properties": { - "file_name": { - "type": "string" - }, - "freq": { - "anyOf": [ - {"type": "string"}, - {"type": "number"} - ], - "pattern": "^-[1]{1,1} *[ seconds| minutes| hours| days| months| years]*|^0&|^[1-9]+ [seconds|minutes|hours|days|months|years]{1,1}" - }, - "time_units": { - "type": "string", - "enum": ["seconds", "minutes", "hours", "days", "months", "years"] - }, - "unlimdim": { - "type": "string" - }, - "write_file": { - "type": "boolean" - }, - "global_meta": { - }, - "sub_region": { - "type": "array", - "minItems": 1, - "maxItems": 1, - "required": ["grid_type", "corner1", "corner2", "corner3", "corner4"], - "properties": { - "grid_type": { - "type": "string", - "enum": ["indices", "latlon"] - }, - "corner1": { - "type": "array", - "minItems": 2, - "maxItems": 2, - "items": { - "type": "number" - } - }, - "corner2": { - "type": "array", - "minItems": 2, - "maxItems": 2, - "items": { - "type": "number" - } - }, - "corner3": { - "type": "array", - "minItems": 2, - "maxItems": 2, - "items": { - "type": "number" - } - }, - "corner4": { - "type": "array", - "minItems": 2, - "maxItems": 2, - "items": { - "type": "number" - } - }, - "tile": { - "type": "number" - } - } - }, - "new_file_freq": { - "type": "string", - "pattern": "[0-9]{1,} [a-z]{1,}" - }, - "start_time": { - "type": "string" - }, - "file_duration": { - "type": "string" - }, - "varlist": { - "type": "array", - "items": { - "type": "object", - "required": ["var_name", "reduction", "module", "kind"], - "additionalProperties": false, - "properties": { - "kind": { - "type": "string", - "enum": ["r4", "r8", "i4", "i8"] - }, - "module": { - "type": "string" - }, - "reduction": { - "type": "string", - "pattern": "^average$|^min$|^max$|^none$|^rms$|^sum$|^diurnal[1-9]+|^pow[1-9]+" - }, - "var_name": { - "type": "string" - }, - "write_var": { - "type": "boolean" - }, - "output_name": { - "type": "string" - }, - "long_name": { - "type": "string" - }, - "attributes": { - }, - "zbounds": { - "type": "string" - } - } - } - } - } - } - } - } -}