feat: modern diag add diag_model_subset behaviour for ocean models (N…

…OAA-GFDL#927)

diag_manager/diag_manager.F90

@@ -3950,7 +3950,7 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg)
     END IF
 
 #ifdef use_yaml
-    if (use_modern_diag) CALL diag_yaml_object_init()
+    if (use_modern_diag) CALL diag_yaml_object_init(diag_subset_output)
 #endif
 
     CALL parse_diag_table(DIAG_SUBSET=diag_subset_output, ISTAT=mystat, ERR_MSG=err_msg_local)

diag_manager/fms_diag_yaml.F90

@@ -30,7 +30,7 @@
 !> @{
 module fms_diag_yaml_mod
 #ifdef use_yaml
-use diag_data_mod,   only: DIAG_NULL
+use diag_data_mod,   only: DIAG_NULL, DIAG_OCEAN, DIAG_ALL, DIAG_OTHER
 use yaml_parser_mod, only: open_and_parse_file, get_value_from_key, get_num_blocks, get_nkeys, &
                            get_block_ids, get_key_value, get_key_ids, get_key_name
 use mpp_mod,         only: mpp_error, FATAL
@@ -97,6 +97,7 @@ module fms_diag_yaml_mod
                                                                                         !! meta data to the file
 
  contains
+
  !> All getter functions (functions named get_x(), for member field named x)
  !! return copies of the member variables unless explicitly noted.
  procedure :: get_file_fname
@@ -260,7 +261,12 @@ end function get_diag_fields
 
 !> @brief Uses the yaml_parser_mod to read in the diag_table and fill in the
 !! diag_yaml object
-subroutine diag_yaml_object_init
+subroutine diag_yaml_object_init(diag_subset_output)
+  integer, intent(in)  :: diag_subset_output !< DIAG_ALL   - Current PE is in the one and only pelist
+                                             !! DIAG_OTHER - Current PE is not in the ocean pelist
+                                             !! and there are multiple pelists
+                                             !! DIAG_OCEAN - Current PE is in the ocean pelist
+                                             !! and there are multiple pelists
   integer              :: diag_yaml_id     !< Id for the diag_table yaml
   integer              :: nfiles           !< Number of files in the diag_table yaml
   integer, allocatable :: diag_file_ids(:) !< Ids of the files in the diag_table yaml
@@ -269,39 +275,73 @@ subroutine diag_yaml_object_init
   integer              :: var_count        !< The current number of variables added to the diag_yaml obj
   integer              :: nvars            !< The number of variables in the current file
   integer, allocatable :: var_ids(:)       !< Ids of the variables in diag_table yaml
+  logical              :: is_ocean         !< Flag indicating if it is an ocean file
+  logical, allocatable :: ignore(:)        !< Flag indicating if the diag_file is going to be ignored
+  integer              :: actual_num_files !< The actual number of files that were saved
+  integer              :: file_count       !! The current number of files added to the diag_yaml obj
 
   diag_yaml_id = open_and_parse_file("diag_table.yaml")
 
   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)
 
   nfiles = get_num_blocks(diag_yaml_id, "diag_files")
-  allocate(diag_yaml%diag_files(nfiles))
   allocate(diag_file_ids(nfiles))
+  allocate(ignore(nfiles))
+
   call get_block_ids(diag_yaml_id, "diag_files", diag_file_ids)
 
-  total_nvars = get_total_num_vars(diag_yaml_id, diag_file_ids)
+  ignore = .false.
+  total_nvars = 0
+  !< If you are on two seperate pelists
+  if(diag_subset_output .ne. DIAG_ALL) then
+    actual_num_files = 0
+    do i = 1, nfiles
+      is_ocean = .false.
+      call get_value_from_key(diag_yaml_id, diag_file_ids(i), "is_ocean", is_ocean, is_optional=.true.)
+      !< If you are on the ocean pelist and the file is not an ocean file, skip the file
+      if (diag_subset_output .eq. DIAG_OCEAN .and. .not. is_ocean) ignore(i) = .true.
+
+      !< If you are not on the ocean pelist and the file is ocean, skip the file
+      if(diag_subset_output .eq. DIAG_OTHER .and. is_ocean) ignore(i) = .true.
+
+      if (.not. ignore(i)) then
+        actual_num_files = actual_num_files + 1
+        !< If ignoring the file, ignore the fields in that file too!
+        total_nvars = total_nvars + get_num_blocks(diag_yaml_id, "varlist", parent_block_id=diag_file_ids(i))
+      endif
+    enddo
+  else
+    actual_num_files = nfiles
+    total_nvars = get_total_num_vars(diag_yaml_id, diag_file_ids)
+  endif
+
+  allocate(diag_yaml%diag_files(actual_num_files))
   allocate(diag_yaml%diag_fields(total_nvars))
 
   var_count = 0
+  file_count = 0
+  !> Loop through the number of nfiles and fill in the diag_yaml obj
   nfiles_loop: do i = 1, nfiles
-    call diag_yaml_files_obj_init(diag_yaml%diag_files(i))
-    call fill_in_diag_files(diag_yaml_id, diag_file_ids(i), diag_yaml%diag_files(i))
+    if(ignore(i)) cycle
+    file_count = file_count + 1
+    call diag_yaml_files_obj_init(diag_yaml%diag_files(file_count))
+    call fill_in_diag_files(diag_yaml_id, diag_file_ids(i), diag_yaml%diag_files(file_count))
 
     nvars = 0
     nvars = get_num_blocks(diag_yaml_id, "varlist", parent_block_id=diag_file_ids(i))
     allocate(var_ids(nvars))
     call get_block_ids(diag_yaml_id, "varlist", var_ids, parent_block_id=diag_file_ids(i))
-    allocate(diag_yaml%diag_files(i)%file_varlist(nvars))
+    allocate(diag_yaml%diag_files(file_count)%file_varlist(nvars))
     nvars_loop: do j = 1, nvars
       var_count = var_count + 1
       !> Save the filename in the diag_field type
-      diag_yaml%diag_fields(var_count)%var_fname = diag_yaml%diag_files(i)%file_fname
+      diag_yaml%diag_fields(var_count)%var_fname = diag_yaml%diag_files(file_count)%file_fname
 
       call fill_in_diag_fields(diag_yaml_id, var_ids(j), diag_yaml%diag_fields(var_count))
 
       !> Save the variable name in the diag_file type
-      diag_yaml%diag_files(i)%file_varlist(j) = diag_yaml%diag_fields(var_count)%var_varname
+      diag_yaml%diag_files(file_count)%file_varlist(j) = diag_yaml%diag_fields(var_count)%var_varname
     enddo nvars_loop
     deallocate(var_ids)
   enddo nfiles_loop

test_fms/diag_manager/Makefile.am

@@ -30,7 +30,7 @@ LDADD = $(top_builddir)/libFMS/libFMS.la
 # Build this test program.
 check_PROGRAMS = test_diag_manager test_diag_manager_time test_diag_object_container \
                  test_diag_update_buffer test_diag_dlinked_list \
-                 test_diag_dlinked_list test_diag_yaml
+                 test_diag_yaml test_diag_ocean
 
 # This is the source code for the test.
 test_diag_manager_SOURCES = test_diag_manager.F90
@@ -39,6 +39,7 @@ test_diag_update_buffer_SOURCES= test_diag_update_buffer.F90
 test_diag_yaml_SOURCES = test_diag_yaml.F90
 test_diag_object_container_SOURCES = test_diag_object_container.F90
 test_diag_dlinked_list_SOURCES = test_diag_dlinked_list.F90
+test_diag_ocean_SOURCES = test_diag_ocean.F90
 
 TEST_EXTENSIONS = .sh
 SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \

test_fms/diag_manager/test_diag_manager2.sh

@@ -509,4 +509,131 @@ test_expect_success "Test the diag update_buffer (test $my_test_count)" '
   mpirun -n 1 ../test_diag_update_buffer
 '
 
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: wild_card_name%4yr%2mo%2dy%2hr
+  freq: 6
+  freq_units: hours
+  time_units: hours
+  unlimdim: time
+  new_file_freq: 6
+  new_file_freq_units: hours
+  start_time: 2 1 1 0 0 0
+  file_duration: 12
+  file_duration_units: hours
+  write_file: false
+  realm: ATM
+  varlist:
+  - module: test_diag_manager_mod
+    var_name: sst
+    output_name: sst
+    reduction: average
+    kind: float
+    write_var: false
+  global_meta:
+  - is_a_file: true
+- file_name: normal
+  freq: 24
+  freq_units: days
+  time_units: hours
+  unlimdim: records
+  varlist:
+  - module: test_diag_manager_mod
+    var_name: sst
+    output_name: sst
+    reduction: average
+    kind: float
+    write_var: true
+    attributes:
+    - do_sst: .true.
+  sub_region:
+  - grid_type: latlon
+    dim1_begin: 64.0
+    dim3_end: 20.0
+- file_name: normal2
+  freq: -1
+  freq_units: days
+  time_units: hours
+  unlimdim: records
+  write_file: true
+  varlist:
+  - module: test_diag_manager_mod
+    var_name: sstt
+    output_name: sstt
+    reduction: average
+    kind: float
+    long_name: S S T
+  sub_region:
+  - grid_type: index
+    tile: 1
+    dim2_begin: 10
+    dim2_end: 20
+    dim1_begin: 10
+_EOF
+cp diag_table.yaml diag_table.yaml_base
+
+test_expect_success "diag_yaml test (test $my_test_count)" '
+  mpirun -n 1 ../test_diag_yaml
+'
+
+. $top_srcdir/test_fms/diag_manager/check_crashes.sh
+
+printf "&diag_manager_nml \n use_modern_diag = .true. \n/" | cat > input.nml
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: file1
+  freq: 6
+  freq_units: hours
+  time_units: hours
+  unlimdim: time
+  varlist:
+  - module: test_diag_manager_mod
+    var_name: sst1
+    output_name: sst1
+    reduction: average
+    kind: float
+- file_name: file2
+  freq: 6
+  freq_units: hours
+  time_units: hours
+  unlimdim: time
+  is_ocean: True
+  varlist:
+  - module: test_diag_manager_mod
+    var_name: sst2
+    output_name: sst2
+    reduction: average
+    kind: float
+- file_name: file3
+  freq: 6
+  freq_units: hours
+  time_units: hours
+  unlimdim: time
+  varlist:
+  - module: test_diag_manager_mod
+    var_name: sst3
+    output_name: sst3
+    reduction: average
+    kind: float
+  - module: test_diag_manager_mod
+    var_name: sst4
+    output_name: sst4
+    reduction: average
+    kind: float
+_EOF
+test_expect_success "Test the diag_ocean feature in diag_manager_init (test $my_test_count)" '
+  mpirun -n 2 ../test_diag_ocean
+'
+
+test_expect_success "test_diag_object_container (test $my_test_count)" '
+  mpirun -n 1 ../test_diag_object_container
+'
+test_expect_success "test_diag_dlinked_list (test $my_test_count)" '
+  mpirun -n 1 ../test_diag_dlinked_list
+'
+
 test_done

test_fms/diag_manager/test_diag_ocean.F90

@@ -0,0 +1,100 @@
+!***********************************************************************
+!*                   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 <http://www.gnu.org/licenses/>.
+!***********************************************************************
+
+!> @brief This program tests the diag_model_subset feature of diag_mananger_init
+!! It requires two PEs to run and it runs with diag_table_yaml_27
+program test_diag_ocean
+
+#ifdef use_yaml
+use FMS_mod, only: fms_init, fms_end, string
+use fms_diag_yaml_mod
+use diag_manager_mod, only: diag_manager_init
+use diag_data_mod, only: DIAG_NULL, DIAG_OCEAN, DIAG_OTHER
+use mpp_mod
+use platform_mod
+
+implicit none
+
+type(diagYamlObject_type) :: my_yaml !< diagYamlObject obtained from diag_yaml_object_init
+type(diagYamlFiles_type), allocatable, dimension (:) :: diag_files !< Files from the diag_yaml
+type(diagYamlFilesVar_type), allocatable, dimension(:) :: diag_fields !< Fields from the diag_yaml
+character(len=10), allocatable :: file_names(:) !< The expected names of the files
+character(len=10), allocatable :: var_names(:) !< The expected names of the variables
+integer :: diag_subset !< Diag_subset to be sent to diag_manager_init
+integer :: nfiles !< Expected number of files
+integer :: nvariables !< Expected number of variables
+integer :: i !< For do loops
+
+call fms_init()
+
+if (mpp_npes() .ne. 2) call mpp_error(FATAL, "test_diag_ocean requires two PEs!")
+
+!> PE 0 is not going to include the file with is_ocean = .true.
+if (mpp_pe() .eq. 0) then
+  diag_subset = DIAG_OTHER
+  nfiles = 2
+  allocate(file_names(nfiles))
+  file_names = (/"file1", "file3"/)
+  nvariables = 3
+  allocate(var_names(nvariables))
+  var_names = (/"sst1", "sst3", "sst4"/)
+endif
+
+!> PE 1 is only going to include the file with is_ocean = .true.
+if (mpp_pe() .eq. 1) then
+  diag_subset = DIAG_OCEAN
+  nfiles = 1
+  allocate(file_names(nfiles))
+  file_names = (/"file2"/)
+  nvariables = 1
+  allocate(var_names(nvariables))
+  var_names = (/"sst2"/)
+endif
+
+call diag_manager_init(diag_model_subset=diag_subset)
+
+my_yaml = get_diag_yaml_obj()
+diag_files = my_yaml%get_diag_files()
+if (size(diag_files) .ne. nfiles) call mpp_error(FATAL, "The number of files should be "//string(nfiles))
+
+do i = 1, nfiles
+  if(trim(file_names(i)) .ne. diag_files(i)%get_file_fname()) &
+    call mpp_error(FATAL, "The file_name should of the "//string(i)//" file should be "//&
+      &trim(file_names(i))//" not "//diag_files(i)%get_file_fname())
+end do
+
+diag_fields = my_yaml%get_diag_fields()
+if (size(diag_fields) .ne. nvariables) call mpp_error(FATAL, "The number of variables should be "//string(nvariables))
+
+do i = 1, nvariables
+  if(trim(var_names(i)) .ne. diag_fields(i)%get_var_varname()) &
+    call mpp_error(FATAL, "The var_name should of the "//string(i)//" field should be "//&
+      &trim(var_names(i))//" not "//diag_fields(i)%get_var_varname())
+end do
+
+deallocate(diag_files)
+deallocate(diag_fields)
+deallocate(file_names)
+deallocate(var_names)
+
+call diag_yaml_object_end
+call fms_end()
+
+#endif
+end program test_diag_ocean

test_fms/diag_manager/test_diag_yaml.F90

@@ -24,7 +24,7 @@ program test_diag_yaml
 #ifdef use_yaml
 use FMS_mod, only: fms_init, fms_end
 use fms_diag_yaml_mod
-use diag_data_mod, only: DIAG_NULL
+use diag_data_mod, only: DIAG_NULL, DIAG_ALL
 use mpp_mod
 use platform_mod
 
@@ -61,7 +61,11 @@ end subroutine compare_result_1d
 read (input_nml_file, check_crashes_nml, iostat=io_status)
 if (io_status > 0) call mpp_error(FATAL,'=>check_crashes: Error reading input.nml')
 
-call diag_yaml_object_init
+#ifndef use_yaml
+if (checking_crashes) call mpp_error(FATAL, "It is crashing!")
+call fms_end()
+#else
+call diag_yaml_object_init(DIAG_ALL)
 
 my_yaml = get_diag_yaml_obj()