!=======================================================================
! RCS Header:
!   Revision     [$Revision: 1.3.1.1 $]     Named [$Name: release#2_9_b5 $]
!   Last checkin [$Date: 2001/12/06 10:14:15 $]
!   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 "gcg_prolog.h"    

      SUBROUTINE GCG_RMIN (LEN, GID, ISTAT, SMIN)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Calculate the real minimum across all processors of a group and
!     *  distribute the result to all members of the group.
!     *
!     * Input:
!     *  LEN     - number of elements in message
!     *  GID     - processor group ID
!     *  SMIN    - array with elements to be added up across the nodes
!     *
!     * Output:
!     *  SMIN    - array containing the sums across the nodes
!     *  ISTAT   - status of rsum. 0 is OK (MPI_SRC only),
!     *            refer to the header files for nonzero status codes
!     *
!     * NOTES:       
!     *
!     ******************************************************************

      IMPLICIT NONE
      INTEGER LEN, GID, ISTAT
      REAL SMIN(LEN)
      
      INTEGER OFFSET,TOT_LEN,PART_LEN

      OFFSET=0
      TOT_LEN=LEN
            
 1000 CONTINUE
 
      PART_LEN=MIN(TOT_LEN,MAX_COLL)
      
      CALL GCG_RMIN_batch(PART_LEN,GID,ISTAT,SMIN(1+OFFSET))
      
      OFFSET=OFFSET+PART_LEN
      TOT_LEN=TOT_LEN-PART_LEN
      IF (TOT_LEN .GT. 0) GOTO 1000
      
      RETURN
      END

      SUBROUTINE GCG_RMIN_batch (LEN, GID, ISTAT, SMIN)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Calculate the real minimum across all processors of a group and
!     *  distribute the result to all members of the group.
!     *
!     * Input:
!     *  LEN     - number of elements in message
!     *  GID     - processor group ID
!     *  SMIN    - array with elements to be added up across the nodes
!     *
!     * Output:
!     *  SMIN    - array containing the sums across the nodes
!     *  ISTAT   - status of rsum. 0 is OK (MPI_SRC only),
!     *            refer to the header files for nonzero status codes
!     *
!     * NOTES:       
!     *
!     ******************************************************************

      IMPLICIT NONE
      INTEGER LEN, GID, ISTAT
      REAL SMIN(LEN)

#if defined(SHM_SRC)
      INCLUDE 'mpp/shmem.fh'
#include "gc__shm_common.h"
#include "gc__nam_common.h"
#else
      REAL REDUCE_DATA_WRK(MAX_COLL)
#endif

#if defined(SHM_SRC)
#include "gcg__grstore_common.h"

      INTEGER L, ME, NPROC, IGID, ILOC, GRANK
#endif
#if defined(MPI_SRC)
      INCLUDE 'mpif.h'
      INTEGER IGID
#endif
      INCLUDE 'gc_com.h'
      INTEGER I


      ISTAT = GC__OK
      IF (LEN .GT. MAX_COLL) CALL GCG__ERRLIM(1, 'RMIN', 'COLL', 
     $                                        MAX_COLL, LEN)

#if defined(SHM_SRC)
      IF (GID .EQ. GCG__ALLGROUP) THEN
         NPROC = GC_NPROC()
         CALL GC_RMIN(LEN, NPROC, ISTAT, SMIN)
         RETURN
      ENDIF


!---  Verify GID and membership
      IF (GID .GT. 0) THEN
         DO IGID = 1, MAX_GROUP
            IF (GR_ID(IGID) .EQ. GID) THEN
               ILOC = GR_LOC(IGID)
               ME = GC_ME()
               DO I = ILOC, ILOC+GR_SZ(IGID)-1
                  IF (ME .EQ. GR_MEM(I)) THEN
                     GRANK = I - ILOC
                     GOTO 100
                  ENDIF
               ENDDO
            ENDIF
         ENDDO
      ENDIF
      ISTAT = -1
      RETURN
 100  CONTINUE
      

!---  Perform the global MIN for this GID, we use the simple collect
!     to one (GR_MEM(ILOC)) and broadcast scheme.

      DO I = 1, LEN
         NAM_RWORK(I) = SMIN(I)
      ENDDO
      CALL GCG__SHMSYNC(GRANK, ILOC, IGID)
      IF (GRANK .EQ. 0) THEN
         DO I = 1, GR_SZ(IGID)-1
            CALL SHMEM_GET(REDUCE_DATA_WRK, NAM_RWORK(1), 
     &                     LEN, GR_MEM(ILOC+I))
            DO L = 1, LEN
               NAM_RWORK(L) = MIN(NAM_RWORK(L),
     &                                  REDUCE_DATA_WRK(L))
            ENDDO
         ENDDO
      ENDIF
      CALL GCG__SHMSYNC(GRANK, ILOC, IGID)

      CALL SHMEM_GET(SMIN, NAM_RWORK(1), LEN, GR_MEM(ILOC))

      CALL GCG__SHMSYNC(GRANK, ILOC, IGID)
#endif

#if defined(MPI_SRC)
      IF (GID .EQ. GCG__ALLGROUP) THEN
         IGID = MPI_COMM_WORLD
      ELSE
         IGID = GID
      ENDIF
      DO I = 1,LEN
         REDUCE_DATA_WRK(I) = SMIN(I)
      ENDDO
#if defined(FLP_64B)
#if defined(_UNICOS)
      CALL MPI_ALLREDUCE(REDUCE_DATA_WRK, SMIN, LEN, 
     $     MPI_REAL, MPI_MIN, IGID, ISTAT)
#else
      CALL MPI_ALLREDUCE(REDUCE_DATA_WRK, SMIN, LEN, 
     $     MPI_DOUBLE_PRECISION, MPI_MIN, IGID, ISTAT)
#endif
#else
      CALL MPI_ALLREDUCE(REDUCE_DATA_WRK, SMIN, LEN, MPI_REAL, MPI_MIN,
     $     IGID, ISTAT)
#endif
#endif

      RETURN
      END