subroutine lanczo (a,t,n,b,c,x,iolp,ind)
      implicit doubleprecision(a-h,o-z)
      integer flagx, flagy, iolp, ind
      integer maxcor, maxcr2, maxcr4, maxcr5, maxcr6, maxcr7, maxcr8
c     parameter (maxcor=2, maxcr2=maxcor*maxcor, maxcr4=maxcr2*maxcr2,
c    1 maxcr5=maxcr2*(maxcr2+1)/2, maxcr6=maxcor*2, maxcr7=maxcr6+1,
c    2 maxcr8=maxcr6*maxcr7+1)
      parameter (maxcor=2, maxcr2=4, maxcr4=16,
     1 maxcr5=10, maxcr6=4, maxcr7=5,
     2 maxcr8=21)
      double precision a(maxcr7,maxcr6), t(maxcr6,maxcr6), x(maxcr6
     1 ,maxcr7), y(maxcr6,maxcr7), b(maxcr7), c(maxcr7), yta(maxcr6)
      nminus=n-1
      do 10 i=1,nminus
      x(i,1)=0.0d0
c choose x(1),y(1)
   10 y(i,1)=0.0d0
      x(n,1)=1.0d0
      y(n,1)=1.0d0
c initialize t
   20 do 30 i=1,n
      do 30 j=1,n
   30 t(i,j)=0.0d0
      do 40 i=2,n
   40 t(i,i-1)=1.0d0
      flagx=0
      flagy=0
      do 190 k=1,n
c find b(k)
      do 50 j=1,n
      yta(j)=0.0d0
      do 50 i=1,n
   50 yta(j)=yta(j)+y(i,k)*a(i,j)
      ytax=0.0d0
      do 60 i=1,n
   60 ytax=ytax+yta(i)*x(i,k)
      ytx=0.0d0
      do 70 i=1,n
   70 ytx=ytx+y(i,k)*x(i,k)
c if ytx=0, go rechoose x(1),y(1) & start over
      if (dabs(ytx).lt.1.0d-8) go to 210
      b(k)=ytax/ytx
      if (k.ne.1) go to 120
c find x(2) when k=1
      do 90 i=1,n
      x(i,2)=0.0d0
      do 80 j=1,n
   80 x(i,2)=x(i,2)+a(i,j)*x(j,1)
   90 x(i,2)=x(i,2)-b(1)*x(i,1)
c set flagx=1 if x(2)=0
      call test (x,n,2,flagx)
c find y(2) when k=1
      do 110 i=1,n
      y(i,2)=0.0d0
      do 100 j=1,n
  100 y(i,2)=y(i,2)+a(j,i)*y(j,1)
  110 y(i,2)=y(i,2)-b(1)*y(i,1)
c set flagy=1 if y(2)=0
      call test (y,n,2,flagy)
      go to 180
c find c(k-1)
  120 save=ytx
      ytx=0.0d0
      do 130 i=1,n
  130 ytx=ytx+y(i,k-1)*x(i,k-1)
      c(k-1)=save/ytx
      t(k-1,k)=c(k-1)
      if ((flagx.eq.1).or.(flagy.eq.1)) t(k-1,k)=0.0d0
      km1=k-1
      if (k.eq.n) go to 180
c find x(k+1)
      csave=c(k-1)
      if (flagy.eq.1) csave=0.0d0
      flagy=0
      do 150 i=1,n
      x(i,k+1)=0.0d0
      do 140 j=1,n
  140 x(i,k+1)=x(i,k+1)+a(i,j)*x(j,k)
  150 x(i,k+1)=x(i,k+1)-b(k)*x(i,k)-csave*x(i,k-1)
      kp1=k+1
c find y(k+1)
      csave=c(k-1)
      if (flagx.eq.1) csave=0.0d0
      flagx=0
      do 170 i=1,n
      y(i,k+1)=0.0d0
      do 160 j=1,n
  160 y(i,k+1)=y(i,k+1)+a(j,i)*y(j,k)
  170 y(i,k+1)=y(i,k+1)-b(k)*y(i,k)-csave*y(i,k-1)
c set flagx=1 if x(k+1)=0
      call test (x,n,kp1,flagx)
c if (x(k+1)=0, rechoose it
      if (flagx.eq.1) call rechos (y,n,x,kp1)
c set flagy=1 if y(k+1)=0
      call test (y,n,kp1,flagy)
c if y(k+1)=0, rechoose it
      if (flagy.eq.1) call rechos (x,n,y,kp1)
  180 t(k,k)=b(k)
  190 continue
c fix c to correspond with final t matrix
      do 200 k=2,n
  200 c(k-1)=t(k-1,k)
      return
c rechoose x(1),y(1)
  210 do 220 k=1,n
      if (dabs(x(k,1)).gt.1.0d-8) go to 230
  220 continue
  230 if (k.eq.1) go to 250
      do 240 i=1,n
      x(i,1)=0.0d0
  240 y(i,1)=0.0d0
      x(k-1,1)=1.0d0
      y(k-1,1)=1.0d0
      go to 20
  250 if (ind.ge.0) then
         write (unit=iolp,fmt=260)
         call linect (1)
      endif
      return
c
  260 format (10x,'n starting vectors have been attempted')
      end