LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cerrec.f
Go to the documentation of this file.
00001 *> \brief \b CERREC
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 CERREC( 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 *> CERREC tests the error exits for the routines for eigen- condition
00025 *> estimation for REAL matrices:
00026 *>    CTRSYL, CTREXC, CTRSNA and CTRSEN.
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 complex_eig
00055 *
00056 *  =====================================================================
00057       SUBROUTINE CERREC( 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, LW
00073       PARAMETER          ( NMAX = 4, LW = NMAX*( NMAX+2 ) )
00074       REAL               ONE, ZERO
00075       PARAMETER          ( ONE = 1.0E0, ZERO = 0.0E0 )
00076 *     ..
00077 *     .. Local Scalars ..
00078       INTEGER            I, IFST, ILST, INFO, J, M, NT
00079       REAL               SCALE
00080 *     ..
00081 *     .. Local Arrays ..
00082       LOGICAL            SEL( NMAX )
00083       REAL               RW( LW ), S( NMAX ), SEP( NMAX )
00084       COMPLEX            A( NMAX, NMAX ), B( NMAX, NMAX ),
00085      $                   C( NMAX, NMAX ), WORK( LW ), X( NMAX )
00086 *     ..
00087 *     .. External Subroutines ..
00088       EXTERNAL           CHKXER, CTREXC, CTRSEN, CTRSNA, CTRSYL
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 CTRSYL
00119 *
00120       SRNAMT = 'CTRSYL'
00121       INFOT = 1
00122       CALL CTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00123       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00124       INFOT = 2
00125       CALL CTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00126       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00127       INFOT = 3
00128       CALL CTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00129       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00130       INFOT = 4
00131       CALL CTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00132       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00133       INFOT = 5
00134       CALL CTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO )
00135       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00136       INFOT = 7
00137       CALL CTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO )
00138       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00139       INFOT = 9
00140       CALL CTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO )
00141       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00142       INFOT = 11
00143       CALL CTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO )
00144       CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK )
00145       NT = NT + 8
00146 *
00147 *     Test CTREXC
00148 *
00149       SRNAMT = 'CTREXC'
00150       IFST = 1
00151       ILST = 1
00152       INFOT = 1
00153       CALL CTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, INFO )
00154       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00155       INFOT = 7
00156       CALL CTREXC( 'N', 0, A, 1, B, 1, IFST, ILST, INFO )
00157       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00158       INFOT = 4
00159       ILST = 2
00160       CALL CTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, INFO )
00161       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00162       INFOT = 6
00163       CALL CTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, INFO )
00164       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00165       INFOT = 7
00166       IFST = 0
00167       ILST = 1
00168       CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00169       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00170       INFOT = 7
00171       IFST = 2
00172       CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00173       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00174       INFOT = 8
00175       IFST = 1
00176       ILST = 0
00177       CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00178       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00179       INFOT = 8
00180       ILST = 2
00181       CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00182       CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK )
00183       NT = NT + 8
00184 *
00185 *     Test CTRSNA
00186 *
00187       SRNAMT = 'CTRSNA'
00188       INFOT = 1
00189       CALL CTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00190      $             WORK, 1, RW, INFO )
00191       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00192       INFOT = 2
00193       CALL CTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00194      $             WORK, 1, RW, INFO )
00195       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00196       INFOT = 4
00197       CALL CTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
00198      $             WORK, 1, RW, INFO )
00199       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00200       INFOT = 6
00201       CALL CTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
00202      $             WORK, 2, RW, INFO )
00203       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00204       INFOT = 8
00205       CALL CTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
00206      $             WORK, 2, RW, INFO )
00207       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00208       INFOT = 10
00209       CALL CTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
00210      $             WORK, 2, RW, INFO )
00211       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00212       INFOT = 13
00213       CALL CTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
00214      $             WORK, 1, RW, INFO )
00215       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00216       INFOT = 13
00217       CALL CTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
00218      $             WORK, 1, RW, INFO )
00219       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00220       INFOT = 16
00221       CALL CTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
00222      $             WORK, 1, RW, INFO )
00223       CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK )
00224       NT = NT + 9
00225 *
00226 *     Test CTRSEN
00227 *
00228       SEL( 1 ) = .FALSE.
00229       SRNAMT = 'CTRSEN'
00230       INFOT = 1
00231       CALL CTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
00232      $             WORK, 1, INFO )
00233       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00234       INFOT = 2
00235       CALL CTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
00236      $             WORK, 1, INFO )
00237       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00238       INFOT = 4
00239       CALL CTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, X, M, S( 1 ),
00240      $             SEP( 1 ), WORK, 1, INFO )
00241       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00242       INFOT = 6
00243       CALL CTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
00244      $             WORK, 2, INFO )
00245       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00246       INFOT = 8
00247       CALL CTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ),
00248      $             WORK, 1, INFO )
00249       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00250       INFOT = 14
00251       CALL CTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ),
00252      $             WORK, 0, INFO )
00253       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00254       INFOT = 14
00255       CALL CTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
00256      $             WORK, 1, INFO )
00257       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00258       INFOT = 14
00259       CALL CTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
00260      $             WORK, 3, INFO )
00261       CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK )
00262       NT = NT + 8
00263 *
00264 *     Print a summary line.
00265 *
00266       IF( OK ) THEN
00267          WRITE( NOUT, FMT = 9999 )PATH, NT
00268       ELSE
00269          WRITE( NOUT, FMT = 9998 )PATH
00270       END IF
00271 *
00272  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
00273      $      I3, ' tests done)' )
00274  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
00275      $      'exits ***' )
00276       RETURN
00277 *
00278 *     End of CERREC
00279 *
00280       END
 All Files Functions