LAPACK: TESTING/EIG/derrhs.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DERRHS( 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 *  DERRHS tests the error exits for DGEBAK, SGEBAL, SGEHRD, DORGHR,
00016 *  DORMHR, DHSEQR, SHSEIN, and DTREVC.
00017 *
00018 *  Arguments
00019 *  =========
00020 *
00021 *  PATH    (input) CHARACTER*3
00022 *          The LAPACK path name for the routines to be tested.
00023 *
00024 *  NUNIT   (input) INTEGER
00025 *          The unit number for output.
00026 *
00027 *  =====================================================================
00028 *
00029 *     .. Parameters ..
00030       INTEGER            NMAX, LW
00031       PARAMETER          ( NMAX = 3, LW = ( NMAX+2 )*( NMAX+2 )+NMAX )
00032 *     ..
00033 *     .. Local Scalars ..
00034       CHARACTER*2        C2
00035       INTEGER            I, IHI, ILO, INFO, J, M, NT
00036 *     ..
00037 *     .. Local Arrays ..
00038       LOGICAL            SEL( NMAX )
00039       INTEGER            IFAILL( NMAX ), IFAILR( NMAX )
00040       DOUBLE PRECISION   A( NMAX, NMAX ), C( NMAX, NMAX ), S( NMAX ),
00041      $                   TAU( NMAX ), VL( NMAX, NMAX ),
00042      $                   VR( NMAX, NMAX ), W( LW ), WI( NMAX ),
00043      $                   WR( NMAX )
00044 *     ..
00045 *     .. External Functions ..
00046       LOGICAL            LSAMEN
00047       EXTERNAL           LSAMEN
00048 *     ..
00049 *     .. External Subroutines ..
00050       EXTERNAL           CHKXER, DGEBAK, DGEBAL, DGEHRD, DHSEIN, DHSEQR,
00051      $                   DORGHR, DORMHR, DTREVC
00052 *     ..
00053 *     .. Intrinsic Functions ..
00054       INTRINSIC          DBLE
00055 *     ..
00056 *     .. Scalars in Common ..
00057       LOGICAL            LERR, OK
00058       CHARACTER*32       SRNAMT
00059       INTEGER            INFOT, NOUT
00060 *     ..
00061 *     .. Common blocks ..
00062       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00063       COMMON             / SRNAMC / SRNAMT
00064 *     ..
00065 *     .. Executable Statements ..
00066 *
00067       NOUT = NUNIT
00068       WRITE( NOUT, FMT = * )
00069       C2 = PATH( 2: 3 )
00070 *
00071 *     Set the variables to innocuous values.
00072 *
00073       DO 20 J = 1, NMAX
00074          DO 10 I = 1, NMAX
00075             A( I, J ) = 1.D0 / DBLE( I+J )
00076    10    CONTINUE
00077          WI( J ) = DBLE( J )
00078          SEL( J ) = .TRUE.
00079    20 CONTINUE
00080       OK = .TRUE.
00081       NT = 0
00082 *
00083 *     Test error exits of the nonsymmetric eigenvalue routines.
00084 *
00085       IF( LSAMEN( 2, C2, 'HS' ) ) THEN
00086 *
00087 *        DGEBAL
00088 *
00089          SRNAMT = 'DGEBAL'
00090          INFOT = 1
00091          CALL DGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO )
00092          CALL CHKXER( 'DGEBAL', INFOT, NOUT, LERR, OK )
00093          INFOT = 2
00094          CALL DGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO )
00095          CALL CHKXER( 'DGEBAL', INFOT, NOUT, LERR, OK )
00096          INFOT = 4
00097          CALL DGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO )
00098          CALL CHKXER( 'DGEBAL', INFOT, NOUT, LERR, OK )
00099          NT = NT + 3
00100 *
00101 *        DGEBAK
00102 *
00103          SRNAMT = 'DGEBAK'
00104          INFOT = 1
00105          CALL DGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO )
00106          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00107          INFOT = 2
00108          CALL DGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO )
00109          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00110          INFOT = 3
00111          CALL DGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO )
00112          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00113          INFOT = 4
00114          CALL DGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO )
00115          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00116          INFOT = 4
00117          CALL DGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO )
00118          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00119          INFOT = 5
00120          CALL DGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO )
00121          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00122          INFOT = 5
00123          CALL DGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO )
00124          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00125          INFOT = 7
00126          CALL DGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO )
00127          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00128          INFOT = 9
00129          CALL DGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO )
00130          CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK )
00131          NT = NT + 9
00132 *
00133 *        DGEHRD
00134 *
00135          SRNAMT = 'DGEHRD'
00136          INFOT = 1
00137          CALL DGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO )
00138          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00139          INFOT = 2
00140          CALL DGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO )
00141          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00142          INFOT = 2
00143          CALL DGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO )
00144          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00145          INFOT = 3
00146          CALL DGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO )
00147          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00148          INFOT = 3
00149          CALL DGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO )
00150          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00151          INFOT = 5
00152          CALL DGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO )
00153          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00154          INFOT = 8
00155          CALL DGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO )
00156          CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK )
00157          NT = NT + 7
00158 *
00159 *        DORGHR
00160 *
00161          SRNAMT = 'DORGHR'
00162          INFOT = 1
00163          CALL DORGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO )
00164          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00165          INFOT = 2
00166          CALL DORGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO )
00167          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00168          INFOT = 2
00169          CALL DORGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO )
00170          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00171          INFOT = 3
00172          CALL DORGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO )
00173          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00174          INFOT = 3
00175          CALL DORGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO )
00176          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00177          INFOT = 5
00178          CALL DORGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO )
00179          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00180          INFOT = 8
00181          CALL DORGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO )
00182          CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK )
00183          NT = NT + 7
00184 *
00185 *        DORMHR
00186 *
00187          SRNAMT = 'DORMHR'
00188          INFOT = 1
00189          CALL DORMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
00190      $                INFO )
00191          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00192          INFOT = 2
00193          CALL DORMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
00194      $                INFO )
00195          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00196          INFOT = 3
00197          CALL DORMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
00198      $                INFO )
00199          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00200          INFOT = 4
00201          CALL DORMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1,
00202      $                INFO )
00203          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00204          INFOT = 5
00205          CALL DORMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1,
00206      $                INFO )
00207          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00208          INFOT = 5
00209          CALL DORMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1,
00210      $                INFO )
00211          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00212          INFOT = 5
00213          CALL DORMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2,
00214      $                INFO )
00215          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00216          INFOT = 5
00217          CALL DORMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2,
00218      $                INFO )
00219          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00220          INFOT = 6
00221          CALL DORMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1,
00222      $                INFO )
00223          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00224          INFOT = 6
00225          CALL DORMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1,
00226      $                INFO )
00227          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00228          INFOT = 6
00229          CALL DORMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1,
00230      $                INFO )
00231          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00232          INFOT = 8
00233          CALL DORMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
00234      $                INFO )
00235          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00236          INFOT = 8
00237          CALL DORMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
00238      $                INFO )
00239          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00240          INFOT = 11
00241          CALL DORMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1,
00242      $                INFO )
00243          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00244          INFOT = 13
00245          CALL DORMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
00246      $                INFO )
00247          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00248          INFOT = 13
00249          CALL DORMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
00250      $                INFO )
00251          CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK )
00252          NT = NT + 16
00253 *
00254 *        DHSEQR
00255 *
00256          SRNAMT = 'DHSEQR'
00257          INFOT = 1
00258          CALL DHSEQR( '/', 'N', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1,
00259      $                INFO )
00260          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00261          INFOT = 2
00262          CALL DHSEQR( 'E', '/', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1,
00263      $                INFO )
00264          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00265          INFOT = 3
00266          CALL DHSEQR( 'E', 'N', -1, 1, 0, A, 1, WR, WI, C, 1, W, 1,
00267      $                INFO )
00268          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00269          INFOT = 4
00270          CALL DHSEQR( 'E', 'N', 0, 0, 0, A, 1, WR, WI, C, 1, W, 1,
00271      $                INFO )
00272          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00273          INFOT = 4
00274          CALL DHSEQR( 'E', 'N', 0, 2, 0, A, 1, WR, WI, C, 1, W, 1,
00275      $                INFO )
00276          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00277          INFOT = 5
00278          CALL DHSEQR( 'E', 'N', 1, 1, 0, A, 1, WR, WI, C, 1, W, 1,
00279      $                INFO )
00280          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00281          INFOT = 5
00282          CALL DHSEQR( 'E', 'N', 1, 1, 2, A, 1, WR, WI, C, 1, W, 1,
00283      $                INFO )
00284          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00285          INFOT = 7
00286          CALL DHSEQR( 'E', 'N', 2, 1, 2, A, 1, WR, WI, C, 2, W, 1,
00287      $                INFO )
00288          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00289          INFOT = 11
00290          CALL DHSEQR( 'E', 'V', 2, 1, 2, A, 2, WR, WI, C, 1, W, 1,
00291      $                INFO )
00292          CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK )
00293          NT = NT + 9
00294 *
00295 *        DHSEIN
00296 *
00297          SRNAMT = 'DHSEIN'
00298          INFOT = 1
00299          CALL DHSEIN( '/', 'N', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
00300      $                0, M, W, IFAILL, IFAILR, INFO )
00301          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00302          INFOT = 2
00303          CALL DHSEIN( 'R', '/', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
00304      $                0, M, W, IFAILL, IFAILR, INFO )
00305          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00306          INFOT = 3
00307          CALL DHSEIN( 'R', 'N', '/', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
00308      $                0, M, W, IFAILL, IFAILR, INFO )
00309          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00310          INFOT = 5
00311          CALL DHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, WR, WI, VL, 1, VR,
00312      $                1, 0, M, W, IFAILL, IFAILR, INFO )
00313          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00314          INFOT = 7
00315          CALL DHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, WR, WI, VL, 1, VR, 2,
00316      $                4, M, W, IFAILL, IFAILR, INFO )
00317          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00318          INFOT = 11
00319          CALL DHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1,
00320      $                4, M, W, IFAILL, IFAILR, INFO )
00321          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00322          INFOT = 13
00323          CALL DHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1,
00324      $                4, M, W, IFAILL, IFAILR, INFO )
00325          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00326          INFOT = 14
00327          CALL DHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 2,
00328      $                1, M, W, IFAILL, IFAILR, INFO )
00329          CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK )
00330          NT = NT + 8
00331 *
00332 *        DTREVC
00333 *
00334          SRNAMT = 'DTREVC'
00335          INFOT = 1
00336          CALL DTREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W,
00337      $                INFO )
00338          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00339          INFOT = 2
00340          CALL DTREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W,
00341      $                INFO )
00342          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00343          INFOT = 4
00344          CALL DTREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W,
00345      $                INFO )
00346          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00347          INFOT = 6
00348          CALL DTREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W,
00349      $                INFO )
00350          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00351          INFOT = 8
00352          CALL DTREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W,
00353      $                INFO )
00354          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00355          INFOT = 10
00356          CALL DTREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W,
00357      $                INFO )
00358          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00359          INFOT = 11
00360          CALL DTREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W,
00361      $                INFO )
00362          CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK )
00363          NT = NT + 7
00364       END IF
00365 *
00366 *     Print a summary line.
00367 *
00368       IF( OK ) THEN
00369          WRITE( NOUT, FMT = 9999 )PATH, NT
00370       ELSE
00371          WRITE( NOUT, FMT = 9998 )PATH
00372       END IF
00373 *
00374  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
00375      $      ' (', I3, ' tests done)' )
00376  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
00377      $      'exits ***' )
00378 *
00379       RETURN
00380 *
00381 *     End of DERRHS
00382 *
00383       END