SUBROUTINE SIEVE (NPNTS,R,CAN_WCNT,CAN_CPY,AREA,TFALL 6APA1F405.12
&, TIMESTEP) APA1F405.13
APA1F405.14
IMPLICIT NONE SIEVE1A.33
! APA1F405.15
! Description: APA1F405.16
! Calculates the flux of water passing through the canopy APA1F405.17
! APA1F405.18
! Documentation: APA1F405.19
! APA1F405.20
! Current Code Owner: Peter Cox APA1F405.21
! APA1F405.22
! History: APA1F405.23
! Version Date Comment APA1F405.24
! ------- ---- ------- APA1F405.25
! 4.5 6/98 Options to interpret canopy moisture as bimodally APA1F405.26
! rather than uniformily distributed, with either a APA1F405.27
! random or maximum overlap of the wet canopy and APA1F405.28
! the precipitating area (P.M.Cox) APA1F405.29
! 4.5 01/10/98 Removed old section-version defs. K Rogers APA1F405.30
! APA1F405.31
! Code Description: APA1F405.32
! Language: FORTRAN 77 + common extensions. APA1F405.33
! APA1F405.34
! System component covered: P25 APA1F405.35
! System Task: P25 APA1F405.36
! APA1F405.37
! Subroutine arguments APA1F405.38
! Scalar arguments with intent(IN): APA1F405.39
INTEGER APA1F405.40
& NPNTS ! IN Number of gridpoints. APA1F405.41
APA1F405.42
REAL APA1F405.43
& TIMESTEP ! IN Model timestep (s). APA1F405.44
&,AREA ! IN Fractional area of the gridbox over APA1F405.45
C ! which water falls. APA1F405.46
APA1F405.47
! Array arguments with intent(IN): APA1F405.48
REAL APA1F405.49
& R(NPNTS) ! IN Flux of water incident on the APA1F405.50
C ! canopy (kg/m2/s). APA1F405.51
&,CAN_WCNT(NPNTS) ! IN Canopy water content (kg/m2). APA1F405.52
&,CAN_CPY(NPNTS) ! IN Canopy capacity (kg/m2). APA1F405.53
APA1F405.54
! Array arguments with intent(OUT): APA1F405.55
REAL APA1F405.56
& TFALL(NPNTS) ! OUT Throughfall (kg/m2/s). APA1F405.57
APA1F405.58
! Local scalars: APA1F405.59
INTEGER APA1F405.60
& I ! WORK Loop counter. APA1F405.61
APA1F405.62
REAL APA1F405.63
& AEXP ! WORK Exponential term. APA1F405.64
&,CAN_RATIO ! WORK Fractional saturation of the APA1F405.65
C ! canopy. APA1F405.66
&,FDT_TERM ! WORK Finite timestep term. APA1F405.67
APA1F405.68
! Local parameters: APA1F405.69
REAL APA1F405.70
& GAMMA ! Forward timestep weighting APA1F405.71
PARAMETER(GAMMA=1.0) APA1F405.72
APA1F405.73
*CALL MOSES_OPT 
APA1F405.74
APA1F405.75
C----------------------------------------------------------------------- SIEVE1A.65
C Uniform canopy water APA1F405.76
C----------------------------------------------------------------------- SIEVE1A.67
IF (TF_MODEL.EQ.1) THEN APA1F405.77
DO I=1,NPNTS APA1F405.78
IF (CAN_CPY(I).GT.0.0.AND.R(I).GT.0.0) THEN APA1F405.79
AEXP=AREA*CAN_CPY(I)/(R(I)*TIMESTEP) APA1F405.80
*IF DEF,SCMA,AND,-DEF,T3E APA1F405.81
IF (AEXP.GT.80) THEN APA1F405.82
AEXP=0.0 APA1F405.83
ELSE APA1F405.84
AEXP=EXP(-AEXP) APA1F405.85
ENDIF APA1F405.86
*ELSE APA1F405.87
AEXP=EXP(-AEXP) APA1F405.88
*ENDIF APA1F405.89
CAN_RATIO=CAN_WCNT(I)/CAN_CPY(I) APA1F405.90
TFALL(I)=R(I)*((1.0-CAN_RATIO)*AEXP+CAN_RATIO) APA1F405.91
ELSE APA1F405.92
TFALL(I)=R(I) APA1F405.93
END IF APA1F405.94
ENDDO APA1F405.95
APA1F405.96
C----------------------------------------------------------------------- SIEVE1A.75
C Bimodel canopy water, random overlap APA1F405.97
C----------------------------------------------------------------------- SIEVE1A.77
ELSEIF (TF_MODEL.EQ.2) THEN APA1F405.98
DO I=1,NPNTS APA1F405.99
IF (CAN_CPY(I).GT.0.0.AND.R(I).GT.0.0) THEN APA1F405.100
CAN_RATIO=CAN_WCNT(I)/CAN_CPY(I) APA1F405.101
FDT_TERM=GAMMA*R(I)*TIMESTEP/CAN_CPY(I) APA1F405.102
TFALL(I)=R(I)*((CAN_RATIO+FDT_TERM)/(1.0+FDT_TERM)) APA1F405.103
ELSE APA1F405.104
TFALL(I)=R(I) APA1F405.105
END IF APA1F405.106
ENDDO APA1F405.107
APA1F405.108
C----------------------------------------------------------------------- SIEVE1A.88
C Bimodel canopy water, maximum overlap APA1F405.109
C----------------------------------------------------------------------- SIEVE1A.90
ELSEIF (TF_MODEL.EQ.3) THEN APA1F405.110
DO I=1,NPNTS APA1F405.111
IF (CAN_CPY(I).GT.0.0.AND.R(I).GT.0.0) THEN APA1F405.112
CAN_RATIO=CAN_WCNT(I)/(AREA*CAN_CPY(I)) APA1F405.113
IF (CAN_RATIO.LT.1.0) THEN APA1F405.114
FDT_TERM=GAMMA*R(I)*TIMESTEP/(AREA*CAN_CPY(I)) APA1F405.115
TFALL(I)=R(I)*((CAN_RATIO+FDT_TERM)/(1.0+FDT_TERM)) APA1F405.116
ELSE APA1F405.117
TFALL(I)=R(I) APA1F405.118
ENDIF APA1F405.119
ELSE APA1F405.120
TFALL(I)=R(I) APA1F405.121
ENDIF APA1F405.122
ENDDO APA1F405.123
ENDIF APA1F405.124
RETURN SIEVE1A.109
END SIEVE1A.110
*ENDIF SIEVE1A.111