Skip to content

Commit 401addd

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #1585 from martin-frbg/lapack-253
Fixes from Lapack-Reference PR 253
2 parents 1a49fb1 + c5b13d4 commit 401addd

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

53 files changed

+178
-124
lines changed

‎lapack-netlib/LAPACKE/src/lapacke_chetrf_aa_work.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
4141
lapack_int info = 0;
4242
if( matrix_layout == LAPACK_COL_MAJOR ) {
4343
/* Call LAPACK function and adjust info */
44-
LAPACK_chetrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
44+
LAPACK_chetrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
4545
if( info < 0 ) {
4646
info = info - 1;
4747
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
5656
}
5757
/* Query optimal working array(s) size if requested */
5858
if( lwork == -1 ) {
59-
LAPACK_chetrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
59+
LAPACK_chetrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
6060
return (info < 0) ? (info - 1) : info;
6161
}
6262
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
6969
/* Transpose input matrices */
7070
LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
7171
/* Call LAPACK function and adjust info */
72-
LAPACK_chetrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
72+
LAPACK_chetrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
7373
if( info < 0 ) {
7474
info = info - 1;
7575
}

‎lapack-netlib/LAPACKE/src/lapacke_csytrf_aa_work.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
4141
lapack_int info = 0;
4242
if( matrix_layout == LAPACK_COL_MAJOR ) {
4343
/* Call LAPACK function and adjust info */
44-
LAPACK_csytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
44+
LAPACK_csytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
4545
if( info < 0 ) {
4646
info = info - 1;
4747
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
5656
}
5757
/* Query optimal working array(s) size if requested */
5858
if( lwork == -1 ) {
59-
LAPACK_csytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
59+
LAPACK_csytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
6060
return (info < 0) ? (info - 1) : info;
6161
}
6262
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
6969
/* Transpose input matrices */
7070
LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
7171
/* Call LAPACK function and adjust info */
72-
LAPACK_csytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
72+
LAPACK_csytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
7373
if( info < 0 ) {
7474
info = info - 1;
7575
}

‎lapack-netlib/LAPACKE/src/lapacke_dsytrf_aa_work.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
4040
lapack_int info = 0;
4141
if( matrix_layout == LAPACK_COL_MAJOR ) {
4242
/* Call LAPACK function and adjust info */
43-
LAPACK_dsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
43+
LAPACK_dsytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
4444
if( info < 0 ) {
4545
info = info - 1;
4646
}
@@ -55,7 +55,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
5555
}
5656
/* Query optimal working array(s) size if requested */
5757
if( lwork == -1 ) {
58-
LAPACK_dsytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
58+
LAPACK_dsytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
5959
return (info < 0) ? (info - 1) : info;
6060
}
6161
/* Allocate memory for temporary array(s) */
@@ -67,7 +67,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
6767
/* Transpose input matrices */
6868
LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
6969
/* Call LAPACK function and adjust info */
70-
LAPACK_dsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
70+
LAPACK_dsytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
7171
if( info < 0 ) {
7272
info = info - 1;
7373
}

‎lapack-netlib/LAPACKE/src/lapacke_ssytrf_aa_work.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
4040
lapack_int info = 0;
4141
if( matrix_layout == LAPACK_COL_MAJOR ) {
4242
/* Call LAPACK function and adjust info */
43-
LAPACK_ssytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
43+
LAPACK_ssytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
4444
if( info < 0 ) {
4545
info = info - 1;
4646
}
@@ -55,7 +55,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
5555
}
5656
/* Query optimal working array(s) size if requested */
5757
if( lwork == -1 ) {
58-
LAPACK_ssytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
58+
LAPACK_ssytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
5959
return (info < 0) ? (info - 1) : info;
6060
}
6161
/* Allocate memory for temporary array(s) */
@@ -67,7 +67,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
6767
/* Transpose input matrices */
6868
LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
6969
/* Call LAPACK function and adjust info */
70-
LAPACK_ssytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
70+
LAPACK_ssytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
7171
if( info < 0 ) {
7272
info = info - 1;
7373
}

‎lapack-netlib/LAPACKE/src/lapacke_zhetrf_aa_work.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
4141
lapack_int info = 0;
4242
if( matrix_layout == LAPACK_COL_MAJOR ) {
4343
/* Call LAPACK function and adjust info */
44-
LAPACK_zhetrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
44+
LAPACK_zhetrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
4545
if( info < 0 ) {
4646
info = info - 1;
4747
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
5656
}
5757
/* Query optimal working array(s) size if requested */
5858
if( lwork == -1 ) {
59-
LAPACK_zhetrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
59+
LAPACK_zhetrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
6060
return (info < 0) ? (info - 1) : info;
6161
}
6262
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
6969
/* Transpose input matrices */
7070
LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
7171
/* Call LAPACK function and adjust info */
72-
LAPACK_zhetrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
72+
LAPACK_zhetrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
7373
if( info < 0 ) {
7474
info = info - 1;
7575
}

‎lapack-netlib/LAPACKE/src/lapacke_zsytrf_aa_work.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
4141
lapack_int info = 0;
4242
if( matrix_layout == LAPACK_COL_MAJOR ) {
4343
/* Call LAPACK function and adjust info */
44-
LAPACK_zsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
44+
LAPACK_zsytrf_aa( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
4545
if( info < 0 ) {
4646
info = info - 1;
4747
}
@@ -56,7 +56,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
5656
}
5757
/* Query optimal working array(s) size if requested */
5858
if( lwork == -1 ) {
59-
LAPACK_zsytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
59+
LAPACK_zsytrf_aa( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
6060
return (info < 0) ? (info - 1) : info;
6161
}
6262
/* Allocate memory for temporary array(s) */
@@ -69,7 +69,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
6969
/* Transpose input matrices */
7070
LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
7171
/* Call LAPACK function and adjust info */
72-
LAPACK_zsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
72+
LAPACK_zsytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
7373
if( info < 0 ) {
7474
info = info - 1;
7575
}

‎lapack-netlib/SRC/cgejsv.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -701,7 +701,7 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
701701
LWSVDJ = MAX( 2 * N, 1 )
702702
LWSVDJV = MAX( 2 * N, 1 )
703703
* .. minimal REAL workspace length for CGEQP3, CPOCON, CGESVJ
704-
LRWQP3 = N
704+
LRWQP3 = 2 * N
705705
LRWCON = N
706706
LRWSVDJ = N
707707
IF ( LQUERY ) THEN
@@ -939,7 +939,7 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
939939
END IF
940940
END IF
941941
MINWRK = MAX( 2, MINWRK )
942-
OPTWRK = MAX( 2, OPTWRK )
942+
OPTWRK = MAX( OPTWRK, MINWRK )
943943
IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17
944944
IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19
945945
END IF

‎lapack-netlib/SRC/chesv_aa.f

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -209,6 +209,8 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
209209
INFO = -5
210210
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
211211
INFO = -8
212+
ELSE IF( LWORK.LT.MAX( 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
213+
INFO = -10
212214
END IF
213215
*
214216
IF( INFO.EQ.0 ) THEN
@@ -219,9 +221,6 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
219221
LWKOPT_HETRS = INT( WORK(1) )
220222
LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS )
221223
WORK( 1 ) = LWKOPT
222-
IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
223-
INFO = -10
224-
END IF
225224
END IF
226225
*
227226
IF( INFO.NE.0 ) THEN

‎lapack-netlib/SRC/chesv_aa_2stage.f

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,7 @@
105105
*>
106106
*> \param[in] LTB
107107
*> \verbatim
108+
*> LTB is INTEGER
108109
*> The size of the array TB. LTB >= 4*N, internally
109110
*> used to select NB such that LTB >= (3*NB+1)*N.
110111
*>
@@ -124,7 +125,7 @@
124125
*>
125126
*> \param[out] IPIV2
126127
*> \verbatim
127-
*> IPIV is INTEGER array, dimension (N)
128+
*> IPIV2 is INTEGER array, dimension (N)
128129
*> On exit, it contains the details of the interchanges, i.e.,
129130
*> the row and column k of T were interchanged with the
130131
*> row and column IPIV(k).
@@ -150,6 +151,7 @@
150151
*>
151152
*> \param[in] LWORK
152153
*> \verbatim
154+
*> LWORK is INTEGER
153155
*> The size of WORK. LWORK >= N, internally used to select NB
154156
*> such that LWORK >= N*NB.
155157
*>
@@ -233,19 +235,18 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
233235
INFO = -3
234236
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
235237
INFO = -5
238+
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
239+
INFO = -7
236240
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
237241
INFO = -11
242+
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
243+
INFO = -13
238244
END IF
239245
*
240246
IF( INFO.EQ.0 ) THEN
241247
CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
242248
$ IPIV2, WORK, -1, INFO )
243249
LWKOPT = INT( WORK(1) )
244-
IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
245-
INFO = -7
246-
ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
247-
INFO = -13
248-
END IF
249250
END IF
250251
*
251252
IF( INFO.NE.0 ) THEN
@@ -270,6 +271,8 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
270271
END IF
271272
*
272273
WORK( 1 ) = LWKOPT
274+
*
275+
RETURN
273276
*
274277
* End of CHESV_AA_2STAGE
275278
*

‎lapack-netlib/SRC/chetrf_aa_2stage.f

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,7 @@
9393
*>
9494
*> \param[in] LTB
9595
*> \verbatim
96+
*> LTB is INTEGER
9697
*> The size of the array TB. LTB >= 4*N, internally
9798
*> used to select NB such that LTB >= (3*NB+1)*N.
9899
*>
@@ -112,7 +113,7 @@
112113
*>
113114
*> \param[out] IPIV2
114115
*> \verbatim
115-
*> IPIV is INTEGER array, dimension (N)
116+
*> IPIV2 is INTEGER array, dimension (N)
116117
*> On exit, it contains the details of the interchanges, i.e.,
117118
*> the row and column k of T were interchanged with the
118119
*> row and column IPIV(k).
@@ -125,6 +126,7 @@
125126
*>
126127
*> \param[in] LWORK
127128
*> \verbatim
129+
*> LWORK is INTEGER
128130
*> The size of WORK. LWORK >= N, internally used to select NB
129131
*> such that LWORK >= N*NB.
130132
*>
@@ -658,6 +660,8 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
658660
*
659661
* Factor the band matrix
660662
CALL CGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
663+
*
664+
RETURN
661665
*
662666
* End of CHETRF_AA_2STAGE
663667
*

0 commit comments

Comments
 (0)