home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / cbabk2.f < prev    next >
Text File  |  1996-09-28  |  3KB  |  84 lines
  1.       subroutine cbabk2(nm,n,low,igh,scale,m,zr,zi)
  2. c
  3.       integer i,j,k,m,n,ii,nm,igh,low
  4.       double precision scale(n),zr(nm,m),zi(nm,m)
  5.       double precision s
  6. c
  7. c     this subroutine is a translation of the algol procedure
  8. c     cbabk2, which is a complex version of balbak,
  9. c     num. math. 13, 293-304(1969) by parlett and reinsch.
  10. c     handbook for auto. comp., vol.ii-linear algebra, 315-326(1971).
  11. c
  12. c     this subroutine forms the eigenvectors of a complex general
  13. c     matrix by back transforming those of the corresponding
  14. c     balanced matrix determined by  cbal.
  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        low and igh are integers determined by  cbal.
  25. c
  26. c        scale contains information determining the permutations
  27. c          and scaling factors used by  cbal.
  28. c
  29. c        m is the number of eigenvectors to be back transformed.
  30. c
  31. c        zr and zi contain the real and imaginary parts,
  32. c          respectively, of the eigenvectors to be
  33. c          back transformed in their first m columns.
  34. c
  35. c     on output
  36. c
  37. c        zr and zi contain the real and imaginary parts,
  38. c          respectively, of the transformed eigenvectors
  39. c          in their first m columns.
  40. c
  41. c     questions and comments should be directed to burton s. garbow,
  42. c     mathematics and computer science div, argonne national laboratory
  43. c
  44. c     this version dated august 1983.
  45. c
  46. c     ------------------------------------------------------------------
  47. c
  48.       if (m .eq. 0) go to 200
  49.       if (igh .eq. low) go to 120
  50. c
  51.       do 110 i = low, igh
  52.          s = scale(i)
  53. c     .......... left hand eigenvectors are back transformed
  54. c                if the foregoing statement is replaced by
  55. c                s=1.0d0/scale(i). ..........
  56.          do 100 j = 1, m
  57.             zr(i,j) = zr(i,j) * s
  58.             zi(i,j) = zi(i,j) * s
  59.   100    continue
  60. c
  61.   110 continue
  62. c     .......... for i=low-1 step -1 until 1,
  63. c                igh+1 step 1 until n do -- ..........
  64.   120 do 140 ii = 1, n
  65.          i = ii
  66.          if (i .ge. low .and. i .le. igh) go to 140
  67.          if (i .lt. low) i = low - ii
  68.          k = scale(i)
  69.          if (k .eq. i) go to 140
  70. c
  71.          do 130 j = 1, m
  72.             s = zr(i,j)
  73.             zr(i,j) = zr(k,j)
  74.             zr(k,j) = s
  75.             s = zi(i,j)
  76.             zi(i,j) = zi(k,j)
  77.             zi(k,j) = s
  78.   130    continue
  79. c
  80.   140 continue
  81. c
  82.   200 return
  83.       end
  84.