LAPACK: TESTING/EIG/cerrhs.f Source File

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