SUBROUTINE SMC_ROOT (NPNTS,NSHYD,F_TYPE,DZ,ROOTD,STHU,VFRAC, 3,2APA1F405.262
& V_SAT,V_WILT,SMC,V_ROOT,V_SOIL,WT_EXT,LTIMER) APA1F405.263
SMROOT5A.25
IMPLICIT NONE SMROOT5A.26
! SMROOT5A.27
! Description: SMROOT5A.28
! Calculates the volumetric soil moisture in the top soil layer, SMROOT5A.29
! the volumetric soil moisture in the rootzone, the gridbox mean SMROOT5A.30
! available soil moisture, and the fraction of the transpiration SMROOT5A.31
! which is extracted from each soil layer. (Cox, 2/96) SMROOT5A.32
! SMROOT5A.33
! SMROOT5A.34
! Documentation : UM Documentation Paper 25 SMROOT5A.35
! SMROOT5A.36
! Current Code Owner : David Gregory SMROOT5A.37
! SMROOT5A.38
! History: SMROOT5A.39
! Version Date Comment SMROOT5A.40
! ------- ---- ------- SMROOT5A.41
! 4.1 New deck Peter Cox SMROOT5A.42
!LL 4.5 18/06/98 Changed Timer calls to indicate non-barrier GPB8F405.51
!LL P.Burton GPB8F405.52
! 4.5 6/98 Optional exponential root profile Peter Cox APA1F405.264
! SMROOT5A.43
! Code Description: SMROOT5A.44
! Language: FORTRAN 77 + common extensions. SMROOT5A.45
! SMROOT5A.46
! System component covered: P25 SMROOT5A.47
! System Task: P25 SMROOT5A.48
! SMROOT5A.49
SMROOT5A.50
! Global variables: SMROOT5A.51
*CALL C_DENSTY 
SMROOT5A.52
*CALL C_SOILH SMROOT5A.53
*CALL MOSES_OPT APA1F405.265
SMROOT5A.54
! Subroutine arguments: SMROOT5A.55
! Scalar arguments with intent(IN) : SMROOT5A.56
INTEGER SMROOT5A.57
& NPNTS ! IN Number of gridpoints. SMROOT5A.58
&,NSHYD ! IN Number of soil moisture levels. SMROOT5A.59
&,F_TYPE(NPNTS) ! IN Plant functional type: SMROOT5A.60
! ! 1 - Broadleaf tree SMROOT5A.61
! ! 2 - Needleleaf tree SMROOT5A.62
! ! 3 - C3 Grass SMROOT5A.63
! ! 4 - C4 Grass SMROOT5A.64
SMROOT5A.65
! Array arguments with intent(IN) : SMROOT5A.66
REAL SMROOT5A.67
& DZ(NSHYD) ! IN Soil layer thicknesses (m). SMROOT5A.68
&,ROOTD(NSHYD) ! IN Rootdepth (m). APA1F405.266
&,STHU(NPNTS,NSHYD) ! IN Unfrozen soil moisture content of SMROOT5A.69
! ! each layer as a fraction of SMROOT5A.70
! ! saturation. SMROOT5A.71
&,VFRAC(NPNTS) ! IN Vegetated fraction. SMROOT5A.72
&,V_SAT(NPNTS) ! IN Volumetric soil moisture SMROOT5A.73
! ! concentration at saturation SMROOT5A.74
! ! (m3 H2O/m3 soil). SMROOT5A.75
&,V_WILT(NPNTS) ! IN Volumetric soil moisture SMROOT5A.76
! ! concentration below which SMROOT5A.77
! ! stomata close (m3 H2O/m3 soil). SMROOT5A.78
SMROOT5A.79
LOGICAL LTIMER ! Logical switch for TIMER diags SMROOT5A.80
SMROOT5A.81
! Array arguments with intent(OUT) : SMROOT5A.82
REAL SMROOT5A.83
& SMC(NPNTS) ! OUT Available soil moisture in the SMROOT5A.84
! ! rootzone (kg/m2). SMROOT5A.85
&,V_ROOT(NPNTS) ! OUT Volumetric soil moisture SMROOT5A.86
! ! concentration in the rootzone SMROOT5A.87
! ! (m3 H2O/m3 soil). SMROOT5A.88
&,V_SOIL(NPNTS) ! OUT Volumetric soil moisture SMROOT5A.89
! ! concentration in the top soil SMROOT5A.90
! ! layer (m3 H2O/m3 soil). SMROOT5A.91
&,WT_EXT(NPNTS,NSHYD) ! OUT Fraction of transpiration extracted SMROOT5A.92
! ! from each soil layer (kg/m2/s). SMROOT5A.93
! Local scalars: SMROOT5A.94
INTEGER SMROOT5A.95
& I,J,N ! WORK Loop counters SMROOT5A.96
SMROOT5A.97
! Local arrays: SMROOT5A.98
REAL SMROOT5A.99
& RHO_ROOT(NPNTS,NSHYD)! WORK Density of roots in each soil layer SMROOT5A.100
! ! (normalised). SMROOT5A.101
&,RHO_RNORM(NPNTS) ! WORK Normalisation factor for RHO_ROOT. APA1F405.267
&,SMCLA(NPNTS,NSHYD) ! WORK Available soil moisture in each SMROOT5A.102
! ! layer (scaled with root density) SMROOT5A.103
! ! (kg/m2) SMROOT5A.104
&,Z(0:NSHYD) ! WORK Depths of soil layer boundaries (m). APA1F405.268
&,Z_ROOT(NPNTS) ! WORK Rootdepth of the vegetated area (m). SMROOT5A.105
SMROOT5A.106
!---------------------------------------------------------------------- SMROOT5A.107
! Functional type dependent parameters SMROOT5A.108
!---------------------------------------------------------------------- SMROOT5A.109
INTEGER SMROOT5A.110
& R_LAYERS(4) ! Number of soil layers from which water SMROOT5A.111
! ! can be extracted. SMROOT5A.112
!---------------------------------------------------------------------- SMROOT5A.113
! BT NT C3G C4G SMROOT5A.114
!---------------------------------------------------------------------- SMROOT5A.115
DATA R_LAYERS/ 4, 4, 3, 3/ SMROOT5A.116
SMROOT5A.117
SMROOT5A.118
IF (LTIMER) THEN SMROOT5A.119
CALL TIMER('SMROOT ',103) GPB8F405.53
ENDIF SMROOT5A.121
SMROOT5A.122
!---------------------------------------------------------------------- SMROOT5A.123
! Initialisations SMROOT5A.124
!---------------------------------------------------------------------- SMROOT5A.125
DO I=1,NPNTS SMROOT5A.126
SMC(I)=0.0 SMROOT5A.127
V_ROOT(I)=0.0 SMROOT5A.128
Z_ROOT(I)=0.0 SMROOT5A.129
RHO_RNORM(I)=1.0 APA1F405.269
V_SOIL(I)=STHU(I,1)*V_SAT(I) SMROOT5A.130
ENDDO SMROOT5A.131
SMROOT5A.132
APA1F405.270
!---------------------------------------------------------------------- SMROOT5A.133
! Calculate the root density in each layer, assuming either: APA1F405.271
! An exponential profile APA1F405.272
!---------------------------------------------------------------------- SMROOT5A.136
IF (REX_MODEL .EQ. 2) THEN APA1F405.273
APA1F405.274
Z(0)=0.0 APA1F405.275
DO N=1,NSHYD APA1F405.276
Z(N)=Z(N-1)+DZ(N) APA1F405.277
ENDDO APA1F405.278
APA1F405.279
DO I=1,NPNTS SMROOT5A.138
!---------------------------------------------------------------------- APA1F405.280
! Assume here that the gridbox mean rootdepth includes a contribution APA1F405.281
! of 0.1m from the non-vegetated area APA1F405.282
!---------------------------------------------------------------------- APA1F405.283
IF (VFRAC(I).GT.0.0) THEN APA1F405.284
Z_ROOT(I)=(ROOTD(I)-0.1*(1.0-VFRAC(I)))/VFRAC(I) APA1F405.285
ELSE APA1F405.286
Z_ROOT(I)=0.0 APA1F405.287
ENDIF APA1F405.288
APA1F405.289
IF (Z_ROOT(I).GT.0.0) THEN APA1F405.290
RHO_RNORM(I)=(1-EXP(-Z(NSHYD)/Z_ROOT(I)))/Z_ROOT(I) APA1F405.291
ENDIF APA1F405.292
ENDDO APA1F405.293
APA1F405.294
DO N=1,NSHYD APA1F405.295
DO I=1,NPNTS APA1F405.296
IF (V_SAT(I).GT.0.0 .AND. Z_ROOT(I).GT.0.0) THEN APA1F405.297
RHO_ROOT(I,N)=(EXP(-Z(N-1)/Z_ROOT(I)) APA1F405.298
& -EXP(-Z(N)/Z_ROOT(I)))/(DZ(N)*RHO_RNORM(I)) APA1F405.299
ENDIF APA1F405.300
ENDDO APA1F405.301
ENDDO APA1F405.302
APA1F405.303
!---------------------------------------------------------------------- APA1F405.304
! A uniform profile APA1F405.305
!---------------------------------------------------------------------- APA1F405.306
ELSE APA1F405.307
APA1F405.308
DO N=1,NSHYD APA1F405.309
DO I=1,NPNTS APA1F405.310
IF (R_LAYERS(F_TYPE(I)).GE.N) THEN APA1F405.311
RHO_ROOT(I,N)=1.0 APA1F405.312
Z_ROOT(I)=Z_ROOT(I)+DZ(N) APA1F405.313
ELSE APA1F405.314
RHO_ROOT(I,N)=0.0 APA1F405.315
ENDIF APA1F405.316
ENDDO APA1F405.317
ENDDO APA1F405.318
APA1F405.319
ENDIF APA1F405.320
SMROOT5A.147
!---------------------------------------------------------------------- SMROOT5A.148
! Calculate the volumetric soil moisture in the rootzone and the SMROOT5A.149
! available moisture in each soil layer. Only do calculation for SMROOT5A.150
! non land-ice points (V_SAT is set to zero for land-ice points). SMROOT5A.151
!---------------------------------------------------------------------- SMROOT5A.152
DO N=1,NSHYD SMROOT5A.153
DO I=1,NPNTS SMROOT5A.154
SMROOT5A.155
IF (V_SAT(I).GT.0.0 .AND. Z_ROOT(I).GT.0.0) THEN SMROOT5A.156
V_ROOT(I)=V_ROOT(I)+RHO_ROOT(I,N)*STHU(I,N) SMROOT5A.157
& *V_SAT(I)*(DZ(N)/Z_ROOT(I)) SMROOT5A.158
SMCLA(I,N)=RHO_ROOT(I,N)*(STHU(I,N)*V_SAT(I)-V_WILT(I)) SMROOT5A.159
& *RHO_WATER*DZ(N) SMROOT5A.160
SMCLA(I,N)=MAX(SMCLA(I,N),0.0) SMROOT5A.161
SMC(I)=SMC(I)+SMCLA(I,N) SMROOT5A.162
ENDIF SMROOT5A.163
SMROOT5A.164
ENDDO SMROOT5A.165
ENDDO SMROOT5A.166
SMROOT5A.167
!---------------------------------------------------------------------- SMROOT5A.168
! Calculate the fraction of the tranpiration which is extracted from SMROOT5A.169
! each soil layer. SMROOT5A.170
!---------------------------------------------------------------------- SMROOT5A.171
DO N=1,NSHYD SMROOT5A.172
DO I=1,NPNTS SMROOT5A.173
SMROOT5A.174
IF (V_SAT(I).GT.0.0) THEN SMROOT5A.175
SMROOT5A.176
IF (SMC(I).GT.0.0) THEN SMROOT5A.177
WT_EXT(I,N)=SMCLA(I,N)/SMC(I) SMROOT5A.178
ELSE SMROOT5A.179
WT_EXT(I,N)=0.0 SMROOT5A.180
ENDIF SMROOT5A.181
ELSE SMROOT5A.182
WT_EXT(I,N)=0.0 SMROOT5A.183
ENDIF SMROOT5A.184
SMROOT5A.185
ENDDO SMROOT5A.186
ENDDO SMROOT5A.187
SMROOT5A.188
!--------------------------------------------------------------------- SMROOT5A.189
! Diagnose the gridbox mean available soil moisture SMROOT5A.190
!--------------------------------------------------------------------- SMROOT5A.191
DO I=1,NPNTS SMROOT5A.192
SMC(I)=VFRAC(I)*SMC(I) SMROOT5A.193
& +(1-VFRAC(I))*RHO_WATER*DZ(1)* SMROOT5A.194
& MAX(0.0,(V_SOIL(I)-V_WILT(I))) SMROOT5A.195
ENDDO SMROOT5A.196
SMROOT5A.197
IF (LTIMER) THEN SMROOT5A.198
CALL TIMER('SMROOT ',104) GPB8F405.54
ENDIF SMROOT5A.200
SMROOT5A.201
RETURN SMROOT5A.202
END SMROOT5A.203
*ENDIF SMROOT5A.204