teshsuite/smpi/mpich-test/pt2pt/sendfort.f

   1       program main
   2 C
   3 C     Test Fortran logical data
   4 C
   5       implicit none
   6       include 'mpif.h'
   7       integer ierr, n, tag, status(MPI_STATUS_SIZE), size, rank, i
   8       integer errs, nrecv
   9       logical l(1000)
  10 C
  11       call mpi_init( ierr )
  12       call mpi_comm_size( MPI_COMM_WORLD, size, ierr )
  13       call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
  14 C
  15       n = 100
  16       do i=1, n
  17          l(i) = i .lt. n/2
  18       enddo
  19       tag = 27
  20       if (rank .eq. 1) then
  21          call MPI_Send( l, n, MPI_LOGICAL, 0, tag, MPI_COMM_WORLD, ierr
  22      $        )
  23       else if (rank .eq. 0) then
  24          call MPI_Recv( l, n, MPI_LOGICAL, 1, tag, MPI_COMM_WORLD,
  25      $        status, ierr )
  26 C         Check results
  27          call MPI_Get_count( status, MPI_LOGICAL, nrecv, ierr )
  28          if (nrecv .ne. n) then
  29             print *, 'Wrong count for logical data'
  30          endif
  31          errs = 0
  32          do i=1, n
  33             if (l(i) .neqv. (i .lt. n/2)) then
  34                errs = errs + 1
  35                print *, 'Error in logical entry ', i
  36             endif
  37          enddo
  38          if (errs .gt. 0) then
  39             print *, ' Found ', errs, ' errors'
  40          else
  41             print *, ' No Errors'
  42          endif
  43       endif
  44 C
  45       call mpi_finalize( ierr )
  46 C
  47       end