rsg.f 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. *DECK RSG
  2. SUBROUTINE RSG (NM, N, A, B, W, MATZ, Z, FV1, FV2, IERR)
  3. C***BEGIN PROLOGUE RSG
  4. C***PURPOSE Compute the eigenvalues and, optionally, the eigenvectors
  5. C of a symmetric generalized eigenproblem.
  6. C***LIBRARY SLATEC (EISPACK)
  7. C***CATEGORY D4B1
  8. C***TYPE SINGLE PRECISION (RSG-S)
  9. C***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
  10. C***AUTHOR Smith, B. T., et al.
  11. C***DESCRIPTION
  12. C
  13. C This subroutine calls the recommended sequence of
  14. C subroutines from the eigensystem subroutine package (EISPACK)
  15. C To find the eigenvalues and eigenvectors (if desired)
  16. C for the REAL SYMMETRIC generalized eigenproblem Ax = (LAMBDA)Bx.
  17. C
  18. C On Input
  19. C
  20. C NM must be set to the row dimension of the two-dimensional
  21. C array parameters, A, B, and Z, as declared in the calling
  22. C program dimension statement. NM is an INTEGER variable.
  23. C
  24. C N is the order of the matrices A and B. N is an INTEGER
  25. C variable. N must be less than or equal to NM.
  26. C
  27. C A contains a real symmetric matrix. A is a two-dimensional
  28. C REAL array, dimensioned A(NM,N).
  29. C
  30. C B contains a positive definite real symmetric matrix. B is a
  31. C two-dimensional REAL array, dimensioned B(NM,N).
  32. C
  33. C MATZ is an INTEGER variable set equal to zero if only
  34. C eigenvalues are desired. Otherwise, it is set to any
  35. C non-zero integer for both eigenvalues and eigenvectors.
  36. C
  37. C On Output
  38. C
  39. C W contains the eigenvalues in ascending order. W is a
  40. C one-dimensional REAL array, dimensioned W(N).
  41. C
  42. C Z contains the eigenvectors if MATZ is not zero. Z is a
  43. C two-dimensional REAL array, dimensioned Z(NM,N).
  44. C
  45. C IERR is an INTEGER flag set to
  46. C Zero for normal return,
  47. C 10*N if N is greater than NM,
  48. C 7*N+1 if B is not positive definite,
  49. C J if the J-th eigenvalue has not been
  50. C determined after 30 iterations.
  51. C The eigenvalues should be correct for indices
  52. C 1, 2, ..., IERR-1, but no eigenvectors are
  53. C computed.
  54. C
  55. C FV1 and FV2 are one-dimensional REAL arrays used for temporary
  56. C storage, dimensioned FV1(N) and FV2(N).
  57. C
  58. C Questions and comments should be directed to B. S. Garbow,
  59. C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
  60. C ------------------------------------------------------------------
  61. C
  62. C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
  63. C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
  64. C system Routines - EISPACK Guide, Springer-Verlag,
  65. C 1976.
  66. C***ROUTINES CALLED REBAK, REDUC, TQL2, TQLRAT, TRED1, TRED2
  67. C***REVISION HISTORY (YYMMDD)
  68. C 760101 DATE WRITTEN
  69. C 890831 Modified array declarations. (WRB)
  70. C 890831 REVISION DATE from Version 3.2
  71. C 891214 Prologue converted to Version 4.0 format. (BAB)
  72. C 920501 Reformatted the REFERENCES section. (WRB)
  73. C***END PROLOGUE RSG
  74. C
  75. INTEGER N,NM,IERR,MATZ
  76. REAL A(NM,*),B(NM,*),W(*),Z(NM,*),FV1(*),FV2(*)
  77. C
  78. C***FIRST EXECUTABLE STATEMENT RSG
  79. IF (N .LE. NM) GO TO 10
  80. IERR = 10 * N
  81. GO TO 50
  82. C
  83. 10 CALL REDUC(NM,N,A,B,FV2,IERR)
  84. IF (IERR .NE. 0) GO TO 50
  85. IF (MATZ .NE. 0) GO TO 20
  86. C .......... FIND EIGENVALUES ONLY ..........
  87. CALL TRED1(NM,N,A,W,FV1,FV2)
  88. CALL TQLRAT(N,W,FV2,IERR)
  89. GO TO 50
  90. C .......... FIND BOTH EIGENVALUES AND EIGENVECTORS ..........
  91. 20 CALL TRED2(NM,N,A,W,FV1,Z)
  92. CALL TQL2(NM,N,W,FV1,Z,IERR)
  93. IF (IERR .NE. 0) GO TO 50
  94. CALL REBAK(NM,N,B,FV2,N,Z)
  95. 50 RETURN
  96. END