program main

!*********************************************************************72
!
!! MAIN is the main program for SPARSEKIT_PRB06.
!
!  Discussion:
!
!    SPARSEKIT_PRB06 demonstrates how to read a Harwell-Boeing 
!    sparse matrix file.
!
      implicit none

      integer nmax
      parameter ( nmax = 500 )
      integer nzmax
      parameter ( nzmax = 7000 )

      double precision a(nzmax)
      double precision a1(nzmax)
      character * ( 80 ) filnam
      character * ( 2 ) guesol
      integer ia(nmax+1)
      integer ia1(nmax+1)
      integer ierr
      integer iin
      integer iout
      integer ja(nzmax)
      integer ja1(nzmax)
      integer job
      character * ( 8 ) key
      integer ncol
      integer nnz
      integer nrhs
      integer nrow
      double precision rhs(1)
      character * ( 72 ) title
      character * ( 3 ) type
      logical valued

      iout = 6
      job = 2
      nrhs = 0

      call timestamp ( )

      write ( *, * ) ' '
      write ( *, * ) 'SPARSEKIT_PRB06'
      write ( *, '(a)' ) '  Fortran77 version'
      write ( *, '(a)' ) ' '
      write ( *, * ) '  This program demonstrates the use of the'
      write ( *, * ) '  routines READMT and DINFO1 to read and report'
      write ( *, * ) '  on a sparse matrix stored in a file in the'
      write ( *, * ) '  format used by the Harwell-Boeing Sparse Matrix'
      write ( *, * ) '  Collection or "HBSMC".'
      write ( *, * ) ' '

      filnam = 'saylor_hb.txt'
      iin = 20

      open ( unit = iin, file = filnam, status = 'old', err = 99 )

      call readmt ( nmax, nzmax, job, iin, a, ja, ia, rhs, nrhs, 
     &  guesol, nrow, ncol, nnz, title, key, type, ierr )

      close ( unit = iin )
!
!  If not readable, return.
!
      if ( ierr .ne. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'Error!'
        write ( *, '(a)' ) '  Unable to read matrix.'
        write ( *, '(a,i6)' ) '  READMT returned IERR = ', ierr
        stop
      end if

      valued = ( 2 <= job )

      call dinfo1 ( ncol, iout, a, ja, ia, valued, title, key, type, 
     &  a1, ja1, ia1 )

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'SPARSEKIT_PRB06'
      write ( *, '(a)' ) '  Normal end of execution.'

      write ( *, '(a)' ) ' '
      call timestamp ( )

      stop

99    continue

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'SPARSEKIT_PRB06 - Error!'
      write ( *, '(a)' ) '  Unable to open file.'
      write ( *, '(a)' ) '  Abnormal end of execution.'
      write ( *, '(a)' ) ' '
      call timestamp ( )
      stop
      end
      function afun ( x, y, z )

c*********************************************************************72
c
cc AFUN
c
      implicit none

      double precision afun
      double precision x
      double precision y
      double precision z

      afun = -1.0D+00

      return
      end
      function bfun ( x, y, z )

c*********************************************************************72
c
cc BFUN
c
      implicit none

      double precision bfun
      double precision x
      double precision y
      double precision z

      bfun = -1.0D+00

      return
      end
      function cfun ( x, y, z )

c*********************************************************************72
c
cc CFUN
c
      implicit none

      double precision cfun
      double precision x
      double precision y
      double precision z

      cfun = -1.0D+00

      return
      end
      function dfun ( x, y, z )

c*********************************************************************72
c
cc DFUN
c
      implicit none

      double precision dfun
      double precision x
      double precision y
      double precision z

      dfun = 0.0D+00

      return
      end
      function efun ( x, y, z )

c*********************************************************************72
c
cc EFUN
c
      implicit none

      double precision efun
      double precision x
      double precision y
      double precision z

      efun = 0.0D+00

      return
      end
      function ffun ( x, y, z )

c*********************************************************************72
c
cc FFUN
c
      implicit none

      double precision ffun
      double precision x
      double precision y
      double precision z

      ffun = 0.0D+00

      return
      end
      function gfun ( x, y, z )

c*********************************************************************72
c
cc GFUN
c
      implicit none

      double precision gfun
      double precision x
      double precision y
      double precision z

      gfun = 0.0D+00

      return
      end
      subroutine afunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
        coeff((j-1)*nfree+j) = -1.0
      end do

      return
      end
      subroutine bfunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
        coeff((j-1)*nfree+j) = -1.0
      end do

      return
      end
      subroutine cfunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
        coeff((j-1)*nfree+j) = -1.0
      end do

      return
      end
      subroutine dfunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
      end do

      return
      end
      subroutine efunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
      end do

      return
      end
      subroutine ffunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
      end do

      return
      end
      subroutine gfunbl (nfree,x,y,z,coeff)

c*********************************************************************72
c
      implicit none

      double precision coeff(100)
      integer i
      integer j
      integer nfree
      double precision x
      double precision y
      double precision z

      do j=1, nfree
        do i=1, nfree
          coeff((j-1)*nfree+i) = 0.0
        end do
      end do

      return
      end