c sample program for dgbfs
c
      parameter (lda=10,p=2)
      implicit double precision (a-h,o-z)
      double precision a(lda,lda), abd(lda,lda), b(lda,p), rcond,
     c                 work(lda)
      integer ipvt(lda), i,j,n,ml,mu 

      n = 6
      ml= 2
      mu= 2
      a(1,1) = 10.D0
      a(2,1) = -3.D0
      a(3,1) =  5.D0
      a(4,1) =  0.d0
      a(5,1) =  0.d0
      a(6,1) =  0.d0
      a(1,2) = -2.D0
      a(2,2) =  2.D0
      a(3,2) = -1.D0
      a(4,2) = -2.D0
      a(5,2) =  0.d0
      a(6,2) =  0.d0
      a(1,3) = -1.D0
      a(2,3) =  6.D0
      a(3,3) =  5.D0
      a(4,3) =  5.D0
      a(5,3) =  1.D0
      a(6,3) =  0.d0
      a(1,4) =  0.D0
      a(2,4) =  2.D0
      a(3,4) =  3.D0
      a(4,4) =  2.D0
      a(5,4) =  1.D0
      a(6,4) = -6.d0
      a(1,5) =  0.D0
      a(2,5) =  0.D0
      a(3,5) =  2.D0
      a(4,5) =  8.D0
      a(5,5) =  0.D0
      a(6,5) = -3.d0
      a(1,6) =  0.D0
      a(2,6) =  0.D0
      a(3,6) =  0.D0
      a(4,6) =  2.D0
      a(5,6) =  5.D0
      a(6,6) =  6.d0
      b(1,1) =  7.D0
      b(2,1) =  4.D0
      b(3,1) = 10.D0
      b(4,1) =  7.D0
      b(5,1) =  4.D0
      b(6,1) = 10.D0
      b(1,2) =  3.D0
      b(2,2) =  4.D0
      b(3,2) =  2.D0
      b(4,2) =  7.D0
      b(5,2) =  1.D0
      b(6,2) =  5.D0
c
c print information
c
      write (*,*) ' coefficient matrix ='
      do 10 i = 1,n
         write (*,800) (a(i,j), j = 1,n)
10    continue
      write (*,*)
      write (*,*) ' first right-hand side ='
      write (*,800) (b(j,1), j = 1,n)
      write (*,*)
      write (*,*) ' second right-hand side ='
      write (*,800) (b(j,2), j = 1,n)
      m = ml + mu + 1
      do 40 j = 1, n
        i1 = max(1, j-mu)
        i2 = min(n, j+ml)
        do 50 i = i1, i2
          k = i - j + m
          abd(k,j) = a(i,j)
50       continue
40    continue
      job = 0
      call dgbco(abd,lda,n,ml,mu,ipvt,rcond,work)
      if (rcond.eq.0.d0)  go to 104
c     check for computationally singular matrix
c     compute ind (estimate of no. of significant digits)
      ind=-int(dlog10(d1mach(4)/rcond))
c
c     check for ind greater than zero
      if (ind.gt.0)  go to 20
      ind=-10
      call xerror( 'dgbfs error (ind=-10) -- solution may have no signif
     1icance',58,-10,0)
c
c     solve after factoring
20    job=0
      do 30 j = 1, p
        call dgbsl(abd,lda,n,ml,mu,ipvt,b(1,j),job)
30    continue


c
c print results
c
      write (*,*)
      write (*,*) 'DGBCO RESULTS'
      if (ind.eq. -10) then
         write (*,*) ' ERROR CODE =', ind
      else if (ind .lt.0) THEN
         write (*,*) ' ERROR CODE =', ind
         stop
      else
         write (*,*) ' NUMBER OF ACCURATE DIGITS =', IND
      endif
c
      write (*,*) ' SOLUTION ='
      write (*,801) ((b(i,j), j = 1,p),i=1,n)
      stop
c
c     if singular matrix, ind=-4, fatal xerror message
  104 ind=-4
      call xerror( 'DGEFS ERROR (IND=-4) -- SINGULAR MATRIX A - NO SOLUT
     1ION',55,-4,0)
800   format (4X, 6F12.6)
801   format (4X, 2F12.6)
      stop
      end