← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/lapack/double/dorgbr.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/dorgbr.f
 
1
*> \brief \b DORGBR
 
2
*
 
3
*  =========== DOCUMENTATION ===========
 
4
*
 
5
* Online html documentation available at 
 
6
*            http://www.netlib.org/lapack/explore-html/ 
 
7
*
 
8
*> \htmlonly
 
9
*> Download DORGBR + dependencies 
 
10
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgbr.f"> 
 
11
*> [TGZ]</a> 
 
12
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgbr.f"> 
 
13
*> [ZIP]</a> 
 
14
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgbr.f"> 
 
15
*> [TXT]</a>
 
16
*> \endhtmlonly 
 
17
*
 
18
*  Definition:
 
19
*  ===========
 
20
*
 
21
*       SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 
22
* 
 
23
*       .. Scalar Arguments ..
 
24
*       CHARACTER          VECT
 
25
*       INTEGER            INFO, K, LDA, LWORK, M, N
 
26
*       ..
 
27
*       .. Array Arguments ..
 
28
*       DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 
29
*       ..
 
30
*  
 
31
*
 
32
*> \par Purpose:
 
33
*  =============
 
34
*>
 
35
*> \verbatim
 
36
*>
 
37
*> DORGBR generates one of the real orthogonal matrices Q or P**T
 
38
*> determined by DGEBRD when reducing a real matrix A to bidiagonal
 
39
*> form: A = Q * B * P**T.  Q and P**T are defined as products of
 
40
*> elementary reflectors H(i) or G(i) respectively.
 
41
*>
 
42
*> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
 
43
*> is of order M:
 
44
*> if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
 
45
*> columns of Q, where m >= n >= k;
 
46
*> if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
 
47
*> M-by-M matrix.
 
48
*>
 
49
*> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
 
50
*> is of order N:
 
51
*> if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
 
52
*> rows of P**T, where n >= m >= k;
 
53
*> if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
 
54
*> an N-by-N matrix.
 
55
*> \endverbatim
 
56
*
 
57
*  Arguments:
 
58
*  ==========
 
59
*
 
60
*> \param[in] VECT
 
61
*> \verbatim
 
62
*>          VECT is CHARACTER*1
 
63
*>          Specifies whether the matrix Q or the matrix P**T is
 
64
*>          required, as defined in the transformation applied by DGEBRD:
 
65
*>          = 'Q':  generate Q;
 
66
*>          = 'P':  generate P**T.
 
67
*> \endverbatim
 
68
*>
 
69
*> \param[in] M
 
70
*> \verbatim
 
71
*>          M is INTEGER
 
72
*>          The number of rows of the matrix Q or P**T to be returned.
 
73
*>          M >= 0.
 
74
*> \endverbatim
 
75
*>
 
76
*> \param[in] N
 
77
*> \verbatim
 
78
*>          N is INTEGER
 
79
*>          The number of columns of the matrix Q or P**T to be returned.
 
80
*>          N >= 0.
 
81
*>          If VECT = 'Q', M >= N >= min(M,K);
 
82
*>          if VECT = 'P', N >= M >= min(N,K).
 
83
*> \endverbatim
 
84
*>
 
85
*> \param[in] K
 
86
*> \verbatim
 
87
*>          K is INTEGER
 
88
*>          If VECT = 'Q', the number of columns in the original M-by-K
 
89
*>          matrix reduced by DGEBRD.
 
90
*>          If VECT = 'P', the number of rows in the original K-by-N
 
91
*>          matrix reduced by DGEBRD.
 
92
*>          K >= 0.
 
93
*> \endverbatim
 
94
*>
 
95
*> \param[in,out] A
 
96
*> \verbatim
 
97
*>          A is DOUBLE PRECISION array, dimension (LDA,N)
 
98
*>          On entry, the vectors which define the elementary reflectors,
 
99
*>          as returned by DGEBRD.
 
100
*>          On exit, the M-by-N matrix Q or P**T.
 
101
*> \endverbatim
 
102
*>
 
103
*> \param[in] LDA
 
104
*> \verbatim
 
105
*>          LDA is INTEGER
 
106
*>          The leading dimension of the array A. LDA >= max(1,M).
 
107
*> \endverbatim
 
108
*>
 
109
*> \param[in] TAU
 
110
*> \verbatim
 
111
*>          TAU is DOUBLE PRECISION array, dimension
 
112
*>                                (min(M,K)) if VECT = 'Q'
 
113
*>                                (min(N,K)) if VECT = 'P'
 
114
*>          TAU(i) must contain the scalar factor of the elementary
 
115
*>          reflector H(i) or G(i), which determines Q or P**T, as
 
116
*>          returned by DGEBRD in its array argument TAUQ or TAUP.
 
117
*> \endverbatim
 
118
*>
 
119
*> \param[out] WORK
 
120
*> \verbatim
 
121
*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
 
122
*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 
123
*> \endverbatim
 
124
*>
 
125
*> \param[in] LWORK
 
126
*> \verbatim
 
127
*>          LWORK is INTEGER
 
128
*>          The dimension of the array WORK. LWORK >= max(1,min(M,N)).
 
129
*>          For optimum performance LWORK >= min(M,N)*NB, where NB
 
130
*>          is the optimal blocksize.
 
131
*>
 
132
*>          If LWORK = -1, then a workspace query is assumed; the routine
 
133
*>          only calculates the optimal size of the WORK array, returns
 
134
*>          this value as the first entry of the WORK array, and no error
 
135
*>          message related to LWORK is issued by XERBLA.
 
136
*> \endverbatim
 
137
*>
 
138
*> \param[out] INFO
 
139
*> \verbatim
 
140
*>          INFO is INTEGER
 
141
*>          = 0:  successful exit
 
142
*>          < 0:  if INFO = -i, the i-th argument had an illegal value
 
143
*> \endverbatim
 
144
*
 
145
*  Authors:
 
146
*  ========
 
147
*
 
148
*> \author Univ. of Tennessee 
 
149
*> \author Univ. of California Berkeley 
 
150
*> \author Univ. of Colorado Denver 
 
151
*> \author NAG Ltd. 
 
152
*
 
153
*> \date April 2012
 
154
*
 
155
*> \ingroup doubleGBcomputational
 
156
*
 
157
*  =====================================================================
1
158
      SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
2
159
*
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
 
160
*  -- LAPACK computational routine (version 3.4.1) --
 
161
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 
162
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
163
*     April 2012
7
164
*
8
165
*     .. Scalar Arguments ..
9
166
      CHARACTER          VECT
10
167
      INTEGER            INFO, K, LDA, LWORK, M, N
11
168
*     ..
12
169
*     .. Array Arguments ..
13
 
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
 
170
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
14
171
*     ..
15
172
*
16
 
c
17
 
* $Id: dorgbr.f 19697 2010-10-29 16:57:34Z d3y133 $
18
 
c
19
 
*  Purpose
20
 
*  =======
21
 
*
22
 
*  DORGBR generates one of the real orthogonal matrices Q or P**T
23
 
*  determined by DGEBRD when reducing a real matrix A to bidiagonal
24
 
*  form: A = Q * B * P**T.  Q and P**T are defined as products of
25
 
*  elementary reflectors H(i) or G(i) respectively.
26
 
*
27
 
*  If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
28
 
*  is of order M:
29
 
*  if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
30
 
*  columns of Q, where m >= n >= k;
31
 
*  if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
32
 
*  M-by-M matrix.
33
 
*
34
 
*  If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
35
 
*  is of order N:
36
 
*  if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
37
 
*  rows of P**T, where n >= m >= k;
38
 
*  if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
39
 
*  an N-by-N matrix.
40
 
*
41
 
*  Arguments
42
 
*  =========
43
 
*
44
 
*  VECT    (input) CHARACTER*1
45
 
*          Specifies whether the matrix Q or the matrix P**T is
46
 
*          required, as defined in the transformation applied by DGEBRD:
47
 
*          = 'Q':  generate Q;
48
 
*          = 'P':  generate P**T.
49
 
*
50
 
*  M       (input) INTEGER
51
 
*          The number of rows of the matrix Q or P**T to be returned.
52
 
*          M >= 0.
53
 
*
54
 
*  N       (input) INTEGER
55
 
*          The number of columns of the matrix Q or P**T to be returned.
56
 
*          N >= 0.
57
 
*          If VECT = 'Q', M >= N >= min(M,K);
58
 
*          if VECT = 'P', N >= M >= min(N,K).
59
 
*
60
 
*  K       (input) INTEGER
61
 
*          If VECT = 'Q', the number of columns in the original M-by-K
62
 
*          matrix reduced by DGEBRD.
63
 
*          If VECT = 'P', the number of rows in the original K-by-N
64
 
*          matrix reduced by DGEBRD.
65
 
*          K >= 0.
66
 
*
67
 
*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
68
 
*          On entry, the vectors which define the elementary reflectors,
69
 
*          as returned by DGEBRD.
70
 
*          On exit, the M-by-N matrix Q or P**T.
71
 
*
72
 
*  LDA     (input) INTEGER
73
 
*          The leading dimension of the array A. LDA >= max(1,M).
74
 
*
75
 
*  TAU     (input) DOUBLE PRECISION array, dimension
76
 
*                                (min(M,K)) if VECT = 'Q'
77
 
*                                (min(N,K)) if VECT = 'P'
78
 
*          TAU(i) must contain the scalar factor of the elementary
79
 
*          reflector H(i) or G(i), which determines Q or P**T, as
80
 
*          returned by DGEBRD in its array argument TAUQ or TAUP.
81
 
*
82
 
*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
83
 
*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
84
 
*
85
 
*  LWORK   (input) INTEGER
86
 
*          The dimension of the array WORK. LWORK >= max(1,min(M,N)).
87
 
*          For optimum performance LWORK >= min(M,N)*NB, where NB
88
 
*          is the optimal blocksize.
89
 
*
90
 
*  INFO    (output) INTEGER
91
 
*          = 0:  successful exit
92
 
*          < 0:  if INFO = -i, the i-th argument had an illegal value
93
 
*
94
173
*  =====================================================================
95
174
*
96
175
*     .. Parameters ..
98
177
      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
99
178
*     ..
100
179
*     .. Local Scalars ..
101
 
      LOGICAL            WANTQ
102
 
      INTEGER            I, IINFO, J
 
180
      LOGICAL            LQUERY, WANTQ
 
181
      INTEGER            I, IINFO, J, LWKOPT, MN
103
182
*     ..
104
183
*     .. External Functions ..
105
184
      LOGICAL            LSAME
106
 
      EXTERNAL           LSAME
 
185
      INTEGER            ILAENV
 
186
      EXTERNAL           LSAME, ILAENV
107
187
*     ..
108
188
*     .. External Subroutines ..
109
189
      EXTERNAL           DORGLQ, DORGQR, XERBLA
117
197
*
118
198
      INFO = 0
119
199
      WANTQ = LSAME( VECT, 'Q' )
 
200
      MN = MIN( M, N )
 
201
      LQUERY = ( LWORK.EQ.-1 )
120
202
      IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
121
203
         INFO = -1
122
204
      ELSE IF( M.LT.0 ) THEN
129
211
         INFO = -4
130
212
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
131
213
         INFO = -6
132
 
      ELSE IF( LWORK.LT.MAX( 1, MIN( M, N ) ) ) THEN
 
214
      ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
133
215
         INFO = -9
134
216
      END IF
 
217
*
 
218
      IF( INFO.EQ.0 ) THEN
 
219
         WORK( 1 ) = 1
 
220
         IF( WANTQ ) THEN
 
221
            IF( M.GE.K ) THEN
 
222
               CALL DORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
 
223
            ELSE
 
224
               IF( M.GT.1 ) THEN
 
225
                  CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
 
226
     $                         -1, IINFO )
 
227
               END IF
 
228
            END IF
 
229
         ELSE
 
230
            IF( K.LT.N ) THEN
 
231
               CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
 
232
            ELSE
 
233
               IF( N.GT.1 ) THEN
 
234
                  CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
 
235
     $                         -1, IINFO )
 
236
               END IF
 
237
            END IF
 
238
         END IF
 
239
         LWKOPT = WORK( 1 )
 
240
         LWKOPT = MAX (LWKOPT, MN)
 
241
      END IF
 
242
*
135
243
      IF( INFO.NE.0 ) THEN
136
244
         CALL XERBLA( 'DORGBR', -INFO )
137
245
         RETURN
 
246
      ELSE IF( LQUERY ) THEN
 
247
         WORK( 1 ) = LWKOPT
 
248
         RETURN
138
249
      END IF
139
250
*
140
251
*     Quick return if possible
183
294
         END IF
184
295
      ELSE
185
296
*
186
 
*        Form P', determined by a call to DGEBRD to reduce a k-by-n
 
297
*        Form P**T, determined by a call to DGEBRD to reduce a k-by-n
187
298
*        matrix
188
299
*
189
300
         IF( K.LT.N ) THEN
197
308
*           If k >= n, assume m = n
198
309
*
199
310
*           Shift the vectors which define the elementary reflectors one
200
 
*           row downward, and set the first row and column of P' to
 
311
*           row downward, and set the first row and column of P**T to
201
312
*           those of the unit matrix
202
313
*
203
314
            A( 1, 1 ) = ONE
212
323
   60       CONTINUE
213
324
            IF( N.GT.1 ) THEN
214
325
*
215
 
*              Form P'(2:n,2:n)
 
326
*              Form P**T(2:n,2:n)
216
327
*
217
328
               CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
218
329
     $                      LWORK, IINFO )
219
330
            END IF
220
331
         END IF
221
332
      END IF
 
333
      WORK( 1 ) = LWKOPT
222
334
      RETURN
223
335
*
224
336
*     End of DORGBR