C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.697   
C                                                                                  RAD_ALL.698   
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.699   
C restrictions as set forth in the contract.                                       RAD_ALL.700   
C                                                                                  RAD_ALL.701   
C                Meteorological Office                                             RAD_ALL.702   
C                London Road                                                       RAD_ALL.703   
C                BRACKNELL                                                         RAD_ALL.704   
C                Berkshire UK                                                      RAD_ALL.705   
C                RG12 2SZ                                                          RAD_ALL.706   
C                                                                                  RAD_ALL.707   
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.708   
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.709   
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.710   
C Modelling at the above address.                                                  RAD_ALL.711   
C ******************************COPYRIGHT******************************            RAD_ALL.712   
C                                                                                  RAD_ALL.713   
!+ Subroutine to solve a set of banded matrix equations.                           RAD_ALL.714   
!                                                                                  RAD_ALL.715   
! Method:                                                                          RAD_ALL.716   
!       A set of bands matrix equations is solved using the                        RAD_ALL.717   
!       standard method of Gaussian elimination.                                   RAD_ALL.718   
!                                                                                  RAD_ALL.719   
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.720   
!                                                                                  RAD_ALL.721   
! History:                                                                         RAD_ALL.722   
!       Version         Date                    Comment                            RAD_ALL.723   
!       4.0             27-07-95                Original Code                      RAD_ALL.724   
!                                               (J. M. Edwards)                    RAD_ALL.725   
!                                                                                  RAD_ALL.726   
! Description of Code:                                                             RAD_ALL.727   
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.728   
!                                                                                  RAD_ALL.729   
!- ---------------------------------------------------------------------           RAD_ALL.730   
      SUBROUTINE BAND_SOLVER(M, N                                                  RAD_ALL.731   
     &   , IU, IL                                                                  RAD_ALL.732   
     &   , A, B                                                                    RAD_ALL.733   
     &   , X                                                                       RAD_ALL.734   
     &   , PM, PN                                                                  RAD_ALL.735   
     &   , RHO                                                                     RAD_ALL.736   
     &   )                                                                         RAD_ALL.737   
!                                                                                  RAD_ALL.738   
!                                                                                  RAD_ALL.739   
      IMPLICIT NONE                                                                RAD_ALL.740   
!                                                                                  RAD_ALL.741   
!                                                                                  RAD_ALL.742   
!     DUMMY ARGUMENTS                                                              RAD_ALL.743   
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.744   
     &     M                                                                       RAD_ALL.745   
!             NUMBER OF PROFILES                                                   RAD_ALL.746   
     &   , N                                                                       RAD_ALL.747   
!             NUMBER OF EQUATIONS                                                  RAD_ALL.748   
     &   , IU                                                                      RAD_ALL.749   
!             NUMBER OF SUPERDIAGONALS                                             RAD_ALL.750   
     &   , IL                                                                      RAD_ALL.751   
!             NUMBER OF SUBDIAGONALS                                               RAD_ALL.752   
     &   , PM                                                                      RAD_ALL.753   
!             FIRST ARRAY SIZE                                                     RAD_ALL.754   
     &   , PN                                                                      RAD_ALL.755   
!             SECOND ARRAY SIZE                                                    RAD_ALL.756   
      REAL      !, INTENT(IN)                                                      RAD_ALL.757   
     &     A(PM, (1+IU+IL), PN)                                                    RAD_ALL.758   
!             MATRIX OF COEFFICIENTS                                               RAD_ALL.759   
     &   , B(PM, PN)                                                               RAD_ALL.760   
!             RIGHTHAND SIDES                                                      RAD_ALL.761   
      REAL      !, INTENT(OUT)                                                     RAD_ALL.762   
     &     X(PM, PN)                                                               RAD_ALL.763   
!             SOLUTION VECTOR                                                      RAD_ALL.764   
      REAL      !, INTENT(WORK)                                                    RAD_ALL.765   
     &     RHO(PM)                                                                 RAD_ALL.766   
!             TEMPORARY ARRAY                                                      RAD_ALL.767   
!                                                                                  RAD_ALL.768   
!     LOCAL VARIABLES                                                              RAD_ALL.769   
      INTEGER                                                                      RAD_ALL.770   
     &     I                                                                       RAD_ALL.771   
!             LOOP VARIABLE                                                        RAD_ALL.772   
     &   , J                                                                       RAD_ALL.773   
!             LOOP VARIABLE                                                        RAD_ALL.774   
     &   , K                                                                       RAD_ALL.775   
!             LOOP VARIABLE                                                        RAD_ALL.776   
     &   , L                                                                       RAD_ALL.777   
!             LOOP VARIABLE                                                        RAD_ALL.778   
     &   , IU1                                                                     RAD_ALL.779   
!             LOCAL SCALAR                                                         RAD_ALL.780   
!                                                                                  RAD_ALL.781   
!                                                                                  RAD_ALL.782   
      IU1=IU+1                                                                     RAD_ALL.783   
!     ELIMINATIVE PHASE.                                                           RAD_ALL.784   
      DO I=N, 2, -1                                                                RAD_ALL.785   
         DO J=1, MIN(IU, I-1)                                                      RAD_ALL.786   
            DO L=1, M                                                              RAD_ALL.787   
               RHO(L)=A(L, IU1-J, I-J)/A(L, IU1, I)                                RAD_ALL.788   
               B(L, I-J)=B(L, I-J)-RHO(L)*B(L, I)                                  RAD_ALL.789   
            ENDDO                                                                  RAD_ALL.790   
            DO K=1, MIN(IL, I-1)                                                   RAD_ALL.791   
               DO L=1, M                                                           RAD_ALL.792   
                  A(L, IU1+K-J, I-J)=A(L, IU1+K-J, I-J)                            RAD_ALL.793   
     &               -RHO(L)*A(L, IU1+K, I)                                        RAD_ALL.794   
               ENDDO                                                               RAD_ALL.795   
            ENDDO                                                                  RAD_ALL.796   
         ENDDO                                                                     RAD_ALL.797   
      ENDDO                                                                        RAD_ALL.798   
!                                                                                  RAD_ALL.799   
!     SOLUTION AND BACK-SUBSTITUTION:                                              RAD_ALL.800   
!                                                                                  RAD_ALL.801   
      IF ( (IU.EQ.2).AND.(IL.EQ.2) ) THEN                                          RAD_ALL.802   
!        A SPECIAL VERSION IS USED FOR THE PENTADIAGONAL CASE TO ALLOW             RAD_ALL.803   
!        US TO CHAIN OPERATIONS TOGETHER FOR EFFICIENCY ON THE CRAY.               RAD_ALL.804   
!        FIRST EQUATION:                                                           RAD_ALL.805   
         DO L=1, M                                                                 RAD_ALL.806   
            X(L, 1)=B(L, 1)/A(L, 3, 1)                                             RAD_ALL.807   
         ENDDO                                                                     RAD_ALL.808   
!        SECOND EQUATION:                                                          RAD_ALL.809   
         DO L=1, M                                                                 RAD_ALL.810   
            X(L, 2)=(B(L, 2)-A(L, 4, 2)*X(L, 1))/A(L, 3, 2)                        RAD_ALL.811   
         ENDDO                                                                     RAD_ALL.812   
!        REMAINING EQUATIONS:                                                      RAD_ALL.813   
         DO I=3, N                                                                 RAD_ALL.814   
            DO L=1, M                                                              RAD_ALL.815   
               X(L, I)=(B(L, I)-A(L, 4, I)*X(L, I-1)                               RAD_ALL.816   
     &            -A(L, 5, I)*X(L, I-2))/A(L, 3, I)                                RAD_ALL.817   
            ENDDO                                                                  RAD_ALL.818   
         ENDDO                                                                     RAD_ALL.819   
      ELSE                                                                         RAD_ALL.820   
!        GENERAL CASE:                                                             RAD_ALL.821   
         DO I=1, N                                                                 RAD_ALL.822   
            DO L=1, M                                                              RAD_ALL.823   
               X(L, I)=B(L, I)                                                     RAD_ALL.824   
            ENDDO                                                                  RAD_ALL.825   
            DO K=1, MIN(IL, I-1)                                                   RAD_ALL.826   
               DO L=1, M                                                           RAD_ALL.827   
                  X(L, I)=X(L, I)-A(L, IU1+K, I)*X(L, I-K)                         RAD_ALL.828   
               ENDDO                                                               RAD_ALL.829   
            ENDDO                                                                  RAD_ALL.830   
            DO L=1, M                                                              RAD_ALL.831   
               X(L, I)=X(L, I)/A(L, IU1, I)                                        RAD_ALL.832   
            ENDDO                                                                  RAD_ALL.833   
         ENDDO                                                                     RAD_ALL.834   
      ENDIF                                                                        RAD_ALL.835   
!                                                                                  RAD_ALL.836   
!                                                                                  RAD_ALL.837   
      RETURN                                                                       RAD_ALL.838   
      END     
