C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.8538  
C                                                                                  RAD_ALL.8539  
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.8540  
C restrictions as set forth in the contract.                                       RAD_ALL.8541  
C                                                                                  RAD_ALL.8542  
C                Meteorological Office                                             RAD_ALL.8543  
C                London Road                                                       RAD_ALL.8544  
C                BRACKNELL                                                         RAD_ALL.8545  
C                Berkshire UK                                                      RAD_ALL.8546  
C                RG12 2SZ                                                          RAD_ALL.8547  
C                                                                                  RAD_ALL.8548  
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.8549  
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.8550  
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.8551  
C Modelling at the above address.                                                  RAD_ALL.8552  
C ******************************COPYRIGHT******************************            RAD_ALL.8553  
C                                                                                  RAD_ALL.8554  
!+ Subroutine to calculate fluxes using Gaussian quadrature.                       RAD_ALL.8555  
!                                                                                  RAD_ALL.8556  
! Method:                                                                          RAD_ALL.8557  
!       Fluxes are calculated by using Gaussian quadrature for                     RAD_ALL.8558  
!       the angular integration. This is not a full implementation                 RAD_ALL.8559  
!       of Gaussian quadrature for multiple scattering, but is                     RAD_ALL.8560  
!       intended only for non-scattering calculations in the                       RAD_ALL.8561  
!       infra-red. In this case, the fluxes can be calculated as                   RAD_ALL.8562  
!       a weighted sum of two-stream fluxes where the diffusivity                  RAD_ALL.8563  
!       factors for the two-stream approximations are determined                   RAD_ALL.8564  
!       from the Gaussian points.                                                  RAD_ALL.8565  
!                                                                                  RAD_ALL.8566  
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.8567  
!                                                                                  RAD_ALL.8568  
! History:                                                                         RAD_ALL.8569  
!       Version         Date                    Comment                            RAD_ALL.8570  
!       4.0             27-07-95                Original Code                      RAD_ALL.8571  
!                                               (J. M. Edwards)                    RAD_ALL.8572  
!                                                                                  RAD_ALL.8573  
! Description of Code:                                                             RAD_ALL.8574  
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.8575  
!                                                                                  RAD_ALL.8576  
!- ---------------------------------------------------------------------           RAD_ALL.8577  
      SUBROUTINE GAUSS_ANGLE(N_PROFILE, N_LAYER, L_NET, N_AUGMENT                  RAD_ALL.8578  
     &   , N_ORDER_GAUSS                                                           RAD_ALL.8579  
     &   , TAU                                                                     RAD_ALL.8580  
     &   , FLUX_INC_DOWN                                                           RAD_ALL.8581  
     &   , DIFF_PLANCK, SOURCE_GROUND, ALBEDO_SURFACE_DIFF                         RAD_ALL.8582  
     &   , FLUX_DIFFUSE                                                            RAD_ALL.8583  
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_2                                         RAD_ALL.8584  
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.8585  
     &   )                                                                         RAD_ALL.8586  
!                                                                                  RAD_ALL.8587  
!                                                                                  RAD_ALL.8588  
      IMPLICIT NONE                                                                RAD_ALL.8589  
!                                                                                  RAD_ALL.8590  
!                                                                                  RAD_ALL.8591  
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.8592  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.8593  
     &     NPD_PROFILE                                                             RAD_ALL.8594  
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.8595  
     &   , NPD_LAYER                                                               RAD_ALL.8596  
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.8597  
!                                                                                  RAD_ALL.8598  
!     INCLUDE COMDECKS.                                                            RAD_ALL.8599  
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           GSSWTP3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       GSSWTP3A.3     
!                                                                                  GSSWTP3A.4     
!     MODULE DEFINING ARRAYS OF GAUSSIAN POINTS AND WEIGHTS.                       GSSWTP3A.5     
!                                                                                  GSSWTP3A.6     
      INTEGER                                                                      GSSWTP3A.7     
     &     NPD_GAUSS_ORD                                                           GSSWTP3A.8     
!             MAX. ORDER OF GAUSSIAN QUADRATURE                                    GSSWTP3A.9     
!                                                                                  GSSWTP3A.10    
      PARAMETER(                                                                   GSSWTP3A.11    
     &     NPD_GAUSS_ORD=10                                                        GSSWTP3A.12    
     &   )                                                                         GSSWTP3A.13    
      REAL                                                                         GSSWTP3A.14    
     &     GAUSS_POINT(NPD_GAUSS_ORD, NPD_GAUSS_ORD)                               GSSWTP3A.15    
!             POINTS OF GAUSSIAN INTEGRATION                                       GSSWTP3A.16    
     &   , GAUSS_WEIGHT(NPD_GAUSS_ORD, NPD_GAUSS_ORD)                              GSSWTP3A.17    
!             WEIGHTS OF GAUSSIAN INTEGRATION                                      GSSWTP3A.18    
!                                                                                  GSSWTP3A.19    
!     ------------------------------------------------------------------           GSSWTP3A.20    
C*L------------------COMDECK C_PI---------------------------------------           C_PI.2     
CLL                                                                                C_PI.3     
CLL 4.0 19/09/95  New value for PI. Old value incorrect                            C_PI.4     
CLL               from 12th decimal place. D. Robinson                             C_PI.5     
CLL                                                                                C_PI.6     
      REAL PI,PI_OVER_180,RECIP_PI_OVER_180                                        C_PI.7     
                                                                                   C_PI.8     
      PARAMETER(                                                                   C_PI.9     
     & PI=3.14159265358979323846, ! Pi                                             C_PI.10    
     & PI_OVER_180 =PI/180.0,   ! Conversion factor degrees to radians             C_PI.11    
     & RECIP_PI_OVER_180 = 180.0/PI ! Conversion factor radians to                 C_PI.12    
     &                              ! degrees                                      C_PI.13    
     & )                                                                           C_PI.14    
C*----------------------------------------------------------------------           C_PI.15    
                                                                                   C_PI.16    
!                                                                                  RAD_ALL.8603  
!     DUMMY VARIABLES.                                                             RAD_ALL.8604  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.8605  
     &     N_PROFILE                                                               RAD_ALL.8606  
!             NUMBER OF PROFILES                                                   RAD_ALL.8607  
     &   , N_LAYER                                                                 RAD_ALL.8608  
!             NUMBER OF LAYERS                                                     RAD_ALL.8609  
     &   , N_AUGMENT                                                               RAD_ALL.8610  
!             SIZE OF ARRAY TO INCREMENT                                           RAD_ALL.8611  
     &   , N_ORDER_GAUSS                                                           RAD_ALL.8612  
!             ORDER OF GAUSSIAN INTEGRATION                                        RAD_ALL.8613  
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.8614  
     &     L_NET                                                                   RAD_ALL.8615  
!             NET FLUXES REQUIRED                                                  RAD_ALL.8616  
     &   , L_IR_SOURCE_QUAD                                                        RAD_ALL.8617  
!             USE QUADRATIC SOURCE TERM                                            RAD_ALL.8618  
      REAL      !, INTENT(IN)                                                      RAD_ALL.8619  
     &     TAU(NPD_PROFILE, NPD_LAYER)                                             RAD_ALL.8620  
!             OPTICAL DEPTH                                                        RAD_ALL.8621  
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.8622  
!             DIFFUSE ALBEDO                                                       RAD_ALL.8623  
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.8624  
!             INCIDENT TOTAL FLUX                                                  RAD_ALL.8625  
     &   , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.8626  
!             DIFFERENCE IN PI*PLANCK FUNCTION                                     RAD_ALL.8627  
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.8628  
!             GROUND SOURCE FUNCTION                                               RAD_ALL.8629  
     &   , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER)                                   RAD_ALL.8630  
!             2x2ND DIFFERENCES OF PLANCKIAN                                       RAD_ALL.8631  
      REAL      !, INTENT(OUT)                                                     RAD_ALL.8632  
     &     FLUX_DIFFUSE(NPD_PROFILE, 2*NPD_LAYER+2)                                RAD_ALL.8633  
!             DIFFUSE FLUXES                                                       RAD_ALL.8634  
!                                                                                  RAD_ALL.8635  
!     LOCAL VARIABALES.                                                            RAD_ALL.8636  
      INTEGER                                                                      RAD_ALL.8637  
     &     I                                                                       RAD_ALL.8638  
!             LOOP VARIABLE                                                        RAD_ALL.8639  
     &   , L                                                                       RAD_ALL.8640  
!             LOOP VARIABLE                                                        RAD_ALL.8641  
     &   , K                                                                       RAD_ALL.8642  
!             LOOP VARIABLE                                                        RAD_ALL.8643  
      REAL                                                                         RAD_ALL.8644  
     &     FLUX_STREAM(NPD_PROFILE, 2*NPD_LAYER+2)                                 RAD_ALL.8645  
!             FLUX IN STREAM                                                       RAD_ALL.8646  
     &   , FLUX_NULL(NPD_PROFILE, 2*NPD_LAYER+2)                                   RAD_ALL.8647  
!             ARRAY OF NULL FLUXES                                                 RAD_ALL.8648  
     &   , SECANT_RAY                                                              RAD_ALL.8649  
!             SECANT OF ANGLE WITH VERTICAL                                        RAD_ALL.8650  
     &   , DIFF_PLANCK_RAD(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.8651  
!             DIFFERENCE IN PI*PLANCK FUNCTION                                     RAD_ALL.8652  
     &   , DIFF_PLANCK_RAD_2(NPD_PROFILE, NPD_LAYER)                               RAD_ALL.8653  
!             2x2ND DIFFERENCES OF PLANCKIAN                                       RAD_ALL.8654  
     &   , SOURCE_GROUND_RAD(NPD_PROFILE)                                          RAD_ALL.8655  
!             GROUND SOURCE FUNCTION                                               RAD_ALL.8656  
     &   , RADIANCE_INC(NPD_PROFILE)                                               RAD_ALL.8657  
!             INCIDNET RADIANCE                                                    RAD_ALL.8658  
     &   , WEIGHT_STREAM                                                           RAD_ALL.8659  
!             WEIGHTING FOR STREAM                                                 RAD_ALL.8660  
!                                                                                  RAD_ALL.8661  
!     SET THE GAUSSIAN WEIGHTS FOR INTEGRATION.                                    RAD_ALL.8662  
!     ------------------------------------------------------------------           GSSWTD3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       GSSWTD3A.3     
!                                                                                  GSSWTD3A.4     
!     MODULE SETTING GAUSSIAN POINTS AND WEIGHTS: ONLY EVEN                        GSSWTD3A.5     
!     ORDERS ARE USED AT PRESENT.                                                  GSSWTD3A.6     
!                                                                                  GSSWTD3A.7     
!     FIRST ORDER:                                                                 GSSWTD3A.8     
      DATA GAUSS_POINT(1,1)/0.00000000000000E+00/                                  GSSWTD3A.9     
      DATA GAUSS_WEIGHT(1,1)/2.00000000000000E+00/                                 GSSWTD3A.10    
!                                                                                  GSSWTD3A.11    
!     SECOND ORDER:                                                                GSSWTD3A.12    
      DATA GAUSS_POINT(1,2)/-5.77350269189626E-01/                                 GSSWTD3A.13    
      DATA GAUSS_POINT(2,2)/5.77350269189626E-01/                                  GSSWTD3A.14    
      DATA GAUSS_WEIGHT(1,2)/1.00000000000000E+00/                                 GSSWTD3A.15    
      DATA GAUSS_WEIGHT(2,2)/1.00000000000000E+00/                                 GSSWTD3A.16    
!                                                                                  GSSWTD3A.17    
!     THIRD ORDER:                                                                 GSSWTD3A.18    
      DATA GAUSS_POINT(1,3)/-7.74596669241484E-01/                                 GSSWTD3A.19    
      DATA GAUSS_POINT(2,3)/0.00000000000000E+00/                                  GSSWTD3A.20    
      DATA GAUSS_POINT(3,3)/7.74596669241484E-01/                                  GSSWTD3A.21    
      DATA GAUSS_WEIGHT(1,3)/5.55555555555556E-01/                                 GSSWTD3A.22    
      DATA GAUSS_WEIGHT(2,3)/8.88888888888889E-01/                                 GSSWTD3A.23    
      DATA GAUSS_WEIGHT(3,3)/5.55555555555556E-01/                                 GSSWTD3A.24    
!                                                                                  GSSWTD3A.25    
!     FOURTH ORDER:                                                                GSSWTD3A.26    
      DATA GAUSS_POINT(1,4)/-8.61136311594053E-01/                                 GSSWTD3A.27    
      DATA GAUSS_POINT(2,4)/-3.39981043584856E-01/                                 GSSWTD3A.28    
      DATA GAUSS_POINT(3,4)/3.39981043584856E-01/                                  GSSWTD3A.29    
      DATA GAUSS_POINT(4,4)/8.61136311594053E-01/                                  GSSWTD3A.30    
      DATA GAUSS_WEIGHT(1,4)/3.47854845137454E-01/                                 GSSWTD3A.31    
      DATA GAUSS_WEIGHT(2,4)/6.52145154862546E-01/                                 GSSWTD3A.32    
      DATA GAUSS_WEIGHT(3,4)/6.52145154862546E-01/                                 GSSWTD3A.33    
      DATA GAUSS_WEIGHT(4,4)/3.47854845137454E-01/                                 GSSWTD3A.34    
!                                                                                  GSSWTD3A.35    
!     FIFTH ORDER:                                                                 GSSWTD3A.36    
      DATA GAUSS_POINT(1,5)/-9.06179845938664E-01/                                 GSSWTD3A.37    
      DATA GAUSS_POINT(2,5)/-5.38469310105683E-01/                                 GSSWTD3A.38    
      DATA GAUSS_POINT(3,5)/0.00000000000000E+00/                                  GSSWTD3A.39    
      DATA GAUSS_POINT(4,5)/5.38469310105683E-01/                                  GSSWTD3A.40    
      DATA GAUSS_POINT(5,5)/9.06179845938664E-01/                                  GSSWTD3A.41    
      DATA GAUSS_WEIGHT(1,5)/2.36926885056189E-01/                                 GSSWTD3A.42    
      DATA GAUSS_WEIGHT(2,5)/4.78628670499366E-01/                                 GSSWTD3A.43    
      DATA GAUSS_WEIGHT(3,5)/4.67913934572691E-01/                                 GSSWTD3A.44    
      DATA GAUSS_WEIGHT(4,5)/4.78628670499366E-01/                                 GSSWTD3A.45    
      DATA GAUSS_WEIGHT(5,5)/2.36926885056189E-01/                                 GSSWTD3A.46    
!                                                                                  GSSWTD3A.47    
!     SIXTH ORDER:                                                                 GSSWTD3A.48    
      DATA GAUSS_POINT(1,6)/-9.32469514203152E-01/                                 GSSWTD3A.49    
      DATA GAUSS_POINT(2,6)/-6.61209386466265E-01/                                 GSSWTD3A.50    
      DATA GAUSS_POINT(3,6)/-2.38619186083197E-01/                                 GSSWTD3A.51    
      DATA GAUSS_POINT(4,6)/2.38619186083197E-01/                                  GSSWTD3A.52    
      DATA GAUSS_POINT(5,6)/6.61209386466265E-01/                                  GSSWTD3A.53    
      DATA GAUSS_POINT(6,6)/9.32469514203152E-01/                                  GSSWTD3A.54    
      DATA GAUSS_WEIGHT(1,6)/1.71324492379170E-01/                                 GSSWTD3A.55    
      DATA GAUSS_WEIGHT(2,6)/3.60761573048139E-01/                                 GSSWTD3A.56    
      DATA GAUSS_WEIGHT(3,6)/4.67913934572691E-01/                                 GSSWTD3A.57    
      DATA GAUSS_WEIGHT(4,6)/4.67913934572691E-01/                                 GSSWTD3A.58    
      DATA GAUSS_WEIGHT(5,6)/3.60761573048139E-01/                                 GSSWTD3A.59    
      DATA GAUSS_WEIGHT(6,6)/1.71324492379170E-01/                                 GSSWTD3A.60    
!                                                                                  GSSWTD3A.61    
!     SEVENTH ORDER:                                                               GSSWTD3A.62    
      DATA GAUSS_POINT(1,7)/-9.49107912342759E-01/                                 GSSWTD3A.63    
      DATA GAUSS_POINT(2,7)/-7.41531185599394E-01/                                 GSSWTD3A.64    
      DATA GAUSS_POINT(3,7)/-4.05845151377397E-01/                                 GSSWTD3A.65    
      DATA GAUSS_POINT(4,7)/0.00000000000000E+00/                                  GSSWTD3A.66    
      DATA GAUSS_POINT(5,7)/4.05845151377397E-01/                                  GSSWTD3A.67    
      DATA GAUSS_POINT(6,7)/7.41531185599394E-01/                                  GSSWTD3A.68    
      DATA GAUSS_POINT(7,7)/9.49107912342759E-01/                                  GSSWTD3A.69    
      DATA GAUSS_WEIGHT(1,7)/1.29484966168870E-01/                                 GSSWTD3A.70    
      DATA GAUSS_WEIGHT(2,7)/2.79705391489277E-01/                                 GSSWTD3A.71    
      DATA GAUSS_WEIGHT(3,7)/3.81830050505119E-01/                                 GSSWTD3A.72    
      DATA GAUSS_WEIGHT(4,7)/4.17959183673469E-01/                                 GSSWTD3A.73    
      DATA GAUSS_WEIGHT(5,7)/3.81830050505119E-01/                                 GSSWTD3A.74    
      DATA GAUSS_WEIGHT(6,7)/2.79705391489277E-01/                                 GSSWTD3A.75    
      DATA GAUSS_WEIGHT(7,7)/1.29484966168870E-01/                                 GSSWTD3A.76    
!                                                                                  GSSWTD3A.77    
!     EIGHTH ORDER:                                                                GSSWTD3A.78    
      DATA GAUSS_POINT(1,8)/-9.60289856497536E-01/                                 GSSWTD3A.79    
      DATA GAUSS_POINT(2,8)/-7.96666477413627E-01/                                 GSSWTD3A.80    
      DATA GAUSS_POINT(3,8)/-5.25532409916329E-01/                                 GSSWTD3A.81    
      DATA GAUSS_POINT(4,8)/-1.83434642495650E-01/                                 GSSWTD3A.82    
      DATA GAUSS_POINT(5,8)/1.83434642495650E-01/                                  GSSWTD3A.83    
      DATA GAUSS_POINT(6,8)/5.25532409916329E-01/                                  GSSWTD3A.84    
      DATA GAUSS_POINT(7,8)/7.96666477413627E-01/                                  GSSWTD3A.85    
      DATA GAUSS_POINT(8,8)/9.60289856497536E-01/                                  GSSWTD3A.86    
      DATA GAUSS_WEIGHT(1,8)/1.01228536290376E-01/                                 GSSWTD3A.87    
      DATA GAUSS_WEIGHT(2,8)/2.22381034453374E-01/                                 GSSWTD3A.88    
      DATA GAUSS_WEIGHT(3,8)/3.13706645877887E-01/                                 GSSWTD3A.89    
      DATA GAUSS_WEIGHT(4,8)/3.62683783378362E-01/                                 GSSWTD3A.90    
      DATA GAUSS_WEIGHT(5,8)/3.62683783378362E-01/                                 GSSWTD3A.91    
      DATA GAUSS_WEIGHT(6,8)/3.13706645877887E-01/                                 GSSWTD3A.92    
      DATA GAUSS_WEIGHT(7,8)/2.22381034453374E-01/                                 GSSWTD3A.93    
      DATA GAUSS_WEIGHT(8,8)/1.01228536290376E-01/                                 GSSWTD3A.94    
!                                                                                  GSSWTD3A.95    
!     NINTH ORDER:                                                                 GSSWTD3A.96    
      DATA GAUSS_POINT(1,9)/-9.68160239507626E-01/                                 GSSWTD3A.97    
      DATA GAUSS_POINT(2,9)/-8.36031107326636E-01/                                 GSSWTD3A.98    
      DATA GAUSS_POINT(3,9)/-6.13371432700590E-01/                                 GSSWTD3A.99    
      DATA GAUSS_POINT(4,9)/-3.24253423403809E-01/                                 GSSWTD3A.100   
      DATA GAUSS_POINT(5,9)/0.00000000000000E+00/                                  GSSWTD3A.101   
      DATA GAUSS_POINT(6,9)/3.24253423403809E-01/                                  GSSWTD3A.102   
      DATA GAUSS_POINT(7,9)/6.13371432700590E-01/                                  GSSWTD3A.103   
      DATA GAUSS_POINT(8,9)/8.36031107326636E-01/                                  GSSWTD3A.104   
      DATA GAUSS_POINT(9,9)/9.68160239507626E-01/                                  GSSWTD3A.105   
      DATA GAUSS_WEIGHT(1,9)/8.1274388361574E-02/                                  GSSWTD3A.106   
      DATA GAUSS_WEIGHT(2,9)/1.80648160694857E-01/                                 GSSWTD3A.107   
      DATA GAUSS_WEIGHT(3,9)/2.60610696402935E-01/                                 GSSWTD3A.108   
      DATA GAUSS_WEIGHT(4,9)/3.12347077040003E-01/                                 GSSWTD3A.109   
      DATA GAUSS_WEIGHT(5,9)/3.30239355001260E-01/                                 GSSWTD3A.110   
      DATA GAUSS_WEIGHT(6,9)/3.12347077040003E-01/                                 GSSWTD3A.111   
      DATA GAUSS_WEIGHT(7,9)/2.60610696402935E-01/                                 GSSWTD3A.112   
      DATA GAUSS_WEIGHT(8,9)/1.80648160694857E-01/                                 GSSWTD3A.113   
      DATA GAUSS_WEIGHT(9,9)/8.1274388361574E-02/                                  GSSWTD3A.114   
!                                                                                  GSSWTD3A.115   
!     TENTH ORDER:                                                                 GSSWTD3A.116   
      DATA GAUSS_POINT(1,10)/-9.73906528517172E-01/                                GSSWTD3A.117   
      DATA GAUSS_POINT(2,10)/-8.65063366688985E-01/                                GSSWTD3A.118   
      DATA GAUSS_POINT(3,10)/-6.79409568299024E-01/                                GSSWTD3A.119   
      DATA GAUSS_POINT(4,10)/-4.33395394129427E-01/                                GSSWTD3A.120   
      DATA GAUSS_POINT(5,10)/-1.48874338981631E-01/                                GSSWTD3A.121   
      DATA GAUSS_POINT(6,10)/1.48874338981631E-01/                                 GSSWTD3A.122   
      DATA GAUSS_POINT(7,10)/4.33395394129427E-01/                                 GSSWTD3A.123   
      DATA GAUSS_POINT(8,10)/6.79409568299024E-01/                                 GSSWTD3A.124   
      DATA GAUSS_POINT(9,10)/8.65063366688985E-01/                                 GSSWTD3A.125   
      DATA GAUSS_POINT(10,10)/9.73906528517172E-01/                                GSSWTD3A.126   
      DATA GAUSS_WEIGHT(1,10)/6.6671344308688E-02/                                 GSSWTD3A.127   
      DATA GAUSS_WEIGHT(2,10)/1.49451349150581E-01/                                GSSWTD3A.128   
      DATA GAUSS_WEIGHT(3,10)/2.19086362515982E-01/                                GSSWTD3A.129   
      DATA GAUSS_WEIGHT(4,10)/2.69266719309996E-01/                                GSSWTD3A.130   
      DATA GAUSS_WEIGHT(5,10)/2.95524224714753E-01/                                GSSWTD3A.131   
      DATA GAUSS_WEIGHT(6,10)/2.95524224714753E-01/                                GSSWTD3A.132   
      DATA GAUSS_WEIGHT(7,10)/2.69266719309996E-01/                                GSSWTD3A.133   
      DATA GAUSS_WEIGHT(8,10)/2.19086362515982E-01/                                GSSWTD3A.134   
      DATA GAUSS_WEIGHT(9,10)/1.49451349150581E-01/                                GSSWTD3A.135   
      DATA GAUSS_WEIGHT(10,10)/6.6671344308688E-02/                                GSSWTD3A.136   
!                                                                                  GSSWTD3A.137   
!     ------------------------------------------------------------------           GSSWTD3A.138   
                                                                                   GSSWTD3A.139   
!                                                                                  RAD_ALL.8664  
!     SUBROUTINES CALLED:                                                          RAD_ALL.8665  
      EXTERNAL                                                                     RAD_ALL.8666  
     &     MONOCHROMATIC_IR_RADIANCE, AUGMENT_FLUX                                 RAD_ALL.8667  
!                                                                                  RAD_ALL.8668  
!                                                                                  RAD_ALL.8669  
!                                                                                  RAD_ALL.8670  
!     SET THE SOURCE FUNCTION.                                                     RAD_ALL.8671  
      DO L=1, N_PROFILE                                                            RAD_ALL.8672  
         SOURCE_GROUND_RAD(L)=SOURCE_GROUND(L)/PI                                  RAD_ALL.8673  
         RADIANCE_INC(L)=FLUX_INC_DOWN(L)/PI                                       RAD_ALL.8674  
      ENDDO                                                                        RAD_ALL.8675  
      DO I=1, N_LAYER                                                              RAD_ALL.8676  
         DO L=1, N_PROFILE                                                         RAD_ALL.8677  
            DIFF_PLANCK_RAD(L, I)=DIFF_PLANCK(L, I)/PI                             RAD_ALL.8678  
         ENDDO                                                                     RAD_ALL.8679  
      ENDDO                                                                        RAD_ALL.8680  
      DO I=1, 2*N_LAYER+2                                                          RAD_ALL.8681  
         DO L=1, N_PROFILE                                                         RAD_ALL.8682  
            FLUX_DIFFUSE(L, I)=0.0                                                 RAD_ALL.8683  
         ENDDO                                                                     RAD_ALL.8684  
      ENDDO                                                                        RAD_ALL.8685  
      IF (L_IR_SOURCE_QUAD) THEN                                                   RAD_ALL.8686  
         DO I=1, N_LAYER                                                           RAD_ALL.8687  
            DO L=1, N_PROFILE                                                      RAD_ALL.8688  
               DIFF_PLANCK_RAD_2(L, I)=DIFF_PLANCK_2(L, I)/PI                      RAD_ALL.8689  
            ENDDO                                                                  RAD_ALL.8690  
         ENDDO                                                                     RAD_ALL.8691  
      ENDIF                                                                        RAD_ALL.8692  
!                                                                                  RAD_ALL.8693  
!     CALCULATE THE FLUXES WITH A NUMBER OF DIFFUSIVITY FACTORS                    RAD_ALL.8694  
!     AND SUM THE RESULTS.                                                         RAD_ALL.8695  
      DO K=1, N_ORDER_GAUSS                                                        RAD_ALL.8696  
         SECANT_RAY=2.0E+00/(GAUSS_POINT(K, N_ORDER_GAUSS)+1.0E+00)                RAD_ALL.8697  
!                                                                                  RAD_ALL.8698  
!        CALCULATE THE RADIANCE AT THIS ANGLE.                                     RAD_ALL.8699  
            CALL MONOCHROMATIC_IR_RADIANCE(N_PROFILE, N_LAYER                      RAD_ALL.8700  
     &         , L_NET                                                             RAD_ALL.8701  
     &         , TAU                                                               RAD_ALL.8702  
     &         , RADIANCE_INC                                                      RAD_ALL.8703  
     &         , DIFF_PLANCK_RAD, SOURCE_GROUND_RAD, ALBEDO_SURFACE_DIFF           RAD_ALL.8704  
     &         , SECANT_RAY                                                        RAD_ALL.8705  
     &         , FLUX_STREAM                                                       RAD_ALL.8706  
     &         , NPD_PROFILE, NPD_LAYER                                            RAD_ALL.8707  
     &         )                                                                   RAD_ALL.8708  
!                                                                                  RAD_ALL.8709  
!        AUGMENT THE FLUX BY THE AMOUNT IN THIS STREAM.                            RAD_ALL.8710  
         WEIGHT_STREAM=5.0E-01*PI*GAUSS_WEIGHT(K, N_ORDER_GAUSS)                   RAD_ALL.8711  
     &      *(GAUSS_POINT(K, N_ORDER_GAUSS)+1.0E+00)                               RAD_ALL.8712  
         CALL AUGMENT_FLUX(N_PROFILE, N_LAYER, N_AUGMENT                           RAD_ALL.8713  
     &      , IP_INFRA_RED, .FALSE.                                                RAD_ALL.8714  
     &      , WEIGHT_STREAM                                                        RAD_ALL.8715  
     &      , FLUX_NULL, FLUX_DIFFUSE                                              RAD_ALL.8716  
     &      , FLUX_NULL, FLUX_STREAM                                               RAD_ALL.8717  
     &      , FLUX_NULL, FLUX_NULL                                                 RAD_ALL.8718  
     &      , FLUX_NULL, FLUX_NULL                                                 RAD_ALL.8719  
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.8720  
     &      )                                                                      RAD_ALL.8721  
!                                                                                  RAD_ALL.8722  
      ENDDO                                                                        RAD_ALL.8723  
!                                                                                  RAD_ALL.8724  
!                                                                                  RAD_ALL.8725  
      RETURN                                                                       RAD_ALL.8726  
      END 
