Skip to content

Commit

Permalink
Merge pull request ESMCI#1574 from NCAR/ejh_fortran_test_2
Browse files Browse the repository at this point in the history
now getting darray write working in fortran with netcdf integration
  • Loading branch information
edwardhartnett authored Jul 27, 2019
2 parents f067353 + bbe6927 commit cc5832b
Show file tree
Hide file tree
Showing 7 changed files with 189 additions and 73 deletions.
43 changes: 23 additions & 20 deletions src/clib/pio_darray_int.c
Original file line number Diff line number Diff line change
Expand Up @@ -1785,33 +1785,36 @@ flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize)
int request[reqcnt];
int status[reqcnt];

for (int i = 0; i <= maxreq; i++)
if (file->varlist)
{
if ((ierr = get_var_desc(i, &file->varlist, &vdesc)))
return pio_err(NULL, file, ierr, __FILE__, __LINE__);
#ifdef MPIO_ONESIDED
/*onesided optimization requires that all of the requests in a wait_all call represent
a contiguous block of data in the file */
if (rcnt > 0 && (prev_record != vdesc->record || vdesc->nreqs == 0))
for (int i = 0; i <= maxreq; i++)
{
ierr = ncmpi_wait_all(file->fh, rcnt, request, status);
rcnt = 0;
}
prev_record = vdesc->record;
if ((ierr = get_var_desc(i, &file->varlist, &vdesc)))
return pio_err(NULL, file, ierr, __FILE__, __LINE__);
#ifdef MPIO_ONESIDED
/*onesided optimization requires that all of the requests in a wait_all call represent
a contiguous block of data in the file */
if (rcnt > 0 && (prev_record != vdesc->record || vdesc->nreqs == 0))
{
ierr = ncmpi_wait_all(file->fh, rcnt, request, status);
rcnt = 0;
}
prev_record = vdesc->record;
#endif
for (reqcnt = 0; reqcnt < vdesc->nreqs; reqcnt++)
request[rcnt++] = max(vdesc->request[reqcnt], NC_REQ_NULL);
PLOG((3,"flush_output_buffer rcnt=%d",rcnt));
for (reqcnt = 0; reqcnt < vdesc->nreqs; reqcnt++)
request[rcnt++] = max(vdesc->request[reqcnt], NC_REQ_NULL);
PLOG((3,"flush_output_buffer rcnt=%d",rcnt));

if (vdesc->request != NULL)
free(vdesc->request);
vdesc->request = NULL;
vdesc->nreqs = 0;
if (vdesc->request != NULL)
free(vdesc->request);
vdesc->request = NULL;
vdesc->nreqs = 0;

#ifdef FLUSH_EVERY_VAR
ierr = ncmpi_wait_all(file->fh, rcnt, request, status);
rcnt = 0;
ierr = ncmpi_wait_all(file->fh, rcnt, request, status);
rcnt = 0;
#endif
}
}

if (rcnt > 0)
Expand Down
2 changes: 1 addition & 1 deletion src/flib/ncint_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -180,9 +180,9 @@ function nf_def_decomp(iosysid, basepiotype, dims, compdof, &
integer(i4), intent(in) :: basepiotype
integer(i4), intent(in) :: dims(:)
integer (PIO_OFFSET_KIND), intent(in) :: compdof(:)
integer(i4), intent(out) :: decompid
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
Expand Down
5 changes: 4 additions & 1 deletion tests/fncint/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,11 @@ LDADD += -lnetcdff
# Find the pio.mod file.
AM_FCFLAGS = -I${top_builddir}/src/flib ${CPPFLAGS}

# Find the pio.h and pio_tests.h file for the C test.
AM_CPPFLAGS = -I${top_srcdir}/src/clib -I${top_srcdir}/tests/cunit

# Build the test for make check.
check_PROGRAMS = ftst_pio ftst_pio_orig
check_PROGRAMS = ftst_pio ftst_pio_orig tst_c_pio
ftst_pio_SOURCES = ftst_pio.f90
ftst_pio_orig_SOURCES = ftst_pio_orig.f90

Expand Down
16 changes: 7 additions & 9 deletions tests/fncint/ftst_pio.f90
Original file line number Diff line number Diff line change
Expand Up @@ -33,19 +33,18 @@ program ftst_pio
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)
!ierr = pio_set_log_level(3)
!ierr = nf_set_log_level(2)

! Define an IOSystem.
ierr = nf_def_iosystem(my_rank, MPI_COMM_WORLD, niotasks, numAggregator, &
stride, PIO_rearr_subset, iosysid, base)
stride, PIO_rearr_box, iosysid, base)
if (ierr .ne. nf_noerr) call handle_err(ierr)

! Define a 2D decomposition.
dims(1) = NLAT * 2 / ntasks
dims(2) = NLON * 2 / ntasks
maplen = dims(1) * dims(2)
dims(1) = 4
dims(2) = 4
maplen = 4
print *, 'dims: ', dims
print *, 'maplen: ', maplen
print *, 'my_rank: ', my_rank
Expand All @@ -55,8 +54,7 @@ program ftst_pio
! 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
data_buffer(i) = my_rank * 10 + i
end do
print *, 'compdof', my_rank, compdof
ierr = nf_def_decomp(iosysid, PIO_int, dims, compdof, decompid)
Expand Down
74 changes: 35 additions & 39 deletions tests/fncint/ftst_pio_orig.f90
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ program ftst_pio
include 'netcdf.inc'

character*(*) FILE_NAME
parameter (FILE_NAME = 'ftst_pio.nc')
parameter (FILE_NAME = 'ftst_pio_orig.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', &
Expand All @@ -23,7 +23,10 @@ program ftst_pio
integer, dimension(2) :: dims
integer, dimension(3) :: var_dim
type(iosystem_desc_t) :: ioSystem
type(file_desc_t) :: pioFileDesc
type(io_desc_t) :: iodesc
type(var_desc_t) :: var
integer(kind=pio_offset_kind) :: recnum = 1
integer :: maplen
integer :: decompid, iosysid
integer :: varid, i
Expand All @@ -35,18 +38,17 @@ program ftst_pio
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)
! ierr = pio_set_log_level(3)
! ierr = nf_set_log_level(2)

! 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)
dims(1) = 4
dims(2) = 4
maplen = 4
print *, 'dims: ', dims
print *, 'maplen: ', maplen
print *, 'my_rank: ', my_rank
Expand All @@ -56,49 +58,43 @@ program ftst_pio
! 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
data_buffer(i) = my_rank * 10 + i
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)
call PIO_initdecomp(ioSystem, PIO_int, dims, compdof, iodesc)

! ! Create a file.
! ierr = nf_create(FILE_NAME, 64, ncid)
! if (ierr .ne. nf_noerr) call handle_err(ierr)
! Create a file.
ierr = PIO_createfile(ioSystem, pioFileDesc, PIO_IOTYPE_PNETCDF, FILE_NAME, PIO_clobber)
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 dimensions.
ierr = PIO_def_dim(pioFileDesc%fh, LAT_NAME, NLAT, var_dim(1))
if (ierr .ne. nf_noerr) call handle_err(ierr)
ierr = PIO_def_dim(pioFileDesc%fh, LON_NAME, NLON, var_dim(2))
if (ierr .ne. nf_noerr) call handle_err(ierr)
ierr = PIO_def_dim(pioFileDesc%fh, 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)
! Define a data variable.
ierr = PIO_def_var(pioFileDesc, VAR_NAME, NF_INT, var_dim, var)
if (ierr .ne. nf_noerr) call handle_err(ierr)
ierr = PIO_enddef(pioFileDesc%fh)
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)
! Write 1st record with distributed arrays.
call PIO_setframe(pioFileDesc, var, recnum)
call PIO_write_darray(pioFileDesc, var, iodesc, data_buffer, ierr)
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)
! Close the file.
call PIO_closefile(pioFileDesc)
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)
! Free resources.
deallocate(compdof)
deallocate(data_buffer)
! call PIO_freedecomp(ioSystem, iodesc)
call PIO_freedecomp(ioSystem, iodesc)
call pio_finalize(ioSystem, ierr)

! We're done!
Expand Down
4 changes: 1 addition & 3 deletions tests/fncint/run_tests.sh
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,7 @@ set -e
trap exit INT TERM

printf 'running Fortran tests for PIO netCDF integration...\n'

#PIO_TESTS='ftst_pio_orig ftst_pio'
PIO_TESTS='ftst_pio_orig'
PIO_TESTS='tst_c_pio ftst_pio_orig ftst_pio'

success1=true
for TEST in $PIO_TESTS
Expand Down
118 changes: 118 additions & 0 deletions tests/fncint/tst_c_pio.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,118 @@
/* This program does a very simple I/O system and decomposition, and
* writes a simple file.
Ed Hartnett, 7/27/19
*/

#include "config.h"
#include <pio.h>
#include <mpi.h>
#include <pio_tests.h>
#include <pio_internal.h>

#define FILE_NAME "tst_c_pio.nc"
#define VAR_NAME "data_var"
#define DIM_NAME_UNLIMITED "dim_unlimited"
#define DIM_NAME_X "dim_x"
#define DIM_NAME_Y "dim_y"
#define DIM_LEN_X 4
#define DIM_LEN_Y 4
#define NDIM2 2
#define NDIM3 3
#define LLEN 4
#define MPI_ERR 999
#define NTASKS4 4

int
main(int argc, char **argv)
{
int my_rank;
int ntasks;

/* Initialize MPI. */
if (MPI_Init(&argc, &argv))
return MPI_ERR;

/* Learn my rank and the total number of processors. */
if (MPI_Comm_rank(MPI_COMM_WORLD, &my_rank))
return MPI_ERR;
if (MPI_Comm_size(MPI_COMM_WORLD, &ntasks))
return MPI_ERR;
/* Must run on 4 tasks only. */
if (ntasks != NTASKS4)
return MPI_ERR;

if (!my_rank)
{
printf("\n*** Testing simple use of PIO.\n");
printf("*** testing creating of simple file...");
}
{
int iosysid;
int ncid;
int dimid[NDIM3];
int varid;
int ioid;
int dimlen[NDIM3] = {NC_UNLIMITED, DIM_LEN_X, DIM_LEN_Y};
char dimname[NDIM3][NC_MAX_NAME + 1] = {DIM_NAME_UNLIMITED, DIM_NAME_X, DIM_NAME_Y};
int iotype = PIO_IOTYPE_NETCDF;
int my_data[LLEN];
PIO_Offset compmap[LLEN];
int i;
int ret;

/* PIOc_set_log_level(3); */

/* Initialize local data. */
for (i = 0; i < LLEN; i++)
my_data[i] = my_rank * 10 + i;

/* Initialize the IOSystem. */
if ((ret = PIOc_Init_Intracomm(MPI_COMM_WORLD, 1, 1, 0, 0, &iosysid)))
return ret;

/* Create a file. */
if ((ret = PIOc_createfile(iosysid, &ncid, &iotype, FILE_NAME, 0)))
return ret;

/* Define metadata. */
for (i = 0; i < NDIM3; i++)
if ((ret = PIOc_def_dim(ncid, dimname[i], dimlen[i], &dimid[i])))
return ret;
if ((ret = PIOc_def_var(ncid, VAR_NAME, PIO_INT, NDIM3, dimid, &varid)))
return ret;
if ((ret = PIOc_enddef(ncid)))
return ret;

/* Create the decomposition. */
for (i = 0; i < LLEN; i++)
compmap[i] = i + my_rank * LLEN;
if ((ret = PIOc_init_decomp(iosysid, PIO_INT, NDIM2, &dimlen[1], LLEN, compmap,
&ioid, PIO_REARR_BOX, NULL, NULL)))
return ret;

/* Write data. */
if ((ret = PIOc_setframe(ncid, varid, 0)))
return ret;
if ((ret = PIOc_write_darray(ncid, varid, ioid, LLEN, my_data, NULL)))
return ret;

/* Close the file. */
if ((ret = PIOc_closefile(ncid)))
return ret;

/* Free the decomposition. */
if ((ret = PIOc_freedecomp(iosysid, ioid)))
return ret;

/* Free the IOSystem. */
if ((ret = PIOc_free_iosystem(iosysid)))
return ret;
}

if (!my_rank)
printf("\nSUCCESS!\n");
/* Finalize MPI. */
MPI_Finalize();
return 0;
}

0 comments on commit cc5832b

Please sign in to comment.