home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / ch.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  71 lines
  1.       subroutine ch(nm,n,ar,ai,w,matz,zr,zi,fv1,fv2,fm1,ierr)
  2. c
  3.       integer i,j,n,nm,ierr,matz
  4.       double precision ar(nm,n),ai(nm,n),w(n),zr(nm,n),zi(nm,n),
  5.      x       fv1(n),fv2(n),fm1(2,n)
  6. c
  7. c     this subroutine calls the recommended sequence of
  8. c     subroutines from the eigensystem subroutine package (eispack)
  9. c     to find the eigenvalues and eigenvectors (if desired)
  10. c     of a complex hermitian matrix.
  11. c
  12. c     on input
  13. c
  14. c        nm  must be set to the row dimension of the two-dimensional
  15. c        array parameters as declared in the calling program
  16. c        dimension statement.
  17. c
  18. c        n  is the order of the matrix  a=(ar,ai).
  19. c
  20. c        ar  and  ai  contain the real and imaginary parts,
  21. c        respectively, of the complex hermitian matrix.
  22. c
  23. c        matz  is an integer variable set equal to zero if
  24. c        only eigenvalues are desired.  otherwise it is set to
  25. c        any non-zero integer for both eigenvalues and eigenvectors.
  26. c
  27. c     on output
  28. c
  29. c        w  contains the eigenvalues in ascending order.
  30. c
  31. c        zr  and  zi  contain the real and imaginary parts,
  32. c        respectively, of the eigenvectors if matz is not zero.
  33. c
  34. c        ierr  is an integer output variable set equal to an error
  35. c           completion code described in the documentation for tqlrat
  36. c           and tql2.  the normal completion code is zero.
  37. c
  38. c        fv1, fv2, and  fm1  are temporary storage arrays.
  39. c
  40. c     questions and comments should be directed to burton s. garbow,
  41. c     mathematics and computer science div, argonne national laboratory
  42. c
  43. c     this version dated august 1983.
  44. c
  45. c     ------------------------------------------------------------------
  46. c
  47.       if (n .le. nm) go to 10
  48.       ierr = 10 * n
  49.       go to 50
  50. c
  51.    10 call  htridi(nm,n,ar,ai,w,fv1,fv2,fm1)
  52.       if (matz .ne. 0) go to 20
  53. c     .......... find eigenvalues only ..........
  54.       call  tqlrat(n,w,fv2,ierr)
  55.       go to 50
  56. c     .......... find both eigenvalues and eigenvectors ..........
  57.    20 do 40 i = 1, n
  58. c
  59.          do 30 j = 1, n
  60.             zr(j,i) = 0.0d0
  61.    30    continue
  62. c
  63.          zr(i,i) = 1.0d0
  64.    40 continue
  65. c
  66.       call  tql2(nm,n,w,fv1,zr,ierr)
  67.       if (ierr .ne. 0) go to 50
  68.       call  htribk(nm,n,ar,ai,fm1,n,zr,zi)
  69.    50 return
  70.       end
  71.