C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.26685 
C                                                                                  RAD_ALL.26686 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.26687 
C restrictions as set forth in the contract.                                       RAD_ALL.26688 
C                                                                                  RAD_ALL.26689 
C                Meteorological Office                                             RAD_ALL.26690 
C                London Road                                                       RAD_ALL.26691 
C                BRACKNELL                                                         RAD_ALL.26692 
C                Berkshire UK                                                      RAD_ALL.26693 
C                RG12 2SZ                                                          RAD_ALL.26694 
C                                                                                  RAD_ALL.26695 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.26696 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.26697 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.26698 
C Modelling at the above address.                                                  RAD_ALL.26699 
C ******************************COPYRIGHT******************************            RAD_ALL.26700 
C                                                                                  RAD_ALL.26701 
!+ Subroutine to solve the two-stream equations in a column.                       RAD_ALL.26702 
!                                                                                  RAD_ALL.26703 
! Method:                                                                          RAD_ALL.26704 
!       The coefficients of the two-stream equations are calculated.               RAD_ALL.26705 
!       From these we obtain the transmission and reflection                       RAD_ALL.26706 
!       coefficients and the source terms. Depending on the solver                 RAD_ALL.26707 
!       selected, an appropriate set of matrix equations is formulated             RAD_ALL.26708 
!       and solved to give the fluxes.                                             RAD_ALL.26709 
!                                                                                  RAD_ALL.26710 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.26711 
!                                                                                  RAD_ALL.26712 
! History:                                                                         RAD_ALL.26713 
!       Version         Date                    Comment                            RAD_ALL.26714 
!       4.0             27-07-95                Original Code                      RAD_ALL.26715 
!                                               (J. M. Edwards)                    RAD_ALL.26716 
!       4.1             10-04-96                New solver added.                  RAD_ALL.26717 
!                                               (J. M. Edwards)                    RAD_ALL.26718 
!                                                                                  RAD_ALL.26719 
! Description of Code:                                                             RAD_ALL.26720 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.26721 
!                                                                                  RAD_ALL.26722 
!- ---------------------------------------------------------------------           RAD_ALL.26723 
      SUBROUTINE TWO_STREAM(IERR                                                   RAD_ALL.26724 
!                       Atmospheric Properties                                     RAD_ALL.26725 
     &   , N_PROFILE, N_LAYER                                                      RAD_ALL.26726 
!                       Two-stream Scheme                                          RAD_ALL.26727 
     &   , I_2STREAM                                                               RAD_ALL.26728 
!                       Corrections to Two-stream scheme                           RAD_ALL.26729 
     &   , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION                      RAD_ALL.26730 
!                       Options for Solver                                         RAD_ALL.26731 
     &   , L_NET, I_SOLVER                                                         RAD_ALL.26732 
!                       Options for Equivalent Extinction                          RAD_ALL.26733 
     &   , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                          RAD_ALL.26734 
!                       Spectral Region                                            RAD_ALL.26735 
     &   , ISOLIR                                                                  RAD_ALL.26736 
!                       Infra-red Properties                                       RAD_ALL.26737 
     &   , DIFF_PLANCK                                                             RAD_ALL.26738 
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                         RAD_ALL.26739 
!                       Conditions at TOA                                          RAD_ALL.26740 
     &   , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                                   RAD_ALL.26741 
!                       Surface Conditions                                         RAD_ALL.26742 
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND                  RAD_ALL.26743 
!                       Single Scattering Properties                               RAD_ALL.26744 
     &   , TAU, OMEGA, ASYMMETRY                                                   RAD_ALL.26745 
!                       Fluxes Calculated                                          RAD_ALL.26746 
     &   , FLUX_DIRECT, FLUX_TOTAL                                                 RAD_ALL.26747 
!                       Flag for Clear-sky Fluxes                                  RAD_ALL.26748 
     &   , L_CLEAR                                                                 RAD_ALL.26749 
!                       Clear-sky Fluxes Calculated                                RAD_ALL.26750 
     &   , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                                     RAD_ALL.26751 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.26752 
     &   )                                                                         RAD_ALL.26753 
!                                                                                  RAD_ALL.26754 
!                                                                                  RAD_ALL.26755 
!                                                                                  RAD_ALL.26756 
      IMPLICIT NONE                                                                RAD_ALL.26757 
!                                                                                  RAD_ALL.26758 
!                                                                                  RAD_ALL.26759 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.26760 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26761 
     &     NPD_PROFILE                                                             RAD_ALL.26762 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.26763 
     &   , NPD_LAYER                                                               RAD_ALL.26764 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.26765 
!     INCLUDE COMDECKS.                                                            RAD_ALL.26766 
!     ------------------------------------------------------------------           DIMFIX3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       DIMFIX3A.3     
!                                                                                  DIMFIX3A.4     
!     MODULE TO SET INTERNAL DIMENSIONS TIED TO ALGORITHMS,                        DIMFIX3A.5     
!     MOSTLY FOR CLOUDS.                                                           DIMFIX3A.6     
!                                                                                  DIMFIX3A.7     
      INTEGER                                                                      DIMFIX3A.8     
     &     NPD_CLOUD_COMPONENT                                                     DIMFIX3A.9     
!             NUMBER OF COMPONENTS OF CLOUDS                                       DIMFIX3A.10    
     &   , NPD_CLOUD_TYPE                                                          DIMFIX3A.11    
!             NUMBER OF PERMITTED TYPES OF CLOUDS.                                 DIMFIX3A.12    
     &   , NPD_CLOUD_REPRESENTATION                                                DIMFIX3A.13    
!             NUMBER OF PERMITTED REPRESENTATIONS OF CLOUDS.                       DIMFIX3A.14    
     &   , NPD_OVERLAP_COEFF                                                       DIMFIX3A.15    
!             NUMBER OF OVERLAP COEFFICIENTS FOR CLOUDS                            DIMFIX3A.16    
     &   , NPD_SOURCE_COEFF                                                        DIMFIX3A.17    
!             NUMBER OF COEFFICIENTS FOR TWO-STREAM SOURCES                        DIMFIX3A.18    
     &   , NPD_REGION                                                              DIMFIX3A.19    
!             NUMBER OF REGIONS IN A LAYER                                         DIMFIX3A.20    
!                                                                                  DIMFIX3A.21    
      PARAMETER(                                                                   DIMFIX3A.22    
     &     NPD_CLOUD_COMPONENT=4                                                   DIMFIX3A.23    
     &   , NPD_CLOUD_TYPE=4                                                        DIMFIX3A.24    
     &   , NPD_CLOUD_REPRESENTATION=4                                              DIMFIX3A.25    
     &   , NPD_OVERLAP_COEFF=18                                                    DIMFIX3A.26    
     &   , NPD_SOURCE_COEFF=2                                                      DIMFIX3A.27    
     &   , NPD_REGION=3                                                            DIMFIX3A.28    
     &   )                                                                         DIMFIX3A.29    
!                                                                                  DIMFIX3A.30    
!     ------------------------------------------------------------------           DIMFIX3A.31    
!     ------------------------------------------------------------------           STDIO3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       STDIO3A.3     
!                                                                                  STDIO3A.4     
!     MODULE TO SET UNIT NUMBERS FOR STANDARD I/O.                                 STDIO3A.5     
!                                                                                  STDIO3A.6     
      INTEGER                                                                      STDIO3A.7     
     &     IU_STDIN                                                                STDIO3A.8     
!             UNIT NUMBER FOR STANDARD INPUT                                       STDIO3A.9     
     &   , IU_STDOUT                                                               STDIO3A.10    
!             UNIT NUMBER FOR STANDARD OUTPUT                                      STDIO3A.11    
     *   , IU_ERR                                                                  STDIO3A.12    
!             UNIT NUMBER FOR ERROR MESSAGES                                       STDIO3A.13    
!                                                                                  STDIO3A.14    
      PARAMETER(                                                                   STDIO3A.15    
     &     IU_STDIN=5                                                              STDIO3A.16    
     &   , IU_STDOUT=6                                                             STDIO3A.17    
     *   , IU_ERR=6                                                                STDIO3A.18    
     &   )                                                                         STDIO3A.19    
!                                                                                  STDIO3A.20    
!     ------------------------------------------------------------------           STDIO3A.21    
!     ------------------------------------------------------------------           ERROR3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       ERROR3A.3     
!                                                                                  ERROR3A.4     
!     MODULE TO SET ERROR FLAGS IN THE RADIATION CODE.                             ERROR3A.5     
!                                                                                  ERROR3A.6     
      INTEGER                                                                      ERROR3A.7     
     &     I_NORMAL                                                                ERROR3A.8     
!             ERROR FREE CONDITION                                                 ERROR3A.9     
     &   , I_ERR_FATAL                                                             ERROR3A.10    
!             FATAL ERROR: IMMEDIATE RETURN                                        ERROR3A.11    
     &   , I_ABORT_CALCULATION                                                     ERROR3A.12    
!             CALCULATION ABORTED                                                  ERROR3A.13    
     &   , I_MISSING_DATA                                                          ERROR3A.14    
!             MISSING DATA ERROR: CONDITIONAL                                      ERROR3A.15    
     &   , I_ERR_IO                                                                ERROR3A.16    
!             I/O ERROR                                                            ERROR3A.17    
     &   , I_ERR_RANGE                                                             ERROR3A.18    
!             INTERPOLATION RANGE ERROR                                            ERROR3A.19    
     &   , I_ERR_EXIST                                                             ERROR3A.20    
!             EXISTENCE ERROR                                                      ERROR3A.21    
!                                                                                  ERROR3A.22    
      PARAMETER(                                                                   ERROR3A.23    
     &     I_NORMAL=0                                                              ERROR3A.24    
     &   , I_ERR_FATAL=1                                                           ERROR3A.25    
     &   , I_ABORT_CALCULATION=2                                                   ERROR3A.26    
     &   , I_MISSING_DATA=3                                                        ERROR3A.27    
     &   , I_ERR_IO=4                                                              ERROR3A.28    
     &   , I_ERR_RANGE=5                                                           ERROR3A.29    
     &   , I_ERR_EXIST=6                                                           ERROR3A.30    
     &   )                                                                         ERROR3A.31    
!                                                                                  ERROR3A.32    
!     ------------------------------------------------------------------           ERROR3A.33    
!     ------------------------------------------------------------------           SOLVER3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SOLVER3A.3     
!                                                                                  SOLVER3A.4     
!     MODULE TO DEFINE REFERENCE NUMBERS FOR SOLVERS.                              SOLVER3A.5     
!                                                                                  SOLVER3A.6     
      INTEGER                                                                      SOLVER3A.7     
     &     IP_SOLVER_PENTADIAGONAL                                                 SOLVER3A.8     
!             PENTADIAGONAL SCHEME                                                 SOLVER3A.9     
     &   , IP_SOLVER_TRIDIAG_FULL                                                  SOLVER3A.10    
!             TRIDIAGONAL SOLVER FOR FLUXES                                        SOLVER3A.11    
     &   , IP_SOLVER_TRIDIAG_PRECOND                                               SOLVER3A.12    
!             TRIDIAGONAL SOLVER FOR FLUXES                                        SOLVER3A.13    
!             WITH PRECONDITIONING OF MATRIX                                       SOLVER3A.14    
     &   , IP_SOLVER_TRIDIAG_NET                                                   SOLVER3A.15    
!             TRIDIAGONAL SOLVER FOR NET FLUX                                      SOLVER3A.16    
     &   , IP_SOLVER_SCHMETZ                                                       SOLVER3A.17    
!             SCHMETZ'S SCHEME                                                     SOLVER3A.18    
     &   , IP_SOLVER_MIX_11                                                        SOLVER3A.19    
!             MIXED COLUMN SCHEME USING FULL ENDEKADIAGONAL MATRIX                 SOLVER3A.20    
     &   , IP_SOLVER_MIX_FULL                                                      SOLVER3A.21    
!             MIXED COLUMN SCHEME FOR FULL FLUXES                                  SOLVER3A.22    
     &   , IP_SOLVER_MIX_NET                                                       SOLVER3A.23    
!             MIXED COLUMN SCHEME FOR NET FLUX                                     SOLVER3A.24    
     &   , IP_SOLVER_MIX_APP_SCAT                                                  SOLVER3A.25    
!             MIXED COLUMN SCHEME WITH APPROXIMATE SCATTERING                      SOLVER3A.26    
     &   , IP_SOLVER_MIX_NET_APP_SCAT                                              SOLVER3A.27    
!             MIXED COLUMN SCHEME FOR NET FLUXES                                   SOLVER3A.28    
!             WITH APPROXIMATE SCATTERING                                          SOLVER3A.29    
     &   , IP_SOLVER_MIX_DIRECT                                                    SOLVER3A.30    
!             DIRECT MIXED COLUMN SCHEME FOR FULL FLUXES                           SOLVER3A.31    
     &   , IP_SOLVER_MIX_DIRECT_NET                                                SOLVER3A.32    
!             DIRECT MIXED COLUMN SCHEME FOR NET FLUXES                            SOLVER3A.33    
     &   , IP_SOLVER_HOMOGEN_DIRECT                                                SOLVER3A.34    
!             DIRECT SOLVER FOR A HOMOGENEOUS COLUMN                               SOLVER3A.35    
     &   , IP_SOLVER_TRIPLE                                                        SOLVER3A.36    
!             DIRECT SOLVER FOR TRIPLE COLUMN                                      SOLVER3A.37    
     &   , IP_SOLVER_TRIPLE_APP_SCAT                                               SOLVER3A.38    
!             DIRECT SOLVER FOR TRIPLE COLUMN APPROXIMATING SCATTERING             SOLVER3A.39    
!                                                                                  SOLVER3A.40    
      PARAMETER(                                                                   SOLVER3A.41    
     &     IP_SOLVER_PENTADIAGONAL=1                                               SOLVER3A.42    
     &   , IP_SOLVER_TRIDIAG_FULL=2                                                SOLVER3A.43    
     &   , IP_SOLVER_TRIDIAG_PRECOND=3                                             SOLVER3A.44    
     &   , IP_SOLVER_TRIDIAG_NET=4                                                 SOLVER3A.45    
     &   , IP_SOLVER_SCHMETZ=5                                                     SOLVER3A.46    
     &   , IP_SOLVER_MIX_11=6                                                      SOLVER3A.47    
     &   , IP_SOLVER_MIX_FULL=7                                                    SOLVER3A.48    
     &   , IP_SOLVER_MIX_NET=8                                                     SOLVER3A.49    
     &   , IP_SOLVER_MIX_APP_SCAT=9                                                SOLVER3A.50    
     &   , IP_SOLVER_MIX_NET_APP_SCAT=10                                           SOLVER3A.51    
     &   , IP_SOLVER_MIX_DIRECT=11                                                 SOLVER3A.52    
     &   , IP_SOLVER_MIX_DIRECT_NET=12                                             SOLVER3A.53    
     &   , IP_SOLVER_HOMOGEN_DIRECT=13                                             SOLVER3A.54    
     &   , IP_SOLVER_TRIPLE=14                                                     SOLVER3A.55    
     &   , IP_SOLVER_TRIPLE_APP_SCAT=15                                            SOLVER3A.56    
     &   )                                                                         SOLVER3A.57    
!                                                                                  SOLVER3A.58    
!     ------------------------------------------------------------------           SOLVER3A.59    
!     ------------------------------------------------------------------           SPCRG3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SPCRG3A.3     
!                                                                                  SPCRG3A.4     
!     MODULE TO SET FLAGS FOR DIFFERENT PORTIONS                                   SPCRG3A.5     
!     OF THE SPECTRUM.                                                             SPCRG3A.6     
!                                                                                  SPCRG3A.7     
      INTEGER                                                                      SPCRG3A.8     
     &     IP_SOLAR                                                                SPCRG3A.9     
!             SOLAR REGION                                                         SPCRG3A.10    
     &   , IP_INFRA_RED                                                            SPCRG3A.11    
!             INFRA-RED REGION                                                     SPCRG3A.12    
!                                                                                  SPCRG3A.13    
      PARAMETER(                                                                   SPCRG3A.14    
     &     IP_SOLAR=1                                                              SPCRG3A.15    
     &   , IP_INFRA_RED=2                                                          SPCRG3A.16    
     &   )                                                                         SPCRG3A.17    
!                                                                                  SPCRG3A.18    
!     ------------------------------------------------------------------           SPCRG3A.19    
!                                                                                  RAD_ALL.26772 
!     DUMMY VARIABLES.                                                             RAD_ALL.26773 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26774 
     &     N_PROFILE                                                               RAD_ALL.26775 
!             NUMBER OF PROFILES                                                   RAD_ALL.26776 
     &   , N_LAYER                                                                 RAD_ALL.26777 
!             NUMBER OF LAYERS                                                     RAD_ALL.26778 
     &   , ISOLIR                                                                  RAD_ALL.26779 
!             SPECTRAL REGION                                                      RAD_ALL.26780 
     &   , I_SOLVER                                                                RAD_ALL.26781 
!             SOLVER EMPLOYED                                                      RAD_ALL.26782 
     &   , I_2STREAM                                                               RAD_ALL.26783 
!             TWO-STREAM SCHEME                                                    RAD_ALL.26784 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.26785 
     &     IERR                                                                    RAD_ALL.26786 
!             ERROR FLAG                                                           RAD_ALL.26787 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.26788 
     &     L_NET                                                                   RAD_ALL.26789 
!             CALCULATE NET FLUXES                                                 RAD_ALL.26790 
     &   , L_CLEAR                                                                 RAD_ALL.26791 
!             CALCULATE CLEAR FLUXES                                               RAD_ALL.26792 
     &   , L_SCALE_SOLAR                                                           RAD_ALL.26793 
!             SCALING APPLIED TO SOLAR FLUX                                        RAD_ALL.26794 
     &   , L_IR_SOURCE_QUAD                                                        RAD_ALL.26795 
!             USE QUADRATIC SOURCE TERM                                            RAD_ALL.26796 
     &   , L_2_STREAM_CORRECT                                                      RAD_ALL.26797 
!             EDGE CORRECTION FOR 2-STREAM                                         RAD_ALL.26798 
      REAL      !, INTENT(IN)                                                      RAD_ALL.26799 
     &     TAU(NPD_PROFILE, NPD_LAYER)                                             RAD_ALL.26800 
!             OPTICAL DEPTH                                                        RAD_ALL.26801 
     &   , OMEGA(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.26802 
!             ALBEDO OF SINGLE SCATTERING                                          RAD_ALL.26803 
     &   , ASYMMETRY(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.26804 
!             ASYMMETRY                                                            RAD_ALL.26805 
     &   , SEC_0(NPD_PROFILE)                                                      RAD_ALL.26806 
!             SECANTS OF SOLAR ZENITH ANGLES                                       RAD_ALL.26807 
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.26808 
!             DIFFUSE ALBEDO                                                       RAD_ALL.26809 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.26810 
!             DIRECT ALBEDO                                                        RAD_ALL.26811 
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.26812 
!             INCIDENT TOTAL FLUX                                                  RAD_ALL.26813 
     &   , FLUX_INC_DIRECT(NPD_PROFILE)                                            RAD_ALL.26814 
!             INCIDENT DIRECT FLUX                                                 RAD_ALL.26815 
     &   , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.26816 
!             DIFFERENCE IN PI*PLANCK FUNCTION                                     RAD_ALL.26817 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.26818 
!             GROUND SOURCE FUNCTION                                               RAD_ALL.26819 
     &   , ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.26820 
!             ADJUSTMENT OF SOLAR BEAM WITH EQUIVALENT EXTINCTION                  RAD_ALL.26821 
     &   , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER)                                   RAD_ALL.26822 
!             2x2ND DIFFERENCES OF PLANCKIAN                                       RAD_ALL.26823 
     &   , PLANCK_SOURCE(NPD_PROFILE, NPD_LAYER)                                   RAD_ALL.26824 
!             PLANCKIAN SOURCE FUNCTION                                            RAD_ALL.26825 
     &   , GROUND_EMISSION(NPD_PROFILE)                                            RAD_ALL.26826 
!             TOTAL FLUX EMITTED FROM GROUND                                       RAD_ALL.26827 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.26828 
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)                                  RAD_ALL.26829 
!             DIRECT FLUX                                                          RAD_ALL.26830 
     &   , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)                                  RAD_ALL.26831 
!             TOTAL FLUXES                                                         RAD_ALL.26832 
     &   , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)                            RAD_ALL.26833 
!             CLEAR DIRECT FLUX                                                    RAD_ALL.26834 
     &   , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)                            RAD_ALL.26835 
!             CLEAR TOTAL FLUXES                                                   RAD_ALL.26836 
!                                                                                  RAD_ALL.26837 
!                                                                                  RAD_ALL.26838 
!     LOCAL VARIABALES.                                                            RAD_ALL.26839 
      INTEGER                                                                      RAD_ALL.26840 
     &     N_EQUATION                                                              RAD_ALL.26841 
!             NUMBER OF EQUATIONS                                                  RAD_ALL.26842 
     &   , I                                                                       RAD_ALL.26843 
!             LOOP VARIABLE                                                        RAD_ALL.26844 
     &   , L                                                                       RAD_ALL.26845 
!             LOOP VARIABLE                                                        RAD_ALL.26846 
      REAL                                                                         RAD_ALL.26847 
     &     TRANS(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.26848 
!             TRANSMISSION OF LAYER                                                RAD_ALL.26849 
     &   , REFLECT(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.26850 
!             REFLECTANCE OF LAYER                                                 RAD_ALL.26851 
     &   , TRANS_0(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.26852 
!             DIRECT TRANSMITTANCE                                                 RAD_ALL.26853 
     &   , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)                  RAD_ALL.26854 
!             SOURCE COEFFICIENTS                                                  RAD_ALL.26855 
     &   , S_DOWN(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.26856 
!             DOWNWARD SOURCE                                                      RAD_ALL.26857 
     &   , S_UP(NPD_PROFILE, NPD_LAYER)                                            RAD_ALL.26858 
!             UPWARD SOURCE                                                        RAD_ALL.26859 
      REAL                                                                         RAD_ALL.26860 
     &     A3(NPD_PROFILE, 3, 2*NPD_LAYER+2)                                       RAD_ALL.26861 
!             TRIDIAGONAL MATRIX                                                   RAD_ALL.26862 
     &   , A5(NPD_PROFILE, 5, 2*NPD_LAYER+2)                                       RAD_ALL.26863 
!             PENTADIGONAL MATRIX                                                  RAD_ALL.26864 
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                           RAD_ALL.26865 
!             RHS OF MATRIX EQUATION                                               RAD_ALL.26866 
     &   , WORK_1(NPD_PROFILE, 2*NPD_LAYER+2)                                      RAD_ALL.26867 
!             WORKING ARRAY FOR SOLVER                                             RAD_ALL.26868 
     &   , WORK_2(NPD_PROFILE, 2*NPD_LAYER+2)                                      RAD_ALL.26869 
!             WORKING ARRAY FOR SOLVER                                             RAD_ALL.26870 
!                                                                                  RAD_ALL.26871 
!     SUBROUTINES CALLED:                                                          RAD_ALL.26872 
      EXTERNAL                                                                     RAD_ALL.26873 
     &     TWO_COEFF, SOLAR_SOURCE, IR_SOURCE                                      RAD_ALL.26874 
     &   , SET_MATRIX_NET, TRIDIAG_SOLVER_UP, SET_MATRIX_FULL                      RAD_ALL.26875 
     &   , PRECONDITIONER_CLEAR, SET_MATRIX_PENTADIAGONAL                          RAD_ALL.26876 
     &   , BAND_SOLVER, SOLVER_HOMOGEN_DIRECT                                      RAD_ALL.26877 
!                                                                                  RAD_ALL.26878 
!                                                                                  RAD_ALL.26879 
!                                                                                  RAD_ALL.26880 
!     CALCULATE THE TWO-STREAM COEFFICIENTS.                                       RAD_ALL.26881 
      CALL TWO_COEFF(IERR                                                          RAD_ALL.26882 
     &   , N_PROFILE, 1, N_LAYER                                                   RAD_ALL.26883 
     &   , I_2STREAM, L_IR_SOURCE_QUAD                                             RAD_ALL.26884 
     &   , ASYMMETRY, OMEGA, TAU                                                   RAD_ALL.26885 
     &   , ISOLIR, SEC_0                                                           RAD_ALL.26886 
     &   , TRANS, REFLECT, TRANS_0                                                 RAD_ALL.26887 
     &   , SOURCE_COEFF                                                            RAD_ALL.26888 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.26889 
     &   )                                                                         RAD_ALL.26890 
      IF (IERR.NE.I_NORMAL) THEN                                                   RAD_ALL.26891 
         RETURN                                                                    RAD_ALL.26892 
      ENDIF                                                                        RAD_ALL.26893 
!                                                                                  RAD_ALL.26894 
!     CALCULATE THE APPROPRIATE SOURCE TERMS.                                      RAD_ALL.26895 
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                                 RAD_ALL.26896 
         CALL SOLAR_SOURCE(N_PROFILE, N_LAYER                                      RAD_ALL.26897 
     &      , FLUX_INC_DIRECT                                                      RAD_ALL.26898 
     &      , TRANS_0, SOURCE_COEFF                                                RAD_ALL.26899 
     &      , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                       RAD_ALL.26900 
     &      , FLUX_DIRECT                                                          RAD_ALL.26901 
     &      , S_DOWN, S_UP                                                         RAD_ALL.26902 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.26903 
     &      )                                                                      RAD_ALL.26904 
      ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                        RAD_ALL.26905 
         CALL IR_SOURCE(N_PROFILE, 1, N_LAYER                                      RAD_ALL.26906 
     &      , SOURCE_COEFF, DIFF_PLANCK                                            RAD_ALL.26907 
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                      RAD_ALL.26908 
     &      , L_2_STREAM_CORRECT, PLANCK_SOURCE                                    RAD_ALL.26909 
     &      , GROUND_EMISSION, N_LAYER                                             RAD_ALL.26910 
     &      , TAU, TRANS                                                           RAD_ALL.26911 
     &      , S_DOWN, S_UP                                                         RAD_ALL.26912 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.26913 
     &      )                                                                      RAD_ALL.26914 
      ENDIF                                                                        RAD_ALL.26915 
!                                                                                  RAD_ALL.26916 
!     FEED THE COEFFICIENTS INTO THE TRIDIAGONCAL MATRIX.                          RAD_ALL.26917 
!     DIFFERENT SOLVERS ARE USED FOR THE NET OR THE FULL TOTAL FLUXES.             RAD_ALL.26918 
      IF (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_NET) THEN                                  RAD_ALL.26919 
         CALL SET_MATRIX_NET(N_PROFILE, N_LAYER                                    RAD_ALL.26920 
     &      , TRANS, REFLECT                                                       RAD_ALL.26921 
     &      , S_DOWN, S_UP                                                         RAD_ALL.26922 
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                              RAD_ALL.26923 
     &      , FLUX_DIRECT(1, N_LAYER), FLUX_INC_DOWN                               RAD_ALL.26924 
     &      , SOURCE_GROUND                                                        RAD_ALL.26925 
     &      , A3, B                                                                RAD_ALL.26926 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.26927 
     &      )                                                                      RAD_ALL.26928 
         N_EQUATION=N_LAYER+1                                                      RAD_ALL.26929 
!                                                                                  RAD_ALL.26930 
!        SOLVE THE EQUATIONS WORKING UPWARD IN THE ELIMINATIVE PHASE.              RAD_ALL.26931 
         CALL TRIDIAG_SOLVER_UP(N_PROFILE, N_EQUATION                              RAD_ALL.26932 
     &      , A3, B                                                                RAD_ALL.26933 
     &      , FLUX_TOTAL                                                           RAD_ALL.26934 
     &      , NPD_PROFILE, 2*NPD_LAYER+2                                           RAD_ALL.26935 
     &      , WORK_1, WORK_2                                                       RAD_ALL.26936 
     &      )                                                                      RAD_ALL.26937 
      ELSE IF ( (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_FULL).OR.                           RAD_ALL.26938 
     &          (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_PRECOND) ) THEN                     RAD_ALL.26939 
         CALL SET_MATRIX_FULL(N_PROFILE, N_LAYER                                   RAD_ALL.26940 
     &      , TRANS, REFLECT                                                       RAD_ALL.26941 
     &      , S_DOWN, S_UP                                                         RAD_ALL.26942 
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                              RAD_ALL.26943 
     &      , FLUX_DIRECT(1, N_LAYER), FLUX_INC_DOWN                               RAD_ALL.26944 
     &      , SOURCE_GROUND                                                        RAD_ALL.26945 
     &      , A3, B                                                                RAD_ALL.26946 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.26947 
     &      )                                                                      RAD_ALL.26948 
         IF (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_PRECOND) THEN                           RAD_ALL.26949 
!           THE MATRIX IS PRECONDITIONED TO LIMIT THE REFLECTION                   RAD_ALL.26950 
!           COEFFICIENTS CLOSE TO 0.                                               RAD_ALL.26951 
            CALL PRECONDITIONER_CLEAR(N_PROFILE, N_LAYER                           RAD_ALL.26952 
     &         , A3, B                                                             RAD_ALL.26953 
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.26954 
     &         )                                                                   RAD_ALL.26955 
         ENDIF                                                                     RAD_ALL.26956 
!                                                                                  RAD_ALL.26957 
         N_EQUATION=2*N_LAYER+2                                                    RAD_ALL.26958 
!                                                                                  RAD_ALL.26959 
!        SOLVE THE EQUATIONS WORKING UPWARD IN THE ELIMINATIVE PHASE.              RAD_ALL.26960 
         CALL TRIDIAG_SOLVER_UP(N_PROFILE, N_EQUATION                              RAD_ALL.26961 
     &      , A3, B                                                                RAD_ALL.26962 
     &      , FLUX_TOTAL                                                           RAD_ALL.26963 
     &      , NPD_PROFILE, 2*NPD_LAYER+2                                           RAD_ALL.26964 
     &      , WORK_1, WORK_2                                                       RAD_ALL.26965 
     &      )                                                                      RAD_ALL.26966 
!                                                                                  RAD_ALL.26967 
      ELSE IF (I_SOLVER.EQ.IP_SOLVER_PENTADIAGONAL) THEN                           RAD_ALL.26968 
         CALL SET_MATRIX_PENTADIAGONAL(N_PROFILE, N_LAYER                          RAD_ALL.26969 
     &      , TRANS, REFLECT                                                       RAD_ALL.26970 
     &      , S_DOWN, S_UP                                                         RAD_ALL.26971 
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                              RAD_ALL.26972 
     &      , FLUX_DIRECT(1, N_LAYER), FLUX_INC_DOWN                               RAD_ALL.26973 
     &      , SOURCE_GROUND                                                        RAD_ALL.26974 
     &      , A5, B                                                                RAD_ALL.26975 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.26976 
     &      )                                                                      RAD_ALL.26977 
         N_EQUATION=2*N_LAYER+2                                                    RAD_ALL.26978 
!                                                                                  RAD_ALL.26979 
         CALL BAND_SOLVER(N_PROFILE, N_EQUATION                                    RAD_ALL.26980 
     &      , 2, 2                                                                 RAD_ALL.26981 
     &      , A5, B                                                                RAD_ALL.26982 
     &      , FLUX_TOTAL                                                           RAD_ALL.26983 
     &      , NPD_PROFILE, 2*NPD_LAYER+2                                           RAD_ALL.26984 
     &      , WORK_1                                                               RAD_ALL.26985 
     &      )                                                                      RAD_ALL.26986 
!                                                                                  RAD_ALL.26987 
      ELSE IF (I_SOLVER.EQ.IP_SOLVER_HOMOGEN_DIRECT) THEN                          RAD_ALL.26988 
!                                                                                  RAD_ALL.26989 
         CALL SOLVER_HOMOGEN_DIRECT(N_PROFILE, N_LAYER                             RAD_ALL.26990 
     &      , TRANS, REFLECT                                                       RAD_ALL.26991 
     &      , S_DOWN, S_UP                                                         RAD_ALL.26992 
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                              RAD_ALL.26993 
     &      , FLUX_DIRECT(1, N_LAYER), FLUX_INC_DOWN                               RAD_ALL.26994 
     &      , SOURCE_GROUND                                                        RAD_ALL.26995 
     &      , FLUX_TOTAL                                                           RAD_ALL.26996 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.26997 
     &      )                                                                      RAD_ALL.26998 
!                                                                                  RAD_ALL.26999 
      ELSE                                                                         RAD_ALL.27000 
!                                                                                  RAD_ALL.27001 
         WRITE(IU_ERR, '(/A)')                                                     RAD_ALL.27002 
     &      '***ERROR: THE SOLVER AND CLOUD SCHEME ARE NOT COMPATIBLE.'            RAD_ALL.27003 
         IERR=I_ERR_FATAL                                                          RAD_ALL.27004 
         RETURN                                                                    RAD_ALL.27005 
!                                                                                  RAD_ALL.27006 
      ENDIF                                                                        RAD_ALL.27007 
!                                                                                  RAD_ALL.27008 
!                                                                                  RAD_ALL.27009 
!                                                                                  RAD_ALL.27010 
      IF (L_CLEAR) THEN                                                            RAD_ALL.27011 
!        THE CLEAR FLUXES HERE CAN BE COPIED DIRECTLY WITHOUT                      RAD_ALL.27012 
!        ANY FURTHER CALCULATION.                                                  RAD_ALL.27013 
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.27014 
            DO I=0, N_LAYER                                                        RAD_ALL.27015 
               DO L=1, N_PROFILE                                                   RAD_ALL.27016 
                  FLUX_DIRECT_CLEAR(L, I)=FLUX_DIRECT(L, I)                        RAD_ALL.27017 
               ENDDO                                                               RAD_ALL.27018 
            ENDDO                                                                  RAD_ALL.27019 
         ENDIF                                                                     RAD_ALL.27020 
         IF (L_NET) THEN                                                           RAD_ALL.27021 
            DO I=1, N_LAYER+1                                                      RAD_ALL.27022 
               DO L=1, N_PROFILE                                                   RAD_ALL.27023 
                  FLUX_TOTAL_CLEAR(L, I)=FLUX_TOTAL(L, I)                          RAD_ALL.27024 
               ENDDO                                                               RAD_ALL.27025 
            ENDDO                                                                  RAD_ALL.27026 
         ELSE                                                                      RAD_ALL.27027 
            DO I=1, 2*N_LAYER+2                                                    RAD_ALL.27028 
               DO L=1, N_PROFILE                                                   RAD_ALL.27029 
                  FLUX_TOTAL_CLEAR(L, I)=FLUX_TOTAL(L, I)                          RAD_ALL.27030 
               ENDDO                                                               RAD_ALL.27031 
            ENDDO                                                                  RAD_ALL.27032 
         ENDIF                                                                     RAD_ALL.27033 
      ENDIF                                                                        RAD_ALL.27034 
!                                                                                  RAD_ALL.27035 
!                                                                                  RAD_ALL.27036 
!                                                                                  RAD_ALL.27037 
      RETURN                                                                       RAD_ALL.27038 
      END 
