d7/d87/cerrtz_8f_source.html

00001       SUBROUTINE CERRTZ( 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 *  CERRTZ tests the error exits for CTZRQF and CTZRZF.
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       COMPLEX            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, CTZRQF, CTZRZF
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 *     .. Intrinsic Functions ..
00056       INTRINSIC          CMPLX
00057 *     ..
00058 *     .. Executable Statements ..
00059 *
00060       NOUT = NUNIT
00061       C2 = PATH( 2: 3 )
00062       A( 1, 1 ) = CMPLX( 1.E+0, -1.E+0 )
00063       A( 1, 2 ) = CMPLX( 2.E+0, -2.E+0 )
00064       A( 2, 2 ) = CMPLX( 3.E+0, -3.E+0 )
00065       A( 2, 1 ) = CMPLX( 4.E+0, -4.E+0 )
00066       W( 1 ) = CMPLX( 0.E+0, 0.E+0 )
00067       W( 2 ) = CMPLX( 0.E+0, 0.E+0 )
00068       OK = .TRUE.
00069 *
00070 *     Test error exits for the trapezoidal routines.
00071 *
00072       WRITE( NOUT, FMT = * )
00073       IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
00074 *
00075 *        CTZRQF
00076 *
00077          SRNAMT = 'CTZRQF'
00078          INFOT = 1
00079          CALL CTZRQF( -1, 0, A, 1, TAU, INFO )
00080          CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
00081          INFOT = 2
00082          CALL CTZRQF( 1, 0, A, 1, TAU, INFO )
00083          CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
00084          INFOT = 4
00085          CALL CTZRQF( 2, 2, A, 1, TAU, INFO )
00086          CALL CHKXER( 'CTZRQF', INFOT, NOUT, LERR, OK )
00087 *
00088 *        CTZRZF
00089 *
00090          SRNAMT = 'CTZRZF'
00091          INFOT = 1
00092          CALL CTZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
00093          CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
00094          INFOT = 2
00095          CALL CTZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
00096          CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
00097          INFOT = 4
00098          CALL CTZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
00099          CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
00100          INFOT = 7
00101          CALL CTZRZF( 2, 2, A, 2, TAU, W, 1, INFO )
00102          CALL CHKXER( 'CTZRZF', INFOT, NOUT, LERR, OK )
00103       END IF
00104 *
00105 *     Print a summary line.
00106 *
00107       CALL ALAESM( PATH, OK, NOUT )
00108 *
00109       RETURN
00110 *
00111 *     End of CERRTZ
00112 *
00113       END