C $Header: /u/gcmpack/MITgcm/eesupp/src/exch1_rx_ad.template,v 1.2 2013/08/09 22:31:01 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP

C     !ROUTINE: EXCH1_RX_AD

C     !INTERFACE:
#ifdef AUTODIFF_TAMC_COMPATIBILITY
      SUBROUTINE EXCH1_RX_AD(
     I                 myOLw, myOLe, myOLs, myOLn, myNz,
     I                 exchWidthX, exchWidthY,
     I                 cornerMode, myThid,
     U                 array )
#else
      SUBROUTINE EXCH1_RX_AD(
     U                 array,
     I                 myOLw, myOLe, myOLs, myOLn, myNz,
     I                 exchWidthX, exchWidthY,
     I                 cornerMode, myThid )
#endif

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH1_RX_AD
C     | o Control reverse-mode edge exchanges for RX array.
C     *==========================================================*
C     | Controlling routine for exchange of XY edges of an array
C     | distributed in X and Y. The routine interfaces to
C     | communication routines that can use messages passing
C     | exchanges, put type exchanges or get type exchanges.
C     |  This allows anything from MPI to raw memory channel to
C     | memmap segments to be used as a inter-process and/or
C     | inter-thread communiation and synchronisation
C     | mechanism.
C     | Notes --
C     | 1. Some low-level mechanisms such as raw memory-channel
C     | or SGI/CRAY shmem put do not have direct Fortran bindings
C     | and are invoked through C stub routines.
C     | 2. Although this routine is fairly general but it does
C     | require nSx and nSy are the same for all innvocations.
C     | There are many common data structures ( myByLo,
C     | westCommunicationMode, mpiIdW etc... ) tied in with
C     | (nSx,nSy). To support arbitray nSx and nSy would require
C     | general forms of these.
C     | 3. RX arrays are used to generate code for both _RL and
C     | _RS forms.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

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

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     array       :: Array with edges to exchange.
C     myOLw,myOLe :: West  and East  overlap region sizes.
C     myOLs,myOLn :: South and North overlap region sizes.
C     exchWidthX  :: Width of data region exchanged in X.
C     exchWidthY  :: Width of data region exchanged in Y.
C                    Note --
C                    1. In theory one could have a send width and
C                    a receive width for each face of each tile. The only
C                    restriction would be that the send width of one
C                    face should equal the receive width of the sent to
C                    tile face. Dont know if this would be useful. I
C                    have left it out for now as it requires additional
C                    bookeeping.
C     cornerMode  :: Flag indicating whether corner updates are needed.
C     myThid      :: my Thread Id number

      INTEGER myOLw, myOLe, myOLs, myOLn, myNz
      _RX     array( 1-myOLw:sNx+myOLe,
     &               1-myOLs:sNy+myOLn,
     &               myNz, nSx, nSy )
      INTEGER exchWidthX
      INTEGER exchWidthY
      INTEGER cornerMode
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     theSimulationMode :: Holds working copy of simulation mode
C     theCornerMode     :: Holds working copy of corner mode
C     i,j,k,bi,bj       :: Loop counters
      INTEGER theSimulationMode
      INTEGER theCornerMode
      INTEGER i,j,k,bi,bj
CEOP

      theSimulationMode = REVERSE_SIMULATION
      theCornerMode     = cornerMode

C--   Error checks
      IF ( exchWidthX .GT. myOLw   )
     &  STOP ' S/R EXCH1_RX_AD: exchWidthX .GT. myOLw'
      IF ( exchWidthX .GT. myOLe   )
     &  STOP ' S/R EXCH1_RX_AD: exchWidthX .GT. myOLe'
      IF ( exchWidthY .GT. myOLs   )
     &  STOP ' S/R EXCH1_RX_AD: exchWidthY .GT. myOLs'
      IF ( exchWidthY .GT. myOLn   )
     &  STOP ' S/R EXCH1_RX_AD: exchWidthY .GT. myOLn'
      IF ( myOLw      .GT. MAX_OLX_EXCH )
     &  STOP ' S/R EXCH1_RX_AD: myOLw .GT. MAX_OLX_EXCH'
      IF ( myOLe      .GT. MAX_OLX_EXCH )
     &  STOP ' S/R EXCH1_RX_AD: myOLe .GT. MAX_OLX_EXCH'
      IF ( myOLn      .GT. MAX_OLY_EXCH )
     &  STOP ' S/R EXCH1_RX_AD: myOLn .GT. MAX_OLY_EXCH'
      IF ( myOLs      .GT. MAX_OLY_EXCH )
     &  STOP ' S/R EXCH1_RX_AD: myOLs .GT. MAX_OLY_EXCH'
      IF ( myNz       .GT. MAX_NR_EXCH  )
     &  STOP ' S/R EXCH1_RX_AD: myNz  .GT. MAX_NR_EXCH '
      IF (       theCornerMode .NE. EXCH_IGNORE_CORNERS
     &     .AND. theCornerMode .NE. EXCH_UPDATE_CORNERS
     &   ) STOP ' S/R EXCH1_RX_AD: Unrecognised cornerMode '

C--   Cycle edge buffer level
      CALL EXCH_CYCLE_EBL( myThid )

      IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN

       IF ( Nx .EQ. 1 ) THEN
C      Special case for zonal average model i.e. case where Nx == 1
C      In this case a reverse mode exchange simply add values from all i <> 1
C      to i=1 element and reset to zero.
         DO bj=myByLo(myThid),myByHi(myThid)
          DO bi=myBxLo(myThid),myBxHi(myThid)
           DO k = 1,myNz
            DO j = 1-myOLs,sNy+myOLn
             DO i = 1-myOLw,0
              array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
     &                           + array(i,j,k,bi,bj)
              array(i,j,k,bi,bj) = 0.
             ENDDO
             DO i = sNx+1,sNx+myOLe
              array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
     &                           + array(i,j,k,bi,bj)
              array(i,j,k,bi,bj) = 0.
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
       ENDIF

       IF ( Ny .EQ. 1 ) THEN
C      Special case for X-slice domain i.e. case where Ny == 1
C      In this case a reverse mode exchange simply add values from all j <> 1
C      to j=1 element and reset to zero.
         DO bj=myByLo(myThid),myByHi(myThid)
          DO bi=myBxLo(myThid),myBxHi(myThid)
           DO k = 1,myNz
            DO j = 1-myOLs,0
             DO i = 1-myOLw,sNx+myOLe
              array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
     &                           + array(i,j,k,bi,bj)
              array(i,j,k,bi,bj) = 0.
             ENDDO
            ENDDO
            DO j = sNy+1,sNy+myOLn
             DO i = 1-myOLw,sNx+myOLe
              array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
     &                           + array(i,j,k,bi,bj)
              array(i,j,k,bi,bj) = 0.
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
       ENDIF

C--   end of special cases of forward exch
      ENDIF

      IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
C--     "Put" east and west edges.
        CALL EXCH_RX_SEND_PUT_X( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
C--     If corners are important then sync and update east and west edges
C--     before doing north and south exchanges.
        IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
         CALL EXCH_RX_RECV_GET_X( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
        ENDIF
C       "Put" north and south edges.
        CALL EXCH_RX_SEND_PUT_Y( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
C--     Sync and update north, south (and east, west if corner updating
C--     not active).
        IF ( theCornerMode .NE. EXCH_UPDATE_CORNERS ) THEN
         CALL EXCH_RX_RECV_GET_X( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
        ENDIF
        CALL EXCH_RX_RECV_GET_Y( array,
     I             myOLw, myOLe, myOLs, myOLn, myNz,
     I             exchWidthX, exchWidthY,
     I             theSimulationMode, theCornerMode, myThid )
      ENDIF

      IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
C       "Put" north and south edges.
        CALL EXCH_RX_SEND_PUT_Y( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
C--     If corners are important then sync and update east and west edges
C--     before doing north and south exchanges.
        IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
         CALL EXCH_RX_RECV_GET_Y( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
        ENDIF
C--     "Put" east and west edges.
        CALL EXCH_RX_SEND_PUT_X( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
C--     Sync and update east, west (and north, south if corner updating
C--     not active).
        IF ( theCornerMode .NE. EXCH_UPDATE_CORNERS ) THEN
         CALL EXCH_RX_RECV_GET_Y( array,
     I              myOLw, myOLe, myOLs, myOLn, myNz,
     I              exchWidthX, exchWidthY,
     I              theSimulationMode, theCornerMode, myThid )
        ENDIF
        CALL EXCH_RX_RECV_GET_X( array,
     I             myOLw, myOLe, myOLs, myOLn, myNz,
     I             exchWidthX, exchWidthY,
     I             theSimulationMode, theCornerMode, myThid )
      ENDIF

      IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN

       IF ( Nx .EQ. 1 ) THEN
C      Special case for zonal average model i.e. case where Nx == 1
C      In this case a forward mode exchange simply sets array to
C      the i=1 value for all i.
         DO bj=myByLo(myThid),myByHi(myThid)
          DO bi=myBxLo(myThid),myBxHi(myThid)
           DO k = 1,myNz
            DO j = 1-myOLs,sNy+myOLn
             DO i = 1-myOLw,sNx+myOLe
              array(i,j,k,bi,bj) = array(1,j,k,bi,bj)
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
       ENDIF

       IF ( Ny .EQ. 1 ) THEN
C      Special case for X-slice domain i.e. case where Ny == 1
C      In this case a forward mode exchange simply sets array to
C      the j=1 value for all j.
         DO bj=myByLo(myThid),myByHi(myThid)
          DO bi=myBxLo(myThid),myBxHi(myThid)
           DO k = 1,myNz
            DO j = 1-myOLs,sNy+myOLn
             DO i = 1-myOLw,sNx+myOLe
              array(i,j,k,bi,bj) = array(i,1,k,bi,bj)
             ENDDO
            ENDDO
           ENDDO
          ENDDO
         ENDDO
       ENDIF

C--    end of special cases of forward exch
      ENDIF

      RETURN
      END