From 46604b2708d41f3f90f35040370ba0a92b8662b0 Mon Sep 17 00:00:00 2001 From: NAKATA Maho Date: Tue, 14 Apr 2026 07:36:16 +0900 Subject: [PATCH 1/3] cleanup: normalize ZERO/ONE declaration order in TESTING/EIG error-exit tests Reorder ZERO and ONE declarations and PARAMETER definitions for consistency in the TESTING/EIG error-exit test sources. No functional change intended. --- TESTING/EIG/cerrec.f | 4 ++-- TESTING/EIG/cerred.f | 4 ++-- TESTING/EIG/derrec.f | 4 ++-- TESTING/EIG/derred.f | 4 ++-- TESTING/EIG/serrec.f | 4 ++-- TESTING/EIG/serred.f | 4 ++-- TESTING/EIG/zerrec.f | 4 ++-- TESTING/EIG/zerred.f | 4 ++-- 8 files changed, 16 insertions(+), 16 deletions(-) diff --git a/TESTING/EIG/cerrec.f b/TESTING/EIG/cerrec.f index 7e5c6ced8..4f68f7b38 100644 --- a/TESTING/EIG/cerrec.f +++ b/TESTING/EIG/cerrec.f @@ -69,8 +69,8 @@ SUBROUTINE CERREC( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 4, LW = NMAX*( NMAX+2 ) ) - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 ) + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. INTEGER I, IFST, ILST, INFO, J, M, NT diff --git a/TESTING/EIG/cerred.f b/TESTING/EIG/cerred.f index a406d9cc5..96c0aeb7c 100644 --- a/TESTING/EIG/cerred.f +++ b/TESTING/EIG/cerred.f @@ -83,8 +83,8 @@ SUBROUTINE CERRED( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 4, LW = 5*NMAX ) - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 ) + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 diff --git a/TESTING/EIG/derrec.f b/TESTING/EIG/derrec.f index cdee74180..68c691cad 100644 --- a/TESTING/EIG/derrec.f +++ b/TESTING/EIG/derrec.f @@ -68,8 +68,8 @@ SUBROUTINE DERREC( PATH, NUNIT ) * * .. Parameters .. INTEGER NMAX - DOUBLE PRECISION ONE, ZERO - PARAMETER ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 ) + DOUBLE PRECISION ZERO, ONE + PARAMETER ( NMAX = 4, ZERO = 0.0D0, ONE = 1.0D0 ) * .. * .. Local Scalars .. INTEGER I, IFST, ILST, INFO, J, M, NT diff --git a/TESTING/EIG/derred.f b/TESTING/EIG/derred.f index a20d08ff9..d411471df 100644 --- a/TESTING/EIG/derred.f +++ b/TESTING/EIG/derred.f @@ -82,8 +82,8 @@ SUBROUTINE DERRED( PATH, NUNIT ) * * .. Parameters .. INTEGER NMAX - DOUBLE PRECISION ONE, ZERO - PARAMETER ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 ) + DOUBLE PRECISION ZERO, ONE + PARAMETER ( NMAX = 4, ZERO = 0.0D0, ONE = 1.0D0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 diff --git a/TESTING/EIG/serrec.f b/TESTING/EIG/serrec.f index 6c89ed3a1..477c8c0bf 100644 --- a/TESTING/EIG/serrec.f +++ b/TESTING/EIG/serrec.f @@ -68,8 +68,8 @@ SUBROUTINE SERREC( PATH, NUNIT ) * * .. Parameters .. INTEGER NMAX - REAL ONE, ZERO - PARAMETER ( NMAX = 4, ONE = 1.0E0, ZERO = 0.0E0 ) + REAL ZERO, ONE + PARAMETER ( NMAX = 4, ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. INTEGER I, IFST, ILST, INFO, J, M, NT diff --git a/TESTING/EIG/serred.f b/TESTING/EIG/serred.f index d6d5f5c61..5ef8a56a9 100644 --- a/TESTING/EIG/serred.f +++ b/TESTING/EIG/serred.f @@ -82,8 +82,8 @@ SUBROUTINE SERRED( PATH, NUNIT ) * * .. Parameters .. INTEGER NMAX - REAL ONE, ZERO - PARAMETER ( NMAX = 4, ONE = 1.0E0, ZERO = 0.0E0 ) + REAL ZERO, ONE + PARAMETER ( NMAX = 4, ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 diff --git a/TESTING/EIG/zerrec.f b/TESTING/EIG/zerrec.f index cc3f48b48..76f863b3f 100644 --- a/TESTING/EIG/zerrec.f +++ b/TESTING/EIG/zerrec.f @@ -69,8 +69,8 @@ SUBROUTINE ZERREC( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 4, LW = NMAX*( NMAX+2 ) ) - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) * .. * .. Local Scalars .. INTEGER I, IFST, ILST, INFO, J, M, NT diff --git a/TESTING/EIG/zerred.f b/TESTING/EIG/zerred.f index eef38dda7..2f6e114c7 100644 --- a/TESTING/EIG/zerred.f +++ b/TESTING/EIG/zerred.f @@ -83,8 +83,8 @@ SUBROUTINE ZERRED( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 4, LW = 5*NMAX ) - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 From 9def0ea1712c20714e30e8ec531b0b0ba6080430 Mon Sep 17 00:00:00 2001 From: NAKATA Maho Date: Tue, 14 Apr 2026 07:41:30 +0900 Subject: [PATCH 2/3] TESTING/EIG: use named constants in errgg and zerrhs tests Replace hard-coded floating-point constants with named constants in selected TESTING/EIG error-exit tests. This keeps the test setup code consistent with surrounding LAPACK test style. --- TESTING/EIG/cerrgg.f | 8 ++++---- TESTING/EIG/derrgg.f | 8 ++++---- TESTING/EIG/serrgg.f | 8 ++++---- TESTING/EIG/zerrgg.f | 8 ++++---- TESTING/EIG/zerrhs.f | 4 +++- 5 files changed, 19 insertions(+), 17 deletions(-) diff --git a/TESTING/EIG/cerrgg.f b/TESTING/EIG/cerrgg.f index fa5eeb47b..b7cb9974b 100644 --- a/TESTING/EIG/cerrgg.f +++ b/TESTING/EIG/cerrgg.f @@ -70,8 +70,8 @@ SUBROUTINE CERRGG( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 3, LW = 6*NMAX ) - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 @@ -129,8 +129,8 @@ SUBROUTINE CERRGG( PATH, NUNIT ) B( I, I ) = ONE 30 CONTINUE OK = .TRUE. - TOLA = 1.0E0 - TOLB = 1.0E0 + TOLA = ONE + TOLB = ONE IFST = 1 ILST = 1 NT = 0 diff --git a/TESTING/EIG/derrgg.f b/TESTING/EIG/derrgg.f index 63358eb9f..b7cb951ef 100644 --- a/TESTING/EIG/derrgg.f +++ b/TESTING/EIG/derrgg.f @@ -70,8 +70,8 @@ SUBROUTINE DERRGG( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 3, LW = 6*NMAX ) - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 @@ -128,8 +128,8 @@ SUBROUTINE DERRGG( PATH, NUNIT ) B( I, I ) = ONE 30 CONTINUE OK = .TRUE. - TOLA = 1.0D0 - TOLB = 1.0D0 + TOLA = ONE + TOLB = ONE IFST = 1 ILST = 1 NT = 0 diff --git a/TESTING/EIG/serrgg.f b/TESTING/EIG/serrgg.f index ed7ce4947..2d6b97065 100644 --- a/TESTING/EIG/serrgg.f +++ b/TESTING/EIG/serrgg.f @@ -70,8 +70,8 @@ SUBROUTINE SERRGG( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 3, LW = 6*NMAX ) - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 @@ -128,8 +128,8 @@ SUBROUTINE SERRGG( PATH, NUNIT ) B( I, I ) = ONE 30 CONTINUE OK = .TRUE. - TOLA = 1.0E0 - TOLB = 1.0E0 + TOLA = ONE + TOLB = ONE IFST = 1 ILST = 1 NT = 0 diff --git a/TESTING/EIG/zerrgg.f b/TESTING/EIG/zerrgg.f index e232133d5..fdfbe8b38 100644 --- a/TESTING/EIG/zerrgg.f +++ b/TESTING/EIG/zerrgg.f @@ -70,8 +70,8 @@ SUBROUTINE ZERRGG( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 3, LW = 6*NMAX ) - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 @@ -129,8 +129,8 @@ SUBROUTINE ZERRGG( PATH, NUNIT ) B( I, I ) = ONE 30 CONTINUE OK = .TRUE. - TOLA = 1.0D0 - TOLB = 1.0D0 + TOLA = ONE + TOLB = ONE IFST = 1 ILST = 1 NT = 0 diff --git a/TESTING/EIG/zerrhs.f b/TESTING/EIG/zerrhs.f index f9e2e32dd..f7cd5b290 100644 --- a/TESTING/EIG/zerrhs.f +++ b/TESTING/EIG/zerrhs.f @@ -68,6 +68,8 @@ SUBROUTINE ZERRHS( PATH, NUNIT ) * .. Parameters .. INTEGER NMAX, LW PARAMETER ( NMAX = 3, LW = NMAX*NMAX ) + DOUBLE PRECISION ONE + PARAMETER ( ONE = 1.0D+0 ) * .. * .. Local Scalars .. CHARACTER*2 C2 @@ -111,7 +113,7 @@ SUBROUTINE ZERRHS( PATH, NUNIT ) * DO 20 J = 1, NMAX DO 10 I = 1, NMAX - A( I, J ) = 1.D0 / DBLE( I+J ) + A( I, J ) = ONE / DBLE( I+J ) 10 CONTINUE SEL( J ) = .TRUE. 20 CONTINUE From 6a1be421a1b482c85f8c2735326444468286480c Mon Sep 17 00:00:00 2001 From: NAKATA Maho Date: Tue, 14 Apr 2026 07:52:43 +0900 Subject: [PATCH 3/3] SRC: use LSAME for UPLO checks in pttrs Replace direct case-sensitive UPLO character comparisons in CPTTRS and ZPTTRS with LSAME. This matches the surrounding LAPACK convention for case-insensitive option checks. --- SRC/cpttrs.f | 7 ++++--- SRC/zpttrs.f | 7 ++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/SRC/cpttrs.f b/SRC/cpttrs.f index ac9bac310..816364e7e 100644 --- a/SRC/cpttrs.f +++ b/SRC/cpttrs.f @@ -139,7 +139,8 @@ SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + LOGICAL LSAME + EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. EXTERNAL CPTTS2, XERBLA @@ -152,8 +153,8 @@ SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * Test the input arguments. * INFO = 0 - UPPER = ( UPLO.EQ.'U' .OR. UPLO.EQ.'u' ) - IF( .NOT.UPPER .AND. .NOT.( UPLO.EQ.'L' .OR. UPLO.EQ.'l' ) ) THEN + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zpttrs.f b/SRC/zpttrs.f index 3f32fb18b..cba956798 100644 --- a/SRC/zpttrs.f +++ b/SRC/zpttrs.f @@ -139,7 +139,8 @@ SUBROUTINE ZPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + LOGICAL LSAME + EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. EXTERNAL XERBLA, ZPTTS2 @@ -152,8 +153,8 @@ SUBROUTINE ZPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * Test the input arguments. * INFO = 0 - UPPER = ( UPLO.EQ.'U' .OR. UPLO.EQ.'u' ) - IF( .NOT.UPPER .AND. .NOT.( UPLO.EQ.'L' .OR. UPLO.EQ.'l' ) ) THEN + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2