← Back to branch summary

~ubuntu-branches/ubuntu/saucy/python-scipy/saucy

« back to all changes in this revision

Viewing changes to scipy/sandbox/arpack/ARPACK/SRC/dseigt.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:
scipy/sandbox/arpack/ARPACK/SRC/dseigt.f
 
1
c-----------------------------------------------------------------------
 
2
c\BeginDoc
 
3
c
 
4
c\Name: dseigt
 
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 dseigt
 
12
c     ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
 
13
c
 
14
c\Arguments
 
15
c  RNORM   Double precision 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       Double precision 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     Double precision 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  Double precision 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   Double precision 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 dstqrb.
 
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     dstqrb  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     dvout   ARPACK utility routine that prints vectors.
 
64
c     dcopy   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 dseigt 
 
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
      Double precision
 
103
     &           rnorm
 
104
c
 
105
c     %-----------------%
 
106
c     | Array Arguments |
 
107
c     %-----------------%
 
108
c
 
109
      Double precision
 
110
     &           eig(n), bounds(n), h(ldh,2), workl(3*n)
 
111
c
 
112
c     %------------%
 
113
c     | Parameters |
 
114
c     %------------%
 
115
c
 
116
      Double precision
 
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, 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 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 second (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