From 0c2aa0bed7d51af06f2ef2ab24779722473bce9d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 13 Nov 2022 20:29:08 +0100 Subject: [PATCH 1/4] Fix implicit conversions and unused variables (Reference-LAPACK PR 703) --- lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c | 1 - lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c | 1 - lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c | 1 - lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c | 1 - 4 files changed, 4 deletions(-) diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c index 8406635e9..05ff8d57f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c @@ -48,7 +48,6 @@ lapack_int LAPACKE_cgesvdq( int matrix_layout, char joba, char jobp, lapack_int lrwork = -1; float* rwork = NULL; float rwork_query; - lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_cgesvdq", -1 ); return -1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c index 4e1b87681..4a0d427b3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c @@ -48,7 +48,6 @@ lapack_int LAPACKE_dgesvdq( int matrix_layout, char joba, char jobp, lapack_int lrwork = -1; double* rwork = NULL; double rwork_query; - lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dgesvdq", -1 ); return -1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c index 0b6406dec..627d2406c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c @@ -48,7 +48,6 @@ lapack_int LAPACKE_sgesvdq( int matrix_layout, char joba, char jobp, lapack_int lrwork = -1; float* rwork = NULL; float rwork_query; - lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_sgesvdq", -1 ); return -1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c index 528b94a47..1d318e571 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c @@ -48,7 +48,6 @@ lapack_int LAPACKE_zgesvdq( int matrix_layout, char joba, char jobp, lapack_int lrwork = -1; double* rwork = NULL; double rwork_query; - lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zgesvdq", -1 ); return -1; From a485e4f5156ad08dad26cdc20960b379fbc6a919 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 13 Nov 2022 20:30:06 +0100 Subject: [PATCH 2/4] Fix implicit conversions and unused variables (Reference-LAPACK PR 703) --- lapack-netlib/LAPACKE/example/example_DGELS_rowmajor.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lapack-netlib/LAPACKE/example/example_DGELS_rowmajor.c b/lapack-netlib/LAPACKE/example/example_DGELS_rowmajor.c index 1c027f862..a174fcaf0 100644 --- a/lapack-netlib/LAPACKE/example/example_DGELS_rowmajor.c +++ b/lapack-netlib/LAPACKE/example/example_DGELS_rowmajor.c @@ -49,11 +49,9 @@ LAPACKE_dgels (row-major, high-level) Example Program Results - -- LAPACKE Example routine (version 3.7.0) -- + -- LAPACKE Example routine -- -- LAPACK is a software package provided by Univ. of Tennessee, -- -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- - December 2016 - */ /* Calling DGELS using row-major layout */ @@ -66,8 +64,8 @@ int main (int argc, const char * argv[]) { /* Locals */ - double A[5][3] = {1,1,1,2,3,4,3,5,2,4,2,5,5,4,3}; - double b[5][2] = {-10,-3,12,14,14,12,16,16,18,16}; + double A[5][3] = {{1,1,1},{2,3,4},{3,5,2},{4,2,5},{5,4,3}}; + double b[5][2] = {{-10,-3},{12,14},{14,12},{16,16},{18,16}}; lapack_int info,m,n,lda,ldb,nrhs; /* Initialization */ From c99d27ae451a8c3e1ad46f3ff2fc2661ccb94896 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 13 Nov 2022 20:33:20 +0100 Subject: [PATCH 3/4] Fix implicit conversions and unused variables (Reference-LAPACK PR 703) --- lapack-netlib/TESTING/EIG/cdrvsg.f | 4 ++-- lapack-netlib/TESTING/EIG/cget37.f | 2 +- lapack-netlib/TESTING/EIG/ddrvsg.f | 4 ++-- lapack-netlib/TESTING/EIG/sdrvsg.f | 4 ++-- lapack-netlib/TESTING/EIG/zdrvsg.f | 4 ++-- lapack-netlib/TESTING/EIG/zget37.f | 2 +- 6 files changed, 10 insertions(+), 10 deletions(-) diff --git a/lapack-netlib/TESTING/EIG/cdrvsg.f b/lapack-netlib/TESTING/EIG/cdrvsg.f index a93933a27..d15b39d01 100644 --- a/lapack-netlib/TESTING/EIG/cdrvsg.f +++ b/lapack-netlib/TESTING/EIG/cdrvsg.f @@ -663,8 +663,8 @@ IL = 1 IU = N ELSE - IL = 1 + ( N-1 )*SLARND( 1, ISEED2 ) - IU = 1 + ( N-1 )*SLARND( 1, ISEED2 ) + IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) ) + IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) ) IF( IL.GT.IU ) THEN ITEMP = IL IL = IU diff --git a/lapack-netlib/TESTING/EIG/cget37.f b/lapack-netlib/TESTING/EIG/cget37.f index c2a6589f3..44d4580d6 100644 --- a/lapack-netlib/TESTING/EIG/cget37.f +++ b/lapack-netlib/TESTING/EIG/cget37.f @@ -265,7 +265,7 @@ 100 CONTINUE WSRT( KMIN ) = WSRT( I ) WSRT( I ) = VMIN - VCMIN = WTMP( I ) + VCMIN = REAL( WTMP( I ) ) WTMP( I ) = W( KMIN ) WTMP( KMIN ) = VCMIN VMIN = STMP( KMIN ) diff --git a/lapack-netlib/TESTING/EIG/ddrvsg.f b/lapack-netlib/TESTING/EIG/ddrvsg.f index 0b49c8404..2e9d3c643 100644 --- a/lapack-netlib/TESTING/EIG/ddrvsg.f +++ b/lapack-netlib/TESTING/EIG/ddrvsg.f @@ -645,8 +645,8 @@ IL = 1 IU = N ELSE - IL = 1 + ( N-1 )*DLARND( 1, ISEED2 ) - IU = 1 + ( N-1 )*DLARND( 1, ISEED2 ) + IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) + IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) IF( IL.GT.IU ) THEN ITEMP = IL IL = IU diff --git a/lapack-netlib/TESTING/EIG/sdrvsg.f b/lapack-netlib/TESTING/EIG/sdrvsg.f index 4a57223c8..877579bcd 100644 --- a/lapack-netlib/TESTING/EIG/sdrvsg.f +++ b/lapack-netlib/TESTING/EIG/sdrvsg.f @@ -645,8 +645,8 @@ IL = 1 IU = N ELSE - IL = 1 + ( N-1 )*SLARND( 1, ISEED2 ) - IU = 1 + ( N-1 )*SLARND( 1, ISEED2 ) + IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) ) + IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) ) IF( IL.GT.IU ) THEN ITEMP = IL IL = IU diff --git a/lapack-netlib/TESTING/EIG/zdrvsg.f b/lapack-netlib/TESTING/EIG/zdrvsg.f index 336514a3f..71f1d6371 100644 --- a/lapack-netlib/TESTING/EIG/zdrvsg.f +++ b/lapack-netlib/TESTING/EIG/zdrvsg.f @@ -663,8 +663,8 @@ IL = 1 IU = N ELSE - IL = 1 + ( N-1 )*DLARND( 1, ISEED2 ) - IU = 1 + ( N-1 )*DLARND( 1, ISEED2 ) + IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) + IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) IF( IL.GT.IU ) THEN ITEMP = IL IL = IU diff --git a/lapack-netlib/TESTING/EIG/zget37.f b/lapack-netlib/TESTING/EIG/zget37.f index 63680e855..5013fbdd9 100644 --- a/lapack-netlib/TESTING/EIG/zget37.f +++ b/lapack-netlib/TESTING/EIG/zget37.f @@ -265,7 +265,7 @@ 100 CONTINUE WSRT( KMIN ) = WSRT( I ) WSRT( I ) = VMIN - VCMIN = WTMP( I ) + VCMIN = DBLE( WTMP( I ) ) WTMP( I ) = W( KMIN ) WTMP( KMIN ) = VCMIN VMIN = STMP( KMIN ) From fdb012ceed9ec69d900f9c5117e7be4263b6a947 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 13 Nov 2022 20:37:18 +0100 Subject: [PATCH 4/4] Fix implicit conversions and unused variables (Reference-LAPACK PR 703) --- lapack-netlib/TESTING/LIN/cchkpt.f | 6 +-- lapack-netlib/TESTING/LIN/cchktr.f | 54 ++++++++++++++++++++++----- lapack-netlib/TESTING/LIN/cdrvgt.f | 8 ++-- lapack-netlib/TESTING/LIN/clattp.f | 6 +-- lapack-netlib/TESTING/LIN/cpbt01.f | 5 ++- lapack-netlib/TESTING/LIN/cpot01.f | 4 +- lapack-netlib/TESTING/LIN/cppt01.f | 2 +- lapack-netlib/TESTING/LIN/cpst01.f | 2 +- lapack-netlib/TESTING/LIN/zchkpt.f | 6 +-- lapack-netlib/TESTING/LIN/zchktr.f | 60 +++++++++++++++++++++++------- lapack-netlib/TESTING/LIN/zdrvgt.f | 8 ++-- lapack-netlib/TESTING/LIN/zdrvpt.f | 12 +++--- lapack-netlib/TESTING/LIN/zlattp.f | 6 +-- lapack-netlib/TESTING/LIN/zpbt01.f | 5 ++- lapack-netlib/TESTING/LIN/zpot01.f | 4 +- lapack-netlib/TESTING/LIN/zppt01.f | 2 +- lapack-netlib/TESTING/LIN/zpst01.f | 2 +- 17 files changed, 131 insertions(+), 61 deletions(-) diff --git a/lapack-netlib/TESTING/LIN/cchkpt.f b/lapack-netlib/TESTING/LIN/cchkpt.f index 2ec802064..7dc367eeb 100644 --- a/lapack-netlib/TESTING/LIN/cchkpt.f +++ b/lapack-netlib/TESTING/LIN/cchkpt.f @@ -319,15 +319,15 @@ * elements. * IF( IZERO.EQ.1 ) THEN - D( 1 ) = Z( 2 ) + D( 1 ) = REAL( Z( 2 ) ) IF( N.GT.1 ) $ E( 1 ) = Z( 3 ) ELSE IF( IZERO.EQ.N ) THEN E( N-1 ) = Z( 1 ) - D( N ) = Z( 2 ) + D( N ) = REAL( Z( 2 ) ) ELSE E( IZERO-1 ) = Z( 1 ) - D( IZERO ) = Z( 2 ) + D( IZERO ) = REAL( Z( 2 ) ) E( IZERO ) = Z( 3 ) END IF END IF diff --git a/lapack-netlib/TESTING/LIN/cchktr.f b/lapack-netlib/TESTING/LIN/cchktr.f index ce1ecf761..c55b07643 100644 --- a/lapack-netlib/TESTING/LIN/cchktr.f +++ b/lapack-netlib/TESTING/LIN/cchktr.f @@ -31,7 +31,7 @@ *> *> \verbatim *> -*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS +*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS(3) *> \endverbatim * * Arguments: @@ -184,7 +184,7 @@ INTEGER NTYPE1, NTYPES PARAMETER ( NTYPE1 = 10, NTYPES = 18 ) INTEGER NTESTS - PARAMETER ( NTESTS = 9 ) + PARAMETER ( NTESTS = 10 ) INTEGER NTRAN PARAMETER ( NTRAN = 3 ) REAL ONE, ZERO @@ -195,13 +195,13 @@ CHARACTER*3 PATH INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN, $ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN - REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI, - $ RCONDO, SCALE + REAL AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC, + $ RCONDI, RCONDO, RES, SCALE, SLAMCH * .. * .. Local Arrays .. CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) + REAL RESULT( NTESTS ), SCALE3( 2 ) * .. * .. External Functions .. LOGICAL LSAME @@ -210,9 +210,9 @@ * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRTR, CGET04, - $ CLACPY, CLARHS, CLATRS, CLATTR, CTRCON, CTRRFS, - $ CTRT01, CTRT02, CTRT03, CTRT05, CTRT06, CTRTRI, - $ CTRTRS, XLAENV + $ CLACPY, CLARHS, CLATRS, CLATRS3, CLATTR, + $ CSSCAL, CTRCON, CTRRFS, CTRT01, CTRT02, CTRT03, + $ CTRT05, CTRT06, CTRTRI, CTRTRS, XLAENV, SLAMCH * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -236,6 +236,7 @@ * PATH( 1: 1 ) = 'Complex precision' PATH( 2: 3 ) = 'TR' + BIGNUM = SLAMCH('Overflow') / SLAMCH('Precision') NRUN = 0 NFAIL = 0 NERRS = 0 @@ -380,7 +381,7 @@ * This line is needed on a Sun SPARCstation. * IF( N.GT.0 ) - $ DUMMY = A( 1 ) + $ DUMMY = REAL( A( 1 ) ) * CALL CTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, $ X, LDA, B, LDA, WORK, RWORK, @@ -535,6 +536,32 @@ $ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK, $ RESULT( 9 ) ) * +*+ TEST 10 +* Solve op(A)*X = B. +* + SRNAMT = 'CLATRS3' + CALL CCOPY( N, X, 1, B, 1 ) + CALL CCOPY( N, X, 1, B, 1 ) + CALL CSCAL( N, BIGNUM, B( N+1 ), 1 ) + CALL CLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA, + $ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX, + $ INFO ) +* +* Check error code from CLATRS3. +* + IF( INFO.NE.0 ) + $ CALL ALAERH( PATH, 'CLATRS3', INFO, 0, + $ UPLO // TRANS // DIAG // 'Y', N, N, + $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) + CALL CTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, + $ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA, + $ X, LDA, WORK, RESULT( 10 ) ) + CALL CSSCAL( N, BIGNUM, X, 1 ) + CALL CTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, + $ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA, + $ X, LDA, WORK, RESULT( 10 ) ) + RESULT( 10 ) = MAX( RESULT( 10 ), RES ) +* * Print information about the tests that did not pass * the threshold. * @@ -552,7 +579,14 @@ $ DIAG, 'Y', N, IMAT, 9, RESULT( 9 ) NFAIL = NFAIL + 1 END IF - NRUN = NRUN + 2 + IF( RESULT( 10 ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'CLATRS3', UPLO, TRANS, + $ DIAG, 'N', N, IMAT, 10, RESULT( 10 ) + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 3 90 CONTINUE 100 CONTINUE 110 CONTINUE diff --git a/lapack-netlib/TESTING/LIN/cdrvgt.f b/lapack-netlib/TESTING/LIN/cdrvgt.f index 8d43f640f..acfbbcfa1 100644 --- a/lapack-netlib/TESTING/LIN/cdrvgt.f +++ b/lapack-netlib/TESTING/LIN/cdrvgt.f @@ -307,16 +307,16 @@ IZERO = 0 ELSE IF( IMAT.EQ.8 ) THEN IZERO = 1 - Z( 2 ) = A( N ) + Z( 2 ) = REAL( A( N ) ) A( N ) = ZERO IF( N.GT.1 ) THEN - Z( 3 ) = A( 1 ) + Z( 3 ) = REAL( A( 1 ) ) A( 1 ) = ZERO END IF ELSE IF( IMAT.EQ.9 ) THEN IZERO = N - Z( 1 ) = A( 3*N-2 ) - Z( 2 ) = A( 2*N-1 ) + Z( 1 ) = REAL( A( 3*N-2 ) ) + Z( 2 ) = REAL( A( 2*N-1 ) ) A( 3*N-2 ) = ZERO A( 2*N-1 ) = ZERO ELSE diff --git a/lapack-netlib/TESTING/LIN/clattp.f b/lapack-netlib/TESTING/LIN/clattp.f index 82f0585df..a47a252ad 100644 --- a/lapack-netlib/TESTING/LIN/clattp.f +++ b/lapack-netlib/TESTING/LIN/clattp.f @@ -336,7 +336,7 @@ WORK( J+1 ) = PLUS2 WORK( N+J+1 ) = ZERO PLUS1 = STAR1 / PLUS2 - REXP = CLARND( 2, ISEED ) + REXP = REAL( CLARND( 2, ISEED ) ) IF( REXP.LT.ZERO ) THEN STAR1 = -SFAC**( ONE-REXP )*CLARND( 5, ISEED ) ELSE @@ -790,7 +790,7 @@ DO 460 J = 1, N / 2 JL = JJ DO 450 I = J, N - J - T = AP( JR-I+J ) + T = REAL( AP( JR-I+J ) ) AP( JR-I+J ) = AP( JL ) AP( JL ) = T JL = JL + I @@ -804,7 +804,7 @@ DO 480 J = 1, N / 2 JR = JJ DO 470 I = J, N - J - T = AP( JL+I-J ) + T = REAL( AP( JL+I-J ) ) AP( JL+I-J ) = AP( JR ) AP( JR ) = T JR = JR - I diff --git a/lapack-netlib/TESTING/LIN/cpbt01.f b/lapack-netlib/TESTING/LIN/cpbt01.f index 33c80666d..6145a1875 100644 --- a/lapack-netlib/TESTING/LIN/cpbt01.f +++ b/lapack-netlib/TESTING/LIN/cpbt01.f @@ -201,7 +201,8 @@ * * Compute the (K,K) element of the result. * - AKK = CDOTC( KLEN+1, AFAC( KC, K ), 1, AFAC( KC, K ), 1 ) + AKK = REAL( + $ CDOTC( KLEN+1, AFAC( KC, K ), 1, AFAC( KC, K ), 1 ) ) AFAC( KD+1, K ) = AKK * * Compute the rest of column K. @@ -228,7 +229,7 @@ * * Scale column K by the diagonal element. * - AKK = AFAC( 1, K ) + AKK = REAL( AFAC( 1, K ) ) CALL CSSCAL( KLEN+1, AKK, AFAC( 1, K ), 1 ) * 40 CONTINUE diff --git a/lapack-netlib/TESTING/LIN/cpot01.f b/lapack-netlib/TESTING/LIN/cpot01.f index 00e195dd6..fbcf65086 100644 --- a/lapack-netlib/TESTING/LIN/cpot01.f +++ b/lapack-netlib/TESTING/LIN/cpot01.f @@ -176,7 +176,7 @@ * * Compute the (K,K) element of the result. * - TR = CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) + TR = REAL( CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) ) AFAC( K, K ) = TR * * Compute the rest of column K. @@ -224,7 +224,7 @@ 70 CONTINUE END IF * -* Compute norm( L*U - A ) / ( N * norm(A) * EPS ) +* Compute norm(L*U - A) / ( N * norm(A) * EPS ) * RESID = CLANHE( '1', UPLO, N, AFAC, LDAFAC, RWORK ) * diff --git a/lapack-netlib/TESTING/LIN/cppt01.f b/lapack-netlib/TESTING/LIN/cppt01.f index 3a761a4c7..f865ec779 100644 --- a/lapack-netlib/TESTING/LIN/cppt01.f +++ b/lapack-netlib/TESTING/LIN/cppt01.f @@ -178,7 +178,7 @@ * * Compute the (K,K) element of the result. * - TR = CDOTC( K, AFAC( KC ), 1, AFAC( KC ), 1 ) + TR = REAL( CDOTC( K, AFAC( KC ), 1, AFAC( KC ), 1 ) ) AFAC( KC+K-1 ) = TR * * Compute the rest of column K. diff --git a/lapack-netlib/TESTING/LIN/cpst01.f b/lapack-netlib/TESTING/LIN/cpst01.f index 26da4b394..03d25515d 100644 --- a/lapack-netlib/TESTING/LIN/cpst01.f +++ b/lapack-netlib/TESTING/LIN/cpst01.f @@ -219,7 +219,7 @@ * * Compute the (K,K) element of the result. * - TR = CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) + TR = REAL( CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) ) AFAC( K, K ) = TR * * Compute the rest of column K. diff --git a/lapack-netlib/TESTING/LIN/zchkpt.f b/lapack-netlib/TESTING/LIN/zchkpt.f index 80e1690a7..11089d2a1 100644 --- a/lapack-netlib/TESTING/LIN/zchkpt.f +++ b/lapack-netlib/TESTING/LIN/zchkpt.f @@ -319,15 +319,15 @@ * elements. * IF( IZERO.EQ.1 ) THEN - D( 1 ) = Z( 2 ) + D( 1 ) = DBLE( Z( 2 ) ) IF( N.GT.1 ) $ E( 1 ) = Z( 3 ) ELSE IF( IZERO.EQ.N ) THEN E( N-1 ) = Z( 1 ) - D( N ) = Z( 2 ) + D( N ) = DBLE( Z( 2 ) ) ELSE E( IZERO-1 ) = Z( 1 ) - D( IZERO ) = Z( 2 ) + D( IZERO ) = DBLE( Z( 2 ) ) E( IZERO ) = Z( 3 ) END IF END IF diff --git a/lapack-netlib/TESTING/LIN/zchktr.f b/lapack-netlib/TESTING/LIN/zchktr.f index 0a6f47b1e..275ca2857 100644 --- a/lapack-netlib/TESTING/LIN/zchktr.f +++ b/lapack-netlib/TESTING/LIN/zchktr.f @@ -31,7 +31,7 @@ *> *> \verbatim *> -*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS +*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS(3) *> \endverbatim * * Arguments: @@ -184,7 +184,7 @@ INTEGER NTYPE1, NTYPES PARAMETER ( NTYPE1 = 10, NTYPES = 18 ) INTEGER NTESTS - PARAMETER ( NTESTS = 9 ) + PARAMETER ( NTESTS = 10 ) INTEGER NTRAN PARAMETER ( NTRAN = 3 ) DOUBLE PRECISION ONE, ZERO @@ -195,13 +195,13 @@ CHARACTER*3 PATH INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN, $ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN - DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI, - $ RCONDO, SCALE + DOUBLE PRECISION AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC, + $ RCONDI, RCONDO, RES, SCALE, DLAMCH * .. * .. Local Arrays .. CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) + DOUBLE PRECISION RESULT( NTESTS ), SCALE3( 2 ) * .. * .. External Functions .. LOGICAL LSAME @@ -209,10 +209,10 @@ EXTERNAL LSAME, ZLANTR * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZCOPY, ZERRTR, - $ ZGET04, ZLACPY, ZLARHS, ZLATRS, ZLATTR, ZTRCON, - $ ZTRRFS, ZTRT01, ZTRT02, ZTRT03, ZTRT05, ZTRT06, - $ ZTRTRI, ZTRTRS + EXTERNAL ALAERH, ALAHD, ALASUM, DLAMCH, XLAENV, ZCOPY, + $ ZDSCAL, ZERRTR, ZGET04, ZLACPY, ZLARHS, ZLATRS, + $ ZLATRS3, ZLATTR, ZTRCON, ZTRRFS, ZTRT01, + $ ZTRT02, ZTRT03, ZTRT05, ZTRT06, ZTRTRI, ZTRTRS * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -236,6 +236,7 @@ * PATH( 1: 1 ) = 'Zomplex precision' PATH( 2: 3 ) = 'TR' + BIGNUM = DLAMCH('Overflow') / DLAMCH('Precision') NRUN = 0 NFAIL = 0 NERRS = 0 @@ -380,7 +381,7 @@ * This line is needed on a Sun SPARCstation. * IF( N.GT.0 ) - $ DUMMY = A( 1 ) + $ DUMMY = DBLE( A( 1 ) ) * CALL ZTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, $ X, LDA, B, LDA, WORK, RWORK, @@ -535,6 +536,32 @@ $ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK, $ RESULT( 9 ) ) * +*+ TEST 10 +* Solve op(A)*X = B +* + SRNAMT = 'ZLATRS3' + CALL ZCOPY( N, X, 1, B, 1 ) + CALL ZCOPY( N, X, 1, B( N+1 ), 1 ) + CALL ZDSCAL( N, BIGNUM, B( N+1 ), 1 ) + CALL ZLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA, + $ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX, + $ INFO ) +* +* Check error code from ZLATRS3. +* + IF( INFO.NE.0 ) + $ CALL ALAERH( PATH, 'ZLATRS3', INFO, 0, + $ UPLO // TRANS // DIAG // 'N', N, N, + $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) + CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, + $ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA, + $ X, LDA, WORK, RESULT( 10 ) ) + CALL ZDSCAL( N, BIGNUM, X, 1 ) + CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, + $ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA, + $ X, LDA, WORK, RES ) + RESULT( 10 ) = MAX( RESULT( 10 ), RES ) +* * Print information about the tests that did not pass * the threshold. * @@ -552,7 +579,14 @@ $ DIAG, 'Y', N, IMAT, 9, RESULT( 9 ) NFAIL = NFAIL + 1 END IF - NRUN = NRUN + 2 + IF( RESULT( 10 ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'ZLATRS3', UPLO, TRANS, + $ DIAG, 'N', N, IMAT, 10, RESULT( 10 ) + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 3 90 CONTINUE 100 CONTINUE 110 CONTINUE @@ -565,8 +599,8 @@ 9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=', $ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 ) 9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1, - $ ''', N=', I5, ', NB=', I4, ', type ', I2, ', - $ test(', I2, ')= ', G12.5 ) + $ ''', N=', I5, ', NB=', I4, ', type ', I2, ', test(', + $ I2, ')= ', G12.5 ) 9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',', $ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 ) 9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''', diff --git a/lapack-netlib/TESTING/LIN/zdrvgt.f b/lapack-netlib/TESTING/LIN/zdrvgt.f index d055e4bdb..b2e0f66b1 100644 --- a/lapack-netlib/TESTING/LIN/zdrvgt.f +++ b/lapack-netlib/TESTING/LIN/zdrvgt.f @@ -307,16 +307,16 @@ IZERO = 0 ELSE IF( IMAT.EQ.8 ) THEN IZERO = 1 - Z( 2 ) = A( N ) + Z( 2 ) = DBLE( A( N ) ) A( N ) = ZERO IF( N.GT.1 ) THEN - Z( 3 ) = A( 1 ) + Z( 3 ) = DBLE( A( 1 ) ) A( 1 ) = ZERO END IF ELSE IF( IMAT.EQ.9 ) THEN IZERO = N - Z( 1 ) = A( 3*N-2 ) - Z( 2 ) = A( 2*N-1 ) + Z( 1 ) = DBLE( A( 3*N-2 ) ) + Z( 2 ) = DBLE( A( 2*N-1 ) ) A( 3*N-2 ) = ZERO A( 2*N-1 ) = ZERO ELSE diff --git a/lapack-netlib/TESTING/LIN/zdrvpt.f b/lapack-netlib/TESTING/LIN/zdrvpt.f index 14a9f76ba..75f4d5738 100644 --- a/lapack-netlib/TESTING/LIN/zdrvpt.f +++ b/lapack-netlib/TESTING/LIN/zdrvpt.f @@ -266,12 +266,12 @@ * IA = 1 DO 20 I = 1, N - 1 - D( I ) = A( IA ) + D( I ) = DBLE( A( IA ) ) E( I ) = A( IA+1 ) IA = IA + 2 20 CONTINUE IF( N.GT.0 ) - $ D( N ) = A( IA ) + $ D( N ) = DBLE( A( IA ) ) ELSE * * Type 7-12: generate a diagonally dominant matrix with @@ -333,13 +333,13 @@ Z( 2 ) = D( 1 ) D( 1 ) = ZERO IF( N.GT.1 ) THEN - Z( 3 ) = E( 1 ) + Z( 3 ) = DBLE( E( 1 ) ) E( 1 ) = ZERO END IF ELSE IF( IMAT.EQ.9 ) THEN IZERO = N IF( N.GT.1 ) THEN - Z( 1 ) = E( N-1 ) + Z( 1 ) = DBLE( E( N-1 ) ) E( N-1 ) = ZERO END IF Z( 2 ) = D( N ) @@ -347,9 +347,9 @@ ELSE IF( IMAT.EQ.10 ) THEN IZERO = ( N+1 ) / 2 IF( IZERO.GT.1 ) THEN - Z( 1 ) = E( IZERO-1 ) + Z( 1 ) = DBLE( E( IZERO-1 ) ) E( IZERO-1 ) = ZERO - Z( 3 ) = E( IZERO ) + Z( 3 ) = DBLE( E( IZERO ) ) E( IZERO ) = ZERO END IF Z( 2 ) = D( IZERO ) diff --git a/lapack-netlib/TESTING/LIN/zlattp.f b/lapack-netlib/TESTING/LIN/zlattp.f index b728852b5..e05d9299e 100644 --- a/lapack-netlib/TESTING/LIN/zlattp.f +++ b/lapack-netlib/TESTING/LIN/zlattp.f @@ -336,7 +336,7 @@ WORK( J+1 ) = PLUS2 WORK( N+J+1 ) = ZERO PLUS1 = STAR1 / PLUS2 - REXP = ZLARND( 2, ISEED ) + REXP = DBLE( ZLARND( 2, ISEED ) ) IF( REXP.LT.ZERO ) THEN STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED ) ELSE @@ -790,7 +790,7 @@ DO 460 J = 1, N / 2 JL = JJ DO 450 I = J, N - J - T = AP( JR-I+J ) + T = DBLE( AP( JR-I+J ) ) AP( JR-I+J ) = AP( JL ) AP( JL ) = T JL = JL + I @@ -804,7 +804,7 @@ DO 480 J = 1, N / 2 JR = JJ DO 470 I = J, N - J - T = AP( JL+I-J ) + T = DBLE( AP( JL+I-J ) ) AP( JL+I-J ) = AP( JR ) AP( JR ) = T JR = JR - I diff --git a/lapack-netlib/TESTING/LIN/zpbt01.f b/lapack-netlib/TESTING/LIN/zpbt01.f index fb7881ac7..1801b66cf 100644 --- a/lapack-netlib/TESTING/LIN/zpbt01.f +++ b/lapack-netlib/TESTING/LIN/zpbt01.f @@ -201,7 +201,8 @@ * * Compute the (K,K) element of the result. * - AKK = ZDOTC( KLEN+1, AFAC( KC, K ), 1, AFAC( KC, K ), 1 ) + AKK = DBLE( + $ ZDOTC( KLEN+1, AFAC( KC, K ), 1, AFAC( KC, K ), 1 ) ) AFAC( KD+1, K ) = AKK * * Compute the rest of column K. @@ -228,7 +229,7 @@ * * Scale column K by the diagonal element. * - AKK = AFAC( 1, K ) + AKK = DBLE( AFAC( 1, K ) ) CALL ZDSCAL( KLEN+1, AKK, AFAC( 1, K ), 1 ) * 40 CONTINUE diff --git a/lapack-netlib/TESTING/LIN/zpot01.f b/lapack-netlib/TESTING/LIN/zpot01.f index d71445cd4..de83414c6 100644 --- a/lapack-netlib/TESTING/LIN/zpot01.f +++ b/lapack-netlib/TESTING/LIN/zpot01.f @@ -176,7 +176,7 @@ * * Compute the (K,K) element of the result. * - TR = ZDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) + TR = DBLE( ZDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) ) AFAC( K, K ) = TR * * Compute the rest of column K. @@ -224,7 +224,7 @@ 70 CONTINUE END IF * -* Compute norm( L*U - A ) / ( N * norm(A) * EPS ) +* Compute norm(L*U - A) / ( N * norm(A) * EPS ) * RESID = ZLANHE( '1', UPLO, N, AFAC, LDAFAC, RWORK ) * diff --git a/lapack-netlib/TESTING/LIN/zppt01.f b/lapack-netlib/TESTING/LIN/zppt01.f index 78ec595af..acaea50d2 100644 --- a/lapack-netlib/TESTING/LIN/zppt01.f +++ b/lapack-netlib/TESTING/LIN/zppt01.f @@ -178,7 +178,7 @@ * * Compute the (K,K) element of the result. * - TR = ZDOTC( K, AFAC( KC ), 1, AFAC( KC ), 1 ) + TR = DBLE( ZDOTC( K, AFAC( KC ), 1, AFAC( KC ), 1 ) ) AFAC( KC+K-1 ) = TR * * Compute the rest of column K. diff --git a/lapack-netlib/TESTING/LIN/zpst01.f b/lapack-netlib/TESTING/LIN/zpst01.f index 691857219..bed18c514 100644 --- a/lapack-netlib/TESTING/LIN/zpst01.f +++ b/lapack-netlib/TESTING/LIN/zpst01.f @@ -219,7 +219,7 @@ * * Compute the (K,K) element of the result. * - TR = ZDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) + TR = DBLE( ZDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) ) AFAC( K, K ) = TR * * Compute the rest of column K.