diff --git a/.gitignore b/.gitignore index eca734371d..5055b0c6a8 100644 --- a/.gitignore +++ b/.gitignore @@ -29,3 +29,4 @@ m4/ *.nc *.log *.gz +!/decomps/*/*.nc \ No newline at end of file diff --git a/src/flib/pio.F90 b/src/flib/pio.F90 index f89fa905ae..fa7473c60a 100644 --- a/src/flib/pio.F90 +++ b/src/flib/pio.F90 @@ -81,7 +81,7 @@ module pio PIO_inq_var_fill => inq_var_fill use pionfput_mod, only : PIO_put_var => put_var use pionfget_mod, only : PIO_get_var => get_var - use pio_support, only: pio_writedof + use pio_support, only: pio_writedof, pio_readdof, pio_write_nc_dof, pio_read_nc_dof use iso_c_binding implicit none diff --git a/src/flib/pio_support.F90 b/src/flib/pio_support.F90 index 686da26fed..bae82051da 100644 --- a/src/flib/pio_support.F90 +++ b/src/flib/pio_support.F90 @@ -18,6 +18,8 @@ module pio_support public :: CheckMPIreturn public :: pio_readdof public :: pio_writedof + public :: pio_write_nc_dof + public :: pio_read_nc_dof public :: replace_c_null logical, public :: Debug=.FALSE. !< debug mode @@ -173,6 +175,76 @@ end function PIOc_writemap_from_f90 end subroutine pio_writedof + !> + !! Fortran interface to write a netcdf format mapping file. + !! + !! @param ios : The iosystem structure + !! @param filename : The file where the decomp map will be written. + !! @param cmode : The netcdf creation mode. + !! @param iodesc : The io descriptor structure + !! @param title : An optional title to add to the netcdf attributes + !! @param history : An optional history to add to the netcdf attributes + !! @param fortran_order : Optional logical - Should multidimensional arrays be written in fortran order? + !! @param ret : Return code 0 if success + !< + + subroutine pio_write_nc_dof(ios, filename, cmode, iodesc, ret, title, history, fortran_order) + use pio_types, only : iosystem_desc_t, io_desc_t + type(iosystem_desc_t) :: ios + character(len=*) :: filename + integer :: cmode + type(io_desc_t) :: iodesc + integer :: ret + character(len=*), optional :: title + character(len=*), optional :: history + logical, optional :: fortran_order + + interface + integer(c_int) function PIOc_write_nc_decomp(iosysid, filename, cmode, & + ioid, title, history, fortran_order) & + bind(C,name="PIOc_write_nc_decomp") + use iso_c_binding + integer(C_INT), value :: iosysid + character(kind=c_char) :: filename + integer(C_INT), value :: cmode + integer(c_int), value :: ioid + character(kind=c_char) :: title + character(kind=c_char) :: history + integer(c_int), value :: fortran_order + end function PIOc_write_nc_decomp + end interface + character(len=:), allocatable :: ctitle, chistory + integer :: nl + integer :: forder + integer :: i + + + if(present(title)) then + ctitle = trim(title)//C_NULL_CHAR + else + ctitle = C_NULL_CHAR + endif + + if(present(history)) then + chistory = trim(history)//C_NULL_CHAR + else + chistory = C_NULL_CHAR + endif + + if(present(fortran_order)) then + if(fortran_order) then + forder = 1 + else + forder = 0 + endif + endif + nl = len_trim(filename) + ret = PIOc_write_nc_decomp(ios%iosysid, filename(:nl)//C_NULL_CHAR, cmode, iodesc%ioid, ctitle, chistory, forder) + + end subroutine pio_write_nc_dof + + + !> !! Fortran interface to read a mapping file. !! @@ -217,4 +289,54 @@ end function PIOc_readmap_from_f90 ! DOF = DOF+1 end subroutine pio_readdof + !> + !! Fortran interface to read a netcdf format mapping file. + !! + !! @param ios : The iosystem structure + !! @param filename : The file where the decomp map will be written. + !! @param iodesc : The io descriptor structure returned + !! @param ret : Return code 0 if success + !! @param title : An optional title to add to the netcdf attributes + !! @param history : An optional history to add to the netcdf attributes + !! @param fortran_order : An optional logical - should arrays be read in fortran order + !< + + subroutine pio_read_nc_dof(ios, filename, iodesc, ret, title, history, fortran_order) + use pio_types, only : iosystem_desc_t, io_desc_t + type(iosystem_desc_t) :: ios + character(len=*) :: filename + type(io_desc_t) :: iodesc + integer :: ret + character(len=*), optional :: title + character(len=*), optional :: history + logical, optional :: fortran_order + + interface + integer(c_int) function PIOc_read_nc_decomp(iosysid, filename, ioid, & + title, history, fortran_order) & + bind(C,name="PIOc_read_nc_decomp") + use iso_c_binding + integer(C_INT), value :: iosysid + character(kind=c_char) :: filename + integer(c_int) :: ioid + character(kind=c_char) :: title + character(kind=c_char) :: history + integer(c_int), value :: fortran_order + end function PIOc_read_nc_decomp + end interface + character(len=:), allocatable :: ctitle, chistory + integer :: nl + integer :: forder + + nl = len_trim(filename) + ret = PIOc_read_nc_decomp(ios%iosysid, filename(:nl)//C_NULL_CHAR, iodesc%ioid, title, history, forder) + if(present(fortran_order)) then + if(forder /= 0) then + fortran_order = .true. + else + fortran_order = .true. + endif + endif + end subroutine pio_read_nc_dof + end module pio_support diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 007a503f65..9a20eabb24 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -21,6 +21,7 @@ add_subdirectory (cperf) if (PIO_ENABLE_FORTRAN) add_subdirectory (unit) add_subdirectory (general) + add_subdirectory (doftests) if (PIO_ENABLE_TIMING) add_subdirectory (performance) else () diff --git a/tests/doftests/CMakeLists.txt b/tests/doftests/CMakeLists.txt new file mode 100644 index 0000000000..9e0825978b --- /dev/null +++ b/tests/doftests/CMakeLists.txt @@ -0,0 +1,19 @@ +#============================================================================== +# DEFINE THE TARGETS AND TESTS +#============================================================================== + +add_executable (dofcopy EXCLUDE_FROM_ALL + dofcopy.F90) +target_link_libraries (dofcopy piof) + +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU") + target_compile_options (dofcopy + PRIVATE -ffree-line-length-none) +endif() + +if (CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + set ( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mismatch_all" ) + # target_compile_options (gptl + # PRIVATE -mismatch_all) +endif () + diff --git a/tests/doftests/dofcopy.F90 b/tests/doftests/dofcopy.F90 new file mode 100644 index 0000000000..e676ba58da --- /dev/null +++ b/tests/doftests/dofcopy.F90 @@ -0,0 +1,83 @@ +! +! Copy an old style dof text file into the newer netcdf format file +! +program dofcopy +#ifndef NO_MPIMOD + use mpi +#endif + use pio + + implicit none +#ifdef NO_MPIMOD +#include +#endif + character(len=256) :: infile, outfile + integer :: ndims + integer, pointer :: gdims(:) + integer(kind=PIO_Offset_kind), pointer :: compmap(:) + integer :: ierr, mype, npe + integer :: comm=MPI_COMM_WORLD + logical :: Mastertask + integer :: stride=3 + integer :: rearr = PIO_REARR_SUBSET + type(iosystem_desc_t) :: iosystem + type(io_desc_t) :: iodesc + + call MPI_Init(ierr) + call CheckMPIreturn(__LINE__,ierr) + call MPI_Comm_rank(MPI_COMM_WORLD, mype, ierr) + call CheckMPIreturn(__LINE__,ierr) + call MPI_Comm_size(MPI_COMM_WORLD, npe, ierr) + call CheckMPIreturn(__LINE__,ierr) + if(mype==0) then + Mastertask=.true. + else + Mastertask=.false. + endif + + CALL get_command_argument(1, infile) + + call pio_readdof(trim(infile), ndims, gdims, compmap, MPI_COMM_WORLD) + + if(mype < npe) then + call pio_init(mype, comm, npe/stride, 0, stride, PIO_REARR_SUBSET, iosystem) + + call PIO_InitDecomp(iosystem, PIO_INT, gdims, compmap, iodesc, rearr=rearr) + write(outfile, *) trim(infile)//".nc" + call PIO_write_nc_dof(iosystem, outfile, PIO_64BIT_DATA, iodesc, ierr) + call PIO_finalize(iosystem, ierr) + endif + + + call MPI_Finalize(ierr) +contains + !============================================= + ! CheckMPIreturn: + ! + ! Check and prints an error message + ! if an error occured in a MPI subroutine. + !============================================= + subroutine CheckMPIreturn(line,errcode) +#ifndef NO_MPIMOD + use mpi +#endif + implicit none +#ifdef NO_MPIMOD +#include +#endif + integer, intent(in) :: errcode + integer, intent(in) :: line + character(len=MPI_MAX_ERROR_STRING) :: errorstring + + integer :: errorlen + + integer :: ierr + + if (errcode .ne. MPI_SUCCESS) then + call MPI_Error_String(errcode,errorstring,errorlen,ierr) + write(*,*) errorstring(1:errorlen) + end if + end subroutine CheckMPIreturn + + +end program dofcopy