SUBROUTINE SMC_EXT (NPNTS,NSHYD,TILE_PTS,TILE_INDEX 2SMCEXT7A.23
&, F_ROOT,FRAC,STHU,V_CRIT,V_SAT,V_WILT SMCEXT7A.24
&, WT_EXT,FSMC) SMCEXT7A.25
SMCEXT7A.26
IMPLICIT NONE SMCEXT7A.27
! SMCEXT7A.28
! Description: SMCEXT7A.29
! Calculates the soil moisture availability factor and SMCEXT7A.30
! the fraction of the transpiration which is extracted from each SMCEXT7A.31
! soil layer. SMCEXT7A.32
! SMCEXT7A.33
! SMCEXT7A.34
! Documentation : UM Documentation Paper 25 SMCEXT7A.35
! SMCEXT7A.36
! Current Code Owner : David Gregory SMCEXT7A.37
! SMCEXT7A.38
! History: SMCEXT7A.39
! Version Date Comment SMCEXT7A.40
! ------- ---- ------- SMCEXT7A.41
! 4.4 New deck Peter Cox SMCEXT7A.42
! SMCEXT7A.43
! Code Description: SMCEXT7A.44
! Language: FORTRAN 77 + common extensions. SMCEXT7A.45
! SMCEXT7A.46
! System component covered: P25 SMCEXT7A.47
! System Task: P25 SMCEXT7A.48
! SMCEXT7A.49
SMCEXT7A.50
! Subroutine arguments: SMCEXT7A.51
! Scalar arguments with intent(IN) : SMCEXT7A.52
INTEGER SMCEXT7A.53
& NPNTS ! IN Number of gridpoints. SMCEXT7A.54
&,NSHYD ! IN Number of soil moisture layers. SMCEXT7A.55
&,TILE_PTS ! IN Number of points containing the SMCEXT7A.56
C ! given surface type. SMCEXT7A.57
&,TILE_INDEX(NPNTS) ! IN Indices on the land grid of the SMCEXT7A.58
C ! points containing the given SMCEXT7A.59
C ! surface type. SMCEXT7A.60
SMCEXT7A.61
SMCEXT7A.62
! Array arguments with intent(IN) : SMCEXT7A.63
REAL SMCEXT7A.64
& F_ROOT(NSHYD) ! IN Fraction of roots in each soil SMCEXT7A.65
! ! layer. SMCEXT7A.66
&,FRAC(NPNTS) ! IN Tile fraction. SMCEXT7A.67
&,STHU(NPNTS,NSHYD) ! IN Unfrozen soil moisture content of SMCEXT7A.68
! ! each layer as a fraction of SMCEXT7A.69
! ! saturation. SMCEXT7A.70
&,V_CRIT(NPNTS) ! IN Volumetric soil moisture SMCEXT7A.71
! ! concentration above which SMCEXT7A.72
! ! evapotranspiration is not sensitive SMCEXT7A.73
! ! to soil water (m3 H2O/m3 soil). SMCEXT7A.74
&,V_SAT(NPNTS) ! IN Volumetric soil moisture SMCEXT7A.75
! ! concentration at saturation SMCEXT7A.76
! ! (m3 H2O/m3 soil). SMCEXT7A.77
&,V_WILT(NPNTS) ! IN Volumetric soil moisture SMCEXT7A.78
! ! concentration below which SMCEXT7A.79
! ! stomata close (m3 H2O/m3 soil). SMCEXT7A.80
SMCEXT7A.81
! Array arguments with intent(INOUT) : SMCEXT7A.82
REAL SMCEXT7A.83
& WT_EXT(NPNTS,NSHYD) ! OUT Cummulative fraction of transpiration SMCEXT7A.84
! ! extracted from each soil layer SMCEXT7A.85
! ! (kg/m2/s). SMCEXT7A.86
SMCEXT7A.87
SMCEXT7A.88
! Array arguments with intent(OUT) : SMCEXT7A.89
REAL SMCEXT7A.90
& FSMC(NPNTS) ! OUT Soil moisture availability SMCEXT7A.91
! ! factor. SMCEXT7A.92
SMCEXT7A.93
! Local scalars: SMCEXT7A.94
INTEGER SMCEXT7A.95
& I,J,N ! WORK Loop counters SMCEXT7A.96
SMCEXT7A.97
! Local arrays: SMCEXT7A.98
REAL SMCEXT7A.99
& FSMC_L(NPNTS,NSHYD) ! WORK Soil moisture availability SMCEXT7A.100
! ! factor for each soil layer. SMCEXT7A.101
SMCEXT7A.102
!---------------------------------------------------------------------- SMCEXT7A.103
! Initialisations SMCEXT7A.104
!---------------------------------------------------------------------- SMCEXT7A.105
DO I=1,NPNTS SMCEXT7A.106
FSMC(I)=0.0 SMCEXT7A.107
ENDDO SMCEXT7A.108
SMCEXT7A.109
!---------------------------------------------------------------------- SMCEXT7A.110
! Calculate the soil moisture availability factor for each layer and SMCEXT7A.111
! weight with the root fraction to calculate the total availability SMCEXT7A.112
! factor. SMCEXT7A.113
!---------------------------------------------------------------------- SMCEXT7A.114
DO N=1,NSHYD SMCEXT7A.115
DO J=1,TILE_PTS SMCEXT7A.116
I=TILE_INDEX(J) SMCEXT7A.117
SMCEXT7A.118
FSMC_L(I,N)=(STHU(I,N)*V_SAT(I)-V_WILT(I)) SMCEXT7A.119
& /(V_CRIT(I)-V_WILT(I)) SMCEXT7A.120
FSMC_L(I,N)=MAX(FSMC_L(I,N),0.0) SMCEXT7A.121
FSMC_L(I,N)=MIN(FSMC_L(I,N),1.0) SMCEXT7A.122
SMCEXT7A.123
FSMC(I)=FSMC(I)+F_ROOT(N)*FSMC_L(I,N) SMCEXT7A.124
SMCEXT7A.125
ENDDO SMCEXT7A.126
ENDDO SMCEXT7A.127
SMCEXT7A.128
!---------------------------------------------------------------------- SMCEXT7A.129
! Calculate the fraction of the tranpiration which is extracted from SMCEXT7A.130
! each soil layer. SMCEXT7A.131
!---------------------------------------------------------------------- SMCEXT7A.132
DO N=1,NSHYD SMCEXT7A.133
DO J=1,TILE_PTS SMCEXT7A.134
I=TILE_INDEX(J) SMCEXT7A.135
IF (FSMC(I) .GT. 0.0) SMCEXT7A.136
& WT_EXT(I,N) = WT_EXT(I,N) + SMCEXT7A.137
& FRAC(I)*F_ROOT(N)*FSMC_L(I,N)/FSMC(I) SMCEXT7A.138
ENDDO SMCEXT7A.139
ENDDO SMCEXT7A.140
SMCEXT7A.141
RETURN SMCEXT7A.142
END SMCEXT7A.143
*ENDIF SMCEXT7A.144