home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / rsp.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  77 lines
  1.       subroutine rsp(nm,n,nv,a,w,matz,z,fv1,fv2,ierr)
  2. c
  3.       integer i,j,n,nm,nv,ierr,matz
  4.       double precision a(nv),w(n),z(nm,n),fv1(n),fv2(n)
  5. c
  6. c     this subroutine calls the recommended sequence of
  7. c     subroutines from the eigensystem subroutine package (eispack)
  8. c     to find the eigenvalues and eigenvectors (if desired)
  9. c     of a real symmetric packed matrix.
  10. c
  11. c     on input
  12. c
  13. c        nm  must be set to the row dimension of the two-dimensional
  14. c        array parameters as declared in the calling program
  15. c        dimension statement.
  16. c
  17. c        n  is the order of the matrix  a.
  18. c
  19. c        nv  is an integer variable set equal to the
  20. c        dimension of the array  a  as specified for
  21. c        a  in the calling program.  nv  must not be
  22. c        less than  n*(n+1)/2.
  23. c
  24. c        a  contains the lower triangle of the real symmetric
  25. c        packed matrix stored row-wise.
  26. c
  27. c        matz  is an integer variable set equal to zero if
  28. c        only eigenvalues are desired.  otherwise it is set to
  29. c        any non-zero integer for both eigenvalues and eigenvectors.
  30. c
  31. c     on output
  32. c
  33. c        w  contains the eigenvalues in ascending order.
  34. c
  35. c        z  contains the eigenvectors if matz is not zero.
  36. c
  37. c        ierr  is an integer output variable set equal to an error
  38. c           completion code described in the documentation for tqlrat
  39. c           and tql2.  the normal completion code is zero.
  40. c
  41. c        fv1  and  fv2  are temporary storage arrays.
  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 (n .le. nm) go to 5
  51.       ierr = 10 * n
  52.       go to 50
  53.     5 if (nv .ge. (n * (n + 1)) / 2) go to 10
  54.       ierr = 20 * n
  55.       go to 50
  56. c
  57.    10 call  tred3(n,nv,a,w,fv1,fv2)
  58.       if (matz .ne. 0) go to 20
  59. c     .......... find eigenvalues only ..........
  60.       call  tqlrat(n,w,fv2,ierr)
  61.       go to 50
  62. c     .......... find both eigenvalues and eigenvectors ..........
  63.    20 do 40 i = 1, n
  64. c
  65.          do 30 j = 1, n
  66.             z(j,i) = 0.0d0
  67.    30    continue
  68. c
  69.          z(i,i) = 1.0d0
  70.    40 continue
  71. c
  72.       call  tql2(nm,n,w,fv1,z,ierr)
  73.       if (ierr .ne. 0) go to 50
  74.       call  trbak3(nm,n,nv,a,n,z)
  75.    50 return
  76.       end
  77.