program test
c
c     Program to test the HYCHOL subroutines with hard-wired matrix
c
c     Declarations for PUTAR
c
c     Address matrix:
      integer*4 ihzei,ihba1
      parameter (ihzei=4,ihba1=5)
      integer*4 iadm(ihzei,ihba1)

c     Addresses:
      integer*4 iad,jad

c     Submatrix:
      integer*4 idim,ir
      parameter (idim=2,ir=1)
      real*8 ar(idim,ir)

c     Logical files and common blocks:
      integer*4 iou,igl,igr
      integer*4 kkkk,nofil,lpru,ifile(7,2),lfile(3,2)
      common/out/iou,kkkk
      common/ibmf/lpru
      common/defie/nofil,ifile
      character*8 lfnam(2)
c
c     Declarations for HCHOL
c
c     Size of hyper matrix, # sub.matr. in row, # band cols.:
      integer*4 maxzei,ihbdi,ihbra
      parameter (maxzei=4,ihbdi=1,ihbra=1)

c     Number of right hand sides:
      integer*4 iresei
      parameter (iresei=1)

c     Submatrices (work space):
      real*8 a(idim,idim),b(idim,idim),c(idim,idim)

c
c     Function ixy10:
      integer*4 ixy10
      external ixy10
c
      iou=6
      igl=17
      igr=18
      ntrsz=32258
      lpru=ntrsz/8
      OPEN (igl,ACCESS='DIRECT',RECL=19040)
      OPEN (igr,ACCESS='DIRECT',RECL=19040)
c
c     Initialize file tables
      call dinit(2)
      lfnam(1)='LE.SCR'
      lfile(1,1)=igl
      lfile(2,1)=idim*idim
      lfile(3,1)=ihzei*(ihba1-1)
      lfnam(2)='RI.SCR'
      lfile(1,2)=igr
      lfile(2,2)=idim
      lfile(3,2)=ihzei
      call vorhy(iadm,ihzei,ihba1,lfile,lfnam)
c
c     Store sumatrices
c     submatrix 1,1
      a(1,1)=0.24d0
      a(2,1)=0.44d0
      a(1,2)=0.44d0
      a(2,2)=1.15d0
      ia=idim
      call putar(iadm,ihzei,1,1,a,idim,idim,ia,igl)
c     Submatrix 2,1
      a(1,1)=0.75d0
      a(2,1)=0.83d0
      a(1,2)=0.83d0
      a(2,2)=1.58d0
      call putar(iadm,ihzei,2,1,a,idim,idim,ia,igl)

c     Submatrix 3,1
      a(1,1)=1.36d0
      a(2,1)=0.73d0
      a(1,2)=0.73d0
      a(2,2)=1.40d0
      call putar(iadm,ihzei,3,1,a,idim,idim,ia,igl)
             
c     border band
      a(1,1)=0.16d0
      a(2,1)=0.47d0
      a(1,2)=0.32d0
      a(2,2)=0.61d0
      call putar(iadm,ihzei,1,ihba1-1,a,idim,idim,ia,igl)
      a(1,1)=0.27d0
      a(2,1)=0.57d0
      a(1,2)=0.56d0
      a(2,2)=0.72d0
      call putar(iadm,ihzei,2,ihba1-1,a,idim,idim,ia,igl)
      a(1,1)=1.19d0
      a(2,1)=1.66d0
      a(1,2)=1.45d0
      a(2,2)=1.18d0
      call putar(iadm,ihzei,3,ihba1-1,a,idim,idim,ia,igl)

c     lower right
      a(1,1)=2.68d0
      a(2,1)=2.33d0
      a(1,2)=2.33d0
      a(2,2)=3.08d0
      call putar(iadm,ihzei,ihzei,ihba1-1,a,idim,idim,ia,igl)
c
c     Store right hand side
      ia=ir
      ar(1,1)= 4.80d0
      ar(2,1)=10.91d0
      call putar(iadm,ihzei,1,ihba1,ar,idim,ir,ia,igr)
      ar(1,1)=11.94d0
      ar(2,1)=18.56d0
      call putar(iadm,ihzei,2,ihba1,ar,idim,ir,ia,igr)
      ar(1,1)=31.11d0
      ar(2,1)=33.11d0
      call putar(iadm,ihzei,3,ihba1,ar,idim,ir,ia,igr)
c     lower right
      ar(1,1)=57.50d0
      ar(2,1)=61.38d0
      call putar(iadm,ihzei,ihzei,ihba1,ar,idim,ir,ia,igr)

c
c     call HYCHOL routines
      call hchol(iadm,ihzei,ihba1,maxzei,ihbdi,ihbra,a,b,c,idim,
     &           iresei,igl,igr)
c
c     get results
      do i=1,maxzei
       call getar(iadm,ihzei,i,ihba1,ar,idim,ir,igr)
       do j=1,idim
        write(6,*)ar(j,ir)
       enddo
      enddo
c
      end