|
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 146 147 148 149 150 151 152 |
SUBROUTINE ZCHKGL( 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 * ======= * * ZCHKGL tests ZGGBAL, a routine for balancing a matrix pair (A, B). * * 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, LDB, LWORK PARAMETER ( LDA = 20, LDB = 20, LWORK = 6*LDA ) DOUBLE PRECISION ZERO PARAMETER ( ZERO = 0.0D+0 ) * .. * .. Local Scalars .. INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, $ NINFO DOUBLE PRECISION ANORM, BNORM, EPS, RMAX, VMAX * .. * .. Local Arrays .. INTEGER LMAX( 3 ) DOUBLE PRECISION LSCALE( LDA ), LSCLIN( LDA ), RSCALE( LDA ), $ RSCLIN( LDA ), WORK( LWORK ) COMPLEX*16 A( LDA, LDA ), AIN( LDA, LDA ), B( LDB, LDB ), $ BIN( LDB, LDB ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, ZLANGE EXTERNAL DLAMCH, ZLANGE * .. * .. External Subroutines .. EXTERNAL ZGGBAL * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. * .. Executable Statements .. * LMAX( 1 ) = 0 LMAX( 2 ) = 0 LMAX( 3 ) = 0 NINFO = 0 KNT = 0 RMAX = ZERO * EPS = DLAMCH( 'Precision' ) * 10 CONTINUE * READ( NIN, FMT = * )N IF( N.EQ.0 ) $ GO TO 90 DO 20 I = 1, N READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 20 CONTINUE * DO 30 I = 1, N READ( NIN, FMT = * )( B( I, J ), J = 1, N ) 30 CONTINUE * READ( NIN, FMT = * )ILOIN, IHIIN DO 40 I = 1, N READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 40 CONTINUE DO 50 I = 1, N READ( NIN, FMT = * )( BIN( I, J ), J = 1, N ) 50 CONTINUE * READ( NIN, FMT = * )( LSCLIN( I ), I = 1, N ) READ( NIN, FMT = * )( RSCLIN( I ), I = 1, N ) * ANORM = ZLANGE( 'M', N, N, A, LDA, WORK ) BNORM = ZLANGE( 'M', N, N, B, LDB, WORK ) * KNT = KNT + 1 * CALL ZGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, $ WORK, 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 * VMAX = ZERO DO 70 I = 1, N DO 60 J = 1, N VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) ) VMAX = MAX( VMAX, ABS( B( I, J )-BIN( I, J ) ) ) 60 CONTINUE 70 CONTINUE * DO 80 I = 1, N VMAX = MAX( VMAX, ABS( LSCALE( I )-LSCLIN( I ) ) ) VMAX = MAX( VMAX, ABS( RSCALE( I )-RSCLIN( I ) ) ) 80 CONTINUE * VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) ) * IF( VMAX.GT.RMAX ) THEN LMAX( 3 ) = KNT RMAX = VMAX END IF * GO TO 10 * 90 CONTINUE * WRITE( NOUT, FMT = 9999 ) 9999 FORMAT( ' .. test output of ZGGBAL .. ' ) * WRITE( NOUT, FMT = 9998 )RMAX 9998 FORMAT( ' ratio of largest test error = ', D12.3 ) WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 9997 FORMAT( ' example number where info is not zero = ', I4 ) WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 9996 FORMAT( ' example number where ILO or IHI is wrong = ', I4 ) WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 9995 FORMAT( ' example number having largest error = ', I4 ) WRITE( NOUT, FMT = 9994 )NINFO 9994 FORMAT( ' number of examples where info is not 0 = ', I4 ) WRITE( NOUT, FMT = 9993 )KNT 9993 FORMAT( ' total number of examples tested = ', I4 ) * RETURN * * End of ZCHKGL * END |