*IF DEF,A03_5A AJS1F401.1484
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.14436
C GTS2F400.14437
C Use, duplication or disclosure of this code is subject to the GTS2F400.14438
C restrictions as set forth in the contract. GTS2F400.14439
C GTS2F400.14440
C Meteorological Office GTS2F400.14441
C London Road GTS2F400.14442
C BRACKNELL GTS2F400.14443
C Berkshire UK GTS2F400.14444
C RG12 2SZ GTS2F400.14445
C GTS2F400.14446
C If no contract has been raised with this copy of the code, the use, GTS2F400.14447
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.14448
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.14449
C Modelling at the above address. GTS2F400.14450
C ******************************COPYRIGHT****************************** GTS2F400.14451
C GTS2F400.14452
C*LL SUBROUTINE SICE_HTF----------------------------------------------- SICEHT4A.3
CLL SICEHT4A.4
CLL Purpose: Calculates heat flux through sea-ice (+ve downwards). SICEHT4A.5
CLL Sea-ice leads heat flux calculated in P243 (SF_EXCH). SICEHT4A.6
CLL SICEHT4A.7
CLL Model Modification history from model version 3.0: SICEHT4A.8
CLL version date SICEHT4A.9
CLL 3.4 06/06/94 DEF TIMER replaced by LOGICAL LTIMER SICEHT4A.10
CLL Argument LTIMER added SICEHT4A.11
CLL S.J.Swarbrick SICEHT4A.12
CLL SICEHT4A.13
CLL Note: At present the formulation is so simple as to make this SICEHT4A.14
CLL routine fairly trivial; but in future the formulation may SICEHT4A.15
CLL be revised so as to make a separate routine more obviously SICEHT4A.16
CLL worthwhile. SICEHT4A.17
CLL SICEHT4A.18
CLL Programming standard: Unified Model Documentation Paper No.4 SICEHT4A.19
CLL version no.2, dated 18/1/90. SICEHT4A.20
CLL SICEHT4A.21
CLL System component covered: P241 SICEHT4A.22
CLL SICEHT4A.23
CLL Documentation: ?? SICEHT4A.24
CLL SICEHT4A.25
CLL ********************************************* SICEHT4A.26
CLL Penman-Monteith model. RE 19/1/95 SICEHT4A.27
CLL ********************************************* SICEHT4A.28
CLL Updates surface layer temperature and diagnoses surface temperature SICEHT4A.29
CLL for sea-ice. SICEHT4A.30
CLL SICEHT4A.31
C* SICEHT4A.32
C*L Arguments:--------------------------------------------------------- SICEHT4A.33
SUBROUTINE SICE_HTF(ASHTF,DI,ICE_FRACTION,SURF_HT_FLUX,TIMESTEP, 4,6SICEHT4A.34
+ LAND_MASK,POINTS,TI,TSTAR,ASURF,SEA_ICE_HTF, SICEHT4A.35
+ LTIMER) SICEHT4A.36
IMPLICIT NONE SICEHT4A.37
LOGICAL LTIMER SICEHT4A.38
INTEGER POINTS ! IN No of gridpoints to be processed. SICEHT4A.39
REAL SICEHT4A.40
+ ASHTF(POINTS) ! IN Coefficient to calculate surface SICEHT4A.41
C ! heat flux into sea-ice (W/m2/K). SICEHT4A.42
+,DI(POINTS) ! IN "Equivalent thickness" of sea-ice (m). SICEHT4A.43
+,ICE_FRACTION(POINTS) ! IN Fraction of gridbox covered by sea-ice. SICEHT4A.44
+,SURF_HT_FLUX(POINTS) ! IN Net downward heat flux at surface SICEHT4A.45
C ! (W/m2). SICEHT4A.46
+,TIMESTEP ! IN Timestep (s). SICEHT4A.47
LOGICAL SICEHT4A.48
+ LAND_MASK(POINTS) ! IN Land mask (T for land, F for sea). SICEHT4A.49
REAL SICEHT4A.50
+ TI(POINTS) ! INOUT Sea-ice surface layer temperature SICEHT4A.51
C ! (K). Set to TSTAR for unfrozen sea, SICEHT4A.52
C ! missing data for land. SICEHT4A.53
+,TSTAR(POINTS) ! INOUT Gridbox mean surface temperature (K) SICEHT4A.54
+,ASURF(POINTS) ! OUT Reciprocal areal heat capacity of SICEHT4A.55
C ! sea-ice surface layer (Km2/J). SICEHT4A.56
+,SEA_ICE_HTF(POINTS) ! OUT Heat flux through sea-ice (W per sq m, SICEHT4A.57
C ! positive downwards). SICEHT4A.58
C----------------------------------------------------------------------- SICEHT4A.59
CL No workspace or EXTERNAL routines required. SICEHT4A.60
C----------------------------------------------------------------------- SICEHT4A.61
EXTERNAL TIMER SICEHT4A.62
C* SICEHT4A.63
C Common and local physical constants. SICEHT4A.64
*CALL C_0_DG_C 
SICEHT4A.65
*CALL C_KAPPAI SICEHT4A.66
*CALL C_SICEHC SICEHT4A.67
C Define local scalar. SICEHT4A.68
INTEGER I ! Loop Counter; horizontal field index. SICEHT4A.69
C----------------------------------------------------------------------- SICEHT4A.70
CL No significant structure. SICEHT4A.71
C----------------------------------------------------------------------- SICEHT4A.72
IF (LTIMER) THEN SICEHT4A.73
CALL TIMER('SICEHTF ',3) SICEHT4A.74
ENDIF SICEHT4A.75
DO 1 I=1,POINTS SICEHT4A.76
IF (LAND_MASK(I)) THEN SICEHT4A.77
SEA_ICE_HTF(I)=0.0 SICEHT4A.78
TI(I) = 0.0 SICEHT4A.79
ELSE IF (ICE_FRACTION(I).LE.0.0) THEN SICEHT4A.80
SEA_ICE_HTF(I)=0.0 SICEHT4A.81
TI(I) = TSTAR(I) SICEHT4A.82
ELSE SICEHT4A.83
ASURF(I) = AI / ICE_FRACTION(I) SICEHT4A.84
SEA_ICE_HTF(I) = KAPPAI*ICE_FRACTION(I)*(TI(I) - TFS)/DI(I) SICEHT4A.85
TSTAR(I) = (1. - ICE_FRACTION(I))*TFS + ICE_FRACTION(I)*TI(I) SICEHT4A.86
& + SURF_HT_FLUX(I)/ASHTF(I) SICEHT4A.87
TI(I) = TI(I) + ASURF(I)*TIMESTEP* SICEHT4A.88
& (SURF_HT_FLUX(I) - SEA_ICE_HTF(I)) SICEHT4A.89
ENDIF SICEHT4A.90
1 CONTINUE SICEHT4A.91
IF (LTIMER) THEN SICEHT4A.92
CALL TIMER('SICEHTF ',4) SICEHT4A.93
ENDIF SICEHT4A.94
RETURN SICEHT4A.95
END SICEHT4A.96
*ENDIF SICEHT4A.97