*IF DEF,A08_7A                                                             SOILMC7A.2      
C *****************************COPYRIGHT*******************************    SOILMC7A.3      
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved.    SOILMC7A.4      
C                                                                          SOILMC7A.5      
C Use, duplication or disclosure of this code is subject to the            SOILMC7A.6      
C restrictions as set forth in the contract.                               SOILMC7A.7      
C                                                                          SOILMC7A.8      
C                Meteorological Office                                     SOILMC7A.9      
C                London Road                                               SOILMC7A.10     
C                BRACKNELL                                                 SOILMC7A.11     
C                Berkshire UK                                              SOILMC7A.12     
C                RG12 2SZ                                                  SOILMC7A.13     
C                                                                          SOILMC7A.14     
C If no contract has been raised with this copy of the code, the use,      SOILMC7A.15     
C duplication or disclosure of it is strictly prohibited.  Permission      SOILMC7A.16     
C to do so must first be obtained in writing from the Head of Numerical    SOILMC7A.17     
C Modelling at the above address.                                          SOILMC7A.18     
C ******************************COPYRIGHT******************************    SOILMC7A.19     
!    SUBROUTINE SOILMC-------------------------------------------------    SOILMC7A.20     
                                                                           SOILMC7A.21     

      SUBROUTINE SOILMC ( NPNTS,NSHYD,SOIL_PTS,SOIL_INDEX,                  1SOILMC7A.22     
     &                    DZ,STHU,V_SAT,V_WILT,SMC )                       SOILMC7A.23     
                                                                           SOILMC7A.24     
      IMPLICIT NONE                                                        SOILMC7A.25     
!                                                                          SOILMC7A.26     
! Description:                                                             SOILMC7A.27     
!     Diagnoses the soil moisture in a layer at the surface                SOILMC7A.28     
!                                                                          SOILMC7A.29     
      INTEGER                                                              SOILMC7A.30     
     & NPNTS                ! IN Number of gridpoints.                     SOILMC7A.31     
     &,NSHYD                ! IN Number of soil moisture levels.           SOILMC7A.32     
     &,SOIL_PTS             ! IN Number of soil points.                    SOILMC7A.33     
     &,SOIL_INDEX(NPNTS)    ! IN Array of soil points.                     SOILMC7A.34     
                                                                           SOILMC7A.35     
      REAL                                                                 SOILMC7A.36     
     & DZ(NSHYD)            ! IN Thicknesses of the soil layers (m).       SOILMC7A.37     
     &,STHU(NPNTS,NSHYD)    ! IN Unfrozen soil moisture content of         SOILMC7A.38     
!                           !    each layer as a frac. of saturation.      SOILMC7A.39     
     &,V_SAT(NPNTS)         ! IN Volumetric soil moisture conc. at         SOILMC7A.40     
!                           !    saturation (m3 H2O/m3 soil).              SOILMC7A.41     
     &,V_WILT(NPNTS)        ! IN Volumetric soil moisture conc. below      SOILMC7A.42     
!                           !    which stomata close (m3 H2O/m3 soil).     SOILMC7A.43     
                                                                           SOILMC7A.44     
      REAL                                                                 SOILMC7A.45     
     & SMC(NPNTS)           ! OUT Soil moisture (kg/m2).                   SOILMC7A.46     
                                                                           SOILMC7A.47     
      REAL                                                                 SOILMC7A.48     
     & Z1,Z2                ! WORK Depth of the top and bottom of the      SOILMC7A.49     
!                           !      soil layers (m).                        SOILMC7A.50     
     &,ZSMC                 ! WORK Depth of layer for soil moisture        SOILMC7A.51     
!                           !      diagnostic (m).                         SOILMC7A.52     
      PARAMETER ( ZSMC = 1. )                                              SOILMC7A.53     
                                                                           SOILMC7A.54     
      INTEGER                                                              SOILMC7A.55     
     & I,J,N                ! WORK Loop counters                           SOILMC7A.56     
                                                                           SOILMC7A.57     
*CALL C_DENSTY                                                             SOILMC7A.58     
                                                                           SOILMC7A.59     
      DO I=1,NPNTS                                                         SOILMC7A.60     
        SMC(I) = 0.                                                        SOILMC7A.61     
      ENDDO                                                                SOILMC7A.62     
                                                                           SOILMC7A.63     
      Z2 = 0.                                                              SOILMC7A.64     
      DO N=1,NSHYD                                                         SOILMC7A.65     
        Z1 = Z2                                                            SOILMC7A.66     
        Z2 = Z2 + DZ(N)                                                    SOILMC7A.67     
        IF ( Z2.LT.ZSMC ) THEN                                             SOILMC7A.68     
          DO J=1,SOIL_PTS                                                  SOILMC7A.69     
            I = SOIL_INDEX(J)                                              SOILMC7A.70     
            SMC(I) = SMC(I) + RHO_WATER * DZ(N) *                          SOILMC7A.71     
     &                               ( STHU(I,N)*V_SAT(I) - V_WILT(I) )    SOILMC7A.72     
          ENDDO                                                            SOILMC7A.73     
        ELSEIF ( Z2.GE.ZSMC .AND. Z1.LT.ZSMC ) THEN                        SOILMC7A.74     
          DO J=1,SOIL_PTS                                                  SOILMC7A.75     
            I = SOIL_INDEX(J)                                              SOILMC7A.76     
            SMC(I) = SMC(I) + RHO_WATER * ( Z2 - ZSMC ) *                  SOILMC7A.77     
     &                               ( STHU(I,N)*V_SAT(I) - V_WILT(I) )    SOILMC7A.78     
          ENDDO                                                            SOILMC7A.79     
        ENDIF                                                              SOILMC7A.80     
      ENDDO                                                                SOILMC7A.81     
                                                                           SOILMC7A.82     
      RETURN                                                               SOILMC7A.83     
      END                                                                  SOILMC7A.84     
*ENDIF                                                                     SOILMC7A.85