*IF DEF,A03_3A ASJ4F401.14
C ******************************COPYRIGHT****************************** GTS2F400.8929
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8930
C GTS2F400.8931
C Use, duplication or disclosure of this code is subject to the GTS2F400.8932
C restrictions as set forth in the contract. GTS2F400.8933
C GTS2F400.8934
C Meteorological Office GTS2F400.8935
C London Road GTS2F400.8936
C BRACKNELL GTS2F400.8937
C Berkshire UK GTS2F400.8938
C RG12 2SZ GTS2F400.8939
C GTS2F400.8940
C If no contract has been raised with this copy of the code, the use, GTS2F400.8941
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8942
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8943
C Modelling at the above address. GTS2F400.8944
C ******************************COPYRIGHT****************************** GTS2F400.8945
C GTS2F400.8946
C*LL SUBROUTINE SICE_HTF----------------------------------------------- SICEHT1A.3
CLL SICEHT1A.4
CLL Purpose: Calculates heat flux through sea-ice (+ve downwards). SICEHT1A.5
CLL Sea-ice leads heat flux calculated in P243 (SF_EXCH). SICEHT1A.6
CLL SICEHT1A.7
CLL Model Modification history from model version 3.0: SICEHT1A.8
CLL version date SICEHT1A.9
CLL 3.4 06/06/94 DEF TIMER replaced by LOGICAL LTIMER ASJ1F304.392
CLL Argument LTIMER added ASJ1F304.393
CLL S.J.Swarbrick ASJ1F304.394
CLL 4.1 08/05/96 decks A03_2C and A03_3B removed ASJ4F401.15
CLL S D Jackson ASJ4F401.16
CLL SICEHT1A.10
CLL Note: At present the formulation is so simple as to make this SICEHT1A.11
CLL routine fairly trivial; but in future the formulation may SICEHT1A.12
CLL be revised so as to make a separate routine more obviously SICEHT1A.13
CLL worthwhile. SICEHT1A.14
CLL SICEHT1A.15
CLL Programming standard: Unified Model Documentation Paper No.4 SICEHT1A.16
CLL version no.2, dated 18/1/90. SICEHT1A.17
CLL SICEHT1A.18
CLL System component covered: P241 SICEHT1A.19
CLL SICEHT1A.20
CLL Documentation: ?? SICEHT1A.21
CLL SICEHT1A.22
C* SICEHT1A.23
C*L Arguments:--------------------------------------------------------- SICEHT1A.24
SUBROUTINE SICE_HTF ( 4,6SICEHT1A.25
+ DI,ICE_FRACTION,LAND_MASK,TSTAR,POINTS,SEA_ICE_HTF,LTIMER ASJ1F304.395
+) SICEHT1A.27
IMPLICIT NONE SICEHT1A.28
LOGICAL LTIMER ASJ1F304.396
INTEGER POINTS ! IN No of gridpoints to be processed. SICEHT1A.29
REAL SICEHT1A.30
+ DI(POINTS) ! IN "Equivalent thickness" of sea-ice (m). SICEHT1A.31
+,ICE_FRACTION(POINTS) ! IN Fraction of gridbox covered by sea-ice. SICEHT1A.32
+,TSTAR(POINTS) ! IN Gridbox mean surface temperature (K). SICEHT1A.33
LOGICAL SICEHT1A.34
+ LAND_MASK(POINTS) ! IN Land mask (T for land, F for sea). SICEHT1A.35
REAL SICEHT1A.36
+ SEA_ICE_HTF(POINTS) ! OUT Heat flux through sea-ice (W per sq m, SICEHT1A.37
C ! positive downwards). SICEHT1A.38
C----------------------------------------------------------------------- SICEHT1A.39
CL No workspace or EXTERNAL routines required. SICEHT1A.40
C----------------------------------------------------------------------- SICEHT1A.41
EXTERNAL TIMER SICEHT1A.43
C* SICEHT1A.45
C Common and local physical constants. SICEHT1A.46
*CALL C_0_DG_C 
SICEHT1A.47
REAL KAPPAI SICEHT1A.48
PARAMETER ( SICEHT1A.49
+ KAPPAI=2.09 ! Thermal conductivity of sea-ice (W per SICEHT1A.50
C ! m per K). SICEHT1A.51
+) SICEHT1A.52
C Define local scalar. SICEHT1A.53
INTEGER I ! Loop Counter; horizontal field index. SICEHT1A.54
C----------------------------------------------------------------------- SICEHT1A.55
CL No significant structure. SICEHT1A.56
C----------------------------------------------------------------------- SICEHT1A.57
IF (LTIMER) THEN ASJ1F304.397
CALL TIMER('SICEHTF ',3) SICEHT1A.59
ENDIF ASJ1F304.398
DO 1 I=1,POINTS SICEHT1A.61
IF (.NOT.LAND_MASK(I) .AND. ICE_FRACTION(I).GT.0.0) THEN SICEHT1A.62
SEA_ICE_HTF(I)=KAPPAI*(TSTAR(I)-TFS)/DI(I) ! Eq P241.3 SICEHT1A.63
ELSE SICEHT1A.64
SEA_ICE_HTF(I)=0.0 SICEHT1A.65
ENDIF SICEHT1A.66
1 CONTINUE SICEHT1A.67
IF (LTIMER) THEN ASJ1F304.399
CALL TIMER('SICEHTF ',4) SICEHT1A.69
ENDIF ASJ1F304.400
RETURN SICEHT1A.71
END SICEHT1A.72
*ENDIF SICEHT1A.73