SUBROUTINE STASH_SCATTER_FIELD ( 1,8STSFLD1A.25
& LOCAL_FIELD , GLOBAL_FIELD , STSFLD1A.26
& LOCAL_SIZE, GLOBAL_SIZE, LEVELS, STSFLD1A.27
& GLOBAL_NORTH , GLOBAL_EAST_IN , GLOBAL_SOUTH , GLOBAL_WEST, STSFLD1A.28
& GRIDTYPE_CODE , STSFLD1A.29
& SCATTER_PE, STSFLD1A.30
& ICODE, CMESSAGE) STSFLD1A.31
STSFLD1A.32
IMPLICIT NONE STSFLD1A.33
STSFLD1A.34
STSFLD1A.35
! Description: STSFLD1A.36
! Takes a decomposed, STASH processed field and gathers STSFLD1A.37
! it to a single processor, ready for I/O, STSFLD1A.38
! STSFLD1A.39
! Method: STSFLD1A.40
! See in-line documentation STSFLD1A.41
! STSFLD1A.42
! Current code owner : P.Burton STSFLD1A.43
! STSFLD1A.44
! History: STSFLD1A.45
! Model Date Modification history from model version 4.3 STSFLD1A.46
! version STSFLD1A.47
! 4.3 17/09/96 New DECK created for MPP version of STASH STSFLD1A.48
! P.Burton STSFLD1A.49
! 4.3 13/06/97 More robust handling of zonal fields P.Burton GPB0F404.400
! Fix for global_start_row P.Burton GPB0F404.401
! STSFLD1A.50
! Subroutine arguments: STSFLD1A.51
STSFLD1A.52
INTEGER STSFLD1A.53
& LOCAL_SIZE ! IN: size of level of LOCAL_FIELD STSFLD1A.54
&, GLOBAL_SIZE ! IN: size of level of GLOBAL_FIELD STSFLD1A.55
&, LEVELS ! IN: number of levels STSFLD1A.56
&, GLOBAL_NORTH ! IN: specification of subdomain boundaries STSFLD1A.57
&, GLOBAL_EAST_IN ! IN: "" STSFLD1A.58
&, GLOBAL_SOUTH ! IN: "" STSFLD1A.59
&, GLOBAL_WEST ! IN: "" STSFLD1A.60
&, GRIDTYPE_CODE ! IN: indicates the type of grid output STSFLD1A.61
&, SCATTER_PE ! IN: the PE to scatter global field from STSFLD1A.62
&, ICODE ! OUT: return code, 0=OK STSFLD1A.63
STSFLD1A.64
REAL STSFLD1A.65
& LOCAL_FIELD(LOCAL_SIZE,LEVELS) STSFLD1A.66
! ! OUT : local scattered data STSFLD1A.67
&, GLOBAL_FIELD(GLOBAL_SIZE,LEVELS) STSFLD1A.68
! ! IN : (PE SCATTER_PE only) - full field STSFLD1A.69
STSFLD1A.70
CHARACTER*80 STSFLD1A.71
& CMESSAGE ! OUT: Error message if ICODE .NE. 0 STSFLD1A.72
STSFLD1A.73
! Parameters and common blocks STSFLD1A.74
*CALL STPARAM 
STSFLD1A.75
*CALL CPPXREF GPB0F404.402
*CALL PARVARS STSFLD1A.76
*CALL GCCOM STSFLD1A.77
*CALL AMAXSIZE STSFLD1A.78
STSFLD1A.79
! Local variables STSFLD1A.80
STSFLD1A.81
INTEGER STSFLD1A.82
& GLOBAL_EAST ! copy of GLOBAL_EAST_IN with wrap around s.t. STSFLD1A.83
! ! GLOBAL_EAST > GLOBAL_ROW_LEN STSFLD1A.84
&, global_x ! size of global data EW GPB0F404.403
&, global_y ! size of global data NS GPB0F404.404
&, fld_type ! indicates if field is on P or U grid STSFLD1A.85
&, level ! loop index for loop over levels STSFLD1A.86
&, proc_topleft_x,proc_topleft_y ! processors at corners of STSFLD1A.87
&, proc_botright_x,proc_botright_y ! the subarea STSFLD1A.88
&, dummy1,dummy2 ! ignored return arguments STSFLD1A.89
&, procx,procy ! loop indexes for loops over processors STSFLD1A.90
&, eff_procx ! real x co-ord of processor column procx STSFLD1A.91
&, procid ! processor id of (procx,procy) STSFLD1A.92
&, local_xstart,local_xend ! boundaries of subdomain for STSFLD1A.93
&, local_ystart,local_yend ! processor procid STSFLD1A.94
&, local_start_row ! first row to receive on procid STSFLD1A.95
&, local_start_col ! first column to receive on procid STSFLD1A.96
&, sendsize_x ! number of points on each row to send STSFLD1A.97
! ! to procid STSFLD1A.98
&, nrows_to_send ! number of rows to send to procid STSFLD1A.99
&, local_row_length ! size of receiving array EW STSFLD1A.100
&, global_start_row ! first row to send on SCATTER_PE STSFLD1A.101
&, global_start_col ! first col. to send on SCATTER_PE STSFLD1A.102
&, global_row_length ! size of sending array EW STSFLD1A.103
&, flag,info ! GCOM arguments STSFLD1A.104
STSFLD1A.105
! Copies of arguments / variables used to decide if we can use the STSFLD1A.106
! send/receive maps used in the last call STSFLD1A.107
STSFLD1A.108
INTEGER STSFLD1A.109
& old_LOCAL_SIZE , old_GLOBAL_SIZE STSFLD1A.110
&, old_GLOBAL_NORTH , old_GLOBAL_EAST_IN STSFLD1A.111
&, old_GLOBAL_SOUTH , old_GLOBAL_WEST STSFLD1A.112
&, old_GRIDTYPE_CODE , old_SCATTER_PE STSFLD1A.113
&, old_current_decomp_type STSFLD1A.114
STSFLD1A.115
INTEGER STSFLD1A.116
! variables defining send and receive maps to be passed to STSFLD1A.117
! GC_RALL_TO_ALL, defining the data transposition STSFLD1A.118
& send_map(7,MAXPROC*2) STSFLD1A.119
&, receive_map(7,2) STSFLD1A.120
&, n_sends,n_recvs ! number of sends and receives STSFLD1A.121
STSFLD1A.122
STSFLD1A.123
LOGICAL STSFLD1A.124
& wrap ! if the subdomain wraps over 0 degree meridion STSFLD1A.125
&, wrap_special ! if there is a wrap around, which starts and STSFLD1A.126
! ends on the same processor STSFLD1A.127
&, zonal_data ! if this is a zonal data grid GPB0F404.405
&, fullfield ! if this is a full field - NOT a subarea STSFLD1A.128
STSFLD1A.129
! Save all the variables that may be used in the next call STSFLD1A.130
SAVE STSFLD1A.131
& old_LOCAL_SIZE , old_GLOBAL_SIZE STSFLD1A.132
&, old_GLOBAL_NORTH , old_GLOBAL_EAST_IN STSFLD1A.133
&, old_GLOBAL_SOUTH , old_GLOBAL_WEST STSFLD1A.134
&, old_GRIDTYPE_CODE , old_SCATTER_PE STSFLD1A.135
&, old_current_decomp_type STSFLD1A.136
&, send_map,receive_map,n_sends,n_recvs STSFLD1A.137
STSFLD1A.138
! Set all the old_* variables to a number indicating they've STSFLD1A.139
! not been used yet STSFLD1A.140
STSFLD1A.141
DATA STSFLD1A.142
& old_LOCAL_SIZE , old_GLOBAL_SIZE STSFLD1A.143
&, old_GLOBAL_NORTH , old_GLOBAL_EAST_IN STSFLD1A.144
&, old_GLOBAL_SOUTH , old_GLOBAL_WEST STSFLD1A.145
&, old_GRIDTYPE_CODE , old_SCATTER_PE STSFLD1A.146
&, old_current_decomp_type STSFLD1A.147
& / -1,-1,-1,-1,-1,-1,-1,-1,-1 / STSFLD1A.148
STSFLD1A.149
! Functions STSFLD1A.150
STSFLD1A.151
INTEGER GET_FLD_TYPE STSFLD1A.152
! ------------------------------------------------------------------ STSFLD1A.153
STSFLD1A.154
ICODE=0 STSFLD1A.155
STSFLD1A.156
! See if there is wrap around over meridion, and if so make STSFLD1A.157
! sure that GLOBAL_EAST is > glsize(1) STSFLD1A.158
STSFLD1A.159
GLOBAL_EAST=GLOBAL_EAST_IN STSFLD1A.160
IF (GLOBAL_EAST .GT. glsize(1)) THEN STSFLD1A.161
wrap=.TRUE. STSFLD1A.162
ELSEIF (GLOBAL_EAST .LT. GLOBAL_WEST) THEN STSFLD1A.163
wrap=.TRUE. STSFLD1A.164
GLOBAL_EAST=GLOBAL_EAST_IN+glsize(1) STSFLD1A.165
ELSE STSFLD1A.166
wrap=.FALSE. STSFLD1A.167
ENDIF STSFLD1A.168
STSFLD1A.169
IF ((GRIDTYPE_CODE .EQ. ppx_atm_tzonal) .OR. ! Atmos T zonal GPB0F404.406
& ( GRIDTYPE_CODE .EQ. ppx_atm_uzonal) .OR. ! Atmos U zonal GPB0F404.407
& ( GRIDTYPE_CODE .EQ. ppx_ocn_tzonal) .OR. ! Ocean T zonal GPB0F404.408
& ( GRIDTYPE_CODE .EQ. ppx_ocn_uzonal)) ! Atmos U zonal GPB0F404.409
& THEN GPB0F404.410
GPB0F404.411
! This is a zonal field GPB0F404.412
GPB0F404.413
zonal_data=.TRUE. GPB0F404.414
global_x=1 GPB0F404.415
GPB0F404.416
IF ((GRIDTYPE_CODE .EQ. ppx_atm_tzonal) .OR. ! Atmos T zonal GPB0F404.417
& ( GRIDTYPE_CODE .EQ. ppx_ocn_tzonal)) ! Ocean T zonal GPB0F404.418
& THEN GPB0F404.419
fld_type=fld_type_p GPB0F404.420
ELSE GPB0F404.421
fld_type=fld_type_u GPB0F404.422
ENDIF GPB0F404.423
ELSE GPB0F404.424
GPB0F404.425
! This is a normal field GPB0F404.426
GPB0F404.427
zonal_data=.FALSE. GPB0F404.428
global_x=glsize(1) GPB0F404.429
GPB0F404.430
fld_type=GET_FLD_TYPE(GRIDTYPE_CODE) GPB0F404.431
GPB0F404.432
IF (fld_type .EQ. fld_type_unknown) THEN GPB0F404.433
WRITE(6,*) 'STASH_GATHER_FIELD encountered ', GPB0F404.434
& 'field with gridtype code ',GRIDTYPE_CODE GPB0F404.435
WRITE(6,*) 'Unable to process this field.' GPB0F404.436
CMESSAGE='MPP : STASH_GATHER_FIELD could not process field' GPB0F404.437
ICODE=1 GPB0F404.438
GOTO 9999 GPB0F404.439
ENDIF GPB0F404.440
GPB0F404.441
ENDIF GPB0F404.442
GPB0F404.443
IF (fld_type .EQ. fld_type_p) THEN GPB0F404.444
global_y=glsize(2) GPB0F404.445
ELSE GPB0F404.446
global_y=glsize(2)-1 GPB0F404.447
ENDIF GPB0F404.448
STSFLD1A.182
! Set up logical indicating if this is a full field, or just STSFLD1A.183
! a subdomain STSFLD1A.184
STSFLD1A.185
IF (zonal_data) THEN GPB0F404.449
GPB0F404.450
fullfield= ( ( GLOBAL_NORTH .EQ. 1) .AND. GPB0F404.451
& ( GLOBAL_SOUTH .EQ. global_y)) GPB0F404.452
GPB0F404.453
ELSE GPB0F404.454
GPB0F404.455
fullfield = (( GLOBAL_WEST .EQ. 1) .AND. GPB0F404.456
& ( GLOBAL_EAST .EQ. global_x) .AND. GPB0F404.457
& ( GLOBAL_NORTH .EQ. 1) .AND. GPB0F404.458
& ( GLOBAL_SOUTH .EQ. global_y)) GPB0F404.459
GPB0F404.460
ENDIF GPB0F404.461
GPB0F404.462
! If this is a fullfield, we can simply use the standard GPB0F404.463
! SCATTER_FIELD routine GPB0F404.464
GPB0F404.465
IF (fullfield) THEN GPB0F404.466
GPB0F404.467
IF (zonal_data) THEN GPB0F404.468
GPB0F404.469
CALL SCATTER_ZONAL_FIELD( LOCAL_FIELD,GLOBAL_FIELD, GPB0F404.470
& lasize(2),global_y, GPB0F404.471
& LEVELS,GRIDTYPE_CODE, GPB0F404.472
& SCATTER_PE) GPB0F404.473
GPB0F404.474
! Don't call swapbounds for ocean zonal fields which currently GPB0F404.475
! do not have halos GPB0F404.476
GPB0F404.477
IF ((GRIDTYPE_CODE .NE. ppx_ocn_uzonal) .AND. GPB0F404.478
& (GRIDTYPE_CODE .NE. ppx_ocn_tzonal)) THEN GPB0F404.479
CALL SWAPBOUNDS(LOCAL_FIELD,1,lasize(2),0,Offy,LEVELS) GPB0F404.480
ENDIF GPB0F404.481
GPB0F404.482
ELSE GPB0F404.483
GPB0F404.484
DO level=1,LEVELS GPB0F404.485
GPB0F404.486
CALL SCATTER_FIELD( LOCAL_FIELD(1,level) , GPB0F404.487
& GLOBAL_FIELD(1,level), GPB0F404.488
& lasize(1),lasize(2), GPB0F404.489
& global_x,global_y, GPB0F404.490
& SCATTER_PE,GC_ALL_PROC_GROUP, GPB0F404.491
& info) GPB0F404.492
GPB0F404.493
ENDDO GPB0F404.494
GPB0F404.495
CALL SWAPBOUNDS(LOCAL_FIELD,lasize(1),lasize(2), GPB0F404.496
& Offx,Offy,LEVELS) GPB0F404.497
GPB0F404.498
ENDIF GPB0F404.499
ELSE STSFLD1A.222
! for subdomains, life is not so easy - we must explicitly STSFLD1A.223
! calculate our own send and receive maps, and use GCG_RALLTOALLE STSFLD1A.224
! to shift the data around. STSFLD1A.225
STSFLD1A.226
! If the same arguments are used as were used in the last call STSFLD1A.227
! to this routine, we can just use the previously calculated STSFLD1A.228
! send and receive maps, otherwise we need to calculate new maps STSFLD1A.229
STSFLD1A.230
IF (.NOT. ( STSFLD1A.231
& (LOCAL_SIZE .EQ. old_LOCAL_SIZE) .AND. STSFLD1A.232
& (GLOBAL_SIZE .EQ. old_GLOBAL_SIZE) .AND. STSFLD1A.233
& (GLOBAL_NORTH .EQ. old_GLOBAL_NORTH) .AND. STSFLD1A.234
& (GLOBAL_EAST_IN .EQ. old_GLOBAL_EAST_IN) .AND. STSFLD1A.235
& (GLOBAL_SOUTH .EQ. old_GLOBAL_SOUTH) .AND. STSFLD1A.236
& (GLOBAL_WEST .EQ. old_GLOBAL_WEST) .AND. STSFLD1A.237
& (GRIDTYPE_CODE .EQ. old_GRIDTYPE_CODE) .AND. STSFLD1A.238
& (SCATTER_PE .EQ. old_SCATTER_PE) .AND. STSFLD1A.239
& (current_decomp_type .EQ. old_current_decomp_type ))) THEN STSFLD1A.240
STSFLD1A.241
old_LOCAL_SIZE=LOCAL_SIZE STSFLD1A.242
old_GLOBAL_SIZE=GLOBAL_SIZE STSFLD1A.243
old_GLOBAL_NORTH=GLOBAL_NORTH STSFLD1A.244
old_GLOBAL_EAST_IN=GLOBAL_EAST_IN STSFLD1A.245
old_GLOBAL_SOUTH=GLOBAL_SOUTH STSFLD1A.246
old_GLOBAL_WEST=GLOBAL_WEST STSFLD1A.247
old_GRIDTYPE_CODE=GRIDTYPE_CODE STSFLD1A.248
old_SCATTER_PE=SCATTER_PE STSFLD1A.249
old_current_decomp_type=current_decomp_type STSFLD1A.250
STSFLD1A.251
! Find out what the boundaries of the subdomain area STSFLD1A.252
STSFLD1A.253
CALL GLOBAL_TO_LOCAL_RC(GRIDTYPE_CODE, STSFLD1A.254
& GLOBAL_WEST,GLOBAL_NORTH, STSFLD1A.255
& proc_topleft_x,proc_topleft_y, STSFLD1A.256
& dummy1,dummy2) STSFLD1A.257
CALL GLOBAL_TO_LOCAL_RC(GRIDTYPE_CODE, STSFLD1A.258
& GLOBAL_EAST,GLOBAL_SOUTH, STSFLD1A.259
& proc_botright_x,proc_botright_y, STSFLD1A.260
& dummy1,dummy2) STSFLD1A.261
STSFLD1A.262
! Ensure that the processor x co-ords are such that the botright_x is STSFLD1A.263
! always greater than (or equal to) top_left_x. STSFLD1A.264
IF (wrap) proc_botright_x=gridsize(1)+proc_botright_x STSFLD1A.265
STSFLD1A.266
! wrap_special is set to true if there is a wrap around which starts STSFLD1A.267
! and ends on the same processor. This case requires extra work as STSFLD1A.268
! the processor in question STSFLD1A.269
IF (wrap .AND. (proc_topleft_x+gridsize(1) .EQ. STSFLD1A.270
& proc_botright_x)) THEN STSFLD1A.271
wrap_special=.TRUE. STSFLD1A.272
ELSE STSFLD1A.273
wrap_special=.FALSE. STSFLD1A.274
ENDIF STSFLD1A.275
STSFLD1A.276
n_sends=0 STSFLD1A.277
n_recvs=0 STSFLD1A.278
STSFLD1A.279
DO procy=proc_topleft_y,proc_botright_y STSFLD1A.280
DO procx=proc_topleft_x,proc_botright_x STSFLD1A.281
STSFLD1A.282
eff_procx=MOD(procx,gridsize(1)) STSFLD1A.283
procid=eff_procx+procy*gridsize(1) STSFLD1A.284
STSFLD1A.285
CALL GLOBAL_TO_LOCAL_SUBDOMAIN( STSFLD1A.286
& .TRUE.,.TRUE., STSFLD1A.287
& GRIDTYPE_CODE,procid, STSFLD1A.288
& GLOBAL_NORTH,GLOBAL_EAST, STSFLD1A.289
& GLOBAL_SOUTH,GLOBAL_WEST, STSFLD1A.290
& local_ystart,local_xend, STSFLD1A.291
& local_yend ,local_xstart) STSFLD1A.292
STSFLD1A.293
! Calculate the shape of the arrays, and where to start sending/ STSFLD1A.294
! receiving data, and how many rows to send STSFLD1A.295
STSFLD1A.296
local_start_row=1 STSFLD1A.297
nrows_to_send=local_yend-local_ystart+1 STSFLD1A.298
STSFLD1A.299
global_start_row=g_datastart(2,procid)+local_ystart-Offy- GPB0F404.500
& GLOBAL_NORTH STSFLD1A.301
global_row_length=GLOBAL_EAST-GLOBAL_WEST+1 STSFLD1A.302
STSFLD1A.303
! Calculate the following variables: STSFLD1A.304
! local_row_length : the X dimension size of the local array STSFLD1A.305
! local_send_offx : the offset into each row to start sending from STSFLD1A.306
! sendsize_x : the number of points on each row to send STSFLD1A.307
! The calculation of these numbers is different for processors STSFLD1A.308
! at the start and end of a wrap_special case STSFLD1A.309
STSFLD1A.310
IF (wrap_special .AND. procx .EQ. proc_topleft_x) THEN STSFLD1A.311
local_row_length=g_lasize(1,procid)+local_xend- STSFLD1A.312
& local_xstart-2*Offx+1 STSFLD1A.313
local_start_col=1 STSFLD1A.314
sendsize_x=g_lasize(1,procid)-local_xstart STSFLD1A.315
global_start_col=1 STSFLD1A.316
STSFLD1A.317
ELSEIF (wrap_special .AND. procx .EQ. proc_botright_x) STSFLD1A.318
& THEN STSFLD1A.319
local_row_length=g_lasize(1,procid)+local_xend- STSFLD1A.320
& local_xstart-2*Offx+1 STSFLD1A.321
local_start_col=local_row_length-local_xend+Offx+1 STSFLD1A.322
sendsize_x=local_xend-Offx STSFLD1A.323
global_start_col=global_row_length-sendsize_x+1 STSFLD1A.324
STSFLD1A.325
ELSE STSFLD1A.326
local_row_length=local_xend-local_xstart+1 STSFLD1A.327
local_start_col=1 STSFLD1A.328
sendsize_x=local_xend-local_xstart+1 STSFLD1A.329
global_start_col=local_xstart-(Offx+1)+ STSFLD1A.330
& g_datastart(1,procid)-GLOBAL_WEST+1 STSFLD1A.331
ENDIF STSFLD1A.332
STSFLD1A.333
IF (global_start_col .LT. 0) THEN STSFLD1A.334
! Wrapped around field, but this processor is not start or end STSFLD1A.335
! processor STSFLD1A.336
global_start_col=global_start_col+glsize(1) STSFLD1A.337
ENDIF STSFLD1A.338
STSFLD1A.339
! Now we can set up the send and receive map entries for the data on STSFLD1A.340
! this processor STSFLD1A.341
STSFLD1A.342
IF (mype .EQ. procid) THEN ! I need to receive some data STSFLD1A.343
STSFLD1A.344
n_recvs=n_recvs+1 STSFLD1A.345
STSFLD1A.346
receive_map(R_SOURCE_PE,n_recvs) = SCATTER_PE STSFLD1A.347
receive_map(R_BASE_ADDRESS_IN_RECV_ARRAY,n_recvs) = STSFLD1A.348
& (local_start_row-1)*local_row_length + STSFLD1A.349
& local_start_col STSFLD1A.350
receive_map(R_NUMBER_OF_ELEMENTS_IN_ITEM,n_recvs) = STSFLD1A.351
& nrows_to_send STSFLD1A.352
receive_map(R_STRIDE_IN_RECV_ARRAY,n_recvs) = STSFLD1A.353
& local_row_length STSFLD1A.354
receive_map(R_ELEMENT_LENGTH,n_recvs) = sendsize_x STSFLD1A.355
receive_map(R_BASE_ADDRESS_IN_SEND_ARRAY,n_recvs) = STSFLD1A.356
& (global_start_row-1)*global_row_length + STSFLD1A.357
& global_start_col STSFLD1A.358
receive_map(R_STRIDE_IN_SEND_ARRAY,n_recvs) = STSFLD1A.359
& global_row_length STSFLD1A.360
STSFLD1A.361
ENDIF ! if I'm receiving data STSFLD1A.362
STSFLD1A.363
IF (mype .EQ. SCATTER_PE) THEN ! I need to send data STSFLD1A.364
STSFLD1A.365
n_sends=n_sends+1 STSFLD1A.366
STSFLD1A.367
send_map(S_DESTINATION_PE,n_sends) = procid STSFLD1A.368
send_map(S_BASE_ADDRESS_IN_SEND_ARRAY,n_sends) = STSFLD1A.369
& (global_start_row-1)*global_row_length + STSFLD1A.370
& global_start_col STSFLD1A.371
send_map(S_NUMBER_OF_ELEMENTS_IN_ITEM,n_sends) = STSFLD1A.372
& nrows_to_send STSFLD1A.373
send_map(S_STRIDE_IN_SEND_ARRAY,n_sends) = STSFLD1A.374
& global_row_length STSFLD1A.375
send_map(S_ELEMENT_LENGTH,n_sends) = sendsize_x STSFLD1A.376
send_map(S_BASE_ADDRESS_IN_RECV_ARRAY,n_sends) = STSFLD1A.377
& (local_start_row-1)*local_row_length + STSFLD1A.378
& local_start_col STSFLD1A.379
send_map(S_STRIDE_IN_RECV_ARRAY,n_sends) = STSFLD1A.380
& local_row_length STSFLD1A.381
STSFLD1A.382
ENDIF ! if I'm sending data STSFLD1A.383
STSFLD1A.384
ENDDO ! procx : loop along processor row STSFLD1A.385
STSFLD1A.386
ENDDO ! procy : loop down processor column STSFLD1A.387
STSFLD1A.388
ENDIF ! if I need to recalculate my send/receive maps STSFLD1A.389
STSFLD1A.390
! Send / receive the data using GCG_RALLTOALLE STSFLD1A.391
STSFLD1A.392
DO level=1,LEVELS STSFLD1A.393
STSFLD1A.394
flag=0 ! This is currently ignored at GCG v1.1 STSFLD1A.395
STSFLD1A.396
CALL GC_SETOPT(GC_SHM_DIR,GC_SHM_GET,info) ! set as scatter STSFLD1A.397
STSFLD1A.398
info=GC_NONE STSFLD1A.399
STSFLD1A.400
CALL GCG_RALLTOALLE( STSFLD1A.401
& GLOBAL_FIELD(1,level) , STSFLD1A.402
& send_map , n_sends ,GLOBAL_SIZE , STSFLD1A.403
& LOCAL_FIELD(1,level) , STSFLD1A.404
& receive_map , n_recvs , LOCAL_SIZE , STSFLD1A.405
& GC_ALL_PROC_GROUP , flag, info) STSFLD1A.406
STSFLD1A.407
ENDDO STSFLD1A.408
STSFLD1A.409
ENDIF ! if this is a full or extracted field STSFLD1A.410
STSFLD1A.411
9999 CONTINUE STSFLD1A.412
STSFLD1A.413
RETURN STSFLD1A.414
END STSFLD1A.415
STSFLD1A.416
*ENDIF STSFLD1A.417
*ENDIF STSFLD1A.418