home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / htrib3.f < prev    next >
Text File  |  1996-09-28  |  3KB  |  91 lines
  1.       subroutine htrib3(nm,n,a,tau,m,zr,zi)
  2. c
  3.       integer i,j,k,l,m,n,nm
  4.       double precision a(nm,n),tau(2,n),zr(nm,m),zi(nm,m)
  5.       double precision h,s,si
  6. c
  7. c     this subroutine is a translation of a complex analogue of
  8. c     the algol procedure trbak3, num. math. 11, 181-195(1968)
  9. c     by martin, reinsch, and wilkinson.
  10. c     handbook for auto. comp., vol.ii-linear algebra, 212-226(1971).
  11. c
  12. c     this subroutine forms the eigenvectors of a complex hermitian
  13. c     matrix by back transforming those of the corresponding
  14. c     real symmetric tridiagonal matrix determined by  htrid3.
  15. c
  16. c     on input
  17. c
  18. c        nm must be set to the row dimension of two-dimensional
  19. c          array parameters as declared in the calling program
  20. c          dimension statement.
  21. c
  22. c        n is the order of the matrix.
  23. c
  24. c        a contains information about the unitary transformations
  25. c          used in the reduction by  htrid3.
  26. c
  27. c        tau contains further information about the transformations.
  28. c
  29. c        m is the number of eigenvectors to be back transformed.
  30. c
  31. c        zr contains the eigenvectors to be back transformed
  32. c          in its first m columns.
  33. c
  34. c     on output
  35. c
  36. c        zr and zi contain the real and imaginary parts,
  37. c          respectively, of the transformed eigenvectors
  38. c          in their first m columns.
  39. c
  40. c     note that the last component of each returned vector
  41. c     is real and that vector euclidean norms are preserved.
  42. c
  43. c     questions and comments should be directed to burton s. garbow,
  44. c     mathematics and computer science div, argonne national laboratory
  45. c
  46. c     this version dated august 1983.
  47. c
  48. c     ------------------------------------------------------------------
  49. c
  50.       if (m .eq. 0) go to 200
  51. c     .......... transform the eigenvectors of the real symmetric
  52. c                tridiagonal matrix to those of the hermitian
  53. c                tridiagonal matrix. ..........
  54.       do 50 k = 1, n
  55. c
  56.          do 50 j = 1, m
  57.             zi(k,j) = -zr(k,j) * tau(2,k)
  58.             zr(k,j) = zr(k,j) * tau(1,k)
  59.    50 continue
  60. c
  61.       if (n .eq. 1) go to 200
  62. c     .......... recover and apply the householder matrices ..........
  63.       do 140 i = 2, n
  64.          l = i - 1
  65.          h = a(i,i)
  66.          if (h .eq. 0.0d0) go to 140
  67. c
  68.          do 130 j = 1, m
  69.             s = 0.0d0
  70.             si = 0.0d0
  71. c
  72.             do 110 k = 1, l
  73.                s = s + a(i,k) * zr(k,j) - a(k,i) * zi(k,j)
  74.                si = si + a(i,k) * zi(k,j) + a(k,i) * zr(k,j)
  75.   110       continue
  76. c     .......... double divisions avoid possible underflow ..........
  77.             s = (s / h) / h
  78.             si = (si / h) / h
  79. c
  80.             do 120 k = 1, l
  81.                zr(k,j) = zr(k,j) - s * a(i,k) - si * a(k,i)
  82.                zi(k,j) = zi(k,j) - si * a(i,k) + s * a(k,i)
  83.   120       continue
  84. c
  85.   130    continue
  86. c
  87.   140 continue
  88. c
  89.   200 return
  90.       end
  91.