1*> \brief \b SCHKBL 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE SCHKBL( NIN, NOUT ) 12* 13* .. Scalar Arguments .. 14* INTEGER NIN, NOUT 15* .. 16* 17* 18*> \par Purpose: 19* ============= 20*> 21*> \verbatim 22*> 23*> SCHKBL tests SGEBAL, a routine for balancing a general real 24*> matrix and isolating some of its eigenvalues. 25*> \endverbatim 26* 27* Arguments: 28* ========== 29* 30*> \param[in] NIN 31*> \verbatim 32*> NIN is INTEGER 33*> The logical unit number for input. NIN > 0. 34*> \endverbatim 35*> 36*> \param[in] NOUT 37*> \verbatim 38*> NOUT is INTEGER 39*> The logical unit number for output. NOUT > 0. 40*> \endverbatim 41* 42* Authors: 43* ======== 44* 45*> \author Univ. of Tennessee 46*> \author Univ. of California Berkeley 47*> \author Univ. of Colorado Denver 48*> \author NAG Ltd. 49* 50*> \ingroup single_eig 51* 52* ===================================================================== 53 SUBROUTINE SCHKBL( NIN, NOUT ) 54* 55* -- LAPACK test routine -- 56* -- LAPACK is a software package provided by Univ. of Tennessee, -- 57* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 58* 59* .. Scalar Arguments .. 60 INTEGER NIN, NOUT 61* .. 62* 63* ====================================================================== 64* 65* .. Parameters .. 66 INTEGER LDA 67 PARAMETER ( LDA = 20 ) 68 REAL ZERO 69 PARAMETER ( ZERO = 0.0E+0 ) 70* .. 71* .. Local Scalars .. 72 INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, 73 $ NINFO 74 REAL ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX 75* .. 76* .. Local Arrays .. 77 INTEGER LMAX( 3 ) 78 REAL A( LDA, LDA ), AIN( LDA, LDA ), DUMMY( 1 ), 79 $ SCALE( LDA ), SCALIN( LDA ) 80* .. 81* .. External Functions .. 82 REAL SLAMCH, SLANGE 83 EXTERNAL SLAMCH, SLANGE 84* .. 85* .. External Subroutines .. 86 EXTERNAL SGEBAL 87* .. 88* .. Intrinsic Functions .. 89 INTRINSIC ABS, MAX 90* .. 91* .. Executable Statements .. 92* 93 LMAX( 1 ) = 0 94 LMAX( 2 ) = 0 95 LMAX( 3 ) = 0 96 NINFO = 0 97 KNT = 0 98 RMAX = ZERO 99 VMAX = ZERO 100 SFMIN = SLAMCH( 'S' ) 101 MEPS = SLAMCH( 'E' ) 102* 103 10 CONTINUE 104* 105 READ( NIN, FMT = * )N 106 IF( N.EQ.0 ) 107 $ GO TO 70 108 DO 20 I = 1, N 109 READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 110 20 CONTINUE 111* 112 READ( NIN, FMT = * )ILOIN, IHIIN 113 DO 30 I = 1, N 114 READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 115 30 CONTINUE 116 READ( NIN, FMT = * )( SCALIN( I ), I = 1, N ) 117* 118 ANORM = SLANGE( 'M', N, N, A, LDA, DUMMY ) 119 KNT = KNT + 1 120* 121 CALL SGEBAL( 'B', N, A, LDA, ILO, IHI, SCALE, INFO ) 122* 123 IF( INFO.NE.0 ) THEN 124 NINFO = NINFO + 1 125 LMAX( 1 ) = KNT 126 END IF 127* 128 IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN 129 NINFO = NINFO + 1 130 LMAX( 2 ) = KNT 131 END IF 132* 133 DO 50 I = 1, N 134 DO 40 J = 1, N 135 TEMP = MAX( A( I, J ), AIN( I, J ) ) 136 TEMP = MAX( TEMP, SFMIN ) 137 VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) / TEMP ) 138 40 CONTINUE 139 50 CONTINUE 140* 141 DO 60 I = 1, N 142 TEMP = MAX( SCALE( I ), SCALIN( I ) ) 143 TEMP = MAX( TEMP, SFMIN ) 144 VMAX = MAX( VMAX, ABS( SCALE( I )-SCALIN( I ) ) / TEMP ) 145 60 CONTINUE 146* 147* 148 IF( VMAX.GT.RMAX ) THEN 149 LMAX( 3 ) = KNT 150 RMAX = VMAX 151 END IF 152* 153 GO TO 10 154* 155 70 CONTINUE 156* 157 WRITE( NOUT, FMT = 9999 ) 158 9999 FORMAT( 1X, '.. test output of SGEBAL .. ' ) 159* 160 WRITE( NOUT, FMT = 9998 )RMAX 161 9998 FORMAT( 1X, 'value of largest test error = ', E12.3 ) 162 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 163 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) 164 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 165 9996 FORMAT( 1X, 'example number where ILO or IHI wrong = ', I4 ) 166 WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 167 9995 FORMAT( 1X, 'example number having largest error = ', I4 ) 168 WRITE( NOUT, FMT = 9994 )NINFO 169 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) 170 WRITE( NOUT, FMT = 9993 )KNT 171 9993 FORMAT( 1X, 'total number of examples tested = ', I4 ) 172* 173 RETURN 174* 175* End of SCHKBL 176* 177 END 178