Merge branch 'Hallberg-NOAA-streamline_restore_state' into dev/gfdl

src/framework/MOM_domains.F90

@@ -118,7 +118,6 @@ module MOM_domains
                                 !! domain in the i-direction in a define_domain call.
   integer :: Y_FLAGS            !< Flag that specifies the properties of the
                                 !! domain in the j-direction in a define_domain call.
-  logical :: use_io_layout      !< True if an I/O layout is available.
   logical, pointer :: maskmap(:,:) => NULL() !< A pointer to an array indicating
                                 !! which logical processors are actually used for
                                 !! the ocean code. The other logical processors
@@ -1401,11 +1400,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, &
                  "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",&
                  layoutParam=.true.)
   call log_param(param_file, mdl, trim(njproc_nm), layout(2), &
-                 "The number of processors in the x-direction. With \n"//& !### FIX THIS COMMENT
+                 "The number of processors in the y-direction. With \n"//&
                  "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",&
                  layoutParam=.true.)
   call log_param(param_file, mdl, trim(layout_nm), layout, &
-                 "The processor layout that was acutally used.",&
+                 "The processor layout that was actually used.",&
                  layoutParam=.true.)
 
   ! Idiot check that fewer PEs than columns have been requested
@@ -1490,7 +1489,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, &
   MOM_dom%Y_FLAGS = Y_FLAGS
   MOM_dom%layout = layout
   MOM_dom%io_layout = io_layout
-  MOM_dom%use_io_layout = (io_layout(1) + io_layout(2) > 0)
 
   if (is_static) then
   !   A requirement of equal sized compute domains is necessary when STATIC_MEMORY_
@@ -1554,7 +1552,6 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, &
 
   MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS
   MOM_dom%layout(:) = MD_in%layout(:) ; MOM_dom%io_layout(:) = MD_in%io_layout(:)
-  MOM_dom%use_io_layout = (MOM_dom%io_layout(1) + MOM_dom%io_layout(2) > 0)
 
   if (associated(MD_in%maskmap)) then
     mask_table_exists = .true.

src/framework/MOM_io.F90

@@ -30,15 +30,15 @@ module MOM_io
 use mpp_io_mod,           only : MPP_APPEND, MPP_MULTI, MPP_OVERWR, MPP_NETCDF, MPP_RDONLY
 use mpp_io_mod,           only : get_file_info=>mpp_get_info, get_file_atts=>mpp_get_atts
 use mpp_io_mod,           only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times
-use mpp_io_mod,           only : read_field=>mpp_read, io_infra_init=>mpp_io_init
+use mpp_io_mod,           only : io_infra_init=>mpp_io_init
 
 use netcdf
 
 implicit none ; private
 
 public :: close_file, create_file, field_exists, field_size, fieldtype, get_filename_appendix
 public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields
-public :: get_file_times, open_file, read_axis_data, read_data, read_field
+public :: get_file_times, open_file, read_axis_data, read_data
 public :: num_timelevels, MOM_read_data, MOM_read_vector, ensembler
 public :: reopen_file, slasher, write_field, write_version_number, MOM_io_init
 public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end
@@ -154,9 +154,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit
   endif
 
   one_file = .true.
-  if (domain_set) then
-    one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout)
-  endif
+  if (domain_set) one_file = (thread == SINGLE_FILE)
 
   if (one_file) then
     call open_file(unit, filename, MPP_OVERWR, MPP_NETCDF, threading=thread)
@@ -398,9 +396,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit
     endif
 
     one_file = .true.
-    if (domain_set) then
-      one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout)
-    endif
+    if (domain_set) one_file = (thread == SINGLE_FILE)
 
     if (one_file) then
       call open_file(unit, filename, MPP_APPEND, MPP_NETCDF, threading=thread)
@@ -1012,7 +1008,7 @@ end subroutine MOM_io_init
 !!
 !!   * write_field: write a field to an open file.
 !!   * write_time: write a value of the time axis to an open file.
-!!   * read_field: read a field from an open file.
+!!   * read_data: read a variable from an open file.
 !!   * read_time: read a time from an open file.
 !!
 !!   * name_output_file: provide a name for an output file based on a

src/framework/MOM_restart.F90

@@ -9,7 +9,7 @@ module MOM_restart
 use MOM_string_functions, only : lowercase
 use MOM_grid, only : ocean_grid_type
 use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file
-use MOM_io, only : read_field, write_field, MOM_read_data, read_data, get_filename_appendix
+use MOM_io, only : write_field, MOM_read_data, read_data, get_filename_appendix
 use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times
 use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc
 use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE
@@ -1093,117 +1093,46 @@ subroutine restore_state(filename, directory, day, G, CS)
             call mpp_get_atts(fields(i),checksum=checksum_file)
             is_there_a_checksum = .true.
           endif
-          if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming.
+          if (.NOT. CS%checksum_required) is_there_a_checksum = .false. ! Do not need to do data checksumming.
 
           if (associated(CS%var_ptr1d(m)%p))  then
             ! Read a 1d array, which should be invariant to domain decomposition.
             call read_data(unit_path(n), varname, CS%var_ptr1d(m)%p, &
-                           no_domain=.true., timelevel=1)
-            if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p)
+                           G%Domain%mpp_domain, timelevel=1)
+            if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p)
           elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar...
             call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, &
                            G%Domain%mpp_domain, timelevel=1)
-            if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p)
-          elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then  ! Read a non-decomposed 2d array.
-            ! Probably should query the field type to make sure that the sizes are right.
-            call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, &
-                           no_domain=.true., timelevel=1)
-            if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
-          elseif ((pos == 0) .and. associated(CS%var_ptr3d(m)%p)) then  ! Read a non-decomposed 3d array.
-            ! Probably should query the field type to make sure that the sizes are right.
-            call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
-                           no_domain=.true., timelevel=1)
-             if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
-          elseif ((pos == 0) .and. associated(CS%var_ptr4d(m)%p)) then  ! Read a non-decomposed 4d array.
-            ! Probably should query the field type to make sure that the sizes are right.
-            call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
-                           no_domain=.true., timelevel=1)
-            if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
-          elseif (unit_is_global(n) .or. G%Domain%use_io_layout) then
-            if (associated(CS%var_ptr3d(m)%p)) then
-              ! Read 3d array...  Time level 1 is always used.
-              call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
-                             G%Domain, 1, position=pos)
-              if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
-            elseif (associated(CS%var_ptr2d(m)%p)) then ! Read 2d array...
+            if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p)
+          elseif (associated(CS%var_ptr2d(m)%p)) then  ! Read a 2d array.
+            if (pos /= 0) then
               call MOM_read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, &
-                             G%Domain, 1, position=pos)
-              if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
-            elseif (associated(CS%var_ptr4d(m)%p)) then ! Read 4d array...
-              call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
-                             G%Domain, 1, position=pos)
-              if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
-            else
-              call MOM_error(FATAL, "MOM_restart restore_state: "//&
-                              "No pointers set for "//trim(varname))
-            endif
-          else ! Do not use an io_layout.  !### GET RID OF THIS BRANCH ONCE read_data_4d_new IS AVAILABLE.
-            ! This file is decomposed onto the current processors.  We need
-            ! to check whether the sizes look right, and abort if not.
-            call get_file_atts(fields(i),ndim=ndim,siz=sizes)
-
-            !   NOTE: The index ranges f var_ptrs always start with 1, so with
-            ! symmetric memory the staggering is swapped from NE to SW!
-            is0 = 1-G%isd
-            if ((pos == EAST_FACE) .or. (pos == CORNER)) is0 = 1-G%IsdB
-            if (sizes(1) == G%iec-G%isc+1) then
-              isL = G%isc+is0 ; ieL = G%iec+is0
-            elseif (sizes(1) == G%IecB-G%IscB+1) then
-              isL = G%IscB+is0 ; ieL = G%IecB+is0
-            elseif (((pos == EAST_FACE) .or. (pos == CORNER)) .and. &
-                    (G%IscB == G%isc) .and. (sizes(1) == G%iec-G%isc+2)) then
-              ! This is reading a symmetric file in a non-symmetric model.
-              isL = G%isc-1+is0 ; ieL = G%iec+is0
-            else
-              call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//&
-                    " has the wrong i-size in "//trim(unit_path(n)))
-              exit
+                                 G%Domain, timelevel=1, position=pos)
+            else ! This array is not domain-decomposed.  This variant may be under-tested.
+              call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, &
+                             no_domain=.true., timelevel=1)
             endif
-
-            js0 = 1-G%jsd
-            if ((pos == NORTH_FACE) .or. (pos == CORNER)) js0 = 1-G%JsdB
-            if (sizes(2) == G%jec-G%jsc+1) then
-              jsL = G%jsc+js0 ; jeL = G%jec+js0
-            elseif (sizes(2) == G%jecB-G%jscB+1) then
-              jsL = G%jscB+js0 ; jeL = G%jecB+js0
-            elseif (((pos == NORTH_FACE) .or. (pos == CORNER)) .and. &
-                    (G%JscB == G%jsc) .and. (sizes(2) == G%jec-G%jsc+2)) then
-              ! This is reading a symmetric file in a non-symmetric model.
-              jsL = G%jsc-1+js0 ; jeL = G%jec+js0
-            else
-              call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//&
-                    " has the wrong j-size in "//trim(unit_path(n)))
-              exit
+            if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
+          elseif (associated(CS%var_ptr3d(m)%p)) then  ! Read a 3d array.
+            if (pos /= 0) then
+              call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
+                                 G%Domain, timelevel=1, position=pos)
+            else ! This array is not domain-decomposed.  This variant may be under-tested.
+              call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, &
+                             no_domain=.true., timelevel=1)
             endif
-
-            if (associated(CS%var_ptr3d(m)%p)) then
-              if (ntime == 0) then
-                call read_field(unit(n), fields(i), &
-                                CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
-              else
-                call read_field(unit(n), fields(i), &
-                                CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:), 1)
-              endif
-            elseif (associated(CS%var_ptr2d(m)%p)) then
-              if (ntime == 0) then
-                call read_field(unit(n), fields(i), &
-                                CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL))
-              else
-                call read_field(unit(n), fields(i), &
-                                CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL), 1)
-              endif
-            elseif (associated(CS%var_ptr4d(m)%p)) then
-              if (ntime == 0) then
-                call read_field(unit(n), fields(i), &
-                                CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
-              else
-                call read_field(unit(n), fields(i), &
-                                CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:), 1)
-              endif
-            else
-              call MOM_error(FATAL, "MOM_restart restore_state: "//&
-                              "No pointers set for "//trim(varname))
+            if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:))
+          elseif (associated(CS%var_ptr4d(m)%p)) then  ! Read a 4d array.
+            if (pos /= 0) then
+              call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
+                                 G%Domain, timelevel=1, position=pos)
+            else ! This array is not domain-decomposed.  This variant may be under-tested.
+              call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
+                             no_domain=.true., timelevel=1)
             endif
+            if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:))
+          else
+            call MOM_error(FATAL, "MOM_restart restore_state: No pointers set for "//trim(varname))
           endif
 
           if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then
@@ -1412,24 +1341,11 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, &
                            threading = MULTIPLE, fileset = SINGLE_FILE)
           if (present(global_files)) global_files(n) = .true.
         elseif (CS%parallel_restartfiles) then
-          if (G%Domain%use_io_layout) then
-            ! Look for decomposed files using the I/O Layout.
-            fexists = file_exists(filepath, G%Domain)
-            if (fexists .and. (present(units))) &
-              call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, &
-                             domain=G%Domain%mpp_domain)
-          else
-            ! Look for any PE-specific files of the form NAME.nc.####.
-            if (num_PEs()>10000) then
-              write(filepath, '(a,i6.6)' ) trim(filepath)//'.', pe_here()
-            else
-              write(filepath, '(a,i4.4)' ) trim(filepath)//'.', pe_here()
-            endif
-            inquire(file=filepath, exist=fexists)
-            if (fexists .and. (present(units))) &
-              call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, &
-                             threading = MULTIPLE, fileset = SINGLE_FILE)
-          endif
+          ! Look for decomposed files using the I/O Layout.
+          fexists = file_exists(filepath, G%Domain)
+          if (fexists .and. (present(units))) &
+            call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, &
+                           domain=G%Domain%mpp_domain)
           if (fexists .and. present(global_files)) global_files(n) = .false.
         endif
 

src/initialization/MOM_grid_initialize.F90

@@ -220,7 +220,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
   SGdom%niglobal = 2*G%domain%niglobal
   SGdom%njglobal = 2*G%domain%njglobal
   SGdom%layout(:) = G%domain%layout(:)
-  SGdom%use_io_layout = G%domain%use_io_layout
   SGdom%io_layout(:) = G%domain%io_layout(:)
   global_indices(1) = 1+SGdom%nihalo
   global_indices(2) = SGdom%niglobal+SGdom%nihalo
@@ -241,8 +240,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file)
             symmetry=.true., name="MOM_MOSAIC")
   endif
 
-  if (SGdom%use_io_layout) &
-    call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout)
+  call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout)
   deallocate(exni)
   deallocate(exnj)