*IF DEF,A03_6A,OR,DEF,A03_7A ACB1F405.13
C *****************************COPYRIGHT****************************** SICEHT5B.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SICEHT5B.4
C SICEHT5B.5
C Use, duplication or disclosure of this code is subject to the SICEHT5B.6
C restrictions as set forth in the contract. SICEHT5B.7
C SICEHT5B.8
C Meteorological Office SICEHT5B.9
C London Road SICEHT5B.10
C BRACKNELL SICEHT5B.11
C Berkshire UK SICEHT5B.12
C RG12 2SZ SICEHT5B.13
C SICEHT5B.14
C If no contract has been raised with this copy of the code, the use, SICEHT5B.15
C duplication or disclosure of it is strictly prohibited. Permission SICEHT5B.16
C to do so must first be obtained in writing from the Head of Numerical SICEHT5B.17
C Modelling at the above address. SICEHT5B.18
C ******************************COPYRIGHT****************************** SICEHT5B.19
!!! SUBROUTINE SICE_HTF----------------------------------------------- SICEHT5B.20
!!! SICEHT5B.21
!!! Purpose: Calculates heat flux through sea-ice (+ve downwards). SICEHT5B.22
!!! Sea-ice leads heat flux calculated in P243 (SF_EXCH). SICEHT5B.23
!!! SICEHT5B.24
!!! Model Modification history SICEHT5B.25
!!! version date SICEHT5B.26
!!! SICEHT5B.27
!!! Note: At present the formulation is so simple as to make this SICEHT5B.28
!!! routine fairly trivial; but in future the formulation may SICEHT5B.29
!!! be revised so as to make a separate routine more obviously SICEHT5B.30
!!! worthwhile. SICEHT5B.31
!!! SICEHT5B.32
!!! Programming standard: Unified Model Documentation Paper No.4 SICEHT5B.33
!!! version no.2, dated 18/1/90. SICEHT5B.34
!!! SICEHT5B.35
!!! System component covered: P241 SICEHT5B.36
!!! SICEHT5B.37
!!! Documentation: ?? SICEHT5B.38
!!! SICEHT5B.39
!!! ********************************************* SICEHT5B.40
!!! Penman-Monteith model. RE 19/1/95 SICEHT5B.41
!!! ********************************************* SICEHT5B.42
!!! Updates surface layer temperature and diagnoses surface temperature SICEHT5B.43
!!! for sea-ice. SICEHT5B.44
SICEHT5B.45
SICEHT5B.46
! Arguments:--------------------------------------------------------- SICEHT5B.47
SUBROUTINE SICE_HTF ( 4,6SICEHT5B.48
& ASHTF,DI,ICE_FRACTION,SURF_HT_FLUX,TIMESTEP SICEHT5B.49
&,LAND_MASK,P_FIELD,POINTS,P1,TI,TSTAR,ASURF,SEA_ICE_HTF SICEHT5B.50
&,LTIMER) SICEHT5B.51
IMPLICIT NONE SICEHT5B.52
SICEHT5B.53
LOGICAL LTIMER SICEHT5B.54
SICEHT5B.55
INTEGER SICEHT5B.56
& POINTS ! IN No of gridpoints to be processed. SICEHT5B.57
&,P_FIELD ! IN Total Number of points on p-grid SICEHT5B.58
&,P1 ! IN First point of p grid to be processed SICEHT5B.59
SICEHT5B.60
REAL SICEHT5B.61
& ASHTF(P_FIELD) ! IN Coefficient to calculate surface SICEHT5B.62
! heat flux into sea-ice (W/m2/K). SICEHT5B.63
&,DI(P_FIELD) ! IN "Equivalent thickness" of sea-ice (m). SICEHT5B.64
&,ICE_FRACTION(P_FIELD)! IN Fraction of gridbox covered by sea-ice. SICEHT5B.65
&,SURF_HT_FLUX(P_FIELD)! IN Net downward heat flux at surface W/m2 SICEHT5B.66
SICEHT5B.67
&,TIMESTEP ! IN Timestep (s). SICEHT5B.68
SICEHT5B.69
LOGICAL SICEHT5B.70
& LAND_MASK(P_FIELD) ! IN Land mask (T for land, F for sea). SICEHT5B.71
SICEHT5B.72
REAL SICEHT5B.73
& TI(P_FIELD) ! INOUT Sea-ice surface layer temperature SICEHT5B.74
! (K). Set to TSTAR for unfrozen sea, SICEHT5B.75
! missing data for land. SICEHT5B.76
&,TSTAR(P_FIELD) ! INOUT Gridbox mean surface temperature (K) SICEHT5B.77
&,ASURF(P_FIELD) ! OUT Reciprocal areal heat capacity of SICEHT5B.78
! sea-ice surface layer (Km2/J). SICEHT5B.79
&,SEA_ICE_HTF(P_FIELD) ! OUT Heat flux through sea-ice (W per sq m, SICEHT5B.80
! positive downwards). SICEHT5B.81
SICEHT5B.82
!----------------------------------------------------------------------- SICEHT5B.83
!! No workspace or EXTERNAL routines required. SICEHT5B.84
!----------------------------------------------------------------------- SICEHT5B.85
SICEHT5B.86
EXTERNAL TIMER SICEHT5B.87
SICEHT5B.88
! Common and local physical constants. SICEHT5B.89
*CALL C_0_DG_C 
SICEHT5B.90
*CALL C_KAPPAI SICEHT5B.91
*CALL C_SICEHC SICEHT5B.92
SICEHT5B.93
! Define local scalar. SICEHT5B.94
INTEGER I ! Loop Counter; horizontal field index. SICEHT5B.95
!----------------------------------------------------------------------- SICEHT5B.96
!! No significant structure. SICEHT5B.97
!----------------------------------------------------------------------- SICEHT5B.98
SICEHT5B.99
IF (LTIMER) THEN SICEHT5B.100
CALL TIMER('SICEHTF ',3) SICEHT5B.101
ENDIF SICEHT5B.102
SICEHT5B.103
SICEHT5B.104
DO I=P1,P1+POINTS-1 SICEHT5B.105
IF (LAND_MASK(I)) THEN SICEHT5B.106
SEA_ICE_HTF(I)=0.0 SICEHT5B.107
TI(I) = 1.0E30 SICEHT5B.108
ELSE IF (ICE_FRACTION(I).LE.0.0) THEN SICEHT5B.109
SEA_ICE_HTF(I)=0.0 SICEHT5B.110
TI(I) = TSTAR(I) SICEHT5B.111
ELSE SICEHT5B.112
ASURF(I) = AI / ICE_FRACTION(I) SICEHT5B.113
SEA_ICE_HTF(I) = KAPPAI*ICE_FRACTION(I)*(TI(I) - TFS)/DI(I) SICEHT5B.114
TSTAR(I) = (1. - ICE_FRACTION(I))*TFS + ICE_FRACTION(I)*TI(I) SICEHT5B.115
& + SURF_HT_FLUX(I)/ASHTF(I) SICEHT5B.116
TI(I) = TI(I) + ASURF(I)*TIMESTEP* SICEHT5B.117
& (SURF_HT_FLUX(I) - SEA_ICE_HTF(I)) SICEHT5B.118
ENDIF SICEHT5B.119
ENDDO SICEHT5B.120
SICEHT5B.121
IF (LTIMER) THEN SICEHT5B.122
CALL TIMER('SICEHTF ',4) SICEHT5B.123
ENDIF SICEHT5B.124
SICEHT5B.125
RETURN SICEHT5B.126
END SICEHT5B.127
*ENDIF SICEHT5B.128