← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/lapack/single/chetrd.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
http://bugs.debian.org/696361
* 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:
src/lapack/single/chetrd.f
 
1
*> \brief \b CHETRD
 
2
*
 
3
*  =========== DOCUMENTATION ===========
 
4
*
 
5
* Online html documentation available at 
 
6
*            http://www.netlib.org/lapack/explore-html/ 
 
7
*
 
8
*> \htmlonly
 
9
*> Download CHETRD + dependencies 
 
10
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrd.f"> 
 
11
*> [TGZ]</a> 
 
12
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrd.f"> 
 
13
*> [ZIP]</a> 
 
14
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrd.f"> 
 
15
*> [TXT]</a>
 
16
*> \endhtmlonly 
 
17
*
 
18
*  Definition:
 
19
*  ===========
 
20
*
 
21
*       SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 
22
* 
 
23
*       .. Scalar Arguments ..
 
24
*       CHARACTER          UPLO
 
25
*       INTEGER            INFO, LDA, LWORK, N
 
26
*       ..
 
27
*       .. Array Arguments ..
 
28
*       REAL               D( * ), E( * )
 
29
*       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
 
30
*       ..
 
31
*  
 
32
*
 
33
*> \par Purpose:
 
34
*  =============
 
35
*>
 
36
*> \verbatim
 
37
*>
 
38
*> CHETRD reduces a complex Hermitian matrix A to real symmetric
 
39
*> tridiagonal form T by a unitary similarity transformation:
 
40
*> Q**H * A * Q = T.
 
41
*> \endverbatim
 
42
*
 
43
*  Arguments:
 
44
*  ==========
 
45
*
 
46
*> \param[in] UPLO
 
47
*> \verbatim
 
48
*>          UPLO is CHARACTER*1
 
49
*>          = 'U':  Upper triangle of A is stored;
 
50
*>          = 'L':  Lower triangle of A is stored.
 
51
*> \endverbatim
 
52
*>
 
53
*> \param[in] N
 
54
*> \verbatim
 
55
*>          N is INTEGER
 
56
*>          The order of the matrix A.  N >= 0.
 
57
*> \endverbatim
 
58
*>
 
59
*> \param[in,out] A
 
60
*> \verbatim
 
61
*>          A is COMPLEX array, dimension (LDA,N)
 
62
*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
 
63
*>          N-by-N upper triangular part of A contains the upper
 
64
*>          triangular part of the matrix A, and the strictly lower
 
65
*>          triangular part of A is not referenced.  If UPLO = 'L', the
 
66
*>          leading N-by-N lower triangular part of A contains the lower
 
67
*>          triangular part of the matrix A, and the strictly upper
 
68
*>          triangular part of A is not referenced.
 
69
*>          On exit, if UPLO = 'U', the diagonal and first superdiagonal
 
70
*>          of A are overwritten by the corresponding elements of the
 
71
*>          tridiagonal matrix T, and the elements above the first
 
72
*>          superdiagonal, with the array TAU, represent the unitary
 
73
*>          matrix Q as a product of elementary reflectors; if UPLO
 
74
*>          = 'L', the diagonal and first subdiagonal of A are over-
 
75
*>          written by the corresponding elements of the tridiagonal
 
76
*>          matrix T, and the elements below the first subdiagonal, with
 
77
*>          the array TAU, represent the unitary matrix Q as a product
 
78
*>          of elementary reflectors. See Further Details.
 
79
*> \endverbatim
 
80
*>
 
81
*> \param[in] LDA
 
82
*> \verbatim
 
83
*>          LDA is INTEGER
 
84
*>          The leading dimension of the array A.  LDA >= max(1,N).
 
85
*> \endverbatim
 
86
*>
 
87
*> \param[out] D
 
88
*> \verbatim
 
89
*>          D is REAL array, dimension (N)
 
90
*>          The diagonal elements of the tridiagonal matrix T:
 
91
*>          D(i) = A(i,i).
 
92
*> \endverbatim
 
93
*>
 
94
*> \param[out] E
 
95
*> \verbatim
 
96
*>          E is REAL array, dimension (N-1)
 
97
*>          The off-diagonal elements of the tridiagonal matrix T:
 
98
*>          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
 
99
*> \endverbatim
 
100
*>
 
101
*> \param[out] TAU
 
102
*> \verbatim
 
103
*>          TAU is COMPLEX array, dimension (N-1)
 
104
*>          The scalar factors of the elementary reflectors (see Further
 
105
*>          Details).
 
106
*> \endverbatim
 
107
*>
 
108
*> \param[out] WORK
 
109
*> \verbatim
 
110
*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
 
111
*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 
112
*> \endverbatim
 
113
*>
 
114
*> \param[in] LWORK
 
115
*> \verbatim
 
116
*>          LWORK is INTEGER
 
117
*>          The dimension of the array WORK.  LWORK >= 1.
 
118
*>          For optimum performance LWORK >= N*NB, where NB is the
 
119
*>          optimal blocksize.
 
120
*>
 
121
*>          If LWORK = -1, then a workspace query is assumed; the routine
 
122
*>          only calculates the optimal size of the WORK array, returns
 
123
*>          this value as the first entry of the WORK array, and no error
 
124
*>          message related to LWORK is issued by XERBLA.
 
125
*> \endverbatim
 
126
*>
 
127
*> \param[out] INFO
 
128
*> \verbatim
 
129
*>          INFO is INTEGER
 
130
*>          = 0:  successful exit
 
131
*>          < 0:  if INFO = -i, the i-th argument had an illegal value
 
132
*> \endverbatim
 
133
*
 
134
*  Authors:
 
135
*  ========
 
136
*
 
137
*> \author Univ. of Tennessee 
 
138
*> \author Univ. of California Berkeley 
 
139
*> \author Univ. of Colorado Denver 
 
140
*> \author NAG Ltd. 
 
141
*
 
142
*> \date November 2011
 
143
*
 
144
*> \ingroup complexHEcomputational
 
145
*
 
146
*> \par Further Details:
 
147
*  =====================
 
148
*>
 
149
*> \verbatim
 
150
*>
 
151
*>  If UPLO = 'U', the matrix Q is represented as a product of elementary
 
152
*>  reflectors
 
153
*>
 
154
*>     Q = H(n-1) . . . H(2) H(1).
 
155
*>
 
156
*>  Each H(i) has the form
 
157
*>
 
158
*>     H(i) = I - tau * v * v**H
 
159
*>
 
160
*>  where tau is a complex scalar, and v is a complex vector with
 
161
*>  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
 
162
*>  A(1:i-1,i+1), and tau in TAU(i).
 
163
*>
 
164
*>  If UPLO = 'L', the matrix Q is represented as a product of elementary
 
165
*>  reflectors
 
166
*>
 
167
*>     Q = H(1) H(2) . . . H(n-1).
 
168
*>
 
169
*>  Each H(i) has the form
 
170
*>
 
171
*>     H(i) = I - tau * v * v**H
 
172
*>
 
173
*>  where tau is a complex scalar, and v is a complex vector with
 
174
*>  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
 
175
*>  and tau in TAU(i).
 
176
*>
 
177
*>  The contents of A on exit are illustrated by the following examples
 
178
*>  with n = 5:
 
179
*>
 
180
*>  if UPLO = 'U':                       if UPLO = 'L':
 
181
*>
 
182
*>    (  d   e   v2  v3  v4 )              (  d                  )
 
183
*>    (      d   e   v3  v4 )              (  e   d              )
 
184
*>    (          d   e   v4 )              (  v1  e   d          )
 
185
*>    (              d   e  )              (  v1  v2  e   d      )
 
186
*>    (                  d  )              (  v1  v2  v3  e   d  )
 
187
*>
 
188
*>  where d and e denote diagonal and off-diagonal elements of T, and vi
 
189
*>  denotes an element of the vector defining H(i).
 
190
*> \endverbatim
 
191
*>
 
192
*  =====================================================================
1
193
      SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
2
194
*
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 
 
195
*  -- LAPACK computational routine (version 3.4.0) --
 
196
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 
197
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
198
*     November 2011
7
199
*
8
200
*     .. Scalar Arguments ..
9
201
      CHARACTER          UPLO
14
206
      COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
15
207
*     ..
16
208
*
17
 
c
18
 
* $Id: chetrd.f 19697 2010-10-29 16:57:34Z d3y133 $
19
 
c
20
 
*  Purpose
21
 
*  =======
22
 
*
23
 
*  CHETRD reduces a complex Hermitian matrix A to real symmetric
24
 
*  tridiagonal form T by a unitary similarity transformation:
25
 
*  Q**H * A * Q = T.
26
 
*
27
 
*  Arguments
28
 
*  =========
29
 
*
30
 
*  UPLO    (input) CHARACTER*1
31
 
*          = 'U':  Upper triangle of A is stored;
32
 
*          = 'L':  Lower triangle of A is stored.
33
 
*
34
 
*  N       (input) INTEGER
35
 
*          The order of the matrix A.  N >= 0.
36
 
*
37
 
*  A       (input/output) COMPLEX array, dimension (LDA,N)
38
 
*          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
39
 
*          N-by-N upper triangular part of A contains the upper
40
 
*          triangular part of the matrix A, and the strictly lower
41
 
*          triangular part of A is not referenced.  If UPLO = 'L', the
42
 
*          leading N-by-N lower triangular part of A contains the lower
43
 
*          triangular part of the matrix A, and the strictly upper
44
 
*          triangular part of A is not referenced.
45
 
*          On exit, if UPLO = 'U', the diagonal and first superdiagonal
46
 
*          of A are overwritten by the corresponding elements of the
47
 
*          tridiagonal matrix T, and the elements above the first
48
 
*          superdiagonal, with the array TAU, represent the unitary
49
 
*          matrix Q as a product of elementary reflectors; if UPLO
50
 
*          = 'L', the diagonal and first subdiagonal of A are over-
51
 
*          written by the corresponding elements of the tridiagonal
52
 
*          matrix T, and the elements below the first subdiagonal, with
53
 
*          the array TAU, represent the unitary matrix Q as a product
54
 
*          of elementary reflectors. See Further Details.
55
 
*
56
 
*  LDA     (input) INTEGER
57
 
*          The leading dimension of the array A.  LDA >= max(1,N).
58
 
*
59
 
*  D       (output) REAL array, dimension (N)
60
 
*          The diagonal elements of the tridiagonal matrix T:
61
 
*          D(i) = A(i,i).
62
 
*
63
 
*  E       (output) REAL array, dimension (N-1)
64
 
*          The off-diagonal elements of the tridiagonal matrix T:
65
 
*          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
66
 
*
67
 
*  TAU     (output) COMPLEX array, dimension (N-1)
68
 
*          The scalar factors of the elementary reflectors (see Further
69
 
*          Details).
70
 
*
71
 
*  WORK    (workspace/output) COMPLEX array, dimension (LWORK)
72
 
*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
73
 
*
74
 
*  LWORK   (input) INTEGER
75
 
*          The dimension of the array WORK.  LWORK >= 1.
76
 
*          For optimum performance LWORK >= N*NB, where NB is the
77
 
*          optimal blocksize.
78
 
*
79
 
*  INFO    (output) INTEGER
80
 
*          = 0:  successful exit
81
 
*          < 0:  if INFO = -i, the i-th argument had an illegal value
82
 
*
83
 
*  Further Details
84
 
*  ===============
85
 
*
86
 
*  If UPLO = 'U', the matrix Q is represented as a product of elementary
87
 
*  reflectors
88
 
*
89
 
*     Q = H(n-1) . . . H(2) H(1).
90
 
*
91
 
*  Each H(i) has the form
92
 
*
93
 
*     H(i) = I - tau * v * v'
94
 
*
95
 
*  where tau is a complex scalar, and v is a complex vector with
96
 
*  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
97
 
*  A(1:i-1,i+1), and tau in TAU(i).
98
 
*
99
 
*  If UPLO = 'L', the matrix Q is represented as a product of elementary
100
 
*  reflectors
101
 
*
102
 
*     Q = H(1) H(2) . . . H(n-1).
103
 
*
104
 
*  Each H(i) has the form
105
 
*
106
 
*     H(i) = I - tau * v * v'
107
 
*
108
 
*  where tau is a complex scalar, and v is a complex vector with
109
 
*  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
110
 
*  and tau in TAU(i).
111
 
*
112
 
*  The contents of A on exit are illustrated by the following examples
113
 
*  with n = 5:
114
 
*
115
 
*  if UPLO = 'U':                       if UPLO = 'L':
116
 
*
117
 
*    (  d   e   v2  v3  v4 )              (  d                  )
118
 
*    (      d   e   v3  v4 )              (  e   d              )
119
 
*    (          d   e   v4 )              (  v1  e   d          )
120
 
*    (              d   e  )              (  v1  v2  e   d      )
121
 
*    (                  d  )              (  v1  v2  v3  e   d  )
122
 
*
123
 
*  where d and e denote diagonal and off-diagonal elements of T, and vi
124
 
*  denotes an element of the vector defining H(i).
125
 
*
126
209
*  =====================================================================
127
210
*
128
211
*     .. Parameters ..
132
215
      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ) )
133
216
*     ..
134
217
*     .. Local Scalars ..
135
 
      LOGICAL            UPPER
136
 
      INTEGER            I, IINFO, IWS, J, KK, LDWORK, NB, NBMIN, NX
 
218
      LOGICAL            LQUERY, UPPER
 
219
      INTEGER            I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
 
220
     $                   NBMIN, NX
137
221
*     ..
138
222
*     .. External Subroutines ..
139
223
      EXTERNAL           CHER2K, CHETD2, CLATRD, XERBLA
152
236
*
153
237
      INFO = 0
154
238
      UPPER = LSAME( UPLO, 'U' )
 
239
      LQUERY = ( LWORK.EQ.-1 )
155
240
      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
156
241
         INFO = -1
157
242
      ELSE IF( N.LT.0 ) THEN
158
243
         INFO = -2
159
244
      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
160
245
         INFO = -4
161
 
      ELSE IF( LWORK.LT.1 ) THEN
 
246
      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
162
247
         INFO = -9
163
248
      END IF
 
249
*
 
250
      IF( INFO.EQ.0 ) THEN
 
251
*
 
252
*        Determine the block size.
 
253
*
 
254
         NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
 
255
         LWKOPT = N*NB
 
256
         WORK( 1 ) = LWKOPT
 
257
      END IF
 
258
*
164
259
      IF( INFO.NE.0 ) THEN
165
260
         CALL XERBLA( 'CHETRD', -INFO )
166
261
         RETURN
 
262
      ELSE IF( LQUERY ) THEN
 
263
         RETURN
167
264
      END IF
168
265
*
169
266
*     Quick return if possible
173
270
         RETURN
174
271
      END IF
175
272
*
176
 
*     Determine the block size.
177
 
*
178
 
      NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
179
273
      NX = N
180
274
      IWS = 1
181
275
      IF( NB.GT.1 .AND. NB.LT.N ) THEN
224
318
     $                   LDWORK )
225
319
*
226
320
*           Update the unreduced submatrix A(1:i-1,1:i-1), using an
227
 
*           update of the form:  A := A - V*W' - W*V'
 
321
*           update of the form:  A := A - V*W**H - W*V**H
228
322
*
229
323
            CALL CHER2K( UPLO, 'No transpose', I-1, NB, -CONE,
230
324
     $                   A( 1, I ), LDA, WORK, LDWORK, ONE, A, LDA )
255
349
     $                   TAU( I ), WORK, LDWORK )
256
350
*
257
351
*           Update the unreduced submatrix A(i+nb:n,i+nb:n), using
258
 
*           an update of the form:  A := A - V*W' - W*V'
 
352
*           an update of the form:  A := A - V*W**H - W*V**H
259
353
*
260
354
            CALL CHER2K( UPLO, 'No transpose', N-I-NB+1, NB, -CONE,
261
355
     $                   A( I+NB, I ), LDA, WORK( NB+1 ), LDWORK, ONE,
276
370
     $                TAU( I ), IINFO )
277
371
      END IF
278
372
*
279
 
      WORK( 1 ) = IWS
 
373
      WORK( 1 ) = LWKOPT
280
374
      RETURN
281
375
*
282
376
*     End of CHETRD