*IF DEF,C96_1A,OR,DEF,C96_1B GPB3F403.260
*IF DEF,MPP GPB3F403.261
C ******************************COPYRIGHT****************************** GTS2F400.12820
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.12821
C GTS2F400.12822
C Use, duplication or disclosure of this code is subject to the GTS2F400.12823
C restrictions as set forth in the contract. GTS2F400.12824
C GTS2F400.12825
C Meteorological Office GTS2F400.12826
C London Road GTS2F400.12827
C BRACKNELL GTS2F400.12828
C Berkshire UK GTS2F400.12829
C RG12 2SZ GTS2F400.12830
C GTS2F400.12831
C If no contract has been raised with this copy of the code, the use, GTS2F400.12832
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.12833
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.12834
C Modelling at the above address. GTS2F400.12835
C GTS2F400.12836
!+ Parallel UM: Sets up array of tids of adjacent processes. SETNEB1A.3
! SETNEB1A.4
! Subroutine interface: SETNEB1A.5
SUBROUTINE SET_NEIGHBOUR(decomp_type) 2GPB0F402.222
SETNEB1A.7
IMPLICIT NONE SETNEB1A.8
SETNEB1A.9
! SETNEB1A.10
! Description: SETNEB1A.11
! This routine finds the tids of the North, South, East and West SETNEB1A.12
! neighbouring processes. It takes account of the boundary SETNEB1A.13
! condition in each dimension (X and Y) which can be either: SETNEB1A.14
! cyclic : wrap around SETNEB1A.15
! static : no wrap around SETNEB1A.16
! SETNEB1A.17
! Method: SETNEB1A.18
! The tid of each neighbouring process is calculated (taking into SETNEB1A.19
! account the relevant boundary conditions) and placed in the SETNEB1A.20
! neighbour array. SETNEB1A.21
! SETNEB1A.22
! Current Code Owner: Paul Burton SETNEB1A.23
! SETNEB1A.24
! History: SETNEB1A.25
! Model Date Modification history from model version 3.5 SETNEB1A.26
! version SETNEB1A.27
! 3.5 4/1/95 New DECK created for the Parallel Unified SETNEB1A.28
! Model. P.Burton + R.Skaalin SETNEB1A.29
! 4.2 21/08/96 Updated to use DECOMPDB variables rather than GPB0F402.223
! PARVARS. Only argument required is the GPB0F402.224
! decomposition type. P.Burton GPB0F402.225
GPB0F402.226
! SETNEB1A.30
! Subroutine Arguments: SETNEB1A.31
SETNEB1A.32
INTEGER decomp_type ! Decomposition type to update neighbours GPB0F402.227
! ! for GPB0F402.228
SETNEB1A.35
! Parameters and Common blocks SETNEB1A.36
SETNEB1A.37
*CALL PARVARS 
SETNEB1A.38
*CALL DECOMPTP GPB0F402.229
*CALL DECOMPDB GPB0F402.230
SETNEB1A.39
! ------------------------------------------------------------------ SETNEB1A.40
SETNEB1A.41
SETNEB1A.44
C Set Northen neighbour SETNEB1A.45
SETNEB1A.46
IF ( decomp_db_g_gridpos(2,mype,decomp_type) .GT. 0) THEN GPB0F402.231
! This processor is not at the top of the LPG GPB0F402.232
decomp_db_neighbour(PNorth,decomp_type) = GPB0F402.233
& mype - decomp_db_gridsize(1,decomp_type) GPB0F402.234
ELSEIF (decomp_db_bound(2,decomp_type) .EQ. BC_CYCLIC) THEN GPB0F402.235
! This processor at the top of LPG, and has cyclic BCs. GPB0F402.236
decomp_db_neighbour(PNorth,decomp_type) = GPB0F402.237
& mype + decomp_db_nproc(decomp_type) - GPB0F402.238
& decomp_db_gridsize(1,decomp_type) GPB0F402.239
ELSE GPB0F402.240
! This processor at top of LPG and has static BCs GPB0F402.241
decomp_db_neighbour(PNorth,decomp_type) =NoDomain GPB0F402.242
ENDIF GPB0F402.243
SETNEB1A.54
C Set Southern neighbour SETNEB1A.55
SETNEB1A.56
IF ( decomp_db_g_gridpos(2,mype,decomp_type) .LT. GPB0F402.244
& (decomp_db_gridsize(2,decomp_type)-1) ) THEN GPB0F402.245
! This processor is not at the bottom of the LPG GPB0F402.246
decomp_db_neighbour(PSouth,decomp_type) = GPB0F402.247
& mype + decomp_db_gridsize(1,decomp_type) GPB0F402.248
ELSEIF (decomp_db_bound(2,decomp_type) .EQ. BC_CYCLIC) THEN GPB0F402.249
! This processor at the bottom of LPG, and has cyclic BCs. GPB0F402.250
decomp_db_neighbour(PSouth,decomp_type) = GPB0F402.251
& mype - decomp_db_nproc(decomp_type) + GPB0F402.252
& decomp_db_gridsize(1,decomp_type) GPB0F402.253
ELSE GPB0F402.254
! This processor at top of LPG and has static BCs GPB0F402.255
decomp_db_neighbour(PSouth,decomp_type) =NoDomain GPB0F402.256
ENDIF GPB0F402.257
SETNEB1A.64
C Set Western neighbour SETNEB1A.65
SETNEB1A.66
IF ( decomp_db_g_gridpos(1,mype,decomp_type) .GT. 0) THEN GPB0F402.258
! This processor is not at the left of the LPG GPB0F402.259
decomp_db_neighbour(PWest,decomp_type) = GPB0F402.260
& mype - 1 GPB0F402.261
ELSEIF (decomp_db_bound(1,decomp_type) .EQ. BC_CYCLIC) THEN GPB0F402.262
! This processor at the left of the LPG, and has cyclic BCs. GPB0F402.263
decomp_db_neighbour(PWest,decomp_type) = GPB0F402.264
& mype + decomp_db_gridsize(1,decomp_type) - 1 GPB0F402.265
ELSE GPB0F402.266
! This processor at top of LPG and has static BCs GPB0F402.267
decomp_db_neighbour(PWest,decomp_type) =NoDomain GPB0F402.268
ENDIF GPB0F402.269
SETNEB1A.74
C Set Eastern neighbour SETNEB1A.75
IF ( decomp_db_g_gridpos(1,mype,decomp_type) .LT. GPB0F402.270
& (decomp_db_gridsize(1,decomp_type)-1) ) THEN GPB0F402.271
! This processor is not at the right of the LPG GPB0F402.272
decomp_db_neighbour(PEast,decomp_type) = GPB0F402.273
& mype + 1 GPB0F402.274
ELSEIF (decomp_db_bound(1,decomp_type) .EQ. BC_CYCLIC) THEN GPB0F402.275
! This processor at the left of the LPG, and has cyclic BCs. GPB0F402.276
decomp_db_neighbour(PEast,decomp_type) = GPB0F402.277
& mype - decomp_db_gridsize(1,decomp_type) + 1 GPB0F402.278
ELSE GPB0F402.279
! This processor at top of LPG and has static BCs GPB0F402.280
decomp_db_neighbour(PEast,decomp_type) =NoDomain GPB0F402.281
ENDIF GPB0F402.282
SETNEB1A.83
RETURN SETNEB1A.84
END SETNEB1A.85
*ENDIF SETNEB1A.86
*ENDIF GPB3F403.262