 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ZCHKGL( NIN, NOUT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 INTEGER NIN, NOUT 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * ZCHKGL tests ZGGBAL, a routine for balancing a matrix pair (A, B). 00015 * 00016 * Arguments 00017 * ========= 00018 * 00019 * NIN (input) INTEGER 00020 * The logical unit number for input. NIN > 0. 00021 * 00022 * NOUT (input) INTEGER 00023 * The logical unit number for output. NOUT > 0. 00024 * 00025 * ===================================================================== 00026 * 00027 * .. Parameters .. 00028 INTEGER LDA, LDB, LWORK 00029 PARAMETER ( LDA = 20, LDB = 20, LWORK = 6*LDA ) 00030 DOUBLE PRECISION ZERO 00031 PARAMETER ( ZERO = 0.0D+0 ) 00032 * .. 00033 * .. Local Scalars .. 00034 INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, 00035 $ NINFO 00036 DOUBLE PRECISION ANORM, BNORM, EPS, RMAX, VMAX 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER LMAX( 3 ) 00040 DOUBLE PRECISION LSCALE( LDA ), LSCLIN( LDA ), RSCALE( LDA ), 00041 $ RSCLIN( LDA ), WORK( LWORK ) 00042 COMPLEX*16 A( LDA, LDA ), AIN( LDA, LDA ), B( LDB, LDB ), 00043 $ BIN( LDB, LDB ) 00044 * .. 00045 * .. External Functions .. 00046 DOUBLE PRECISION DLAMCH, ZLANGE 00047 EXTERNAL DLAMCH, ZLANGE 00048 * .. 00049 * .. External Subroutines .. 00050 EXTERNAL ZGGBAL 00051 * .. 00052 * .. Intrinsic Functions .. 00053 INTRINSIC ABS, MAX 00054 * .. 00055 * .. Executable Statements .. 00056 * 00057 LMAX( 1 ) = 0 00058 LMAX( 2 ) = 0 00059 LMAX( 3 ) = 0 00060 NINFO = 0 00061 KNT = 0 00062 RMAX = ZERO 00063 * 00064 EPS = DLAMCH( 'Precision' ) 00065 * 00066 10 CONTINUE 00067 * 00068 READ( NIN, FMT = * )N 00069 IF( N.EQ.0 ) 00070 $ GO TO 90 00071 DO 20 I = 1, N 00072 READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 00073 20 CONTINUE 00074 * 00075 DO 30 I = 1, N 00076 READ( NIN, FMT = * )( B( I, J ), J = 1, N ) 00077 30 CONTINUE 00078 * 00079 READ( NIN, FMT = * )ILOIN, IHIIN 00080 DO 40 I = 1, N 00081 READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 00082 40 CONTINUE 00083 DO 50 I = 1, N 00084 READ( NIN, FMT = * )( BIN( I, J ), J = 1, N ) 00085 50 CONTINUE 00086 * 00087 READ( NIN, FMT = * )( LSCLIN( I ), I = 1, N ) 00088 READ( NIN, FMT = * )( RSCLIN( I ), I = 1, N ) 00089 * 00090 ANORM = ZLANGE( 'M', N, N, A, LDA, WORK ) 00091 BNORM = ZLANGE( 'M', N, N, B, LDB, WORK ) 00092 * 00093 KNT = KNT + 1 00094 * 00095 CALL ZGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, 00096 $ WORK, INFO ) 00097 * 00098 IF( INFO.NE.0 ) THEN 00099 NINFO = NINFO + 1 00100 LMAX( 1 ) = KNT 00101 END IF 00102 * 00103 IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN 00104 NINFO = NINFO + 1 00105 LMAX( 2 ) = KNT 00106 END IF 00107 * 00108 VMAX = ZERO 00109 DO 70 I = 1, N 00110 DO 60 J = 1, N 00111 VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) ) 00112 VMAX = MAX( VMAX, ABS( B( I, J )-BIN( I, J ) ) ) 00113 60 CONTINUE 00114 70 CONTINUE 00115 * 00116 DO 80 I = 1, N 00117 VMAX = MAX( VMAX, ABS( LSCALE( I )-LSCLIN( I ) ) ) 00118 VMAX = MAX( VMAX, ABS( RSCALE( I )-RSCLIN( I ) ) ) 00119 80 CONTINUE 00120 * 00121 VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) ) 00122 * 00123 IF( VMAX.GT.RMAX ) THEN 00124 LMAX( 3 ) = KNT 00125 RMAX = VMAX 00126 END IF 00127 * 00128 GO TO 10 00129 * 00130 90 CONTINUE 00131 * 00132 WRITE( NOUT, FMT = 9999 ) 00133 9999 FORMAT( ' .. test output of ZGGBAL .. ' ) 00134 * 00135 WRITE( NOUT, FMT = 9998 )RMAX 00136 9998 FORMAT( ' ratio of largest test error = ', D12.3 ) 00137 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 00138 9997 FORMAT( ' example number where info is not zero = ', I4 ) 00139 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 00140 9996 FORMAT( ' example number where ILO or IHI is wrong = ', I4 ) 00141 WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 00142 9995 FORMAT( ' example number having largest error = ', I4 ) 00143 WRITE( NOUT, FMT = 9994 )NINFO 00144 9994 FORMAT( ' number of examples where info is not 0 = ', I4 ) 00145 WRITE( NOUT, FMT = 9993 )KNT 00146 9993 FORMAT( ' total number of examples tested = ', I4 ) 00147 * 00148 RETURN 00149 * 00150 * End of ZCHKGL 00151 * 00152 END
1.7.3 
