LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrtz.f
Go to the documentation of this file.
1 *> \brief \b CERRTZ
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE CERRTZ( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> CERRTZ tests the error exits for CTZRQF and CTZRZF.
25 *> \endverbatim
26 *
27 * Arguments:
28 * ==========
29 *
30 *> \param[in] PATH
31 *> \verbatim
32 *> PATH is CHARACTER*3
33 *> The LAPACK path name for the routines to be tested.
34 *> \endverbatim
35 *>
36 *> \param[in] NUNIT
37 *> \verbatim
38 *> NUNIT is INTEGER
39 *> The unit number for output.
40 *> \endverbatim
41 *
42 * Authors:
43 * ========
44 *
45 *> \author Univ. of Tennessee
46 *> \author Univ. of California Berkeley
47 *> \author Univ. of Colorado Denver
48 *> \author NAG Ltd.
49 *
50 *> \date November 2011
51 *
52 *> \ingroup complex_lin
53 *
54 * =====================================================================
55  SUBROUTINE cerrtz( PATH, NUNIT )
56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  CHARACTER*3 path
64  INTEGER nunit
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  INTEGER nmax
71  parameter( nmax = 2 )
72 * ..
73 * .. Local Scalars ..
74  CHARACTER*2 c2
75  INTEGER info
76 * ..
77 * .. Local Arrays ..
78  COMPLEX a( nmax, nmax ), tau( nmax ), w( nmax )
79 * ..
80 * .. External Functions ..
81  LOGICAL lsamen
82  EXTERNAL lsamen
83 * ..
84 * .. External Subroutines ..
85  EXTERNAL alaesm, chkxer, ctzrqf, ctzrzf
86 * ..
87 * .. Scalars in Common ..
88  LOGICAL lerr, ok
89  CHARACTER*32 srnamt
90  INTEGER infot, nout
91 * ..
92 * .. Common blocks ..
93  common / infoc / infot, nout, ok, lerr
94  common / srnamc / srnamt
95 * ..
96 * .. Intrinsic Functions ..
97  INTRINSIC cmplx
98 * ..
99 * .. Executable Statements ..
100 *
101  nout = nunit
102  c2 = path( 2: 3 )
103  a( 1, 1 ) = cmplx( 1.e+0, -1.e+0 )
104  a( 1, 2 ) = cmplx( 2.e+0, -2.e+0 )
105  a( 2, 2 ) = cmplx( 3.e+0, -3.e+0 )
106  a( 2, 1 ) = cmplx( 4.e+0, -4.e+0 )
107  w( 1 ) = cmplx( 0.e+0, 0.e+0 )
108  w( 2 ) = cmplx( 0.e+0, 0.e+0 )
109  ok = .true.
110 *
111 * Test error exits for the trapezoidal routines.
112 *
113  WRITE( nout, fmt = * )
114  IF( lsamen( 2, c2, 'TZ' ) ) THEN
115 *
116 * CTZRQF
117 *
118  srnamt = 'CTZRQF'
119  infot = 1
120  CALL ctzrqf( -1, 0, a, 1, tau, info )
121  CALL chkxer( 'CTZRQF', infot, nout, lerr, ok )
122  infot = 2
123  CALL ctzrqf( 1, 0, a, 1, tau, info )
124  CALL chkxer( 'CTZRQF', infot, nout, lerr, ok )
125  infot = 4
126  CALL ctzrqf( 2, 2, a, 1, tau, info )
127  CALL chkxer( 'CTZRQF', infot, nout, lerr, ok )
128 *
129 * CTZRZF
130 *
131  srnamt = 'CTZRZF'
132  infot = 1
133  CALL ctzrzf( -1, 0, a, 1, tau, w, 1, info )
134  CALL chkxer( 'CTZRZF', infot, nout, lerr, ok )
135  infot = 2
136  CALL ctzrzf( 1, 0, a, 1, tau, w, 1, info )
137  CALL chkxer( 'CTZRZF', infot, nout, lerr, ok )
138  infot = 4
139  CALL ctzrzf( 2, 2, a, 1, tau, w, 1, info )
140  CALL chkxer( 'CTZRZF', infot, nout, lerr, ok )
141  infot = 7
142  CALL ctzrzf( 2, 2, a, 2, tau, w, 0, info )
143  CALL chkxer( 'CTZRZF', infot, nout, lerr, ok )
144  infot = 7
145  CALL ctzrzf( 2, 3, a, 2, tau, w, 1, info )
146  CALL chkxer( 'CTZRZF', infot, nout, lerr, ok )
147  END IF
148 *
149 * Print a summary line.
150 *
151  CALL alaesm( path, ok, nout )
152 *
153  return
154 *
155 * End of CERRTZ
156 *
157  END