subroutine o_lbc_frs(ncols,nrows,n_cols_bdy,n_rows_bdy, 1OLBCFRS1.23
& levn, d1_field, f_type, OLBCFRS1.24
& levels_dataset,rimwidth,rimweights, OLBCFRS1.25
& l_obdy_north,l_obdy_east,l_obdy_south,l_obdy_west, OLBCFRS1.26
& bdy_n, bdy_e, bdy_s, bdy_w, OLBCFRS1.27
& l_apply_lsm, land_val, icode, cmessage) OLBCFRS1.28
OLBCFRS1.29
implicit none OLBCFRS1.30
!--------------------------------------------------------------------- OLBCFRS1.31
! Program: o_lbc_frs OLBCFRS1.32
! OLBCFRS1.33
! Purpose: This routine creates open north/east/south/west OLBCFRS1.34
! boundaries using the Flow Relaxation Scheme (FRS). OLBCFRS1.35
! This is the scheme which is presently used in the OLBCFRS1.36
! atmosphere LAM's and is based on the subroutine OLBCFRS1.37
! mergefld called from boundval. OLBCFRS1.38
! OLBCFRS1.39
! Author: Mike Bell OLBCFRS1.40
! OLBCFRS1.41
! History OLBCFRS1.42
! Model Date Modification history from model version 4.5 OLBCFRS1.43
! version OLBCFRS1.44
! 4.5 07/07/98 New subroutine/deck. M.Bell,S.Ineson OLBCFRS1.45
! OLBCFRS1.46
!-------------------------------------------------------------------- OLBCFRS1.47
! Subroutine Arguments: OLBCFRS1.48
OLBCFRS1.49
integer ncols ! IN number of columns (on tracer grid) OLBCFRS1.50
integer nrows ! IN number of rows OLBCFRS1.51
integer n_cols_bdy ! IN number of cols in boundary data OLBCFRS1.52
integer n_rows_bdy ! IN number of rows in boundary data OLBCFRS1.53
integer levn ! IN present level number OLBCFRS1.54
OLBCFRS1.55
real d1_field(ncols*nrows) ! IN/OUT section of the D1 array to OLBCFRS1.56
! be updated OLBCFRS1.57
OLBCFRS1.58
integer f_type ! IN: field type indicator OLBCFRS1.59
real levels_dataset(ncols,nrows) ! IN levels dataset for this OLBCFRS1.60
! field type OLBCFRS1.61
OLBCFRS1.62
integer rimwidth ! IN width of rim to update(max 4) OLBCFRS1.63
real rimweights(rimwidth) ! IN rim weights for each row OLBCFRS1.64
OLBCFRS1.65
logical l_obdy_north ! IN T=> update north lateral bdy OLBCFRS1.66
logical l_obdy_east ! IN T=> update east lateral bdy OLBCFRS1.67
logical l_obdy_south ! IN T=> update south lateral bdy OLBCFRS1.68
logical l_obdy_west ! IN T=> update west lateral bdy OLBCFRS1.69
OLBCFRS1.70
real bdy_n(n_cols_bdy*rimwidth) ! IN north part of boundary data OLBCFRS1.71
real bdy_e(n_rows_bdy*rimwidth) ! IN east part of boundary data OLBCFRS1.72
real bdy_s(n_cols_bdy*rimwidth) ! IN south part of boundary data OLBCFRS1.73
real bdy_w(n_rows_bdy*rimwidth) ! IN west part of boundary data OLBCFRS1.74
OLBCFRS1.75
logical l_apply_lsm ! IN: T => apply lsm at boundaries OLBCFRS1.76
real land_val ! IN value to use for fields at land points OLBCFRS1.77
OLBCFRS1.78
integer icode ! OUT Return code OLBCFRS1.79
character*(80) cmessage ! OUT Error message OLBCFRS1.80
CL-------------------------------------------------------------------- OLBCFRS1.81
OLBCFRS1.82
CL Global variables OLBCFRS1.83
*CALL PARVARS 
OLBCFRS1.84
*IF -DEF,MPP OLBCFRS1.85
OLBCFRS1.86
INTEGER OLBCFRS1.87
& fld_type_p ! indicates a grid on P points OLBCFRS1.88
&, fld_type_u ! indicates a grid on U points OLBCFRS1.89
&, fld_type_unknown ! indicates a non-standard grid. OLBCFRS1.90
PARAMETER ( OLBCFRS1.91
& fld_type_p=1 OLBCFRS1.92
&, fld_type_u=2 OLBCFRS1.93
&, fld_type_unknown=-1) OLBCFRS1.94
OLBCFRS1.95
integer Offx, Offy OLBCFRS1.96
logical atright, atleft, atbase, attop OLBCFRS1.97
*ENDIF OLBCFRS1.98
OLBCFRS1.99
C Local scalars OLBCFRS1.100
OLBCFRS1.101
integer i ! loop over columns OLBCFRS1.102
integer j ! loop over rows OLBCFRS1.103
integer irim ! pointer to position in bdy data arrays OLBCFRS1.104
integer ifld ! pointer to position in field to update OLBCFRS1.105
real rwt ! rimweight for present boundary pt OLBCFRS1.106
OLBCFRS1.107
integer row_start ! start row (not counting offsets) for E & W OLBCFRS1.108
integer row_end ! end row (not counting offsets) for E & W bdys OLBCFRS1.109
integer irim_start ! initial value of irim for E and W bdys - OLBCFRS1.110
! depends on value of l_obdy_south. OLBCFRS1.111
OLBCFRS1.112
C---------------------------------------------------------------------- OLBCFRS1.113
CL 0.0 Set grid off-sets and indicators showing if domain lies next to OLBCFRS1.114
CL each model boundary; non-mpp settings for offsets are zero and OLBCFRS1.115
CL for boundary indicators are true. This allows the same code OLBCFRS1.116
CL to be used for MPP and non-MPP cases. OLBCFRS1.117
CL OLBCFRS1.118
OLBCFRS1.119
*IF -DEF,MPP OLBCFRS1.120
Offx = 0 OLBCFRS1.121
Offy = 0 OLBCFRS1.122
atright = .true. OLBCFRS1.123
atleft = .true. OLBCFRS1.124
atbase = .true. OLBCFRS1.125
attop = .true. OLBCFRS1.126
*ENDIF OLBCFRS1.127
OLBCFRS1.128
CL 0.1 Set row_start and row_end and irim_start OLBCFRS1.129
OLBCFRS1.130
if ( atright .and. l_obdy_east .or. OLBCFRS1.131
# atleft .and. l_obdy_west) then OLBCFRS1.132
OLBCFRS1.133
row_start = 1 OLBCFRS1.134
irim_start=1 OLBCFRS1.135
if (attop .and. l_obdy_south) then OLBCFRS1.136
row_start = rimwidth + 1 OLBCFRS1.137
irim_start = rimwidth * rimwidth + 1 OLBCFRS1.138
endif OLBCFRS1.139
OLBCFRS1.140
row_end = n_rows_bdy ! first guess ! OLBCFRS1.141
if (atbase .and. l_obdy_north) then OLBCFRS1.142
row_end = n_rows_bdy - rimwidth OLBCFRS1.143
else if ( atbase .and. .not. l_obdy_north .and. OLBCFRS1.144
# f_type .eq. fld_type_u ) then OLBCFRS1.145
row_end = n_rows_bdy - 1 OLBCFRS1.146
end if OLBCFRS1.147
OLBCFRS1.148
end if ! if east or west boundaries to update OLBCFRS1.149
OLBCFRS1.150
OLBCFRS1.151
CL 1.1 Northern boundary: set all points including those in corners at OLBCFRS1.152
CL east or west boundaries OLBCFRS1.153
OLBCFRS1.154
if ( l_obdy_north .and. atbase ) then OLBCFRS1.155
OLBCFRS1.156
irim = 1 OLBCFRS1.157
OLBCFRS1.158
do j = n_rows_bdy-rimwidth+1,n_rows_bdy OLBCFRS1.159
do i = 1, n_cols_bdy OLBCFRS1.160
OLBCFRS1.161
! note: ncols IS the number of columns of data stored for all cases OLBCFRS1.162
ifld = i + Offx + (j+Offy-1)*ncols OLBCFRS1.163
OLBCFRS1.164
rwt = rimweights(n_rows_bdy+1-j) ! first guess OLBCFRS1.165
OLBCFRS1.166
! rim weights are reduced in the corners OLBCFRS1.167
if (atleft .and. i .lt. n_rows_bdy+1-j) then OLBCFRS1.168
rwt = rimweights(i) OLBCFRS1.169
else if ( atright .and. OLBCFRS1.170
# i .gt. n_cols_bdy - n_rows_bdy + j ) then OLBCFRS1.171
rwt = rimweights(n_cols_bdy + 1 - i) OLBCFRS1.172
end if OLBCFRS1.173
OLBCFRS1.174
d1_field(ifld) = bdy_n(irim)*rwt + OLBCFRS1.175
& d1_field(ifld)*(1.0-rwt) OLBCFRS1.176
OLBCFRS1.177
if (l_apply_lsm .and. levels_dataset(i,j) .lt. levn) then OLBCFRS1.178
d1_field(ifld) = land_val OLBCFRS1.179
endif OLBCFRS1.180
OLBCFRS1.181
irim=irim+1 OLBCFRS1.182
OLBCFRS1.183
enddo ! i OLBCFRS1.184
enddo ! j OLBCFRS1.185
OLBCFRS1.186
endif ! northern boundary OLBCFRS1.187
OLBCFRS1.188
CL 1.2 Southern boundary: as for northern boundary OLBCFRS1.189
OLBCFRS1.190
OLBCFRS1.191
if (l_obdy_south .and. attop ) then OLBCFRS1.192
OLBCFRS1.193
irim=1 OLBCFRS1.194
OLBCFRS1.195
do j = 1,rimwidth OLBCFRS1.196
do i = 1, n_cols_bdy OLBCFRS1.197
OLBCFRS1.198
ifld = i + Offx + (j+Offy-1)*ncols OLBCFRS1.199
OLBCFRS1.200
rwt = rimweights(j) OLBCFRS1.201
OLBCFRS1.202
if (atleft .and. i .lt. j) then OLBCFRS1.203
rwt = rimweights(i) OLBCFRS1.204
else if (atright .and. OLBCFRS1.205
# i .gt. n_cols_bdy + 1 - j ) then OLBCFRS1.206
rwt = rimweights(n_cols_bdy + 1 - i) OLBCFRS1.207
endif OLBCFRS1.208
OLBCFRS1.209
d1_field(ifld) = bdy_s(irim)*rwt + OLBCFRS1.210
& d1_field(ifld)*(1.0-rwt) OLBCFRS1.211
OLBCFRS1.212
if (l_apply_lsm .and. levels_dataset(i,j) .lt. levn) then OLBCFRS1.213
d1_field(ifld) = land_val OLBCFRS1.214
endif OLBCFRS1.215
OLBCFRS1.216
irim=irim+1 OLBCFRS1.217
OLBCFRS1.218
enddo ! i OLBCFRS1.219
enddo ! j OLBCFRS1.220
endif ! southern boundary OLBCFRS1.221
OLBCFRS1.222
CL 1.3 Eastern boundary: does not calculate values for corner points OLBCFRS1.223
CL if they have already been set. OLBCFRS1.224
OLBCFRS1.225
if (atright .and. l_obdy_east) then OLBCFRS1.226
OLBCFRS1.227
irim = irim_start OLBCFRS1.228
OLBCFRS1.229
do j = row_start,row_end OLBCFRS1.230
OLBCFRS1.231
do i = n_cols_bdy - rimwidth + 1, n_cols_bdy OLBCFRS1.232
OLBCFRS1.233
ifld = i + Offx + (j+Offy-1)*ncols OLBCFRS1.234
rwt = rimweights(n_cols_bdy+1-i) OLBCFRS1.235
OLBCFRS1.236
d1_field(ifld) = bdy_e(irim)*rwt+ d1_field(ifld)*(1.0-rwt) OLBCFRS1.237
OLBCFRS1.238
if (l_apply_lsm .and. levels_dataset(i,j) .lt. levn) then OLBCFRS1.239
d1_field(ifld) = land_val OLBCFRS1.240
endif OLBCFRS1.241
OLBCFRS1.242
irim=irim+1 OLBCFRS1.243
OLBCFRS1.244
enddo OLBCFRS1.245
enddo OLBCFRS1.246
OLBCFRS1.247
endif OLBCFRS1.248
OLBCFRS1.249
C 1.4 Western boundary: same as for eastern boundary OLBCFRS1.250
OLBCFRS1.251
if (atleft .and.l_obdy_west) then OLBCFRS1.252
OLBCFRS1.253
irim = irim_start OLBCFRS1.254
OLBCFRS1.255
do j = row_start,row_end OLBCFRS1.256
OLBCFRS1.257
do i = 1,rimwidth OLBCFRS1.258
OLBCFRS1.259
ifld = i + Offx + (j+Offy-1)*ncols OLBCFRS1.260
rwt = rimweights(i) OLBCFRS1.261
OLBCFRS1.262
d1_field(ifld) = bdy_w(irim)*rwt+ d1_field(ifld)*(1.0-rwt) OLBCFRS1.263
OLBCFRS1.264
if (l_apply_lsm .and. levels_dataset(i,j) .lt. levn) then OLBCFRS1.265
d1_field(i+((j-1)*ncols)) = land_val OLBCFRS1.266
endif OLBCFRS1.267
OLBCFRS1.268
irim=irim+1 OLBCFRS1.269
OLBCFRS1.270
enddo ! i OLBCFRS1.271
enddo ! j OLBCFRS1.272
OLBCFRS1.273
endif ! western boundary OLBCFRS1.274
OLBCFRS1.275
return OLBCFRS1.276
OLBCFRS1.277
end OLBCFRS1.278
*ENDIF OLBCFRS1.279