*IF DEF,A03_7A SFREST7A.2
C *****************************COPYRIGHT****************************** SFREST7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFREST7A.4
C SFREST7A.5
C Use, duplication or disclosure of this code is subject to the SFREST7A.6
C restrictions as set forth in the contract. SFREST7A.7
C SFREST7A.8
C Meteorological Office SFREST7A.9
C London Road SFREST7A.10
C BRACKNELL SFREST7A.11
C Berkshire UK SFREST7A.12
C RG12 2SZ SFREST7A.13
C SFREST7A.14
C If no contract has been raised with this copy of the code, the use, SFREST7A.15
C duplication or disclosure of it is strictly prohibited. Permission SFREST7A.16
C to do so must first be obtained in writing from the Head of Numerical SFREST7A.17
C Modelling at the above address. SFREST7A.18
C ******************************COPYRIGHT****************************** SFREST7A.19
C*LL SUBROUTINE SF_RESIST---------------------------------------------- SFREST7A.20
CLL SFREST7A.21
CLL Purpose: Calculate surface moisture flux resistance factors. SFREST7A.22
CLL SFREST7A.23
CLL SFREST7A.24
CLLEND----------------------------------------------------------------- SFREST7A.25
C* SFREST7A.26
C*L Arguments -------------------------------------------------------- SFREST7A.27
SUBROUTINE SF_RESIST ( 6,6SFREST7A.28
& P_FIELD,LAND_FIELD,TILE_PTS,LAND_INDEX,TILE_INDEX, SFREST7A.29
& CANOPY,CATCH,CH,DQ,EPDT,GC,VSHR, SFREST7A.30
& FRACA,RESFS,RESFT,LTIMER SFREST7A.31
& ) SFREST7A.32
SFREST7A.33
IMPLICIT NONE SFREST7A.34
SFREST7A.35
INTEGER SFREST7A.36
& P_FIELD ! IN Total number of P-grid points. SFREST7A.37
&,LAND_FIELD ! IN Total number of land points. SFREST7A.38
&,TILE_PTS ! IN Number of tile points. SFREST7A.39
&,LAND_INDEX(P_FIELD )! IN Index of land points. SFREST7A.40
&,TILE_INDEX(LAND_FIELD) SFREST7A.41
! ! IN Index of tile points. SFREST7A.42
SFREST7A.43
LOGICAL SFREST7A.44
& LTIMER ! IN Logical switch for TIMER diags SFREST7A.45
SFREST7A.46
REAL SFREST7A.47
& CANOPY(LAND_FIELD) ! IN Surface water (kg per sq metre). F642. SFREST7A.48
&,CATCH(LAND_FIELD) ! IN Surface capacity (max. surface water) SFREST7A.49
! ! (kg per sq metre). F6416. SFREST7A.50
&,CH(LAND_FIELD) ! IN Transport coefficient for heat and SFREST7A.51
! ! moisture transport SFREST7A.52
&,DQ(LAND_FIELD) ! IN Sp humidity difference between surface SFREST7A.53
! ! and lowest atmospheric level (Q1 - Q*). SFREST7A.54
&,EPDT(LAND_FIELD) ! IN "Potential" Evaporation * Timestep. SFREST7A.55
! ! Dummy variable for first call to routine SFREST7A.56
&,GC(LAND_FIELD) ! IN Interactive canopy conductance SFREST7A.57
! ! to evaporation (m/s) SFREST7A.58
&,VSHR(P_FIELD) ! IN Magnitude of surface-to-lowest-level SFREST7A.59
! ! windshear SFREST7A.60
SFREST7A.61
REAL SFREST7A.62
& FRACA(LAND_FIELD) ! OUT Fraction of surface moisture flux with SFREST7A.63
! ! only aerodynamic resistance. SFREST7A.64
&,RESFS(LAND_FIELD) ! OUT Combined soil, stomatal and aerodynamic SFREST7A.65
! ! resistance factor for fraction 1-FRACA. SFREST7A.66
&,RESFT(LAND_FIELD) ! OUT Total resistance factor SFREST7A.67
! ! FRACA+(1-FRACA)*RESFS. SFREST7A.68
SFREST7A.69
! Workspace ----------------------------------------------------------- SFREST7A.70
INTEGER SFREST7A.71
& I ! Horizontal field index. SFREST7A.72
&,J ! Tile field index. SFREST7A.73
&,L ! Land field index. SFREST7A.74
SFREST7A.75
IF (LTIMER) THEN SFREST7A.76
CALL TIMER
('SFRESIST',3) SFREST7A.77
ENDIF SFREST7A.78
SFREST7A.79
!----------------------------------------------------------------------- SFREST7A.80
! Evaporation over land surfaces without snow is limited by SFREST7A.81
! soil moisture availability and stomatal resistance. SFREST7A.82
! Set FRACA (= fA in the documentation) according to P243.68, SFREST7A.83
! and RESFS (= fS) according to P243.75 and P243.61. SFREST7A.84
!----------------------------------------------------------------------- SFREST7A.85
DO J=1,TILE_PTS SFREST7A.86
L = TILE_INDEX(J) SFREST7A.87
I = LAND_INDEX(L) SFREST7A.88
SFREST7A.89
!----------------------------------------------------------------------- SFREST7A.90
! Calculate the fraction of the flux with only aerodynamic resistance SFREST7A.91
! (canopy evaporation). SFREST7A.92
! Set to 1 for negative moisture flux (no surface/stomatal resistance to SFREST7A.93
! condensation). SFREST7A.94
!----------------------------------------------------------------------- SFREST7A.95
FRACA(L) = 1.0 SFREST7A.96
IF ( DQ(L).LT.0.0 ) FRACA(L) = 0.0 SFREST7A.97
IF ( DQ(L).LT.0.0 .AND. CATCH(L).GT.0.0 ) SFREST7A.98
& FRACA(L) = CANOPY(L) / ( EPDT(L) + CATCH(L) ) SFREST7A.99
FRACA(L) = MIN(FRACA(L),1.0) ABX1F405.894
SFREST7A.100
!----------------------------------------------------------------------- SFREST7A.101
! Calculate resistance factors for transpiration from vegetation tiles SFREST7A.102
! and bare soil evaporation from soil tiles. SFREST7A.103
!----------------------------------------------------------------------- SFREST7A.104
RESFS(L) = GC(L) / ( GC(L) + CH(L)*VSHR(I) ) SFREST7A.105
RESFT(L) = FRACA(L) + (1.0 - FRACA(L)) * RESFS(L) SFREST7A.106
SFREST7A.107
ENDDO SFREST7A.108
SFREST7A.109
IF (LTIMER) THEN SFREST7A.110
CALL TIMER('SFRESIST',4) SFREST7A.111
ENDIF SFREST7A.112
SFREST7A.113
RETURN SFREST7A.114
END SFREST7A.115
*ENDIF SFREST7A.116