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*> \date November 2011 51* 52*> \ingroup complex_eig 53* 54* ===================================================================== 55 SUBROUTINE CCHKBL( NIN, NOUT ) 56* 57* -- LAPACK test routine (version 3.4.0) -- 58* -- LAPACK is a software package provided by Univ. of Tennessee, -- 59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 60* November 2011 61* 62* .. Scalar Arguments .. 63 INTEGER NIN, NOUT 64* .. 65* 66* ====================================================================== 67* 68* .. Parameters .. 69 INTEGER LDA 70 PARAMETER ( LDA = 20 ) 71 REAL ZERO 72 PARAMETER ( ZERO = 0.0E+0 ) 73* .. 74* .. Local Scalars .. 75 INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, 76 $ NINFO 77 REAL ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX 78 COMPLEX CDUM 79* .. 80* .. Local Arrays .. 81 INTEGER LMAX( 3 ) 82 REAL DUMMY( 1 ), SCALE( LDA ), SCALIN( LDA ) 83 COMPLEX A( LDA, LDA ), AIN( LDA, LDA ) 84* .. 85* .. External Functions .. 86 REAL CLANGE, SLAMCH 87 EXTERNAL CLANGE, SLAMCH 88* .. 89* .. External Subroutines .. 90 EXTERNAL CGEBAL 91* .. 92* .. Intrinsic Functions .. 93 INTRINSIC ABS, AIMAG, MAX, REAL 94* .. 95* .. Statement Functions .. 96 REAL CABS1 97* .. 98* .. Statement Function definitions .. 99 CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) 100* .. 101* .. Executable Statements .. 102* 103 LMAX( 1 ) = 0 104 LMAX( 2 ) = 0 105 LMAX( 3 ) = 0 106 NINFO = 0 107 KNT = 0 108 RMAX = ZERO 109 VMAX = ZERO 110 SFMIN = SLAMCH( 'S' ) 111 MEPS = SLAMCH( 'E' ) 112* 113 10 CONTINUE 114* 115 READ( NIN, FMT = * )N 116 IF( N.EQ.0 ) 117 $ GO TO 70 118 DO 20 I = 1, N 119 READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 120 20 CONTINUE 121* 122 READ( NIN, FMT = * )ILOIN, IHIIN 123 DO 30 I = 1, N 124 READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 125 30 CONTINUE 126 READ( NIN, FMT = * )( SCALIN( I ), I = 1, N ) 127* 128 ANORM = CLANGE( 'M', N, N, A, LDA, DUMMY ) 129 KNT = KNT + 1 130 CALL CGEBAL( 'B', N, A, LDA, ILO, IHI, SCALE, INFO ) 131* 132 IF( INFO.NE.0 ) THEN 133 NINFO = NINFO + 1 134 LMAX( 1 ) = KNT 135 END IF 136* 137 IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN 138 NINFO = NINFO + 1 139 LMAX( 2 ) = KNT 140 END IF 141* 142 DO 50 I = 1, N 143 DO 40 J = 1, N 144 TEMP = MAX( CABS1( A( I, J ) ), CABS1( AIN( I, J ) ) ) 145 TEMP = MAX( TEMP, SFMIN ) 146 VMAX = MAX( VMAX, CABS1( A( I, J )-AIN( I, J ) ) / TEMP ) 147 40 CONTINUE 148 50 CONTINUE 149* 150 DO 60 I = 1, N 151 TEMP = MAX( SCALE( I ), SCALIN( I ) ) 152 TEMP = MAX( TEMP, SFMIN ) 153 VMAX = MAX( VMAX, ABS( SCALE( I )-SCALIN( I ) ) / TEMP ) 154 60 CONTINUE 155* 156 IF( VMAX.GT.RMAX ) THEN 157 LMAX( 3 ) = KNT 158 RMAX = VMAX 159 END IF 160* 161 GO TO 10 162* 163 70 CONTINUE 164* 165 WRITE( NOUT, FMT = 9999 ) 166 9999 FORMAT( 1X, '.. test output of CGEBAL .. ' ) 167* 168 WRITE( NOUT, FMT = 9998 )RMAX 169 9998 FORMAT( 1X, 'value of largest test error = ', E12.3 ) 170 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 171 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) 172 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 173 9996 FORMAT( 1X, 'example number where ILO or IHI wrong = ', I4 ) 174 WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 175 9995 FORMAT( 1X, 'example number having largest error = ', I4 ) 176 WRITE( NOUT, FMT = 9994 )NINFO 177 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) 178 WRITE( NOUT, FMT = 9993 )KNT 179 9993 FORMAT( 1X, 'total number of examples tested = ', I4 ) 180* 181 RETURN 182* 183* End of CCHKBL 184* 185 END 186