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