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

SERREC

Purpose:
``` SERREC tests the error exits for the routines for eigen- condition
estimation for REAL matrices:
STRSYL, STREXC, STRSNA and STRSEN.```
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.```
Date
November 2011

Definition at line 58 of file serrec.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
73  REAL one, zero
74  parameter ( nmax = 4, one = 1.0e0, zero = 0.0e0 )
75 * ..
76 * .. Local Scalars ..
77  INTEGER i, ifst, ilst, info, j, m, nt
78  REAL scale
79 * ..
80 * .. Local Arrays ..
81  LOGICAL sel( nmax )
82  INTEGER iwork( nmax )
83  REAL a( nmax, nmax ), b( nmax, nmax ),
84  \$ c( nmax, nmax ), s( nmax ), sep( nmax ),
85  \$ wi( nmax ), work( nmax ), wr( nmax )
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL chkxer, strexc, strsen, strsna, strsyl
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 STRSYL
119 *
120  srnamt = 'STRSYL'
121  infot = 1
122  CALL strsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
124  infot = 2
125  CALL strsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
126  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
127  infot = 3
128  CALL strsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
129  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
130  infot = 4
131  CALL strsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
132  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
133  infot = 5
134  CALL strsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
135  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
136  infot = 7
137  CALL strsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
138  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
139  infot = 9
140  CALL strsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
141  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
142  infot = 11
143  CALL strsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
144  CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
145  nt = nt + 8
146 *
147 * Test STREXC
148 *
149  srnamt = 'STREXC'
150  ifst = 1
151  ilst = 1
152  infot = 1
153  CALL strexc( 'X', 1, a, 1, b, 1, ifst, ilst, work, info )
154  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
155  infot = 7
156  CALL strexc( 'N', 0, a, 1, b, 1, ifst, ilst, work, info )
157  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
158  infot = 4
159  ilst = 2
160  CALL strexc( 'N', 2, a, 1, b, 1, ifst, ilst, work, info )
161  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
162  infot = 6
163  CALL strexc( 'V', 2, a, 2, b, 1, ifst, ilst, work, info )
164  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
165  infot = 7
166  ifst = 0
167  ilst = 1
168  CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
169  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
170  infot = 7
171  ifst = 2
172  CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
173  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
174  infot = 8
175  ifst = 1
176  ilst = 0
177  CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
178  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
179  infot = 8
180  ilst = 2
181  CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
182  CALL chkxer( 'STREXC', infot, nout, lerr, ok )
183  nt = nt + 8
184 *
185 * Test STRSNA
186 *
187  srnamt = 'STRSNA'
188  infot = 1
189  CALL strsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
190  \$ work, 1, iwork, info )
191  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
192  infot = 2
193  CALL strsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
194  \$ work, 1, iwork, info )
195  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
196  infot = 4
197  CALL strsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
198  \$ work, 1, iwork, info )
199  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
200  infot = 6
201  CALL strsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
202  \$ work, 2, iwork, info )
203  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
204  infot = 8
205  CALL strsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
206  \$ work, 2, iwork, info )
207  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
208  infot = 10
209  CALL strsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
210  \$ work, 2, iwork, info )
211  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
212  infot = 13
213  CALL strsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
214  \$ work, 1, iwork, info )
215  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
216  infot = 13
217  CALL strsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
218  \$ work, 2, iwork, info )
219  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
220  infot = 16
221  CALL strsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
222  \$ work, 1, iwork, info )
223  CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
224  nt = nt + 9
225 *
226 * Test STRSEN
227 *
228  sel( 1 ) = .false.
229  srnamt = 'STRSEN'
230  infot = 1
231  CALL strsen( 'X', 'N', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
232  \$ sep( 1 ), work, 1, iwork, 1, info )
233  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
234  infot = 2
235  CALL strsen( 'N', 'X', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
236  \$ sep( 1 ), work, 1, iwork, 1, info )
237  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
238  infot = 4
239  CALL strsen( 'N', 'N', sel, -1, a, 1, b, 1, wr, wi, m, s( 1 ),
240  \$ sep( 1 ), work, 1, iwork, 1, info )
241  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
242  infot = 6
243  CALL strsen( 'N', 'N', sel, 2, a, 1, b, 1, wr, wi, m, s( 1 ),
244  \$ sep( 1 ), work, 2, iwork, 1, info )
245  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
246  infot = 8
247  CALL strsen( 'N', 'V', sel, 2, a, 2, b, 1, wr, wi, m, s( 1 ),
248  \$ sep( 1 ), work, 1, iwork, 1, info )
249  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
250  infot = 15
251  CALL strsen( 'N', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
252  \$ sep( 1 ), work, 0, iwork, 1, info )
253  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
254  infot = 15
255  CALL strsen( 'E', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
256  \$ sep( 1 ), work, 1, iwork, 1, info )
257  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
258  infot = 15
259  CALL strsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
260  \$ sep( 1 ), work, 3, iwork, 2, info )
261  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
262  infot = 17
263  CALL strsen( 'E', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
264  \$ sep( 1 ), work, 1, iwork, 0, info )
265  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
266  infot = 17
267  CALL strsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
268  \$ sep( 1 ), work, 4, iwork, 1, info )
269  CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
270  nt = nt + 10
271 *
272 * Print a summary line.
273 *
274  IF( ok ) THEN
275  WRITE( nout, fmt = 9999 )path, nt
276  ELSE
277  WRITE( nout, fmt = 9998 )path
278  END IF
279 *
280  RETURN
281  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
282  \$ i3, ' tests done)' )
283  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ex',
284  \$ 'its ***' )
285 *
286 * End of SERREC
287 *
subroutine strsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
STRSYL
Definition: strsyl.f:166
subroutine strsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
STRSNA
Definition: strsna.f:267
subroutine strexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
STREXC
Definition: strexc.f:148
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine strsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
STRSEN
Definition: strsen.f:316

Here is the call graph for this function:

Here is the caller graph for this function: