LAPACK: TESTING/EIG/serrhs.f Source File

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