*IF DEF,A08_1A GKR1F405.5
C ******************************COPYRIGHT****************************** GTS2F400.8893
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8894
C GTS2F400.8895
C Use, duplication or disclosure of this code is subject to the GTS2F400.8896
C restrictions as set forth in the contract. GTS2F400.8897
C GTS2F400.8898
C Meteorological Office GTS2F400.8899
C London Road GTS2F400.8900
C BRACKNELL GTS2F400.8901
C Berkshire UK GTS2F400.8902
C RG12 2SZ GTS2F400.8903
C GTS2F400.8904
C If no contract has been raised with this copy of the code, the use, GTS2F400.8905
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8906
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8907
C Modelling at the above address. GTS2F400.8908
C ******************************COPYRIGHT****************************** GTS2F400.8909
C GTS2F400.8910
CLL SUBROUTINE SFSNOW ------------------------------------------------ SFSNOW1A.3
CLL SFSNOW1A.4
CLL Purpose: Calculates the decrease/increase in snowdepth due to the SFSNOW1A.5
CLL sublimation/deposition of lying snow; adds the large- SFSNOW1A.6
CLL scale and convective snowfall to the snowdepth; SFSNOW1A.7
CLL melts snow when the input surface temperature is above SFSNOW1A.8
CLL the melting point of ice, and adjusts the surface SFSNOW1A.9
CLL temperature to account for latent cooling thus caused. SFSNOW1A.10
CLL SFSNOW1A.11
CLL Model Modification history from model version 3.0: SFSNOW1A.12
CLL version Date SFSNOW1A.13
CLL 4.2 Oct. 96 T3E migration: *DEF CRAY removed (was used to GSS1F402.106
CLL switch on dynamic allocation) GSS1F402.107
CLL S.J.Swarbrick GSS1F402.108
CLL 4.4 17/9/97 Updates snow grain size if required for ARE2F404.453
CLL prognostic snow albedo R. Essery ARE2F404.454
CLL 4.5 01/10/98 Removed old section-version defs. K Rogers GKR1F405.4
CLL SFSNOW1A.14
CLL Programming standard: Unified Model Documentation Paper No.4 SFSNOW1A.15
CLL version no. 2, dated 18/1/90. SFSNOW1A.16
CLL SFSNOW1A.17
CLL Logical component covered: P251. SFSNOW1A.18
CLL SFSNOW1A.19
CLL System task: SFSNOW1A.20
CLL SFSNOW1A.21
CLL Documentation: um documentation paper no 25 SFSNOW1A.22
CLLEND------------------------------------------------------------------ SFSNOW1A.23
C SFSNOW1A.24
C*L ARGUMENTS:--------------------------------------------------------- SFSNOW1A.25
SUBROUTINE SFSNOW( 3,4SFSNOW1A.26
+ CONV_SNOW,HCAP,HCON,LS_SNOW,SNOW_SUB,TIMESTEP,POINTS, SFSNOW1A.27
+ RGRAIN,L_SNOW_ALBEDO,LYING_SNOW,TSTAR,SNOWMELT ARE2F404.455
+,SNOWMELT_HTF,STF_SNOWMELT_HTF SFSNOW1A.29
+) SFSNOW1A.30
IMPLICIT NONE SFSNOW1A.31
INTEGER POINTS ! IN Number of points to be processed. SFSNOW1A.32
REAL SFSNOW1A.33
+ CONV_SNOW(POINTS) ! IN Convective snowfall (kg per sq m per s) SFSNOW1A.34
+,HCAP(POINTS) ! IN Soil heat capacity (J per K per m**3). SFSNOW1A.35
+,HCON(POINTS) ! IN Soil thermal conductivity SFSNOW1A.36
C ! (J per m per s per K). SFSNOW1A.37
+,LS_SNOW(POINTS) ! IN Large-scale snowfall (kg per sq m per s) SFSNOW1A.38
+,SNOW_SUB(POINTS) ! IN Sublimation of lying snow (kg/sq m/s). SFSNOW1A.39
REAL TIMESTEP ! IN Timestep in seconds. SFSNOW1A.40
REAL SFSNOW1A.41
+ LYING_SNOW(POINTS) ! INOUT Snow on the ground (kg per sq m). SFSNOW1A.42
+,RGRAIN(POINTS) ! INOUT Snow grain size (microns). ARE2F404.456
+,TSTAR(POINTS) ! INOUT Surface temperature (K). SFSNOW1A.43
REAL SFSNOW1A.44
+ SNOWMELT(POINTS) ! OUT Snowmelt (kg per sq m per second). SFSNOW1A.45
+,SNOWMELT_HTF(POINTS) ! OUT Snowmelt heat flux (Watts per sq m). SFSNOW1A.46
LOGICAL STF_SNOWMELT_HTF ! IN stash flag for snow melt heat flux SFSNOW1A.47
+,L_SNOW_ALBEDO ! IN Flag for prognostic snow albedo ARE2F404.457
C----------------------------------------------------------------------- SFSNOW1A.48
C* SFSNOW1A.49
C Define common then local physical constants -------------------------- SFSNOW1A.50
*CALL C_LHEAT 
SFSNOW1A.51
*CALL C_0_DG_C SFSNOW1A.52
REAL OMEGA1 SFSNOW1A.53
PARAMETER ( SFSNOW1A.54
+ OMEGA1=3.55088E-4 ! Characteristic freq (rad per sec; tunable). SFSNOW1A.55
+) SFSNOW1A.56
C SFSNOW1A.57
C WORKSPACE USAGE------------------------------------------------------- SFSNOW1A.58
C 1 real work array of full length is required. SFSNOW1A.59
REAL SFSNOW1A.61
+ ASOIL(POINTS) ! WORK ASOIL(1) - may be replaced by i/p. SFSNOW1A.62
C NO EXTERNAL SUBROUTINES CALLED---------------------------------------- SFSNOW1A.69
C*---------------------------------------------------------------------- SFSNOW1A.70
C Define local variables----------------------------------------------- SFSNOW1A.71
REAL SFSNOW1A.72
+ SMELT_TO_DT ! See comments for contents. SFSNOW1A.73
+,R0 ! Grain size for fresh snow (microns). ARE2F404.458
+,RMAX ! Maximum snow grain size (microns). ARE2F404.459
+,RATE ! Grain area growth rate (microns**2 / s). ARE2F404.460
+,SNOWFALL ! Snowfall in timestep (kg/m2). ARE2F404.461
PARAMETER (R0 = 50., RMAX = 2000.) ARE2F404.462
INTEGER I ! Loop counter; horizontal field index. SFSNOW1A.74
C SFSNOW1A.75
DO 1 I=1,POINTS SFSNOW1A.76
ASOIL(I)=0.0 SFSNOW1A.77
SMELT_TO_DT=1.0 SFSNOW1A.78
C SFSNOW1A.79
C----------------------------------------------------------------------- SFSNOW1A.80
CL 1. Alter snowdepth as a result of snowfall and turbulent mass SFSNOW1A.81
CL transport (equations P251.1 and P251.2 combined). SFSNOW1A.82
C----------------------------------------------------------------------- SFSNOW1A.83
C SFSNOW1A.84
LYING_SNOW(I) = MAX ( 0.0, LYING_SNOW(I)-TIMESTEP*SNOW_SUB(I) ) SFSNOW1A.85
LYING_SNOW(I) = LYING_SNOW(I) + TIMESTEP * SFSNOW1A.86
& ( LS_SNOW(I) + CONV_SNOW(I) ) SFSNOW1A.87
C SFSNOW1A.88
C----------------------------------------------------------------------- SFSNOW1A.89
CL 2. Melt snow over land if TSTAR is above freezing. SFSNOW1A.90
CL Snowmelt is calculated as kg per sq m PER TIMESTEP, for internal SFSNOW1A.91
CL convenience/efficiency. Bear this in mind when comparing code SFSNOW1A.92
CL with equations in the documentation. SFSNOW1A.93
C----------------------------------------------------------------------- SFSNOW1A.94
CL 2.1 Calculate snowmelt according to equation P251.3. SFSNOW1A.95
C----------------------------------------------------------------------- SFSNOW1A.96
C SFSNOW1A.97
IF(TSTAR(I).GT.TM .AND. LYING_SNOW(I).GT.0.0)THEN SFSNOW1A.98
C SFSNOW1A.99
C See P242 documentation for definition of ASOIL, i.e. ASOIL(1), the SFSNOW1A.100
C reciprocal areal heat capacity of the top soil layer (sq m K per J). SFSNOW1A.101
C SFSNOW1A.102
ASOIL(I)= SFSNOW1A.103
+ TIMESTEP*SQRT(OMEGA1/(2.0*HCON(I)*HCAP(I))) SFSNOW1A.104
C SFSNOW1A.105
C SMELT_TO_DT is in Kelvin per (kg per sq m of snowmelt). SFSNOW1A.106
C It is the factor to convert between snowmelt and temperature change. SFSNOW1A.107
C SFSNOW1A.108
SMELT_TO_DT=ASOIL(I)*LF/TIMESTEP SFSNOW1A.109
SNOWMELT(I)=MIN(LYING_SNOW(I),(TSTAR(I)-TM)/SMELT_TO_DT) SFSNOW1A.110
C SFSNOW1A.111
C----------------------------------------------------------------------- SFSNOW1A.112
CL 2.2 Adjust snowdepth and TSTAR. See eqs. P251.4, P251.5. SFSNOW1A.113
C----------------------------------------------------------------------- SFSNOW1A.114
C SFSNOW1A.115
LYING_SNOW(I)=LYING_SNOW(I)-SNOWMELT(I) SFSNOW1A.116
TSTAR(I)=TSTAR(I)-SNOWMELT(I)*SMELT_TO_DT SFSNOW1A.117
C SFSNOW1A.118
C----------------------------------------------------------------------- SFSNOW1A.119
CL 2.3 Convert snowmelt to kg of water per sq metre second. SFSNOW1A.120
C Calculate heat flux required to melt snow (defined to be GE 0). SFSNOW1A.121
C----------------------------------------------------------------------- SFSNOW1A.122
C SFSNOW1A.123
SNOWMELT(I)=SNOWMELT(I)/TIMESTEP SFSNOW1A.124
IF (STF_SNOWMELT_HTF) SNOWMELT_HTF(I)=LF*SNOWMELT(I) SFSNOW1A.125
C SFSNOW1A.126
C----------------------------------------------------------------------- SFSNOW1A.127
CL 3. Set snowmelt to zero if no snow, or below freezing, or not land. SFSNOW1A.128
C----------------------------------------------------------------------- SFSNOW1A.129
C SFSNOW1A.130
ELSE ! (If no snow, or below freezing.) SFSNOW1A.131
SNOWMELT(I)=0.0 SFSNOW1A.132
IF (STF_SNOWMELT_HTF) SNOWMELT_HTF(I)=0.0 SFSNOW1A.133
ENDIF SFSNOW1A.134
1 CONTINUE SFSNOW1A.135
ARE2F404.463
!----------------------------------------------------------------------- ARE2F404.464
! Increment snow grain size used in albedo calculations ARE2F404.465
!----------------------------------------------------------------------- ARE2F404.466
IF ( L_SNOW_ALBEDO ) THEN ARE2F404.467
DO I=1,POINTS ARE2F404.468
IF ( LYING_SNOW(I) .GT. 0.) THEN ARE2F404.469
SNOWFALL = TIMESTEP*(LS_SNOW(I) + CONV_SNOW(I)) ARE2F404.470
RATE = 0.6 ARE2F404.471
IF (TSTAR(I) .LT. TM) THEN ARE2F404.472
IF (RGRAIN(I) .LT. 150.) THEN ARE2F404.473
RATE = 0.06 ARE2F404.474
ELSE ARE2F404.475
RATE = 0.23E6*EXP(-3.7E4/(8.13451*TSTAR(I))) ARE2F404.476
ENDIF ARE2F404.477
ENDIF ARE2F404.478
RGRAIN(I) = SQRT( RGRAIN(I)**2 + (RATE/3.14159)*TIMESTEP ) ARE2F404.479
& - (RGRAIN(I) - R0)*SNOWFALL/2.5 ARE2F404.480
RGRAIN(I) = MIN( RMAX, RGRAIN(I) ) ARE2F404.481
RGRAIN(I) = MAX( R0, RGRAIN(I) ) ARE2F404.482
ELSE ARE2F404.483
RGRAIN(I) = R0 ARE2F404.484
ENDIF ARE2F404.485
ENDDO ARE2F404.486
ENDIF ARE2F404.487
ARE2F404.488
RETURN SFSNOW1A.136
END SFSNOW1A.137
*ENDIF SFSNOW1A.138