Skip to content

Commit f50f038

Browse files
jedwards4bjedwards4b
authored
Merge pull request #1899 from jedwards4b/add_write_nc_decomp_support_fortran
2 parents a4ed64c + 776de3e commit f50f038

File tree

6 files changed

+227
-1
lines changed

6 files changed

+227
-1
lines changed

‎.gitignore

+1
Original file line numberDiff line numberDiff line change
@@ -29,3 +29,4 @@ m4/
2929
*.nc
3030
*.log
3131
*.gz
32+
!/decomps/*/*.nc

‎src/flib/pio.F90

+1-1
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,7 @@ module pio
8181
PIO_inq_var_fill => inq_var_fill
8282
use pionfput_mod, only : PIO_put_var => put_var
8383
use pionfget_mod, only : PIO_get_var => get_var
84-
use pio_support, only: pio_writedof
84+
use pio_support, only: pio_writedof, pio_readdof, pio_write_nc_dof, pio_read_nc_dof
8585
use iso_c_binding
8686

8787
implicit none

‎src/flib/pio_support.F90

+122
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,8 @@ module pio_support
1818
public :: CheckMPIreturn
1919
public :: pio_readdof
2020
public :: pio_writedof
21+
public :: pio_write_nc_dof
22+
public :: pio_read_nc_dof
2123
public :: replace_c_null
2224

2325
logical, public :: Debug=.FALSE. !< debug mode
@@ -173,6 +175,76 @@ end function PIOc_writemap_from_f90
173175

174176
end subroutine pio_writedof
175177

178+
!>
179+
!! Fortran interface to write a netcdf format mapping file.
180+
!!
181+
!! @param ios : The iosystem structure
182+
!! @param filename : The file where the decomp map will be written.
183+
!! @param cmode : The netcdf creation mode.
184+
!! @param iodesc : The io descriptor structure
185+
!! @param title : An optional title to add to the netcdf attributes
186+
!! @param history : An optional history to add to the netcdf attributes
187+
!! @param fortran_order : Optional logical - Should multidimensional arrays be written in fortran order?
188+
!! @param ret : Return code 0 if success
189+
!<
190+
191+
subroutine pio_write_nc_dof(ios, filename, cmode, iodesc, ret, title, history, fortran_order)
192+
use pio_types, only : iosystem_desc_t, io_desc_t
193+
type(iosystem_desc_t) :: ios
194+
character(len=*) :: filename
195+
integer :: cmode
196+
type(io_desc_t) :: iodesc
197+
integer :: ret
198+
character(len=*), optional :: title
199+
character(len=*), optional :: history
200+
logical, optional :: fortran_order
201+
202+
interface
203+
integer(c_int) function PIOc_write_nc_decomp(iosysid, filename, cmode, &
204+
ioid, title, history, fortran_order) &
205+
bind(C,name="PIOc_write_nc_decomp")
206+
use iso_c_binding
207+
integer(C_INT), value :: iosysid
208+
character(kind=c_char) :: filename
209+
integer(C_INT), value :: cmode
210+
integer(c_int), value :: ioid
211+
character(kind=c_char) :: title
212+
character(kind=c_char) :: history
213+
integer(c_int), value :: fortran_order
214+
end function PIOc_write_nc_decomp
215+
end interface
216+
character(len=:), allocatable :: ctitle, chistory
217+
integer :: nl
218+
integer :: forder
219+
integer :: i
220+
221+
222+
if(present(title)) then
223+
ctitle = trim(title)//C_NULL_CHAR
224+
else
225+
ctitle = C_NULL_CHAR
226+
endif
227+
228+
if(present(history)) then
229+
chistory = trim(history)//C_NULL_CHAR
230+
else
231+
chistory = C_NULL_CHAR
232+
endif
233+
234+
if(present(fortran_order)) then
235+
if(fortran_order) then
236+
forder = 1
237+
else
238+
forder = 0
239+
endif
240+
endif
241+
nl = len_trim(filename)
242+
ret = PIOc_write_nc_decomp(ios%iosysid, filename(:nl)//C_NULL_CHAR, cmode, iodesc%ioid, ctitle, chistory, forder)
243+
244+
end subroutine pio_write_nc_dof
245+
246+
247+
176248
!>
177249
!! Fortran interface to read a mapping file.
178250
!!
@@ -217,4 +289,54 @@ end function PIOc_readmap_from_f90
217289
! DOF = DOF+1
218290
end subroutine pio_readdof
219291

292+
!>
293+
!! Fortran interface to read a netcdf format mapping file.
294+
!!
295+
!! @param ios : The iosystem structure
296+
!! @param filename : The file where the decomp map will be written.
297+
!! @param iodesc : The io descriptor structure returned
298+
!! @param ret : Return code 0 if success
299+
!! @param title : An optional title to add to the netcdf attributes
300+
!! @param history : An optional history to add to the netcdf attributes
301+
!! @param fortran_order : An optional logical - should arrays be read in fortran order
302+
!<
303+
304+
subroutine pio_read_nc_dof(ios, filename, iodesc, ret, title, history, fortran_order)
305+
use pio_types, only : iosystem_desc_t, io_desc_t
306+
type(iosystem_desc_t) :: ios
307+
character(len=*) :: filename
308+
type(io_desc_t) :: iodesc
309+
integer :: ret
310+
character(len=*), optional :: title
311+
character(len=*), optional :: history
312+
logical, optional :: fortran_order
313+
314+
interface
315+
integer(c_int) function PIOc_read_nc_decomp(iosysid, filename, ioid, &
316+
title, history, fortran_order) &
317+
bind(C,name="PIOc_read_nc_decomp")
318+
use iso_c_binding
319+
integer(C_INT), value :: iosysid
320+
character(kind=c_char) :: filename
321+
integer(c_int) :: ioid
322+
character(kind=c_char) :: title
323+
character(kind=c_char) :: history
324+
integer(c_int), value :: fortran_order
325+
end function PIOc_read_nc_decomp
326+
end interface
327+
character(len=:), allocatable :: ctitle, chistory
328+
integer :: nl
329+
integer :: forder
330+
331+
nl = len_trim(filename)
332+
ret = PIOc_read_nc_decomp(ios%iosysid, filename(:nl)//C_NULL_CHAR, iodesc%ioid, title, history, forder)
333+
if(present(fortran_order)) then
334+
if(forder /= 0) then
335+
fortran_order = .true.
336+
else
337+
fortran_order = .true.
338+
endif
339+
endif
340+
end subroutine pio_read_nc_dof
341+
220342
end module pio_support

‎tests/CMakeLists.txt

+1
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ add_subdirectory (cperf)
2121
if (PIO_ENABLE_FORTRAN)
2222
add_subdirectory (unit)
2323
add_subdirectory (general)
24+
add_subdirectory (doftests)
2425
if (PIO_ENABLE_TIMING)
2526
add_subdirectory (performance)
2627
else ()

‎tests/doftests/CMakeLists.txt

+19
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
#==============================================================================
2+
# DEFINE THE TARGETS AND TESTS
3+
#==============================================================================
4+
5+
add_executable (dofcopy EXCLUDE_FROM_ALL
6+
dofcopy.F90)
7+
target_link_libraries (dofcopy piof)
8+
9+
if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU")
10+
target_compile_options (dofcopy
11+
PRIVATE -ffree-line-length-none)
12+
endif()
13+
14+
if (CMAKE_Fortran_COMPILER_ID STREQUAL "NAG")
15+
set ( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mismatch_all" )
16+
# target_compile_options (gptl
17+
# PRIVATE -mismatch_all)
18+
endif ()
19+

‎tests/doftests/dofcopy.F90

+83
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
!
2+
! Copy an old style dof text file into the newer netcdf format file
3+
!
4+
program dofcopy
5+
#ifndef NO_MPIMOD
6+
use mpi
7+
#endif
8+
use pio
9+
10+
implicit none
11+
#ifdef NO_MPIMOD
12+
#include <mpif.h>
13+
#endif
14+
character(len=256) :: infile, outfile
15+
integer :: ndims
16+
integer, pointer :: gdims(:)
17+
integer(kind=PIO_Offset_kind), pointer :: compmap(:)
18+
integer :: ierr, mype, npe
19+
integer :: comm=MPI_COMM_WORLD
20+
logical :: Mastertask
21+
integer :: stride=3
22+
integer :: rearr = PIO_REARR_SUBSET
23+
type(iosystem_desc_t) :: iosystem
24+
type(io_desc_t) :: iodesc
25+
26+
call MPI_Init(ierr)
27+
call CheckMPIreturn(__LINE__,ierr)
28+
call MPI_Comm_rank(MPI_COMM_WORLD, mype, ierr)
29+
call CheckMPIreturn(__LINE__,ierr)
30+
call MPI_Comm_size(MPI_COMM_WORLD, npe, ierr)
31+
call CheckMPIreturn(__LINE__,ierr)
32+
if(mype==0) then
33+
Mastertask=.true.
34+
else
35+
Mastertask=.false.
36+
endif
37+
38+
CALL get_command_argument(1, infile)
39+
40+
call pio_readdof(trim(infile), ndims, gdims, compmap, MPI_COMM_WORLD)
41+
42+
if(mype < npe) then
43+
call pio_init(mype, comm, npe/stride, 0, stride, PIO_REARR_SUBSET, iosystem)
44+
45+
call PIO_InitDecomp(iosystem, PIO_INT, gdims, compmap, iodesc, rearr=rearr)
46+
write(outfile, *) trim(infile)//".nc"
47+
call PIO_write_nc_dof(iosystem, outfile, PIO_64BIT_DATA, iodesc, ierr)
48+
call PIO_finalize(iosystem, ierr)
49+
endif
50+
51+
52+
call MPI_Finalize(ierr)
53+
contains
54+
!=============================================
55+
! CheckMPIreturn:
56+
!
57+
! Check and prints an error message
58+
! if an error occured in a MPI subroutine.
59+
!=============================================
60+
subroutine CheckMPIreturn(line,errcode)
61+
#ifndef NO_MPIMOD
62+
use mpi
63+
#endif
64+
implicit none
65+
#ifdef NO_MPIMOD
66+
#include <mpif.h>
67+
#endif
68+
integer, intent(in) :: errcode
69+
integer, intent(in) :: line
70+
character(len=MPI_MAX_ERROR_STRING) :: errorstring
71+
72+
integer :: errorlen
73+
74+
integer :: ierr
75+
76+
if (errcode .ne. MPI_SUCCESS) then
77+
call MPI_Error_String(errcode,errorstring,errorlen,ierr)
78+
write(*,*) errorstring(1:errorlen)
79+
end if
80+
end subroutine CheckMPIreturn
81+
82+
83+
end program dofcopy

0 commit comments

Comments
 (0)