diff options
author | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
---|---|---|
committer | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
commit | baba851215b44ac3b60b9248eb02bcce7eb76247 (patch) | |
tree | 8c0f5c006875532a30d4409f5e94b0f310ff00a7 /TESTING/EIG/schkbk.f | |
download | lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.gz lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.bz2 lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.zip |
Move LAPACK trunk into position.
Diffstat (limited to 'TESTING/EIG/schkbk.f')
-rw-r--r-- | TESTING/EIG/schkbk.f | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/TESTING/EIG/schkbk.f b/TESTING/EIG/schkbk.f new file mode 100644 index 00000000..9cd4884c --- /dev/null +++ b/TESTING/EIG/schkbk.f @@ -0,0 +1,123 @@ + SUBROUTINE SCHKBK( NIN, NOUT ) +* +* -- LAPACK test routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER NIN, NOUT +* .. +* +* Purpose +* ======= +* +* SCHKBK tests SGEBAK, a routine for backward transformation of +* the computed right or left eigenvectors if the orginal matrix +* was preprocessed by balance subroutine SGEBAL. +* +* Arguments +* ========= +* +* NIN (input) INTEGER +* The logical unit number for input. NIN > 0. +* +* NOUT (input) INTEGER +* The logical unit number for output. NOUT > 0. +* +* ====================================================================== +* +* .. Parameters .. + INTEGER LDE + PARAMETER ( LDE = 20 ) + REAL ZERO + PARAMETER ( ZERO = 0.0E0 ) +* .. +* .. Local Scalars .. + INTEGER I, IHI, ILO, INFO, J, KNT, N, NINFO + REAL EPS, RMAX, SAFMIN, VMAX, X +* .. +* .. Local Arrays .. + INTEGER LMAX( 2 ) + REAL E( LDE, LDE ), EIN( LDE, LDE ), SCALE( LDE ) +* .. +* .. External Functions .. + REAL SLAMCH + EXTERNAL SLAMCH +* .. +* .. External Subroutines .. + EXTERNAL SGEBAK +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX +* .. +* .. Executable Statements .. +* + LMAX( 1 ) = 0 + LMAX( 2 ) = 0 + NINFO = 0 + KNT = 0 + RMAX = ZERO + EPS = SLAMCH( 'E' ) + SAFMIN = SLAMCH( 'S' ) +* + 10 CONTINUE +* + READ( NIN, FMT = * )N, ILO, IHI + IF( N.EQ.0 ) + $ GO TO 60 +* + READ( NIN, FMT = * )( SCALE( I ), I = 1, N ) + DO 20 I = 1, N + READ( NIN, FMT = * )( E( I, J ), J = 1, N ) + 20 CONTINUE +* + DO 30 I = 1, N + READ( NIN, FMT = * )( EIN( I, J ), J = 1, N ) + 30 CONTINUE +* + KNT = KNT + 1 + CALL SGEBAK( 'B', 'R', N, ILO, IHI, SCALE, N, E, LDE, INFO ) +* + IF( INFO.NE.0 ) THEN + NINFO = NINFO + 1 + LMAX( 1 ) = KNT + END IF +* + VMAX = ZERO + DO 50 I = 1, N + DO 40 J = 1, N + X = ABS( E( I, J )-EIN( I, J ) ) / EPS + IF( ABS( E( I, J ) ).GT.SAFMIN ) + $ X = X / ABS( E( I, J ) ) + VMAX = MAX( VMAX, X ) + 40 CONTINUE + 50 CONTINUE +* + IF( VMAX.GT.RMAX ) THEN + LMAX( 2 ) = KNT + RMAX = VMAX + END IF +* + GO TO 10 +* + 60 CONTINUE +* + WRITE( NOUT, FMT = 9999 ) + 9999 FORMAT( 1X, '.. test output of SGEBAK .. ' ) +* + WRITE( NOUT, FMT = 9998 )RMAX + 9998 FORMAT( 1X, 'value of largest test error = ', E12.3 ) + WRITE( NOUT, FMT = 9997 )LMAX( 1 ) + 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) + WRITE( NOUT, FMT = 9996 )LMAX( 2 ) + 9996 FORMAT( 1X, 'example number having largest error = ', I4 ) + WRITE( NOUT, FMT = 9995 )NINFO + 9995 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) + WRITE( NOUT, FMT = 9994 )KNT + 9994 FORMAT( 1X, 'total number of examples tested = ', I4 ) +* + RETURN +* +* End of SCHKBK +* + END |