~ubuntu-branches/ubuntu/utopic/nwchem/utopic

« back to all changes in this revision

Viewing changes to src/lapack/double/dsterf.f

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
*> \brief \b DSTERF
 
2
*
 
3
*  =========== DOCUMENTATION ===========
 
4
*
 
5
* Online html documentation available at 
 
6
*            http://www.netlib.org/lapack/explore-html/ 
 
7
*
 
8
*> \htmlonly
 
9
*> Download DSTERF + dependencies 
 
10
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsterf.f"> 
 
11
*> [TGZ]</a> 
 
12
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsterf.f"> 
 
13
*> [ZIP]</a> 
 
14
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsterf.f"> 
 
15
*> [TXT]</a>
 
16
*> \endhtmlonly 
 
17
*
 
18
*  Definition:
 
19
*  ===========
 
20
*
 
21
*       SUBROUTINE DSTERF( N, D, E, INFO )
 
22
 
23
*       .. Scalar Arguments ..
 
24
*       INTEGER            INFO, N
 
25
*       ..
 
26
*       .. Array Arguments ..
 
27
*       DOUBLE PRECISION   D( * ), E( * )
 
28
*       ..
 
29
*  
 
30
*
 
31
*> \par Purpose:
 
32
*  =============
 
33
*>
 
34
*> \verbatim
 
35
*>
 
36
*> DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
 
37
*> using the Pal-Walker-Kahan variant of the QL or QR algorithm.
 
38
*> \endverbatim
 
39
*
 
40
*  Arguments:
 
41
*  ==========
 
42
*
 
43
*> \param[in] N
 
44
*> \verbatim
 
45
*>          N is INTEGER
 
46
*>          The order of the matrix.  N >= 0.
 
47
*> \endverbatim
 
48
*>
 
49
*> \param[in,out] D
 
50
*> \verbatim
 
51
*>          D is DOUBLE PRECISION array, dimension (N)
 
52
*>          On entry, the n diagonal elements of the tridiagonal matrix.
 
53
*>          On exit, if INFO = 0, the eigenvalues in ascending order.
 
54
*> \endverbatim
 
55
*>
 
56
*> \param[in,out] E
 
57
*> \verbatim
 
58
*>          E is DOUBLE PRECISION array, dimension (N-1)
 
59
*>          On entry, the (n-1) subdiagonal elements of the tridiagonal
 
60
*>          matrix.
 
61
*>          On exit, E has been destroyed.
 
62
*> \endverbatim
 
63
*>
 
64
*> \param[out] INFO
 
65
*> \verbatim
 
66
*>          INFO is INTEGER
 
67
*>          = 0:  successful exit
 
68
*>          < 0:  if INFO = -i, the i-th argument had an illegal value
 
69
*>          > 0:  the algorithm failed to find all of the eigenvalues in
 
70
*>                a total of 30*N iterations; if INFO = i, then i
 
71
*>                elements of E have not converged to zero.
 
72
*> \endverbatim
 
73
*
 
74
*  Authors:
 
75
*  ========
 
76
*
 
77
*> \author Univ. of Tennessee 
 
78
*> \author Univ. of California Berkeley 
 
79
*> \author Univ. of Colorado Denver 
 
80
*> \author NAG Ltd. 
 
81
*
 
82
*> \date November 2011
 
83
*
 
84
*> \ingroup auxOTHERcomputational
 
85
*
 
86
*  =====================================================================
1
87
      SUBROUTINE DSTERF( N, D, E, INFO )
2
88
*
3
 
*  -- LAPACK routine (version 2.0) --
4
 
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5
 
*     Courant Institute, Argonne National Lab, and Rice University
6
 
*     September 30, 1994
 
89
*  -- LAPACK computational routine (version 3.4.0) --
 
90
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 
91
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
92
*     November 2011
7
93
*
8
94
*     .. Scalar Arguments ..
9
95
      INTEGER            INFO, N
12
98
      DOUBLE PRECISION   D( * ), E( * )
13
99
*     ..
14
100
*
15
 
c
16
 
* $Id: dsterf.f 19697 2010-10-29 16:57:34Z d3y133 $
17
 
c
18
 
*  Purpose
19
 
*  =======
20
 
*
21
 
*  DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
22
 
*  using the Pal-Walker-Kahan variant of the QL or QR algorithm.
23
 
*
24
 
*  Arguments
25
 
*  =========
26
 
*
27
 
*  N       (input) INTEGER
28
 
*          The order of the matrix.  N >= 0.
29
 
*
30
 
*  D       (input/output) DOUBLE PRECISION array, dimension (N)
31
 
*          On entry, the n diagonal elements of the tridiagonal matrix.
32
 
*          On exit, if INFO = 0, the eigenvalues in ascending order.
33
 
*
34
 
*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
35
 
*          On entry, the (n-1) subdiagonal elements of the tridiagonal
36
 
*          matrix.
37
 
*          On exit, E has been destroyed.
38
 
*
39
 
*  INFO    (output) INTEGER
40
 
*          = 0:  successful exit
41
 
*          < 0:  if INFO = -i, the i-th argument had an illegal value
42
 
*          > 0:  the algorithm failed to find all of the eigenvalues in
43
 
*                a total of 30*N iterations; if INFO = i, then i
44
 
*                elements of E have not converged to zero.
45
 
*
46
101
*  =====================================================================
47
102
*
48
103
*     .. Parameters ..
53
108
      PARAMETER          ( MAXIT = 30 )
54
109
*     ..
55
110
*     .. Local Scalars ..
56
 
      INTEGER            I, ISCALE, JTOT, L, L1, LEND, LENDM1, LENDP1,
57
 
     $                   LENDSV, LM1, LSV, M, MM1, NM1, NMAXIT
 
111
      INTEGER            I, ISCALE, JTOT, L, L1, LEND, LENDSV, LSV, M,
 
112
     $                   NMAXIT
58
113
      DOUBLE PRECISION   ALPHA, ANORM, BB, C, EPS, EPS2, GAMMA, OLDC,
59
114
     $                   OLDGAM, P, R, RT1, RT2, RTE, S, SAFMAX, SAFMIN,
60
 
     $                   SIGMA, SSFMAX, SSFMIN, TST
 
115
     $                   SIGMA, SSFMAX, SSFMIN, RMAX
61
116
*     ..
62
117
*     .. External Functions ..
63
118
      DOUBLE PRECISION   DLAMCH, DLANST, DLAPY2
93
148
      SAFMAX = ONE / SAFMIN
94
149
      SSFMAX = SQRT( SAFMAX ) / THREE
95
150
      SSFMIN = SQRT( SAFMIN ) / EPS2
 
151
      RMAX = DLAMCH( 'O' )
96
152
*
97
153
*     Compute the eigenvalues of the tridiagonal matrix.
98
154
*
105
161
*     element is smaller.
106
162
*
107
163
      L1 = 1
108
 
      NM1 = N - 1
109
164
*
110
165
   10 CONTINUE
111
166
      IF( L1.GT.N )
112
167
     $   GO TO 170
113
168
      IF( L1.GT.1 )
114
169
     $   E( L1-1 ) = ZERO
115
 
      IF( L1.LE.NM1 ) THEN
116
 
         DO 20 M = L1, NM1
117
 
            TST = ABS( E( M ) )
118
 
            IF( TST.EQ.ZERO )
119
 
     $         GO TO 30
120
 
            IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
121
 
     $          1 ) ) ) )*EPS ) THEN
122
 
               E( M ) = ZERO
123
 
               GO TO 30
124
 
            END IF
125
 
   20    CONTINUE
126
 
      END IF
 
170
      DO 20 M = L1, N - 1
 
171
         IF( ABS( E( M ) ).LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
 
172
     $       1 ) ) ) )*EPS ) THEN
 
173
            E( M ) = ZERO
 
174
            GO TO 30
 
175
         END IF
 
176
   20 CONTINUE
127
177
      M = N
128
178
*
129
179
   30 CONTINUE
137
187
*
138
188
*     Scale submatrix in rows and columns L to LEND
139
189
*
140
 
      ANORM = DLANST( 'I', LEND-L+1, D( L ), E( L ) )
 
190
      ANORM = DLANST( 'M', LEND-L+1, D( L ), E( L ) )
141
191
      ISCALE = 0
142
 
      IF( ANORM.GT.SSFMAX ) THEN
 
192
      IF( ANORM.EQ.ZERO )
 
193
     $   GO TO 10      
 
194
      IF( (ANORM.GT.SSFMAX) ) THEN
143
195
         ISCALE = 1
144
196
         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
145
197
     $                INFO )
172
224
*
173
225
   50    CONTINUE
174
226
         IF( L.NE.LEND ) THEN
175
 
            LENDM1 = LEND - 1
176
 
            DO 60 M = L, LENDM1
177
 
               TST = ABS( E( M ) )
178
 
               IF( TST.LE.EPS2*ABS( D( M )*D( M+1 ) ) )
 
227
            DO 60 M = L, LEND - 1
 
228
               IF( ABS( E( M ) ).LE.EPS2*ABS( D( M )*D( M+1 ) ) )
179
229
     $            GO TO 70
180
230
   60       CONTINUE
181
231
         END IF
182
 
*
183
232
         M = LEND
184
233
*
185
234
   70    CONTINUE
222
271
*
223
272
*        Inner loop
224
273
*
225
 
         MM1 = M - 1
226
 
         DO 80 I = MM1, L, -1
 
274
         DO 80 I = M - 1, L, -1
227
275
            BB = E( I )
228
276
            R = P + BB
229
277
            IF( I.NE.M-1 )
263
311
*        Look for small superdiagonal element.
264
312
*
265
313
  100    CONTINUE
266
 
         IF( L.NE.LEND ) THEN
267
 
            LENDP1 = LEND + 1
268
 
            DO 110 M = L, LENDP1, -1
269
 
               TST = ABS( E( M-1 ) )
270
 
               IF( TST.LE.EPS2*ABS( D( M )*D( M-1 ) ) )
271
 
     $            GO TO 120
272
 
  110       CONTINUE
273
 
         END IF
274
 
*
 
314
         DO 110 M = L, LEND + 1, -1
 
315
            IF( ABS( E( M-1 ) ).LE.EPS2*ABS( D( M )*D( M-1 ) ) )
 
316
     $         GO TO 120
 
317
  110    CONTINUE
275
318
         M = LEND
276
319
*
277
320
  120    CONTINUE
314
357
*
315
358
*        Inner loop
316
359
*
317
 
         LM1 = L - 1
318
 
         DO 130 I = M, LM1
 
360
         DO 130 I = M, L - 1
319
361
            BB = E( I )
320
362
            R = P + BB
321
363
            IF( I.NE.M )
334
376
            END IF
335
377
  130    CONTINUE
336
378
*
337
 
         E( LM1 ) = S*P
 
379
         E( L-1 ) = S*P
338
380
         D( L ) = SIGMA + GAMMA
339
381
         GO TO 100
340
382
*
363
405
*     Check for no convergence to an eigenvalue after a total
364
406
*     of N*MAXIT iterations.
365
407
*
366
 
      IF( JTOT.EQ.NMAXIT ) THEN
367
 
         DO 160 I = 1, N - 1
368
 
            IF( E( I ).NE.ZERO )
369
 
     $         INFO = INFO + 1
370
 
  160    CONTINUE
371
 
         RETURN
372
 
      END IF
373
 
      GO TO 10
 
408
      IF( JTOT.LT.NMAXIT )
 
409
     $   GO TO 10
 
410
      DO 160 I = 1, N - 1
 
411
         IF( E( I ).NE.ZERO )
 
412
     $      INFO = INFO + 1
 
413
  160 CONTINUE
 
414
      GO TO 180
374
415
*
375
416
*     Sort eigenvalues in increasing order.
376
417
*
377
418
  170 CONTINUE
378
419
      CALL DLASRT( 'I', N, D, INFO )
379
420
*
 
421
  180 CONTINUE
380
422
      RETURN
381
423
*
382
424
*     End of DSTERF