SUBROUTINE EXCH_XY_R8( arr )

C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EXCH.h"

#ifdef ALLOW_MPI
#include "mpif.h"
#endif

#include "MPI_INFO.h"
#include "JAM_INFO.h"

C     == Routine arguments ==
      Real*8 arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)

C     == Local variables ==
      INTEGER I, J
      INTEGER northProc, southProc
      INTEGER farProc1, farProc2
      INTEGER toPid, fromPid
      INTEGER rc

      INTEGER myFourWayRank, exchangePhase

#ifdef ALLOW_MPI
      INTEGER mpiStatus(MPI_STATUS_SIZE)
#endif

C     East-west halo update (without corners)
      DO J=1,sNy
       DO I=1,OLx
        arr(1-I  ,J)     = arr(sNx-I+1,J)
        arr(sNx+I,J)     = arr(1+I-1  ,J)
       ENDDO
      ENDDO
   
C     Phase 1 pairing
C     | 0 |  ---> | 1 |
C     | 0 |  <--- | 1 |

C     | 2 |  ---> | 3 |
C     | 2 |  <--- | 3 |

C     | 4 |  ---> | 5 |
C     | 4 |  <--- | 5 |

C     etc ...             
C    

#ifdef USE_MPI_EXCH
C     North-south halo update (without corners)
C     Put my edges into a buffers
      IF ( MOD(myProcId,2) .EQ. 0 ) THEN
       DO I=1,sNx
        exchBuf1(I) = arr(I,sNy)
        exchBuf2(I) = arr(I,1  )
       ENDDO
      ELSE
       DO I=1,sNx
        exchBuf1(I) = arr(I,1  )
        exchBuf2(I) = arr(I,sNy)
       ENDDO
      ENDIF

C     Exchange the buffers
      northProc = mpi_northId
      southProc = mpi_southId
      IF ( MOD(myProcId,2) .EQ. 0 ) THEN
       farProc1 = northProc
       farProc2 = southProc
      ELSE
       farProc1 = southProc
       farProc2 = northProc
      ENDIF
C     Even-odd pairs
      IF ( farProc1 .NE. myProcId ) THEN
       CALL MPI_Sendrecv_replace(exchBuf1,sNx,MPI_DOUBLE_PRECISION,
     &                           farProc1,0,
     &                           farProc1,MPI_ANY_TAG,
     &                           MPI_COMM_WORLD,mpiStatus,
     &                           rc)
      ENDIF
C     Odd-even pairs
      IF ( farProc2 .NE. myProcId ) THEN
       CALL MPI_Sendrecv_replace(exchBuf2,sNx,MPI_DOUBLE_PRECISION,
     &                           farProc2,0,
     &                           farProc2,MPI_ANY_TAG,
     &                           MPI_COMM_WORLD,mpiStatus,
     &                           rc)
      ENDIF
#endif

#ifdef USE_JAM_EXCH

      myFourWayRank = MOD(myProcId,4)

      northProc = jam_northId
      southProc = jam_southId
      IF ( MOD(myProcId,2) .EQ. 0 ) THEN
C      sendBuf1  = &arr(I,sNy  )
C      recvBuf1  = &arr(I,sNy+1)
C      sendBuf2  = &arr(I,1    )
C      recvBuf2  = &arr(I,0    )
       farProc1 = northProc
       farProc2 = southProc
       IF ( farProc1 .NE. myProcId ) THEN
        CALL JAM_EXCHANGE(farProc1,arr(I,sNy),arr(I,sNy+1),sNx*8,jam_exchKey)
        jam_exchKey = jam_exchKey+1
       ENDIF

   10  CONTINUE
        CALL JAM_EXCHANGE_TEST( exchangePhase )
        IF ( myFourWayRank .EQ. 0 ) THEN
          IF ( exchangePhase .EQ. 0 ) GOTO 11
        ELSE
          IF ( exchangePhase .EQ. 1 ) GOTO 11
        ENDIF
       GOTO 10
   11  CONTINUE

       IF ( farProc2 .NE. myProcId ) THEN
        CALL JAM_EXCHANGE(farProc2,arr(I,1),arr(I,0),sNx*8,jam_exchKey)
        jam_exchKey = jam_exchKey+1
       ENDIF

       CALL JAM_EXCHANGE_MARK

      ELSE
C      sendBuf1  = &arr(I,1    )
C      recvBuf1  = &arr(I,0    )
C      sendBuf2  = &arr(I,sNy  )
C      recvBuf2  = &arr(I,sNy+1)
       farProc1 = southProc
       farProc2 = northProc
       IF ( farProc1 .NE. myProcId ) THEN
        CALL JAM_EXCHANGE(farProc1,arr(I,1),arr(I,0),sNx*8,jam_exchKey)
        jam_exchKey = jam_exchKey+1
       ENDIF

   20  CONTINUE
         CALL JAM_EXCHANGE_TEST( exchangePhase )
         IF ( myFourWayRank .EQ. 3 ) THEN
           IF ( exchangePhase .EQ. 0 ) GOTO 21
         ELSE
           IF ( exchangePhase .EQ. 1 ) GOTO 21
         ENDIF
       GOTO 20
   21  CONTINUE

       IF ( farProc2 .NE. myProcId ) THEN
        CALL JAM_EXCHANGE(farProc2,arr(I,sNy),arr(I,sNy+1),sNx*8,jam_exchKey)
        jam_exchKey = jam_exchKey+1
       ENDIF

       CALL JAM_EXCHANGE_MARK

      ENDIF
#endif

#ifdef USE_MPI_EXCH
C     Fill overlap regions from the buffers
      IF ( MOD(myProcId,2) .EQ. 0 ) THEN
       DO I=1,sNx
        arr(I,sNy+1) = exchBuf1(I)
        arr(I,0    ) = exchBuf2(I)
       ENDDO
      ELSE
       DO I=1,sNx
        arr(I,sNy+1) = exchBuf2(I)
        arr(I,0    ) = exchBuf1(I)
       ENDDO
      ENDIF
#endif

      IF ( numberOfProcs .EQ. 1 ) THEN
       DO I=1,sNx
        arr(I,sNy+1) = arr(I,1  )
        arr(I,0    ) = arr(I,sNy)
       ENDDO
      ENDIF

      RETURN
      END