*IF DEF,A08_5A,OR,DEF,A08_7A ARE1F404.348
C *****************************COPYRIGHT****************************** HYDCON5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. HYDCON5A.4
C HYDCON5A.5
C Use, duplication or disclosure of this code is subject to the HYDCON5A.6
C restrictions as set forth in the contract. HYDCON5A.7
C HYDCON5A.8
C Meteorological Office HYDCON5A.9
C London Road HYDCON5A.10
C BRACKNELL HYDCON5A.11
C Berkshire UK HYDCON5A.12
C RG12 2SZ HYDCON5A.13
C HYDCON5A.14
C If no contract has been raised with this copy of the code, the use, HYDCON5A.15
C duplication or disclosure of it is strictly prohibited. Permission HYDCON5A.16
C to do so must first be obtained in writing from the Head of Numerical HYDCON5A.17
C Modelling at the above address. HYDCON5A.18
C ******************************COPYRIGHT****************************** HYDCON5A.19
! SUBROUTINE HYD_CON------------------------------------------------ HYDCON5A.20
! HYDCON5A.21
! Subroutine Interface: HYDCON5A.22
SUBROUTINE HYD_CON (NPNTS,SOIL_PTS,SOIL_INDEX,B,KS,THETAK,K 2,2HYDCON5A.23
C LOGICAL LTIMER HYDCON5A.24
+,LTIMER HYDCON5A.25
+) HYDCON5A.26
HYDCON5A.27
IMPLICIT NONE HYDCON5A.28
! HYDCON5A.29
! Description: HYDCON5A.30
! Calculates the hydraulic conductivity (Cox, 6/95) HYDCON5A.31
! HYDCON5A.32
! HYDCON5A.33
! Documentation : UM Documentation Paper 25 HYDCON5A.34
! HYDCON5A.35
! Current Code Owner : David Gregory HYDCON5A.36
! HYDCON5A.37
! History: HYDCON5A.38
! Version Date Comment HYDCON5A.39
! ------- ---- ------- HYDCON5A.40
! 4.1 6/96 New deck. Peter Cox HYDCON5A.41
! HYDCON5A.42
! Code Description: HYDCON5A.43
! Language: FORTRAN 77 + common extensions. HYDCON5A.44
! HYDCON5A.45
! System component covered: P25 HYDCON5A.46
! System Task: P25 HYDCON5A.47
! HYDCON5A.48
! Subroutine arguments: HYDCON5A.49
! Scalar arguments with intent(IN) : HYDCON5A.50
INTEGER HYDCON5A.51
& NPNTS ! IN points in grid HYDCON5A.52
&,SOIL_PTS ! IN Number of soil points. HYDCON5A.53
HYDCON5A.54
! Array arguments with intent(IN) : HYDCON5A.55
INTEGER HYDCON5A.56
& SOIL_INDEX(NPNTS)! IN Array of soil points. HYDCON5A.57
HYDCON5A.58
REAL HYDCON5A.59
& B(NPNTS) ! IN Exponent in conductivity and soil water HYDCON5A.60
! ! suction fits. HYDCON5A.61
&,KS(NPNTS) ! IN The saturated hydraulic conductivity (kg/m2 HYDCON5A.62
&,THETAK(NPNTS) ! IN Fractional saturation. HYDCON5A.63
C HYDCON5A.64
LOGICAL LTIMER ! Logical switch for TIMER diags HYDCON5A.65
HYDCON5A.66
! Array arguments with intent(OUT) : HYDCON5A.67
REAL HYDCON5A.68
& K(NPNTS) ! OUT The hydraulic conductivity (kg/m2/s). HYDCON5A.69
HYDCON5A.70
! Local scalars: HYDCON5A.71
INTEGER HYDCON5A.72
& I,J ! WORK Loop counter. HYDCON5A.73
HYDCON5A.74
IF (LTIMER) THEN HYDCON5A.75
CALL TIMER
('HYDCON ',103) GPB8F405.144
ENDIF HYDCON5A.77
HYDCON5A.78
DO J=1,SOIL_PTS HYDCON5A.79
I=SOIL_INDEX(J) HYDCON5A.80
HYDCON5A.81
IF (THETAK(I).GE.0.0.AND.THETAK(I).LT.1.0) THEN HYDCON5A.82
K(I)=KS(I)*THETAK(I)**(2*B(I)+3) HYDCON5A.83
ELSEIF (THETAK(I).LT.0.0) THEN HYDCON5A.84
K(I)=0.0 HYDCON5A.85
ELSE HYDCON5A.86
K(I)=KS(I) HYDCON5A.87
ENDIF HYDCON5A.88
HYDCON5A.89
ENDDO HYDCON5A.90
HYDCON5A.91
IF (LTIMER) THEN HYDCON5A.92
CALL TIMER
('HYDCON ',104) GPB8F405.145
ENDIF HYDCON5A.94
HYDCON5A.95
RETURN HYDCON5A.96
END HYDCON5A.97
*ENDIF HYDCON5A.98