*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.51     
*IF DEF,A01_3A,OR,DEF,A02_3A                                               MXCOL3A.2      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.13518  
C                                                                          GTS2F400.13519  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.13520  
C restrictions as set forth in the contract.                               GTS2F400.13521  
C                                                                          GTS2F400.13522  
C                Meteorological Office                                     GTS2F400.13523  
C                London Road                                               GTS2F400.13524  
C                BRACKNELL                                                 GTS2F400.13525  
C                Berkshire UK                                              GTS2F400.13526  
C                RG12 2SZ                                                  GTS2F400.13527  
C                                                                          GTS2F400.13528  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.13529  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.13530  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.13531  
C Modelling at the above address.                                          GTS2F400.13532  
C ******************************COPYRIGHT******************************    GTS2F400.13533  
C                                                                          GTS2F400.13534  
!+ Subroutine to solve the two-stream equations in a mixed column.         MXCOL3A.3      
!                                                                          MXCOL3A.4      
! Method:                                                                  MXCOL3A.5      
!       The two-stream coefficients are calculated in clear regions        MXCOL3A.6      
!       and in stratiform and convective clouds. From these                MXCOL3A.7      
!       coefficients transmission and reflection coefficients are          MXCOL3A.8      
!       determined. The coefficients for convective and stratiform         MXCOL3A.9      
!       clouds are appropriately mixed to form single cloudy values        MXCOL3A.10     
!       and an appropriate solver is called.                               MXCOL3A.11     
!                                                                          MXCOL3A.12     
! Current Owner of Code: J. M. Edwards                                     MXCOL3A.13     
!                                                                          MXCOL3A.14     
! History:                                                                 MXCOL3A.15     
!       Version         Date                    Comment                    MXCOL3A.16     
!       4.0             27-07-95                Original Code              MXCOL3A.17     
!                                               (J. M. Edwards)            MXCOL3A.18     
!       4.1             10-04-96                New solver added.          ADB1F401.615    
!                                               (J. M. Edwards)            ADB1F401.616    
!       4.5             18-05-98                Code for obsolete          ADB1F405.391    
!                                               solver removed.            ADB1F405.392    
!                                               (J. M. Edwards)            ADB1F405.393    
!                                                                          MXCOL3A.19     
! Description of Code:                                                     MXCOL3A.20     
!   FORTRAN 77  with extensions listed in documentation.                   MXCOL3A.21     
!                                                                          MXCOL3A.22     
!- ---------------------------------------------------------------------   MXCOL3A.23     

      SUBROUTINE MIX_COLUMN(IERR                                            1,10MXCOL3A.24     
!                       Atmospheric Properties                             MXCOL3A.25     
     &   , N_PROFILE, N_LAYER                                              MXCOL3A.26     
!                       Two-stream Scheme                                  MXCOL3A.27     
     &   , I_2STREAM                                                       MXCOL3A.28     
!                       Corrections to Two-stream Equations                MXCOL3A.29     
     &   , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION              MXCOL3A.30     
!                       Options for Solver                                 MXCOL3A.31     
     &   , I_SOLVER, L_NET                                                 ADB1F405.394    
!                       Options for Equivalent Extinction                  MXCOL3A.33     
     &   , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                  MXCOL3A.34     
!                       Spectral Region                                    MXCOL3A.35     
     &   , ISOLIR                                                          MXCOL3A.36     
!                       Infra-red Properties                               MXCOL3A.37     
     &   , DIFF_PLANCK                                                     MXCOL3A.38     
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                 MXCOL3A.39     
!                       Conditions at TOA                                  MXCOL3A.40     
     &   , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                           MXCOL3A.41     
!                       Conditions at Surface                              MXCOL3A.42     
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND          MXCOL3A.43     
!                       Clear-sky Single Scattering Properties             MXCOL3A.44     
     &   , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE                            MXCOL3A.45     
!                       Cloud Geometry                                     MXCOL3A.46     
     &   , N_CLOUD_TOP                                                     MXCOL3A.47     
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                        MXCOL3A.48     
     &   , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                          MXCOL3A.49     
     &   , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                       MXCOL3A.50     
     &   , CLOUD_OVERLAP                                                   MXCOL3A.51     
!                       Cloudy Optical Properties                          MXCOL3A.52     
     &   , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD                         MXCOL3A.53     
!                       Fluxes Calculated                                  MXCOL3A.54     
     &   , FLUX_DIRECT, FLUX_TOTAL                                         MXCOL3A.55     
!                       Flags for Clear-sky Calculations                   MXCOL3A.56     
     &   , L_CLEAR, I_SOLVER_CLEAR                                         MXCOL3A.57     
!                       Clear-sky Fluxes Calculated                        MXCOL3A.58     
     &   , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                             MXCOL3A.59     
!                       Dimensions of Arrays                               MXCOL3A.60     
     &   , NPD_PROFILE, NPD_LAYER                                          MXCOL3A.61     
     &   )                                                                 MXCOL3A.62     
!                                                                          MXCOL3A.63     
!                                                                          MXCOL3A.64     
!                                                                          MXCOL3A.65     
      IMPLICIT NONE                                                        MXCOL3A.66     
!                                                                          MXCOL3A.67     
!                                                                          MXCOL3A.68     
!     SIZES OF DUMMY ARRAYS.                                               MXCOL3A.69     
      INTEGER   !, INTENT(IN)                                              MXCOL3A.70     
     &     NPD_PROFILE                                                     MXCOL3A.71     
!             MAXIMUM NUMBER OF PROFILES                                   MXCOL3A.72     
     &   , NPD_LAYER                                                       MXCOL3A.73     
!             MAXIMUM NUMBER OF LAYERS                                     MXCOL3A.74     
!                                                                          MXCOL3A.75     
!     INCLUDE COMDECKS.                                                    MXCOL3A.76     
*CALL STDIO3A                                                              MXCOL3A.77     
*CALL DIMFIX3A                                                             MXCOL3A.78     
*CALL ERROR3A                                                              MXCOL3A.79     
*CALL PRMCH3A                                                              MXCOL3A.80     
*CALL PRECSN3A                                                             MXCOL3A.81     
*CALL SPCRG3A                                                              MXCOL3A.82     
*CALL SOLVER3A                                                             MXCOL3A.83     
*CALL CLCFPT3A                                                             MXCOL3A.84     
!                                                                          MXCOL3A.85     
!     DUMMY VARIABLES.                                                     MXCOL3A.86     
      INTEGER   !, INTENT(IN)                                              MXCOL3A.87     
     &     N_PROFILE                                                       MXCOL3A.88     
!             NUMBER OF PROFILES                                           MXCOL3A.89     
     &   , N_LAYER                                                         MXCOL3A.90     
!             NUMBER OF LAYERS                                             MXCOL3A.91     
     &   , N_CLOUD_TOP                                                     MXCOL3A.92     
!             TOP CLOUDY LAYER                                             MXCOL3A.93     
     &   , N_CLOUD_TYPE                                                    MXCOL3A.94     
!             NUMBER OF TYPES OF CLOUDS                                    MXCOL3A.95     
     &   , N_FREE_PROFILE(NPD_LAYER)                                       MXCOL3A.96     
!             NUMBER OF FREE PROFILES                                      MXCOL3A.97     
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)                          MXCOL3A.98     
!             INDICES OF FREE PROFILES                                     MXCOL3A.99     
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                      MXCOL3A.100    
!             NUMBER OF CLOUDY PROFILES                                    MXCOL3A.101    
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                         MXCOL3A.102    
!             INDICES OF CLOUDY PROFILES                                   MXCOL3A.103    
     &   , ISOLIR                                                          MXCOL3A.104    
!             SPECTRAL REGION                                              MXCOL3A.105    
     &   , I_2STREAM                                                       MXCOL3A.106    
!             TWO-STREAM SCHEME                                            MXCOL3A.107    
     &   , I_SOLVER                                                        MXCOL3A.108    
!             SOLVER USED                                                  MXCOL3A.109    
     &   , I_SOLVER_CLEAR                                                  MXCOL3A.112    
!             SOLVER FOR CLEAR-SKY FLUXES                                  MXCOL3A.113    
      INTEGER   !, INTENT(OUT)                                             MXCOL3A.114    
     &     IERR                                                            MXCOL3A.115    
!             ERROR FLAG                                                   MXCOL3A.116    
      LOGICAL   !, INTENT(IN)                                              MXCOL3A.117    
     &     L_NET                                                           MXCOL3A.118    
!             CALCULATE NET FLUXES                                         MXCOL3A.119    
     &   , L_CLEAR                                                         MXCOL3A.120    
!             CALCULATE CLEAR-SKY FLUXES                                   MXCOL3A.121    
     &   , L_SCALE_SOLAR                                                   MXCOL3A.122    
!             FLAG TO SCALE SOLAR                                          MXCOL3A.123    
     &   , L_IR_SOURCE_QUAD                                                MXCOL3A.124    
!             USE QUADRATIC SOURCE TERM                                    MXCOL3A.125    
     &   , L_2_STREAM_CORRECT                                              MXCOL3A.126    
!             EDGE CORRECTION TO 2-STREAM                                  MXCOL3A.127    
!                                                                          MXCOL3A.128    
!     OPTICAL PROPERTIES:                                                  MXCOL3A.129    
      REAL      !, INTENT(IN)                                              MXCOL3A.130    
     &     TAU_FREE(NPD_PROFILE, NPD_LAYER)                                MXCOL3A.131    
!             FREE OPTICAL DEPTH                                           MXCOL3A.132    
     &   , OMEGA_FREE(NPD_PROFILE, NPD_LAYER)                              MXCOL3A.133    
!             FREE ALBEDO OF SINGLE SCATTERING                             MXCOL3A.134    
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                          MXCOL3A.135    
!             CLEAR-SKY ASYMMETRY                                          MXCOL3A.136    
     &   , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)               MXCOL3A.137    
!             CLOUDY OPTICAL DEPTH                                         MXCOL3A.138    
     &   , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)             MXCOL3A.139    
!             CLOUDY ALBEDO OF SINGLE SCATTERING                           MXCOL3A.140    
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)         MXCOL3A.141    
!             CLOUDY ASYMMETRY                                             MXCOL3A.142    
!                                                                          MXCOL3A.143    
!     CLOUD GEOMETRY:                                                      MXCOL3A.144    
      REAL      !, INTENT(IN)                                              MXCOL3A.145    
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)                                 MXCOL3A.146    
!             CLOUDY FRACTIONS IN EACH LAYER                               MXCOL3A.147    
     &   , W_FREE(NPD_PROFILE, NPD_LAYER)                                  MXCOL3A.148    
!             CLEAR SKY FRACTIONS IN EACH LAYER                            MXCOL3A.149    
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)              MXCOL3A.150    
!             FRACTIONS OF DIFFERENT TYPES OF CLOUD                        MXCOL3A.151    
     &   , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF)     MXCOL3A.152    
!             ENERGY TRANSFER COEFFICIENTS                                 MXCOL3A.153    
      REAL      !, INTENT(IN)                                              MXCOL3A.154    
     &     SEC_0(NPD_PROFILE)                                              MXCOL3A.155    
!             SECANT OF SOLAR ZENITH ANGLE                                 MXCOL3A.156    
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                MXCOL3A.157    
!             DIFFUSE ALBEDO                                               MXCOL3A.158    
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                 MXCOL3A.159    
!             DIRECT ALBEDO                                                MXCOL3A.160    
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                      MXCOL3A.161    
!             INCIDENT TOTAL FLUX                                          MXCOL3A.162    
     &   , FLUX_INC_DIRECT(NPD_PROFILE)                                    MXCOL3A.163    
!             INCIDENT DIRECT FLUX                                         MXCOL3A.164    
     &   , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER)                             MXCOL3A.165    
!             CHANGE IN PLANCK FUNCTION                                    MXCOL3A.166    
     &   , SOURCE_GROUND(NPD_PROFILE)                                      MXCOL3A.167    
!             FLUX FROM SURFACE                                            MXCOL3A.168    
     &   , ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                         MXCOL3A.169    
!             ADJUSTMENT OF SOLAR BEAM WITH EQUIVALENT EXTINCTION          MXCOL3A.170    
     &   , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER)                           MXCOL3A.171    
!             2x2ND DIFFERENCE OF PLANCKIAN                                MXCOL3A.172    
     &   , PLANCK_SOURCE(NPD_PROFILE, 0: NPD_LAYER)                        MXCOL3A.173    
!             PLANCKIAN SOURCE FUNCTION                                    MXCOL3A.174    
     &   , GROUND_EMISSION(NPD_PROFILE)                                    MXCOL3A.175    
!             TOTAL FLUX EMITTED FROM GROUND                               MXCOL3A.176    
!                                                                          MXCOL3A.177    
!     FLUXES CALCULATED                                                    MXCOL3A.178    
      REAL      !, INTENT(OUT)                                             MXCOL3A.179    
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)                          MXCOL3A.180    
!             DIRECT FLUX                                                  MXCOL3A.181    
     &   , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)                          MXCOL3A.182    
!             LONG FLUX VECTOR                                             MXCOL3A.183    
     &   , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)                    MXCOL3A.184    
!             CLEAR DIRECT FLUX                                            MXCOL3A.185    
     &   , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)                    MXCOL3A.186    
!             CLEAR TOTAL FLUX                                             MXCOL3A.187    
!                                                                          MXCOL3A.188    
!                                                                          MXCOL3A.189    
!                                                                          MXCOL3A.190    
!     LOCAL VARIABALES.                                                    MXCOL3A.191    
      INTEGER                                                              MXCOL3A.192    
     &     N_SOURCE_COEFF                                                  MXCOL3A.193    
!             NUMBER OF SOURCE COEFFICIENTS                                MXCOL3A.194    
     &   , N_EQUATION                                                      MXCOL3A.195    
!             NUMBER OF EQUATIONS                                          MXCOL3A.196    
     &   , I                                                               MXCOL3A.197    
!             LOOP VARIABLE                                                MXCOL3A.198    
     &   , L                                                               MXCOL3A.199    
!             LOOP VARIABLE                                                MXCOL3A.200    
!                                                                          MXCOL3A.201    
!                                                                          MXCOL3A.202    
!     CLEAR-SKY COEFFICIENTS:                                              MXCOL3A.203    
      REAL                                                                 MXCOL3A.204    
     &     TRANS_FREE(NPD_PROFILE, NPD_LAYER)                              MXCOL3A.205    
!             FREE TRANSMISSION OF LAYER                                   MXCOL3A.206    
     &   , REFLECT_FREE(NPD_PROFILE, NPD_LAYER)                            MXCOL3A.207    
!             FREE REFLECTANCE OF LAYER                                    MXCOL3A.208    
     &   , TRANS_0_FREE(NPD_PROFILE, NPD_LAYER)                            MXCOL3A.209    
!             FREE DIRECT TRANSMISSION OF LAYER                            MXCOL3A.210    
     &   , SOURCE_COEFF_FREE(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)     MXCOL3A.211    
!             FREE SOURCE COEFFICIENTS                                     MXCOL3A.212    
     &   , S_DOWN_FREE(NPD_PROFILE, NPD_LAYER)                             MXCOL3A.213    
!             FREE DOWNWARD SOURCE                                         MXCOL3A.214    
     &   , S_UP_FREE(NPD_PROFILE, NPD_LAYER)                               MXCOL3A.215    
!             FREE UPWARD SOURCE                                           MXCOL3A.216    
     &   , S_DOWN_CLEAR(NPD_PROFILE, NPD_LAYER)                            MXCOL3A.217    
!             CLEAR DOWNWARD SOURCE                                        MXCOL3A.218    
     &   , S_UP_CLEAR(NPD_PROFILE, NPD_LAYER)                              MXCOL3A.219    
!             CLEAR UPWARD SOURCE                                          MXCOL3A.220    
!                                                                          MXCOL3A.221    
!     CLOUDY COEFFICIENTS:                                                 MXCOL3A.222    
      REAL                                                                 MXCOL3A.223    
     &     TRANS_CLOUD(NPD_PROFILE, NPD_LAYER)                             MXCOL3A.224    
!             CLOUDY TRANSMISSION OF LAYER                                 MXCOL3A.225    
     &   , REFLECT_CLOUD(NPD_PROFILE, NPD_LAYER)                           MXCOL3A.226    
!             CLOUDY REFLECTANCE OF LAYER                                  MXCOL3A.227    
     &   , TRANS_0_CLOUD(NPD_PROFILE, NPD_LAYER)                           MXCOL3A.228    
!             CLOUDY DIRECT TRANSMISSION OF LAYER                          MXCOL3A.229    
     &   , SOURCE_COEFF_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)    MXCOL3A.230    
!             CLOUDY SOURCE COEFFICIENTS                                   MXCOL3A.231    
     &   , S_DOWN_CLOUD(NPD_PROFILE, NPD_LAYER)                            MXCOL3A.232    
!             CLOUDY DOWNWARD SOURCE                                       MXCOL3A.233    
     &   , S_UP_CLOUD(NPD_PROFILE, NPD_LAYER)                              MXCOL3A.234    
!             CLOUDY UPWARD SOURCE                                         MXCOL3A.235    
!                                                                          MXCOL3A.236    
!     SOURCE FUNCTIONS AT THE CROUND                                       ADB1F401.617    
      REAL                                                                 ADB1F401.618    
     &     SOURCE_GROUND_FREE(NPD_PROFILE)                                 ADB1F401.619    
!             SOURCE FROM GROUND UNDER CLEAR SKIES                         ADB1F401.620    
     &   , SOURCE_GROUND_CLOUD(NPD_PROFILE)                                ADB1F401.621    
!             SOURCE FROM GROUND UNDER CLOUDY SKIES                        ADB1F401.622    
     &   , FLUX_DIRECT_GROUND_CLOUD(NPD_PROFILE)                           ADB1F401.623    
!             DIRECT FLUX AT GROUND UNDER CLOUDY SKIES                     ADB1F401.624    
!                                                                          ADB1F401.625    
!                                                                          MXCOL3A.247    
!     NUMERICAL ARRAYS:                                                    MXCOL3A.248    
      REAL                                                                 MXCOL3A.249    
     &     A5(NPD_PROFILE, 5, 2*NPD_LAYER+2)                               MXCOL3A.250    
!             PENTADIAGONAL MATRIX                                         MXCOL3A.251    
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                   MXCOL3A.252    
!             RHS OF MATRIX EQUATION                                       MXCOL3A.253    
     &   , WORK(NPD_PROFILE)                                               MXCOL3A.254    
!             WORKING ARRAY FOR SOLVER                                     MXCOL3A.255    
!                                                                          MXCOL3A.256    
!     FUNCTIONS CALLED:                                                    MXCOL3A.257    
      INTEGER                                                              MXCOL3A.258    
     &     SET_N_SOURCE_COEFF                                              MXCOL3A.259    
!             FUNCTION TO SET NUMBER OF SOURCE COEFFICIENTS                MXCOL3A.260    
!                                                                          MXCOL3A.261    
!     SUBROUTINES CALLED:                                                  MXCOL3A.262    
      EXTERNAL                                                             MXCOL3A.263    
     &     TWO_COEFF, TWO_COEFF_CLOUD, IR_SOURCE, MIXED_SOLAR_SOURCE       MXCOL3A.264    
     &   , BAND_SOLVER, MIX_COLUMN_FULL, MIX_APP_SCAT                      ADB1F405.395    
     &   , CLEAR_SUPPLEMENT                                                MXCOL3A.267    
!                                                                          MXCOL3A.268    
!                                                                          MXCOL3A.269    
!                                                                          MXCOL3A.270    
!     CALCULATE THE TRANSMISSION AND REFLECTION COEFFICIENTS AND           MXCOL3A.271    
!     SOURCE TERMS FOR THE CLEAR AND CLOUDY PARTS OF THE COLUMN            MXCOL3A.272    
!                                                                          MXCOL3A.273    
!     SET THE NUMBER OF SOURCE COEFFICIENTS FOR THE APPROXIMATION          MXCOL3A.274    
      N_SOURCE_COEFF=SET_N_SOURCE_COEFF(ISOLIR, L_IR_SOURCE_QUAD)          MXCOL3A.275    
!                                                                          MXCOL3A.276    
      CALL TWO_COEFF(IERR                                                  MXCOL3A.277    
     &   , N_PROFILE, 1, N_LAYER                                           MXCOL3A.278    
     &   , I_2STREAM, L_IR_SOURCE_QUAD                                     MXCOL3A.279    
     &   , ASYMMETRY_FREE, OMEGA_FREE, TAU_FREE                            MXCOL3A.280    
     &   , ISOLIR, SEC_0                                                   MXCOL3A.281    
     &   , TRANS_FREE, REFLECT_FREE, TRANS_0_FREE                          MXCOL3A.282    
     &   , SOURCE_COEFF_FREE                                               MXCOL3A.283    
     &   , NPD_PROFILE, NPD_LAYER                                          MXCOL3A.284    
     &   )                                                                 MXCOL3A.285    
      IF (IERR.NE.I_NORMAL) RETURN                                         MXCOL3A.286    
!                                                                          MXCOL3A.287    
!                                                                          MXCOL3A.288    
!     INFRA-RED SOURCE TERMS DEPEND ONLY ON THE LAYER AND MAY BE           MXCOL3A.289    
!     CALCULATED NOW. SOLAR TERMS DEPEND ON CONDITIONS IN CLOUD            MXCOL3A.290    
!     IN OVERLYING LAYERS AND MUST BE CALCULATED LATER.                    MXCOL3A.291    
!                                                                          MXCOL3A.292    
      IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                     MXCOL3A.293    
!                                                                          MXCOL3A.294    
         CALL IR_SOURCE(N_PROFILE, 1, N_LAYER                              MXCOL3A.295    
     &      , SOURCE_COEFF_FREE, DIFF_PLANCK                               MXCOL3A.296    
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                              MXCOL3A.297    
     &      , L_2_STREAM_CORRECT, PLANCK_SOURCE                            MXCOL3A.298    
     &      , GROUND_EMISSION, N_LAYER                                     MXCOL3A.299    
     &      , TAU_FREE, TRANS_FREE                                         MXCOL3A.300    
     &      , S_DOWN_FREE, S_UP_FREE                                       MXCOL3A.301    
     &      , NPD_PROFILE, NPD_LAYER                                       MXCOL3A.302    
     &      )                                                              MXCOL3A.303    
!                                                                          MXCOL3A.304    
!        IF A CLEAR-SKY CALCULATION IS REQUIRED THESE SOURCE TERMS MUST    MXCOL3A.305    
!        BE STORED.                                                        MXCOL3A.306    
         IF (L_CLEAR) THEN                                                 MXCOL3A.307    
            DO I=1, N_LAYER                                                MXCOL3A.308    
               DO L=1, N_PROFILE                                           MXCOL3A.309    
                  S_DOWN_CLEAR(L, I)=S_DOWN_FREE(L, I)                     MXCOL3A.310    
                  S_UP_CLEAR(L, I)=S_UP_FREE(L, I)                         MXCOL3A.311    
               ENDDO                                                       MXCOL3A.312    
            ENDDO                                                          MXCOL3A.313    
         ENDIF                                                             MXCOL3A.314    
!                                                                          MXCOL3A.315    
!        SCALE THE SOURCES BY THE CLEAR-SKY FRACTIONS IN THE CLOUDY        MXCOL3A.316    
!        LAYERS. IN HIGHER LAYERS THE CLEAR-SKY FRACTION IS 1.             MXCOL3A.317    
         DO I=N_CLOUD_TOP, N_LAYER                                         MXCOL3A.318    
            DO L=1, N_PROFILE                                              MXCOL3A.319    
               S_DOWN_FREE(L, I)=W_FREE(L, I)*S_DOWN_FREE(L, I)            MXCOL3A.320    
               S_UP_FREE(L, I)=W_FREE(L, I)*S_UP_FREE(L, I)                MXCOL3A.321    
            ENDDO                                                          MXCOL3A.322    
         ENDDO                                                             MXCOL3A.323    
!                                                                          MXCOL3A.324    
      ENDIF                                                                MXCOL3A.325    
!                                                                          MXCOL3A.326    
!                                                                          MXCOL3A.327    
!                                                                          MXCOL3A.328    
!     REPEAT THE CALCULATION FOR CLOUDY REGIONS.                           MXCOL3A.329    
!                                                                          MXCOL3A.330    
!                                                                          MXCOL3A.331    
      CALL TWO_COEFF_CLOUD(IERR                                            MXCOL3A.332    
     &   , N_PROFILE, N_CLOUD_TOP, N_LAYER                                 MXCOL3A.333    
     &   , I_2STREAM, L_IR_SOURCE_QUAD, N_SOURCE_COEFF                     MXCOL3A.334    
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                        MXCOL3A.335    
     &   , ASYMMETRY_CLOUD, OMEGA_CLOUD, TAU_CLOUD                         MXCOL3A.336    
     &   , ISOLIR, SEC_0                                                   MXCOL3A.337    
     &   , TRANS_CLOUD, REFLECT_CLOUD, TRANS_0_CLOUD                       MXCOL3A.338    
     &   , SOURCE_COEFF_CLOUD                                              MXCOL3A.339    
     &   , NPD_PROFILE, NPD_LAYER                                          MXCOL3A.340    
     &   )                                                                 MXCOL3A.341    
      IF (IERR.NE.I_NORMAL) RETURN                                         MXCOL3A.342    
!                                                                          MXCOL3A.343    
!                                                                          MXCOL3A.344    
      IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                     MXCOL3A.345    
!                                                                          MXCOL3A.346    
!        EDGE CORRECTIONS FOR THE TWO-STREAM EQUATIONS DO NOT              MXCOL3A.347    
!        REALLY FIT WITH THIS METHOD OF TREATING CLOUDS. OPTICAL           MXCOL3A.348    
!        DEPTHS AND TRANSMISSIONS MUST BE PASSED TO THE SUBROUTINE         MXCOL3A.349    
!        TO FILL THE ARGUMENT LIST, BUT IT IS NOT INTENDED THAT            MXCOL3A.350    
!        THESE ARRAYS WILL BE USED.                                        MXCOL3A.351    
!                                                                          MXCOL3A.352    
         CALL IR_SOURCE(N_PROFILE, N_CLOUD_TOP, N_LAYER                    MXCOL3A.353    
     &      , SOURCE_COEFF_CLOUD, DIFF_PLANCK                              MXCOL3A.354    
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                              MXCOL3A.355    
     &      , L_2_STREAM_CORRECT, PLANCK_SOURCE                            MXCOL3A.356    
     &      , GROUND_EMISSION, N_LAYER                                     MXCOL3A.357    
     &      , TAU_CLOUD, TRANS_CLOUD                                       MXCOL3A.358    
     &      , S_DOWN_CLOUD, S_UP_CLOUD                                     MXCOL3A.359    
     &      , NPD_PROFILE, NPD_LAYER                                       MXCOL3A.360    
     &      )                                                              MXCOL3A.361    
!                                                                          MXCOL3A.362    
!                                                                          MXCOL3A.363    
         DO I=N_CLOUD_TOP, N_LAYER                                         MXCOL3A.364    
            DO L=1, N_PROFILE                                              MXCOL3A.365    
               S_DOWN_CLOUD(L, I)=W_CLOUD(L, I)*S_DOWN_CLOUD(L, I)         MXCOL3A.366    
               S_UP_CLOUD(L, I)=W_CLOUD(L, I)*S_UP_CLOUD(L, I)             MXCOL3A.367    
            ENDDO                                                          MXCOL3A.368    
         ENDDO                                                             MXCOL3A.369    
!                                                                          MXCOL3A.370    
      ENDIF                                                                MXCOL3A.371    
!                                                                          MXCOL3A.372    
!                                                                          MXCOL3A.373    
!     CALCULATE THE APPROPRIATE SOURCE TERMS FOR THE SOLAR: CLOUDY         MXCOL3A.374    
!     AND CLEAR PROPERTIES ARE BOTH NEEDED HERE.                           MXCOL3A.375    
!                                                                          MXCOL3A.376    
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                         MXCOL3A.377    
!                                                                          MXCOL3A.378    
         CALL MIXED_SOLAR_SOURCE(N_PROFILE, N_LAYER, N_CLOUD_TOP           MXCOL3A.379    
     &      , FLUX_INC_DIRECT                                              MXCOL3A.380    
     &      , L_SCALE_SOLAR, ADJUST_SOLAR_KE                               MXCOL3A.381    
     &      , TRANS_0_FREE, SOURCE_COEFF_FREE                              MXCOL3A.382    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GFF)                           MXCOL3A.383    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GFC)                           MXCOL3A.384    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GCF)                           MXCOL3A.385    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GCC)                           MXCOL3A.386    
     &      , TRANS_0_CLOUD, SOURCE_COEFF_CLOUD                            MXCOL3A.387    
     &      , FLUX_DIRECT                                                  MXCOL3A.388    
     &      , FLUX_DIRECT_GROUND_CLOUD                                     ADB1F401.626    
     &      , S_UP_FREE, S_DOWN_FREE                                       MXCOL3A.389    
     &      , S_UP_CLOUD, S_DOWN_CLOUD                                     MXCOL3A.390    
     &      , NPD_PROFILE, NPD_LAYER                                       MXCOL3A.391    
     &   )                                                                 MXCOL3A.392    
      ENDIF                                                                MXCOL3A.393    
!                                                                          MXCOL3A.394    
!                                                                          MXCOL3A.395    
!                                                                          MXCOL3A.396    
!     FORMULATE THE MATRIX EQUATIONS FOR THE FLUXES.                       ADB1F405.396    
!                                                                          MXCOL3A.398    
      IF (I_SOLVER.EQ.IP_SOLVER_MIX_APP_SCAT) THEN                         ADB1F405.397    
!                                                                          MXCOL3A.485    
         CALL MIX_APP_SCAT(N_PROFILE, N_LAYER, N_CLOUD_TOP                 MXCOL3A.486    
     &      , TRANS_FREE, REFLECT_FREE, S_DOWN_FREE, S_UP_FREE             MXCOL3A.487    
     &      , TRANS_CLOUD, REFLECT_CLOUD                                   MXCOL3A.488    
     &      , S_DOWN_CLOUD, S_UP_CLOUD                                     MXCOL3A.489    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GFF)                           MXCOL3A.490    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GFC)                           MXCOL3A.491    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GCF)                           MXCOL3A.492    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GCC)                           MXCOL3A.493    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BFF)                           MXCOL3A.494    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BFC)                           MXCOL3A.495    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BCF)                           MXCOL3A.496    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BCC)                           MXCOL3A.497    
     &      , L_NET                                                        MXCOL3A.498    
     &      , FLUX_INC_DOWN                                                MXCOL3A.499    
     &      , SOURCE_GROUND, ALBEDO_SURFACE_DIFF                           MXCOL3A.500    
     &      , FLUX_TOTAL                                                   ADB1F401.627    
     &      , NPD_PROFILE, NPD_LAYER                                       ADB1F401.628    
     &      )                                                              ADB1F401.629    
!                                                                          ADB1F401.630    
      ELSE IF (I_SOLVER.EQ.IP_SOLVER_MIX_DIRECT) THEN                      ADB1F405.398    
!                                                                          ADB1F401.633    
!        SET THE PARTITIONED SOURCE FUNCTIONS AT THE GROUND.               ADB1F401.634    
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                      ADB1F401.635    
            DO L=1, N_PROFILE                                              ADB1F401.636    
               SOURCE_GROUND_FREE(L)=(ALBEDO_SURFACE_DIR(L)                ADB1F401.637    
     &            -ALBEDO_SURFACE_DIFF(L))                                 ADB1F401.638    
     &            *(FLUX_DIRECT(L, N_LAYER)                                ADB1F401.639    
     &            -FLUX_DIRECT_GROUND_CLOUD(L))                            ADB1F401.640    
               SOURCE_GROUND_CLOUD(L)=(ALBEDO_SURFACE_DIR(L)               ADB1F401.641    
     &            -ALBEDO_SURFACE_DIFF(L))                                 ADB1F401.642    
     &            *FLUX_DIRECT_GROUND_CLOUD(L)                             ADB1F401.643    
            ENDDO                                                          ADB1F401.644    
         ELSE                                                              ADB1F401.645    
            DO L=1, N_PROFILE                                              ADB1F401.646    
               SOURCE_GROUND_FREE(L)                                       ADB1F401.647    
     &            =CLOUD_OVERLAP(L, N_LAYER, IP_CLOVLP_BFF)                ADB1F401.648    
     &            *SOURCE_GROUND(L)                                        ADB1F401.649    
               SOURCE_GROUND_CLOUD(L)                                      ADB1F401.650    
     &            =CLOUD_OVERLAP(L, N_LAYER, IP_CLOVLP_BCF)                ADB1F401.651    
     &            *SOURCE_GROUND(L)                                        ADB1F401.652    
            ENDDO                                                          ADB1F401.653    
         ENDIF                                                             ADB1F401.654    
!                                                                          ADB1F401.655    
         CALL SOLVER_MIX_DIRECT(N_PROFILE, N_LAYER, N_CLOUD_TOP            ADB1F401.656    
     &      , TRANS_FREE, REFLECT_FREE, S_DOWN_FREE, S_UP_FREE             ADB1F401.657    
     &      , TRANS_CLOUD, REFLECT_CLOUD                                   ADB1F401.658    
     &      , S_DOWN_CLOUD, S_UP_CLOUD                                     ADB1F401.659    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GFF)                           ADB1F401.660    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GFC)                           ADB1F401.661    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GCF)                           ADB1F401.662    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GCC)                           ADB1F401.663    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BFF)                           ADB1F401.664    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BFC)                           ADB1F401.665    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BCF)                           ADB1F401.666    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BCC)                           ADB1F401.667    
     &      , L_NET                                                        ADB1F401.668    
     &      , FLUX_INC_DOWN                                                ADB1F401.669    
     &      , SOURCE_GROUND_FREE, SOURCE_GROUND_CLOUD                      ADB1F401.670    
     &      , ALBEDO_SURFACE_DIFF                                          ADB1F401.671    
     &      , FLUX_TOTAL                                                   MXCOL3A.501    
     &      , NPD_PROFILE, NPD_LAYER                                       MXCOL3A.502    
     &      )                                                              MXCOL3A.532    
!                                                                          MXCOL3A.533    
      ELSE IF (I_SOLVER.EQ.IP_SOLVER_MIX_11) THEN                          MXCOL3A.534    
!                                                                          MXCOL3A.535    
         CALL MIX_COLUMN_FULL(N_PROFILE, N_LAYER, N_CLOUD_TOP              MXCOL3A.536    
     &      , TRANS_FREE, REFLECT_FREE, S_DOWN_FREE, S_UP_FREE             MXCOL3A.537    
     &      , TRANS_CLOUD, REFLECT_CLOUD                                   MXCOL3A.538    
     &      , S_DOWN_CLOUD, S_UP_CLOUD                                     MXCOL3A.539    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GM)                            MXCOL3A.540    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_GP)                            MXCOL3A.541    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BM)                            MXCOL3A.542    
     &      , CLOUD_OVERLAP(1, 0, IP_CLOVLP_BP)                            MXCOL3A.543    
     &      , FLUX_INC_DOWN                                                MXCOL3A.544    
     &      , SOURCE_GROUND, ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR       MXCOL3A.545    
     &      , FLUX_DIRECT(1, N_LAYER)                                      MXCOL3A.546    
     &      , FLUX_TOTAL                                                   MXCOL3A.547    
     &      , NPD_PROFILE, NPD_LAYER                                       MXCOL3A.548    
     &      )                                                              MXCOL3A.549    
!                                                                          MXCOL3A.550    
      ELSE                                                                 MXCOL3A.551    
!                                                                          MXCOL3A.552    
         WRITE(IU_ERR, '(/A)')                                             MXCOL3A.553    
     &      '***ERROR: THE SOLVER SPECIFIED IS NOT VALID HERE.'            MXCOL3A.554    
         IERR=I_ERR_FATAL                                                  MXCOL3A.555    
         RETURN                                                            MXCOL3A.556    
!                                                                          MXCOL3A.557    
      ENDIF                                                                MXCOL3A.558    
!                                                                          MXCOL3A.559    
!                                                                          MXCOL3A.560    
!                                                                          MXCOL3A.561    
      IF (L_CLEAR) THEN                                                    MXCOL3A.562    
!                                                                          MXCOL3A.563    
         CALL CLEAR_SUPPLEMENT(IERR, N_PROFILE, N_LAYER, I_SOLVER_CLEAR    MXCOL3A.564    
     &      , TRANS_FREE, REFLECT_FREE, TRANS_0_FREE, SOURCE_COEFF_FREE    MXCOL3A.565    
     &      , ISOLIR, FLUX_INC_DIRECT, FLUX_INC_DOWN                       MXCOL3A.566    
     &      , S_DOWN_CLEAR, S_UP_CLEAR                                     MXCOL3A.567    
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                      MXCOL3A.568    
     &      , SOURCE_GROUND                                                MXCOL3A.569    
     &      , L_SCALE_SOLAR, ADJUST_SOLAR_KE                               MXCOL3A.570    
     &      , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                          MXCOL3A.571    
     &      , NPD_PROFILE, NPD_LAYER                                       MXCOL3A.572    
     &      )                                                              MXCOL3A.573    
      ENDIF                                                                MXCOL3A.574    
!                                                                          MXCOL3A.575    
!                                                                          MXCOL3A.576    
!                                                                          MXCOL3A.577    
      RETURN                                                               MXCOL3A.578    
      END                                                                  MXCOL3A.579    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            MXCOL3A.580    
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.52