*IF DEF,C96_1A,OR,DEF,C96_1B GPB3F403.236
*IF DEF,MPP GPB3F403.237
C ******************************COPYRIGHT****************************** GTS2F400.12344
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.12345
C GTS2F400.12346
C Use, duplication or disclosure of this code is subject to the GTS2F400.12347
C restrictions as set forth in the contract. GTS2F400.12348
C GTS2F400.12349
C Meteorological Office GTS2F400.12350
C London Road GTS2F400.12351
C BRACKNELL GTS2F400.12352
C Berkshire UK GTS2F400.12353
C RG12 2SZ GTS2F400.12354
C GTS2F400.12355
C If no contract has been raised with this copy of the code, the use, GTS2F400.12356
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.12357
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.12358
C Modelling at the above address. GTS2F400.12359
C GTS2F400.12360
!+ Parallel UM: Perform 2D data decomposition DECOMP1A.3
! DECOMP1A.4
! Subroutine interface: DECOMP1A.5
SUBROUTINE DECOMPOSE_ATMOS(global_row_len, global_n_rows, 1,1GPB0F402.1
& tot_levels, GPB0F402.2
& nproc_EW, nproc_NS, GPB0F402.3
& local_row_len, local_n_rows) GPB0F402.4
IMPLICIT NONE DECOMP1A.9
! DECOMP1A.10
! Description: DECOMP1A.11
! This routine performs a 2D decomposition - taking the global X DECOMP1A.12
! (global_row_len) and Y (global_n_rows) data sizes and decomposing DECOMP1A.13
! across nproc_EW processors in the X direction and nproc_NS processors GPB0F402.5
! in the Y direction. DECOMP1A.15
! The local data size is returned via local_row_len and local_n_rows. DECOMP1A.16
! These values will include a data halo for boundary updates. DECOMP1A.17
! DECOMP1A.18
! Method: DECOMP1A.19
! The local data sizes are calculated and stored in the COMMON block DECOMP1A.20
! DECOMPDB. The boundary conditions are set (cyclic in East/West GPB0F402.6
! direction if *DEF,GLOBAL). DECOMP1A.22
! DECOMP1A.23
! Current Code Owner: Paul Burton DECOMP1A.24
! DECOMP1A.25
! History: DECOMP1A.26
! Model Date Modification history from model version 3.5 DECOMP1A.27
! version DECOMP1A.28
! 3.5 1/3/95 New DECK created for the Parallel Unified DECOMP1A.29
! Model. P.Burton + R.Skaalin DECOMP1A.30
! 4.1 18/3/96 Added first/last_comp_pe variable. P.Burton GPB0F401.155
! 4.2 19/08/96 Changed name to DECOMPOSE_ATMOS. GPB0F402.7
! Changed argument list to allow a standard GPB0F402.8
! interface to all decomposition routines. GPB0F402.9
! Changed decomposition description variables to GPB0F402.10
! the decomp_db* form, from the DECOMPDB comdeck GPB0F402.11
! to allow flexible decompositions. GPB0F402.12
! Added code to initialise GCOM groups GPB0F402.13
! Changed LAM model EW BCs to cyclic GPB0F402.14
! DECOMP1A.31
! Subroutine Arguments: DECOMP1A.32
DECOMP1A.33
INTEGER DECOMP1A.34
DECOMP1A.35
& global_row_len, ! IN :number of E-W points of entire model DECOMP1A.36
& global_n_rows, ! IN :number of P rows of entire model DECOMP1A.37
& tot_levels, ! IN :total number of levels DECOMP1A.38
& nproc_EW, ! IN : number of processors East-West GPB0F402.15
& nproc_NS, ! IN : number of processors North-South GPB0F402.16
& local_row_len, ! OUT :number of E-W points of this process DECOMP1A.39
& local_n_rows ! OUT :number of rows of this process DECOMP1A.40
DECOMP1A.41
! Parameters and Common blocks DECOMP1A.42
DECOMP1A.43
*CALL PARVARS 
DECOMP1A.44
*CALL DECOMPTP GPB0F402.17
*CALL DECOMPDB GPB0F402.18
*CALL GCCOM GPB0F401.156
DECOMP1A.45
! Local variables DECOMP1A.46
INTEGER iproc,irest,jrest,info GPB0F402.19
&, in_atm_decomp GPB0F402.20
DECOMP1A.48
! ------------------------------------------------------------------ DECOMP1A.49
decomp_db_halosize(1,decomp_standard_atmos) = 1 GPB0F402.21
decomp_db_halosize(2,decomp_standard_atmos) = 1 GPB0F402.22
decomp_db_halosize(3,decomp_standard_atmos) = 0 GPB0F402.23
DECOMP1A.53
! ------------------------------------------------------------------ DECOMP1A.54
! 1.0 Set up global data size DECOMP1A.55
! ------------------------------------------------------------------ DECOMP1A.56
DECOMP1A.57
decomp_db_glsize(1,decomp_standard_atmos) = global_row_len GPB0F402.24
decomp_db_glsize(2,decomp_standard_atmos) = global_n_rows GPB0F402.25
decomp_db_glsize(3,decomp_standard_atmos) = tot_levels GPB0F402.26
DECOMP1A.61
! ------------------------------------------------------------------ DECOMP1A.62
! 2.0 Calculate decomposition DECOMP1A.63
! ------------------------------------------------------------------ DECOMP1A.64
DECOMP1A.65
GPB0F401.160
! select processors to use for the data decomposition GPB0F401.161
decomp_db_nproc(decomp_standard_atmos)=nproc_EW*nproc_NS GPB0F402.27
decomp_db_first_comp_pe(decomp_standard_atmos) = 0 GPB0F402.28
decomp_db_last_comp_pe(decomp_standard_atmos) = GPB0F402.29
& decomp_db_nproc(decomp_standard_atmos)-1 GPB0F402.30
GPB0F402.31
! Set the grid size DECOMP1A.66
DECOMP1A.67
decomp_db_gridsize(1,decomp_standard_atmos) = nproc_EW GPB0F402.32
decomp_db_gridsize(2,decomp_standard_atmos) = nproc_NS GPB0F402.33
decomp_db_gridsize(3,decomp_standard_atmos) = 1 GPB0F402.34
DECOMP1A.71
! Calculate the local data shape of each processor. DECOMP1A.72
DO iproc=decomp_db_first_comp_pe(decomp_standard_atmos), GPB0F402.35
& decomp_db_last_comp_pe(decomp_standard_atmos) GPB0F402.36
! ! Loop over all processors in this decomposition GPB0F402.37
DECOMP1A.74
decomp_db_g_gridpos(3,iproc,decomp_standard_atmos) = 0 GPB0F402.38
decomp_db_g_gridpos(2,iproc,decomp_standard_atmos) = GPB0F402.39
& iproc / decomp_db_gridsize(1,decomp_standard_atmos) GPB0F402.40
decomp_db_g_gridpos(1,iproc,decomp_standard_atmos) = GPB0F402.41
& iproc - decomp_db_g_gridpos(2,iproc,decomp_standard_atmos)* GPB0F402.42
& decomp_db_gridsize(1,decomp_standard_atmos) GPB0F402.43
DECOMP1A.78
! Find the number of grid points (blsizep) in each domain and starting DECOMP1A.79
! points in the global domain (datastart) We first try to divide DECOMP1A.80
! the total number equally among the processors. The rest is GPB0F401.164
! distributed one by one to first processor in each direction. DECOMP1A.82
DECOMP1A.83
! The X (East-West) direction: DECOMP1A.84
DECOMP1A.85
decomp_db_g_blsizep(1,iproc,decomp_standard_atmos) = GPB0F402.44
& decomp_db_glsize(1,decomp_standard_atmos) / GPB0F402.45
& decomp_db_gridsize(1,decomp_standard_atmos) GPB0F402.46
irest = decomp_db_glsize(1,decomp_standard_atmos)- GPB0F402.47
& decomp_db_g_blsizep(1,iproc,decomp_standard_atmos)* GPB0F402.48
& decomp_db_gridsize(1,decomp_standard_atmos) GPB0F402.49
decomp_db_g_datastart(1,iproc,decomp_standard_atmos) = GPB0F402.50
& decomp_db_g_gridpos(1,iproc,decomp_standard_atmos)* GPB0F402.51
& decomp_db_g_blsizep(1,iproc,decomp_standard_atmos) + 1 GPB0F402.52
GPB0F402.53
IF (decomp_db_g_gridpos(1,iproc,decomp_standard_atmos) .LT. GPB0F402.54
& irest) THEN GPB0F402.55
decomp_db_g_blsizep(1,iproc,decomp_standard_atmos) = GPB0F402.56
& decomp_db_g_blsizep(1,iproc,decomp_standard_atmos)+1 GPB0F402.57
decomp_db_g_datastart(1,iproc,decomp_standard_atmos) = GPB0F402.58
& decomp_db_g_datastart(1,iproc,decomp_standard_atmos) + GPB0F402.59
& decomp_db_g_gridpos(1,iproc,decomp_standard_atmos) GPB0F402.60
ELSE GPB0F402.61
decomp_db_g_datastart(1,iproc,decomp_standard_atmos) = GPB0F402.62
& decomp_db_g_datastart(1,iproc,decomp_standard_atmos) + GPB0F402.63
& irest GPB0F402.64
ENDIF GPB0F402.65
GPB0F402.66
decomp_db_g_lasize(1,iproc,decomp_standard_atmos)= GPB0F402.67
& decomp_db_g_blsizep(1,iproc,decomp_standard_atmos) + GPB0F402.68
& 2*decomp_db_halosize(1,decomp_standard_atmos) GPB0F402.69
DECOMP1A.96
! The Y (North-South) direction DECOMP1A.97
DECOMP1A.98
decomp_db_g_blsizep(2,iproc,decomp_standard_atmos) = GPB0F402.70
& decomp_db_glsize(2,decomp_standard_atmos) / GPB0F402.71
& decomp_db_gridsize(2,decomp_standard_atmos) GPB0F402.72
jrest = decomp_db_glsize(2,decomp_standard_atmos)- GPB0F402.73
& decomp_db_g_blsizep(2,iproc,decomp_standard_atmos)* GPB0F402.74
& decomp_db_gridsize(2,decomp_standard_atmos) GPB0F402.75
decomp_db_g_datastart(2,iproc,decomp_standard_atmos) = GPB0F402.76
& decomp_db_g_gridpos(2,iproc,decomp_standard_atmos)* GPB0F402.77
& decomp_db_g_blsizep(2,iproc,decomp_standard_atmos) + 1 GPB0F402.78
GPB0F402.79
IF (decomp_db_g_gridpos(2,iproc,decomp_standard_atmos) .LT. GPB0F402.80
& jrest) THEN GPB0F402.81
decomp_db_g_blsizep(2,iproc,decomp_standard_atmos) = GPB0F402.82
& decomp_db_g_blsizep(2,iproc,decomp_standard_atmos)+1 GPB0F402.83
decomp_db_g_datastart(2,iproc,decomp_standard_atmos) = GPB0F402.84
& decomp_db_g_datastart(2,iproc,decomp_standard_atmos) + GPB0F402.85
& decomp_db_g_gridpos(2,iproc,decomp_standard_atmos) GPB0F402.86
ELSE GPB0F402.87
decomp_db_g_datastart(2,iproc,decomp_standard_atmos) = GPB0F402.88
& decomp_db_g_datastart(2,iproc,decomp_standard_atmos) + GPB0F402.89
& jrest GPB0F402.90
ENDIF GPB0F402.91
GPB0F402.92
decomp_db_g_lasize(2,iproc,decomp_standard_atmos)= GPB0F402.93
& decomp_db_g_blsizep(2,iproc,decomp_standard_atmos) + GPB0F402.94
& 2*decomp_db_halosize(2,decomp_standard_atmos) GPB0F402.95
DECOMP1A.109
! The Z (vertical) direction (no decomposition): DECOMP1A.110
DECOMP1A.111
decomp_db_g_datastart(3,iproc,decomp_standard_atmos) = 1 GPB0F402.96
decomp_db_g_blsizep(3,iproc,decomp_standard_atmos) = GPB0F402.97
& tot_levels GPB0F402.98
decomp_db_g_lasize(3,iproc,decomp_standard_atmos) = GPB0F402.99
& tot_levels GPB0F402.100
DECOMP1A.115
! One less u row at the bottom DECOMP1A.116
DECOMP1A.117
decomp_db_g_blsizeu(1,iproc,decomp_standard_atmos) = GPB0F402.101
& decomp_db_g_blsizep(1,iproc,decomp_standard_atmos) GPB0F402.102
IF ( decomp_db_g_gridpos(2,iproc,decomp_standard_atmos) GPB0F402.103
& .EQ. (decomp_db_gridsize(2,decomp_standard_atmos)-1)) GPB0F402.104
& THEN GPB0F402.105
decomp_db_g_blsizeu(2,iproc,decomp_standard_atmos) = GPB0F402.106
& decomp_db_g_blsizep(2,iproc,decomp_standard_atmos) - 1 GPB0F402.107
ELSE GPB0F402.108
decomp_db_g_blsizeu(2,iproc,decomp_standard_atmos) = GPB0F402.109
& decomp_db_g_blsizep(2,iproc,decomp_standard_atmos) GPB0F402.110
ENDIF GPB0F402.111
decomp_db_g_blsizeu(3,iproc,decomp_standard_atmos) = GPB0F402.112
& decomp_db_g_blsizep(3,iproc,decomp_standard_atmos) GPB0F402.113
DECOMP1A.125
DECOMP1A.138
ENDDO ! loop over processors DECOMP1A.139
DECOMP1A.140
DECOMP1A.141
! ------------------------------------------------------------------ DECOMP1A.167
! 3.0 Set boundary conditions DECOMP1A.168
! ------------------------------------------------------------------ DECOMP1A.169
DECOMP1A.170
*IF DEF,GLOBAL DECOMP1A.171
decomp_db_bound(1,decomp_standard_atmos) = BC_CYCLIC GPB0F402.114
! ! Cyclic East-West boundaries GPB0F402.115
*ELSE DECOMP1A.173
decomp_db_bound(1,decomp_standard_atmos) = BC_CYCLIC GPB0F402.116
! ! No East-West wrap around GPB0F402.117
*ENDIF DECOMP1A.175
DECOMP1A.176
decomp_db_bound(2,decomp_standard_atmos) = BC_STATIC GPB0F402.118
! ! No North-South wrap around GPB0F402.119
decomp_db_bound(3,decomp_standard_atmos) = BC_STATIC GPB0F402.120
! ! No vertical wrap around GPB0F402.121
GPB0F402.122
CALL SET_NEIGHBOUR( GPB0F402.123
& decomp_standard_atmos) GPB0F402.124
DECOMP1A.181
! ------------------------------------------------------------------ DECOMP1A.182
! 4.0 Return the new data sizes and exit subroutine DECOMP1A.183
! ------------------------------------------------------------------ DECOMP1A.184
DECOMP1A.185
! Set up the GCOM groups: GPB0F402.125
GPB0F402.126
! 1) Group of all processors on my row GPB0F402.127
GPB0F402.128
IF ( decomp_db_gridsize(2,decomp_standard_atmos) .EQ. 1) GPB0F402.129
& THEN GPB0F402.130
decomp_db_gc_proc_row_group(decomp_standard_atmos)=GCG_ALL GPB0F402.131
ELSE GPB0F402.132
CALL GCG_SPLIT(mype,nproc_max, GPB0F402.133
& decomp_db_g_gridpos(2,mype,decomp_standard_atmos), GPB0F402.134
& info, GPB0F402.135
& decomp_db_gc_proc_row_group(decomp_standard_atmos)) GPB0F402.136
ENDIF GPB0F402.137
GPB0F402.138
! 2) Group of all processors on my column GPB0F402.139
GPB0F402.140
IF ( decomp_db_gridsize(1,decomp_standard_atmos) .EQ. 1) GPB0F402.141
& THEN GPB0F402.142
decomp_db_gc_proc_col_group(decomp_standard_atmos)=GCG_ALL GPB0F402.143
ELSE GPB0F402.144
CALL GCG_SPLIT(mype,nproc_max, GPB0F402.145
& decomp_db_g_gridpos(1,mype,decomp_standard_atmos), GPB0F402.146
& info, GPB0F402.147
& decomp_db_gc_proc_col_group(decomp_standard_atmos)) GPB0F402.148
ENDIF GPB0F402.149
GPB0F402.150
! 3) Group of all processors in the atmosphere model GPB0F402.151
IF (decomp_db_nproc(decomp_standard_atmos) .EQ. nproc_max) GPB0F402.152
& THEN GPB0F402.153
decomp_db_gc_all_proc_group(decomp_standard_atmos)=GCG_ALL GPB0F402.154
ELSE GPB0F402.155
IF ((mype .GE. decomp_db_first_comp_pe(decomp_standard_atmos)) GPB0F402.156
& .AND. GPB0F402.157
& (mype .LE. decomp_db_last_comp_pe(decomp_standard_atmos)) ) GPB0F402.158
& THEN GPB0F402.159
in_atm_decomp=1 GPB0F402.160
ELSE GPB0F402.161
in_atm_decomp=0 GPB0F402.162
ENDIF GPB0F402.163
GPB0F402.164
CALL GCG_SPLIT(mype,nproc_max,in_atm_decomp,info, GPB0F402.165
& decomp_db_gc_all_proc_group(decomp_standard_atmos)) GPB0F402.166
ENDIF GPB0F402.167
GPB0F402.168
! Set logical indicating this decomposition has been initialised GPB0F402.169
! and is now ready for use GPB0F402.170
GPB0F402.171
decomp_db_set(decomp_standard_atmos)=.TRUE. GPB0F402.172
GPB0F402.173
! And return the new horizontal dimensions GPB0F402.174
GPB0F402.175
local_row_len=decomp_db_g_lasize(1,mype,decomp_standard_atmos) GPB0F402.176
local_n_rows=decomp_db_g_lasize(2,mype,decomp_standard_atmos) GPB0F402.177
DECOMP1A.198
RETURN DECOMP1A.199
DECOMP1A.200
END DECOMP1A.201
DECOMP1A.202
*ENDIF DECOMP1A.203
*ENDIF GPB3F403.238