*IF DEF,FLUXPROC FPLOOKU1.2
C ******************************COPYRIGHT****************************** FPLOOKU1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPLOOKU1.4
C FPLOOKU1.5
C Use, duplication or disclosure of this code is subject to the FPLOOKU1.6
C restrictions as set forth in the contract. FPLOOKU1.7
C FPLOOKU1.8
C Meteorological Office FPLOOKU1.9
C London Road FPLOOKU1.10
C BRACKNELL FPLOOKU1.11
C Berkshire UK FPLOOKU1.12
C RG12 2SZ FPLOOKU1.13
C FPLOOKU1.14
C If no contract has been raised with this copy of the code, the use, FPLOOKU1.15
C duplication or disclosure of it is strictly prohibited. Permission FPLOOKU1.16
C to do so must first be obtained in writing from the Head of Numerical FPLOOKU1.17
C Modelling at the above address. FPLOOKU1.18
C ******************************COPYRIGHT****************************** FPLOOKU1.19
C FPLOOKU1.20
C Programming standard: Unified Model Documentation Paper No 3 FPLOOKU1.21
C Version No 1 15/1/90 FPLOOKU1.22
C History: FPLOOKU1.23
C version date change FPLOOKU1.24
C 4.5 03/09/98 New code FPLOOKU1.25
C FPLOOKU1.26
! Author: M. J. Bell FPLOOKU1.27
!---------------------------------------------------------------------- FPLOOKU1.28
! contains routines: set_lookup_lsmu FPLOOKU1.29
! FPLOOKU1.30
! Purpose: Flux processing routine. FPLOOKU1.31
! Sets lookup for u velocity atmosphere land / sea mask FPLOOKU1.32
! FPLOOKU1.33
! Important: this routine assumes that the atmosphere uses a B grid FPLOOKU1.34
!---------------------------------------------------------------------- FPLOOKU1.35
subroutine set_lookup_lsmu ( Len1_Lookup, Lookuplsmt, Lookuplsmu ) 1,6FPLOOKU1.36
FPLOOKU1.37
implicit none FPLOOKU1.38
FPLOOKU1.39
! declaration of arguments FPLOOKU1.40
FPLOOKU1.41
integer Len1_Lookup ! IN length of lookup table FPLOOKU1.42
integer Lookuplsmt(Len1_Lookup) ! IN tracer grid lsm lookup FPLOOKU1.43
integer Lookuplsmu(Len1_Lookup) ! OUT velocity grid lsm lookup FPLOOKU1.44
FPLOOKU1.45
! declaration of parameters FPLOOKU1.46
*CALL CLOOKADD 
FPLOOKU1.47
FPLOOKU1.48
! declaration of local scalars FPLOOKU1.49
FPLOOKU1.50
integer i ! loop index over lookup elements FPLOOKU1.51
FPLOOKU1.52
real DPhi ! latitude interval FPLOOKU1.53
real Phi0 ! Zeroth latitude FPLOOKU1.54
real DLambda ! Zeroth longitude FPLOOKU1.55
real Lambda0 ! Longitude interval FPLOOKU1.56
FPLOOKU1.57
! declaration of externals FPLOOKU1.58
external copy_to_real, copy_to_integer FPLOOKU1.59
!---------------------------------------------------------------------- FPLOOKU1.60
FPLOOKU1.61
! 1. copy all elements from Lookuplsmt into Lookuplsmu FPLOOKU1.62
FPLOOKU1.63
do i = 1, Len1_Lookup FPLOOKU1.64
Lookuplsmu(i) = Lookuplsmt(i) FPLOOKU1.65
end do FPLOOKU1.66
FPLOOKU1.67
! 2. amend the number of rows and length of data FPLOOKU1.68
Lookuplsmu( LBROW ) = Lookuplsmu( LBROW ) - 1 FPLOOKU1.69
Lookuplsmu( LBLREC ) = Lookuplsmu( LBROW ) * Lookuplsmu( LBNPT ) FPLOOKU1.70
FPLOOKU1.71
! 3. amend the start latitude FPLOOKU1.72
call copy_to_real ( Lookuplsmu(BDY), DPhi ) FPLOOKU1.73
call copy_to_real ( Lookuplsmu(BZY), Phi0 ) FPLOOKU1.74
Phi0 = Phi0 + 0.5 * DPhi FPLOOKU1.75
FPLOOKU1.76
call copy_to_integer ( Phi0, Lookuplsmu(BZY) ) FPLOOKU1.77
FPLOOKU1.78
! 4. amend the start longitude FPLOOKU1.79
call copy_to_real ( Lookuplsmu(BDX), DLambda ) FPLOOKU1.80
call copy_to_real ( Lookuplsmu(BZX), Lambda0 ) FPLOOKU1.81
Lambda0 = Lambda0 + 0.5 * DLambda FPLOOKU1.82
FPLOOKU1.83
call copy_to_integer ( Lambda0, Lookuplsmu(BZX) ) FPLOOKU1.84
FPLOOKU1.85
9999 continue FPLOOKU1.86
return FPLOOKU1.87
end FPLOOKU1.88
!---------------------------------------------------------------------- FPLOOKU1.89
*ENDIF FPLOOKU1.90