real recv_buf(n)
integer source, tag, count, rank, status(MPI_STATUS_SIZE)
character*(*) name
- logical foundError
integer ierr, recv_src, recv_tag, recv_count
- foundError = .false.
recv_src = status(MPI_SOURCE)
recv_tag = status(MPI_TAG)
call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr )
print *, '[', rank, '] Unexpected source:', recv_src,
* ' in ', name
errs = errs + 1
- foundError = .true.
end if
if (recv_tag .ne. tag) then
print *, '[', rank, '] Unexpected tag:', recv_tag, ' in ', name
errs = errs + 1
- foundError = .true.
end if
if (recv_count .ne. count) then
print *, '[', rank, '] Unexpected count:', recv_count,
* ' in ', name
errs = errs + 1
- foundError = .true.
end if
call verify_test_data(recv_buf, count, n, name, errs )
endif
myindex = mod( myindex, 4 ) + 1
MTestGetIntracomm = comm .ne. MPI_COMM_NULL
+ qsmaller=.true.
end
C
subroutine MTestFreeComm( comm )
program main
use mpi
integer ierr, errs
- integer i, ans, size, rank, color, comm, newcomm
- integer maxSize, displ
+ integer i, size, rank, comm, newcomm
+ integer maxSize
parameter (maxSize=128)
integer scounts(maxSize), sdispls(maxSize), stypes(maxSize)
integer rcounts(maxSize), rdispls(maxSize), rtypes(maxSize)
integer count, datatype
integer i
-! if (datatype .ne. MPI_INTEGER) then
-! print *, 'Invalid datatype (',datatype,') passed to user_op()'
-! return
-! endif
+ if (datatype .eq. MPI_INTEGER) then
+ print *, 'Invalid datatype (',datatype,') passed to user_op()'
+ return
+ endif
do i=1, count
cout(i) = cin(i) + cout(i)
integer rbuf(MAX_SIZE)
integer rdispls(MAX_SIZE), rcounts(MAX_SIZE), rtypes(MAX_SIZE)
integer ierr, errs
- integer comm, root
+ integer comm
integer rank, size
integer iexpected, igot
integer i, j
!
program main
use mpi
- integer atype, ierr
+ integer ierr
!
call mtest_init(ierr)
call mpi_comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN, &
use mpi
integer max_asizev
parameter (max_asizev=2)
- integer (kind=MPI_ADDRESS_KIND) aint, aintv(max_asizev)
+ integer (kind=MPI_ADDRESS_KIND) aintv(max_asizev), gap
- integer iarray(200), gap, intsize
+ integer iarray(200), intsize
integer ierr, errs
errs = 0
integer (kind=MPI_ADDRESS_KIND) aint, aintv(max_asizev)
integer blocklens(max_asizev), dtypes(max_asizev)
- integer displs(max_asizev)
integer recvbuf(6*max_asizev)
integer sendbuf(max_asizev), status(MPI_STATUS_SIZE)
integer rank, size
integer max_nints, max_dtypes, max_asizev
parameter (max_nints = 10, max_dtypes = 10, max_asizev=10)
integer intv(max_nints), dtypesv(max_dtypes)
- integer (kind=MPI_ADDRESS_KIND) aint, aintv(max_asizev)
+ integer (kind=MPI_ADDRESS_KIND) aintv(max_asizev)
!
call mpi_type_get_envelope( dtype, nints, nadds, ntype, &
subroutine test_pair_irsend( comm, errs )
use mpi
integer comm, errs
- integer rank, size, ierr, next, prev, tag, count, index, i
+ integer rank, size, ierr, next, prev, tag, count, index
integer TEST_SIZE
integer dupcom
parameter (TEST_SIZE=2000)
integer TEST_SIZE
parameter (TEST_SIZE=2000)
integer status(MPI_STATUS_SIZE)
- real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
+ real recv_buf(TEST_SIZE)
logical verbose
common /flags/ verbose
!
integer n, errs
real buf(n)
character *(*) name
- integer count, ierr, i
+ integer count, i
!
do 10 i = 1, count
if (buf(i) .ne. REAL(i)) then
! F90 tests from the F77 tests looks for mpif.h
subroutine dummyupdate( extrastate )
use mpi
- integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
-
+ integer (kind=MPI_ADDRESS_KIND) extrastate
+ extrastate=extrastate
end
subroutine query_fn( extrastate, status, ierr )
use mpi
integer status(MPI_STATUS_SIZE), ierr
- integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
+ integer (kind=MPI_ADDRESS_KIND) extrastate
!
! set a default status
call mpi_status_set_cancelled( status, .false., ierr)
call mpi_status_set_elements( status, MPI_BYTE, 0, ierr )
ierr = MPI_SUCCESS
+ extrastate = extrastate
end
!
subroutine free_fn( extrastate, ierr )
use mpi
- integer value, ierr
- integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
+ integer ierr
+ integer (kind=MPI_ADDRESS_KIND) extrastate
integer freefncall
common /fnccalls/ freefncall
use mpi
integer ierr
logical complete
- integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
+ integer (kind=MPI_ADDRESS_KIND) extrastate
ierr = MPI_SUCCESS
+ complete=.true.
+ extrastate=extrastate
end
!
!
integer status(MPI_STATUS_SIZE)
integer request
external query_fn, free_fn, cancel_fn
- integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
+ integer (kind=MPI_ADDRESS_KIND) extrastate
integer freefncall
common /fnccalls/ freefncall
endif
myindex(rank+1) = mod( myindex(rank+1), 4 ) + 1
MTestGetIntracomm = comm .ne. MPI_COMM_NULL
+ qsmaller=.true.
end
!
subroutine MTestFreeComm( comm )