1 C -*- Mode: Fortran; -*-
3 C (C) 2012 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
6 C This program is based on the allpair.f test from the MPICH-1 test
7 C (test/pt2pt/allpair.f), which in turn was inspired by a bug report from
8 C fsset@corelli.lerc.nasa.gov (Scott Townsend)
13 integer ierr, errs, comm
14 logical mtestGetIntraComm
16 common /flags/ verbose
21 call MTest_Init( ierr )
23 do while ( mtestGetIntraComm( comm, 2, .false. ) )
24 call test_pair_send( comm, errs )
25 call test_pair_ssend( comm, errs )
26 !call test_pair_rsend( comm, errs )
27 call test_pair_isend( comm, errs )
28 !call test_pair_irsend( comm, errs )
29 call test_pair_issend( comm, errs )
30 !call test_pair_psend( comm, errs )
31 !call test_pair_prsend( comm, errs )
32 !call test_pair_pssend( comm, errs )
33 call test_pair_sendrecv( comm, errs )
34 call test_pair_sendrecvrepl( comm, errs )
35 call mtestFreeComm( comm )
38 call MTest_Finalize( errs )
39 call MPI_Finalize(ierr)
43 subroutine test_pair_send( comm, errs )
47 integer rank, size, ierr, next, prev, tag, count
49 parameter (TEST_SIZE=2000)
50 integer status(MPI_STATUS_SIZE)
51 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
53 common /flags/ verbose
56 print *, ' Send and recv'
59 call mpi_comm_rank( comm, rank, ierr )
60 call mpi_comm_size( comm, size, ierr )
62 if (next .ge. size) next = 0
65 if (prev .lt. 0) prev = size - 1
70 call clear_test_data(recv_buf,TEST_SIZE)
74 call init_test_data(send_buf,TEST_SIZE)
76 call MPI_Send(send_buf, count, MPI_REAL, next, tag,
79 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
80 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr)
82 call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,
83 . 'send and recv', errs )
84 else if (prev .eq. 0) then
85 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
86 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr)
88 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
89 . 'send and recv', errs )
91 call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr)
96 subroutine test_pair_rsend( comm, errs )
100 integer rank, size, ierr, next, prev, tag, count, i
102 parameter (TEST_SIZE=2000)
103 integer status(MPI_STATUS_SIZE), requests(1)
104 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
106 common /flags/ verbose
109 print *, ' Rsend and recv'
113 call mpi_comm_rank( comm, rank, ierr )
114 call mpi_comm_size( comm, size, ierr )
116 if (next .ge. size) next = 0
119 if (prev .lt. 0) prev = size - 1
122 count = TEST_SIZE / 3
124 call clear_test_data(recv_buf,TEST_SIZE)
126 if (rank .eq. 0) then
128 call init_test_data(send_buf,TEST_SIZE)
130 call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag,
131 . comm, status, ierr )
133 call MPI_Rsend(send_buf, count, MPI_REAL, next, tag,
136 call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr)
138 if (status(MPI_SOURCE) .ne. next) then
139 print *, 'Rsend: Incorrect source, expected', next,
140 . ', got', status(MPI_SOURCE)
144 if (status(MPI_TAG) .ne. tag) then
145 print *, 'Rsend: Incorrect tag, expected', tag,
146 . ', got', status(MPI_TAG)
150 call MPI_Get_count(status, MPI_REAL, i, ierr)
152 if (i .ne. count) then
153 print *, 'Rsend: Incorrect count, expected', count,
158 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
159 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
162 call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,
163 . 'rsend and recv', errs )
165 else if (prev .eq. 0) then
167 call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,
168 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
170 call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag,
172 call MPI_Wait( requests(1), status, ierr )
173 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
174 . 'rsend and recv', errs )
176 call MPI_Send(recv_buf, count, MPI_REAL, prev, tag,
182 subroutine test_pair_ssend( comm, errs )
186 integer rank, size, ierr, next, prev, tag, count, i
188 parameter (TEST_SIZE=2000)
189 integer status(MPI_STATUS_SIZE)
191 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
193 common /flags/ verbose
196 print *, ' Ssend and recv'
200 call mpi_comm_rank( comm, rank, ierr )
201 call mpi_comm_size( comm, size, ierr )
203 if (next .ge. size) next = 0
206 if (prev .lt. 0) prev = size - 1
209 count = TEST_SIZE / 3
211 call clear_test_data(recv_buf,TEST_SIZE)
213 if (rank .eq. 0) then
215 call init_test_data(send_buf,TEST_SIZE)
217 call MPI_Iprobe(MPI_ANY_SOURCE, tag,
218 . comm, flag, status, ierr)
221 print *, 'Ssend: Iprobe succeeded! source',
222 . status(MPI_SOURCE),
223 . ', tag', status(MPI_TAG)
227 call MPI_Ssend(send_buf, count, MPI_REAL, next, tag,
230 do while (.not. flag)
231 call MPI_Iprobe(MPI_ANY_SOURCE, tag,
232 . comm, flag, status, ierr)
235 if (status(MPI_SOURCE) .ne. next) then
236 print *, 'Ssend: Incorrect source, expected', next,
237 . ', got', status(MPI_SOURCE)
241 if (status(MPI_TAG) .ne. tag) then
242 print *, 'Ssend: Incorrect tag, expected', tag,
243 . ', got', status(MPI_TAG)
247 call MPI_Get_count(status, MPI_REAL, i, ierr)
249 if (i .ne. count) then
250 print *, 'Ssend: Incorrect count, expected', count,
255 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
256 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
259 call msg_check( recv_buf, next, tag, count, status,
260 . TEST_SIZE, 'ssend and recv', errs )
262 else if (prev .eq. 0) then
264 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
265 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
268 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
269 . 'ssend and recv', errs )
271 call MPI_Ssend(recv_buf, count, MPI_REAL, prev, tag,
277 subroutine test_pair_isend( comm, errs )
281 integer rank, size, ierr, next, prev, tag, count
283 parameter (TEST_SIZE=2000)
284 integer status(MPI_STATUS_SIZE), requests(2)
285 integer statuses(MPI_STATUS_SIZE,2)
286 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
288 common /flags/ verbose
291 print *, ' isend and irecv'
295 call mpi_comm_rank( comm, rank, ierr )
296 call mpi_comm_size( comm, size, ierr )
298 if (next .ge. size) next = 0
301 if (prev .lt. 0) prev = size - 1
304 count = TEST_SIZE / 5
306 call clear_test_data(recv_buf,TEST_SIZE)
308 if (rank .eq. 0) then
310 call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,
311 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
314 call init_test_data(send_buf,TEST_SIZE)
316 call MPI_Isend(send_buf, count, MPI_REAL, next, tag,
317 . comm, requests(2), ierr)
319 call MPI_Waitall(2, requests, statuses, ierr)
321 call rq_check( requests, 2, 'isend and irecv' )
323 call msg_check( recv_buf, next, tag, count, statuses(1,1),
324 . TEST_SIZE, 'isend and irecv', errs )
326 else if (prev .eq. 0) then
328 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
329 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
332 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
333 . 'isend and irecv', errs )
335 call MPI_Isend(recv_buf, count, MPI_REAL, prev, tag,
336 . comm, requests(1), ierr)
338 call MPI_Wait(requests(1), status, ierr)
340 C call rq_check( requests(1), 1, 'isend and irecv' )
346 subroutine test_pair_irsend( comm, errs )
350 integer rank, size, ierr, next, prev, tag, count, index, i
353 parameter (TEST_SIZE=2000)
354 integer status(MPI_STATUS_SIZE), requests(2)
355 integer statuses(MPI_STATUS_SIZE,2)
357 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
359 common /flags/ verbose
362 print *, ' Irsend and irecv'
365 call mpi_comm_rank( comm, rank, ierr )
366 call mpi_comm_size( comm, size, ierr )
368 if (next .ge. size) next = 0
371 if (prev .lt. 0) prev = size - 1
373 call mpi_comm_dup( comm, dupcom, ierr )
376 count = TEST_SIZE / 3
378 call clear_test_data(recv_buf,TEST_SIZE)
380 if (rank .eq. 0) then
382 call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,
383 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
386 call init_test_data(send_buf,TEST_SIZE)
388 call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, next, 0,
389 . MPI_BOTTOM, 0, MPI_INTEGER, next, 0,
390 . dupcom, status, ierr )
392 call MPI_Irsend(send_buf, count, MPI_REAL, next, tag,
393 . comm, requests(2), ierr)
396 do while (index .ne. 1)
397 call MPI_Waitany(2, requests, index, statuses, ierr)
400 call rq_check( requests(1), 1, 'irsend and irecv' )
402 call msg_check( recv_buf, next, tag, count, statuses,
403 . TEST_SIZE, 'irsend and irecv', errs )
405 else if (prev .eq. 0) then
407 call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,
408 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
411 call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, prev, 0,
412 . MPI_BOTTOM, 0, MPI_INTEGER, prev, 0,
413 . dupcom, status, ierr )
416 do while (.not. flag)
417 call MPI_Test(requests(1), flag, status, ierr)
420 call rq_check( requests, 1, 'irsend and irecv (test)' )
422 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
423 . 'irsend and irecv', errs )
425 call MPI_Irsend(recv_buf, count, MPI_REAL, prev, tag,
426 . comm, requests(1), ierr)
428 call MPI_Waitall(1, requests, statuses, ierr)
430 call rq_check( requests, 1, 'irsend and irecv' )
434 call mpi_comm_free( dupcom, ierr )
438 subroutine test_pair_issend( comm, errs )
442 integer rank, size, ierr, next, prev, tag, count, index
444 parameter (TEST_SIZE=2000)
445 integer status(MPI_STATUS_SIZE), requests(2)
446 integer statuses(MPI_STATUS_SIZE,2)
448 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
450 common /flags/ verbose
453 print *, ' issend and irecv (testall)'
457 call mpi_comm_rank( comm, rank, ierr )
458 call mpi_comm_size( comm, size, ierr )
460 if (next .ge. size) next = 0
463 if (prev .lt. 0) prev = size - 1
466 count = TEST_SIZE / 3
468 call clear_test_data(recv_buf,TEST_SIZE)
470 if (rank .eq. 0) then
472 call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,
473 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
476 call init_test_data(send_buf,TEST_SIZE)
478 call MPI_Issend(send_buf, count, MPI_REAL, next, tag,
479 . comm, requests(2), ierr)
482 do while (.not. flag)
483 call MPI_Testall(2, requests, flag, statuses, ierr)
486 call rq_check( requests, 2, 'issend and irecv (testall)' )
488 call msg_check( recv_buf, next, tag, count, statuses(1,1),
489 . TEST_SIZE, 'issend and recv (testall)', errs )
491 else if (prev .eq. 0) then
493 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
494 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
497 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
498 . 'issend and recv', errs )
500 call MPI_Issend(recv_buf, count, MPI_REAL, prev, tag,
501 . comm, requests(1), ierr)
504 do while (.not. flag)
505 call MPI_Testany(1, requests(1), index, flag,
506 . statuses(1,1), ierr)
509 call rq_check( requests, 1, 'issend and recv (testany)' )
515 subroutine test_pair_psend( comm, errs )
519 integer rank, size, ierr, next, prev, tag, count, i
521 parameter (TEST_SIZE=2000)
522 integer status(MPI_STATUS_SIZE)
523 integer statuses(MPI_STATUS_SIZE,2), requests(2)
524 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
526 common /flags/ verbose
529 print *, ' Persistent send and recv'
532 call mpi_comm_rank( comm, rank, ierr )
533 call mpi_comm_size( comm, size, ierr )
535 if (next .ge. size) next = 0
538 if (prev .lt. 0) prev = size - 1
541 count = TEST_SIZE / 5
543 call clear_test_data(recv_buf,TEST_SIZE)
544 call MPI_Recv_init(recv_buf, TEST_SIZE, MPI_REAL,
545 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
548 if (rank .eq. 0) then
550 call init_test_data(send_buf,TEST_SIZE)
552 call MPI_Send_init(send_buf, count, MPI_REAL, next, tag,
553 . comm, requests(1), ierr)
555 call MPI_Startall(2, requests, ierr)
556 call MPI_Waitall(2, requests, statuses, ierr)
558 call msg_check( recv_buf, next, tag, count, statuses(1,2),
559 . TEST_SIZE, 'persistent send/recv', errs )
561 call MPI_Request_free(requests(1), ierr)
563 else if (prev .eq. 0) then
565 call MPI_Send_init(send_buf, count, MPI_REAL, prev, tag,
566 . comm, requests(1), ierr)
567 call MPI_Start(requests(2), ierr)
568 call MPI_Wait(requests(2), status, ierr)
570 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
571 * 'persistent send/recv', errs )
574 send_buf(i) = recv_buf(i)
577 call MPI_Start(requests(1), ierr)
578 call MPI_Wait(requests(1), status, ierr)
580 call MPI_Request_free(requests(1), ierr)
583 call dummyRef( send_buf, count, ierr )
584 call MPI_Request_free(requests(2), ierr)
588 subroutine test_pair_prsend( comm, errs )
592 integer rank, size, ierr, next, prev, tag, count, index, i
593 integer outcount, indices(2)
595 parameter (TEST_SIZE=2000)
596 integer statuses(MPI_STATUS_SIZE,2), requests(2)
597 integer status(MPI_STATUS_SIZE)
599 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
601 common /flags/ verbose
604 print *, ' Persistent Rsend and recv'
607 call mpi_comm_rank( comm, rank, ierr )
608 call mpi_comm_size( comm, size, ierr )
610 if (next .ge. size) next = 0
613 if (prev .lt. 0) prev = size - 1
616 count = TEST_SIZE / 3
618 call clear_test_data(recv_buf,TEST_SIZE)
620 call MPI_Recv_init(recv_buf, TEST_SIZE, MPI_REAL,
621 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
624 if (rank .eq. 0) then
626 call MPI_Rsend_init(send_buf, count, MPI_REAL, next, tag,
627 . comm, requests(1), ierr)
629 call init_test_data(send_buf,TEST_SIZE)
631 call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag,
632 . comm, status, ierr )
634 call MPI_Startall(2, requests, ierr)
638 do while (index .ne. 2)
639 call MPI_Waitsome(2, requests, outcount,
640 . indices, statuses, ierr)
642 if (indices(i) .eq. 2) then
643 call msg_check( recv_buf, next, tag, count,
644 . statuses(1,i), TEST_SIZE, 'waitsome', errs )
650 call MPI_Request_free(requests(1), ierr)
651 else if (prev .eq. 0) then
653 call MPI_Rsend_init(send_buf, count, MPI_REAL, prev, tag,
654 . comm, requests(1), ierr)
656 call MPI_Start(requests(2), ierr)
658 call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag,
662 do while (.not. flag)
663 call MPI_Test(requests(2), flag, status, ierr)
665 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
669 send_buf(i) = recv_buf(i)
672 call MPI_Start(requests(1), ierr)
673 call MPI_Wait(requests(1), status, ierr)
675 call MPI_Request_free(requests(1), ierr)
678 call dummyRef( send_buf, count, ierr )
679 call MPI_Request_free(requests(2), ierr)
683 subroutine test_pair_pssend( comm, errs )
687 integer rank, size, ierr, next, prev, tag, count, index, i
688 integer outcount, indices(2)
690 parameter (TEST_SIZE=2000)
691 integer statuses(MPI_STATUS_SIZE,2), requests(2)
692 integer status(MPI_STATUS_SIZE)
694 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
696 common /flags/ verbose
699 print *, ' Persistent Ssend and recv'
702 call mpi_comm_rank( comm, rank, ierr )
703 call mpi_comm_size( comm, size, ierr )
705 if (next .ge. size) next = 0
708 if (prev .lt. 0) prev = size - 1
711 count = TEST_SIZE / 3
713 call clear_test_data(recv_buf,TEST_SIZE)
715 call MPI_Recv_init(recv_buf, TEST_SIZE, MPI_REAL,
716 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
719 if (rank .eq. 0) then
721 call MPI_Ssend_init(send_buf, count, MPI_REAL, next, tag,
722 . comm, requests(2), ierr)
724 call init_test_data(send_buf,TEST_SIZE)
726 call MPI_Startall(2, requests, ierr)
729 do while (index .ne. 1)
730 call MPI_Testsome(2, requests, outcount,
731 . indices, statuses, ierr)
733 if (indices(i) .eq. 1) then
734 call msg_check( recv_buf, next, tag, count,
735 . statuses(1,i), TEST_SIZE, 'testsome', errs )
741 call MPI_Request_free(requests(2), ierr)
743 else if (prev .eq. 0) then
745 call MPI_Ssend_init(send_buf, count, MPI_REAL, prev, tag,
746 . comm, requests(2), ierr)
748 call MPI_Start(requests(1), ierr)
751 do while (.not. flag)
752 call MPI_Testany(1, requests(1), index, flag,
753 . statuses(1,1), ierr)
755 call msg_check( recv_buf, prev, tag, count, statuses(1,1),
756 . TEST_SIZE, 'testany', errs )
759 send_buf(i) = recv_buf(i)
762 call MPI_Start(requests(2), ierr)
763 call MPI_Wait(requests(2), status, ierr)
765 call MPI_Request_free(requests(2), ierr)
769 call dummyRef( send_buf, count, ierr )
770 call MPI_Request_free(requests(1), ierr)
774 subroutine test_pair_sendrecv( comm, errs )
778 integer rank, size, ierr, next, prev, tag, count
780 parameter (TEST_SIZE=2000)
781 integer status(MPI_STATUS_SIZE)
782 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
784 common /flags/ verbose
791 call mpi_comm_rank( comm, rank, ierr )
792 call mpi_comm_size( comm, size, ierr )
794 if (next .ge. size) next = 0
797 if (prev .lt. 0) prev = size - 1
800 count = TEST_SIZE / 5
802 call clear_test_data(recv_buf,TEST_SIZE)
804 if (rank .eq. 0) then
806 call init_test_data(send_buf,TEST_SIZE)
808 call MPI_Sendrecv(send_buf, count, MPI_REAL, next, tag,
809 . recv_buf, count, MPI_REAL, next, tag,
810 . comm, status, ierr)
812 call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,
815 else if (prev .eq. 0) then
817 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
818 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
821 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
822 . 'recv/send', errs )
824 call MPI_Send(recv_buf, count, MPI_REAL, prev, tag,
830 subroutine test_pair_sendrecvrepl( comm, errs )
834 integer rank, size, ierr, next, prev, tag, count, i
836 parameter (TEST_SIZE=2000)
837 integer status(MPI_STATUS_SIZE)
838 real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)
840 common /flags/ verbose
843 print *, ' Sendrecv replace'
846 call mpi_comm_rank( comm, rank, ierr )
847 call mpi_comm_size( comm, size, ierr )
849 if (next .ge. size) next = 0
852 if (prev .lt. 0) prev = size - 1
855 count = TEST_SIZE / 3
857 if (rank .eq. 0) then
859 call init_test_data(recv_buf, TEST_SIZE)
861 do 11 i = count+1,TEST_SIZE
865 call MPI_Sendrecv_replace(recv_buf, count, MPI_REAL,
866 . next, tag, next, tag,
867 . comm, status, ierr)
869 call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,
870 . 'sendrecvreplace', errs )
872 else if (prev .eq. 0) then
874 call clear_test_data(recv_buf,TEST_SIZE)
876 call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,
877 . MPI_ANY_SOURCE, MPI_ANY_TAG, comm,
880 call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,
881 . 'recv/send for replace', errs )
883 call MPI_Send(recv_buf, count, MPI_REAL, prev, tag,
889 c------------------------------------------------------------------------------
891 c Check for correct source, tag, count, and data in test message.
893 c------------------------------------------------------------------------------
894 subroutine msg_check( recv_buf, source, tag, count, status, n,
900 integer source, tag, count, rank, status(MPI_STATUS_SIZE)
903 integer ierr, recv_src, recv_tag, recv_count
905 recv_src = status(MPI_SOURCE)
906 recv_tag = status(MPI_TAG)
907 call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr )
908 call MPI_Get_count(status, MPI_REAL, recv_count, ierr)
910 if (recv_src .ne. source) then
911 print *, '[', rank, '] Unexpected source:', recv_src,
916 if (recv_tag .ne. tag) then
917 print *, '[', rank, '] Unexpected tag:', recv_tag, ' in ', name
921 if (recv_count .ne. count) then
922 print *, '[', rank, '] Unexpected count:', recv_count,
927 call verify_test_data(recv_buf, count, n, name, errs )
930 c------------------------------------------------------------------------------
932 c Check that requests have been set to null
934 c------------------------------------------------------------------------------
935 subroutine rq_check( requests, n, msg )
937 integer n, requests(n)
942 if (requests(i) .ne. MPI_REQUEST_NULL) then
943 print *, 'Nonnull request in ', msg
948 c------------------------------------------------------------------------------
950 c Initialize test data buffer with integral sequence.
952 c------------------------------------------------------------------------------
953 subroutine init_test_data(buf,n)
963 c------------------------------------------------------------------------------
965 c Clear test data buffer
967 c------------------------------------------------------------------------------
968 subroutine clear_test_data(buf, n)
979 c------------------------------------------------------------------------------
981 c Verify test data buffer
983 c------------------------------------------------------------------------------
984 subroutine verify_test_data( buf, count, n, name, errs )
990 integer count, ierr, i
993 if (buf(i) .ne. REAL(i)) then
994 print 100, buf(i), i, count, name
999 do 20 i = count + 1, n
1000 if (buf(i) .ne. 0.) then
1001 print 100, buf(i), i, n, name
1006 100 format('Invalid data', f6.1, ' at ', i4, ' of ', i4, ' in ', a)
1010 C This routine is used to prevent the compiler from deallocating the
1011 C array "a", which may happen in some of the tests (see the text in
1012 C the MPI standard about why this may be a problem in valid Fortran
1013 C codes). Without this, for example, tests fail with the Cray ftn
1016 subroutine dummyRef( a, n, ie )
1019 C This condition will never be true, but the compile won't know that
1020 if (ie .eq. -1) then