LAPACK: TESTING/EIG/zerrhs.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZERRHS( 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 *  ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR,
00016 *  ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC.
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*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   RW( NMAX ), S( NMAX )
00041       COMPLEX*16         A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
00042      $                   VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
00043      $                   X( NMAX )
00044 *     ..
00045 *     .. External Functions ..
00046       LOGICAL            LSAMEN
00047       EXTERNAL           LSAMEN
00048 *     ..
00049 *     .. External Subroutines ..
00050       EXTERNAL           CHKXER, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEIN, ZHSEQR,
00051      $                   ZTREVC, ZUNGHR, ZUNMHR
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          SEL( J ) = .TRUE.
00078    20 CONTINUE
00079       OK = .TRUE.
00080       NT = 0
00081 *
00082 *     Test error exits of the nonsymmetric eigenvalue routines.
00083 *
00084       IF( LSAMEN( 2, C2, 'HS' ) ) THEN
00085 *
00086 *        ZGEBAL
00087 *
00088          SRNAMT = 'ZGEBAL'
00089          INFOT = 1
00090          CALL ZGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO )
00091          CALL CHKXER( 'ZGEBAL', INFOT, NOUT, LERR, OK )
00092          INFOT = 2
00093          CALL ZGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO )
00094          CALL CHKXER( 'ZGEBAL', INFOT, NOUT, LERR, OK )
00095          INFOT = 4
00096          CALL ZGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO )
00097          CALL CHKXER( 'ZGEBAL', INFOT, NOUT, LERR, OK )
00098          NT = NT + 3
00099 *
00100 *        ZGEBAK
00101 *
00102          SRNAMT = 'ZGEBAK'
00103          INFOT = 1
00104          CALL ZGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO )
00105          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00106          INFOT = 2
00107          CALL ZGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO )
00108          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00109          INFOT = 3
00110          CALL ZGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO )
00111          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00112          INFOT = 4
00113          CALL ZGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO )
00114          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00115          INFOT = 4
00116          CALL ZGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO )
00117          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00118          INFOT = 5
00119          CALL ZGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO )
00120          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00121          INFOT = 5
00122          CALL ZGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO )
00123          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00124          INFOT = 7
00125          CALL ZGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO )
00126          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00127          INFOT = 9
00128          CALL ZGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO )
00129          CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK )
00130          NT = NT + 9
00131 *
00132 *        ZGEHRD
00133 *
00134          SRNAMT = 'ZGEHRD'
00135          INFOT = 1
00136          CALL ZGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO )
00137          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00138          INFOT = 2
00139          CALL ZGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO )
00140          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00141          INFOT = 2
00142          CALL ZGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO )
00143          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00144          INFOT = 3
00145          CALL ZGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO )
00146          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00147          INFOT = 3
00148          CALL ZGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO )
00149          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00150          INFOT = 5
00151          CALL ZGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO )
00152          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00153          INFOT = 8
00154          CALL ZGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO )
00155          CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK )
00156          NT = NT + 7
00157 *
00158 *        ZUNGHR
00159 *
00160          SRNAMT = 'ZUNGHR'
00161          INFOT = 1
00162          CALL ZUNGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO )
00163          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00164          INFOT = 2
00165          CALL ZUNGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO )
00166          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00167          INFOT = 2
00168          CALL ZUNGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO )
00169          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00170          INFOT = 3
00171          CALL ZUNGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO )
00172          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00173          INFOT = 3
00174          CALL ZUNGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO )
00175          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00176          INFOT = 5
00177          CALL ZUNGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO )
00178          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00179          INFOT = 8
00180          CALL ZUNGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO )
00181          CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK )
00182          NT = NT + 7
00183 *
00184 *        ZUNMHR
00185 *
00186          SRNAMT = 'ZUNMHR'
00187          INFOT = 1
00188          CALL ZUNMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
00189      $                INFO )
00190          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00191          INFOT = 2
00192          CALL ZUNMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
00193      $                INFO )
00194          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00195          INFOT = 3
00196          CALL ZUNMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
00197      $                INFO )
00198          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00199          INFOT = 4
00200          CALL ZUNMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1,
00201      $                INFO )
00202          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00203          INFOT = 5
00204          CALL ZUNMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1,
00205      $                INFO )
00206          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00207          INFOT = 5
00208          CALL ZUNMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1,
00209      $                INFO )
00210          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00211          INFOT = 5
00212          CALL ZUNMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2,
00213      $                INFO )
00214          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00215          INFOT = 5
00216          CALL ZUNMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2,
00217      $                INFO )
00218          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00219          INFOT = 6
00220          CALL ZUNMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1,
00221      $                INFO )
00222          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00223          INFOT = 6
00224          CALL ZUNMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1,
00225      $                INFO )
00226          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00227          INFOT = 6
00228          CALL ZUNMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1,
00229      $                INFO )
00230          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00231          INFOT = 8
00232          CALL ZUNMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
00233      $                INFO )
00234          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00235          INFOT = 8
00236          CALL ZUNMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
00237      $                INFO )
00238          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00239          INFOT = 11
00240          CALL ZUNMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1,
00241      $                INFO )
00242          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00243          INFOT = 13
00244          CALL ZUNMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
00245      $                INFO )
00246          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00247          INFOT = 13
00248          CALL ZUNMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
00249      $                INFO )
00250          CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK )
00251          NT = NT + 16
00252 *
00253 *        ZHSEQR
00254 *
00255          SRNAMT = 'ZHSEQR'
00256          INFOT = 1
00257          CALL ZHSEQR( '/', 'N', 0, 1, 0, A, 1, X, C, 1, W, 1, INFO )
00258          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00259          INFOT = 2
00260          CALL ZHSEQR( 'E', '/', 0, 1, 0, A, 1, X, C, 1, W, 1, INFO )
00261          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00262          INFOT = 3
00263          CALL ZHSEQR( 'E', 'N', -1, 1, 0, A, 1, X, C, 1, W, 1, INFO )
00264          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00265          INFOT = 4
00266          CALL ZHSEQR( 'E', 'N', 0, 0, 0, A, 1, X, C, 1, W, 1, INFO )
00267          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00268          INFOT = 4
00269          CALL ZHSEQR( 'E', 'N', 0, 2, 0, A, 1, X, C, 1, W, 1, INFO )
00270          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00271          INFOT = 5
00272          CALL ZHSEQR( 'E', 'N', 1, 1, 0, A, 1, X, C, 1, W, 1, INFO )
00273          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00274          INFOT = 5
00275          CALL ZHSEQR( 'E', 'N', 1, 1, 2, A, 1, X, C, 1, W, 1, INFO )
00276          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00277          INFOT = 7
00278          CALL ZHSEQR( 'E', 'N', 2, 1, 2, A, 1, X, C, 2, W, 1, INFO )
00279          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00280          INFOT = 10
00281          CALL ZHSEQR( 'E', 'V', 2, 1, 2, A, 2, X, C, 1, W, 1, INFO )
00282          CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK )
00283          NT = NT + 9
00284 *
00285 *        ZHSEIN
00286 *
00287          SRNAMT = 'ZHSEIN'
00288          INFOT = 1
00289          CALL ZHSEIN( '/', 'N', 'N', SEL, 0, A, 1, X, VL, 1, VR, 1, 0,
00290      $                M, W, RW, IFAILL, IFAILR, INFO )
00291          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00292          INFOT = 2
00293          CALL ZHSEIN( 'R', '/', 'N', SEL, 0, A, 1, X, VL, 1, VR, 1, 0,
00294      $                M, W, RW, IFAILL, IFAILR, INFO )
00295          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00296          INFOT = 3
00297          CALL ZHSEIN( 'R', 'N', '/', SEL, 0, A, 1, X, VL, 1, VR, 1, 0,
00298      $                M, W, RW, IFAILL, IFAILR, INFO )
00299          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00300          INFOT = 5
00301          CALL ZHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, X, VL, 1, VR, 1, 0,
00302      $                M, W, RW, IFAILL, IFAILR, INFO )
00303          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00304          INFOT = 7
00305          CALL ZHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, X, VL, 1, VR, 2, 4,
00306      $                M, W, RW, IFAILL, IFAILR, INFO )
00307          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00308          INFOT = 10
00309          CALL ZHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 1, 4,
00310      $                M, W, RW, IFAILL, IFAILR, INFO )
00311          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00312          INFOT = 12
00313          CALL ZHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 1, 4,
00314      $                M, W, RW, IFAILL, IFAILR, INFO )
00315          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00316          INFOT = 13
00317          CALL ZHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 2, 1,
00318      $                M, W, RW, IFAILL, IFAILR, INFO )
00319          CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK )
00320          NT = NT + 8
00321 *
00322 *        ZTREVC
00323 *
00324          SRNAMT = 'ZTREVC'
00325          INFOT = 1
00326          CALL ZTREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, RW,
00327      $                INFO )
00328          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00329          INFOT = 2
00330          CALL ZTREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, RW,
00331      $                INFO )
00332          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00333          INFOT = 4
00334          CALL ZTREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W,
00335      $                RW, INFO )
00336          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00337          INFOT = 6
00338          CALL ZTREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W, RW,
00339      $                INFO )
00340          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00341          INFOT = 8
00342          CALL ZTREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, RW,
00343      $                INFO )
00344          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00345          INFOT = 10
00346          CALL ZTREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, RW,
00347      $                INFO )
00348          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00349          INFOT = 11
00350          CALL ZTREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W, RW,
00351      $                INFO )
00352          CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK )
00353          NT = NT + 7
00354       END IF
00355 *
00356 *     Print a summary line.
00357 *
00358       IF( OK ) THEN
00359          WRITE( NOUT, FMT = 9999 )PATH, NT
00360       ELSE
00361          WRITE( NOUT, FMT = 9998 )PATH
00362       END IF
00363 *
00364  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
00365      $      ' (', I3, ' tests done)' )
00366  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
00367      $      'exits ***' )
00368 *
00369       RETURN
00370 *
00371 *     End of ZERRHS
00372 *
00373       END