diff --git a/.github/workflows/github_autotools_intel.yml b/.github/workflows/github_autotools_intel.yml index a09f8c87d3..372af083dc 100644 --- a/.github/workflows/github_autotools_intel.yml +++ b/.github/workflows/github_autotools_intel.yml @@ -17,7 +17,7 @@ jobs: CC: mpiicc FC: mpiifort CFLAGS: "-I/libs/include" - FCFLAGS: "-I/libs/include -g -traceback ${{ matrix.io-flag }}" + FCFLAGS: "-I/libs/include -g -traceback" LDFLAGS: "-L/libs/lib" TEST_VERBOSE: 1 I_MPI_FABRICS: "shm" # needed for mpi in image @@ -55,7 +55,10 @@ jobs: - name: checkout uses: actions/checkout@v4 - name: Configure - run: autoreconf -if ./configure.ac && ./configure --with-yaml + run: | + autoreconf -if ./configure.ac + export LD_LIBRARY_PATH="/libs/lib:$LD_LIBRARY_PATH" + ./configure --with-yaml ${{ matrix.io-flag }} - name: Compile run: make -j || make - name: Run test suite 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/CHANGELOG.md b/CHANGELOG.md index c4e463ac02..8f7cbe6066 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,87 @@ 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 +- 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 +- 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. + +### Added +- DIAG_MANAGER: Implements `flush_nc_files` functionality from legacy diag_manager. + +### Changed +- FMS2_IO: Changed `register_unlimited_compressed_axis` to use a collective gather rather than send and recieves to improve efficiency when reading in iceberg restarts. + +### Fixed +- DIAG_MANAGER: Fixes 0 day output frequencies causing error stating a time_step was skipped. Also adds checks to crash if averaged fields have -1 or 0 day frequencies or if mixing averaged and non-averaged fields in the same file. +- DIAG_MANAGER: Fixes issue with the weight argument not getting passed through to reduction methods. +- DIAG_MANAGER: Allocation errors when using two empty files. +- DIAG_MANAGER: `time` and `time_bnds` being larger than expected when running for 1 day and using daily data. +- DIAG_MANAGER: Allows for mixing static and non-static fields when frequency is 0 days. +- TESTS: Fixes compile failure with ifort 2024.01 from test_mpp_gatscat.F90. + +### Removed +- DIAG_MANAGER: The `mix_snapshot_average_fields` option is deprecated for the rewritten diag_manager only. + +### Tag Commit Hashes +- 2024.01.01-beta2 c00367fa810960e87610162f0f012c5da724c5a9 +- 2024.01.01-beta1 42f8506512e1b5b43982320f5b9d4ca1ca9cbebd + ## [2024.01] - 2024-05-03 ### Known Issues @@ -32,9 +113,10 @@ sequential patch number (starting from `01`). - Support defining subregions with indices - More flexibility when adding metadata and defining output frequency - FMS2_IO: Adds support for collective parallel reads to improve model startup time. The collective reads are disabled by default and enabled via the `use_collective` flag in `netcdf_io_mod`. -- DATA_OVERRIDE: Adds multifile support for using 3 input netcdf files instead of one. Three keys have been added to the data_table: `is_multi_file` to be set to true to enable the feature, as well as `prev_file_name` and `next_file_name` to set to the names of the additional files. +- DATA_OVERRIDE: Adds option to use multiple data files for one field within data_override in order to use annual data files in yearly runs without having to append/prepend timesteps from previous and next year. With the legacy data_table, filenames can be set in order and separated with `:` ie. `prev_year.nc:curr_year.nc:next_year.nc`. With the data_table.yaml format, the key `is_multi_file` enables the functionality and `prev_file_name` and `next_file_name` sets the file paths. + - INTERPOLATOR: Adds support for yearly/annual data -- DATA_OVERRIDE: Adds support for monotonically increasing/decreasing arrays +- DATA_OVERRIDE: Adds support for monotonically decreasing arrays for `nearest_index`, `axis_edges`, `horiz_interp`(bilinear), and `data_override` (#1388) - DOCS: Add documentation for the exchange grid (xgrid_mod) and update the contribution guide to add a section on code reviews - MPP: MPI sub-communicators for domains are now accessible via `mpp_get_domain_tile_commid` and `mpp_get_domain_commid` in `mpp_domains_mod` diff --git a/CMakeLists.txt b/CMakeLists.txt index 319ac474f6..2ca5c652ae 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -21,12 +21,9 @@ 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.0 + VERSION 2024.02.0 DESCRIPTION "GFDL FMS Library" HOMEPAGE_URL "https://www.gfdl.noaa.gov/fms" LANGUAGES C Fortran) @@ -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}) diff --git a/configure.ac b/configure.ac index f86eeb7d4f..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.01.00-dev], + [2024.02-dev], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) 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/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 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_manager.F90 b/diag_manager/diag_manager.F90 index eeab1a5227..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 @@ -4210,7 +4211,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) @@ -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, & 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/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 7e0c446475..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 @@ -1393,11 +1398,12 @@ logical function is_time_to_close_file (this, time_step) end function !> \brief Determine if it is time to "write" to the file -logical function is_time_to_write(this, time_step, output_buffers, do_not_write) +logical function is_time_to_write(this, time_step, output_buffers, diag_fields, do_not_write) class(fmsDiagFileContainer_type), intent(inout), target :: this !< The file object TYPE(time_type), intent(in) :: time_step !< Current model step time type(fmsDiagOutputBuffer_type), intent(in) :: output_buffers(:) !< Array of output buffer. !! This is needed for error messages! + type(fmsDiagField_type), intent(in) :: diag_fields(:) !< Array of diag_fields objects logical, intent(out) :: do_not_write !< .True. only if this is not a new !! time step and you are writting !! at every time step @@ -1411,7 +1417,7 @@ logical function is_time_to_write(this, time_step, output_buffers, do_not_write) !! If the diag file is being written at every time step if (time_step .ne. this%FMS_diag_file%next_output) then !! Only write and update the next_output if it is a new time - call this%FMS_diag_file%check_buffer_times(output_buffers) + call this%FMS_diag_file%check_buffer_times(output_buffers, diag_fields) this%FMS_diag_file%next_output = time_step this%FMS_diag_file%next_next_output = time_step is_time_to_write = .true. @@ -1840,22 +1846,29 @@ end function get_number_of_buffers !> Check to ensure that send_data was called at the time step for every output buffer in the file !! This is only needed when you are output data at every time step -subroutine check_buffer_times(this, output_buffers) +subroutine check_buffer_times(this, output_buffers, diag_fields) class(fmsDiagFile_type), intent(in) :: this !< file object type(fmsDiagOutputBuffer_type), intent(in), target :: output_buffers(:) !< Array of output buffers + type(fmsDiagField_type), intent(in) :: diag_fields(:) !< Array of diag_fields - integer :: i - type(time_type) :: current_buffer_time - character(len=:), allocatable :: field_name + integer :: i !< For do loop + type(time_type) :: current_buffer_time !< The buffer time for the current buffer in the do loop + character(len=:), allocatable :: field_name !< The field name (for error messages) + logical :: buffer_time_set !< .True. if current_buffer_time has been set + type(fmsDiagOutputBuffer_type), pointer :: output_buffer_obj !< Pointer to the output buffer + buffer_time_set = .false. do i = 1, this%number_of_buffers - if (i .eq. 1) then - current_buffer_time = output_buffers(this%buffer_ids(i))%get_buffer_time() - field_name = output_buffers(this%buffer_ids(i))%get_buffer_name() + output_buffer_obj => output_buffers(this%buffer_ids(i)) + if (diag_fields(output_buffer_obj%get_field_id())%is_static()) cycle + if (.not. buffer_time_set) then + current_buffer_time = output_buffer_obj%get_buffer_time() + field_name = output_buffer_obj%get_buffer_name() + buffer_time_set = .true. else - if (current_buffer_time .ne. output_buffers(this%buffer_ids(i))%get_buffer_time()) & + if (current_buffer_time .ne. output_buffer_obj%get_buffer_time()) & call mpp_error(FATAL, "Send data has not been called at the same time steps for the fields:"//& - field_name//" and "//output_buffers(this%buffer_ids(i))%get_buffer_name()//& + field_name//" and "//output_buffer_obj%get_buffer_name()//& " in file:"//this%get_file_fname()) endif enddo diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 794a1c6a40..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) @@ -837,7 +846,8 @@ subroutine fms_diag_do_io(this, end_time) call diag_file%write_axis_data(this%diag_axis) endif - finish_writing = diag_file%is_time_to_write(model_time, this%FMS_diag_output_buffers, do_not_write) + finish_writing = diag_file%is_time_to_write(model_time, this%FMS_diag_output_buffers, & + this%FMS_diag_fields, do_not_write) unlim_dim_was_increased = .false. ! finish reduction method if its time to write 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" - } - } - } - } - } - } - } - } -} 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/libFMS/Makefile.am b/libFMS/Makefile.am index fe796928aa..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:0: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 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..a86fcba626 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -119,6 +119,35 @@ end do end if end subroutine mpp_init_logfile + + !> Opens the warning log file, called during mpp_init + subroutine mpp_init_warninglog() + logical :: exist + character(len=11) :: this_pe + if( pe.EQ.root_pe )then + 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' ) + 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 ! 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 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_output_every_freq.F90 b/test_fms/diag_manager/test_output_every_freq.F90 index a0383667fc..3cc88d08ac 100644 --- a/test_fms/diag_manager/test_output_every_freq.F90 +++ b/test_fms/diag_manager/test_output_every_freq.F90 @@ -22,14 +22,16 @@ program test_output_every_freq 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_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 use fms2_io_mod, only: FmsNetcdfFile_t, open_file, close_file, read_data, get_dimension_size implicit none - integer :: id_var0, id_var1 !< diag field ids + integer :: id_var0, id_var1, id_var2 !< 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 @@ -45,9 +47,12 @@ program test_output_every_freq 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_var1 = register_diag_field ('ocn_mod', 'var1', Time) + id_var2 = register_static_field ('ocn_mod', 'var2', (/id_axis1/)) + used = send_data(id_var2, real(123.456)) do i = 1, ntimes Time = Time + Time_step vdata = real(i) diff --git a/test_fms/diag_manager/test_output_every_freq.sh b/test_fms/diag_manager/test_output_every_freq.sh index 705c01293f..71f6cad23f 100755 --- a/test_fms/diag_manager/test_output_every_freq.sh +++ b/test_fms/diag_manager/test_output_every_freq.sh @@ -41,6 +41,10 @@ diag_files: var_name: var0 reduction: none kind: r4 + - module: ocn_mod + var_name: var2 + reduction: none + kind: r4 _EOF my_test_count=1 @@ -66,6 +70,10 @@ diag_files: var_name: var1 reduction: none kind: r4 + - module: ocn_mod + var_name: var2 + reduction: none + kind: r4 _EOF my_test_count=`expr $my_test_count + 1` 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 diff --git a/test_fms/fms/Makefile.am b/test_fms/fms/Makefile.am index f1ceef9ed9..8c2e2fb46b 100644 --- a/test_fms/fms/Makefile.am +++ b/test_fms/fms/Makefile.am @@ -49,7 +49,7 @@ TESTS = test_fms2.sh # These will also be included in the distribution. EXTRA_DIST = test_fms2.sh -CLEANFILES = input.nml logfile.*.out *.mod *.o *.dpi *.spi *.dyn *.spl +CLEANFILES = input.nml *.out *.mod *.o *.dpi *.spi *.dyn *.spl clean-local: rm -rf RESTART 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 diff --git a/test_fms/mpp/Makefile.am b/test_fms/mpp/Makefile.am index 1d44b9bc93..c131f99545 100644 --- a/test_fms/mpp/Makefile.am +++ b/test_fms/mpp/Makefile.am @@ -67,7 +67,8 @@ check_PROGRAMS = test_mpp \ test_mpp_init_logfile \ test_mpp_clock_begin_end_id \ test_mpp_nesting \ - test_mpp_chksum + test_mpp_chksum \ + test_stdlog # These are the sources for the tests. test_mpp_SOURCES = test_mpp.F90 @@ -133,6 +134,7 @@ test_mpp_init_logfile_SOURCES=test_mpp_init_logfile.F90 test_mpp_clock_begin_end_id_SOURCES=test_mpp_clock_begin_end_id.F90 test_super_grid_SOURCES = test_super_grid.F90 test_mpp_chksum_SOURCES = test_mpp_chksum.F90 +test_stdlog_SOURCES = test_stdlog.F90 # ifort gets a internal error during compilation for this test, issue #1071 # we'll just remove the openmp flag if present since it doesn't use openmp at all @@ -177,7 +179,8 @@ TESTS = test_mpp_domains2.sh \ test_mpp_clock_begin_end_id.sh \ test_super_grid.sh \ test_mpp_nesting.sh \ - test_mpp_chksum.sh + test_mpp_chksum.sh \ + test_stdlog.sh # Define test file extensions and log driver TEST_EXTENSIONS = .sh @@ -221,7 +224,8 @@ EXTRA_DIST = test_mpp_domains2.sh \ test_mpp_clock_begin_end_id.sh \ test_super_grid.sh \ test_mpp_nesting.sh \ - test_mpp_chksum.sh + test_mpp_chksum.sh \ + test_stdlog.sh fill_halo.mod: fill_halo.$(OBJEXT) compare_data_checksums.mod: compare_data_checksums.$(OBJEXT) diff --git a/test_fms/mpp/test_stdlog.F90 b/test_fms/mpp/test_stdlog.F90 new file mode 100644 index 0000000000..f8a9bc6d4e --- /dev/null +++ b/test_fms/mpp/test_stdlog.F90 @@ -0,0 +1,94 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** + +!> @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 diff --git a/test_fms/parser/generic_blocks.F90 b/test_fms/parser/generic_blocks.F90 index e5843dda28..d44beb9fcb 100644 --- a/test_fms/parser/generic_blocks.F90 +++ b/test_fms/parser/generic_blocks.F90 @@ -1,3 +1,24 @@ +!*********************************************************************** +!* 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 the subroutines get_num_unique_blocks, get_unique_block_ids, and +!! get_block_name program generic_blocks #ifdef use_yaml use fms_mod, only: fms_init, fms_end