LAPACK: TESTING/EIG/zerrec.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZERREC( 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 *  ZERREC tests the error exits for the routines for eigen- condition
00016 *  estimation for DOUBLE PRECISION matrices:
00017 *     ZTRSYL, CTREXC, CTRSNA and CTRSEN.
00018 *
00019 *  Arguments
00020 *  =========
00021 *
00022 *  PATH    (input) CHARACTER*3
00023 *          The LAPACK path name for the routines to be tested.
00024 *
00025 *  NUNIT   (input) INTEGER
00026 *          The unit number for output.
00027 *
00028 *  =====================================================================
00029 *
00030 *     .. Parameters ..
00031       INTEGER            NMAX, LW
00032       PARAMETER          ( NMAX = 4, LW = NMAX*( NMAX+2 ) )
00033       DOUBLE PRECISION   ONE, ZERO
00034       PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
00035 *     ..
00036 *     .. Local Scalars ..
00037       INTEGER            I, IFST, ILST, INFO, J, M, NT
00038       DOUBLE PRECISION   SCALE
00039 *     ..
00040 *     .. Local Arrays ..
00041       LOGICAL            SEL( NMAX )
00042       DOUBLE PRECISION   RW( LW ), S( NMAX ), SEP( NMAX )
00043       COMPLEX*16         A( NMAX, NMAX ), B( NMAX, NMAX ),
00044      $                   C( NMAX, NMAX ), WORK( LW ), X( NMAX )
00045 *     ..
00046 *     .. External Subroutines ..
00047       EXTERNAL           CHKXER, ZTREXC, ZTRSEN, ZTRSNA, ZTRSYL
00048 *     ..
00049 *     .. Scalars in Common ..
00050       LOGICAL            LERR, OK
00051       CHARACTER*32       SRNAMT
00052       INTEGER            INFOT, NOUT
00053 *     ..
00054 *     .. Common blocks ..
00055       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00056       COMMON             / SRNAMC / SRNAMT
00057 *     ..
00058 *     .. Executable Statements ..
00059 *
00060       NOUT = NUNIT
00061       OK = .TRUE.
00062       NT = 0
00063 *
00064 *     Initialize A, B and SEL
00065 *
00066       DO 20 J = 1, NMAX
00067          DO 10 I = 1, NMAX
00068             A( I, J ) = ZERO
00069             B( I, J ) = ZERO
00070    10    CONTINUE
00071    20 CONTINUE
00072       DO 30 I = 1, NMAX
00073          A( I, I ) = ONE
00074          SEL( I ) = .TRUE.
00075    30 CONTINUE
00076 *
00077 *     Test ZTRSYL
00078 *
00079       SRNAMT = 'ZTRSYL'
00080       INFOT = 1
00081       CALL ZTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00082       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00083       INFOT = 2
00084       CALL ZTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00085       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00086       INFOT = 3
00087       CALL ZTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00088       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00089       INFOT = 4
00090       CALL ZTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00091       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00092       INFOT = 5
00093       CALL ZTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO )
00094       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00095       INFOT = 7
00096       CALL ZTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO )
00097       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00098       INFOT = 9
00099       CALL ZTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO )
00100       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00101       INFOT = 11
00102       CALL ZTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO )
00103       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
00104       NT = NT + 8
00105 *
00106 *     Test ZTREXC
00107 *
00108       SRNAMT = 'ZTREXC'
00109       IFST = 1
00110       ILST = 1
00111       INFOT = 1
00112       CALL ZTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, INFO )
00113       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00114       INFOT = 7
00115       CALL ZTREXC( 'N', 0, A, 1, B, 1, IFST, ILST, INFO )
00116       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00117       INFOT = 4
00118       ILST = 2
00119       CALL ZTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, INFO )
00120       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00121       INFOT = 6
00122       CALL ZTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, INFO )
00123       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00124       INFOT = 7
00125       IFST = 0
00126       ILST = 1
00127       CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00128       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00129       INFOT = 7
00130       IFST = 2
00131       CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00132       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00133       INFOT = 8
00134       IFST = 1
00135       ILST = 0
00136       CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00137       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00138       INFOT = 8
00139       ILST = 2
00140       CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO )
00141       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
00142       NT = NT + 8
00143 *
00144 *     Test ZTRSNA
00145 *
00146       SRNAMT = 'ZTRSNA'
00147       INFOT = 1
00148       CALL ZTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00149      $             WORK, 1, RW, INFO )
00150       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00151       INFOT = 2
00152       CALL ZTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00153      $             WORK, 1, RW, INFO )
00154       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00155       INFOT = 4
00156       CALL ZTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
00157      $             WORK, 1, RW, INFO )
00158       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00159       INFOT = 6
00160       CALL ZTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
00161      $             WORK, 2, RW, INFO )
00162       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00163       INFOT = 8
00164       CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
00165      $             WORK, 2, RW, INFO )
00166       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00167       INFOT = 10
00168       CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
00169      $             WORK, 2, RW, INFO )
00170       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00171       INFOT = 13
00172       CALL ZTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
00173      $             WORK, 1, RW, INFO )
00174       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00175       INFOT = 13
00176       CALL ZTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
00177      $             WORK, 1, RW, INFO )
00178       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00179       INFOT = 16
00180       CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
00181      $             WORK, 1, RW, INFO )
00182       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
00183       NT = NT + 9
00184 *
00185 *     Test ZTRSEN
00186 *
00187       SEL( 1 ) = .FALSE.
00188       SRNAMT = 'ZTRSEN'
00189       INFOT = 1
00190       CALL ZTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
00191      $             WORK, 1, INFO )
00192       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00193       INFOT = 2
00194       CALL ZTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
00195      $             WORK, 1, INFO )
00196       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00197       INFOT = 4
00198       CALL ZTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, X, M, S( 1 ),
00199      $             SEP( 1 ), WORK, 1, INFO )
00200       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00201       INFOT = 6
00202       CALL ZTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
00203      $             WORK, 2, INFO )
00204       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00205       INFOT = 8
00206       CALL ZTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ),
00207      $             WORK, 1, INFO )
00208       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00209       INFOT = 14
00210       CALL ZTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ),
00211      $             WORK, 0, INFO )
00212       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00213       INFOT = 14
00214       CALL ZTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
00215      $             WORK, 1, INFO )
00216       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00217       INFOT = 14
00218       CALL ZTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
00219      $             WORK, 3, INFO )
00220       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
00221       NT = NT + 8
00222 *
00223 *     Print a summary line.
00224 *
00225       IF( OK ) THEN
00226          WRITE( NOUT, FMT = 9999 )PATH, NT
00227       ELSE
00228          WRITE( NOUT, FMT = 9998 )PATH
00229       END IF
00230 *
00231  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
00232      $      I3, ' tests done)' )
00233  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
00234      $      'exits ***' )
00235       RETURN
00236 *
00237 *     End of ZERREC
00238 *
00239       END