*IF DEF,A19_1A,OR,DEF,A19_2A                                               TPTS1A.2      
C *****************************COPYRIGHT******************************     TPTS1A.3      
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved.    TPTS1A.4      
C                                                                          TPTS1A.5      
C Use, duplication or disclosure of this code is subject to the            TPTS1A.6      
C restrictions as set forth in the contract.                               TPTS1A.7      
C                                                                          TPTS1A.8      
C                Meteorological Office                                     TPTS1A.9      
C                London Road                                               TPTS1A.10     
C                BRACKNELL                                                 TPTS1A.11     
C                Berkshire UK                                              TPTS1A.12     
C                RG12 2SZ                                                  TPTS1A.13     
C                                                                          TPTS1A.14     
C If no contract has been raised with this copy of the code, the use,      TPTS1A.15     
C duplication or disclosure of it is strictly prohibited.  Permission      TPTS1A.16     
C to do so must first be obtained in writing from the Head of Numerical    TPTS1A.17     
C Modelling at the above address.                                          TPTS1A.18     
C ******************************COPYRIGHT******************************    TPTS1A.19     
!                                                                          TPTS1A.20     
! Counts the number of points containing each surface type and creates     TPTS1A.21     
! a TILE_INDEX array specifying the location of these points on the land   TPTS1A.22     
! grid.                                                                    TPTS1A.23     
!                                                                          TPTS1A.24     
! Subroutine Interface:                                                    TPTS1A.25     
                                                                           TPTS1A.26     

      SUBROUTINE TILEPTS(P_FIELD,LAND_FIELD,LAND1,LAND_PTS,                 6TPTS1A.27     
     &                   FRAC,TILE_PTS,TILE_INDEX                          TPTS1A.28     
     &                   )                                                 TPTS1A.29     
                                                                           TPTS1A.30     
                                                                           TPTS1A.31     
      IMPLICIT NONE                                                        TPTS1A.32     
!                                                                          TPTS1A.33     
! Description:                                                             TPTS1A.34     
!                                                                          TPTS1A.35     
! Method:                                                                  TPTS1A.36     
!                                                                          TPTS1A.37     
! Current Code Owner:  Richard Betts                                       TPTS1A.38     
!                                                                          TPTS1A.39     
! History:                                                                 TPTS1A.40     
! Version   Date     Comment                                               TPTS1A.41     
! -------   ----     -------                                               TPTS1A.42     
!   4.4    16/10/97   Original code.  Peter Cox                            TPTS1A.43     
!                                                                          TPTS1A.44     
! Code Description:                                                        TPTS1A.45     
!   Language: FORTRAN 77 + common extensions.                              TPTS1A.46     
!   This code is written to UMDP3 v6 programming standards.                TPTS1A.47     
                                                                           TPTS1A.48     
      INTEGER                                                              TPTS1A.49     
     & P_FIELD               ! IN Number of P-points in whole grid         TPTS1A.50     
     &,LAND_FIELD            ! IN Number of land points in whole grid.     TPTS1A.51     
     &,LAND1                 ! IN First land point to be processed.        TPTS1A.52     
     &,LAND_PTS              ! IN Number of land points to be processed.   TPTS1A.53     
                                                                           TPTS1A.54     
*CALL NSTYPES                                                              TPTS1A.55     
                                                                           TPTS1A.56     
      REAL                                                                 TPTS1A.57     
     & FRAC(LAND_FIELD,NTYPE)       ! IN Fractions of surface types.       TPTS1A.58     
                                                                           TPTS1A.59     
      INTEGER                                                              TPTS1A.60     
     & TILE_PTS(NTYPE)              ! OUT Number of land points which      TPTS1A.61     
C                                   !     include the nth surface type.    TPTS1A.62     
     &,TILE_INDEX(LAND_FIELD,NTYPE) ! OUT Indices of land points which     TPTS1A.63     
C                                   !     include the nth surface type.    TPTS1A.64     
     &,L,N                          ! WORK Loop counters.                  TPTS1A.65     
C-----------------------------------------------------------------------   TPTS1A.66     
C Local parameters                                                         TPTS1A.67     
C-----------------------------------------------------------------------   TPTS1A.68     
*CALL SEED                                                                 TPTS1A.69     
                                                                           TPTS1A.70     
C-----------------------------------------------------------------------   TPTS1A.71     
C Create the TILE_INDEX array of land points with each surface type        TPTS1A.72     
C-----------------------------------------------------------------------   TPTS1A.73     
      DO N=1,NTYPE                                                         TPTS1A.74     
        TILE_PTS(N) = 0                                                    TPTS1A.75     
        DO L=LAND1,LAND1+LAND_PTS-1                                        TPTS1A.76     
          TILE_INDEX(L,N)=0                                                TPTS1A.77     
          IF (FRAC(L,N).GT.0.0) THEN                                       ABX1F405.1586   
            TILE_PTS(N) = TILE_PTS(N) + 1                                  TPTS1A.79     
            TILE_INDEX(TILE_PTS(N),N) = L                                  TPTS1A.80     
          ENDIF                                                            TPTS1A.81     
        ENDDO                                                              TPTS1A.82     
      ENDDO                                                                TPTS1A.83     
                                                                           TPTS1A.84     
      RETURN                                                               TPTS1A.85     
      END                                                                  TPTS1A.86     
*ENDIF                                                                     TPTS1A.87