teshsuite/smpi/mpich-test/coll/allredf.f

   1
   2         program main
   3         include 'mpif.h'
   4         integer count, errcnt, size, rank, ierr, i
   5         integer comm
   6         logical fnderr
   7         integer max_size
   8         integer world_rank
   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),
  13      *                   dblesol(max_size)
  14         complex cplxin(max_size), cplxout(max_size), cplxsol(max_size)
  15         logical login(max_size), logout(max_size), logsol(max_size)
  16 C
  17 C
  18 C
  19 C       Declare work areas
  20 C
  21         call MPI_INIT( ierr )
  22
  23         errcnt = 0
  24         comm = MPI_COMM_WORLD
  25         call MPI_COMM_RANK( comm, rank, ierr )
  26         world_rank = rank
  27         call MPI_COMM_SIZE( comm, size, ierr )
  28         count = 10
  29
  30 C Test sum
  31         if (world_rank .eq. 0) print *, ' MPI_SUM'
  32
  33        fnderr = .false.
  34        do 23000 i=1,count
  35         intin(i) = i
  36         intsol(i) = i*size
  37         intout(i) = 0
  38 23000   continue
  39        call MPI_Allreduce( intin, intout, count,
  40      *      MPI_INTEGER, MPI_SUM, comm, ierr )
  41               do 23001 i=1,count
  42         if (intout(i).ne.intsol(i)) then
  43             errcnt = errcnt + 1
  44             fnderr = .true.
  45         endif
  46 23001   continue
  47         if (fnderr) then
  48           print *, 'Error for type MPI_INTEGER and op MPI_SUM'
  49         endif
  50
  51
  52        fnderr = .false.
  53        do 23002 i=1,count
  54         realin(i) = i
  55         realsol(i) = i*size
  56         realout(i) = 0
  57 23002   continue
  58        call MPI_Allreduce( realin, realout, count,
  59      *      MPI_REAL, MPI_SUM, comm, ierr )
  60               do 23003 i=1,count
  61         if (realout(i).ne.realsol(i)) then
  62             errcnt = errcnt + 1
  63             fnderr = .true.
  64         endif
  65 23003   continue
  66         if (fnderr) then
  67           print *, 'Error for type MPI_REAL and op MPI_SUM'
  68         endif
  69
  70
  71        fnderr = .false.
  72        do 23004 i=1,count
  73         dblein(i) = i
  74         dblesol(i) = i*size
  75         dbleout(i) = 0
  76 23004   continue
  77        call MPI_Allreduce( dblein, dbleout, count,
  78      *      MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
  79               do 23005 i=1,count
  80         if (dbleout(i).ne.dblesol(i)) then
  81             errcnt = errcnt + 1
  82             fnderr = .true.
  83         endif
  84 23005   continue
  85         if (fnderr) then
  86           print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_SUM'
  87         endif
  88
  89
  90        fnderr = .false.
  91        do 23006 i=1,count
  92         cplxin(i) = i
  93         cplxsol(i) = i*size
  94         cplxout(i) = 0
  95 23006   continue
  96        call MPI_Allreduce( cplxin, cplxout, count,
  97      *      MPI_COMPLEX, MPI_SUM, comm, ierr )
  98               do 23007 i=1,count
  99         if (cplxout(i).ne.cplxsol(i)) then
 100             errcnt = errcnt + 1
 101             fnderr = .true.
 102         endif
 103 23007   continue
 104         if (fnderr) then
 105           print *, 'Error for type MPI_COMPLEX and op MPI_SUM'
 106         endif
 107
 108
 109         if (errcnt .gt. 0) then
 110         print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_SUM'
 111         endif
 112         errcnt = 0
 113
 114 C Test product
 115         if (world_rank .eq. 0) print *, ' MPI_PROD'
 116
 117        fnderr = .false.
 118        do 23008 i=1,count
 119         intin(i) = i
 120         intsol(i) = (i)**(size)
 121         intout(i) = 0
 122 23008   continue
 123        call MPI_Allreduce( intin, intout, count,
 124      *      MPI_INTEGER, MPI_PROD, comm, ierr )
 125               do 23009 i=1,count
 126         if (intout(i).ne.intsol(i)) then
 127             errcnt = errcnt + 1
 128             fnderr = .true.
 129         endif
 130 23009   continue
 131         if (fnderr) then
 132           print *, 'Error for type MPI_INTEGER and op MPI_PROD'
 133         endif
 134
 135
 136        fnderr = .false.
 137        do 23010 i=1,count
 138         realin(i) = i
 139         realsol(i) = (i)**(size)
 140         realout(i) = 0
 141 23010   continue
 142        call MPI_Allreduce( realin, realout, count,
 143      *      MPI_REAL, MPI_PROD, comm, ierr )
 144               do 23011 i=1,count
 145         if (realout(i).ne.realsol(i)) then
 146             errcnt = errcnt + 1
 147             fnderr = .true.
 148         endif
 149 23011   continue
 150         if (fnderr) then
 151           print *, 'Error for type MPI_REAL and op MPI_PROD'
 152         endif
 153
 154
 155        fnderr = .false.
 156        do 23012 i=1,count
 157         dblein(i) = i
 158         dblesol(i) = (i)**(size)
 159         dbleout(i) = 0
 160 23012   continue
 161        call MPI_Allreduce( dblein, dbleout, count,
 162      *      MPI_DOUBLE_PRECISION, MPI_PROD, comm, ierr )
 163               do 23013 i=1,count
 164         if (dbleout(i).ne.dblesol(i)) then
 165             errcnt = errcnt + 1
 166             fnderr = .true.
 167         endif
 168 23013   continue
 169         if (fnderr) then
 170           print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_PROD'
 171         endif
 172
 173
 174        fnderr = .false.
 175        do 23014 i=1,count
 176         cplxin(i) = i
 177         cplxsol(i) = (i)**(size)
 178         cplxout(i) = 0
 179 23014   continue
 180        call MPI_Allreduce( cplxin, cplxout, count,
 181      *      MPI_COMPLEX, MPI_PROD, comm, ierr )
 182               do 23015 i=1,count
 183         if (cplxout(i).ne.cplxsol(i)) then
 184             errcnt = errcnt + 1
 185             fnderr = .true.
 186         endif
 187 23015   continue
 188         if (fnderr) then
 189           print *, 'Error for type MPI_COMPLEX and op MPI_PROD'
 190         endif
 191
 192
 193         if (errcnt .gt. 0) then
 194         print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_PROD'
 195         endif
 196         errcnt = 0
 197
 198 C  Test max
 199         if (world_rank .eq. 0) print *, ' MPI_MAX'
 200
 201        fnderr = .false.
 202        do 23016 i=1,count
 203         intin(i) = (rank + i)
 204         intsol(i) = (size - 1 + i)
 205         intout(i) = 0
 206 23016   continue
 207        call MPI_Allreduce( intin, intout, count,
 208      *      MPI_INTEGER, MPI_MAX, comm, ierr )
 209               do 23017 i=1,count
 210         if (intout(i).ne.intsol(i)) then
 211             errcnt = errcnt + 1
 212             fnderr = .true.
 213         endif
 214 23017   continue
 215         if (fnderr) then
 216           print *, 'Error for type MPI_INTEGER and op MPI_MAX'
 217         endif
 218
 219
 220        fnderr = .false.
 221        do 23018 i=1,count
 222         realin(i) = (rank + i)
 223         realsol(i) = (size - 1 + i)
 224         realout(i) = 0
 225 23018   continue
 226        call MPI_Allreduce( realin, realout, count,
 227      *      MPI_REAL, MPI_MAX, comm, ierr )
 228               do 23019 i=1,count
 229         if (realout(i).ne.realsol(i)) then
 230             errcnt = errcnt + 1
 231             fnderr = .true.
 232         endif
 233 23019   continue
 234         if (fnderr) then
 235           print *, 'Error for type MPI_REAL and op MPI_MAX'
 236         endif
 237
 238
 239        fnderr = .false.
 240        do 23020 i=1,count
 241         dblein(i) = (rank + i)
 242         dblesol(i) = (size - 1 + i)
 243         dbleout(i) = 0
 244 23020   continue
 245        call MPI_Allreduce( dblein, dbleout, count,
 246      *      MPI_DOUBLE_PRECISION, MPI_MAX, comm, ierr )
 247               do 23021 i=1,count
 248         if (dbleout(i).ne.dblesol(i)) then
 249             errcnt = errcnt + 1
 250             fnderr = .true.
 251         endif
 252 23021   continue
 253         if (fnderr) then
 254           print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_MAX'
 255         endif
 256
 257
 258         if (errcnt .gt. 0) then
 259         print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_MAX'
 260         endif
 261         errcnt = 0
 262
 263 C Test min
 264         if (world_rank .eq. 0) print *, ' MPI_MIN'
 265
 266        fnderr = .false.
 267        do 23022 i=1,count
 268         intin(i) = (rank + i)
 269         intsol(i) = i
 270         intout(i) = 0
 271 23022   continue
 272        call MPI_Allreduce( intin, intout, count,
 273      *      MPI_INTEGER, MPI_MIN, comm, ierr )
 274               do 23023 i=1,count
 275         if (intout(i).ne.intsol(i)) then
 276             errcnt = errcnt + 1
 277             fnderr = .true.
 278         endif
 279 23023   continue
 280         if (fnderr) then
 281           print *, 'Error for type MPI_INTEGER and op MPI_MIN'
 282         endif
 283
 284
 285        fnderr = .false.
 286        do 23024 i=1,count
 287         realin(i) = (rank + i)
 288         realsol(i) = i
 289         realout(i) = 0
 290 23024   continue
 291        call MPI_Allreduce( realin, realout, count,
 292      *      MPI_REAL, MPI_MIN, comm, ierr )
 293               do 23025 i=1,count
 294         if (realout(i).ne.realsol(i)) then
 295             errcnt = errcnt + 1
 296             fnderr = .true.
 297         endif
 298 23025   continue
 299         if (fnderr) then
 300           print *, 'Error for type MPI_REAL and op MPI_MIN'
 301         endif
 302
 303
 304        fnderr = .false.
 305        do 23026 i=1,count
 306         dblein(i) = (rank + i)
 307         dblesol(i) = i
 308         dbleout(i) = 0
 309 23026   continue
 310        call MPI_Allreduce( dblein, dbleout, count,
 311      *      MPI_DOUBLE_PRECISION, MPI_MIN, comm, ierr )
 312               do 23027 i=1,count
 313         if (dbleout(i).ne.dblesol(i)) then
 314             errcnt = errcnt + 1
 315             fnderr = .true.
 316         endif
 317 23027   continue
 318         if (fnderr) then
 319           print *, 'Error for type MPI_DOUBLE_PRECISION and op MPI_MIN'
 320         endif
 321
 322
 323         if (errcnt .gt. 0) then
 324         print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_MIN'
 325         endif
 326         errcnt = 0
 327
 328 C Test LOR
 329         if (world_rank .eq. 0) print *, ' MPI_LOR'
 330
 331        fnderr = .false.
 332        do 23028 i=1,count
 333         login(i) = (mod(rank,2) .eq. 1)
 334         logsol(i) = (size .gt. 1)
 335         logout(i) = .FALSE.
 336 23028   continue
 337        call MPI_Allreduce( login, logout, count,
 338      *      MPI_LOGICAL, MPI_LOR, comm, ierr )
 339               do 23029 i=1,count
 340         if (logout(i).neqv.logsol(i)) then
 341             errcnt = errcnt + 1
 342             fnderr = .true.
 343         endif
 344 23029   continue
 345         if (fnderr) then
 346       print *, 'Error for type MPI_LOGICAL and op MPI_LOR'
 347         endif
 348
 349
 350         if (errcnt .gt. 0) then
 351            print *, 'Found ', errcnt, ' errors on ', rank,
 352      *          ' for MPI_LOR(0)'
 353         endif
 354         errcnt = 0
 355
 356
 357
 358        fnderr = .false.
 359        do 23030 i=1,count
 360         login(i) = .false.
 361         logsol(i) = .false.
 362         logout(i) = .FALSE.
 363 23030   continue
 364        call MPI_Allreduce( login, logout, count,
 365      *      MPI_LOGICAL, MPI_LOR, comm, ierr )
 366               do 23031 i=1,count
 367         if (logout(i).neqv.logsol(i)) then
 368             errcnt = errcnt + 1
 369             fnderr = .true.
 370         endif
 371 23031   continue
 372         if (fnderr) then
 373       print *, 'Error for type MPI_LOGICAL and op MPI_LOR'
 374         endif
 375
 376
 377         if (errcnt .gt. 0) then
 378            print *, 'Found ', errcnt, ' errors on ', rank,
 379      *              ' for MPI_LOR(1)'
 380         endif
 381         errcnt = 0
 382
 383 C Test LXOR
 384         if (world_rank .eq. 0) print *, ' MPI_LXOR'
 385
 386        fnderr = .false.
 387        do 23032 i=1,count
 388         login(i) = (rank .eq. 1)
 389         logsol(i) = (size .gt. 1)
 390         logout(i) = .FALSE.
 391 23032   continue
 392        call MPI_Allreduce( login, logout, count,
 393      *      MPI_LOGICAL, MPI_LXOR, comm, ierr )
 394               do 23033 i=1,count
 395         if (logout(i).neqv.logsol(i)) then
 396             errcnt = errcnt + 1
 397             fnderr = .true.
 398         endif
 399 23033   continue
 400         if (fnderr) then
 401       print *, 'Error for type MPI_LOGICAL and op MPI_LXOR'
 402         endif
 403
 404
 405         if (errcnt .gt. 0) then
 406         print *, 'Found ',errcnt,' errors on ', rank, ' for MPI_LXOR'
 407         endif
 408         errcnt = 0
 409
 410
 411        fnderr = .false.
 412        do 23034 i=1,count
 413         login(i) = .false.
 414         logsol(i) = .false.
 415         logout(i) = .FALSE.
 416 23034   continue
 417        call MPI_Allreduce( login, logout, count,
 418      *      MPI_LOGICAL, MPI_LXOR, comm, ierr )
 419               do 23035 i=1,count
 420         if (logout(i).neqv.logsol(i)) then
 421             errcnt = errcnt + 1
 422             fnderr = .true.
 423         endif
 424 23035   continue
 425         if (fnderr) then
 426       print *, 'Error for type MPI_LOGICAL and op MPI_LXOR'
 427         endif
 428
 429
 430         if (errcnt .gt. 0) then
 431         print *, 'Found ',errcnt,' errors on ',rank,' for MPI_LXOR(0)'
 432         endif
 433         errcnt = 0
 434
 435
 436        fnderr = .false.
 437        do 23036 i=1,count
 438         login(i) = .true.
 439         logsol(i) = mod(size,2) .ne. 0
 440         logout(i) = .FALSE.
 441 23036   continue
 442        call MPI_Allreduce( login, logout, count,
 443      *      MPI_LOGICAL, MPI_LXOR, comm, ierr )
 444               do 23037 i=1,count
 445         if (logout(i).neqv.logsol(i)) then
 446             errcnt = errcnt + 1
 447             fnderr = .true.
 448         endif
 449 23037   continue
 450         if (fnderr) then
 451       print *, 'Error for type MPI_LOGICAL and op MPI_LXOR'
 452         endif
 453
 454
 455         if (errcnt .gt. 0) then
 456         print *, 'Found ',errcnt,' errors on ',rank,' for MPI_LXOR(1-0)'
 457         endif
 458         errcnt = 0
 459
 460 C Test LAND
 461         if (world_rank .eq. 0) print *, ' MPI_LAND'
 462
 463        fnderr = .false.
 464        do 23038 i=1,count
 465         login(i) = (mod(rank,2) .eq. 1)
 466         logsol(i) = .false.
 467         logout(i) = .FALSE.
 468 23038   continue
 469        call MPI_Allreduce( login, logout, count,
 470      *      MPI_LOGICAL, MPI_LAND, comm, ierr )
 471               do 23039 i=1,count
 472         if (logout(i).neqv.logsol(i)) then
 473             errcnt = errcnt + 1
 474             fnderr = .true.
 475         endif
 476 23039   continue
 477         if (fnderr) then
 478       print *, 'Error for type MPI_LOGICAL and op MPI_LAND'
 479         endif
 480
 481
 482         if (errcnt .gt. 0) then
 483         print *, 'Found ', errcnt, ' errors on ', rank, ' for MPI_LAND'
 484         endif
 485         errcnt = 0
 486
 487
 488
 489
 490        fnderr = .false.
 491        do 23040 i=1,count
 492         login(i) = .true.
 493         logsol(i) = .true.
 494         logout(i) = .FALSE.
 495 23040   continue
 496        call MPI_Allreduce( login, logout, count,
 497      *      MPI_LOGICAL, MPI_LAND, comm, ierr )
 498               do 23041 i=1,count
 499         if (logout(i).neqv.logsol(i)) then
 500             errcnt = errcnt + 1
 501             fnderr = .true.
 502         endif
 503 23041   continue
 504         if (fnderr) then
 505       print *, 'Error for type MPI_LOGICAL and op MPI_LAND'
 506         endif
 507
 508
 509         if (errcnt .gt. 0) then
 510         print *, 'Found ',errcnt,' errors on ',rank,
 511      *      ' for MPI_LAND(true)'
 512         endif
 513         errcnt = 0
 514
 515 C Test BOR
 516         if (world_rank .eq. 0) print *, ' MPI_BOR'
 517         if (size .lt. 3) then
 518
 519        fnderr = .false.
 520        do 23042 i=1,count
 521         intin(i) = mod(rank,4)
 522         intsol(i) = size - 1
 523         intout(i) = 0
 524 23042   continue
 525        call MPI_Allreduce( intin, intout, count,
 526      *      MPI_INTEGER, MPI_BOR, comm, ierr )
 527               do 23043 i=1,count
 528         if (intout(i).ne.intsol(i)) then
 529             errcnt = errcnt + 1
 530             fnderr = .true.
 531         endif
 532 23043   continue
 533         if (fnderr) then
 534           print *, 'Error for type MPI_INTEGER and op MPI_BOR'
 535         endif
 536
 537         else
 538
 539        fnderr = .false.
 540        do 23044 i=1,count
 541         intin(i) = mod(rank,4)
 542         intsol(i) = 3
 543         intout(i) = 0
 544 23044   continue
 545        call MPI_Allreduce( intin, intout, count,
 546      *      MPI_INTEGER, MPI_BOR, comm, ierr )
 547               do 23045 i=1,count
 548         if (intout(i).ne.intsol(i)) then
 549             errcnt = errcnt + 1
 550             fnderr = .true.
 551         endif
 552 23045   continue
 553         if (fnderr) then
 554           print *, 'Error for type MPI_INTEGER and op MPI_BOR'
 555         endif
 556
 557         endif
 558         if (errcnt .gt. 0) then
 559         print *, 'Found ', errcnt, ' errors on ', rank,
 560      *           ' for MPI_BOR(1)'
 561         endif
 562         errcnt = 0
 563
 564 C Test BAND
 565         if (world_rank .eq. 0) print *, ' MPI_BAND'
 566 C See bottom for function definitions
 567
 568        fnderr = .false.
 569        do 23046 i=1,count
 570         intin(i) = ibxandval(rank,size,i)
 571         intsol(i) = i
 572         intout(i) = 0
 573 23046   continue
 574        call MPI_Allreduce( intin, intout, count,
 575      *      MPI_INTEGER, MPI_BAND, comm, ierr )
 576               do 23047 i=1,count
 577         if (intout(i).ne.intsol(i)) then
 578             errcnt = errcnt + 1
 579             fnderr = .true.
 580         endif
 581 23047   continue
 582         if (fnderr) then
 583           print *, 'Error for type MPI_INTEGER and op MPI_BAND'
 584         endif
 585
 586
 587         if (errcnt .gt. 0) then
 588         print *, 'Found ', errcnt, ' errors on ', rank,
 589      *          ' for MPI_BAND(1)'
 590         endif
 591         errcnt = 0
 592
 593
 594        fnderr = .false.
 595        do 23048 i=1,count
 596         intin(i) = ibxandval1(rank,size,i)
 597         intsol(i) = 0
 598         intout(i) = 0
 599 23048   continue
 600        call MPI_Allreduce( intin, intout, count,
 601      *      MPI_INTEGER, MPI_BAND, comm, ierr )
 602               do 23049 i=1,count
 603         if (intout(i).ne.intsol(i)) then
 604             errcnt = errcnt + 1
 605             fnderr = .true.
 606         endif
 607 23049   continue
 608         if (fnderr) then
 609           print *, 'Error for type MPI_INTEGER and op MPI_BAND'
 610         endif
 611
 612
 613         if (errcnt .gt. 0) then
 614         print *, 'Found ', errcnt, ' errors on ', rank,
 615      *          ' for MPI_BAND(0)'
 616         endif
 617         errcnt = 0
 618
 619 C Test BXOR
 620         if (world_rank .eq. 0) print *, ' MPI_BXOR'
 621 C See below for function definitions
 622
 623        fnderr = .false.
 624        do 23050 i=1,count
 625         intin(i) = ibxorval1(rank)
 626         intsol(i) = ibxorsol1(size)
 627         intout(i) = 0
 628 23050   continue
 629        call MPI_Allreduce( intin, intout, count,
 630      *      MPI_INTEGER, MPI_BXOR, comm, ierr )
 631               do 23051 i=1,count
 632         if (intout(i).ne.intsol(i)) then
 633             errcnt = errcnt + 1
 634             fnderr = .true.
 635         endif
 636 23051   continue
 637         if (fnderr) then
 638           print *, 'Error for type MPI_INTEGER and op MPI_BXOR'
 639         endif
 640
 641
 642         if (errcnt .gt. 0) then
 643         print *, 'Found ', errcnt, ' errors on ', rank,
 644      *          ' for MPI_BXOR(1)'
 645         endif
 646         errcnt = 0
 647
 648
 649        fnderr = .false.
 650        do 23052 i=1,count
 651         intin(i) = 0
 652         intsol(i) = 0
 653         intout(i) = 0
 654 23052   continue
 655        call MPI_Allreduce( intin, intout, count,
 656      *      MPI_INTEGER, MPI_BXOR, comm, ierr )
 657               do 23053 i=1,count
 658         if (intout(i).ne.intsol(i)) then
 659             errcnt = errcnt + 1
 660             fnderr = .true.
 661         endif
 662 23053   continue
 663         if (fnderr) then
 664           print *, 'Error for type MPI_INTEGER and op MPI_BXOR'
 665         endif
 666
 667
 668         if (errcnt .gt. 0) then
 669         print *, 'Found ', errcnt, ' errors on ', rank,
 670      *          ' for MPI_BXOR(0)'
 671         endif
 672         errcnt = 0
 673
 674 C Assumes -1 == all bits set
 675
 676        fnderr = .false.
 677        do 23054 i=1,count
 678         intin(i) = (-1)
 679         if (mod(size,2) .eq. 0) then
 680             intsol(i) = 0
 681         else
 682             intsol(i) = -1
 683         endif
 684         intout(i) = 0
 685 23054   continue
 686        call MPI_Allreduce( intin, intout, count,
 687      *      MPI_INTEGER, MPI_BXOR, comm, ierr )
 688               do 23055 i=1,count
 689         if (intout(i).ne.intsol(i)) then
 690             errcnt = errcnt + 1
 691             fnderr = .true.
 692         endif
 693 23055   continue
 694         if (fnderr) then
 695           print *, 'Error for type MPI_INTEGER and op MPI_BXOR'
 696         endif
 697
 698
 699         if (errcnt .gt. 0) then
 700         print *, 'Found ', errcnt, ' errors on ', rank,
 701      *          ' for MPI_BXOR(1-0)'
 702         endif
 703         errcnt = 0
 704
 705 C Test Maxloc
 706         if (world_rank .eq. 0) print *, ' MPI_MAXLOC'
 707
 708         fnderr = .false.
 709         do 23056 i=1, count
 710            intin(2*i-1) = (rank + i)
 711            intin(2*i)   = rank
 712            intsol(2*i-1) = (size - 1 + i)
 713            intsol(2*i) = (size-1)
 714            intout(2*i-1) = 0
 715            intout(2*i)   = 0
 716 23056   continue
 717                 call MPI_Allreduce( intin, intout, count,
 718      *      MPI_2INTEGER, MPI_MAXLOC, comm, ierr )
 719         do 23057 i=1, count
 720         if (intout(2*i-1) .ne. intsol(2*i-1) .or.
 721      *      intout(2*i) .ne. intsol(2*i)) then
 722             errcnt = errcnt + 1
 723             fnderr = .true.
 724         endif
 725 23057   continue
 726         if (fnderr) then
 727         print *, 'Error for type MPI_2INTEGER and op MPI_MAXLOC'
 728         endif
 729
 730
 731         fnderr = .false.
 732         do 23058 i=1, count
 733            realin(2*i-1) = (rank + i)
 734            realin(2*i)   = rank
 735            realsol(2*i-1) = (size - 1 + i)
 736            realsol(2*i) = (size-1)
 737            realout(2*i-1) = 0
 738            realout(2*i)   = 0
 739 23058   continue
 740                 call MPI_Allreduce( realin, realout, count,
 741      *      MPI_2REAL, MPI_MAXLOC, comm, ierr )
 742         do 23059 i=1, count
 743         if (realout(2*i-1) .ne. realsol(2*i-1) .or.
 744      *      realout(2*i) .ne. realsol(2*i)) then
 745             errcnt = errcnt + 1
 746             fnderr = .true.
 747         endif
 748 23059   continue
 749         if (fnderr) then
 750         print *, 'Error for type MPI_2REAL and op MPI_MAXLOC'
 751         endif
 752
 753
 754 !        fnderr = .false.
 755 !        do 23060 i=1, count
 756 !           dblein(2*i-1) = (rank + i)
 757 !           dblein(2*i)   = rank
 758 !           dblesol(2*i-1) = (size - 1 + i)
 759 !           dblesol(2*i) = (size-1)
 760 !           dbleout(2*i-1) = 0
 761 !           dbleout(2*i)   = 0
 762 !23060   continue
 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
 769 !            fnderr = .true.
 770 !        endif
 771 !23061   continue
 772 !        if (fnderr) then
 773 !           print *,
 774 !     *     'Error for type MPI_2DOUBLE_PRECISION and op MPI_MAXLOC'
 775
 776 !        endif
 777
 778
 779         if (errcnt .gt. 0) then
 780         print *, 'Found ', errcnt, ' errors on ', rank,
 781      *          ' for MPI_MAXLOC'
 782         endif
 783         errcnt = 0
 784
 785 C Test minloc
 786         if (world_rank .eq. 0) print *, ' MPI_MINLOC'
 787
 788
 789         fnderr = .false.
 790         do 23062 i=1, count
 791            intin(2*i-1) = (rank + i)
 792            intin(2*i)   = rank
 793            intsol(2*i-1) = i
 794            intsol(2*i) = 0
 795            intout(2*i-1) = 0
 796            intout(2*i)   = 0
 797 23062   continue
 798                 call MPI_Allreduce( intin, intout, count,
 799      *      MPI_2INTEGER, MPI_MINLOC, comm, ierr )
 800         do 23063 i=1, count
 801         if (intout(2*i-1) .ne. intsol(2*i-1) .or.
 802      *      intout(2*i) .ne. intsol(2*i)) then
 803             errcnt = errcnt + 1
 804             fnderr = .true.
 805         endif
 806 23063   continue
 807         if (fnderr) then
 808         print *, 'Error for type MPI_2INTEGER and op MPI_MINLOC'
 809         endif
 810
 811
 812         fnderr = .false.
 813         do 23064 i=1, count
 814            realin(2*i-1) = (rank + i)
 815            realin(2*i)   = rank
 816            realsol(2*i-1) = i
 817            realsol(2*i) = 0
 818            realout(2*i-1) = 0
 819            realout(2*i)   = 0
 820 23064   continue
 821                 call MPI_Allreduce( realin, realout, count,
 822      *      MPI_2REAL, MPI_MINLOC, comm, ierr )
 823         do 23065 i=1, count
 824         if (realout(2*i-1) .ne. realsol(2*i-1) .or.
 825      *      realout(2*i) .ne. realsol(2*i)) then
 826             errcnt = errcnt + 1
 827             fnderr = .true.
 828         endif
 829 23065   continue
 830         if (fnderr) then
 831         print *, 'Error for type MPI_2REAL and op MPI_MINLOC'
 832         endif
 833
 834
 835 !        fnderr = .false.
 836 !        do 23066 i=1, count
 837 !           dblein(2*i-1) = (rank + i)
 838 !           dblein(2*i)   = rank
 839 !           dblesol(2*i-1) = i
 840 !           dblesol(2*i) = 0
 841 !           dbleout(2*i-1) = 0
 842 !           dbleout(2*i)   = 0
 843 !23066   continue
 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
 850 !            fnderr = .true.
 851 !        endif
 852 !23067   continue
 853 !        if (fnderr) then
 854 !           print *,
 855 !     *      'Error for type MPI_2DOUBLE_PRECISION and op MPI_MINLOC'
 856 !        endif
 857
 858
 859         if (errcnt .gt. 0) then
 860         print *, 'Found ', errcnt, ' errors on ', rank,
 861      *          ' for MPI_MINLOC'
 862         endif
 863         errcnt = 0
 864
 865         call MPI_Finalize( ierr )
 866         end
 867
 868         integer function ibxorval1( ir )
 869         ibxorval1 = 0
 870         if (ir .eq. 1) ibxorval1 = 16+32+64+128
 871         return
 872         end
 873
 874         integer function ibxorsol1( is )
 875         ibxorsol1 = 0
 876         if (is .gt. 1) ibxorsol1 = 16+32+64+128
 877         return
 878         end
 879
 880 C
 881 C       Assumes -1 == all bits set
 882         integer function ibxandval( ir, is, i )
 883         integer ir, is, i
 884         ibxandval = -1
 885         if (ir .eq. is - 1) ibxandval = i
 886         return
 887         end
 888 C
 889         integer function ibxandval1( ir, is, i )
 890         integer ir, is, i
 891         ibxandval1 = 0
 892         if (ir .eq. is - 1) ibxandval1 = i
 893         return
 894         end