LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
derrec.f
Go to the documentation of this file.
00001 *> \brief \b DERREC
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 DERREC( 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 *> DERREC tests the error exits for the routines for eigen- condition
00025 *> estimation for DOUBLE PRECISION matrices:
00026 *>    DTRSYL, STREXC, STRSNA and STRSEN.
00027 *> \endverbatim
00028 *
00029 *  Arguments:
00030 *  ==========
00031 *
00032 *> \param[in] PATH
00033 *> \verbatim
00034 *>          PATH is CHARACTER*3
00035 *>          The LAPACK path name for the routines to be tested.
00036 *> \endverbatim
00037 *>
00038 *> \param[in] NUNIT
00039 *> \verbatim
00040 *>          NUNIT is INTEGER
00041 *>          The unit number for output.
00042 *> \endverbatim
00043 *
00044 *  Authors:
00045 *  ========
00046 *
00047 *> \author Univ. of Tennessee 
00048 *> \author Univ. of California Berkeley 
00049 *> \author Univ. of Colorado Denver 
00050 *> \author NAG Ltd. 
00051 *
00052 *> \date November 2011
00053 *
00054 *> \ingroup double_eig
00055 *
00056 *  =====================================================================
00057       SUBROUTINE DERREC( PATH, NUNIT )
00058 *
00059 *  -- LAPACK test routine (version 3.4.0) --
00060 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00061 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00062 *     November 2011
00063 *
00064 *     .. Scalar Arguments ..
00065       CHARACTER*3        PATH
00066       INTEGER            NUNIT
00067 *     ..
00068 *
00069 *  =====================================================================
00070 *
00071 *     .. Parameters ..
00072       INTEGER            NMAX
00073       DOUBLE PRECISION   ONE, ZERO
00074       PARAMETER          ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 )
00075 *     ..
00076 *     .. Local Scalars ..
00077       INTEGER            I, IFST, ILST, INFO, J, M, NT
00078       DOUBLE PRECISION   SCALE
00079 *     ..
00080 *     .. Local Arrays ..
00081       LOGICAL            SEL( NMAX )
00082       INTEGER            IWORK( NMAX )
00083       DOUBLE PRECISION   A( NMAX, NMAX ), B( NMAX, NMAX ),
00084      $                   C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
00085      $                   WI( NMAX ), WORK( NMAX ), WR( NMAX )
00086 *     ..
00087 *     .. External Subroutines ..
00088       EXTERNAL           CHKXER, DTREXC, DTRSEN, DTRSNA, DTRSYL
00089 *     ..
00090 *     .. Scalars in Common ..
00091       LOGICAL            LERR, OK
00092       CHARACTER*32       SRNAMT
00093       INTEGER            INFOT, NOUT
00094 *     ..
00095 *     .. Common blocks ..
00096       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00097       COMMON             / SRNAMC / SRNAMT
00098 *     ..
00099 *     .. Executable Statements ..
00100 *
00101       NOUT = NUNIT
00102       OK = .TRUE.
00103       NT = 0
00104 *
00105 *     Initialize A, B and SEL
00106 *
00107       DO 20 J = 1, NMAX
00108          DO 10 I = 1, NMAX
00109             A( I, J ) = ZERO
00110             B( I, J ) = ZERO
00111    10    CONTINUE
00112    20 CONTINUE
00113       DO 30 I = 1, NMAX
00114          A( I, I ) = ONE
00115          SEL( I ) = .TRUE.
00116    30 CONTINUE
00117 *
00118 *     Test DTRSYL
00119 *
00120       SRNAMT = 'DTRSYL'
00121       INFOT = 1
00122       CALL DTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00123       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00124       INFOT = 2
00125       CALL DTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00126       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00127       INFOT = 3
00128       CALL DTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00129       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00130       INFOT = 4
00131       CALL DTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00132       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00133       INFOT = 5
00134       CALL DTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO )
00135       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00136       INFOT = 7
00137       CALL DTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO )
00138       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00139       INFOT = 9
00140       CALL DTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO )
00141       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00142       INFOT = 11
00143       CALL DTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO )
00144       CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
00145       NT = NT + 8
00146 *
00147 *     Test DTREXC
00148 *
00149       SRNAMT = 'DTREXC'
00150       IFST = 1
00151       ILST = 1
00152       INFOT = 1
00153       CALL DTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00154       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00155       INFOT = 7
00156       CALL DTREXC( 'N', 0, A, 1, B, 1, IFST, ILST, WORK, INFO )
00157       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00158       INFOT = 4
00159       ILST = 2
00160       CALL DTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, WORK, INFO )
00161       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00162       INFOT = 6
00163       CALL DTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, WORK, INFO )
00164       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00165       INFOT = 7
00166       IFST = 0
00167       ILST = 1
00168       CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00169       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00170       INFOT = 7
00171       IFST = 2
00172       CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00173       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00174       INFOT = 8
00175       IFST = 1
00176       ILST = 0
00177       CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00178       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00179       INFOT = 8
00180       ILST = 2
00181       CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00182       CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
00183       NT = NT + 8
00184 *
00185 *     Test DTRSNA
00186 *
00187       SRNAMT = 'DTRSNA'
00188       INFOT = 1
00189       CALL DTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00190      $             WORK, 1, IWORK, INFO )
00191       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00192       INFOT = 2
00193       CALL DTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00194      $             WORK, 1, IWORK, INFO )
00195       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00196       INFOT = 4
00197       CALL DTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
00198      $             WORK, 1, IWORK, INFO )
00199       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00200       INFOT = 6
00201       CALL DTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
00202      $             WORK, 2, IWORK, INFO )
00203       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00204       INFOT = 8
00205       CALL DTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
00206      $             WORK, 2, IWORK, INFO )
00207       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00208       INFOT = 10
00209       CALL DTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
00210      $             WORK, 2, IWORK, INFO )
00211       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00212       INFOT = 13
00213       CALL DTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
00214      $             WORK, 1, IWORK, INFO )
00215       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00216       INFOT = 13
00217       CALL DTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
00218      $             WORK, 2, IWORK, INFO )
00219       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00220       INFOT = 16
00221       CALL DTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
00222      $             WORK, 1, IWORK, INFO )
00223       CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
00224       NT = NT + 9
00225 *
00226 *     Test DTRSEN
00227 *
00228       SEL( 1 ) = .FALSE.
00229       SRNAMT = 'DTRSEN'
00230       INFOT = 1
00231       CALL DTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
00232      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00233       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00234       INFOT = 2
00235       CALL DTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
00236      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00237       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00238       INFOT = 4
00239       CALL DTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, WR, WI, M, S( 1 ),
00240      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00241       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00242       INFOT = 6
00243       CALL DTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, WR, WI, M, S( 1 ),
00244      $             SEP( 1 ), WORK, 2, IWORK, 1, INFO )
00245       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00246       INFOT = 8
00247       CALL DTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, WR, WI, M, S( 1 ),
00248      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00249       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00250       INFOT = 15
00251       CALL DTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
00252      $             SEP( 1 ), WORK, 0, IWORK, 1, INFO )
00253       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00254       INFOT = 15
00255       CALL DTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
00256      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00257       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00258       INFOT = 15
00259       CALL DTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
00260      $             SEP( 1 ), WORK, 3, IWORK, 2, INFO )
00261       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00262       INFOT = 17
00263       CALL DTRSEN( 'E', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
00264      $             SEP( 1 ), WORK, 1, IWORK, 0, INFO )
00265       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00266       INFOT = 17
00267       CALL DTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
00268      $             SEP( 1 ), WORK, 4, IWORK, 1, INFO )
00269       CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
00270       NT = NT + 10
00271 *
00272 *     Print a summary line.
00273 *
00274       IF( OK ) THEN
00275          WRITE( NOUT, FMT = 9999 )PATH, NT
00276       ELSE
00277          WRITE( NOUT, FMT = 9998 )PATH
00278       END IF
00279 *
00280       RETURN
00281  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
00282      $      I3, ' tests done)' )
00283  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ex',
00284      $      'its ***' )
00285 *
00286 *     End of DERREC
00287 *
00288       END
 All Files Functions