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

      SUBROUTINE OISLESUM(FIELDIN,JMT,NISLE,SUM,RESMAX)                     1,5OISLESUM.21     
                                                                           OISLESUM.22     
      IMPLICIT NONE                                                        OISLESUM.23     
!                                                                          OISLESUM.24     
! Description:                                                             OISLESUM.25     
! This routine is especially designed for the island global summations     OISLESUM.26     
! used in RELAX. RVECSUM isnt all that great in terms of efficiency,       OISLESUM.27     
! so were trying to speed things up here.                                  OISLESUM.28     
!                                                                          OISLESUM.29     
! Current Code Owner: Richard Hill                                         OISLESUM.30     
!                                                                          OISLESUM.31     
! History:                                                                 OISLESUM.32     
!  Model    Date     Modification history:                                 OISLESUM.33     
!  version                                                                 OISLESUM.34     
!    4.3    24/04/96 New DECK created for the Parallel Unified             OISLESUM.35     
!                    Ocean Model. R.Hill                                   OISLESUM.36     
!                    including shmem speedup                               OISLESUM.37     
!                                                                          OISLESUM.38     
                                                                           OISLESUM.39     
                                                                           OISLESUM.40     
*CALL PARVARS                                                              OISLESUM.41     
*CALL COCNINDX                                                             OISLESUM.42     
                                                                           OISLESUM.43     
                                                                           OISLESUM.44     
! Subroutine Arguments:                                                    OISLESUM.45     
      INTEGER JMT      ! IN  Size of incoming field S-N                    OISLESUM.46     
     &,       NISLE    ! IN  Number of islands                             OISLESUM.47     
                                                                           OISLESUM.48     
      REAL FIELDIN(JMT,NISLE) ! IN  Field to sum                           OISLESUM.49     
     &,    SUM(NISLE)  ! OUT  result                                       OISLESUM.50     
     &,    RESMAX      ! IN/OUT  field to be max'd over all pes            OISLESUM.51     
                                                                           OISLESUM.52     
                                                                           OISLESUM.53     
! Local variables                                                          OISLESUM.54     
                                                                           OISLESUM.55     
      INTEGER I,J,ISLE !}                                                  OISLESUM.56     
     &,       ISLE_CTL !} Loop control variables                           OISLESUM.57     
     &,       IPROC    !}                                                  OISLESUM.58     
     &,       II       !}                                                  OISLESUM.59     
     &, ISLEPROC(NISLE)!  Which pe handles which island sum                OISLESUM.60     
     &,       GID                                                          OISLESUM.61     
     &,       ISTAT                                                        OISLESUM.62     
     &,       INFO                                                         PXOISLE.1      
                                                                           OISLESUM.63     
                                                                           OISLESUM.64     
*IF DEF,MPP                                                                OISLESUM.65     
*IF DEF,T3E                                                                OISLESUM.66     
                                                                           OISLESUM.67     
! Local variables for direct shmem calls                                   OISLESUM.68     
                                                                           OISLESUM.69     
                                                                           OISLESUM.70     
      ! Allows for 350 rows and 40 islands max.                            OISLESUM.71     
      REAL FIELDIN_global(350,40)                                          OISLESUM.72     
     &,SSUM(40)                                                            OISLESUM.73     
     &,FIELDMAX_global(350)                                                OISLESUM.74     
     &,MAX_TEMP                                                            OISLESUM.75     
                                                                           OISLESUM.76     
      common/shmem_isle/FIELDIN_global,SSUM,FIELDMAX_global                OISLESUM.77     
     &,MAX_TEMP                                                            OISLESUM.78     
                                                                           OISLESUM.79     
      ! Set up a list of processors which deal with                        OISLESUM.80     
      ! each island sum.                                                   OISLESUM.81     
      II = 0                                                               OISLESUM.82     
      DO I = 1, NISLE                                                      OISLESUM.83     
         IF (II.LT.NPROC-1) II = II + 1                                    OISLESUM.84     
         ISLEPROC(I) = II                                                  OISLESUM.85     
         IF (II.EQ.NPROC-1) II = 0                                         OISLESUM.86     
      ENDDO                                                                OISLESUM.87     
                                                                           OISLESUM.88     
                                                                           OISLESUM.89     
                                                                           OISLESUM.90     
      IF (O_MYPE.EQ.0) THEN                                                OISLESUM.91     
         DO I = 1, NPROC                                                   OISLESUM.92     
            FIELDMAX_global(I) = 0.0                                       OISLESUM.93     
         ENDDO                                                             OISLESUM.94     
      ENDIF                                                                OISLESUM.95     
                                                                           OISLESUM.96     
      CALL BARRIER()                                                       OISLESUM.97     
                                                                           OISLESUM.98     
      ! Send our field to be max'd to pe 0 if its > 0.0                    OISLESUM.99     
      IF (RESMAX.NE.0.0) THEN                                              OISLESUM.100    
         CALL shmem_put(FIELDMAX_global(O_MYPE+1)                          OISLESUM.101    
     &                  ,RESMAX,1,0)                                       OISLESUM.102    
      ENDIF                                                                OISLESUM.103    
                                                                           OISLESUM.104    
      do isle_ctl=0,nisle-1                                                OISLESUM.105    
                                                                           OISLESUM.106    
        ISLE = MOD(O_MYPE+ISLE_CTL,NISLE)+1                                OISLESUM.107    
                                                                           OISLESUM.108    
        call shmem_put(FIELDIN_global(g_datastart(2,o_mype),ISLE),         OISLESUM.109    
     &         fieldin(2,isle),g_blsizep(2,O_MYPE),ISLEPROC(isle))         OISLESUM.110    
                                                                           OISLESUM.111    
      enddo    ! isle                                                      OISLESUM.112    
                                                                           OISLESUM.113    
      call barrier()                                                       OISLESUM.114    
                                                                           OISLESUM.115    
      ! If I am a process which does an island sum                         OISLESUM.116    
      DO ISLE = 1, NISLE                                                   OISLESUM.117    
         if(o_mype.EQ.ISLEPROC(ISLE)) THEN                                 OISLESUM.118    
                                                                           OISLESUM.119    
            ssum(ISLE)=0.                                                  OISLESUM.120    
                                                                           OISLESUM.121    
            do J =1,JMT_GLOBAL                                             OISLESUM.122    
               ssum(ISLE)=ssum(ISLE)+FIELDIN_global(J,ISLE)                OISLESUM.123    
            enddo                                                          OISLESUM.124    
                                                                           OISLESUM.125    
         endif !                                                           OISLESUM.126    
      ENDDO                                                                OISLESUM.127    
                                                                           OISLESUM.128    
      ! While the other processors are doing the island sum                OISLESUM.129    
      ! PE 0 can do the global maximum on RESMAX.                          OISLESUM.130    
      IF (O_MYPE.EQ.0) THEN                                                OISLESUM.131    
         MAX_TEMP = 0.0                                                    OISLESUM.132    
         DO I = 1, NPROC                                                   OISLESUM.133    
            MAX_TEMP = MAX(ABS(FIELDMAX_global(i)),MAX_TEMP)               OISLESUM.134    
         ENDDO                                                             OISLESUM.135    
      ENDIF                                                                OISLESUM.136    
                                                                           OISLESUM.137    
      call barrier()                                                       OISLESUM.138    
                                                                           OISLESUM.139    
      do isle_ctl=0,nisle-1                                                OISLESUM.140    
         ISLE = MOD(O_MYPE+ISLE_CTL,NISLE)+1                               OISLESUM.141    
         call shmem_get(sum(isle),ssum(isle),1,ISLEPROC(isle))             OISLESUM.142    
      enddo                                                                OISLESUM.143    
                                                                           OISLESUM.144    
      ! All pes have to access pe 0 to find the new RESMAX.                OISLESUM.145    
      call shmem_get(RESMAX,MAX_TEMP,1,0)                                  OISLESUM.146    
*ELSE                                                                      OISLESUM.147    
! Non T3E MPP version:                                                     OISLESUM.148    
      GID = 0                                                              OISLESUM.149    
      ! perform the maximum on RESMAX                                      OISLESUM.150    
      CALL GC_RMAX(1,O_NPROC,INFO,RESMAX)                                  OISLESUM.151    
                                                                           OISLESUM.152    
      ! Sum the input field on all islands                                 OISLESUM.153    
      CALL GCG_RVECSUMR(JMT,J_JMT-J_1+1,J_1,NISLE,FIELDIN,                 PXOISLE.2      
     &                  GID,ISTAT,SUM)                                     PXOISLE.3      
                                                                           PXOISLE.4      
                                                                           OISLESUM.156    
                                                                           OISLESUM.157    
*ENDIF                                                                     OISLESUM.158    
*ELSE                                                                      OISLESUM.159    
      ! Non MPP version of code.                                           OISLESUM.160    
      ! Note: the non mpp version does not need to perform the             OISLESUM.161    
      ! MAX operation on RESMAX since this will be catered                 OISLESUM.162    
      ! for in the normal course of the code main relax.                   OISLESUM.163    
      DO ISLE = 1, NISLE                                                   OISLESUM.164    
         SUM(ISLE) = 0.0                                                   OISLESUM.165    
         DO J = J_1, J_JMT                                                 OISLESUM.166    
            SUM(ISLE) = SUM(ISLE) + FIELDIN(J,ISLE)                        OISLESUM.167    
         ENDDO                                                             OISLESUM.168    
      ENDDO                                                                OISLESUM.169    
*ENDIF                                                                     OISLESUM.170    
                                                                           OISLESUM.171    
      RETURN                                                               OISLESUM.172    
                                                                           OISLESUM.173    
      END                                                                  OISLESUM.174    
*ENDIF                                                                     OISLESUM.175