*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