*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