LAPACK: TESTING/EIG/serrec.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SERREC( 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 *  SERREC tests the error exits for the routines for eigen- condition
00016 *  estimation for REAL matrices:
00017 *     STRSYL, STREXC, STRSNA and STRSEN.
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
00032       REAL               ONE, ZERO
00033       PARAMETER          ( NMAX = 4, ONE = 1.0E0, ZERO = 0.0E0 )
00034 *     ..
00035 *     .. Local Scalars ..
00036       INTEGER            I, IFST, ILST, INFO, J, M, NT
00037       REAL               SCALE
00038 *     ..
00039 *     .. Local Arrays ..
00040       LOGICAL            SEL( NMAX )
00041       INTEGER            IWORK( NMAX )
00042       REAL               A( NMAX, NMAX ), B( NMAX, NMAX ),
00043      $                   C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
00044      $                   WI( NMAX ), WORK( NMAX ), WR( NMAX )
00045 *     ..
00046 *     .. External Subroutines ..
00047       EXTERNAL           CHKXER, STREXC, STRSEN, STRSNA, STRSYL
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 STRSYL
00078 *
00079       SRNAMT = 'STRSYL'
00080       INFOT = 1
00081       CALL STRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00082       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00083       INFOT = 2
00084       CALL STRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00085       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00086       INFOT = 3
00087       CALL STRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00088       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00089       INFOT = 4
00090       CALL STRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO )
00091       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00092       INFOT = 5
00093       CALL STRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO )
00094       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00095       INFOT = 7
00096       CALL STRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO )
00097       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00098       INFOT = 9
00099       CALL STRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO )
00100       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00101       INFOT = 11
00102       CALL STRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO )
00103       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
00104       NT = NT + 8
00105 *
00106 *     Test STREXC
00107 *
00108       SRNAMT = 'STREXC'
00109       IFST = 1
00110       ILST = 1
00111       INFOT = 1
00112       CALL STREXC( 'X', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00113       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00114       INFOT = 7
00115       CALL STREXC( 'N', 0, A, 1, B, 1, IFST, ILST, WORK, INFO )
00116       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00117       INFOT = 4
00118       ILST = 2
00119       CALL STREXC( 'N', 2, A, 1, B, 1, IFST, ILST, WORK, INFO )
00120       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00121       INFOT = 6
00122       CALL STREXC( 'V', 2, A, 2, B, 1, IFST, ILST, WORK, INFO )
00123       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00124       INFOT = 7
00125       IFST = 0
00126       ILST = 1
00127       CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00128       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00129       INFOT = 7
00130       IFST = 2
00131       CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00132       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00133       INFOT = 8
00134       IFST = 1
00135       ILST = 0
00136       CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00137       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00138       INFOT = 8
00139       ILST = 2
00140       CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
00141       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
00142       NT = NT + 8
00143 *
00144 *     Test STRSNA
00145 *
00146       SRNAMT = 'STRSNA'
00147       INFOT = 1
00148       CALL STRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00149      $             WORK, 1, IWORK, INFO )
00150       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00151       INFOT = 2
00152       CALL STRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
00153      $             WORK, 1, IWORK, INFO )
00154       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00155       INFOT = 4
00156       CALL STRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
00157      $             WORK, 1, IWORK, INFO )
00158       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00159       INFOT = 6
00160       CALL STRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
00161      $             WORK, 2, IWORK, INFO )
00162       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00163       INFOT = 8
00164       CALL STRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
00165      $             WORK, 2, IWORK, INFO )
00166       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00167       INFOT = 10
00168       CALL STRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
00169      $             WORK, 2, IWORK, INFO )
00170       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00171       INFOT = 13
00172       CALL STRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
00173      $             WORK, 1, IWORK, INFO )
00174       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00175       INFOT = 13
00176       CALL STRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
00177      $             WORK, 2, IWORK, INFO )
00178       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00179       INFOT = 16
00180       CALL STRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
00181      $             WORK, 1, IWORK, INFO )
00182       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
00183       NT = NT + 9
00184 *
00185 *     Test STRSEN
00186 *
00187       SEL( 1 ) = .FALSE.
00188       SRNAMT = 'STRSEN'
00189       INFOT = 1
00190       CALL STRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
00191      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00192       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00193       INFOT = 2
00194       CALL STRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
00195      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00196       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00197       INFOT = 4
00198       CALL STRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, WR, WI, M, S( 1 ),
00199      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00200       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00201       INFOT = 6
00202       CALL STRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, WR, WI, M, S( 1 ),
00203      $             SEP( 1 ), WORK, 2, IWORK, 1, INFO )
00204       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00205       INFOT = 8
00206       CALL STRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, WR, WI, M, S( 1 ),
00207      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00208       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00209       INFOT = 15
00210       CALL STRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
00211      $             SEP( 1 ), WORK, 0, IWORK, 1, INFO )
00212       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00213       INFOT = 15
00214       CALL STRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
00215      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
00216       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00217       INFOT = 15
00218       CALL STRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
00219      $             SEP( 1 ), WORK, 3, IWORK, 2, INFO )
00220       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00221       INFOT = 17
00222       CALL STRSEN( 'E', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
00223      $             SEP( 1 ), WORK, 1, IWORK, 0, INFO )
00224       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00225       INFOT = 17
00226       CALL STRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
00227      $             SEP( 1 ), WORK, 4, IWORK, 1, INFO )
00228       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
00229       NT = NT + 10
00230 *
00231 *     Print a summary line.
00232 *
00233       IF( OK ) THEN
00234          WRITE( NOUT, FMT = 9999 )PATH, NT
00235       ELSE
00236          WRITE( NOUT, FMT = 9998 )PATH
00237       END IF
00238 *
00239       RETURN
00240  9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
00241      $      I3, ' tests done)' )
00242  9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ex',
00243      $      'its ***' )
00244 *
00245 *     End of SERREC
00246 *
00247       END