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