Skip to content

Commit a0083fd

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #4647 from martin-frbg/lapack961
Fix uninitialized variables in LAPACK tests for ?QP3RK (Reference-LAPACK PR 961)
2 parents 91a24b8 + c20caa4 commit a0083fd

4 files changed

Lines changed: 112 additions & 252 deletions

File tree

‎lapack-netlib/TESTING/LIN/cchkqp3rk.f‎

Lines changed: 28 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -608,6 +608,9 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
608608
CALL CLACPY( 'All', M, NRHS, COPYB, LDA,
609609
$ B, LDA )
610610
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
611+
DO I = 1, NTESTS
612+
RESULT( I ) = ZERO
613+
END DO
611614
*
612615
ABSTOL = -1.0
613616
RELTOl = -1.0
@@ -652,16 +655,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
652655
RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK,
653656
$ LWORK , RWORK )
654657
*
655-
DO T = 1, 1
656-
IF( RESULT( T ).GE.THRESH ) THEN
657-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
658-
$ CALL ALAHD( NOUT, PATH )
659-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
660-
$ NRHS, KMAX, ABSTOL, RELTOL, NB, NX,
661-
$ IMAT, T, RESULT( T )
662-
NFAIL = NFAIL + 1
663-
END IF
664-
END DO
665658
NRUN = NRUN + 1
666659
*
667660
* End test 1
@@ -675,7 +668,7 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
675668
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
676669
*
677670
RESULT( 2 ) = CQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
678-
$ IWORK( N+1 ), WORK, LWORK )
671+
$ IWORK( N+1 ), WORK, LWORK )
679672
*
680673
* Compute test 3:
681674
*
@@ -684,21 +677,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
684677
* 1-norm( Q**T * Q - I ) / ( M * EPS )
685678
*
686679
RESULT( 3 ) = CQRT11( M, KFACT, A, LDA, TAU, WORK,
687-
$ LWORK )
680+
$ LWORK )
688681
*
689-
* Print information about the tests that did not pass
690-
* the threshold.
691-
*
692-
DO T = 2, 3
693-
IF( RESULT( T ).GE.THRESH ) THEN
694-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
695-
$ CALL ALAHD( NOUT, PATH )
696-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
697-
$ NRHS, KMAX, ABSTOL, RELTOL,
698-
$ NB, NX, IMAT, T, RESULT( T )
699-
NFAIL = NFAIL + 1
700-
END IF
701-
END DO
702682
NRUN = NRUN + 2
703683
*
704684
* Compute test 4:
@@ -717,8 +697,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
717697
*
718698
DO J = 1, KFACT-1, 1
719699
*
720-
DTEMP = (( ABS( A( (J-1)*M+J ) ) -
721-
$ ABS( A( (J)*M+J+1 ) ) ) /
700+
DTEMP = (( ABS( A( (J-1)*LDA+J ) ) -
701+
$ ABS( A( (J)*LDA+J+1 ) ) ) /
722702
$ ABS( A(1) ) )
723703
*
724704
IF( DTEMP.LT.ZERO ) THEN
@@ -727,20 +707,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
727707
*
728708
END DO
729709
*
730-
* Print information about the tests that did not
731-
* pass the threshold.
732-
*
733-
DO T = 4, 4
734-
IF( RESULT( T ).GE.THRESH ) THEN
735-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
736-
$ CALL ALAHD( NOUT, PATH )
737-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK',
738-
$ M, N, NRHS, KMAX, ABSTOL, RELTOL,
739-
$ NB, NX, IMAT, T,
740-
$ RESULT( T )
741-
NFAIL = NFAIL + 1
742-
END IF
743-
END DO
744710
NRUN = NRUN + 1
745711
*
746712
* End test 4.
@@ -762,42 +728,41 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
762728
*
763729
LWORK_MQR = MAX(1, NRHS)
764730
CALL CUNMQR( 'Left', 'Conjugate transpose',
765-
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
766-
$ WORK, LWORK_MQR, INFO )
731+
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
732+
$ WORK, LWORK_MQR, INFO )
767733
*
768734
DO I = 1, NRHS
769735
*
770736
* Compare N+J-th column of A and J-column of B.
771737
*
772738
CALL CAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1,
773-
$ B( ( I-1 )*LDA+1 ), 1 )
739+
$ B( ( I-1 )*LDA+1 ), 1 )
774740
END DO
775741
*
776-
RESULT( 5 ) =
777-
$ ABS(
778-
$ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
779-
$ ( REAL( M )*SLAMCH( 'Epsilon' ) )
780-
$ )
781-
*
782-
* Print information about the tests that did not pass
783-
* the threshold.
784-
*
785-
DO T = 5, 5
786-
IF( RESULT( T ).GE.THRESH ) THEN
787-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
788-
$ CALL ALAHD( NOUT, PATH )
789-
WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N,
790-
$ NRHS, KMAX, ABSTOL, RELTOL,
791-
$ NB, NX, IMAT, T, RESULT( T )
792-
NFAIL = NFAIL + 1
793-
END IF
794-
END DO
742+
RESULT( 5 ) = ABS(
743+
$ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
744+
$ ( REAL( M )*SLAMCH( 'Epsilon' ) ) )
745+
*
795746
NRUN = NRUN + 1
796747
*
797748
* End compute test 5.
798749
*
799750
END IF
800751
*
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+
*
801766
* END DO KMAX = 1, MIN(M,N)+1
802767
*
803768
END DO

‎lapack-netlib/TESTING/LIN/dchkqp3rk.f‎

Lines changed: 28 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -605,6 +605,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
605605
CALL DLACPY( 'All', M, NRHS, COPYB, LDA,
606606
$ B, LDA )
607607
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
608+
DO I = 1, NTESTS
609+
RESULT( I ) = ZERO
610+
END DO
608611
*
609612
ABSTOL = -1.0
610613
RELTOL = -1.0
@@ -648,16 +651,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
648651
RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK,
649652
$ LWORK )
650653
*
651-
DO T = 1, 1
652-
IF( RESULT( T ).GE.THRESH ) THEN
653-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
654-
$ CALL ALAHD( NOUT, PATH )
655-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
656-
$ NRHS, KMAX, ABSTOL, RELTOL, NB, NX,
657-
$ IMAT, T, RESULT( T )
658-
NFAIL = NFAIL + 1
659-
END IF
660-
END DO
661654
NRUN = NRUN + 1
662655
*
663656
* End test 1
@@ -671,7 +664,7 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
671664
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
672665
*
673666
RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
674-
$ IWORK( N+1 ), WORK, LWORK )
667+
$ IWORK( N+1 ), WORK, LWORK )
675668
*
676669
* Compute test 3:
677670
*
@@ -680,21 +673,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
680673
* 1-norm( Q**T * Q - I ) / ( M * EPS )
681674
*
682675
RESULT( 3 ) = DQRT11( M, KFACT, A, LDA, TAU, WORK,
683-
$ LWORK )
684-
*
685-
* Print information about the tests that did not pass
686-
* the threshold.
676+
$ LWORK )
687677
*
688-
DO T = 2, 3
689-
IF( RESULT( T ).GE.THRESH ) THEN
690-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
691-
$ CALL ALAHD( NOUT, PATH )
692-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
693-
$ NRHS, KMAX, ABSTOL, RELTOL,
694-
$ NB, NX, IMAT, T, RESULT( T )
695-
NFAIL = NFAIL + 1
696-
END IF
697-
END DO
698678
NRUN = NRUN + 2
699679
*
700680
* Compute test 4:
@@ -713,8 +693,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
713693
*
714694
DO J = 1, KFACT-1, 1
715695

716-
DTEMP = (( ABS( A( (J-1)*M+J ) ) -
717-
$ ABS( A( (J)*M+J+1 ) ) ) /
696+
DTEMP = (( ABS( A( (J-1)*LDA+J ) ) -
697+
$ ABS( A( (J)*LDA+J+1 ) ) ) /
718698
$ ABS( A(1) ) )
719699
*
720700
IF( DTEMP.LT.ZERO ) THEN
@@ -723,20 +703,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
723703
*
724704
END DO
725705
*
726-
* Print information about the tests that did not
727-
* pass the threshold.
728-
*
729-
DO T = 4, 4
730-
IF( RESULT( T ).GE.THRESH ) THEN
731-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
732-
$ CALL ALAHD( NOUT, PATH )
733-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK',
734-
$ M, N, NRHS, KMAX, ABSTOL, RELTOL,
735-
$ NB, NX, IMAT, T,
736-
$ RESULT( T )
737-
NFAIL = NFAIL + 1
738-
END IF
739-
END DO
740706
NRUN = NRUN + 1
741707
*
742708
* End test 4.
@@ -758,42 +724,41 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
758724
*
759725
LWORK_MQR = MAX(1, NRHS)
760726
CALL DORMQR( 'Left', 'Transpose',
761-
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
762-
$ WORK, LWORK_MQR, INFO )
727+
$ M, NRHS, KFACT, A, LDA, TAU, B, LDA,
728+
$ WORK, LWORK_MQR, INFO )
763729
*
764730
DO I = 1, NRHS
765731
*
766732
* Compare N+J-th column of A and J-column of B.
767733
*
768734
CALL DAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1,
769-
$ B( ( I-1 )*LDA+1 ), 1 )
735+
$ B( ( I-1 )*LDA+1 ), 1 )
770736
END DO
771737
*
772-
RESULT( 5 ) =
773-
$ ABS(
774-
$ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
775-
$ ( DBLE( M )*DLAMCH( 'Epsilon' ) )
776-
$ )
777-
*
778-
* Print information about the tests that did not pass
779-
* the threshold.
780-
*
781-
DO T = 5, 5
782-
IF( RESULT( T ).GE.THRESH ) THEN
783-
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
784-
$ CALL ALAHD( NOUT, PATH )
785-
WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N,
786-
$ NRHS, KMAX, ABSTOL, RELTOL,
787-
$ NB, NX, IMAT, T, RESULT( T )
788-
NFAIL = NFAIL + 1
789-
END IF
790-
END DO
738+
RESULT( 5 ) = ABS(
739+
$ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) /
740+
$ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) )
741+
*
791742
NRUN = NRUN + 1
792743
*
793744
* End compute test 5.
794745
*
795746
END IF
796747
*
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+
*
797762
* END DO KMAX = 1, MIN(M,N)+1
798763
*
799764
END DO

0 commit comments

Comments
 (0)