*IF DEF,OCEAN                                                              OISLSUMA.2      
C *****************************COPYRIGHT******************************     OISLSUMA.3      
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved.    OISLSUMA.4      
C                                                                          OISLSUMA.5      
C Use, duplication or disclosure of this code is subject to the            OISLSUMA.6      
C restrictions as set forth in the contract.                               OISLSUMA.7      
C                                                                          OISLSUMA.8      
C                Meteorological Office                                     OISLSUMA.9      
C                London Road                                               OISLSUMA.10     
C                BRACKNELL                                                 OISLSUMA.11     
C                Berkshire UK                                              OISLSUMA.12     
C                RG12 2SZ                                                  OISLSUMA.13     
C                                                                          OISLSUMA.14     
C If no contract has been raised with this copy of the code, the use,      OISLSUMA.15     
C duplication or disclosure of it is strictly prohibited.  Permission      OISLSUMA.16     
C to do so must first be obtained in writing from the Head of Numerical    OISLSUMA.17     
C Modelling at the above address.                                          OISLSUMA.18     
C ******************************COPYRIGHT******************************    OISLSUMA.19     
! Subroutine interface:                                                    OISLSUMA.20     

      SUBROUTINE OISLESUMA(FIELDIN,JMT,SUM)                                 1OISLSUMA.21     
                                                                           OISLSUMA.22     
      IMPLICIT NONE                                                        OISLSUMA.23     
!                                                                          OISLSUMA.24     
! Description:                                                             OISLSUMA.25     
! This routine is especially designed for the island global summations     OISLSUMA.26     
! used in RELAX. RVECSUM isnt all that great in terms of efficiency,       OISLSUMA.27     
! so we're trying to speed things up here.                                 OISLSUMA.28     
!                                                                          OISLSUMA.29     
! Current Code Owner: Richard Hill                                         OISLSUMA.30     
!                                                                          OISLSUMA.31     
! History:                                                                 OISLSUMA.32     
!  Model    Date     Modification history:                                 OISLSUMA.33     
!  version                                                                 OISLSUMA.34     
!    4.3    17/04/97 New DECK created for the Parallel Unified             OISLSUMA.35     
!                    Ocean Model. R.Hill                                   OISLSUMA.36     
!**********************************************************************    OISLSUMA.37     
                                                                           OISLSUMA.38     
                                                                           OISLSUMA.39     
*CALL PARVARS                                                              OISLSUMA.40     
*CALL COCNINDX                                                             OISLSUMA.41     
                            !                                              OISLSUMA.42     
! Arguments:                                                               OISLSUMA.43     
                                                                           OISLSUMA.44     
      INTEGER JMT       ! IN  size of incoming field                       OISLSUMA.45     
                                                                           OISLSUMA.46     
      REAL FIELDIN(JMT) ! IN  Field to sum                                 OISLSUMA.47     
     &,    SUM          ! OUT result                                       OISLSUMA.48     
                                                                           OISLSUMA.49     
! Local variables:                                                         OISLSUMA.50     
                                                                           OISLSUMA.51     
      INTEGER I,J,ISLE !}                                                  OISLSUMA.52     
     &,       ISLE_CTL !} Loop control variables                           OISLSUMA.53     
     &,       IPROC    !}                                                  OISLSUMA.54     
     &,       II       !}                                                  OISLSUMA.55     
     &,       GID                                                          OISLSUMA.56     
     &,       ISTAT                                                        OISLSUMA.57     
                                                                           OISLSUMA.58     
                                                                           OISLSUMA.59     
*IF DEF,MPP                                                                OISLSUMA.60     
*IF DEF,T3E                                                                OISLSUMA.61     
                                                                           OISLSUMA.62     
! Variables for use with direct shmem calls                                OISLSUMA.63     
      real FIELDIN_global(500)                                             OISLSUMA.64     
     &,ssum                                                                OISLSUMA.65     
                                                                           OISLSUMA.66     
      common/shmem_isle/FIELDIN_global,ssum                                OISLSUMA.67     
                                                                           OISLSUMA.68     
                                                                           OISLSUMA.69     
      CALL BARRIER()                                                       OISLSUMA.70     
                                                                           OISLSUMA.71     
      ! Carry out summation on pe 0                                        OISLSUMA.72     
      IPROC = 0                                                            OISLSUMA.73     
                                                                           OISLSUMA.74     
      ! Fill up the global array                                           OISLSUMA.75     
      call shmem_put(FIELDIN_global(g_datastart(2,o_mype)),                OISLSUMA.76     
     &               fieldin(2),g_blsizep(2,O_MYPE),IPROC)                 OISLSUMA.77     
                                                                           OISLSUMA.78     
                                                                           OISLSUMA.79     
      call barrier()                                                       OISLSUMA.80     
                                                                           OISLSUMA.81     
      ! If I am the summing pe                                             OISLSUMA.82     
      if(o_mype.EQ.IPROC) THEN                                             OISLSUMA.83     
                                                                           OISLSUMA.84     
         ssum=0.                                                           OISLSUMA.85     
                                                                           OISLSUMA.86     
         do J=1,JMT_GLOBAL                                                 OISLSUMA.87     
            ssum=ssum+FIELDIN_global(J)                                    OISLSUMA.88     
         enddo                                                             OISLSUMA.89     
                                                                           OISLSUMA.90     
      endif !                                                              OISLSUMA.91     
                                                                           OISLSUMA.92     
      call barrier()                                                       OISLSUMA.93     
                                                                           OISLSUMA.94     
      ! Get the result in sum                                              OISLSUMA.95     
      call shmem_get(sum,ssum,1,IPROC)                                     OISLSUMA.96     
                                                                           OISLSUMA.97     
      call barrier()                                                       OISLSUMA.98     
                                                                           OISLSUMA.99     
*ELSE                                                                      OISLSUMA.100    
! Non T3E MPP version:                                                     OISLSUMA.101    
      GID = 0                                                              OISLSUMA.102    
                                                                           OISLSUMA.103    
      ! Sum the input field on all islands                                 OISLSUMA.104    
      CALL GCG_RVECSUMR(JMT,J_JMT-J_1+1,J_1,1,FIELDIN,                     OISLSUMA.105    
     &                  GID,ISTAT,SUM)                                     OISLSUMA.106    
                                                                           OISLSUMA.107    
                                                                           OISLSUMA.108    
*ENDIF                                                                     OISLSUMA.109    
*ELSE                                                                      OISLSUMA.110    
      ! Non MPP version of code.                                           OISLSUMA.111    
      ! Note: the non mpp version does not need to perform the             OISLSUMA.112    
      ! MAX operation on RESMAX since this will be catered                 OISLSUMA.113    
      ! for in the normal course of the code main relax.                   OISLSUMA.114    
      SUM = 0.0                                                            OISLSUMA.115    
      DO J = J_1, J_JMT                                                    OISLSUMA.116    
         SUM = SUM + FIELDIN(J)                                            OISLSUMA.117    
      ENDDO                                                                OISLSUMA.118    
*ENDIF                                                                     OISLSUMA.119    
                                                                           OISLSUMA.120    
      RETURN                                                               OISLSUMA.121    
                                                                           OISLSUMA.122    
      END                                                                  OISLSUMA.123    
*ENDIF                                                                     OISLSUMA.124