From 4a26507b5ff7526e4bcb8f5f3d9c2555e6091629 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 15 Dec 2023 17:36:33 +0000 Subject: [PATCH 1/4] Initialize test results to zero in LIN testing routines to preempt potential garbage data influencing the test evaluations. --- TESTING/LIN/cchkqp3rk.f | 3 +++ TESTING/LIN/dchkqp3rk.f | 3 +++ TESTING/LIN/schkqp3rk.f | 3 +++ TESTING/LIN/zchkqp3rk.f | 3 +++ 4 files changed, 12 insertions(+) diff --git a/TESTING/LIN/cchkqp3rk.f b/TESTING/LIN/cchkqp3rk.f index 79d6add72e..c8dc612bb3 100644 --- a/TESTING/LIN/cchkqp3rk.f +++ b/TESTING/LIN/cchkqp3rk.f @@ -587,6 +587,9 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 434d2067e2..8f7c2f6b41 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -584,6 +584,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f index 36cf9370ea..e0b286d9ae 100755 --- a/TESTING/LIN/schkqp3rk.f +++ b/TESTING/LIN/schkqp3rk.f @@ -583,6 +583,9 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be diff --git a/TESTING/LIN/zchkqp3rk.f b/TESTING/LIN/zchkqp3rk.f index 302c7b1a87..d4a51624e6 100644 --- a/TESTING/LIN/zchkqp3rk.f +++ b/TESTING/LIN/zchkqp3rk.f @@ -587,6 +587,9 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be From f6355dc7697aeecb866d73ba91f1cf07e01af070 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 15 Dec 2023 17:54:40 +0000 Subject: [PATCH 2/4] Updated array index calculations in cchkqp3rk.f, dchkqp3rk.f, schkqp3rk.f, and zchkqp3rk.f to use the leading dimension (LDA) instead of the fixed size (M) --- TESTING/LIN/cchkqp3rk.f | 4 ++-- TESTING/LIN/dchkqp3rk.f | 4 ++-- TESTING/LIN/schkqp3rk.f | 4 ++-- TESTING/LIN/zchkqp3rk.f | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/TESTING/LIN/cchkqp3rk.f b/TESTING/LIN/cchkqp3rk.f index c8dc612bb3..fbfd8291fb 100644 --- a/TESTING/LIN/cchkqp3rk.f +++ b/TESTING/LIN/cchkqp3rk.f @@ -720,8 +720,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 * - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 8f7c2f6b41..42ca0277fc 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -716,8 +716,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f index e0b286d9ae..8ab7b847a1 100755 --- a/TESTING/LIN/schkqp3rk.f +++ b/TESTING/LIN/schkqp3rk.f @@ -715,8 +715,8 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN diff --git a/TESTING/LIN/zchkqp3rk.f b/TESTING/LIN/zchkqp3rk.f index d4a51624e6..4afa20f19f 100644 --- a/TESTING/LIN/zchkqp3rk.f +++ b/TESTING/LIN/zchkqp3rk.f @@ -720,8 +720,8 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 * - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN From 4bd18e2663dcd40e981c7e5bb582ffc1f7e237ea Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Mon, 18 Dec 2023 17:17:07 +0000 Subject: [PATCH 3/4] Refactor test result initialization and reporting Consolidated the initialization of the RESULT array and the reporting of test outcomes for the xCHKQP3RK tests. The initialization of the RESULT array to zeros is now occurring immediately before the tests, ensuring a clean slate without scattering across different test phases. Reporting functionality has been centralized at the end of the 5 tests, eliminating redundant blocks and improving maintainability. --- TESTING/LIN/cchkqp3rk.f | 90 ++++++++++++----------------------------- TESTING/LIN/dchkqp3rk.f | 90 ++++++++++++----------------------------- TESTING/LIN/schkqp3rk.f | 90 ++++++++++++----------------------------- TESTING/LIN/zchkqp3rk.f | 90 ++++++++++++----------------------------- 4 files changed, 104 insertions(+), 256 deletions(-) diff --git a/TESTING/LIN/cchkqp3rk.f b/TESTING/LIN/cchkqp3rk.f index fbfd8291fb..b794d4664c 100644 --- a/TESTING/LIN/cchkqp3rk.f +++ b/TESTING/LIN/cchkqp3rk.f @@ -587,9 +587,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -611,6 +608,9 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL CLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOl = -1.0 @@ -655,16 +655,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK, $ LWORK , RWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -678,7 +668,7 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = CQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -687,21 +677,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = CQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) + $ LWORK ) * -* Print information about the tests that did not pass -* the threshold. -* - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -730,20 +707,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -765,42 +728,41 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL CUNMQR( 'Left', 'Conjugate transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL CAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not pass +* the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, + $ NB, NX, IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 42ca0277fc..1834e63282 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -584,9 +584,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -608,6 +605,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL DLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + ! DO I = 1, NTESTS + ! RESULT( I ) = ZERO + ! END DO * ABSTOL = -1.0 RELTOL = -1.0 @@ -651,16 +651,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -674,7 +664,7 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -683,21 +673,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = DQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) -* -* Print information about the tests that did not pass -* the threshold. + $ LWORK ) * - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -726,20 +703,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -761,42 +724,41 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL DORMQR( 'Left', 'Transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL DAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not +* pass the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, + $ IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f index 8ab7b847a1..c5ce7ff609 100755 --- a/TESTING/LIN/schkqp3rk.f +++ b/TESTING/LIN/schkqp3rk.f @@ -583,9 +583,6 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -607,6 +604,9 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL SLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOL = -1.0 @@ -650,16 +650,6 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -673,7 +663,7 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = SQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -682,21 +672,8 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = SQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) + $ LWORK ) * -* Print information about the tests that did not pass -* the threshold. -* - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -725,20 +702,6 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -760,42 +723,41 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL SORMQR( 'Left', 'Transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL SAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ SLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ SLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not pass +* the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, + $ NB, NX, IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO diff --git a/TESTING/LIN/zchkqp3rk.f b/TESTING/LIN/zchkqp3rk.f index 4afa20f19f..5092058837 100644 --- a/TESTING/LIN/zchkqp3rk.f +++ b/TESTING/LIN/zchkqp3rk.f @@ -587,9 +587,6 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -611,6 +608,9 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL ZLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOl = -1.0 @@ -655,16 +655,6 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, $ LWORK , RWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -678,7 +668,7 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = ZQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -687,21 +677,8 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = ZQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) + $ LWORK ) * -* Print information about the tests that did not pass -* the threshold. -* - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -730,20 +707,6 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -765,42 +728,41 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL ZUNMQR( 'Left', 'Conjugate transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL ZAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ ZLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ ZLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not pass +* the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, + $ NB, NX, IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO From 7113caa0eca3af6d3e7cb9902e585e5e16a16aaa Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 21 Jun 2024 11:05:16 +0200 Subject: [PATCH 4/4] Fixed commented out result initialization --- TESTING/LIN/dchkqp3rk.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 1834e63282..319d332dd2 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -605,9 +605,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL DLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) - ! DO I = 1, NTESTS - ! RESULT( I ) = ZERO - ! END DO + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOL = -1.0