phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix(eig): pass IINFO instead of INFO to xSPGVX/xHPGVX in *drvsg2stg

Browse Source 
In cdrvsg2stg.f, ddrvsg2stg.f, sdrvsg2stg.f, and zdrvsg2stg.f, the
three RANGE='A'/'V'/'I' calls to CHPGVX, DSPGVX, SSPGVX, and ZHPGVX
were passing INFO as the output error argument instead of IINFO.

The error-check block immediately following each call tests IINFO.NE.0,
but IINFO was never updated by the routine, so errors were silently
ignored. Additionally, the block sets INFO = ABS(IINFO), which would
overwrite the value ZHPGVX/xSPGVX had written into INFO with the
stale value of IINFO.

All other driver calls in these files (ZHEGV, ZHEGVD, ZHEGVX, ZHPGV,
ZHPGVD, ZHBGV, ZHBGVD, ZHBGVX and their s/d/c equivalents) correctly
use IINFO. This commit brings the xSPGVX/xHPGVX calls into line with
the established pattern.

Affected routines (3 call sites each):
  CHPGVX in cdrvsg2stg.f
  DSPGVX in ddrvsg2stg.f
  SSPGVX in sdrvsg2stg.f
  ZHPGVX in zdrvsg2stg.f
This commit is contained in:
NAKATA Maho
2026-03-24 18:21:30 +09:00
parent 7f18edae13
commit 4e013d710c
4 changed files with 12 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
TESTING/EIG/cdrvsg2stg.f
+3 -3
View File
@@ -1009,7 +1009,7 @@ C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
*
CALL CHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ RWORK, IWORK( N+1 ), IWORK, INFO )
$ RWORK, IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,A' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1055,7 +1055,7 @@ C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
VU = ANORM
CALL CHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ RWORK, IWORK( N+1 ), IWORK, INFO )
$ RWORK, IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,V' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1099,7 +1099,7 @@ C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
*
CALL CHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ RWORK, IWORK( N+1 ), IWORK, INFO )
$ RWORK, IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,I' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
TESTING/EIG/ddrvsg2stg.f
+3 -3
View File
@@ -989,7 +989,7 @@ C $ LDZ, D, WORK, RESULT( NTEST ) )
*
CALL DSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ IWORK( N+1 ), IWORK, INFO )
$ IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,A' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1035,7 +1035,7 @@ C $ LDZ, D, WORK, RESULT( NTEST ) )
VU = ANORM
CALL DSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ IWORK( N+1 ), IWORK, INFO )
$ IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,V' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1079,7 +1079,7 @@ C $ LDZ, D, WORK, RESULT( NTEST ) )
*
CALL DSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ IWORK( N+1 ), IWORK, INFO )
$ IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,I' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
TESTING/EIG/sdrvsg2stg.f
+3 -3
View File
@@ -990,7 +990,7 @@ C $ LDZ, D, WORK, RESULT( NTEST ) )
*
CALL SSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ IWORK( N+1 ), IWORK, INFO )
$ IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,A' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1036,7 +1036,7 @@ C $ LDZ, D, WORK, RESULT( NTEST ) )
VU = ANORM
CALL SSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ IWORK( N+1 ), IWORK, INFO )
$ IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,V' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1080,7 +1080,7 @@ C $ LDZ, D, WORK, RESULT( NTEST ) )
*
CALL SSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ IWORK( N+1 ), IWORK, INFO )
$ IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,I' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
TESTING/EIG/zdrvsg2stg.f
+3 -3
View File
@@ -1009,7 +1009,7 @@ C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
*
CALL ZHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ RWORK, IWORK( N+1 ), IWORK, INFO )
$ RWORK, IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,A' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1055,7 +1055,7 @@ C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
VU = ANORM
CALL ZHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ RWORK, IWORK( N+1 ), IWORK, INFO )
$ RWORK, IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,V' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD
@@ -1099,7 +1099,7 @@ C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
*
CALL ZHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
$ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
$ RWORK, IWORK( N+1 ), IWORK, INFO )
$ RWORK, IWORK( N+1 ), IWORK, IINFO )
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,I' // UPLO //
$ ')', IINFO, N, JTYPE, IOLDSD