*IF DEF,FLUXPROC FPLSMSE1.2
C ******************************COPYRIGHT****************************** FPLSMSE1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPLSMSE1.4
C FPLSMSE1.5
C Use, duplication or disclosure of this code is subject to the FPLSMSE1.6
C restrictions as set forth in the contract. FPLSMSE1.7
C FPLSMSE1.8
C Meteorological Office FPLSMSE1.9
C London Road FPLSMSE1.10
C BRACKNELL FPLSMSE1.11
C Berkshire UK FPLSMSE1.12
C RG12 2SZ FPLSMSE1.13
C FPLSMSE1.14
C If no contract has been raised with this copy of the code, the use, FPLSMSE1.15
C duplication or disclosure of it is strictly prohibited. Permission FPLSMSE1.16
C to do so must first be obtained in writing from the Head of Numerical FPLSMSE1.17
C Modelling at the above address. FPLSMSE1.18
C ******************************COPYRIGHT****************************** FPLSMSE1.19
C FPLSMSE1.20
C Programming standard: Unified Model Documentation Paper No 3 FPLSMSE1.21
C Version No 1 15/1/90 FPLSMSE1.22
C History: FPLSMSE1.23
C version date change FPLSMSE1.24
C 4.5 03/09/98 New code FPLSMSE1.25
C FPLSMSE1.26
! Author: M. J. Bell FPLSMSE1.27
!---------------------------------------------------------------------- FPLSMSE1.28
! contains routines: lsm_set FPLSMSE1.29
! FPLSMSE1.30
! Purpose: Flux processing routine. FPLSMSE1.31
! Sets missing data values in a field according to the lsm FPLSMSE1.32
!---------------------------------------------------------------------- FPLSMSE1.33
subroutine lsm_set (ncols, nrows, lsm, ivalue_mask, 4,1FPLSMSE1.34
# rmdi, ldebug, field ) FPLSMSE1.35
FPLSMSE1.36
implicit none FPLSMSE1.37
FPLSMSE1.38
! declaration of argument list FPLSMSE1.39
FPLSMSE1.40
integer ncols ! IN number of columns in field FPLSMSE1.41
integer nrows ! IN number of rows in field FPLSMSE1.42
integer lsm(ncols, nrows) ! IN land / sea mask FPLSMSE1.43
integer ivalue_mask ! IN integer value in lsm for which to set a FPLSMSE1.44
! missing value in array "field" FPLSMSE1.45
real rmdi ! IN missing data value FPLSMSE1.46
logical ldebug ! IN T => debug output is produced FPLSMSE1.47
real field(ncols, nrows) ! IN/OUT field FPLSMSE1.48
FPLSMSE1.49
FPLSMSE1.50
! no parameters, globals or local arrays FPLSMSE1.51
FPLSMSE1.52
! declaration of local scalars FPLSMSE1.53
integer i, j ! do loop indices FPLSMSE1.54
FPLSMSE1.55
! externals FPLSMSE1.56
external output_debug FPLSMSE1.57
!---------------------------------------------------------------------- FPLSMSE1.58
FPLSMSE1.59
! 1. Set values FPLSMSE1.60
FPLSMSE1.61
do j = 1, nrows FPLSMSE1.62
do i = 1, ncols FPLSMSE1.63
if ( lsm(i, j) .eq. ivalue_mask ) then FPLSMSE1.64
field(i,j) = rmdi FPLSMSE1.65
end if FPLSMSE1.66
end do FPLSMSE1.67
end do FPLSMSE1.68
FPLSMSE1.69
! 2. output selected values for debugging FPLSMSE1.70
FPLSMSE1.71
if (ldebug) then FPLSMSE1.72
call output_debug
('values after land-sea mask imposed', FPLSMSE1.73
# nrows, ncols, Field) FPLSMSE1.74
end if FPLSMSE1.75
FPLSMSE1.76
return FPLSMSE1.77
end FPLSMSE1.78
!---------------------------------------------------------------------- FPLSMSE1.79
*ENDIF FPLSMSE1.80