4 integer count, errcnt, size, rank, ierr, i
9 parameter (max_size=100)
10 integer intin(max_size), intout(max_size), intsol(max_size)
11 real realin(max_size), realout(max_size), realsol(max_size)
12 double precision dblein(max_size), dbleout(max_size),
14 complex cplxin(max_size), cplxout(max_size), cplxsol(max_size)
15 logical login(max_size), logout(max_size), logsol(max_size)
25 call MPI_COMM_RANK( comm, rank, ierr )
27 call MPI_COMM_SIZE( comm, size, ierr )
31 if (world_rank .eq. 0) print *, ' MPI_SUM'
39 call MPI_Allreduce( intin, intout, count,
40 * MPI_INTEGER, MPI_SUM, comm, ierr )
42 if (intout(i).ne.intsol(i)) then
48 print *, 'Error for type MPI_INTEGER and op MPI_SUM'
58 call MPI_Allreduce( realin, realout, count,
59 * MPI_REAL, MPI_SUM, comm, ierr )
61 if (realout(i).ne.realsol(i)) then
67 print *, 'Error for type MPI_REAL and op MPI_SUM'
77 call MPI_Allreduce( dblein, dbleout, count,
78 * MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
80 if (dbleout(i).ne.dblesol(i)) then
86 print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_SUM'
96 call MPI_Allreduce( cplxin, cplxout, count,
97 * MPI_COMPLEX, MPI_SUM, comm, ierr )
99 if (cplxout(i).ne.cplxsol(i)) then
105 print *, 'Error for type MPI_COMPLEX and op MPI_SUM'
109 if (errcnt .gt. 0) then
110 print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_SUM'
115 if (world_rank .eq. 0) print *, ' MPI_PROD'
120 intsol(i) = (i)**(size)
123 call MPI_Allreduce( intin, intout, count,
124 * MPI_INTEGER, MPI_PROD, comm, ierr )
126 if (intout(i).ne.intsol(i)) then
132 print *, 'Error for type MPI_INTEGER and op MPI_PROD'
139 realsol(i) = (i)**(size)
142 call MPI_Allreduce( realin, realout, count,
143 * MPI_REAL, MPI_PROD, comm, ierr )
145 if (realout(i).ne.realsol(i)) then
151 print *, 'Error for type MPI_REAL and op MPI_PROD'
158 dblesol(i) = (i)**(size)
161 call MPI_Allreduce( dblein, dbleout, count,
162 * MPI_DOUBLE_PRECISION, MPI_PROD, comm, ierr )
164 if (dbleout(i).ne.dblesol(i)) then
170 print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_PROD'
177 cplxsol(i) = (i)**(size)
180 call MPI_Allreduce( cplxin, cplxout, count,
181 * MPI_COMPLEX, MPI_PROD, comm, ierr )
183 if (cplxout(i).ne.cplxsol(i)) then
189 print *, 'Error for type MPI_COMPLEX and op MPI_PROD'
193 if (errcnt .gt. 0) then
194 print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_PROD'
199 if (world_rank .eq. 0) print *, ' MPI_MAX'
203 intin(i) = (rank + i)
204 intsol(i) = (size - 1 + i)
207 call MPI_Allreduce( intin, intout, count,
208 * MPI_INTEGER, MPI_MAX, comm, ierr )
210 if (intout(i).ne.intsol(i)) then
216 print *, 'Error for type MPI_INTEGER and op MPI_MAX'
222 realin(i) = (rank + i)
223 realsol(i) = (size - 1 + i)
226 call MPI_Allreduce( realin, realout, count,
227 * MPI_REAL, MPI_MAX, comm, ierr )
229 if (realout(i).ne.realsol(i)) then
235 print *, 'Error for type MPI_REAL and op MPI_MAX'
241 dblein(i) = (rank + i)
242 dblesol(i) = (size - 1 + i)
245 call MPI_Allreduce( dblein, dbleout, count,
246 * MPI_DOUBLE_PRECISION, MPI_MAX, comm, ierr )
248 if (dbleout(i).ne.dblesol(i)) then
254 print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_MAX'
258 if (errcnt .gt. 0) then
259 print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_MAX'
264 if (world_rank .eq. 0) print *, ' MPI_MIN'
268 intin(i) = (rank + i)
272 call MPI_Allreduce( intin, intout, count,
273 * MPI_INTEGER, MPI_MIN, comm, ierr )
275 if (intout(i).ne.intsol(i)) then
281 print *, 'Error for type MPI_INTEGER and op MPI_MIN'
287 realin(i) = (rank + i)
291 call MPI_Allreduce( realin, realout, count,
292 * MPI_REAL, MPI_MIN, comm, ierr )
294 if (realout(i).ne.realsol(i)) then
300 print *, 'Error for type MPI_REAL and op MPI_MIN'
306 dblein(i) = (rank + i)
310 call MPI_Allreduce( dblein, dbleout, count,
311 * MPI_DOUBLE_PRECISION, MPI_MIN, comm, ierr )
313 if (dbleout(i).ne.dblesol(i)) then
319 print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_MIN'
323 if (errcnt .gt. 0) then
324 print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_MIN'
329 if (world_rank .eq. 0) print *, ' MPI_LOR'
333 login(i) = (mod(rank,2) .eq. 1)
334 logsol(i) = (size .gt. 1)
337 call MPI_Allreduce( login, logout, count,
338 * MPI_LOGICAL, MPI_LOR, comm, ierr )
340 if (logout(i).neqv.logsol(i)) then
346 print *, 'Error for type MPI_LOGICAL and op MPI_LOR'
350 if (errcnt .gt. 0) then
351 print *, 'Found ', errcnt, ' errors on ', rank,
364 call MPI_Allreduce( login, logout, count,
365 * MPI_LOGICAL, MPI_LOR, comm, ierr )
367 if (logout(i).neqv.logsol(i)) then
373 print *, 'Error for type MPI_LOGICAL and op MPI_LOR'
377 if (errcnt .gt. 0) then
378 print *, 'Found ', errcnt, ' errors on ', rank,
384 if (world_rank .eq. 0) print *, ' MPI_LXOR'
388 login(i) = (rank .eq. 1)
389 logsol(i) = (size .gt. 1)
392 call MPI_Allreduce( login, logout, count,
393 * MPI_LOGICAL, MPI_LXOR, comm, ierr )
395 if (logout(i).neqv.logsol(i)) then
401 print *, 'Error for type MPI_LOGICAL and op MPI_LXOR'
405 if (errcnt .gt. 0) then
406 print *, 'Found ',errcnt,' errors on ', rank, ' for MPI_LXOR'
417 call MPI_Allreduce( login, logout, count,
418 * MPI_LOGICAL, MPI_LXOR, comm, ierr )
420 if (logout(i).neqv.logsol(i)) then
426 print *, 'Error for type MPI_LOGICAL and op MPI_LXOR'
430 if (errcnt .gt. 0) then
431 print *, 'Found ',errcnt,' errors on ',rank,' for MPI_LXOR(0)'
439 logsol(i) = mod(size,2) .ne. 0
442 call MPI_Allreduce( login, logout, count,
443 * MPI_LOGICAL, MPI_LXOR, comm, ierr )
445 if (logout(i).neqv.logsol(i)) then
451 print *, 'Error for type MPI_LOGICAL and op MPI_LXOR'
455 if (errcnt .gt. 0) then
456 print *, 'Found ',errcnt,' errors on ',rank,' for MPI_LXOR(1-0)'
461 if (world_rank .eq. 0) print *, ' MPI_LAND'
465 login(i) = (mod(rank,2) .eq. 1)
469 call MPI_Allreduce( login, logout, count,
470 * MPI_LOGICAL, MPI_LAND, comm, ierr )
472 if (logout(i).neqv.logsol(i)) then
478 print *, 'Error for type MPI_LOGICAL and op MPI_LAND'
482 if (errcnt .gt. 0) then
483 print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_LAND'
496 call MPI_Allreduce( login, logout, count,
497 * MPI_LOGICAL, MPI_LAND, comm, ierr )
499 if (logout(i).neqv.logsol(i)) then
505 print *, 'Error for type MPI_LOGICAL and op MPI_LAND'
509 if (errcnt .gt. 0) then
510 print *, 'Found ',errcnt,' errors on ',rank,
511 * ' for MPI_LAND(true)'
516 if (world_rank .eq. 0) print *, ' MPI_BOR'
517 if (size .lt. 3) then
521 intin(i) = mod(rank,4)
525 call MPI_Allreduce( intin, intout, count,
526 * MPI_INTEGER, MPI_BOR, comm, ierr )
528 if (intout(i).ne.intsol(i)) then
534 print *, 'Error for type MPI_INTEGER and op MPI_BOR'
541 intin(i) = mod(rank,4)
545 call MPI_Allreduce( intin, intout, count,
546 * MPI_INTEGER, MPI_BOR, comm, ierr )
548 if (intout(i).ne.intsol(i)) then
554 print *, 'Error for type MPI_INTEGER and op MPI_BOR'
558 if (errcnt .gt. 0) then
559 print *, 'Found ', errcnt, ' errors on ', rank,
565 if (world_rank .eq. 0) print *, ' MPI_BAND'
566 C See bottom for function definitions
570 intin(i) = ibxandval(rank,size,i)
574 call MPI_Allreduce( intin, intout, count,
575 * MPI_INTEGER, MPI_BAND, comm, ierr )
577 if (intout(i).ne.intsol(i)) then
583 print *, 'Error for type MPI_INTEGER and op MPI_BAND'
587 if (errcnt .gt. 0) then
588 print *, 'Found ', errcnt, ' errors on ', rank,
596 intin(i) = ibxandval1(rank,size,i)
600 call MPI_Allreduce( intin, intout, count,
601 * MPI_INTEGER, MPI_BAND, comm, ierr )
603 if (intout(i).ne.intsol(i)) then
609 print *, 'Error for type MPI_INTEGER and op MPI_BAND'
613 if (errcnt .gt. 0) then
614 print *, 'Found ', errcnt, ' errors on ', rank,
620 if (world_rank .eq. 0) print *, ' MPI_BXOR'
621 C See below for function definitions
625 intin(i) = ibxorval1(rank)
626 intsol(i) = ibxorsol1(size)
629 call MPI_Allreduce( intin, intout, count,
630 * MPI_INTEGER, MPI_BXOR, comm, ierr )
632 if (intout(i).ne.intsol(i)) then
638 print *, 'Error for type MPI_INTEGER and op MPI_BXOR'
642 if (errcnt .gt. 0) then
643 print *, 'Found ', errcnt, ' errors on ', rank,
655 call MPI_Allreduce( intin, intout, count,
656 * MPI_INTEGER, MPI_BXOR, comm, ierr )
658 if (intout(i).ne.intsol(i)) then
664 print *, 'Error for type MPI_INTEGER and op MPI_BXOR'
668 if (errcnt .gt. 0) then
669 print *, 'Found ', errcnt, ' errors on ', rank,
674 C Assumes -1 == all bits set
679 if (mod(size,2) .eq. 0) then
686 call MPI_Allreduce( intin, intout, count,
687 * MPI_INTEGER, MPI_BXOR, comm, ierr )
689 if (intout(i).ne.intsol(i)) then
695 print *, 'Error for type MPI_INTEGER and op MPI_BXOR'
699 if (errcnt .gt. 0) then
700 print *, 'Found ', errcnt, ' errors on ', rank,
701 * ' for MPI_BXOR(1-0)'
706 if (world_rank .eq. 0) print *, ' MPI_MAXLOC'
710 intin(2*i-1) = (rank + i)
712 intsol(2*i-1) = (size - 1 + i)
713 intsol(2*i) = (size-1)
717 call MPI_Allreduce( intin, intout, count,
718 * MPI_2INTEGER, MPI_MAXLOC, comm, ierr )
720 if (intout(2*i-1) .ne. intsol(2*i-1) .or.
721 * intout(2*i) .ne. intsol(2*i)) then
727 print *, 'Error for type MPI_2INTEGER and op MPI_MAXLOC'
733 realin(2*i-1) = (rank + i)
735 realsol(2*i-1) = (size - 1 + i)
736 realsol(2*i) = (size-1)
740 call MPI_Allreduce( realin, realout, count,
741 * MPI_2REAL, MPI_MAXLOC, comm, ierr )
743 if (realout(2*i-1) .ne. realsol(2*i-1) .or.
744 * realout(2*i) .ne. realsol(2*i)) then
750 print *, 'Error for type MPI_2REAL and op MPI_MAXLOC'
755 ! do 23060 i=1, count
756 ! dblein(2*i-1) = (rank + i)
758 ! dblesol(2*i-1) = (size - 1 + i)
759 ! dblesol(2*i) = (size-1)
763 ! call MPI_Allreduce( dblein, dbleout, count,
764 ! * MPI_2DOUBLE_PRECISION, MPI_MAXLOC, comm, ierr )
765 ! do 23061 i=1, count
766 ! if (dbleout(2*i-1) .ne. dblesol(2*i-1) .or.
767 ! * dbleout(2*i) .ne. dblesol(2*i)) then
768 ! errcnt = errcnt + 1
774 ! * 'Error for type MPI_2DOUBLE_PRECISION and op MPI_MAXLOC'
779 if (errcnt .gt. 0) then
780 print *, 'Found ', errcnt, ' errors on ', rank,
786 if (world_rank .eq. 0) print *, ' MPI_MINLOC'
791 intin(2*i-1) = (rank + i)
798 call MPI_Allreduce( intin, intout, count,
799 * MPI_2INTEGER, MPI_MINLOC, comm, ierr )
801 if (intout(2*i-1) .ne. intsol(2*i-1) .or.
802 * intout(2*i) .ne. intsol(2*i)) then
808 print *, 'Error for type MPI_2INTEGER and op MPI_MINLOC'
814 realin(2*i-1) = (rank + i)
821 call MPI_Allreduce( realin, realout, count,
822 * MPI_2REAL, MPI_MINLOC, comm, ierr )
824 if (realout(2*i-1) .ne. realsol(2*i-1) .or.
825 * realout(2*i) .ne. realsol(2*i)) then
831 print *, 'Error for type MPI_2REAL and op MPI_MINLOC'
836 ! do 23066 i=1, count
837 ! dblein(2*i-1) = (rank + i)
844 ! call MPI_Allreduce( dblein, dbleout, count,
845 ! * MPI_2DOUBLE_PRECISION, MPI_MINLOC, comm, ierr )
846 ! do 23067 i=1, count
847 ! if (dbleout(2*i-1) .ne. dblesol(2*i-1) .or.
848 ! * dbleout(2*i) .ne. dblesol(2*i)) then
849 ! errcnt = errcnt + 1
855 ! * 'Error for type MPI_2DOUBLE_PRECISION and op MPI_MINLOC'
859 if (errcnt .gt. 0) then
860 print *, 'Found ', errcnt, ' errors on ', rank,
865 call MPI_Finalize( ierr )
868 integer function ibxorval1( ir )
870 if (ir .eq. 1) ibxorval1 = 16+32+64+128
874 integer function ibxorsol1( is )
876 if (is .gt. 1) ibxorsol1 = 16+32+64+128
881 C Assumes -1 == all bits set
882 integer function ibxandval( ir, is, i )
885 if (ir .eq. is - 1) ibxandval = i
889 integer function ibxandval1( ir, is, i )
892 if (ir .eq. is - 1) ibxandval1 = i