C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/exch3/ex3_send_rx2.template,v 1.1 2006/04/06 20:36:26 edhill Exp $
C $Name:  $

#include "EX3_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: EX3_SEND_RX2

C     !INTERFACE:
      SUBROUTINE EX3_SEND_RX2(
     I     bufftag, recvProc,
     I     along_i,
     I     prmat,
     I     il,ih,is,  jl,jh,js,  kl,kh,ks,
     I     io1,jo1,ko1, io2,jo2,ko2,
     I     idl1,idh1, jdl1,jdh1, kdl1,kdh1,
     I     array1,
     I     idl2,idh2, jdl2,jdh2, kdl2,kdh2,
     I     array2,
     B     buff, n_buff, msgID,
     I     commType,
     I     myThid )

C     !DESCRIPTION:
C     Vector exchange routine which copies values from two input arrays,
C     performs a rotation/permutation of the values, writes the values
C     to two buffers in the specified order and then, if necessary,
C     calls the appropriate MPI send functions.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"

C     !INPUT PARAMETERS:
      INTEGER bufftag, recvProc
      LOGICAL along_i
      INTEGER prmat(4)
      INTEGER il,ih,is, jl,jh,js, kl,kh,ks
      INTEGER io1,jo1,ko1, io2,jo2,ko2
      INTEGER idl1,idh1, jdl1,jdh1, kdl1,kdh1
      INTEGER idl2,idh2, jdl2,jdh2, kdl2,kdh2
      _RX array1( idl1:idh1, jdl1:jdh1, kdl1:kdh1 )
      _RX array2( idl2:idh2, jdl2:jdh2, kdl2:kdh2 )
      INTEGER n_buff
      _RX buff( n_buff )
      INTEGER msgID(1)
      CHARACTER commType
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES
      INTEGER ii,jj,kk, ntb, nbv
#ifdef ALLOW_USE_MPI
      INTEGER mpiid, mpirc
#endif
      _RX prm(4), a1, a2
      character*(100) msgbuf

C     Setup the affine (permute & rotate) matrix as a real of the same
C     precision
      DO ii = 1,4
        prm(ii) = REAL(prmat(ii))
      ENDDO

C     Calculate buffer sizes
      nbv =  IABS((ih-il+1)/is) 
     &     * IABS((jh-jl+1)/js)
     &     * IABS((kh-kl+1)/ks)
      IF ( nbv*2 .GT. n_buff ) THEN
        WRITE(msgbuf,'(2a)') 'EX3_SEND_RX2 ERROR: buffer too small',
     &       '--please increase EX3_BUFF_FAC in ''EX3_SIZE.h'''
        CALL print_error(msgbuf, mythid)
        WRITE(msgbuf,'(a,i9)') '  current buffer length   = ', n_buff
        CALL print_error(msgbuf, mythid)
        WRITE(msgbuf,'(a,i9)') '  requested buffer length = ', nbv*2
        CALL print_error(msgbuf, mythid)
        STOP 'ABNORMAL END: S/R EX3_SEND_RX2'
      ENDIF


C     Copy the values into the buffer in the specified order
      ntb = 0
      DO kk = kl, kh, ks
        IF ( along_i ) THEN
C         Here, the "i" dimension cycles fastest and it "measures" the
C         overlap width
          DO jj = jl, jh, js
            DO ii = il, ih, is
              ntb = ntb + 1
              a1 = array1( ii+io1, jj+jo1, kk )
              a2 = array2( ii+io2, jj+jo2, kk )
              buff( ntb     ) = prm(1)*a1 + prm(2)*a2
              buff( nbv+ntb ) = prm(3)*a1 + prm(4)*a2
            ENDDO
          ENDDO
        ELSE
C         Here, the "j" dimension cycles fastest and it "measures" the
C         overlap width
          DO ii = il, ih, is
            DO jj = jl, jh, js
              ntb = ntb + 1
              a1 = array1( ii+io1, jj+jo1, kk )
              a2 = array2( ii+io2, jj+jo2, kk )
              buff( ntb     ) = prm(1)*a1 + prm(2)*a2
              buff( nbv+ntb ) = prm(3)*a1 + prm(4)*a2
            ENDDO
          ENDDO
        ENDIF
      ENDDO

      IF ( commType .EQ. 'P' ) THEN
C       We may eventually need (?) some sort of synchronization
C       mechanism for multi-threaded mode
      ELSEIF ( commType .EQ. 'M' ) THEN
#ifdef ALLOW_USE_MPI
        nbv = nbv * 2
        CALL MPI_Isend(
     I       buff, nbv, EX3_MPI_TYPE_RX, recvProc, bufftag,
     I       MPI_COMM_MODEL, 
     O       mpiid, mpirc )
C       Store MPI_Wait token in msgID.
        msgID(1) = mpiid
#endif
      ELSE
        WRITE(msgbuf,'(3a)') 'EX3_SEND_RX2 ERROR: commType ''',
     &       commType, ''' is invalid'
        CALL print_error(msgbuf, mythid)
        STOP 'ABNORMAL END: S/R EX3_SEND_RX2'
      ENDIF

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***