Merge pull request #1899 from jedwards4b/add_write_nc_decomp_support_…

…fortran

.gitignore

@@ -29,3 +29,4 @@ m4/
 *.nc
 *.log
 *.gz
+!/decomps/*/*.nc

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

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

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 ()

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 ()
+

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 <mpif.h>
+#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 <mpif.h>
+#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