program array 

      include 'mpif.h'

      integer   ARRAYSIZE, MASTER
      parameter (ARRAYSIZE = 60000)
      parameter (MASTER = 0)

      integer  numtasks, numworkers, taskid, dest, index, i, ierr,
     &         arraymsg, indexmsg, source, chunksize
      integer status(MPI_STATUS_SIZE)
      real*4   data(ARRAYSIZE), result(ARRAYSIZE+1)

C-------------------------- INITIALIZATIONS ------------------------------>
C Find out how many tasks are in this partition and what my task id is.
C Then define the number of worker tasks and the array partition size as
C chunksize.
C NOTE:  For this example, the MP_PROCS environment variable should be set
C to an odd number...to insure even distribution of the array to
C numtasks-1 worker tasks.
C------------------------------------------------------------------------->

C  *------------------->
C *---> Initialize MPI
C  *------------------->

      call MPI_INIT( ierr )

C  *------------------------------------------>
C *---> Determine rank in global communicator
C  *------------------------------------------>

      call MPI_COMM_RANK(MPI_COMM_WORLD, taskid, ierr)

C  *---------------------------------------------->
C *---> Determine size of the global communicator
C  *---------------------------------------------->

      call MPI_COMM_SIZE(MPI_COMM_WORLD, numtasks, ierr)

      numworkers = numtasks-1
      chunksize = (ARRAYSIZE / numworkers)
      arraymsg = 1
      indexmsg = 2

C  *=-=-=-=-=-=-=-=-=-=-=->
C ***-=-=-=-> MASTER TASK
C  *=-=-=-=-=-=-=-=-=-=-=->

      if (taskid .eq. MASTER) then

C  *------------------------->
C *---> Initialize the array
C  *------------------------->

      do 20 i=1, ARRAYSIZE 
        data(i) =  0.0
 20   continue

C  *--------------------------------------------------->
C *---> Send each worker task its portion of the array
C  *--------------------------------------------------->

      index = 1
      do 30 dest=1, numworkers
        write(*,*) 'Sending to worker task', dest

C  *--------------------------------------------------------------------->
C *--->Send index so each process knows where to start in the data array
C  *--------------------------------------------------------------------->

        call MPI_SEND(index, 1, MPI_INTEGER, dest, indexmsg, 
     &                MPI_COMM_WORLD, ierr)

C  *-------------------------------------------------------------->
C *--->Send chunksize bit of data starting at the index position.
C  *-------------------------------------------------------------->

        call MPI_SEND(data(index), chunksize, MPI_REAL, dest, arraymsg,
     &                MPI_COMM_WORLD, ierr)
        index = index + chunksize
 30   continue

C  *------------------------------------------------------------------->
C *---> Wait to get back the results from workers & print a few values
C  *------------------------------------------------------------------->

      do 40 i=1, numworkers
        source = i

C  *------------------------------------------------------------------------->
C *---> Receive the index position of the chunk this process was working on.
C  *------------------------------------------------------------------------->

        call MPI_RECV(index, 1, MPI_INTEGER, source, indexmsg,
     &                MPI_COMM_WORLD, status, ierr)

C  *--------------------------------------------------------->
C *---> Receive chunksize bit of data for the results array.
C  *--------------------------------------------------------->

        call MPI_RECV(result(index), chunksize, MPI_REAL, source,
     &                arraymsg, MPI_COMM_WORLD, status, ierr)
        print *, '---------------------------------------------------'
        print *, 'MASTER: Sample results from worker task ', source
        print *, '   result[', index, ']=', result(index)
        print *, '   result[', index+100, ']=', result(index+100)
        print *, '   result[', index+1000, ']=', result(index+1000)
        print *, ' '
 40   continue

      print *, 'MASTER: All Done!' 
      endif

C  *=-=-=-=-=-=-=-=-=-=-=-=>
C ***-=-=-=-> WORKER TASKS
C  *=-=-=-=-=-=-=-=-=-=-=-=>

      if (taskid .gt. MASTER) then

C  *---------------------------------------------------------->
C *---> Receive the starting position of the data to work on.
C  *---------------------------------------------------------->

        call MPI_RECV(index, 1, MPI_INTEGER, MASTER, indexmsg,
     &                MPI_COMM_WORLD, status, ierr)

C  *-------------------------------------------------------------->
C *---> Receive chunksize bit of data starting at index position.
C  *-------------------------------------------------------------->

        call MPI_RECV(result(index), chunksize, MPI_REAL, MASTER,
     &                arraymsg, MPI_COMM_WORLD, status, ierr)

C  *-------------------------------------------------------------->
C *---> Do a simple value assignment to each of my array elements
C  *-------------------------------------------------------------->

        do 50 i=index, index + chunksize
          result(i) = i + 1
 50     continue

C  *--------------------------------------------------------------->
C *---> Send index position of the data working on back to master.
C  *--------------------------------------------------------------->

        call MPI_SEND(index, 1, MPI_INTEGER, MASTER, indexmsg,
     &                MPI_COMM_WORLD, ierr)

C  *------------------------------------------------------------------->
C *---> Send chunksize bit of result back to master starting at index.
C  *------------------------------------------------------------------->

        call MPI_SEND(result(index), chunksize, MPI_REAL, MASTER,
     &                arraymsg, MPI_COMM_WORLD, ierr)

      endif

C  *----------------->
C *---> Finalize MPI
C  *----------------->

      call MPI_FINALIZE(ierr)
      end