1*> \brief \b CCHKBL 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 CCHKBL( NIN, NOUT ) 12* 13* .. Scalar Arguments .. 14* INTEGER NIN, NOUT 15* .. 16* 17* 18*> \par Purpose: 19* ============= 20*> 21*> \verbatim 22*> 23*> CCHKBL tests CGEBAL, a routine for balancing a general complex 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 complex_eig 51* 52* ===================================================================== 53 SUBROUTINE CCHKBL( 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 COMPLEX CDUM 76* .. 77* .. Local Arrays .. 78 INTEGER LMAX( 3 ) 79 REAL DUMMY( 1 ), SCALE( LDA ), SCALIN( LDA ) 80 COMPLEX A( LDA, LDA ), AIN( LDA, LDA ) 81* .. 82* .. External Functions .. 83 REAL CLANGE, SLAMCH 84 EXTERNAL CLANGE, SLAMCH 85* .. 86* .. External Subroutines .. 87 EXTERNAL CGEBAL 88* .. 89* .. Intrinsic Functions .. 90 INTRINSIC ABS, AIMAG, MAX, REAL 91* .. 92* .. Statement Functions .. 93 REAL CABS1 94* .. 95* .. Statement Function definitions .. 96 CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) 97* .. 98* .. Executable Statements .. 99* 100 LMAX( 1 ) = 0 101 LMAX( 2 ) = 0 102 LMAX( 3 ) = 0 103 NINFO = 0 104 KNT = 0 105 RMAX = ZERO 106 VMAX = ZERO 107 SFMIN = SLAMCH( 'S' ) 108 MEPS = SLAMCH( 'E' ) 109* 110 10 CONTINUE 111* 112 READ( NIN, FMT = * )N 113 IF( N.EQ.0 ) 114 $ GO TO 70 115 DO 20 I = 1, N 116 READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 117 20 CONTINUE 118* 119 READ( NIN, FMT = * )ILOIN, IHIIN 120 DO 30 I = 1, N 121 READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 122 30 CONTINUE 123 READ( NIN, FMT = * )( SCALIN( I ), I = 1, N ) 124* 125 ANORM = CLANGE( 'M', N, N, A, LDA, DUMMY ) 126 KNT = KNT + 1 127 CALL CGEBAL( 'B', N, A, LDA, ILO, IHI, SCALE, INFO ) 128* 129 IF( INFO.NE.0 ) THEN 130 NINFO = NINFO + 1 131 LMAX( 1 ) = KNT 132 END IF 133* 134 IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN 135 NINFO = NINFO + 1 136 LMAX( 2 ) = KNT 137 END IF 138* 139 DO 50 I = 1, N 140 DO 40 J = 1, N 141 TEMP = MAX( CABS1( A( I, J ) ), CABS1( AIN( I, J ) ) ) 142 TEMP = MAX( TEMP, SFMIN ) 143 VMAX = MAX( VMAX, CABS1( A( I, J )-AIN( I, J ) ) / TEMP ) 144 40 CONTINUE 145 50 CONTINUE 146* 147 DO 60 I = 1, N 148 TEMP = MAX( SCALE( I ), SCALIN( I ) ) 149 TEMP = MAX( TEMP, SFMIN ) 150 VMAX = MAX( VMAX, ABS( SCALE( I )-SCALIN( I ) ) / TEMP ) 151 60 CONTINUE 152* 153 IF( VMAX.GT.RMAX ) THEN 154 LMAX( 3 ) = KNT 155 RMAX = VMAX 156 END IF 157* 158 GO TO 10 159* 160 70 CONTINUE 161* 162 WRITE( NOUT, FMT = 9999 ) 163 9999 FORMAT( 1X, '.. test output of CGEBAL .. ' ) 164* 165 WRITE( NOUT, FMT = 9998 )RMAX 166 9998 FORMAT( 1X, 'value of largest test error = ', E12.3 ) 167 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 168 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) 169 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 170 9996 FORMAT( 1X, 'example number where ILO or IHI wrong = ', I4 ) 171 WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 172 9995 FORMAT( 1X, 'example number having largest error = ', I4 ) 173 WRITE( NOUT, FMT = 9994 )NINFO 174 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) 175 WRITE( NOUT, FMT = 9993 )KNT 176 9993 FORMAT( 1X, 'total number of examples tested = ', I4 ) 177* 178 RETURN 179* 180* End of CCHKBL 181* 182 END 183