*IF DEF,C70_1A                                                             GLW1F404.33     
C ******************************COPYRIGHT******************************    GTS2F400.12497  
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.12498  
C                                                                          GTS2F400.12499  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.12500  
C restrictions as set forth in the contract.                               GTS2F400.12501  
C                                                                          GTS2F400.12502  
C                Meteorological Office                                     GTS2F400.12503  
C                London Road                                               GTS2F400.12504  
C                BRACKNELL                                                 GTS2F400.12505  
C                Berkshire UK                                              GTS2F400.12506  
C                RG12 2SZ                                                  GTS2F400.12507  
C                                                                          GTS2F400.12508  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.12509  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.12510  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.12511  
C Modelling at the above address.                                          GTS2F400.12512  
C                                                                          GTS2F400.12513  
!+                                                                         LEVSRT1.3      
! Subroutine Interface:                                                    LEVSRT1.4      

      SUBROUTINE LEVSRT(TYPE,NLEVS,IL,RL)                                   3LEVSRT1.5      
      IMPLICIT NONE                                                        LEVSRT1.6      
! Description:                                                             LEVSRT1.7      
!                                                                          LEVSRT1.8      
! Method:                                                                  LEVSRT1.9      
!                                                                          LEVSRT1.10     
! Current code owner:  S.J.Swarbrick                                       LEVSRT1.11     
!                                                                          LEVSRT1.12     
! History:                                                                 LEVSRT1.13     
! Version   Date       Comment                                             LEVSRT1.14     
! =======   ====       =======                                             LEVSRT1.15     
!   3.5     Mar. 95    Original code.  S.J.Swarbrick                       LEVSRT1.16     
!                                                                          LEVSRT1.17     
!  Code description:                                                       LEVSRT1.18     
!    FORTRAN 77 + common Fortran 90 extensions.                            LEVSRT1.19     
!    Written to UM programming standards version 7.                        LEVSRT1.20     
!                                                                          LEVSRT1.21     
!  System component covered:                                               LEVSRT1.22     
!  System task:               Sub-Models Project                           LEVSRT1.23     
                                                                           LEVSRT1.24     
! Subroutine arguments:                                                    LEVSRT1.25     
                                                                           LEVSRT1.26     
!   Scalar arguments with intent(in):                                      LEVSRT1.27     
                                                                           LEVSRT1.28     
      CHARACTER*1 TYPE                                                     LEVSRT1.29     
      INTEGER     NLEVS                                                    LEVSRT1.30     
                                                                           LEVSRT1.31     
!   Array arguments with intent(inout):                                    LEVSRT1.32     
                                                                           LEVSRT1.33     
      REAL        RL(NLEVS)                                                LEVSRT1.34     
      INTEGER     IL(NLEVS)                                                LEVSRT1.35     
                                                                           LEVSRT1.36     
! Local variables:                                                         LEVSRT1.37     
                                                                           LEVSRT1.38     
      LOGICAL     LSWAP                                                    LEVSRT1.39     
      INTEGER     I                                                        LEVSRT1.40     
      INTEGER     J                                                        LEVSRT1.41     
      INTEGER     ILT                                                      LEVSRT1.42     
      REAL        RLT                                                      LEVSRT1.43     
                                                                           LEVSRT1.44     
!- End of Header ----------------------------------------------------      LEVSRT1.45     
                                                                           LEVSRT1.46     
      DO 100 I=1,NLEVS                                                     LEVSRT1.47     
        LSWAP=.FALSE.                                                      LEVSRT1.48     
        DO 200 J=1,NLEVS-1                                                 LEVSRT1.49     
          IF(TYPE.EQ.'I') THEN                                             LEVSRT1.50     
            IF(IL(J).GT.IL(J+1)) THEN                                      LEVSRT1.51     
              LSWAP=.TRUE.                                                 LEVSRT1.52     
              ILT=IL(J)                                                    LEVSRT1.53     
              IL(J)=IL(J+1)                                                LEVSRT1.54     
              IL(J+1)=ILT                                                  LEVSRT1.55     
            END IF                                                         LEVSRT1.56     
          ELSE                                                             LEVSRT1.57     
            IF(RL(J).LT.RL(J+1)) THEN                                      LEVSRT1.58     
              LSWAP=.TRUE.                                                 LEVSRT1.59     
              RLT=RL(J)                                                    LEVSRT1.60     
              RL(J)=RL(J+1)                                                LEVSRT1.61     
              RL(J+1)=RLT                                                  LEVSRT1.62     
            END IF                                                         LEVSRT1.63     
          END IF                                                           LEVSRT1.64     
  200   CONTINUE                                                           LEVSRT1.65     
        IF(.NOT.LSWAP) RETURN                                              LEVSRT1.66     
  100 CONTINUE                                                             LEVSRT1.67     
      RETURN                                                               LEVSRT1.68     
      END                                                                  LEVSRT1.69     
*ENDIF                                                                     LEVSRT1.70