*IF DEF,A08_5A AJS1F401.1513
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.14538
C GTS2F400.14539
C Use, duplication or disclosure of this code is subject to the GTS2F400.14540
C restrictions as set forth in the contract. GTS2F400.14541
C GTS2F400.14542
C Meteorological Office GTS2F400.14543
C London Road GTS2F400.14544
C BRACKNELL GTS2F400.14545
C Berkshire UK GTS2F400.14546
C RG12 2SZ GTS2F400.14547
C GTS2F400.14548
C If no contract has been raised with this copy of the code, the use, GTS2F400.14549
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.14550
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.14551
C Modelling at the above address. GTS2F400.14552
C ******************************COPYRIGHT****************************** GTS2F400.14553
C GTS2F400.14554
CLL SUBROUTINE SFSNOW ------------------------------------------------ SFSNOW2A.3
CLL SFSNOW2A.4
CLL Purpose: Calculates the decrease/increase in snowdepth due to the SFSNOW2A.5
CLL sublimation/deposition of lying snow; adds the large- SFSNOW2A.6
CLL scale and convective snowfall to the snowdepth; SFSNOW2A.7
CLL melts snow when the input surface temperature is above SFSNOW2A.8
CLL the melting point of ice, and adjusts the surface SFSNOW2A.9
CLL temperature to account for latent cooling thus caused. SFSNOW2A.10
CLL SFSNOW2A.11
CLL Model Modification history from model version 3.0: SFSNOW2A.12
CLL version Date SFSNOW2A.13
CLL SFSNOW2A.14
CLL 4.4 17/9/97 Updates snow grain size if required for ARE2F404.489
CLL prognostic snow albedo R. Essery ARE2F404.490
CLL ARE2F404.491
CLL Programming standard: Unified Model Documentation Paper No.4 SFSNOW2A.15
CLL version no. 2, dated 18/1/90. SFSNOW2A.16
CLL SFSNOW2A.17
CLL Logical component covered: P251. SFSNOW2A.18
CLL SFSNOW2A.19
CLL System task: SFSNOW2A.20
CLL SFSNOW2A.21
CLL Documentation: um documentation paper no 25 SFSNOW2A.22
CLLEND------------------------------------------------------------------ SFSNOW2A.30
C SFSNOW2A.31
C*L ARGUMENTS:--------------------------------------------------------- SFSNOW2A.32
SUBROUTINE SFSNOW( 3,4SFSNOW2A.33
+ ASOIL,CONV_SNOW,LS_SNOW,SNOW_SUB,TSTAR,TIMESTEP,POINTS, ARE2F404.492
+ LYING_SNOW,RGRAIN,L_SNOW_ALBEDO,TS1,SNOWMELT, ARE2F404.493
+ SNOMLT_SUB_HTF,STF_HF_SNOW_MELT, ARE2F404.494
+ LTIMER) AJS1F401.1515
IMPLICIT NONE SFSNOW2A.37
INTEGER POINTS ! IN Number of points to be processed. SFSNOW2A.38
REAL SFSNOW2A.39
+ ASOIL(POINTS) ! IN Reciprocal areal heat capacity of top SFSNOW2A.40
C ! soil layer (K m2 / J). SFSNOW2A.41
+,CONV_SNOW(POINTS) ! IN Convective snowfall (kg per sq m per s) SFSNOW2A.42
+,LS_SNOW(POINTS) ! IN Large-scale snowfall (kg per sq m per s) SFSNOW2A.43
+,SNOW_SUB(POINTS) ! IN Sublimation of lying snow (kg/sq m/s). SFSNOW2A.44
+,TIMESTEP ! IN Timestep in seconds. SFSNOW2A.45
+,TSTAR(POINTS) ! IN Surface temperature (K). ARE2F404.495
REAL SFSNOW2A.46
+ LYING_SNOW(POINTS) ! INOUT Snow on the ground (kg per sq m). SFSNOW2A.47
+,RGRAIN(POINTS) ! INOUT Snow grain size (microns). ARE2F404.496
+,SNOWMELT(POINTS) ! IN Surface snowmelt (kg/m2/s). SFSNOW2A.48
C ! OUT Total snowmelt (kg/m2/s). SFSNOW2A.49
+,TS1(POINTS) ! INOUT Surface layer temperature (K). SFSNOW2A.50
REAL SFSNOW2A.51
+ SNOMLT_SUB_HTF(POINTS)! OUT Sub-surface snowmelt heat flux (W/m2) SFSNOW2A.52
LOGICAL SFSNOW2A.53
+ STF_HF_SNOW_MELT ! IN Stash flag for snow melt heat flux SFSNOW2A.54
+,L_SNOW_ALBEDO ! IN Flag for prognostic snow albedo ARE2F404.497
LOGICAL AJS1F401.1516
+ LTIMER AJS1F401.1517
C----------------------------------------------------------------------- SFSNOW2A.55
C* SFSNOW2A.56
C Define common then local physical constants -------------------------- SFSNOW2A.57
*CALL C_LHEAT 
SFSNOW2A.58
*CALL C_0_DG_C SFSNOW2A.59
C NO EXTERNAL SUBROUTINES CALLED---------------------------------------- SFSNOW2A.60
C*---------------------------------------------------------------------- SFSNOW2A.61
C Define local variables----------------------------------------------- SFSNOW2A.62
REAL SFSNOW2A.63
+ SNOMLT_SUB ! Sub-surface snow melt. SFSNOW2A.64
+,R0 ! Grain size for fresh snow (microns). ARE2F404.498
+,RMAX ! Maximum snow grain size (microns). ARE2F404.499
+,RATE ! Grain area growth rate (microns**2 / s). ARE2F404.500
+,SNOWFALL ! Snowfall in timestep (kg/m2). ARE2F404.501
PARAMETER (R0 = 50., RMAX = 2000.) ARE2F404.502
INTEGER I ! Loop counter; horizontal field index. SFSNOW2A.65
C SFSNOW2A.66
IF (LTIMER) THEN AJS1F401.1518
CALL TIMER('SFSNOW ',3) AJS1F401.1519
ENDIF AJS1F401.1520
DO 1 I=1,POINTS SFSNOW2A.67
SNOMLT_SUB = 0.0 SFSNOW2A.68
C SFSNOW2A.69
C----------------------------------------------------------------------- SFSNOW2A.70
CL Alter snowdepth as a result of snowfall, turbulent mass transport and SFSNOW2A.71
CL surface melt. SFSNOW2A.72
C----------------------------------------------------------------------- SFSNOW2A.73
C SFSNOW2A.74
LYING_SNOW(I) = TIMESTEP*(LS_SNOW(I) + CONV_SNOW(I)) + SFSNOW2A.75
& MAX( 0.0, LYING_SNOW(I)-TIMESTEP*(SNOW_SUB(I)+SNOWMELT(I)) ) SFSNOW2A.76
C SFSNOW2A.77
C----------------------------------------------------------------------- SFSNOW2A.78
CL Melt snow over land if TS1 is above freezing. SFSNOW2A.79
CL Adjust TS1 accordingly. SFSNOW2A.80
C----------------------------------------------------------------------- SFSNOW2A.81
C SFSNOW2A.82
IF (TS1(I).GT.TM .AND. LYING_SNOW(I).GT.0.0) THEN SFSNOW2A.83
IF (ASOIL(I).GT.0.0) THEN SFSNOW2A.84
SNOMLT_SUB = MIN( LYING_SNOW(I)/TIMESTEP, SFSNOW2A.85
& (TS1(I) - TM)/(LF*ASOIL(I)*TIMESTEP) ) SFSNOW2A.86
!----------------------------------------------------------------------- SFSNOW2A.87
! For N/S boundaries in LAMS and polar rows in global model SFSNOW2A.88
! ASOIL will not have been calculated for these rows so diagnostics SFSNOW2A.89
! are not valid so just set to zero SFSNOW2A.90
!----------------------------------------------------------------------- SFSNOW2A.91
ELSE SFSNOW2A.92
SNOMLT_SUB = 0.0 SFSNOW2A.93
ENDIF SFSNOW2A.94
TS1(I) = TS1(I) - ASOIL(I)*TIMESTEP*LF*SNOMLT_SUB SFSNOW2A.95
LYING_SNOW(I) = LYING_SNOW(I) - TIMESTEP*SNOMLT_SUB SFSNOW2A.96
SNOWMELT(I) = SNOWMELT(I) + SNOMLT_SUB SFSNOW2A.97
ENDIF SFSNOW2A.98
IF (STF_HF_SNOW_MELT) SNOMLT_SUB_HTF(I) = LF*SNOMLT_SUB SFSNOW2A.99
1 CONTINUE SFSNOW2A.100
ARE2F404.503
!----------------------------------------------------------------------- ARE2F404.504
! Increment snow grain size used in albedo calculations ARE2F404.505
!----------------------------------------------------------------------- ARE2F404.506
IF ( L_SNOW_ALBEDO ) THEN ARE2F404.507
DO I=1,POINTS ARE2F404.508
IF ( LYING_SNOW(I) .GT. 0.) THEN ARE2F404.509
SNOWFALL = TIMESTEP*(LS_SNOW(I) + CONV_SNOW(I)) ARE2F404.510
RATE = 0.6 ARE2F404.511
IF (TSTAR(I) .LT. TM) THEN ARE2F404.512
IF (RGRAIN(I) .LT. 150.) THEN ARE2F404.513
RATE = 0.06 ARE2F404.514
ELSE ARE2F404.515
RATE = 0.23E6*EXP(-3.7E4/(8.13451*TSTAR(I))) ARE2F404.516
ENDIF ARE2F404.517
ENDIF ARE2F404.518
RGRAIN(I) = SQRT( RGRAIN(I)**2 + (RATE/3.14159)*TIMESTEP ) ARE2F404.519
& - (RGRAIN(I) - R0)*SNOWFALL/2.5 ARE2F404.520
RGRAIN(I) = MIN( RMAX, RGRAIN(I) ) ARE2F404.521
RGRAIN(I) = MAX( R0, RGRAIN(I) ) ARE2F404.522
ELSE ARE2F404.523
RGRAIN(I) = R0 ARE2F404.524
ENDIF ARE2F404.525
ENDDO ARE2F404.526
ENDIF ARE2F404.527
ARE2F404.528
IF (LTIMER) THEN AJS1F401.1521
CALL TIMER('SFSNOW ',4) AJS1F401.1522
ENDIF AJS1F401.1523
RETURN SFSNOW2A.101
END SFSNOW2A.102
*ENDIF SFSNOW2A.103