Skip to content

Commit

Permalink
handle and document corner cases of lwork in lapack, align all precis…
Browse files Browse the repository at this point in the history 
…ions
  • Loading branch information
@dklyuchinskiy
dklyuchinskiy committed Dec 1, 2023
1 parent 4d3d130 commit 4b48d98
Show file tree
Hide file tree
Showing 82 changed files with 823 additions and 633 deletions.
1 change: 0 additions & 1 deletion SRC/cgehrd.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -226,7 +226,6 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
*
* Compute the workspace requirements
*

IF( N.EQ.0 ) THEN
LWKOPT = 1

Check warning on line 230 in SRC/cgehrd.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgehrd.f#L229-L230 

Added lines #L229 - L230 were not covered by tests
ELSE
Expand Down
2 changes: 1 addition & 1 deletion SRC/cgelqf.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -185,7 +185,7 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF ( .NOT.LQUERY ) THEN
ELSE IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
$ INFO = -7

Check warning on line 190 in SRC/cgelqf.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgelqf.f#L188-L190 

Added lines #L188 - L190 were not covered by tests
END IF
Expand Down
6 changes: 3 additions & 3 deletions SRC/cgemlq.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,8 +110,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
Expand Down Expand Up @@ -227,7 +227,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
ELSE
LWMIN = MAX( 1, LW )

Check warning on line 228 in SRC/cgemlq.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgemlq.f#L228 

Added line #L228 was not covered by tests
END IF

*
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
NBLCKS = ( MN - K ) / ( NB - K )
Expand Down
4 changes: 2 additions & 2 deletions SRC/cgemqr.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -111,8 +111,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
Expand Down
2 changes: 1 addition & 1 deletion SRC/cgeqlf.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -192,7 +192,7 @@ SUBROUTINE CGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
*
IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) )
$ INFO = -7
$ INFO = -7

Check warning on line 195 in SRC/cgeqlf.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqlf.f#L193-L195 

Added lines #L193 - L195 were not covered by tests
END IF
END IF
*
Expand Down
23 changes: 12 additions & 11 deletions SRC/cgeqp3rk.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -428,7 +428,7 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0,
*> LWORK >= 1, if MIN(M,N) = 0, and
*> LWORK >= N+NRHS-1, otherwise.
*> For optimal performance LWORK >= NB*( N+NRHS+1 ),
*> where NB is the optimal block size for CGEQP3RK returned
Expand Down Expand Up @@ -628,8 +628,9 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
* .. External Functions ..
LOGICAL SISNAN
INTEGER ISAMAX, ILAENV
REAL SLAMCH, SCNRM2
EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV
REAL SLAMCH, SCNRM2, SROUNDUP_LWORK
EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV,
$ SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC CMPLX, MAX, MIN
Expand Down Expand Up @@ -704,7 +705,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
*
LWKOPT = 2*N + NB*( N+NRHS+1 )
END IF
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 708 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L708 

Added line #L708 was not covered by tests
*
IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
INFO = -15
Expand All @@ -727,7 +728,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
K = 0
MAXC2NRMK = ZERO
RELMAXC2NRMK = ZERO
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 731 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L731 

Added line #L731 was not covered by tests
RETURN
END IF
*
Expand Down Expand Up @@ -779,7 +780,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
*
* Array TAU is not set and contains undefined elements.
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 783 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L783 

Added line #L783 was not covered by tests
RETURN
END IF
*
Expand All @@ -798,7 +799,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
TAU( J ) = CZERO
END DO
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 802 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L802 

Added line #L802 was not covered by tests
RETURN
*
END IF
Expand Down Expand Up @@ -829,7 +830,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
DO J = 1, MINMN
TAU( J ) = CZERO
END DO
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 833 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L833 

Added line #L833 was not covered by tests
RETURN
END IF
*
Expand Down Expand Up @@ -874,7 +875,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
TAU( J ) = CZERO
END DO
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 878 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L878 

Added line #L878 was not covered by tests
RETURN
END IF
*
Expand Down Expand Up @@ -992,7 +993,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
*
* Return from the routine.
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 996 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L996 

Added line #L996 was not covered by tests
*
RETURN
*
Expand Down Expand Up @@ -1083,7 +1084,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
*
END IF
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 1087 in SRC/cgeqp3rk.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqp3rk.f#L1087 

Added line #L1087 was not covered by tests
*
RETURN
*
Expand Down
10 changes: 5 additions & 5 deletions SRC/cgeqrfp.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -184,12 +184,12 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
INFO = 0
NB = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 )
K = MIN( M, N )
IF ( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1

Check warning on line 189 in SRC/cgeqrfp.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqrfp.f#L186-L189 

Added lines #L186 - L189 were not covered by tests
ELSE
LWKMIN = N
LWKOPT = N*NB
LWKMIN = N
LWKOPT = N*NB

Check warning on line 192 in SRC/cgeqrfp.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqrfp.f#L191-L192 

Added lines #L191 - L192 were not covered by tests
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )

Check warning on line 194 in SRC/cgeqrfp.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgeqrfp.f#L194 

Added line #L194 was not covered by tests
*
Expand Down
35 changes: 19 additions & 16 deletions SRC/cgesvj.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -208,16 +208,17 @@
*> \verbatim
*> CWORK is COMPLEX array, dimension (max(1,LWORK))
*> Used as workspace.
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*> length of CWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER.
*> Length of CWORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(1,M+N), otherwise.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M+N, otherwise.
*>
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*> length of CWORK.
*> \endverbatim
*>
*> \param[in,out] RWORK
Expand Down Expand Up @@ -248,15 +249,17 @@
*> RWORK(6) = the largest absolute value over all sines of the
*> Jacobi rotation angles in the last sweep. It can be
*> useful for a post festum analysis.
*> If on entry LRWORK = -1, then a workspace query is assumed and
*> no computation is done; RWORK(1) is set to the minial (and optimal)
*> length of RWORK.
*> \endverbatim
*>
*> \param[in] LRWORK
*> \verbatim
*> LRWORK is INTEGER
*> Length of RWORK, LRWORK >= MAX(6,N).
*> Length of RWORK.
*> LRWORK >= 1, if MIN(M,N) = 0, and LRWORK >= MAX(6,N), otherwise
*>
*> If on entry LRWORK = -1, then a workspace query is assumed and
*> no computation is done; RWORK(1) is set to the minial (and optimal)
*> length of RWORK.
*> \endverbatim
*>
*> \param[out] INFO
Expand Down Expand Up @@ -400,8 +403,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
INTEGER ISAMAX
EXTERNAL ISAMAX
* from LAPACK
REAL SLAMCH
EXTERNAL SLAMCH
REAL SLAMCH, SROUNDUP_LWORK
EXTERNAL SLAMCH, SROUNDUP_LWORK
LOGICAL LSAME
EXTERNAL LSAME
* ..
Expand All @@ -423,19 +426,19 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
APPLV = LSAME( JOBV, 'A' )
UPPER = LSAME( JOBA, 'U' )
LOWER = LSAME( JOBA, 'L' )

*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
LRWMIN = 6
LRWMIN = 1

Check warning on line 433 in SRC/cgesvj.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgesvj.f#L430-L433 

Added lines #L430 - L433 were not covered by tests
ELSE
LWMIN = M + N
LRWMIN = MAX( 6, N )

Check warning on line 436 in SRC/cgesvj.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgesvj.f#L435-L436 

Added lines #L435 - L436 were not covered by tests
END IF
CWORK(1) = LWMIN
RWORK(1) = LRWMIN
CWORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )

Check warning on line 439 in SRC/cgesvj.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgesvj.f#L438-L439 

Added lines #L438 - L439 were not covered by tests
*
LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 )
LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 )

Check warning on line 441 in SRC/cgesvj.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgesvj.f#L441 

Added line #L441 was not covered by tests
IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
INFO = -1
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
Expand Down Expand Up @@ -467,7 +470,7 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGESVJ', -INFO )
RETURN
ELSE IF ( LQUERY ) THEN
ELSE IF( LQUERY ) THEN

Check warning on line 473 in SRC/cgesvj.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgesvj.f#L473 

Added line #L473 was not covered by tests
RETURN
END IF
*
Expand Down
16 changes: 11 additions & 5 deletions SRC/cgetsqrhrt.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,13 +131,15 @@
*> \param[in] LWORK
*> \verbatim
*> The dimension of the array WORK.
*> If MIN(M,N) = 0, LWORK >= 1, else
*> LWORK >= MAX( 1, 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
Expand Down Expand Up @@ -200,6 +202,10 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK,
INTEGER I, IINFO, J, LW1, LW2, LWT, LDWT, LWORKOPT,
$ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS
* ..
* .. External Functions ..
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, CUNHR_COL,
$ XERBLA
Expand All @@ -212,7 +218,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK,
* Test the input arguments
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LQUERY = ( LWORK.EQ.-1 )

Check warning on line 221 in SRC/cgetsqrhrt.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgetsqrhrt.f#L221 

Added line #L221 was not covered by tests
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
Expand All @@ -225,7 +231,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK,
INFO = -5
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -7
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN

Check warning on line 234 in SRC/cgetsqrhrt.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgetsqrhrt.f#L234 

Added line #L234 was not covered by tests
INFO = -9
ELSE
*
Expand Down Expand Up @@ -278,14 +284,14 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK,
CALL XERBLA( 'CGETSQRHRT', -INFO )
RETURN
ELSE IF ( LQUERY ) THEN
WORK( 1 ) = CMPLX( LWORKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )

Check warning on line 287 in SRC/cgetsqrhrt.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgetsqrhrt.f#L287 

Added line #L287 was not covered by tests
RETURN
END IF
*
* Quick return if possible
*
IF( MIN( M, N ).EQ.0 ) THEN
WORK( 1 ) = CMPLX( LWORKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )

Check warning on line 294 in SRC/cgetsqrhrt.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgetsqrhrt.f#L294 

Added line #L294 was not covered by tests
RETURN
END IF
*
Expand Down Expand Up @@ -342,7 +348,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK,
END IF
END DO
*
WORK( 1 ) = CMPLX( LWORKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )

Check warning on line 351 in SRC/cgetsqrhrt.f

View check run for this annotation

Codecov / codecov/patch

SRC/cgetsqrhrt.f#L351 

Added line #L351 was not covered by tests
RETURN
*
* End of CGETSQRHRT
Expand Down
Loading

0 comments on commit 4b48d98

Please sign in to comment.