|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SCHKBL( NIN, NOUT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 INTEGER NIN, NOUT 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * SCHKBL tests SGEBAL, a routine for balancing a general real 00015 * matrix and isolating some of its eigenvalues. 00016 * 00017 * Arguments 00018 * ========= 00019 * 00020 * NIN (input) INTEGER 00021 * The logical unit number for input. NIN > 0. 00022 * 00023 * NOUT (input) INTEGER 00024 * The logical unit number for output. NOUT > 0. 00025 * 00026 * ====================================================================== 00027 * 00028 * .. Parameters .. 00029 INTEGER LDA 00030 PARAMETER ( LDA = 20 ) 00031 REAL ZERO 00032 PARAMETER ( ZERO = 0.0E+0 ) 00033 * .. 00034 * .. Local Scalars .. 00035 INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, 00036 $ NINFO 00037 REAL ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX 00038 * .. 00039 * .. Local Arrays .. 00040 INTEGER LMAX( 3 ) 00041 REAL A( LDA, LDA ), AIN( LDA, LDA ), DUMMY( 1 ), 00042 $ SCALE( LDA ), SCALIN( LDA ) 00043 * .. 00044 * .. External Functions .. 00045 REAL SLAMCH, SLANGE 00046 EXTERNAL SLAMCH, SLANGE 00047 * .. 00048 * .. External Subroutines .. 00049 EXTERNAL SGEBAL 00050 * .. 00051 * .. Intrinsic Functions .. 00052 INTRINSIC ABS, MAX 00053 * .. 00054 * .. Executable Statements .. 00055 * 00056 LMAX( 1 ) = 0 00057 LMAX( 2 ) = 0 00058 LMAX( 3 ) = 0 00059 NINFO = 0 00060 KNT = 0 00061 RMAX = ZERO 00062 VMAX = ZERO 00063 SFMIN = SLAMCH( 'S' ) 00064 MEPS = SLAMCH( 'E' ) 00065 * 00066 10 CONTINUE 00067 * 00068 READ( NIN, FMT = * )N 00069 IF( N.EQ.0 ) 00070 $ GO TO 70 00071 DO 20 I = 1, N 00072 READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 00073 20 CONTINUE 00074 * 00075 READ( NIN, FMT = * )ILOIN, IHIIN 00076 DO 30 I = 1, N 00077 READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 00078 30 CONTINUE 00079 READ( NIN, FMT = * )( SCALIN( I ), I = 1, N ) 00080 * 00081 ANORM = SLANGE( 'M', N, N, A, LDA, DUMMY ) 00082 KNT = KNT + 1 00083 * 00084 CALL SGEBAL( 'B', N, A, LDA, ILO, IHI, SCALE, INFO ) 00085 * 00086 IF( INFO.NE.0 ) THEN 00087 NINFO = NINFO + 1 00088 LMAX( 1 ) = KNT 00089 END IF 00090 * 00091 IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN 00092 NINFO = NINFO + 1 00093 LMAX( 2 ) = KNT 00094 END IF 00095 * 00096 DO 50 I = 1, N 00097 DO 40 J = 1, N 00098 TEMP = MAX( A( I, J ), AIN( I, J ) ) 00099 TEMP = MAX( TEMP, SFMIN ) 00100 VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) / TEMP ) 00101 40 CONTINUE 00102 50 CONTINUE 00103 * 00104 DO 60 I = 1, N 00105 TEMP = MAX( SCALE( I ), SCALIN( I ) ) 00106 TEMP = MAX( TEMP, SFMIN ) 00107 VMAX = MAX( VMAX, ABS( SCALE( I )-SCALIN( I ) ) / TEMP ) 00108 60 CONTINUE 00109 * 00110 * 00111 IF( VMAX.GT.RMAX ) THEN 00112 LMAX( 3 ) = KNT 00113 RMAX = VMAX 00114 END IF 00115 * 00116 GO TO 10 00117 * 00118 70 CONTINUE 00119 * 00120 WRITE( NOUT, FMT = 9999 ) 00121 9999 FORMAT( 1X, '.. test output of SGEBAL .. ' ) 00122 * 00123 WRITE( NOUT, FMT = 9998 )RMAX 00124 9998 FORMAT( 1X, 'value of largest test error = ', E12.3 ) 00125 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 00126 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) 00127 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 00128 9996 FORMAT( 1X, 'example number where ILO or IHI wrong = ', I4 ) 00129 WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 00130 9995 FORMAT( 1X, 'example number having largest error = ', I4 ) 00131 WRITE( NOUT, FMT = 9994 )NINFO 00132 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) 00133 WRITE( NOUT, FMT = 9993 )KNT 00134 9993 FORMAT( 1X, 'total number of examples tested = ', I4 ) 00135 * 00136 RETURN 00137 * 00138 * End of SCHKBL 00139 * 00140 END
1.7.3 
