Skip to content

Commit 4bd18e2

Browse files
ACSimon33ACSimon33
committed
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.
1 parent f6355dc commit 4bd18e2

File tree

4 files changed

+104
-256
lines changed

4 files changed

+104
-256
lines changed

‎TESTING/LIN/cchkqp3rk.f‎

Lines changed: 26 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -587,9 +587,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
587587
CALL XLAENV( 1, NB )
588588
NX = NXVAL( INB )
589589
CALL XLAENV( 3, NX )
590-
DO I = 1, NTESTS
591-
RESULT( I ) = ZERO
592-
END DO
593590
*
594591
* We do MIN(M,N)+1 because we need a test for KMAX > N,
595592
* when KMAX is larger than MIN(M,N), KMAX should be
@@ -611,6 +608,9 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
611608
CALL CLACPY( 'All', M, NRHS, COPYB, LDA,
612609
$ B, LDA )
613610
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
611+
DO I = 1, NTESTS
612+
RESULT( I ) = ZERO
613+
END DO
614614
*
615615
ABSTOL = -1.0
616616
RELTOl = -1.0
@@ -655,16 +655,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
655655
RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK,
656656
$ LWORK , RWORK )
657657
*
658-
DO T = 1, 1
659-
IF( RESULT( T ).GE.THRESH ) THEN
660-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
661-
$ CALL ALAHD( NOUT, PATH )
662-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
663-
$ NRHS, KMAX, ABSTOL, RELTOL, NB, NX,
664-
$ IMAT, T, RESULT( T )
665-
NFAIL = NFAIL + 1
666-
END IF
667-
END DO
668658
NRUN = NRUN + 1
669659
*
670660
* End test 1
@@ -678,7 +668,7 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
678668
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
679669
*
680670
RESULT( 2 ) = CQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
681-
$ IWORK( N+1 ), WORK, LWORK )
671+
$ IWORK( N+1 ), WORK, LWORK )
682672
*
683673
* Compute test 3:
684674
*
@@ -687,21 +677,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
687677
* 1-norm( Q**T * Q - I ) / ( M * EPS )
688678
*
689679
RESULT( 3 ) = CQRT11( M, KFACT, A, LDA, TAU, WORK,
690-
$ LWORK )
680+
$ LWORK )
691681
*
692-
* Print information about the tests that did not pass
693-
* the threshold.
694-
*
695-
DO T = 2, 3
696-
IF( RESULT( T ).GE.THRESH ) THEN
697-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
698-
$ CALL ALAHD( NOUT, PATH )
699-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
700-
$ NRHS, KMAX, ABSTOL, RELTOL,
701-
$ NB, NX, IMAT, T, RESULT( T )
702-
NFAIL = NFAIL + 1
703-
END IF
704-
END DO
705682
NRUN = NRUN + 2
706683
*
707684
* Compute test 4:
@@ -730,20 +707,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
730707
*
731708
END DO
732709
*
733-
* Print information about the tests that did not
734-
* pass the threshold.
735-
*
736-
DO T = 4, 4
737-
IF( RESULT( T ).GE.THRESH ) THEN
738-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
739-
$ CALL ALAHD( NOUT, PATH )
740-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK',
741-
$ M, N, NRHS, KMAX, ABSTOL, RELTOL,
742-
$ NB, NX, IMAT, T,
743-
$ RESULT( T )
744-
NFAIL = NFAIL + 1
745-
END IF
746-
END DO
747710
NRUN = NRUN + 1
748711
*
749712
* End test 4.
@@ -765,42 +728,41 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
765728
*
766729
LWORK_MQR = MAX(1, NRHS)
767730
CALL CUNMQR( 'Left', 'Conjugate transpose',
768-
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
769-
$ WORK, LWORK_MQR, INFO )
731+
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
732+
$ WORK, LWORK_MQR, INFO )
770733
*
771734
DO I = 1, NRHS
772735
*
773736
* Compare N+J-th column of A and J-column of B.
774737
*
775738
CALL CAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1,
776-
$ B( ( I-1 )*LDA+1 ), 1 )
739+
$ B( ( I-1 )*LDA+1 ), 1 )
777740
END DO
778741
*
779-
RESULT( 5 ) =
780-
$ ABS(
781-
$ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
782-
$ ( REAL( M )*SLAMCH( 'Epsilon' ) )
783-
$ )
784-
*
785-
* Print information about the tests that did not pass
786-
* the threshold.
787-
*
788-
DO T = 5, 5
789-
IF( RESULT( T ).GE.THRESH ) THEN
790-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
791-
$ CALL ALAHD( NOUT, PATH )
792-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
793-
$ NRHS, KMAX, ABSTOL, RELTOL,
794-
$ NB, NX, IMAT, T, RESULT( T )
795-
NFAIL = NFAIL + 1
796-
END IF
797-
END DO
742+
RESULT( 5 ) = ABS(
743+
$ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
744+
$ ( REAL( M )*SLAMCH( 'Epsilon' ) ) )
745+
*
798746
NRUN = NRUN + 1
799747
*
800748
* End compute test 5.
801749
*
802750
END IF
803751
*
752+
* Print information about the tests that did not pass
753+
* the threshold.
754+
*
755+
DO T = 1, NTESTS
756+
IF( RESULT( T ).GE.THRESH ) THEN
757+
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
758+
$ CALL ALAHD( NOUT, PATH )
759+
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
760+
$ NRHS, KMAX, ABSTOL, RELTOL,
761+
$ NB, NX, IMAT, T, RESULT( T )
762+
NFAIL = NFAIL + 1
763+
END IF
764+
END DO
765+
*
804766
* END DO KMAX = 1, MIN(M,N)+1
805767
*
806768
END DO

‎TESTING/LIN/dchkqp3rk.f‎

Lines changed: 26 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -584,9 +584,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
584584
CALL XLAENV( 1, NB )
585585
NX = NXVAL( INB )
586586
CALL XLAENV( 3, NX )
587-
DO I = 1, NTESTS
588-
RESULT( I ) = ZERO
589-
END DO
590587
*
591588
* We do MIN(M,N)+1 because we need a test for KMAX > N,
592589
* when KMAX is larger than MIN(M,N), KMAX should be
@@ -608,6 +605,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
608605
CALL DLACPY( 'All', M, NRHS, COPYB, LDA,
609606
$ B, LDA )
610607
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
608+
! DO I = 1, NTESTS
609+
! RESULT( I ) = ZERO
610+
! END DO
611611
*
612612
ABSTOL = -1.0
613613
RELTOL = -1.0
@@ -651,16 +651,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
651651
RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK,
652652
$ LWORK )
653653
*
654-
DO T = 1, 1
655-
IF( RESULT( T ).GE.THRESH ) THEN
656-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
657-
$ CALL ALAHD( NOUT, PATH )
658-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
659-
$ NRHS, KMAX, ABSTOL, RELTOL, NB, NX,
660-
$ IMAT, T, RESULT( T )
661-
NFAIL = NFAIL + 1
662-
END IF
663-
END DO
664654
NRUN = NRUN + 1
665655
*
666656
* End test 1
@@ -674,7 +664,7 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
674664
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
675665
*
676666
RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
677-
$ IWORK( N+1 ), WORK, LWORK )
667+
$ IWORK( N+1 ), WORK, LWORK )
678668
*
679669
* Compute test 3:
680670
*
@@ -683,21 +673,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
683673
* 1-norm( Q**T * Q - I ) / ( M * EPS )
684674
*
685675
RESULT( 3 ) = DQRT11( M, KFACT, A, LDA, TAU, WORK,
686-
$ LWORK )
687-
*
688-
* Print information about the tests that did not pass
689-
* the threshold.
676+
$ LWORK )
690677
*
691-
DO T = 2, 3
692-
IF( RESULT( T ).GE.THRESH ) THEN
693-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
694-
$ CALL ALAHD( NOUT, PATH )
695-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
696-
$ NRHS, KMAX, ABSTOL, RELTOL,
697-
$ NB, NX, IMAT, T, RESULT( T )
698-
NFAIL = NFAIL + 1
699-
END IF
700-
END DO
701678
NRUN = NRUN + 2
702679
*
703680
* Compute test 4:
@@ -726,20 +703,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
726703
*
727704
END DO
728705
*
729-
* Print information about the tests that did not
730-
* pass the threshold.
731-
*
732-
DO T = 4, 4
733-
IF( RESULT( T ).GE.THRESH ) THEN
734-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
735-
$ CALL ALAHD( NOUT, PATH )
736-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK',
737-
$ M, N, NRHS, KMAX, ABSTOL, RELTOL,
738-
$ NB, NX, IMAT, T,
739-
$ RESULT( T )
740-
NFAIL = NFAIL + 1
741-
END IF
742-
END DO
743706
NRUN = NRUN + 1
744707
*
745708
* End test 4.
@@ -761,42 +724,41 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
761724
*
762725
LWORK_MQR = MAX(1, NRHS)
763726
CALL DORMQR( 'Left', 'Transpose',
764-
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
765-
$ WORK, LWORK_MQR, INFO )
727+
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
728+
$ WORK, LWORK_MQR, INFO )
766729
*
767730
DO I = 1, NRHS
768731
*
769732
* Compare N+J-th column of A and J-column of B.
770733
*
771734
CALL DAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1,
772-
$ B( ( I-1 )*LDA+1 ), 1 )
735+
$ B( ( I-1 )*LDA+1 ), 1 )
773736
END DO
774737
*
775-
RESULT( 5 ) =
776-
$ ABS(
777-
$ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
778-
$ ( DBLE( M )*DLAMCH( 'Epsilon' ) )
779-
$ )
780-
*
781-
* Print information about the tests that did not pass
782-
* the threshold.
783-
*
784-
DO T = 5, 5
785-
IF( RESULT( T ).GE.THRESH ) THEN
786-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
787-
$ CALL ALAHD( NOUT, PATH )
788-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
789-
$ NRHS, KMAX, ABSTOL, RELTOL,
790-
$ NB, NX, IMAT, T, RESULT( T )
791-
NFAIL = NFAIL + 1
792-
END IF
793-
END DO
738+
RESULT( 5 ) = ABS(
739+
$ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
740+
$ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) )
741+
*
794742
NRUN = NRUN + 1
795743
*
796744
* End compute test 5.
797745
*
798746
END IF
799747
*
748+
* Print information about the tests that did not
749+
* pass the threshold.
750+
*
751+
DO T = 1, NTESTS
752+
IF( RESULT( T ).GE.THRESH ) THEN
753+
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
754+
$ CALL ALAHD( NOUT, PATH )
755+
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
756+
$ NRHS, KMAX, ABSTOL, RELTOL, NB, NX,
757+
$ IMAT, T, RESULT( T )
758+
NFAIL = NFAIL + 1
759+
END IF
760+
END DO
761+
*
800762
* END DO KMAX = 1, MIN(M,N)+1
801763
*
802764
END DO

0 commit comments

Comments
 (0)