1C
2C Copyright (C) by Argonne National Laboratory
3C     See COPYRIGHT in top-level directory
4C
5
6C This program is based on the allpair.f test from the MPICH-1 test
7C (test/pt2pt/allpair.f), which in turn was inspired by a bug report from
8C fsset@corelli.lerc.nasa.gov (Scott Townsend)
9
10      program isend
11      implicit none
12      include 'mpif.h'
13      integer ierr, errs, comm
14      logical mtestGetIntraComm
15      logical verbose
16      common /flags/ verbose
17
18      errs = 0
19      verbose = .false.
20C      verbose = .true.
21      call MTest_Init( ierr )
22
23      do while ( mtestGetIntraComm( comm, 2, .false. ) )
24         call test_pair_isend( comm, errs )
25         call mtestFreeComm( comm )
26      enddo
27C
28      call MTest_Finalize( errs )
29C
30      end
31C
32      subroutine test_pair_isend( comm, errs )
33      implicit none
34      include 'mpif.h'
35      integer comm, errs
36      integer rank, size, ierr, next, prev, tag, count
37      integer TEST_SIZE
38      parameter (TEST_SIZE=2000)
39      integer status(MPI_STATUS_SIZE), requests(2)
40      integer statuses(MPI_STATUS_SIZE,2)
41      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
42      logical verbose
43      common /flags/ verbose
44C
45      if (verbose) then
46         print *, ' isend and irecv'
47      endif
48C
49C
50      call mpi_comm_rank( comm, rank, ierr )
51      call mpi_comm_size( comm, size, ierr )
52      next = rank + 1
53      if (next .ge. size) next = 0
54C
55      prev = rank - 1
56      if (prev .lt. 0) prev = size - 1
57C
58      tag = 2123
59      count = TEST_SIZE / 5
60C
61      call clear_test_data(recv_buf,TEST_SIZE)
62C
63      if (rank .eq. 0) then
64C
65         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,
66     .                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
67     .                  requests(1), ierr)
68C
69         call init_test_data(send_buf,TEST_SIZE)
70C
71         call MPI_Isend(send_buf, count, MPI_REAL, next, tag,
72     .                  comm, requests(2), ierr)
73C
74         call MPI_Waitall(2, requests, statuses, ierr)
75C
76         call rq_check( requests, 2, 'isend and irecv' )
77C
78         call msg_check( recv_buf, next, tag, count, statuses(1,1),
79     .        TEST_SIZE, 'isend and irecv', errs )
80C
81      else if (prev .eq. 0) then
82C
83         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
84     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
85     .                 status, ierr)
86C
87         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
88     .                   'isend and irecv', errs )
89C
90         call MPI_Isend(recv_buf, count, MPI_REAL, prev, tag,
91     .                  comm, requests(1), ierr)
92C
93         call MPI_Wait(requests(1), status, ierr)
94C
95         call rq_check( requests(1), 1, 'isend and irecv' )
96C
97      end if
98C
99      end
100