*IF DEF,A08_5A,OR,DEF,A08_7A ARE1F404.349
C *****************************COPYRIGHT****************************** DARCY5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. DARCY5A.4
C DARCY5A.5
C Use, duplication or disclosure of this code is subject to the DARCY5A.6
C restrictions as set forth in the contract. DARCY5A.7
C DARCY5A.8
C Meteorological Office DARCY5A.9
C London Road DARCY5A.10
C BRACKNELL DARCY5A.11
C Berkshire UK DARCY5A.12
C RG12 2SZ DARCY5A.13
C DARCY5A.14
C If no contract has been raised with this copy of the code, the use, DARCY5A.15
C duplication or disclosure of it is strictly prohibited. Permission DARCY5A.16
C to do so must first be obtained in writing from the Head of Numerical DARCY5A.17
C Modelling at the above address. DARCY5A.18
C ******************************COPYRIGHT****************************** DARCY5A.19
! SUBROUTINE DARCY-------------------------------------------------- DARCY5A.20
! DARCY5A.21
! Subroutine Interface: DARCY5A.22
SUBROUTINE DARCY (NPNTS,SOIL_PTS,SOIL_INDEX,B,KS,SATHH, 1,3DARCY5A.23
& STHU1,DZ1,STHU2,DZ2,WFLUX DARCY5A.24
C LOGICAL LTIMER DARCY5A.25
+,LTIMER DARCY5A.26
+) DARCY5A.27
DARCY5A.28
IMPLICIT NONE DARCY5A.29
! DARCY5A.30
! Description: DARCY5A.31
! Calculates the Darcian fluxes between adjacent soil layers. DARCY5A.32
! (Cox, 6/95) DARCY5A.33
! DARCY5A.34
! DARCY5A.35
! Documentation : UM Documentation Paper 25 DARCY5A.36
! DARCY5A.37
! Current Code Owner : David Gregory DARCY5A.38
! DARCY5A.39
! History: DARCY5A.40
! Version Date Comment DARCY5A.41
! ------- ---- ------- DARCY5A.42
! 4.1 6/96 New deck. Peter Cox DARCY5A.43
! DARCY5A.44
! Code Description: DARCY5A.45
! Language: FORTRAN 77 + common extensions. DARCY5A.46
! DARCY5A.47
! System component covered: P25 DARCY5A.48
! System Task: P25 DARCY5A.49
! DARCY5A.50
DARCY5A.51
! Global variables: DARCY5A.52
DARCY5A.53
! Subroutine arguments DARCY5A.54
! Scalar arguments with intent(IN) : DARCY5A.55
INTEGER DARCY5A.56
& NPNTS ! IN Number of gridpoints. DARCY5A.57
&,SOIL_PTS ! IN Number of soil points. DARCY5A.58
DARCY5A.59
DARCY5A.60
! Array arguments with intent(IN) : DARCY5A.61
INTEGER DARCY5A.62
& SOIL_INDEX(NPNTS) ! IN Array of soil points. DARCY5A.63
DARCY5A.64
REAL DARCY5A.65
& B(NPNTS) ! IN Clapp-Hornberger exponent. DARCY5A.66
&,DZ1 ! IN Thickness of the upper layer (m). DARCY5A.67
&,DZ2 ! IN Thickness of the lower layer (m). DARCY5A.68
&,KS(NPNTS) ! IN Saturated hydraulic conductivity DARCY5A.69
! ! (kg/m2/s). DARCY5A.70
&,SATHH(NPNTS) ! IN Saturated soil water pressure (m). DARCY5A.71
&,STHU1(NPNTS) ! IN Unfrozen soil moisture content of upper DARCY5A.72
! ! layer as a fraction of saturation. DARCY5A.73
! DARCY5A.74
&,STHU2(NPNTS) ! IN Unfrozen soil moisture content of lower DARCY5A.75
! ! layer as a fraction of saturation. DARCY5A.76
C DARCY5A.77
LOGICAL LTIMER ! Logical switch for TIMER diags DARCY5A.78
DARCY5A.79
DARCY5A.80
! Array arguments with intent(OUT) : DARCY5A.81
REAL DARCY5A.82
& WFLUX(NPNTS) ! OUT The flux of water between layers DARCY5A.83
! ! (kg/m2/s). DARCY5A.84
DARCY5A.85
! Local scalars: DARCY5A.86
INTEGER DARCY5A.87
& I,J,N ! WORK Loop counters. DARCY5A.88
DARCY5A.89
! Local arrays: DARCY5A.90
REAL DARCY5A.91
& THETA(NPNTS,2) ! WORK Fractional saturation of the upper DARCY5A.92
! ! and lower layer respectively. DARCY5A.93
&,THETAK(NPNTS) ! WORK Fractional saturation at the layer DARCY5A.94
! ! boundary. DARCY5A.95
&,K(NPNTS) ! WORK The hydraulic conductivity between DARCY5A.96
! ! layers (kg/m2/s). DARCY5A.97
&,PSI(NPNTS,2) ! WORK The soil water suction of the upper DARCY5A.98
! ! and lower layer respectively (m). DARCY5A.99
IF (LTIMER) THEN DARCY5A.100
CALL TIMER
('DARCY ',103) GPB8F405.142
ENDIF DARCY5A.102
DARCY5A.103
!----------------------------------------------------------------------- DARCY5A.104
! Calculate the fractional saturation of the layers DARCY5A.105
!----------------------------------------------------------------------- DARCY5A.106
DO J=1,SOIL_PTS DARCY5A.107
I=SOIL_INDEX(J) DARCY5A.108
THETA(I,1)=STHU1(I) DARCY5A.109
THETA(I,2)=STHU2(I) DARCY5A.110
ENDDO DARCY5A.111
DARCY5A.112
!----------------------------------------------------------------------- DARCY5A.113
! Calculate the soil water suction of the layers. DARCY5A.114
!----------------------------------------------------------------------- DARCY5A.115
DO N=1,2 DARCY5A.116
DO J=1,SOIL_PTS DARCY5A.117
I=SOIL_INDEX(J) DARCY5A.118
IF (THETA(I,N).LE.0.01) THEN ! Prevent blow up for dry soil. ACB1F404.1
PSI(I,N)=SATHH(I)/(0.01**B(I)) DARCY5A.120
ELSEIF (THETA(I,N).GT.0.01.AND.THETA(I,N).LE.1.0) THEN DARCY5A.121
PSI(I,N)=SATHH(I)/(THETA(I,N)**B(I)) DARCY5A.122
ELSE DARCY5A.123
PSI(I,N)=SATHH(I) DARCY5A.124
ENDIF DARCY5A.125
ENDDO DARCY5A.126
ENDDO DARCY5A.127
DARCY5A.128
!----------------------------------------------------------------------- DARCY5A.129
! Estimate the fractional saturation at the layer boundary by DARCY5A.130
! interpolating the soil moisture. DARCY5A.131
!----------------------------------------------------------------------- DARCY5A.132
DO J=1,SOIL_PTS DARCY5A.133
I=SOIL_INDEX(J) DARCY5A.134
THETAK(I)=(DZ2*THETA(I,1)+DZ1*THETA(I,2))/(DZ2+DZ1) DARCY5A.135
ENDDO DARCY5A.136
!----------------------------------------------------------------------- DARCY5A.137
! Calculate the hydraulic conductivities for transport between layers. DARCY5A.138
!----------------------------------------------------------------------- DARCY5A.139
CALL HYD_CON
(NPNTS,SOIL_PTS,SOIL_INDEX,B,KS,THETAK,K,LTIMER) DARCY5A.140
DARCY5A.141
!----------------------------------------------------------------------- DARCY5A.142
! Calculate the Darcian flux from the upper to the lower layer. DARCY5A.143
!----------------------------------------------------------------------- DARCY5A.144
DO J=1,SOIL_PTS DARCY5A.145
I=SOIL_INDEX(J) DARCY5A.146
WFLUX(I)=K(I)*(2.0*(PSI(I,2)-PSI(I,1))/(DZ2+DZ1)+1) DARCY5A.147
ENDDO DARCY5A.148
DARCY5A.149
IF (LTIMER) THEN DARCY5A.150
CALL TIMER
('DARCY ',104) GPB8F405.143
ENDIF DARCY5A.152
DARCY5A.153
RETURN DARCY5A.154
END DARCY5A.155
*ENDIF DARCY5A.156