!=======================================================================
! RCS Header:
!   Revision     [$Revision: 1.5.2.1 $]     Named [$Name: release#2_9_b5 $]
!   Last checkin [$Date: 2001/12/06 10:13:50 $]
!   Author       [$Author: frpb $]
!=======================================================================

! *****************************COPYRIGHT*******************************
! (c) CROWN COPYRIGHT 2001, Met Office, All Rights Reserved.           
! Please refer to Copyright file in top level GCOM directory
!                 for further details
! *****************************COPYRIGHT*******************************

#include "gc_prolog.h"    

      SUBROUTINE GC_RSEND (MSG, LEN, RECI, ISTAT, RARR, SARR)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Send a real array from this processor to processor RECI.
!     *
!     * Input:
!     *  MSG     - message tag
!     *  LEN     - number of elements in message
!     *  RECI    - receiver of the message
!     *  RARR    - name of the array on recieving processor
!     *            (SHM_SRC and FMM_SRC only)
!     *  SARR    - array to be sent
!     *
!     * Output:
!     *  ISTAT   - status of send 0 is OK (MPI_SRC only),
!     *            refer to the header files for nonzero status codes
!     *
!     * NOTES:  
!     *  The use of ISTAT as an input argument is obsoleted. Use
!     *  GC_SETOPT().     
!     *
!     ******************************************************************

      IMPLICIT NONE
      INTEGER MSG, LEN, RECI, ISTAT
      REAL RARR(LEN), SARR(LEN)
#if defined(SHM_SRC)
#include "gc__opts_common.h"
      INCLUDE 'mpp/shmem.fh'
      INTEGER GC_ME, ME, SHMEM_SWAP, INFO
      REAL LARR(LEN)
      POINTER(PTR,LARR)
#include "gc__nam_flags_common.h"
#endif
#if defined(MPI_SRC)
      INCLUDE 'mpif.h'
      INTEGER GC_ME,ME
#endif
#if defined(SERIAL_SRC)
      INTEGER I
#endif

#if defined(SHM_SRC) 
      ME = GC_ME()
      CALL GC__GET_SWAP_LOCATION(NAM_FLAG, ME, RECI, ME, PTR, 0)
      PTR = LOC(SARR)
!DIR$ SUPPRESS NAM_FLAG
      INFO = SHMEM_SWAP(NAM_FLAG(ME), PTR, RECI)
      IF (INFO .NE. SHMEM_SYNC_VALUE)
     $   CALL GC__LOST_LOCK(RECI, ME, INFO)
#endif

#if defined(MPI_SRC)
      ME=GC_ME()
      IF (RECI .NE. ME) THEN    ! If I'm not sending to myself
#if defined(BUFFERED_MPI)
         CALL MPI_BSEND(SARR, GC__RSIZE*LEN, MPI_BYTE, RECI, MSG,
     $        MPI_COMM_WORLD, ISTAT)
#else 
         CALL MPI_SEND(SARR, GC__RSIZE*LEN, MPI_BYTE, RECI, MSG,
     $        MPI_COMM_WORLD, ISTAT)
#endif
      ENDIF
#endif

#if defined(SERIAL_SRC)
      DO I=1,LEN
        RARR(I)=SARR(I)
      ENDDO
#endif

#if defined(SHM_SRC) || defined(SERIAL_SRC)
      ISTAT = GC__OK
#endif

      RETURN
      END