OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
Browse Source

Fix uninitialized variables in the LAPACK tests for the new ?QP3RK functions (Reference-LAPACK PR961)

tags/v0.3.28^2
Martin Kroeker GitHub 1 year ago
parent
91a24b837d
commit
c20caa4960
No known key found for this signature in database GPG Key ID: B5690EEEBB952194
4 changed files with 112 additions and 252 deletions
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +28
    -63
      lapack-netlib/TESTING/LIN/cchkqp3rk.f
  2. +28
    -63
      lapack-netlib/TESTING/LIN/dchkqp3rk.f
  3. +28
    -63
      lapack-netlib/TESTING/LIN/schkqp3rk.f
  4. +28
    -63
      lapack-netlib/TESTING/LIN/zchkqp3rk.f

+ 28
- 63
lapack-netlib/TESTING/LIN/cchkqp3rk.f View File

@@ -608,6 +608,9 @@
CALL CLACPY( 'All', M, NRHS, COPYB, LDA, CALL CLACPY( 'All', M, NRHS, COPYB, LDA,
$ B, LDA ) $ B, LDA )
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
DO I = 1, NTESTS
RESULT( I ) = ZERO
END DO
* *
ABSTOL = -1.0 ABSTOL = -1.0
RELTOl = -1.0 RELTOl = -1.0
@@ -652,16 +655,6 @@
RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK, RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK,
$ LWORK , RWORK ) $ 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 NRUN = NRUN + 1
* *
* End test 1 * End test 1
@@ -675,7 +668,7 @@
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
* *
RESULT( 2 ) = CQPT01( M, N, KFACT, COPYA, A, LDA, TAU, RESULT( 2 ) = CQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
$ IWORK( N+1 ), WORK, LWORK )
$ IWORK( N+1 ), WORK, LWORK )
* *
* Compute test 3: * Compute test 3:
* *
@@ -684,21 +677,8 @@
* 1-norm( Q**T * Q - I ) / ( M * EPS ) * 1-norm( Q**T * Q - I ) / ( M * EPS )
* *
RESULT( 3 ) = CQRT11( M, KFACT, A, LDA, TAU, WORK, 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 NRUN = NRUN + 2
* *
* Compute test 4: * Compute test 4:
@@ -717,8 +697,8 @@
* *
DO J = 1, KFACT-1, 1 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) ) ) $ ABS( A(1) ) )
* *
IF( DTEMP.LT.ZERO ) THEN IF( DTEMP.LT.ZERO ) THEN
@@ -727,20 +707,6 @@
* *
END DO 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 NRUN = NRUN + 1
* *
* End test 4. * End test 4.
@@ -762,42 +728,41 @@
* *
LWORK_MQR = MAX(1, NRHS) LWORK_MQR = MAX(1, NRHS)
CALL CUNMQR( 'Left', 'Conjugate transpose', 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 DO I = 1, NRHS
* *
* Compare N+J-th column of A and J-column of B. * Compare N+J-th column of A and J-column of B.
* *
CALL CAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1, 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 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 NRUN = NRUN + 1
* *
* End compute test 5. * End compute test 5.
* *
END IF 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 KMAX = 1, MIN(M,N)+1
* *
END DO END DO


+ 28
- 63
lapack-netlib/TESTING/LIN/dchkqp3rk.f View File

@@ -605,6 +605,9 @@
CALL DLACPY( 'All', M, NRHS, COPYB, LDA, CALL DLACPY( 'All', M, NRHS, COPYB, LDA,
$ B, LDA ) $ B, LDA )
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
DO I = 1, NTESTS
RESULT( I ) = ZERO
END DO
* *
ABSTOL = -1.0 ABSTOL = -1.0
RELTOL = -1.0 RELTOL = -1.0
@@ -648,16 +651,6 @@
RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK,
$ LWORK ) $ 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 NRUN = NRUN + 1
* *
* End test 1 * End test 1
@@ -671,7 +664,7 @@
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
* *
RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU, RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
$ IWORK( N+1 ), WORK, LWORK )
$ IWORK( N+1 ), WORK, LWORK )
* *
* Compute test 3: * Compute test 3:
* *
@@ -680,21 +673,8 @@
* 1-norm( Q**T * Q - I ) / ( M * EPS ) * 1-norm( Q**T * Q - I ) / ( M * EPS )
* *
RESULT( 3 ) = DQRT11( M, KFACT, A, LDA, TAU, WORK, 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 NRUN = NRUN + 2
* *
* Compute test 4: * Compute test 4:
@@ -713,8 +693,8 @@
* *
DO J = 1, KFACT-1, 1 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) ) ) $ ABS( A(1) ) )
* *
IF( DTEMP.LT.ZERO ) THEN IF( DTEMP.LT.ZERO ) THEN
@@ -723,20 +703,6 @@
* *
END DO 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 NRUN = NRUN + 1
* *
* End test 4. * End test 4.
@@ -758,42 +724,41 @@
* *
LWORK_MQR = MAX(1, NRHS) LWORK_MQR = MAX(1, NRHS)
CALL DORMQR( 'Left', 'Transpose', 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 DO I = 1, NRHS
* *
* Compare N+J-th column of A and J-column of B. * Compare N+J-th column of A and J-column of B.
* *
CALL DAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, 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 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 NRUN = NRUN + 1
* *
* End compute test 5. * End compute test 5.
* *
END IF 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 KMAX = 1, MIN(M,N)+1
* *
END DO END DO


+ 28
- 63
lapack-netlib/TESTING/LIN/schkqp3rk.f View File

@@ -604,6 +604,9 @@
CALL SLACPY( 'All', M, NRHS, COPYB, LDA, CALL SLACPY( 'All', M, NRHS, COPYB, LDA,
$ B, LDA ) $ B, LDA )
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
DO I = 1, NTESTS
RESULT( I ) = ZERO
END DO
* *
ABSTOL = -1.0 ABSTOL = -1.0
RELTOL = -1.0 RELTOL = -1.0
@@ -647,16 +650,6 @@
RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK,
$ LWORK ) $ 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 NRUN = NRUN + 1
* *
* End test 1 * End test 1
@@ -670,7 +663,7 @@
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
* *
RESULT( 2 ) = SQPT01( M, N, KFACT, COPYA, A, LDA, TAU, RESULT( 2 ) = SQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
$ IWORK( N+1 ), WORK, LWORK )
$ IWORK( N+1 ), WORK, LWORK )
* *
* Compute test 3: * Compute test 3:
* *
@@ -679,21 +672,8 @@
* 1-norm( Q**T * Q - I ) / ( M * EPS ) * 1-norm( Q**T * Q - I ) / ( M * EPS )
* *
RESULT( 3 ) = SQRT11( M, KFACT, A, LDA, TAU, WORK, 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 NRUN = NRUN + 2
* *
* Compute test 4: * Compute test 4:
@@ -712,8 +692,8 @@
* *
DO J = 1, KFACT-1, 1 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) ) ) $ ABS( A(1) ) )
* *
IF( DTEMP.LT.ZERO ) THEN IF( DTEMP.LT.ZERO ) THEN
@@ -722,20 +702,6 @@
* *
END DO 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 NRUN = NRUN + 1
* *
* End test 4. * End test 4.
@@ -757,42 +723,41 @@
* *
LWORK_MQR = MAX(1, NRHS) LWORK_MQR = MAX(1, NRHS)
CALL SORMQR( 'Left', 'Transpose', 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 DO I = 1, NRHS
* *
* Compare N+J-th column of A and J-column of B. * Compare N+J-th column of A and J-column of B.
* *
CALL SAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, 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 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 NRUN = NRUN + 1
* *
* End compute test 5. * End compute test 5.
* *
END IF 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 KMAX = 1, MIN(M,N)+1
* *
END DO END DO


+ 28
- 63
lapack-netlib/TESTING/LIN/zchkqp3rk.f View File

@@ -608,6 +608,9 @@
CALL ZLACPY( 'All', M, NRHS, COPYB, LDA, CALL ZLACPY( 'All', M, NRHS, COPYB, LDA,
$ B, LDA ) $ B, LDA )
CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
DO I = 1, NTESTS
RESULT( I ) = ZERO
END DO
* *
ABSTOL = -1.0 ABSTOL = -1.0
RELTOl = -1.0 RELTOl = -1.0
@@ -652,16 +655,6 @@
RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK,
$ LWORK , RWORK ) $ 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 NRUN = NRUN + 1
* *
* End test 1 * End test 1
@@ -675,7 +668,7 @@
* 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS )
* *
RESULT( 2 ) = ZQPT01( M, N, KFACT, COPYA, A, LDA, TAU, RESULT( 2 ) = ZQPT01( M, N, KFACT, COPYA, A, LDA, TAU,
$ IWORK( N+1 ), WORK, LWORK )
$ IWORK( N+1 ), WORK, LWORK )
* *
* Compute test 3: * Compute test 3:
* *
@@ -684,21 +677,8 @@
* 1-norm( Q**T * Q - I ) / ( M * EPS ) * 1-norm( Q**T * Q - I ) / ( M * EPS )
* *
RESULT( 3 ) = ZQRT11( M, KFACT, A, LDA, TAU, WORK, 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 NRUN = NRUN + 2
* *
* Compute test 4: * Compute test 4:
@@ -717,8 +697,8 @@
* *
DO J = 1, KFACT-1, 1 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) ) ) $ ABS( A(1) ) )
* *
IF( DTEMP.LT.ZERO ) THEN IF( DTEMP.LT.ZERO ) THEN
@@ -727,20 +707,6 @@
* *
END DO 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 NRUN = NRUN + 1
* *
* End test 4. * End test 4.
@@ -762,42 +728,41 @@
* *
LWORK_MQR = MAX(1, NRHS) LWORK_MQR = MAX(1, NRHS)
CALL ZUNMQR( 'Left', 'Conjugate transpose', 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 DO I = 1, NRHS
* *
* Compare N+J-th column of A and J-column of B. * Compare N+J-th column of A and J-column of B.
* *
CALL ZAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1, 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 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 NRUN = NRUN + 1
* *
* End compute test 5. * End compute test 5.
* *
END IF 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 KMAX = 1, MIN(M,N)+1
* *
END DO END DO


Write Preview
Loading…
Cancel
Save