LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ sgetsqrhrt()

subroutine sgetsqrhrt ( integer  M,
integer  N,
integer  MB1,
integer  NB1,
integer  NB2,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( ldt, * )  T,
integer  LDT,
real, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

SGETSQRHRT

Download SGETSQRHRT + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SGETSQRHRT computes a NB2-sized column blocked QR-factorization
 of a complex M-by-N matrix A with M >= N,

    A = Q * R.

 The routine uses internally a NB1-sized column blocked and MB1-sized
 row blocked TSQR-factorization and perfors the reconstruction
 of the Householder vectors from the TSQR output. The routine also
 converts the R_tsqr factor from the TSQR-factorization output into
 the R factor that corresponds to the Householder QR-factorization,

    A = Q_tsqr * R_tsqr = Q * R.

 The output Q and R factors are stored in the same format as in SGEQRT
 (Q is in blocked compact WY-representation). See the documentation
 of SGEQRT for more details on the format.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrix A.  M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix A. M >= N >= 0.
[in]MB1
          MB1 is INTEGER
          The row block size to be used in the blocked TSQR.
          MB1 > N.
[in]NB1
          NB1 is INTEGER
          The column block size to be used in the blocked TSQR.
          N >= NB1 >= 1.
[in]NB2
          NB2 is INTEGER
          The block size to be used in the blocked QR that is
          output. NB2 >= 1.
[in,out]A
          A is REAL array, dimension (LDA,N)

          On entry: an M-by-N matrix A.

          On exit:
           a) the elements on and above the diagonal
              of the array contain the N-by-N upper-triangular
              matrix R corresponding to the Householder QR;
           b) the elements below the diagonal represent Q by
              the columns of blocked V (compact WY-representation).
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,M).
[out]T
          T is REAL array, dimension (LDT,N))
          The upper triangular block reflectors stored in compact form
          as a sequence of upper triangular blocks.
[in]LDT
          LDT is INTEGER
          The leading dimension of the array T.  LDT >= NB2.
[out]WORK
          (workspace) REAL array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          The dimension of the array WORK.
          LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
          where
             NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
             NB1LOCAL = MIN(NB1,N).
             LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
             LW1 = NB1LOCAL * N,
             LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ),
          If LWORK = -1, then a workspace query is assumed.
          The routine only calculates the optimal size of the WORK
          array, returns this value as the first entry of the WORK
          array, and no error message related to LWORK is issued
          by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Contributors:
 November 2020, Igor Kozachenko,
                Computer Science Division,
                University of California, Berkeley

Definition at line 177 of file sgetsqrhrt.f.

179  IMPLICIT NONE
180 *
181 * -- LAPACK computational routine --
182 * -- LAPACK is a software package provided by Univ. of Tennessee, --
183 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
184 *
185 * .. Scalar Arguments ..
186  INTEGER INFO, LDA, LDT, LWORK, M, N, NB1, NB2, MB1
187 * ..
188 * .. Array Arguments ..
189  REAL A( LDA, * ), T( LDT, * ), WORK( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL ONE
196  parameter( one = 1.0e+0 )
197 * ..
198 * .. Local Scalars ..
199  LOGICAL LQUERY
200  INTEGER I, IINFO, J, LW1, LW2, LWT, LDWT, LWORKOPT,
201  $ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS
202 * ..
203 * .. External Subroutines ..
204  EXTERNAL scopy, slatsqr, sorgtsqr_row, sorhr_col,
205  $ xerbla
206 * ..
207 * .. Intrinsic Functions ..
208  INTRINSIC ceiling, max, min
209 * ..
210 * .. Executable Statements ..
211 *
212 * Test the input arguments
213 *
214  info = 0
215  lquery = lwork.EQ.-1
216  IF( m.LT.0 ) THEN
217  info = -1
218  ELSE IF( n.LT.0 .OR. m.LT.n ) THEN
219  info = -2
220  ELSE IF( mb1.LE.n ) THEN
221  info = -3
222  ELSE IF( nb1.LT.1 ) THEN
223  info = -4
224  ELSE IF( nb2.LT.1 ) THEN
225  info = -5
226  ELSE IF( lda.LT.max( 1, m ) ) THEN
227  info = -7
228  ELSE IF( ldt.LT.max( 1, min( nb2, n ) ) ) THEN
229  info = -9
230  ELSE
231 *
232 * Test the input LWORK for the dimension of the array WORK.
233 * This workspace is used to store array:
234 * a) Matrix T and WORK for SLATSQR;
235 * b) N-by-N upper-triangular factor R_tsqr;
236 * c) Matrix T and array WORK for SORGTSQR_ROW;
237 * d) Diagonal D for SORHR_COL.
238 *
239  IF( lwork.LT.n*n+1 .AND. .NOT.lquery ) THEN
240  info = -11
241  ELSE
242 *
243 * Set block size for column blocks
244 *
245  nb1local = min( nb1, n )
246 *
247  num_all_row_blocks = max( 1,
248  $ ceiling( real( m - n ) / real( mb1 - n ) ) )
249 *
250 * Length and leading dimension of WORK array to place
251 * T array in TSQR.
252 *
253  lwt = num_all_row_blocks * n * nb1local
254 
255  ldwt = nb1local
256 *
257 * Length of TSQR work array
258 *
259  lw1 = nb1local * n
260 *
261 * Length of SORGTSQR_ROW work array.
262 *
263  lw2 = nb1local * max( nb1local, ( n - nb1local ) )
264 *
265  lworkopt = max( lwt + lw1, max( lwt+n*n+lw2, lwt+n*n+n ) )
266 *
267  IF( ( lwork.LT.max( 1, lworkopt ) ).AND.(.NOT.lquery) ) THEN
268  info = -11
269  END IF
270 *
271  END IF
272  END IF
273 *
274 * Handle error in the input parameters and return workspace query.
275 *
276  IF( info.NE.0 ) THEN
277  CALL xerbla( 'SGETSQRHRT', -info )
278  RETURN
279  ELSE IF ( lquery ) THEN
280  work( 1 ) = real( lworkopt )
281  RETURN
282  END IF
283 *
284 * Quick return if possible
285 *
286  IF( min( m, n ).EQ.0 ) THEN
287  work( 1 ) = real( lworkopt )
288  RETURN
289  END IF
290 *
291  nb2local = min( nb2, n )
292 *
293 *
294 * (1) Perform TSQR-factorization of the M-by-N matrix A.
295 *
296  CALL slatsqr( m, n, mb1, nb1local, a, lda, work, ldwt,
297  $ work(lwt+1), lw1, iinfo )
298 *
299 * (2) Copy the factor R_tsqr stored in the upper-triangular part
300 * of A into the square matrix in the work array
301 * WORK(LWT+1:LWT+N*N) column-by-column.
302 *
303  DO j = 1, n
304  CALL scopy( j, a( 1, j ), 1, work( lwt + n*(j-1)+1 ), 1 )
305  END DO
306 *
307 * (3) Generate a M-by-N matrix Q with orthonormal columns from
308 * the result stored below the diagonal in the array A in place.
309 *
310 
311  CALL sorgtsqr_row( m, n, mb1, nb1local, a, lda, work, ldwt,
312  $ work( lwt+n*n+1 ), lw2, iinfo )
313 *
314 * (4) Perform the reconstruction of Householder vectors from
315 * the matrix Q (stored in A) in place.
316 *
317  CALL sorhr_col( m, n, nb2local, a, lda, t, ldt,
318  $ work( lwt+n*n+1 ), iinfo )
319 *
320 * (5) Copy the factor R_tsqr stored in the square matrix in the
321 * work array WORK(LWT+1:LWT+N*N) into the upper-triangular
322 * part of A.
323 *
324 * (6) Compute from R_tsqr the factor R_hr corresponding to
325 * the reconstructed Householder vectors, i.e. R_hr = S * R_tsqr.
326 * This multiplication by the sign matrix S on the left means
327 * changing the sign of I-th row of the matrix R_tsqr according
328 * to sign of the I-th diagonal element DIAG(I) of the matrix S.
329 * DIAG is stored in WORK( LWT+N*N+1 ) from the SORHR_COL output.
330 *
331 * (5) and (6) can be combined in a single loop, so the rows in A
332 * are accessed only once.
333 *
334  DO i = 1, n
335  IF( work( lwt+n*n+i ).EQ.-one ) THEN
336  DO j = i, n
337  a( i, j ) = -one * work( lwt+n*(j-1)+i )
338  END DO
339  ELSE
340  CALL scopy( n-i+1, work(lwt+n*(i-1)+i), n, a( i, i ), lda )
341  END IF
342  END DO
343 *
344  work( 1 ) = real( lworkopt )
345  RETURN
346 *
347 * End of SGETSQRHRT
348 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
scopy
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:82
slatsqr
subroutine slatsqr(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
SLATSQR
Definition: slatsqr.f:166
sorgtsqr_row
subroutine sorgtsqr_row(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
SORGTSQR_ROW
Definition: sorgtsqr_row.f:188
sorhr_col
subroutine sorhr_col(M, N, NB, A, LDA, T, LDT, D, INFO)
SORHR_COL
Definition: sorhr_col.f:259
Here is the call graph for this function:
Here is the caller graph for this function: