*IF DEF,A08_1A,OR,DEF,A08_5A GKR1F405.8
C ******************************COPYRIGHT****************************** GTS2F400.9883
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9884
C GTS2F400.9885
C Use, duplication or disclosure of this code is subject to the GTS2F400.9886
C restrictions as set forth in the contract. GTS2F400.9887
C GTS2F400.9888
C Meteorological Office GTS2F400.9889
C London Road GTS2F400.9890
C BRACKNELL GTS2F400.9891
C Berkshire UK GTS2F400.9892
C RG12 2SZ GTS2F400.9893
C GTS2F400.9894
C If no contract has been raised with this copy of the code, the use, GTS2F400.9895
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9896
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9897
C Modelling at the above address. GTS2F400.9898
C ******************************COPYRIGHT****************************** GTS2F400.9899
C GTS2F400.9900
CLL SUBROUTINE SURF_HYD----------------------------------------------- SURFHY1A.3
CLL SURFHY1A.4
CLL PURPOSE : TO CARRY OUT CANOPY AND SURFACE HYDROLOGY CALCULATIONS SURFHY1A.5
CLL SURFHY1A.6
CLL CANOPY WATER CONTENT IS DEPRECIATED BY EVAPORATION SURFHY1A.7
CLL SURFHY1A.8
CLL SNOWMELT IS RUNOFF THE SURFACE WITHOUT INTERACTING SURFHY1A.9
CLL WITH THE CANOPY SURFHY1A.10
CLL SURFHY1A.11
CLL THE CANOPY INTERCEPTION AND SURFACE RUNOFF OF SURFHY1A.12
CLL LARGE-SCALE RAIN IS CALCUALTED SURFHY1A.13
CLL SURFHY1A.14
CLL THE CANOPY INTERCEPTION AND SURFACE RUNOFF OF SURFHY1A.15
CLL CONVECTIVE RAIN IS CALCUALTED SURFHY1A.16
CLL SURFHY1A.17
CLL SURFHY1A.18
CLL SUITABLE FOR SINGLE COLUMN MODEL USE SURFHY1A.19
CLL SURFHY1A.20
CLL WRITTEN FOR CRAY-YMP BY S.ALLEN-BETT AND D.GREGORY SURFHY1A.21
CLL SURFHY1A.22
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: SURFHY1A.23
CLL VERSION DATE SURFHY1A.24
CLL 4.5 01/10/98 Removed old section-version defs. K Rogers GKR1F405.7
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.19
CLL SURFHY1A.25
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 SURFHY1A.26
CLL VERSION NO. 1 18/1/90 SURFHY1A.27
CLL SURFHY1A.28
CLL SYSTEM TASK : P252 SURFHY1A.29
CLL SURFHY1A.30
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER NO 25 SURFHY1A.31
CLL SURFHY1A.32
CLLEND----------------------------------------------------------------- SURFHY1A.33
C SURFHY1A.34
C*L ARGUMENTS--------------------------------------------------------- SURFHY1A.35
C SURFHY1A.36
SUBROUTINE SURF_HYD (NPNTS,E_CANOPY,SNOW_MELT,LS_RAIN, 3,13SURFHY1A.37
* CON_RAIN,DSMC_DT,SURF_ROFF,CAN_WCNT, SURFHY1A.38
* CAN_CPY,INFIL,TOT_TFALL,TIMESTEP) SURFHY1A.39
C SURFHY1A.40
IMPLICIT NONE SURFHY1A.41
C SURFHY1A.42
C----------------------------------------------------------------------- SURFHY1A.43
C VECTOR LENGTHS SURFHY1A.44
C----------------------------------------------------------------------- SURFHY1A.45
C SURFHY1A.46
INTEGER NPNTS ! IN VECTOR LENGTH SURFHY1A.50
C SURFHY1A.51
C SURFHY1A.52
C----------------------------------------------------------------------- SURFHY1A.53
C VARIABLES WHICH ARE INPUT SURFHY1A.54
C----------------------------------------------------------------------- SURFHY1A.55
C SURFHY1A.56
REAL TIMESTEP ! IN MODEL TIMESTEP (S) SURFHY1A.57
C SURFHY1A.58
REAL E_CANOPY(NPNTS) ! IN CANOPY EVAPORATION (KG/M2/S) SURFHY1A.59
C SURFHY1A.60
REAL SNOW_MELT(NPNTS) ! IN SNOW MELT (KG/M2/S) SURFHY1A.61
C SURFHY1A.62
REAL LS_RAIN(NPNTS) ! IN LARGE-SCALE RAIN (KG/M2/S) SURFHY1A.63
C SURFHY1A.64
REAL CON_RAIN(NPNTS) ! IN CONVECTIVE RAIN (KG/M2/S) SURFHY1A.65
C SURFHY1A.66
REAL CAN_CPY(NPNTS) ! IN CANOPY CAPACITY (KG/M2) SURFHY1A.67
C SURFHY1A.68
REAL INFIL(NPNTS) ! IN INFILTRATION RATE(KG/M2/S) SURFHY1A.69
C SURFHY1A.70
C SURFHY1A.71
C----------------------------------------------------------------------- SURFHY1A.72
C VARIABLES WHICH ARE INPUT AND OUTPUT SURFHY1A.73
C----------------------------------------------------------------------- SURFHY1A.74
C SURFHY1A.75
REAL CAN_WCNT(NPNTS) ! INOUT SURFHY1A.76
! IN CANOPY WATER CONTENT (KG/M2) SURFHY1A.77
! OUT UPDATED CANOPY WATER CONTENT SURFHY1A.78
! (KG/M2) SURFHY1A.79
C SURFHY1A.80
C SURFHY1A.81
C----------------------------------------------------------------------- SURFHY1A.82
C VARIABLES WHICH ARE OUTPUT SURFHY1A.83
C----------------------------------------------------------------------- SURFHY1A.84
C SURFHY1A.85
REAL DSMC_DT(NPNTS) ! OUT CUMULATIVE RATE OF CHANGE OF SOIL SURFHY1A.86
! MOISTURE CONTENT WITH TIMES SURFHY1A.87
! (KG/M2/S) SURFHY1A.88
C SURFHY1A.89
REAL SURF_ROFF(NPNTS) ! OUT CUMULATIVE SURFACE RUNOFF (KG/M2/S) SURFHY1A.90
C SURFHY1A.91
REAL TOT_TFALL(NPNTS) ! OUT TOTAL CANOPY THROUGHFALL (KG/M2/S) SURFHY1A.92
C SURFHY1A.93
C SURFHY1A.94
C----------------------------------------------------------------------- SURFHY1A.95
C VARIABLES WHICH ARE DEFINED LOCALLY SURFHY1A.96
C SURFHY1A.97
C ON THE CRAY ARRAYS ARE DYNAMICALLY ALLOCATED SURFHY1A.114
C SURFHY1A.115
C WORK SPACE USAGE : 3 * NPNTS SURFHY1A.116
C SURFHY1A.117
C----------------------------------------------------------------------- SURFHY1A.118
C SURFHY1A.119
C SURFHY1A.120
REAL CAN_COND(NPNTS) ! CANOPY CONDENSATION (KG/M2/S) SURFHY1A.121
C SURFHY1A.122
REAL RUNOFF(NPNTS) ! SURFACE RUNOFF FROM SINGLE WATER SURFHY1A.123
! TYPE (KG/M2/S) SURFHY1A.124
C SURFHY1A.125
REAL TFALL(NPNTS) ! THROUGHFALL FROM SINGLE WATER SURFHY1A.126
! TYPE (KG/M2/S) SURFHY1A.127
C SURFHY1A.128
C SURFHY1A.130
C----------------------------------------------------------------------- SURFHY1A.131
C INTERNAL LOOP COUNTERS SURFHY1A.132
C----------------------------------------------------------------------- SURFHY1A.133
C SURFHY1A.134
INTEGER I ! LOOP COUNTER SURFHY1A.135
C SURFHY1A.136
C SURFHY1A.137
C---------------------------------------------------------------------- SURFHY1A.138
C EXTERNAL SUBROUTINE CALLS SURFHY1A.139
C---------------------------------------------------------------------- SURFHY1A.140
C SURFHY1A.141
EXTERNAL FRUNOFF,SIEVE SURFHY1A.142
C SURFHY1A.143
C*-------------------------------------------------------------------- SURFHY1A.144
C SURFHY1A.145
DO 10 I=1,NPNTS SURFHY1A.146
CL SURFHY1A.147
CL---------------------------------------------------------------------- SURFHY1A.148
CL DEPRECIATE CANOPY WATER CONTENT BY EVAPORATION SURFHY1A.149
CL SURFHY1A.150
CL UM DOCUMENTATION PAPER P25 SURFHY1A.151
CL SECTION (3), EQN(P252.17) SURFHY1A.152
CL---------------------------------------------------------------------- SURFHY1A.153
CL SURFHY1A.154
IF (E_CANOPY(I) .GT. 0.0) SURFHY1A.155
* CAN_WCNT(I) = CAN_WCNT(I)-E_CANOPY(I)*TIMESTEP SURFHY1A.156
C SURFHY1A.157
C----------------------------------------------------------------------- SURFHY1A.158
C NEXT IF TEST INTRODUCED TO PREVENT CANOPY WATER CONTENT BECOMING SURFHY1A.159
C SLIGHTLY NEGATIVE DUE TO ROUNDING ERROR SURFHY1A.160
C----------------------------------------------------------------------- SURFHY1A.161
C SURFHY1A.162
IF (CAN_WCNT(I) . LT. 0.0) CAN_WCNT(I) = 0.0 SURFHY1A.163
C SURFHY1A.164
C----------------------------------------------------------------------- SURFHY1A.165
C ZERO CUMULATIVE STORES SURFHY1A.166
C----------------------------------------------------------------------- SURFHY1A.167
C SURFHY1A.168
TOT_TFALL(I) = 0.0 SURFHY1A.169
SURF_ROFF(I) = 0.0 SURFHY1A.170
DSMC_DT(I) = 0.0 SURFHY1A.171
10 CONTINUE SURFHY1A.172
CL SURFHY1A.173
CL---------------------------------------------------------------------- SURFHY1A.174
CL CALCULATION OF SURFACE RUN0FF OF SNOWMELT SURFHY1A.175
CL SURFHY1A.176
CL UM DOCUMENTATION PAPER NO 25 SURFHY1A.177
CL SECTION (3) SURFHY1A.178
CL---------------------------------------------------------------------- SURFHY1A.179
CL SURFHY1A.180
CALL FRUNOFF
(NPNTS,SNOW_MELT,SNOW_MELT,CAN_CPY,CAN_CPY,INFIL, APA1F405.1
* 1.0,RUNOFF,TIMESTEP) APA1F405.2
C SURFHY1A.183
DO 20 I=1,NPNTS SURFHY1A.184
IF(SNOW_MELT(I) .GT. 0.0)THEN SURFHY1A.185
C SURFHY1A.186
C---------------------------------------------------------------------- SURFHY1A.187
C CUMULATE SURFACE RUNOFF AND RATE OF CHANGE OF SURFHY1A.188
C SOIL MOISTURE CONTENT DUE TO INFILTRATION OF SURFACE WATER SURFHY1A.189
C---------------------------------------------------------------------- SURFHY1A.190
C SURFHY1A.191
SURF_ROFF(I) = RUNOFF(I) SURFHY1A.192
DSMC_DT(I) = (SNOW_MELT(I) - RUNOFF(I)) SURFHY1A.193
END IF SURFHY1A.194
C SURFHY1A.195
C----------------------------------------------------------------------- SURFHY1A.196
C DEFINE CANOPY CONDENSATION (WHEN CANOPY EVAPORATION IS NEGATIVE) SURFHY1A.197
C----------------------------------------------------------------------- SURFHY1A.198
C SURFHY1A.199
IF (E_CANOPY(I) .LT. 0.0) THEN SURFHY1A.200
CAN_COND(I) = -E_CANOPY(I) SURFHY1A.201
ELSE SURFHY1A.202
CAN_COND(I) =0.0 SURFHY1A.203
END IF SURFHY1A.204
20 CONTINUE SURFHY1A.205
CL SURFHY1A.206
CL---------------------------------------------------------------------- SURFHY1A.207
CL CALCULATE CANOPY INTERCEPTION, THROUGHFALL AND SURFACE RUNOFF FOR SURFHY1A.208
CL CANOPY CONDENSATION SURFHY1A.209
CL SURFHY1A.210
CL UM DOCUMENTATION PAPER NO 25 SURFHY1A.211
CL SECTION (3) SURFHY1A.212
CL SURFHY1A.213
CL FRACTIONAL AREA OF GRID BOX WHERE SURFHY1A.214
CL CANOPY CONDENSATION IS ASSUMED TO FALL = 1.0 SURFHY1A.215
CL---------------------------------------------------------------------- SURFHY1A.216
CL SURFHY1A.217
CALL SIEVE (NPNTS,CAN_COND,CAN_WCNT,CAN_CPY,1.0,TFALL, SURFHY1A.218
* TIMESTEP) SURFHY1A.219
C SURFHY1A.220
CALL FRUNOFF (NPNTS,CAN_COND,TFALL,CAN_WCNT,CAN_CPY,INFIL,1.0, APA1F405.3
* RUNOFF,TIMESTEP) APA1F405.4
C SURFHY1A.223
DO 30 I=1,NPNTS SURFHY1A.224
IF (CAN_COND(I) .GT. 0.0) THEN SURFHY1A.225
C SURFHY1A.226
C----------------------------------------------------------------------- SURFHY1A.227
C UPDATE CANOPY WATER CONTENT FOR INTERCEPTION OF CANOPY SURFHY1A.228
C CONDENSATION SURFHY1A.229
C SURFHY1A.230
C UM DOCUMENTATION PAPER NO 25 SURFHY1A.231
C SECTION (3(I)), EQN(P252.10) SURFHY1A.232
C----------------------------------------------------------------------- SURFHY1A.233
C SURFHY1A.234
CAN_WCNT(I) = CAN_WCNT(I) + (CAN_COND(I) - TFALL(I))*TIMESTEP SURFHY1A.235
C SURFHY1A.236
C---------------------------------------------------------------------- SURFHY1A.237
C CUMULATE THROUGHFALL, SURAFCE RUNOFF AND RATE OF CHANGE OF SURFHY1A.238
C SOIL MOISTURE CONTENT DUE TO INFILTRATION OF SURFACE WATER SURFHY1A.239
C---------------------------------------------------------------------- SURFHY1A.240
C SURFHY1A.241
TOT_TFALL(I) = TFALL(I) SURFHY1A.242
SURF_ROFF(I) = SURF_ROFF(I) + RUNOFF(I) SURFHY1A.243
DSMC_DT(I) = DSMC_DT(I) + (TFALL(I) - RUNOFF(I)) SURFHY1A.244
C SURFHY1A.245
END IF SURFHY1A.246
30 CONTINUE SURFHY1A.247
CL SURFHY1A.248
CL---------------------------------------------------------------------- SURFHY1A.249
CL CALCULATE CANOPY INTERCEPTION, THROUGHFALL AND SURFACE RUNOFF FOR SURFHY1A.250
CL LARGE-SCALE RAIN SURFHY1A.251
CL SURFHY1A.252
CL UM DOCUMENTATION PAPER NO 25 SURFHY1A.253
CL SECTION (3) SURFHY1A.254
CL SURFHY1A.255
CL FRACTIONAL AREA OF GRID BOX WHERE SURFHY1A.256
CL LARGE-SCALE RAIN IS ASSUMED TO FALL = 0.5 SURFHY1A.257
CL---------------------------------------------------------------------- SURFHY1A.258
CL SURFHY1A.259
CALL SIEVE (NPNTS,LS_RAIN,CAN_WCNT,CAN_CPY,1.0,TFALL, SURFHY1A.260
* TIMESTEP) SURFHY1A.261
C SURFHY1A.262
CALL FRUNOFF (NPNTS,LS_RAIN,TFALL,CAN_WCNT,CAN_CPY,INFIL,1.0, APA1F405.5
* RUNOFF,TIMESTEP) APA1F405.6
C SURFHY1A.265
DO 40 I=1,NPNTS SURFHY1A.266
IF (LS_RAIN(I) .GT. 0.0) THEN SURFHY1A.267
C SURFHY1A.268
C----------------------------------------------------------------------- SURFHY1A.269
C UPDATE CANOPY WATER CONTENT FOR INTERCEPTION OF SURFHY1A.270
C LARGE-SCALE RAIN SURFHY1A.271
C SURFHY1A.272
C UM DOCUMENTATION PAPER NO 25 SURFHY1A.273
C SECTION (3(I)), EQN(P252.10) SURFHY1A.274
C----------------------------------------------------------------------- SURFHY1A.275
C SURFHY1A.276
CAN_WCNT(I) = CAN_WCNT(I) + (LS_RAIN(I) - TFALL(I))*TIMESTEP SURFHY1A.277
C SURFHY1A.278
C---------------------------------------------------------------------- SURFHY1A.279
C CUMULATE THROUGHFALL, SURAFCE RUNOFF AND RATE OF CHANGE OF SURFHY1A.280
C SOIL MOISTURE CONTENT DUE TO INFILTRATION OF SURFACE WATER SURFHY1A.281
C---------------------------------------------------------------------- SURFHY1A.282
C SURFHY1A.283
TOT_TFALL(I) = TOT_TFALL(I)+TFALL(I) SURFHY1A.284
SURF_ROFF(I) = SURF_ROFF(I)+RUNOFF(I) SURFHY1A.285
DSMC_DT(I) = DSMC_DT(I) + (TFALL(I) - RUNOFF(I)) SURFHY1A.286
C SURFHY1A.287
END IF SURFHY1A.288
C SURFHY1A.289
40 CONTINUE SURFHY1A.290
CL SURFHY1A.291
CL---------------------------------------------------------------------- SURFHY1A.292
CL CALCULATE CANOPY INTERCEPTION, THROUGHFALL AND SURFACE RUNOFF FOR SURFHY1A.293
CL CONVECTIVE RAIN SURFHY1A.294
CL SURFHY1A.295
CL UM DOCUMENTATION PAPER NO 25 SURFHY1A.296
CL SECTION (3) SURFHY1A.297
CL SURFHY1A.298
CL FRACTIONAL AREA OF GRID BOX WHERE SURFHY1A.299
CL CONVECTIVE RAIN IS ASSUMED TO FALL = 0.1 SURFHY1A.300
CL---------------------------------------------------------------------- SURFHY1A.301
CL SURFHY1A.302
CALL SIEVE (NPNTS,CON_RAIN,CAN_WCNT,CAN_CPY,0.3,TFALL, SURFHY1A.303
* TIMESTEP) SURFHY1A.304
C SURFHY1A.305
CALL FRUNOFF (NPNTS,CON_RAIN,TFALL,CAN_WCNT,CAN_CPY,INFIL,0.3, APA1F405.7
* RUNOFF,TIMESTEP) APA1F405.8
C SURFHY1A.308
DO 50 I= 1,NPNTS SURFHY1A.309
IF (CON_RAIN(I) .GT. 0.0) THEN SURFHY1A.310
C SURFHY1A.311
C----------------------------------------------------------------------- SURFHY1A.312
C UPDATE CANOPY WATER CONTENT FOR INTERCEPTION OF SURFHY1A.313
C CONVECTIVE RAIN SURFHY1A.314
C SURFHY1A.315
C UM DOCUMENTATION PAPER NO 25 SURFHY1A.316
C SECTION (3(I)), EQN(P252.10) SURFHY1A.317
C----------------------------------------------------------------------- SURFHY1A.318
C SURFHY1A.319
CAN_WCNT(I) = CAN_WCNT(I) + (CON_RAIN(I) - TFALL(I))*TIMESTEP SURFHY1A.320
C SURFHY1A.321
C---------------------------------------------------------------------- SURFHY1A.322
C CUMULATE THROUGHFALL, SURAFCE RUNOFF AND RATE OF CHANGE OF SURFHY1A.323
C SOIL MOISTURE CONTENT DUE TO INFILTRATION OF SURFACE WATER SURFHY1A.324
C---------------------------------------------------------------------- SURFHY1A.325
C SURFHY1A.326
TOT_TFALL(I) = TOT_TFALL(I)+TFALL(I) SURFHY1A.327
SURF_ROFF(I) = SURF_ROFF(I)+RUNOFF(I) SURFHY1A.328
DSMC_DT(I) = DSMC_DT(I) + (TFALL(I) - RUNOFF(I)) SURFHY1A.329
C SURFHY1A.330
END IF SURFHY1A.331
C SURFHY1A.332
50 CONTINUE SURFHY1A.333
C SURFHY1A.334
RETURN SURFHY1A.335
END SURFHY1A.336
*ENDIF SURFHY1A.337