further pio transformations in preparation for the io decomposition i…

…mplemention

fms2_pio_io/fms_netcdf_domain_io.F90

@@ -203,7 +203,8 @@ function get_domain_decomposed_dimension_index(fileobj, variable_name, &
   integer :: i
 
   index_ = no_domain_decomposed_dimension
-  if (fileobj%is_root) then
+  if (fileobj%is_root &
+      .or. ncid_handled_by_pio(fileobj%ncid)) then
     ndims = get_variable_num_dimensions(fileobj, variable_name, broadcast=.false.)
     allocate(dim_names(ndims))
     dim_names(:) = ""
@@ -225,6 +226,7 @@ function get_domain_decomposed_dimension_index(fileobj, variable_name, &
     enddo
     deallocate(dim_names)
   endif
+  if (ncid_handled_by_pio(fileobj%ncid)) return
   if (present(broadcast)) then
     if (.not. broadcast) then
       return

fms2_pio_io/include/compressed_write.inc

@@ -121,6 +121,8 @@ subroutine compressed_write_1d(fileobj, variable_name, cdata, unlim_dim_level, &
     return
   endif
 
+  print *, "ERRORline compressed_write_1d"; call error("PIO version not implemented!!!")
+
   e(:) = shape(cdata)
   !The root pe creates a buffer big enough to store the data:
   if (fileobj%is_root) then
@@ -227,6 +229,8 @@ subroutine compressed_write_2d(fileobj, variable_name, cdata, unlim_dim_level, &
     return
   endif
 
+  print *, "ERRORline compressed_write_2d"; call error("PIO version not implemented!!!")
+
   e(:) = shape(cdata)
   !The root pe creates a buffer big enough to store the data:
   if (fileobj%is_root) then
@@ -351,6 +355,8 @@ subroutine compressed_write_3d(fileobj, variable_name, cdata, unlim_dim_level, &
     call compressed_write_4d(fileobj, variable_name, cdata_dummy, unlim_dim_level)
   endif
 
+  print *, "ERRORline compressed_write_3d"; call error("PIO version not implemented!!!")
+
   e(:) = shape(cdata)
   !The root pe creates a buffer big enough to store the data:
   if (fileobj%is_root) then
@@ -465,6 +471,8 @@ subroutine compressed_write_4d(fileobj, variable_name, cdata, unlim_dim_level, &
     return
   endif
 
+  print *, "ERRORline compressed_write_4d"; call error("PIO version not implemented!!!")
+
   !Gather the data onto the I/O root and write it out.
   if (fileobj%is_root) then
     c(:) = 1
@@ -573,6 +581,8 @@ subroutine compressed_write_5d(fileobj, variable_name, cdata, unlim_dim_level, &
     return
   endif
 
+  print *, "ERRORline compressed_write_5d"; call error("PIO version not implemented!!!")
+
   !Gather the data onto the I/O root and write it out.
   if (fileobj%is_root) then
     c(:) = 1

fms2_pio_io/include/domain_write.inc

@@ -40,6 +40,8 @@ subroutine domain_write_0d(fileobj, variable_name, vdata, unlim_dim_level, corne
                                           !! where the data
                                           !! will be written to.
 
+  print *, "ERRORline domain_write_0d"; call error("PIO version not implemented!!!")
+
   call compressed_write(fileobj, variable_name, vdata, &
                           unlim_dim_level=unlim_dim_level, corner=corner)
 
@@ -69,6 +71,8 @@ subroutine domain_write_1d(fileobj, variable_name, vdata, unlim_dim_level, &
                                                               !! will be written
                                                               !! in each dimension.
 
+  print *, "ERRORline domain_write_1d"; call error("PIO version not implemented!!!")
+
   call compressed_write(fileobj, variable_name, vdata, &
                           unlim_dim_level=unlim_dim_level, corner=corner, &
                           edge_lengths=edge_lengths)
@@ -137,6 +141,8 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, &
   integer :: ygmax !< Ending y index of the global io domain
   integer :: ygmin !< Ending y index of the global io domain
 
+  print *, "ERRORline domain_write_2d"; call error("PIO version not implemented!!!")
+
   if (.not. is_variable_domain_decomposed(fileobj, variable_name, .true., &
                                           xdim_index, ydim_index, xpos, ypos)) then
     call compressed_write(fileobj, variable_name, vdata, &
@@ -433,6 +439,8 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, &
   integer :: ygmax !< Ending y index of the global io domain
   integer :: ygmin !< Ending y index of the global io domain
 
+  print *, "ERRORline domain_write_3d"; call error("PIO version not implemented!!!")
+
   if (.not. is_variable_domain_decomposed(fileobj, variable_name, .true., &
                                           xdim_index, ydim_index, xpos, ypos)) then
     call compressed_write(fileobj, variable_name, vdata, &
@@ -736,6 +744,9 @@ subroutine domain_write_4d(fileobj, variable_name, vdata, unlim_dim_level, &
                           edge_lengths=edge_lengths)
     return
   endif
+
+  print *, "ERRORline domain_write_4d"; call error("PIO version not implemented!!!")
+
   io_domain => mpp_get_io_domain(fileobj%domain)
   call domain_offsets(size(vdata, xdim_index), size(vdata, ydim_index), fileobj%domain, &
                       xpos, ypos, isd, isc, xc_size, jsd, jsc, yc_size, &
@@ -1025,6 +1036,8 @@ subroutine domain_write_5d(fileobj, variable_name, vdata, unlim_dim_level, &
   integer :: ygmax !< Ending y index of the global io domain
   integer :: ygmin !< Ending y index of the global io domain
 
+  print *, "ERRORline domain_write_5d"; call error("PIO version not implemented!!!")
+
   if (.not. is_variable_domain_decomposed(fileobj, variable_name, .true., &
                                           xdim_index, ydim_index, xpos, ypos)) then
     call compressed_write(fileobj, variable_name, vdata, &

fms2_pio_io/include/netcdf_write_data.inc

@@ -47,11 +47,9 @@ subroutine netcdf_write_data_0d(fileobj, variable_name, variable_data, unlim_dim
   integer :: i
   integer :: tlen
   character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
-
-  print *, "ERRORline", 51, "write_data.inc"; call error("PIO version not implemented!!!")
-
+  
   append_error_msg = "netcdf_write_data_0d: file:"//trim(fileobj%path)//" variable: "//trim(variable_name)
-  if (fileobj%is_root) then
+  !if (fileobj%is_root) then !--- pio write routines are to be called by all PEs and not just root PE. 
     c(:) = 1
     if (present(corner)) then
       c(1) = corner
@@ -68,14 +66,15 @@ subroutine netcdf_write_data_0d(fileobj, variable_name, variable_data, unlim_dim
     varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
     select type(variable_data)
       type is (integer(kind=i4_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c)
+        err = pio_put_var(fileobj%file_desc, varid, variable_data)
       type is (integer(kind=i8_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c)
+        call error(trim(fileobj%path)//": 64 bit integers are not supported with PIO.")
       type is (real(kind=r4_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c)
+        err = pio_put_var(fileobj%file_desc, varid, variable_data)
       type is (real(kind=r8_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c)
+        err = pio_put_var(fileobj%file_desc, varid, variable_data)
       type is (character(len=*))
+        call error(trim(fileobj%path)//": character write not implemented yet (netcdf_write_data.inc)")
         ndims = get_variable_num_dimensions(fileobj, variable_name, broadcast=.false.)
         if (ndims .ne. 1) then
           call error("currently only scalar and 1d character writes are supported: "//trim(append_error_msg))
@@ -101,7 +100,8 @@ subroutine netcdf_write_data_0d(fileobj, variable_name, variable_data, unlim_dim
         call error("Unsupported variable type: "//trim(append_error_msg))
     end select
     call check_netcdf_code(err, append_error_msg)
-  endif
+  !endif
+  print*, "dbg-wrote0d ", trim(variable_name)
 end subroutine netcdf_write_data_0d
 
 
@@ -137,11 +137,9 @@ subroutine netcdf_write_data_1d(fileobj, variable_name, variable_data, unlim_dim
   integer :: tlen
   character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
 
-  print *, "ERRORline", 140, "write_data.inc"; call error("PIO version not implemented!!!")
-
   append_error_msg = "netcdf_write_data_1d: file:"//trim(fileobj%path)//" variable: "//trim(variable_name)
 
-  if (fileobj%is_root) then
+  !if (fileobj%is_root) then !--- pio write routines are to be called by all PEs and not just root PE. 
     c(:) = 1
     if (present(corner)) then
       c(1:1) = corner(:)
@@ -164,14 +162,15 @@ subroutine netcdf_write_data_1d(fileobj, variable_name, variable_data, unlim_dim
     varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
     select type(variable_data)
       type is (integer(kind=i4_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c, count=e)
+        err = pio_put_var(fileobj%file_desc, varid, variable_data(c(1):e(1)))
       type is (integer(kind=i8_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c, count=e)
+        call error(trim(fileobj%path)//": 64 bit integers are not supported with PIO.")
       type is (real(kind=r4_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c, count=e)
+        err = pio_put_var(fileobj%file_desc, varid, variable_data(c(1):e(1)))
       type is (real(kind=r8_kind))
-        err = nf90_put_var(fileobj%ncid, varid, variable_data, start=c, count=e)
+        err = pio_put_var(fileobj%file_desc, varid, variable_data(c(1):e(1)))
       type is (character(len=*))
+        call error(trim(fileobj%path)//": character write not implemented yet (netcdf_write_data.inc)")
         ndims = get_variable_num_dimensions(fileobj, variable_name, broadcast=.false.)
         if (ndims .ne. 2) then
           call error("currently only scalar and 1d character writes are supported: "//trim(append_error_msg))
@@ -203,7 +202,7 @@ subroutine netcdf_write_data_1d(fileobj, variable_name, variable_data, unlim_dim
         call error("Unsupported variable type: "//trim(append_error_msg))
     end select
     call check_netcdf_code(err, append_error_msg)
-  endif
+  !endif
 end subroutine netcdf_write_data_1d
 
 

fms2_pio_io/netcdf_io.F90

@@ -256,6 +256,7 @@ module netcdf_io_mod
 public :: write_restart_bc
 public :: read_restart_bc
 public :: flush_file
+public :: ncid_handled_by_pio
 
 !> @ingroup netcdf_io_mod
 interface netcdf_add_restart_variable
@@ -420,7 +421,7 @@ subroutine fms2_pio_init ()
   pio_numiotasks = 1
   pio_rearranger = 1 
   pio_root = 1
-  pio_stride = 32
+  pio_stride = 2
   pio_optbase = 1
   pio_log_level = 1
 
@@ -762,6 +763,21 @@ function netcdf_file_open_pio(fileobj, path, mode, nc_format, pelist, is_restart
 
   !Store properties in the derived type.
   call string_copy(fileobj%path, trim(buf2))
+  if (present(pelist)) then
+    if (size(pelist) /= mpp_npes()) then
+      call mpp_error(FATAL,'All processors must be assigned as FMS IO pes when PIO is active.'//&
+                           '(Note that the list of FMS IO PEs is different than PIO IO PEs '//&
+                           'which may be a subset of active processors.).')
+    endif
+    allocate(fileobj%pelist(size(pelist)))
+    fileobj%pelist(:) = pelist(:)
+  else
+    allocate(fileobj%pelist(1))
+    fileobj%pelist(1) = mpp_pe()
+  endif
+  fileobj%io_root = fileobj%pelist(1)
+  fileobj%is_root = mpp_pe() .eq. fileobj%io_root ! TODO: REMOVE all occurences of is_root (and io_root) 
+
   ! if passed, ignore pelist and do not store:
   ! - pelist, io_root, is_root
   fileobj%is_netcdf4 = .false.
@@ -1219,10 +1235,6 @@ subroutine netcdf_add_dimension(fileobj, dimension_name, dimension_length, &
     endif
   endif
 
-  if (trim(dimension_name) == "lath") then
-    print *, "dbglath"
-  endif
-
   call set_netcdf_mode(fileobj%ncid, define_mode)
   err = pio_def_dim(fileobj%ncid, trim(dimension_name), dim_len, dimid)
   call check_netcdf_code(err, "Netcdf_add_dimension: file:"//trim(fileobj%path)//" dimension name:"// &
@@ -1567,7 +1579,14 @@ function variable_att_exists(fileobj, variable_name, attribute_name, &
   integer :: varid
 
   if (ncid_handled_by_pio(fileobj%ncid)) then
-    print *, "ERRORline", __LINE__, trim(__FILE__); call error("PIO version not implemented!!!")
+    att_exists = .false.
+    varid = get_variable_id(fileobj%ncid, trim(variable_name), &
+            & msg="variable_att_exists: file:"//trim(fileobj%path)//"- variable:"//&
+            &trim(variable_name))
+    att_exists = attribute_exists(fileobj%ncid, varid, trim(attribute_name), &
+                 &msg="variable_att_exists: file:"//trim(fileobj%path)//" variable:"//trim(variable_name)//&
+                 &" attribute name:"//trim(attribute_name))
+    return
   endif
 
   att_exists = .false.
@@ -1605,7 +1624,9 @@ function get_num_dimensions(fileobj, broadcast) &
   integer :: err
 
   if (ncid_handled_by_pio(fileobj%ncid)) then
-    print *, "ERRORline", __LINE__, trim(__FILE__); call error("PIO version not implemented!!!")
+    err = pio_inquire(fileobj%ncid, nDimensions=ndims)
+    call check_netcdf_code(err, "get_num_dimensions: file:"//trim(fileobj%path))
+    return
   endif
 
   if (fileobj%is_root) then
@@ -1639,7 +1660,22 @@ subroutine get_dimension_names(fileobj, names, broadcast)
   integer :: err
 
   if (ncid_handled_by_pio(fileobj%ncid)) then
-    print *, "ERRORline", __LINE__, trim(__FILE__); call error("PIO version not implemented!!!")
+    ndims = get_num_dimensions(fileobj)
+    if (ndims .gt. 0) then
+      if (size(names) .ne. ndims) then
+        call error("'names' has to be the same size of the number of dimensions."&
+                   &" Check your get_dimension_names call for file "//trim(fileobj%path))
+      endif
+    else
+      call error("get_dimension_names: the file "//trim(fileobj%path)//" does not have any dimensions")
+    endif
+    names(:) = ""
+    do i = 1, ndims
+      err = pio_inquire_dimension(fileobj%ncid, i, name=names(i))
+      call check_netcdf_code(err, "get_dimension_names: file:"//trim(fileobj%path))
+    enddo
+
+    return
   endif
 
 
@@ -1753,7 +1789,14 @@ function is_dimension_unlimited(fileobj, dimension_name, broadcast) &
   integer :: ulim_dimid
 
   if (ncid_handled_by_pio(fileobj%ncid)) then
-    print *, "ERRORline", __LINE__, trim(__FILE__); call error("PIO version not implemented!!!")
+    append_error_msg="is_dimension_unlimited: file:"//trim(fileobj%path)//&
+                   & " dimension_name:"//trim(dimension_name)
+    dimid = get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
+    err = pio_inquire(fileobj%ncid, unlimitedDimId=ulim_dimid)
+    call check_netcdf_code(err, append_error_msg)
+    is_unlimited = dimid .eq. ulim_dimid
+
+    return
   endif
 
   if (fileobj%is_root) then
@@ -1940,30 +1983,6 @@ subroutine get_variable_names(fileobj, names, broadcast)
 end subroutine get_variable_names
 
 
-!> @brief Determine if a variable exists.
-!! @return Flag telling if the variable exists.
-function variable_exists_pio(fileobj, variable_name, broadcast) &
-  result(var_exists)
-
-  class(FmsNetcdfFile_t), intent(in) :: fileobj !< File object.
-  character(len=*), intent(in) :: variable_name !< Variable name.
-  logical, intent(in), optional :: broadcast !< Flag controlling whether or
-                                             !! not the data will be
-                                             !! broadcasted to non
-                                             !! "I/O root" ranks.
-                                             !! The broadcast will be done
-                                             !! by default.
-  logical :: var_exists
-
-  integer :: varid
-
-  varid = get_variable_id(fileobj%ncid, trim(variable_name), &
-                          msg="variable_exists: file:"//trim(fileobj%path)//" variable:"//trim(variable_name), &
-                          allow_failure=.true.)
-  var_exists = varid .ne. variable_missing
-end function variable_exists_pio
-
-
 !> @brief Determine if a variable exists.
 !! @return Flag telling if the variable exists.
 function variable_exists(fileobj, variable_name, broadcast) &
@@ -1982,7 +2001,9 @@ function variable_exists(fileobj, variable_name, broadcast) &
   integer :: varid
 
   if (ncid_handled_by_pio(fileobj%ncid)) then
-    varid = variable_exists_pio(fileobj, variable_name, broadcast)
+    varid = get_variable_id(fileobj%ncid, trim(variable_name), &
+                          msg="variable_exists: file:"//trim(fileobj%path)//" variable:"//trim(variable_name), &
+                          allow_failure=.true.)
     var_exists = varid .ne. variable_missing
     return
   endif