206 строки
6.3 KiB
Fortran
206 строки
6.3 KiB
Fortran
! -*- Mode: Fortran; -*-
|
|
!
|
|
! (C) 2001 by Argonne National Laboratory.
|
|
! See COPYRIGHT in top-level directory.
|
|
!
|
|
program main
|
|
implicit none
|
|
|
|
include 'mpif.h'
|
|
@F77MPIOINC@
|
|
|
|
! Fortran equivalent of misc.c
|
|
! tests various miscellaneous functions.
|
|
|
|
integer buf(1024), amode, fh, status(MPI_STATUS_SIZE)
|
|
logical flag
|
|
integer ierr, newtype, i, group
|
|
integer etype, filetype, mynod, argc, iargc
|
|
integer errs, toterrs
|
|
logical verbose
|
|
character*7 datarep
|
|
character*1024 str ! used to store the filename
|
|
@FORTRAN_MPI_OFFSET@ disp, offset, filesize
|
|
@FTESTDEFINE@
|
|
|
|
errs = 0
|
|
verbose = .false.
|
|
call MPI_INIT(ierr)
|
|
call MPI_COMM_RANK(MPI_COMM_WORLD, mynod, ierr)
|
|
|
|
! process 0 takes the file name as a command-line argument and
|
|
! broadcasts it to other processes
|
|
|
|
if (mynod .eq. 0) then
|
|
argc = @F77IARGC@
|
|
i = 0
|
|
@F77GETARG@
|
|
do while ((i .lt. argc) .and. (str .ne. '-fname'))
|
|
i = i + 1
|
|
@F77GETARG@
|
|
end do
|
|
if (i .ge. argc) then
|
|
print *
|
|
print *, '*# Usage: fmisc -fname filename'
|
|
print *
|
|
call MPI_ABORT(MPI_COMM_WORLD, 1, ierr)
|
|
end if
|
|
|
|
i = i + 1
|
|
@F77GETARG@
|
|
call MPI_BCAST(str, 1024, MPI_CHARACTER, 0, &
|
|
& MPI_COMM_WORLD, ierr)
|
|
else
|
|
call MPI_BCAST(str, 1024, MPI_CHARACTER, 0, &
|
|
& MPI_COMM_WORLD, ierr)
|
|
end if
|
|
|
|
|
|
call MPI_FILE_OPEN(MPI_COMM_WORLD, str, &
|
|
& MPI_MODE_CREATE + MPI_MODE_RDWR, MPI_INFO_NULL, fh, ierr)
|
|
|
|
call MPI_FILE_WRITE(fh, buf, 1024, MPI_INTEGER, status, ierr)
|
|
|
|
call MPI_FILE_SYNC(fh, ierr)
|
|
|
|
call MPI_FILE_GET_AMODE(fh, amode, ierr)
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' testing MPI_FILE_GET_AMODE'
|
|
end if
|
|
if (amode .ne. (MPI_MODE_CREATE + MPI_MODE_RDWR)) then
|
|
errs = errs + 1
|
|
print *, 'amode is ', amode, ', should be ', MPI_MODE_CREATE &
|
|
& + MPI_MODE_RDWR
|
|
end if
|
|
|
|
call MPI_FILE_GET_ATOMICITY(fh, flag, ierr)
|
|
if (flag) then
|
|
errs = errs + 1
|
|
print *, 'atomicity is ', flag, ', should be .FALSE.'
|
|
end if
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' setting atomic mode'
|
|
end if
|
|
call MPI_FILE_SET_ATOMICITY(fh, .TRUE., ierr)
|
|
call MPI_FILE_GET_ATOMICITY(fh, flag, ierr)
|
|
if (.not. flag) then
|
|
errs = errs + 1
|
|
print *, 'atomicity is ', flag, ', should be .TRUE.'
|
|
end if
|
|
call MPI_FILE_SET_ATOMICITY(fh, .FALSE., ierr)
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' reverting back to nonatomic mode'
|
|
end if
|
|
|
|
call MPI_TYPE_VECTOR(10, 10, 20, MPI_INTEGER, newtype, ierr)
|
|
call MPI_TYPE_COMMIT(newtype, ierr)
|
|
|
|
disp = 1000
|
|
call MPI_FILE_SET_VIEW(fh, disp, MPI_INTEGER, newtype, 'native', &
|
|
& MPI_INFO_NULL, ierr)
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' testing MPI_FILE_GET_VIEW'
|
|
end if
|
|
|
|
disp = 0
|
|
call MPI_FILE_GET_VIEW(fh, disp, etype, filetype, datarep, ierr)
|
|
if ((disp .ne. 1000) .or. (datarep .ne. 'native')) then
|
|
errs = errs + 1
|
|
print *, 'disp = ', disp, ', datarep = ', datarep, &
|
|
& ', should be 1000, native'
|
|
end if
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' testing MPI_FILE_GET_BYTE_OFFSET'
|
|
end if
|
|
offset = 10
|
|
call MPI_FILE_GET_BYTE_OFFSET(fh, offset, disp, ierr)
|
|
if (disp .ne. 1080) then
|
|
errs = errs + 1
|
|
print *, 'byte offset = ', disp, ', should be 1080'
|
|
end if
|
|
|
|
call MPI_FILE_GET_GROUP(fh, group, ierr)
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' setting file size to 1060 bytes'
|
|
end if
|
|
filesize = 1060
|
|
call MPI_FILE_SET_SIZE(fh, filesize, ierr)
|
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
|
call MPI_FILE_SYNC(fh, ierr)
|
|
filesize = 0
|
|
call MPI_FILE_GET_SIZE(fh, filesize, ierr)
|
|
if (filesize .ne. 1060) then
|
|
errs = errs + 1
|
|
print *, 'file size = ', filesize, ', should be 1060'
|
|
end if
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' seeking to eof and testing MPI_FILE_GET_POSITION'
|
|
end if
|
|
offset = 0
|
|
call MPI_FILE_SEEK(fh, offset, MPI_SEEK_END, ierr)
|
|
call MPI_FILE_GET_POSITION(fh, offset, ierr)
|
|
if (offset .ne. 10) then
|
|
errs = errs + 1
|
|
print *, 'file pointer posn = ', offset, ', should be 10'
|
|
end if
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' testing MPI_FILE_GET_BYTE_OFFSET'
|
|
end if
|
|
call MPI_FILE_GET_BYTE_OFFSET(fh, offset, disp, ierr)
|
|
if (disp .ne. 1080) then
|
|
errs = errs + 1
|
|
print *, 'byte offset = ', disp, ', should be 1080'
|
|
end if
|
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' testing MPI_FILE_SEEK with MPI_SEEK_CUR'
|
|
end if
|
|
offset = -10
|
|
call MPI_FILE_SEEK(fh, offset, MPI_SEEK_CUR, ierr)
|
|
call MPI_FILE_GET_POSITION(fh, offset, ierr)
|
|
call MPI_FILE_GET_BYTE_OFFSET(fh, offset, disp, ierr)
|
|
if (disp .ne. 1000) then
|
|
errs = errs + 1
|
|
print *, 'file pointer posn in bytes = ', disp, &
|
|
& ', should be 1000'
|
|
end if
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' preallocating disk space up to 8192 bytes'
|
|
end if
|
|
filesize = 8192
|
|
call MPI_FILE_PREALLOCATE(fh, filesize, ierr)
|
|
|
|
if (mynod .eq. 0 .and. verbose) then
|
|
print *, ' closing the file and deleting it'
|
|
end if
|
|
call MPI_FILE_CLOSE(fh, ierr)
|
|
|
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
|
if (mynod .eq. 0) then
|
|
call MPI_FILE_DELETE(str, MPI_INFO_NULL, ierr)
|
|
end if
|
|
|
|
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_TYPE_FREE(newtype, ierr)
|
|
call MPI_TYPE_FREE(filetype, ierr)
|
|
call MPI_GROUP_FREE(group, ierr)
|
|
call MPI_FINALIZE(ierr)
|
|
|
|
stop
|
|
end
|