Skip to content

Commit 8931652

Browse files
author
Mark Gates
committed
gesvdq: Add liwork. Query liwork and lrwork.
1 parent 37fd0bc commit 8931652

File tree

4 files changed

+265
-113
lines changed

4 files changed

+265
-113
lines changed

‎SRC/cgesvdq.f

Lines changed: 59 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
* ===========
44
*
55
* SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA,
6-
* $ S, U, LDU, V, LDV, NUMRANK, IWORK,
6+
* $ S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK,
77
* $ CWORK, LCWORK, RWORK, LRWORK, INFO )
88
*
99
* SIGMA library, xGESVDQ section updated February 2016.
@@ -16,7 +16,8 @@
1616
* .. Scalar Arguments ..
1717
* IMPLICIT NONE
1818
* CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV
19-
* INTEGER M, N, LDA, LDU, LDV, NUMRANK, LCWORK, LRWORK, INFO
19+
* INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LCWORK, LRWORK,
20+
* INFO
2021
* ..
2122
* .. Array Arguments ..
2223
* COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( * )
@@ -166,23 +167,36 @@
166167
* some singular values are computed as zeros.
167168
*..............................................................................
168169
* IWORK (workspace/output)
169-
* IWORK is INTEGER array of length
170-
* N + M - 1, if JOBP = 'P',
171-
* N if JOBP = 'N'
170+
* IWORK is INTEGER array, dimension (max(1, LIWORK)).
172171
* On exit, IWORK(1:N) contains column pivoting permutation of the
173172
* rank revealing QR factorization.
174173
* If JOBP = 'P', IWORK(N+1:N+M-1) contains the indices of the sequence
175174
* of row swaps used in row pivoting. These can be used to restore the
176175
* left singular vectors in the case JOBU = 'F'.
176+
*
177+
* If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0,
178+
* LIWORK(1) returns the minimal LIWORK.
179+
*..............................................................................
180+
* LIWORK (input)
181+
* LIWORK is INTEGER
182+
* The dimension of the array IWORK.
183+
* LIWORK >= N + M - 1, if JOBP = 'P';
184+
* LIWORK >= N if JOBP = 'N'.
185+
*
186+
* If LIWORK = -1, then a workspace query is assumed; the routine
187+
* only calculates and returns the optimal and minimal sizes
188+
* for the CWORK, IWORK, and RWORK arrays, and no error
189+
* message related to LCWORK is issued by XERBLA.
177190
*..............................................................................
178191
* CWORK (workspace/output)
179-
* CWORK is COMPLEX array of size LCWORK, used as a workspace.
192+
* CWORK is COMPLEX array, dimension (max(2, LCWORK)), used as a workspace.
180193
* On exit, if, on entry, LCWORK.NE.-1, CWORK(1:N) contains parameters
181194
* needed to recover the Q factor from the QR factorization computed by
182-
* CGEQP3. If, on entry, LCWORK = -1, then then a workspace query is
183-
* assumed and CWORK must be of length at least two. On exit CWORK(1)
184-
* contains the optimal length of CWORK and CWORK(2) contains the
185-
* minimal length.
195+
* CGEQP3.
196+
*
197+
* If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0,
198+
* CWORK(1) returns the optimal LCWORK, and
199+
* CWORK(2) returns the minimal LCWORK.
186200
*..............................................................................
187201
* LCWORK (input/output)
188202
* LCWORK is INTEGER
@@ -233,12 +247,14 @@
233247
* JOBR ='T', and also a scaled condition number estimate
234248
* requested.
235249
* Finally, LCWORK must be at least two: LCWORK = MAX( 2, LCWORK ).
236-
* If, on entry, LCWORK = -1, (workspace query) then the optimal and the
237-
* minimal length of CWORK are computed and returned in the first two entries
238-
* of CWORK. See the description of CWORK.
250+
*
251+
* If LCWORK = -1, then a workspace query is assumed; the routine
252+
* only calculates and returns the optimal and minimal sizes
253+
* for the CWORK, IWORK, and RWORK arrays, and no error
254+
* message related to LCWORK is issued by XERBLA.
239255
*..............................................................................
240256
* RWORK (workspace/output)
241-
* RWORK is REAL array of size LRWORK
257+
* RWORK is REAL array, dimension (max(1, LRWORK)).
242258
* On exit,
243259
* 1. If JOBA = 'E', RWORK(1) contains an estimate of the condition
244260
* number of column scaled A. If A = C * D where D is diagonal and C
@@ -249,12 +265,20 @@
249265
* exact zeros in CGESVD applied to the upper triangular or trapeziodal
250266
* R (from the initial QR factorization). In case of early exit (no call to
251267
* CGESVD, such as in the case of zero matrix) RWORK(2) = -1.
268+
*
269+
* If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0,
270+
* RWORK(1) returns the minimal LRWORK.
252271
*..............................................................................
253272
* LRWORK (input)
254273
* LRWORK is INTEGER.
255274
* The dimension of the array RWORK.
256275
* If JOBP ='P', then LRWORK >= MAX(2, M, 5*N);
257276
* Otherwise, LRWORK >= MAX(2, 5*N).
277+
*
278+
* If LRWORK = -1, then a workspace query is assumed; the routine
279+
* only calculates and returns the optimal and minimal sizes
280+
* for the CWORK, IWORK, and RWORK arrays, and no error
281+
* message related to LCWORK is issued by XERBLA.
258282
*..............................................................................
259283
* INFO
260284
* INFO is INTEGER
@@ -296,12 +320,13 @@
296320
*"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
297321
*
298322
SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA,
299-
$ S, U, LDU, V, LDV, NUMRANK, IWORK,
323+
$ S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK,
300324
$ CWORK, LCWORK, RWORK, LRWORK, INFO )
301325
* .. Scalar Arguments ..
302326
IMPLICIT NONE
303327
CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV
304-
INTEGER M, N, LDA, LDU, LDV, NUMRANK, LCWORK, LRWORK, INFO
328+
INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LCWORK, LRWORK,
329+
$ INFO
305330
* ..
306331
* .. Array Arguments ..
307332
COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( * )
@@ -320,7 +345,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA,
320345
INTEGER LWCON, LWQP3, LWRK_CGELQF, LWRK_CGESVD, LWRK_CGESVD2,
321346
$ LWRK_CGEQP3, LWRK_CGEQRF, LWRK_CUNMLQ, LWRK_CUNMQR,
322347
$ LWRK_CUNMQR2, LWLQF, LWQRF, LWSVD, LWSVD2, LWUNQ,
323-
$ LWUNQ2, LWUNLQ, MINWRK, MINWRK2, OPTWRK, OPTWRK2
348+
$ LWUNQ2, LWUNLQ, MINWRK, MINWRK2, OPTWRK, OPTWRK2,
349+
$ IMINWRK, RMINWRK
324350
LOGICAL ACCLA, ACCLM, ACCLH, ASCALED, CONDA, DNTWU, DNTWV,
325351
$ LQUERY, LSVC0, LSVEC, ROWPRM, RSVEC, RTRANS, WNTUA,
326352
$ WNTUF, WNTUR, WNTUS, WNTVA, WNTVR
@@ -366,7 +392,14 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA,
366392
ROWPRM = LSAME( JOBP, 'P' )
367393
RTRANS = LSAME( JOBR, 'T' )
368394
*
369-
LQUERY = ( LCWORK .EQ. -1 )
395+
IF ( ROWPRM ) THEN
396+
IMINWRK = MAX( 1, N + M - 1 )
397+
RMINWRK = MAX( 2, M, 5*N )
398+
ELSE
399+
IMINWRK = MAX( 1, N )
400+
RMINWRK = MAX( 2, 5*N )
401+
END IF
402+
LQUERY = (LIWORK .EQ. -1 .OR. LCWORK .EQ. -1 .OR. LRWORK .EQ. -1)
370403
INFO = 0
371404
IF ( .NOT. ( ACCLA .OR. ACCLM .OR. ACCLH ) ) THEN
372405
INFO = -1
@@ -392,6 +425,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA,
392425
ELSE IF ( LDV.LT.1 .OR. ( RSVEC .AND. LDV.LT.N ) .OR.
393426
$ ( CONDA .AND. LDV.LT.N ) ) THEN
394427
INFO = -14
428+
ELSE IF ( LIWORK .LT. IMINWRK .AND. .NOT. LQUERY ) THEN
429+
INFO = -17
395430
END IF
396431
*
397432
*
@@ -584,22 +619,21 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA,
584619
*
585620
MINWRK = MAX( 2, MINWRK )
586621
OPTWRK = MAX( 2, OPTWRK )
587-
IF ( LCWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 18
622+
IF ( LCWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = -19
588623
*
589624
END IF
590625
*
626+
IF (INFO .EQ. 0 .AND. LRWORK .LT. RMINWRK .AND. .NOT. LQUERY) THEN
627+
INFO = -21
628+
END IF
591629
IF( INFO.NE.0 ) THEN
592630
CALL XERBLA( 'CGESVDQ', -INFO )
593631
RETURN
594632
ELSE IF ( LQUERY ) THEN
633+
IWORK(1) = IMINWRK
595634
CWORK(1) = OPTWRK
596635
CWORK(2) = MINWRK
597-
RETURN
598-
END IF
599-
IF ( (ROWPRM .AND. (LRWORK .LT. MAX( 2, M, 5*N ))) .OR.
600-
$ ((.NOT.ROWPRM) .AND. (LRWORK .LT. MAX( 2, 5*N )))) THEN
601-
INFO = -20
602-
CALL XERBLA( 'CGESVDQ', -INFO )
636+
RWORK(1) = RMINWRK
603637
RETURN
604638
END IF
605639
*

0 commit comments

Comments
 (0)