!=======================================================================
! RCS Header:
!   Revision     [$Revision: 1.6.2.1 $]     Named [$Name: release#2_9_b5 $]
!   Last checkin [$Date: 2001/12/06 10:13:54 $]
!   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_CRECV (MSG, LEN, SEND, ISTAT, RARR, SARR)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Receive a character array from processor SEND.
!     *
!     * Input:
!     *  MSG     - message tag
!     *  LEN     - number of BYTES in message
!     *  SEND    - sender of the message (SEND = GC_ANY means any
!     *            processor)
!     *  SARR    - name of the array on the sending processor
!     *            (SHM_SRC only)
!     *
!     * Output:
!     *  RARR    - array to be received
!     *  ISTAT   - status of send 0 is OK (MPI_SRC only),
!     *            refer to the header files for nonzero status codes
!     *
!     * NOTES:       
!     *
!     ******************************************************************

      IMPLICIT NONE
      INTEGER MSG, LEN, SEND, ISTAT
      CHARACTER*(*) RARR, SARR
#if defined(SHM_SRC) 
      INTEGER LEN8, IRALIGN, ISALIGN, IRARR, ISARR, IRADDR, ISADDR
      POINTER (PRARR, IRARR), (PSARR, ISARR)
#include "gc__shm_char_common.h"
#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 STATUS(MPI_STATUS_SIZE)
      INTEGER GC_ME,ME,I
#endif


#if defined(SHM_SRC) 
      IF (LEN .GT. MAX_CHARS) CALL GC__ERRLIM(1, 'CRECV', 'CHARS', 
     $                                        MAX_CHARS, LEN)

!     The GC_Cxxxx() character routines use SHMEM_GET() only. Notice: we
!     must assign LOCs to integers to avoid word addressing pointer
!     arithmetics.
      IRADDR = LOC(RARR)
      IRALIGN = MOD(IRADDR,8)
      ME = GC_ME()
      CALL GC__GET_SWAP_LOCATION(NAM_FLAG, ME, ME, SEND, PTR, 1)
!DIR$ SUPPRESS 
      INFO = SHMEM_SWAP(NAM_FLAG(SEND), 0, ME)
      IF (INFO .NE. SHMEM_SYNC_VALUE)
     &   CALL GC__LOST_LOCK(ME, SEND, INFO)
      ISADDR = PTR
      ISALIGN = MOD(ISADDR,8)

      IF (IRALIGN .EQ. 0 .AND. ISALIGN .EQ. 0) THEN
         PRARR = IRADDR
      ELSE
         PRARR = LOC(ICBUF)
      ENDIF
      PSARR = ISADDR - ISALIGN
      LEN8 = (LEN+ISALIGN) / GC__ISIZE
      IF (MOD(LEN+ISALIGN, GC__ISIZE) .NE. 0) LEN8 = LEN8 + 1

      CALL SHMEM_GET(IRARR, ISARR, LEN8, SEND)
      
!     Copy from character buffer ICBUF if RARR _or_ SARR was misaligned.
      IF (IRALIGN .NE. 0 .OR. ISALIGN .NE. 0) THEN
         RARR(1:LEN) = CBUF(ISALIGN+1:ISALIGN+LEN)
      ENDIF
#endif

#if defined(MPI_SRC)
      ME=GC_ME()
      IF (SEND .EQ. ME) THEN  ! Receiving from myself
        DO I=1,LEN
          RARR(I:I)=SARR(I:I)
        ENDDO
      ELSE ! Receiving from another processor
        IF (SEND .EQ. GC__ANY) THEN
           CALL MPI_RECV(RARR, LEN, MPI_CHARACTER, MPI_ANY_SOURCE, MSG,
     $          MPI_COMM_WORLD, STATUS, ISTAT)
        ELSE
           CALL MPI_RECV(RARR, LEN, MPI_CHARACTER, SEND, MSG,
     $          MPI_COMM_WORLD, STATUS, ISTAT)
        ENDIF
      ENDIF ! IF (SEND .EQ. ME)
#endif

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

      RETURN
      END