C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.23112 
C                                                                                  RAD_ALL.23113 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.23114 
C restrictions as set forth in the contract.                                       RAD_ALL.23115 
C                                                                                  RAD_ALL.23116 
C                Meteorological Office                                             RAD_ALL.23117 
C                London Road                                                       RAD_ALL.23118 
C                BRACKNELL                                                         RAD_ALL.23119 
C                Berkshire UK                                                      RAD_ALL.23120 
C                RG12 2SZ                                                          RAD_ALL.23121 
C                                                                                  RAD_ALL.23122 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.23123 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.23124 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.23125 
C Modelling at the above address.                                                  RAD_ALL.23126 
C ******************************COPYRIGHT******************************            RAD_ALL.23127 
C                                                                                  RAD_ALL.23128 
!+ Subroutine to set the matrix equations for the fluxes.                          RAD_ALL.23129 
!                                                                                  RAD_ALL.23130 
! Method:                                                                          RAD_ALL.23131 
!       Straightforward.                                                           RAD_ALL.23132 
!                                                                                  RAD_ALL.23133 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.23134 
!                                                                                  RAD_ALL.23135 
! History:                                                                         RAD_ALL.23136 
!       Version         Date                    Comment                            RAD_ALL.23137 
!       4.0             27-07-95                Original Code                      RAD_ALL.23138 
!                                               (J. M. Edwards)                    RAD_ALL.23139 
!       4.1             05-03-96                Surface albedo and                 RAD_ALL.23140 
!                                               reflection coefficients            RAD_ALL.23141 
!                                               perturbed to avoid                 RAD_ALL.23142 
!                                               failure above a                    RAD_ALL.23143 
!                                               non-reflecting surface             RAD_ALL.23144 
!                                               or in a strongly                   RAD_ALL.23145 
!                                               absorbing atmosphere.              RAD_ALL.23146 
!                                                                                  RAD_ALL.23147 
! Description of Code:                                                             RAD_ALL.23148 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.23149 
!                                                                                  RAD_ALL.23150 
!- ---------------------------------------------------------------------           RAD_ALL.23151 
      SUBROUTINE SET_MATRIX_FULL(N_PROFILE, N_LAYER                                RAD_ALL.23152 
     &   , TRANS, REFLECT                                                          RAD_ALL.23153 
     &   , S_DOWN, S_UP                                                            RAD_ALL.23154 
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                                 RAD_ALL.23155 
     &   , FLUX_DIRECT_GROUND, FLUX_INC_DOWN                                       RAD_ALL.23156 
     &   , SOURCE_GROUND                                                           RAD_ALL.23157 
     &   , A3, B                                                                   RAD_ALL.23158 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.23159 
     &   )                                                                         RAD_ALL.23160 
!                                                                                  RAD_ALL.23161 
!                                                                                  RAD_ALL.23162 
      IMPLICIT NONE                                                                RAD_ALL.23163 
!                                                                                  RAD_ALL.23164 
!                                                                                  RAD_ALL.23165 
!      COMDECKS INCLUDED.                                                          RAD_ALL.23166 
!     ------------------------------------------------------------------           PRMCH3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PRMCH3A.3     
!                                                                                  PRMCH3A.4     
!     MODULE FOR SETTING MACHINE PRECISION.                                        PRMCH3A.5     
!                                                                                  PRMCH3A.6     
      REAL                                                                         PRMCH3A.7     
     &     TOL_MACHINE                                                             PRMCH3A.8     
!             MACHINE TOLERANCE                                                    PRMCH3A.9     
     &   , SQRT_TOL_MACHINE                                                        PRMCH3A.10    
!             SQRT OF MACHINE TOLERANCE                                            PRMCH3A.11    
!                                                                                  PRMCH3A.12    
!                                                                                  PRMCH3A.13    
!     THE PRECISION SHOULD BE ABOUT 2/2^(SIZE OF SIGNIFICAND)                      PRMCH3A.14    
!                                                                                  PRMCH3A.15    
!     THE IEEE-FORMAT USES 53 BITS FOR THE SIGNIFICAND                             PRMCH3A.16    
!     IN DOUBLE PRECISION                                                          PRMCH3A.17    
!                                                                                  PRMCH3A.18    
!     THE CRAY FORMAT USES 47 BITS IN SINGLE PRECISION.                            PRMCH3A.19    
!                                                                                  PRMCH3A.20    
      PARAMETER(                                                                   PRMCH3A.21    
     &     TOL_MACHINE=1.42E-14                                                    PRMCH3A.22    
     &   , SQRT_TOL_MACHINE=1.19E-7                                                PRMCH3A.23    
     &   )                                                                         PRMCH3A.24    
!                                                                                  PRMCH3A.25    
!     ------------------------------------------------------------------           PRMCH3A.26    
!                                                                                  RAD_ALL.23168 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.23169 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.23170 
     &     NPD_PROFILE                                                             RAD_ALL.23171 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.23172 
     &   , NPD_LAYER                                                               RAD_ALL.23173 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.23174 
!                                                                                  RAD_ALL.23175 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.23176 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.23177 
     &     N_PROFILE                                                               RAD_ALL.23178 
!             NUMBER OF PROFILES                                                   RAD_ALL.23179 
     &   , N_LAYER                                                                 RAD_ALL.23180 
!             NUMBER OF LAYERS                                                     RAD_ALL.23181 
      REAL      !, INTENT(IN)                                                      RAD_ALL.23182 
     &     TRANS(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.23183 
!             TRANSMISSION COEFFICIENTS                                            RAD_ALL.23184 
     &   , REFLECT(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.23185 
!             REFLECT COEFFICIENTS                                                 RAD_ALL.23186 
     &   , S_UP(NPD_PROFILE, NPD_LAYER)                                            RAD_ALL.23187 
!             UPWARD SOURCE FUNCTION                                               RAD_ALL.23188 
     &   , S_DOWN(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.23189 
!             DOWNWARD SOURCE FUNCTION                                             RAD_ALL.23190 
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.23191 
!             DIFFUSE REFLECTION COEFFICIENTS                                      RAD_ALL.23192 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.23193 
!             DIRECT REFLECTION COEFFICIENTS                                       RAD_ALL.23194 
     &   , FLUX_DIRECT_GROUND(NPD_PROFILE)                                         RAD_ALL.23195 
!             DIRECT FLUX AT SURFACE                                               RAD_ALL.23196 
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.23197 
!             INCIDENT DOWNWARD FLUX                                               RAD_ALL.23198 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.23199 
!             SOURCE FROM GROUND                                                   RAD_ALL.23200 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.23201 
     &     A3(NPD_PROFILE, 3, 2*NPD_LAYER+2)                                       RAD_ALL.23202 
!             TRIDIAGONAL MATRIX                                                   RAD_ALL.23203 
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                           RAD_ALL.23204 
!             RHS OF EQUATIONS                                                     RAD_ALL.23205 
!                                                                                  RAD_ALL.23206 
!     LOCAL VARIABLES.                                                             RAD_ALL.23207 
      INTEGER                                                                      RAD_ALL.23208 
     &     I                                                                       RAD_ALL.23209 
!             LOOP VARIABLE                                                        RAD_ALL.23210 
     &   , L                                                                       RAD_ALL.23211 
!             LOOP VARIABLE                                                        RAD_ALL.23212 
      REAL                                                                         RAD_ALL.23213 
     &     PERTURBATION                                                            RAD_ALL.23214 
!             PERTURBATION TO RESTORE CONDITIONING                                 RAD_ALL.23215 
!                                                                                  RAD_ALL.23216 
!                                                                                  RAD_ALL.23217 
!     CODE THE EQUATIONS INTO THE MATRIX:                                          RAD_ALL.23218 
!     UPPER SURFACE:                                                               RAD_ALL.23219 
      DO L=1, N_PROFILE                                                            RAD_ALL.23220 
         A3(L, 2, 1)=0.0E+00                                                       RAD_ALL.23221 
         A3(L, 3, 1)=1.0E+00                                                       RAD_ALL.23222 
         B(L, 1)=FLUX_INC_DOWN(L)                                                  RAD_ALL.23223 
      ENDDO                                                                        RAD_ALL.23224 
!     THE INTERIOR EQUATIONS:                                                      RAD_ALL.23225 
      DO I=1, N_LAYER                                                              RAD_ALL.23226 
         DO L=1, N_PROFILE                                                         RAD_ALL.23227 
            PERTURBATION=(1.0E+00-TRANS(L, I)-REFLECT(L, I))                       RAD_ALL.23228 
     &         *TOL_MACHINE/(SQRT_TOL_MACHINE+REFLECT(L, I))                       RAD_ALL.23229 
            A3(L, 1, 2*I)=1.0E+00                                                  RAD_ALL.23230 
            A3(L, 2, 2*I)=-REFLECT(L, I)-PERTURBATION                              RAD_ALL.23231 
            A3(L, 3, 2*I)=-TRANS(L, I)                                             RAD_ALL.23232 
            B(L, 2*I)=S_UP(L, I)                                                   RAD_ALL.23233 
            A3(L, 1, 2*I+1)=-TRANS(L, I)                                           RAD_ALL.23234 
            A3(L, 2, 2*I+1)=-REFLECT(L, I)-PERTURBATION                            RAD_ALL.23235 
            A3(L, 3, 2*I+1)=1.0E+00                                                RAD_ALL.23236 
            B(L, 2*I+1)=S_DOWN(L, I)                                               RAD_ALL.23237 
         ENDDO                                                                     RAD_ALL.23238 
      ENDDO                                                                        RAD_ALL.23239 
!     LOWER BOUNDARY                                                               RAD_ALL.23240 
      DO L=1, N_PROFILE                                                            RAD_ALL.23241 
         A3(L, 1, 2*N_LAYER+2)=1.0E+00                                             RAD_ALL.23242 
         A3(L, 2, 2*N_LAYER+2)=-ALBEDO_SURFACE_DIFF(L)                             RAD_ALL.23243 
     &      -TOL_MACHINE/(ALBEDO_SURFACE_DIFF(L)+SQRT_TOL_MACHINE)                 RAD_ALL.23244 
         B(L, 2*N_LAYER+2)                                                         RAD_ALL.23245 
     &      =(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L))                        RAD_ALL.23246 
     &      *FLUX_DIRECT_GROUND(L)+SOURCE_GROUND(L)                                RAD_ALL.23247 
      ENDDO                                                                        RAD_ALL.23248 
!                                                                                  RAD_ALL.23249 
!                                                                                  RAD_ALL.23250 
      RETURN                                                                       RAD_ALL.23251 
      END      
