Télécharger dseigt.eso

Retour à la liste

Numérotation des lignes :

  1. C DSEIGT SOURCE GF238795 18/02/01 21:15:20 9724
  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. 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. c
  127. c %----------------------%
  128. c | External Subroutines |
  129. c %----------------------%
  130. c
  131. external dcopy, dstqrb, dvout, arscnd
  132. c
  133. c %-----------------------%
  134. c | Executable Statements |
  135. c %-----------------------%
  136. T0=0.D0
  137. T1=0.D0
  138. c
  139. c %-------------------------------%
  140. c | Initialize timing statistics |
  141. c | & message level for debugging |
  142. c %-------------------------------%
  143. c
  144. * call arscnd (t0)
  145. msglvl = mseigt
  146. c
  147. if (msglvl .gt. 0) then
  148. call dvout (logfil, n, h(1,2), ndigit,
  149. & '_seigt: main diagonal of matrix H')
  150. if (n .gt. 1) then
  151. call dvout (logfil, n-1, h(2,1), ndigit,
  152. & '_seigt: sub diagonal of matrix H')
  153. end if
  154. end if
  155. c
  156. call dcopy (n, h(1,2), 1, eig, 1)
  157. call dcopy (n-1, h(2,1), 1, workl, 1)
  158. call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
  159. if (ierr .ne. 0) go to 9000
  160. if (msglvl .gt. 1) then
  161. call dvout (logfil, n, bounds, ndigit,
  162. & '_seigt: last row of the eigenvector matrix for H')
  163. end if
  164. c
  165. c %-----------------------------------------------%
  166. c | Finally determine the error bounds associated |
  167. c | with the n Ritz values of H. |
  168. c %-----------------------------------------------%
  169. c
  170. do 30 k = 1, n
  171. bounds(k) = rnorm*abs(bounds(k))
  172. 30 continue
  173. c
  174. * call arscnd (t1)
  175. tseigt = tseigt + (t1 - t0)
  176. c
  177. 9000 continue
  178. return
  179. c
  180. c %---------------%
  181. c | End of dseigt |
  182. c %---------------%
  183. c
  184. end
  185.  
  186.  
  187.  

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