|
1
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 |
SUBROUTINE CCHKBL( 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 * ======= * * CCHKBL tests CGEBAL, a routine for balancing a general complex * matrix and isolating some of its eigenvalues. * * 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 LDA PARAMETER ( LDA = 20 ) REAL ZERO PARAMETER ( ZERO = 0.0E+0 ) * .. * .. Local Scalars .. INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, $ NINFO REAL ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX COMPLEX CDUM * .. * .. Local Arrays .. INTEGER LMAX( 3 ) REAL DUMMY( 1 ), SCALE( LDA ), SCALIN( LDA ) COMPLEX A( LDA, LDA ), AIN( LDA, LDA ) * .. * .. External Functions .. REAL CLANGE, SLAMCH EXTERNAL CLANGE, SLAMCH * .. * .. External Subroutines .. EXTERNAL CGEBAL * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL * .. * .. Statement Functions .. REAL CABS1 * .. * .. Statement Function definitions .. CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) * .. * .. Executable Statements .. * LMAX( 1 ) = 0 LMAX( 2 ) = 0 LMAX( 3 ) = 0 NINFO = 0 KNT = 0 RMAX = ZERO VMAX = ZERO SFMIN = SLAMCH( 'S' ) MEPS = SLAMCH( 'E' ) * 10 CONTINUE * READ( NIN, FMT = * )N IF( N.EQ.0 ) $ GO TO 70 DO 20 I = 1, N READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 20 CONTINUE * READ( NIN, FMT = * )ILOIN, IHIIN DO 30 I = 1, N READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 30 CONTINUE READ( NIN, FMT = * )( SCALIN( I ), I = 1, N ) * ANORM = CLANGE( 'M', N, N, A, LDA, DUMMY ) KNT = KNT + 1 CALL CGEBAL( 'B', N, A, LDA, ILO, IHI, SCALE, INFO ) * IF( INFO.NE.0 ) THEN NINFO = NINFO + 1 LMAX( 1 ) = KNT END IF * IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN NINFO = NINFO + 1 LMAX( 2 ) = KNT END IF * DO 50 I = 1, N DO 40 J = 1, N TEMP = MAX( CABS1( A( I, J ) ), CABS1( AIN( I, J ) ) ) TEMP = MAX( TEMP, SFMIN ) VMAX = MAX( VMAX, CABS1( A( I, J )-AIN( I, J ) ) / TEMP ) 40 CONTINUE 50 CONTINUE * DO 60 I = 1, N TEMP = MAX( SCALE( I ), SCALIN( I ) ) TEMP = MAX( TEMP, SFMIN ) VMAX = MAX( VMAX, ABS( SCALE( I )-SCALIN( I ) ) / TEMP ) 60 CONTINUE * IF( VMAX.GT.RMAX ) THEN LMAX( 3 ) = KNT RMAX = VMAX END IF * GO TO 10 * 70 CONTINUE * WRITE( NOUT, FMT = 9999 ) 9999 FORMAT( 1X, '.. test output of CGEBAL .. ' ) * 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 where ILO or IHI wrong = ', I4 ) WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 9995 FORMAT( 1X, 'example number having largest error = ', I4 ) WRITE( NOUT, FMT = 9994 )NINFO 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) WRITE( NOUT, FMT = 9993 )KNT 9993 FORMAT( 1X, 'total number of examples tested = ', I4 ) * RETURN * * End of CCHKBL * END |