LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ cerrec()

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.

Definition at line 55 of file cerrec.f.

56 *
57 * -- LAPACK test routine --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 *
61 * .. Scalar Arguments ..
62  CHARACTER*3 PATH
63  INTEGER NUNIT
64 * ..
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69  INTEGER NMAX, LW
70  parameter( nmax = 4, lw = nmax*( nmax+2 ) )
71  REAL ONE, ZERO
72  parameter( one = 1.0e0, zero = 0.0e0 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER I, IFST, ILST, INFO, J, M, NT
76  REAL SCALE
77 * ..
78 * .. Local Arrays ..
79  LOGICAL SEL( NMAX )
80  REAL RW( LW ), S( NMAX ), SEP( NMAX )
81  COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ),
82  $ C( NMAX, NMAX ), WORK( LW ), X( NMAX )
83 * ..
84 * .. External Subroutines ..
85  EXTERNAL chkxer, ctrexc, ctrsen, ctrsna, ctrsyl
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 * .. Executable Statements ..
97 *
98  nout = nunit
99  ok = .true.
100  nt = 0
101 *
102 * Initialize A, B and SEL
103 *
104  DO 20 j = 1, nmax
105  DO 10 i = 1, nmax
106  a( i, j ) = zero
107  b( i, j ) = zero
108  10 CONTINUE
109  20 CONTINUE
110  DO 30 i = 1, nmax
111  a( i, i ) = one
112  sel( i ) = .true.
113  30 CONTINUE
114 *
115 * Test CTRSYL
116 *
117  srnamt = 'CTRSYL'
118  infot = 1
119  CALL ctrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
121  infot = 2
122  CALL ctrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
124  infot = 3
125  CALL ctrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
127  infot = 4
128  CALL ctrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
130  infot = 5
131  CALL ctrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
133  infot = 7
134  CALL ctrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
136  infot = 9
137  CALL ctrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
139  infot = 11
140  CALL ctrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141  CALL chkxer( 'CTRSYL', infot, nout, lerr, ok )
142  nt = nt + 8
143 *
144 * Test CTREXC
145 *
146  srnamt = 'CTREXC'
147  ifst = 1
148  ilst = 1
149  infot = 1
150  CALL ctrexc( 'X', 1, a, 1, b, 1, ifst, ilst, info )
151  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
152  infot = 2
153  CALL ctrexc( 'N', -1, a, 1, b, 1, ifst, ilst, info )
154  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
155  infot = 4
156  ilst = 2
157  CALL ctrexc( 'N', 2, a, 1, b, 1, ifst, ilst, info )
158  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
159  infot = 6
160  CALL ctrexc( 'V', 2, a, 2, b, 1, ifst, ilst, info )
161  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
162  infot = 7
163  ifst = 0
164  ilst = 1
165  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
166  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
167  infot = 7
168  ifst = 2
169  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
170  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
171  infot = 8
172  ifst = 1
173  ilst = 0
174  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
175  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
176  infot = 8
177  ilst = 2
178  CALL ctrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
179  CALL chkxer( 'CTREXC', infot, nout, lerr, ok )
180  nt = nt + 8
181 *
182 * Test CTRSNA
183 *
184  srnamt = 'CTRSNA'
185  infot = 1
186  CALL ctrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
187  $ work, 1, rw, info )
188  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
189  infot = 2
190  CALL ctrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
191  $ work, 1, rw, info )
192  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
193  infot = 4
194  CALL ctrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
195  $ work, 1, rw, info )
196  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
197  infot = 6
198  CALL ctrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
199  $ work, 2, rw, info )
200  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
201  infot = 8
202  CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
203  $ work, 2, rw, info )
204  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
205  infot = 10
206  CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
207  $ work, 2, rw, info )
208  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
209  infot = 13
210  CALL ctrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
211  $ work, 1, rw, info )
212  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
213  infot = 13
214  CALL ctrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
215  $ work, 1, rw, info )
216  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
217  infot = 16
218  CALL ctrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
219  $ work, 1, rw, info )
220  CALL chkxer( 'CTRSNA', infot, nout, lerr, ok )
221  nt = nt + 9
222 *
223 * Test CTRSEN
224 *
225  sel( 1 ) = .false.
226  srnamt = 'CTRSEN'
227  infot = 1
228  CALL ctrsen( 'X', 'N', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
229  $ work, 1, info )
230  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
231  infot = 2
232  CALL ctrsen( 'N', 'X', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
233  $ work, 1, info )
234  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
235  infot = 4
236  CALL ctrsen( 'N', 'N', sel, -1, a, 1, b, 1, x, m, s( 1 ),
237  $ sep( 1 ), work, 1, info )
238  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
239  infot = 6
240  CALL ctrsen( 'N', 'N', sel, 2, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
241  $ work, 2, info )
242  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
243  infot = 8
244  CALL ctrsen( 'N', 'V', sel, 2, a, 2, b, 1, x, m, s( 1 ), sep( 1 ),
245  $ work, 1, info )
246  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
247  infot = 14
248  CALL ctrsen( 'N', 'V', sel, 2, a, 2, b, 2, x, m, s( 1 ), sep( 1 ),
249  $ work, 0, info )
250  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
251  infot = 14
252  CALL ctrsen( 'E', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
253  $ work, 1, info )
254  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
255  infot = 14
256  CALL ctrsen( 'V', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
257  $ work, 3, info )
258  CALL chkxer( 'CTRSEN', infot, nout, lerr, ok )
259  nt = nt + 8
260 *
261 * Print a summary line.
262 *
263  IF( ok ) THEN
264  WRITE( nout, fmt = 9999 )path, nt
265  ELSE
266  WRITE( nout, fmt = 9998 )path
267  END IF
268 *
269  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
270  $ i3, ' tests done)' )
271  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
272  $ 'exits ***' )
273  RETURN
274 *
275 * End of CERREC
276 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
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:249
ctrsen
subroutine ctrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
CTRSEN
Definition: ctrsen.f:264
ctrexc
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC
Definition: ctrexc.f:126
ctrsyl
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:157
Here is the call graph for this function:
Here is the caller graph for this function: