*IF DEF,A03_7A SFMELT7A.2
C *****************************COPYRIGHT****************************** SFMELT7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFMELT7A.4
C SFMELT7A.5
C Use, duplication or disclosure of this code is subject to the SFMELT7A.6
C restrictions as set forth in the contract. SFMELT7A.7
C SFMELT7A.8
C Meteorological Office SFMELT7A.9
C London Road SFMELT7A.10
C BRACKNELL SFMELT7A.11
C Berkshire UK SFMELT7A.12
C RG12 2SZ SFMELT7A.13
C SFMELT7A.14
C If no contract has been raised with this copy of the code, the use, SFMELT7A.15
C duplication or disclosure of it is strictly prohibited. Permission SFMELT7A.16
C to do so must first be obtained in writing from the Head of Numerical SFMELT7A.17
C Modelling at the above address. SFMELT7A.18
C ******************************COPYRIGHT****************************** SFMELT7A.19
C SUBROUTINE SF_MELT---------------------------------------------------- SFMELT7A.20
C Purpose : Calculates surface melting (snow and sea-ice) and increments SFMELT7A.21
C surface fluxes to satisfy energy balance. SFMELT7A.22
C Sub-surface snowmelt is calculated and snowdepth incremented SFMELT7A.23
C by melt and sublimation in P251. SFMELT7A.24
C R.Essery 19/1/95 SFMELT7A.25
C----------------------------------------------------------------------- SFMELT7A.26
SUBROUTINE SF_MELT ( 3,6SFMELT7A.27
& POINTS,P_FIELD,P1,LAND_FIELD,LAND_INDEX SFMELT7A.28
&,SNOW_INDEX,NSNOW,LAND_MASK,LTIMER,SIMLT,SMLT SFMELT7A.29
&,ALPHA1,ALPHA1_SICE,ASHTF,ASHTF_SNOW,DTRDZ_1,ICE_FRACT SFMELT7A.30
&,LYING_SNOW,RHOKH_1,RHOKH_1_SICE,SNOW_FRAC,TIMESTEP SFMELT7A.31
&,FQW_1,FQW_ICE,FQW_SNOW,FTL_1,FTL_SNOW,QW_1 SFMELT7A.32
&,TL_1,TSTAR,TSTAR_SNOW,TI SFMELT7A.33
&,EI,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT SFMELT7A.34
& ) SFMELT7A.35
SFMELT7A.36
IMPLICIT NONE SFMELT7A.37
SFMELT7A.38
INTEGER SFMELT7A.39
& POINTS ! IN Number of P-grid points to be SFMELT7A.40
! ! processed. SFMELT7A.41
&,P_FIELD ! IN Total number of P-grid points. SFMELT7A.42
&,P1 ! IN First P-point to be processed. SFMELT7A.43
&,LAND_FIELD ! IN Total number of land points.. SFMELT7A.44
&,LAND_INDEX(P_FIELD) !IN Index of land points. SFMELT7A.45
&,SNOW_INDEX(LAND_FIELD)!IN Index of snow points. SFMELT7A.46
&,NSNOW !IN Number of snow points. SFMELT7A.47
SFMELT7A.48
LOGICAL SFMELT7A.49
& LAND_MASK(P_FIELD) ! IN T for land points, F otherwise. SFMELT7A.50
&,LTIMER ! IN Logical for TIMER. SFMELT7A.51
&,SIMLT ! IN STASH flag for sea-ice melting ht flux. SFMELT7A.52
&,SMLT ! IN STASH flag for snow melting ht flux. SFMELT7A.53
SFMELT7A.54
REAL SFMELT7A.55
& ALPHA1(LAND_FIELD) ! IN Gradient of saturated specific SFMELT7A.56
! ! humidity with respect to temp. SFMELT7A.57
! ! between the bottom model layer SFMELT7A.58
! ! and the snow surface. SFMELT7A.59
&,ALPHA1_SICE(P_FIELD) ! IN ALPHA1 for sea-ice. SFMELT7A.60
&,ASHTF(P_FIELD) ! IN Coefficient to calculate surface SFMELT7A.61
! ! heat flux into sea-ice (W/m2/K). SFMELT7A.62
&,ASHTF_SNOW(P_FIELD) ! IN Coefficient to calculate surface SFMELT7A.63
! ! heat flux into snow (W/m2/K). SFMELT7A.64
&,DTRDZ_1(P_FIELD) ! IN -g.dt/dp for surface layer SFMELT7A.65
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is covered SFMELT7A.66
! ! by sea-ice. SFMELT7A.67
&,LYING_SNOW(P_FIELD) ! IN Lying snow (kg/m2). SFMELT7A.68
&,RHOKH_1(LAND_FIELD) ! IN Surface exchange coefficient for snow. SFMELT7A.69
&,RHOKH_1_SICE(P_FIELD)! IN Surface exchange coefficient for SFMELT7A.70
! ! sea-ice. SFMELT7A.71
&,SNOW_FRAC(LAND_FIELD)! IN Fraction of gridbox which is covered SFMELT7A.72
! ! by snow. SFMELT7A.73
&,TIMESTEP ! IN Timestep (sec). SFMELT7A.74
SFMELT7A.75
REAL SFMELT7A.76
& FQW_1(P_FIELD) ! INOUT GBM surface moisture flux (kg/m2/s). SFMELT7A.77
&,FQW_ICE(P_FIELD) ! INOUT FQW for sea-ice. SFMELT7A.78
&,FQW_SNOW(LAND_FIELD) ! INOUT FQW for snow. SFMELT7A.79
&,FTL_1(P_FIELD) ! INOUT GBM surface sens. heat flux (W/m2). SFMELT7A.80
&,FTL_SNOW(LAND_FIELD) ! INOUT FTL for snow. SFMELT7A.81
&,QW_1(P_FIELD) ! INOUT Total water content of lowest SFMELT7A.82
! ! atmospheric layer (kg per kg air). SFMELT7A.83
&,TL_1(P_FIELD) ! INOUT Liquid/frozen water temperature for SFMELT7A.84
! ! lowest atmospheric layer (K). SFMELT7A.85
&,TSTAR(P_FIELD) ! INOUT GBM surface temperature (K). SFMELT7A.86
&,TSTAR_SNOW(LAND_FIELD)!INOUT Snow surface temperature (K). SFMELT7A.87
&,TI(P_FIELD) ! INOUT Sea-ice surface layer temp. (K). SFMELT7A.88
SFMELT7A.89
REAL SFMELT7A.90
& EI(P_FIELD) ! OUT Sublimation from lying snow or SFMELT7A.91
! ! sea-ice (kg/m2/s). SFMELT7A.92
&,SICE_MLT_HTF(P_FIELD)! OUT Heat flux due to melting of sea-ice SFMELT7A.93
! ! (W/m2). SFMELT7A.94
&,SNOMLT_SURF_HTF(P_FIELD) SFMELT7A.95
! ! OUT Heat flux due to surface melting SFMELT7A.96
! ! of snow (W/m2). SFMELT7A.97
&,SNOWMELT(P_FIELD) ! OUT Surface snowmelt (kg/m2/s). SFMELT7A.98
SFMELT7A.99
*CALL C_0_DG_C 
SFMELT7A.100
*CALL C_SICEHC SFMELT7A.101
*CALL C_LHEAT SFMELT7A.102
*CALL C_R_CP SFMELT7A.103
*CALL C_GAMMA SFMELT7A.104
SFMELT7A.105
REAL SFMELT7A.106
& DFQW ! Moisture flux increment. SFMELT7A.107
&,DFTL ! Sensible heat flux increment. SFMELT7A.108
&,DTSTAR ! Surface temperature increment. SFMELT7A.109
&,LCMELT ! Temporary in melt calculations. SFMELT7A.110
&,LSMELT ! Temporary in melt calculations. SFMELT7A.111
&,RHOKH1_PRIME ! Modified forward time-weighted SFMELT7A.112
! ! transfer coefficient. SFMELT7A.113
&,SNOW_MAX ! Snow available for melting. SFMELT7A.114
&,TSTARMAX ! Maximum gridbox mean surface temperature SFMELT7A.115
! ! at sea points with ice. SFMELT7A.116
INTEGER SFMELT7A.117
& I ! Loop counter - full horizontal field. SFMELT7A.118
&,J ! SFMELT7A.119
&,L ! Loop counter - land field. SFMELT7A.120
C SFMELT7A.121
IF (LTIMER) THEN SFMELT7A.122
CALL TIMER('SFMELT ',3) SFMELT7A.123
ENDIF SFMELT7A.124
SFMELT7A.125
DO I=P1,P1+POINTS-1 SFMELT7A.126
IF (SIMLT) SICE_MLT_HTF(I) = 0.0 SFMELT7A.127
IF (SMLT) SNOMLT_SURF_HTF(I) = 0.0 SFMELT7A.128
SNOWMELT(I) = 0.0 SFMELT7A.129
EI(I) = 0.0 SFMELT7A.130
ENDDO SFMELT7A.131
SFMELT7A.132
DO J=1,NSNOW SFMELT7A.133
L = SNOW_INDEX(J) SFMELT7A.134
I = LAND_INDEX(L) SFMELT7A.135
!----------------------------------------------------------------------- SFMELT7A.136
! Melt snow if TSTAR_SNOW is greater than TM. SFMELT7A.137
!----------------------------------------------------------------------- SFMELT7A.138
EI(I) = SNOW_FRAC(L)*FQW_SNOW(L) SFMELT7A.139
SNOW_MAX = MAX( 0.0, SFMELT7A.140
& LYING_SNOW(I)/SNOW_FRAC(L) - FQW_SNOW(L)*TIMESTEP ) SFMELT7A.141
IF ( SNOW_MAX.GT.0.0 .AND. TSTAR_SNOW(L).GT.TM ) THEN SFMELT7A.142
RHOKH1_PRIME = 1. / ( 1. / RHOKH_1(L) + SFMELT7A.143
& GAMMA(1)*SNOW_FRAC(L)*DTRDZ_1(I) ) SFMELT7A.144
LCMELT = (CP + LC*ALPHA1(L))*RHOKH1_PRIME + ASHTF_SNOW(I) SFMELT7A.145
LSMELT = (CP + (LC+LF)*ALPHA1(L))*RHOKH1_PRIME + ASHTF_SNOW(I) SFMELT7A.146
SNOWMELT(I) = LSMELT * MIN( (TSTAR_SNOW(L) - TM)/LF , SFMELT7A.147
& SNOW_MAX/(LCMELT*TIMESTEP) ) SFMELT7A.148
DFTL = - CP*RHOKH1_PRIME*LF*SNOWMELT(I) / LSMELT SFMELT7A.149
DFQW = - ALPHA1(L)*RHOKH1_PRIME*LF*SNOWMELT(I) / LSMELT SFMELT7A.150
FTL_SNOW(L) = FTL_SNOW(L) + DFTL SFMELT7A.151
FQW_SNOW(L) = FQW_SNOW(L) + DFQW SFMELT7A.152
TSTAR_SNOW(L) = TM SFMELT7A.153
!----------------------------------------------------------------------- SFMELT7A.154
! Update gridbox-mean quantities SFMELT7A.155
!----------------------------------------------------------------------- SFMELT7A.156
SNOWMELT(I) = SNOW_FRAC(L)*SNOWMELT(I) SFMELT7A.157
IF (SMLT) SNOMLT_SURF_HTF(I) = LF*SNOWMELT(I) SFMELT7A.158
DFTL = SNOW_FRAC(L)*DFTL SFMELT7A.159
DFQW = SNOW_FRAC(L)*DFQW SFMELT7A.160
TL_1(I) = TL_1(I) + DTRDZ_1(I) * DFTL / CP SFMELT7A.161
QW_1(I) = QW_1(I) + DTRDZ_1(I) * DFQW SFMELT7A.162
FTL_1(I) = FTL_1(I) + DFTL SFMELT7A.163
FQW_1(I) = FQW_1(I) + DFQW SFMELT7A.164
EI(I) = EI(I) + DFQW SFMELT7A.165
ENDIF SFMELT7A.166
ENDDO SFMELT7A.167
SFMELT7A.168
DO I=P1,P1+POINTS-1 SFMELT7A.169
IF ( .NOT.LAND_MASK(I) .AND. ICE_FRACT(I).GT.0.0 ) THEN SFMELT7A.170
!----------------------------------------------------------------------- SFMELT7A.171
! Melt sea-ice if TSTAR > TSTARMAX or TI > TM. SFMELT7A.172
!----------------------------------------------------------------------- SFMELT7A.173
EI(I) = FQW_ICE(I) SFMELT7A.174
TSTARMAX = ICE_FRACT(I)*TM + (1.0 - ICE_FRACT(I))*TFS SFMELT7A.175
IF ( TSTAR(I) .GT. TSTARMAX ) THEN SFMELT7A.176
RHOKH1_PRIME = 1. / ( 1. / RHOKH_1_SICE(I) SFMELT7A.177
& + ICE_FRACT(I)*GAMMA(1)*DTRDZ_1(I) ) SFMELT7A.178
DTSTAR = TSTARMAX - TSTAR(I) SFMELT7A.179
LSMELT = (CP + (LC + LF)*ALPHA1_SICE(I))*RHOKH1_PRIME SFMELT7A.180
& + ASHTF(I) SFMELT7A.181
DFTL = CP * RHOKH1_PRIME * DTSTAR SFMELT7A.182
DFQW = ALPHA1_SICE(I) * RHOKH1_PRIME * DTSTAR SFMELT7A.183
TI(I) =TI(I) + AI*ASHTF(I)*DTSTAR*TIMESTEP / ICE_FRACT(I) SFMELT7A.184
TSTAR(I) = TSTARMAX SFMELT7A.185
IF (SIMLT) SICE_MLT_HTF(I) = - LSMELT * DTSTAR SFMELT7A.186
TL_1(I) = TL_1(I) + DTRDZ_1(I) * DFTL / CP SFMELT7A.187
QW_1(I) = QW_1(I) + DTRDZ_1(I) * DFQW SFMELT7A.188
FTL_1(I) = FTL_1(I) + DFTL SFMELT7A.189
FQW_1(I) = FQW_1(I) + DFQW SFMELT7A.190
EI(I) = EI(I) + DFQW SFMELT7A.191
ENDIF SFMELT7A.192
IF ( TI(I) .GT. TM ) THEN SFMELT7A.193
IF (SIMLT) SICE_MLT_HTF(I) = SICE_MLT_HTF(I) + SFMELT7A.194
& ICE_FRACT(I)*(TI(I) - TM)/(AI*TIMESTEP) SFMELT7A.195
TI(I) = TM SFMELT7A.196
ENDIF SFMELT7A.197
ENDIF SFMELT7A.198
ENDDO SFMELT7A.199
SFMELT7A.200
IF (LTIMER) THEN SFMELT7A.201
CALL TIMER('SFMELT ',4) SFMELT7A.202
ENDIF SFMELT7A.203
SFMELT7A.204
RETURN SFMELT7A.205
END SFMELT7A.206
*ENDIF SFMELT7A.207