*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.83     
*IF DEF,A01_3A,OR,DEF,A02_3A                                               SBWG3A.2      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.13824  
C                                                                          GTS2F400.13825  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.13826  
C restrictions as set forth in the contract.                               GTS2F400.13827  
C                                                                          GTS2F400.13828  
C                Meteorological Office                                     GTS2F400.13829  
C                London Road                                               GTS2F400.13830  
C                BRACKNELL                                                 GTS2F400.13831  
C                Berkshire UK                                              GTS2F400.13832  
C                RG12 2SZ                                                  GTS2F400.13833  
C                                                                          GTS2F400.13834  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.13835  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.13836  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.13837  
C Modelling at the above address.                                          GTS2F400.13838  
C ******************************COPYRIGHT******************************    GTS2F400.13839  
C                                                                          GTS2F400.13840  
!+ Subroutine to calculate the fluxes within the band with no gases.       SBWG3A.3      
!                                                                          SBWG3A.4      
! Method:                                                                  SBWG3A.5      
!       Gaseous extinction is set to 0 and a monochromatic                 SBWG3A.6      
!       calculation is performed.                                          SBWG3A.7      
!                                                                          SBWG3A.8      
! Current Owner of Code: J. M. Edwards                                     SBWG3A.9      
!                                                                          SBWG3A.10     
! History:                                                                 SBWG3A.11     
!       Version         Date                    Comment                    SBWG3A.12     
!       4.0             27-07-95                Original Code              SBWG3A.13     
!                                               (J. M. Edwards)            SBWG3A.14     
!       4.2             08-08-96                Code for vertically        ADB1F402.674    
!                                               coherent convective        ADB1F402.675    
!                                               cloud added.               ADB1F402.676    
!                                               (J. M. Edwards)            ADB1F402.677    
!       4.5             18-05-98                Variable for obsolete      ADB1F405.589    
!                                               solver removed.            ADB1F405.590    
!                                               (J. M. Edwards)            ADB1F405.591    
!                                                                          SBWG3A.15     
! Description of Code:                                                     SBWG3A.16     
!   FORTRAN 77  with extensions listed in documentation.                   SBWG3A.17     
!                                                                          SBWG3A.18     
!- ---------------------------------------------------------------------   SBWG3A.19     

      SUBROUTINE SOLVE_BAND_WITHOUT_GAS(IERR                                1,1SBWG3A.20     
!                       Atmospheric Column                                 SBWG3A.21     
     &   , N_PROFILE, N_LAYER, D_MASS                                      SBWG3A.22     
!                       Angular Integration                                SBWG3A.23     
     &   , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT            SBWG3A.24     
     &   , L_RESCALE, N_ORDER_GAUSS                                        SBWG3A.25     
!                       Treatment of scattering                            SBWG3A.26     
     &   , I_SCATTER_METHOD_BAND                                           SBWG3A.27     
!                       Options for solver                                 SBWG3A.28     
     &   , I_SOLVER, L_NET, N_AUGMENT                                      ADB1F405.592    
!                       Spectral region                                    SBWG3A.30     
     &   , ISOLIR                                                          SBWG3A.31     
!                       Solar properties                                   SBWG3A.32     
     &   , SEC_0, SOLAR_FLUX                                               SBWG3A.33     
!                       Infra-red properties                               SBWG3A.34     
     &   , PLANCK_SOURCE_TOP, PLANCK_SOURCE_BOTTOM                         SBWG3A.35     
     &   , DIFF_PLANCK_BAND, L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2          SBWG3A.36     
!                       Surface properties                                 SBWG3A.37     
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, THERMAL_GROUND_BAND    SBWG3A.38     
!                       Clear-sky optical properties                       SBWG3A.39     
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE                SBWG3A.40     
     &   , FORWARD_SCATTER_FREE                                            SBWG3A.41     
!                       Cloudy properties                                  SBWG3A.42     
     &   , L_CLOUD, I_CLOUD                                                SBWG3A.43     
!                       Cloud Geometry                                     SBWG3A.44     
     &   , N_CLOUD_TOP                                                     SBWG3A.45     
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                        SBWG3A.46     
     &   , I_REGION_CLOUD, FRAC_REGION                                     ADB1F402.678    
     &   , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                          SBWG3A.47     
     &   , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                       SBWG3A.48     
     &   , CLOUD_OVERLAP                                                   SBWG3A.49     
     &   , N_COLUMN, L_COLUMN, AREA_COLUMN                                 SBWG3A.50     
!                       Cloudy optical properties                          SBWG3A.51     
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                              SBWG3A.52     
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                          SBWG3A.53     
!                       Calculated Fluxes                                  SBWG3A.54     
     &   , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND                               SBWG3A.55     
!                       Flags For Clear-sky Fluxes                         SBWG3A.56     
     &   , L_CLEAR, I_SOLVER_CLEAR                                         SBWG3A.57     
!                       Calculated Clear-sky Fluxes                        SBWG3A.58     
     &   , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND                   SBWG3A.59     
!                       Planckian Function                                 SBWG3A.60     
     &   , PLANCK_SOURCE_BAND                                              SBWG3A.61     
!                       Dimensions of Arrays                               SBWG3A.62     
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                              SBWG3A.63     
     &   )                                                                 SBWG3A.64     
!                                                                          SBWG3A.65     
!                                                                          SBWG3A.66     
!                                                                          SBWG3A.67     
      IMPLICIT NONE                                                        SBWG3A.68     
!                                                                          SBWG3A.69     
!                                                                          SBWG3A.70     
!     SIZES OF DUMMY ARRAYS.                                               SBWG3A.71     
      INTEGER   !, INTENT(IN)                                              SBWG3A.72     
     &     NPD_PROFILE                                                     SBWG3A.73     
!             MAXIMUM NUMBER OF PROFILES                                   SBWG3A.74     
     &   , NPD_LAYER                                                       SBWG3A.75     
!             MAXIMUM NUMBER OF LAYERS                                     SBWG3A.76     
     &   , NPD_COLUMN                                                      SBWG3A.77     
!             NUMBER OF COLUMNS PER POINT                                  SBWG3A.78     
!                                                                          SBWG3A.79     
!     INCLUDE COMDECKS.                                                    SBWG3A.80     
*CALL DIMFIX3A                                                             SBWG3A.81     
*CALL SPCRG3A                                                              SBWG3A.82     
!                                                                          SBWG3A.83     
!     DUMMY ARGUMENTS.                                                     SBWG3A.84     
      INTEGER   !, INTENT(OUT)                                             SBWG3A.85     
     &     IERR                                                            SBWG3A.86     
!             ERROR FLAG                                                   SBWG3A.87     
!                                                                          SBWG3A.88     
!                       Atmospheric Column                                 SBWG3A.89     
      INTEGER   !, INTENT(IN)                                              SBWG3A.90     
     &     N_PROFILE                                                       SBWG3A.91     
!             NUMBER OF PROFILES                                           SBWG3A.92     
     &   , N_LAYER                                                         SBWG3A.93     
!             NUMBER OF LAYERS                                             SBWG3A.94     
      REAL  !, INTENT(IN)                                                  SBWG3A.95     
     &     D_MASS(NPD_PROFILE, NPD_LAYER)                                  SBWG3A.96     
!             MASS THICKNESS OF EACH LAYER                                 SBWG3A.97     
!                                                                          SBWG3A.98     
!                       Angular integration                                SBWG3A.99     
      INTEGER   !, INTENT(IN)                                              SBWG3A.100    
     &     I_ANGULAR_INTEGRATION                                           SBWG3A.101    
!             ANGULAR INTEGRATION SCHEME                                   SBWG3A.102    
     &   , I_2STREAM                                                       SBWG3A.103    
!             TWO-STREAM SCHEME                                            SBWG3A.104    
     &   , N_ORDER_GAUSS                                                   SBWG3A.105    
!             ORDER OF GAUSSIAN INTEGRATION                                SBWG3A.106    
      LOGICAL   !, INTENT(IN)                                              SBWG3A.107    
     &     L_2_STREAM_CORRECT                                              SBWG3A.108    
!             USE AN EDGE CORRECTION                                       SBWG3A.109    
     &   , L_RESCALE                                                       SBWG3A.110    
!             RESCALE OPTICAL PROPERTIES                                   SBWG3A.111    
!                                                                          SBWG3A.112    
!                       Treatment of Scattering                            SBWG3A.113    
      INTEGER   !, INTENT(IN)                                              SBWG3A.114    
     &     I_SCATTER_METHOD_BAND                                           SBWG3A.115    
!             METHOD OF TREATING SCATTERING                                SBWG3A.116    
!                                                                          SBWG3A.117    
!                       Options for solver                                 SBWG3A.118    
      INTEGER   !, INTENT(IN)                                              SBWG3A.119    
     &     I_SOLVER                                                        SBWG3A.120    
!             SOLVER USED                                                  SBWG3A.121    
     &   , N_AUGMENT                                                       SBWG3A.124    
!             LENGTH OF LONG FLUX VECTOR                                   SBWG3A.125    
      LOGICAL   !, INTENT(IN)                                              SBWG3A.126    
     &     L_NET                                                           SBWG3A.127    
!             SOLVE FOR NET FLUXES                                         SBWG3A.128    
!                                                                          SBWG3A.129    
!                       Spectral Region                                    SBWG3A.130    
      INTEGER   !, INTENT(IN)                                              SBWG3A.131    
     &     ISOLIR                                                          SBWG3A.132    
!             VISIBLE OR IR                                                SBWG3A.133    
!                                                                          SBWG3A.134    
!                       Solar Properties                                   SBWG3A.135    
      REAL  !, INTENT(IN)                                                  SBWG3A.136    
     &     SEC_0(NPD_PROFILE)                                              SBWG3A.137    
!             SECANT OF SOLAR ZENITH ANGLE                                 SBWG3A.138    
     &   , SOLAR_FLUX(NPD_PROFILE)                                         SBWG3A.139    
!             INCIDENT SOLAR FLUX                                          SBWG3A.140    
!                                                                          SBWG3A.141    
!                       Infra-red Properties                               SBWG3A.142    
      REAL  !, INTENT(IN)                                                  SBWG3A.143    
     &     PLANCK_SOURCE_TOP(NPD_PROFILE)                                  SBWG3A.144    
!             PLANCK FUNCTION AT BOTTOM OF COLUMN                          SBWG3A.145    
     &   , PLANCK_SOURCE_BOTTOM(NPD_PROFILE)                               SBWG3A.146    
!             PLANCK FUNCTION AT BOTTOM OF COLUMN                          SBWG3A.147    
     &   , DIFF_PLANCK_BAND(NPD_PROFILE, NPD_LAYER)                        SBWG3A.148    
!             CHANGE IN PLANCK FUNCTION                                    SBWG3A.149    
     &   , DIFF_PLANCK_BAND_2(NPD_PROFILE, NPD_LAYER)                      SBWG3A.150    
!             2x2ND DIFFERENCE OF PLANCKIAN IN BAND                        SBWG3A.151    
      LOGICAL   !, INTENT(IN)                                              SBWG3A.152    
     &     L_IR_SOURCE_QUAD                                                SBWG3A.153    
!             USE A QUADRATIC SOURCE FUNCTION                              SBWG3A.154    
!                                                                          SBWG3A.155    
!                       Surface Properties                                 SBWG3A.156    
      REAL  !, INTENT(IN)                                                  SBWG3A.157    
     &     ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                SBWG3A.158    
!             DIFFUSE SURFACE ALBEDO                                       SBWG3A.159    
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                 SBWG3A.160    
!             DIRECT SURFACE ALBEDO                                        SBWG3A.161    
     &   , THERMAL_GROUND_BAND(NPD_PROFILE)                                SBWG3A.162    
!             THERMAL SOURCE AT SURFACE IN BAND                            SBWG3A.163    
!                                                                          SBWG3A.164    
!                       Clear-sky Optical Properties                       SBWG3A.165    
      REAL  !, INTENT(IN)                                                  SBWG3A.166    
     &     K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)                         SBWG3A.167    
!             FREE ABSORPTIVE EXTINCTION                                   SBWG3A.168    
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)                         SBWG3A.169    
!             FREE SCATTERING EXTINCTION                                   SBWG3A.170    
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                          SBWG3A.171    
!             CLEAR-SKY ASYMMETRY                                          SBWG3A.172    
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)                    SBWG3A.173    
!             FREE FORWARD SCATTERING                                      SBWG3A.174    
!                                                                          SBWG3A.175    
!                       Cloudy Properties                                  SBWG3A.176    
      LOGICAL   !, INTENT(IN)                                              SBWG3A.177    
     &     L_CLOUD                                                         SBWG3A.178    
!             CLOUDS REQUIRED                                              SBWG3A.179    
      INTEGER   !, INTENT(IN)                                              SBWG3A.180    
     &     I_CLOUD                                                         SBWG3A.181    
!             CLOUD SCHEME USED                                            SBWG3A.182    
!                                                                          SBWG3A.183    
!                       Cloud Geometry                                     SBWG3A.184    
      INTEGER   !, INTENT(IN)                                              SBWG3A.185    
     &     N_CLOUD_TOP                                                     SBWG3A.186    
!             TOPMOST CLOUDY LAYER                                         SBWG3A.187    
     &   , N_CLOUD_TYPE                                                    SBWG3A.188    
!             NUMBER OF TYPES OF CLOUDS                                    SBWG3A.189    
     &   , N_FREE_PROFILE(NPD_LAYER)                                       SBWG3A.190    
!             NUMBER OF FREE PROFILES                                      SBWG3A.191    
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)                          SBWG3A.192    
!             INDICES OF FREE PROFILES                                     SBWG3A.193    
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                      SBWG3A.194    
!             NUMBER OF CLOUDY PROFILES                                    SBWG3A.195    
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                         SBWG3A.196    
!             INDICES OF CLOUDY PROFILES                                   SBWG3A.197    
     &   , N_COLUMN(NPD_PROFILE)                                           SBWG3A.198    
!             NUMBER OF COLUMNS REQUIRED                                   SBWG3A.199    
     &   , I_REGION_CLOUD(NPD_CLOUD_TYPE)                                  ADB1F402.679    
!             REGIONS IN WHICH TYPES OF CLOUDS FALL                        ADB1F402.680    
      LOGICAL   !, INTENT(IN)                                              SBWG3A.200    
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)                    SBWG3A.201    
!             FLAGS FOR CONTENTS OF COLUMNS                                SBWG3A.202    
      REAL  !, INTENT(IN)                                                  SBWG3A.203    
     &     W_FREE(NPD_PROFILE, NPD_LAYER)                                  SBWG3A.204    
!             CLEAR-SKY FRACTION                                           SBWG3A.205    
     &   , W_CLOUD(NPD_PROFILE, NPD_LAYER)                                 SBWG3A.206    
!             CLOUDY FRACTION                                              SBWG3A.207    
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)              SBWG3A.208    
!             FRACTIONS OF TYPES OF CLOUDS                                 SBWG3A.209    
     &   , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF)     SBWG3A.210    
!             COEFFICIENTS FOR TRANSFER FOR ENERGY AT INTERFACES           SBWG3A.211    
     &   , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)                            SBWG3A.212    
!             AREAS OF COLUMNS                                             SBWG3A.213    
     &   , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)                 ADB1F402.681    
!             FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION             ADB1F402.682    
!                                                                          SBWG3A.214    
!                       Cloudy Optical Properties                          SBWG3A.215    
      REAL  !, INTENT(IN)                                                  SBWG3A.216    
     &     K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        SBWG3A.217    
!             CLOUDY ABSORPTIVE EXTINCTION                                 SBWG3A.218    
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        SBWG3A.219    
!             CLOUDY SCATTERING EXTINCTION                                 SBWG3A.220    
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)         SBWG3A.221    
!             CLOUDY ASYMMETRY                                             SBWG3A.222    
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)   SBWG3A.223    
!             CLOUDY FORWARD SCATTERING                                    SBWG3A.224    
!                                                                          SBWG3A.225    
!                       Calculated Fluxes                                  SBWG3A.226    
      REAL  !, INTENT(OUT)                                                 SBWG3A.227    
     &     FLUX_DIRECT_BAND(NPD_PROFILE, 0: NPD_LAYER)                     SBWG3A.228    
!             DIRECT FLUX                                                  SBWG3A.229    
     &   , FLUX_TOTAL_BAND(NPD_PROFILE, 2*NPD_LAYER+2)                     SBWG3A.230    
!                                                                          SBWG3A.231    
!                       Flags for Clear-sky Fluxes                         SBWG3A.232    
      LOGICAL   !, INTENT(IN)                                              SBWG3A.233    
     &     L_CLEAR                                                         SBWG3A.234    
!             CALCULATE NET CLEAR-SKY PROPERTIES                           SBWG3A.235    
      INTEGER   !, INTENT(IN)                                              SBWG3A.236    
     &     I_SOLVER_CLEAR                                                  SBWG3A.237    
!             CLEAR SOLVER USED                                            SBWG3A.238    
!                                                                          SBWG3A.239    
!                       Calculated Clear-sky Fluxes                        SBWG3A.240    
      REAL  !, INTENT(OUT)                                                 SBWG3A.241    
     &     FLUX_DIRECT_CLEAR_BAND(NPD_PROFILE, 0: NPD_LAYER)               SBWG3A.242    
!             CLEAR-SKY DIRECT FLUX                                        SBWG3A.243    
     &   , FLUX_TOTAL_CLEAR_BAND(NPD_PROFILE, 2*NPD_LAYER+2)               SBWG3A.244    
!             CLEAR-SKY TOTAL FLUX                                         SBWG3A.245    
!                                                                          SBWG3A.246    
!                       Planckian Function                                 SBWG3A.247    
      REAL  !, INTENT(IN)                                                  SBWG3A.248    
     &     PLANCK_SOURCE_BAND(NPD_PROFILE, 0: NPD_LAYER)                   SBWG3A.249    
!             PLANCKIAN SOURCE IN BAND                                     SBWG3A.250    
!                                                                          SBWG3A.251    
!                                                                          SBWG3A.252    
!                                                                          SBWG3A.253    
!     LOCAL VARIABLES.                                                     SBWG3A.254    
      INTEGER                                                              SBWG3A.255    
     &     I                                                               SBWG3A.256    
!             LOOP VARIABLE                                                SBWG3A.257    
     &   , L                                                               SBWG3A.258    
!             LOOP VARIABLE                                                SBWG3A.259    
      REAL                                                                 SBWG3A.260    
     &     FLUX_INC_DIRECT(NPD_PROFILE)                                    SBWG3A.261    
!             INCIDENT DIRECT FLUX                                         SBWG3A.262    
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                      SBWG3A.263    
!             INCIDENT DOWNWARD FLUX                                       SBWG3A.264    
     &   , SOURCE_GROUND(NPD_PROFILE)                                      SBWG3A.265    
!             GROUND SOURCE FUNCTION                                       SBWG3A.266    
     &   , K_NULL(NPD_PROFILE, NPD_LAYER)                                  SBWG3A.267    
!             NULL VECTOR FOR CALL TO SUBROUTINE                           SBWG3A.268    
     &   , DUMMY_KE(NPD_PROFILE, NPD_LAYER)                                SBWG3A.269    
!             DUMMY ARRAY (NOT USED)                                       SBWG3A.270    
!                                                                          SBWG3A.271    
!     SUBROUTINES CALLED:                                                  SBWG3A.272    
      EXTERNAL                                                             SBWG3A.273    
     &     MONOCHROMATIC_FLUX                                              SBWG3A.274    
!                                                                          SBWG3A.275    
!                                                                          SBWG3A.276    
!                                                                          SBWG3A.277    
!     SET THE APPROPRIATE TOTAL UPWARD AND DOWNWARD FLUXES                 SBWG3A.278    
!     AT THE BOUNDARIES.                                                   SBWG3A.279    
!                                                                          SBWG3A.280    
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                         SBWG3A.281    
!        VISIBLE REGION.                                                   SBWG3A.282    
         DO L=1, N_PROFILE                                                 SBWG3A.283    
            SOURCE_GROUND(L)=0.0E+00                                       SBWG3A.284    
            FLUX_INC_DOWN(L)=SOLAR_FLUX(L)                                 SBWG3A.285    
            FLUX_INC_DIRECT(L)=SOLAR_FLUX(L)                               SBWG3A.286    
         ENDDO                                                             SBWG3A.287    
      ELSEIF (ISOLIR.EQ.IP_INFRA_RED) THEN                                 SBWG3A.288    
!        INFRA-RED REGION.                                                 SBWG3A.289    
         DO L=1, N_PROFILE                                                 SBWG3A.290    
            FLUX_INC_DIRECT(L)=0.0E+00                                     SBWG3A.291    
            FLUX_DIRECT_BAND(L, N_LAYER)=0.0E+00                           ADB1F401.920    
            FLUX_INC_DOWN(L)=-PLANCK_SOURCE_TOP(L)                         SBWG3A.292    
            SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L)                        SBWG3A.293    
     &         +(ALBEDO_SURFACE_DIFF(L)-1.0E+00)                           SBWG3A.294    
     &         *PLANCK_SOURCE_BOTTOM(L)                                    SBWG3A.295    
         ENDDO                                                             SBWG3A.296    
         IF (L_CLEAR) THEN                                                 ADB1F401.921    
            DO L=1, N_PROFILE                                              ADB1F401.922    
               FLUX_DIRECT_CLEAR_BAND(L, N_LAYER)=0.0E+00                  ADB1F401.923    
            ENDDO                                                          ADB1F401.924    
         ENDIF                                                             ADB1F401.925    
      ENDIF                                                                SBWG3A.297    
!                                                                          SBWG3A.298    
      DO I=1, N_LAYER                                                      SBWG3A.299    
         DO L=1, N_PROFILE                                                 SBWG3A.300    
            K_NULL(L, I)=0.0E+00                                           SBWG3A.301    
         ENDDO                                                             SBWG3A.302    
      ENDDO                                                                SBWG3A.303    
!                                                                          SBWG3A.304    
!                                                                          SBWG3A.305    
      CALL MONOCHROMATIC_FLUX(IERR                                         SBWG3A.306    
!                       Atmospheric Properties                             SBWG3A.307    
     &   , N_PROFILE, N_LAYER, D_MASS                                      SBWG3A.308    
!                       Angular Integration                                SBWG3A.309    
     &   , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT            SBWG3A.310    
     &   , L_RESCALE, N_ORDER_GAUSS                                        SBWG3A.311    
!                       Treatment of Scattering                            SBWG3A.312    
     &   , I_SCATTER_METHOD_BAND                                           SBWG3A.313    
!                       Options for Solver                                 SBWG3A.314    
     &   , I_SOLVER, L_NET, N_AUGMENT                                      ADB1F405.593    
!                       Gaseous Propreties                                 SBWG3A.316    
     &   , K_NULL                                                          SBWG3A.317    
!                       Options for Equivalent Extinction                  SBWG3A.318    
     &   , .FALSE., DUMMY_KE                                               SBWG3A.319    
!                       Spectral Region                                    SBWG3A.320    
     &   , ISOLIR                                                          SBWG3A.321    
!                       Infra-red Properties                               SBWG3A.322    
     &   , DIFF_PLANCK_BAND                                                SBWG3A.323    
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2                            SBWG3A.324    
!                       Conditions at TOA                                  SBWG3A.325    
     &   , SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN                           SBWG3A.326    
!                       Surface Properties                                 SBWG3A.327    
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND          SBWG3A.328    
     &   , THERMAL_GROUND_BAND                                             SBWG3A.329    
!                       Clear-sky Optical Properties                       SBWG3A.330    
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE                                SBWG3A.331    
     &   , ASYMMETRY_FREE, FORWARD_SCATTER_FREE                            SBWG3A.332    
!                       Cloudy Properties                                  SBWG3A.333    
     &   , L_CLOUD, I_CLOUD                                                SBWG3A.334    
!                       Cloud Geometry                                     SBWG3A.335    
     &   , N_CLOUD_TOP                                                     SBWG3A.336    
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                        SBWG3A.337    
     &   , I_REGION_CLOUD, FRAC_REGION                                     ADB1F402.683    
     &   , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                          SBWG3A.338    
     &   , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                       SBWG3A.339    
     &   , CLOUD_OVERLAP                                                   SBWG3A.340    
     &   , N_COLUMN, L_COLUMN, AREA_COLUMN                                 SBWG3A.341    
!                       Cloudy Optical Properties                          SBWG3A.342    
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                              SBWG3A.343    
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                          SBWG3A.344    
!                       Flxues Calculated                                  SBWG3A.345    
     &   , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND                               SBWG3A.346    
!                       Flags for Clear-sky Calculations                   SBWG3A.347    
     &   , L_CLEAR, I_SOLVER_CLEAR                                         SBWG3A.348    
!                       Clear-sky Fluxes Calculated                        SBWG3A.349    
     &   , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND                   SBWG3A.350    
!                       Planckian Function                                 SBWG3A.351    
     &   , PLANCK_SOURCE_BAND                                              SBWG3A.352    
!                       Dimensions of Arrays                               SBWG3A.353    
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                              SBWG3A.354    
     &   )                                                                 SBWG3A.355    
!                                                                          SBWG3A.356    
!                                                                          SBWG3A.357    
!                                                                          SBWG3A.358    
      RETURN                                                               SBWG3A.359    
      END                                                                  SBWG3A.360    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            SBWG3A.361    
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.84