SUBROUTINE MPP_MERGEFLD(ROW_LENGTH,ROWS, 8MPPMFL1A.23
& LENRIM,RIMWIDTH,RIMWEIGHTS, MPPMFL1A.24
& FLD_TYPE,RIM,FIELD) MPPMFL1A.25
IMPLICIT NONE MPPMFL1A.26
! MPPMFL1A.27
! Description: MPPMFL1A.28
! Merges Lateral Boundary Conditions (LBCs) with full field data MPPMFL1A.29
! (This is an MPP version of the MERGEFLD routine, upon which MPPMFL1A.30
! this code is based) MPPMFL1A.31
! MPPMFL1A.32
! Method: MPPMFL1A.33
! Each boundary is treated seperately. If this processor MPPMFL1A.34
! lies on a particular boundary, the relevant part of that MPPMFL1A.35
! LBC is merged into the data held on the processor, using MPPMFL1A.36
! the weighting factor RIMWEIGHTS. MPPMFL1A.37
! The appropriate element of the RIMWEIGHTS array is shown MPPMFL1A.38
! in the diagram below (which assumes RIMWIDTH=4). Take MPPMFL1A.39
! note of what happens at the corners! It also shows the MPPMFL1A.40
! structure of the LBC arrays: Northern, Eastern, Southern MPPMFL1A.41
! and Western Boundaries. MPPMFL1A.42
! MPPMFL1A.43
! 1 1 1 1 1 1 1 1 1 1 1 1 MPPMFL1A.44
! Northern --> 1 2 2 2 2 2 2 2 2 2 2 1 MPPMFL1A.45
! Boundary 1 2 3 3 3 3 3 3 3 3 2 1 MPPMFL1A.46
! 1 2 3 4 4 4 4 4 4 3 2 1 MPPMFL1A.47
! ------------------------- MPPMFL1A.48
! 1 2 3 4 . . . . 4 3 2 1 MPPMFL1A.49
! Western ---> 1 2 3 4 . . . . 4 3 2 1 <-- Eastern MPPMFL1A.50
! Boundary 1 2 3 4 . . . . 4 3 2 1 Boundary MPPMFL1A.51
! 1 2 3 4 . . . . 4 3 2 1 MPPMFL1A.52
! ------------------------- MPPMFL1A.53
! 1 2 3 4 4 4 4 4 4 3 2 1 MPPMFL1A.54
! Southern --> 1 2 3 3 3 3 3 3 3 3 2 1 MPPMFL1A.55
! Boundary 1 2 2 2 2 2 2 2 2 2 2 1 MPPMFL1A.56
! 1 1 1 1 1 1 1 1 1 1 1 1 MPPMFL1A.57
! MPPMFL1A.58
! IMPORTANT NOTE: MPPMFL1A.59
! This routine assumes that the rim fits entirely onto the MPPMFL1A.60
! processors at the edge of the LPG. If the rim overlaps MPPMFL1A.61
! into processors inside the LPG then this code will not MPPMFL1A.62
! work. MPPMFL1A.63
! MPPMFL1A.64
! Current code owner : Paul Burton MPPMFL1A.65
! MPPMFL1A.66
! History MPPMFL1A.67
! Model Date Modification history from model version 4.1 MPPMFL1A.68
! version MPPMFL1A.69
! 4.1 16/1/96 New Deck for MPP code P.Burton MPPMFL1A.70
! MPPMFL1A.71
! Subroutine Arguments: MPPMFL1A.72
MPPMFL1A.73
INTEGER MPPMFL1A.74
& ROW_LENGTH ! IN length of local rows (inc. MPP halos) MPPMFL1A.75
&, ROWS ! IN number of local rows (inc. MPP halos) MPPMFL1A.76
&, LENRIM ! IN length of local LBC data MPPMFL1A.77
&, RIMWIDTH ! IN width of boundary zone MPPMFL1A.78
&, FLD_TYPE ! IN indicates type of field (P or U) MPPMFL1A.79
MPPMFL1A.80
REAL MPPMFL1A.81
& RIMWEIGHTS(RIMWIDTH) ! IN weights to be given to boundary MPPMFL1A.82
! ! zone values MPPMFL1A.83
&, RIM(LENRIM) ! IN boundary data to merge MPPMFL1A.84
&, FIELD(ROW_LENGTH*ROWS) ! INOUT field to merge boundary data MPPMFL1A.85
! ! into MPPMFL1A.86
MPPMFL1A.87
! Parameters and COMMON MPPMFL1A.88
*CALL PARVARS 
MPPMFL1A.89
MPPMFL1A.90
! Local variables MPPMFL1A.91
MPPMFL1A.92
INTEGER MPPMFL1A.93
& I ! loop index East-West : NB I and J take no account MPPMFL1A.94
&, J ! loop index North-South : of the MPP halos MPPMFL1A.95
&, IRIM ! position in RIM data array MPPMFL1A.96
&, IFLD ! position in FIELD data array MPPMFL1A.97
&, LBC_ROW_LEN ! length of rows in LBC array MPPMFL1A.98
&, EW_START_ROW ! row to start merging in LBCs at : east/west MPPMFL1A.99
&, EW_END_ROW ! row to end merging in LBCs at : boundaries MPPMFL1A.100
&, S_START_ROW ! row to start memrging in LBCs at : southern MPPMFL1A.101
&, S_END_ROW ! row to end merging in LBCs at : boundary MPPMFL1A.102
MPPMFL1A.103
REAL MPPMFL1A.104
& RWT ! rimweight of point being processed MPPMFL1A.105
MPPMFL1A.106
! 0.0 Calculate the length of the LBC rows, and where to start and MPPMFL1A.107
! end merging in the side LBC rows, and the southern LBC rows MPPMFL1A.108
MPPMFL1A.109
LBC_ROW_LEN=ROW_LENGTH-2*Offx MPPMFL1A.110
! For most cases the length of the LBC row is just the MPPMFL1A.111
! processor's row length minus the two MPP halos. MPPMFL1A.112
! However, for U fields, the last point on each global row MPPMFL1A.113
! is dropped in the LBC field: MPPMFL1A.114
IF ((FLD_TYPE .EQ. fld_type_u) .AND. (atright)) MPPMFL1A.115
& LBC_ROW_LEN=LBC_ROW_LEN-1 MPPMFL1A.116
MPPMFL1A.117
EW_START_ROW=Offy+1 MPPMFL1A.118
EW_END_ROW=ROWS-Offy MPPMFL1A.119
! This is a first-guess. If the processor is at the top or MPPMFL1A.120
! bottom of the grid, it starts getting more complicated... MPPMFL1A.121
MPPMFL1A.122
IF (attop) THEN MPPMFL1A.123
! At the top of the grid, the first RIMWIDTH rows are MPPMFL1A.124
! dealt with at the Northern boundary MPPMFL1A.125
EW_START_ROW=EW_START_ROW+RIMWIDTH MPPMFL1A.126
ENDIF MPPMFL1A.127
MPPMFL1A.128
IF (atbase) THEN MPPMFL1A.129
! At the bottom of the grid, the last RIMWIDTH rows are MPPMFL1A.130
! dealt with at the Southern boundary MPPMFL1A.131
EW_END_ROW=EW_END_ROW-RIMWIDTH MPPMFL1A.132
MPPMFL1A.133
! If we're at the base then we need to know where to MPPMFL1A.134
! apply the Southern boundary rows MPPMFL1A.135
S_START_ROW=ROWS-Offy-RIMWIDTH+1 MPPMFL1A.136
MPPMFL1A.137
IF (FLD_TYPE .EQ. fld_type_u) THEN MPPMFL1A.138
! For U fields we loose a row at the bottom of the MPPMFL1A.139
! global grid MPPMFL1A.140
EW_END_ROW=EW_END_ROW-1 MPPMFL1A.141
S_START_ROW=S_START_ROW-1 MPPMFL1A.142
ENDIF MPPMFL1A.143
S_END_ROW=S_START_ROW+RIMWIDTH-1 MPPMFL1A.144
ENDIF MPPMFL1A.145
MPPMFL1A.146
MPPMFL1A.147
! 1.0 Merge Northern Boundary MPPMFL1A.148
MPPMFL1A.149
IRIM=1 MPPMFL1A.150
IF (attop) THEN ! if this processor at Northern boundary MPPMFL1A.151
MPPMFL1A.152
DO J=1,RIMWIDTH MPPMFL1A.153
DO I=1,LBC_ROW_LEN MPPMFL1A.154
MPPMFL1A.155
IFLD=I+Offx+(J+Offy-1)*ROW_LENGTH ! point in FIELD MPPMFL1A.156
MPPMFL1A.157
RWT=RIMWEIGHTS(J) ! simplistic first guess at RIMWEIGHT MPPMFL1A.158
! ! If we are at a corner it starts to MPPMFL1A.159
! ! get a bit more involved..... MPPMFL1A.160
IF ((atleft) .AND. (I .LT. RIMWIDTH)) THEN MPPMFL1A.161
! This is a left hand corner MPPMFL1A.162
RWT=RIMWEIGHTS(MIN(I,J)) MPPMFL1A.163
ELSEIF ((atright) .AND. MPPMFL1A.164
& (I .GT. LBC_ROW_LEN-RIMWIDTH)) THEN MPPMFL1A.165
! This is a right hand corner MPPMFL1A.166
RWT=RIMWEIGHTS(MIN(LBC_ROW_LEN-I+1,J)) MPPMFL1A.167
ENDIF MPPMFL1A.168
MPPMFL1A.169
FIELD(IFLD)=RIM(IRIM)*RWT + FIELD(IFLD)*(1.0-RWT) MPPMFL1A.170
MPPMFL1A.171
IRIM=IRIM+1 MPPMFL1A.172
MPPMFL1A.173
ENDDO ! I loop over points along row MPPMFL1A.174
ENDDO ! J loop over rows in boundary area MPPMFL1A.175
MPPMFL1A.176
ENDIF ! If I'm a processor at the Northern boundary area MPPMFL1A.177
MPPMFL1A.178
IRIM=LBC_ROW_LEN*RIMWIDTH+1 MPPMFL1A.179
MPPMFL1A.180
! 2.0 Merge Eastern Boundary MPPMFL1A.181
MPPMFL1A.182
IF (atright) THEN ! if this processor at Eastern boundary MPPMFL1A.183
MPPMFL1A.184
DO J=EW_START_ROW,EW_END_ROW MPPMFL1A.185
DO I=1,RIMWIDTH MPPMFL1A.186
MPPMFL1A.187
IFLD=I+Offx+LBC_ROW_LEN-RIMWIDTH+(J-1)*ROW_LENGTH MPPMFL1A.188
MPPMFL1A.189
RWT=RIMWEIGHTS(RIMWIDTH+1-I) MPPMFL1A.190
MPPMFL1A.191
FIELD(IFLD)=RIM(IRIM)*RWT + FIELD(IFLD)*(1.0-RWT) MPPMFL1A.192
MPPMFL1A.193
IRIM=IRIM+1 MPPMFL1A.194
MPPMFL1A.195
ENDDO ! I loop over points along rim MPPMFL1A.196
ENDDO ! J loop over rows in boundary area MPPMFL1A.197
MPPMFL1A.198
ENDIF ! If I'm a processor at the Eastern boundary area MPPMFL1A.199
MPPMFL1A.200
IRIM=LBC_ROW_LEN*RIMWIDTH + (ROWS-2*Offy)*RIMWIDTH + 1 MPPMFL1A.201
MPPMFL1A.202
! 3.0 Merge Southern Boundary MPPMFL1A.203
MPPMFL1A.204
IF (atbase) THEN ! if this processor at Southern boundary MPPMFL1A.205
MPPMFL1A.206
DO J=S_START_ROW,S_END_ROW MPPMFL1A.207
DO I=1,LBC_ROW_LEN MPPMFL1A.208
MPPMFL1A.209
IFLD=I+Offx+(J-1)*ROW_LENGTH ! point in FIELD MPPMFL1A.210
MPPMFL1A.211
! RWT=RIMWEIGHTS(J+1-S_START_ROW) MPPMFL1A.212
RWT=RIMWEIGHTS(RIMWIDTH-(J-S_START_ROW)) MPPMFL1A.213
MPPMFL1A.214
! And now the special case of the corners... MPPMFL1A.215
IF ((atleft) .AND. (I .LT. RIMWIDTH)) THEN MPPMFL1A.216
! This is a left hand corner MPPMFL1A.217
RWT=RIMWEIGHTS(MIN(I,RIMWIDTH-(J-S_START_ROW))) MPPMFL1A.218
ELSEIF ((atright) .AND. MPPMFL1A.219
& (I .GT. LBC_ROW_LEN-RIMWIDTH)) THEN MPPMFL1A.220
! This is a right hand corner MPPMFL1A.221
RWT=RIMWEIGHTS(MIN(LBC_ROW_LEN-I+1, MPPMFL1A.222
& RIMWIDTH-(J-S_START_ROW))) MPPMFL1A.223
ENDIF MPPMFL1A.224
MPPMFL1A.225
FIELD(IFLD)=RIM(IRIM)*RWT + FIELD(IFLD)*(1.0-RWT) MPPMFL1A.226
MPPMFL1A.227
IRIM=IRIM+1 MPPMFL1A.228
ENDDO ! I loop over points along row MPPMFL1A.229
ENDDO ! J loop over rows in boundary area MPPMFL1A.230
MPPMFL1A.231
ENDIF ! If I'm a processor at the Southern boundary area MPPMFL1A.232
MPPMFL1A.233
IRIM=2*LBC_ROW_LEN*RIMWIDTH + (ROWS-2*Offy)*RIMWIDTH + 1 MPPMFL1A.234
MPPMFL1A.235
! 4.0 Merge Western Boundary MPPMFL1A.236
MPPMFL1A.237
IF (atleft) THEN ! if this processor at Western boundary MPPMFL1A.238
MPPMFL1A.239
DO J=EW_START_ROW,EW_END_ROW MPPMFL1A.240
DO I=1,RIMWIDTH MPPMFL1A.241
MPPMFL1A.242
IFLD=I+Offx+(J-1)*ROW_LENGTH MPPMFL1A.243
MPPMFL1A.244
RWT=RIMWEIGHTS(I) MPPMFL1A.245
MPPMFL1A.246
FIELD(IFLD)=RIM(IRIM)*RWT + FIELD(IFLD)*(1.0-RWT) MPPMFL1A.247
MPPMFL1A.248
IRIM=IRIM+1 MPPMFL1A.249
MPPMFL1A.250
ENDDO ! I loop over points along rim MPPMFL1A.251
ENDDO ! J loop over rows in boundary area MPPMFL1A.252
MPPMFL1A.253
ENDIF ! If I'm a processor at the Western boundary area MPPMFL1A.254
MPPMFL1A.255
MPPMFL1A.256
RETURN MPPMFL1A.257
MPPMFL1A.258
END MPPMFL1A.259
*ENDIF MPPMFL1A.260
*ENDIF GPB3F403.283