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