C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.962   
C                                                                                  RAD_ALL.963   
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.964   
C restrictions as set forth in the contract.                                       RAD_ALL.965   
C                                                                                  RAD_ALL.966   
C                Meteorological Office                                             RAD_ALL.967   
C                London Road                                                       RAD_ALL.968   
C                BRACKNELL                                                         RAD_ALL.969   
C                Berkshire UK                                                      RAD_ALL.970   
C                RG12 2SZ                                                          RAD_ALL.971   
C                                                                                  RAD_ALL.972   
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.973   
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.974   
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.975   
C Modelling at the above address.                                                  RAD_ALL.976   
C ******************************COPYRIGHT******************************            RAD_ALL.977   
C                                                                                  RAD_ALL.978   
!+ Subroutine to calculate cloudy fluxes by division into columns.                 RAD_ALL.979   
!                                                                                  RAD_ALL.980   
! Method:                                                                          RAD_ALL.981   
!       A number of atmospheric profiles are taken and split into                  RAD_ALL.982   
!       columns in which each layer is homogeneous. The areal                      RAD_ALL.983   
!       coverages of these columns has been calculated before. The                 RAD_ALL.984   
!       sub-columns are passed into a long vector to be passed to a                RAD_ALL.985   
!       multicolumn solver.                                                        RAD_ALL.986   
!                                                                                  RAD_ALL.987   
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.988   
!                                                                                  RAD_ALL.989   
! History:                                                                         RAD_ALL.990   
!       Version         Date                    Comment                            RAD_ALL.991   
!       4.0             27-07-95                Original Code                      RAD_ALL.992   
!                                               (J. M. Edwards)                    RAD_ALL.993   
!       4.1             10-06-96                New solvers added.                 RAD_ALL.994   
!                                               (J. M. Edwards)                    RAD_ALL.995   
!       4.4             19-09-97                Addressing for long                RAD_ALL.996   
!                                               rows corrected and                 RAD_ALL.997   
!                                               missing intialization              RAD_ALL.998   
!                                               added.                             RAD_ALL.999   
!                                               (J. M. Edwards)                    RAD_ALL.1000  
!                                                                                  RAD_ALL.1001  
! Description of Code:                                                             RAD_ALL.1002  
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.1003  
!                                                                                  RAD_ALL.1004  
!- ---------------------------------------------------------------------           RAD_ALL.1005  
      SUBROUTINE CLOUD_COLUMN(IERR                                                 RAD_ALL.1006  
!                       Atmospheric Properties                                     RAD_ALL.1007  
     &   , N_PROFILE, N_LAYER                                                      RAD_ALL.1008  
!                       Two-stream Scheme                                          RAD_ALL.1009  
     &   , I_2STREAM                                                               RAD_ALL.1010  
!                       Corrections to Two-stream Equations                        RAD_ALL.1011  
     &   , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION                      RAD_ALL.1012  
!                       Options for Solver                                         RAD_ALL.1013  
     &   , I_SOLVER, N_AUGMENT                                                     RAD_ALL.1014  
!                       Options for Equivalent Extinction                          RAD_ALL.1015  
     &   , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                          RAD_ALL.1016  
!                       Spectral Region                                            RAD_ALL.1017  
     &   , ISOLIR                                                                  RAD_ALL.1018  
!                       Infra-red Properties                                       RAD_ALL.1019  
     &   , DIFF_PLANCK                                                             RAD_ALL.1020  
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                         RAD_ALL.1021  
!                       Conditions at TOA                                          RAD_ALL.1022  
     &   , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0                                   RAD_ALL.1023  
!                       Conditions at Surface                                      RAD_ALL.1024  
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND                  RAD_ALL.1025  
!                       Clear-sky Single Scattering Properties                     RAD_ALL.1026  
     &   , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE                                    RAD_ALL.1027  
!                       Cloud Geometry                                             RAD_ALL.1028  
     &   , N_CLOUD_TOP                                                             RAD_ALL.1029  
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                                RAD_ALL.1030  
     &   , N_COLUMN, L_COLUMN, AREA_COLUMN                                         RAD_ALL.1031  
!                       Cloudy Optical Properties                                  RAD_ALL.1032  
     &   , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD                                 RAD_ALL.1033  
!                       Fluxes Calculated                                          RAD_ALL.1034  
     &   , FLUX_DIRECT, FLUX_TOTAL                                                 RAD_ALL.1035  
!                       Flags for Clear-sky Calculations                           RAD_ALL.1036  
     &   , L_CLEAR, I_SOLVER_CLEAR                                                 RAD_ALL.1037  
!                       Clear-sky Fluxes Calculated                                RAD_ALL.1038  
     &   , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                                     RAD_ALL.1039  
!                       Dimensions of Arrays                                       RAD_ALL.1040  
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                                      RAD_ALL.1041  
     &   )                                                                         RAD_ALL.1042  
!                                                                                  RAD_ALL.1043  
!                                                                                  RAD_ALL.1044  
      IMPLICIT NONE                                                                RAD_ALL.1045  
!                                                                                  RAD_ALL.1046  
!                                                                                  RAD_ALL.1047  
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.1048  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1049  
     &     NPD_PROFILE                                                             RAD_ALL.1050  
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.1051  
     &   , NPD_LAYER                                                               RAD_ALL.1052  
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.1053  
     &   , NPD_COLUMN                                                              RAD_ALL.1054  
!             NUMBER OF COLUMNS PER POINT                                          RAD_ALL.1055  
!                                                                                  RAD_ALL.1056  
!     INCLUDE COMDECKS                                                             RAD_ALL.1057  
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           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    
!                                                                                  RAD_ALL.1063  
!                                                                                  RAD_ALL.1064  
!     DUMMY ARGUMENTS.                                                             RAD_ALL.1065  
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.1066  
     &     IERR                                                                    RAD_ALL.1067  
!             ERROR FLAG                                                           RAD_ALL.1068  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1069  
     &     N_PROFILE                                                               RAD_ALL.1070  
!             NUMBER OF PROFILES                                                   RAD_ALL.1071  
     &   , N_LAYER                                                                 RAD_ALL.1072  
!             NUMBER OF LAYERS                                                     RAD_ALL.1073  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1074  
     &     ISOLIR                                                                  RAD_ALL.1075  
!             SPECTRAL REGION                                                      RAD_ALL.1076  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1077  
     &     I_2STREAM                                                               RAD_ALL.1078  
!             TWO STREAM SCHEME                                                    RAD_ALL.1079  
     &   , I_SOLVER                                                                RAD_ALL.1080  
!             SOLVER FOR TWO-STREAM EQUATIONS                                      RAD_ALL.1081  
     &   , N_AUGMENT                                                               RAD_ALL.1082  
!             LENGTH OF LONG VECTOR                                                RAD_ALL.1083  
     &   , I_SOLVER_CLEAR                                                          RAD_ALL.1084  
!             SOLVER FOR CLEAR FLUXES                                              RAD_ALL.1085  
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.1086  
     &     L_CLEAR                                                                 RAD_ALL.1087  
!             CALCULATE CLEAR-SKY FLUXES                                           RAD_ALL.1088  
     &   , L_SCALE_SOLAR                                                           RAD_ALL.1089  
!             SCALE SOLAR BEAM                                                     RAD_ALL.1090  
     &   , L_IR_SOURCE_QUAD                                                        RAD_ALL.1091  
!             USE A QUADRATIC SOURCE TERM                                          RAD_ALL.1092  
     &   , L_2_STREAM_CORRECT                                                      RAD_ALL.1093  
!             EDGE CORRECTION TO 2-STREAM                                          RAD_ALL.1094  
!                                                                                  RAD_ALL.1095  
!     FIELDS FOR EQUIVALENT EXTINCTION                                             RAD_ALL.1096  
      REAL  !, INTENT(IN)                                                          RAD_ALL.1097  
     &     ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.1098  
!             ADJUSTMENT OF SOLAR BEAM WITH EQUIVALENT EXTINCTION                  RAD_ALL.1099  
!                                                                                  RAD_ALL.1100  
!     CLEAR-SKY OPTICAL PROPETIES                                                  RAD_ALL.1101  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1102  
     &     TAU_FREE(NPD_PROFILE, NPD_LAYER)                                        RAD_ALL.1103  
!             FREE OPTICAL DEPTH                                                   RAD_ALL.1104  
     &   , OMEGA_FREE(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.1105  
!             FREE ALBEDO OF SINGLE SCATTERING                                     RAD_ALL.1106  
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.1107  
!             FREE FRACTIONAL FORWARD SCATTER                                      RAD_ALL.1108  
!                                                                                  RAD_ALL.1109  
!     CLOUDY OPTICAL PROPETIES                                                     RAD_ALL.1110  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1111  
     &     TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                       RAD_ALL.1112  
!             OPTICAL DEPTH IN CLOUD                                               RAD_ALL.1113  
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                 RAD_ALL.1114  
!             CLOUDY FRACTIONAL FORWARD SCATTER                                    RAD_ALL.1115  
     &   , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                     RAD_ALL.1116  
!             ALBEDO OF SINGLE SCATTERING IN CLOUD                                 RAD_ALL.1117  
!                                                                                  RAD_ALL.1118  
!     PLANCKIAN TERMS:                                                             RAD_ALL.1119  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1120  
     &     DIFF_PLANCK(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.1121  
!             CHANGE IN PLANCK FUNCTION                                            RAD_ALL.1122  
     &   , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER)                                   RAD_ALL.1123  
!             TWICE 2ND DIFFERENCES IN PLANCKIAN                                   RAD_ALL.1124  
     &   , PLANCK_SOURCE(NPD_PROFILE, 0: NPD_LAYER)                                RAD_ALL.1125  
!             PLANCKIAN SOURCE FUNCTION                                            RAD_ALL.1126  
!                                                                                  RAD_ALL.1127  
!     CONDITIONS AT TOA                                                            RAD_ALL.1128  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1129  
     &     SEC_0(NPD_PROFILE)                                                      RAD_ALL.1130  
!             SECANT OF ZENITH ANGLE                                               RAD_ALL.1131  
     &   , FLUX_INC_DIRECT(NPD_PROFILE)                                            RAD_ALL.1132  
!             INCIDENT DIRECT FLUX                                                 RAD_ALL.1133  
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.1134  
!             INCIDENT TOTAL FLUX                                                  RAD_ALL.1135  
!                                                                                  RAD_ALL.1136  
!     CONDITIONS AT SURFACE                                                        RAD_ALL.1137  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1138  
     &     ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.1139  
!             DIFFUSE ALBEDO OF GROUND                                             RAD_ALL.1140  
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.1141  
!             DIRECT ALBEDO OF GROUND                                              RAD_ALL.1142  
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.1143  
!             SOURCE FUNCTION OF GROUND                                            RAD_ALL.1144  
!                                                                                  RAD_ALL.1145  
!     CLOUD GEOMETRY                                                               RAD_ALL.1146  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.1147  
     &     N_CLOUD_TOP                                                             RAD_ALL.1148  
!             TOP CLOUDY LAYER                                                     RAD_ALL.1149  
     &   , N_CLOUD_TYPE                                                            RAD_ALL.1150  
!             NUMBER OF TYPES OF CLOUDS                                            RAD_ALL.1151  
     &   , N_COLUMN(NPD_PROFILE)                                                   RAD_ALL.1152  
!             NUMBER OF COLUMNS                                                    RAD_ALL.1153  
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.1154  
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)                            RAD_ALL.1155  
!             TYPE FLAG FOR EACH LAYER/COLUMN                                      RAD_ALL.1156  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1157  
     &     FRAC_CLOUD(NPD_PROFILE, NPD_COLUMN, NPD_CLOUD_TYPE)                     RAD_ALL.1158  
!             AREA OF EACH COLUMN                                                  RAD_ALL.1159  
     &   , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)                                    RAD_ALL.1160  
!             AREA OF EACH COLUMN                                                  RAD_ALL.1161  
!                                                                                  RAD_ALL.1162  
      REAL      !, INTENT(IN)                                                      RAD_ALL.1163  
     &     GROUND_EMISSION(NPD_PROFILE)                                            RAD_ALL.1164  
!             TOTAL FLUX EMITTED FROM GROUND                                       RAD_ALL.1165  
!                                                                                  RAD_ALL.1166  
!     FLUXES CALCULATED:                                                           RAD_ALL.1167  
      REAL      !, INTENT(OUT)                                                     RAD_ALL.1168  
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)                                  RAD_ALL.1169  
!             DIRECT FLUX                                                          RAD_ALL.1170  
     &   , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)                                  RAD_ALL.1171  
!             TOTAL FLUX                                                           RAD_ALL.1172  
     &   , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)                            RAD_ALL.1173  
!             CLEAR DIRECT FLUX                                                    RAD_ALL.1174  
     &   , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)                            RAD_ALL.1175  
!             CLEAR TOTAL FLUX                                                     RAD_ALL.1176  
!                                                                                  RAD_ALL.1177  
!                                                                                  RAD_ALL.1178  
!                                                                                  RAD_ALL.1179  
!     LOCAL VARIABLES.                                                             RAD_ALL.1180  
      INTEGER                                                                      RAD_ALL.1181  
     &     N_SOURCE_COEFF                                                          RAD_ALL.1182  
!             NUMBER OF SOURCE COEFFICIENTS                                        RAD_ALL.1183  
     &   , N_EQUATION                                                              RAD_ALL.1184  
!             NUMBER OF EQUATIONS SOLVED                                           RAD_ALL.1185  
     &   , I                                                                       RAD_ALL.1186  
!             LOOP VARIABLE                                                        RAD_ALL.1187  
     &   , J                                                                       RAD_ALL.1188  
!             LOOP VARIABLE                                                        RAD_ALL.1189  
     &   , JS                                                                      RAD_ALL.1190  
!             LOOP VARIABLE                                                        RAD_ALL.1191  
     &   , L                                                                       RAD_ALL.1192  
!             LOOP VARIABLE                                                        RAD_ALL.1193  
     &   , K                                                                       RAD_ALL.1194  
!             LOOP VARIABLE                                                        RAD_ALL.1195  
      INTEGER                                                                      RAD_ALL.1196  
     &     N_LONG                                                                  RAD_ALL.1197  
!             LENGTH OF LONG VECTOR                                                RAD_ALL.1198  
     &   , N_PROFILE_SOLVED                                                        RAD_ALL.1199  
!             NUMBER OF PROFILES SOLVED AT ONCE                                    RAD_ALL.1200  
     &   , N_COLUMN_DONE                                                           RAD_ALL.1201  
!             NUMBER OF COLUMNS ALREADY ASSIGNED                                   RAD_ALL.1202  
     &   , OFFSET                                                                  RAD_ALL.1203  
!             OFFSET IN LIST OF PROFILES                                           RAD_ALL.1204  
     &   , I_PROFILE                                                               RAD_ALL.1205  
!             PROFILE BEING CONSIDERED                                             RAD_ALL.1206  
!                                                                                  RAD_ALL.1207  
      REAL                                                                         RAD_ALL.1208  
     &     SOURCE_COEFF_FREE(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)             RAD_ALL.1209  
!             FREE SOURCE COEFFICIENTS                                             RAD_ALL.1210  
     &   , TRANS_FREE(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.1211  
!             FREE DIFFUSE TRANSMISSION                                            RAD_ALL.1212  
     &   , TRANS_0_FREE(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.1213  
!             FREE DIRECT TRANSMISSION                                             RAD_ALL.1214  
     &   , REFLECT_FREE(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.1215  
!             FREE REFLECTANCE                                                     RAD_ALL.1216  
     &   , S_DOWN_FREE(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.1217  
!             FREE DOWNWARD SOURCE                                                 RAD_ALL.1218  
     &   , S_UP_FREE(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.1219  
!             FREE UPWARD SOURCE                                                   RAD_ALL.1220  
!                                                                                  RAD_ALL.1221  
      REAL                                                                         RAD_ALL.1222  
     &     SOURCE_COEFF_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)            RAD_ALL.1223  
!             CLOUDY TWO-STREAM SOURCE COEFFICIENTS                                RAD_ALL.1224  
     &   , TRANS_CLOUD(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.1225  
!             CLOUDY DIFFUSE TRANSMISSION                                          RAD_ALL.1226  
     &   , REFLECT_CLOUD(NPD_PROFILE, NPD_LAYER)                                   RAD_ALL.1227  
!             CLOUDY REFLECTANCE                                                   RAD_ALL.1228  
     &   , TRANS_0_CLOUD(NPD_PROFILE, NPD_LAYER)                                   RAD_ALL.1229  
!             CLOUDY DIRECT TRANSMISSION                                           RAD_ALL.1230  
     &   , S_DOWN_CLOUD(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.1231  
!             CLOUDY DOWNWARD SOURCE                                               RAD_ALL.1232  
     &   , S_UP_CLOUD(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.1233  
!             CLOUDY UPWARD SOURCE                                                 RAD_ALL.1234  
!                                                                                  RAD_ALL.1235  
      REAL                                                                         RAD_ALL.1236  
     &     FLUX_LONG(NPD_PROFILE, 2*NPD_LAYER+2)                                   RAD_ALL.1237  
!             DIFFUSE FLUXES IN COLUMNS                                            RAD_ALL.1238  
     &   , FLUX_DIRECT_LONG(NPD_PROFILE, 0: NPD_LAYER)                             RAD_ALL.1239  
!             DIRECT FLUXES IN COLUMNS                                             RAD_ALL.1240  
!                                                                                  RAD_ALL.1241  
      REAL                                                                         RAD_ALL.1242  
     &     SOURCE_GROUND_LONG(NPD_PROFILE)                                         RAD_ALL.1243  
!             SOURCE FUNCTION OF GROUND IN COL.                                    RAD_ALL.1244  
     &   , FLUX_INC_DIRECT_LONG(NPD_PROFILE)                                       RAD_ALL.1245  
!             DIRECT FLUX INCIDENT ON COLUMN                                       RAD_ALL.1246  
     &   , FLUX_INC_DOWN_LONG(NPD_PROFILE)                                         RAD_ALL.1247  
!             DIRECT FLUX INCIDENT ON COLUMN                                       RAD_ALL.1248  
     &   , ALBEDO_SURFACE_DIFF_LONG(NPD_PROFILE)                                   RAD_ALL.1249  
!             DIFFUSE ALBEDO OF GROUND                                             RAD_ALL.1250  
     &   , ALBEDO_SURFACE_DIR_LONG(NPD_PROFILE)                                    RAD_ALL.1251  
!             DIRECT ALBEDO OF GROUND                                              RAD_ALL.1252  
     &   , TRANS_LONG(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.1253  
!             TRANSMISSION IN LONG ARRAY                                           RAD_ALL.1254  
     &   , REFLECT_LONG(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.1255  
!             REFLECTION IN LONG ARRAY                                             RAD_ALL.1256  
     &   , TRANS_0_LONG(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.1257  
!             SOLAR COEFFICIENT IN LONG ARRAY                                      RAD_ALL.1258  
     &   , SOURCE_COEFF_LONG(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)             RAD_ALL.1259  
!             SOURCE COEFFICIENTS IN LONG ARRAY                                    RAD_ALL.1260  
     &   , S_UP_LONG(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.1261  
!             UPWARD SOURCE FUNCTION                                               RAD_ALL.1262  
     &   , S_DOWN_LONG(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.1263  
!             DOWNWARD SOURCE FUNCTION                                             RAD_ALL.1264  
     &   , SCALE_SOLAR_LONG(NPD_PROFILE, NPD_LAYER)                                RAD_ALL.1265  
!             LONG VECTOR OF SOLAR SCALINGS                                        RAD_ALL.1266  
     &   , WORK_1(NPD_PROFILE, 2*NPD_LAYER+2)                                      RAD_ALL.1267  
!             WORK ARRAY                                                           RAD_ALL.1268  
     &   , WORK_2(NPD_PROFILE, 2*NPD_LAYER+2)                                      RAD_ALL.1269  
!             WORK ARRAY                                                           RAD_ALL.1270  
!                                                                                  RAD_ALL.1271  
      REAL                                                                         RAD_ALL.1272  
     &     A3(NPD_PROFILE, 3, 2*NPD_LAYER+2)                                       RAD_ALL.1273  
!             TRIDIAGONAL MATRIX                                                   RAD_ALL.1274  
     &   , A5(NPD_PROFILE, 5, 2*NPD_LAYER+2)                                       RAD_ALL.1275  
!             PENTADIAGONAL MATRIX                                                 RAD_ALL.1276  
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                           RAD_ALL.1277  
!             RIGHT-HAND SIDES OF EQUATIONS                                        RAD_ALL.1278  
!                                                                                  RAD_ALL.1279  
!                                                                                  RAD_ALL.1280  
!     FUNCTIONS CALLED:                                                            RAD_ALL.1281  
      INTEGER                                                                      RAD_ALL.1282  
     &     SET_N_SOURCE_COEFF                                                      RAD_ALL.1283  
!             FUNCTION TO SET NUMBER OF SOURCE COEFFICIENTS                        RAD_ALL.1284  
!                                                                                  RAD_ALL.1285  
!     SUBROUTINES CALLED:                                                          RAD_ALL.1286  
      EXTERNAL                                                                     RAD_ALL.1287  
     &     TWO_COEFF, TWO_COEFF_CLOUD, IR_SOURCE, SOLAR_SOURCE                     RAD_ALL.1288  
     &   , SET_MATRIX_NET, TRIDIAG_SOLVER_UP, SET_MATRIX_FULL                      RAD_ALL.1289  
     &   , SET_MATRIX_PENTADIAGONAL, BAND_SOLVER                                   RAD_ALL.1290  
     &   , SOLVER_HOMOGEN_DIRECT, CLEAR_SUPPLEMENT                                 RAD_ALL.1291  
!                                                                                  RAD_ALL.1292  
!                                                                                  RAD_ALL.1293  
!                                                                                  RAD_ALL.1294  
!                                                                                  RAD_ALL.1295  
!     ENTER A SUMMING LOOP TO CALCULATE THE TOTAL FLUX BY ADDING UP                RAD_ALL.1296  
!     THE FLOW OF ENERGY IN EACH COLUMN.                                           RAD_ALL.1297  
!                                                                                  RAD_ALL.1298  
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                                 RAD_ALL.1299  
         DO I=0, N_LAYER                                                           RAD_ALL.1300  
            DO L=1, N_PROFILE                                                      RAD_ALL.1301  
               FLUX_DIRECT(L, I)=0.0E+00                                           RAD_ALL.1302  
            ENDDO                                                                  RAD_ALL.1303  
         ENDDO                                                                     RAD_ALL.1304  
      ENDIF                                                                        RAD_ALL.1305  
      DO I=1, N_AUGMENT                                                            RAD_ALL.1306  
         DO L=1, N_PROFILE                                                         RAD_ALL.1307  
            FLUX_TOTAL(L, I)=0.0E+00                                               RAD_ALL.1308  
         ENDDO                                                                     RAD_ALL.1309  
      ENDDO                                                                        RAD_ALL.1310  
!                                                                                  RAD_ALL.1311  
!     SET THE NUMBER OF SOURCE COEFFICIENTS FOR THE APPROXIMATION                  RAD_ALL.1312  
      N_SOURCE_COEFF=SET_N_SOURCE_COEFF(ISOLIR, L_IR_SOURCE_QUAD)                  RAD_ALL.1313  
!                                                                                  RAD_ALL.1314  
!     THE FUNDAMENTAL PARAMETERS OF THE TWO-STREAM EQUATIONS CAN BE                RAD_ALL.1315  
!     PRECALCULATED.                                                               RAD_ALL.1316  
      CALL TWO_COEFF(IERR                                                          RAD_ALL.1317  
     &   , N_PROFILE, 1, N_LAYER                                                   RAD_ALL.1318  
     &   , I_2STREAM, L_IR_SOURCE_QUAD                                             RAD_ALL.1319  
     &   , ASYMMETRY_FREE, OMEGA_FREE, TAU_FREE                                    RAD_ALL.1320  
     &   , ISOLIR, SEC_0                                                           RAD_ALL.1321  
     &   , TRANS_FREE, REFLECT_FREE, TRANS_0_FREE                                  RAD_ALL.1322  
     &   , SOURCE_COEFF_FREE                                                       RAD_ALL.1323  
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.1324  
     &   )                                                                         RAD_ALL.1325  
      IF (IERR.NE.I_NORMAL) RETURN                                                 RAD_ALL.1326  
!                                                                                  RAD_ALL.1327  
      CALL TWO_COEFF_CLOUD(IERR                                                    RAD_ALL.1328  
     &   , N_PROFILE, N_CLOUD_TOP, N_LAYER                                         RAD_ALL.1329  
     &   , I_2STREAM, L_IR_SOURCE_QUAD, N_SOURCE_COEFF                             RAD_ALL.1330  
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                                RAD_ALL.1331  
     &   , ASYMMETRY_CLOUD, OMEGA_CLOUD, TAU_CLOUD                                 RAD_ALL.1332  
     &   , ISOLIR, SEC_0                                                           RAD_ALL.1333  
     &   , TRANS_CLOUD, REFLECT_CLOUD, TRANS_0_CLOUD                               RAD_ALL.1334  
     &   , SOURCE_COEFF_CLOUD                                                      RAD_ALL.1335  
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.1336  
     &   )                                                                         RAD_ALL.1337  
      IF (IERR.NE.I_NORMAL) RETURN                                                 RAD_ALL.1338  
!                                                                                  RAD_ALL.1339  
!                                                                                  RAD_ALL.1340  
!     THE INFRA-RED SOURCE FUNCTIONS DEPEND ONLY ON THE LAYER IN WHICH             RAD_ALL.1341  
!     THEY ARE EVALUATED AND, UNLIKE THE VISIBLE SOURCE FUNCTIONS, THEY            RAD_ALL.1342  
!     MAY BE PRECALCULATED.                                                        RAD_ALL.1343  
      IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                             RAD_ALL.1344  
         CALL IR_SOURCE(N_PROFILE, 1, N_LAYER                                      RAD_ALL.1345  
     &      , SOURCE_COEFF_FREE, DIFF_PLANCK                                       RAD_ALL.1346  
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                      RAD_ALL.1347  
     &      , L_2_STREAM_CORRECT, PLANCK_SOURCE                                    RAD_ALL.1348  
     &      , GROUND_EMISSION, N_LAYER                                             RAD_ALL.1349  
     &      , TAU_FREE, TRANS_FREE                                                 RAD_ALL.1350  
     &      , S_DOWN_FREE, S_UP_FREE                                               RAD_ALL.1351  
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.1352  
     &      )                                                                      RAD_ALL.1353  
         CALL IR_SOURCE(N_PROFILE, N_CLOUD_TOP, N_LAYER                            RAD_ALL.1354  
     &      , SOURCE_COEFF_CLOUD, DIFF_PLANCK                                      RAD_ALL.1355  
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                      RAD_ALL.1356  
     &      , L_2_STREAM_CORRECT, PLANCK_SOURCE                                    RAD_ALL.1357  
     &      , GROUND_EMISSION, N_LAYER                                             RAD_ALL.1358  
     &      , TAU_CLOUD, TRANS_CLOUD                                               RAD_ALL.1359  
     &      , S_DOWN_CLOUD, S_UP_CLOUD                                             RAD_ALL.1360  
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.1361  
     &      )                                                                      RAD_ALL.1362  
      ENDIF                                                                        RAD_ALL.1363  
                                                                                   RAD_ALL.1364  
c         print*, 'trans_cloud->' , trans_cloud,'<-trans_cloud'                    RAD_ALL.1365  
                                                                                   RAD_ALL.1366  
c         print*, 'trans_free->' , trans_free,'<-trans_free'                       RAD_ALL.1367  
                                                                                   RAD_ALL.1368  
c         print*, 'tau_cloud->' , tau_cloud,'<-tau_cloud'                          RAD_ALL.1369  
                                                                                   RAD_ALL.1370  
c         print*, 'tau_free->' , tau_free,'<-tau_free'                             RAD_ALL.1371  
c         print*, '<<--top'                                                        RAD_ALL.1372  
!                                                                                  RAD_ALL.1373  
!                                                                                  RAD_ALL.1374  
!     THE MAIN LOOP: PROFILES ARE ADDED ON TO THE LONG ARRAY UNTIL                 RAD_ALL.1375  
!     IT IS NO LONGER POSSIBLE TO SOLVE FOR THEM ALL IN ONE GO.                    RAD_ALL.1376  
      OFFSET=0                                                                     RAD_ALL.1377  
      N_LONG=0                                                                     RAD_ALL.1378  
      I_PROFILE=1                                                                  RAD_ALL.1379  
!                                                                                  RAD_ALL.1380  
10       IF (N_LONG+N_COLUMN(I_PROFILE).LE.NPD_PROFILE) THEN                       RAD_ALL.1381  
!           CONTINUE FEEDING PROFILES INTO THE LONG ARRAY:                         RAD_ALL.1382  
!                                                                                  RAD_ALL.1383  
            DO J=1, N_COLUMN(I_PROFILE)                                            RAD_ALL.1384  
!                                                                                  RAD_ALL.1385  
!              ASSIGN THE OPTICAL PROPERTIES TO EACH LAYER WITHIN THE              RAD_ALL.1386  
!              COLUMN. J IS THE INDEX OF COLUMNS AT A GRID-POINT:                  RAD_ALL.1387  
!              K INDEXES POINTS IN THE LONG VECTOR.                                RAD_ALL.1388  
               K=N_LONG+J                                                          RAD_ALL.1389  
!                                                                                  RAD_ALL.1390  
               DO I=1, N_LAYER                                                     RAD_ALL.1391  
                  IF (L_COLUMN(I_PROFILE, I, J)) THEN                              RAD_ALL.1392  
!                    THE LAYER IS CLOUDY.                                          RAD_ALL.1393  
                     TRANS_LONG(K, I)=TRANS_CLOUD(I_PROFILE, I)                    RAD_ALL.1394  
                     REFLECT_LONG(K, I)=REFLECT_CLOUD(I_PROFILE, I)                RAD_ALL.1395  
                  ELSE                                                             RAD_ALL.1396  
!                    THE LAYER IS FREE OF CLOUD.                                   RAD_ALL.1397  
                     TRANS_LONG(K, I)=TRANS_FREE(I_PROFILE, I)                     RAD_ALL.1398  
                     REFLECT_LONG(K, I)=REFLECT_FREE(I_PROFILE, I)                 RAD_ALL.1399  
                  ENDIF                                                            RAD_ALL.1400  
               ENDDO                                                               RAD_ALL.1401  
               IF (ISOLIR.EQ.IP_SOLAR) THEN                                        RAD_ALL.1402  
                  FLUX_INC_DIRECT_LONG(K)=FLUX_INC_DIRECT(I_PROFILE)               RAD_ALL.1403  
                  SOURCE_GROUND_LONG(K)=0.0E+00                                    RAD_ALL.1404  
                  DO I=1, N_LAYER                                                  RAD_ALL.1405  
                     IF (L_COLUMN(I_PROFILE, I, J)) THEN                           RAD_ALL.1406  
                        TRANS_0_LONG(K, I)                                         RAD_ALL.1407  
     &                     =TRANS_0_CLOUD(I_PROFILE, I)                            RAD_ALL.1408  
                        DO JS=1, N_SOURCE_COEFF                                    RAD_ALL.1409  
                           SOURCE_COEFF_LONG(K, I, JS)                             RAD_ALL.1410  
     &                        =SOURCE_COEFF_CLOUD(I_PROFILE, I, JS)                RAD_ALL.1411  
                        ENDDO                                                      RAD_ALL.1412  
                     ELSE                                                          RAD_ALL.1413  
                        TRANS_0_LONG(K, I)=TRANS_0_FREE(I_PROFILE, I)              RAD_ALL.1414  
                        DO JS=1, N_SOURCE_COEFF                                    RAD_ALL.1415  
                           SOURCE_COEFF_LONG(K, I, JS)                             RAD_ALL.1416  
     &                        =SOURCE_COEFF_FREE(I_PROFILE, I, JS)                 RAD_ALL.1417  
                        ENDDO                                                      RAD_ALL.1418  
                     ENDIF                                                         RAD_ALL.1419  
                  ENDDO                                                            RAD_ALL.1420  
                  IF (L_SCALE_SOLAR) THEN                                          RAD_ALL.1421  
                     DO I=1, N_LAYER                                               RAD_ALL.1422  
                        SCALE_SOLAR_LONG(K, I)                                     RAD_ALL.1423  
     &                     =ADJUST_SOLAR_KE(I_PROFILE, I)                          RAD_ALL.1424  
                     ENDDO                                                         RAD_ALL.1425  
                  ENDIF                                                            RAD_ALL.1426  
               ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                               RAD_ALL.1427  
                  DO I=1, N_LAYER                                                  RAD_ALL.1428  
                     IF (L_COLUMN(I_PROFILE, I, J)) THEN                           RAD_ALL.1429  
                        S_UP_LONG(K, I)=S_UP_CLOUD(I_PROFILE, I)                   RAD_ALL.1430  
                        S_DOWN_LONG(K, I)=S_DOWN_CLOUD(I_PROFILE, I)               RAD_ALL.1431  
                     ELSE                                                          RAD_ALL.1432  
                        S_DOWN_LONG(K, I)=S_DOWN_FREE(I_PROFILE, I)                RAD_ALL.1433  
                        S_UP_LONG(K, I)=S_UP_FREE(I_PROFILE, I)                    RAD_ALL.1434  
                     ENDIF                                                         RAD_ALL.1435  
                  ENDDO                                                            RAD_ALL.1436  
                  SOURCE_GROUND_LONG(K)=SOURCE_GROUND(I_PROFILE)                   RAD_ALL.1437  
               ENDIF                                                               RAD_ALL.1438  
               FLUX_INC_DOWN_LONG(K)=FLUX_INC_DOWN(I_PROFILE)                      RAD_ALL.1439  
               ALBEDO_SURFACE_DIFF_LONG(K)                                         RAD_ALL.1440  
     &            =ALBEDO_SURFACE_DIFF(I_PROFILE)                                  RAD_ALL.1441  
               ALBEDO_SURFACE_DIR_LONG(K)                                          RAD_ALL.1442  
     &            =ALBEDO_SURFACE_DIR(I_PROFILE)                                   RAD_ALL.1443  
            ENDDO                                                                  RAD_ALL.1444  
!                                                                                  RAD_ALL.1445  
            N_LONG=N_LONG+N_COLUMN(I_PROFILE)                                      RAD_ALL.1446  
!                                                                                  RAD_ALL.1447  
!           INCREMENT I_PROFILE AND RETURN TO SEE IF ANOTHER PROFILE               RAD_ALL.1448  
!           MAY BE ADDED.                                                          RAD_ALL.1449  
            IF (I_PROFILE.LT.N_PROFILE) THEN                                       RAD_ALL.1450  
               I_PROFILE=I_PROFILE+1                                               RAD_ALL.1451  
               GOTO 10                                                             RAD_ALL.1452  
            ENDIF                                                                  RAD_ALL.1453  
!                                                                                  RAD_ALL.1454  
         ELSE IF (N_COLUMN(I_PROFILE).GT.NPD_PROFILE) THEN                         RAD_ALL.1455  
            WRITE(IU_ERR, '(/A, I5, A, /A)')                                       RAD_ALL.1456  
     &         '*** ERROR: PROFILE ', I_PROFILE                                    RAD_ALL.1457  
     &         , ' CONTAINS TOO MANY COLUMNS.'                                     RAD_ALL.1458  
     &         , 'INCREASE NPD_PROFILE AND RECOMPILE.'                             RAD_ALL.1459  
         ELSE                                                                      RAD_ALL.1460  
!           IF NO MORE PROFILES CAN BE ADDED THE EQUATIONS ARE SOLVED.             RAD_ALL.1461  
!           RESET THE POINTER TO POINT TO THE LAST PROFILE CONSIDERED.             RAD_ALL.1462  
            I_PROFILE=I_PROFILE-1                                                  RAD_ALL.1463  
         ENDIF                                                                     RAD_ALL.1464  
!                                                                                  RAD_ALL.1465  
         N_PROFILE_SOLVED=I_PROFILE-OFFSET                                         RAD_ALL.1466  
!                                                                                  RAD_ALL.1467  
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.1468  
            CALL SOLAR_SOURCE(N_LONG, N_LAYER                                      RAD_ALL.1469  
     &         , FLUX_INC_DIRECT_LONG                                              RAD_ALL.1470  
     &         , TRANS_0_LONG, SOURCE_COEFF_LONG                                   RAD_ALL.1471  
     &         , L_SCALE_SOLAR, SCALE_SOLAR_LONG                                   RAD_ALL.1472  
     &         , FLUX_DIRECT_LONG                                                  RAD_ALL.1473  
     &         , S_DOWN_LONG, S_UP_LONG                                            RAD_ALL.1474  
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.1475  
     &         )                                                                   RAD_ALL.1476  
         ELSE                                                                      RAD_ALL.1477  
!           SET THE DIRECT FLUX AT THE GROUND FOR USE IN THE SOLVER.               RAD_ALL.1478  
            DO K=1, N_LONG                                                         RAD_ALL.1479  
               FLUX_DIRECT_LONG(K, N_LAYER)=0.0E+00                                RAD_ALL.1480  
            ENDDO                                                                  RAD_ALL.1481  
         ENDIF                                                                     RAD_ALL.1482  
!                                                                                  RAD_ALL.1483  
                                                                                   RAD_ALL.1484  
c         print*, 'before-->>'                                                     RAD_ALL.1485  
c         print*, 'trans_cloud->' , trans_cloud,'<-trans_cloud'                    RAD_ALL.1486  
                                                                                   RAD_ALL.1487  
c         print*, 'trans_free->' , trans_free,'<-trans_free'                       RAD_ALL.1488  
                                                                                   RAD_ALL.1489  
c         print*, 'tau_cloud->' , tau_cloud,'<-tau_cloud'                          RAD_ALL.1490  
                                                                                   RAD_ALL.1491  
c         print*, 'tau_free->' , tau_free,'<-tau_free'                             RAD_ALL.1492  
c         print*, '<<--before'                                                     RAD_ALL.1493  
                                                                                   RAD_ALL.1494  
         IF (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_NET) THEN                               RAD_ALL.1495  
            CALL SET_MATRIX_NET(N_LONG, N_LAYER                                    RAD_ALL.1496  
     &         , TRANS_LONG, REFLECT_LONG                                          RAD_ALL.1497  
     &         , S_DOWN_LONG, S_UP_LONG                                            RAD_ALL.1498  
     &         , ALBEDO_SURFACE_DIFF_LONG, ALBEDO_SURFACE_DIR_LONG                 RAD_ALL.1499  
     &         , FLUX_DIRECT_LONG(1, N_LAYER), FLUX_INC_DOWN_LONG                  RAD_ALL.1500  
     &         , SOURCE_GROUND_LONG                                                RAD_ALL.1501  
     &         , A3, B                                                             RAD_ALL.1502  
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.1503  
     &         )                                                                   RAD_ALL.1504  
!                                                                                  RAD_ALL.1505  
!           SOLVE THE EQUATIONS WORKING UPWARD IN THE ELIMINATIVE PHASE.           RAD_ALL.1506  
            N_EQUATION=N_LAYER+1                                                   RAD_ALL.1507  
            CALL TRIDIAG_SOLVER_UP(N_LONG, N_EQUATION                              RAD_ALL.1508  
     &         , A3, B                                                             RAD_ALL.1509  
     &         , FLUX_LONG                                                         RAD_ALL.1510  
     &         , NPD_PROFILE, 2*NPD_LAYER+2                                        RAD_ALL.1511  
     &         , WORK_1, WORK_2                                                    RAD_ALL.1512  
     &         )                                                                   RAD_ALL.1513  
         ELSE IF (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_FULL) THEN                         RAD_ALL.1514  
            CALL SET_MATRIX_FULL(N_LONG, N_LAYER                                   RAD_ALL.1515  
     &         , TRANS_LONG, REFLECT_LONG                                          RAD_ALL.1516  
     &         , S_DOWN_LONG, S_UP_LONG                                            RAD_ALL.1517  
     &         , ALBEDO_SURFACE_DIFF_LONG, ALBEDO_SURFACE_DIR_LONG                 RAD_ALL.1518  
     &         , FLUX_DIRECT_LONG(1, N_LAYER), FLUX_INC_DOWN_LONG                  RAD_ALL.1519  
     &         , SOURCE_GROUND_LONG                                                RAD_ALL.1520  
     &         , A3, B                                                             RAD_ALL.1521  
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.1522  
     &         )                                                                   RAD_ALL.1523  
!                                                                                  RAD_ALL.1524  
!           SOLVE THE EQUATIONS WORKING UPWARD IN THE ELIMINATIVE PHASE.           RAD_ALL.1525  
            N_EQUATION=2*N_LAYER+2                                                 RAD_ALL.1526  
            CALL TRIDIAG_SOLVER_UP(N_LONG, N_EQUATION                              RAD_ALL.1527  
     &         , A3, B                                                             RAD_ALL.1528  
     &         , FLUX_LONG                                                         RAD_ALL.1529  
     &         , NPD_PROFILE, 2*NPD_LAYER+2                                        RAD_ALL.1530  
     &         , WORK_1, WORK_2                                                    RAD_ALL.1531  
     &         )                                                                   RAD_ALL.1532  
!                                                                                  RAD_ALL.1533  
         ELSE IF (I_SOLVER.EQ.IP_SOLVER_PENTADIAGONAL) THEN                        RAD_ALL.1534  
!                                                                                  RAD_ALL.1535  
                                                                                   RAD_ALL.1536  
            CALL SET_MATRIX_PENTADIAGONAL(N_LONG, N_LAYER                          RAD_ALL.1537  
     &         , TRANS_LONG, REFLECT_LONG                                          RAD_ALL.1538  
     &         , S_DOWN_LONG, S_UP_LONG                                            RAD_ALL.1539  
     &         , ALBEDO_SURFACE_DIFF_LONG, ALBEDO_SURFACE_DIR_LONG                 RAD_ALL.1540  
     &         , FLUX_DIRECT_LONG(1, N_LAYER), FLUX_INC_DOWN_LONG                  RAD_ALL.1541  
     &         , SOURCE_GROUND_LONG                                                RAD_ALL.1542  
     &         , A5, B                                                             RAD_ALL.1543  
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.1544  
     &         )                                                                   RAD_ALL.1545  
            N_EQUATION=2*N_LAYER+2                                                 RAD_ALL.1546  
!                                                                                  RAD_ALL.1547  
            CALL BAND_SOLVER(N_LONG, N_EQUATION                                    RAD_ALL.1548  
     &         , 2, 2                                                              RAD_ALL.1549  
     &         , A5, B                                                             RAD_ALL.1550  
     &         , FLUX_LONG                                                         RAD_ALL.1551  
     &         , NPD_PROFILE, 2*NPD_LAYER+2                                        RAD_ALL.1552  
     &         , WORK_1                                                            RAD_ALL.1553  
     &         )                                                                   RAD_ALL.1554  
!                                                                                  RAD_ALL.1555  
         ELSE IF (I_SOLVER.EQ.IP_SOLVER_HOMOGEN_DIRECT) THEN                       RAD_ALL.1556  
!                                                                                  RAD_ALL.1557  
            CALL SOLVER_HOMOGEN_DIRECT(N_LONG, N_LAYER                             RAD_ALL.1558  
     &         , TRANS_LONG, REFLECT_LONG                                          RAD_ALL.1559  
     &         , S_DOWN_LONG, S_UP_LONG                                            RAD_ALL.1560  
     &         , ALBEDO_SURFACE_DIFF_LONG, ALBEDO_SURFACE_DIR_LONG                 RAD_ALL.1561  
     &         , FLUX_DIRECT_LONG(1, N_LAYER), FLUX_INC_DOWN_LONG                  RAD_ALL.1562  
     &         , SOURCE_GROUND_LONG                                                RAD_ALL.1563  
     &         , FLUX_LONG                                                         RAD_ALL.1564  
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.1565  
     &         )                                                                   RAD_ALL.1566  
!                                                                                  RAD_ALL.1567  
         ELSE                                                                      RAD_ALL.1568  
!                                                                                  RAD_ALL.1569  
            WRITE(IU_ERR, '(/A)')                                                  RAD_ALL.1570  
     &         '*** ERROR: THE SOLVER AND CLOUD SCHEME '                           RAD_ALL.1571  
     &         //'ARE NOT COMPATIBLE.'                                             RAD_ALL.1572  
            IERR=I_ERR_FATAL                                                       RAD_ALL.1573  
            RETURN                                                                 RAD_ALL.1574  
!                                                                                  RAD_ALL.1575  
         ENDIF                                                                     RAD_ALL.1576  
!                                                                                  RAD_ALL.1577  
!                                                                                  RAD_ALL.1578  
!        ADD THE PARTIAL FLUX FOR THE COLUMN ONTO THE CUMULATIVE TOTAL.            RAD_ALL.1579  
!                                                                                  RAD_ALL.1580  
         N_COLUMN_DONE=0                                                           RAD_ALL.1581  
         DO L=OFFSET+1, N_PROFILE_SOLVED+OFFSET                                    RAD_ALL.1582  
            DO J=1, N_COLUMN(L)                                                    RAD_ALL.1583  
               K=J+N_COLUMN_DONE                                                   RAD_ALL.1584  
               IF (ISOLIR.EQ.IP_SOLAR) THEN                                        RAD_ALL.1585  
                  DO I=0, N_LAYER                                                  RAD_ALL.1586  
                     FLUX_DIRECT(L, I)=FLUX_DIRECT(L, I)                           RAD_ALL.1587  
     &                  +FLUX_DIRECT_LONG(K, I)*AREA_COLUMN(L, J)                  RAD_ALL.1588  
                  ENDDO                                                            RAD_ALL.1589  
               ENDIF                                                               RAD_ALL.1590  
               DO I=1, N_AUGMENT                                                   RAD_ALL.1591  
                  FLUX_TOTAL(L, I)=FLUX_TOTAL(L, I)                                RAD_ALL.1592  
     &               +FLUX_LONG(K, I)*AREA_COLUMN(L, J)                            RAD_ALL.1593  
               ENDDO                                                               RAD_ALL.1594  
            ENDDO                                                                  RAD_ALL.1595  
            N_COLUMN_DONE=N_COLUMN_DONE+N_COLUMN(L)                                RAD_ALL.1596  
         ENDDO                                                                     RAD_ALL.1597  
!                                                                                  RAD_ALL.1598  
!        THE OFFSET IS NOW ADVANCED FOR THE NEXT LOOP AND A NEW                    RAD_ALL.1599  
!        LONG VECTOR IS FORMED UNLESS WE HAVE ALREADY SOLVED FOR ALL               RAD_ALL.1600  
!        THE PROFILES.                                                             RAD_ALL.1601  
         OFFSET=OFFSET+N_PROFILE_SOLVED                                            RAD_ALL.1602  
         IF (OFFSET.LT.N_PROFILE) THEN                                             RAD_ALL.1603  
            N_LONG=0                                                               RAD_ALL.1604  
            I_PROFILE=I_PROFILE+1                                                  RAD_ALL.1605  
            GOTO 10                                                                RAD_ALL.1606  
         ENDIF                                                                     RAD_ALL.1607  
!                                                                                  RAD_ALL.1608  
!                                                                                  RAD_ALL.1609  
!                                                                                  RAD_ALL.1610  
      IF (L_CLEAR) THEN                                                            RAD_ALL.1611  
         CALL CLEAR_SUPPLEMENT(IERR, N_PROFILE, N_LAYER, I_SOLVER_CLEAR            RAD_ALL.1612  
     &      , TRANS_FREE, REFLECT_FREE, TRANS_0_FREE, SOURCE_COEFF_FREE            RAD_ALL.1613  
     &      , ISOLIR, FLUX_INC_DIRECT, FLUX_INC_DOWN                               RAD_ALL.1614  
     &      , S_DOWN_FREE, S_UP_FREE                                               RAD_ALL.1615  
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                              RAD_ALL.1616  
     &      , SOURCE_GROUND                                                        RAD_ALL.1617  
     &      , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                       RAD_ALL.1618  
     &      , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR                                  RAD_ALL.1619  
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.1620  
     &      )                                                                      RAD_ALL.1621  
      ENDIF                                                                        RAD_ALL.1622  
!                                                                                  RAD_ALL.1623  
!                                                                                  RAD_ALL.1624  
                                                                                   RAD_ALL.1625  
c         print*, 'end-->>'                                                        RAD_ALL.1626  
c         print*, 'trans_cloud->' , trans_cloud,'<-trans_cloud'                    RAD_ALL.1627  
                                                                                   RAD_ALL.1628  
c        print*, 'trans_free->' , trans_free,'<-trans_free'                        RAD_ALL.1629  
                                                                                   RAD_ALL.1630  
c         print*, 'tau_cloud->' , tau_cloud,'<-tau_cloud'                          RAD_ALL.1631  
                                                                                   RAD_ALL.1632  
c         print*, 'tau_free->' , tau_free,'<-tau_free'                             RAD_ALL.1633  
c         print*, '<<--end'                                                        RAD_ALL.1634  
      RETURN                                                                       RAD_ALL.1635  
      END 
