Télécharger dseigt.eso

Retour à la liste

Numérotation des lignes :

  1. C DSEIGT SOURCE BP208322 20/02/06 21:15:30 10512
  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. -> deleted by BP in 2020
  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. c -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. real*8 T0,T1
  105. c
  106. c %-----------------%
  107. c | Array Arguments |
  108. c %-----------------%
  109. c
  110. REAL*8
  111. & eig(n), bounds(n), h(ldh,2), workl(3*n)
  112. c
  113. c %------------%
  114. c | Parameters |
  115. c %------------%
  116. c
  117. REAL*8
  118. & zero
  119. parameter (zero = 0.0D+0)
  120. c
  121. c %---------------%
  122. c | Local Scalars |
  123. c %---------------%
  124. c
  125. integer i, k, msglvl
  126. parameter (msglvl=0)
  127. c
  128. c %----------------------%
  129. c | External Subroutines |
  130. c %----------------------%
  131. c
  132. external dcopy, dstqrb, dvout
  133. c
  134. c %-----------------------%
  135. c | Executable Statements |
  136. c %-----------------------%
  137. c T0=0.D0
  138. c T1=0.D0
  139. c
  140. c %-------------------------------%
  141. c | Initialize timing statistics |
  142. c | & message level for debugging |
  143. c %-------------------------------%
  144. c
  145. * call arscnd (t0)
  146. c msglvl = mseigt
  147. c
  148. if (msglvl .gt. 0) then
  149. call dvout ( n, h(1,2), ndigit,
  150. & '_seigt: main diagonal of matrix H')
  151. if (n .gt. 1) then
  152. call dvout ( n-1, h(2,1), ndigit,
  153. & '_seigt: sub diagonal of matrix H')
  154. end if
  155. end if
  156. c
  157. call dcopy (n, h(1,2), 1, eig, 1)
  158. call dcopy (n-1, h(2,1), 1, workl, 1)
  159. call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
  160. if (ierr .ne. 0) go to 9000
  161. c if (msglvl .gt. 1) then
  162. c call dvout ( n, bounds, ndigit,
  163. c & '_seigt: last row of the eigenvector matrix for H')
  164. c end if
  165. c
  166. c %-----------------------------------------------%
  167. c | Finally determine the error bounds associated |
  168. c | with the n Ritz values of H. |
  169. c %-----------------------------------------------%
  170. c
  171. do 30 k = 1, n
  172. bounds(k) = rnorm*abs(bounds(k))
  173. 30 continue
  174. c
  175. * call arscnd (t1)
  176. c tseigt = tseigt + (t1 - t0)
  177. c
  178. 9000 continue
  179. c return
  180. c
  181. c %---------------%
  182. c | End of dseigt |
  183. c %---------------%
  184. c
  185. end
  186.  
  187.  
  188.  
  189.  

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