← Back to branch summary

~ubuntu-branches/ubuntu/karmic/python-scipy/karmic

« back to all changes in this revision

Viewing changes to Lib/sandbox/arpack/ARPACK/SRC/sseigt.f

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
http://bugs.debian.org/489149
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

Lines of Context:
Lib/sandbox/arpack/ARPACK/SRC/sseigt.f
1
 
c-----------------------------------------------------------------------
2
 
c\BeginDoc
3
 
c
4
 
c\Name: sseigt
5
 
c
6
 
c\Description: 
7
 
c  Compute the eigenvalues of the current symmetric tridiagonal matrix
8
 
c  and the corresponding error bounds given the current residual norm.
9
 
c
10
 
c\Usage:
11
 
c  call sseigt
12
 
c     ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
13
 
c
14
 
c\Arguments
15
 
c  RNORM   Real scalar.  (INPUT)
16
 
c          RNORM contains the residual norm corresponding to the current
17
 
c          symmetric tridiagonal matrix H.
18
 
c
19
 
c  N       Integer.  (INPUT)
20
 
c          Size of the symmetric tridiagonal matrix H.
21
 
c
22
 
c  H       Real N by 2 array.  (INPUT)
23
 
c          H contains the symmetric tridiagonal matrix with the 
24
 
c          subdiagonal in the first column starting at H(2,1) and the 
25
 
c          main diagonal in second column.
26
 
c
27
 
c  LDH     Integer.  (INPUT)
28
 
c          Leading dimension of H exactly as declared in the calling 
29
 
c          program.
30
 
c
31
 
c  EIG     Real array of length N.  (OUTPUT)
32
 
c          On output, EIG contains the N eigenvalues of H possibly 
33
 
c          unsorted.  The BOUNDS arrays are returned in the
34
 
c          same sorted order as EIG.
35
 
c
36
 
c  BOUNDS  Real array of length N.  (OUTPUT)
37
 
c          On output, BOUNDS contains the error estimates corresponding
38
 
c          to the eigenvalues EIG.  This is equal to RNORM times the
39
 
c          last components of the eigenvectors corresponding to the
40
 
c          eigenvalues in EIG.
41
 
c
42
 
c  WORKL   Real work array of length 3*N.  (WORKSPACE)
43
 
c          Private (replicated) array on each PE or array allocated on
44
 
c          the front end.
45
 
c
46
 
c  IERR    Integer.  (OUTPUT)
47
 
c          Error exit flag from sstqrb.
48
 
c
49
 
c\EndDoc
50
 
c
51
 
c-----------------------------------------------------------------------
52
 
c
53
 
c\BeginLib
54
 
c
55
 
c\Local variables:
56
 
c     xxxxxx  real
57
 
c
58
 
c\Routines called:
59
 
c     sstqrb  ARPACK routine that computes the eigenvalues and the
60
 
c             last components of the eigenvectors of a symmetric
61
 
c             and tridiagonal matrix.
62
 
c     second  ARPACK utility routine for timing.
63
 
c     svout   ARPACK utility routine that prints vectors.
64
 
c     scopy   Level 1 BLAS that copies one vector to another.
65
 
c
66
 
c\Author
67
 
c     Danny Sorensen               Phuong Vu
68
 
c     Richard Lehoucq              CRPC / Rice University 
69
 
c     Dept. of Computational &     Houston, Texas 
70
 
c     Applied Mathematics
71
 
c     Rice University           
72
 
c     Houston, Texas            
73
 
c
74
 
c\Revision history:
75
 
c     xx/xx/92: Version ' 2.4'
76
 
c
77
 
c\SCCS Information: @(#) 
78
 
c FILE: seigt.F   SID: 2.4   DATE OF SID: 8/27/96   RELEASE: 2
79
 
c
80
 
c\Remarks
81
 
c     None
82
 
c
83
 
c\EndLib
84
 
c
85
 
c-----------------------------------------------------------------------
86
 
c
87
 
      subroutine sseigt 
88
 
     &   ( rnorm, n, h, ldh, eig, bounds, workl, ierr )
89
 
c
90
 
c     %----------------------------------------------------%
91
 
c     | Include files for debugging and timing information |
92
 
c     %----------------------------------------------------%
93
 
c
94
 
      include   'debug.h'
95
 
      include   'stat.h'
96
 
c
97
 
c     %------------------%
98
 
c     | Scalar Arguments |
99
 
c     %------------------%
100
 
c
101
 
      integer    ierr, ldh, n
102
 
      Real
103
 
     &           rnorm
104
 
c
105
 
c     %-----------------%
106
 
c     | Array Arguments |
107
 
c     %-----------------%
108
 
c
109
 
      Real
110
 
     &           eig(n), bounds(n), h(ldh,2), workl(3*n)
111
 
c
112
 
c     %------------%
113
 
c     | Parameters |
114
 
c     %------------%
115
 
c
116
 
      Real
117
 
     &           zero
118
 
      parameter (zero = 0.0E+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   scopy, sstqrb, svout, second
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 second (t0)
142
 
      msglvl = mseigt
143
 
c
144
 
      if (msglvl .gt. 0) then
145
 
         call svout (logfil, n, h(1,2), ndigit,
146
 
     &              '_seigt: main diagonal of matrix H')
147
 
         if (n .gt. 1) then
148
 
         call svout (logfil, n-1, h(2,1), ndigit,
149
 
     &              '_seigt: sub diagonal of matrix H')
150
 
         end if
151
 
      end if
152
 
c
153
 
      call scopy  (n, h(1,2), 1, eig, 1)
154
 
      call scopy  (n-1, h(2,1), 1, workl, 1)
155
 
      call sstqrb (n, eig, workl, bounds, workl(n+1), ierr)
156
 
      if (ierr .ne. 0) go to 9000
157
 
      if (msglvl .gt. 1) then
158
 
         call svout (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 second (t1)
172
 
      tseigt = tseigt + (t1 - t0)
173
 
c
174
 
 9000 continue
175
 
      return
176
 
c
177
 
c     %---------------%
178
 
c     | End of sseigt |
179
 
c     %---------------%
180
 
c
181
 
      end