teshsuite/smpi/mpich3-test/f77/pt2pt/mprobef.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2012 by Argonne National Laboratory.
   4 C      See COPYRIGHT in top-level directory.
   5 C
   6       program main
   7       implicit none
   8       include 'mpif.h'
   9       integer idx, ierr, rank, size, count
  10       integer sendbuf(8), recvbuf(8)
  11       integer s1(MPI_STATUS_SIZE), s2(MPI_STATUS_SIZE)
  12       integer msg, errs
  13       integer rreq
  14       logical found, flag
  15
  16       ierr = -1
  17       errs = 0
  18       call mpi_init( ierr )
  19       if (ierr .ne. MPI_SUCCESS) then
  20           errs = errs + 1
  21           print *, ' Unexpected return from MPI_INIT', ierr
  22       endif
  23
  24       call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
  25       call mpi_comm_size( MPI_COMM_WORLD, size, ierr )
  26       if (size .lt. 2) then
  27           errs = errs + 1
  28           print *, ' This test requires at least 2 processes'
  29 C         Abort now - do not continue in this case.
  30           call mpi_abort( MPI_COMM_WORLD, 1, ierr )
  31       endif
  32       if (size .gt. 2) then
  33           print *, ' This test is running with ', size, ' processes,'
  34           print *, ' only 2 processes are used.'
  35       endif
  36
  37 C Test 0: simple Send and Mprobe+Mrecv.
  38       if (rank .eq. 0) then
  39           sendbuf(1) = 1735928559
  40           sendbuf(2) = 1277009102
  41           call MPI_Send(sendbuf, 2, MPI_INTEGER,
  42      .                  1, 5, MPI_COMM_WORLD, ierr)
  43       else
  44           do idx = 1, MPI_STATUS_SIZE
  45               s1(idx) = 0
  46               s2(idx) = 0
  47           enddo
  48 C         the error fields are initialized for modification check.
  49           s1(MPI_ERROR) = MPI_ERR_DIMS
  50           s2(MPI_ERROR) = MPI_ERR_OTHER
  51
  52           msg = MPI_MESSAGE_NULL
  53           call MPI_Mprobe(0, 5, MPI_COMM_WORLD, msg, s1, ierr)
  54           if (s1(MPI_SOURCE) .ne. 0) then
  55               errs = errs + 1
  56               print *, 's1(MPI_SOURCE) != 0 at T0 Mprobe().'
  57           endif
  58           if (s1(MPI_TAG) .ne. 5) then
  59               errs = errs + 1
  60               print *, 's1(MPI_TAG) != 5 at T0 Mprobe().'
  61           endif
  62           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
  63               errs = errs + 1
  64               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T0 Mprobe().'
  65           endif
  66           if (msg .eq. MPI_MESSAGE_NULL) then
  67               errs = errs + 1
  68               print *, 'msg == MPI_MESSAGE_NULL at T0 Mprobe().'
  69           endif
  70
  71           count = -1
  72           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
  73           if (count .ne. 2) then
  74               errs = errs + 1
  75               print *, 'probed buffer does not have 2 MPI_INTEGERs.'
  76           endif
  77
  78           recvbuf(1) = 19088743
  79           recvbuf(2) = 1309737967
  80           call MPI_Mrecv(recvbuf, count, MPI_INTEGER, msg, s2, ierr)
  81           if (recvbuf(1) .ne. 1735928559) then
  82               errs = errs + 1
  83               print *, 'recvbuf(1) is corrupted at T0 Mrecv().'
  84           endif
  85           if (recvbuf(2) .ne. 1277009102) then
  86               errs = errs + 1
  87               print *, 'recvbuf(2) is corrupted at T0 Mrecv().'
  88           endif
  89           if (s2(MPI_SOURCE) .ne. 0) then
  90               errs = errs + 1
  91               print *, 's2(MPI_SOURCE) != 0 at T0 Mrecv().'
  92           endif
  93           if (s2(MPI_TAG) .ne. 5) then
  94               errs = errs + 1
  95               print *, 's2(MPI_TAG) != 5 at T0 Mrecv().'
  96           endif
  97           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
  98               errs = errs + 1
  99               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T0 Mrecv().'
 100           endif
 101           if (msg .ne. MPI_MESSAGE_NULL) then
 102               errs = errs + 1
 103               print *, 'msg != MPI_MESSAGE_NULL at T0 Mrecv().'
 104           endif
 105       endif
 106
 107 C Test 1: simple Send and Mprobe+Imrecv.
 108       if (rank .eq. 0) then
 109           sendbuf(1) = 1735928559
 110           sendbuf(2) = 1277009102
 111           call MPI_Send(sendbuf, 2, MPI_INTEGER,
 112      .                  1, 5, MPI_COMM_WORLD, ierr)
 113       else
 114           do idx = 1, MPI_STATUS_SIZE
 115               s1(idx) = 0
 116               s2(idx) = 0
 117           enddo
 118 C         the error fields are initialized for modification check.
 119           s1(MPI_ERROR) = MPI_ERR_DIMS
 120           s2(MPI_ERROR) = MPI_ERR_OTHER
 121
 122           msg = MPI_MESSAGE_NULL
 123           call MPI_Mprobe(0, 5, MPI_COMM_WORLD, msg, s1, ierr)
 124           if (s1(MPI_SOURCE) .ne. 0) then
 125               errs = errs + 1
 126               print *, 's1(MPI_SOURCE) != 0 at T1 Mprobe().'
 127           endif
 128           if (s1(MPI_TAG) .ne. 5) then
 129               errs = errs + 1
 130               print *, 's1(MPI_TAG) != 5 at T1 Mprobe().'
 131           endif
 132           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 133               errs = errs + 1
 134               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T1 Mprobe().'
 135           endif
 136           if (msg .eq. MPI_MESSAGE_NULL) then
 137               errs = errs + 1
 138               print *, 'msg == MPI_MESSAGE_NULL at T1 Mprobe().'
 139           endif
 140
 141           count = -1
 142           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 143           if (count .ne. 2) then
 144               errs = errs + 1
 145               print *, 'probed buffer does not have 2 MPI_INTEGERs.'
 146           endif
 147
 148           rreq = MPI_REQUEST_NULL
 149           recvbuf(1) = 19088743
 150           recvbuf(2) = 1309737967
 151           call MPI_Imrecv(recvbuf, count, MPI_INTEGER, msg, rreq, ierr)
 152           if (rreq .eq. MPI_REQUEST_NULL) then
 153               errs = errs + 1
 154               print *, 'rreq is unmodified at T1 Imrecv().'
 155           endif
 156           call MPI_Wait(rreq, s2, ierr)
 157           if (recvbuf(1) .ne. 1735928559) then
 158               errs = errs + 1
 159               print *, 'recvbuf(1) is corrupted at T1 Imrecv().'
 160           endif
 161           if (recvbuf(2) .ne. 1277009102) then
 162               errs = errs + 1
 163               print *, 'recvbuf(2) is corrupted at T1 Imrecv().'
 164           endif
 165           if (s2(MPI_SOURCE) .ne. 0) then
 166               errs = errs + 1
 167               print *, 's2(MPI_SOURCE) != 0 at T1 Imrecv().'
 168           endif
 169           if (s2(MPI_TAG) .ne. 5) then
 170               errs = errs + 1
 171               print *, 's2(MPI_TAG) != 5 at T1 Imrecv().'
 172           endif
 173           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 174               errs = errs + 1
 175               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T1 Imrecv().'
 176           endif
 177           if (msg .ne. MPI_MESSAGE_NULL) then
 178               errs = errs + 1
 179               print *, 'msg != MPI_MESSAGE_NULL at T1 Imrecv().'
 180           endif
 181       endif
 182
 183 C Test 2: simple Send and Improbe+Mrecv.
 184       if (rank .eq. 0) then
 185           sendbuf(1) = 1735928559
 186           sendbuf(2) = 1277009102
 187           call MPI_Send(sendbuf, 2, MPI_INTEGER,
 188      .                  1, 5, MPI_COMM_WORLD, ierr)
 189       else
 190           do idx = 1, MPI_STATUS_SIZE
 191               s1(idx) = 0
 192               s2(idx) = 0
 193           enddo
 194 C         the error fields are initialized for modification check.
 195           s1(MPI_ERROR) = MPI_ERR_DIMS
 196           s2(MPI_ERROR) = MPI_ERR_OTHER
 197
 198           msg = MPI_MESSAGE_NULL
 199           call MPI_Improbe(0, 5, MPI_COMM_WORLD, found, msg, s1, ierr)
 200           do while (.not. found)
 201               call MPI_Improbe(0, 5, MPI_COMM_WORLD,
 202      .                          found, msg, s1, ierr)
 203           enddo
 204           if (msg .eq. MPI_MESSAGE_NULL) then
 205               errs = errs + 1
 206               print *, 'msg == MPI_MESSAGE_NULL at T2 Improbe().'
 207           endif
 208           if (s1(MPI_SOURCE) .ne. 0) then
 209               errs = errs + 1
 210               print *, 's1(MPI_SOURCE) != 0 at T2 Improbe().'
 211           endif
 212           if (s1(MPI_TAG) .ne. 5) then
 213               errs = errs + 1
 214               print *, 's1(MPI_TAG) != 5 at T2 Improbe().'
 215           endif
 216           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 217               errs = errs + 1
 218               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T2 Improbe().'
 219           endif
 220
 221           count = -1
 222           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 223           if (count .ne. 2) then
 224               errs = errs + 1
 225               print *, 'probed buffer does not have 2 MPI_INTEGERs.'
 226           endif
 227
 228           recvbuf(1) = 19088743
 229           recvbuf(2) = 1309737967
 230           call MPI_Mrecv(recvbuf, count, MPI_INTEGER, msg, s2, ierr)
 231           if (recvbuf(1) .ne. 1735928559) then
 232               errs = errs + 1
 233               print *, 'recvbuf(1) is corrupted at T2 Mrecv().'
 234           endif
 235           if (recvbuf(2) .ne. 1277009102) then
 236               errs = errs + 1
 237               print *, 'recvbuf(2) is corrupted at T2 Mrecv().'
 238           endif
 239           if (s2(MPI_SOURCE) .ne. 0) then
 240               errs = errs + 1
 241               print *, 's2(MPI_SOURCE) != 0 at T2 Mrecv().'
 242           endif
 243           if (s2(MPI_TAG) .ne. 5) then
 244               errs = errs + 1
 245               print *, 's2(MPI_TAG) != 5 at T2 Mrecv().'
 246           endif
 247           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 248               errs = errs + 1
 249               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T2 Mrecv().'
 250           endif
 251           if (msg .ne. MPI_MESSAGE_NULL) then
 252               errs = errs + 1
 253               print *, 'msg != MPI_MESSAGE_NULL at T2 Mrecv().'
 254           endif
 255       endif
 256
 257 C Test 3: simple Send and Improbe+Imrecv.
 258       if (rank .eq. 0) then
 259           sendbuf(1) = 1735928559
 260           sendbuf(2) = 1277009102
 261           call MPI_Send(sendbuf, 2, MPI_INTEGER,
 262      .                  1, 5, MPI_COMM_WORLD, ierr)
 263       else
 264           do idx = 1, MPI_STATUS_SIZE
 265               s1(idx) = 0
 266               s2(idx) = 0
 267           enddo
 268 C         the error fields are initialized for modification check.
 269           s1(MPI_ERROR) = MPI_ERR_DIMS
 270           s2(MPI_ERROR) = MPI_ERR_OTHER
 271
 272           msg = MPI_MESSAGE_NULL
 273           call MPI_Improbe(0, 5, MPI_COMM_WORLD, found, msg, s1, ierr)
 274           do while (.not. found)
 275               call MPI_Improbe(0, 5, MPI_COMM_WORLD,
 276      .                          found, msg, s1, ierr)
 277           enddo
 278           if (msg .eq. MPI_MESSAGE_NULL) then
 279               errs = errs + 1
 280               print *, 'msg == MPI_MESSAGE_NULL at T3 Improbe().'
 281           endif
 282           if (s1(MPI_SOURCE) .ne. 0) then
 283               errs = errs + 1
 284               print *, 's1(MPI_SOURCE) != 0 at T3 Improbe().'
 285           endif
 286           if (s1(MPI_TAG) .ne. 5) then
 287               errs = errs + 1
 288               print *, 's1(MPI_TAG) != 5 at T3 Improbe().'
 289           endif
 290           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 291               errs = errs + 1
 292               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T3 Improbe().'
 293           endif
 294
 295           count = -1
 296           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 297           if (count .ne. 2) then
 298               errs = errs + 1
 299               print *, 'probed buffer does not have 2 MPI_INTEGERs.'
 300           endif
 301
 302           rreq = MPI_REQUEST_NULL
 303           recvbuf(1) = 19088743
 304           recvbuf(2) = 1309737967
 305           call MPI_Imrecv(recvbuf, count, MPI_INTEGER, msg, rreq, ierr)
 306           if (rreq .eq. MPI_REQUEST_NULL) then
 307               errs = errs + 1
 308               print *, 'rreq is unmodified at T3 Imrecv().'
 309           endif
 310           call MPI_Wait(rreq, s2, ierr)
 311           if (recvbuf(1) .ne. 1735928559) then
 312               errs = errs + 1
 313               print *, 'recvbuf(1) is corrupted at T3 Imrecv().'
 314           endif
 315           if (recvbuf(2) .ne. 1277009102) then
 316               errs = errs + 1
 317               print *, 'recvbuf(2) is corrupted at T3 Imrecv().'
 318           endif
 319           if (s2(MPI_SOURCE) .ne. 0) then
 320               errs = errs + 1
 321               print *, 's2(MPI_SOURCE) != 0 at T3 Imrecv().'
 322           endif
 323           if (s2(MPI_TAG) .ne. 5) then
 324               errs = errs + 1
 325               print *, 's2(MPI_TAG) != 5 at T3 Imrecv().'
 326           endif
 327           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 328               errs = errs + 1
 329               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T3 Imrecv().'
 330           endif
 331           if (msg .ne. MPI_MESSAGE_NULL) then
 332               errs = errs + 1
 333               print *, 'msg != MPI_MESSAGE_NULL at T3 Imrecv().'
 334           endif
 335       endif
 336
 337 C Test 4: Mprobe+Mrecv with MPI_PROC_NULL
 338       if (.true.) then
 339           do idx = 1, MPI_STATUS_SIZE
 340               s1(idx) = 0
 341               s2(idx) = 0
 342           enddo
 343 C         the error fields are initialized for modification check.
 344           s1(MPI_ERROR) = MPI_ERR_DIMS
 345           s2(MPI_ERROR) = MPI_ERR_OTHER
 346
 347           msg = MPI_MESSAGE_NULL
 348           call MPI_Mprobe(MPI_PROC_NULL, 5, MPI_COMM_WORLD,
 349      .                     msg, s1, ierr)
 350           if (s1(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 351               errs = errs + 1
 352               print *, 's1(MPI_SOURCE) != MPI_PROC_NULL at T4 Mprobe().'
 353           endif
 354           if (s1(MPI_TAG) .ne. MPI_ANY_TAG) then
 355               errs = errs + 1
 356               print *, 's1(MPI_TAG) != MPI_ANY_TAG at T4 Mprobe().'
 357           endif
 358           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 359               errs = errs + 1
 360               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T4 Mprobe().'
 361           endif
 362           if (msg .ne. MPI_MESSAGE_NO_PROC) then
 363               errs = errs + 1
 364               print *, 'msg != MPI_MESSAGE_NO_PROC at T4 Mprobe().'
 365           endif
 366
 367           count = -1
 368           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 369           if (count .ne. 0) then
 370               errs = errs + 1
 371               print *, 'probed buffer does not have 0 MPI_INTEGER.'
 372           endif
 373
 374           recvbuf(1) = 19088743
 375           recvbuf(2) = 1309737967
 376           call MPI_Mrecv(recvbuf, count, MPI_INTEGER, msg, s2, ierr)
 377 C         recvbuf() should remain unmodified
 378           if (recvbuf(1) .ne. 19088743) then
 379               errs = errs + 1
 380               print *, 'recvbuf(1) is corrupted at T4 Mrecv().'
 381           endif
 382           if (recvbuf(2) .ne. 1309737967) then
 383               errs = errs + 1
 384               print *, 'recvbuf(2) is corrupted at T4 Mrecv().'
 385           endif
 386           if (s2(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 387               errs = errs + 1
 388               print *, 's2(MPI_SOURCE) != MPI_PROC_NULL at T4 Mrecv().'
 389           endif
 390           if (s2(MPI_TAG) .ne. MPI_ANY_TAG) then
 391               errs = errs + 1
 392               print *, 's2(MPI_TAG) != MPI_ANY_TAG at T4 Mrecv().'
 393           endif
 394           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 395               errs = errs + 1
 396               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T4 Mrecv().'
 397           endif
 398           if (msg .ne. MPI_MESSAGE_NULL) then
 399               errs = errs + 1
 400               print *, 'msg != MPI_MESSAGE_NULL at T4 Mrecv().'
 401           endif
 402
 403           count = -1
 404           call MPI_Get_count(s2, MPI_INTEGER, count, ierr)
 405           if (count .ne. 0) then
 406               errs = errs + 1
 407               print *, 'recv buffer does not have 0 MPI_INTEGER.'
 408           endif
 409       endif
 410
 411 C Test 5: Mprobe+Imrecv with MPI_PROC_NULL
 412       if (.true.) then
 413           do idx = 1, MPI_STATUS_SIZE
 414               s1(idx) = 0
 415               s2(idx) = 0
 416           enddo
 417 C         the error fields are initialized for modification check.
 418           s1(MPI_ERROR) = MPI_ERR_DIMS
 419           s2(MPI_ERROR) = MPI_ERR_OTHER
 420
 421           msg = MPI_MESSAGE_NULL
 422           call MPI_Mprobe(MPI_PROC_NULL, 5, MPI_COMM_WORLD,
 423      .                     msg, s1, ierr)
 424           if (s1(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 425               errs = errs + 1
 426               print *, 's1(MPI_SOURCE) != MPI_PROC_NULL at T5 Mprobe().'
 427           endif
 428           if (s1(MPI_TAG) .ne. MPI_ANY_TAG) then
 429               errs = errs + 1
 430               print *, 's1(MPI_TAG) != MPI_ANY_TAG at T5 Mprobe().'
 431           endif
 432           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 433               errs = errs + 1
 434               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T5 Mprobe().'
 435           endif
 436           if (msg .ne. MPI_MESSAGE_NO_PROC) then
 437               errs = errs + 1
 438               print *, 'msg != MPI_MESSAGE_NO_PROC at T5 Mprobe().'
 439           endif
 440
 441           count = -1
 442           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 443           if (count .ne. 0) then
 444               errs = errs + 1
 445               print *, 'probed buffer does not have 0 MPI_INTEGER.'
 446           endif
 447
 448           rreq = MPI_REQUEST_NULL
 449           recvbuf(1) = 19088743
 450           recvbuf(2) = 1309737967
 451           call MPI_Imrecv(recvbuf, count, MPI_INTEGER, msg, rreq, ierr)
 452           if (rreq .eq. MPI_REQUEST_NULL) then
 453               errs = errs + 1
 454               print *, 'rreq == MPI_REQUEST_NULL at T5 Imrecv().'
 455           endif
 456           flag = .false.
 457           call MPI_Test(rreq, flag, s2, ierr)
 458           if (.not. flag) then
 459               errs = errs + 1
 460               print *, 'flag is false at T5 Imrecv().'
 461           endif
 462 C         recvbuf() should remain unmodified
 463           if (recvbuf(1) .ne. 19088743) then
 464               errs = errs + 1
 465               print *, 'recvbuf(1) is corrupted at T5 Imrecv().'
 466           endif
 467           if (recvbuf(2) .ne. 1309737967) then
 468               errs = errs + 1
 469               print *, 'recvbuf(2) is corrupted at T5 Imrecv().'
 470           endif
 471           if (s2(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 472               errs = errs + 1
 473               print *, 's2(MPI_SOURCE) != MPI_PROC_NULL at T5 Imrecv().'
 474           endif
 475           if (s2(MPI_TAG) .ne. MPI_ANY_TAG) then
 476               errs = errs + 1
 477               print *, 's2(MPI_TAG) != MPI_ANY_TAG at T5 Imrecv().'
 478           endif
 479           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 480               errs = errs + 1
 481               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T5 Imrecv().'
 482           endif
 483           if (msg .ne. MPI_MESSAGE_NULL) then
 484               errs = errs + 1
 485               print *, 'msg != MPI_MESSAGE_NULL at T5 Imrecv().'
 486           endif
 487
 488           count = -1
 489           call MPI_Get_count(s2, MPI_INTEGER, count, ierr)
 490           if (count .ne. 0) then
 491               errs = errs + 1
 492               print *, 'recv buffer does not have 0 MPI_INTEGER.'
 493           endif
 494       endif
 495
 496 C Test 6: Improbe+Mrecv with MPI_PROC_NULL
 497       if (.true.) then
 498           do idx = 1, MPI_STATUS_SIZE
 499               s1(idx) = 0
 500               s2(idx) = 0
 501           enddo
 502 C         the error fields are initialized for modification check.
 503           s1(MPI_ERROR) = MPI_ERR_DIMS
 504           s2(MPI_ERROR) = MPI_ERR_OTHER
 505
 506           found = .false.
 507           msg = MPI_MESSAGE_NULL
 508           call MPI_Improbe(MPI_PROC_NULL, 5, MPI_COMM_WORLD,
 509      .                      found, msg, s1, ierr)
 510           if (.not. found) then
 511               errs = errs + 1
 512               print *, 'found is false at T6 Improbe().'
 513           endif
 514           if (s1(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 515               errs = errs + 1
 516               print *, 's1(MPI_SOURCE) != MPI_PROC_NULL at T6 Improbe()'
 517           endif
 518           if (s1(MPI_TAG) .ne. MPI_ANY_TAG) then
 519               errs = errs + 1
 520               print *, 's1(MPI_TAG) != MPI_ANY_TAG at T6 Improbe().'
 521           endif
 522           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 523               errs = errs + 1
 524               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T6 Improbe().'
 525           endif
 526           if (msg .ne. MPI_MESSAGE_NO_PROC) then
 527               errs = errs + 1
 528               print *, 'msg != MPI_MESSAGE_NO_PROC at T6 Improbe().'
 529           endif
 530
 531           count = -1
 532           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 533           if (count .ne. 0) then
 534               errs = errs + 1
 535               print *, 'probed buffer does not have 0 MPI_INTEGER.'
 536           endif
 537
 538           recvbuf(1) = 19088743
 539           recvbuf(2) = 1309737967
 540           call MPI_Mrecv(recvbuf, count, MPI_INTEGER, msg, s2, ierr)
 541 C         recvbuf() should remain unmodified
 542           if (recvbuf(1) .ne. 19088743) then
 543               errs = errs + 1
 544               print *, 'recvbuf(1) is corrupted at T6 Mrecv().'
 545           endif
 546           if (recvbuf(2) .ne. 1309737967) then
 547               errs = errs + 1
 548               print *, 'recvbuf(2) is corrupted at T6 Mrecv().'
 549           endif
 550           if (s2(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 551               errs = errs + 1
 552               print *, 's2(MPI_SOURCE) != MPI_PROC_NULL at T6 Mrecv().'
 553           endif
 554           if (s2(MPI_TAG) .ne. MPI_ANY_TAG) then
 555               errs = errs + 1
 556               print *, 's2(MPI_TAG) != MPI_ANY_TAG at T6 Mrecv().'
 557           endif
 558           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 559               errs = errs + 1
 560               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T6 Mrecv().'
 561           endif
 562           if (msg .ne. MPI_MESSAGE_NULL) then
 563               errs = errs + 1
 564               print *, 'msg != MPI_MESSAGE_NULL at T6 Mrecv().'
 565           endif
 566
 567           count = -1
 568           call MPI_Get_count(s2, MPI_INTEGER, count, ierr)
 569           if (count .ne. 0) then
 570               errs = errs + 1
 571               print *, 'recv buffer does not have 0 MPI_INTEGER.'
 572           endif
 573       endif
 574
 575 C Test 7: Improbe+Imrecv with MPI_PROC_NULL
 576       if (.true.) then
 577           do idx = 1, MPI_STATUS_SIZE
 578               s1(idx) = 0
 579               s2(idx) = 0
 580           enddo
 581 C         the error fields are initialized for modification check.
 582           s1(MPI_ERROR) = MPI_ERR_DIMS
 583           s2(MPI_ERROR) = MPI_ERR_OTHER
 584
 585           found = .false.
 586           msg = MPI_MESSAGE_NULL
 587           call MPI_Improbe(MPI_PROC_NULL, 5, MPI_COMM_WORLD,
 588      .                      found, msg, s1, ierr)
 589           if (.not. found) then
 590               errs = errs + 1
 591               print *, 'found is false at T7 Improbe().'
 592           endif
 593           if (s1(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 594               errs = errs + 1
 595               print *, 's1(MPI_SOURCE) != MPI_PROC_NULL at T7 Improbe()'
 596           endif
 597           if (s1(MPI_TAG) .ne. MPI_ANY_TAG) then
 598               errs = errs + 1
 599               print *, 's1(MPI_TAG) != MPI_ANY_TAG at T7 Improbe().'
 600           endif
 601           if (s1(MPI_ERROR) .ne. MPI_ERR_DIMS) then
 602               errs = errs + 1
 603               print *, 's1(MPI_ERROR) != MPI_ERR_DIMS at T7 Improbe().'
 604           endif
 605           if (msg .ne. MPI_MESSAGE_NO_PROC) then
 606               errs = errs + 1
 607               print *, 'msg != MPI_MESSAGE_NO_PROC at T7 Improbe().'
 608           endif
 609
 610           count = -1
 611           call MPI_Get_count(s1, MPI_INTEGER, count, ierr)
 612           if (count .ne. 0) then
 613               errs = errs + 1
 614               print *, 'probed buffer does not have 0 MPI_INTEGER.'
 615           endif
 616
 617           rreq = MPI_REQUEST_NULL
 618           recvbuf(1) = 19088743
 619           recvbuf(2) = 1309737967
 620           call MPI_Imrecv(recvbuf, count, MPI_INTEGER, msg, rreq, ierr)
 621           if (rreq .eq. MPI_REQUEST_NULL) then
 622               errs = errs + 1
 623               print *, 'rreq == MPI_REQUEST_NULL at T7 Imrecv().'
 624           endif
 625           flag = .false.
 626           call MPI_Test(rreq, flag, s2, ierr)
 627           if (.not. flag) then
 628               errs = errs + 1
 629               print *, 'flag is false at T7 Imrecv().'
 630           endif
 631 C         recvbuf() should remain unmodified
 632           if (recvbuf(1) .ne. 19088743) then
 633               errs = errs + 1
 634               print *, 'recvbuf(1) is corrupted at T7 Imrecv().'
 635           endif
 636           if (recvbuf(2) .ne. 1309737967) then
 637               errs = errs + 1
 638               print *, 'recvbuf(2) is corrupted at T7 Imrecv().'
 639           endif
 640           if (s2(MPI_SOURCE) .ne. MPI_PROC_NULL) then
 641               errs = errs + 1
 642               print *, 's2(MPI_SOURCE) != MPI_PROC_NULL at T7 Imrecv().'
 643           endif
 644           if (s2(MPI_TAG) .ne. MPI_ANY_TAG) then
 645               errs = errs + 1
 646               print *, 's2(MPI_TAG) != MPI_ANY_TAG at T7 Imrecv().'
 647           endif
 648           if (s2(MPI_ERROR) .ne. MPI_ERR_OTHER) then
 649               errs = errs + 1
 650               print *, 's2(MPI_ERROR) != MPI_ERR_OTHER at T7 Imrecv().'
 651           endif
 652           if (msg .ne. MPI_MESSAGE_NULL) then
 653               errs = errs + 1
 654               print *, 'msg != MPI_MESSAGE_NULL at T7 Imrecv().'
 655           endif
 656
 657           count = -1
 658           call MPI_Get_count(s2, MPI_INTEGER, count, ierr)
 659           if (count .ne. 0) then
 660               errs = errs + 1
 661               print *, 'recv buffer does not have 0 MPI_INTEGER.'
 662           endif
 663       endif
 664
 665       call mtest_finalize( errs )
 666       call mpi_finalize( ierr )
 667       end