diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS
index 4421b72854..b9d65285a0 100644
--- a/.github/CODEOWNERS
+++ b/.github/CODEOWNERS
@@ -25,7 +25,7 @@
# These owners will be the default owners for all the files in the
# repository. Unless a later match is found, these owners
# will be requested for a review when a PR is opened.
-* @thomas-robinson @bensonr @rem1776
+* @uramirez8707 @bensonr @rem1776
# GNU autotools files
Makefile.am @uramirez8707 @rem1776
@@ -41,7 +41,7 @@ cmake @mlee03
/.github/ @rem1776
# Testing files
-/test_fms/ @uramirez8707 @mlee03 @bensonr @thomas-robinson @rem1776
+/test_fms/ @uramirez8707 @mlee03 @bensonr @rem1776
# Specific component directories
/affinity/ @bensonr
@@ -53,15 +53,15 @@ cmake @mlee03
#/data_override/ Currently no code owner
/test_fms/data_override/ @rem1776
-/diag_manager @thomas-robinson
-/test_fms/diag_manager/ @thomas-robinson
+/diag_manager @uramirez8707
+/test_fms/diag_manager/ @uramirez8707
-/fms/ @thomas-robinson @rem1776
-/test_fms/fms/ @thomas-robinson @rem1776
+/fms/ @uramirez8707 @rem1776
+/test_fms/fms/ @uramirez8707 @rem1776
/fms2/ @uramirez8707
/test_fms/fms2/ @uramirez8707
-/libFMS/ @thomas-robinson @rem1776
+/libFMS/ @uramirez8707 @rem1776
-/mpp/ @thomas-robinson @bensonr
-/test_fms/mpp/ @thomas-robinson @bensonr @rem1776
+/mpp/ @uramirez8707 @bensonr
+/test_fms/mpp/ @uramirez8707 @bensonr @rem1776
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 5082a98e0f..676116f932 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -257,6 +257,8 @@ if(WITH_YAML)
endif()
if(USE_DEPRECATED_IO)
+ message( WARNING "fms_io WILL BE DEPRECATED IN A FUTURE RELEASE. PLEASE UPDATE TO USE FMS2_IO AND REMOVE "
+ "-DUSE_DEPRECATED_IO=on FROM YOUR OPTIONS")
list(APPEND fms_defs use_deprecated_io)
endif()
@@ -429,13 +431,13 @@ endforeach()
install(
TARGETS ${LIB_TARGETS}
EXPORT FMSExports
- RUNTIME DESTINATION bin
- LIBRARY DESTINATION lib
- ARCHIVE DESTINATION lib)
+ RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}
+ LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
+ ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR})
### Package config
include(CMakePackageConfigHelpers)
-set(CONFIG_INSTALL_DESTINATION lib/cmake/fms)
+set(CONFIG_INSTALL_DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/fms)
export(EXPORT FMSExports
NAMESPACE FMS::
diff --git a/configure.ac b/configure.ac
index e7dc02506e..d5ab7d2f88 100644
--- a/configure.ac
+++ b/configure.ac
@@ -537,3 +537,7 @@ AC_CONFIG_FILES([
])
AC_OUTPUT()
+
+if test $enable_deprecated_io = yes; then
+ AC_MSG_WARN(FMS_IO WILL BE DEPRECATED IN A FUTURE RLEASE. PLEASE UPDATE TO USE FMS2_IO AND REMOVE --enable-deprecated-io FROM YOUR CONFIGURE OPTIONS)
+fi
\ No newline at end of file
diff --git a/data_override/README.MD b/data_override/README.MD
index b35879edf2..fd83965638 100644
--- a/data_override/README.MD
+++ b/data_override/README.MD
@@ -8,6 +8,7 @@
- [Converting legacy data_table to data_table.yaml](README.MD#3-converting-legacy-data_table-to-data_tableyaml)
- [Examples](README.MD#4-examples)
- [External Weight File Structure](README.MD#5-external-weight-file-structure)
+- [Ensemble and Nest Support](README.MD#6-ensemble-and-nest-support)
#### 1. YAML Data Table format:
Each entry in the data_table has the following key values:
@@ -200,3 +201,7 @@ variables:
- weight(:,:,2) -> (i,j+1)
- weight(:,:,3) -> (i+1,j)
- weight(:,:,4) -> (i+1,j+1)
+
+#### 6. Ensemble and Nest Support
+
+It may be desired to have each member of an ensemble use a different forcing file. In other to support this, FMS allows for each ensemble member to have its own data_table.yaml. For example, for a run with 2 ensemble members, fms will search for data_table_ens_01.yaml and data_table_ens_02.yaml. However, if both the data_table.yaml and the data_table_ens_* files are present, the code will crash as only 1 option is allowed. Similary, each nest can have its own data_table (data_table_nest_01.yaml), but in this case FMS will not crash if both data_table_nest_01.yaml and data_table.yaml are present. The main grid will use the data_table.yaml and the first nest will use the data_table_nest_01.yaml file.
\ No newline at end of file
diff --git a/data_override/include/data_override.inc b/data_override/include/data_override.inc
index d5cc939029..17360d0b85 100644
--- a/data_override/include/data_override.inc
+++ b/data_override/include/data_override.inc
@@ -21,7 +21,7 @@
! modules. These modules are not intended to be used directly - they should be
! used through the data_override_mod API. See data_override.F90 for details.
-use platform_mod, only: r4_kind, r8_kind, FMS_PATH_LEN
+use platform_mod, only: r4_kind, r8_kind, FMS_PATH_LEN, FMS_FILE_LEN
use yaml_parser_mod
use constants_mod, only: DEG_TO_RAD
use mpp_mod, only : mpp_error, FATAL, WARNING, NOTE, stdout, stdlog, mpp_max
@@ -45,7 +45,7 @@ use mpp_domains_mod, only : domainUG, mpp_pass_SG_to_UG, mpp_get_UG_SG_domain, N
use time_manager_mod, only: time_type, OPERATOR(>), OPERATOR(<)
use fms2_io_mod, only : FmsNetcdfFile_t, open_file, close_file, &
read_data, fms2_io_init, variable_exists, &
- get_mosaic_tile_file, file_exists
+ get_mosaic_tile_file, file_exists, get_instance_filename
use get_grid_version_mod, only: get_grid_version_1, get_grid_version_2
use fms_string_utils_mod, only: string
@@ -591,9 +591,18 @@ subroutine read_table_yaml(data_table)
integer :: nentries, mentries
integer :: i
character(len=50) :: buffer
+ character(len=FMS_FILE_LEN) :: filename !< Name of the expected data_table.yaml
integer :: file_id
- file_id = open_and_parse_file("data_table.yaml")
+ ! If doing and ensemble or nest run add the filename appendix (ens_XX or nest_XX) to the filename
+ call get_instance_filename("data_table.yaml", filename)
+ if (index(trim(filename), "ens_") .ne. 0) then
+ if (file_exists(filename) .and. file_exists("data_table.yaml")) &
+ call mpp_error(FATAL, "Both data_table.yaml and "//trim(filename)//" exists, pick one!")
+ endif
+
+ file_id = open_and_parse_file(trim(filename))
+
if (file_id==999) then
nentries = 0
else
diff --git a/diag_manager/diag_yaml_format.md b/diag_manager/diag_yaml_format.md
index d9e93c3593..b561445fdc 100644
--- a/diag_manager/diag_yaml_format.md
+++ b/diag_manager/diag_yaml_format.md
@@ -15,6 +15,7 @@ The purpose of this document is to explain the diag_table yaml format.
- [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)
+- [5. Ensemble and Nest Support](diag_yaml_format.md#5-ensemble-and-nest-support)
### 1. Converting from legacy ascii diag_table format
@@ -349,3 +350,6 @@ diag_files:
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.
+
+### 5. Ensemble and Nest Support
+When using nests, it may be desired for a nest to have a different file frequency or number of variables from the parent grid. This may allow users to save disk space and reduce simulations time. In order to supports, FMS allows each nest to have a different diag_table.yaml from the parent grid. For example, if running with 1 test FMS will use diag_table.yaml for the parent grid and diag_table.nest_01.yaml for the first nest Similary, each ensemble member can have its own diag_table (diag_table_ens_XX.yaml, where XX is the ensemble number). However, for the ensemble case if both the diag_table.yaml and the diag_table_ens_* files are present, the code will crash as only 1 option is allowed.
\ No newline at end of file
diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90
index c985a6c30d..f4c892dec8 100644
--- a/diag_manager/fms_diag_object.F90
+++ b/diag_manager/fms_diag_object.F90
@@ -224,6 +224,7 @@ integer function fms_register_diag_field_obj &
integer, allocatable :: file_ids(:) !< The file IDs for this variable
integer :: i !< For do loops
integer, allocatable :: diag_field_indices(:) !< indices where the field was found in the yaml
+ class(diagDomain_t), pointer :: null_diag_domain => NULL() !< Workaround for a Cray bug which will be fixed in CCE 19
#endif
#ifndef use_yaml
fms_register_diag_field_obj = DIAG_FIELD_NOT_FOUND
@@ -267,7 +268,7 @@ integer function fms_register_diag_field_obj &
call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
if(fieldptr%get_type_of_domain() .eq. NO_DOMAIN) then
- call fileptr%set_file_domain(NULL(), fieldptr%get_type_of_domain())
+ call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
else
call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
endif
@@ -284,7 +285,7 @@ integer function fms_register_diag_field_obj &
call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
if(fieldptr%get_type_of_domain() .eq. NO_DOMAIN) then
- call fileptr%set_file_domain(NULL(), fieldptr%get_type_of_domain())
+ call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
else
call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
endif
diff --git a/diag_manager/fms_diag_yaml.F90 b/diag_manager/fms_diag_yaml.F90
index a1c9b0b805..26f631414c 100644
--- a/diag_manager/fms_diag_yaml.F90
+++ b/diag_manager/fms_diag_yaml.F90
@@ -45,6 +45,7 @@ module fms_diag_yaml_mod
fms_f2c_string
use platform_mod, only: r4_kind, i4_kind, r8_kind, i8_kind, FMS_FILE_LEN
use fms_mod, only: lowercase
+use fms2_io_mod, only: file_exists, get_instance_filename
implicit none
@@ -381,10 +382,17 @@ subroutine diag_yaml_object_init(diag_subset_output)
!! outputing data at every frequency)
character(len=:), allocatable :: filename!< Diag file name (for error messages)
logical :: is_instantaneous !< .True. if the file is instantaneous (i.e no averaging)
+ character(len=FMS_FILE_LEN) :: yamlfilename !< Name of the expected diag_table.yaml
if (diag_yaml_module_initialized) return
- diag_yaml_id = open_and_parse_file("diag_table.yaml")
+ ! If doing and ensemble or nest run add the filename appendix (ens_XX or nest_XX) to the filename
+ call get_instance_filename("diag_table.yaml", yamlfilename)
+ if (index(trim(yamlfilename), "ens_") .ne. 0) then
+ if (file_exists(yamlfilename) .and. file_exists("diag_table.yaml")) &
+ call mpp_error(FATAL, "Both diag_table.yaml and "//trim(yamlfilename)//" exists, pick one!")
+ endif
+ diag_yaml_id = open_and_parse_file(trim(yamlfilename))
call diag_get_value_from_key(diag_yaml_id, 0, "title", diag_yaml%diag_title)
call get_value_from_key(diag_yaml_id, 0, "base_date", diag_yaml%diag_basedate)
diff --git a/field_manager/field_manager.F90 b/field_manager/field_manager.F90
index 5c4b44294b..ba26417195 100644
--- a/field_manager/field_manager.F90
+++ b/field_manager/field_manager.F90
@@ -190,7 +190,7 @@ module field_manager_mod
use fms_mod, only : lowercase, &
write_version_number, &
check_nml_error
-use fms2_io_mod, only: file_exists
+use fms2_io_mod, only: file_exists, get_instance_filename
use platform_mod, only: r4_kind, r8_kind, FMS_PATH_LEN, FMS_FILE_LEN
#ifdef use_yaml
use fm_yaml_mod
@@ -606,18 +606,27 @@ subroutine read_field_table_yaml(nfields, table_name)
logical :: fm_success !< logical for whether fm_change_list was a success
logical :: subparams !< logical whether subparams exist in this iteration
+character(len=FMS_FILE_LEN) :: filename !< Name of the expected field_table.yaml
+
if (.not.PRESENT(table_name)) then
tbl_name = 'field_table.yaml'
else
tbl_name = trim(table_name)
endif
-if (.not. file_exists(trim(tbl_name))) then
+
+call get_instance_filename(tbl_name, filename)
+if (index(trim(filename), "ens_") .ne. 0) then
+ if (file_exists(filename) .and. file_exists(tbl_name)) &
+ call mpp_error(FATAL, "Both "//trim(tbl_name)//" and "//trim(filename)//" exists, pick one!")
+endif
+
+if (.not. file_exists(trim(filename))) then
if(present(nfields)) nfields = 0
return
endif
! Construct my_table object
-call build_fmTable(my_table, trim(tbl_name))
+call build_fmTable(my_table, trim(filename))
do h=1,size(my_table%types)
do i=1,size(my_table%types(h)%models)
diff --git a/fms/fms_io.F90 b/fms/fms_io.F90
index 06ca5a0627..47854fb997 100644
--- a/fms/fms_io.F90
+++ b/fms/fms_io.F90
@@ -693,6 +693,11 @@ subroutine fms_io_init()
call mpp_error(FATAL,'=>fms_io_init: Error reading input nml file')
endif
+ call mpp_error(NOTE, "fms_io_init: fms_io WILL BE DEPRECATED IN A FUTURE RELEASE! "//&
+ "PLEASE REMOVE -Duse_deprecated_io FROM YOUR COMPILE FLAGS "// &
+ "AND MOVE TO FMS2_IO. CONTACT YOUR MODEL LIASISON IF YOU NEED "// &
+ "ASSISTANCE")
+
! take namelist options if present
! read_data_bug is no longer supported.
if (read_data_bug) then
@@ -802,6 +807,11 @@ subroutine fms_io_exit()
if( .NOT.module_is_initialized )return !make sure it's only called once per PE
+ call mpp_error(NOTE, "fms_io_exit: fms_io WILL BE DEPRECATED IN A FUTURE RELEASE! "//&
+ "PLEASE REMOVE -Duse_deprecated_io FROM YOUR COMPILE FLAGS "// &
+ "AND MOVE TO FMS2_IO. CONTACT YOUR MODEL LIASISON IF YOU NEED "// &
+ "ASSISTANCE")
+
do i=1,max_axis_size
axisdata(i) = i
enddo
diff --git a/fms2_io/fms_io_utils.F90 b/fms2_io/fms_io_utils.F90
index 85b34aa840..605c7d08e9 100644
--- a/fms2_io/fms_io_utils.F90
+++ b/fms2_io/fms_io_utils.F90
@@ -824,8 +824,14 @@ subroutine get_instance_filename(name_in,name_out)
if ( i .ne. 0 ) then
name_out = name_in(1:i-1)//'.'//trim(filename_appendix)//name_in(i:length)
else
- !< If .nc is not in the name, add the appendix at the end of the file
- name_out = name_in(1:length) //'.'//trim(filename_appendix)
+ i = index(trim(name_in), ".yaml", back=.true.)
+ if (i .ne. 0) then
+ !< If .yaml is in the filename add the appendix before it
+ name_out = name_in(1:i-1)//'.'//trim(filename_appendix)//name_in(i:length)
+ else
+ !< If .nc and .yaml are not in the name, add the appendix at the end of the file
+ name_out = name_in(1:length) //'.'//trim(filename_appendix)
+ endif
end if
end if
diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90
index e87870698c..a2bc90a821 100644
--- a/horiz_interp/horiz_interp_type.F90
+++ b/horiz_interp/horiz_interp_type.F90
@@ -164,58 +164,131 @@ subroutine horiz_interp_type_eq(horiz_interp_out, horiz_interp_in)
call mpp_error(FATAL,'horiz_interp_type_eq: horiz_interp_type variable on right hand side is unassigned')
endif
- horiz_interp_out%ilon = horiz_interp_in%ilon
- horiz_interp_out%jlat = horiz_interp_in%jlat
- horiz_interp_out%i_lon = horiz_interp_in%i_lon
- horiz_interp_out%j_lat = horiz_interp_in%j_lat
- horiz_interp_out%found_neighbors = horiz_interp_in%found_neighbors
- horiz_interp_out%num_found = horiz_interp_in%num_found
- horiz_interp_out%nlon_src = horiz_interp_in%nlon_src
- horiz_interp_out%nlat_src = horiz_interp_in%nlat_src
- horiz_interp_out%nlon_dst = horiz_interp_in%nlon_dst
- horiz_interp_out%nlat_dst = horiz_interp_in%nlat_dst
+ if( allocated(horiz_interp_in%ilon )) &
+ horiz_interp_out%ilon = horiz_interp_in%ilon
+
+ if( allocated(horiz_interp_in%jlat )) &
+ horiz_interp_out%jlat = horiz_interp_in%jlat
+
+ if( allocated(horiz_interp_in%i_lon )) &
+ horiz_interp_out%i_lon = horiz_interp_in%i_lon
+
+ if( allocated(horiz_interp_in%j_lat )) &
+ horiz_interp_out%j_lat = horiz_interp_in%j_lat
+
+ if( allocated(horiz_interp_in%found_neighbors )) &
+ horiz_interp_out%found_neighbors = horiz_interp_in%found_neighbors
+
+ if( allocated(horiz_interp_in%num_found )) &
+ horiz_interp_out%num_found = horiz_interp_in%num_found
+
+ if( allocated(horiz_interp_in%i_src )) &
+ horiz_interp_out%i_src = horiz_interp_in%i_src
+
+ if( allocated(horiz_interp_in%j_src )) &
+ horiz_interp_out%j_src = horiz_interp_in%j_src
+
+ if( allocated(horiz_interp_in%i_dst )) &
+ horiz_interp_out%i_dst = horiz_interp_in%i_dst
+
+ if( allocated(horiz_interp_in%j_dst )) &
+ horiz_interp_out%j_dst = horiz_interp_in%j_dst
+
+ horiz_interp_out%nlon_src = horiz_interp_in%nlon_src
+ horiz_interp_out%nlat_src = horiz_interp_in%nlat_src
+ horiz_interp_out%nlon_dst = horiz_interp_in%nlon_dst
+ horiz_interp_out%nlat_dst = horiz_interp_in%nlat_dst
horiz_interp_out%interp_method = horiz_interp_in%interp_method
horiz_interp_out%I_am_initialized = .true.
- horiz_interp_out%i_src = horiz_interp_in%i_src
- horiz_interp_out%j_src = horiz_interp_in%j_src
- horiz_interp_out%i_dst = horiz_interp_in%i_dst
- horiz_interp_out%j_dst = horiz_interp_in%j_dst
if(horiz_interp_in%horizInterpReals8_type%is_allocated) then
- horiz_interp_out%horizInterpReals8_type%faci = horiz_interp_in%horizInterpReals8_type%faci
- horiz_interp_out%horizInterpReals8_type%facj = horiz_interp_in%horizInterpReals8_type%facj
- horiz_interp_out%horizInterpReals8_type%area_src = horiz_interp_in%horizInterpReals8_type%area_src
- horiz_interp_out%horizInterpReals8_type%area_dst = horiz_interp_in%horizInterpReals8_type%area_dst
- horiz_interp_out%horizInterpReals8_type%wti = horiz_interp_in%horizInterpReals8_type%wti
- horiz_interp_out%horizInterpReals8_type%wtj = horiz_interp_in%horizInterpReals8_type%wtj
- horiz_interp_out%horizInterpReals8_type%src_dist = horiz_interp_in%horizInterpReals8_type%src_dist
- horiz_interp_out%horizInterpReals8_type%rat_x = horiz_interp_in%horizInterpReals8_type%rat_x
- horiz_interp_out%horizInterpReals8_type%rat_y = horiz_interp_in%horizInterpReals8_type%rat_y
- horiz_interp_out%horizInterpReals8_type%lon_in = horiz_interp_in%horizInterpReals8_type%lon_in
- horiz_interp_out%horizInterpReals8_type%lat_in = horiz_interp_in%horizInterpReals8_type%lat_in
- horiz_interp_out%horizInterpReals8_type%area_frac_dst = horiz_interp_in%horizInterpReals8_type%area_frac_dst
- horiz_interp_out%horizInterpReals8_type%max_src_dist = horiz_interp_in%horizInterpReals8_type%max_src_dist
- horiz_interp_out%horizInterpReals8_type%is_allocated = .true.
+
+ if( allocated(horiz_interp_in%horizInterpReals8_type%faci)) &
+ horiz_interp_out%horizInterpReals8_type%faci = horiz_interp_in%horizInterpReals8_type%faci
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%facj)) &
+ horiz_interp_out%horizInterpReals8_type%facj = horiz_interp_in%horizInterpReals8_type%facj
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%area_src)) &
+ horiz_interp_out%horizInterpReals8_type%area_src = horiz_interp_in%horizInterpReals8_type%area_src
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%area_dst)) &
+ horiz_interp_out%horizInterpReals8_type%area_dst = horiz_interp_in%horizInterpReals8_type%area_dst
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%wti)) &
+ horiz_interp_out%horizInterpReals8_type%wti = horiz_interp_in%horizInterpReals8_type%wti
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%wtj)) &
+ horiz_interp_out%horizInterpReals8_type%wtj = horiz_interp_in%horizInterpReals8_type%wtj
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%src_dist)) &
+ horiz_interp_out%horizInterpReals8_type%src_dist = horiz_interp_in%horizInterpReals8_type%src_dist
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%rat_x)) &
+ horiz_interp_out%horizInterpReals8_type%rat_x = horiz_interp_in%horizInterpReals8_type%rat_x
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%rat_y)) &
+ horiz_interp_out%horizInterpReals8_type%rat_y = horiz_interp_in%horizInterpReals8_type%rat_y
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%lon_in)) &
+ horiz_interp_out%horizInterpReals8_type%lon_in = horiz_interp_in%horizInterpReals8_type%lon_in
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%lat_in)) &
+ horiz_interp_out%horizInterpReals8_type%lat_in = horiz_interp_in%horizInterpReals8_type%lat_in
+
+ if( allocated( horiz_interp_in%horizInterpReals8_type%area_frac_dst)) &
+ horiz_interp_out%horizInterpReals8_type%area_frac_dst = horiz_interp_in%horizInterpReals8_type%area_frac_dst
+
+ horiz_interp_out%horizInterpReals8_type%max_src_dist = horiz_interp_in%horizInterpReals8_type%max_src_dist
+
+ horiz_interp_out%horizInterpReals8_type%is_allocated = .true.
! this was left out previous to mixed mode
- horiz_interp_out%horizInterpReals8_type%mask_in = horiz_interp_in%horizInterpReals8_type%mask_in
+ if( allocated(horiz_interp_in%horizInterpReals8_type%mask_in)) &
+ horiz_interp_out%horizInterpReals8_type%mask_in = horiz_interp_in%horizInterpReals8_type%mask_in
else if (horiz_interp_in%horizInterpReals4_type%is_allocated) then
- horiz_interp_out%horizInterpReals4_type%faci = horiz_interp_in%horizInterpReals4_type%faci
- horiz_interp_out%horizInterpReals4_type%facj = horiz_interp_in%horizInterpReals4_type%facj
- horiz_interp_out%horizInterpReals4_type%area_src = horiz_interp_in%horizInterpReals4_type%area_src
- horiz_interp_out%horizInterpReals4_type%area_dst = horiz_interp_in%horizInterpReals4_type%area_dst
- horiz_interp_out%horizInterpReals4_type%wti = horiz_interp_in%horizInterpReals4_type%wti
- horiz_interp_out%horizInterpReals4_type%wtj = horiz_interp_in%horizInterpReals4_type%wtj
- horiz_interp_out%horizInterpReals4_type%src_dist = horiz_interp_in%horizInterpReals4_type%src_dist
- horiz_interp_out%horizInterpReals4_type%rat_x = horiz_interp_in%horizInterpReals4_type%rat_x
- horiz_interp_out%horizInterpReals4_type%rat_y = horiz_interp_in%horizInterpReals4_type%rat_y
- horiz_interp_out%horizInterpReals4_type%lon_in = horiz_interp_in%horizInterpReals4_type%lon_in
- horiz_interp_out%horizInterpReals4_type%lat_in = horiz_interp_in%horizInterpReals4_type%lat_in
- horiz_interp_out%horizInterpReals4_type%area_frac_dst = horiz_interp_in%horizInterpReals4_type%area_frac_dst
- horiz_interp_out%horizInterpReals4_type%max_src_dist = horiz_interp_in%horizInterpReals4_type%max_src_dist
- horiz_interp_out%horizInterpReals4_type%is_allocated = .true.
+ if( allocated(horiz_interp_in%horizInterpReals4_type%faci)) &
+ horiz_interp_out%horizInterpReals4_type%faci = horiz_interp_in%horizInterpReals4_type%faci
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%facj)) &
+ horiz_interp_out%horizInterpReals4_type%facj = horiz_interp_in%horizInterpReals4_type%facj
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%area_src)) &
+ horiz_interp_out%horizInterpReals4_type%area_src = horiz_interp_in%horizInterpReals4_type%area_src
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%area_dst)) &
+ horiz_interp_out%horizInterpReals4_type%area_dst = horiz_interp_in%horizInterpReals4_type%area_dst
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%wti)) &
+ horiz_interp_out%horizInterpReals4_type%wti = horiz_interp_in%horizInterpReals4_type%wti
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%wtj)) &
+ horiz_interp_out%horizInterpReals4_type%wtj = horiz_interp_in%horizInterpReals4_type%wtj
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%src_dist)) &
+ horiz_interp_out%horizInterpReals4_type%src_dist = horiz_interp_in%horizInterpReals4_type%src_dist
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%rat_x)) &
+ horiz_interp_out%horizInterpReals4_type%rat_x = horiz_interp_in%horizInterpReals4_type%rat_x
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%rat_y)) &
+ horiz_interp_out%horizInterpReals4_type%rat_y = horiz_interp_in%horizInterpReals4_type%rat_y
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%lon_in)) &
+ horiz_interp_out%horizInterpReals4_type%lon_in = horiz_interp_in%horizInterpReals4_type%lon_in
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%lat_in)) &
+ horiz_interp_out%horizInterpReals4_type%lat_in = horiz_interp_in%horizInterpReals4_type%lat_in
+
+ if( allocated( horiz_interp_in%horizInterpReals4_type%area_frac_dst)) &
+ horiz_interp_out%horizInterpReals4_type%area_frac_dst = horiz_interp_in%horizInterpReals4_type%area_frac_dst
+
+ horiz_interp_out%horizInterpReals4_type%max_src_dist = horiz_interp_in%horizInterpReals4_type%max_src_dist
+
+ horiz_interp_out%horizInterpReals4_type%is_allocated = .true.
! this was left out previous to mixed mode
- horiz_interp_out%horizInterpReals4_type%mask_in = horiz_interp_in%horizInterpReals4_type%mask_in
+ if( allocated(horiz_interp_in%horizInterpReals4_type%mask_in)) &
+ horiz_interp_out%horizInterpReals4_type%mask_in = horiz_interp_in%horizInterpReals4_type%mask_in
else
call mpp_error(FATAL, "horiz_interp_type_eq: cannot assign unallocated real values from horiz_interp_in")
diff --git a/libFMS.F90 b/libFMS.F90
index 9180be32f5..09296b76aa 100644
--- a/libFMS.F90
+++ b/libFMS.F90
@@ -742,6 +742,7 @@ module fms
fms_string_utils_sort_this => fms_sort_this, &
fms_string_utils_find_my_string => fms_find_my_string, &
fms_string_utils_find_unique => fms_find_unique, &
+ fms_string_utils_f2c_string => fms_f2c_string, &
fms_string_utils_c2f_string => fms_c2f_string, &
fms_string_utils_cstring2cpointer => fms_cstring2cpointer, &
fms_string_utils_copy => string_copy
diff --git a/m4/gx_fortran_options.m4 b/m4/gx_fortran_options.m4
index 04980c1b68..294264eadd 100644
--- a/m4/gx_fortran_options.m4
+++ b/m4/gx_fortran_options.m4
@@ -90,13 +90,12 @@ for ac_flag in none \
'-qrealsize=8'; do
test "x$ac_flag" != xnone && FCFLAGS="$gx_fc_default_real_kind8_flag_FCFLAGS_save ${ac_flag}"
AC_COMPILE_IFELSE([[ program test
- interface
+ real :: b=1.0
+ call test_sub(b)
+ contains
subroutine test_sub(a)
real(kind=selected_real_kind(15,307)) :: a
end subroutine test_sub
- end interface
- real :: b=1.0
- call test_sub(b)
end program test]],
[gx_cv_fc_default_real_kind8_flag=$ac_flag; break])
done
@@ -148,13 +147,12 @@ for ac_flag in none \
'-qrealsize=4'; do
test "x$ac_flag" != xnone && FCFLAGS="$gx_fc_default_real_kind4_flag_FCFLAGS_save ${ac_flag}"
AC_COMPILE_IFELSE([[ program test
- interface
+ real :: b=1.0
+ call test_sub(b)
+ contains
subroutine test_sub(a)
real(kind=selected_real_kind(6, 37)) :: a
end subroutine test_sub
- end interface
- real :: b=1.0
- call test_sub(b)
end program test]],
[gx_cv_fc_default_real_kind4_flag=$ac_flag; break])
done
diff --git a/mosaic2/include/mosaic2.inc b/mosaic2/include/mosaic2.inc
index 2da3d136db..c87481e700 100644
--- a/mosaic2/include/mosaic2.inc
+++ b/mosaic2/include/mosaic2.inc
@@ -86,15 +86,13 @@
!>
Example usage:
!! call calc_mosaic_grid_area(lon, lat, area)
subroutine CALC_MOSAIC_GRID_AREA_(lon, lat, area)
- real(kind=FMS_MOS_KIND_), dimension(:,:), intent(in) :: lon
- real(kind=FMS_MOS_KIND_), dimension(:,:), intent(in) :: lat
- real(kind=FMS_MOS_KIND_), dimension(:,:), intent(inout) :: area
+ real(kind=FMS_MOS_KIND_), dimension(:,:), intent(in) :: lon
+ real(kind=FMS_MOS_KIND_), dimension(:,:), intent(in) :: lat
+ real(kind=FMS_MOS_KIND_), dimension(:,:), intent(out) :: area
integer :: nlon, nlat
real(r8_kind) :: area_r8(size(area,1),size(area,2))
- area_r8=real(area,r8_kind)
-
nlon = size(area,1)
nlat = size(area,2)
! make sure size of lon, lat and area are consitency
diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90
index 3a3c7f0051..a34c5d4e22 100644
--- a/parser/yaml_parser.F90
+++ b/parser/yaml_parser.F90
@@ -76,7 +76,7 @@ function open_and_parse_file_wrap(filename, file_id) bind(c) &
use iso_c_binding, only: c_char, c_int, c_bool
character(kind=c_char), intent(in) :: filename(*) !< Filename of the yaml file
integer(kind=c_int), intent(out) :: file_id !< File id corresponding to the yaml file that was opened
- logical(kind=c_int) :: error_code !< Flag indicating the error message (1 if sucessful)
+ integer(kind=c_int) :: error_code !< Flag indicating the error message (1 if sucessful)
end function open_and_parse_file_wrap
!> @brief Private c function that checks if a file_id is valid (see yaml_parser_binding.c)
diff --git a/test_fms/column_diagnostics/Makefile.am b/test_fms/column_diagnostics/Makefile.am
index 8c9f9b6d5a..d8fb204ff5 100644
--- a/test_fms/column_diagnostics/Makefile.am
+++ b/test_fms/column_diagnostics/Makefile.am
@@ -34,8 +34,8 @@ check_PROGRAMS = test_column_diagnostics_r4 test_column_diagnostics_r8
test_column_diagnostics_r4_SOURCES = test_column_diagnostics.F90
test_column_diagnostics_r8_SOURCES = test_column_diagnostics.F90
-test_column_diagnostics_r4_CPPFLAGS=-DTEST_CD_KIND_=4 -I$(AM_CPPFLAGS)
-test_column_diagnostics_r8_CPPFLAGS=-DTEST_CD_KIND_=8 -I$(AM_CPPFLAGS)
+test_column_diagnostics_r4_CPPFLAGS=$(AM_CPPFLAGS) -DTEST_CD_KIND_=4
+test_column_diagnostics_r8_CPPFLAGS=$(AM_CPPFLAGS) -DTEST_CD_KIND_=8
TEST_EXTENSIONS = .sh
SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) $(abs_top_srcdir)/test_fms/tap-driver.sh
diff --git a/test_fms/coupler/test_atmos_ocean_fluxes.F90 b/test_fms/coupler/test_atmos_ocean_fluxes.F90
index 742ac4c50f..7eb50880df 100644
--- a/test_fms/coupler/test_atmos_ocean_fluxes.F90
+++ b/test_fms/coupler/test_atmos_ocean_fluxes.F90
@@ -106,7 +106,8 @@ subroutine test_aof_set_coupler_flux
character(100) :: cresults, thelist
real(FMS_CP_TEST_KIND_) :: rresults, rresults2(num_bcs)
- integer :: i, success, n
+ integer :: i, n
+ logical :: success
write(*,*) "*** TEST_AOF_SET_COUPLER_FLUX ***"
diff --git a/test_fms/data_override/Makefile.am b/test_fms/data_override/Makefile.am
index 087bd91ea3..0de57700f9 100644
--- a/test_fms/data_override/Makefile.am
+++ b/test_fms/data_override/Makefile.am
@@ -73,11 +73,11 @@ TESTS_ENVIRONMENT= test_input_path="@TEST_INPUT_PATH@" \
# Run the test program.
TESTS = test_data_override2.sh test_data_override_init.sh test_data_override2_mono.sh test_data_override2_ongrid.sh \
- test_data_override2_scalar.sh test_data_override_weights.sh
+ test_data_override2_scalar.sh test_data_override_weights.sh test_data_override_ensembles.sh
# Include these files with the distribution.
EXTRA_DIST = test_data_override2.sh test_data_override_init.sh test_data_override2_mono.sh test_data_override2_ongrid.sh \
- test_data_override2_scalar.sh test_data_override_weights.sh
+ test_data_override2_scalar.sh test_data_override_weights.sh test_data_override_ensembles.sh
# Clean up
CLEANFILES = input.nml *.nc* *.out diag_table data_table data_table.yaml INPUT/* *.dpi *.spi *.dyn *.spl *-files/*
diff --git a/test_fms/data_override/test_data_override2_mono.sh b/test_fms/data_override/test_data_override2_mono.sh
index be1cce4103..05c833389a 100755
--- a/test_fms/data_override/test_data_override2_mono.sh
+++ b/test_fms/data_override/test_data_override2_mono.sh
@@ -27,9 +27,10 @@
output_dir
[ ! -d "INPUT" ] && mkdir -p "INPUT"
-cat <<_EOF > input.nml
+cat <<_EOF > input_base.nml
&test_data_override_ongrid_nml
test_case = 2
+ write_only = .False.
/
_EOF
@@ -41,6 +42,12 @@ _EOF
for KIND in r4 r8
do
rm -rf INPUT/*
+ sed 's/write_only = .False./write_only = .True./g' input_base.nml > input.nml
+ test_expect_success "Creating input files (${KIND})" '
+ mpirun -n 6 ../test_data_override_ongrid_${KIND}
+ '
+
+ cp input_base.nml input.nml
test_expect_success "test_data_override with monotonically increasing and decreasing data sets (${KIND})" '
mpirun -n 6 ../test_data_override_ongrid_${KIND}
'
@@ -48,9 +55,10 @@ done
rm -rf data_table
-cat <<_EOF > input.nml
+cat <<_EOF > input_base.nml
&test_data_override_ongrid_nml
test_case = 2
+ write_only = .False.
/
&data_override_nml
use_data_table_yaml = .True.
@@ -80,6 +88,12 @@ if [ -z $parser_skip ]; then
for KIND in r4 r8
do
rm -rf INPUT/*
+ sed 's/write_only = .False./write_only = .True./g' input_base.nml > input.nml
+ test_expect_success "Creating input files (${KIND})" '
+ mpirun -n 6 ../test_data_override_ongrid_${KIND}
+ '
+
+ cp input_base.nml input.nml
test_expect_success "test_data_override with monotonically increasing and decreasing data sets -yaml (${KIND})" '
mpirun -n 6 ../test_data_override_ongrid_${KIND}
'
diff --git a/test_fms/data_override/test_data_override2_ongrid.sh b/test_fms/data_override/test_data_override2_ongrid.sh
index e9f36712ce..4d4616734c 100755
--- a/test_fms/data_override/test_data_override2_ongrid.sh
+++ b/test_fms/data_override/test_data_override2_ongrid.sh
@@ -36,6 +36,7 @@ use_data_table_yaml=.False.
&test_data_override_ongrid_nml
nhalox=halo_size
nhaloy=halo_size
+ write_only = .False.
/
_EOF
printf '"OCN", "runoff", "runoff", "./INPUT/runoff.daitren.clim.1440x1080.v20180328.nc", "none" , 1.0' | cat > data_table
@@ -48,6 +49,7 @@ use_data_table_yaml=.True.
&test_data_override_ongrid_nml
nhalox=halo_size
nhaloy=halo_size
+ write_only = .False.
/
_EOF
cat <<_EOF > data_table.yaml
@@ -65,13 +67,17 @@ fi
[ ! -d "INPUT" ] && mkdir -p "INPUT"
for KIND in r4 r8
do
-rm -rf INPUT/*
+sed -e 's/halo_size/2/g ; s/write_only = .False./write_only = .True./g' input_base.nml > input.nml
+
+test_expect_success "Creating input files (${KIND})" '
+ mpirun -n 6 ../test_data_override_ongrid_${KIND}
+'
+
sed 's/halo_size/2/g' input_base.nml > input.nml
test_expect_success "data_override on grid with 2 halos in x and y (${KIND})" '
mpirun -n 6 ../test_data_override_ongrid_${KIND}
'
-rm -rf INPUT/*
sed 's/halo_size/0/g' input_base.nml > input.nml
test_expect_success "data_override on grid with 0 halos in x and y (${KIND})" '
mpirun -n 6 ../test_data_override_ongrid_${KIND}
diff --git a/test_fms/data_override/test_data_override2_scalar.sh b/test_fms/data_override/test_data_override2_scalar.sh
index ac19b2b0a6..6b6c096b7a 100755
--- a/test_fms/data_override/test_data_override2_scalar.sh
+++ b/test_fms/data_override/test_data_override2_scalar.sh
@@ -28,22 +28,24 @@ output_dir
rm -rf data_table data_table.yaml input.nml input_base.nml
if [ ! -z $parser_skip ]; then
- cat <<_EOF > input.nml
+ cat <<_EOF > input_base.nml
&data_override_nml
use_data_table_yaml=.False.
/
&test_data_override_ongrid_nml
test_case = 3
+ write_only = .False.
/
_EOF
printf '"OCN", "co2", "co2", "./INPUT/scalar.nc", "none" , 1.0' | cat > data_table
else
-cat <<_EOF > input.nml
+cat <<_EOF > input_base.nml
&data_override_nml
use_data_table_yaml=.True.
/
&test_data_override_ongrid_nml
test_case = 3
+ write_only = .False.
/
_EOF
cat <<_EOF > data_table.yaml
@@ -62,6 +64,12 @@ fi
for KIND in r4 r8
do
rm -rf INPUT/*
+sed 's/write_only = .False./write_only = .True./g' input_base.nml > input.nml
+test_expect_success "Creating input files (${KIND})" '
+ mpirun -n 6 ../test_data_override_ongrid_${KIND}
+'
+
+cp input_base.nml input.nml
test_expect_success "data_override scalar field (${KIND})" '
mpirun -n 6 ../test_data_override_ongrid_${KIND}
'
diff --git a/test_fms/data_override/test_data_override_ensembles.sh b/test_fms/data_override/test_data_override_ensembles.sh
new file mode 100755
index 0000000000..afcdcd458f
--- /dev/null
+++ b/test_fms/data_override/test_data_override_ensembles.sh
@@ -0,0 +1,99 @@
+#!/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 .
+#***********************************************************************
+#
+# Copyright (c) 2019-2021 Ed Hartnett, Uriel Ramirez, Seth Underwood
+
+# Set common test settings.
+. ../test-lib.sh
+
+output_dir
+[ ! -d "INPUT" ] && mkdir -p "INPUT"
+
+cat <<_EOF > data_table.ens_01.yaml
+data_table:
+ - grid_name: OCN
+ fieldname_in_model: runoff
+ override_file:
+ - fieldname_in_file: runoff
+ file_name: INPUT/runoff.daitren.clim.1440x1080.v20180328_ens_01.nc
+ interp_method: none
+ factor: 1.0
+_EOF
+
+cat <<_EOF > data_table.ens_02.yaml
+data_table:
+ - grid_name: OCN
+ fieldname_in_model: runoff
+ override_file:
+ - fieldname_in_file: runoff
+ file_name: INPUT/runoff.daitren.clim.1440x1080.v20180328_ens_02.nc
+ interp_method: none
+ factor: 1.0
+_EOF
+
+cat <<_EOF > input_base.nml
+&data_override_nml
+ use_data_table_yaml = .True.
+/
+
+&test_data_override_ongrid_nml
+ test_case = 5
+ write_only = .False.
+/
+
+&ensemble_nml
+ ensemble_size = 2
+/
+_EOF
+
+#The test only runs with yaml
+if [ -z $parser_skip ]; then
+ for KIND in r4 r8
+ do
+ rm -rf INPUT/.
+ sed 's/write_only = .False./write_only = .True./g' input_base.nml > input.nml
+ test_expect_success "Creating input files (${KIND})" '
+ mpirun -n 12 ../test_data_override_ongrid_${KIND}
+ '
+
+ cp input_base.nml input.nml
+ test_expect_success "test_data_override with two ensembles -yaml (${KIND})" '
+ mpirun -n 12 ../test_data_override_ongrid_${KIND}
+ '
+ done
+
+cat <<_EOF > data_table.yaml
+data_table:
+ - grid_name: OCN
+ fieldname_in_model: runoff
+ override_file:
+ - fieldname_in_file: runoff
+ file_name: INPUT/runoff.daitren.clim.1440x1080.v20180328_ens_02.nc
+ interp_method: none
+ factor: 1.0
+_EOF
+
+ test_expect_failure "test_data_override with both data_table.yaml and data_table.ens_xx.yaml files" '
+ mpirun -n 12 ../test_data_override_ongrid_${KIND}
+ '
+rm -rf INPUT
+fi
+test_done
diff --git a/test_fms/data_override/test_data_override_ongrid.F90 b/test_fms/data_override/test_data_override_ongrid.F90
index a05eb9d6c8..d8e3864ba2 100644
--- a/test_fms/data_override/test_data_override_ongrid.F90
+++ b/test_fms/data_override/test_data_override_ongrid.F90
@@ -26,14 +26,16 @@ program test_data_override_ongrid
use mpp_domains_mod, only: mpp_define_domains, mpp_define_io_domain, mpp_get_data_domain, &
mpp_domains_set_stack_size, mpp_get_compute_domain, domain2d
use mpp_mod, only: mpp_init, mpp_exit, mpp_pe, mpp_root_pe, mpp_error, FATAL, &
- input_nml_file, mpp_sync, NOTE
+ input_nml_file, mpp_sync, NOTE, mpp_npes, mpp_get_current_pelist, &
+ mpp_set_current_pelist
use data_override_mod, only: data_override_init, data_override
use fms2_io_mod
use time_manager_mod, only: set_calendar_type, time_type, set_date, NOLEAP
use netcdf, only: nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, &
nf90_close, nf90_put_att, nf90_clobber, nf90_64bit_offset, nf90_char, &
nf90_double, nf90_unlimited
-use fms_mod, only: string
+use ensemble_manager_mod, only: get_ensemble_size, ensemble_manager_init
+use fms_mod, only: string, fms_init, fms_end
implicit none
@@ -52,11 +54,17 @@ program test_data_override_ongrid
integer, parameter :: bilinear = 2
integer, parameter :: scalar = 3
integer, parameter :: weight_file = 4
+integer, parameter :: ensemble_case = 5
integer :: test_case = ongrid
+integer :: npes
+integer, allocatable :: pelist(:)
+integer, allocatable :: pelist_ens(:)
+integer :: ensemble_id
+logical :: write_only=.false. !< True if creating the input files only
-namelist / test_data_override_ongrid_nml / nhalox, nhaloy, test_case, nlon, nlat, layout
+namelist / test_data_override_ongrid_nml / nhalox, nhaloy, test_case, nlon, nlat, layout, write_only
-call mpp_init
+call fms_init
call fms2_io_init
read (input_nml_file, test_data_override_ongrid_nml, iostat=io_status)
@@ -69,6 +77,15 @@ program test_data_override_ongrid
call set_calendar_type(NOLEAP)
+npes = mpp_npes()
+allocate(pelist(npes))
+call mpp_get_current_pelist(pelist)
+
+select case (test_case)
+case (ensemble_case)
+ call set_up_ensemble_case()
+end select
+
!< Create a domain nlonXnlat with mask
call mpp_domains_set_stack_size(17280000)
call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, xhalo=nhalox, yhalo=nhaloy, name='test_data_override_emc')
@@ -76,34 +93,54 @@ program test_data_override_ongrid
call mpp_get_data_domain(Domain, is, ie, js, je)
select case (test_case)
-case (ongrid)
- call generate_ongrid_input_file ()
-case (bilinear)
- call generate_bilinear_input_file ()
-case (scalar)
- call generate_scalar_input_file ()
-case (weight_file)
- call generate_weight_input_file ()
+case (ensemble_case)
+ ! Go back to the full pelist
+ call mpp_set_current_pelist(pelist)
end select
-call mpp_sync()
-call mpp_error(NOTE, "Finished creating INPUT Files")
-
-!< Initiliaze data_override
-call data_override_init(Ocean_domain_in=Domain, mode=lkind)
-
-select case (test_case)
-case (ongrid)
- call ongrid_test()
-case (bilinear)
- call bilinear_test()
-case (scalar)
- call scalar_test()
-case (weight_file)
- call weight_file_test()
-end select
+if (write_only) then
+ select case (test_case)
+ case (ongrid)
+ call generate_ongrid_input_file ()
+ case (bilinear)
+ call generate_bilinear_input_file ()
+ case (scalar)
+ call generate_scalar_input_file ()
+ case (weight_file)
+ call generate_weight_input_file ()
+ case (ensemble_case)
+ call generate_ensemble_input_file()
+ end select
-call mpp_exit
+ call mpp_sync()
+ call mpp_error(NOTE, "Finished creating INPUT Files")
+
+else
+ select case (test_case)
+ case (ensemble_case)
+ !< Go back to the ensemble pelist
+ call mpp_set_current_pelist(pelist_ens)
+ end select
+
+ !< Initiliaze data_override
+ call data_override_init(Ocean_domain_in=Domain, mode=lkind)
+
+ select case (test_case)
+ case (ongrid)
+ call ongrid_test()
+ case (bilinear)
+ call bilinear_test()
+ case (scalar)
+ call scalar_test()
+ case (weight_file)
+ call weight_file_test()
+ case (ensemble_case)
+ call ensemble_test()
+ call mpp_set_current_pelist(pelist)
+ end select
+endif
+
+call fms_end
contains
@@ -214,17 +251,29 @@ subroutine create_ocean_hgrid_file()
endif
end subroutine create_ocean_hgrid_file
-subroutine create_ongrid_data_file()
+subroutine create_ongrid_data_file(is_ensemble)
+ logical, intent(in), optional :: is_ensemble
type(FmsNetcdfFile_t) :: fileobj
character(len=10) :: dimnames(3)
real(lkind), allocatable, dimension(:,:,:) :: runoff_in
real(lkind), allocatable, dimension(:) :: time_data
+ integer :: offset
+ character(len=256), allocatable :: appendix
+
integer :: i
+ offset = 0
+ appendix = ""
+ if (present(is_ensemble)) then
+ offset = ensemble_id
+ call get_filename_appendix(appendix)
+ appendix = "_"//trim(appendix)
+ endif
+
allocate(runoff_in(nlon, nlat, 10))
allocate(time_data(10))
do i = 1, 10
- runoff_in(:,:,i) = real(i, lkind)
+ runoff_in(:,:,i) = real(i+offset, lkind)
enddo
time_data = (/1., 2., 3., 5., 6., 7., 8., 9., 10., 11./)
@@ -232,7 +281,7 @@ subroutine create_ongrid_data_file()
dimnames(2) = 'j'
dimnames(3) = 'time'
- if (open_file(fileobj, 'INPUT/runoff.daitren.clim.1440x1080.v20180328.nc', 'overwrite')) then
+ if (open_file(fileobj, 'INPUT/runoff.daitren.clim.1440x1080.v20180328'//trim(appendix)//'.nc', 'overwrite')) then
call register_axis(fileobj, "i", nlon)
call register_axis(fileobj, "j", nlat)
call register_axis(fileobj, "time", unlimited)
@@ -605,4 +654,84 @@ subroutine scalar_test()
end subroutine scalar_test
+subroutine set_up_ensemble_case()
+ integer :: ens_siz(6)
+ character(len=10) :: text
+
+ if (npes .ne. 12) &
+ call mpp_error(FATAL, "This test requires 12 pes to run")
+
+ if (layout(1)*layout(2) .ne. 6) &
+ call mpp_error(FATAL, "The two members of the layout do not equal 6")
+
+ call ensemble_manager_init
+ ens_siz = get_ensemble_size()
+ if (ens_siz(1) .ne. 2) &
+ call mpp_error(FATAL, "This test requires 2 ensembles")
+
+ if (mpp_pe() < 6) then
+ !PEs 0-5 are the first ensemble
+ ensemble_id = 1
+ allocate(pelist_ens(npes/ens_siz(1)))
+ pelist_ens = pelist(1:6)
+ call mpp_set_current_pelist(pelist_ens)
+ else
+ !PEs 6-11 are the second ensemble
+ ensemble_id = 2
+ allocate(pelist_ens(npes/ens_siz(1)))
+ pelist_ens = pelist(7:)
+ call mpp_set_current_pelist(pelist_ens)
+ endif
+
+ write( text,'(a,i2.2)' ) 'ens_', ensemble_id
+ call set_filename_appendix(trim(text))
+
+ if (mpp_pe() .eq. mpp_root_pe()) &
+ print *, "ensemble_id:", ensemble_id, ":: ", pelist_ens
+end subroutine
+
+subroutine generate_ensemble_input_file()
+ if (mpp_pe() .eq. mpp_root_pe()) then
+ call create_grid_spec_file ()
+ call create_ocean_mosaic_file()
+ call create_ocean_hgrid_file()
+ endif
+
+ !< Go back to the ensemble pelist so that each root pe can write its own input file
+ call mpp_set_current_pelist(pelist_ens)
+ if (mpp_pe() .eq. mpp_root_pe()) then
+ call create_ongrid_data_file(is_ensemble=.true.)
+ endif
+ call mpp_set_current_pelist(pelist)
+end subroutine
+
+subroutine ensemble_test()
+ real(lkind) :: expected_result !< Expected result from data_override
+ type(time_type) :: Time !< Time
+ real(lkind), allocatable, dimension(:,:) :: runoff !< Data to be written
+
+ allocate(runoff(is:ie,js:je))
+
+ runoff = 999._lkind
+ !< Run it when time=3
+ Time = set_date(1,1,4,0,0,0)
+ call data_override('OCN','runoff',runoff, Time)
+ !< Because you are getting the data when time=3, and this is an "ongrid" case, the expected result is just
+ !! equal to the data at time=3, which is 3+ensemble_id.
+ expected_result = 3._lkind + real(ensemble_id,kind=lkind)
+ call compare_data(Domain, runoff, expected_result)
+
+ !< Run it when time=4
+ runoff = 999._lkind
+ Time = set_date(1,1,5,0,0,0)
+ call data_override('OCN','runoff',runoff, Time)
+ !< You are getting the data when time=4, the data at time=3 is 3+ensemble_id. and at time=5 is 4+ensemble_id.,
+ !! so the expected result is the average of the 2 (because this is is an "ongrid" case and there
+ !! is no horizontal interpolation).
+ expected_result = (3._lkind + real(ensemble_id,kind=lkind) + 4._lkind + real(ensemble_id,kind=lkind)) / 2._lkind
+ call compare_data(Domain, runoff, expected_result)
+
+ deallocate(runoff)
+end subroutine ensemble_test
+
end program test_data_override_ongrid
diff --git a/test_fms/data_override/test_data_override_weights.sh b/test_fms/data_override/test_data_override_weights.sh
index a3bc8902e4..2bb1e2c3f1 100755
--- a/test_fms/data_override/test_data_override_weights.sh
+++ b/test_fms/data_override/test_data_override_weights.sh
@@ -48,7 +48,7 @@ data_table:
factor: 1.0
_EOF
-cat <<_EOF > input.nml
+cat <<_EOF > input_base.nml
&data_override_nml
use_data_table_yaml = .True.
/
@@ -58,6 +58,7 @@ cat <<_EOF > input.nml
nlon = 5
nlat = 6
layout = 1, 2
+ write_only = .False.
/
_EOF
@@ -66,6 +67,13 @@ if [ -z $parser_skip ]; then
for KIND in r4 r8
do
rm -rf INPUT/.
+
+ sed 's/write_only = .False./write_only = .True./g' input_base.nml > input.nml
+ test_expect_success "Creating input files (${KIND})" '
+ mpirun -n 2 ../test_data_override_ongrid_${KIND}
+ '
+
+ cp input_base.nml input.nml
test_expect_success "test_data_override with and without weight files -yaml (${KIND})" '
mpirun -n 2 ../test_data_override_ongrid_${KIND}
'
diff --git a/test_fms/diag_integral/test_diag_integral.F90 b/test_fms/diag_integral/test_diag_integral.F90
index af21fac6c2..cd4fe4c80e 100644
--- a/test_fms/diag_integral/test_diag_integral.F90
+++ b/test_fms/diag_integral/test_diag_integral.F90
@@ -175,13 +175,12 @@ end subroutine test_sum_diag_integral_field
!-------------------------------------
subroutine read_diag_integral_file
- character(17), parameter :: di_file='diag_integral.out'
- integer, parameter :: iunit=100
-
+ character(*), parameter :: di_file='diag_integral.out'
+ integer :: iunit
character(100) :: cline1, cline2, cline3, cline4, cline5, clin6
!> read in computed values
- open(unit=iunit,file=trim(di_file))
+ open(newunit=iunit, file=di_file)
read(iunit,*) cline1, cline2, cline3, cline4, cline5, clin6
read(iunit,*) itime, field_avg2, field_avg3, field_avgw, field_avgh
close(iunit)
diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am
index a224eb2451..2d7d6440a5 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_prepend_date
+ test_dm_weights test_prepend_date test_ens_runs
# This is the source code for the test.
test_output_every_freq_SOURCES = test_output_every_freq.F90
@@ -65,6 +65,7 @@ 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_ens_runs_SOURCES = test_ens_runs.F90
TEST_EXTENSIONS = .sh
SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
@@ -74,7 +75,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_prepend_date.sh
+ test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh
testing_utils.mod: testing_utils.$(OBJEXT)
@@ -82,7 +83,8 @@ 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_prepend_date.sh
+ test_flush_nc_file.sh test_dm_weights.sh test_output_every_freq.sh test_prepend_date.sh \
+ test_ens_runs.sh
if USING_YAML
skipflag=""
diff --git a/test_fms/diag_manager/test_ens_runs.F90 b/test_fms/diag_manager/test_ens_runs.F90
new file mode 100644
index 0000000000..621016430f
--- /dev/null
+++ b/test_fms/diag_manager/test_ens_runs.F90
@@ -0,0 +1,128 @@
+!***********************************************************************
+!* 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 file frequency is set to 0 days
+program test_ens_runs
+
+ 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, mpp_npes, mpp_pe, mpp_get_current_pelist, mpp_set_current_pelist
+ use fms2_io_mod, only: FmsNetcdfFile_t, open_file, close_file, read_data, get_dimension_size, &
+ set_filename_appendix, get_instance_filename
+ use ensemble_manager_mod, only: get_ensemble_size, ensemble_manager_init
+
+ implicit none
+
+ integer :: id_var0 !< 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
+ integer :: npes !< Number of pes in the current pelist
+ integer, allocatable :: pelist(:) !< Full pelist
+ integer :: ensemble_id !< The ensemble id
+ integer :: ens_siz(6) !< The size of the ensemble
+ character(len=10) :: text !< The filename appendix
+ integer :: expected_ntimes
+
+ call fms_init
+ call ensemble_manager_init
+ npes = mpp_npes()
+ if (npes .ne. 2) &
+ call mpp_error(FATAL, "This test requires two pes to run")
+
+ allocate(pelist(npes))
+ call mpp_get_current_pelist(pelist)
+
+ ens_siz = get_ensemble_size()
+ if (ens_siz(1) .ne. 2) &
+ call mpp_error(FATAL, "This test requires 2 ensembles")
+
+ if (mpp_pe() < 1) then
+ !< PE 0 is the first ensemble
+ ensemble_id = 1
+ call mpp_set_current_pelist((/0/))
+ expected_ntimes = 48
+ else
+ ensemble_id = 2
+ call mpp_set_current_pelist((/1/))
+ expected_ntimes = 24
+ endif
+
+ write( text,'(a,i2.2)' ) 'ens_', ensemble_id
+ call set_filename_appendix(trim(text))
+
+ call set_calendar_type(JULIAN)
+ call diag_manager_init
+
+ 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_var0 = register_diag_field ('ocn_mod', 'var0', Time)
+
+ do i = 1, ntimes
+ Time = Time + Time_step
+ vdata = real(i)
+
+ used = send_data(id_var0, vdata, Time)
+ 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, allocatable :: var_data(:) !< Buffer to read variable data to
+ integer :: j !< For looping
+ character(len=255) :: filename !< Name of the diag file
+
+ call get_instance_filename("test_ens.nc", filename)
+ if (.not. open_file(fileobj, filename, "read")) &
+ call mpp_error(FATAL, "Error opening file:"//trim(filename)//" to read")
+
+ call get_dimension_size(fileobj, "time", var_size)
+ if (var_size .ne. expected_ntimes) call mpp_error(FATAL, "The dimension of time in the file:"//&
+ "test_ens 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 * ensemble_id))&
+ call mpp_error(FATAL, "The variable data for var1 at time level:"//&
+ string(j)//" is not the correct value!")
+ enddo
+
+ call close_file(fileobj)
+ end subroutine check_output
+end program test_ens_runs
diff --git a/test_fms/diag_manager/test_ens_runs.sh b/test_fms/diag_manager/test_ens_runs.sh
new file mode 100755
index 0000000000..b2e262b69c
--- /dev/null
+++ b/test_fms/diag_manager/test_ens_runs.sh
@@ -0,0 +1,97 @@
+#!/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 .
+#***********************************************************************
+
+# Copyright (c) 2019-2020 Ed Hartnett, Seth Underwood
+
+# 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.ens_01.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_ens
+ time_units: days
+ unlimdim: time
+ freq: 1 hours
+ varlist:
+ - module: ocn_mod
+ var_name: var0
+ reduction: none
+ kind: r8
+_EOF
+
+cat <<_EOF > diag_table.ens_02.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_ens
+ time_units: days
+ unlimdim: time
+ freq: 2 hours
+ varlist:
+ - module: ocn_mod
+ var_name: var0
+ reduction: none
+ kind: r8
+_EOF
+
+cat <<_EOF > input.nml
+&diag_manager_nml
+ use_modern_diag = .True.
+/
+
+&ensemble_nml
+ ensemble_size = 2
+/
+_EOF
+
+my_test_count=1
+test_expect_success "Running diag_manager with 2 ensembles (test $my_test_count)" '
+ mpirun -n 2 ../test_ens_runs
+'
+
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_0days
+ time_units: days
+ unlimdim: time
+ freq: 0 days
+ varlist:
+ - module: ocn_mod
+ var_name: var0
+ reduction: none
+ kind: r8
+_EOF
+
+my_test_count=`expr $my_test_count + 1`
+test_expect_failure "Running diag_manager with both diag_table.yaml and diag_table.ens_xx.yaml files present (test $my_test_count)" '
+ mpirun -n 2 ../test_ens_runs
+'
+
+fi
+test_done
diff --git a/test_fms/field_manager/test_field_manager2.sh b/test_fms/field_manager/test_field_manager2.sh
index 2485701598..313c830a75 100755
--- a/test_fms/field_manager/test_field_manager2.sh
+++ b/test_fms/field_manager/test_field_manager2.sh
@@ -106,6 +106,48 @@ else
test_expect_success "field table read with use_field_table.yaml = .true." 'mpirun -n 1 ./test_field_table_read'
test_expect_success "field manager functional r4 with yaml table" 'mpirun -n 2 ./test_field_manager_r4'
test_expect_success "field manager functional r8 with yaml table" 'mpirun -n 2 ./test_field_manager_r8'
+
+ cat <<_EOF > field_table.ens_01.yaml
+field_table:
+- field_type: tracer
+ modlist:
+ - model_type: atmos_mod
+ varlist:
+ - variable: radon
+ - variable: radon2
+ - variable: radon3
+ longname: bad radon!
+_EOF
+
+ cat <<_EOF > field_table.ens_02.yaml
+field_table:
+- field_type: tracer
+ modlist:
+ - model_type: atmos_mod
+ varlist:
+ - variable: radon
+ - variable: radon2
+ - variable: radon3
+ longname: bad radon!
+ - variable: radon4
+ longname: REALLY bad radon!
+_EOF
+cat <<_EOF > input.nml
+&field_manager_nml
+ use_field_table_yaml = .true.
+/
+&test_field_table_read_nml
+ test_case = 1
+/
+&ensemble_nml
+ ensemble_size = 2
+/
+_EOF
+ test_expect_failure "field manager test with both field_table.yaml and field_table.ens_XX.yaml files present" 'mpirun -n 2 ./test_field_table_read'
+
+ rm -rf field_table.yaml
+
+ test_expect_success "field manager test with 2 ensembles" 'mpirun -n 2 ./test_field_table_read'
fi
test_done
diff --git a/test_fms/field_manager/test_field_table_read.F90 b/test_fms/field_manager/test_field_table_read.F90
index ba9b125a46..bb46256cb1 100644
--- a/test_fms/field_manager/test_field_table_read.F90
+++ b/test_fms/field_manager/test_field_table_read.F90
@@ -36,15 +36,74 @@ program test_field_table_read
use field_manager_mod, only: field_manager_init
use fms_mod, only: fms_init, fms_end
-use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, NOTE, FATAL
+use fms2_io_mod, only: set_filename_appendix
+use ensemble_manager_mod, only: get_ensemble_size, ensemble_manager_init
+use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, NOTE, FATAL, input_nml_file, mpp_npes, &
+ mpp_set_current_pelist, mpp_get_current_pelist
implicit none
integer :: nfields
+integer :: nfields_expected
+integer :: io_status
+integer :: npes
+integer, allocatable :: pelist(:)
+integer :: ens_siz(6)
+integer :: ensemble_id
+character(len=10) :: text
+integer, parameter :: default_test = 0
+integer, parameter :: ensemble_test = 1
+
+! namelist parameters
+integer :: test_case = default_test
+
+namelist / test_field_table_read_nml / test_case
call fms_init
+read (input_nml_file, test_field_table_read_nml, iostat=io_status)
+if (io_status > 0) call mpp_error(FATAL,'=>test_field_table_read: Error reading input.nml')
+
+npes = mpp_npes()
+allocate(pelist(npes))
+call mpp_get_current_pelist(pelist)
+
+nfields_expected = 4
+select case (test_case)
+case (ensemble_test)
+ if (npes .ne. 2) &
+ call mpp_error(FATAL, "test_field_table_read:: this test requires 2 PEs!")
+
+ call ensemble_manager_init
+ ens_siz = get_ensemble_size()
+ if (ens_siz(1) .ne. 2) &
+ call mpp_error(FATAL, "This test requires 2 ensembles")
+
+ if (mpp_pe() .eq. 0) then
+ !PEs 0 is the first ensemble
+ ensemble_id = 1
+ call mpp_set_current_pelist((/0/))
+ nfields_expected = 3
+ else
+ !PEs 1 is the second ensemble
+ ensemble_id = 2
+ call mpp_set_current_pelist((/1/))
+ nfields_expected = 4
+ endif
+
+ write( text,'(a,i2.2)' ) 'ens_', ensemble_id
+ call set_filename_appendix(trim(text))
+
+end select
+
call field_manager_init(nfields)
-if (nfields .ne. 4) &
+print *, nfields
+if (nfields .ne. nfields_expected) &
call mpp_error(FATAL, "test_field_table_read:: The number fields returned is not the expected result")
+
+select case (test_case)
+case (ensemble_test)
+ call mpp_set_current_pelist(pelist)
+end select
+
call fms_end
end program test_field_table_read
diff --git a/test_fms/horiz_interp/test_horiz_interp.F90 b/test_fms/horiz_interp/test_horiz_interp.F90
index eb8afba071..59ccdbb230 100644
--- a/test_fms/horiz_interp/test_horiz_interp.F90
+++ b/test_fms/horiz_interp/test_horiz_interp.F90
@@ -37,7 +37,7 @@ program horiz_interp_test
use mpp_domains_mod, only : mpp_domains_init, domain2d
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_mod, only : horiz_interp, horiz_interp_type, assignment(=)
use horiz_interp_type_mod, only: SPHERICAL
use constants_mod, only : constants_init, PI
use horiz_interp_bilinear_mod, only: horiz_interp_bilinear_new
@@ -111,7 +111,7 @@ program horiz_interp_test
subroutine test_horiz_interp_spherical
!! grid data
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_2D, lon_in_2D
- type(horiz_interp_type) :: interp_t
+ type(horiz_interp_type) :: interp_t, interp_copy
!! input data
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: data_src, data_dst
!! output data
@@ -125,7 +125,6 @@ subroutine test_horiz_interp_spherical
real(HI_TEST_KIND_) :: lon_dst_beg = -280._lkind, lon_dst_end = 80._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
! set up longitude and latitude of source/destination grid.
@@ -170,6 +169,7 @@ subroutine test_horiz_interp_spherical
call horiz_interp_new(interp_t, lon_in_2d, lat_in_2d, lon_out_2d, lon_out_2d, interp_method="spherical")
call horiz_interp(interp_t, data_src, data_dst)
call horiz_interp_spherical_wght(interp_t, wghts, verbose=1)
+ interp_copy = interp_t
else
call horiz_interp(data_src, lon_in_2D, lat_in_2D, lon_out_2D, lat_out_2D, data_dst, interp_method="spherical")
endif
@@ -185,7 +185,9 @@ subroutine test_horiz_interp_spherical
enddo
if(.not. test_solo) then
call horiz_interp_del(interp_t)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_t)
+ call check_dealloc(interp_copy)
endif
deallocate(data_src, data_dst)
deallocate(lat_in_2D, lon_in_2D)
@@ -203,9 +205,8 @@ subroutine test_horiz_interp_bilinear
real(HI_TEST_KIND_) :: lon_src_beg = 0._lkind, lon_src_end = 360.0_lkind
real(HI_TEST_KIND_) :: lat_src_beg = -90._lkind, lat_src_end = 90._lkind
real(HI_TEST_KIND_), parameter :: D2R = real(PI,lkind)/180._lkind
- real(HI_TEST_KIND_), parameter :: R2D = 180._lkind/real(PI,lkind)
- type(horiz_interp_type) :: interp
+ type(horiz_interp_type) :: interp, interp_copy
if (decreasing_lat) then
lon_src_beg = 360.0_lkind
@@ -256,6 +257,7 @@ subroutine test_horiz_interp_bilinear
if (.not. test_solo) then
call horiz_interp_new(interp, lon1D_src, lat1D_src, lon1D_dst, lat1D_dst, interp_method = "bilinear")
call horiz_interp(interp, data_src, data_dst)
+ interp_copy = interp
else
call horiz_interp(data_src, lon1D_src, lat1D_src, lon1D_dst, lat1D_dst, data_dst, interp_method = "bilinear")
endif
@@ -313,7 +315,9 @@ subroutine test_horiz_interp_bilinear
end do
if(.not. test_solo) then
call horiz_interp_del(interp)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp)
+ call check_dealloc(interp_copy)
endif
! --- 1dx2d version bilinear interpolation
@@ -329,6 +333,7 @@ subroutine test_horiz_interp_bilinear
if(.not. test_solo) then
call horiz_interp_new(interp, lon1D_src, lat1D_src, lon2D_dst, lat2D_dst, interp_method = "bilinear")
call horiz_interp(interp, data_src, data_dst)
+ interp_copy = interp
else
call horiz_interp(data_src, lon1D_src, lat1D_src, lon2D_dst, lat2D_dst, data_dst,interp_method="bilinear")
endif
@@ -386,7 +391,9 @@ subroutine test_horiz_interp_bilinear
end do
if(.not. test_solo) then
call horiz_interp_del(interp)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp)
+ call check_dealloc(interp_copy)
endif
if (decreasing_lat) return
@@ -405,6 +412,7 @@ subroutine test_horiz_interp_bilinear
call horiz_interp_new(interp,lon2D_src,lat2D_src,lon1D_dst(1:ni_src),lat1D_dst(1:nj_src), &
interp_method = "bilinear")
call horiz_interp(interp, data_src, data_dst)
+ interp_copy = interp
else
call horiz_interp(data_src, lon2D_src, lat2d_src, lon1D_dst(1:ni_src),lat1D_dst(1:nj_src), data_dst, &
interp_method="bilinear")
@@ -502,7 +510,9 @@ subroutine test_horiz_interp_bilinear
end do
if(.not. test_solo) then
call horiz_interp_del(interp)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp)
+ call check_dealloc(interp_copy)
endif
! --- 2dx2d version bilinear interpolation
@@ -514,6 +524,7 @@ subroutine test_horiz_interp_bilinear
if(.not. test_solo) then
call horiz_interp_new(interp, lon2D_src, lat2D_src, lon2D_dst, lat2D_dst, interp_method = "bilinear")
call horiz_interp(interp, data_src, data_dst)
+ interp_copy = interp
else
call horiz_interp(data_src, lon2D_src, lat2d_src, lon2D_dst, lat2D_dst, data_dst, interp_method="bilinear")
endif
@@ -601,7 +612,9 @@ subroutine test_horiz_interp_bilinear
endif
if(.not. test_solo) then
call horiz_interp_del(interp)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp)
+ call check_dealloc(interp_copy)
endif
!check that data are equal
do j=1, nj_src
@@ -620,8 +633,7 @@ end subroutine test_horiz_interp_bilinear
subroutine test_horiz_interp_bicubic
!! grid data
real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_in_1D, lon_in_1D
- real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_2D, lon_in_2D
- type(horiz_interp_type) :: interp_t
+ type(horiz_interp_type) :: interp_t, interp_copy
!! input data
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: data_src, data_dst
!! output data
@@ -637,7 +649,6 @@ subroutine test_horiz_interp_bicubic
real(HI_TEST_KIND_) :: lon_dst_beg = -280._lkind, lon_dst_end = 80._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
! set up longitude and latitude of source/destination grid.
@@ -691,6 +702,7 @@ subroutine test_horiz_interp_bicubic
if(.not. test_solo) then
call horiz_interp_new(interp_t, lon_in_1d, lat_in_1d, lon_out_1d, lat_out_1d, interp_method="bicubic")
call horiz_interp(interp_t, data_src, data_dst)
+ interp_copy = interp_t
else
call horiz_interp(data_src, lon_in_1D, lat_in_1D, lon_out_1D, lat_out_1D, data_dst, interp_method="bicubic")
endif
@@ -719,7 +731,9 @@ subroutine test_horiz_interp_bicubic
enddo
enddo
call horiz_interp_del(interp_t)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_t)
+ call check_dealloc(interp_copy)
endif
do i=isc, iec
do j=jsc, jec
@@ -737,6 +751,7 @@ subroutine test_horiz_interp_bicubic
if(.not. test_solo) then
call horiz_interp_new(interp_t, lon_in_1d, lat_in_1d, lon_out_2d, lat_out_2d, interp_method="bicubic")
call horiz_interp(interp_t, data_src, data_dst)
+ interp_copy = interp_t
else
call horiz_interp(data_src, lon_in_1D, lat_in_1D, lon_out_2D, lat_out_2D, data_dst, interp_method="bicubic")
endif
@@ -762,7 +777,9 @@ subroutine test_horiz_interp_bicubic
enddo
enddo
call horiz_interp_del(interp_t)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_t)
+ call check_dealloc(interp_copy)
endif
do i=isc, iec
do j=jsc, jec
@@ -782,14 +799,13 @@ subroutine test_horiz_interp_conserve
real(HI_TEST_KIND_), allocatable, dimension(:) :: lon1D_src, lat1D_src, lon1D_dst, lat1D_dst
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lon2D_src, lat2D_src, lon2D_dst, lat2D_dst
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: data_src, data1_dst, data2_dst, data3_dst, data4_dst
- real(HI_TEST_KIND_), allocatable, dimension(:,:) :: data1_solo, data2_solo, data3_solo, data4_solo
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 = -280._lkind, lon_dst_end = 80._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_), parameter :: SMALL = 1.0e-10_lkind
- type(horiz_interp_type) :: interp_conserve
+ type(horiz_interp_type) :: interp_conserve, interp_copy
allocate(lon2D_src(ni_src+1, nj_src+1), lat2D_src(ni_src+1, nj_src+1) )
allocate(lon1D_src(ni_src+1), lat1D_src(nj_src+1), data_src(ni_src, nj_src) )
@@ -861,22 +877,29 @@ subroutine test_horiz_interp_conserve
call horiz_interp_new(interp_conserve, lon1D_src, lat1D_src, lon1D_dst, lat1D_dst, &
interp_method = "conservative")
call horiz_interp(interp_conserve, data_src, data1_dst)
+ interp_copy = interp_conserve
call horiz_interp_del(interp_conserve)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_conserve)
+ call check_dealloc(interp_copy)
else
call horiz_interp(data_src, lon1D_src, lat1D_src, lon1D_dst, lat1D_dst, data1_dst, &
interp_method="conservative")
endif
call mpp_clock_end(id1)
+
! --- 1dx2d version conservative interpolation
call mpp_clock_begin(id2)
if(.not. test_solo) then
call horiz_interp_new(interp_conserve, lon1D_src, lat1D_src, lon2D_dst, lat2D_dst, &
interp_method = "conservative")
call horiz_interp(interp_conserve, data_src, data2_dst)
+ interp_copy = interp_conserve
call horiz_interp_del(interp_conserve)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_conserve)
+ call check_dealloc(interp_copy)
else
call horiz_interp(data_src, lon1D_src, lat1D_src, lon2D_dst, lat2D_dst, data2_dst, &
interp_method="conservative")
@@ -889,8 +912,11 @@ subroutine test_horiz_interp_conserve
call horiz_interp_new(interp_conserve, lon2D_src, lat2D_src, lon1D_dst, lat1D_dst, &
interp_method = "conservative")
call horiz_interp(interp_conserve, data_src, data3_dst)
+ interp_copy = interp_conserve
call horiz_interp_del(interp_conserve)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_conserve)
+ call check_dealloc(interp_copy)
else
call horiz_interp(data_src, lon2D_src, lat2D_src, lon1D_dst, lat1D_dst, data3_dst, &
interp_method="conservative")
@@ -903,8 +929,11 @@ subroutine test_horiz_interp_conserve
call horiz_interp_new(interp_conserve, lon2D_src, lat2D_src, lon2D_dst, lat2D_dst, &
interp_method = "conservative")
call horiz_interp(interp_conserve, data_src, data4_dst)
+ interp_copy = interp_conserve
call horiz_interp_del(interp_conserve)
+ call horiz_interp_del(interp_copy)
call check_dealloc(interp_conserve)
+ call check_dealloc(interp_copy)
else
call horiz_interp(data_src, lon2D_src, lat2D_src, lon2D_dst, lat2D_dst, data4_dst, &
interp_method="conservative")
@@ -963,7 +992,7 @@ subroutine test_horiz_interp_conserve
!! 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
+ type(horiz_interp_type) :: Interp_new1, Interp_new2, Interp_cp
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
@@ -980,7 +1009,6 @@ subroutine test_assignment()
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
integer :: icount !< index for setting the output array when taking midpoints for bilinear
@@ -1103,7 +1131,7 @@ subroutine test_assignment()
! 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_src_1d(nlon_in-1), lat_src_1d(nlat_in-1))
allocate(lon_dst_1d(nlon_out), lat_dst_1d(nlat_out))
do i = 1, nlon_in-1
lon_src_1d(i) = (lon_in_1d(i) + lon_in_1d(i+1)) * 0.5_lkind
@@ -1185,7 +1213,7 @@ subroutine test_assignment()
call horiz_interp_del(Interp_cp)
! 2dx1d
deallocate(lon_out_1D, lat_out_1D)
- allocate(lon_out_1D(ni_dst+1), lat_out_1D(nj_dst+1))
+ allocate(lon_out_1D(ni_dst), lat_out_1D(nj_dst))
do i=1, ni_dst
lon_out_1d(i) = real(i-1, HI_TEST_KIND_) * dlon_dst + lon_dst_beg
enddo
diff --git a/test_fms/monin_obukhov/test_monin_obukhov.F90 b/test_fms/monin_obukhov/test_monin_obukhov.F90
index 36da4b7947..27b386a250 100644
--- a/test_fms/monin_obukhov/test_monin_obukhov.F90
+++ b/test_fms/monin_obukhov/test_monin_obukhov.F90
@@ -125,17 +125,10 @@ program test_monin_obukhov
integer(ki), dimension(n_1d) :: del_m, del_t, del_q
end type
- type(drag_input_t), parameter :: drag_input = drag_input_t() &
- & !< Input arguments for mo_drag
-
- type(stable_mix_input_t), parameter :: stable_mix_input = stable_mix_input_t() &
- & !< Input arguments for stable_mix
-
- type(diff_input_t), parameter :: diff_input = diff_input_t() &
- & !< Input arguments for mo_diff
-
- type(profile_input_t), parameter :: profile_input = profile_input_t() &
- & !< Input arguments for mo_profile
+ type(drag_input_t), parameter :: drag_input = drag_input_t() !< Input arguments for mo_drag
+ type(stable_mix_input_t), parameter :: stable_mix_input = stable_mix_input_t() !< Input arguments for stable_mix
+ type(diff_input_t), parameter :: diff_input = diff_input_t() !< Input arguments for mo_diff
+ type(profile_input_t), parameter :: profile_input = profile_input_t() !< Input arguments for mo_profile
! Entries 1:n of the arrays below contain known answer keys. Entry n+1 contains
! the answers that we calculate. Represent answer data using integral arrays,
diff --git a/test_fms/mosaic2/test_mosaic2.F90 b/test_fms/mosaic2/test_mosaic2.F90
index 10da8a2820..69df86fd3e 100644
--- a/test_fms/mosaic2/test_mosaic2.F90
+++ b/test_fms/mosaic2/test_mosaic2.F90
@@ -254,7 +254,7 @@ subroutine test_is_inside_polygon
z2(1)=2.0_lkind ; z2(2)=4.0_lkind ; z2(3)=4.0_lkind ; z2(4)=2.0_lkind ; z2(5)=2.0_lkind
do i=1, n
r = sqrt( x2(i)**2 + y2(i)**2 + z2(i)**2 )
- lon2(i)=atan(y2(i)/x2(i))
+ lon2(i)=atan2(y2(i), x2(i))
lat2(i)=asin(z2(i)/r)
end do
@@ -263,7 +263,7 @@ subroutine test_is_inside_polygon
y1=5.0_lkind
z1=4.2_lkind
r = sqrt(x1**2+y1**2+z1**2)
- lon1=atan(y1/x1)
+ lon1=atan2(y1, x1)
lat1=asin(z1/r)
answer=.false.
@@ -275,7 +275,7 @@ subroutine test_is_inside_polygon
y1=3.0_lkind
z1=2.5_lkind
r = sqrt(x1**2+y1**2+z1**2)
- lon1=atan(y1/x1)
+ lon1=atan2(y1, x1)
lat1=asin(z1/r)
answer=.true.
diff --git a/test_fms/mpp/test_stdlog.F90 b/test_fms/mpp/test_stdlog.F90
index 61ee8d81c8..92b4079157 100644
--- a/test_fms/mpp/test_stdlog.F90
+++ b/test_fms/mpp/test_stdlog.F90
@@ -85,6 +85,7 @@ subroutine check_write()
if (trim(line) == '') cycle
!! if we're testing with the old io enabled, we'll have some additional output we can skip
if (trim(line) == 'NOTE from PE 0: MPP_IO_SET_STACK_SIZE: stack size set to 131072.') cycle
+ if (index(trim(line), "fms_io") .ne. 0) 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)
diff --git a/test_fms/parser/test_output_yaml.F90 b/test_fms/parser/test_output_yaml.F90
index 6122ff7ab3..e5a144caba 100644
--- a/test_fms/parser/test_output_yaml.F90
+++ b/test_fms/parser/test_output_yaml.F90
@@ -203,11 +203,12 @@ program test_output_yaml
call yaml_out_add_level2key( "order 4",k1(1))
call yaml_out_add_level2key( "sides", k2(1))
call yaml_out_add_level2key( "specials", k2(2))
- call write_yaml_from_struct_3 (trim(filename), 1, k1, v1, a2, k2, v2, a3, (/1, 1, 1, 1, 2, 1/), k3, v3, &
- & (/ 1, 1, 1 , 1, 0 ,0 ,0 ,0/))
+ call write_yaml_from_struct_3 (trim(filename) // c_null_char, 1, k1, v1, a2, k2, v2, a3, &
+ & (/1, 1, 1, 1, 2, 1/), k3, v3, (/ 1, 1, 1 , 1, 0 ,0 ,0 ,0/))
else
!> Write the yaml
- call write_yaml_from_struct_3 (trim(filename), 1, k1, v1, a2, k2, v2, a3, a3each, k3, v3,(/3, 0, 0, 0, 0, 0, 0, 0/))
+ call write_yaml_from_struct_3 (trim(filename) // c_null_char, 1, k1, v1, a2, k2, v2, a3, &
+ & a3each, k3, v3, (/3, 0, 0, 0, 0, 0, 0, 0/))
endif
!> Check yaml output against reference
diff --git a/test_fms/tracer_manager/test_tracer_manager.F90 b/test_fms/tracer_manager/test_tracer_manager.F90
index dbab8a5e2e..f8697f7c04 100644
--- a/test_fms/tracer_manager/test_tracer_manager.F90
+++ b/test_fms/tracer_manager/test_tracer_manager.F90
@@ -45,7 +45,8 @@ subroutine test_set_tracer_profile
integer, parameter :: numlevels=10
integer, parameter :: npoints=5
- integer :: tracer_index, success, i, j, k
+ integer :: tracer_index, i, j, k
+ logical :: success
real(TEST_TM_KIND_) :: top_value, bottom_value, surf_value, multiplier
real(TEST_TM_KIND_) :: tracer_out1(1,1,1), tracer_out2(npoints,npoints,numlevels)
real(TEST_TM_KIND_) :: answer1(1,1,1), answer2(npoints,npoints,numlevels)