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/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/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/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/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/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/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/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 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 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 diff --git a/TESTING/LIN/clatsp.f b/TESTING/LIN/clatsp.f index de4a203c2..bdade04df 100644 --- a/TESTING/LIN/clatsp.f +++ b/TESTING/LIN/clatsp.f @@ -109,7 +109,8 @@ SUBROUTINE CLATSP( UPLO, N, X, ISEED ) * .. * .. External Functions .. COMPLEX CLARND - EXTERNAL CLARND + LOGICAL LSAME + EXTERNAL CLARND, LSAME * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -130,7 +131,7 @@ SUBROUTINE CLATSP( UPLO, N, X, ISEED ) * * UPLO = 'U': Upper triangular storage * - IF( UPLO.EQ.'U' ) THEN + IF( LSAME( UPLO, 'U' ) ) THEN N5 = N / 5 N5 = N - 5*N5 + 1 * diff --git a/TESTING/LIN/clatsy.f b/TESTING/LIN/clatsy.f index d24d195b8..f30c36d83 100644 --- a/TESTING/LIN/clatsy.f +++ b/TESTING/LIN/clatsy.f @@ -114,7 +114,8 @@ SUBROUTINE CLATSY( UPLO, N, X, LDX, ISEED ) * .. * .. External Functions .. COMPLEX CLARND - EXTERNAL CLARND + LOGICAL LSAME + EXTERNAL CLARND, LSAME * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -129,7 +130,7 @@ SUBROUTINE CLATSY( UPLO, N, X, LDX, ISEED ) * * UPLO = 'U': Upper triangular storage * - IF( UPLO.EQ.'U' ) THEN + IF( LSAME( UPLO, 'U' ) ) THEN * * Fill the upper triangle of the matrix with zeros. * diff --git a/TESTING/LIN/zlatsp.f b/TESTING/LIN/zlatsp.f index aac864d22..6a3cbc0cb 100644 --- a/TESTING/LIN/zlatsp.f +++ b/TESTING/LIN/zlatsp.f @@ -109,7 +109,8 @@ SUBROUTINE ZLATSP( UPLO, N, X, ISEED ) * .. * .. External Functions .. COMPLEX*16 ZLARND - EXTERNAL ZLARND + LOGICAL LSAME + EXTERNAL ZLARND, LSAME * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -130,7 +131,7 @@ SUBROUTINE ZLATSP( UPLO, N, X, ISEED ) * * UPLO = 'U': Upper triangular storage * - IF( UPLO.EQ.'U' ) THEN + IF( LSAME( UPLO, 'U' ) ) THEN N5 = N / 5 N5 = N - 5*N5 + 1 * diff --git a/TESTING/LIN/zlatsy.f b/TESTING/LIN/zlatsy.f index 883e54853..69f6285ab 100644 --- a/TESTING/LIN/zlatsy.f +++ b/TESTING/LIN/zlatsy.f @@ -114,7 +114,8 @@ SUBROUTINE ZLATSY( UPLO, N, X, LDX, ISEED ) * .. * .. External Functions .. COMPLEX*16 ZLARND - EXTERNAL ZLARND + LOGICAL LSAME + EXTERNAL ZLARND, LSAME * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -129,7 +130,7 @@ SUBROUTINE ZLATSY( UPLO, N, X, LDX, ISEED ) * * UPLO = 'U': Upper triangular storage * - IF( UPLO.EQ.'U' ) THEN + IF( LSAME( UPLO, 'U' ) ) THEN * * Fill the upper triangle of the matrix with zeros. *