1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
11 integer left, right, rank, size
13 parameter (nrows=25,ncols=10)
14 integer buf(1:nrows,0:ncols+1)
17 logical mtestGetIntraComm
18 C Include addsize defines asize as an address-sized integer
22 call mtest_init( ierr )
24 call mpi_type_size( MPI_INTEGER, intsize, ierr )
25 do while( mtestGetIntraComm( comm, 2, .false. ) )
26 asize = nrows * (ncols + 2) * intsize
27 call mpi_win_create( buf, asize, intsize * nrows,
28 & MPI_INFO_NULL, comm, win, ierr )
30 call mpi_comm_size( comm, size, ierr )
31 call mpi_comm_rank( comm, rank, ierr )
37 if (right .ge. size) then
41 C Initialize the buffer
48 buf(i,j) = rank * (ncols * nrows) + i + (j-1) * nrows
51 call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr )
54 call mpi_get( buf(1,ncols+1), nrows, MPI_INTEGER, right,
55 & asize, nrows, MPI_INTEGER, win, ierr )
57 call mpi_get( buf(1,0), nrows, MPI_INTEGER, left,
58 & asize, nrows, MPI_INTEGER, win, ierr )
60 call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT +
61 & MPI_MODE_NOSUCCEED, win, ierr )
64 if (left .ne. MPI_PROC_NULL) then
66 ans = rank * (ncols * nrows) - nrows + i
67 if (buf(i,0) .ne. ans) then
69 if (errs .le. 10) then
70 print *, rank, ' buf(',i,',0) = ', buf(i,0),
76 if (right .ne. MPI_PROC_NULL) then
78 ans = (rank + 1)* (ncols * nrows) + i
79 if (buf(i,ncols+1) .ne. ans) then
81 if (errs .le. 10) then
82 print *, rank, ' buf(',i,',',ncols+1,') = ',
83 & buf(i,ncols+1), ' expected ', ans
88 call mpi_win_free( win, ierr )
89 call mtestFreeComm( comm )
92 call mtest_finalize( errs )
93 call mpi_finalize( ierr )