![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CCHKBL 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE CCHKBL( NIN, NOUT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NIN, NOUT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> CCHKBL tests CGEBAL, a routine for balancing a general complex 00024 *> matrix and isolating some of its eigenvalues. 00025 *> \endverbatim 00026 * 00027 * Arguments: 00028 * ========== 00029 * 00030 *> \param[in] NIN 00031 *> \verbatim 00032 *> NIN is INTEGER 00033 *> The logical unit number for input. NIN > 0. 00034 *> \endverbatim 00035 *> 00036 *> \param[in] NOUT 00037 *> \verbatim 00038 *> NOUT is INTEGER 00039 *> The logical unit number for output. NOUT > 0. 00040 *> \endverbatim 00041 * 00042 * Authors: 00043 * ======== 00044 * 00045 *> \author Univ. of Tennessee 00046 *> \author Univ. of California Berkeley 00047 *> \author Univ. of Colorado Denver 00048 *> \author NAG Ltd. 00049 * 00050 *> \date November 2011 00051 * 00052 *> \ingroup complex_eig 00053 * 00054 * ===================================================================== 00055 SUBROUTINE CCHKBL( NIN, NOUT ) 00056 * 00057 * -- LAPACK test routine (version 3.4.0) -- 00058 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00059 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00060 * November 2011 00061 * 00062 * .. Scalar Arguments .. 00063 INTEGER NIN, NOUT 00064 * .. 00065 * 00066 * ====================================================================== 00067 * 00068 * .. Parameters .. 00069 INTEGER LDA 00070 PARAMETER ( LDA = 20 ) 00071 REAL ZERO 00072 PARAMETER ( ZERO = 0.0E+0 ) 00073 * .. 00074 * .. Local Scalars .. 00075 INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N, 00076 $ NINFO 00077 REAL ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX 00078 COMPLEX CDUM 00079 * .. 00080 * .. Local Arrays .. 00081 INTEGER LMAX( 3 ) 00082 REAL DUMMY( 1 ), SCALE( LDA ), SCALIN( LDA ) 00083 COMPLEX A( LDA, LDA ), AIN( LDA, LDA ) 00084 * .. 00085 * .. External Functions .. 00086 REAL CLANGE, SLAMCH 00087 EXTERNAL CLANGE, SLAMCH 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL CGEBAL 00091 * .. 00092 * .. Intrinsic Functions .. 00093 INTRINSIC ABS, AIMAG, MAX, REAL 00094 * .. 00095 * .. Statement Functions .. 00096 REAL CABS1 00097 * .. 00098 * .. Statement Function definitions .. 00099 CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) 00100 * .. 00101 * .. Executable Statements .. 00102 * 00103 LMAX( 1 ) = 0 00104 LMAX( 2 ) = 0 00105 LMAX( 3 ) = 0 00106 NINFO = 0 00107 KNT = 0 00108 RMAX = ZERO 00109 VMAX = ZERO 00110 SFMIN = SLAMCH( 'S' ) 00111 MEPS = SLAMCH( 'E' ) 00112 * 00113 10 CONTINUE 00114 * 00115 READ( NIN, FMT = * )N 00116 IF( N.EQ.0 ) 00117 $ GO TO 70 00118 DO 20 I = 1, N 00119 READ( NIN, FMT = * )( A( I, J ), J = 1, N ) 00120 20 CONTINUE 00121 * 00122 READ( NIN, FMT = * )ILOIN, IHIIN 00123 DO 30 I = 1, N 00124 READ( NIN, FMT = * )( AIN( I, J ), J = 1, N ) 00125 30 CONTINUE 00126 READ( NIN, FMT = * )( SCALIN( I ), I = 1, N ) 00127 * 00128 ANORM = CLANGE( 'M', N, N, A, LDA, DUMMY ) 00129 KNT = KNT + 1 00130 CALL CGEBAL( 'B', N, A, LDA, ILO, IHI, SCALE, INFO ) 00131 * 00132 IF( INFO.NE.0 ) THEN 00133 NINFO = NINFO + 1 00134 LMAX( 1 ) = KNT 00135 END IF 00136 * 00137 IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN 00138 NINFO = NINFO + 1 00139 LMAX( 2 ) = KNT 00140 END IF 00141 * 00142 DO 50 I = 1, N 00143 DO 40 J = 1, N 00144 TEMP = MAX( CABS1( A( I, J ) ), CABS1( AIN( I, J ) ) ) 00145 TEMP = MAX( TEMP, SFMIN ) 00146 VMAX = MAX( VMAX, CABS1( A( I, J )-AIN( I, J ) ) / TEMP ) 00147 40 CONTINUE 00148 50 CONTINUE 00149 * 00150 DO 60 I = 1, N 00151 TEMP = MAX( SCALE( I ), SCALIN( I ) ) 00152 TEMP = MAX( TEMP, SFMIN ) 00153 VMAX = MAX( VMAX, ABS( SCALE( I )-SCALIN( I ) ) / TEMP ) 00154 60 CONTINUE 00155 * 00156 IF( VMAX.GT.RMAX ) THEN 00157 LMAX( 3 ) = KNT 00158 RMAX = VMAX 00159 END IF 00160 * 00161 GO TO 10 00162 * 00163 70 CONTINUE 00164 * 00165 WRITE( NOUT, FMT = 9999 ) 00166 9999 FORMAT( 1X, '.. test output of CGEBAL .. ' ) 00167 * 00168 WRITE( NOUT, FMT = 9998 )RMAX 00169 9998 FORMAT( 1X, 'value of largest test error = ', E12.3 ) 00170 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 00171 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) 00172 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 00173 9996 FORMAT( 1X, 'example number where ILO or IHI wrong = ', I4 ) 00174 WRITE( NOUT, FMT = 9995 )LMAX( 3 ) 00175 9995 FORMAT( 1X, 'example number having largest error = ', I4 ) 00176 WRITE( NOUT, FMT = 9994 )NINFO 00177 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) 00178 WRITE( NOUT, FMT = 9993 )KNT 00179 9993 FORMAT( 1X, 'total number of examples tested = ', I4 ) 00180 * 00181 RETURN 00182 * 00183 * End of CCHKBL 00184 * 00185 END