LAPACK: TESTING/EIG/cerred.f Source File

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