*IF DEF,A08_7A SFSNOW7A.2
C *****************************COPYRIGHT****************************** SFSNOW7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFSNOW7A.4
C SFSNOW7A.5
C Use, duplication or disclosure of this code is subject to the SFSNOW7A.6
C restrictions as set forth in the contract. SFSNOW7A.7
C SFSNOW7A.8
C Meteorological Office SFSNOW7A.9
C London Road SFSNOW7A.10
C BRACKNELL SFSNOW7A.11
C Berkshire UK SFSNOW7A.12
C RG12 2SZ SFSNOW7A.13
C SFSNOW7A.14
C If no contract has been raised with this copy of the code, the use, SFSNOW7A.15
C duplication or disclosure of it is strictly prohibited. Permission SFSNOW7A.16
C to do so must first be obtained in writing from the Head of Numerical SFSNOW7A.17
C Modelling at the above address. SFSNOW7A.18
C ******************************COPYRIGHT****************************** SFSNOW7A.19
C SFSNOW7A.20
CLL SUBROUTINE SFSNOW ------------------------------------------------ SFSNOW7A.21
CLL SFSNOW7A.22
CLL Purpose: Calculates the decrease/increase in snowdepth due to the SFSNOW7A.23
CLL sublimation/deposition of lying snow; adds the large- SFSNOW7A.24
CLL scale and convective snowfall to the snowdepth; SFSNOW7A.25
CLL updates the snow layer temperature; SFSNOW7A.26
CLL melts snow when the snow layer temperature is above SFSNOW7A.27
CLL the melting point of ice. SFSNOW7A.28
CLL SFSNOW7A.29
CLL Model Modification history from model version 3.0: SFSNOW7A.30
CLL version Date SFSNOW7A.31
CLL SFSNOW7A.32
CLL Programming standard: Unified Model Documentation Paper No.4 SFSNOW7A.33
CLL version no. 2, dated 18/1/90. SFSNOW7A.34
CLL SFSNOW7A.35
CLL Logical component covered: P251. SFSNOW7A.36
CLL SFSNOW7A.37
CLL System task: SFSNOW7A.38
CLL SFSNOW7A.39
CLL Documentation: um documentation paper no 25 SFSNOW7A.40
CLLEND------------------------------------------------------------------ SFSNOW7A.41
C SFSNOW7A.42
C*L ARGUMENTS:--------------------------------------------------------- SFSNOW7A.43
SUBROUTINE SFSNOW( 3,4SFSNOW7A.44
& NPNTS,SOIL_PTS,SOIL_INDEX, SFSNOW7A.45
& CONV_SNOW,LS_SNOW,DZ_1,HCONS,SNOW_FRAC,SNOW_SUB,SNOW_SURF_HTF, SFSNOW7A.46
& TSOIL_1,TSTAR,TIMESTEP, SFSNOW7A.47
& LYING_SNOW,RGRAIN,L_SNOW_ALBEDO,SNOWMELT,TSNOW, SFSNOW7A.48
& SNOMLT_SUB_HTF,SNOW_SOIL_HTF,STF_HF_SNOW_MELT,LTIMER) SFSNOW7A.49
SFSNOW7A.50
IMPLICIT NONE SFSNOW7A.51
SFSNOW7A.52
INTEGER SFSNOW7A.53
& NPNTS ! IN Number of gridpoints. SFSNOW7A.54
&,SOIL_PTS ! IN Number of soil points. SFSNOW7A.55
&,SOIL_INDEX(NPNTS) ! IN Array of soil points. SFSNOW7A.56
SFSNOW7A.57
REAL SFSNOW7A.58
& CONV_SNOW(NPNTS) ! IN Convective snowfall (kg/m2/s). SFSNOW7A.59
&,LS_SNOW(NPNTS) ! IN Large-scale snowfall (kg/m2/s). SFSNOW7A.60
&,DZ_1 ! IN Soil surface layer depth (m). SFSNOW7A.61
&,HCONS(NPNTS) ! IN Thermal conductivity of surface soil SFSNOW7A.62
! ! layer (W/m/K). SFSNOW7A.63
&,SNOW_FRAC(NPNTS) ! IN Snow-cover fraction. SFSNOW7A.64
&,SNOW_SUB(NPNTS) ! IN Sublimation of lying snow (kg/m2/s). SFSNOW7A.65
&,SNOW_SURF_HTF(NPNTS) ! IN Snow surface heat flux (W/m2). SFSNOW7A.66
&,TSOIL_1(NPNTS) ! IN Soil surface layer temperature (K). SFSNOW7A.67
&,TIMESTEP ! IN Timestep (s). SFSNOW7A.68
&,TSTAR(NPNTS) ! IN Snow surface temperature (K). SFSNOW7A.69
SFSNOW7A.70
REAL SFSNOW7A.71
& LYING_SNOW(NPNTS) ! INOUT Snow on the ground (kg/m2). SFSNOW7A.72
&,RGRAIN(NPNTS) ! INOUT Snow grain size (microns). SFSNOW7A.73
&,SNOWMELT(NPNTS) ! IN Surface snowmelt (kg/m2/s). SFSNOW7A.74
! ! OUT Total snowmelt (kg/m2/s). SFSNOW7A.75
&,TSNOW(NPNTS) ! INOUT Snow surface layer temperature (K). SFSNOW7A.76
SFSNOW7A.77
REAL SFSNOW7A.78
& SNOMLT_SUB_HTF(NPNTS)! OUT Sub-surface snowmelt heat flux (W/m2). SFSNOW7A.79
&,SNOW_SOIL_HTF(NPNTS) ! OUT Heat flux from snow to soil (W/m2). SFSNOW7A.80
SFSNOW7A.81
LOGICAL SFSNOW7A.82
& STF_HF_SNOW_MELT ! IN Stash flag for snow melt heat flux. SFSNOW7A.83
&,L_SNOW_ALBEDO ! IN Flag for prognostic snow albedo. SFSNOW7A.84
&,LTIMER ! IN Logical for TIMER. SFSNOW7A.85
SFSNOW7A.86
*CALL C_LHEAT 
SFSNOW7A.87
*CALL C_0_DG_C SFSNOW7A.88
*CALL C_SOILH SFSNOW7A.89
SFSNOW7A.90
! Local variables SFSNOW7A.91
REAL SFSNOW7A.92
& ASNOW ! Reciprocal areal heat capacity of surface SFSNOW7A.93
! ! snow layer (K m2 / J). SFSNOW7A.94
&,R0 ! Grain size for fresh snow (microns). SFSNOW7A.95
&,RMAX ! Maximum snow grain size (microns). SFSNOW7A.96
&,RATE ! Grain area growth rate (microns**2 / s). SFSNOW7A.97
&,SNOWFALL ! Snowfall in timestep (kg/m2). SFSNOW7A.98
&,SNOWDEPTH ! Local snowdepth (m). SFSNOW7A.99
&,SNOMLT_SUB ! Sub-surface snow melt (kg/m2). SFSNOW7A.100
PARAMETER (R0 = 50., RMAX = 2000.) SFSNOW7A.101
INTEGER I,J ! Loop counters. SFSNOW7A.102
SFSNOW7A.103
! NO EXTERNAL SUBROUTINES CALLED SFSNOW7A.104
SFSNOW7A.105
IF (LTIMER) THEN SFSNOW7A.106
CALL TIMER('SFSNOW ',103) GPB8F405.148
ENDIF SFSNOW7A.108
ASNOW = 1./(SNOW_HCAP*DEFF_SNOW) SFSNOW7A.109
SFSNOW7A.110
!----------------------------------------------------------------------- SFSNOW7A.111
! Update TSNOW for land points without permanent ice cover. SFSNOW7A.112
!----------------------------------------------------------------------- SFSNOW7A.113
DO J=1,SOIL_PTS SFSNOW7A.114
I=SOIL_INDEX(J) SFSNOW7A.115
IF (SNOW_FRAC(I) .GT. 0.0) THEN SFSNOW7A.116
SNOWDEPTH = LYING_SNOW(I)/(RHO_SNOW*SNOW_FRAC(I)) SFSNOW7A.117
SNOWDEPTH = MAX (SNOWDEPTH, DEFF_SNOW/2) ARE1F405.33
SNOW_SOIL_HTF(I) = SNOW_FRAC(I)*(TSNOW(I) - TSOIL_1(I)) / ARE1F405.41
& ( (2*SNOWDEPTH - DEFF_SNOW)/(2*SNOW_HCON) SFSNOW7A.119
& + DZ_1 / (2*HCONS(I)) ) SFSNOW7A.120
TSNOW(I) = TSNOW(I) + TIMESTEP*(ASNOW/SNOW_FRAC(I))* ARE1F405.42
& (SNOW_SURF_HTF(I) - SNOW_SOIL_HTF(I)) SFSNOW7A.122
ELSE SFSNOW7A.123
SNOW_SOIL_HTF(I) = 0. SFSNOW7A.124
TSNOW(I) = TSOIL_1(I) SFSNOW7A.125
ENDIF SFSNOW7A.126
ENDDO SFSNOW7A.127
SFSNOW7A.128
!----------------------------------------------------------------------- SFSNOW7A.129
! Increment snowdepth by sublimation and surface melt. SFSNOW7A.130
!----------------------------------------------------------------------- SFSNOW7A.131
DO I=1,NPNTS ABX1F405.970
LYING_SNOW(I) = LYING_SNOW(I) - TIMESTEP * SFSNOW7A.134
& ( SNOW_SUB(I) + SNOWMELT(I) ) SFSNOW7A.135
LYING_SNOW(I) = MAX( LYING_SNOW(I), 0. ) SFSNOW7A.136
ENDDO SFSNOW7A.137
SFSNOW7A.138
!----------------------------------------------------------------------- SFSNOW7A.139
! Melt snow over land if TSNOW is above freezing. SFSNOW7A.140
! Increment snowdepth by subsurface melt. SFSNOW7A.141
!----------------------------------------------------------------------- SFSNOW7A.142
DO J=1,SOIL_PTS ABX1F405.971
I=SOIL_INDEX(J) SFSNOW7A.144
SNOMLT_SUB = 0.0 SFSNOW7A.145
IF (TSNOW(I).GT.TM .AND. LYING_SNOW(I).GT.0.0) THEN SFSNOW7A.146
SNOMLT_SUB = MIN( LYING_SNOW(I), SFSNOW7A.147
& SNOW_FRAC(I)*(TSNOW(I) - TM)/(LF*ASNOW) ) SFSNOW7A.148
TSNOW(I) = TM SFSNOW7A.149
LYING_SNOW(I) = LYING_SNOW(I) - SNOMLT_SUB SFSNOW7A.150
SNOWMELT(I) = SNOWMELT(I) + SNOMLT_SUB/TIMESTEP SFSNOW7A.151
ENDIF SFSNOW7A.152
IF (STF_HF_SNOW_MELT) SNOMLT_SUB_HTF(I) = LF*SNOMLT_SUB SFSNOW7A.153
ENDDO SFSNOW7A.154
SFSNOW7A.155
!----------------------------------------------------------------------- SFSNOW7A.156
! Increment snowdepth by snowfall. SFSNOW7A.157
!----------------------------------------------------------------------- SFSNOW7A.158
DO I=1,NPNTS ABX1F405.972
LYING_SNOW(I) = LYING_SNOW(I) + TIMESTEP * SFSNOW7A.161
& ( LS_SNOW(I) + CONV_SNOW(I) ) SFSNOW7A.162
ENDDO SFSNOW7A.163
SFSNOW7A.164
!----------------------------------------------------------------------- SFSNOW7A.165
! Increment snow grain size used in albedo calculations SFSNOW7A.166
!----------------------------------------------------------------------- SFSNOW7A.167
IF ( L_SNOW_ALBEDO ) THEN SFSNOW7A.168
DO I=1,NPNTS SFSNOW7A.169
IF ( LYING_SNOW(I) .GT. 0.) THEN SFSNOW7A.170
SNOWFALL = TIMESTEP*(LS_SNOW(I) + CONV_SNOW(I)) SFSNOW7A.171
RATE = 0.6 SFSNOW7A.172
IF (TSTAR(I) .LT. TM) THEN SFSNOW7A.173
IF (RGRAIN(I) .LT. 150.) THEN SFSNOW7A.174
RATE = 0.06 SFSNOW7A.175
ELSE SFSNOW7A.176
RATE = 0.23E6*EXP(-3.7E4/(8.13451*TSTAR(I))) SFSNOW7A.177
ENDIF SFSNOW7A.178
ENDIF SFSNOW7A.179
RGRAIN(I) = SQRT( RGRAIN(I)**2 + (RATE/3.14159)*TIMESTEP ) SFSNOW7A.180
& - (RGRAIN(I) - R0)*SNOWFALL/2.5 SFSNOW7A.181
RGRAIN(I) = MIN( RMAX, RGRAIN(I) ) SFSNOW7A.182
RGRAIN(I) = MAX( R0, RGRAIN(I) ) SFSNOW7A.183
ELSE SFSNOW7A.184
RGRAIN(I) = R0 SFSNOW7A.185
ENDIF SFSNOW7A.186
ENDDO SFSNOW7A.187
ENDIF SFSNOW7A.188
SFSNOW7A.189
IF (LTIMER) THEN SFSNOW7A.190
CALL TIMER('SFSNOW ',104) GPB8F405.149
ENDIF SFSNOW7A.192
SFSNOW7A.193
RETURN SFSNOW7A.194
END SFSNOW7A.195
*ENDIF SFSNOW7A.196