C***********************************************************
C            Test Program of MPI / test-3
C
C                                H. Matsufuru  20 Jan 2000
C***********************************************************
      PROGRAM TEST2
C
      IMPLICIT REAL*8 (A-H, O-Z)
      INCLUDE 'mpif.h'
C----------Variables----------------------------------------
      PARAMETER( NPE = 4, Nx = 16 )
      PARAMETER( Nx2 = Nx/NPE )
      DIMENSION A(Nx2), B(Nx2)
      INTEGER Istat1(MPI_STATUS_SIZE),
     &        Istat2(MPI_STATUS_SIZE)
C------------Main-------------------------------------------
C
      CALL MPI_Init(ierr)
C
      CALL MPI_Comm_size(MPI_COMM_WORLD, Nproc, ierr)
      CALL MPI_Comm_rank(MPI_COMM_WORLD, Nid, ierr)
C
      IF(Nproc.NE.NPE) WRITE(*,*) 'Wrong NPE.'
C
      IF(Nid.EQ.0) READ(*,*) N
      IF(Nid.EQ.0) WRITE(*,*) 'N = ', N
C
      CALL MPI_Bcast( N, 1, MPI_INTEGER, 0,
     &                             MPI_COMM_WORLD, ierr )
C
C --- Initial values of A ---
      DO 100 ix2 = 1, Nx2
        ix = ix2 + Nid * Nx2
        A(ix2) = 0.D0
        IF(ix.EQ.1) A(ix2) = 1.D0
 100  CONTINUE
C
      Nup = MOD(Nid+1,NPE)
      Ndn = MOD(Nid-1+NPE,NPE)
C
C --- Smoothing of A ---
      DO 1000 i = 1, N
C
       DO 1100 iturn = 0,1
       IF (MOD(Nid,2).EQ.iturn) THEN
         CALL MPI_Send( A(Nx2), 1, MPI_DOUBLE_PRECISION,
     &                  Nup, 10, MPI_COMM_WORLD, ierr )
         CALL MPI_Send( A(1), 1, MPI_DOUBLE_PRECISION,
     &                  Ndn, 20, MPI_COMM_WORLD, ierr )
       ELSE
         CALL MPI_Recv( Am, 1, MPI_DOUBLE_PRECISION,
     &            Ndn, 10, MPI_COMM_WORLD, Istat1,ierr )
         CALL MPI_Recv( Ap, 1, MPI_DOUBLE_PRECISION,
     &            Nup, 20, MPI_COMM_WORLD, Istat2,ierr )
       ENDIF
 1100  CONTINUE
C
       DO 1200 ix2 = 2, Nx2-1
         B(ix2) = A(ix2) + 0.5*( A(ix2-1)+A(ix2+1) )
 1200  CONTINUE
         B(  1) = A(  1) + 0.5*( Am      +A(2) )
         B(Nx2) = A(Nx2) + 0.5*( A(Nx2-1)+Ap   )
C
       DO 1300 ix2 = 1, Nx2
         A(ix2) = B(ix2)
 1300  CONTINUE
C
 1000 CONTINUE
C --- Smoothing finished ---
C
      DO 400 inode = 0, NPE-1
        IF(inode.EQ.Nid) THEN
          DO 420 ix2 = 1, Nx2
            ix = ix2 + Nid * Nx2
            WRITE(*,'(I4,F10.4)') ix, A(ix2)
 420      CONTINUE
        ENDIF
        CALL MPI_Barrier(MPI_COMM_WORLD, ierr)
 400  CONTINUE
C
      CALL MPI_Finalize(ierr)
C
C-----------------------------------------------------------
      STOP
      END
C***********************************************************
C***************************************************END*****
