Skip to content

Commit 6b0dafd

Browse files
jipjip
committed
modifies xGBT02 and xGET02 to use 1-norm of op(A) not A (no.2 from PR Reference-LAPACK#562)
1. Comments improved, unified and fixed. 2. Code changed. To unify with routines xGBT01, xGTT02, xTBT02, xTPT02, and xTRT02.
1 parent 705bb81 commit 6b0dafd

24 files changed

+380
-184
lines changed

‎TESTING/EIG/cget02.f‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,9 +28,10 @@
2828
*> \verbatim
2929
*>
3030
*> CGET02 computes the residual for a solution of a system of linear
31-
*> equations A*x = b or A'*x = b:
32-
*> RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
33-
*> where EPS is the machine epsilon.
31+
*> equations op(A)*X = B:
32+
*> RESID = norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ),
33+
*> where op(A) = A, A**T, or A**H, depending on TRANS, and EPS is the
34+
*> machine epsilon.
3435
*> \endverbatim
3536
*
3637
* Arguments:
@@ -40,9 +41,9 @@
4041
*> \verbatim
4142
*> TRANS is CHARACTER*1
4243
*> Specifies the form of the system of equations:
43-
*> = 'N': A *x = b
44-
*> = 'T': A^T*x = b, where A^T is the transpose of A
45-
*> = 'C': A^H*x = b, where A^H is the conjugate transpose of A
44+
*> = 'N': A * X = B (No transpose)
45+
*> = 'T': A**T * X = B (Transpose)
46+
*> = 'C': A**H * X = B (Conjugate transpose)
4647
*> \endverbatim
4748
*>
4849
*> \param[in] M
@@ -114,7 +115,7 @@
114115
*> \verbatim
115116
*> RESID is REAL
116117
*> The maximum over the number of right hand sides of
117-
*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
118+
*> norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ).
118119
*> \endverbatim
119120
*
120121
* Authors:
@@ -188,19 +189,23 @@ SUBROUTINE CGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
188189
* Exit with RESID = 1/EPS if ANORM = 0.
189190
*
190191
EPS = SLAMCH( 'Epsilon' )
191-
ANORM = CLANGE( '1', M, N, A, LDA, RWORK )
192+
IF( LSAME( TRANS, 'N' ) ) THEN
193+
ANORM = CLANGE( '1', M, N, A, LDA, RWORK )
194+
ELSE
195+
ANORM = CLANGE( 'I', M, N, A, LDA, RWORK )
196+
END IF
192197
IF( ANORM.LE.ZERO ) THEN
193198
RESID = ONE / EPS
194199
RETURN
195200
END IF
196201
*
197-
* Compute B - A*X (or B - A'*X ) and store in B.
202+
* Compute B - op(A)*X and store in B.
198203
*
199204
CALL CGEMM( TRANS, 'No transpose', N1, NRHS, N2, -CONE, A, LDA, X,
200205
$ LDX, CONE, B, LDB )
201206
*
202207
* Compute the maximum over the number of right hand sides of
203-
* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) .
208+
* norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ) .
204209
*
205210
RESID = ZERO
206211
DO 10 J = 1, NRHS

‎TESTING/EIG/dget02.f‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,9 +28,10 @@
2828
*> \verbatim
2929
*>
3030
*> DGET02 computes the residual for a solution of a system of linear
31-
*> equations A*x = b or A'*x = b:
32-
*> RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
33-
*> where EPS is the machine epsilon.
31+
*> equations op(A)*X = B:
32+
*> RESID = norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ),
33+
*> where op(A) = A or A**T, depending on TRANS, and EPS is the
34+
*> machine epsilon.
3435
*> \endverbatim
3536
*
3637
* Arguments:
@@ -40,9 +41,9 @@
4041
*> \verbatim
4142
*> TRANS is CHARACTER*1
4243
*> Specifies the form of the system of equations:
43-
*> = 'N': A *x = b
44-
*> = 'T': A'*x = b, where A' is the transpose of A
45-
*> = 'C': A'*x = b, where A' is the transpose of A
44+
*> = 'N': A * X = B (No transpose)
45+
*> = 'T': A**T * X = B (Transpose)
46+
*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
4647
*> \endverbatim
4748
*>
4849
*> \param[in] M
@@ -114,7 +115,7 @@
114115
*> \verbatim
115116
*> RESID is DOUBLE PRECISION
116117
*> The maximum over the number of right hand sides of
117-
*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
118+
*> norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ).
118119
*> \endverbatim
119120
*
120121
* Authors:
@@ -186,19 +187,23 @@ SUBROUTINE DGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
186187
* Exit with RESID = 1/EPS if ANORM = 0.
187188
*
188189
EPS = DLAMCH( 'Epsilon' )
189-
ANORM = DLANGE( '1', M, N, A, LDA, RWORK )
190+
IF( LSAME( TRANS, 'N' ) ) THEN
191+
ANORM = DLANGE( '1', M, N, A, LDA, RWORK )
192+
ELSE
193+
ANORM = DLANGE( 'I', M, N, A, LDA, RWORK )
194+
END IF
190195
IF( ANORM.LE.ZERO ) THEN
191196
RESID = ONE / EPS
192197
RETURN
193198
END IF
194199
*
195-
* Compute B - A*X (or B - A'*X ) and store in B.
200+
* Compute B - op(A)*X and store in B.
196201
*
197202
CALL DGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X,
198203
$ LDX, ONE, B, LDB )
199204
*
200205
* Compute the maximum over the number of right hand sides of
201-
* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) .
206+
* norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ) .
202207
*
203208
RESID = ZERO
204209
DO 10 J = 1, NRHS

‎TESTING/EIG/sget02.f‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,9 +28,10 @@
2828
*> \verbatim
2929
*>
3030
*> SGET02 computes the residual for a solution of a system of linear
31-
*> equations A*x = b or A'*x = b:
32-
*> RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
33-
*> where EPS is the machine epsilon.
31+
*> equations op(A)*X = B:
32+
*> RESID = norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ),
33+
*> where op(A) = A or A**T, depending on TRANS, and EPS is the
34+
*> machine epsilon.
3435
*> \endverbatim
3536
*
3637
* Arguments:
@@ -40,9 +41,9 @@
4041
*> \verbatim
4142
*> TRANS is CHARACTER*1
4243
*> Specifies the form of the system of equations:
43-
*> = 'N': A *x = b
44-
*> = 'T': A'*x = b, where A' is the transpose of A
45-
*> = 'C': A'*x = b, where A' is the transpose of A
44+
*> = 'N': A * X = B (No transpose)
45+
*> = 'T': A**T * X = B (Transpose)
46+
*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
4647
*> \endverbatim
4748
*>
4849
*> \param[in] M
@@ -114,7 +115,7 @@
114115
*> \verbatim
115116
*> RESID is REAL
116117
*> The maximum over the number of right hand sides of
117-
*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
118+
*> norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ).
118119
*> \endverbatim
119120
*
120121
* Authors:
@@ -186,19 +187,23 @@ SUBROUTINE SGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
186187
* Exit with RESID = 1/EPS if ANORM = 0.
187188
*
188189
EPS = SLAMCH( 'Epsilon' )
189-
ANORM = SLANGE( '1', M, N, A, LDA, RWORK )
190+
IF( LSAME( TRANS, 'N' ) ) THEN
191+
ANORM = SLANGE( '1', M, N, A, LDA, RWORK )
192+
ELSE
193+
ANORM = SLANGE( 'I', M, N, A, LDA, RWORK )
194+
END IF
190195
IF( ANORM.LE.ZERO ) THEN
191196
RESID = ONE / EPS
192197
RETURN
193198
END IF
194199
*
195-
* Compute B - A*X (or B - A'*X ) and store in B.
200+
* Compute B - op(A)*X and store in B.
196201
*
197202
CALL SGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X,
198203
$ LDX, ONE, B, LDB )
199204
*
200205
* Compute the maximum over the number of right hand sides of
201-
* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) .
206+
* norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ) .
202207
*
203208
RESID = ZERO
204209
DO 10 J = 1, NRHS

‎TESTING/EIG/zget02.f‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,9 +28,10 @@
2828
*> \verbatim
2929
*>
3030
*> ZGET02 computes the residual for a solution of a system of linear
31-
*> equations A*x = b or A'*x = b:
32-
*> RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
33-
*> where EPS is the machine epsilon.
31+
*> equations op(A)*X = B:
32+
*> RESID = norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ),
33+
*> where op(A) = A, A**T, or A**H, depending on TRANS, and EPS is the
34+
*> machine epsilon.
3435
*> \endverbatim
3536
*
3637
* Arguments:
@@ -40,9 +41,9 @@
4041
*> \verbatim
4142
*> TRANS is CHARACTER*1
4243
*> Specifies the form of the system of equations:
43-
*> = 'N': A *x = b
44-
*> = 'T': A^T*x = b, where A^T is the transpose of A
45-
*> = 'C': A^H*x = b, where A^H is the conjugate transpose of A
44+
*> = 'N': A * X = B (No transpose)
45+
*> = 'T': A**T * X = B (Transpose)
46+
*> = 'C': A**H * X = B (Conjugate transpose)
4647
*> \endverbatim
4748
*>
4849
*> \param[in] M
@@ -114,7 +115,7 @@
114115
*> \verbatim
115116
*> RESID is DOUBLE PRECISION
116117
*> The maximum over the number of right hand sides of
117-
*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
118+
*> norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ).
118119
*> \endverbatim
119120
*
120121
* Authors:
@@ -188,19 +189,23 @@ SUBROUTINE ZGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
188189
* Exit with RESID = 1/EPS if ANORM = 0.
189190
*
190191
EPS = DLAMCH( 'Epsilon' )
191-
ANORM = ZLANGE( '1', M, N, A, LDA, RWORK )
192+
IF( LSAME( TRANS, 'N' ) ) THEN
193+
ANORM = ZLANGE( '1', M, N, A, LDA, RWORK )
194+
ELSE
195+
ANORM = ZLANGE( 'I', M, N, A, LDA, RWORK )
196+
END IF
192197
IF( ANORM.LE.ZERO ) THEN
193198
RESID = ONE / EPS
194199
RETURN
195200
END IF
196201
*
197-
* Compute B - A*X (or B - A'*X ) and store in B.
202+
* Compute B - op(A)*X and store in B.
198203
*
199204
CALL ZGEMM( TRANS, 'No transpose', N1, NRHS, N2, -CONE, A, LDA, X,
200205
$ LDX, CONE, B, LDB )
201206
*
202207
* Compute the maximum over the number of right hand sides of
203-
* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) .
208+
* norm(B - op(A)*X) / ( norm(op(A)) * norm(X) * EPS ) .
204209
*
205210
RESID = ZERO
206211
DO 10 J = 1, NRHS

‎TESTING/LIN/cchkgb.f‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -563,7 +563,7 @@ SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
563563
END IF
564564
*
565565
*+ TEST 2:
566-
* Solve and compute residual for A * X = B.
566+
* Solve and compute residual for op(A) * X = B.
567567
*
568568
SRNAMT = 'CLARHS'
569569
CALL CLARHS( PATH, XTYPE, ' ', TRANS, N,
@@ -589,7 +589,7 @@ SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
589589
$ WORK, LDB )
590590
CALL CGBT02( TRANS, M, N, KL, KU, NRHS, A,
591591
$ LDA, X, LDB, WORK, LDB,
592-
$ RESULT( 2 ) )
592+
$ RWORK, RESULT( 2 ) )
593593
*
594594
*+ TEST 3:
595595
* Check solution from generated exact

‎TESTING/LIN/cdrvgb.f‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -582,7 +582,8 @@ SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
582582
$ WORK, LDB )
583583
CALL CGBT02( 'No transpose', N, N, KL,
584584
$ KU, NRHS, A, LDA, X, LDB,
585-
$ WORK, LDB, RESULT( 2 ) )
585+
$ WORK, LDB, RWORK,
586+
$ RESULT( 2 ) )
586587
*
587588
* Check solution from generated exact
588589
* solution.
@@ -699,6 +700,7 @@ SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
699700
$ WORK, LDB )
700701
CALL CGBT02( TRANS, N, N, KL, KU, NRHS,
701702
$ ASAV, LDA, X, LDB, WORK, LDB,
703+
$ RWORK( 2*NRHS+1 ),
702704
$ RESULT( 2 ) )
703705
*
704706
* Check solution from generated exact

‎TESTING/LIN/cdrvgbx.f‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -590,7 +590,8 @@ SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
590590
$ WORK, LDB )
591591
CALL CGBT02( 'No transpose', N, N, KL,
592592
$ KU, NRHS, A, LDA, X, LDB,
593-
$ WORK, LDB, RESULT( 2 ) )
593+
$ WORK, LDB, RWORK,
594+
$ RESULT( 2 ) )
594595
*
595596
* Check solution from generated exact
596597
* solution.
@@ -708,6 +709,7 @@ SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
708709
$ WORK, LDB )
709710
CALL CGBT02( TRANS, N, N, KL, KU, NRHS,
710711
$ ASAV, LDA, X, LDB, WORK, LDB,
712+
$ RWORK( 2*NRHS+1 ),
711713
$ RESULT( 2 ) )
712714
*
713715
* Check solution from generated exact
@@ -897,7 +899,8 @@ SUBROUTINE CDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
897899
CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
898900
$ LDB )
899901
CALL CGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
900-
$ LDA, X, LDB, WORK, LDB, RESULT( 2 ) )
902+
$ LDA, X, LDB, WORK, LDB, RWORK,
903+
$ RESULT( 2 ) )
901904
*
902905
* Check solution from generated exact solution.
903906
*

0 commit comments

Comments
 (0)