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