LAPACK: TESTING/EIG/serred.f Source File

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