LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cchkgl.f
Go to the documentation of this file.
00001 *> \brief \b CCHKGL
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 CCHKGL( NIN, NOUT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            NIN, NOUT
00015 *       ..
00016 *  
00017 *
00018 *> \par Purpose:
00019 *  =============
00020 *>
00021 *> \verbatim
00022 *>
00023 *> CCHKGL tests CGGBAL, 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 complex_eig
00052 *
00053 *  =====================================================================
00054       SUBROUTINE CCHKGL( 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( 3 )
00080       REAL               LSCALE( LDA ), LSCLIN( LDA ), RSCALE( LDA ),
00081      $                   RSCLIN( LDA ), WORK( LWORK )
00082       COMPLEX            A( LDA, LDA ), AIN( LDA, LDA ), B( LDB, LDB ),
00083      $                   BIN( LDB, LDB )
00084 *     ..
00085 *     .. External Functions ..
00086       REAL               CLANGE, SLAMCH
00087       EXTERNAL           CLANGE, SLAMCH
00088 *     ..
00089 *     .. External Subroutines ..
00090       EXTERNAL           CGGBAL
00091 *     ..
00092 *     .. Intrinsic Functions ..
00093       INTRINSIC          ABS, MAX
00094 *     ..
00095 *     .. Executable Statements ..
00096 *
00097       LMAX( 1 ) = 0
00098       LMAX( 2 ) = 0
00099       LMAX( 3 ) = 0
00100       NINFO = 0
00101       KNT = 0
00102       RMAX = ZERO
00103 *
00104       EPS = SLAMCH( 'Precision' )
00105 *
00106    10 CONTINUE
00107 *
00108       READ( NIN, FMT = * )N
00109       IF( N.EQ.0 )
00110      $   GO TO 90
00111       DO 20 I = 1, N
00112          READ( NIN, FMT = * )( A( I, J ), J = 1, N )
00113    20 CONTINUE
00114 *
00115       DO 30 I = 1, N
00116          READ( NIN, FMT = * )( B( I, J ), J = 1, N )
00117    30 CONTINUE
00118 *
00119       READ( NIN, FMT = * )ILOIN, IHIIN
00120       DO 40 I = 1, N
00121          READ( NIN, FMT = * )( AIN( I, J ), J = 1, N )
00122    40 CONTINUE
00123       DO 50 I = 1, N
00124          READ( NIN, FMT = * )( BIN( I, J ), J = 1, N )
00125    50 CONTINUE
00126 *
00127       READ( NIN, FMT = * )( LSCLIN( I ), I = 1, N )
00128       READ( NIN, FMT = * )( RSCLIN( I ), I = 1, N )
00129 *
00130       ANORM = CLANGE( 'M', N, N, A, LDA, WORK )
00131       BNORM = CLANGE( 'M', N, N, B, LDB, WORK )
00132 *
00133       KNT = KNT + 1
00134 *
00135       CALL CGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
00136      $             WORK, INFO )
00137 *
00138       IF( INFO.NE.0 ) THEN
00139          NINFO = NINFO + 1
00140          LMAX( 1 ) = KNT
00141       END IF
00142 *
00143       IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN
00144          NINFO = NINFO + 1
00145          LMAX( 2 ) = KNT
00146       END IF
00147 *
00148       VMAX = ZERO
00149       DO 70 I = 1, N
00150          DO 60 J = 1, N
00151             VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) )
00152             VMAX = MAX( VMAX, ABS( B( I, J )-BIN( I, J ) ) )
00153    60    CONTINUE
00154    70 CONTINUE
00155 *
00156       DO 80 I = 1, N
00157          VMAX = MAX( VMAX, ABS( LSCALE( I )-LSCLIN( I ) ) )
00158          VMAX = MAX( VMAX, ABS( RSCALE( I )-RSCLIN( I ) ) )
00159    80 CONTINUE
00160 *
00161       VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
00162 *
00163       IF( VMAX.GT.RMAX ) THEN
00164          LMAX( 3 ) = KNT
00165          RMAX = VMAX
00166       END IF
00167 *
00168       GO TO 10
00169 *
00170    90 CONTINUE
00171 *
00172       WRITE( NOUT, FMT = 9999 )
00173  9999 FORMAT( ' .. test output of CGGBAL .. ' )
00174 *
00175       WRITE( NOUT, FMT = 9998 )RMAX
00176  9998 FORMAT( ' ratio of largest test error              = ', E12.3 )
00177       WRITE( NOUT, FMT = 9997 )LMAX( 1 )
00178  9997 FORMAT( ' example number where info is not zero    = ', I4 )
00179       WRITE( NOUT, FMT = 9996 )LMAX( 2 )
00180  9996 FORMAT( ' example number where ILO or IHI is wrong = ', I4 )
00181       WRITE( NOUT, FMT = 9995 )LMAX( 3 )
00182  9995 FORMAT( ' example number having largest error      = ', I4 )
00183       WRITE( NOUT, FMT = 9994 )NINFO
00184  9994 FORMAT( ' number of examples where info is not 0   = ', I4 )
00185       WRITE( NOUT, FMT = 9993 )KNT
00186  9993 FORMAT( ' total number of examples tested          = ', I4 )
00187 *
00188       RETURN
00189 *
00190 *     End of CCHKGL
00191 *
00192       END
 All Files Functions