SUBROUTINE GENERAL_GATHER_FIELD ( 3,7GENGAT1A.27
& LOCAL_FIELD , GLOBAL_FIELD , GENGAT1A.28
& LOCAL_SIZE , GLOBAL_SIZE , GENGAT1A.29
& ADDR_INFO , GENGAT1A.30
& GATHER_PE , GENGAT1A.31
& ICODE , CMESSAGE) GENGAT1A.32
GENGAT1A.33
IMPLICIT NONE GENGAT1A.34
GENGAT1A.35
! Description: GENGAT1A.36
! Takes a general decomposed field on many processors and gathers it GENGAT1A.37
! to a single processor. GENGAT1A.38
! GENGAT1A.39
! Current code owner : P.Burton GENGAT1A.40
! GENGAT1A.41
! History GENGAT1A.42
! Model Date Modification history from model version 4.3 GENGAT1A.43
! version GENGAT1A.44
! 4.4 20/05/97 New DECK created for MPP code. P.Burton GENGAT1A.45
! 4.5 13/01/98 Replaced SHMEM COMMON blocks by dynamic arrays GPB2F405.55
! P.Burton GPB2F405.56
! 4.5 21/08/98 Use local_land_field for fields on land points. GDR5F405.31
! D. Robinson. GDR5F405.32
! GENGAT1A.46
! Subroutine arguments: GENGAT1A.47
GENGAT1A.48
INTEGER GENGAT1A.49
& GLOBAL_SIZE ! IN: size of GLOBAL FIELD GENGAT1A.50
&, GATHER_PE ! IN: PE on which to collect GLOBAL_FIELD GENGAT1A.51
&, LOCAL_SIZE ! OUT: size of LOCAL_FIELD GENGAT1A.52
&, ICODE ! OUT: return code, 0=OK GENGAT1A.53
GENGAT1A.54
! Required for dimensioning ADDR_INFO GENGAT1A.55
*CALL D1_ADDR 
GENGAT1A.56
GENGAT1A.57
INTEGER GENGAT1A.58
& ADDR_INFO(D1_LIST_LEN) ! IN: addressing info about field GENGAT1A.59
GENGAT1A.60
REAL GENGAT1A.61
& LOCAL_FIELD(*) ! IN: my local part of field GENGAT1A.62
&, GLOBAL_FIELD(GLOBAL_SIZE) ! OUT: array to gather field to GENGAT1A.63
GENGAT1A.64
GENGAT1A.65
CHARACTER*(80) GENGAT1A.66
& CMESSAGE ! OUT : Error message GENGAT1A.67
GENGAT1A.68
! Parameters and common blocks GENGAT1A.69
GENGAT1A.70
*CALL CPPXREF GENGAT1A.71
*CALL STPARAM GENGAT1A.72
*CALL AMAXSIZE GENGAT1A.73
*CALL ATM_LSM GPB2F405.57
GENGAT1A.75
*CALL GCCOM GENGAT1A.76
GENGAT1A.77
*CALL TYPSIZE GENGAT1A.78
*CALL PARVARS GENGAT1A.79
GENGAT1A.80
! Local variables GENGAT1A.81
GENGAT1A.82
INTEGER GENGAT1A.83
& grid_type ! grid type of field being gathered GENGAT1A.84
&, info ! return code from GCOM routines GENGAT1A.85
&, dummy ! dummy variables - ignored return values GENGAT1A.86
&, north,south,east,west ! domain limits for STASH output GENGAT1A.87
&, fld_type ! P or U field GENGAT1A.88
&, mean_type ! spatial meaning type on diagnostic GENGAT1A.89
GENGAT1A.90
INTEGER GENGAT1A.91
& GET_FLD_TYPE ! function for finding field type GENGAT1A.92
GENGAT1A.93
REAL GENGAT1A.94
& buf_expand(Max2DFieldSize) GPB2F405.58
&, buf_expand_local(Max2DFieldSize) GPB2F405.59
GENGAT1A.96
!=================================================================== GENGAT1A.97
GENGAT1A.98
grid_type=ADDR_INFO(d1_grid_type) GENGAT1A.99
GENGAT1A.100
!------------------------------------------------------------------- GENGAT1A.101
GENGAT1A.102
! Timeseries data GENGAT1A.103
IF ((ADDR_INFO(d1_object_type) .EQ. diagnostic) .AND. GENGAT1A.104
& ((ADDR_INFO(d1_proc_no_code) .EQ. st_time_series_code).OR. GENGAT1A.105
& (ADDR_INFO(d1_proc_no_code) .EQ. st_time_series_mean))) THEN GENGAT1A.106
GENGAT1A.107
! Copy the data to GLOBAL_FIELD from PE 0 GENGAT1A.108
GENGAT1A.109
CALL GC_SSYNC(nproc,info) GENGAT1A.110
GENGAT1A.111
CALL GC_SETOPT(GC_SHM_DIR,GC_SHM_PUT,info) GENGAT1A.112
GENGAT1A.113
IF (mype .EQ. 0) THEN GENGAT1A.114
GENGAT1A.115
info=GC_NONE GENGAT1A.116
CALL GC_RSEND(99,GLOBAL_SIZE,GATHER_PE,info,GLOBAL_FIELD, GENGAT1A.117
& LOCAL_FIELD) GENGAT1A.118
GENGAT1A.119
ENDIF GENGAT1A.120
GENGAT1A.121
IF (mype .EQ. GATHER_PE) THEN GENGAT1A.122
GENGAT1A.123
info=GC_NONE GENGAT1A.124
CALL GC_RRECV(99,GLOBAL_SIZE,0,info,GLOBAL_FIELD,LOCAL_FIELD) GENGAT1A.125
GENGAT1A.126
ENDIF GENGAT1A.127
GENGAT1A.128
LOCAL_SIZE=GLOBAL_SIZE GENGAT1A.129
GENGAT1A.130
!------------------------------------------------------------------- GENGAT1A.131
GENGAT1A.132
! Surface (land points only) fields GENGAT1A.133
GENGAT1A.134
ELSEIF GENGAT1A.135
& (grid_type .EQ. ppx_atm_compressed) THEN GENGAT1A.136
GENGAT1A.137
! Unpack the local field out to full (local) field size and GENGAT1A.138
! put this into the array buf_expand_local GENGAT1A.139
GENGAT1A.140
CALL from_land_points(buf_expand_local,LOCAL_FIELD, GENGAT1A.141
& atmos_landmask_local, GENGAT1A.142
& lasize(1)*lasize(2), GENGAT1A.143
& dummy) GENGAT1A.144
GENGAT1A.145
! Now gather in all the processors local fields into the global GENGAT1A.146
! field (array buf_expand) GENGAT1A.147
GENGAT1A.148
CALL GATHER_FIELD(buf_expand_local,buf_expand, GENGAT1A.149
& lasize(1),lasize(2), GENGAT1A.150
& glsize(1),glsize(2), GENGAT1A.151
& GATHER_PE,GC_ALL_PROC_GROUP,info) GENGAT1A.152
GENGAT1A.153
! And now pack the global field (buf_expand) back to land points GENGAT1A.154
! and put into the array GLOBAL_FIELD. GENGAT1A.155
GENGAT1A.156
IF (mype .EQ. 0) THEN GENGAT1A.157
CALL to_land_points(buf_expand,GLOBAL_FIELD,atmos_landmask, GENGAT1A.158
& glsize(1)*glsize(2),dummy) GENGAT1A.159
ENDIF GENGAT1A.160
GENGAT1A.161
local_size = local_land_field GDR5F405.33
GENGAT1A.163
!------------------------------------------------------------------- GENGAT1A.164
GENGAT1A.165
! Atmosphere Lateral boundary fields GENGAT1A.166
GENGAT1A.167
ELSEIF GENGAT1A.168
& (grid_type .EQ. ppx_atm_rim) THEN GENGAT1A.169
GENGAT1A.170
CALL GATHER_ATMOS_LBCS(GLOBAL_FIELD,global_LENRIMDATA_A, GENGAT1A.171
& LOCAL_FIELD,LENRIMDATA_A, GENGAT1A.172
& GATHER_PE, GENGAT1A.173
& ICODE,CMESSAGE) GENGAT1A.174
GENGAT1A.175
LOCAL_SIZE=LENRIMDATA_A GENGAT1A.176
GENGAT1A.177
!------------------------------------------------------------------- GENGAT1A.178
GENGAT1A.179
! Ocean Lateral boundary fields GENGAT1A.180
GENGAT1A.181
ELSEIF GENGAT1A.182
& (grid_type .EQ. ppx_ocn_rim) THEN GENGAT1A.183
GENGAT1A.184
CALL GATHER_OCEAN_LBCS(GLOBAL_FIELD,global_LENRIMDATA_O, GENGAT1A.185
& LOCAL_FIELD,LENRIMDATA_O, GENGAT1A.186
& GATHER_PE, GENGAT1A.187
& ICODE,CMESSAGE) GENGAT1A.188
GENGAT1A.189
LOCAL_SIZE=LENRIMDATA_O GENGAT1A.190
GENGAT1A.191
!------------------------------------------------------------------- GENGAT1A.192
! "Normal" fields GENGAT1A.193
GENGAT1A.194
ELSEIF GENGAT1A.195
! atmosphere grids GENGAT1A.196
& ((grid_type .EQ. ppx_atm_tall) .OR. ! Atmos T points GENGAT1A.197
& (grid_type .EQ. ppx_atm_tland) .OR. ! Atmos T land points GENGAT1A.198
& (grid_type .EQ. ppx_atm_tsea) .OR. ! Atmos T sea points GENGAT1A.199
& (grid_type .EQ. ppx_atm_uall) .OR. ! Atmos U points GENGAT1A.200
& (grid_type .EQ. ppx_atm_uland) .OR. ! Atmos U land points GENGAT1A.201
& (grid_type .EQ. ppx_atm_usea) .OR. ! Atmos U sea points GENGAT1A.202
& (grid_type .EQ. ppx_atm_cuall) .OR. ! Atmos C grid U pts GENGAT1A.203
& (grid_type .EQ. ppx_atm_cvall) .OR. ! Atmos C grid V pts GENGAT1A.204
& (grid_type .EQ. ppx_atm_ozone) .OR. ! Atmos ozone field GENGAT1A.205
& (grid_type .EQ. ppx_atm_tzonal) .OR. ! Atmos T zonal GENGAT1A.206
& (grid_type .EQ. ppx_atm_uzonal) .OR. ! Atmos U zonal GENGAT1A.207
! ocean grids GENGAT1A.208
& (grid_type .EQ. ppx_ocn_tcomp) .OR. ! Ocean "Compressed" T GENGAT1A.209
& (grid_type .EQ. ppx_ocn_ucomp) .OR. ! Ocean "Compressed" u GENGAT1A.210
& (grid_type .EQ. ppx_ocn_tall) .OR. ! Ocean T points (cyc) GENGAT1A.211
& (grid_type .EQ. ppx_ocn_uall) .OR. ! Ocean U points (cyc) GENGAT1A.212
& (grid_type .EQ. ppx_ocn_cuall) .OR. ! Ocean C grid U pts GENGAT1A.213
& (grid_type .EQ. ppx_ocn_cvall) .OR. ! Ocean C grid V pts GENGAT1A.214
& (grid_type .EQ. ppx_ocn_tfield) .OR.! Ocean T points GENGAT1A.215
& (grid_type .EQ. ppx_ocn_ufield) .OR. ! Ocean U points GENGAT1A.216
& (grid_type .EQ. ppx_ocn_tzonal) .OR. ! Ocean T zonal GENGAT1A.217
& (grid_type .EQ. ppx_ocn_uzonal)) ! Atmos U zonal GENGAT1A.218
& THEN GENGAT1A.219
GENGAT1A.220
LOCAL_SIZE=ADDR_INFO(d1_length)/ADDR_INFO(d1_no_levels) GENGAT1A.221
GENGAT1A.222
fld_type=GET_FLD_TYPE(grid_type) GENGAT1A.223
GENGAT1A.224
IF (ADDR_INFO(d1_object_type) .EQ. diagnostic) THEN GENGAT1A.225
north=ADDR_INFO(d1_north_code) GENGAT1A.226
south=ADDR_INFO(d1_south_code) GENGAT1A.227
east=ADDR_INFO(d1_east_code) GENGAT1A.228
west=ADDR_INFO(d1_west_code) GENGAT1A.229
GENGAT1A.230
mean_type=ADDR_INFO(d1_gridpoint_code)/10 GENGAT1A.231
IF (mean_type .EQ. 2) THEN ! zonal mean GENGAT1A.232
east=west GENGAT1A.233
ELSEIF (mean_type .EQ. 3) THEN ! meridional mean GENGAT1A.234
south=north GENGAT1A.235
ELSEIF (mean_type .GE. 4) THEN ! field/global mean GENGAT1A.236
east=west GENGAT1A.237
south=north GENGAT1A.238
ENDIF GENGAT1A.239
GENGAT1A.240
ELSE GENGAT1A.241
north=1 GENGAT1A.242
west=1 GENGAT1A.243
east=glsize(1) GENGAT1A.244
IF (fld_type .EQ. fld_type_p) THEN GENGAT1A.245
south=glsize(2) GENGAT1A.246
ELSE GENGAT1A.247
south=glsize(2)-1 GENGAT1A.248
ENDIF GENGAT1A.249
ENDIF GENGAT1A.250
GENGAT1A.251
! STASH_GATHER_FIELD can distribute whole fields, or subarea GENGAT1A.252
! fields GENGAT1A.253
GENGAT1A.254
CALL STASH_GATHER_FIELD( GENGAT1A.255
& LOCAL_FIELD,GLOBAL_FIELD, GENGAT1A.256
& LOCAL_SIZE,GLOBAL_SIZE,1, GENGAT1A.257
& north,east,south,west, GENGAT1A.258
& grid_type,GATHER_PE,.TRUE.,ICODE,CMESSAGE) GENGAT1A.259
GENGAT1A.260
!------------------------------------------------------------------- GENGAT1A.261
! Any other type of field GENGAT1A.262
ELSE GENGAT1A.263
GENGAT1A.264
ICODE=1 GENGAT1A.265
CMESSAGE='GENERAL_GATHER_FIELD : Field type not recognized' GENGAT1A.266
GENGAT1A.267
ENDIF GENGAT1A.268
GENGAT1A.269
9999 CONTINUE GENGAT1A.270
GENGAT1A.271
RETURN GENGAT1A.272
GENGAT1A.273
END GENGAT1A.274
GENGAT1A.275
*ENDIF GENGAT1A.276
*ENDIF GENGAT1A.277