C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.22638 
C                                                                                  RAD_ALL.22639 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.22640 
C restrictions as set forth in the contract.                                       RAD_ALL.22641 
C                                                                                  RAD_ALL.22642 
C                Meteorological Office                                             RAD_ALL.22643 
C                London Road                                                       RAD_ALL.22644 
C                BRACKNELL                                                         RAD_ALL.22645 
C                Berkshire UK                                                      RAD_ALL.22646 
C                RG12 2SZ                                                          RAD_ALL.22647 
C                                                                                  RAD_ALL.22648 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.22649 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.22650 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.22651 
C Modelling at the above address.                                                  RAD_ALL.22652 
C ******************************COPYRIGHT******************************            RAD_ALL.22653 
C                                                                                  RAD_ALL.22654 
!+ Subroutine to split the atmosphere into maximally overlapped columns.           RAD_ALL.22655 
!                                                                                  RAD_ALL.22656 
! Method:                                                                          RAD_ALL.22657 
!       The layers are first ranked in order of increasing cloudiness.             RAD_ALL.22658 
!       This operation cannot be vectorized and is done for one profile            RAD_ALL.22659 
!       at a time. The areal extent of each column and the logical                 RAD_ALL.22660 
!       cloud mask are then set.                                                   RAD_ALL.22661 
!                                                                                  RAD_ALL.22662 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.22663 
!                                                                                  RAD_ALL.22664 
! History:                                                                         RAD_ALL.22665 
!       Version         Date                    Comment                            RAD_ALL.22666 
!       4.0             27-07-95                Original Code                      RAD_ALL.22667 
!                                               (J. M. Edwards)                    RAD_ALL.22668 
!                                                                                  RAD_ALL.22669 
! Description of Code:                                                             RAD_ALL.22670 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.22671 
!                                                                                  RAD_ALL.22672 
!- ---------------------------------------------------------------------           RAD_ALL.22673 
      SUBROUTINE SPLIT_MAXIMUM(N_PROFILE, N_LAYER                                  RAD_ALL.22674 
     &   , W_CLOUD                                                                 RAD_ALL.22675 
     &   , N_COLUMN, AREA_COLUMN, L_COLUMN                                         RAD_ALL.22676 
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                                      RAD_ALL.22677 
     &   )                                                                         RAD_ALL.22678 
!                                                                                  RAD_ALL.22679 
!                                                                                  RAD_ALL.22680 
!                                                                                  RAD_ALL.22681 
      IMPLICIT NONE                                                                RAD_ALL.22682 
!                                                                                  RAD_ALL.22683 
!                                                                                  RAD_ALL.22684 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.22685 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.22686 
     &     NPD_PROFILE                                                             RAD_ALL.22687 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.22688 
     &   , NPD_LAYER                                                               RAD_ALL.22689 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.22690 
     &   , NPD_COLUMN                                                              RAD_ALL.22691 
!             NUMBER OF COLUMNS PER POINT                                          RAD_ALL.22692 
!                                                                                  RAD_ALL.22693 
!     INCLUDE COMDECKS                                                             RAD_ALL.22694 
!     ------------------------------------------------------------------           PRMCH3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PRMCH3A.3     
!                                                                                  PRMCH3A.4     
!     MODULE FOR SETTING MACHINE PRECISION.                                        PRMCH3A.5     
!                                                                                  PRMCH3A.6     
      REAL                                                                         PRMCH3A.7     
     &     TOL_MACHINE                                                             PRMCH3A.8     
!             MACHINE TOLERANCE                                                    PRMCH3A.9     
     &   , SQRT_TOL_MACHINE                                                        PRMCH3A.10    
!             SQRT OF MACHINE TOLERANCE                                            PRMCH3A.11    
!                                                                                  PRMCH3A.12    
!                                                                                  PRMCH3A.13    
!     THE PRECISION SHOULD BE ABOUT 2/2^(SIZE OF SIGNIFICAND)                      PRMCH3A.14    
!                                                                                  PRMCH3A.15    
!     THE IEEE-FORMAT USES 53 BITS FOR THE SIGNIFICAND                             PRMCH3A.16    
!     IN DOUBLE PRECISION                                                          PRMCH3A.17    
!                                                                                  PRMCH3A.18    
!     THE CRAY FORMAT USES 47 BITS IN SINGLE PRECISION.                            PRMCH3A.19    
!                                                                                  PRMCH3A.20    
      PARAMETER(                                                                   PRMCH3A.21    
     &     TOL_MACHINE=1.42E-14                                                    PRMCH3A.22    
     &   , SQRT_TOL_MACHINE=1.19E-7                                                PRMCH3A.23    
     &   )                                                                         PRMCH3A.24    
!                                                                                  PRMCH3A.25    
!     ------------------------------------------------------------------           PRMCH3A.26    
!     ------------------------------------------------------------------           PRECSN3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PRECSN3A.3     
!                                                                                  PRECSN3A.4     
!     MODULE FOR SETTING MACHINE-DEPENDENT TOLERANCES.                             PRECSN3A.5     
!     (THE COMDECK PRMCH3A MUST ALWAYS BE INCLUDED BEFORE THIS COMDECK.)           PRECSN3A.6     
!                                                                                  PRECSN3A.7     
      REAL                                                                         PRECSN3A.8     
     &     TOL_DIV                                                                 PRECSN3A.9     
!             TOLERANCE FOR DIVISION                                               PRECSN3A.10    
     &   , TOL_TEST                                                                PRECSN3A.11    
!             TOLERANCE FOR TESTING EQUALITY                                       PRECSN3A.12    
!                                                                                  PRECSN3A.13    
      PARAMETER(                                                                   PRECSN3A.14    
     &     TOL_DIV=3.2E+01*TOL_MACHINE                                             PRECSN3A.15    
     &   , TOL_TEST=1.6E+01*TOL_MACHINE                                            PRECSN3A.16    
     &   )                                                                         PRECSN3A.17    
!                                                                                  PRECSN3A.18    
!     ------------------------------------------------------------------           PRECSN3A.19    
!                                                                                  RAD_ALL.22697 
!     DUMMY ARGUMENTS                                                              RAD_ALL.22698 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.22699 
     &     N_PROFILE                                                               RAD_ALL.22700 
!             NUMBER OF PROFILES                                                   RAD_ALL.22701 
     &   , N_LAYER                                                                 RAD_ALL.22702 
!             NUMBER OF LAYERS                                                     RAD_ALL.22703 
      INTEGER   !, INTENT(INOUT)                                                   RAD_ALL.22704 
     &     N_COLUMN(NPD_PROFILE)                                                   RAD_ALL.22705 
!             NUMBER OF COLUMNS                                                    RAD_ALL.22706 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.22707 
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)                            RAD_ALL.22708 
!             ARRAY OF TYPES                                                       RAD_ALL.22709 
      REAL      !, INTENT(IN)                                                      RAD_ALL.22710 
     &     AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)                                    RAD_ALL.22711 
!             AREA OF EACH COLUMN                                                  RAD_ALL.22712 
     &   , W_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.22713 
!             CLOUD AMOUNTS                                                        RAD_ALL.22714 
!                                                                                  RAD_ALL.22715 
!     LOCAL ARGUMENTS                                                              RAD_ALL.22716 
      INTEGER                                                                      RAD_ALL.22717 
     &     IRANK(NPD_LAYER)                                                        RAD_ALL.22718 
!             ARRAY TO RANK COLUMNS BY W                                           RAD_ALL.22719 
     &   , I                                                                       RAD_ALL.22720 
!             LOOP VARIABLE                                                        RAD_ALL.22721 
     &   , K                                                                       RAD_ALL.22722 
!             LOOP VARIBLE                                                         RAD_ALL.22723 
     &   , L                                                                       RAD_ALL.22724 
!             LOOP VARIBLE                                                         RAD_ALL.22725 
      REAL                                                                         RAD_ALL.22726 
     &     W_CLOUD_SINGLE(NPD_LAYER)                                               RAD_ALL.22727 
!             CLOUD AMOUNTS FOR SINGLE PROFILE                                     RAD_ALL.22728 
     &   , W                                                                       RAD_ALL.22729 
!             SINGLE CLOUD AMOUNT                                                  RAD_ALL.22730 
!                                                                                  RAD_ALL.22731 
!     SUBROUTINES CALLED:                                                          RAD_ALL.22732 
      EXTERNAL                                                                     RAD_ALL.22733 
     &     RANK                                                                    RAD_ALL.22734 
!                                                                                  RAD_ALL.22735 
!                                                                                  RAD_ALL.22736 
!                                                                                  RAD_ALL.22737 
      DO L=1, N_PROFILE                                                            RAD_ALL.22738 
!        GATHER THE CLOUD AMOUNTS FOR ONE PROFILE                                  RAD_ALL.22739 
         DO I=1, N_LAYER                                                           RAD_ALL.22740 
            W_CLOUD_SINGLE(I)=W_CLOUD(L, I)                                        RAD_ALL.22741 
         ENDDO                                                                     RAD_ALL.22742 
!                                                                                  RAD_ALL.22743 
!        FIRST FORM THE VECTOR IRANK, RANKING THE LAYERS IN ORDER OF               RAD_ALL.22744 
!        INCREASING CLOUD CONTENT.                                                 RAD_ALL.22745 
         CALL RANK(N_LAYER                                                         RAD_ALL.22746 
     &      , W_CLOUD_SINGLE, IRANK                                                RAD_ALL.22747 
     $        , npd_layer                                                          RAD_ALL.22748 
     &      )                                                                      RAD_ALL.22749 
!                                                                                  RAD_ALL.22750 
!        PASS THROUGH ALL THE COLUMNS SETTING L_COLUMN EQUAL TO .FALSE.            RAD_ALL.22751 
!        IF THE COLUMN IS ACTUALLY CLEAR ON THAT LEVEL. THE ASSUMPTION             RAD_ALL.22752 
!        OF MAXIMUM OVERLAP IS USED HERE.                                          RAD_ALL.22753 
         N_COLUMN(L)=1                                                             RAD_ALL.22754 
         W=0.0E+00                                                                 RAD_ALL.22755 
         I=1                                                                       RAD_ALL.22756 
30       IF (I.LE.N_LAYER) THEN                                                    RAD_ALL.22757 
            IF ( W_CLOUD_SINGLE(IRANK(I)).LT.(W+TOL_TEST) ) THEN                   RAD_ALL.22758 
               I=I+1                                                               RAD_ALL.22759 
               GOTO 30                                                             RAD_ALL.22760 
            ELSE                                                                   RAD_ALL.22761 
               DO K=1, I-1                                                         RAD_ALL.22762 
                  L_COLUMN(L, IRANK(K), N_COLUMN(L))=.FALSE.                       RAD_ALL.22763 
               ENDDO                                                               RAD_ALL.22764 
               DO K=I, N_LAYER                                                     RAD_ALL.22765 
                  L_COLUMN(L, IRANK(K), N_COLUMN(L))=.TRUE.                        RAD_ALL.22766 
               ENDDO                                                               RAD_ALL.22767 
               AREA_COLUMN(L, N_COLUMN(L))                                         RAD_ALL.22768 
     &            =W_CLOUD_SINGLE(IRANK(I))-W                                      RAD_ALL.22769 
               W=W_CLOUD_SINGLE(IRANK(I))                                          RAD_ALL.22770 
            ENDIF                                                                  RAD_ALL.22771 
            IF (W.LT.W_CLOUD_SINGLE(IRANK(N_LAYER))-TOL_TEST) THEN                 RAD_ALL.22772 
               N_COLUMN(L)=N_COLUMN(L)+1                                           RAD_ALL.22773 
               GOTO 30                                                             RAD_ALL.22774 
            ENDIF                                                                  RAD_ALL.22775 
         ENDIF                                                                     RAD_ALL.22776 
!                                                                                  RAD_ALL.22777 
!        THERE IS A TOTALLY CLEAR COLUMN UNLESS AT LEAST ONE LAYER IS              RAD_ALL.22778 
!        TOTALLY CLOUDY.                                                           RAD_ALL.22779 
         IF ((1.0E+00-W).GT.TOL_TEST) THEN                                         RAD_ALL.22780 
!           INCREMENT THE NUMBER OF COLUMNS IF THE FIRST IS NOT BLANK.             RAD_ALL.22781 
            IF (W.GE.TOL_TEST) THEN                                                RAD_ALL.22782 
               N_COLUMN(L)=N_COLUMN(L)+1                                           RAD_ALL.22783 
            ENDIF                                                                  RAD_ALL.22784 
            DO K=1, N_LAYER                                                        RAD_ALL.22785 
               L_COLUMN(L, IRANK(K), N_COLUMN(L))=.FALSE.                          RAD_ALL.22786 
            ENDDO                                                                  RAD_ALL.22787 
            AREA_COLUMN(L, N_COLUMN(L))=1.0E+00-W                                  RAD_ALL.22788 
         ENDIF                                                                     RAD_ALL.22789 
!                                                                                  RAD_ALL.22790 
      ENDDO                                                                        RAD_ALL.22791 
!                                                                                  RAD_ALL.22792 
!                                                                                  RAD_ALL.22793 
      RETURN                                                                       RAD_ALL.22794 
      END   
