*IF DEF,FLUXPROC FPLSMU.2
C ******************************COPYRIGHT****************************** FPLSMU.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPLSMU.4
C FPLSMU.5
C Use, duplication or disclosure of this code is subject to the FPLSMU.6
C restrictions as set forth in the contract. FPLSMU.7
C FPLSMU.8
C Meteorological Office FPLSMU.9
C London Road FPLSMU.10
C BRACKNELL FPLSMU.11
C Berkshire UK FPLSMU.12
C RG12 2SZ FPLSMU.13
C FPLSMU.14
C If no contract has been raised with this copy of the code, the use, FPLSMU.15
C duplication or disclosure of it is strictly prohibited. Permission FPLSMU.16
C to do so must first be obtained in writing from the Head of Numerical FPLSMU.17
C Modelling at the above address. FPLSMU.18
C ******************************COPYRIGHT****************************** FPLSMU.19
C FPLSMU.20
C Programming standard: Unified Model Documentation Paper No 3 FPLSMU.21
C Version No 1 15/1/90 FPLSMU.22
C History: FPLSMU.23
C version date change FPLSMU.24
C 4.5 03/09/98 New code FPLSMU.25
C FPLSMU.26
! Author: M. J. Bell FPLSMU.27
!---------------------------------------------------------------------- FPLSMU.28
! contains routines: set_lsmu FPLSMU.29
! FPLSMU.30
! Purpose: Flux processing routine. FPLSMU.31
! Sets u velocity atmosphere land / sea mask FPLSMU.32
! FPLSMU.33
! In the atmosphere code C_D | dv/dz | is linearly interpolated from FPLSMU.34
! tracer points to velocity points. Velocity points next to a land FPLSMU.35
! point are thus "contaminated" with these values from land points FPLSMU.36
! which could be much larger than those at sea points. So only velocity FPLSMU.37
! points surrounded by tracer sea points are treated as land points FPLSMU.38
! in code to form fluxes for the operational FOAM model. FPLSMU.39
! FPLSMU.40
! Important: this routine assumes that the atmosphere uses a B grid FPLSMU.41
!---------------------------------------------------------------------- FPLSMU.42
subroutine set_lsmu ( Len1_Lookup, Lookuplsmu, 1,4FPLSMU.43
# ncols, nrowst, nrowsu, LCyclic, FPLSMU.44
# lsmt, lsmu, lambda_u, phi_u ) FPLSMU.45
FPLSMU.46
implicit none FPLSMU.47
FPLSMU.48
! declaration of arguments FPLSMU.49
FPLSMU.50
integer Len1_Lookup ! IN length of lookup table FPLSMU.51
integer Lookuplsmu(Len1_Lookup) ! IN lookup table FPLSMU.52
integer ncols ! IN # of columns (east-west) FPLSMU.53
integer nrowst ! IN # of rows on tracer grid FPLSMU.54
integer nrowsu ! IN # of rows on velocity grid FPLSMU.55
logical LCyclic ! IN T => atmosphere grid cyclic FPLSMU.56
integer lsmt(ncols, nrowst) ! IN land/sea mask for tracers FPLSMU.57
FPLSMU.58
integer lsmu(ncols, nrowsu) ! OUT land/sea mask for velocities FPLSMU.59
real lambda_u(ncols) ! OUT grid coordinates (east-west) FPLSMU.60
real phi_u(nrowsu) ! OUT grid coordinates (north-south) FPLSMU.61
FPLSMU.62
! declaration of parameters FPLSMU.63
*CALL CLOOKADD 
FPLSMU.64
FPLSMU.65
FPLSMU.66
! declaration of local arrays FPLSMU.67
integer lsm_full ( ncols+1, nrowst) ! includes "wrap points" FPLSMU.68
FPLSMU.69
! declaration of local scalars FPLSMU.70
real DPhi ! latitude interval FPLSMU.71
real Phi0 ! Zeroth latitude FPLSMU.72
real DLambda ! Zeroth longitude FPLSMU.73
real Lambda0 ! Longitude interval FPLSMU.74
FPLSMU.75
integer jrow, icol ! loop indices for rows and columns FPLSMU.76
FPLSMU.77
! declaration of externals FPLSMU.78
external copy_to_real FPLSMU.79
FPLSMU.80
!---------------------------------------------------------------------- FPLSMU.81
FPLSMU.82
! 1. Build an extended tracer land / sea mask FPLSMU.83
FPLSMU.84
do jrow = 1, nrowst FPLSMU.85
do icol = 1, ncols FPLSMU.86
lsm_full(icol,jrow) = lsmt(icol,jrow) FPLSMU.87
end do FPLSMU.88
end do FPLSMU.89
FPLSMU.90
if ( LCyclic ) then FPLSMU.91
do jrow = 1, nrowst FPLSMU.92
lsm_full(ncols+1,jrow) = lsm_full(1,jrow) FPLSMU.93
end do FPLSMU.94
else FPLSMU.95
do jrow = 1, nrowst FPLSMU.96
lsm_full(ncols+1,jrow) = lsm_full(ncols,jrow) FPLSMU.97
end do FPLSMU.98
end if ! LCyclic FPLSMU.99
FPLSMU.100
! 2. Convert tracer land/sea mask to velocity grid land/sea mask FPLSMU.101
FPLSMU.102
do jrow = 1, nrowsu FPLSMU.103
do icol = 1, ncols FPLSMU.104
lsmu(icol,jrow) = max ( lsm_full(icol+1,jrow+1), FPLSMU.105
# lsm_full(icol ,jrow+1), FPLSMU.106
# lsm_full(icol+1,jrow ), FPLSMU.107
# lsm_full(icol ,jrow ) ) FPLSMU.108
end do FPLSMU.109
end do FPLSMU.110
FPLSMU.111
! 3. Set latitudes (Phi_u) FPLSMU.112
call copy_to_real ( Lookuplsmu(BDY), DPhi ) FPLSMU.113
call copy_to_real ( Lookuplsmu(BZY), Phi0 ) FPLSMU.114
do jrow = 1, nrowsu FPLSMU.115
phi_u(jrow) = Phi0 + jrow * DPhi FPLSMU.116
end do FPLSMU.117
FPLSMU.118
! 4. Set longitudes (Lambda) FPLSMU.119
call copy_to_real ( Lookuplsmu(BDX), DLambda ) FPLSMU.120
call copy_to_real ( Lookuplsmu(BZX), Lambda0 ) FPLSMU.121
do icol = 1, ncols FPLSMU.122
lambda_u(icol) = Lambda0 + icol * DLambda FPLSMU.123
end do FPLSMU.124
FPLSMU.125
return FPLSMU.126
end FPLSMU.127
!---------------------------------------------------------------------- FPLSMU.128
*ENDIF FPLSMU.129