*IF DEF,OCEAN OSETBDS.2
C *****************************COPYRIGHT****************************** OSETBDS.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. OSETBDS.4
C OSETBDS.5
C Use, duplication or disclosure of this code is subject to the OSETBDS.6
C restrictions as set forth in the contract. OSETBDS.7
C OSETBDS.8
C Meteorological Office OSETBDS.9
C London Road OSETBDS.10
C BRACKNELL OSETBDS.11
C Berkshire UK OSETBDS.12
C RG12 2SZ OSETBDS.13
C OSETBDS.14
C If no contract has been raised with this copy of the code, the use, OSETBDS.15
C duplication or disclosure of it is strictly prohibited. Permission OSETBDS.16
C to do so must first be obtained in writing from the Head of Numerical OSETBDS.17
C Modelling at the above address. OSETBDS.18
C ******************************COPYRIGHT****************************** OSETBDS.19
!+ Updates ocean boundary values with chosen scheme OSETBDS.20
! OSETBDS.21
subroutine o_set_bound(ncols,nrows,nlevs,levn, 8,2OSETBDS.22
& LENRIMO, RIMWIDTHO,RIMWEIGHTSO, OSETBDS.23
& DTEMP_BOUND, OSETBDS.24
& levels_dataset, xgrid, ygrid, OSETBDS.25
& f_type, land_val, l_apply_lsm, OSETBDS.26
& lseg,isz,iez, OSETBDS.27
& d1_field, OSETBDS.28
& icode,cmessage) OSETBDS.29
OSETBDS.30
implicit none OSETBDS.31
OSETBDS.32
! Purpose: Called from BOUNDVOL to update the boundary values OSETBDS.33
! with users chosen scheme. Called every field type OSETBDS.34
! that needs updating. OSETBDS.35
! Calculates the north/east/south/west boundary OSETBDS.36
! pointers. OSETBDS.37
! Author : Catherine Jones OSETBDS.38
! OSETBDS.39
! History OSETBDS.40
! Model Date Modification history from model version 4.5 OSETBDS.41
! version OSETBDS.42
! 4.5 21/07/98 New Subroutine/deck M.Bell/S.Ineson OSETBDS.43
! OSETBDS.44
! OSETBDS.45
! Global variables: OSETBDS.46
OSETBDS.47
*CALL CNTLOCN
OSETBDS.48
*IF DEF,MPP OSETBDS.49
*CALL PARVARS
OSETBDS.50
*ELSE OSETBDS.51
INTEGER OSETBDS.52
& fld_type_p ! indicates a grid on P points OSETBDS.53
&, fld_type_u ! indicates a grid on U points OSETBDS.54
&, fld_type_unknown ! indicates a non-standard grid. OSETBDS.55
PARAMETER ( OSETBDS.56
& fld_type_p=1 OSETBDS.57
&, fld_type_u=2 OSETBDS.58
&, fld_type_unknown=-1) OSETBDS.59
OSETBDS.60
integer Offx, Offy OSETBDS.61
logical atright, atleft, atbase, attop OSETBDS.62
*ENDIF OSETBDS.63
OSETBDS.64
! Subroutine Arguments: OSETBDS.65
OSETBDS.66
integer ncols ! IN: number of columns (for tracers) = IMT OSETBDS.67
integer nrows ! IN: number of rows (for tracers) = JMT OSETBDS.68
integer nlevs ! IN: number of levels (for this field) = KM OSETBDS.69
integer levn ! IN: current level number OSETBDS.70
OSETBDS.71
OSETBDS.72
integer LENRIMO ! IN: max length of a rim field OSETBDS.73
integer RIMWIDTHO ! IN: width of rim field OSETBDS.74
real RIMWEIGHTSO(RIMWIDTHO) ! IN: rim weights OSETBDS.75
OSETBDS.76
real DTEMP_BOUND(LENRIMO) ! IN : temporary array containing OSETBDS.77
! boundary info (max size) OSETBDS.78
OSETBDS.79
real levels_dataset(ncols,nrows) ! IN: levels dataset for this OSETBDS.80
! field type OSETBDS.81
real xgrid(ncols) ! IN: grid spacing along row OSETBDS.82
real ygrid(nrows) ! IN: grid spacing along columns OSETBDS.83
OSETBDS.84
integer f_type ! IN: field type indicator OSETBDS.85
integer land_val ! IN: value to set in field at land points OSETBDS.86
logical l_apply_lsm ! IN: T => apply lsm at boundaries OSETBDS.87
OSETBDS.88
integer lseg ! IN max number of segments on a row OSETBDS.89
integer isz(nrows,lseg) ! IN ztd segment start indices OSETBDS.90
integer iez(nrows,lseg) ! IN ztd segment end indices OSETBDS.91
OSETBDS.92
real d1_field(ncols*nrows) ! IN/OUT: section of the D1 array OSETBDS.93
! updated OSETBDS.94
OSETBDS.95
integer icode ! Return code OSETBDS.96
character*(80) cmessage ! Error message OSETBDS.97
OSETBDS.98
! Local scalars OSETBDS.99
OSETBDS.100
integer n_cols_bdy ! # columns in boundary data (on this proc.) OSETBDS.101
integer n_rows_bdy ! # rows in boundary data (on this proc.) OSETBDS.102
OSETBDS.103
integer ptr_bdy_n ! pointer to start of north boundary data OSETBDS.104
integer ptr_bdy_e ! pointer to start of east boundary data OSETBDS.105
integer ptr_bdy_s ! pointer to start of south boundary data OSETBDS.106
integer ptr_bdy_w ! pointer to start of west boundary data OSETBDS.107
OSETBDS.108
integer bdy_ptr ! counter for start of boundary data OSETBDS.109
OSETBDS.110
C -------------------------------------------------------------------- OSETBDS.111
CL 0.0 Set grid off-sets and indicators showing if domain lies next to OSETBDS.112
CL each model boundary; non-mpp settings for offsets are zero and OSETBDS.113
CL for boundary indicators are true. This allows the same code OSETBDS.114
CL to be used for MPP and non-MPP cases. OSETBDS.115
CL OSETBDS.116
OSETBDS.117
*IF -DEF,MPP OSETBDS.118
Offx = 0 OSETBDS.119
Offy = 0 OSETBDS.120
atright = .true. OSETBDS.121
atleft = .true. OSETBDS.122
atbase = .true. OSETBDS.123
attop = .true. OSETBDS.124
*ENDIF OSETBDS.125
OSETBDS.126
CL 1.0 Determine the number of rows of data in the boundary data OSETBDS.127
CL either globally (non-MPP) or on the local processor. OSETBDS.128
CL Velocity data have one less row and column on the global grid. OSETBDS.129
OSETBDS.130
n_cols_bdy = ncols-2*Offx OSETBDS.131
n_rows_bdy = nrows-2*Offy OSETBDS.132
OSETBDS.133
if ( f_type .eq. fld_type_u .and. atbase) then OSETBDS.134
n_rows_bdy = n_rows_bdy - 1 ! atbase is for N bdy ! OSETBDS.135
end if OSETBDS.136
OSETBDS.137
if ( f_type .eq. fld_type_u .and. atright) then OSETBDS.138
n_cols_bdy = n_cols_bdy - 1 ! atright is for E bdy ! OSETBDS.139
end if OSETBDS.140
OSETBDS.141
CL 2.0 From each bit of the temporary array need to work out where the OSETBDS.142
CL North, South, East and West boundary information is. As there OSETBDS.143
CL is a loop over levels here the pointers need not know about the OSETBDS.144
CL levels. Don't overlap at the corners and take the rim width OSETBDS.145
CL into account. Set pointers to 1 if boundary is not selected OSETBDS.146
CL to avoid uninitialised pointers OSETBDS.147
OSETBDS.148
bdy_ptr = 1 OSETBDS.149
OSETBDS.150
if (l_obdy_north) then OSETBDS.151
ptr_bdy_n = bdy_ptr OSETBDS.152
bdy_ptr=bdy_ptr + n_cols_bdy * RIMWIDTHO OSETBDS.153
else OSETBDS.154
ptr_bdy_n = 1 OSETBDS.155
endif OSETBDS.156
OSETBDS.157
if (l_obdy_east) then OSETBDS.158
ptr_bdy_e = bdy_ptr OSETBDS.159
bdy_ptr = bdy_ptr + n_rows_bdy * RIMWIDTHO OSETBDS.160
else OSETBDS.161
ptr_bdy_e = 1 OSETBDS.162
endif OSETBDS.163
OSETBDS.164
if (l_obdy_south) then OSETBDS.165
ptr_bdy_s = bdy_ptr OSETBDS.166
bdy_ptr = bdy_ptr + n_cols_bdy * RIMWIDTHO OSETBDS.167
else OSETBDS.168
ptr_bdy_s = 1 OSETBDS.169
endif OSETBDS.170
OSETBDS.171
if (l_obdy_west) then OSETBDS.172
ptr_bdy_w = bdy_ptr OSETBDS.173
else OSETBDS.174
ptr_bdy_w = 1 OSETBDS.175
endif OSETBDS.176
OSETBDS.177
CL 3.0 Call the chosen routine to update the values OSETBDS.178
OSETBDS.179
! if ( f_type .ne. fld_type_i ) then OSETBDS.180
OSETBDS.181
if (l_ogill_lbcs) then OSETBDS.182
OSETBDS.183
call o_lbc_gill
(ncols,nrows,n_cols_bdy,n_rows_bdy, OSETBDS.184
& levn,d1_field, OSETBDS.185
& levels_dataset, xgrid, ygrid, f_type, OSETBDS.186
& l_obdy_north,l_obdy_east,l_obdy_south,l_obdy_west, OSETBDS.187
& DTEMP_BOUND(ptr_bdy_n), DTEMP_BOUND(ptr_bdy_e), OSETBDS.188
& DTEMP_BOUND(ptr_bdy_s), DTEMP_BOUND(ptr_bdy_w), OSETBDS.189
& icode,cmessage) OSETBDS.190
OSETBDS.191
endif OSETBDS.192
OSETBDS.193
if (l_ofrs_lbcs) then OSETBDS.194
OSETBDS.195
call o_lbc_frs
(ncols,nrows,n_cols_bdy,n_rows_bdy, OSETBDS.196
& levn, d1_field, f_type, OSETBDS.197
& levels_dataset, RIMWIDTHO, RIMWEIGHTSO, OSETBDS.198
& l_obdy_north,l_obdy_east,l_obdy_south,l_obdy_west, OSETBDS.199
& DTEMP_BOUND(ptr_bdy_n), DTEMP_BOUND(ptr_bdy_e), OSETBDS.200
& DTEMP_BOUND(ptr_bdy_s), DTEMP_BOUND(ptr_bdy_w), OSETBDS.201
& l_apply_lsm, land_val, icode, cmessage) OSETBDS.202
OSETBDS.203
endif OSETBDS.204
OSETBDS.205
OSETBDS.206
C if (l_ostvns_lbcs) then OSETBDS.207
C OSETBDS.208
C call stev_obc ! not written yet OSETBDS.209
C OSETBDS.210
C endif OSETBDS.211
OSETBDS.212
CL 4.0 Set values of ZTD for streamfunction calculation OSETBDS.213
OSETBDS.214
! else ! f_type .eq. f_type_i OSETBDS.215
OSETBDS.216
! call o_lbc_ztd(ncols,nrows,n_cols_bdy,n_rows_bdy, OSETBDS.217
! & lseg,isz,iez, OSETBDS.218
! & d1_field,rimwidth, OSETBDS.219
! & l_obdy_north,l_obdy_east,l_obdy_south,l_obdy_west, OSETBDS.220
! & DTEMP_BOUND(ptr_bdy_n), DTEMP_BOUND(ptr_bdy_e), OSETBDS.221
! & DTEMP_BOUND(ptr_bdy_s), DTEMP_BOUND(ptr_bdy_w), OSETBDS.222
! & icode, cmessage) OSETBDS.223
OSETBDS.224
! end if ! f_type OSETBDS.225
OSETBDS.226
return OSETBDS.227
OSETBDS.228
end OSETBDS.229
*ENDIF OSETBDS.230