!=======================================================================
! RCS Header:
!   Revision     [$Revision: 1.6.2.1 $]     Named [$Name: release#2_9_b5 $]
!   Last checkin [$Date: 2001/12/06 10:13:58 $]
!   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_CBCAST (MSG, LEN, SEND, NPROC, ISTAT, SARR)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Broadcast a character array to every processor.
!     *
!     * Input:
!     *  MSG     - message tag
!     *  LEN     - number of characters in message
!     *  SEND    - sender of the message
!     *  NPROC   - Number of processors
!     *  SARR    - array to be sent
!     *
!     * Output:
!     *  SARR    - array to be received (on nodes != SEND)
!     *  ISTAT   - status of bcast. 0 is OK (MPI_SRC only),
!     *            refer to the header files for nonzero status codes
!     *
!     * NOTES:       
!     *
!     ******************************************************************

      IMPLICIT NONE
      INTEGER MSG, LEN, SEND, NPROC, ISTAT
      CHARACTER*(*) SARR
#if defined(_CRAYMPP)
#if defined(MPI_SRC) || defined(SHM_SRC)
      INTEGER LEN8, ISALIGN, IRARR, ISARR, ISADDR, SHMEM_MY_PE
#include "gc__shm_char_common.h"
      POINTER (PRARR, IRARR), (PSARR, ISARR)
#endif
#endif
#if defined(SHM_SRC)
      INCLUDE 'mpp/shmem.fh'
#include "gc__shm_common.h"
#include "gc__opts_common.h"
#endif
#if defined(MPI_SRC)
      INCLUDE 'mpif.h'
#endif


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

      PRARR = LOC(ICBUF)
      PSARR = LOC(ICBUF)
      ISALIGN = 0
      CBUF(1:LEN) = SARR(1:LEN)
      LEN8 = (LEN+ISALIGN) / GC__ISIZE
      IF (MOD(LEN+ISALIGN, GC__ISIZE) .NE. 0) LEN8 = LEN8 + 1

      CALL BARRIER()
      CALL SHMEM_BROADCAST(IRARR,ISARR,LEN8,SEND,0,0,NPROC,
     $     BCAST_SYNC_WRK)
      IF (SHM_SAFE .NE. GC__OK) CALL BARRIER()

      SARR(1:LEN) = CBUF(1:LEN)
#endif

#if defined (MPI_SRC)
#if defined(_CRAYMPP) 
      IF (LEN .GT. MAX_CHARS) CALL GC__ERRLIM(0, 'CBCAST', 'CHARS', 
     $                                        MAX_CHARS, LEN)
      ISALIGN = 0
      CBUF(1:LEN) = SARR(1:LEN)
      LEN8 = (LEN+ISALIGN) / GC__ISIZE
      IF (MOD(LEN+ISALIGN, GC__ISIZE) .NE. 0) LEN8 = LEN8 + 1
      CALL MPI_BCAST(ICBUF, LEN8, MPI_INTEGER, SEND, MPI_COMM_WORLD,
     $     ISTAT)
      SARR(1:LEN)=CBUF(1:LEN)
#else
      CALL MPI_BCAST(SARR, LEN, MPI_CHARACTER, SEND, MPI_COMM_WORLD,
     $     ISTAT)
#endif
#endif

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

      RETURN
      END