LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
cerrec.f
Go to the documentation of this file.
1 *> \brief \b CERREC
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 CERREC( 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 *> CERREC tests the error exits for the routines for eigen- condition
25 *> estimation for REAL matrices:
26 *> CTRSYL, CTREXC, CTRSNA and CTRSEN.
27 *> \endverbatim
28 *
29 * Arguments:
30 * ==========
31 *
32 *> \param[in] PATH
33 *> \verbatim
34 *> PATH is CHARACTER*3
35 *> The LAPACK path name for the routines to be tested.
36 *> \endverbatim
37 *>
38 *> \param[in] NUNIT
39 *> \verbatim
40 *> NUNIT is INTEGER
41 *> The unit number for output.
42 *> \endverbatim
43 *
44 * Authors:
45 * ========
46 *
47 *> \author Univ. of Tennessee
48 *> \author Univ. of California Berkeley
49 *> \author Univ. of Colorado Denver
50 *> \author NAG Ltd.
51 *
52 *> \date December 2016
53 *
54 *> \ingroup complex_eig
55 *
56 * =====================================================================
57  SUBROUTINE cerrec( PATH, NUNIT )
58 *
59 * -- LAPACK test routine (version 3.7.0) --
60 * -- LAPACK is a software package provided by Univ. of Tennessee, --
61 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
62 * December 2016
63 *
64 * .. Scalar Arguments ..
65  CHARACTER*3 PATH
66  INTEGER NUNIT
67 * ..
68 *
69 * =====================================================================
70 *
71 * .. Parameters ..
72  INTEGER NMAX, LW
73  parameter( nmax = 4, lw = nmax*( nmax+2 ) )
74  REAL ONE, ZERO
75  parameter( one = 1.0e0, zero = 0.0e0 )
76 * ..
77 * .. Local Scalars ..
78  INTEGER I, IFST, ILST, INFO, J, M, NT
79  REAL SCALE
80 * ..
81 * .. Local Arrays ..
82  LOGICAL SEL( NMAX )
83  REAL RW( LW ), S( NMAX ), SEP( NMAX )
84  COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ),
85  $ C( NMAX, NMAX ), WORK( LW ), X( NMAX )
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL chkxer, ctrexc, ctrsen, ctrsna, ctrsyl
89 * ..
90 * .. Scalars in Common ..
91  LOGICAL LERR, OK
92  CHARACTER*32 SRNAMT
93  INTEGER INFOT, NOUT
94 * ..
95 * .. Common blocks ..
96  COMMON / infoc / infot, nout, ok, lerr
97  COMMON / srnamc / srnamt
98 * ..
99 * .. Executable Statements ..
100 *
101  nout = nunit
102  ok = .true.
103  nt = 0
104 *
105 * Initialize A, B and SEL
106 *
107  DO 20 j = 1, nmax
108  DO 10 i = 1, nmax
109  a( i, j ) = zero
110  b( i, j ) = zero
111  10 CONTINUE
112  20 CONTINUE
113  DO 30 i = 1, nmax
114  a( i, i ) = one
115  sel( i ) = .true.
116  30 CONTINUE
117 *
118 * Test CTRSYL
119 *
120  srnamt = 'CTRSYL'
121  infot = 1
122  CALL ctrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
124  infot = 2
125  CALL ctrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
126  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
127  infot = 3
128  CALL ctrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
129  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
130  infot = 4
131  CALL ctrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
132  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
133  infot = 5
134  CALL ctrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
135  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
136  infot = 7
137  CALL ctrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
138  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
139  infot = 9
140  CALL ctrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
141  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
142  infot = 11
143  CALL ctrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
144  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
145  nt = nt + 8
146 *
147 * Test CTREXC
148 *
149  srnamt = 'CTREXC'
150  ifst = 1
151  ilst = 1
152  infot = 1
153  CALL ctrexc( 'X', 1, a, 1, b, 1, ifst, ilst, info )
154  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
155  infot = 2
156  CALL ctrexc( 'N', -1, a, 1, b, 1, ifst, ilst, info )
157  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
158  infot = 4
159  ilst = 2
160  CALL ctrexc( 'N', 2, a, 1, b, 1, ifst, ilst, info )
161  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
162  infot = 6
163  CALL ctrexc( 'V', 2, a, 2, b, 1, ifst, ilst, info )
164  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
165  infot = 7
166  ifst = 0
167  ilst = 1
168  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
169  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
170  infot = 7
171  ifst = 2
172  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
173  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
174  infot = 8
175  ifst = 1
176  ilst = 0
177  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
178  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
179  infot = 8
180  ilst = 2
181  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
182  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
183  nt = nt + 8
184 *
185 * Test CTRSNA
186 *
187  srnamt = 'CTRSNA'
188  infot = 1
189  CALL ctrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
190  $ work, 1, rw, info )
191  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
192  infot = 2
193  CALL ctrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
194  $ work, 1, rw, info )
195  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
196  infot = 4
197  CALL ctrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
198  $ work, 1, rw, info )
199  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
200  infot = 6
201  CALL ctrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
202  $ work, 2, rw, info )
203  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
204  infot = 8
205  CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
206  $ work, 2, rw, info )
207  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
208  infot = 10
209  CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
210  $ work, 2, rw, info )
211  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
212  infot = 13
213  CALL ctrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
214  $ work, 1, rw, info )
215  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
216  infot = 13
217  CALL ctrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
218  $ work, 1, rw, info )
219  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
220  infot = 16
221  CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
222  $ work, 1, rw, info )
223  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
224  nt = nt + 9
225 *
226 * Test CTRSEN
227 *
228  sel( 1 ) = .false.
229  srnamt = 'CTRSEN'
230  infot = 1
231  CALL ctrsen( 'X', 'N', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
232  $ work, 1, info )
233  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
234  infot = 2
235  CALL ctrsen( 'N', 'X', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
236  $ work, 1, info )
237  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
238  infot = 4
239  CALL ctrsen( 'N', 'N', sel, -1, a, 1, b, 1, x, m, s( 1 ),
240  $ sep( 1 ), work, 1, info )
241  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
242  infot = 6
243  CALL ctrsen( 'N', 'N', sel, 2, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
244  $ work, 2, info )
245  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
246  infot = 8
247  CALL ctrsen( 'N', 'V', sel, 2, a, 2, b, 1, x, m, s( 1 ), sep( 1 ),
248  $ work, 1, info )
249  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
250  infot = 14
251  CALL ctrsen( 'N', 'V', sel, 2, a, 2, b, 2, x, m, s( 1 ), sep( 1 ),
252  $ work, 0, info )
253  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
254  infot = 14
255  CALL ctrsen( 'E', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
256  $ work, 1, info )
257  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
258  infot = 14
259  CALL ctrsen( 'V', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
260  $ work, 3, info )
261  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
262  nt = nt + 8
263 *
264 * Print a summary line.
265 *
266  IF( ok ) THEN
267  WRITE( nout, fmt = 9999 )path, nt
268  ELSE
269  WRITE( nout, fmt = 9998 )path
270  END IF
271 *
272  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
273  $ i3, ' tests done)' )
274  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
275  $ 'exits ***' )
276  RETURN
277 *
278 * End of CERREC
279 *
280  END
ctrsna
subroutine ctrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK, INFO)
CTRSNA
Definition: ctrsna.f:251
ctrexc
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC
Definition: ctrexc.f:128
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
ctrsyl
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:159
ctrsen
subroutine ctrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
CTRSEN
Definition: ctrsen.f:266
cerrec
subroutine cerrec(PATH, NUNIT)
CERREC
Definition: cerrec.f:58