*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.67     
*IF DEF,A01_3A,OR,DEF,A02_3A                                               RANK3A.2      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.13671  
C                                                                          GTS2F400.13672  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.13673  
C restrictions as set forth in the contract.                               GTS2F400.13674  
C                                                                          GTS2F400.13675  
C                Meteorological Office                                     GTS2F400.13676  
C                London Road                                               GTS2F400.13677  
C                BRACKNELL                                                 GTS2F400.13678  
C                Berkshire UK                                              GTS2F400.13679  
C                RG12 2SZ                                                  GTS2F400.13680  
C                                                                          GTS2F400.13681  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.13682  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.13683  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.13684  
C Modelling at the above address.                                          GTS2F400.13685  
C ******************************COPYRIGHT******************************    GTS2F400.13686  
C                                                                          GTS2F400.13687  
!+ Subroutine to rank amounts of cloudiness in acolumn.                    RANK3A.3      
!                                                                          RANK3A.4      
! Method:                                                                  RANK3A.5      
!       This routine uses a heap sorting algorithm taken from              RANK3A.6      
!       "Numerical Recipes" by D. E. Knuth to form an array of             RANK3A.7      
!       pointers to layers containing increasing amounts of cloud.         RANK3A.8      
!                                                                          RANK3A.9      
! Current Owner of Code: J. M. Edwards                                     RANK3A.10     
!                                                                          RANK3A.11     
! History:                                                                 RANK3A.12     
!       Version         Date                    Comment                    RANK3A.13     
!       4.0             27-07-95                Original Code              RANK3A.14     
!                                               (J. M. Edwards)            RANK3A.15     
!                                                                          RANK3A.16     
! Description of Code:                                                     RANK3A.17     
!   FORTRAN 77  with extensions listed in documentation.                   RANK3A.18     
!                                                                          RANK3A.19     
!- ---------------------------------------------------------------------   RANK3A.20     

      SUBROUTINE RANK(N_LAYER                                               1RANK3A.21     
     &   , W_CLOUD, IRANK                                                  RANK3A.22     
     &   , NPD_LAYER                                                       RANK3A.23     
     &   )                                                                 RANK3A.24     
!                                                                          RANK3A.25     
!                                                                          RANK3A.26     
!                                                                          RANK3A.27     
      IMPLICIT NONE                                                        RANK3A.28     
!                                                                          RANK3A.29     
!                                                                          RANK3A.30     
!     SIZES OF DUMMY ARRAYS.                                               RANK3A.31     
      INTEGER   !, INTENT(IN)                                              RANK3A.32     
     &     NPD_LAYER                                                       RANK3A.33     
!             MAXIMUM NUMBER OF LAYERS                                     RANK3A.34     
!                                                                          RANK3A.35     
!     DUMMY ARGUMENTS                                                      RANK3A.36     
      INTEGER   !, INTENT(IN)                                              RANK3A.37     
     &     N_LAYER                                                         RANK3A.38     
!             NUMBER OF LAYERS                                             RANK3A.39     
      REAL      !, INTENT(IN)                                              RANK3A.40     
     &     W_CLOUD(NPD_LAYER)                                              RANK3A.41     
!             CLOUD AMOUNT                                                 RANK3A.42     
      INTEGER   !, INTENT(OUT)                                             RANK3A.43     
     &     IRANK(NPD_LAYER)                                                RANK3A.44     
!             RANK ARRAY FOR CLOUDS                                        RANK3A.45     
!                                                                          RANK3A.46     
!                                                                          RANK3A.47     
!     LOCAL ARGUMENTS                                                      RANK3A.48     
      INTEGER                                                              RANK3A.49     
     &     I                                                               RANK3A.50     
!             LOOP VARIBALE                                                RANK3A.51     
     &   , J                                                               RANK3A.52     
!             LOOP VARIBALE                                                RANK3A.53     
     &   , K                                                               RANK3A.54     
!             LOOP VARIBALE                                                RANK3A.55     
     &   , IR                                                              RANK3A.56     
!             LOOP VARIBALE                                                RANK3A.57     
     &   , I_RANK_TEMPORARY                                                RANK3A.58     
!             TEMPORARY RANK VALUE                                         RANK3A.59     
      REAL                                                                 RANK3A.60     
     &     W                                                               RANK3A.61     
!             SINGLE CLOUD AMOUNT                                          RANK3A.62     
!                                                                          RANK3A.63     
!                                                                          RANK3A.64     
!     FORM AN ARRAY RANKING THE AMOUNTS OF CLOUDINESS IN EACH LAYER.       RANK3A.65     
      DO I=1, N_LAYER                                                      RANK3A.66     
         IRANK(I)=I                                                        RANK3A.67     
      ENDDO                                                                RANK3A.68     
!                                                                          RANK3A.69     
      K=N_LAYER/2+1                                                        RANK3A.70     
      IR=N_LAYER                                                           RANK3A.71     
20    CONTINUE                                                             RANK3A.72     
         IF (K.GT.1) THEN                                                  RANK3A.73     
            K=K-1                                                          RANK3A.74     
            I_RANK_TEMPORARY=IRANK(K)                                      RANK3A.75     
            W=W_CLOUD(I_RANK_TEMPORARY)                                    RANK3A.76     
         ELSE                                                              RANK3A.77     
            I_RANK_TEMPORARY=IRANK(IR)                                     RANK3A.78     
            W=W_CLOUD(I_RANK_TEMPORARY)                                    RANK3A.79     
            IRANK(IR)=IRANK(1)                                             RANK3A.80     
            IR=IR-1                                                        RANK3A.81     
            IF (IR.EQ.1) THEN                                              RANK3A.82     
               IRANK(1)=I_RANK_TEMPORARY                                   RANK3A.83     
               RETURN                                                      RANK3A.84     
            ENDIF                                                          RANK3A.85     
         ENDIF                                                             RANK3A.86     
         I=K                                                               RANK3A.87     
         J=K+K                                                             RANK3A.88     
30       IF (J.LE.IR) THEN                                                 RANK3A.89     
            IF (J.LT.IR) THEN                                              RANK3A.90     
               IF (W_CLOUD(IRANK(J)).LT.W_CLOUD(IRANK(J+1))) THEN          RANK3A.91     
                  J=J+1                                                    RANK3A.92     
               ENDIF                                                       RANK3A.93     
            ENDIF                                                          RANK3A.94     
            IF (W.LT.W_CLOUD(IRANK(J))) THEN                               RANK3A.95     
               IRANK(I)=IRANK(J)                                           RANK3A.96     
               I=J                                                         RANK3A.97     
               J=J+J                                                       RANK3A.98     
            ELSE                                                           RANK3A.99     
               J=IR+1                                                      RANK3A.100    
            ENDIF                                                          RANK3A.101    
         GOTO 30                                                           RANK3A.102    
         ENDIF                                                             RANK3A.103    
         IRANK(I)=I_RANK_TEMPORARY                                         RANK3A.104    
      GOTO 20                                                              RANK3A.105    
!                                                                          RANK3A.106    
!                                                                          RANK3A.107    
!                                                                          RANK3A.108    
      END                                                                  RANK3A.109    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            RANK3A.110    
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.68