C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.20535 
C                                                                                  RAD_ALL.20536 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.20537 
C restrictions as set forth in the contract.                                       RAD_ALL.20538 
C                                                                                  RAD_ALL.20539 
C                Meteorological Office                                             RAD_ALL.20540 
C                London Road                                                       RAD_ALL.20541 
C                BRACKNELL                                                         RAD_ALL.20542 
C                Berkshire UK                                                      RAD_ALL.20543 
C                RG12 2SZ                                                          RAD_ALL.20544 
C                                                                                  RAD_ALL.20545 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.20546 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.20547 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.20548 
C Modelling at the above address.                                                  RAD_ALL.20549 
C ******************************COPYRIGHT******************************            RAD_ALL.20550 
C                                                                                  RAD_ALL.20551 
!+ Subroutine to set the pentadiagonal matrix for the fluxes.                      RAD_ALL.20552 
!                                                                                  RAD_ALL.20553 
! Method:                                                                          RAD_ALL.20554 
!       Straightforward.                                                           RAD_ALL.20555 
!                                                                                  RAD_ALL.20556 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.20557 
!                                                                                  RAD_ALL.20558 
! History:                                                                         RAD_ALL.20559 
!       Version         Date                    Comment                            RAD_ALL.20560 
!       4.0             27-07-95                Original Code                      RAD_ALL.20561 
!                                               (J. M. Edwards)                    RAD_ALL.20562 
!                                                                                  RAD_ALL.20563 
! Description of Code:                                                             RAD_ALL.20564 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.20565 
!                                                                                  RAD_ALL.20566 
!- ---------------------------------------------------------------------           RAD_ALL.20567 
      SUBROUTINE SET_MATRIX_PENTADIAGONAL(N_PROFILE, N_LAYER                       RAD_ALL.20568 
     &   , TRANS, REFLECT                                                          RAD_ALL.20569 
     &   , S_DOWN, S_UP                                                            RAD_ALL.20570 
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                                 RAD_ALL.20571 
     &   , FLUX_DIRECT_GROUND, FLUX_INC_DOWN                                       RAD_ALL.20572 
     &   , SOURCE_GROUND                                                           RAD_ALL.20573 
     &   , A5, B                                                                   RAD_ALL.20574 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.20575 
     &   )                                                                         RAD_ALL.20576 
!                                                                                  RAD_ALL.20577 
!                                                                                  RAD_ALL.20578 
      IMPLICIT NONE                                                                RAD_ALL.20579 
!                                                                                  RAD_ALL.20580 
!                                                                                  RAD_ALL.20581 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.20582 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.20583 
     &     NPD_PROFILE                                                             RAD_ALL.20584 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.20585 
     &   , NPD_LAYER                                                               RAD_ALL.20586 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.20587 
!                                                                                  RAD_ALL.20588 
!                                                                                  RAD_ALL.20589 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.20590 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.20591 
     &     N_PROFILE                                                               RAD_ALL.20592 
!             NUMBER OF PROFILES                                                   RAD_ALL.20593 
     &   , N_LAYER                                                                 RAD_ALL.20594 
!             NUMBER OF LAYERS                                                     RAD_ALL.20595 
      REAL      !, INTENT(IN)                                                      RAD_ALL.20596 
     &     TRANS(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.20597 
!             TRANSMISSION COEFFICIENT                                             RAD_ALL.20598 
     &   , REFLECT(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.20599 
!             REFLECTION COEFFICIENT                                               RAD_ALL.20600 
     &   , S_DOWN(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.20601 
!             DOWNWARD DIFFUSE SOURCE                                              RAD_ALL.20602 
     &   , S_UP(NPD_PROFILE, NPD_LAYER)                                            RAD_ALL.20603 
!             UPWARD DIFFUSE SOURCE                                                RAD_ALL.20604 
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.20605 
!             DIFFUSE SURFACE ALBEDO                                               RAD_ALL.20606 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.20607 
!             DIRECT SURFACE ALBEDO                                                RAD_ALL.20608 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.20609 
!             SOURCE FUNCTION OF GROUND                                            RAD_ALL.20610 
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.20611 
!             INCIDENT TOTAL FLUX                                                  RAD_ALL.20612 
     &   , FLUX_DIRECT_GROUND(NPD_PROFILE)                                         RAD_ALL.20613 
!             DIRECT FLUX AT                                                       RAD_ALL.20614 
!                     GROUND LEVEL                                                 RAD_ALL.20615 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.20616 
     &     A5(NPD_PROFILE, 5, 2*NPD_LAYER+2)                                       RAD_ALL.20617 
!             PENTADIAGONAL MATRIX                                                 RAD_ALL.20618 
     &   , B(NPD_PROFILE, 2*NPD_LAYER+2)                                           RAD_ALL.20619 
!             SOURCE TERMS FOR EQUATIONS                                           RAD_ALL.20620 
!                                                                                  RAD_ALL.20621 
!     DECLARATION OF LOCAL VARIABLES.                                              RAD_ALL.20622 
      INTEGER                                                                      RAD_ALL.20623 
     &     I                                                                       RAD_ALL.20624 
!             LOOP VARIABLE                                                        RAD_ALL.20625 
     &   , L                                                                       RAD_ALL.20626 
!             LOOP VARIABLE                                                        RAD_ALL.20627 
!                                                                                  RAD_ALL.20628 
!                                                                                  RAD_ALL.20629 
                                                                                   RAD_ALL.20630 
!     THE TOP BOUNDARY CONDITION:                                                  RAD_ALL.20631 
      DO L=1, N_PROFILE                                                            RAD_ALL.20632 
         A5(L, 4, 2)=0.0E+00                                                       RAD_ALL.20633 
         A5(L, 3, 2)=1.0E+00                                                       RAD_ALL.20634 
         A5(L, 2, 2)=0.0E+00                                                       RAD_ALL.20635 
         A5(L, 1, 2)=0.0E+00                                                       RAD_ALL.20636 
         B(L, 2)=FLUX_INC_DOWN(L)                                                  RAD_ALL.20637 
      ENDDO                                                                        RAD_ALL.20638 
!                                                                                  RAD_ALL.20639 
!     INTERIOR ROWS: ODD AND EVEN ROWS CORRESPOND TO DIFFERENT BOUNDARY            RAD_ALL.20640 
!     CONDITIONS.                                                                  RAD_ALL.20641 
      DO I=1, N_LAYER                                                              RAD_ALL.20642 
         DO L=1, N_PROFILE                                                         RAD_ALL.20643 
            A5(L, 5, 2*I-1)=0.0E+00                                                RAD_ALL.20644 
            A5(L, 4, 2*I-1)=0.0E+00                                                RAD_ALL.20645 
            A5(L, 3, 2*I-1)=-1.0E+00                                               RAD_ALL.20646 
            A5(L, 2, 2*I-1)=REFLECT(L, I)                                          RAD_ALL.20647 
            A5(L, 1, 2*I-1)=TRANS(L, I)                                            RAD_ALL.20648 
            B(L, 2*I-1)=-S_UP(L, I)                                                RAD_ALL.20649 
            A5(L, 5, 2*I+2)=TRANS(L, I)                                            RAD_ALL.20650 
            A5(L, 4, 2*I+2)=REFLECT(L, I)                                          RAD_ALL.20651 
            A5(L, 3, 2*I+2)=-1.0E+00                                               RAD_ALL.20652 
            A5(L, 2, 2*I+2)=0.0E+00                                                RAD_ALL.20653 
            A5(L, 1, 2*I+2)=0.0E+00                                                RAD_ALL.20654 
            B(L, 2*I+2)=-S_DOWN(L, I)                                              RAD_ALL.20655 
         ENDDO                                                                     RAD_ALL.20656 
      ENDDO                                                                        RAD_ALL.20657 
!                                                                                  RAD_ALL.20658 
!     THE SURFACE BOUNDARY CONDITION:                                              RAD_ALL.20659 
      DO L=1, N_PROFILE                                                            RAD_ALL.20660 
         A5(L, 5, 2*N_LAYER+1)=0.0E+00                                             RAD_ALL.20661 
         A5(L, 4, 2*N_LAYER+1)=0.0E+00                                             RAD_ALL.20662 
         A5(L, 3, 2*N_LAYER+1)=1.0E+00                                             RAD_ALL.20663 
         A5(L, 2, 2*N_LAYER+1)=-ALBEDO_SURFACE_DIFF(L)                             RAD_ALL.20664 
         B(L, 2*N_LAYER+1)=SOURCE_GROUND(L)                                        RAD_ALL.20665 
     &      +(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L))                        RAD_ALL.20666 
     &      *FLUX_DIRECT_GROUND(L)                                                 RAD_ALL.20667 
      ENDDO                                                                        RAD_ALL.20668 
!                                                                                  RAD_ALL.20669 
!                                                                                  RAD_ALL.20670 
      RETURN                                                                       RAD_ALL.20671 
      END 
