C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.1885  
C                                                                                  RAD_ALL.1886  
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.1887  
C restrictions as set forth in the contract.                                       RAD_ALL.1888  
C                                                                                  RAD_ALL.1889  
C                Meteorological Office                                             RAD_ALL.1890  
C                London Road                                                       RAD_ALL.1891  
C                BRACKNELL                                                         RAD_ALL.1892  
C                Berkshire UK                                                      RAD_ALL.1893  
C                RG12 2SZ                                                          RAD_ALL.1894  
C                                                                                  RAD_ALL.1895  
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.1896  
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.1897  
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.1898  
C Modelling at the above address.                                                  RAD_ALL.1899  
C ******************************COPYRIGHT******************************            RAD_ALL.1900  
C                                                                                  RAD_ALL.1901  
!+ Subroutine to assemble lists of points with the same surfaces.                  RAD_ALL.1902  
!                                                                                  RAD_ALL.1903  
! Method:                                                                          RAD_ALL.1904  
!       The surfaces at the bottom of each profile are examined                    RAD_ALL.1905  
!       and lists of points with the same type of surface are made.                RAD_ALL.1906  
!                                                                                  RAD_ALL.1907  
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.1908  
!                                                                                  RAD_ALL.1909  
! History:                                                                         RAD_ALL.1910  
!       Version         Date                    Comment                            RAD_ALL.1911  
!       4.0             27-07-95                Original Code                      RAD_ALL.1912  
!                                               (J. M. Edwards)                    RAD_ALL.1913  
!       4.2             Nov. 96   T3E migration: CALL WHENEQ replaced              RAD_ALL.1914  
!                                  by portable fortran code.                       RAD_ALL.1915  
!                                                S.J.Swarbrick                     RAD_ALL.1916  
!                                                                                  RAD_ALL.1917  
! Description of Code:                                                             RAD_ALL.1918  
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.1919  
!                                                                                  RAD_ALL.1920  
!- ---------------------------------------------------------------------           RAD_ALL.1921  
      SUBROUTINE COLLECT_SURFACE(N_PROFILE                                         RAD_ALL.1922  
     &   , I_SURFACE                                                               RAD_ALL.1923  
     &   , N_POINT_TYPE, INDEX_SURFACE                                             RAD_ALL.1924  
     &   , NPD_PROFILE, NPD_SURFACE                                                RAD_ALL.1925  
     &   )                                                                         RAD_ALL.1926  
!                                                                                  RAD_ALL.1927  
!                                                                                  RAD_ALL.1928  
      IMPLICIT NONE                                                                RAD_ALL.1929  
!                                                                                  RAD_ALL.1930  
!                                                                                  RAD_ALL.1931  
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.1932  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1933  
     &     NPD_PROFILE                                                             RAD_ALL.1934  
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.1935  
     &   , NPD_SURFACE                                                             RAD_ALL.1936  
!             MAXIMUM NUMBER OF SURFACES                                           RAD_ALL.1937  
!                                                                                  RAD_ALL.1938  
!     DUMMY ARGUMENTS.                                                             RAD_ALL.1939  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1940  
     &     N_PROFILE                                                               RAD_ALL.1941  
!             NUMBER OF PROFILES                                                   RAD_ALL.1942  
     &   , I_SURFACE(NPD_PROFILE)                                                  RAD_ALL.1943  
!             SURFACE SPECIFICATIONS                                               RAD_ALL.1944  
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.1945  
     &     N_POINT_TYPE(NPD_SURFACE)                                               RAD_ALL.1946  
!             NUMBER OF POINTS OF EEACH TYPE                                       RAD_ALL.1947  
     &   , INDEX_SURFACE(NPD_PROFILE, NPD_SURFACE)                                 RAD_ALL.1948  
!             LIST OF POINTS OF EACH TYPE                                          RAD_ALL.1949  
!                                                                                  RAD_ALL.1950  
!     LOCAL VARIABLES.                                                             RAD_ALL.1951  
      INTEGER                                                                      RAD_ALL.1952  
     &     L                                                                       RAD_ALL.1953  
!             LOOP VARIABLE                                                        RAD_ALL.1954  
     &   , K                                                                       RAD_ALL.1955  
!             LOOP VARIABLE                                                        RAD_ALL.1956  
     &   , J                                                                       RAD_ALL.1957  
!                                                                                  RAD_ALL.1958  
!                                                                                  RAD_ALL.1959  
!     PASS THROUGH ALL THE COLUMNS COLLECTING LISTS OF POINTS WHICH                RAD_ALL.1960  
!     HAVE THE SAME SURFACE TYPE.                                                  RAD_ALL.1961  
      DO K=1, NPD_SURFACE                                                          RAD_ALL.1962  
         N_POINT_TYPE(K)=0                                                         RAD_ALL.1963  
      ENDDO                                                                        RAD_ALL.1964  
C                                                                                  RAD_ALL.1965  
C                                                                                  RAD_ALL.1966  
      DO   K=1,NPD_SURFACE                                                         RAD_ALL.1967  
           J=1                                                                     RAD_ALL.1968  
        DO L=1,N_PROFILE                                                           RAD_ALL.1969  
          IF (I_SURFACE(L).EQ.K) THEN                                              RAD_ALL.1970  
            INDEX_SURFACE(J,K)=L                                                   RAD_ALL.1971  
            J=J+1                                                                  RAD_ALL.1972  
            N_POINT_TYPE(K)=N_POINT_TYPE(K)+1                                      RAD_ALL.1973  
          END IF                                                                   RAD_ALL.1974  
        END DO                                                                     RAD_ALL.1975  
      ENDDO                                                                        RAD_ALL.1976  
!                                                                                  RAD_ALL.1977  
!                                                                                  RAD_ALL.1978  
!                                                                                  RAD_ALL.1979  
      RETURN                                                                       RAD_ALL.1980  
      END     
