C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.18711 
C                                                                                  RAD_ALL.18712 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.18713 
C restrictions as set forth in the contract.                                       RAD_ALL.18714 
C                                                                                  RAD_ALL.18715 
C                Meteorological Office                                             RAD_ALL.18716 
C                London Road                                                       RAD_ALL.18717 
C                BRACKNELL                                                         RAD_ALL.18718 
C                Berkshire UK                                                      RAD_ALL.18719 
C                RG12 2SZ                                                          RAD_ALL.18720 
C                                                                                  RAD_ALL.18721 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.18722 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.18723 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.18724 
C Modelling at the above address.                                                  RAD_ALL.18725 
C ******************************COPYRIGHT******************************            RAD_ALL.18726 
C                                                                                  RAD_ALL.18727 
!+ Subroutine to set geometry of clouds.                                           RAD_ALL.18728 
!                                                                                  RAD_ALL.18729 
! Method:                                                                          RAD_ALL.18730 
!       For use in multi-column mode arrays are set for each layer                 RAD_ALL.18731 
!       pointing to profiles which have non-negligible clear or                    RAD_ALL.18732 
!       cloudy fractions. The topmost cloudy layers are also                       RAD_ALL.18733 
!       detected.                                                                  RAD_ALL.18734 
!                                                                                  RAD_ALL.18735 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.18736 
!                                                                                  RAD_ALL.18737 
! History:                                                                         RAD_ALL.18738 
!       Version         Date                    Comment                            RAD_ALL.18739 
!       4.0             27-07-95                Original Code                      RAD_ALL.18740 
!                                               (J. M. Edwards)                    RAD_ALL.18741 
!       4.2             Nov. 96   T3E migration: CALL WHENFGT,WHENFLE              RAD_ALL.18742 
!                                  replaced by portable fortran code.              RAD_ALL.18743 
!                                                S.J.Swarbrick                     RAD_ALL.18744 
!                                                                                  RAD_ALL.18745 
! Description of Code:                                                             RAD_ALL.18746 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.18747 
!                                                                                  RAD_ALL.18748 
!- ---------------------------------------------------------------------           RAD_ALL.18749 
      SUBROUTINE SET_CLOUD_GEOMETRY(N_PROFILE, N_LAYER                             RAD_ALL.18750 
     &   , L_GLOBAL_CLOUD_TOP, N_CLOUD_TOP_GLOBAL                                  RAD_ALL.18751 
     &   , W_CLOUD                                                                 RAD_ALL.18752 
     &   , N_CLOUD_PROFILE, I_CLOUD_PROFILE                                        RAD_ALL.18753 
     &   , N_CLOUD_TOP                                                             RAD_ALL.18754 
     &   , N_FREE_PROFILE, I_FREE_PROFILE                                          RAD_ALL.18755 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.18756 
     &   )                                                                         RAD_ALL.18757 
!                                                                                  RAD_ALL.18758 
!                                                                                  RAD_ALL.18759 
!                                                                                  RAD_ALL.18760 
      IMPLICIT NONE                                                                RAD_ALL.18761 
!                                                                                  RAD_ALL.18762 
!                                                                                  RAD_ALL.18763 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.18764 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.18765 
     &     NPD_PROFILE                                                             RAD_ALL.18766 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.18767 
     &   , NPD_LAYER                                                               RAD_ALL.18768 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.18769 
!     INCLUDE COMDECKS.                                                            RAD_ALL.18770 
!     ------------------------------------------------------------------           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.18773 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.18774 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.18775 
     &     N_PROFILE                                                               RAD_ALL.18776 
!             NUMBER OF PROFILES                                                   RAD_ALL.18777 
     &   , N_LAYER                                                                 RAD_ALL.18778 
!             NUMBER OF LAYERS                                                     RAD_ALL.18779 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.18780 
     &     L_GLOBAL_CLOUD_TOP                                                      RAD_ALL.18781 
!             FLAG TO USE A GLOBAL VALUE FOR THE TOPS OF CLOUDS                    RAD_ALL.18782 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.18783 
     &     N_CLOUD_TOP_GLOBAL                                                      RAD_ALL.18784 
!             GLOBAL TOPMOST CLOUDY LAYER                                          RAD_ALL.18785 
!                                                                                  RAD_ALL.18786 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.18787 
     &     N_CLOUD_TOP                                                             RAD_ALL.18788 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.18789 
     &   , N_FREE_PROFILE(NPD_LAYER)                                               RAD_ALL.18790 
!             NUMBER OF FREE PROFILES                                              RAD_ALL.18791 
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.18792 
!             CLOUD-FREE PROFILES                                                  RAD_ALL.18793 
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                              RAD_ALL.18794 
!             NUMBER OF CLOUDY PROFILES                                            RAD_ALL.18795 
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.18796 
!             PROFILES CONTAINING CLOUDS                                           RAD_ALL.18797 
      REAL      !, INTENT(IN)                                                      RAD_ALL.18798 
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.18799 
!             AMOUNTS OF CLOUD                                                     RAD_ALL.18800 
!                                                                                  RAD_ALL.18801 
!                                                                                  RAD_ALL.18802 
!     LOCAL VARIABLES.                                                             RAD_ALL.18803 
      INTEGER                                                                      RAD_ALL.18804 
     &     I,J,L                                                                   RAD_ALL.18805 
!             LOOP VARIABLE                                                        RAD_ALL.18806 
!                                                                                  RAD_ALL.18807 
!                                                                                  RAD_ALL.18808 
!     SUBROUTINES CALLED:                                                          RAD_ALL.18809 
!                                                                                  RAD_ALL.18810 
!                                                                                  RAD_ALL.18811 
!                                                                                  RAD_ALL.18812 
      DO I=1, N_LAYER                                                              RAD_ALL.18813 
!                                                                                  RAD_ALL.18814 
         J                 =1                                                      RAD_ALL.18815 
         N_CLOUD_PROFILE(I)=0                                                      RAD_ALL.18816 
         DO L   =1,N_PROFILE                                                       RAD_ALL.18817 
           IF (W_CLOUD(L,I).GT.TOL_TEST) THEN                                      RAD_ALL.18818 
             I_CLOUD_PROFILE(J,I)=L                                                RAD_ALL.18819 
             J                   =J+1                                              RAD_ALL.18820 
             N_CLOUD_PROFILE(  I)=N_CLOUD_PROFILE(I)+1                             RAD_ALL.18821 
           END IF                                                                  RAD_ALL.18822 
         END DO                                                                    RAD_ALL.18823 
!                                                                                  RAD_ALL.18824 
!                                                                                  RAD_ALL.18825 
         J                =1                                                       RAD_ALL.18826 
         N_FREE_PROFILE(I)=0                                                       RAD_ALL.18827 
         DO L   =1,N_PROFILE                                                       RAD_ALL.18828 
           IF (W_CLOUD(L,I).LE.TOL_TEST) THEN                                      RAD_ALL.18829 
             I_FREE_PROFILE(J,I)=L                                                 RAD_ALL.18830 
             J                  =J+1                                               RAD_ALL.18831 
             N_FREE_PROFILE(  I)=N_FREE_PROFILE(I)+1                               RAD_ALL.18832 
           END IF                                                                  RAD_ALL.18833 
         END DO                                                                    RAD_ALL.18834 
!                                                                                  RAD_ALL.18835 
      ENDDO                                                                        RAD_ALL.18836 
!                                                                                  RAD_ALL.18837 
      IF (L_GLOBAL_CLOUD_TOP) THEN                                                 RAD_ALL.18838 
         N_CLOUD_TOP=N_CLOUD_TOP_GLOBAL                                            RAD_ALL.18839 
      ELSE                                                                         RAD_ALL.18840 
         N_CLOUD_TOP=1                                                             RAD_ALL.18841 
         DO WHILE ( (N_CLOUD_TOP.LT.N_LAYER).AND.                                  RAD_ALL.18842 
     &              (N_CLOUD_PROFILE(N_CLOUD_TOP).EQ.0) )                          RAD_ALL.18843 
            N_CLOUD_TOP=N_CLOUD_TOP+1                                              RAD_ALL.18844 
         ENDDO                                                                     RAD_ALL.18845 
      ENDIF                                                                        RAD_ALL.18846 
!                                                                                  RAD_ALL.18847 
!                                                                                  RAD_ALL.18848 
!                                                                                  RAD_ALL.18849 
      RETURN                                                                       RAD_ALL.18850 
      END 
