*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.111    
*IF DEF,A01_3A,OR,DEF,A02_3A                                               SSCTA3A.2      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.14045  
C                                                                          GTS2F400.14046  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.14047  
C restrictions as set forth in the contract.                               GTS2F400.14048  
C                                                                          GTS2F400.14049  
C                Meteorological Office                                     GTS2F400.14050  
C                London Road                                               GTS2F400.14051  
C                BRACKNELL                                                 GTS2F400.14052  
C                Berkshire UK                                              GTS2F400.14053  
C                RG12 2SZ                                                  GTS2F400.14054  
C                                                                          GTS2F400.14055  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.14056  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.14057  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.14058  
C Modelling at the above address.                                          GTS2F400.14059  
C ******************************COPYRIGHT******************************    GTS2F400.14060  
C                                                                          GTS2F400.14061  
!+ Subroutine to find single scattering propeties of all regions.          SSCTA3A.3      
!                                                                          SSCTA3A.4      
! Method:                                                                  SSCTA3A.5      
!       Straightforward.                                                   SSCTA3A.6      
!                                                                          SSCTA3A.7      
! Current Owner of Code: J. M. Edwards                                     SSCTA3A.8      
!                                                                          SSCTA3A.9      
! History:                                                                 SSCTA3A.10     
!       Version         Date                    Comment                    SSCTA3A.11     
!       4.0             27-07-95                Original Code              SSCTA3A.12     
!                                               (J. M. Edwards)            SSCTA3A.13     
!                                                                          SSCTA3A.14     
! Description of Code:                                                     SSCTA3A.15     
!   FORTRAN 77  with extensions listed in documentation.                   SSCTA3A.16     
!                                                                          SSCTA3A.17     
!- ---------------------------------------------------------------------   SSCTA3A.18     

      SUBROUTINE SINGLE_SCATTERING_ALL(I_SCATTER_METHOD_BAND                1,2SSCTA3A.19     
!                       Atmospheric Propeties                              SSCTA3A.20     
     &   , N_PROFILE, N_LAYER, D_MASS                                      SSCTA3A.21     
!                       Cloudy Propeties                                   SSCTA3A.22     
     &   , L_CLOUD, N_CLOUD_TOP, N_CLOUD_TYPE                              SSCTA3A.23     
!                       Optical Propeties                                  SSCTA3A.24     
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE                                SSCTA3A.25     
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                              SSCTA3A.26     
     &   , K_GAS_ABS                                                       SSCTA3A.27     
!                       Single Scattering Propeties                        SSCTA3A.28     
     &   , TAU_FREE, OMEGA_FREE                                            SSCTA3A.29     
     &   , TAU_CLOUD, OMEGA_CLOUD                                          SSCTA3A.30     
!                       Dimensions of Arrays                               SSCTA3A.31     
     &   , NPD_PROFILE, NPD_LAYER                                          SSCTA3A.32     
     &   )                                                                 SSCTA3A.33     
!                                                                          SSCTA3A.34     
!                                                                          SSCTA3A.35     
      IMPLICIT NONE                                                        SSCTA3A.36     
!                                                                          SSCTA3A.37     
!                                                                          SSCTA3A.38     
!     SIZES OF ARRAYS.                                                     SSCTA3A.39     
      INTEGER   !, INTENT(IN)                                              SSCTA3A.40     
     &     NPD_PROFILE                                                     SSCTA3A.41     
!             MAXIMUM NUMBER OF PROFILES                                   SSCTA3A.42     
     &   , NPD_LAYER                                                       SSCTA3A.43     
!             MAXIMUM NUMBER OF LAYERS                                     SSCTA3A.44     
!                                                                          SSCTA3A.45     
!     INCLUDE COMDECKS.                                                    SSCTA3A.46     
*CALL DIMFIX3A                                                             SSCTA3A.47     
!                                                                          SSCTA3A.48     
!                                                                          SSCTA3A.49     
!     DUMMY VARIABLES.                                                     SSCTA3A.50     
      INTEGER   !, INTENT(IN)                                              SSCTA3A.51     
     &     I_SCATTER_METHOD_BAND                                           SSCTA3A.52     
!             TREATMENT OF SCATTERING IN THE BAND                          SSCTA3A.53     
!                                                                          SSCTA3A.54     
!                       Atmospheric Properties                             SSCTA3A.55     
      INTEGER   !, INTENT(IN)                                              SSCTA3A.56     
     &     N_PROFILE                                                       SSCTA3A.57     
!             NUMBER OF PROFILES                                           SSCTA3A.58     
     &   , N_LAYER                                                         SSCTA3A.59     
!             NUMBER OF LAYERS                                             SSCTA3A.60     
      REAL      !, INTENT(IN)                                              SSCTA3A.61     
     &     D_MASS(NPD_PROFILE, NPD_LAYER)                                  SSCTA3A.62     
!             MASS THICKNESS OF EACH LAYER                                 SSCTA3A.63     
!                                                                          SSCTA3A.64     
!                       Cldoudy Propeties                                  SSCTA3A.65     
      LOGICAL   !, INTENT(IN)                                              SSCTA3A.66     
     &     L_CLOUD                                                         SSCTA3A.67     
!             FLAG FOR CLOUDS                                              SSCTA3A.68     
      INTEGER   !, INTENT(IN)                                              SSCTA3A.69     
     &     N_CLOUD_TOP                                                     SSCTA3A.70     
!             TOPMOST CLOUDY LAYER                                         SSCTA3A.71     
     &   , N_CLOUD_TYPE                                                    SSCTA3A.72     
!             NUMBER OF TYPES OF CLOUDS                                    SSCTA3A.73     
!                                                                          SSCTA3A.74     
!                       Optical Properties                                 SSCTA3A.75     
      REAL      !, INTENT(IN)                                              SSCTA3A.76     
     &     K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)                         SSCTA3A.77     
!             FREE ABSORPTIVE EXTINCTION                                   SSCTA3A.78     
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)                         SSCTA3A.79     
!             FREE SCATTERING EXTINCTION                                   SSCTA3A.80     
     &   , K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        SSCTA3A.81     
!             STRATIFORM ABSORPTIVE EXTINCTION                             SSCTA3A.82     
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        SSCTA3A.83     
!             STRATIFORM SCATTERING EXTINCTION                             SSCTA3A.84     
     &   , K_GAS_ABS(NPD_PROFILE, NPD_LAYER)                               SSCTA3A.85     
!             GASEOUS EXTINCTION                                           SSCTA3A.86     
!                                                                          SSCTA3A.87     
!                       Single Scattering Properties                       SSCTA3A.88     
      REAL      !, INTENT(OUT)                                             SSCTA3A.89     
     &     TAU_FREE(NPD_PROFILE, NPD_LAYER)                                SSCTA3A.90     
!             FREE OPTICAL DEPTH                                           SSCTA3A.91     
     &   , OMEGA_FREE(NPD_PROFILE, NPD_LAYER)                              SSCTA3A.92     
!             FREE SINGLE SCATTERING ALBEDO                                SSCTA3A.93     
     &   , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)               SSCTA3A.94     
!             CLOUDY OPTICAL DEPTH                                         SSCTA3A.95     
     &   , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)             SSCTA3A.96     
!             CLOUDY SINGLE SCATTERING ALBEDO                              SSCTA3A.97     
!                                                                          SSCTA3A.98     
!                                                                          SSCTA3A.99     
!     LOCAL VARIABLES.                                                     SSCTA3A.100    
      INTEGER                                                              SSCTA3A.101    
     &     K                                                               SSCTA3A.102    
!             LOOP VARIABLE                                                SSCTA3A.103    
!                                                                          SSCTA3A.104    
!     SUBROUTINES CALLED:                                                  SSCTA3A.105    
      EXTERNAL                                                             SSCTA3A.106    
     &     SINGLE_SCATTERING                                               SSCTA3A.107    
!                                                                          SSCTA3A.108    
!                                                                          SSCTA3A.109    
!                                                                          SSCTA3A.110    
!     CLEAR-SKY PROPERTIES:                                                SSCTA3A.111    
!                                                                          SSCTA3A.112    
      CALL SINGLE_SCATTERING(I_SCATTER_METHOD_BAND                         SSCTA3A.113    
     &   , N_PROFILE, N_LAYER, 1                                           SSCTA3A.114    
     &   , D_MASS                                                          SSCTA3A.115    
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, K_GAS_ABS                     SSCTA3A.116    
     &   , TAU_FREE, OMEGA_FREE                                            SSCTA3A.117    
     &   , NPD_PROFILE, NPD_LAYER                                          SSCTA3A.118    
     &   )                                                                 SSCTA3A.119    
!                                                                          SSCTA3A.120    
      IF (L_CLOUD) THEN                                                    SSCTA3A.121    
         DO K=1, N_CLOUD_TYPE                                              SSCTA3A.122    
            CALL SINGLE_SCATTERING(I_SCATTER_METHOD_BAND                   SSCTA3A.123    
     &         , N_PROFILE, N_LAYER, N_CLOUD_TOP                           SSCTA3A.124    
     &         , D_MASS                                                    SSCTA3A.125    
     &         , K_GREY_TOT_CLOUD(1, 1, K)                                 SSCTA3A.126    
     &         , K_EXT_SCAT_CLOUD(1, 1, K)                                 SSCTA3A.127    
     &         , K_GAS_ABS                                                 SSCTA3A.128    
     &         , TAU_CLOUD(1, 1, K), OMEGA_CLOUD(1, 1, K)                  SSCTA3A.129    
     &         , NPD_PROFILE, NPD_LAYER                                    SSCTA3A.130    
     &         )                                                           SSCTA3A.131    
         ENDDO                                                             SSCTA3A.132    
      ENDIF                                                                SSCTA3A.133    
!                                                                          SSCTA3A.134    
!                                                                          SSCTA3A.135    
!                                                                          SSCTA3A.136    
      RETURN                                                               SSCTA3A.137    
      END                                                                  SSCTA3A.138    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            SSCTA3A.139    
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.112