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