SUBROUTINE DO_SUMS(SUM_ARRAY,FIELD_SIZE,START_POINT,END_POINT, 4,1DOSUMS1.23
& N_SUMS,SUM_RESULTS) DOSUMS1.24
IMPLICIT NONE DOSUMS1.25
! DOSUMS1.26
! Description: DOSUMS1.27
! Primarily written for the energy correction suite of routines: DOSUMS1.28
! Calculate N_SUMS global sums of the SUM_ARRAY field between DOSUMS1.29
! the points START_POINT and END_POINT, adding results DOSUMS1.30
! onto SUM_RESULTS DOSUMS1.31
! DOSUMS1.32
! Method: DOSUMS1.33
*IF -DEF,MPP DOSUMS1.34
! Loop over N_SUMS and do sum of SUM_ARRAY for points between DOSUMS1.35
! START_POINT and END_POINT, putting results in SUM_RESULTS DOSUMS1.36
*ELSE DOSUMS1.37
*IF DEF,REPROD DOSUMS1.38
! Farm out N_SUMS global sums : 1 global sum/processor - do the DOSUMS1.39
! sums and then return the results to all processors DOSUMS1.40
*ELSE DOSUMS1.41
! Every processor does its local part of the sum - then all these DOSUMS1.42
! sub-sums are summed together. DOSUMS1.43
*ENDIF DOSUMS1.44
*ENDIF DOSUMS1.45
! DOSUMS1.46
! Current code owner : Paul Burton DOSUMS1.47
! DOSUMS1.48
! History DOSUMS1.49
! Model Date Modification history from model version 4.1 DOSUMS1.50
! version DOSUMS1.51
! 4.1 9/11/95 New DECK created to make EMDIAG suitable for DOSUMS1.52
! MPP use. P.Burton DOSUMS1.53
! 4.2 18/11/96 *CALL to AMAXSIZE for MaxFieldSize P.Burton GPB3F402.22
! 4.2 18/10/96 New name for group of processors in gather_field GPB0F402.178
! P.Burton GPB0F402.179
! 4.3 29/04/97 Correct call to GATHER_FIELD. D Robinson. GDR1F403.1
! DOSUMS1.54
! Subroutine Arguments: DOSUMS1.55
DOSUMS1.56
INTEGER FIELD_SIZE, ! IN size of SUM_ARRAY DOSUMS1.57
& START_POINT, ! IN local point to start sum at DOSUMS1.58
& END_POINT, ! IN local point to end sum at DOSUMS1.59
& N_SUMS ! IN number of sums to do DOSUMS1.60
DOSUMS1.61
REAL SUM_ARRAY(FIELD_SIZE,N_SUMS), DOSUMS1.62
! ! IN array containing fields DOSUMS1.63
! ! to be summed DOSUMS1.64
& SUM_RESULTS(N_SUMS) ! INOUT sum of SUM_ARRAY added onto DOSUMS1.65
! ! initial value of SUM_RESULTS DOSUMS1.66
DOSUMS1.67
! Parameters and COMMON DOSUMS1.68
*IF DEF,MPP DOSUMS1.69
*CALL PARVARS 
DOSUMS1.70
*CALL AMAXSIZE GPB3F402.23
*CALL GCCOM DOSUMS1.71
*ENDIF DOSUMS1.72
DOSUMS1.73
! Local variabels DOSUMS1.74
*IF DEF,MPP DOSUMS1.75
REAL SUM_RESULTS_TMP(N_SUMS) ! actual sum which will eventually DOSUMS1.76
! ! be added to SUM_RESULTS DOSUMS1.77
DOSUMS1.78
INTEGER FIRST_COL, ! local column of START_POINT DOSUMS1.79
& LAST_COL, ! local column of END_POINT DOSUMS1.80
& FIRST_ROW, ! local row of START_POINT DOSUMS1.81
& LAST_ROW ! local row of END_POINT DOSUMS1.82
DOSUMS1.83
INTEGER info ! return code from GC stuff DOSUMS1.84
DOSUMS1.85
*IF DEF,REPROD DOSUMS1.86
INTEGER MAP(N_SUMS), ! processor number for sum DOSUMS1.87
& N_SUMS_ON_PROC(0:MAXPROC), ! number of sums to do on pe DOSUMS1.88
& RESULT_NUMBER, ! result index in SUM_RESULTS DOSUMS1.89
& GLOBAL_START, ! global point to start sum at DOSUMS1.90
& GLOBAL_END ! global point to end sum at DOSUMS1.91
DOSUMS1.92
INTEGER iproc ! loop index in COMMS DOSUMS1.93
DOSUMS1.94
REAL global_sum_data(MaxFieldSize,N_SUMS) DOSUMS1.95
! area for doing global sums in DOSUMS1.96
*ELSE DOSUMS1.97
INTEGER LOCAL_START, ! modified version of START_POINT DOSUMS1.98
& LOCAL_END, ! modified version of END_POINT DOSUMS1.99
& J ! loop variable for rows DOSUMS1.100
*ENDIF DOSUMS1.101
*ENDIF DOSUMS1.102
INTEGER I,K ! loop variables DOSUMS1.103
DOSUMS1.104
*IF -DEF,MPP DOSUMS1.105
DOSUMS1.106
DO K=1,N_SUMS DOSUMS1.107
DOSUMS1.108
DO I=START_POINT,END_POINT DOSUMS1.109
SUM_RESULTS(K)=SUM_RESULTS(K)+SUM_ARRAY(I,K) DOSUMS1.110
ENDDO ! loop over points DOSUMS1.111
DOSUMS1.112
ENDDO ! loop over sums DOSUMS1.113
DOSUMS1.114
*ELSE DOSUMS1.115
DOSUMS1.116
! 1. Calculate local column and row of start and end, and if DOSUMS1.117
! necessary move them out of the halos. DOSUMS1.118
DOSUMS1.119
! 1.1 FIRST_COL and LAST_COL DOSUMS1.120
DOSUMS1.121
FIRST_COL=MOD(START_POINT-1,lasize(1))+1 DOSUMS1.122
LAST_COL=MOD(END_POINT-1,lasize(1))+1 DOSUMS1.123
DOSUMS1.124
*IF -DEF,REPROD DOSUMS1.125
LOCAL_START=START_POINT DOSUMS1.126
LOCAL_END=END_POINT DOSUMS1.127
*ENDIF DOSUMS1.128
DOSUMS1.129
IF (FIRST_COL .LE. Offx) THEN ! START_POINT lies in halo DOSUMS1.130
*IF -DEF,REPROD DOSUMS1.131
LOCAL_START=START_POINT+(Offx+1-FIRST_COL) DOSUMS1.132
*ENDIF DOSUMS1.133
FIRST_COL=FIRST_COL+(Offx+1-FIRST_COL) DOSUMS1.134
ENDIF DOSUMS1.135
DOSUMS1.136
IF (LAST_COL .GT. lasize(1)-Offx) THEN ! END_POINT in halo DOSUMS1.137
*IF -DEF,REPROD DOSUMS1.138
LOCAL_END=END_POINT-(LAST_COL-(lasize(1)-Offx)) DOSUMS1.139
*ENDIF DOSUMS1.140
LAST_COL=LAST_COL-(LAST_COL-(lasize(1)-Offx)) DOSUMS1.141
ENDIF DOSUMS1.142
DOSUMS1.143
! 1.2 FIRST_ROW and LAST_ROW DOSUMS1.144
DOSUMS1.145
FIRST_ROW=(START_POINT/lasize(1))+1 DOSUMS1.146
LAST_ROW=((END_POINT-1)/lasize(1))+1 DOSUMS1.147
DOSUMS1.148
IF (FIRST_ROW .LE. Offy) THEN ! First row in halo DOSUMS1.149
FIRST_ROW=Offy+1 DOSUMS1.150
*IF -DEF,REPROD DOSUMS1.151
LOCAL_START=(Offy*lasize(1))+Offx+1 DOSUMS1.152
*ENDIF DOSUMS1.153
ENDIF DOSUMS1.154
DOSUMS1.155
IF (LAST_ROW .GT. lasize(2)-Offy) THEN ! Last row in halo DOSUMS1.156
LAST_ROW=lasize(2)-Offy DOSUMS1.157
*IF -DEF,REPROD DOSUMS1.158
LOCAL_END=lasize(1)*(lasize(2)-Offy) - Offx DOSUMS1.159
*ENDIF DOSUMS1.160
ENDIF DOSUMS1.161
DOSUMS1.162
*IF DEF,REPROD DOSUMS1.163
! Reproducible parallel global sums DOSUMS1.164
! We assume all the fields are standard P_FIELDS mapping DOSUMS1.165
! onto the full global grid DOSUMS1.166
DOSUMS1.167
! 2. Convert local start and end points to global values DOSUMS1.168
DOSUMS1.169
FIRST_COL=(FIRST_COL-Offx)+datastart(1)-1 DOSUMS1.170
LAST_COL=(LAST_COL-Offx)+datastart(1)-1 DOSUMS1.171
FIRST_ROW=(FIRST_ROW-Offy)+datastart(2)-1 DOSUMS1.172
LAST_ROW=(LAST_ROW-Offy)+datastart(2)-1 DOSUMS1.173
DOSUMS1.174
GLOBAL_START=FIRST_COL+(FIRST_ROW-1)*glsize(1) DOSUMS1.175
GLOBAL_END=LAST_COL+(LAST_ROW-1)*glsize(1) DOSUMS1.176
DOSUMS1.177
! 2.1 This is only the local version - we must now find out DOSUMS1.178
! the absolute global values of START and END DOSUMS1.179
DOSUMS1.180
CALL GC_IMIN(1,nproc,info,GLOBAL_START) DOSUMS1.181
CALL GC_IMAX(1,nproc,info,GLOBAL_END) DOSUMS1.182
DOSUMS1.183
! 3. Calculate mapping - which sum is done on which processor DOSUMS1.184
DOSUMS1.185
DO K=1,N_SUMS DOSUMS1.186
SUM_RESULTS_TMP(K)=0.0 DOSUMS1.187
MAP(K)=first_comp_pe+MOD((K-1),nproc) DOSUMS1.188
IF (mype .EQ. MAP(K)) SUM_RESULTS_TMP(K)=SUM_RESULTS(K) DOSUMS1.189
ENDDO DOSUMS1.190
DOSUMS1.191
! 4. Distribute the sums DOSUMS1.192
DOSUMS1.193
DO K=0,nproc-1 DOSUMS1.194
N_SUMS_ON_PROC(K)=0 DOSUMS1.195
ENDDO DOSUMS1.196
DOSUMS1.197
DO K=1,N_SUMS DOSUMS1.198
N_SUMS_ON_PROC(MAP(K))=N_SUMS_ON_PROC(MAP(K))+1 DOSUMS1.199
DOSUMS1.200
CALL GATHER_FIELD(SUM_ARRAY(1,K), GDR1F403.2
& global_sum_data(1,N_SUMS_ON_PROC(MAP(K))), DOSUMS1.202
& lasize(1),lasize(2), DOSUMS1.203
& glsize(1),glsize(2), DOSUMS1.204
& MAP(K),GC_ALL_PROC_GROUP, GPB0F402.180
& info) DOSUMS1.206
DOSUMS1.207
ENDDO ! K : loop over N_SUMS DOSUMS1.208
DOSUMS1.209
! 5. And do the sums DOSUMS1.210
DOSUMS1.211
DO K=1,N_SUMS_ON_PROC(mype) DOSUMS1.212
RESULT_NUMBER=(K-1)*nproc+mype+1 DOSUMS1.213
DOSUMS1.214
DO I=GLOBAL_START,GLOBAL_END DOSUMS1.215
SUM_RESULTS_TMP(RESULT_NUMBER)= DOSUMS1.216
& SUM_RESULTS_TMP(RESULT_NUMBER)+ global_sum_data(I,K) DOSUMS1.217
ENDDO ! I : loop over points DOSUMS1.218
DOSUMS1.219
ENDDO ! K : loop over number of sums I must do DOSUMS1.220
DOSUMS1.221
! 6. Broadcast the results to everyone DOSUMS1.222
! Rather than do a bcast for each sum, we'll do a DOSUMS1.223
! parallel sum. Only the processor doing a particular DOSUMS1.224
! sum will contribute, ie.: DOSUMS1.225
! SUM PE0 PE1 PE2 PE3 PE0 PE1 PE2 PE3 DOSUMS1.226
! 1 3.2 0.0 0.0 0.0 --SUM--> 3.2 3.2 3.2 3.2 DOSUMS1.227
! 2 0.0 9.2 0.0 0.0 --SUM--> 9.2 9.2 9.2 9.2 DOSUMS1.228
! 3 0.0 0.0 5.7 0.0 --SUM--> 5.7 5.7 5.7 5.7 DOSUMS1.229
DOSUMS1.230
CALL GC_RSUM(N_SUMS,nproc,info,SUM_RESULTS_TMP) DOSUMS1.231
DOSUMS1.232
DO K=1,N_SUMS DOSUMS1.233
SUM_RESULTS(K)= SUM_RESULTS_TMP(K) DOSUMS1.234
ENDDO DOSUMS1.235
*ELSE DOSUMS1.236
! This is the faster version of the global sum. DOSUMS1.237
! Each processor works out its local sum across its part of the field DOSUMS1.238
! and then these are summed up. DOSUMS1.239
! This can give non-reproducible answers of two kinds: DOSUMS1.240
! 1) If sums across processors are always done in the same order then DOSUMS1.241
! the same answer will always be obtained for the same processor DOSUMS1.242
! arrangement. However, the answer will be different on different DOSUMS1.243
! processor arrangements DOSUMS1.244
! 2) If the sums across processor are not done in any particular order DOSUMS1.245
! then different results will be obtained even when the same DOSUMS1.246
! processor arrangement is used. DOSUMS1.247
! Which case is true depends on how GC_RSUM has been implemented on DOSUMS1.248
! this particular platform. It is probably safest to assume that (2) DOSUMS1.249
! is the case, and this is the method that generally gives the DOSUMS1.250
! fastest sum. DOSUMS1.251
DOSUMS1.252
! 2 Do the local sum of my part of SUM_ARRAY DOSUMS1.253
DOSUMS1.254
DO K=1,N_SUMS DOSUMS1.255
DOSUMS1.256
SUM_RESULTS_TMP(K)=0.0 DOSUMS1.257
DOSUMS1.258
! 2.1 The first row (or part of row) DOSUMS1.259
DO I=LOCAL_START,FIRST_ROW*lasize(1)-Offx DOSUMS1.260
SUM_RESULTS_TMP(K)=SUM_RESULTS_TMP(K)+SUM_ARRAY(I,K) DOSUMS1.261
ENDDO DOSUMS1.262
DOSUMS1.263
! 2.2 All the rows between first and last rows DOSUMS1.264
DO J=FIRST_ROW+1,LAST_ROW-1 DOSUMS1.265
DO I=(J-1)*lasize(1)+Offx+1,J*lasize(1)-Offx DOSUMS1.266
SUM_RESULTS_TMP(K)=SUM_RESULTS_TMP(K)+SUM_ARRAY(I,K) DOSUMS1.267
ENDDO ! I : all points along row between halos DOSUMS1.268
ENDDO ! J : all rows between start and end DOSUMS1.269
DOSUMS1.270
! 2.3 The last row (or part of row) DOSUMS1.271
DO I=(LAST_ROW-1)*lasize(1)+Offx+1,LOCAL_END DOSUMS1.272
SUM_RESULTS_TMP(K)=SUM_RESULTS_TMP(K)+SUM_ARRAY(I,K) DOSUMS1.273
ENDDO DOSUMS1.274
DOSUMS1.275
ENDDO ! K : loop over N_SUMS DOSUMS1.276
DOSUMS1.277
! 3. and now sum up all the local sums, and give everyone DOSUMS1.278
! the total sum DOSUMS1.279
DOSUMS1.280
CALL GC_RSUM(N_SUMS,nproc,info,SUM_RESULTS_TMP) DOSUMS1.281
DOSUMS1.282
DO K=1,N_SUMS DOSUMS1.283
SUM_RESULTS(K)=SUM_RESULTS(K)+SUM_RESULTS_TMP(K) DOSUMS1.284
ENDDO DOSUMS1.285
DOSUMS1.286
*ENDIF DOSUMS1.287
*ENDIF DOSUMS1.288
DOSUMS1.289
RETURN DOSUMS1.290
END DOSUMS1.291