*IF DEF,A70_1A,OR,DEF,A70_1B                                               APB4F405.45     
*IF DEF,A01_3A,OR,DEF,A02_3A                                               MONFX3A.2      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.13467  
C                                                                          GTS2F400.13468  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.13469  
C restrictions as set forth in the contract.                               GTS2F400.13470  
C                                                                          GTS2F400.13471  
C                Meteorological Office                                     GTS2F400.13472  
C                London Road                                               GTS2F400.13473  
C                BRACKNELL                                                 GTS2F400.13474  
C                Berkshire UK                                              GTS2F400.13475  
C                RG12 2SZ                                                  GTS2F400.13476  
C                                                                          GTS2F400.13477  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.13478  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.13479  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.13480  
C Modelling at the above address.                                          GTS2F400.13481  
C ******************************COPYRIGHT******************************    GTS2F400.13482  
C                                                                          GTS2F400.13483  
!+ Subroutine to solve for the monochromatic fluxes.                       MONFX3A.3      
!                                                                          MONFX3A.4      
! Method:                                                                  MONFX3A.5      
!       The final single scattering properties are calculated              MONFX3A.6      
!       and rescaled. An appropriate subroutine is called to               MONFX3A.7      
!       calculate the fluxes depending on the treatment of                 MONFX3A.8      
!       cloudiness.                                                        MONFX3A.9      
!                                                                          MONFX3A.10     
! Current Owner of Code: J. M. Edwards                                     MONFX3A.11     
!                                                                          MONFX3A.12     
! History:                                                                 MONFX3A.13     
!       Version         Date                    Comment                    MONFX3A.14     
!       4.0             27-07-95                Original Code              MONFX3A.15     
!                                               (J. M. Edwards)            MONFX3A.16     
!       4.2             08-08-96                Code for vertically        ADB1F402.523    
!                                               coherent cloud added.      ADB1F402.524    
!                                               (J. M. Edwards)            ADB1F402.525    
!       4.5             18-05-98                Variable for obsolete      ADB1F405.381    
!                                               solver removed.            ADB1F405.382    
!                                               Unused variables           ADB1F405.383    
!                                               removed from call          ADB1F405.384    
!                                               to TRPILE_COLUMN.          ADB1F405.385    
!                                               (J. M. Edwards)            ADB1F405.386    
!                                                                          MONFX3A.17     
! Description of Code:                                                     MONFX3A.18     
!   FORTRAN 77  with extensions listed in documentation.                   MONFX3A.19     
!                                                                          MONFX3A.20     
!- ---------------------------------------------------------------------   MONFX3A.21     

      SUBROUTINE MONOCHROMATIC_FLUX(IERR                                    7,8MONFX3A.22     
!                       Atmospheric Propetries                             MONFX3A.23     
     &   , N_PROFILE, N_LAYER, D_MASS                                      MONFX3A.24     
!                       Angular Integration                                MONFX3A.25     
     &   , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT            MONFX3A.26     
     &   , L_RESCALE, N_ORDER_GAUSS                                        MONFX3A.27     
!                       Treatment of Scattering                            MONFX3A.28     
     &   , I_SCATTER_METHOD_BAND                                           MONFX3A.29     
!                       Options for Solver                                 MONFX3A.30     
     &   , I_SOLVER, L_NET, N_AUGMENT                                      ADB1F405.387    
!                       Gaseous Propeties                                  MONFX3A.32     
     &   , K_GAS_ABS                                                       MONFX3A.33     
!                       Options for Equivalent Extinction                  MONFX3A.34     
     &   , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                  MONFX3A.35     
!                       Spectral Region                                    MONFX3A.36     
     &   , ISOLIR                                                          MONFX3A.37     
!                       Infra-red Properties                               MONFX3A.38     
     &   , DIFF_PLANCK                                                     MONFX3A.39     
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                 MONFX3A.40     
!                       Conditions at TOA                                  MONFX3A.41     
     &   , SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN                           MONFX3A.42     
!                       Surface Propeties                                  MONFX3A.43     
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND          MONFX3A.44     
     &   , GROUND_EMISSION                                                 MONFX3A.45     
!                       Clear-sky Optical Propeties                        MONFX3A.46     
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE                MONFX3A.47     
     &   , FORWARD_SCATTER_FREE                                            MONFX3A.48     
!                       Cloudy Properties                                  MONFX3A.49     
     &   , L_CLOUD, I_CLOUD                                                MONFX3A.50     
!                       Cloud Geometry                                     MONFX3A.51     
     &   , N_CLOUD_TOP                                                     MONFX3A.52     
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                        MONFX3A.53     
     &   , I_REGION_CLOUD, FRAC_REGION                                     ADB1F402.526    
     &   , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                          MONFX3A.54     
     &   , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                       MONFX3A.55     
     &   , CLOUD_OVERLAP                                                   MONFX3A.56     
     &   , N_COLUMN, L_COLUMN, AREA_COLUMN                                 MONFX3A.57     
!                       Cloudy Optical Propeties                           MONFX3A.58     
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                              MONFX3A.59     
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                          MONFX3A.60     
!                       Fluxes Calculated                                  MONFX3A.61     
     &   , FLUX_DIRECT, FLUX_TOTAL                                         MONFX3A.62     
!                       Flags for Clear-sky Calculation                    MONFX3A.63     
     &   , L_CLEAR, I_SOLVER_CLEAR                                         MONFX3A.64     
!                       Clear-sky Fluxes Calculated                        MONFX3A.65     
     &   , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                             MONFX3A.66     
!                       Planckian Source                                   MONFX3A.67     
     &   , PLANCK_SOURCE                                                   MONFX3A.68     
!                       Dimensions of Arrays                               MONFX3A.69     
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                              MONFX3A.70     
     &   )                                                                 MONFX3A.71     
!                                                                          MONFX3A.72     
!                                                                          MONFX3A.73     
      IMPLICIT NONE                                                        MONFX3A.74     
!                                                                          MONFX3A.75     
!                                                                          MONFX3A.76     
!     SIZES OF DUMMY ARRAYS.                                               MONFX3A.77     
      INTEGER   !, INTENT(IN)                                              MONFX3A.78     
     &     NPD_PROFILE                                                     MONFX3A.79     
!             MAXIMUM NUMBER OF PROFILES                                   MONFX3A.80     
     &   , NPD_LAYER                                                       MONFX3A.81     
!             MAXIMUM NUMBER OF LAYERS                                     MONFX3A.82     
     &   , NPD_COLUMN                                                      MONFX3A.83     
!             NUMBER OF COLUMNS PER POINT                                  MONFX3A.84     
!                                                                          MONFX3A.85     
!     INCLUDE COMDECKS.                                                    MONFX3A.86     
*CALL DIMFIX3A                                                             MONFX3A.87     
*CALL CLSCHM3A                                                             MONFX3A.88     
*CALL ANGINT3A                                                             MONFX3A.89     
*CALL ERROR3A                                                              MONFX3A.90     
!                                                                          MONFX3A.91     
!                                                                          MONFX3A.92     
!                                                                          MONFX3A.93     
!     DUMMY ARGUMENTS.                                                     MONFX3A.94     
      INTEGER   !, INTENT(OUT)                                             MONFX3A.95     
     &     IERR                                                            MONFX3A.96     
!             ERROR FLAG                                                   MONFX3A.97     
!                                                                          MONFX3A.98     
!                       Atmospheric Properties                             MONFX3A.99     
      INTEGER   !, INTENT(IN)                                              MONFX3A.100    
     &     N_PROFILE                                                       MONFX3A.101    
!             NUMBER OF PROFILES                                           MONFX3A.102    
     &   , N_LAYER                                                         MONFX3A.103    
!             NUMBER OF LAYERS                                             MONFX3A.104    
      REAL      !, INTENT(IN)                                              MONFX3A.105    
     &     D_MASS(NPD_PROFILE, NPD_LAYER)                                  MONFX3A.106    
!             MASS THICKNESS OF EACH LAYER                                 MONFX3A.107    
!                                                                          MONFX3A.108    
!                       Angular Integration                                MONFX3A.109    
      INTEGER   !, INTENT(IN)                                              MONFX3A.110    
     &     I_ANGULAR_INTEGRATION                                           MONFX3A.111    
!             ANGULAR INTEGRATION SCHEME                                   MONFX3A.112    
     &   , I_2STREAM                                                       MONFX3A.113    
!             TWO-STREAM SCHEME                                            MONFX3A.114    
     &   , N_ORDER_GAUSS                                                   MONFX3A.115    
!             ORDER OF GAUSSIAN INTEGRATION                                MONFX3A.116    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.117    
     &     L_2_STREAM_CORRECT                                              MONFX3A.118    
!             CORRECTION TO TWO-STREAM SCHEME                              MONFX3A.119    
     &   , L_RESCALE                                                       MONFX3A.120    
!             RESCALE OPTICAL PROPERTIES                                   MONFX3A.121    
!                                                                          MONFX3A.122    
!                       Treatment of Scattering                            MONFX3A.123    
      INTEGER   !, INTENT(IN)                                              MONFX3A.124    
     &     I_SCATTER_METHOD_BAND                                           MONFX3A.125    
!                                                                          MONFX3A.126    
!                       Options for Solver                                 MONFX3A.127    
      INTEGER   !, INTENT(IN)                                              MONFX3A.128    
     &     I_SOLVER                                                        MONFX3A.129    
!             SOLVER USED                                                  MONFX3A.130    
     &   , N_AUGMENT                                                       MONFX3A.133    
!             LENGTH OF LONG FLUX VECTOR                                   MONFX3A.134    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.135    
     &     L_NET                                                           MONFX3A.136    
!             CALCULATE NET FLUXES                                         MONFX3A.137    
!                                                                          MONFX3A.138    
!                       Gaseous Properties                                 MONFX3A.139    
      REAL      !, INTENT(IN)                                              MONFX3A.140    
     &     K_GAS_ABS(NPD_PROFILE, NPD_LAYER)                               MONFX3A.141    
!             GASEOUS ABSORPTIVE EXTINCTIONS                               MONFX3A.142    
!                                                                          MONFX3A.143    
!                       Variables for Equivalent Extinction                MONFX3A.144    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.145    
     &     L_SCALE_SOLAR                                                   MONFX3A.146    
!             APPLY SCALING TO SOLAR FLUX                                  MONFX3A.147    
      REAL      !, INTENT(IN)                                              MONFX3A.148    
     &     ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                         MONFX3A.149    
!             ADJUSTMENT OF SOLAR BEAM WITH EQUIVALENT EXTINCTION          MONFX3A.150    
!                                                                          MONFX3A.151    
!                       Spectral Region                                    MONFX3A.152    
      INTEGER   !, INTENT(IN)                                              MONFX3A.153    
     &     ISOLIR                                                          MONFX3A.154    
!             VISIBLE OR IR                                                MONFX3A.155    
!                                                                          MONFX3A.156    
!                       Infra-red Properties                               MONFX3A.157    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.158    
     &     L_IR_SOURCE_QUAD                                                MONFX3A.159    
!             FLAG FOR QUADRATIC IR-SOURCE                                 MONFX3A.160    
      REAL      !, INTENT(IN)                                              MONFX3A.161    
     &     PLANCK_SOURCE(NPD_PROFILE, 0: NPD_LAYER)                        MONFX3A.162    
!             MONOCHROMATIC PLANCKIAN SOURCE                               MONFX3A.163    
     &   , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER)                             MONFX3A.164    
!             THERMAL SOURCE FUNCTION                                      MONFX3A.165    
     &   , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER)                           MONFX3A.166    
!             2ND DIFF. OF THERMAL SOURCE FUNCTION                         MONFX3A.167    
!                                                                          MONFX3A.168    
!                       Conditions at TOA                                  MONFX3A.169    
      REAL      !, INTENT(IN)                                              MONFX3A.170    
     &     SEC_0(NPD_PROFILE)                                              MONFX3A.171    
!             SECANT OF SOLAR ZENITH ANGLE                                 MONFX3A.172    
     &   , FLUX_INC_DIRECT(NPD_PROFILE)                                    MONFX3A.173    
!             INCIDENT DIRECT FLUX                                         MONFX3A.174    
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                      MONFX3A.175    
!             INCIDENT DOWNWARD FLUX                                       MONFX3A.176    
!                                                                          MONFX3A.177    
!                       Surface Propeties                                  MONFX3A.178    
      REAL      !, INTENT(IN)                                              MONFX3A.179    
     &     ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                MONFX3A.180    
!             DIFFUSE SURFACE ALBEDO                                       MONFX3A.181    
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                 MONFX3A.182    
!             DIRECT SURFACE ALBEDO                                        MONFX3A.183    
     &   , SOURCE_GROUND(NPD_PROFILE)                                      MONFX3A.184    
!             GROUND SOURCE FUNCTION                                       MONFX3A.185    
      REAL      !, INTENT(IN)                                              MONFX3A.186    
     &     GROUND_EMISSION(NPD_PROFILE)                                    MONFX3A.187    
!             TOTAL FLUX EMITTED FROM GROUND                               MONFX3A.188    
!                                                                          MONFX3A.189    
!                       Optical Properties                                 MONFX3A.190    
      REAL      !, INTENT(IN)                                              MONFX3A.191    
     &     K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)                         MONFX3A.192    
!             FREE ABSORPTIVE EXTINCTION                                   MONFX3A.193    
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)                         MONFX3A.194    
!             FREE SCATTERING EXTINCTION                                   MONFX3A.195    
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                          MONFX3A.196    
!             CLEAR-SKY ASYMMETRY                                          MONFX3A.197    
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)                    MONFX3A.198    
!             FREE FORWARD SCATTERING                                      MONFX3A.199    
!                                                                          MONFX3A.200    
!                       Cloudy Properties                                  MONFX3A.201    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.202    
     &     L_CLOUD                                                         MONFX3A.203    
!             CLOUDS REQUIRED                                              MONFX3A.204    
      INTEGER   !, INTENT(IN)                                              MONFX3A.205    
     &     I_CLOUD                                                         MONFX3A.206    
!             CLOUD SCHEME USED                                            MONFX3A.207    
!                                                                          MONFX3A.208    
!                       Cloud Geometry                                     MONFX3A.209    
      INTEGER   !, INTENT(IN)                                              MONFX3A.210    
     &     N_CLOUD_TOP                                                     MONFX3A.211    
!             TOPMOST CLOUDY LAYER                                         MONFX3A.212    
     &   , N_CLOUD_TYPE                                                    MONFX3A.213    
!             NUMBER OF TYPES OF CLOUDS                                    MONFX3A.214    
     &   , N_FREE_PROFILE(NPD_LAYER)                                       MONFX3A.215    
!             NUMBER OF FREE PROFILES                                      MONFX3A.216    
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)                          MONFX3A.217    
!             INDICES OF FREE PROFILES                                     MONFX3A.218    
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                      MONFX3A.219    
!             NUMBER OF CLOUDY PROFILES                                    MONFX3A.220    
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                         MONFX3A.221    
!             INDICES OF CLOUDY PROFILES                                   MONFX3A.222    
     &   , N_COLUMN(NPD_PROFILE)                                           MONFX3A.223    
!             NUMBER OF COLUMNS REQUIRED                                   MONFX3A.224    
     &   , I_REGION_CLOUD(NPD_CLOUD_TYPE)                                  ADB1F402.527    
!             REGIONS IN WHICH TYPES OF CLOUDS FALL                        ADB1F402.528    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.225    
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)                    MONFX3A.226    
!             FLAGS FOR CONTENTS OF COLUMNS                                MONFX3A.227    
      REAL      !, INTENT(IN)                                              MONFX3A.228    
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)                                 MONFX3A.229    
!             CLOUDY FRACTION                                              MONFX3A.230    
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)              MONFX3A.231    
!             FRACTIONS OF DIFFERENT TYPES OF CLOUD                        MONFX3A.232    
     &   , W_FREE(NPD_PROFILE, NPD_LAYER)                                  MONFX3A.233    
!             CLEAR-SKY FRACTION                                           MONFX3A.234    
     &   , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF)     MONFX3A.235    
!             COEFFICIENTS FOR ENERGY TRANSFER AT INTERFACES               MONFX3A.236    
     &   , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)                            MONFX3A.237    
!             AREAS OF COLUMNS                                             MONFX3A.238    
     &   , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)                 ADB1F402.529    
!             FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION             ADB1F402.530    
!                                                                          MONFX3A.239    
!                       Cloudy Optical Properties                          MONFX3A.240    
      REAL      !, INTENT(IN)                                              MONFX3A.241    
     &     K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        MONFX3A.242    
!             CLOUDY ABSORPTIVE EXTINCTION                                 MONFX3A.243    
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        MONFX3A.244    
!             CLOUDY SCATTERING EXTINCTION                                 MONFX3A.245    
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)         MONFX3A.246    
!             CLOUDY ASYMMETRY                                             MONFX3A.247    
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)   MONFX3A.248    
!             CLOUDY FORWARD SCATTERING                                    MONFX3A.249    
!                                                                          MONFX3A.250    
!                       Fluxes Calculated                                  MONFX3A.251    
      REAL      !, INTENT(OUT)                                             MONFX3A.252    
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)                          MONFX3A.253    
!             DIRECT FLUX                                                  MONFX3A.254    
     &   , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)                          MONFX3A.255    
!             TOTAL FLUX                                                   MONFX3A.256    
!                                                                          MONFX3A.257    
!                       Flags for Clear-sky Calculations                   MONFX3A.258    
      LOGICAL   !, INTENT(IN)                                              MONFX3A.259    
     &     L_CLEAR                                                         MONFX3A.260    
!             CALCULATE CLEAR-SKY PROPERTIES                               MONFX3A.261    
      INTEGER   !, INTENT(IN)                                              MONFX3A.262    
     &     I_SOLVER_CLEAR                                                  MONFX3A.263    
!             CLEAR SOLVER USED                                            MONFX3A.264    
!                                                                          MONFX3A.265    
!                       Clear-sky Fluxes Calculated                        MONFX3A.266    
      REAL      !, INTENT(OUT)                                             MONFX3A.267    
     &     FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)                    MONFX3A.268    
!             CLEAR-SKY DIRECT FLUX                                        MONFX3A.269    
     &   , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)                    MONFX3A.270    
!             CLEAR-SKY TOTAL FLUX                                         MONFX3A.271    
!                                                                          MONFX3A.272    
!                                                                          MONFX3A.273    
!                                                                          MONFX3A.274    
!     LOCAL VARIABLES.                                                     MONFX3A.275    
      INTEGER                                                              MONFX3A.276    
     &     K                                                               MONFX3A.277    
!             LOOP VARIABLE                                                MONFX3A.278    
      REAL                                                                 MONFX3A.279    
     &     TAU_FREE(NPD_PROFILE, NPD_LAYER)                                MONFX3A.280    
!             FREE OPTICAL DEPTH                                           MONFX3A.281    
     &   , OMEGA_FREE(NPD_PROFILE, NPD_LAYER)                              MONFX3A.282    
!             FREE ALBEDO OF S. S.                                         MONFX3A.283    
     &   , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)               MONFX3A.284    
!             CLOUDY OPTICAL DEPTH                                         MONFX3A.285    
     &   , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)             MONFX3A.286    
!             CLOUDY SINGLE SCATTERING ALBEDO                              MONFX3A.287    
!                                                                          MONFX3A.288    
!     SUBROUTINES CALLED:                                                  MONFX3A.289    
      EXTERNAL                                                             MONFX3A.290    
     &     SINGLE_SCATTERING_ALL, RESCALE_TAU_OMEGA                        MONFX3A.291    
     &   , TWO_STREAM                                                      MONFX3A.292    
     &   , MIX_COLUMN, CLOUD_COLUMN                                        MONFX3A.293    
     &   , GAUSS_ANGLE                                                     MONFX3A.294    
!                                                                          MONFX3A.295    
!                                                                          MONFX3A.296    
!                                                                          MONFX3A.297    
!     CALCULATE SINGLE SCATTERING PROPERTIES FOR ALL ATMOSPHERIC           MONFX3A.298    
!     CONSTITUENTS.                                                        MONFX3A.299    
!                                                                          MONFX3A.300    
      CALL SINGLE_SCATTERING_ALL(I_SCATTER_METHOD_BAND                     MONFX3A.301    
!                       Atmospheric Properties                             MONFX3A.302    
     &   , N_PROFILE, N_LAYER, D_MASS                                      MONFX3A.303    
!                       Cloudy Properties                                  MONFX3A.304    
     &   , L_CLOUD, N_CLOUD_TOP, N_CLOUD_TYPE                              MONFX3A.305    
!                       Optical Properties                                 MONFX3A.306    
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE                                MONFX3A.307    
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                              MONFX3A.308    
     &   , K_GAS_ABS                                                       MONFX3A.309    
!                       Single Scattering Properties                       MONFX3A.310    
     &   , TAU_FREE, OMEGA_FREE                                            MONFX3A.311    
     &   , TAU_CLOUD, OMEGA_CLOUD                                          MONFX3A.312    
!                       Dimensions of Arrays                               MONFX3A.313    
     &   , NPD_PROFILE, NPD_LAYER                                          MONFX3A.314    
     &   )                                                                 MONFX3A.315    
!                                                                          MONFX3A.316    
!                                                                          MONFX3A.317    
!                                                                          MONFX3A.318    
      IF (I_ANGULAR_INTEGRATION.EQ.IP_TWO_STREAM) THEN                     MONFX3A.319    
!                                                                          MONFX3A.320    
!        RESCALE TAU AND OMEGA. THE ASYMMETRY HAS ALREADY BEEN RESCALED.   MONFX3A.321    
!                                                                          MONFX3A.322    
         IF (L_RESCALE) THEN                                               MONFX3A.323    
!                                                                          MONFX3A.324    
            CALL RESCALE_TAU_OMEGA(N_PROFILE, 1, N_LAYER                   MONFX3A.325    
     &         , TAU_FREE, OMEGA_FREE, FORWARD_SCATTER_FREE                MONFX3A.326    
     &         , NPD_PROFILE, NPD_LAYER                                    MONFX3A.327    
     &         )                                                           MONFX3A.328    
!                                                                          MONFX3A.329    
            IF (L_CLOUD) THEN                                              MONFX3A.330    
!                                                                          MONFX3A.331    
               DO K=1, N_CLOUD_TYPE                                        MONFX3A.332    
                  CALL RESCALE_TAU_OMEGA(N_PROFILE, N_CLOUD_TOP            MONFX3A.333    
     &               , N_LAYER                                             MONFX3A.334    
     &               , TAU_CLOUD(1, 1, K), OMEGA_CLOUD(1, 1, K)            MONFX3A.335    
     &               , FORWARD_SCATTER_CLOUD(1, 1, K)                      MONFX3A.336    
     &               , NPD_PROFILE, NPD_LAYER                              MONFX3A.337    
     &               )                                                     MONFX3A.338    
               ENDDO                                                       MONFX3A.339    
!                                                                          MONFX3A.340    
            ENDIF                                                          MONFX3A.341    
!                                                                          MONFX3A.342    
         ENDIF                                                             MONFX3A.343    
!                                                                          MONFX3A.344    
!                                                                          MONFX3A.345    
!        SOLVE THE EQUATIONS USING THE SCHEME INDICATED BY THE VALUES      MONFX3A.346    
!        OF I_CLOUD AND I_SOLVER.                                          MONFX3A.347    
         IF (I_CLOUD.EQ.IP_CLOUD_CLEAR) THEN                               MONFX3A.348    
!                                                                          MONFX3A.349    
!           A TWO-STREAM SCHEME WITH NO CLOUDS.                            MONFX3A.350    
            CALL TWO_STREAM(IERR                                           MONFX3A.351    
!                       Atmospheric Properties                             MONFX3A.352    
     &         , N_PROFILE, N_LAYER                                        MONFX3A.353    
!                       Two-stream Scheme                                  MONFX3A.354    
     &         , I_2STREAM                                                 MONFX3A.355    
!                       Corrections to Two-stream Equations                MONFX3A.356    
     &         , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION        MONFX3A.357    
!                       Options for Solver                                 MONFX3A.358    
     &         , L_NET, I_SOLVER                                           MONFX3A.359    
!                       Options for Equivalent Extinction                  MONFX3A.360    
     &         , L_SCALE_SOLAR, ADJUST_SOLAR_KE                            MONFX3A.361    
!                       Spectral Region                                    MONFX3A.362    
     &         , ISOLIR                                                    MONFX3A.363    
!                       Infra-red Properties                               MONFX3A.364    
     &         , DIFF_PLANCK                                               MONFX3A.365    
     &         , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                           MONFX3A.366    
!                       Conditions at TOA                                  MONFX3A.367    
     &         , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                     MONFX3A.368    
!                       Surface Conditions                                 MONFX3A.369    
     &         , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND    MONFX3A.370    
!                       Single Scattering Propeties                        MONFX3A.371    
     &         , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE                      MONFX3A.372    
!                       Fluxes Calculated                                  MONFX3A.373    
     &         , FLUX_DIRECT, FLUX_TOTAL                                   MONFX3A.374    
!                       Flag for Clear-sky Fluxes                          MONFX3A.375    
     &         , L_CLEAR                                                   MONFX3A.376    
!                       Clear-sky Fluxes Calculated                        MONFX3A.377    
     &         , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                       MONFX3A.378    
!                       Sizes of Arrays                                    MONFX3A.379    
     &         , NPD_PROFILE, NPD_LAYER                                    MONFX3A.380    
     &         )                                                           MONFX3A.381    
               IF (IERR.NE.I_NORMAL) RETURN                                MONFX3A.382    
!                                                                          MONFX3A.383    
         ELSEIF ( (I_CLOUD.EQ.IP_CLOUD_MIX_MAX)                            MONFX3A.384    
     &          .OR. (I_CLOUD.EQ.IP_CLOUD_MIX_RANDOM) ) THEN               MONFX3A.385    
!                                                                          MONFX3A.386    
!           CLOUDS ARE TREATED USING ZDUNKOWSKI'S MIXED-COLUMN SCHEME.     MONFX3A.387    
!           THE GEOMETRY HAS BEEN SET BEFORE.                              MONFX3A.388    
!                                                                          MONFX3A.389    
            CALL MIX_COLUMN(IERR                                           MONFX3A.390    
!                       Atmospheric Properties                             MONFX3A.391    
     &         , N_PROFILE, N_LAYER                                        MONFX3A.392    
!                       Two-stream Scheme                                  MONFX3A.393    
     &         , I_2STREAM                                                 MONFX3A.394    
!                       Corrections to Two-stream Equations                MONFX3A.395    
     &         , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION        MONFX3A.396    
!                       Options for Solver                                 MONFX3A.397    
     &         , I_SOLVER, L_NET                                           ADB1F405.388    
!                       Options for Equivalent Extinction                  MONFX3A.399    
     &         , L_SCALE_SOLAR, ADJUST_SOLAR_KE                            MONFX3A.400    
!                       Spectral Region                                    MONFX3A.401    
     &         , ISOLIR                                                    MONFX3A.402    
!                       Infra-red Properties                               MONFX3A.403    
     &         , DIFF_PLANCK                                               MONFX3A.404    
     &         , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                           MONFX3A.405    
!                       Conditions at TOA                                  MONFX3A.406    
     &         , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                     MONFX3A.407    
!                       Conditions at Surface                              MONFX3A.408    
     &         , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND    MONFX3A.409    
!                       Clear-sky Single Scattering Properties             MONFX3A.410    
     &         , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE                      MONFX3A.411    
!                       Cloud Geometry                                     MONFX3A.412    
     &         , N_CLOUD_TOP                                               MONFX3A.413    
     &         , N_CLOUD_TYPE, FRAC_CLOUD                                  MONFX3A.414    
     &         , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                    ADB1F402.531    
     &         , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                 ADB1F402.532    
     &         , CLOUD_OVERLAP                                             ADB1F402.533    
!                       Cloudy Optical Properties                          ADB1F402.534    
     &         , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD                   ADB1F402.535    
!                       Fluxes Calculated                                  ADB1F402.536    
     &         , FLUX_DIRECT, FLUX_TOTAL                                   ADB1F402.537    
!                       Flags for Clear-sky Calculations                   ADB1F402.538    
     &         , L_CLEAR, I_SOLVER_CLEAR                                   ADB1F402.539    
!                       Clear-sky Fluxes Calculated                        ADB1F402.540    
     &         , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                       ADB1F402.541    
!                       Dimensions of Arrays                               ADB1F402.542    
     &         , NPD_PROFILE, NPD_LAYER                                    ADB1F402.543    
     &         )                                                           ADB1F402.544    
            IF (IERR.NE.I_NORMAL) RETURN                                   ADB1F402.545    
         ELSEIF (I_CLOUD.EQ.IP_CLOUD_TRIPLE) THEN                          ADB1F402.546    
!                                                                          ADB1F402.547    
!           CLOUDS ARE TREATED USING A DECOMPOSITION OF THE COLUMN         ADB1F402.548    
!           INTO CLEAR-SKY, STRATIFORM AND CONVECTIVE REGIONS, ALL         ADB1F402.549    
!           MAXIMALLY OVERLAPPED.                                          ADB1F402.550    
!                                                                          ADB1F402.551    
            CALL TRIPLE_COLUMN(IERR                                        ADB1F402.552    
!                       Atmospheric Properties                             ADB1F402.553    
     &         , N_PROFILE, N_LAYER                                        ADB1F402.554    
!                       Two-stream Scheme                                  ADB1F402.555    
     &         , I_2STREAM                                                 ADB1F402.556    
!                       Corrections to Two-stream Equations                ADB1F402.557    
     &         , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION        ADB1F402.558    
!                       Options for Solver                                 ADB1F402.559    
     &         , I_SOLVER, L_NET                                           ADB1F405.390    
!                       Options for Equivalent Extinction                  ADB1F402.561    
     &         , L_SCALE_SOLAR, ADJUST_SOLAR_KE                            ADB1F402.562    
!                       Spectral Region                                    ADB1F402.563    
     &         , ISOLIR                                                    ADB1F402.564    
!                       Infra-red Properties                               ADB1F402.565    
     &         , DIFF_PLANCK                                               ADB1F402.566    
     &         , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                           ADB1F402.567    
!                       Conditions at TOA                                  ADB1F402.568    
     &         , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                     ADB1F402.569    
!                       Conditions at Surface                              ADB1F402.570    
     &         , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND    ADB1F402.571    
!                       Clear-sky Single Scattering Properties             ADB1F402.572    
     &         , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE                      ADB1F402.573    
!                       Cloud Geometry                                     ADB1F402.574    
     &         , N_CLOUD_TOP                                               ADB1F402.575    
     &         , N_CLOUD_TYPE, FRAC_CLOUD                                  ADB1F402.576    
     &         , I_REGION_CLOUD, FRAC_REGION                               ADB1F402.577    
     &         , W_FREE, W_CLOUD                                           ADB1F405.389    
     &         , CLOUD_OVERLAP                                             MONFX3A.417    
!                       Cloudy Optical Properties                          MONFX3A.418    
     &         , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD                   MONFX3A.419    
!                       Fluxes Calculated                                  MONFX3A.420    
     &         , FLUX_DIRECT, FLUX_TOTAL                                   MONFX3A.421    
!                       Flags for Clear-sky Calculations                   MONFX3A.422    
     &         , L_CLEAR, I_SOLVER_CLEAR                                   MONFX3A.423    
!                       Clear-sky Fluxes Calculated                        MONFX3A.424    
     &         , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                       MONFX3A.425    
!                       Dimensions of Arrays                               MONFX3A.426    
     &         , NPD_PROFILE, NPD_LAYER                                    MONFX3A.427    
     &         )                                                           MONFX3A.428    
            IF (IERR.NE.I_NORMAL) RETURN                                   MONFX3A.429    
!                                                                          MONFX3A.430    
         ELSEIF (I_CLOUD.EQ.IP_CLOUD_COLUMN_MAX) THEN                      MONFX3A.431    
!           CLOUDS ARE TREATED ON THE ASSUMPTION OF MAXIMUM OVERLAP        MONFX3A.432    
!           IN A COLUMN MODEL.                                             MONFX3A.433    
            CALL CLOUD_COLUMN(IERR                                         MONFX3A.434    
!                       Atmospheric Properties                             MONFX3A.435    
     &         , N_PROFILE, N_LAYER                                        MONFX3A.436    
!                       Two-stream Scheme                                  MONFX3A.437    
     &         , I_2STREAM                                                 MONFX3A.438    
!                       Corrections to Two-stream Equations                MONFX3A.439    
     &         , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION        MONFX3A.440    
!                       Options for Solver                                 MONFX3A.441    
     &         , I_SOLVER, N_AUGMENT                                       MONFX3A.442    
!                       Options for Equivalent Extinction                  MONFX3A.443    
     &         , L_SCALE_SOLAR, ADJUST_SOLAR_KE                            MONFX3A.444    
!                       Spectral Region                                    MONFX3A.445    
     &         , ISOLIR                                                    MONFX3A.446    
!                       Infra-red Properties                               MONFX3A.447    
     &         , DIFF_PLANCK                                               MONFX3A.448    
     &         , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                           MONFX3A.449    
!                       Conditions at TOA                                  MONFX3A.450    
     &         , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                     MONFX3A.451    
!                       Conditions at Surface                              MONFX3A.452    
     &         , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND    MONFX3A.453    
!                       Clear-sky Single Scattering Properties             MONFX3A.454    
     &         , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE                      MONFX3A.455    
!                       Cloud Geometry                                     MONFX3A.456    
     &         , N_CLOUD_TOP                                               MONFX3A.457    
     &         , N_CLOUD_TYPE, FRAC_CLOUD                                  MONFX3A.458    
     &         , N_COLUMN, L_COLUMN, AREA_COLUMN                           MONFX3A.459    
!                       Cloudy Optical Properties                          MONFX3A.460    
     &         , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD                   MONFX3A.461    
!                       Fluxes Calculated                                  MONFX3A.462    
     &         , FLUX_DIRECT, FLUX_TOTAL                                   MONFX3A.463    
!                       Flags for Clear-sky Calculations                   MONFX3A.464    
     &         , L_CLEAR, I_SOLVER_CLEAR                                   MONFX3A.465    
!                       Clear-sky Fluxes Calculated                        MONFX3A.466    
     &         , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                       MONFX3A.467    
!                       Dimensions of Arrays                               MONFX3A.468    
     &         , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                        MONFX3A.469    
     &         )                                                           MONFX3A.470    
            IF (IERR.NE.I_NORMAL) RETURN                                   MONFX3A.471    
!                                                                          MONFX3A.472    
         ENDIF                                                             MONFX3A.473    
!                                                                          MONFX3A.474    
      ELSE IF (I_ANGULAR_INTEGRATION.EQ.IP_IR_GAUSS) THEN                  MONFX3A.475    
!                                                                          MONFX3A.476    
!        FULL ANGULAR RESOLUTION USING GASUSSIAN INTEGRATION.              MONFX3A.477    
         CALL GAUSS_ANGLE(N_PROFILE, N_LAYER, L_NET, N_AUGMENT             MONFX3A.478    
     &      , N_ORDER_GAUSS                                                MONFX3A.479    
     &      , TAU_FREE                                                     MONFX3A.480    
     &      , FLUX_INC_DOWN                                                MONFX3A.481    
     &      , DIFF_PLANCK, SOURCE_GROUND, ALBEDO_SURFACE_DIFF              MONFX3A.482    
     &      , FLUX_TOTAL                                                   MONFX3A.483    
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                              MONFX3A.484    
     &      , NPD_PROFILE, NPD_LAYER                                       MONFX3A.485    
     &      )                                                              MONFX3A.486    
         IF (IERR.NE.I_NORMAL) RETURN                                      MONFX3A.487    
!                                                                          MONFX3A.488    
      ENDIF                                                                MONFX3A.489    
!                                                                          MONFX3A.490    
!                                                                          MONFX3A.491    
      RETURN                                                               MONFX3A.492    
      END                                                                  MONFX3A.493    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            MONFX3A.494    
*ENDIF DEF,A70_1A,OR,DEF,A70_1B                                            APB4F405.46