SUBROUTINE ICE_HTC ( 2,2ICEHTC5A.23
& NPNTS,NSHYD,LICE_PTS,LICE_INDEX,DZ ICEHTC5A.24
&,SURF_HT_FLUX,TIMESTEP ICEHTC5A.25
&,TSOIL ICEHTC5A.26
C LOGICAL LTIMER ICEHTC5A.27
+,LTIMER ICEHTC5A.28
+) ICEHTC5A.29
ICEHTC5A.30
IMPLICIT NONE ICEHTC5A.31
! ICEHTC5A.32
! Description: ICEHTC5A.33
! Updates deep soil temperatures for ice. No external subroutines ICEHTC5A.34
! are called. ICEHTC5A.35
! (Cox, 10/95) ICEHTC5A.36
! ICEHTC5A.37
! Documentation : UM Documentation Paper 25 ICEHTC5A.38
! ICEHTC5A.39
! Current Code Owner : David Gregory ICEHTC5A.40
! ICEHTC5A.41
! History: ICEHTC5A.42
! Version Date Comment ICEHTC5A.43
! ------- ---- ------- ICEHTC5A.44
! 4.1 6/96 New deck. Peter Cox ICEHTC5A.45
!LL 4.5 18/06/98 Changed Timer calls to indicate non-barrier GPB8F405.43
!LL P.Burton GPB8F405.44
! ICEHTC5A.46
! Code Description: ICEHTC5A.47
! Language: FORTRAN 77 + common extensions. ICEHTC5A.48
! ICEHTC5A.49
! System component covered: P25 ICEHTC5A.50
! System Task: P25 ICEHTC5A.51
! ICEHTC5A.52
ICEHTC5A.53
! Global variables: ICEHTC5A.54
*CALL C_SOILH 
ICEHTC5A.55
ICEHTC5A.56
! Subroutine arguments ICEHTC5A.57
! Scalar arguments with intent(IN) : ICEHTC5A.58
INTEGER ICEHTC5A.59
& LICE_PTS ! IN Number of land ice points. ICEHTC5A.60
&,NPNTS ! IN Number of gridpoints. ICEHTC5A.61
&,NSHYD ! IN Number of soil moisture levels. ICEHTC5A.62
ICEHTC5A.63
REAL ICEHTC5A.64
& TIMESTEP ! IN Model timestep (s). ICEHTC5A.65
ICEHTC5A.66
ICEHTC5A.67
! Array arguments with intent(IN) : ICEHTC5A.68
INTEGER ICEHTC5A.69
& LICE_INDEX(NPNTS) ! IN Array of ice points. ICEHTC5A.70
ICEHTC5A.71
REAL ICEHTC5A.72
& DZ(NSHYD) ! IN Thicknesses of the soil layers (m). ICEHTC5A.73
&,SURF_HT_FLUX(NPNTS) ! IN Net downward surface heat flux (W/m2). ICEHTC5A.74
C ICEHTC5A.75
LOGICAL LTIMER ! Logical switch for TIMER diags ICEHTC5A.76
ICEHTC5A.77
! Array arguments with intent(INOUT) : ICEHTC5A.78
REAL ICEHTC5A.79
& TSOIL(NPNTS,NSHYD) ! INOUT Sub-surface temperatures (K). ICEHTC5A.80
ICEHTC5A.81
! Local scalars: ICEHTC5A.82
INTEGER ICEHTC5A.83
& I,J,N ! WORK Loop counters. ICEHTC5A.84
ICEHTC5A.85
! Local arrays: ICEHTC5A.86
REAL ICEHTC5A.87
& H_FLUX(NPNTS,0:NSHYD)! WORK The fluxes of heat between layers ICEHTC5A.88
! ! (W/m2). ICEHTC5A.89
ICEHTC5A.90
IF (LTIMER) THEN ICEHTC5A.91
CALL TIMER('ICEHTC ',103) GPB8F405.45
ENDIF ICEHTC5A.93
ICEHTC5A.94
!-------------------------------------------------------------------- ICEHTC5A.95
! Calculate heat fluxes across layer boundaries ICEHTC5A.96
!-------------------------------------------------------------------- ICEHTC5A.97
DO N=1,NSHYD-1 ICEHTC5A.98
DO J=1,LICE_PTS ICEHTC5A.99
I=LICE_INDEX(J) ICEHTC5A.100
H_FLUX(I,N)=-SNOW_HCON*2.0*(TSOIL(I,N+1)-TSOIL(I,N)) ICEHTC5A.101
& /(DZ(N+1)+DZ(N)) ICEHTC5A.102
ENDDO ICEHTC5A.103
ENDDO ICEHTC5A.104
ICEHTC5A.105
CDIR$ IVDEP ICEHTC5A.106
! Fujitsu vectorization directive GRB0F405.357
!OCL NOVREC GRB0F405.358
DO J=1,LICE_PTS ICEHTC5A.107
I=LICE_INDEX(J) ICEHTC5A.108
H_FLUX(I,NSHYD)=0.0 ICEHTC5A.109
H_FLUX(I,0)=SURF_HT_FLUX(I) ICEHTC5A.110
ENDDO ICEHTC5A.111
ICEHTC5A.112
ICEHTC5A.113
!-------------------------------------------------------------------- ICEHTC5A.114
! Update the sub-surface temperatures ICEHTC5A.115
!-------------------------------------------------------------------- ICEHTC5A.116
DO N=1,NSHYD ICEHTC5A.117
! CDIR$ IVDEP here would force vectorization but changes results! ICEHTC5A.118
DO J=1,LICE_PTS ICEHTC5A.119
I=LICE_INDEX(J) ICEHTC5A.120
ICEHTC5A.121
TSOIL(I,N)=TSOIL(I,N) ICEHTC5A.122
& +1.0/(SNOW_HCAP*DZ(N))*(H_FLUX(I,N-1) ICEHTC5A.123
& -H_FLUX(I,N))*TIMESTEP ICEHTC5A.124
ICEHTC5A.125
ENDDO ICEHTC5A.126
ENDDO ICEHTC5A.127
ICEHTC5A.128
IF (LTIMER) THEN ICEHTC5A.129
CALL TIMER('ICEHTC ',104) GPB8F405.46
ENDIF ICEHTC5A.131
ICEHTC5A.132
RETURN ICEHTC5A.133
END ICEHTC5A.134
*ENDIF ICEHTC5A.135