Commit 66fa21c7 authored by Junchao Zhang's avatar Junchao Zhang
Browse files

Add Fortran tests for nonblocking collective I/O

No review since F08 binding is experimental now.
parent 30da9161
......@@ -38,6 +38,7 @@
/f77/init/checksizes.c
/f90/datatype/allctypesf90.f90
/io/test.ord
/io/i_setviewcur
/threads/pt2pt/greq_test
/threads/pt2pt/greq_wait
/threads/pt2pt/multisend
......@@ -246,6 +247,7 @@
/f77/io/writeordbef.f
/f77/io/writeshf.f
/f77/io/writeatallf.f
/f77/io/iwriteatallf.f
/f77/io/writeatallbef.f
/f77/io/writeallbef.f
/f77/io/iwritef
......@@ -259,6 +261,7 @@
/f77/io/writeatall
/f77/io/writeatallbef
/f77/io/writeallbef
/f77/io/i_setviewcurf
/f77/io/iooffset.h
/f77/io/iodisp.h
/f77/io/ioaint.h
......@@ -343,6 +346,7 @@
/f90/io/writeordbef90.f90
/f90/io/writeshf90.f90
/f90/io/writeatallf90.f90
/f90/io/iwriteatallf90.f90
/f90/io/writeatallbef90.f90
/f90/io/writeallbef90.f90
/f90/io/c2f2ciof90.f90
......@@ -350,8 +354,10 @@
/f90/io/c2f90multio.c
/f90/io/Makefile.sm
/f90/io/testlist
/f90/io/testlist.in
/f90/io/ioharness.defn
/f90/io/ioharness.tlt
/f90/io/i_setviewcurf90.f90
/f90/misc/sizeof
/f90/misc/f77tof90
/f90/pt2pt/Makefile.sm
......@@ -442,6 +448,9 @@
/f08/datatype/get_elem_d
/f08/datatype/get_elem_u
/f08/rma/testlist
/f08/io/iwriteatallf90.f90
/f08/io/iwriteatallf90
/f08/io/i_fcoll_test
/group/errstring
/group/grouptest
/group/groupcreate
......@@ -798,6 +807,8 @@
/f77/io/setviewcurf
/f77/io/shpositionf
/f77/io/writeatallf
/f77/io/iwriteatallf
/f77/io/testlist
/f77/pt2pt/allpairf
/f77/pt2pt/greqf
/f77/pt2pt/mprobef
......@@ -866,6 +877,7 @@
/f90/io/writeallf90
/f90/io/writeatallbef90
/f90/io/writeatallf90
/f90/io/iwriteatallf90
/f90/io/writeatf90
/f90/io/writef90
/f90/io/writeordbef90
......
......@@ -1547,6 +1547,7 @@ AC_OUTPUT(maint/testmerge \
f77/io/iooffset.h \
f77/io/iodisp.h \
f77/io/ioaint.h \
f77/io/testlist \
f77/profile/Makefile \
f90/Makefile \
f90/attr/Makefile \
......@@ -1566,6 +1567,7 @@ AC_OUTPUT(maint/testmerge \
f90/ext/Makefile \
f90/ext/testlist \
f90/io/Makefile \
f90/io/testlist \
f90/misc/Makefile \
f90/profile/Makefile \
f08/Makefile \
......@@ -1579,6 +1581,7 @@ AC_OUTPUT(maint/testmerge \
f08/subarray/Makefile \
f08/topo/Makefile \
f08/io/Makefile \
f08/io/testlist \
f08/init/Makefile \
f08/info/Makefile \
f08/spawn/Makefile \
......
......@@ -7,7 +7,7 @@
include $(top_srcdir)/Makefile_f08.mtest
EXTRA_DIST = testlist
EXTRA_DIST = testlist.in
# avoid having to write many "foo_SOURCES = foo.f90" lines
AM_DEFAULT_SOURCE_EXT = .f90
......@@ -34,6 +34,11 @@ noinst_PROGRAMS = \
c2f90multio \
c2f2ciof90
if BUILD_MPIX_TESTS
noinst_PROGRAMS += \
i_fcoll_test \
iwriteatallf90
endif
# We don't want to distribute these source files because they are created by
# "testmerge", hence "nodist_foo_SOURCES"
......@@ -49,6 +54,7 @@ nodist_writef90_SOURCES = writef90.f90
nodist_writeordbef90_SOURCES = writeordbef90.f90
nodist_writeordf90_SOURCES = writeordf90.f90
nodist_writeshf90_SOURCES = writeshf90.f90
nodist_iwriteatallf90_SOURCES = iwriteatallf90.f90
c2f90multio_SOURCES = c2f90multio.c
# this is a C only program, so we must either:
......@@ -68,6 +74,7 @@ c2f2ciof90_SOURCES = c2f2ciof90.f90 c2f902cio.c
# these files are genereated using testmerge (see below)
generated_io_sources = \
iwriteatf90.f90 \
iwriteatallf90.f90 \
iwritef90.f90 \
iwriteshf90.f90 \
writeallbef90.f90 \
......
! -*- Mode: Fortran; -*-
!
! (C) 2014 by Argonne National Laboratory.
! See COPYRIGHT in top-level directory.
!
program main
use mpi_f08
implicit none
!include 'mpif.h'
! Fortran 2008 equivalent of src/mpi/romio/test/coll_test.c
integer FILESIZE
parameter (FILESIZE=32*32*32*4)
! A 32^3 array. For other array sizes, change FILESIZE above and
! array_of_gsizes below.
! Uses collective I/O. Writes a 3D block-distributed array to a file
! corresponding to the global array in row-major (C) order, reads it
! back, and checks that the data read is correct.
! Note that the file access pattern is noncontiguous.
integer i, ndims, array_of_gsizes(3)
integer order, intsize, nprocs, j, array_of_distribs(3)
integer array_of_dargs(3), array_of_psizes(3)
integer readbuf(FILESIZE), writebuf(FILESIZE), bufcount
integer mynod, tmpbuf(FILESIZE), array_size, argc
integer ierr
character*256 str ! used to store the filename
integer errs, toterrs
integer(MPI_OFFSET_KIND) :: disp
type(MPI_Datatype) :: newtype
type(MPI_Status) :: status
type(MPI_Request) :: request
type(MPI_File) :: fh
errs = 0
str = "iotest.txt"
call MPI_INIT(ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, nprocs, ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD, mynod, ierr)
! create the distributed array filetype
ndims = 3
order = MPI_ORDER_FORTRAN
array_of_gsizes(1) = 32
array_of_gsizes(2) = 32
array_of_gsizes(3) = 32
array_of_distribs(1) = MPI_DISTRIBUTE_BLOCK
array_of_distribs(2) = MPI_DISTRIBUTE_BLOCK
array_of_distribs(3) = MPI_DISTRIBUTE_BLOCK
array_of_dargs(1) = MPI_DISTRIBUTE_DFLT_DARG
array_of_dargs(2) = MPI_DISTRIBUTE_DFLT_DARG
array_of_dargs(3) = MPI_DISTRIBUTE_DFLT_DARG
do i=1, ndims
array_of_psizes(i) = 0
end do
call MPI_DIMS_CREATE(nprocs, ndims, array_of_psizes, ierr)
call MPI_TYPE_CREATE_DARRAY(nprocs, mynod, ndims, &
array_of_gsizes, array_of_distribs, array_of_dargs, &
array_of_psizes, order, MPI_INTEGER, newtype, ierr)
call MPI_TYPE_COMMIT(newtype, ierr)
! initialize writebuf
call MPI_TYPE_SIZE(newtype, bufcount, ierr)
call MPI_TYPE_SIZE(MPI_INTEGER, intsize, ierr)
bufcount = bufcount/intsize
do i=1, bufcount
writebuf(i) = 1
end do
do i=1, FILESIZE
tmpbuf(i) = 0
end do
call MPI_IRECV(tmpbuf, 1, newtype, mynod, 10, MPI_COMM_WORLD, request, ierr)
call MPI_SEND(writebuf, bufcount, MPI_INTEGER, mynod, 10, MPI_COMM_WORLD, ierr)
call MPI_WAIT(request, status, ierr)
j = 1
array_size = array_of_gsizes(1) * array_of_gsizes(2) * array_of_gsizes(3)
do i=1, array_size
if (tmpbuf(i) .ne. 0) then
writebuf(j) = i
j = j + 1
end if
end do
! end of initialization
! write the array to the file
call MPI_FILE_OPEN(MPI_COMM_WORLD, str, MPI_MODE_CREATE+MPI_MODE_RDWR, MPI_INFO_NULL, fh, ierr)
disp = 0
call MPI_FILE_SET_VIEW(fh, disp, MPI_INTEGER, newtype, "native", MPI_INFO_NULL, ierr)
call MPIX_FILE_IWRITE_ALL(fh, writebuf, bufcount, MPI_INTEGER, request, ierr)
call MPI_WAIT(request, status, ierr)
call MPI_FILE_CLOSE(fh, ierr)
!now read it back
call MPI_FILE_OPEN(MPI_COMM_WORLD, str, MPI_MODE_CREATE+MPI_MODE_RDWR, MPI_INFO_NULL, fh, ierr)
call MPI_FILE_SET_VIEW(fh, disp, MPI_INTEGER, newtype, "native", MPI_INFO_NULL, ierr)
call MPIX_FILE_IREAD_ALL(fh, readbuf, bufcount, MPI_INTEGER, request, ierr)
call MPI_WAIT(request, status, ierr)
call MPI_FILE_CLOSE(fh, ierr)
! check the data read
do i=1, bufcount
if (readbuf(i) .ne. writebuf(i)) then
errs = errs + 1
print *, 'Node ', mynod, ' readbuf ', readbuf(i), &
' writebuf ', writebuf(i), ' i', i
end if
end do
call MPI_TYPE_FREE(newtype, ierr)
if (mynod .eq. 0) then
call MPI_FILE_DELETE(str, MPI_INFO_NULL, ierr)
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
endif
endif
call MPI_Allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierr )
if (mynod .eq. 0) then
if( toterrs .gt. 0 ) then
print *, 'Found ', toterrs, ' errors'
else
print *, ' No Errors'
endif
endif
call MPI_FINALIZE(ierr)
stop
end
......@@ -246,6 +246,38 @@ enddo
</readfile>
</TESTDEFN>
# This test uses nonblocking collective I/O with thread-safe, individual file pointers
<TESTDEFN filename="iwriteatallf90.f90">
<writefiledecl>
type(MPI_Status) status
type(MPI_Request) request
integer buf(MAX_BUFFER), ans
integer (kind=MPI_OFFSET_KIND)offset
</writefiledecl>
<writefile>
do k=1, b
<setContigBuffer/>
<findOffset/>
call MPIX_File_iwrite_at_all( fh, offset, buf, n, MPI_INTEGER, request, ierr )
call MPI_Wait(request, status, ierr)
<checkErr/>
enddo
</writefile>
# No extra declarations are needed for the read step
<readfiledecl>
</readfiledecl>
<readfile>
do k=1, b
<clearContigBuffer/>
<findOffset/>
call MPIX_File_iread_at_all( fh, offset, buf, n, MPI_INTEGER, request, ierr )
call MPI_Wait(request, status, ierr)
<checkErr/>
<checkContigBuffer/>
enddo
</readfile>
</TESTDEFN>
# This test uses collective I/O with thread-safe, individual file pointers
<TESTDEFN filename="writeatallbef90.f90">
<writefiledecl>
......
......@@ -18,3 +18,5 @@ miscfilef90 4
setviewcurf90 4
c2f2ciof90 1
c2f90multio 1
@mpix@ i_fcoll_test 4
@mpix@ iwriteatallf90 4
......@@ -7,7 +7,7 @@
include $(top_srcdir)/Makefile_f77.mtest
EXTRA_DIST = testlist
EXTRA_DIST = testlist.in
# avoid having to write many "foo_SOURCES = foo.f" lines
AM_DEFAULT_SOURCE_EXT = .f
......@@ -34,10 +34,17 @@ noinst_PROGRAMS = \
c2fmultio \
c2f2ciof
if BUILD_MPIX_TESTS
noinst_PROGRAMS += \
i_setviewcurf \
iwriteatallf
endif
# We don't want to distribute these source files because they are created by
# "testmerge", hence "nodist_foo_SOURCES"
nodist_iwriteatf_SOURCES = iwriteatf.f
nodist_iwriteatallf_SOURCES = iwriteatallf.f
nodist_iwritef_SOURCES = iwritef.f
nodist_iwriteshf_SOURCES = iwriteshf.f
nodist_writeallbef_SOURCES = writeallbef.f
......@@ -82,6 +89,7 @@ writeordf.$(OBJEXT): iooffset.h
# these files are genereated using testmerge (see below)
generated_io_sources = \
iwriteatf.f \
iwriteatallf.f \
iwritef.f \
iwriteshf.f \
writeallbef.f \
......
C -*- Mode: Fortran; -*-
C
C (C) 2003 by Argonne National Laboratory.
C See COPYRIGHT in top-level directory.
C
program main
implicit none
include 'mpif.h'
include 'iooffset.h'
integer errs, ierr, size, rank
integer fh, comm, status(MPI_STATUS_SIZE)
integer buf(1024)
integer request
errs = 0
call MTest_Init( ierr )
C This test reads a header then sets the view to every "size" int,
C using set view and current displacement. The file is first written
C using a combination of collective and ordered writes
comm = MPI_COMM_WORLD
call MPI_File_open( comm, "test.ord", MPI_MODE_WRONLY +
$ MPI_MODE_CREATE, MPI_INFO_NULL, fh, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Open(1)", ierr )
endif
call MPI_Comm_size( comm, size, ierr )
call MPI_Comm_rank( comm, rank, ierr )
if (size .gt. 1024) then
if (rank .eq. 0) then
print *,
$"This program must be run with no more than 1024 processes"
call MPI_Abort( MPI_COMM_WORLD, 1, ierr )
endif
endif
buf(1) = size
call MPIX_File_iwrite_all( fh, buf, 1, MPI_INTEGER, request, ierr)
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "iwrite_all", ierr )
endif
call MPI_Wait(request, status, ierr)
call MPI_File_get_position( fh, offset, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Get_position", ierr )
endif
call MPI_File_seek_shared( fh, offset, MPI_SEEK_SET, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Seek_shared", ierr )
endif
buf(1) = rank
call MPI_File_write_ordered( fh, buf, 1, MPI_INTEGER, status,ierr)
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Write_ordered", ierr )
endif
call MPI_File_close( fh, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Close(1)", ierr )
endif
C Reopen the file as sequential
call MPI_File_open( comm, "test.ord", MPI_MODE_RDONLY +
$ MPI_MODE_SEQUENTIAL + MPI_MODE_DELETE_ON_CLOSE,
$ MPI_INFO_NULL, fh, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Open(Read)", ierr )
endif
if (rank .eq. 0) then
call MPI_File_read_shared( fh, buf, 1, MPI_INTEGER, status,
$ ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Read_all", ierr )
endif
if (buf(1) .ne. size) then
errs = errs + 1
print *, "Unexpected value for the header = ", buf(1),
$ ", should be ", size
endif
endif
call MPI_Barrier( comm, ierr )
C All processes must provide the same file view for MODE_SEQUENTIAL
call MPI_File_set_view( fh, MPI_DISPLACEMENT_CURRENT, MPI_INTEGER
$ ,MPI_INTEGER, "native", MPI_INFO_NULL, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Set_view", ierr )
endif
buf(1) = -1
call MPI_File_read_ordered( fh, buf, 1, MPI_INTEGER, status, ierr
$ )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Read_all", ierr )
endif
if (buf(1) .ne. rank) then
errs = errs + 1
print *, rank, ": buf(1) = ", buf(1)
endif
call MPI_File_close( fh, ierr )
if (ierr .ne. MPI_SUCCESS) then
errs = errs + 1
call MTestPrintErrorMsg( "Close(2)", ierr )
endif
call MTest_Finalize( errs )
call MPI_Finalize( ierr )
end
......@@ -246,6 +246,38 @@ enddo
</readfile>
</TESTDEFN>
# This test uses nonblocking collective I/O with thread-safe, individual file pointers
<TESTDEFN filename="iwriteatallf.f">
<writefiledecl>
integer status(MPI_STATUS_SIZE)
integer request
integer buf(MAX_BUFFER), ans
include 'iooffset.h'
</writefiledecl>
<writefile>
do k=1, b
<setContigBuffer/>
<findOffset/>
call mpix_file_iwrite_at_all( fh, offset, buf, n, MPI_INTEGER, request, ierr )
call mpi_wait(request, status, ierr)
<checkErr/>
enddo
</writefile>
# No extra declarations are needed for the read step
<readfiledecl>
</readfiledecl>
<readfile>
do k=1, b
<clearContigBuffer/>
<findOffset/>
call mpix_file_iread_at_all( fh, offset, buf, n, MPI_INTEGER, request, ierr )
call mpi_wait(request, status, ierr)
<checkErr/>
<checkContigBuffer/>
enddo
</readfile>
</TESTDEFN>
# This test uses collective I/O with thread-safe, individual file pointers
<TESTDEFN filename="writeatallbef.f">
<writefiledecl>
......
......@@ -18,3 +18,5 @@ miscfilef 4
setviewcurf 4
c2f2ciof 1
c2fmultio 1
@mpix@ i_setviewcurf 4
@mpix@ iwriteatallf 4
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment