PROGRAM mpi_f77_example_1

c*********************************************************************72
c
c  FORTRAN 77 MPI code for use with MPE examples.
c  2008-01-15
c
      INCLUDE 'mpif.h'

      integer nmax
      PARAMETER (nmax=1000000)

      integer error
      integer npart
      integer nrest
      integer rank
      integer size
      integer status(MPI_STATUS_SIZE)
      real sum
      real x(nmax)
      real y(nmax)

c     COMMON /arry/ x,y

      CALL mpi_init ( error )
      CALL mpi_comm_rank ( mpi_comm_world, rank, error )
      CALL mpi_comm_size ( mpi_comm_world, size, error )

      npart = nmax / size
      nrest = nmax - npart * size

      IF (nrest .NE. 0) THEN
        WRITE(*,*)' size =',size,' should be a factor of nmax =',nmax
        STOP
      END IF

      IF ( rank .EQ. 0 ) THEN

        DO i = 1, nmax
          x(i) = i
        end do

        IF (size .gt. 1) THEN

          DO iproc = 1, size-1
            index = iproc*npart+1
            CALL MPI_SEND(x(index),npart,MPI_REAL,iproc,1,
     &         MPI_COMM_WORLD,error)
          end do

        END IF

        DO i = 1, npart
          y(i) = x(i) ** 2.3
        end do

        IF(size .gt. 1)then

          DO iproc = 1, size-1
            index = iproc*npart+1
            CALL MPI_RECV(y(index),npart,MPI_REAL,iproc,2,
     &           MPI_COMM_WORLD,status,error)
          WRITE(*,*)MPI_SOURCE,status(MPI_SOURCE),
     &              MPI_TAG,status(MPI_TAG),
     &              MPI_ERROR,status(MPI_ERROR)
          end do

        END IF

        sum = 0.0
        DO i= 1, nmax
          sum = sum + y(i)
        end do

        WRITE(*,*)' sum=',sum

      ELSE

        CALL MPI_RECV(x,npart,MPI_REAL,0,1,
     &    MPI_COMM_WORLD,status,error)

        DO i=1,npart
          y(i) = x(i)**2.3
        end do

        CALL MPI_SEND(y,npart,MPI_REAL,0,2,
     &   MPI_COMM_WORLD,error)

      END IF
      
      CALL mpi_finalize ( error )

      STOP
      END