diff --git a/SRC/claein.f b/SRC/claein.f index efc659a95..bbd45755c 100644 --- a/SRC/claein.f +++ b/SRC/claein.f @@ -173,7 +173,8 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * .. Local Scalars .. CHARACTER NORMIN, TRANS INTEGER I, IERR, ITS, J - REAL GROWTO, NRMSML, ROOTN, RTEMP, SCALE, VNORM + REAL GROWTO, NRMSML, ROOTN, RTEMP, SCALE, V0NORM, + $ V1NORM COMPLEX CDUM, EI, EJ, TEMP, X * .. * .. External Functions .. @@ -198,11 +199,13 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * INFO = 0 * -* GROWTO is the threshold used in the acceptance test for an -* eigenvector. +* Each starting vector gets one solve, from v0 to v1. The residual +* of v1 is SCALE times the norm of v0, over the norm of v1, so +* GROWTO is the growth V1NORM/(SCALE*V0NORM) that the acceptance +* test below requires. * ROOTN = SQRT( REAL( N ) ) - GROWTO = TENTH / ROOTN + GROWTO = TENTH / ( REAL( N )*EPS3 ) NRMSML = MAX( ONE, EPS3*ROOTN )*SMLNUM * * Form B = H - W*I (except that the subdiagonal elements are not @@ -226,8 +229,8 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * * Scale supplied initial vector. * - VNORM = SCNRM2( N, V, 1 ) - CALL CSSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), V, + V0NORM = SCNRM2( N, V, 1 ) + CALL CSSCAL( N, ( EPS3*ROOTN ) / MAX( V0NORM, NRMSML ), V, $ 1 ) END IF * @@ -309,6 +312,7 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * NORMIN = 'N' DO 110 ITS = 1, N + V0NORM = SCASUM( N, V, 1 ) * * Solve U*x = scale*v for a right eigenvector * or U**H *x = scale*v for a left eigenvector, @@ -321,8 +325,8 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * * Test for sufficient growth in the norm of v. * - VNORM = SCASUM( N, V, 1 ) - IF( VNORM.GE.GROWTO*SCALE ) + V1NORM = SCASUM( N, V, 1 ) + IF( V1NORM.GE.GROWTO*SCALE*V0NORM ) $ GO TO 120 * * Choose new orthogonal starting vector and try again. diff --git a/SRC/dlaein.f b/SRC/dlaein.f index 17bb819aa..fbcab9b38 100644 --- a/SRC/dlaein.f +++ b/SRC/dlaein.f @@ -194,8 +194,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, CHARACTER NORMIN, TRANS INTEGER I, I1, I2, I3, IERR, ITS, J DOUBLE PRECISION ABSBII, ABSBJJ, EI, EJ, GROWTO, NORM, NRMSML, - $ REC, ROOTN, SCALE, TEMP, VCRIT, VMAX, VNORM, W, - $ W1, X, XI, XR, Y + $ REC, ROOTN, SCALE, TEMP, V0NORM, V1NORM, + $ VCRIT, VMAX, W, W1, X, XI, XR, Y * .. * .. External Functions .. INTEGER IDAMAX @@ -212,11 +212,13 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * INFO = 0 * -* GROWTO is the threshold used in the acceptance test for an -* eigenvector. +* Each starting vector gets one solve, from v0 to v1. The residual +* of v1 is SCALE times the norm of v0, over the norm of v1, so +* GROWTO is the growth V1NORM/(SCALE*V0NORM) that the acceptance +* test below requires. * ROOTN = SQRT( DBLE( N ) ) - GROWTO = TENTH / ROOTN + GROWTO = TENTH / ( DBLE( N )*EPS3 ) NRMSML = MAX( ONE, EPS3*ROOTN )*SMLNUM * * Form B = H - (WR,WI)*I (except that the subdiagonal elements and @@ -244,8 +246,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Scale supplied initial vector. * - VNORM = DNRM2( N, VR, 1 ) - CALL DSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), VR, + V0NORM = DNRM2( N, VR, 1 ) + CALL DSCAL( N, ( EPS3*ROOTN ) / MAX( V0NORM, NRMSML ), VR, $ 1 ) END IF * @@ -327,6 +329,7 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * NORMIN = 'N' DO 110 ITS = 1, N + V0NORM = DASUM( N, VR, 1 ) * * Solve U*x = scale*v for a right eigenvector * or U**T*x = scale*v for a left eigenvector, @@ -339,8 +342,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Test for sufficient growth in the norm of v. * - VNORM = DASUM( N, VR, 1 ) - IF( VNORM.GE.GROWTO*SCALE ) + V1NORM = DASUM( N, VR, 1 ) + IF( V1NORM.GE.GROWTO*SCALE*V0NORM ) $ GO TO 120 * * Choose new orthogonal starting vector and try again. @@ -521,6 +524,7 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, END IF * DO 270 ITS = 1, N + V0NORM = DASUM( N, VR, 1 ) + DASUM( N, VI, 1 ) SCALE = ONE VMAX = ONE VCRIT = BIGNUM @@ -591,8 +595,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Test for sufficient growth in the norm of (VR,VI). * - VNORM = DASUM( N, VR, 1 ) + DASUM( N, VI, 1 ) - IF( VNORM.GE.GROWTO*SCALE ) + V1NORM = DASUM( N, VR, 1 ) + DASUM( N, VI, 1 ) + IF( V1NORM.GE.GROWTO*SCALE*V0NORM ) $ GO TO 280 * * Choose a new orthogonal starting vector and try again. @@ -616,12 +620,12 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Normalize eigenvector. * - VNORM = ZERO + V1NORM = ZERO DO 290 I = 1, N - VNORM = MAX( VNORM, ABS( VR( I ) )+ABS( VI( I ) ) ) + V1NORM = MAX( V1NORM, ABS( VR( I ) )+ABS( VI( I ) ) ) 290 CONTINUE - CALL DSCAL( N, ONE / VNORM, VR, 1 ) - CALL DSCAL( N, ONE / VNORM, VI, 1 ) + CALL DSCAL( N, ONE / V1NORM, VR, 1 ) + CALL DSCAL( N, ONE / V1NORM, VI, 1 ) * END IF * diff --git a/SRC/slaein.f b/SRC/slaein.f index e6e2065f5..8246aeaf3 100644 --- a/SRC/slaein.f +++ b/SRC/slaein.f @@ -194,8 +194,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, CHARACTER NORMIN, TRANS INTEGER I, I1, I2, I3, IERR, ITS, J REAL ABSBII, ABSBJJ, EI, EJ, GROWTO, NORM, NRMSML, - $ REC, ROOTN, SCALE, TEMP, VCRIT, VMAX, VNORM, W, - $ W1, X, XI, XR, Y + $ REC, ROOTN, SCALE, TEMP, V0NORM, V1NORM, + $ VCRIT, VMAX, W, W1, X, XI, XR, Y * .. * .. External Functions .. INTEGER ISAMAX @@ -212,11 +212,13 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * INFO = 0 * -* GROWTO is the threshold used in the acceptance test for an -* eigenvector. +* Each starting vector gets one solve, from v0 to v1. The residual +* of v1 is SCALE times the norm of v0, over the norm of v1, so +* GROWTO is the growth V1NORM/(SCALE*V0NORM) that the acceptance +* test below requires. * ROOTN = SQRT( REAL( N ) ) - GROWTO = TENTH / ROOTN + GROWTO = TENTH / ( REAL( N )*EPS3 ) NRMSML = MAX( ONE, EPS3*ROOTN )*SMLNUM * * Form B = H - (WR,WI)*I (except that the subdiagonal elements and @@ -244,8 +246,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Scale supplied initial vector. * - VNORM = SNRM2( N, VR, 1 ) - CALL SSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), VR, + V0NORM = SNRM2( N, VR, 1 ) + CALL SSCAL( N, ( EPS3*ROOTN ) / MAX( V0NORM, NRMSML ), VR, $ 1 ) END IF * @@ -327,6 +329,7 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * NORMIN = 'N' DO 110 ITS = 1, N + V0NORM = SASUM( N, VR, 1 ) * * Solve U*x = scale*v for a right eigenvector * or U**T*x = scale*v for a left eigenvector, @@ -339,8 +342,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Test for sufficient growth in the norm of v. * - VNORM = SASUM( N, VR, 1 ) - IF( VNORM.GE.GROWTO*SCALE ) + V1NORM = SASUM( N, VR, 1 ) + IF( V1NORM.GE.GROWTO*SCALE*V0NORM ) $ GO TO 120 * * Choose new orthogonal starting vector and try again. @@ -521,6 +524,7 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, END IF * DO 270 ITS = 1, N + V0NORM = SASUM( N, VR, 1 ) + SASUM( N, VI, 1 ) SCALE = ONE VMAX = ONE VCRIT = BIGNUM @@ -591,8 +595,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Test for sufficient growth in the norm of (VR,VI). * - VNORM = SASUM( N, VR, 1 ) + SASUM( N, VI, 1 ) - IF( VNORM.GE.GROWTO*SCALE ) + V1NORM = SASUM( N, VR, 1 ) + SASUM( N, VI, 1 ) + IF( V1NORM.GE.GROWTO*SCALE*V0NORM ) $ GO TO 280 * * Choose a new orthogonal starting vector and try again. @@ -616,12 +620,12 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Normalize eigenvector. * - VNORM = ZERO + V1NORM = ZERO DO 290 I = 1, N - VNORM = MAX( VNORM, ABS( VR( I ) )+ABS( VI( I ) ) ) + V1NORM = MAX( V1NORM, ABS( VR( I ) )+ABS( VI( I ) ) ) 290 CONTINUE - CALL SSCAL( N, ONE / VNORM, VR, 1 ) - CALL SSCAL( N, ONE / VNORM, VI, 1 ) + CALL SSCAL( N, ONE / V1NORM, VR, 1 ) + CALL SSCAL( N, ONE / V1NORM, VI, 1 ) * END IF * diff --git a/SRC/zlaein.f b/SRC/zlaein.f index 78b72b881..0786fda9f 100644 --- a/SRC/zlaein.f +++ b/SRC/zlaein.f @@ -173,7 +173,8 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * .. Local Scalars .. CHARACTER NORMIN, TRANS INTEGER I, IERR, ITS, J - DOUBLE PRECISION GROWTO, NRMSML, ROOTN, RTEMP, SCALE, VNORM + DOUBLE PRECISION GROWTO, NRMSML, ROOTN, RTEMP, SCALE, V0NORM, + $ V1NORM COMPLEX*16 CDUM, EI, EJ, TEMP, X * .. * .. External Functions .. @@ -198,11 +199,13 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * INFO = 0 * -* GROWTO is the threshold used in the acceptance test for an -* eigenvector. +* Each starting vector gets one solve, from v0 to v1. The residual +* of v1 is SCALE times the norm of v0, over the norm of v1, so +* GROWTO is the growth V1NORM/(SCALE*V0NORM) that the acceptance +* test below requires. * ROOTN = SQRT( DBLE( N ) ) - GROWTO = TENTH / ROOTN + GROWTO = TENTH / ( DBLE( N )*EPS3 ) NRMSML = MAX( ONE, EPS3*ROOTN )*SMLNUM * * Form B = H - W*I (except that the subdiagonal elements are not @@ -226,8 +229,8 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * * Scale supplied initial vector. * - VNORM = DZNRM2( N, V, 1 ) - CALL ZDSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), V, + V0NORM = DZNRM2( N, V, 1 ) + CALL ZDSCAL( N, ( EPS3*ROOTN ) / MAX( V0NORM, NRMSML ), V, $ 1 ) END IF * @@ -309,6 +312,7 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * NORMIN = 'N' DO 110 ITS = 1, N + V0NORM = DZASUM( N, V, 1 ) * * Solve U*x = scale*v for a right eigenvector * or U**H *x = scale*v for a left eigenvector, @@ -321,8 +325,8 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, * * Test for sufficient growth in the norm of v. * - VNORM = DZASUM( N, V, 1 ) - IF( VNORM.GE.GROWTO*SCALE ) + V1NORM = DZASUM( N, V, 1 ) + IF( V1NORM.GE.GROWTO*SCALE*V0NORM ) $ GO TO 120 * * Choose new orthogonal starting vector and try again.