From 46604b2708d41f3f90f35040370ba0a92b8662b0 Mon Sep 17 00:00:00 2001 From: NAKATA Maho Date: Tue, 14 Apr 2026 07:36:16 +0900 Subject: [PATCH 1/5] 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/5] 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/5] 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 From c1afcaef18539d6f74e29469fb55b55e46656901 Mon Sep 17 00:00:00 2001 From: NAKATA Maho Date: Tue, 14 Apr 2026 07:56:55 +0900 Subject: [PATCH 4/5] SRC: use LSAME for TRANS checks in gttrs Replace direct case-sensitive TRANS character comparisons in the GTTRS routines with LSAME. This keeps option handling consistent with the surrounding LAPACK convention for case-insensitive checks. --- SRC/cgttrs.f | 11 ++++++----- SRC/dgttrs.f | 9 +++++---- SRC/sgttrs.f | 9 +++++---- SRC/zgttrs.f | 11 ++++++----- 4 files changed, 22 insertions(+), 18 deletions(-) diff --git a/SRC/cgttrs.f b/SRC/cgttrs.f index 9ff93a4cf..7fac67bb1 100644 --- a/SRC/cgttrs.f +++ b/SRC/cgttrs.f @@ -157,7 +157,8 @@ SUBROUTINE CGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + LOGICAL LSAME + EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. EXTERNAL CGTTS2, XERBLA @@ -168,9 +169,9 @@ SUBROUTINE CGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. Executable Statements .. * INFO = 0 - NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' ) - IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ. - $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN + NOTRAN = LSAME( TRANS, 'N' ) + IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -193,7 +194,7 @@ SUBROUTINE CGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * IF( NOTRAN ) THEN ITRANS = 0 - ELSE IF( TRANS.EQ.'T' .OR. TRANS.EQ.'t' ) THEN + ELSE IF( LSAME( TRANS, 'T' ) ) THEN ITRANS = 1 ELSE ITRANS = 2 diff --git a/SRC/dgttrs.f b/SRC/dgttrs.f index 1f3d84469..500f71ab2 100644 --- a/SRC/dgttrs.f +++ b/SRC/dgttrs.f @@ -157,7 +157,8 @@ SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + LOGICAL LSAME + EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. EXTERNAL DGTTS2, XERBLA @@ -168,9 +169,9 @@ SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. Executable Statements .. * INFO = 0 - NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' ) - IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ. - $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN + NOTRAN = LSAME( TRANS, 'N' ) + IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/sgttrs.f b/SRC/sgttrs.f index 306c8f1bc..68921b6b8 100644 --- a/SRC/sgttrs.f +++ b/SRC/sgttrs.f @@ -157,7 +157,8 @@ SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + LOGICAL LSAME + EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. EXTERNAL SGTTS2, XERBLA @@ -168,9 +169,9 @@ SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. Executable Statements .. * INFO = 0 - NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' ) - IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ. - $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN + NOTRAN = LSAME( TRANS, 'N' ) + IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zgttrs.f b/SRC/zgttrs.f index 180acb6dc..2238b8d63 100644 --- a/SRC/zgttrs.f +++ b/SRC/zgttrs.f @@ -157,7 +157,8 @@ SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + LOGICAL LSAME + EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. EXTERNAL XERBLA, ZGTTS2 @@ -168,9 +169,9 @@ SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * .. Executable Statements .. * INFO = 0 - NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' ) - IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ. - $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN + NOTRAN = LSAME( TRANS, 'N' ) + IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -193,7 +194,7 @@ SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, * IF( NOTRAN ) THEN ITRANS = 0 - ELSE IF( TRANS.EQ.'T' .OR. TRANS.EQ.'t' ) THEN + ELSE IF( LSAME( TRANS, 'T' ) ) THEN ITRANS = 1 ELSE ITRANS = 2 From bb2bda9ed3414eaba62ac165a25e0e533efe6805 Mon Sep 17 00:00:00 2001 From: NAKATA Maho Date: Tue, 14 Apr 2026 08:17:35 +0900 Subject: [PATCH 5/5] SRC: use LSAME for UPLO checks in lalsd Replace direct UPLO character comparisons in the LALSD routines with LSAME. This keeps option handling consistent with the surrounding LAPACK convention for case-insensitive checks. --- SRC/clalsd.f | 5 +++-- SRC/dlalsd.f | 5 +++-- SRC/slalsd.f | 5 +++-- SRC/zlalsd.f | 5 +++-- 4 files changed, 12 insertions(+), 8 deletions(-) diff --git a/SRC/clalsd.f b/SRC/clalsd.f index 6ee0744cb..3a16ddd13 100644 --- a/SRC/clalsd.f +++ b/SRC/clalsd.f @@ -212,7 +212,8 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * .. External Functions .. INTEGER ISAMAX REAL SLAMCH, SLANST - EXTERNAL ISAMAX, SLAMCH, SLANST + LOGICAL LSAME + EXTERNAL ISAMAX, SLAMCH, SLANST, LSAME * .. * .. External Subroutines .. EXTERNAL CCOPY, CLACPY, CLALSA, CLASCL, CLASET, @@ -271,7 +272,7 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * * Rotate the matrix if it is lower bidiagonal. * - IF( UPLO.EQ.'L' ) THEN + IF( LSAME( UPLO, 'L' ) ) THEN DO 10 I = 1, N - 1 CALL SLARTG( D( I ), E( I ), CS, SN, R ) D( I ) = R diff --git a/SRC/dlalsd.f b/SRC/dlalsd.f index 8844e7552..f5dbfc601 100644 --- a/SRC/dlalsd.f +++ b/SRC/dlalsd.f @@ -200,7 +200,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * .. External Functions .. INTEGER IDAMAX DOUBLE PRECISION DLAMCH, DLANST - EXTERNAL IDAMAX, DLAMCH, DLANST + LOGICAL LSAME + EXTERNAL IDAMAX, DLAMCH, DLANST, LSAME * .. * .. External Subroutines .. EXTERNAL DCOPY, DGEMM, DLACPY, DLALSA, DLARTG, @@ -258,7 +259,7 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * * Rotate the matrix if it is lower bidiagonal. * - IF( UPLO.EQ.'L' ) THEN + IF( LSAME( UPLO, 'L' ) ) THEN DO 10 I = 1, N - 1 CALL DLARTG( D( I ), E( I ), CS, SN, R ) D( I ) = R diff --git a/SRC/slalsd.f b/SRC/slalsd.f index 59e22236a..722b724d2 100644 --- a/SRC/slalsd.f +++ b/SRC/slalsd.f @@ -200,7 +200,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * .. External Functions .. INTEGER ISAMAX REAL SLAMCH, SLANST - EXTERNAL ISAMAX, SLAMCH, SLANST + LOGICAL LSAME + EXTERNAL ISAMAX, SLAMCH, SLANST, LSAME * .. * .. External Subroutines .. EXTERNAL SCOPY, SGEMM, SLACPY, SLALSA, SLARTG, @@ -258,7 +259,7 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * * Rotate the matrix if it is lower bidiagonal. * - IF( UPLO.EQ.'L' ) THEN + IF( LSAME( UPLO, 'L' ) ) THEN DO 10 I = 1, N - 1 CALL SLARTG( D( I ), E( I ), CS, SN, R ) D( I ) = R diff --git a/SRC/zlalsd.f b/SRC/zlalsd.f index dffedc441..db4ddec92 100644 --- a/SRC/zlalsd.f +++ b/SRC/zlalsd.f @@ -213,7 +213,8 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * .. External Functions .. INTEGER IDAMAX DOUBLE PRECISION DLAMCH, DLANST - EXTERNAL IDAMAX, DLAMCH, DLANST + LOGICAL LSAME + EXTERNAL IDAMAX, DLAMCH, DLANST, LSAME * .. * .. External Subroutines .. EXTERNAL DGEMM, DLARTG, DLASCL, DLASDA, DLASDQ, @@ -272,7 +273,7 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * * Rotate the matrix if it is lower bidiagonal. * - IF( UPLO.EQ.'L' ) THEN + IF( LSAME( UPLO, 'L' ) ) THEN DO 10 I = 1, N - 1 CALL DLARTG( D( I ), E( I ), CS, SN, R ) D( I ) = R