LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cerred.f
Go to the documentation of this file.
00001 *> \brief \b CERRED
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 CERRED( PATH, NUNIT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       CHARACTER*3        PATH
00015 *       INTEGER            NUNIT
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> CERRED tests the error exits for the eigenvalue driver routines for
00025 *> REAL matrices:
00026 *>
00027 *> PATH  driver   description
00028 *> ----  ------   -----------
00029 *> CEV   CGEEV    find eigenvalues/eigenvectors for nonsymmetric A
00030 *> CES   CGEES    find eigenvalues/Schur form for nonsymmetric A
00031 *> CVX   CGEEVX   CGEEV + balancing and condition estimation
00032 *> CSX   CGEESX   CGEES + balancing and condition estimation
00033 *> CBD   CGESVD   compute SVD of an M-by-N matrix A
00034 *>       CGESDD   compute SVD of an M-by-N matrix A(by divide and
00035 *>                conquer)
00036 *> \endverbatim
00037 *
00038 *  Arguments:
00039 *  ==========
00040 *
00041 *> \param[in] PATH
00042 *> \verbatim
00043 *>          PATH is CHARACTER*3
00044 *>          The LAPACK path name for the routines to be tested.
00045 *> \endverbatim
00046 *>
00047 *> \param[in] NUNIT
00048 *> \verbatim
00049 *>          NUNIT is INTEGER
00050 *>          The unit number for output.
00051 *> \endverbatim
00052 *
00053 *  Authors:
00054 *  ========
00055 *
00056 *> \author Univ. of Tennessee 
00057 *> \author Univ. of California Berkeley 
00058 *> \author Univ. of Colorado Denver 
00059 *> \author NAG Ltd. 
00060 *
00061 *> \date November 2011
00062 *
00063 *> \ingroup complex_eig
00064 *
00065 *  =====================================================================
00066       SUBROUTINE CERRED( PATH, NUNIT )
00067 *
00068 *  -- LAPACK test routine (version 3.4.0) --
00069 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00070 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00071 *     November 2011
00072 *
00073 *     .. Scalar Arguments ..
00074       CHARACTER*3        PATH
00075       INTEGER            NUNIT
00076 *     ..
00077 *
00078 *  =====================================================================
00079 *
00080 *     .. Parameters ..
00081       INTEGER            NMAX, LW
00082       PARAMETER          ( NMAX = 4, LW = 5*NMAX )
00083       REAL               ONE, ZERO
00084       PARAMETER          ( ONE = 1.0E0, ZERO = 0.0E0 )
00085 *     ..
00086 *     .. Local Scalars ..
00087       CHARACTER*2        C2
00088       INTEGER            I, IHI, ILO, INFO, J, NT, SDIM
00089       REAL               ABNRM
00090 *     ..
00091 *     .. Local Arrays ..
00092       LOGICAL            B( NMAX )
00093       INTEGER            IW( 4*NMAX )
00094       REAL               R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
00095       COMPLEX            A( NMAX, NMAX ), U( NMAX, NMAX ),
00096      $                   VL( NMAX, NMAX ), VR( NMAX, NMAX ),
00097      $                   VT( NMAX, NMAX ), W( 4*NMAX ), X( NMAX )
00098 *     ..
00099 *     .. External Subroutines ..
00100       EXTERNAL           CGEES, CGEESX, CGEEV, CGEEVX, CGESDD, CGESVD,
00101      $                   CHKXER
00102 *     ..
00103 *     .. External Functions ..
00104       LOGICAL            CSLECT, LSAMEN
00105       EXTERNAL           CSLECT, LSAMEN
00106 *     ..
00107 *     .. Intrinsic Functions ..
00108       INTRINSIC          LEN_TRIM
00109 *     ..
00110 *     .. Arrays in Common ..
00111       LOGICAL            SELVAL( 20 )
00112       REAL               SELWI( 20 ), SELWR( 20 )
00113 *     ..
00114 *     .. Scalars in Common ..
00115       LOGICAL            LERR, OK
00116       CHARACTER*32       SRNAMT
00117       INTEGER            INFOT, NOUT, SELDIM, SELOPT
00118 *     ..
00119 *     .. Common blocks ..
00120       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00121       COMMON             / SRNAMC / SRNAMT
00122       COMMON             / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
00123 *     ..
00124 *     .. Executable Statements ..
00125 *
00126       NOUT = NUNIT
00127       WRITE( NOUT, FMT = * )
00128       C2 = PATH( 2: 3 )
00129 *
00130 *     Initialize A
00131 *
00132       DO 20 J = 1, NMAX
00133          DO 10 I = 1, NMAX
00134             A( I, J ) = ZERO
00135    10    CONTINUE
00136    20 CONTINUE
00137       DO 30 I = 1, NMAX
00138          A( I, I ) = ONE
00139    30 CONTINUE
00140       OK = .TRUE.
00141       NT = 0
00142 *
00143       IF( LSAMEN( 2, C2, 'EV' ) ) THEN
00144 *
00145 *        Test CGEEV
00146 *
00147          SRNAMT = 'CGEEV '
00148          INFOT = 1
00149          CALL CGEEV( 'X', 'N', 0, A, 1, X, VL, 1, VR, 1, W, 1, RW,
00150      $               INFO )
00151          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00152          INFOT = 2
00153          CALL CGEEV( 'N', 'X', 0, A, 1, X, VL, 1, VR, 1, W, 1, RW,
00154      $               INFO )
00155          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00156          INFOT = 3
00157          CALL CGEEV( 'N', 'N', -1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
00158      $               INFO )
00159          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00160          INFOT = 5
00161          CALL CGEEV( 'N', 'N', 2, A, 1, X, VL, 1, VR, 1, W, 4, RW,
00162      $               INFO )
00163          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00164          INFOT = 8
00165          CALL CGEEV( 'V', 'N', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
00166      $               INFO )
00167          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00168          INFOT = 10
00169          CALL CGEEV( 'N', 'V', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
00170      $               INFO )
00171          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00172          INFOT = 12
00173          CALL CGEEV( 'V', 'V', 1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
00174      $               INFO )
00175          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
00176          NT = NT + 7
00177 *
00178       ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN
00179 *
00180 *        Test CGEES
00181 *
00182          SRNAMT = 'CGEES '
00183          INFOT = 1
00184          CALL CGEES( 'X', 'N', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
00185      $               RW, B, INFO )
00186          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
00187          INFOT = 2
00188          CALL CGEES( 'N', 'X', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
00189      $               RW, B, INFO )
00190          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
00191          INFOT = 4
00192          CALL CGEES( 'N', 'S', CSLECT, -1, A, 1, SDIM, X, VL, 1, W, 1,
00193      $               RW, B, INFO )
00194          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
00195          INFOT = 6
00196          CALL CGEES( 'N', 'S', CSLECT, 2, A, 1, SDIM, X, VL, 1, W, 4,
00197      $               RW, B, INFO )
00198          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
00199          INFOT = 10
00200          CALL CGEES( 'V', 'S', CSLECT, 2, A, 2, SDIM, X, VL, 1, W, 4,
00201      $               RW, B, INFO )
00202          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
00203          INFOT = 12
00204          CALL CGEES( 'N', 'S', CSLECT, 1, A, 1, SDIM, X, VL, 1, W, 1,
00205      $               RW, B, INFO )
00206          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
00207          NT = NT + 6
00208 *
00209       ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN
00210 *
00211 *        Test CGEEVX
00212 *
00213          SRNAMT = 'CGEEVX'
00214          INFOT = 1
00215          CALL CGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO,
00216      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
00217          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00218          INFOT = 2
00219          CALL CGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO,
00220      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
00221          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00222          INFOT = 3
00223          CALL CGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO,
00224      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
00225          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00226          INFOT = 4
00227          CALL CGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, X, VL, 1, VR, 1, ILO,
00228      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
00229          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00230          INFOT = 5
00231          CALL CGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, X, VL, 1, VR, 1,
00232      $                ILO, IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
00233          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00234          INFOT = 7
00235          CALL CGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, X, VL, 1, VR, 1, ILO,
00236      $                IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
00237          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00238          INFOT = 10
00239          CALL CGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, X, VL, 1, VR, 1, ILO,
00240      $                IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
00241          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00242          INFOT = 12
00243          CALL CGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, X, VL, 1, VR, 1, ILO,
00244      $                IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
00245          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00246          INFOT = 20
00247          CALL CGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, X, VL, 1, VR, 1, ILO,
00248      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
00249          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00250          INFOT = 20
00251          CALL CGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, X, VL, 1, VR, 1, ILO,
00252      $                IHI, S, ABNRM, R1, R2, W, 2, RW, INFO )
00253          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
00254          NT = NT + 10
00255 *
00256       ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN
00257 *
00258 *        Test CGEESX
00259 *
00260          SRNAMT = 'CGEESX'
00261          INFOT = 1
00262          CALL CGEESX( 'X', 'N', CSLECT, 'N', 0, A, 1, SDIM, X, VL, 1,
00263      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
00264          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00265          INFOT = 2
00266          CALL CGEESX( 'N', 'X', CSLECT, 'N', 0, A, 1, SDIM, X, VL, 1,
00267      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
00268          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00269          INFOT = 4
00270          CALL CGEESX( 'N', 'N', CSLECT, 'X', 0, A, 1, SDIM, X, VL, 1,
00271      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
00272          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00273          INFOT = 5
00274          CALL CGEESX( 'N', 'N', CSLECT, 'N', -1, A, 1, SDIM, X, VL, 1,
00275      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
00276          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00277          INFOT = 7
00278          CALL CGEESX( 'N', 'N', CSLECT, 'N', 2, A, 1, SDIM, X, VL, 1,
00279      $                R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
00280          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00281          INFOT = 11
00282          CALL CGEESX( 'V', 'N', CSLECT, 'N', 2, A, 2, SDIM, X, VL, 1,
00283      $                R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
00284          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00285          INFOT = 15
00286          CALL CGEESX( 'N', 'N', CSLECT, 'N', 1, A, 1, SDIM, X, VL, 1,
00287      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
00288          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
00289          NT = NT + 7
00290 *
00291       ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN
00292 *
00293 *        Test CGESVD
00294 *
00295          SRNAMT = 'CGESVD'
00296          INFOT = 1
00297          CALL CGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
00298      $                INFO )
00299          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00300          INFOT = 2
00301          CALL CGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
00302      $                INFO )
00303          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00304          INFOT = 2
00305          CALL CGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
00306      $                INFO )
00307          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00308          INFOT = 3
00309          CALL CGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
00310      $                INFO )
00311          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00312          INFOT = 4
00313          CALL CGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, RW,
00314      $                INFO )
00315          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00316          INFOT = 6
00317          CALL CGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW,
00318      $                INFO )
00319          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00320          INFOT = 9
00321          CALL CGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW,
00322      $                INFO )
00323          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00324          INFOT = 11
00325          CALL CGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW,
00326      $                INFO )
00327          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
00328          NT = NT + 8
00329          IF( OK ) THEN
00330             WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
00331      $           NT
00332          ELSE
00333             WRITE( NOUT, FMT = 9998 )
00334          END IF
00335 *
00336 *        Test CGESDD
00337 *
00338          SRNAMT = 'CGESDD'
00339          INFOT = 1
00340          CALL CGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
00341      $                INFO )
00342          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
00343          INFOT = 2
00344          CALL CGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
00345      $                INFO )
00346          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
00347          INFOT = 3
00348          CALL CGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
00349      $                INFO )
00350          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
00351          INFOT = 5
00352          CALL CGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
00353      $                INFO )
00354          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
00355          INFOT = 8
00356          CALL CGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW, IW,
00357      $                INFO )
00358          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
00359          INFOT = 10
00360          CALL CGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
00361      $                INFO )
00362          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
00363          NT = NT - 2
00364          IF( OK ) THEN
00365             WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
00366      $           NT
00367          ELSE
00368             WRITE( NOUT, FMT = 9998 )
00369          END IF
00370       END IF
00371 *
00372 *     Print a summary line.
00373 *
00374       IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN
00375          IF( OK ) THEN
00376             WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
00377      $           NT
00378          ELSE
00379             WRITE( NOUT, FMT = 9998 )
00380          END IF
00381       END IF
00382 *
00383  9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3,
00384      $      ' tests done)' )
00385  9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' )
00386       RETURN
00387 *
00388 *     End of CERRED
00389 *
00390       END
 All Files Functions