dc/dc6/serrtz_8f_source.html

00001       SUBROUTINE SERRTZ( 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 *  SERRTZ tests the error exits for STZRQF and STZRZF.
00016 *
00017 *  Arguments
00018 *  =========
00019 *
00020 *  PATH    (input) CHARACTER*3
00021 *          The LAPACK path name for the routines to be tested.
00022 *
00023 *  NUNIT   (input) INTEGER
00024 *          The unit number for output.
00025 *
00026 *  =====================================================================
00027 *
00028 *     .. Parameters ..
00029       INTEGER            NMAX
00030       PARAMETER          ( NMAX = 2 )
00031 *     ..
00032 *     .. Local Scalars ..
00033       CHARACTER*2        C2
00034       INTEGER            INFO
00035 *     ..
00036 *     .. Local Arrays ..
00037       REAL               A( NMAX, NMAX ), TAU( NMAX ), W( NMAX )
00038 *     ..
00039 *     .. External Functions ..
00040       LOGICAL            LSAMEN
00041       EXTERNAL           LSAMEN
00042 *     ..
00043 *     .. External Subroutines ..
00044       EXTERNAL           ALAESM, CHKXER, STZRQF, STZRZF
00045 *     ..
00046 *     .. Scalars in Common ..
00047       LOGICAL            LERR, OK
00048       CHARACTER*32       SRNAMT
00049       INTEGER            INFOT, NOUT
00050 *     ..
00051 *     .. Common blocks ..
00052       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00053       COMMON             / SRNAMC / SRNAMT
00054 *     ..
00055 *     .. Executable Statements ..
00056 *
00057       NOUT = NUNIT
00058       WRITE( NOUT, FMT = * )
00059       C2 = PATH( 2: 3 )
00060       A( 1, 1 ) = 1.E+0
00061       A( 1, 2 ) = 2.E+0
00062       A( 2, 2 ) = 3.E+0
00063       A( 2, 1 ) = 4.E+0
00064       W( 1 ) = 0.0E+0
00065       W( 2 ) = 0.0E+0
00066       OK = .TRUE.
00067 *
00068       IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
00069 *
00070 *        Test error exits for the trapezoidal routines.
00071 *
00072 *        STZRQF
00073 *
00074          SRNAMT = 'STZRQF'
00075          INFOT = 1
00076          CALL STZRQF( -1, 0, A, 1, TAU, INFO )
00077          CALL CHKXER( 'STZRQF', INFOT, NOUT, LERR, OK )
00078          INFOT = 2
00079          CALL STZRQF( 1, 0, A, 1, TAU, INFO )
00080          CALL CHKXER( 'STZRQF', INFOT, NOUT, LERR, OK )
00081          INFOT = 4
00082          CALL STZRQF( 2, 2, A, 1, TAU, INFO )
00083          CALL CHKXER( 'STZRQF', INFOT, NOUT, LERR, OK )
00084 *
00085 *        STZRZF
00086 *
00087          SRNAMT = 'STZRZF'
00088          INFOT = 1
00089          CALL STZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
00090          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
00091          INFOT = 2
00092          CALL STZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
00093          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
00094          INFOT = 4
00095          CALL STZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
00096          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
00097          INFOT = 7
00098          CALL STZRZF( 2, 2, A, 2, TAU, W, 1, INFO )
00099          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
00100       END IF
00101 *
00102 *     Print a summary line.
00103 *
00104       CALL ALAESM( PATH, OK, NOUT )
00105 *
00106       RETURN
00107 *
00108 *     End of SERRTZ
00109 *
00110       END