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 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/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/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/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/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/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/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 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