*IF DEF,A08_7A SIEVE7A.2
C ******************************COPYRIGHT****************************** SIEVE7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SIEVE7A.4
C SIEVE7A.5
C Use, duplication or disclosure of this code is subject to the SIEVE7A.6
C restrictions as set forth in the contract. SIEVE7A.7
C SIEVE7A.8
C Meteorological Office SIEVE7A.9
C London Road SIEVE7A.10
C BRACKNELL SIEVE7A.11
C Berkshire UK SIEVE7A.12
C RG12 2SZ SIEVE7A.13
C SIEVE7A.14
C If no contract has been raised with this copy of the code, the use, SIEVE7A.15
C duplication or disclosure of it is strictly prohibited. Permission SIEVE7A.16
C to do so must first be obtained in writing from the Head of Numerical SIEVE7A.17
C Modelling at the above address. SIEVE7A.18
C ******************************COPYRIGHT****************************** SIEVE7A.19
C SIEVE7A.20
CLL SUBROUTINE SIEVE-------------------------------------------------- SIEVE7A.21
CLL SIEVE7A.22
CLL PURPOSE : TO CALCULATE THE THROUGHFALL OF WATER FALLING SIEVE7A.23
CLL THROUGH THE SURFACE CANOPY SIEVE7A.24
CLL SIEVE7A.25
CLL SUITABLE FOR SINGLE COLUMN MODEL USE SIEVE7A.26
CLL SIEVE7A.27
CLL WRITTEN FOR CRAY-YMP BY S.ALLEN AND D.GREGORY SIEVE7A.28
CLL DEC - FEB 1989/90 SIEVE7A.29
CLL SIEVE7A.30
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: SIEVE7A.31
CLL VERSION DATE SIEVE7A.32
CLL SIEVE7A.33
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 SIEVE7A.34
CLL VERSION NO. 1 18/1/90 SIEVE7A.35
CLL SIEVE7A.36
CLL LOGICAL COMPONENTS COVERED: P252 SIEVE7A.37
CLL SIEVE7A.38
CLL SYSTEM TASK : P252 SIEVE7A.39
CLL SIEVE7A.40
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER NO 25 SIEVE7A.41
CCL SECTION (3B(II)), EQN(P252.9) SIEVE7A.42
CLL SIEVE7A.43
CLLEND----------------------------------------------------------------- SIEVE7A.44
C SIEVE7A.45
C*L ARGUMENTS--------------------------------------------------------- SIEVE7A.46
C SIEVE7A.47
SUBROUTINE SIEVE ( 6SIEVE7A.48
& NPNTS,TILE_PTS,TILE_INDEX,AREA,CAN_CPY,R,FRAC,TIMESTEP, SIEVE7A.49
& CAN_WCNT,TOT_TFALL SIEVE7A.50
& ) SIEVE7A.51
SIEVE7A.52
IMPLICIT NONE SIEVE7A.53
SIEVE7A.54
INTEGER SIEVE7A.55
& NPNTS ! IN Total number of land points. SIEVE7A.56
&,TILE_PTS ! IN Number of tile points. SIEVE7A.57
&,TILE_INDEX(NPNTS) ! IN Index of tile points. SIEVE7A.58
SIEVE7A.59
REAL SIEVE7A.60
& AREA ! IN Fractional area of gridbox over which SIEVE7A.61
! water falls (%). SIEVE7A.62
&,CAN_CPY(NPNTS) ! IN Canopy capacity (kg/m2). SIEVE7A.63
&,R(NPNTS) ! IN Water fall rate (kg/m2/s). SIEVE7A.64
&,FRAC(NPNTS) ! IN Tile fraction. SIEVE7A.65
&,TIMESTEP ! IN Timestep (s). SIEVE7A.66
SIEVE7A.67
REAL SIEVE7A.68
& CAN_WCNT(NPNTS) ! INOUT Canopy water content (kg/m2). SIEVE7A.69
&,TOT_TFALL(NPNTS) ! INOUT Cummulative canopy throughfall SIEVE7A.70
! ! (kg/m2/s). SIEVE7A.71
SIEVE7A.72
! Workspace -------------------------------------------------------- SIEVE7A.73
REAL SIEVE7A.74
& AEXP ! Used in calculation of exponential SIEVE7A.75
! in throughfall formula. SIEVE7A.76
&,CAN_RATIO ! CAN_WCNT / CAN_CPY SIEVE7A.77
&,TFALL(NPNTS) ! Local throughfall (kg/m2/s). SIEVE7A.78
SIEVE7A.79
INTEGER SIEVE7A.80
& I ! Land point index. SIEVE7A.81
&,J ! Counter for loop over tile points. SIEVE7A.82
SIEVE7A.83
DO J=1,TILE_PTS SIEVE7A.84
I = TILE_INDEX(J) SIEVE7A.85
IF (CAN_CPY(I) .GT. 0.0 .AND. R(I) .GT. 0.0) THEN SIEVE7A.86
AEXP = AREA*CAN_CPY(I)/(R(I)*TIMESTEP) SIEVE7A.87
AEXP = EXP(-AEXP) SIEVE7A.88
CAN_RATIO = CAN_WCNT(I) / CAN_CPY(I) SIEVE7A.89
CAN_RATIO = MIN(CAN_RATIO,1.0) ABX1F405.969
TFALL(I) = R(I) * ((1.0-CAN_RATIO)*AEXP + CAN_RATIO) SIEVE7A.90
ELSE SIEVE7A.91
TFALL(I) = R(I) SIEVE7A.92
END IF SIEVE7A.93
CAN_WCNT(I) = CAN_WCNT(I) + (R(I) - TFALL(I))*TIMESTEP SIEVE7A.94
TOT_TFALL(I) = TOT_TFALL(I) + FRAC(I)*TFALL(I) SIEVE7A.95
ENDDO SIEVE7A.96
SIEVE7A.97
RETURN SIEVE7A.98
END SIEVE7A.99
*ENDIF SIEVE7A.100