← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/lapack/double/zgebd2.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/double/zgebd2.f
 
1
*> \brief \b ZGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
 
2
*
 
3
*  =========== DOCUMENTATION ===========
 
4
*
 
5
* Online html documentation available at 
 
6
*            http://www.netlib.org/lapack/explore-html/ 
 
7
*
 
8
*> \htmlonly
 
9
*> Download ZGEBD2 + dependencies 
 
10
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgebd2.f"> 
 
11
*> [TGZ]</a> 
 
12
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgebd2.f"> 
 
13
*> [ZIP]</a> 
 
14
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgebd2.f"> 
 
15
*> [TXT]</a>
 
16
*> \endhtmlonly 
 
17
*
 
18
*  Definition:
 
19
*  ===========
 
20
*
 
21
*       SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
 
22
* 
 
23
*       .. Scalar Arguments ..
 
24
*       INTEGER            INFO, LDA, M, N
 
25
*       ..
 
26
*       .. Array Arguments ..
 
27
*       DOUBLE PRECISION   D( * ), E( * )
 
28
*       COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
 
29
*       ..
 
30
*  
 
31
*
 
32
*> \par Purpose:
 
33
*  =============
 
34
*>
 
35
*> \verbatim
 
36
*>
 
37
*> ZGEBD2 reduces a complex general m by n matrix A to upper or lower
 
38
*> real bidiagonal form B by a unitary transformation: Q**H * A * P = B.
 
39
*>
 
40
*> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
 
41
*> \endverbatim
 
42
*
 
43
*  Arguments:
 
44
*  ==========
 
45
*
 
46
*> \param[in] M
 
47
*> \verbatim
 
48
*>          M is INTEGER
 
49
*>          The number of rows in the matrix A.  M >= 0.
 
50
*> \endverbatim
 
51
*>
 
52
*> \param[in] N
 
53
*> \verbatim
 
54
*>          N is INTEGER
 
55
*>          The number of columns in the matrix A.  N >= 0.
 
56
*> \endverbatim
 
57
*>
 
58
*> \param[in,out] A
 
59
*> \verbatim
 
60
*>          A is COMPLEX*16 array, dimension (LDA,N)
 
61
*>          On entry, the m by n general matrix to be reduced.
 
62
*>          On exit,
 
63
*>          if m >= n, the diagonal and the first superdiagonal are
 
64
*>            overwritten with the upper bidiagonal matrix B; the
 
65
*>            elements below the diagonal, with the array TAUQ, represent
 
66
*>            the unitary matrix Q as a product of elementary
 
67
*>            reflectors, and the elements above the first superdiagonal,
 
68
*>            with the array TAUP, represent the unitary matrix P as
 
69
*>            a product of elementary reflectors;
 
70
*>          if m < n, the diagonal and the first subdiagonal are
 
71
*>            overwritten with the lower bidiagonal matrix B; the
 
72
*>            elements below the first subdiagonal, with the array TAUQ,
 
73
*>            represent the unitary matrix Q as a product of
 
74
*>            elementary reflectors, and the elements above the diagonal,
 
75
*>            with the array TAUP, represent the unitary matrix P as
 
76
*>            a product of elementary reflectors.
 
77
*>          See Further Details.
 
78
*> \endverbatim
 
79
*>
 
80
*> \param[in] LDA
 
81
*> \verbatim
 
82
*>          LDA is INTEGER
 
83
*>          The leading dimension of the array A.  LDA >= max(1,M).
 
84
*> \endverbatim
 
85
*>
 
86
*> \param[out] D
 
87
*> \verbatim
 
88
*>          D is DOUBLE PRECISION array, dimension (min(M,N))
 
89
*>          The diagonal elements of the bidiagonal matrix B:
 
90
*>          D(i) = A(i,i).
 
91
*> \endverbatim
 
92
*>
 
93
*> \param[out] E
 
94
*> \verbatim
 
95
*>          E is DOUBLE PRECISION array, dimension (min(M,N)-1)
 
96
*>          The off-diagonal elements of the bidiagonal matrix B:
 
97
*>          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
 
98
*>          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
 
99
*> \endverbatim
 
100
*>
 
101
*> \param[out] TAUQ
 
102
*> \verbatim
 
103
*>          TAUQ is COMPLEX*16 array dimension (min(M,N))
 
104
*>          The scalar factors of the elementary reflectors which
 
105
*>          represent the unitary matrix Q. See Further Details.
 
106
*> \endverbatim
 
107
*>
 
108
*> \param[out] TAUP
 
109
*> \verbatim
 
110
*>          TAUP is COMPLEX*16 array, dimension (min(M,N))
 
111
*>          The scalar factors of the elementary reflectors which
 
112
*>          represent the unitary matrix P. See Further Details.
 
113
*> \endverbatim
 
114
*>
 
115
*> \param[out] WORK
 
116
*> \verbatim
 
117
*>          WORK is COMPLEX*16 array, dimension (max(M,N))
 
118
*> \endverbatim
 
119
*>
 
120
*> \param[out] INFO
 
121
*> \verbatim
 
122
*>          INFO is INTEGER
 
123
*>          = 0: successful exit
 
124
*>          < 0: if INFO = -i, the i-th argument had an illegal value.
 
125
*> \endverbatim
 
126
*
 
127
*  Authors:
 
128
*  ========
 
129
*
 
130
*> \author Univ. of Tennessee 
 
131
*> \author Univ. of California Berkeley 
 
132
*> \author Univ. of Colorado Denver 
 
133
*> \author NAG Ltd. 
 
134
*
 
135
*> \date September 2012
 
136
*
 
137
*> \ingroup complex16GEcomputational
 
138
*
 
139
*> \par Further Details:
 
140
*  =====================
 
141
*>
 
142
*> \verbatim
 
143
*>
 
144
*>  The matrices Q and P are represented as products of elementary
 
145
*>  reflectors:
 
146
*>
 
147
*>  If m >= n,
 
148
*>
 
149
*>     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
 
150
*>
 
151
*>  Each H(i) and G(i) has the form:
 
152
*>
 
153
*>     H(i) = I - tauq * v * v**H  and G(i) = I - taup * u * u**H
 
154
*>
 
155
*>  where tauq and taup are complex scalars, and v and u are complex
 
156
*>  vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
 
157
*>  A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
 
158
*>  A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
 
159
*>
 
160
*>  If m < n,
 
161
*>
 
162
*>     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
 
163
*>
 
164
*>  Each H(i) and G(i) has the form:
 
165
*>
 
166
*>     H(i) = I - tauq * v * v**H  and G(i) = I - taup * u * u**H
 
167
*>
 
168
*>  where tauq and taup are complex scalars, v and u are complex vectors;
 
169
*>  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
 
170
*>  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
 
171
*>  tauq is stored in TAUQ(i) and taup in TAUP(i).
 
172
*>
 
173
*>  The contents of A on exit are illustrated by the following examples:
 
174
*>
 
175
*>  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
 
176
*>
 
177
*>    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
 
178
*>    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
 
179
*>    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
 
180
*>    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
 
181
*>    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
 
182
*>    (  v1  v2  v3  v4  v5 )
 
183
*>
 
184
*>  where d and e denote diagonal and off-diagonal elements of B, vi
 
185
*>  denotes an element of the vector defining H(i), and ui an element of
 
186
*>  the vector defining G(i).
 
187
*> \endverbatim
 
188
*>
 
189
*  =====================================================================
 
190
      SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
 
191
*
 
192
*  -- LAPACK computational routine (version 3.4.2) --
 
193
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 
194
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
195
*     September 2012
 
196
*
 
197
*     .. Scalar Arguments ..
 
198
      INTEGER            INFO, LDA, M, N
 
199
*     ..
 
200
*     .. Array Arguments ..
 
201
      DOUBLE PRECISION   D( * ), E( * )
 
202
      COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
 
203
*     ..
 
204
*
 
205
*  =====================================================================
 
206
*
 
207
*     .. Parameters ..
 
208
      COMPLEX*16         ZERO, ONE
 
209
      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
 
210
     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
 
211
*     ..
 
212
*     .. Local Scalars ..
 
213
      INTEGER            I
 
214
      COMPLEX*16         ALPHA
 
215
*     ..
 
216
*     .. External Subroutines ..
 
217
      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZLARFG
 
218
*     ..
 
219
*     .. Intrinsic Functions ..
 
220
      INTRINSIC          DCONJG, MAX, MIN
 
221
*     ..
 
222
*     .. Executable Statements ..
 
223
*
 
224
*     Test the input parameters
 
225
*
 
226
      INFO = 0
 
227
      IF( M.LT.0 ) THEN
 
228
         INFO = -1
 
229
      ELSE IF( N.LT.0 ) THEN
 
230
         INFO = -2
 
231
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
 
232
         INFO = -4
 
233
      END IF
 
234
      IF( INFO.LT.0 ) THEN
 
235
         CALL XERBLA( 'ZGEBD2', -INFO )
 
236
         RETURN
 
237
      END IF
 
238
*
 
239
      IF( M.GE.N ) THEN
 
240
*
 
241
*        Reduce to upper bidiagonal form
 
242
*
 
243
         DO 10 I = 1, N
 
244
*
 
245
*           Generate elementary reflector H(i) to annihilate A(i+1:m,i)
 
246
*
 
247
            ALPHA = A( I, I )
 
248
            CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
 
249
     $                   TAUQ( I ) )
 
250
            D( I ) = ALPHA
 
251
            A( I, I ) = ONE
 
252
*
 
253
*           Apply H(i)**H to A(i:m,i+1:n) from the left
 
254
*
 
255
            IF( I.LT.N )
 
256
     $         CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
 
257
     $                     DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
 
258
            A( I, I ) = D( I )
 
259
*
 
260
            IF( I.LT.N ) THEN
 
261
*
 
262
*              Generate elementary reflector G(i) to annihilate
 
263
*              A(i,i+2:n)
 
264
*
 
265
               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
 
266
               ALPHA = A( I, I+1 )
 
267
               CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
 
268
     $                      TAUP( I ) )
 
269
               E( I ) = ALPHA
 
270
               A( I, I+1 ) = ONE
 
271
*
 
272
*              Apply G(i) to A(i+1:m,i+1:n) from the right
 
273
*
 
274
               CALL ZLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
 
275
     $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
 
276
               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
 
277
               A( I, I+1 ) = E( I )
 
278
            ELSE
 
279
               TAUP( I ) = ZERO
 
280
            END IF
 
281
   10    CONTINUE
 
282
      ELSE
 
283
*
 
284
*        Reduce to lower bidiagonal form
 
285
*
 
286
         DO 20 I = 1, M
 
287
*
 
288
*           Generate elementary reflector G(i) to annihilate A(i,i+1:n)
 
289
*
 
290
            CALL ZLACGV( N-I+1, A( I, I ), LDA )
 
291
            ALPHA = A( I, I )
 
292
            CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
 
293
     $                   TAUP( I ) )
 
294
            D( I ) = ALPHA
 
295
            A( I, I ) = ONE
 
296
*
 
297
*           Apply G(i) to A(i+1:m,i:n) from the right
 
298
*
 
299
            IF( I.LT.M )
 
300
     $         CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
 
301
     $                     TAUP( I ), A( I+1, I ), LDA, WORK )
 
302
            CALL ZLACGV( N-I+1, A( I, I ), LDA )
 
303
            A( I, I ) = D( I )
 
304
*
 
305
            IF( I.LT.M ) THEN
 
306
*
 
307
*              Generate elementary reflector H(i) to annihilate
 
308
*              A(i+2:m,i)
 
309
*
 
310
               ALPHA = A( I+1, I )
 
311
               CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
 
312
     $                      TAUQ( I ) )
 
313
               E( I ) = ALPHA
 
314
               A( I+1, I ) = ONE
 
315
*
 
316
*              Apply H(i)**H to A(i+1:m,i+1:n) from the left
 
317
*
 
318
               CALL ZLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
 
319
     $                     DCONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
 
320
     $                     WORK )
 
321
               A( I+1, I ) = E( I )
 
322
            ELSE
 
323
               TAUQ( I ) = ZERO
 
324
            END IF
 
325
   20    CONTINUE
 
326
      END IF
 
327
      RETURN
 
328
*
 
329
*     End of ZGEBD2
 
330
*
 
331
      END