SUBROUTINE HEAT_CON(NPNTS,HCON,STHU,STHF, 7,2HTCOND5A.23
& V_SAT,HCONS HTCOND5A.24
C LOGICAL LTIMER HTCOND5A.25
+,LTIMER HTCOND5A.26
+) HTCOND5A.27
HTCOND5A.28
IMPLICIT NONE HTCOND5A.29
! HTCOND5A.30
! Description: HTCOND5A.31
! Calculates the soil thermal conductivity including the HTCOND5A.32
! effects of water and ice using the method suggested by HTCOND5A.33
! Farouki (1981) (note error in Verseghy, 1991) HTCOND5A.34
! (Cox, 6/95) HTCOND5A.35
! HTCOND5A.36
! Documentation : UM Documentation Paper 25 HTCOND5A.37
! HTCOND5A.38
! Current Code Owner : David Gregory HTCOND5A.39
! HTCOND5A.40
! History: HTCOND5A.41
! Version Date Comment HTCOND5A.42
! ------- ---- ------- HTCOND5A.43
! 4.1 New deck. Peter Cox HTCOND5A.44
!LL 4.5 18/06/98 Changed Timer calls to indicate non-barrier GPB8F405.47
!LL P.Burton GPB8F405.48
! HTCOND5A.45
! Code Description: HTCOND5A.46
! Language: FORTRAN 77 + common extensions. HTCOND5A.47
! HTCOND5A.48
! System component covered: P25 HTCOND5A.49
! System Task: P25 HTCOND5A.50
! HTCOND5A.51
HTCOND5A.52
HTCOND5A.53
! Subroutine arguments: HTCOND5A.54
! Scalar arguments with intent(IN) : HTCOND5A.55
INTEGER HTCOND5A.56
& NPNTS ! IN Number of gridpoints HTCOND5A.57
HTCOND5A.58
REAL HTCOND5A.59
& HCON(NPNTS) ! IN Dry soil thermal conductivity (W/m/K). HTCOND5A.60
&,STHU(NPNTS) ! IN Fractional saturation of unfrozen water HTCOND5A.61
! ! at layer boundaries. HTCOND5A.62
&,STHF(NPNTS) ! IN Fractional saturation of frozen water HTCOND5A.63
! ! at layer boundaries. HTCOND5A.64
&,V_SAT(NPNTS) ! IN Volumetric soil moisture concentration HTCOND5A.65
! ! at saturation (m3/m3 soil). HTCOND5A.66
C HTCOND5A.67
LOGICAL LTIMER ! Logical switch for TIMER diags HTCOND5A.68
HTCOND5A.69
! Array arguments with intent(OUT) : HTCOND5A.70
REAL HTCOND5A.71
& HCONS(NPNTS) ! OUT The thermal conductivity between adjacen HTCOND5A.72
! ! layers including effects of water and ic HTCOND5A.73
! ! (W/m/K). HTCOND5A.74
! HTCOND5A.75
*CALL C_SOILH 
HTCOND5A.76
! Local scalars: HTCOND5A.77
INTEGER HTCOND5A.78
& I,J ! WORK Loop counter. HTCOND5A.79
HTCOND5A.80
! Local arrays: HTCOND5A.81
REAL HTCOND5A.82
& HCSAT(NPNTS) ! WORK The thermal conductivity of the HTCOND5A.83
! ! saturated soil at current ratio of ice to HTCOND5A.84
! ! liquid water (W/m/K). HTCOND5A.85
&,STH(NPNTS) ! WORK Fractional saturation of water HTCOND5A.86
! ! (liquid+ice) at layer boundaries. HTCOND5A.87
&,THICE(NPNTS) ! WORK The concentration of ice at saturation HTCOND5A.88
! ! for the current mass fraction of liquid HTCOND5A.89
! ! water (m3 H2O/m3 soil). HTCOND5A.90
&,THWAT(NPNTS) ! WORK The concentration of liquid water at HTCOND5A.91
! ! saturation for the current mass HTCOND5A.92
! ! fraction of liquid water (m3 H2O/m3 soil). HTCOND5A.93
!----------------------------------------------------------------------- HTCOND5A.94
! Local Parameters (Source: "The Frozen Earth" p.90) HTCOND5A.95
!----------------------------------------------------------------------- HTCOND5A.96
REAL HTCOND5A.97
& HCAIR ! Thermal conductivity of air (W/m/K). HTCOND5A.98
&,HCICE ! Thermal conductivity of ice (W/m/K). HTCOND5A.99
&,HCWAT ! Thermal conductivity of liquid water (W/m/K) HTCOND5A.100
PARAMETER (HCAIR=0.025,HCICE=2.24,HCWAT=0.56) HTCOND5A.101
HTCOND5A.102
IF (LTIMER) THEN HTCOND5A.103
CALL TIMER('HEATCON ',103) GPB8F405.49
ENDIF HTCOND5A.105
HTCOND5A.106
!---------------------------------------------------------------------- HTCOND5A.107
! Initialise all points HTCOND5A.108
!---------------------------------------------------------------------- HTCOND5A.109
DO I=1,NPNTS HTCOND5A.110
IF (V_SAT(I).GT.0.0) THEN ! Soil points HTCOND5A.111
HCONS(I)=HCON(I) HTCOND5A.112
ELSE ! Ice points HTCOND5A.113
HCONS(I)=SNOW_HCON HTCOND5A.114
ENDIF HTCOND5A.115
ENDDO HTCOND5A.116
HTCOND5A.117
DO I=1,NPNTS HTCOND5A.118
!--------------------------------------------------------------- HTCOND5A.119
! Only do calculation for non land-ice pts HTCOND5A.120
! V_SAT is set to zero for land-ice points HTCOND5A.121
!--------------------------------------------------------------- HTCOND5A.122
IF (V_SAT(I).GT.0.0) THEN HTCOND5A.123
HTCOND5A.124
IF (STHU(I).GT.0.0) THEN HTCOND5A.125
THWAT(I)=V_SAT(I)*STHU(I)/(STHU(I)+STHF(I)) HTCOND5A.126
ELSE HTCOND5A.127
THWAT(I)=0.0 HTCOND5A.128
ENDIF HTCOND5A.129
HTCOND5A.130
IF (STHF(I).GT.0.0) THEN HTCOND5A.131
THICE(I)=V_SAT(I)*STHF(I)/(STHU(I)+STHF(I)) HTCOND5A.132
ELSE HTCOND5A.133
THICE(I)=0.0 HTCOND5A.134
ENDIF HTCOND5A.135
HTCOND5A.136
STH(I)=STHU(I)+STHF(I) HTCOND5A.137
HCSAT(I)=HCON(I)*(HCWAT**THWAT(I))*(HCICE**THICE(I)) HTCOND5A.138
& /(HCAIR**V_SAT(I)) HTCOND5A.139
HCONS(I)=(HCSAT(I)-HCON(I))*STH(I)+HCON(I) HTCOND5A.140
ENDIF HTCOND5A.141
HTCOND5A.142
ENDDO HTCOND5A.143
HTCOND5A.144
IF (LTIMER) THEN HTCOND5A.145
CALL TIMER('HEATCON ',104) GPB8F405.50
ENDIF HTCOND5A.147
RETURN HTCOND5A.148
END HTCOND5A.149
*ENDIF HTCOND5A.150