LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cerrec ( character*3  PATH,
integer  NUNIT 
)

CERREC

Purpose: 
 CERREC tests the error exits for the routines for eigen- condition
 estimation for REAL matrices:
    CTRSYL, CTREXC, CTRSNA and CTRSEN.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 58 of file cerrec.f.

58 *
59 * -- LAPACK test routine (version 3.4.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 * November 2011
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 = 7
156  CALL ctrexc( 'N', 0, 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 *
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
ctrsyl
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:159
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
ctrsen
subroutine ctrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
CTRSEN
Definition: ctrsen.f:266
ctrexc
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC
Definition: ctrexc.f:126

Here is the call graph for this function:

Here is the caller graph for this function: