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 sendrecvrepl 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_sendrecvrepl( comm, errs ) 25 call mtestFreeComm( comm ) 26 enddo 27C 28 call MTest_Finalize( errs ) 29C 30 end 31C 32 subroutine test_pair_sendrecvrepl( comm, errs ) 33 implicit none 34 include 'mpif.h' 35 integer comm, errs 36 integer rank, size, ierr, next, prev, tag, count, i 37 integer TEST_SIZE 38 parameter (TEST_SIZE=2000) 39 integer status(MPI_STATUS_SIZE) 40 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE) 41 logical verbose 42 common /flags/ verbose 43C 44 if (verbose) then 45 print *, ' Sendrecv replace' 46 endif 47C 48 call mpi_comm_rank( comm, rank, ierr ) 49 call mpi_comm_size( comm, size, ierr ) 50 next = rank + 1 51 if (next .ge. size) next = 0 52C 53 prev = rank - 1 54 if (prev .lt. 0) prev = size - 1 55C 56 tag = 4456 57 count = TEST_SIZE / 3 58 59 if (rank .eq. 0) then 60C 61 call init_test_data(recv_buf, TEST_SIZE) 62C 63 do 11 i = count+1,TEST_SIZE 64 recv_buf(i) = 0.0 65 11 continue 66C 67 call MPI_Sendrecv_replace(recv_buf, count, MPI_REAL, 68 . next, tag, next, tag, 69 . comm, status, ierr) 70 71 call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, 72 . 'sendrecvreplace', errs ) 73 74 else if (prev .eq. 0) then 75 76 call clear_test_data(recv_buf,TEST_SIZE) 77 78 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, 79 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, 80 . status, ierr) 81 82 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, 83 . 'recv/send for replace', errs ) 84 85 call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, 86 . comm, ierr) 87 end if 88C 89 end 90