Merge pull request ESMCI#1571 from NCAR/ejh_fncint_more_2

starting to get nf_put_vard_* functions working

src/flib/ncint_mod.F90

@@ -29,7 +29,8 @@ module ncint_mod
   include 'mpif.h'    ! _EXTERNAL
 #endif
 
-  public :: nf_def_iosystem, nf_free_iosystem, nf_def_decomp, nf_free_decomp
+  public :: nf_def_iosystem, nf_free_iosystem, nf_def_decomp, nf_free_decomp, &
+       nf_put_vard_int
 
 contains
 
@@ -48,15 +49,14 @@ module ncint_mod
   !! @param num_aggregator the mpi aggregator count
   !! @param stride the stride in the mpi rank between io tasks.
   !! @param rearr @copydoc PIO_rearr_method
-  !! @param iosystem a derived type which can be used in subsequent
-  !! pio operations (defined in PIO_types).
+  !! @param iosysid the ID of the IOSystem.
   !! @param base @em optional argument can be used to offset the first
   !! io task - default base is task 1.
   !! @param rearr_opts the rearranger options.
   !! @author Ed Hartnett
   !<
   function nf_def_iosystem(comp_rank, comp_comm, num_iotasks, &
-       num_aggregator, stride,  rearr, iosystem, base, rearr_opts) result(ierr)
+       num_aggregator, stride,  rearr, iosysid, base, rearr_opts) result(ierr)
     use pio_types, only : pio_internal_error, pio_rearr_opt_t
     use iso_c_binding
 
@@ -66,9 +66,10 @@ function nf_def_iosystem(comp_rank, comp_comm, num_iotasks, &
     integer(i4), intent(in) :: num_aggregator
     integer(i4), intent(in) :: stride
     integer(i4), intent(in) :: rearr
-    type (iosystem_desc_t), intent(out)  :: iosystem  ! io descriptor to initalize
+    integer(i4), intent(out) :: iosysid
     integer(i4), intent(in),optional :: base
     type (pio_rearr_opt_t), intent(in), optional :: rearr_opts
+    type (iosystem_desc_t) :: iosystem
     integer :: ierr
 
     interface
@@ -82,7 +83,8 @@ end function nc_set_iosystem
     call PIO_init(comp_rank, comp_comm, num_iotasks, num_aggregator, &
          stride, rearr, iosystem, base, rearr_opts)
 
-    ierr = nc_set_iosystem(iosystem%iosysid)
+    iosysid = iosystem%iosysid
+    ierr = nc_set_iosystem(iosysid)
 
   end function nf_def_iosystem
 
@@ -170,25 +172,66 @@ end function nf_free_decomp
   !! @param compcount The count for the block-cyclic computational
   !! decomposition
   !! @param iodesc @copydoc iodesc_generate
-  !! @author Jim Edwards
+  !! @author Ed Hartnett
   !<
-  function nf_def_decomp(iosystem, basepiotype, dims, compdof, &
+  function nf_def_decomp(iosysid, basepiotype, dims, compdof, &
        decompid, rearr, iostart, iocount) result(status)
-    type (iosystem_desc_t), intent(in) :: iosystem
+    integer(i4), intent(in) :: iosysid
     integer(i4), intent(in) :: basepiotype
     integer(i4), intent(in) :: dims(:)
     integer (PIO_OFFSET_KIND), intent(in) :: compdof(:)
     integer, optional, target :: rearr
     integer (PIO_OFFSET_KIND), optional :: iostart(:), iocount(:)
     integer(i4), intent(inout) :: decompid
     type (io_desc_t) :: iodesc
+    type (iosystem_desc_t) :: iosystem
     integer :: status
 
+    iosystem%iosysid = iosysid
     call PIO_initdecomp(iosystem, basepiotype, dims, compdof, &
          iodesc, rearr, iostart, iocount)
     decompid = iodesc%ioid
 
     status = 0
   end function nf_def_decomp
 
+  !>
+  !! @public
+  !! @ingroup ncint
+  !! Put distributed array subset of an integer variable.
+  !!
+  !! This routine is called collectively by all tasks in the
+  !! communicator ios.union_comm.
+  !!
+  !! @param ncid identifies the netCDF file
+  !! @param varid the variable ID number
+  !! @param decompid the decomposition ID.
+  !! @param recnum the record number.
+  !! @param op pointer to the data to be written.
+  !! @return PIO_NOERR on success, error code otherwise.
+  !! @author Ed Hartnett
+  !<
+  function nf_put_vard_int(ncid, varid, decompid, recnum, ivals) result(status)
+    use iso_c_binding
+    integer, intent(in):: ncid, varid, decompid, recnum
+    integer, intent(in):: ivals(*)
+    integer(c_int64_t):: lrecnum
+    integer(c_int):: ierr
+    integer:: status
+
+    interface
+       function nc_put_vard_int(ncid, varid, decompid, lrecnum, op) bind(c)
+         use iso_c_binding
+         integer(c_int), value, intent(in) :: ncid, varid, decompid
+         integer(c_int64_t), value, intent(in) :: lrecnum
+         integer(c_int), intent(in) :: op(*)
+         integer(c_int) :: nc_put_vard_int
+       end function nc_put_vard_int
+    end interface
+
+    lrecnum = recnum - 1 ! c functions are 0-based
+    ierr = nc_put_vard_int(ncid, varid - 1, decompid, lrecnum, ivals)
+    status = ierr
+  end function nf_put_vard_int
+
   end module ncint_mod

src/flib/pio.F90

@@ -26,7 +26,7 @@ module pio
 
 #ifdef NETCDF_INTEGRATION
   use ncint_mod, only: nf_def_iosystem, nf_free_iosystem, &
-       nf_def_decomp, nf_free_decomp
+       nf_def_decomp, nf_free_decomp, nf_put_vard_int
 #endif
 
   use pio_types, only : io_desc_t, file_desc_t, var_desc_t, iosystem_desc_t, &

src/ncint/nc_put_vard.c

@@ -1,11 +1,11 @@
 /**
-  * @file
-  * PIO functions to write data with distributed arrays.
-  *
-  * @author Ed Hartnett
-  * @date 2019
-  * @see https://github.com/NCAR/ParallelIO
-  */
+ * @file
+ * PIO functions to write data with distributed arrays.
+ *
+ * @author Ed Hartnett
+ * @date 2019
+ * @see https://github.com/NCAR/ParallelIO
+ */
 #include <config.h>
 #include <pio.h>
 #include <pio_internal.h>
@@ -32,7 +32,7 @@
  */
 int
 nc_put_vard_text(int ncid, int varid, int decompid, const size_t recnum,
-                   const char *op)
+                 const char *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_CHAR, op);
 }
@@ -53,7 +53,7 @@ nc_put_vard_text(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_uchar(int ncid, int varid, int decompid, const size_t recnum,
-                    const unsigned char *op)
+                  const unsigned char *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_UBYTE, op);
 }
@@ -74,7 +74,7 @@ nc_put_vard_uchar(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_schar(int ncid, int varid, int decompid, const size_t recnum,
-                    const signed char *op)
+                  const signed char *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_BYTE, op);
 }
@@ -96,7 +96,7 @@ nc_put_vard_schar(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_ushort(int ncid, int varid, int decompid, const size_t recnum,
-                     const unsigned short *op)
+                   const unsigned short *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_USHORT, op);
 }
@@ -117,7 +117,7 @@ nc_put_vard_ushort(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_short(int ncid, int varid, int decompid, const size_t recnum,
-                    const short *op)
+                  const short *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_SHORT, op);
 }
@@ -139,7 +139,7 @@ nc_put_vard_short(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_uint(int ncid, int varid, int decompid, const size_t recnum,
-                   const unsigned int *op)
+                 const unsigned int *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_UINT, op);
 }
@@ -160,7 +160,7 @@ nc_put_vard_uint(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_int(int ncid, int varid, int decompid, const size_t recnum,
-                  const int *op)
+                const int *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_INT, op);
 }
@@ -202,7 +202,7 @@ nc_put_vard_int(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_float(int ncid, int varid, int decompid, const size_t recnum,
-                    const float *op)
+                  const float *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_FLOAT, op);
 }
@@ -224,7 +224,7 @@ nc_put_vard_float(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_longlong(int ncid, int varid, int decompid, const size_t recnum,
-                       const long long *op)
+                     const long long *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_INT64, op);
 }
@@ -246,7 +246,7 @@ nc_put_vard_longlong(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_double(int ncid, int varid, int decompid, const size_t recnum,
-                     const double *op)
+                   const double *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_DOUBLE, op);
 }
@@ -268,7 +268,7 @@ nc_put_vard_double(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard_ulonglong(int ncid, int varid, int decompid, const size_t recnum,
-                        const unsigned long long *op)
+                      const unsigned long long *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_UINT64, op);
 }
@@ -289,7 +289,7 @@ nc_put_vard_ulonglong(int ncid, int varid, int decompid, const size_t recnum,
  */
 int
 nc_put_vard(int ncid, int varid, int decompid, const size_t recnum,
-              const void *op)
+            const void *op)
 {
     return PIOc_put_vard_tc(ncid, varid, decompid, recnum, NC_NAT, op);
 }

tests/fncint/Makefile.am

@@ -13,8 +13,9 @@ LDADD += -lnetcdff
 AM_FCFLAGS = -I${top_builddir}/src/flib ${CPPFLAGS}
 
 # Build the test for make check.
-check_PROGRAMS = ftst_pio
+check_PROGRAMS = ftst_pio ftst_pio_orig
 ftst_pio_SOURCES = ftst_pio.f90
+ftst_pio_orig_SOURCES = ftst_pio_orig.f90
 
 if RUN_TESTS
 # Tests will run from a bash script.

tests/fncint/ftst_pio.f90

@@ -1,56 +1,113 @@
 !> This is a test program for the Fortran API use of the netCDF
 !! integration layer.
+!!
+!! @author Ed Hartnett, 7/19/19
 
 program ftst_pio
   use pio
   implicit none
   include 'mpif.h'
   include 'netcdf.inc'
 
-  integer :: myRank, ntasks
-  type(iosystem_desc_t) :: ioSystem
+  character*(*) FILE_NAME
+  parameter (FILE_NAME = 'ftst_pio.nc')
+  integer :: NDIM3 = 3, NRECS = 2, NLAT = 4, NLON = 4
+  character*(*) LAT_NAME, LON_NAME, REC_NAME, VAR_NAME
+  parameter (LAT_NAME = 'latitude', LON_NAME = 'longitude', &
+       REC_NAME = 'time', VAR_NAME = 'some_data_var')
+  integer :: my_rank, ntasks
   integer :: niotasks = 1, numAggregator = 0, stride = 1, base = 0
   integer :: ncid
-  character*(*) FILE_NAME
-  parameter (FILE_NAME='ftst_pio.nc')
-  integer(kind=PIO_OFFSET_KIND), dimension(3) :: data_buffer, compdof
-  integer, dimension(1) :: dims
-  integer :: decompid
+  integer(kind = PIO_OFFSET_KIND), dimension(:), allocatable :: compdof
+  integer, dimension(:), allocatable :: data_buffer
+  integer, dimension(2) :: dims
+  integer, dimension(3) :: var_dim
+  integer :: maplen
+  integer :: decompid, iosysid
+  integer :: varid, i
   integer :: ierr
 
   ! Set up MPI.
   call MPI_Init(ierr)
-  call MPI_Comm_rank(MPI_COMM_WORLD, myRank, ierr)
+  call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierr)
   call MPI_Comm_size(MPI_COMM_WORLD, ntasks, ierr)
 
   ! These control logging in the PIO and netCDF libraries.
   ierr = pio_set_log_level(3)
   ierr = nf_set_log_level(2)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
 
   ! Define an IOSystem.
-  ierr = nf_def_iosystem(myRank, MPI_COMM_WORLD, niotasks, numAggregator, &
-       stride, PIO_rearr_subset, ioSystem, base)
+  ierr = nf_def_iosystem(my_rank, MPI_COMM_WORLD, niotasks, numAggregator, &
+       stride, PIO_rearr_subset, iosysid, base)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
 
-  ! Define a decomposition.
-  dims(1) = 3 * ntasks
-  compdof = 3 * myRank + (/1, 2, 3/)  ! Where in the global array each task writes
-  ierr = nf_def_decomp(ioSystem, PIO_int, dims, compdof, decompid)
+  ! Define a 2D decomposition.
+  dims(1) = NLAT * 2 / ntasks
+  dims(2) = NLON * 2 / ntasks
+  maplen = dims(1) * dims(2)
+  print *, 'dims: ', dims
+  print *, 'maplen: ', maplen
+  print *, 'my_rank: ', my_rank
+  allocate(compdof(maplen))
+  allocate(data_buffer(maplen))
+  ! Row decomposition. Recall that my_rank is 0-based, even
+  ! in fortran. Also recall that compdof is 1-based for fortran.
+  do i = 1, maplen
+     compdof(i) = i + my_rank * maplen
+     !data_buffer(i) = my_rank * 10 + i
+     data_buffer(i) = my_rank
+  end do
+  print *, 'compdof', my_rank, compdof
+  ierr = nf_def_decomp(iosysid, PIO_int, dims, compdof, decompid)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
 
   ! Create a file.
   ierr = nf_create(FILE_NAME, 64, ncid)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
+
+  ! Define dimensions.
+  ierr = nf_def_dim(ncid, LAT_NAME, NLAT, var_dim(1))
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
+  ierr = nf_def_dim(ncid, LON_NAME, NLON, var_dim(2))
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
+  ierr = nf_def_dim(ncid, REC_NAME, NF_UNLIMITED, var_dim(3))
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
+
+  ! Define a data variable.
+  ierr = nf_def_var(ncid, VAR_NAME, NF_INT, NDIM3, var_dim, varid)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
+  ierr = nf_enddef(ncid)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
 
-  data_buffer = myRank
+  ! Write 1st record with distributed arrays.
+  ierr = nf_put_vard_int(ncid, varid, decompid, 1, data_buffer)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
 
   ! Close the file.
   ierr = nf_close(ncid)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
 
   ! Free resources.
   ierr = nf_free_decomp(decompid)
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
   ierr = nf_free_iosystem()
+  if (ierr .ne. nf_noerr) call handle_err(ierr)
+  deallocate(compdof)
+  deallocate(data_buffer)
 
   ! We're done!
   call MPI_Finalize(ierr)
-  if (myRank .eq. 0) then
+  if (my_rank .eq. 0) then
      print *, '*** SUCCESS running ftst_pio!'
   endif
 end program ftst_pio
+
+subroutine handle_err(errcode)
+  implicit none
+  include 'netcdf.inc'
+  integer errcode
+
+  print *, 'Error: ', nf_strerror(errcode)
+  stop 2
+end subroutine handle_err