Télécharger la plaquette Cast3M


fr en

Télécharger dseigt.eso

Retour à la liste

Numérotation des lignes : 

dseigt

  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