*IF DEF,A08_5A HYDROL5A.2
C *****************************COPYRIGHT****************************** HYDROL5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. HYDROL5A.4
C HYDROL5A.5
C Use, duplication or disclosure of this code is subject to the HYDROL5A.6
C restrictions as set forth in the contract. HYDROL5A.7
C HYDROL5A.8
C Meteorological Office HYDROL5A.9
C London Road HYDROL5A.10
C BRACKNELL HYDROL5A.11
C Berkshire UK HYDROL5A.12
C RG12 2SZ HYDROL5A.13
C HYDROL5A.14
C If no contract has been raised with this copy of the code, the use, HYDROL5A.15
C duplication or disclosure of it is strictly prohibited. Permission HYDROL5A.16
C to do so must first be obtained in writing from the Head of Numerical HYDROL5A.17
C Modelling at the above address. HYDROL5A.18
C ******************************COPYRIGHT****************************** HYDROL5A.19
! SUBROUTINE HYDROL------------------------------------------------- HYDROL5A.20
! HYDROL5A.21
! Subroutine Interface: HYDROL5A.22
SUBROUTINE HYDROL ( 3,22HYDROL5A.23
& LICE_PTS,LICE_INDEX,SOIL_PTS,SOIL_INDEX, HYDROL5A.24
& NPNTS,NSHYD,B,CAN_CPY,CON_RAIN,CON_SNOW, HYDROL5A.25
& E_CANOPY,EXT,HCAP,HCON,INFIL_FAC,LS_RAIN, HYDROL5A.26
& LS_SNOW,ROOTD,SATCON,SATHH,SNOWSUB, HYDROL5A.27
& SURF_HT_FLUX,TIMESTEP,VFRAC,V_SAT,V_WILT, HYDROL5A.28
& TSTAR,RGRAIN,L_SNOW_ALBEDO, ARE2F404.443
& CAN_WCNT,HF_SNOW_MELT,STF_HF_SNOW_MELT, HYDROL5A.29
& SMCL,STHF,STHU,SNOW_DEP,TSOIL, HYDROL5A.30
& INFIL,SMC,SNOW_MELT,SNOMLT_SUB_HTF, HYDROL5A.31
& STF_SUB_SURF_ROFF,SUB_SURF_ROFF,SURF_ROFF, HYDROL5A.32
& TOT_TFALL,LTIMER HYDROL5A.33
&) HYDROL5A.34
HYDROL5A.35
IMPLICIT NONE HYDROL5A.36
! HYDROL5A.37
! Description: HYDROL5A.38
! Surface hydrology module which also updates the HYDROL5A.39
! sub-surface temperatures. Includes soil water phase HYDROL5A.40
! changes and the effect of soil water and ice on the HYDROL5A.41
! thermal and hydraulic characteristics of the soil. HYDROL5A.42
! This version is for use with the Penman-Monteith HYDROL5A.43
! surface flux scheme. Calls the following: HYDROL5A.44
! HYDROL5A.45
! HEAT_CAP - to calculate the heat capacity of the top HYDROL5A.46
! soil layer (Cox, 6/95) HYDROL5A.47
! HYDROL5A.48
! SFSNOW - to calculate the sub-surface snowmelt HYDROL5A.49
! and update the lying snow amount (Essery, 1/95) HYDROL5A.50
! HYDROL5A.51
! INFILT - to calculate the maximum surface infiltration rate HYDROL5A.52
! (Cox, 6/95) HYDROL5A.53
! HYDROL5A.54
! SURF_HYD - to calculate canopy interception and HYDROL5A.55
! surface runoff (Allen-Bett, Gregory, 90) HYDROL5A.56
! HYDROL5A.57
! SOIL_HYD - to update the layer soil moisture contents HYDROL5A.58
! and calculate the drainage (Cox 6/95) HYDROL5A.59
! HYDROL5A.60
! SOIL_HTC - to update the soil layer temperatures and the HYDROL5A.61
! layer ice contents (Cox 6/95) HYDROL5A.62
! HYDROL5A.63
! ICE_HTC - to update the layer temperatures for land ice HYDROL5A.64
! (Cox 10/95) HYDROL5A.65
! HYDROL5A.66
! SMC_ROOT - to diagnose the available soil moisture in the HYDROL5A.67
! rootzone - Temporarary (Cox 2/96) HYDROL5A.68
! HYDROL5A.69
! Documentation : UM Documentation Paper 25 HYDROL5A.70
! HYDROL5A.71
! Current Code Owner : David Gregory HYDROL5A.72
! HYDROL5A.73
! History: HYDROL5A.74
! Version Date Comment HYDROL5A.75
! ------- ---- ------- HYDROL5A.76
! 4.1 6/96 New deck. Peter Cox HYDROL5A.77
! 4.4 24/11/97 Don't call SOIL_HTC/ICE_HTC if there are no GSM1F404.67
! soil/ice points. S.D.Mullerworth GSM1F404.68
! 4.4 29/10/97 Modified for prognostic snow albedo scheme ARE2F404.444
! R. Essery ARE2F404.445
! HYDROL5A.78
! Code Description: HYDROL5A.79
! Language: FORTRAN 77 + common extensions. HYDROL5A.80
! HYDROL5A.81
! System component covered: P25 HYDROL5A.82
! System Task: P25 HYDROL5A.83
! HYDROL5A.84
HYDROL5A.85
! Global variables: HYDROL5A.86
*CALL C_LHEAT 
HYDROL5A.87
*CALL C_SOILH HYDROL5A.88
*CALL SOIL_THICK HYDROL5A.89
HYDROL5A.90
! Subroutine arguments HYDROL5A.91
! Scalar arguments with intent(IN) : HYDROL5A.92
INTEGER HYDROL5A.93
& LICE_PTS ! IN Number of land ice points. HYDROL5A.94
&,NPNTS ! IN Number of gridpoints. HYDROL5A.95
&,NSHYD ! IN Number of soil moisture levels. HYDROL5A.96
&,SOIL_PTS ! IN Number of soil points. HYDROL5A.97
HYDROL5A.98
REAL HYDROL5A.99
& TIMESTEP ! IN Model timestep (s). HYDROL5A.100
HYDROL5A.101
LOGICAL LTIMER ! Logical switch for TIMER diags HYDROL5A.102
HYDROL5A.103
LOGICAL HYDROL5A.104
& STF_HF_SNOW_MELT ! IN Stash flag for snowmelt heat flux. HYDROL5A.105
&,STF_SUB_SURF_ROFF ! IN Stash flag for sub-surface runoff. HYDROL5A.106
&,L_SNOW_ALBEDO ! IN Flag for prognostic snow albedo ARE2F404.446
HYDROL5A.107
HYDROL5A.108
! Array arguments with intent(IN) : HYDROL5A.109
INTEGER HYDROL5A.110
& LICE_INDEX(NPNTS) ! IN Array of land ice points. HYDROL5A.111
&,SOIL_INDEX(NPNTS) ! IN Array of soil points. HYDROL5A.112
HYDROL5A.113
REAL HYDROL5A.114
& B(NPNTS) ! IN Clapp-Hornberger exponent. HYDROL5A.115
&,CAN_CPY(NPNTS) ! IN Canopy capacity (kg/m2). HYDROL5A.116
&,CON_RAIN(NPNTS) ! IN Convective rain (kg/m2/s). HYDROL5A.117
&,CON_SNOW(NPNTS) ! IN Convective snowfall (kg/m2/s). HYDROL5A.118
&,E_CANOPY(NPNTS) ! IN Canopy evaporation (kg/m2/s). HYDROL5A.119
&,EXT(NPNTS,NSHYD) ! IN Extraction of water from each soil HYDROL5A.120
! ! layer (kg/m2/s). HYDROL5A.121
&,HCAP(NPNTS) ! IN Soil heat capacity (J/K/m3). HYDROL5A.122
&,HCON(NPNTS) ! IN Soil thermal conductivity (W/m/K). HYDROL5A.123
&,INFIL_FAC(NPNTS) ! IN Infiltration enhancement factor. HYDROL5A.124
&,LS_RAIN(NPNTS) ! IN Large-scale rain (kg/m2/s). HYDROL5A.125
&,LS_SNOW(NPNTS) ! IN Large-scale snowfall (kg/m2/s). HYDROL5A.126
&,ROOTD(NPNTS) ! IN Rootdepth (m). HYDROL5A.127
&,SATCON(NPNTS) ! IN Saturated hydraulic conductivity HYDROL5A.128
! ! (kg/m2/s). HYDROL5A.129
&,SATHH(NPNTS) ! IN Saturated soil water pressure (m). HYDROL5A.130
&,SNOWSUB(NPNTS) ! IN Sublimation of lying snow (kg/m2/s). HYDROL5A.131
&,SURF_HT_FLUX(NPNTS) ! IN Net downward surface heat flux (W/m2). HYDROL5A.132
&,TSTAR(NPNTS) ! IN Surface temperature (K). ARE2F404.447
&,VFRAC(NPNTS) ! IN Vegetated fraction. HYDROL5A.133
&,V_SAT(NPNTS) ! IN Volumetric soil moisture HYDROL5A.134
! ! concentration at saturation HYDROL5A.135
! ! (m3 H2O/m3 soil). HYDROL5A.136
&,V_WILT(NPNTS) ! IN Volumetric soil moisture HYDROL5A.137
! ! concentration below which HYDROL5A.138
! ! stomata close (m3 H2O/m3 soil). HYDROL5A.139
! HYDROL5A.140
! Array arguments with intent(INOUT) : HYDROL5A.141
! HYDROL5A.142
REAL HYDROL5A.143
& CAN_WCNT(NPNTS) ! INOUT Canopy water content (kg/m2). HYDROL5A.144
&,HF_SNOW_MELT(NPNTS) ! INOUT Total snowmelt heat flux (W/m2). HYDROL5A.145
&,RGRAIN(NPNTS) ! INOUT Snow grain size (microns). ARE2F404.448
&,SMCL(NPNTS,NSHYD) ! INOUT Soil moisture content of each HYDROL5A.146
! ! layer (kg/m2). HYDROL5A.147
&,SNOW_DEP(NPNTS) ! INOUT Snowmass (kg/m2). HYDROL5A.148
&,SNOW_MELT(NPNTS) ! INOUT Snowmelt (kg/m2/s). ABX4F404.1
&,STHF(NPNTS,NSHYD) ! INOUT Frozen soil moisture content of HYDROL5A.149
! ! each layer as a fraction of HYDROL5A.150
! ! saturation. HYDROL5A.151
&,STHU(NPNTS,NSHYD) ! INOUT Unfrozen soil moisture content of HYDROL5A.152
! ! each layer as a fraction of HYDROL5A.153
! ! saturation. HYDROL5A.154
&,TSOIL(NPNTS,NSHYD) ! INOUT Sub-surface temperatures (K). HYDROL5A.155
HYDROL5A.156
HYDROL5A.157
! Array arguments with intent(OUT) : HYDROL5A.158
REAL HYDROL5A.159
& INFIL(NPNTS) ! OUT Maximum surface infiltration HYDROL5A.160
! rate (kg/m2/s). HYDROL5A.161
&,SMC(NPNTS) ! OUT Available soil moisture in the HYDROL5A.162
! rootzone (kg/m2). HYDROL5A.163
ABX4F404.2
ABX4F404.3
ABX4F404.4
&,SNOMLT_SUB_HTF(NPNTS)! OUT Sub-surface snowmelt heat HYDROL5A.165
! flux (W/m2). HYDROL5A.166
&,SUB_SURF_ROFF(NPNTS) ! OUT Sub-surface runoff (kg/m2/s). HYDROL5A.167
&,SURF_ROFF(NPNTS) ! OUT Surface runoff (kg/m2/s). HYDROL5A.168
&,TOT_TFALL(NPNTS) ! OUT Total throughfall (kg/m2/s). HYDROL5A.169
HYDROL5A.170
! Local scalars: HYDROL5A.171
INTEGER HYDROL5A.172
& I ! WORK Loop counter. HYDROL5A.173
HYDROL5A.174
HYDROL5A.175
! Local arrays: HYDROL5A.176
INTEGER HYDROL5A.177
& F_TYPE(NPNTS) ! WORK Plant functional type: HYDROL5A.178
! ! 1 - Broadleaf Tree HYDROL5A.179
! ! 2 - Needleleaf Tree HYDROL5A.180
! ! 3 - C3 Grass HYDROL5A.181
! ! 4 - C4 Grass HYDROL5A.182
HYDROL5A.183
REAL HYDROL5A.184
& ASOIL(NPNTS) ! WORK Reciprocal areal heat capacity HYDROL5A.185
! of the top soil layer (K m2/J). HYDROL5A.186
&,DSMC_DT(NPNTS) ! WORK Rate of change of soil moisture HYDROL5A.187
! due to water falling onto the HYDROL5A.188
! surface after surface runoff HYDROL5A.189
! (kg/m2/s). HYDROL5A.190
&,HCAPS(NPNTS) ! WORK Soil thermal capacity HYDROL5A.191
! including the effects of water HYDROL5A.192
! and ice (W/m/K). HYDROL5A.193
&,SOIL_HT_FLUX12(NPNTS)! WORK Heat flux between soil layers HYDROL5A.194
! 1 and 2 (W/m2). HYDROL5A.195
&,V_ROOT(NPNTS) ! WORK Volumetric soil moisture HYDROL5A.196
! ! concentration in the rootzone HYDROL5A.197
! ! (m3 H2O/m3 soil). HYDROL5A.198
&,V_SOIL(NPNTS) ! WORK Volumetric soil moisture HYDROL5A.199
! ! concentration in the top HYDROL5A.200
! ! soil layer (m3 H2O/m3 soil). HYDROL5A.201
&,W_FLUX(NPNTS,0:NSHYD)! WORK Fluxes of water between layers HYDROL5A.202
! (kg/m2/s). HYDROL5A.203
&,WT_EXT(NPNTS,NSHYD) ! WORK Fraction of transpiration which HYDROL5A.204
! is extracted from each soil layer. HYDROL5A.205
! Function & Subroutine calls: HYDROL5A.206
EXTERNAL HYDROL5A.207
& HEAT_CAP,SFSNOW,INFILT,SURF_HYD,SOIL_HYD,SOIL_HTC,ICE_HTC HYDROL5A.208
HYDROL5A.209
! End of header-------------------------------------------------------- HYDROL5A.210
HYDROL5A.211
IF (LTIMER) THEN HYDROL5A.212
CALL TIMER('HYDROL ',103) GPB8F405.152
ENDIF HYDROL5A.214
!---------------------------------------------------------------------- HYDROL5A.215
! Calculate the heat capacity of the top soil layer HYDROL5A.216
!---------------------------------------------------------------------- HYDROL5A.217
CALL HEAT_CAP (NPNTS,SOIL_PTS,SOIL_INDEX,B,DZSOIL, HYDROL5A.218
& HCAP,SATHH,SMCL,STHF,TSOIL,V_SAT,HCAPS,LTIMER) HYDROL5A.219
HYDROL5A.220
!---------------------------------------------------------------------- HYDROL5A.221
! Calculate the reciprocal areal heat capacity of the top soil layer HYDROL5A.222
!---------------------------------------------------------------------- HYDROL5A.223
DO I=1,NPNTS HYDROL5A.224
ASOIL(I)=1./(DZSOIL(1)*HCAPS(I)) HYDROL5A.225
ENDDO HYDROL5A.226
HYDROL5A.227
!---------------------------------------------------------------------- HYDROL5A.228
! Calculate the subsurface snowmelt and update the snow mass HYDROL5A.229
!---------------------------------------------------------------------- HYDROL5A.230
CALL SFSNOW (ASOIL,CON_SNOW,LS_SNOW,SNOWSUB,TSTAR, ARE2F404.449
& TIMESTEP,NPNTS,SNOW_DEP,RGRAIN,L_SNOW_ALBEDO, ARE2F404.450
& TSOIL,SNOW_MELT,SNOMLT_SUB_HTF,STF_HF_SNOW_MELT, ARE2F404.451
& LTIMER) ARE2F404.452
HYDROL5A.234
!---------------------------------------------------------------------- HYDROL5A.235
! Update the total snowmelt heat flux HYDROL5A.236
!---------------------------------------------------------------------- HYDROL5A.237
IF (STF_HF_SNOW_MELT) THEN HYDROL5A.238
DO I=1,NPNTS HYDROL5A.239
HF_SNOW_MELT(I)=LF*SNOW_MELT(I) HYDROL5A.240
ENDDO HYDROL5A.241
ENDIF HYDROL5A.242
HYDROL5A.243
!---------------------------------------------------------------------- HYDROL5A.244
! Calculate the maximum surface infiltration rate HYDROL5A.245
!---------------------------------------------------------------------- HYDROL5A.246
CALL INFILT (NPNTS,SOIL_PTS,SOIL_INDEX,B,SATCON,INFIL_FAC,STHF, HYDROL5A.247
& INFIL,LTIMER) HYDROL5A.248
HYDROL5A.249
!----------------------------------------------------------------------- HYDROL5A.250
! Calculate throughfall and surface runoff, and update the canopy water HYDROL5A.251
! content HYDROL5A.252
!----------------------------------------------------------------------- HYDROL5A.253
CALL SURF_HYD (NPNTS,E_CANOPY,SNOW_MELT,LS_RAIN, HYDROL5A.254
& CON_RAIN,DSMC_DT,SURF_ROFF,CAN_WCNT, HYDROL5A.255
& CAN_CPY,INFIL,TOT_TFALL,TIMESTEP) HYDROL5A.256
HYDROL5A.257
!----------------------------------------------------------------------- HYDROL5A.258
! Update the layer soil moisture contents and calculate the HYDROL5A.259
! gravitational drainage. HYDROL5A.260
!----------------------------------------------------------------------- HYDROL5A.261
CALL SOIL_HYD (NPNTS,NSHYD,SOIL_PTS,SOIL_INDEX,B,DZSOIL, HYDROL5A.262
& EXT,DSMC_DT,SATCON,SATHH,TIMESTEP,V_SAT, HYDROL5A.263
& SUB_SURF_ROFF,SMCL,STHU,W_FLUX, HYDROL5A.264
& STF_SUB_SURF_ROFF,LTIMER) HYDROL5A.265
HYDROL5A.266
!----------------------------------------------------------------------- HYDROL5A.267
! Update the soil temperatures and the frozen moisture fractions HYDROL5A.268
!----------------------------------------------------------------------- HYDROL5A.269
IF (SOIL_PTS.NE.0) THEN GSM1F404.69
CALL SOIL_HTC (NPNTS,NSHYD,SOIL_PTS,SOIL_INDEX,B, GSM1F404.70
& DZSOIL,HCAP,HCON,SNOW_DEP,SATHH, HYDROL5A.271
& SURF_HT_FLUX,TIMESTEP,V_SAT, HYDROL5A.272
& W_FLUX,SMCL,STHU,STHF,TSOIL,LTIMER) HYDROL5A.273
ENDIF GSM1F404.71
HYDROL5A.274
!----------------------------------------------------------------------- HYDROL5A.275
! Update the sub-surface temperatures for land ice HYDROL5A.276
!----------------------------------------------------------------------- HYDROL5A.277
IF (LICE_PTS.NE.0)THEN GSM1F404.72
CALL ICE_HTC (NPNTS,NSHYD,LICE_PTS,LICE_INDEX,DZSOIL, GSM1F404.73
& SURF_HT_FLUX,TIMESTEP, HYDROL5A.279
& TSOIL,LTIMER) HYDROL5A.280
ENDIF GSM1F404.74
HYDROL5A.281
!----------------------------------------------------------------------- HYDROL5A.282
! Diagnose the plant functional types at each location (temporary). HYDROL5A.283
! Assume : Broadleaf Trees if rootdepth > 0.8m HYDROL5A.284
! C3 Grass if rootdepth < 0.8m HYDROL5A.285
!----------------------------------------------------------------------- HYDROL5A.286
DO I=1,NPNTS HYDROL5A.287
IF (ROOTD(I).GT.0.8) THEN HYDROL5A.288
F_TYPE(I)=1 HYDROL5A.289
ELSE HYDROL5A.290
F_TYPE(I)=3 HYDROL5A.291
ENDIF HYDROL5A.292
ENDDO HYDROL5A.293
HYDROL5A.294
!----------------------------------------------------------------------- HYDROL5A.295
! Diagnose the soil moisture in the root zone. HYDROL5A.296
!----------------------------------------------------------------------- HYDROL5A.297
CALL SMC_ROOT (NPNTS,NSHYD,F_TYPE,DZSOIL,ROOTD,STHU,VFRAC, APA1F405.321
& V_SAT,V_WILT,SMC,V_ROOT,V_SOIL,WT_EXT,LTIMER) HYDROL5A.299
HYDROL5A.300
HYDROL5A.301
IF (LTIMER) THEN HYDROL5A.302
CALL TIMER('HYDROL ',104) GPB8F405.153
ENDIF HYDROL5A.304
HYDROL5A.305
RETURN HYDROL5A.306
END HYDROL5A.307
*ENDIF HYDROL5A.308