Skip to content

Commit

Permalink
Merge pull request #253 from kbergstr/fixes-3-8
Browse files Browse the repository at this point in the history
Fixes for Aasen's LAPACKE interfaces & workspace sizes, + some other small fixes
  • Loading branch information
langou authored May 31, 2018

Verified

This commit was signed with the committer’s verified signature.
renovate-bot Mend Renovate
2 parents 47151af + b8865c1 commit 696469f
Showing 53 changed files with 178 additions and 124 deletions.
6 changes: 3 additions & 3 deletions LAPACKE/src/lapacke_chetrf_aa_work.c
Original file line number Diff line number Diff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_chetrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
LAPACK_chetrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_chetrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
LAPACK_chetrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
/* Transpose input matrices */
LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_chetrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
LAPACK_chetrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
6 changes: 3 additions & 3 deletions LAPACKE/src/lapacke_csytrf_aa_work.c
Original file line number Diff line number Diff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_csytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
LAPACK_csytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_csytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
LAPACK_csytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
/* Transpose input matrices */
LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_csytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
LAPACK_csytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
6 changes: 3 additions & 3 deletions LAPACKE/src/lapacke_dsytrf_aa_work.c
Original file line number Diff line number Diff line change
@@ -40,7 +40,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
LAPACK_dsytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
@@ -55,7 +55,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_dsytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
LAPACK_dsytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
@@ -67,7 +67,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
/* Transpose input matrices */
LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_dsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
LAPACK_dsytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
6 changes: 3 additions & 3 deletions LAPACKE/src/lapacke_ssytrf_aa_work.c
Original file line number Diff line number Diff line change
@@ -40,7 +40,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ssytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
LAPACK_ssytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
@@ -55,7 +55,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_ssytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
LAPACK_ssytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
@@ -67,7 +67,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
/* Transpose input matrices */
LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_ssytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
LAPACK_ssytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
6 changes: 3 additions & 3 deletions LAPACKE/src/lapacke_zhetrf_aa_work.c
Original file line number Diff line number Diff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zhetrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
LAPACK_zhetrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zhetrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
LAPACK_zhetrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
/* Transpose input matrices */
LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zhetrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
LAPACK_zhetrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
6 changes: 3 additions & 3 deletions LAPACKE/src/lapacke_zsytrf_aa_work.c
Original file line number Diff line number Diff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
LAPACK_zsytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zsytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
LAPACK_zsytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
/* Transpose input matrices */
LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
LAPACK_zsytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
4 changes: 2 additions & 2 deletions SRC/cgejsv.f
Original file line number Diff line number Diff line change
@@ -701,7 +701,7 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
LWSVDJ = MAX( 2 * N, 1 )
LWSVDJV = MAX( 2 * N, 1 )
* .. minimal REAL workspace length for CGEQP3, CPOCON, CGESVJ
LRWQP3 = N
LRWQP3 = 2 * N
LRWCON = N
LRWSVDJ = N
IF ( LQUERY ) THEN
@@ -939,7 +939,7 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
END IF
END IF
MINWRK = MAX( 2, MINWRK )
OPTWRK = MAX( 2, OPTWRK )
OPTWRK = MAX( OPTWRK, MINWRK )
IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17
IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19
END IF
5 changes: 2 additions & 3 deletions SRC/chesv_aa.f
Original file line number Diff line number Diff line change
@@ -209,6 +209,8 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8
ELSE IF( LWORK.LT.MAX( 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
*
IF( INFO.EQ.0 ) THEN
@@ -219,9 +221,6 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
LWKOPT_HETRS = INT( WORK(1) )
LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS )
WORK( 1 ) = LWKOPT
IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
END IF
*
IF( INFO.NE.0 ) THEN
15 changes: 9 additions & 6 deletions SRC/chesv_aa_2stage.f
Original file line number Diff line number Diff line change
@@ -105,6 +105,7 @@
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally
*> used to select NB such that LTB >= (3*NB+1)*N.
*>
@@ -124,7 +125,7 @@
*>
*> \param[out] IPIV2
*> \verbatim
*> IPIV is INTEGER array, dimension (N)
*> IPIV2 is INTEGER array, dimension (N)
*> On exit, it contains the details of the interchanges, i.e.,
*> the row and column k of T were interchanged with the
*> row and column IPIV(k).
@@ -150,6 +151,7 @@
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB
*> such that LWORK >= N*NB.
*>
@@ -233,19 +235,18 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
INFO = -13
END IF
*
IF( INFO.EQ.0 ) THEN
CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) )
IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
INFO = -7
ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
INFO = -13
END IF
END IF
*
IF( INFO.NE.0 ) THEN
@@ -270,6 +271,8 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
END IF
*
WORK( 1 ) = LWKOPT
*
RETURN
*
* End of CHESV_AA_2STAGE
*
6 changes: 5 additions & 1 deletion SRC/chetrf_aa_2stage.f
Original file line number Diff line number Diff line change
@@ -93,6 +93,7 @@
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally
*> used to select NB such that LTB >= (3*NB+1)*N.
*>
@@ -112,7 +113,7 @@
*>
*> \param[out] IPIV2
*> \verbatim
*> IPIV is INTEGER array, dimension (N)
*> IPIV2 is INTEGER array, dimension (N)
*> On exit, it contains the details of the interchanges, i.e.,
*> the row and column k of T were interchanged with the
*> row and column IPIV(k).
@@ -125,6 +126,7 @@
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB
*> such that LWORK >= N*NB.
*>
@@ -658,6 +660,8 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
*
* Factor the band matrix
CALL CGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
*
RETURN
*
* End of CHETRF_AA_2STAGE
*
1 change: 1 addition & 0 deletions SRC/chetrs_aa_2stage.f
Original file line number Diff line number Diff line change
@@ -87,6 +87,7 @@
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N.
*> \endverbatim
*>
2 changes: 1 addition & 1 deletion SRC/cla_syamv.f
Original file line number Diff line number Diff line change
@@ -241,7 +241,7 @@ SUBROUTINE CLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
INFO = 10
END IF
IF( INFO.NE.0 )THEN
CALL XERBLA( 'SSYMV ', INFO )
CALL XERBLA( 'CLA_SYAMV', INFO )
RETURN
END IF
*
7 changes: 7 additions & 0 deletions SRC/claqr1.f
Original file line number Diff line number Diff line change
@@ -142,6 +142,13 @@ SUBROUTINE CLAQR1( N, H, LDH, S1, S2, V )
CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )
* ..
* .. Executable Statements ..
*
* Quick return if possible
*
IF( N.NE.2 .AND. N.NE.3 ) THEN
RETURN
END IF
*
IF( N.EQ.2 ) THEN
S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) )
IF( S.EQ.RZERO ) THEN
3 changes: 0 additions & 3 deletions SRC/csysv_aa.f
Original file line number Diff line number Diff line change
@@ -221,9 +221,6 @@ SUBROUTINE CSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
LWKOPT_SYTRS = INT( WORK(1) )
LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS )
WORK( 1 ) = LWKOPT
IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
END IF
*
IF( INFO.NE.0 ) THEN
15 changes: 9 additions & 6 deletions SRC/csysv_aa_2stage.f
Original file line number Diff line number Diff line change
@@ -105,6 +105,7 @@
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally
*> used to select NB such that LTB >= (3*NB+1)*N.
*>
@@ -124,7 +125,7 @@
*>
*> \param[out] IPIV2
*> \verbatim
*> IPIV is INTEGER array, dimension (N)
*> IPIV2 is INTEGER array, dimension (N)
*> On exit, it contains the details of the interchanges, i.e.,
*> the row and column k of T were interchanged with the
*> row and column IPIV(k).
@@ -150,6 +151,7 @@
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB
*> such that LWORK >= N*NB.
*>
@@ -233,19 +235,18 @@ SUBROUTINE CSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
INFO = -13
END IF
*
IF( INFO.EQ.0 ) THEN
CALL CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) )
IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
INFO = -7
ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
INFO = -13
END IF
END IF
*
IF( INFO.NE.0 ) THEN
@@ -270,6 +271,8 @@ SUBROUTINE CSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
END IF
*
WORK( 1 ) = LWKOPT
*
RETURN
*
* End of CSYSV_AA_2STAGE
*
Loading

0 comments on commit 696469f

Please sign in to comment.