LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
schkgl.f
Go to the documentation of this file.
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
 All Files Functions