merge main

.github/workflows/github_autotools_gnu.yml

@@ -19,7 +19,7 @@ jobs:
       env:
         TEST_VERBOSE: 1
         DISTCHECK_CONFIGURE_FLAGS: "${{ matrix.conf-flag }} ${{ matrix.input-flag }} ${{ matrix.io-flag }}"
-        SKIP_TESTS: "test_mpp_domains2.14 test_horiz_interp2.9 test_horiz_interp2.10 test_yaml_parser.5" # temporary till fixes are in
+        SKIP_TESTS: "test_yaml_parser.5" # temporary till fixes are in
     steps:
     - name: Checkout code
       uses: actions/checkout@v2

.github/workflows/github_autotools_intel.yml

@@ -2,13 +2,16 @@ on: pull_request
 jobs:
   intel-autotools:
     runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        io-flag: ["--disable-deprecated-io", "--enable-deprecated-io"]
     container:
       image: intel/oneapi-hpckit:2023.1.0-devel-ubuntu20.04
       env:
         CC: mpiicc
         FC: mpiifort
         CFLAGS:  "-I/libs/include"
-        FCFLAGS: "-I/libs/include -g -traceback"
+        FCFLAGS: "-I/libs/include -g -traceback ${{ matrix.io-flag }}"
         LDFLAGS: "-L/libs/lib"
         TEST_VERBOSE: 1
         I_MPI_FABRICS: "shm" # needed for mpi in image

drifters/cloud_interpolator.F90

@@ -25,6 +25,7 @@
 !> @addtogroup cloud_interpolator_mod
 !> @{
 MODULE cloud_interpolator_mod
+#ifdef use_drifters
   implicit none
   private
 
@@ -284,6 +285,7 @@ pure subroutine cld_ntrp_get_cell_values(nsizes, fnodes, indices, fvals, ier)
 
   end subroutine cld_ntrp_get_cell_values
 
+#endif
 end MODULE cloud_interpolator_mod
 !===============================================================================
 !> @}

drifters/drifters.F90

@@ -60,6 +60,7 @@
 !> @addtogroup drifters_mod
 !> @{
 module drifters_mod
+#ifdef use_drifters
 
 #ifdef _SERIAL
 
@@ -947,7 +948,7 @@ subroutine drifters_reset_rk4(self, ermesg)
     endif
 
   end subroutine drifters_reset_rk4
-
+#endif
 end module drifters_mod
 !> @}
 ! close documentation grouping

drifters/drifters_comm.F90

@@ -23,6 +23,7 @@
 !> @brief Routines and types to update drifter positions across processor domains
 
 module drifters_comm_mod
+#ifdef use_drifters
 
 #ifdef _SERIAL
 
@@ -769,7 +770,7 @@ subroutine drifters_comm_gather(self, drfts, dinp, &
 
   end subroutine drifters_comm_gather
 
-
+#endif
 end module drifters_comm_mod
 
 !===============================================================================

drifters/drifters_core.F90

@@ -21,6 +21,7 @@
 !> @brief Handles the mechanics for adding and removing drifters
 
 module drifters_core_mod
+#ifdef use_drifters
   use platform_mod
   implicit none
   private
@@ -272,7 +273,7 @@ subroutine drifters_core_print(self1, ermesg1)
 
   end subroutine drifters_core_print
 
-
+#endif
 end module drifters_core_mod
 !###############################################################################
 !> @}

drifters/drifters_input.F90

@@ -23,6 +23,7 @@
 !> @addtogroup drifters_input_mod
 !> @{
 module drifters_input_mod
+#ifdef use_drifters
   implicit none
   private
 
@@ -444,7 +445,7 @@ subroutine drifters_input_save(self, filename, geolon, geolat, ermesg)
          & //nf_strerror(ier)
 
   end subroutine drifters_input_save
-
+#endif
 end module drifters_input_mod
 !> @}
 ! close documentation grouping

drifters/drifters_io.F90

@@ -23,6 +23,7 @@
 !> @addtogroup drifters_io_mod
 !> @{
 module drifters_io_mod
+#ifdef use_drifters
 
   use netcdf
   use netcdf_nf_data
@@ -307,7 +308,7 @@ subroutine drifters_io_write(self, time, np, nd, nf, ids, positions, fields, erm
     self%it_id = self%it_id + np
 
   end subroutine drifters_io_write
-
+#endif
 end module drifters_io_mod
 !> @}
 ! close documentation grouping

fms2_io/include/compressed_write.inc

@@ -144,22 +144,22 @@ subroutine compressed_write_1d(fileobj, variable_name, cdata, unlim_dim_level, &
     type is (integer(kind=i4_kind))
       call mpp_gather(cdata, size(cdata), buf_i4_kind, fileobj%compressed_dims(compressed_dim_index(2))%npes_nelems, &
         fileobj%pelist)
-      call netcdf_write_data(fileobj, variable_name, buf_i4_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_i4_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (integer(kind=i8_kind))
       call mpp_gather(cdata, size(cdata), buf_i8_kind, fileobj%compressed_dims(compressed_dim_index(2))%npes_nelems, &
         fileobj%pelist)
-      call netcdf_write_data(fileobj, variable_name, buf_i8_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_i8_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (real(kind=r4_kind))
       call mpp_gather(cdata, size(cdata), buf_r4_kind, fileobj%compressed_dims(compressed_dim_index(2))%npes_nelems, &
         fileobj%pelist)
-      call netcdf_write_data(fileobj, variable_name, buf_r4_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_r4_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (real(kind=r8_kind))
       call mpp_gather(cdata, size(cdata), buf_r8_kind, fileobj%compressed_dims(compressed_dim_index(2))%npes_nelems, &
         fileobj%pelist)
-      call netcdf_write_data(fileobj, variable_name, buf_r8_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_r8_kind, &
         unlim_dim_level=unlim_dim_level)
     class default
       call error("unsupported variable type: "//trim(append_error_msg))
@@ -266,19 +266,19 @@ subroutine compressed_write_2d(fileobj, variable_name, cdata, unlim_dim_level, &
   select type(cdata)
     type is (integer(kind=i4_kind))
       call mpp_gather(is, ie, js, je, fileobj%pelist, cdata, buf_i4_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_i4_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_i4_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (integer(kind=i8_kind))
       call mpp_gather(is, ie, js, je, fileobj%pelist, cdata, buf_i8_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_i8_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_i8_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (real(kind=r4_kind))
       call mpp_gather(is, ie, js, je, fileobj%pelist, cdata, buf_r4_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_r4_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_r4_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (real(kind=r8_kind))
       call mpp_gather(is, ie, js, je, fileobj%pelist, cdata, buf_r8_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_r8_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_r8_kind, &
         unlim_dim_level=unlim_dim_level)
     class default
       call error("unsupported variable type: "//trim(append_error_msg))
@@ -391,22 +391,22 @@ subroutine compressed_write_3d(fileobj, variable_name, cdata, unlim_dim_level, &
     type is (integer(kind=i4_kind))
       call mpp_gather(is, ie, js, je, size(cdata,3), &
         fileobj%pelist, cdata, buf_i4_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_i4_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_i4_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (integer(kind=i8_kind))
       call mpp_gather(is, ie, js, je, size(cdata,3), &
         fileobj%pelist, cdata, buf_i8_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_i8_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_i8_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (real(kind=r4_kind))
       call mpp_gather(is, ie, js, je, size(cdata,3), &
         fileobj%pelist, cdata, buf_r4_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_r4_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_r4_kind, &
         unlim_dim_level=unlim_dim_level)
     type is (real(kind=r8_kind))
       call mpp_gather(is, ie, js, je, size(cdata,3), &
         fileobj%pelist, cdata, buf_r8_kind, fileobj%is_root)
-      call netcdf_write_data(fileobj, variable_name, buf_r8_kind, &
+      if (fileobj%is_root) call netcdf_write_data(fileobj, variable_name, buf_r8_kind, &
         unlim_dim_level=unlim_dim_level)
     class default
       call error("unsupported variable type: "//trim(append_error_msg))

mpp/include/mpp_domains_misc.inc

@@ -419,6 +419,13 @@ end subroutine init_nonblock_type
       field2(isd:ied, jsd:jed) = field_in(:,:)
     endif
 
+!  allocate field1 on pelist1
+!  if field1 is left unallocated, the code will try to access unallocated memory
+!  when field1 is set to 0 in mpp_redistribute
+    if(any(pelist1 == pe)) then
+      allocate(field1(1,1))
+    endif
+
 !  broadcast domain
     call mpp_broadcast_domain(domain1)
     call mpp_broadcast_domain(domain2)
@@ -443,6 +450,8 @@ end subroutine init_nonblock_type
 
     if(any(pelist2 == pe))    deallocate(field1, field2)
 
+    if(any(pelist1 == pe))    deallocate(field1)
+
     call mpp_sync()
 
     return

mpp/include/mpp_util_mpi.inc

@@ -93,7 +93,6 @@ function get_peset(pelist)
   integer, intent(in), optional :: pelist(:)
   integer                       :: errunit
   integer                       :: i, n
-  integer,          allocatable :: sorted(:)
 
   if( .NOT.PRESENT(pelist) )then !set it to current_peset_num
      get_peset = current_peset_num; return
@@ -106,17 +105,14 @@ function get_peset(pelist)
     enddo
   endif
 
-  allocate( sorted(size(pelist(:))) )
-  sorted = pelist
   errunit = stderr()
   if( debug )write( errunit,* )'pelist=', pelist
 
   !find if this array matches any existing peset
   do i = 1,peset_num
      if( debug )write( errunit,'(a,3i6)' )'pe, i, peset_num=', pe, i, peset_num
-     if( size(sorted(:)).EQ.size(peset(i)%list(:)) )then
-        if( ALL(sorted.EQ.peset(i)%list) )then
-           deallocate(sorted)
+     if( size(pelist(:)).EQ.size(peset(i)%list(:)) )then
+        if( ALL(pelist.EQ.peset(i)%list) )then
            get_peset = i; return
         end if
      end if
@@ -126,14 +122,13 @@ function get_peset(pelist)
   if( peset_num > current_peset_max ) call expand_peset()
   i = peset_num             !shorthand
   !create list
-  allocate( peset(i)%list(size(sorted(:))) )
-  peset(i)%list(:) = sorted(:)
-  peset(i)%count = size(sorted(:))
+  allocate( peset(i)%list(size(pelist(:))) )
+  peset(i)%list(:) = pelist(:)
+  peset(i)%count = size(pelist(:))
 
-  call MPI_GROUP_INCL( peset(current_peset_num)%group, size(sorted(:)), sorted-mpp_root_pe(), peset(i)%group, error )
+  call MPI_GROUP_INCL( peset(current_peset_num)%group, size(pelist(:)), pelist-mpp_root_pe(), peset(i)%group, error )
   call MPI_COMM_CREATE_GROUP(peset(current_peset_num)%id, peset(i)%group, &
                              DEFAULT_TAG, peset(i)%id, error )
-  deallocate(sorted)
   get_peset = i
 
   return

test_fms/drifters/test_cloud_interpolator.F90

@@ -18,6 +18,7 @@
 !***********************************************************************
 
 program test_cloud_interpolator
+#ifdef use_drifters
   use cloud_interpolator_mod
   use mpp_mod, only : mpp_error, FATAL, stdout, mpp_init, mpp_exit
 
@@ -215,4 +216,5 @@ subroutine test_get_node_values
 
 end subroutine test_get_node_values
 
+#endif
   end program test_cloud_interpolator

test_fms/drifters/test_drifters.F90

@@ -18,6 +18,7 @@
 !***********************************************************************
 
 program test_drifters
+#ifdef use_drifters
 
 !* contents of input file: drifters_inp_test_3d.nc
 !!$netcdf drifters_inp_test_3d {
@@ -336,7 +337,7 @@ program test_drifters
 !#ifndef _SERIAL
   call mpp_exit
 !#endif
-
+#endif
 end program test_drifters
 
 subroutine my_error_handler(mesg)

test_fms/drifters/test_drifters_comm.F90

@@ -19,6 +19,7 @@
 !**********************************************************************
 
 program test_drifters_comm
+#ifdef use_drifters
 
   use drifters_core_mod
   use drifters_comm_mod
@@ -143,4 +144,5 @@ program test_drifters_comm
   call mpp_domains_exit
   call mpp_exit
 
+#endif
 end program test_drifters_comm

test_fms/drifters/test_drifters_core.F90

@@ -19,6 +19,7 @@
 !**********************************************************************
 
 program test_drifters_core
+#ifdef use_drifters
 
   use drifters_core_mod
   use fms_mod, only : fms_init, fms_end
@@ -111,4 +112,5 @@ program test_drifters_core
 !!$     print *,'Sucessful test ier=', ier
 !!$  end if
   call fms_end()
+#endif
 end program test_drifters_core

test_fms/drifters/test_drifters_input.F90

@@ -19,6 +19,7 @@
 !***********************************************************************
 
 program test_drifters_input
+#ifdef use_drifters
   use drifters_input_mod
   use fms_mod, only : fms_init, fms_end
   use mpp_mod, only : mpp_error, FATAL, stdout
@@ -54,4 +55,5 @@ program test_drifters_input
   call drifters_input_del(obj, ermesg)
 
   call fms_end()
+#endif
 end program test_drifters_input

test_fms/drifters/test_drifters_io.F90

@@ -18,6 +18,7 @@
 !***********************************************************************
 
 program test_drifters_io
+#ifdef use_drifters
 
   use drifters_io_mod
   use mpp_mod, only : mpp_error, FATAL, stdout, mpp_init, mpp_exit
@@ -156,4 +157,5 @@ program test_drifters_io
       call mpp_error(FATAL, ermesg)
   endif
   call mpp_exit()
+#endif
 end program test_drifters_io

test_fms/drifters/test_quicksort.F90

@@ -19,9 +19,11 @@
 !***********************************************************************
 
       program test_quicksort
+#ifdef use_drifters
         implicit none
         integer :: list(16) = (/6, 2, 3, 4, 1, 45, 3432, 3245, 32545, 66555, 32, 1,3, -43254, 324, 54/)
         print *,'before list=', list
         call qksrt_quicksort(size(list), list, 1, size(list))
         print *,'after  list=', list
+#endif
       end program test_quicksort

test_fms/fms2_io/test_bc_restart.sh

@@ -43,7 +43,7 @@ test_expect_failure "bad checksum" '
 '
 
 # run test 3 - test for ignoring a bad checksum
-printf "&test_bc_restart_nml\n bad_checksum=.true.\n ignore_checksum=.true./" | cat > input.nml
+printf "&test_bc_restart_nml\n bad_checksum=.true.\n ignore_checksum=.true.\n /" | cat > input.nml
 test_expect_success "ignore bad checksum" '
   mpirun -n 16 ../test_bc_restart
 '

test_fms/fms2_io/test_compressed_writes.F90

@@ -112,10 +112,10 @@ subroutine register_field_wrapper(fileob, var_name, dimension_names, ndim)
     character(len=*),            intent(in)    :: dimension_names(:) !< dimension names
     integer,                     intent(in)    :: ndim               !< Number of dimension
 
-    call register_field(fileob, trim(var_name)//"_r8", "double", names(1:ndim))
-    call register_field(fileob, trim(var_name)//"_r4", "float",  names(1:ndim))
-    call register_field(fileob, trim(var_name)//"_i8", "int64",  names(1:ndim))
-    call register_field(fileob, trim(var_name)//"_i4", "int",    names(1:ndim))
+    call register_field(fileob, trim(var_name)//"_r8", "double", dimension_names(1:ndim))
+    call register_field(fileob, trim(var_name)//"_r4", "float",  dimension_names(1:ndim))
+    call register_field(fileob, trim(var_name)//"_i8", "int64",  dimension_names(1:ndim))
+    call register_field(fileob, trim(var_name)//"_i4", "int",    dimension_names(1:ndim))
   end subroutine register_field_wrapper
 
 !> @brief Allocates the variable to be the size of data compute domain for x and y