LAPACK: TESTING/EIG/derred.f Source File

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