Télécharger dseigt.eso

Retour à la liste

Numérotation des lignes :

  1. C DSEIGT SOURCE BP208322 15/10/13 21:15:52 8670
  2. c-----------------------------------------------------------------------
  3. c\BeginDoc
  4. c
  5. c\Name: dseigt
  6. c
  7. c\Description:
  8. c Compute the eigenvalues of the current symmetric tridiagonal matrix
  9. c and the corresponding error bounds given the current residual norm.
  10. c
  11. c\Usage:
  12. c call dseigt
  13. c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
  14. c
  15. c\Arguments
  16. c RNORM Double precision scalar. (INPUT)
  17. c RNORM contains the residual norm corresponding to the current
  18. c symmetric tridiagonal matrix H.
  19. c
  20. c N Integer. (INPUT)
  21. c Size of the symmetric tridiagonal matrix H.
  22. c
  23. c H REAL*8 N by 2 array. (INPUT)
  24. c H contains the symmetric tridiagonal matrix with the
  25. c subdiagonal in the first column starting at H(2,1) and the
  26. c main diagonal in second column.
  27. c
  28. c LDH Integer. (INPUT)
  29. c Leading dimension of H exactly as declared in the calling
  30. c program.
  31. c
  32. c EIG Double precision array of length N. (OUTPUT)
  33. c On output, EIG contains the N eigenvalues of H possibly
  34. c unsorted. The BOUNDS arrays are returned in the
  35. c same sorted order as EIG.
  36. c
  37. c BOUNDS Double precision array of length N. (OUTPUT)
  38. c On output, BOUNDS contains the error estimates corresponding
  39. c to the eigenvalues EIG. This is equal to RNORM times the
  40. c last components of the eigenvectors corresponding to the
  41. c eigenvalues in EIG.
  42. c
  43. c WORKL Double precision work array of length 3*N. (WORKSPACE)
  44. c Private (replicated) array on each PE or array allocated on
  45. c the front end.
  46. c
  47. c IERR Integer. (OUTPUT)
  48. c Error exit flag from dstqrb.
  49. c
  50. c\EndDoc
  51. c
  52. c-----------------------------------------------------------------------
  53. c
  54. c\BeginLib
  55. c
  56. c\Local variables:
  57. c xxxxxx real
  58. c
  59. c\Routines called:
  60. c dstqrb ARPACK routine that computes the eigenvalues and the
  61. c last components of the eigenvectors of a symmetric
  62. c and tridiagonal matrix.
  63. c arscnd ARPACK utility routine for timing.
  64. c dvout ARPACK utility routine that prints vectors.
  65. c dcopy Level 1 BLAS that copies one vector to another.
  66. c
  67. c\Author
  68. c Danny Sorensen Phuong Vu
  69. c Richard Lehoucq CRPC / Rice University
  70. c Dept. of Computational & Houston, Texas
  71. c Applied Mathematics
  72. c Rice University
  73. c Houston, Texas
  74. c
  75. c\Revision history:
  76. c xx/xx/92: Version ' 2.4'
  77. c
  78. c\SCCS Information: @(#)
  79. c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
  80. c
  81. c\Remarks
  82. c None
  83. c
  84. c\EndLib
  85. c
  86. c-----------------------------------------------------------------------
  87. c
  88. subroutine dseigt
  89. & ( rnorm, n, h, ldh, eig, bounds, workl, ierr )
  90. c
  91. c %----------------------------------------------------%
  92. c | Include files for debugging and timing information |
  93. -INC TARTRAK
  94. c %----------------------------------------------------%
  95. c
  96. c
  97. c %------------------%
  98. c | Scalar Arguments |
  99. c %------------------%
  100. c
  101. integer ierr, ldh, n
  102. REAL*8
  103. & rnorm
  104. c
  105. c %-----------------%
  106. c | Array Arguments |
  107. c %-----------------%
  108. c
  109. REAL*8
  110. & eig(n), bounds(n), h(ldh,2), workl(3*n)
  111. c
  112. c %------------%
  113. c | Parameters |
  114. c %------------%
  115. c
  116. REAL*8
  117. & zero
  118. parameter (zero = 0.0D+0)
  119. c
  120. c %---------------%
  121. c | Local Scalars |
  122. c %---------------%
  123. c
  124. integer i, k, msglvl
  125. c
  126. c %----------------------%
  127. c | External Subroutines |
  128. c %----------------------%
  129. c
  130. external dcopy, dstqrb, dvout, arscnd
  131. c
  132. c %-----------------------%
  133. c | Executable Statements |
  134. c %-----------------------%
  135. c
  136. c %-------------------------------%
  137. c | Initialize timing statistics |
  138. c | & message level for debugging |
  139. c %-------------------------------%
  140. c
  141. * call arscnd (t0)
  142. msglvl = mseigt
  143. c
  144. if (msglvl .gt. 0) then
  145. call dvout (logfil, n, h(1,2), ndigit,
  146. & '_seigt: main diagonal of matrix H')
  147. if (n .gt. 1) then
  148. call dvout (logfil, n-1, h(2,1), ndigit,
  149. & '_seigt: sub diagonal of matrix H')
  150. end if
  151. end if
  152. c
  153. call dcopy (n, h(1,2), 1, eig, 1)
  154. call dcopy (n-1, h(2,1), 1, workl, 1)
  155. call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
  156. if (ierr .ne. 0) go to 9000
  157. if (msglvl .gt. 1) then
  158. call dvout (logfil, n, bounds, ndigit,
  159. & '_seigt: last row of the eigenvector matrix for H')
  160. end if
  161. c
  162. c %-----------------------------------------------%
  163. c | Finally determine the error bounds associated |
  164. c | with the n Ritz values of H. |
  165. c %-----------------------------------------------%
  166. c
  167. do 30 k = 1, n
  168. bounds(k) = rnorm*abs(bounds(k))
  169. 30 continue
  170. c
  171. * call arscnd (t1)
  172. tseigt = tseigt + (t1 - t0)
  173. c
  174. 9000 continue
  175. return
  176. c
  177. c %---------------%
  178. c | End of dseigt |
  179. c %---------------%
  180. c
  181. end
  182.  
  183.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales