C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.23257 
C                                                                                  RAD_ALL.23258 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.23259 
C restrictions as set forth in the contract.                                       RAD_ALL.23260 
C                                                                                  RAD_ALL.23261 
C                Meteorological Office                                             RAD_ALL.23262 
C                London Road                                                       RAD_ALL.23263 
C                BRACKNELL                                                         RAD_ALL.23264 
C                Berkshire UK                                                      RAD_ALL.23265 
C                RG12 2SZ                                                          RAD_ALL.23266 
C                                                                                  RAD_ALL.23267 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.23268 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.23269 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.23270 
C Modelling at the above address.                                                  RAD_ALL.23271 
C ******************************COPYRIGHT******************************            RAD_ALL.23272 
C                                                                                  RAD_ALL.23273 
!+ Subroutine to set the matrix equations for the net fluxes.                      RAD_ALL.23274 
!                                                                                  RAD_ALL.23275 
! Method:                                                                          RAD_ALL.23276 
!       Straightforward.                                                           RAD_ALL.23277 
!                                                                                  RAD_ALL.23278 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.23279 
!                                                                                  RAD_ALL.23280 
! History:                                                                         RAD_ALL.23281 
!       Version         Date                    Comment                            RAD_ALL.23282 
!       4.0             27-07-95                Original Code                      RAD_ALL.23283 
!                                               (J. M. Edwards)                    RAD_ALL.23284 
!                                                                                  RAD_ALL.23285 
! Description of Code:                                                             RAD_ALL.23286 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.23287 
!                                                                                  RAD_ALL.23288 
!- ---------------------------------------------------------------------           RAD_ALL.23289 
      SUBROUTINE SET_MATRIX_NET(N_PROFILE, N_LAYER                                 RAD_ALL.23290 
     &   , TRANS, REFLECT                                                          RAD_ALL.23291 
     &   , S_DOWN, S_UP                                                            RAD_ALL.23292 
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                                 RAD_ALL.23293 
     &   , FLUX_DIRECT_GROUND, FLUX_INC_DOWN                                       RAD_ALL.23294 
     &   , SOURCE_GROUND                                                           RAD_ALL.23295 
     &   , A3, B                                                                   RAD_ALL.23296 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.23297 
     &   )                                                                         RAD_ALL.23298 
!                                                                                  RAD_ALL.23299 
!                                                                                  RAD_ALL.23300 
      IMPLICIT NONE                                                                RAD_ALL.23301 
!                                                                                  RAD_ALL.23302 
!                                                                                  RAD_ALL.23303 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.23304 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.23305 
     &     NPD_PROFILE                                                             RAD_ALL.23306 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.23307 
     &   , NPD_LAYER                                                               RAD_ALL.23308 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.23309 
!     INCLUDE COMDECKS                                                             RAD_ALL.23310 
!     ------------------------------------------------------------------           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.23312 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.23313 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.23314 
     &     N_PROFILE                                                               RAD_ALL.23315 
!             NUMBER OF PROFILES                                                   RAD_ALL.23316 
     &   , N_LAYER                                                                 RAD_ALL.23317 
!             NUMBER OF LAYERS                                                     RAD_ALL.23318 
      REAL      !, INTENT(IN)                                                      RAD_ALL.23319 
     &     TRANS(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.23320 
!             TRANSMISSION COEFFICIENTS                                            RAD_ALL.23321 
     &   , REFLECT(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.23322 
!             REFLECT COEFFICIENTS                                                 RAD_ALL.23323 
     &   , S_UP(NPD_PROFILE, NPD_LAYER)                                            RAD_ALL.23324 
!             UPWARD SOURCE FUNCTION                                               RAD_ALL.23325 
     &   , S_DOWN(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.23326 
!             DOWNWARD SOURCE FUNCTION                                             RAD_ALL.23327 
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.23328 
!             DIFFUSE REFLECTION COEFFICIENTS                                      RAD_ALL.23329 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.23330 
!             DIRECT REFLECTION COEFFICIENTS                                       RAD_ALL.23331 
     &   , FLUX_DIRECT_GROUND(NPD_PROFILE)                                         RAD_ALL.23332 
!             DIRECT FLUX AT SURFACE                                               RAD_ALL.23333 
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.23334 
!             INCIDENT DOWNWARD FLUX                                               RAD_ALL.23335 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.23336 
!             SOURCE FROM GROUND                                                   RAD_ALL.23337 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.23338 
     &     A3(NPD_PROFILE, 3, 2*NPD_LAYER+2)                                       RAD_ALL.23339 
!             TRIDIAGONAL MATRIX                                                   RAD_ALL.23340 
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                           RAD_ALL.23341 
!             RHS OF EQUATIONS                                                     RAD_ALL.23342 
!                                                                                  RAD_ALL.23343 
!     LOCAL VARIABLES.                                                             RAD_ALL.23344 
      INTEGER                                                                      RAD_ALL.23345 
     &     I                                                                       RAD_ALL.23346 
!             LOOP VARIABLE                                                        RAD_ALL.23347 
     &   , L                                                                       RAD_ALL.23348 
!             LOOP VARIABLE                                                        RAD_ALL.23349 
      REAL                                                                         RAD_ALL.23350 
     &     SIGMA(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.23351 
!             ARRAY SIGMA                                                          RAD_ALL.23352 
     &   , DELTA(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.23353 
!             ARRAY DELTA                                                          RAD_ALL.23354 
     &   , ZETA_TOP(NPD_PROFILE, NPD_LAYER)                                        RAD_ALL.23355 
!             2.0*ARRAY ZETA AT TOP OF LAYER                                       RAD_ALL.23356 
     &   , ZETA_BASE(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.23357 
!             2.0*ARRAY ZETA AT BASE OF LAYER                                      RAD_ALL.23358 
!                                                                                  RAD_ALL.23359 
!                                                                                  RAD_ALL.23360 
!     THE ARRAYS P AND Q MUST BE CALCULATED SEPARATELY SINCE THEY WILL             RAD_ALL.23361 
!     BE COUPLED BETWEEN LAYERS.                                                   RAD_ALL.23362 
      DO I=1, N_LAYER                                                              RAD_ALL.23363 
         DO L=1, N_PROFILE                                                         RAD_ALL.23364 
            SIGMA(L, I)=2.0E+00/(1.0E+00-(TRANS(L, I)+REFLECT(L, I))               RAD_ALL.23365 
     &         *(1.0E+00-SQRT_TOL_MACHINE))-1.0E+00                                RAD_ALL.23366 
            DELTA(L, I)=2.0E+00/(1.0E+00+(TRANS(L, I)-REFLECT(L, I))               RAD_ALL.23367 
     &         *(1.0E+00-SQRT_TOL_MACHINE))-1.0E+00                                RAD_ALL.23368 
            ZETA_BASE(L, I)=SIGMA(L, I)*(S_DOWN(L, I)+S_UP(L, I))                  RAD_ALL.23369 
     &         +DELTA(L, I)*(S_DOWN(L, I)-S_UP(L, I))                              RAD_ALL.23370 
     &         +2.0E+00*S_DOWN(L, I)                                               RAD_ALL.23371 
            ZETA_TOP(L, I)=SIGMA(L, I)*(S_DOWN(L, I)+S_UP(L, I))                   RAD_ALL.23372 
     &         -DELTA(L, I)*(S_DOWN(L, I)-S_UP(L, I))+2.0E+00*S_UP(L, I)           RAD_ALL.23373 
         ENDDO                                                                     RAD_ALL.23374 
      ENDDO                                                                        RAD_ALL.23375 
!                                                                                  RAD_ALL.23376 
!     CODE THE EQUATIONS INTO THE MATRIX:                                          RAD_ALL.23377 
!     UPPER SURFACE:                                                               RAD_ALL.23378 
      DO L=1, N_PROFILE                                                            RAD_ALL.23379 
         A3(L, 2, 1)=-2.0E+00-SIGMA(L, 1)-DELTA(L, 1)                              RAD_ALL.23380 
         A3(L, 3, 1)=SIGMA(L, 1)-DELTA(L, 1)                                       RAD_ALL.23381 
         B(L, 1)=ZETA_TOP(L, 1)-4.0E+00*FLUX_INC_DOWN(L)                           RAD_ALL.23382 
      ENDDO                                                                        RAD_ALL.23383 
!     THE INTERIOR EQUATIONS:                                                      RAD_ALL.23384 
      DO I=1, N_LAYER-1                                                            RAD_ALL.23385 
         DO L=1, N_PROFILE                                                         RAD_ALL.23386 
            A3(L, 1, I+1)=SIGMA(L, I)-DELTA(L, I)                                  RAD_ALL.23387 
            A3(L, 2, I+1)=-SIGMA(L, I)-DELTA(L, I)                                 RAD_ALL.23388 
     &          -SIGMA(L, I+1)-DELTA(L, I+1)                                       RAD_ALL.23389 
            A3(L, 3, I+1)=SIGMA(L, I+1)-DELTA(L, I+1)                              RAD_ALL.23390 
            B(L, I+1)=ZETA_TOP(L, I+1)-ZETA_BASE(L, I)                             RAD_ALL.23391 
         ENDDO                                                                     RAD_ALL.23392 
      ENDDO                                                                        RAD_ALL.23393 
!     LOWER BOUNDARY                                                               RAD_ALL.23394 
      DO L=1, N_PROFILE                                                            RAD_ALL.23395 
         A3(L, 1, N_LAYER+1)=(1.0E+00-ALBEDO_SURFACE_DIFF(L))                      RAD_ALL.23396 
     &      *(SIGMA(L, N_LAYER)-DELTA(L, N_LAYER))                                 RAD_ALL.23397 
         A3(L, 2, N_LAYER+1)=(ALBEDO_SURFACE_DIFF(L)-1.0E+00)                      RAD_ALL.23398 
     &      *(SIGMA(L, N_LAYER)+DELTA(L, N_LAYER))                                 RAD_ALL.23399 
     &      -2.0E+00*(1.0E+00+ALBEDO_SURFACE_DIFF(L))                              RAD_ALL.23400 
         B(L, N_LAYER+1)                                                           RAD_ALL.23401 
     &      =4.0E+00*((ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L))               RAD_ALL.23402 
     &      *FLUX_DIRECT_GROUND(L)+SOURCE_GROUND(L))                               RAD_ALL.23403 
     &      -(1.0E+00-ALBEDO_SURFACE_DIFF(L))*ZETA_BASE(L, N_LAYER)                RAD_ALL.23404 
      ENDDO                                                                        RAD_ALL.23405 
!                                                                                  RAD_ALL.23406 
!                                                                                  RAD_ALL.23407 
      RETURN                                                                       RAD_ALL.23408 
      END 
