Home
Browse Files
  1       SUBROUTINE SERRTZ( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *  -- April 2011                                                      --
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  SERRTZ tests the error exits for STZRQF and STZRZF.
 16 *
 17 *  Arguments
 18 *  =========
 19 *
 20 *  PATH    (input) CHARACTER*3
 21 *          The LAPACK path name for the routines to be tested.
 22 *
 23 *  NUNIT   (input) INTEGER
 24 *          The unit number for output.
 25 *
 26 *  =====================================================================
 27 *
 28 *     .. Parameters ..
 29       INTEGER            NMAX
 30       PARAMETER          ( NMAX = 2 )
 31 *     ..
 32 *     .. Local Scalars ..
 33       CHARACTER*2        C2
 34       INTEGER            INFO
 35 *     ..
 36 *     .. Local Arrays ..
 37       REAL               A( NMAX, NMAX ), TAU( NMAX ), W( NMAX )
 38 *     ..
 39 *     .. External Functions ..
 40       LOGICAL            LSAMEN
 41       EXTERNAL           LSAMEN
 42 *     ..
 43 *     .. External Subroutines ..
 44       EXTERNAL           ALAESM, CHKXER, STZRQF, STZRZF
 45 *     ..
 46 *     .. Scalars in Common ..
 47       LOGICAL            LERR, OK
 48       CHARACTER*32       SRNAMT
 49       INTEGER            INFOT, NOUT
 50 *     ..
 51 *     .. Common blocks ..
 52       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 53       COMMON             / SRNAMC / SRNAMT
 54 *     ..
 55 *     .. Executable Statements ..
 56 *
 57       NOUT = NUNIT
 58       WRITE( NOUT, FMT = * )
 59       C2 = PATH( 2: 3 )
 60       A( 1, 1 ) = 1.E+0
 61       A( 1, 2 ) = 2.E+0
 62       A( 2, 2 ) = 3.E+0
 63       A( 2, 1 ) = 4.E+0
 64       W( 1 ) = 0.0E+0
 65       W( 2 ) = 0.0E+0
 66       OK = .TRUE.
 67 *
 68       IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
 69 *
 70 *        Test error exits for the trapezoidal routines.
 71 *
 72 *        STZRQF
 73 *
 74          SRNAMT = 'STZRQF'
 75          INFOT = 1
 76          CALL STZRQF( -1, 0, A, 1, TAU, INFO )
 77          CALL CHKXER( 'STZRQF', INFOT, NOUT, LERR, OK )
 78          INFOT = 2
 79          CALL STZRQF( 1, 0, A, 1, TAU, INFO )
 80          CALL CHKXER( 'STZRQF', INFOT, NOUT, LERR, OK )
 81          INFOT = 4
 82          CALL STZRQF( 2, 2, A, 1, TAU, INFO )
 83          CALL CHKXER( 'STZRQF', INFOT, NOUT, LERR, OK )
 84 *
 85 *        STZRZF
 86 *
 87          SRNAMT = 'STZRZF'
 88          INFOT = 1
 89          CALL STZRZF( -1, 0, A, 1, TAU, W, 1, INFO )
 90          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
 91          INFOT = 2
 92          CALL STZRZF( 1, 0, A, 1, TAU, W, 1, INFO )
 93          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
 94          INFOT = 4
 95          CALL STZRZF( 2, 2, A, 1, TAU, W, 1, INFO )
 96          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
 97          INFOT = 7
 98          CALL STZRZF( 2, 2, A, 2, TAU, W, 0, INFO )
 99          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
100          INFOT = 7
101          CALL STZRZF( 2, 3, A, 2, TAU, W, 1, INFO )
102          CALL CHKXER( 'STZRZF', INFOT, NOUT, LERR, OK )
103       END IF
104 *
105 *     Print a summary line.
106 *
107       CALL ALAESM( PATH, OK, NOUT )
108 *
109       RETURN
110 *
111 *     End of SERRTZ
112 *
113       END
Home