C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.13978 
C                                                                                  RAD_ALL.13979 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.13980 
C restrictions as set forth in the contract.                                       RAD_ALL.13981 
C                                                                                  RAD_ALL.13982 
C                Meteorological Office                                             RAD_ALL.13983 
C                London Road                                                       RAD_ALL.13984 
C                BRACKNELL                                                         RAD_ALL.13985 
C                Berkshire UK                                                      RAD_ALL.13986 
C                RG12 2SZ                                                          RAD_ALL.13987 
C                                                                                  RAD_ALL.13988 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.13989 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.13990 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.13991 
C Modelling at the above address.                                                  RAD_ALL.13992 
C ******************************COPYRIGHT******************************            RAD_ALL.13993 
C                                                                                  RAD_ALL.13994 
!+ Subroutine to rank amounts of cloudiness in acolumn.                            RAD_ALL.13995 
!                                                                                  RAD_ALL.13996 
! Method:                                                                          RAD_ALL.13997 
!       This routine uses a heap sorting algorithm taken from                      RAD_ALL.13998 
!       "Numerical Recipes" by D. E. Knuth to form an array of                     RAD_ALL.13999 
!       pointers to layers containing increasing amounts of cloud.                 RAD_ALL.14000 
!                                                                                  RAD_ALL.14001 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.14002 
!                                                                                  RAD_ALL.14003 
! History:                                                                         RAD_ALL.14004 
!       Version         Date                    Comment                            RAD_ALL.14005 
!       4.0             27-07-95                Original Code                      RAD_ALL.14006 
!                                               (J. M. Edwards)                    RAD_ALL.14007 
!                                                                                  RAD_ALL.14008 
! Description of Code:                                                             RAD_ALL.14009 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.14010 
!                                                                                  RAD_ALL.14011 
!- ---------------------------------------------------------------------           RAD_ALL.14012 
      SUBROUTINE RANK(N_LAYER                                                      RAD_ALL.14013 
     &   , W_CLOUD, IRANK                                                          RAD_ALL.14014 
     &   , NPD_LAYER                                                               RAD_ALL.14015 
     &   )                                                                         RAD_ALL.14016 
!                                                                                  RAD_ALL.14017 
!                                                                                  RAD_ALL.14018 
!                                                                                  RAD_ALL.14019 
      IMPLICIT NONE                                                                RAD_ALL.14020 
!                                                                                  RAD_ALL.14021 
!                                                                                  RAD_ALL.14022 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.14023 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.14024 
     &     NPD_LAYER                                                               RAD_ALL.14025 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.14026 
!                                                                                  RAD_ALL.14027 
!     DUMMY ARGUMENTS                                                              RAD_ALL.14028 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.14029 
     &     N_LAYER                                                                 RAD_ALL.14030 
!             NUMBER OF LAYERS                                                     RAD_ALL.14031 
      REAL      !, INTENT(IN)                                                      RAD_ALL.14032 
     &     W_CLOUD(NPD_LAYER)                                                      RAD_ALL.14033 
!             CLOUD AMOUNT                                                         RAD_ALL.14034 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.14035 
     &     IRANK(NPD_LAYER)                                                        RAD_ALL.14036 
!             RANK ARRAY FOR CLOUDS                                                RAD_ALL.14037 
!                                                                                  RAD_ALL.14038 
!                                                                                  RAD_ALL.14039 
!     LOCAL ARGUMENTS                                                              RAD_ALL.14040 
      INTEGER                                                                      RAD_ALL.14041 
     &     I                                                                       RAD_ALL.14042 
!             LOOP VARIBALE                                                        RAD_ALL.14043 
     &   , J                                                                       RAD_ALL.14044 
!             LOOP VARIBALE                                                        RAD_ALL.14045 
     &   , K                                                                       RAD_ALL.14046 
!             LOOP VARIBALE                                                        RAD_ALL.14047 
     &   , IR                                                                      RAD_ALL.14048 
!             LOOP VARIBALE                                                        RAD_ALL.14049 
     &   , I_RANK_TEMPORARY                                                        RAD_ALL.14050 
!             TEMPORARY RANK VALUE                                                 RAD_ALL.14051 
      REAL                                                                         RAD_ALL.14052 
     &     W                                                                       RAD_ALL.14053 
!             SINGLE CLOUD AMOUNT                                                  RAD_ALL.14054 
!                                                                                  RAD_ALL.14055 
!                                                                                  RAD_ALL.14056 
!     FORM AN ARRAY RANKING THE AMOUNTS OF CLOUDINESS IN EACH LAYER.               RAD_ALL.14057 
      DO I=1, N_LAYER                                                              RAD_ALL.14058 
         IRANK(I)=I                                                                RAD_ALL.14059 
      ENDDO                                                                        RAD_ALL.14060 
!                                                                                  RAD_ALL.14061 
      K=N_LAYER/2+1                                                                RAD_ALL.14062 
      IR=N_LAYER                                                                   RAD_ALL.14063 
20    CONTINUE                                                                     RAD_ALL.14064 
         IF (K.GT.1) THEN                                                          RAD_ALL.14065 
            K=K-1                                                                  RAD_ALL.14066 
            I_RANK_TEMPORARY=IRANK(K)                                              RAD_ALL.14067 
            W=W_CLOUD(I_RANK_TEMPORARY)                                            RAD_ALL.14068 
         ELSE                                                                      RAD_ALL.14069 
            I_RANK_TEMPORARY=IRANK(IR)                                             RAD_ALL.14070 
            W=W_CLOUD(I_RANK_TEMPORARY)                                            RAD_ALL.14071 
            IRANK(IR)=IRANK(1)                                                     RAD_ALL.14072 
            IR=IR-1                                                                RAD_ALL.14073 
            IF (IR.EQ.1) THEN                                                      RAD_ALL.14074 
               IRANK(1)=I_RANK_TEMPORARY                                           RAD_ALL.14075 
               RETURN                                                              RAD_ALL.14076 
            ENDIF                                                                  RAD_ALL.14077 
         ENDIF                                                                     RAD_ALL.14078 
         I=K                                                                       RAD_ALL.14079 
         J=K+K                                                                     RAD_ALL.14080 
30       IF (J.LE.IR) THEN                                                         RAD_ALL.14081 
            IF (J.LT.IR) THEN                                                      RAD_ALL.14082 
               IF (W_CLOUD(IRANK(J)).LT.W_CLOUD(IRANK(J+1))) THEN                  RAD_ALL.14083 
                  J=J+1                                                            RAD_ALL.14084 
               ENDIF                                                               RAD_ALL.14085 
            ENDIF                                                                  RAD_ALL.14086 
            IF (W.LT.W_CLOUD(IRANK(J))) THEN                                       RAD_ALL.14087 
               IRANK(I)=IRANK(J)                                                   RAD_ALL.14088 
               I=J                                                                 RAD_ALL.14089 
               J=J+J                                                               RAD_ALL.14090 
            ELSE                                                                   RAD_ALL.14091 
               J=IR+1                                                              RAD_ALL.14092 
            ENDIF                                                                  RAD_ALL.14093 
         GOTO 30                                                                   RAD_ALL.14094 
         ENDIF                                                                     RAD_ALL.14095 
         IRANK(I)=I_RANK_TEMPORARY                                                 RAD_ALL.14096 
      GOTO 20                                                                      RAD_ALL.14097 
!                                                                                  RAD_ALL.14098 
!                                                                                  RAD_ALL.14099 
!                                                                                  RAD_ALL.14100 
      END  
