PROGRAM MAIN
           include "mpif.h"
           INTEGER N
           PARAMETER(N=100)
           REAL,ALLOCATABLE:: NEW(:,:),OLD(:,:), TMP(:,:)
           REAL MAXERR, ERR, MAXERRG
           INTEGER NPROCS, NID, REMAINDER, SIZE, I, J,IERR
           CHARACTER*2 STR
           REAL TOL
           INTEGER STATUS
           INTEGER REQ_SEND10, REQ_SEND20, REQ_RECV10, REQ_RECV20
           TOL=0.00001
!
!          Initial mpi setup
!
           CALL MPI_INIT(IERR)
           CALL MPI_COMM_RANK(MPI_COMM_WORLD, NID,IERR)
           CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR)
           REMAINDER = MOD((N-1), NPROCS)
!
!          Deviding the mesh column wise
!
           SIZE = (N-1-REMAINDER)/NPROCS
           IF(NID .LT. REMAINDER) THEN
             SIZE=SIZE+2
           ELSE
             SIZE = SIZE+1 
           ENDIF
           ALLOCATE(NEW(0:N+1,0:SIZE+1),
     &     OLD(0:N+1,0:SIZE+1),TMP(0:N+1,0:SIZE+1))
!
!          Initialization of the arrays with initial and bounday
!          conditions
!
           NEW=0.
           OLD=0.
           TMP=0.
           DO I=0, SIZE
           NEW(0,I) = 1.0
           NEW (N,I) =1.0 
           OLD(0,I) =1.0 
           OLD (N,I) = 1.0
          ENDDO
           IF(NID .EQ. 0) THEN
           DO J=1, N-1
            NEW(J,0) = 1.0
            OLD(J,0)  =1.0
           ENDDO
           ENDIF
           IF(NID .EQ. NPROCS-1)THEN
           DO J=1,N-1
            NEW(J,SIZE) =1.0 
           OLD(J,SIZE) =1.0
           ENDDO
           ENDIF
!
!          First time update for new
!
           CALL ITERATION(OLD,NEW,N+1,SIZE+1,1,SIZE,MAXERR)
           CALL MPI_ALLREDUCE(MAXERR,MAXERRG, 1, MPI_REAL, MPI_MAX, 
     &      MPI_COMM_WORLD,IERR)
!
!           Main iteration loop
!
  101       DO I=0,SIZE+1
            DO J=0,N+1
            TMP(J,I) = NEW(J,I)
          NEW(J,I) = OLD(J,I)
          OLD(J,I) = TMP(J,I)
          ENDDO
          ENDDO
          REQ_SEND10 = 0
          REQ_RECV20 = 0
!
!        initiate sharing  border information with neighbours
!
          IF(NID .LT. NPROCS-1)THEN
            CALL   MPI_ISEND(OLD(1,SIZE-1), N-1,MPI_REAL, NID+1,10, 
     &                  MPI_COMM_WORLD,REQ_SEND10,IERR)
            CALL   MPI_IRECV(OLD(1,SIZE), N-1,MPI_REAL, NID+1, 20, 
     &         MPI_COMM_WORLD, REQ_RECV20,IERR)
                   ENDIF
          REQ_SEND20 = 0
          REQ_RECV10 =0
          IF (NID .GT. 0) THEN
         CALL MPI_ISEND(OLD(1,1), N-1, MPI_REAL, NID-1, 20, 
     & MPI_COMM_WORLD, REQ_SEND20,IERR)
         CALL MPI_IRECV(OLD(1,0), N-1, MPI_REAL, NID-1, 10,
     & MPI_COMM_WORLD,  REQ_RECV10,IERR)
                 ENDIF
!
!         Compute for intirior part of the domain
!
          CALL ITERATION (OLD, NEW,N+1,SIZE+1, 2, SIZE-1, MAXERR)
!
!          Make sure the border information is there for border points
!          and compute for them.
!
           IF(NID .LT. NPROCS-1) THEN
                  CALL MPI_WAIT(REQ_RECV20,STATUS,IERR)
            ENDIF
              CALL ITERATION (OLD,NEW,N+1,SIZE+1,SIZE-1,SIZE,ERR)
              IF(ERR .GT. MAXERR) THEN
                 MAXERR = ERR
               ENDIF
            IF(NID .GT.0) THEN
                 CALL MPI_WAIT(REQ_RECV10,STATUS,IERR)
          ENDIF
               CALL ITERATION (OLD,NEW,N+1,SIZE+1,1,2,ERR)
           
            IF(ERR .GT. MAXERR) THEN
              MAXERR = ERR
            ENDIF
!
!       Get the global maximum of the error and check wheather it is
!       less then desired accuracy 
!
      CALL MPI_ALLREDUCE(MAXERR,MAXERRG, 1,MPI_REAL,MPI_MAX, 
     &MPI_COMM_WORLD,IERR)
        IF(MAXERRG .GT. TOL) THEN
!
!       if not convergen then go back to the loop otherwise come out
!       and write the answer
!
        GO TO 101
        ENDIF
         WRITE (STR,'(i2)')NID
         IF(NID.LT.9)THEN
         STR(1:1)='0'
         ENDIF 
         OPEN(10,FILE ='Solution'//STR//'.Txt',FORM='FORMATTED')
         IF(NID ==0)THEN
         DO J=0, N
           WRITE(10,10)NEW(J,0)
         ENDDO
         ENDIF
        DO I=1, SIZE-1
        DO J=0, N
            WRITE(10,10)NEW(J,I)
        ENDDO
        ENDDO
        IF(NID .EQ. NPROCS-1) THEN
        DO J=0 , N
            WRITE(10,10)NEW(J,SIZE)
        ENDDO
        ENDIF
        CLOSE(10)
  10    FORMAT(E15.4)
        CALL MPI_FINALIZE(IERR)
        END



        SUBROUTINE ITERATION( OLD, NEW,M1,N1,START, FINISH,ERR)
        INTEGER M1,N1,START,FINISH
        REAL OLD(0:M1,0:N1),NEW(0:M1,0:N1)
        REAL DIFF, ERR 
        INTEGER I,J
        ERR =0.
        DO I= START, FINISH-1
        DO J=1,M1-1 
        NEW(J,I) =.25*(OLD(J,I+1)+OLD(J,I-1)+OLD(J+1,I)+OLD(J-1,I))
        DIFF = NEW(J,I) - OLD(J,I)
        IF(DIFF.LT. 0) THEN 
        DIFF = -DIFF
        ENDIF
        IF(ERR .LT. DIFF) THEN
        ERR= DIFF
        ENDIF
        ENDDO
        ENDDO
        RETURN
        END