LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
dorgtsqr.f
Go to the documentation of this file.
1 *> \brief \b DORGTSQR
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DORGTSQR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgtsqr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgtsqr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgtsqr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DORGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
22 * $ INFO )
23 *
24 * .. Scalar Arguments ..
25 * INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB
26 * ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * )
29 * ..
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> DORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns,
37 *> which are the first N columns of a product of real orthogonal
38 *> matrices of order M which are returned by DLATSQR
39 *>
40 *> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ).
41 *>
42 *> See the documentation for DLATSQR.
43 *> \endverbatim
44 *
45 * Arguments:
46 * ==========
47 *
48 *> \param[in] M
49 *> \verbatim
50 *> M is INTEGER
51 *> The number of rows of the matrix A. M >= 0.
52 *> \endverbatim
53 *>
54 *> \param[in] N
55 *> \verbatim
56 *> N is INTEGER
57 *> The number of columns of the matrix A. M >= N >= 0.
58 *> \endverbatim
59 *>
60 *> \param[in] MB
61 *> \verbatim
62 *> MB is INTEGER
63 *> The row block size used by DLATSQR to return
64 *> arrays A and T. MB > N.
65 *> (Note that if MB > M, then M is used instead of MB
66 *> as the row block size).
67 *> \endverbatim
68 *>
69 *> \param[in] NB
70 *> \verbatim
71 *> NB is INTEGER
72 *> The column block size used by DLATSQR to return
73 *> arrays A and T. NB >= 1.
74 *> (Note that if NB > N, then N is used instead of NB
75 *> as the column block size).
76 *> \endverbatim
77 *>
78 *> \param[in,out] A
79 *> \verbatim
80 *> A is DOUBLE PRECISION array, dimension (LDA,N)
81 *>
82 *> On entry:
83 *>
84 *> The elements on and above the diagonal are not accessed.
85 *> The elements below the diagonal represent the unit
86 *> lower-trapezoidal blocked matrix V computed by DLATSQR
87 *> that defines the input matrices Q_in(k) (ones on the
88 *> diagonal are not stored) (same format as the output A
89 *> below the diagonal in DLATSQR).
90 *>
91 *> On exit:
92 *>
93 *> The array A contains an M-by-N orthonormal matrix Q_out,
94 *> i.e the columns of A are orthogonal unit vectors.
95 *> \endverbatim
96 *>
97 *> \param[in] LDA
98 *> \verbatim
99 *> LDA is INTEGER
100 *> The leading dimension of the array A. LDA >= max(1,M).
101 *> \endverbatim
102 *>
103 *> \param[in] T
104 *> \verbatim
105 *> T is DOUBLE PRECISION array,
106 *> dimension (LDT, N * NIRB)
107 *> where NIRB = Number_of_input_row_blocks
108 *> = MAX( 1, CEIL((M-N)/(MB-N)) )
109 *> Let NICB = Number_of_input_col_blocks
110 *> = CEIL(N/NB)
111 *>
112 *> The upper-triangular block reflectors used to define the
113 *> input matrices Q_in(k), k=(1:NIRB*NICB). The block
114 *> reflectors are stored in compact form in NIRB block
115 *> reflector sequences. Each of NIRB block reflector sequences
116 *> is stored in a larger NB-by-N column block of T and consists
117 *> of NICB smaller NB-by-NB upper-triangular column blocks.
118 *> (same format as the output T in DLATSQR).
119 *> \endverbatim
120 *>
121 *> \param[in] LDT
122 *> \verbatim
123 *> LDT is INTEGER
124 *> The leading dimension of the array T.
125 *> LDT >= max(1,min(NB1,N)).
126 *> \endverbatim
127 *>
128 *> \param[out] WORK
129 *> \verbatim
130 *> (workspace) DOUBLE PRECISION array, dimension (MAX(2,LWORK))
131 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
132 *> \endverbatim
133 *>
134 *> \param[in] LWORK
135 *> \verbatim
136 *> The dimension of the array WORK. LWORK >= (M+NB)*N.
137 *> If LWORK = -1, then a workspace query is assumed.
138 *> The routine only calculates the optimal size of the WORK
139 *> array, returns this value as the first entry of the WORK
140 *> array, and no error message related to LWORK is issued
141 *> by XERBLA.
142 *> \endverbatim
143 *>
144 *> \param[out] INFO
145 *> \verbatim
146 *> INFO is INTEGER
147 *> = 0: successful exit
148 *> < 0: if INFO = -i, the i-th argument had an illegal value
149 *> \endverbatim
150 *>
151 * Authors:
152 * ========
153 *
154 *> \author Univ. of Tennessee
155 *> \author Univ. of California Berkeley
156 *> \author Univ. of Colorado Denver
157 *> \author NAG Ltd.
158 *
159 *> \ingroup doubleOTHERcomputational
160 *
161 *> \par Contributors:
162 * ==================
163 *>
164 *> \verbatim
165 *>
166 *> November 2019, Igor Kozachenko,
167 *> Computer Science Division,
168 *> University of California, Berkeley
169 *>
170 *> \endverbatim
171 *
172 * =====================================================================
173  SUBROUTINE dorgtsqr( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
174  $ INFO )
175  IMPLICIT NONE
176 *
177 * -- LAPACK computational routine --
178 * -- LAPACK is a software package provided by Univ. of Tennessee, --
179 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
180 *
181 * .. Scalar Arguments ..
182  INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB
183 * ..
184 * .. Array Arguments ..
185  DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * )
186 * ..
187 *
188 * =====================================================================
189 *
190 * .. Parameters ..
191  DOUBLE PRECISION ONE, ZERO
192  parameter( one = 1.0d+0, zero = 0.0d+0 )
193 * ..
194 * .. Local Scalars ..
195  LOGICAL LQUERY
196  INTEGER IINFO, LDC, LWORKOPT, LC, LW, NBLOCAL, J
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL dcopy, dlamtsqr, dlaset, xerbla
200 * ..
201 * .. Intrinsic Functions ..
202  INTRINSIC dble, max, min
203 * ..
204 * .. Executable Statements ..
205 *
206 * Test the input parameters
207 *
208  lquery = lwork.EQ.-1
209  info = 0
210  IF( m.LT.0 ) THEN
211  info = -1
212  ELSE IF( n.LT.0 .OR. m.LT.n ) THEN
213  info = -2
214  ELSE IF( mb.LE.n ) THEN
215  info = -3
216  ELSE IF( nb.LT.1 ) THEN
217  info = -4
218  ELSE IF( lda.LT.max( 1, m ) ) THEN
219  info = -6
220  ELSE IF( ldt.LT.max( 1, min( nb, n ) ) ) THEN
221  info = -8
222  ELSE
223 *
224 * Test the input LWORK for the dimension of the array WORK.
225 * This workspace is used to store array C(LDC, N) and WORK(LWORK)
226 * in the call to DLAMTSQR. See the documentation for DLAMTSQR.
227 *
228  IF( lwork.LT.2 .AND. (.NOT.lquery) ) THEN
229  info = -10
230  ELSE
231 *
232 * Set block size for column blocks
233 *
234  nblocal = min( nb, n )
235 *
236 * LWORK = -1, then set the size for the array C(LDC,N)
237 * in DLAMTSQR call and set the optimal size of the work array
238 * WORK(LWORK) in DLAMTSQR call.
239 *
240  ldc = m
241  lc = ldc*n
242  lw = n * nblocal
243 *
244  lworkopt = lc+lw
245 *
246  IF( ( lwork.LT.max( 1, lworkopt ) ).AND.(.NOT.lquery) ) THEN
247  info = -10
248  END IF
249  END IF
250 *
251  END IF
252 *
253 * Handle error in the input parameters and return workspace query.
254 *
255  IF( info.NE.0 ) THEN
256  CALL xerbla( 'DORGTSQR', -info )
257  RETURN
258  ELSE IF ( lquery ) THEN
259  work( 1 ) = dble( lworkopt )
260  RETURN
261  END IF
262 *
263 * Quick return if possible
264 *
265  IF( min( m, n ).EQ.0 ) THEN
266  work( 1 ) = dble( lworkopt )
267  RETURN
268  END IF
269 *
270 * (1) Form explicitly the tall-skinny M-by-N left submatrix Q1_in
271 * of M-by-M orthogonal matrix Q_in, which is implicitly stored in
272 * the subdiagonal part of input array A and in the input array T.
273 * Perform by the following operation using the routine DLAMTSQR.
274 *
275 * Q1_in = Q_in * ( I ), where I is a N-by-N identity matrix,
276 * ( 0 ) 0 is a (M-N)-by-N zero matrix.
277 *
278 * (1a) Form M-by-N matrix in the array WORK(1:LDC*N) with ones
279 * on the diagonal and zeros elsewhere.
280 *
281  CALL dlaset( 'F', m, n, zero, one, work, ldc )
282 *
283 * (1b) On input, WORK(1:LDC*N) stores ( I );
284 * ( 0 )
285 *
286 * On output, WORK(1:LDC*N) stores Q1_in.
287 *
288  CALL dlamtsqr( 'L', 'N', m, n, n, mb, nblocal, a, lda, t, ldt,
289  $ work, ldc, work( lc+1 ), lw, iinfo )
290 *
291 * (2) Copy the result from the part of the work array (1:M,1:N)
292 * with the leading dimension LDC that starts at WORK(1) into
293 * the output array A(1:M,1:N) column-by-column.
294 *
295  DO j = 1, n
296  CALL dcopy( m, work( (j-1)*ldc + 1 ), 1, a( 1, j ), 1 )
297  END DO
298 *
299  work( 1 ) = dble( lworkopt )
300  RETURN
301 *
302 * End of DORGTSQR
303 *
304  END
subroutine dlamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
DLAMTSQR
Definition: dlamtsqr.f:197
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:110
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:82
subroutine dorgtsqr(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
DORGTSQR
Definition: dorgtsqr.f:175