      PROGRAM parallel_search
c     
c     /* this program performs a search of matching entries in an */
c     /* integer array in parallel. there is one "master" process */
c     /* dedicated to i/o operations and distributing work to     */
c     /* "worker" processes, which in turn perform the actual     */
c     /* search task simultaneously. communication of matching    */
c     /* entry locations is performed immediately by each worker. */
c     /* therefore, the "master" needs to listen to incoming mess-*/
c     /* ages from any source; also, there is a distinction be-   */
c     /* ween messages containing a result, and those containing  */
c     /* an "end of search" flag. this is realized by using two   */
c     /* different values for the message tag.                    */
c
      implicit none
      include 'mpif.h'
      integer n
      parameter (N=300)
      integer endtag,resulttag
      parameter(endtag=1,resulttag=2)
      integer i, target
      integer b(N)
      integer rank,size,err
      integer istart,istop,ind,iff,ill,nloc
      integer status(MPI_STATUS_SIZE)
      integer end_cnt,x,gi
c
      CALL MPI_INIT(err)
      CALL MPI_COMM_RANK(MPI_COMM_WORLD, rank, err)
      CALL MPI_COMM_SIZE(MPI_COMM_WORLD, size, err)
c
      if(size.le.1)then
         write(*,*)'need at least 2 processors!'
         goto 100
      endif
c
c     /* determine the local indices of the array decomposition */
      call decompose(n,size,rank,iff,ill)
c
      if(rank.gt.0)
     $     write(*,*)'rank=',rank,' (out of ',size,') indices: ',
     $     iff,ill
c
      if (rank.eq.0) then
         open(unit=10,file="b.data")
         read(10,*) target
c         
c     /* send target value to all other processors */
         do i=1,size-1
            CALL MPI_SEND(target,1,MPI_INTEGER,i,resulttag,
     $           MPI_COMM_WORLD,err)
         end do
c
         do i=1,300
            read(10,*) b(i)
         end do
         close(10)
c
c     /* send sub-arrays to all others */
c     /* distribution: integer divide, last proc gets the odd-balls */
         do i=1,size-1
            call decompose(n,size,i,iff,ill)
            nloc=ill-iff+1
            CALL MPI_SEND(b(iff),nloc,MPI_INTEGER,i,endtag,
     $           MPI_COMM_WORLD,err)
         enddo
c
         end_cnt=0
         open(unit=11,file="found.data")
         do while (end_cnt .ne. size-1)
            CALL MPI_RECV(x,1,MPI_INTEGER,MPI_ANY_SOURCE,MPI_ANY_TAG,
     $           MPI_COMM_WORLD,status,err)
            if (status(MPI_TAG) == endtag ) then
               end_cnt=end_cnt+1 ! See Comment  
            else
               write(11,*) "P",status(MPI_SOURCE),x
            end if
         end do 
         close(11)
c
      else 
         CALL MPI_RECV(target,1,MPI_INTEGER,0,resulttag,
     $        MPI_COMM_WORLD,status,err) 
         nloc=ill-iff+1
         CALL MPI_RECV(b,nloc,MPI_INTEGER,0,endtag,
     $        MPI_COMM_WORLD,status,err) 
c
         do i=1,nloc
            if (b(i).eq.target) then
               gi=i+iff-1       !  convert local index to global 
               CALL MPI_SEND(gi,1,MPI_INTEGER,0,resulttag,
     $              MPI_COMM_WORLD,err) !result-message
            end if
         end do  
c         
         CALL MPI_SEND(target,1,MPI_INTEGER,0,endtag,
     $        MPI_COMM_WORLD,err) ! end-of-job message
c         
      end if 
c
 100  CALL MPI_FINALIZE(err)
c
      END PROGRAM parallel_search
c---------------------------------------------------------------------|
      subroutine decompose(n,size,rank,ifirst,ilast)
      implicit none
c     /* computes simple 1d array decomposition:               */
c     /* ifirst,ilast are the first/last indices of each sub-  */
c     /* array, computed as a function of "n" - the number of  */
c     /* points, "size" - the number of processors, "rank" -   */
c     /* the processor rank.                                   */
c     /* NOTE: we do not distribute any points to the "master" */
c     /* (rank=0).                                             */
      integer n,size,rank,ifirst,ilast,neven
c
      neven=int(n/(size-1))
      ifirst=(rank-1)*neven+1
      ilast=rank*neven
      if(rank.eq.size-1)ilast=ilast+mod(n,size-1)
c
      return
      end subroutine decompose
c---------------------------------------------------------------------|
