*IF DEF,A19_1A,OR,DEF,A19_2A                                               PPARM1A.2      
C *****************************COPYRIGHT******************************     PPARM1A.3      
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved.    PPARM1A.4      
C                                                                          PPARM1A.5      
C Use, duplication or disclosure of this code is subject to the            PPARM1A.6      
C restrictions as set forth in the contract.                               PPARM1A.7      
C                                                                          PPARM1A.8      
C                Meteorological Office                                     PPARM1A.9      
C                London Road                                               PPARM1A.10     
C                BRACKNELL                                                 PPARM1A.11     
C                Berkshire UK                                              PPARM1A.12     
C                RG12 2SZ                                                  PPARM1A.13     
C                                                                          PPARM1A.14     
C If no contract has been raised with this copy of the code, the use,      PPARM1A.15     
C duplication or disclosure of it is strictly prohibited.  Permission      PPARM1A.16     
C to do so must first be obtained in writing from the Head of Numerical    PPARM1A.17     
C Modelling at the above address.                                          PPARM1A.18     
C ******************************COPYRIGHT******************************    PPARM1A.19     
! Routine to calculate the land surface parameters of a given PFT from     PPARM1A.20     
! its areal fraction and structural properties.                            PPARM1A.21     
C                                                                          PPARM1A.22     
! Written by Peter Cox (June 1997)                                         PPARM1A.23     
C**********************************************************************    PPARM1A.24     

      SUBROUTINE PFT_SPARM  (LAND_FIELD,N,TILE_INDEX,TILE_PTS               1PPARM1A.25     
     &,                      ALBSOIL,HT,LAI                                PPARM1A.26     
     &,                      ALBSNC_T,ALBSNF_T,CATCH_T                     PPARM1A.27     
     &,                      Z0_T)                                         PPARM1A.28     
                                                                           PPARM1A.29     
                                                                           PPARM1A.30     
      IMPLICIT NONE                                                        PPARM1A.31     
                                                                           PPARM1A.32     
      INTEGER                                                              PPARM1A.33     
     & LAND_FIELD                 ! IN Number of land points.              PPARM1A.34     
     &,N                          ! IN Plant functional type.              PPARM1A.35     
     &,TILE_PTS                   ! IN Number of land points which         PPARM1A.36     
!                                 !    include the surface type.           PPARM1A.37     
     &,TILE_INDEX(LAND_FIELD)     ! IN Indices of land points which        PPARM1A.38     
!                                 !    include the surface type.           PPARM1A.39     
     &,J,L                        ! WORK Loop counters.                    PPARM1A.40     
                                                                           PPARM1A.41     
      REAL                                                                 PPARM1A.42     
     & ALBSOIL(LAND_FIELD)        ! IN Soil albedo.                        PPARM1A.43     
     &,HT(LAND_FIELD)             ! IN Vegetation height (m).              PPARM1A.44     
     &,LAI(LAND_FIELD)            ! IN Leaf area index.                    PPARM1A.45     
     &,ALBSNC_T(LAND_FIELD)       ! OUT Snow-covered albedo.               PPARM1A.46     
     &,ALBSNF_T(LAND_FIELD)       ! OUT Snow-free albedo.                  PPARM1A.47     
     &,CATCH_T(LAND_FIELD)        ! OUT Canopy capacity (kg/m2).           PPARM1A.48     
     &,Z0_T(LAND_FIELD)           ! OUT Roughness length (m).              PPARM1A.49     
     &,FLIT                       ! WORK Weighting factor for albedo.      PPARM1A.50     
                                                                           PPARM1A.51     
*CALL NSTYPES                                                              PPARM1A.59     
*CALL PFTPARM                                                              PPARM1A.60     
                                                                           PPARM1A.61     
      DO J=1,TILE_PTS                                                      PPARM1A.62     
        L = TILE_INDEX(J)                                                  PPARM1A.63     
        FLIT = 1.0 - EXP(-KEXT(N) * LAI(L))                                PPARM1A.64     
        ALBSNC_T(L) = ALBSNC_MIN(N) * (1 - FLIT)                           ABX1F405.1363   
     &              + ALBSNC_MAX(N) * FLIT                                 ABX1F405.1364   
        ALBSNF_T(L) = ALBSOIL(L) * (1 - FLIT) + ALBSNF_MAX(N) * FLIT       PPARM1A.66     
        Z0_T(L) = DZ0V_DH(N) * HT(L)                                       PPARM1A.67     
        CATCH_T(L) = CATCH0(N) + DCATCH_DLAI(N) * LAI(L)                   PPARM1A.68     
      ENDDO                                                                PPARM1A.69     
                                                                           PPARM1A.70     
                                                                           PPARM1A.71     
      RETURN                                                               PPARM1A.72     
      END                                                                  PPARM1A.73     
*ENDIF                                                                     PPARM1A.74