*IF DEF,A03_5A SFMELT5A.2
C *****************************COPYRIGHT****************************** SFMELT5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. SFMELT5A.4
C SFMELT5A.5
C Use, duplication or disclosure of this code is subject to the SFMELT5A.6
C restrictions as set forth in the contract. SFMELT5A.7
C SFMELT5A.8
C Meteorological Office SFMELT5A.9
C London Road SFMELT5A.10
C BRACKNELL SFMELT5A.11
C Berkshire UK SFMELT5A.12
C RG12 2SZ SFMELT5A.13
C SFMELT5A.14
C If no contract has been raised with this copy of the code, the use, SFMELT5A.15
C duplication or disclosure of it is strictly prohibited. Permission SFMELT5A.16
C to do so must first be obtained in writing from the Head of Numerical SFMELT5A.17
C Modelling at the above address. SFMELT5A.18
C ******************************COPYRIGHT****************************** SFMELT5A.19
C SUBROUTINE SF_MELT---------------------------------------------------- SFMELT5A.20
C Purpose : Calculates surface melting (snow and sea-ice) and increments SFMELT5A.21
C in surface fluxes to satisfy energy balance. SFMELT5A.22
C Sub-surface snowmelt is calculated and snowdepth incremented SFMELT5A.23
C by melt and sublimation in P251. SFMELT5A.24
C R.Essery 19/1/95 SFMELT5A.25
C Modification History: AJC1F405.67
C Version Date Change AJC1F405.68
C 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.69
C----------------------------------------------------------------------- SFMELT5A.26
SUBROUTINE SF_MELT( 3,6SFMELT5A.27
+ P_FIELD,P1,LAND_FIELD,LAND1 SFMELT5A.28
+,POINTS,LAND_MASK,LAND_PTS,LAND_INDEX SFMELT5A.32
+,ALPHA1,ASHTF,ASURF,ICE_FRACT SFMELT5A.34
+,RHOKH1_PRIME,TIMESTEP,SIMLT,SMLT,DFQW,DIFF_SENS_HTF SFMELT5A.35
+,EI,LYING_SNOW,SURF_HT_FLUX,TSTAR,TI SFMELT5A.36
+,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT,LTIMER SFMELT5A.37
+) SFMELT5A.38
IMPLICIT NONE SFMELT5A.39
LOGICAL LTIMER SFMELT5A.40
INTEGER SFMELT5A.41
+ P_FIELD ! IN No. of gridpoints in the whole grid. SFMELT5A.42
+,P1 ! IN 1st P-pt in full field to be processed. SFMELT5A.43
+,LAND_FIELD ! IN No. of land points in the whole grid. SFMELT5A.44
+,LAND1 ! IN 1st L-pt in full field to be processed. SFMELT5A.45
+,POINTS ! IN No. of gridpoints to be processed. SFMELT5A.46
+,LAND_PTS ! IN No. of land points to be processed. SFMELT5A.47
LOGICAL SFMELT5A.48
+ LAND_MASK(P_FIELD) ! IN T for land points, F otherwise. SFMELT5A.49
INTEGER SFMELT5A.51
+ LAND_INDEX(P_FIELD) ! IN Index of land points on the P-grid. SFMELT5A.52
C ! The ith element contains the position SFMELT5A.53
C ! in whole grid of the ith land point. SFMELT5A.54
REAL SFMELT5A.56
+ ALPHA1(P_FIELD) ! IN Gradient of saturated specific SFMELT5A.57
C ! humidity with respect to temp. SFMELT5A.58
C ! between the bottom model layer SFMELT5A.59
C ! and the surface. SFMELT5A.60
+,ASHTF(P_FIELD) ! IN Forward time weighted coeff. SFMELT5A.61
C ! to calculate the soil heat flux SFMELT5A.62
C ! between the surface and top soil SFMELT5A.63
C ! layer (W/m2/K). SFMELT5A.64
+,ASURF(P_FIELD) ! IN Reciprocal areal heat capacity of SFMELT5A.65
C ! top soil layer or sea-ice surface SFMELT5A.66
C ! layer (m2 K / J). SFMELT5A.67
+,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is covered SFMELT5A.68
C ! by sea-ice. SFMELT5A.69
+,RHOKH1_PRIME(P_FIELD)! IN Modified forward time-weighted SFMELT5A.70
C ! transfer coefficient. SFMELT5A.71
+,TIMESTEP ! IN Timestep (sec). SFMELT5A.72
LOGICAL SFMELT5A.73
+ SIMLT ! IN STASH flag for sea-ice melting ht flux. SFMELT5A.74
+,SMLT ! IN STASH flag for snow melting ht flux. SFMELT5A.75
REAL SFMELT5A.76
+ DFQW(P_FIELD) ! INOUT Increment to the flux of total SFMELT5A.77
C ! water. SFMELT5A.78
+,DIFF_SENS_HTF(P_FIELD)! INOUT Increment to the sensible heat SFMELT5A.79
C ! flux (W/m2). SFMELT5A.80
+,EI(P_FIELD) ! INOUT Sublimation from lying snow or SFMELT5A.81
C ! sea-ice (Kg/m2/s). SFMELT5A.82
+,LYING_SNOW(P_FIELD) ! INOUT Lying snow (kg/m2). SFMELT5A.83
+,SURF_HT_FLUX(P_FIELD)! INOUT Net downward heat flux at surface SFMELT5A.84
C ! over land or sea-ice fraction of SFMELT5A.85
C ! gridbox (W/m2). SFMELT5A.86
+,TSTAR(P_FIELD) ! INOUT Surface temperature (K). SFMELT5A.87
+,TI(P_FIELD) ! INOUT Sea-ice surface layer temp. (K). SFMELT5A.88
+,SICE_MLT_HTF(P_FIELD)! OUT Heat flux due to melting of sea-ice SFMELT5A.89
C ! (W/m2). SFMELT5A.90
+,SNOMLT_SURF_HTF(P_FIELD)! OUT Heat flux due to surface melting SFMELT5A.91
C ! of snow (W/m2). SFMELT5A.92
+,SNOWMELT(P_FIELD) ! OUT Surface snowmelt (kg/m2/s). SFMELT5A.93
*CALL C_0_DG_C 
SFMELT5A.94
*CALL C_LHEAT SFMELT5A.95
*CALL C_R_CP SFMELT5A.96
REAL SFMELT5A.97
+ DMELT ! Temporary in calculations of melting SFMELT5A.98
C ! heat fluxes. SFMELT5A.99
+,DIFF_EI ! Increment to sublimation. SFMELT5A.100
+,DTSTAR ! Increment to surface temperature. SFMELT5A.101
+,DIFF_SURF_HTF ! Increment to surface heat flux. SFMELT5A.102
+,SNOW_MAX ! Snow available for melting at land SFMELT5A.103
C ! points. SFMELT5A.104
+,TSTARMAX ! Maximum gridbox mean surface temperature SFMELT5A.105
C ! at sea points with ice. SFMELT5A.106
INTEGER SFMELT5A.107
+ I ! Loop counter - full horizontal field. SFMELT5A.108
+,L ! Loop counter - land field. SFMELT5A.109
C SFMELT5A.110
IF (LTIMER) THEN SFMELT5A.111
CALL TIMER('SFMELT ',3) SFMELT5A.112
ENDIF SFMELT5A.113
DO 1 I=P1,P1+POINTS-1 SFMELT5A.114
IF (SIMLT) SICE_MLT_HTF(I) = 0.0 SFMELT5A.115
IF (SMLT) SNOMLT_SURF_HTF(I) = 0.0 SFMELT5A.116
SNOWMELT(I) = 0.0 SFMELT5A.117
1 CONTINUE SFMELT5A.118
CDIR$ IVDEP SFMELT5A.124
! Fujitsu vectorization directive GRB0F405.499
!OCL NOVREC GRB0F405.500
DO 10 L=LAND1,LAND1+LAND_PTS-1 SFMELT5A.125
I = LAND_INDEX(L) SFMELT5A.126
C SFMELT5A.128
C----------------------------------------------------------------------- SFMELT5A.129
C Melt snow if TSTAR is greater than TM. SFMELT5A.130
C----------------------------------------------------------------------- SFMELT5A.131
SNOW_MAX = MAX(0.0, LYING_SNOW(I) - EI(I)*TIMESTEP ) SFMELT5A.132
IF ( SNOW_MAX.GT.0.0 .AND. TSTAR(I).GT.TM ) THEN SFMELT5A.133
DMELT = ( CP + LC * ALPHA1(I) ) * RHOKH1_PRIME(I) + ASHTF(I) SFMELT5A.134
DTSTAR = - MIN ( TSTAR(I) - TM , SFMELT5A.135
& LF * SNOW_MAX / ( TIMESTEP * DMELT ) ) SFMELT5A.136
DMELT = DMELT + LF * ALPHA1(I) * RHOKH1_PRIME(I) SFMELT5A.137
SNOWMELT(I) = - DMELT * DTSTAR / LF SFMELT5A.138
DIFF_SENS_HTF(I) = DIFF_SENS_HTF(I) + SFMELT5A.139
& CP * RHOKH1_PRIME(I) * DTSTAR SFMELT5A.140
DIFF_EI = ALPHA1(I) * RHOKH1_PRIME(I) * DTSTAR SFMELT5A.141
EI(I) = EI(I) + DIFF_EI SFMELT5A.142
DFQW(I) = DFQW(I) + DIFF_EI SFMELT5A.143
DIFF_SURF_HTF = ASHTF(I) * DTSTAR SFMELT5A.144
SURF_HT_FLUX(I) = SURF_HT_FLUX(I) + DIFF_SURF_HTF SFMELT5A.145
TSTAR(I) = TSTAR(I) + DTSTAR SFMELT5A.146
IF (SMLT) SNOMLT_SURF_HTF(I) = LF*SNOWMELT(I) SFMELT5A.147
ENDIF SFMELT5A.148
10 CONTINUE ! End of loop over land points SFMELT5A.152
DO 20 I=P1,P1+POINTS-1 SFMELT5A.153
IF ( .NOT. LAND_MASK(I) ) THEN SFMELT5A.154
IF ( ICE_FRACT(I) .GT. 0.0 ) THEN SFMELT5A.156
C----------------------------------------------------------------------- SFMELT5A.157
C Melt sea-ice if TSTAR > TSTARMAX or TI > TM. SFMELT5A.158
C----------------------------------------------------------------------- SFMELT5A.159
TSTARMAX = ICE_FRACT(I)*TM + (1.0 - ICE_FRACT(I))*TFS SFMELT5A.160
IF ( TSTAR(I) .GT. TSTARMAX ) THEN SFMELT5A.161
DTSTAR = TSTARMAX - TSTAR(I) SFMELT5A.162
DMELT = (CP + (LC + LF)*ALPHA1(I))*RHOKH1_PRIME(I) SFMELT5A.163
& + ASHTF(I) SFMELT5A.164
DIFF_SENS_HTF(I) = CP * RHOKH1_PRIME(I) * DTSTAR SFMELT5A.165
DIFF_EI = ALPHA1(I) * RHOKH1_PRIME(I) * DTSTAR SFMELT5A.166
EI(I) = EI(I) + DIFF_EI SFMELT5A.167
DFQW(I) = DFQW(I) + DIFF_EI SFMELT5A.168
DIFF_SURF_HTF = ASHTF(I) * DTSTAR SFMELT5A.169
TI(I) =TI(I) + ASURF(I) * TIMESTEP * DIFF_SURF_HTF SFMELT5A.170
TSTAR(I) = TSTARMAX SFMELT5A.171
IF (SIMLT) SICE_MLT_HTF(I) = - DMELT * DTSTAR SFMELT5A.172
ENDIF SFMELT5A.173
IF ( TI(I) .GT. TM ) THEN SFMELT5A.174
IF (SIMLT) SICE_MLT_HTF(I) = SICE_MLT_HTF(I) + SFMELT5A.175
& (TI(I) - TM)/(ASURF(I)*TIMESTEP) SFMELT5A.176
TI(I) = TM SFMELT5A.177
ENDIF SFMELT5A.178
SFMELT5A.179
ENDIF ! Sea-ice SFMELT5A.180
ENDIF ! Sea SFMELT5A.185
20 CONTINUE ! End of loop over sea points SFMELT5A.186
IF (LTIMER) THEN SFMELT5A.188
CALL TIMER('SFMELT ',4) SFMELT5A.189
ENDIF SFMELT5A.190
RETURN SFMELT5A.191
END SFMELT5A.192
*ENDIF SFMELT5A.193