C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/exch3/ex3_send_rx1.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_RX1

C     !INTERFACE:
      SUBROUTINE EX3_SEND_RX1(
     I     bufftag, recvProc,
     I     along_i,
     I     il,ih,is,  jl,jh,js,  kl,kh,ks,
     I     io1,jo1,ko1,
     I     idl1,idh1, jdl1,jdh1, kdl1,kdh1,
     I     array1,
     B     buff, n_buff, msgID,
     I     commType,
     I     myThid )

C     !DESCRIPTION:
C     Scalar exchange routine which simply copies values from an input
C     array to a buffer in the specified order and then, if necessary,
C     calls the appropriate MPI send function.

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

C     !INPUT PARAMETERS:
      INTEGER bufftag, recvProc
      LOGICAL along_i
      INTEGER il,ih,is, jl,jh,js, kl,kh,ks
      INTEGER io1,jo1,ko1
      INTEGER idl1,idh1, jdl1,jdh1, kdl1,kdh1
      _RX array1( idl1:idh1, jdl1:jdh1, kdl1:kdh1 )
      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
      character*(100) msgbuf

C     Calculate buffer sizes
      nbv =  IABS((ih-il+1)/is) 
     &     * IABS((jh-jl+1)/js)
     &     * IABS((kh-kl+1)/ks)
      IF ( nbv .GT. n_buff ) THEN
        WRITE(msgbuf,'(2a)') 'EX3_SEND_RX1 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
        CALL print_error(msgbuf, mythid)
        STOP 'ABNORMAL END: S/R EX3_SEND_RX1'
      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
              buff( ntb ) = array1( ii, jj, kk )
            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
              buff( ntb ) = array1( ii, jj, kk )
            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
        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_RX1 ERROR: commType ''',
     &       commType, ''' is invalid'
        CALL print_error(msgbuf, mythid)
        STOP 'ABNORMAL END: S/R EX3_SEND_RX1'
      ENDIF

      RETURN
      END

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

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