From 85ab319efe86c3105fda6ed1d11f54194aaf34b2 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 05:40:38 -0600 Subject: [PATCH 01/10] moving to use of iosysid --- src/flib/ncint_mod.F90 | 8 +++++--- tests/fncint/ftst_pio.f90 | 4 ++-- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/flib/ncint_mod.F90 b/src/flib/ncint_mod.F90 index a374e27b274..8e9ca1ceca3 100644 --- a/src/flib/ncint_mod.F90 +++ b/src/flib/ncint_mod.F90 @@ -170,11 +170,11 @@ 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(:) @@ -182,8 +182,10 @@ function nf_def_decomp(iosystem, basepiotype, dims, compdof, & 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 diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 33017692713..b45b421d84f 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -15,7 +15,7 @@ program ftst_pio parameter (FILE_NAME='ftst_pio.nc') integer(kind=PIO_OFFSET_KIND), dimension(3) :: data_buffer, compdof integer, dimension(1) :: dims - integer :: decompid + integer :: decompid, iosysid integer :: ierr ! Set up MPI. @@ -34,7 +34,7 @@ program ftst_pio ! 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) + ierr = nf_def_decomp(ioSystem%iosysid, PIO_int, dims, compdof, decompid) ! Create a file. ierr = nf_create(FILE_NAME, 64, ncid) From 55424080f3f7de26d47da9d5b84804fac68e9568 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 05:45:31 -0600 Subject: [PATCH 02/10] moving to use of iosysid --- src/flib/ncint_mod.F90 | 11 ++++++----- tests/fncint/ftst_pio.f90 | 4 ++-- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/flib/ncint_mod.F90 b/src/flib/ncint_mod.F90 index 8e9ca1ceca3..f21b385d790 100644 --- a/src/flib/ncint_mod.F90 +++ b/src/flib/ncint_mod.F90 @@ -48,15 +48,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 +65,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 +82,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 diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index b45b421d84f..2ee37c2348a 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -29,12 +29,12 @@ program ftst_pio ! Define an IOSystem. ierr = nf_def_iosystem(myRank, MPI_COMM_WORLD, niotasks, numAggregator, & - stride, PIO_rearr_subset, ioSystem, base) + stride, PIO_rearr_subset, iosysid, base) ! 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%iosysid, PIO_int, dims, compdof, decompid) + ierr = nf_def_decomp(iosysid, PIO_int, dims, compdof, decompid) ! Create a file. ierr = nf_create(FILE_NAME, 64, ncid) From b20cbf24c55c596d3fc149c1c25d443f85cf0473 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 06:05:04 -0600 Subject: [PATCH 03/10] better error handling --- tests/fncint/ftst_pio.f90 | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 2ee37c2348a..9f1a970a571 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -1,5 +1,7 @@ !> 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 @@ -8,14 +10,21 @@ program ftst_pio include 'netcdf.inc' integer :: myRank, ntasks - type(iosystem_desc_t) :: ioSystem 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 + parameter (FILE_NAME = 'ftst_pio.nc') + integer(kind = PIO_OFFSET_KIND), dimension(3) :: data_buffer, compdof integer, dimension(1) :: dims + integer, dimension(3) :: var_dims integer :: decompid, iosysid + integer :: NDIMS, NRECS + parameter (NDIMS = 4, NRECS = 2) + integer NLATS, NLONS + parameter (NLATS = 6, NLONS = 12) + character*(*) LAT_NAME, LON_NAME, REC_NAME + parameter (LAT_NAME = 'latitude', LON_NAME = 'longitude', REC_NAME = 'time') + integer :: lon_dimid, lat_dimid, rec_dimid integer :: ierr ! Set up MPI. @@ -26,6 +35,7 @@ program ftst_pio ! 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, & @@ -39,6 +49,11 @@ program ftst_pio ! Create a file. ierr = nf_create(FILE_NAME, 64, ncid) + ! Define dimensions. + ierr = nf_def_dim(ncid, LAT_NAME, NLATS, lat_dimid) + ierr = nf_def_dim(ncid, LON_NAME, NLONS, lon_dimid) + ierr = nf_def_dim(ncid, REC_NAME, NF_UNLIMITED, rec_dimid) + data_buffer = myRank ! Close the file. @@ -54,3 +69,12 @@ program ftst_pio 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 From 8619790ba9d70080c173526baf3ce129cfea1c2f Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 06:05:25 -0600 Subject: [PATCH 04/10] better error handling --- tests/fncint/ftst_pio.f90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 9f1a970a571..0709f8e3c69 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -40,28 +40,37 @@ program ftst_pio ! Define an IOSystem. ierr = nf_def_iosystem(myRank, 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(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, NLATS, lat_dimid) + if (ierr .ne. nf_noerr) call handle_err(ierr) ierr = nf_def_dim(ncid, LON_NAME, NLONS, lon_dimid) + if (ierr .ne. nf_noerr) call handle_err(ierr) ierr = nf_def_dim(ncid, REC_NAME, NF_UNLIMITED, rec_dimid) + if (ierr .ne. nf_noerr) call handle_err(ierr) data_buffer = myRank ! 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) ! We're done! call MPI_Finalize(ierr) From 041316ba40b5e76cfa93eaff483704eac6bb6e94 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 06:14:24 -0600 Subject: [PATCH 05/10] further improvement of test - now adding dims and var --- tests/fncint/ftst_pio.f90 | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 0709f8e3c69..9c899051ce0 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -9,22 +9,20 @@ program ftst_pio include 'mpif.h' include 'netcdf.inc' + character*(*) FILE_NAME + parameter (FILE_NAME = 'ftst_pio.nc') + integer :: NDIM3 = 3, NRECS = 2, NLAT = 6, NLON = 12 + 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 :: myRank, 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, dimension(3) :: var_dims + integer, dimension(3) :: var_dim integer :: decompid, iosysid - integer :: NDIMS, NRECS - parameter (NDIMS = 4, NRECS = 2) - integer NLATS, NLONS - parameter (NLATS = 6, NLONS = 12) - character*(*) LAT_NAME, LON_NAME, REC_NAME - parameter (LAT_NAME = 'latitude', LON_NAME = 'longitude', REC_NAME = 'time') - integer :: lon_dimid, lat_dimid, rec_dimid + integer :: varid integer :: ierr ! Set up MPI. @@ -53,15 +51,23 @@ program ftst_pio if (ierr .ne. nf_noerr) call handle_err(ierr) ! Define dimensions. - ierr = nf_def_dim(ncid, LAT_NAME, NLATS, lat_dimid) + 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, NLONS, lon_dimid) + 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, rec_dimid) + 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_REAL, 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 + ! Close the file. ierr = nf_close(ncid) if (ierr .ne. nf_noerr) call handle_err(ierr) From a8d20406ecf6a68d54403c065e5d6125b651d0b0 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 06:40:05 -0600 Subject: [PATCH 06/10] further test development --- tests/fncint/ftst_pio.f90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 9c899051ce0..8a808e027a9 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -11,15 +11,16 @@ program ftst_pio character*(*) FILE_NAME parameter (FILE_NAME = 'ftst_pio.nc') - integer :: NDIM3 = 3, NRECS = 2, NLAT = 6, NLON = 12 + 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 :: myRank, ntasks integer :: niotasks = 1, numAggregator = 0, stride = 1, base = 0 integer :: ncid - integer(kind = PIO_OFFSET_KIND), dimension(3) :: data_buffer, compdof - integer, dimension(1) :: dims + integer(kind = PIO_OFFSET_KIND), dimension(3) :: data_buffer + integer(kind = PIO_OFFSET_KIND), dimension(1) :: compdof + integer, dimension(2) :: dims integer, dimension(3) :: var_dim integer :: decompid, iosysid integer :: varid @@ -40,9 +41,10 @@ program ftst_pio 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 + ! Define a 2D decomposition. + dims(1) = NLAT / ntasks + dims(2) = NLON / ntasks + compdof(1) = myRank ierr = nf_def_decomp(iosysid, PIO_int, dims, compdof, decompid) if (ierr .ne. nf_noerr) call handle_err(ierr) From 3279fd0572ba03f64fd24be7886e17756d59d77b Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 11:57:09 -0600 Subject: [PATCH 07/10] test development --- tests/fncint/ftst_pio.f90 | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 8a808e027a9..e448a7add29 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -15,20 +15,21 @@ program ftst_pio 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 :: myRank, ntasks + integer :: my_rank, ntasks integer :: niotasks = 1, numAggregator = 0, stride = 1, base = 0 integer :: ncid integer(kind = PIO_OFFSET_KIND), dimension(3) :: data_buffer - integer(kind = PIO_OFFSET_KIND), dimension(1) :: compdof + integer(kind = PIO_OFFSET_KIND), dimension(:), allocatable :: compdof integer, dimension(2) :: dims integer, dimension(3) :: var_dim + integer :: maplen integer :: decompid, iosysid - integer :: varid + 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. @@ -37,14 +38,18 @@ program ftst_pio if (ierr .ne. nf_noerr) call handle_err(ierr) ! Define an IOSystem. - ierr = nf_def_iosystem(myRank, MPI_COMM_WORLD, niotasks, numAggregator, & + 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 2D decomposition. dims(1) = NLAT / ntasks dims(2) = NLON / ntasks - compdof(1) = myRank + maplen = dims(1) * dims(2) + allocate(compdof(maplen)) + do i = 1, maplen + compdof(i) = i + (my_rank - 1) * maplen + end do ierr = nf_def_decomp(iosysid, PIO_int, dims, compdof, decompid) if (ierr .ne. nf_noerr) call handle_err(ierr) @@ -67,7 +72,7 @@ program ftst_pio ierr = nf_enddef(ncid) if (ierr .ne. nf_noerr) call handle_err(ierr) - data_buffer = myRank + data_buffer = my_rank ! Close the file. @@ -82,7 +87,7 @@ program ftst_pio ! 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 From 47a4e5e8cc01031127314ae31eac8a52c1f1607e Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 12:55:39 -0600 Subject: [PATCH 08/10] starting to add first vard --- src/flib/ncint_mod.F90 | 36 ++++++++++++++++++++++++++++++++++++ src/ncint/nc_put_vard.c | 38 +++++++++++++++++++------------------- tests/fncint/ftst_pio.f90 | 9 +++++---- 3 files changed, 60 insertions(+), 23 deletions(-) diff --git a/src/flib/ncint_mod.F90 b/src/flib/ncint_mod.F90 index f21b385d790..f16da84155e 100644 --- a/src/flib/ncint_mod.F90 +++ b/src/flib/ncint_mod.F90 @@ -194,4 +194,40 @@ function nf_def_decomp(iosysid, basepiotype, dims, compdof, & 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_int):: ierr + integer:: status + + interface + function nc_put_vard_int(ncid, varid, decompid, recnum, op) bind(c) + use iso_c_binding + integer(c_int), value, intent(in) :: ncid, varid, decompid + integer(c_int64_t), value, intent(in) :: recnum + integer(c_int), intent(in) :: op(*) + integer(c_int) :: nc_put_vard_int + end function nc_put_vard_int + end interface + + status = 0 + end function nf_put_vard_int + end module ncint_mod diff --git a/src/ncint/nc_put_vard.c b/src/ncint/nc_put_vard.c index f90f67d2f4b..1c2eadf7225 100644 --- a/src/ncint/nc_put_vard.c +++ b/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 #include #include @@ -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); } diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index e448a7add29..e4cd28ee946 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -18,8 +18,8 @@ program ftst_pio integer :: my_rank, ntasks integer :: niotasks = 1, numAggregator = 0, stride = 1, base = 0 integer :: ncid - integer(kind = PIO_OFFSET_KIND), dimension(3) :: data_buffer integer(kind = PIO_OFFSET_KIND), dimension(:), allocatable :: compdof + integer, dimension(:), allocatable :: data_buffer integer, dimension(2) :: dims integer, dimension(3) :: var_dim integer :: maplen @@ -47,8 +47,10 @@ program ftst_pio dims(2) = NLON / ntasks maplen = dims(1) * dims(2) allocate(compdof(maplen)) + allocate(data_buffer(maplen)) do i = 1, maplen compdof(i) = i + (my_rank - 1) * maplen + data_buffer(i) = (my_rank - 1) * 10 + i end do ierr = nf_def_decomp(iosysid, PIO_int, dims, compdof, decompid) if (ierr .ne. nf_noerr) call handle_err(ierr) @@ -72,9 +74,6 @@ program ftst_pio ierr = nf_enddef(ncid) if (ierr .ne. nf_noerr) call handle_err(ierr) - data_buffer = my_rank - - ! Close the file. ierr = nf_close(ncid) if (ierr .ne. nf_noerr) call handle_err(ierr) @@ -84,6 +83,8 @@ program ftst_pio 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) From 21bced8faf547614d0ca8b7a4bb76f50a900980f Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Fri, 19 Jul 2019 13:05:54 -0600 Subject: [PATCH 09/10] getting darray write working --- src/flib/ncint_mod.F90 | 12 ++++++++---- src/flib/pio.F90 | 2 +- tests/fncint/ftst_pio.f90 | 7 +++++-- 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/flib/ncint_mod.F90 b/src/flib/ncint_mod.F90 index f16da84155e..b94e5ade0dc 100644 --- a/src/flib/ncint_mod.F90 +++ b/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 @@ -214,20 +215,23 @@ 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, recnum, op) bind(c) + 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) :: recnum + 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 - status = 0 + 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 diff --git a/src/flib/pio.F90 b/src/flib/pio.F90 index 943119408c9..19bf75cec78 100644 --- a/src/flib/pio.F90 +++ b/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, & diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index e4cd28ee946..6d4bb14d778 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -68,12 +68,15 @@ program ftst_pio if (ierr .ne. nf_noerr) call handle_err(ierr) ! Define a data variable. - ierr = nf_def_var(ncid, VAR_NAME, NF_REAL, NDIM3, var_dim, varid) + 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) + ! 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) From 9f975e93b0de21a79eab0d9a35a4be01eb53798e Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Mon, 22 Jul 2019 08:49:38 -0600 Subject: [PATCH 10/10] working on vard --- tests/fncint/Makefile.am | 3 +- tests/fncint/ftst_pio.f90 | 15 +++-- tests/fncint/ftst_pio_orig.f90 | 118 +++++++++++++++++++++++++++++++++ tests/fncint/run_tests.sh | 3 +- 4 files changed, 133 insertions(+), 6 deletions(-) create mode 100644 tests/fncint/ftst_pio_orig.f90 diff --git a/tests/fncint/Makefile.am b/tests/fncint/Makefile.am index 3cc3d3df955..98783787800 100644 --- a/tests/fncint/Makefile.am +++ b/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. diff --git a/tests/fncint/ftst_pio.f90 b/tests/fncint/ftst_pio.f90 index 6d4bb14d778..2406a4d2cf0 100644 --- a/tests/fncint/ftst_pio.f90 +++ b/tests/fncint/ftst_pio.f90 @@ -43,15 +43,22 @@ program ftst_pio if (ierr .ne. nf_noerr) call handle_err(ierr) ! Define a 2D decomposition. - dims(1) = NLAT / ntasks - dims(2) = NLON / ntasks + 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 - 1) * maplen - data_buffer(i) = (my_rank - 1) * 10 + i + 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) diff --git a/tests/fncint/ftst_pio_orig.f90 b/tests/fncint/ftst_pio_orig.f90 new file mode 100644 index 00000000000..c6b780b8122 --- /dev/null +++ b/tests/fncint/ftst_pio_orig.f90 @@ -0,0 +1,118 @@ +!> 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' + + 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 + integer, dimension(:), allocatable :: compdof + integer, dimension(:), allocatable :: data_buffer + integer, dimension(2) :: dims + integer, dimension(3) :: var_dim + type(iosystem_desc_t) :: ioSystem + type(io_desc_t) :: iodesc + integer :: maplen + integer :: decompid, iosysid + integer :: varid, i + integer :: ierr + + ! Set up MPI. + call MPI_Init(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. + call PIO_init(my_rank, MPI_COMM_WORLD, niotasks, numAggregator, stride, & + PIO_rearr_subset, ioSystem, base=base) + + ! 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 + +! call PIO_initdecomp(ioSystem, PIO_int, maplen, compdof, iodesc) + + + ! 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) + + ! ! 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) + deallocate(compdof) + deallocate(data_buffer) +! call PIO_freedecomp(ioSystem, iodesc) + call pio_finalize(ioSystem, ierr) + + ! We're done! + call MPI_Finalize(ierr) + 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 diff --git a/tests/fncint/run_tests.sh b/tests/fncint/run_tests.sh index fbe296e54a9..774fdcd7aa2 100755 --- a/tests/fncint/run_tests.sh +++ b/tests/fncint/run_tests.sh @@ -10,7 +10,8 @@ trap exit INT TERM printf 'running Fortran tests for PIO netCDF integration...\n' -PIO_TESTS='ftst_pio' +#PIO_TESTS='ftst_pio_orig ftst_pio' +PIO_TESTS='ftst_pio_orig' success1=true for TEST in $PIO_TESTS