!=======================================================================
! RCS Header:
!   Revision     [$Revision: 1.8.2.2 $]     Named [$Name: release#2_9_b5 $]
!   Last checkin [$Date: 2003/03/14 08:21:40 $]
!   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_IMIN (LEN, NPROC, ISTAT, IMIN)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Finds the real minimum across all processors and distribute
!     *  the result to all the processors.
!     *
!     * Input:
!     *  LEN     - number of elements in message
!     *  NPROC   - number of processors
!     *  IMIN    - array with elements of which the elementwise minimum
!     *            across the nodes is to be found
!     *
!     * Output:
!     *  IMIN    - array containing the minimums 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, NPROC, ISTAT, IMIN(LEN)
      
      INTEGER OFFSET,TOT_LEN,PART_LEN

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

      SUBROUTINE GC_IMIN_batch (LEN, NPROC, ISTAT, IMIN)
!     ******************************************************************
!     * Purpose:
!     *
!     *  Finds the real minimum across all processors and distribute
!     *  the result to all the processors.
!     *
!     * Input:
!     *  LEN     - number of elements in message
!     *  NPROC   - number of processors
!     *  IMIN    - array with elements of which the elementwise minimum
!     *            across the nodes is to be found
!     *
!     * Output:
!     *  IMIN    - array containing the minimums 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, NPROC, ISTAT, IMIN(LEN)
#if defined(SHM_SRC)
      INCLUDE 'mpp/shmem.fh'
#include "gc__shm_common.h"
#include "gc__opts_common.h"
#include "gc__nam_common.h"
      INTEGER I
#else
      INTEGER REDUCE_DATA_IWRK(MAX_COLL)
#endif
#if defined(MPI_SRC)
      INCLUDE 'mpif.h'
      INTEGER I
#endif

#if !defined(SERIAL_SRC)
      IF (LEN .GT. MAX_COLL) CALL GC__ERRLIM(0, 'IMIN', 'COLL', 
     $                                       MAX_COLL, LEN)
#endif

#if defined(SHM_SRC)
      DO I = 1, LEN
         NAM_IWORK(I) = IMIN(I)
      ENDDO
      CALL BARRIER()
      CALL SHMEM_INT8_MIN_TO_ALL(NAM_IWORK,NAM_IWORK,LEN,0,0,NPROC,
     &     REDUCE_DATA_IWRK,REDUCE_SYNC_WRK)
      DO I = 1, LEN
         IMIN(I) = NAM_IWORK(I)
      ENDDO
      CALL BARRIER()
#endif


#if defined(MPI_SRC)
      DO I = 1,LEN
         REDUCE_DATA_IWRK(I) = IMIN(I)
      ENDDO
#if defined(I_64B)
      CALL MPI_ALLREDUCE(REDUCE_DATA_IWRK, IMIN, LEN, MPI_INTEGER8,
#else
      CALL MPI_ALLREDUCE(REDUCE_DATA_IWRK, IMIN, LEN, MPI_INTEGER,
#endif
     $     MPI_MIN, MPI_COMM_WORLD, ISTAT)
#endif

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

      RETURN
      END