LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ serrec()

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, STRSYL3, 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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 55 of file serrec.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
70 REAL ONE, ZERO
71 parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
72* ..
73* .. Local Scalars ..
74 INTEGER I, IFST, ILST, INFO, J, M, NT
75 REAL SCALE
76* ..
77* .. Local Arrays ..
78 LOGICAL SEL( NMAX )
79 INTEGER IWORK( NMAX )
80 REAL A( NMAX, NMAX ), B( NMAX, NMAX ),
81 $ C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
82 $ WI( NMAX ), WORK( NMAX ), WR( NMAX )
83* ..
84* .. External Subroutines ..
85 EXTERNAL chkxer, strexc, strsen, strsna, strsyl, strsyl3
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 STRSYL
116*
117 srnamt = 'STRSYL'
118 infot = 1
119 CALL strsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
121 infot = 2
122 CALL strsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
124 infot = 3
125 CALL strsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
127 infot = 4
128 CALL strsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
130 infot = 5
131 CALL strsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
133 infot = 7
134 CALL strsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
136 infot = 9
137 CALL strsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
139 infot = 11
140 CALL strsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
142 nt = nt + 8
143*
144* Test STRSYL3
145*
146 srnamt = 'STRSYL3'
147 infot = 1
148 CALL strsyl3( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale,
149 $ iwork, nmax, work, nmax, info )
150 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
151 infot = 2
152 CALL strsyl3( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale,
153 $ iwork, nmax, work, nmax, info )
154 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
155 infot = 3
156 CALL strsyl3( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale,
157 $ iwork, nmax, work, nmax, info )
158 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
159 infot = 4
160 CALL strsyl3( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale,
161 $ iwork, nmax, work, nmax, info )
162 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
163 infot = 5
164 CALL strsyl3( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale,
165 $ iwork, nmax, work, nmax, info )
166 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
167 infot = 7
168 CALL strsyl3( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale,
169 $ iwork, nmax, work, nmax, info )
170 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
171 infot = 9
172 CALL strsyl3( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale,
173 $ iwork, nmax, work, nmax, info )
174 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
175 infot = 11
176 CALL strsyl3( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale,
177 $ iwork, nmax, work, nmax, info )
178 CALL chkxer( 'STRSYL3', infot, nout, lerr, ok )
179 nt = nt + 8
180*
181* Test STREXC
182*
183 srnamt = 'STREXC'
184 ifst = 1
185 ilst = 1
186 infot = 1
187 CALL strexc( 'X', 1, a, 1, b, 1, ifst, ilst, work, info )
188 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
189 infot = 2
190 CALL strexc( 'N', -1, a, 1, b, 1, ifst, ilst, work, info )
191 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
192 infot = 4
193 ilst = 2
194 CALL strexc( 'N', 2, a, 1, b, 1, ifst, ilst, work, info )
195 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
196 infot = 6
197 CALL strexc( 'V', 2, a, 2, b, 1, ifst, ilst, work, info )
198 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
199 infot = 7
200 ifst = 0
201 ilst = 1
202 CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
203 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
204 infot = 7
205 ifst = 2
206 CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
207 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
208 infot = 8
209 ifst = 1
210 ilst = 0
211 CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
212 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
213 infot = 8
214 ilst = 2
215 CALL strexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
216 CALL chkxer( 'STREXC', infot, nout, lerr, ok )
217 nt = nt + 8
218*
219* Test STRSNA
220*
221 srnamt = 'STRSNA'
222 infot = 1
223 CALL strsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
224 $ work, 1, iwork, info )
225 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
226 infot = 2
227 CALL strsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
228 $ work, 1, iwork, info )
229 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
230 infot = 4
231 CALL strsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
232 $ work, 1, iwork, info )
233 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
234 infot = 6
235 CALL strsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
236 $ work, 2, iwork, info )
237 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
238 infot = 8
239 CALL strsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
240 $ work, 2, iwork, info )
241 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
242 infot = 10
243 CALL strsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
244 $ work, 2, iwork, info )
245 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
246 infot = 13
247 CALL strsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
248 $ work, 1, iwork, info )
249 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
250 infot = 13
251 CALL strsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
252 $ work, 2, iwork, info )
253 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
254 infot = 16
255 CALL strsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
256 $ work, 1, iwork, info )
257 CALL chkxer( 'STRSNA', infot, nout, lerr, ok )
258 nt = nt + 9
259*
260* Test STRSEN
261*
262 sel( 1 ) = .false.
263 srnamt = 'STRSEN'
264 infot = 1
265 CALL strsen( 'X', 'N', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
266 $ sep( 1 ), work, 1, iwork, 1, info )
267 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
268 infot = 2
269 CALL strsen( 'N', 'X', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
270 $ sep( 1 ), work, 1, iwork, 1, info )
271 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
272 infot = 4
273 CALL strsen( 'N', 'N', sel, -1, a, 1, b, 1, wr, wi, m, s( 1 ),
274 $ sep( 1 ), work, 1, iwork, 1, info )
275 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
276 infot = 6
277 CALL strsen( 'N', 'N', sel, 2, a, 1, b, 1, wr, wi, m, s( 1 ),
278 $ sep( 1 ), work, 2, iwork, 1, info )
279 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
280 infot = 8
281 CALL strsen( 'N', 'V', sel, 2, a, 2, b, 1, wr, wi, m, s( 1 ),
282 $ sep( 1 ), work, 1, iwork, 1, info )
283 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
284 infot = 15
285 CALL strsen( 'N', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
286 $ sep( 1 ), work, 0, iwork, 1, info )
287 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
288 infot = 15
289 CALL strsen( 'E', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
290 $ sep( 1 ), work, 1, iwork, 1, info )
291 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
292 infot = 15
293 CALL strsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
294 $ sep( 1 ), work, 3, iwork, 2, info )
295 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
296 infot = 17
297 CALL strsen( 'E', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
298 $ sep( 1 ), work, 1, iwork, 0, info )
299 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
300 infot = 17
301 CALL strsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
302 $ sep( 1 ), work, 4, iwork, 1, info )
303 CALL chkxer( 'STRSEN', infot, nout, lerr, ok )
304 nt = nt + 10
305*
306* Print a summary line.
307*
308 IF( ok ) THEN
309 WRITE( nout, fmt = 9999 )path, nt
310 ELSE
311 WRITE( nout, fmt = 9998 )path
312 END IF
313*
314 RETURN
315 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
316 $ i3, ' tests done)' )
317 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ex',
318 $ 'its ***' )
319*
320* End of SERREC
321*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
strexc
subroutine strexc(compq, n, t, ldt, q, ldq, ifst, ilst, work, info)
STREXC
Definition strexc.f:148
strsen
subroutine strsen(job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork, info)
STRSEN
Definition strsen.f:314
strsna
subroutine strsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, iwork, info)
STRSNA
Definition strsna.f:265
strsyl
subroutine strsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
STRSYL
Definition strsyl.f:164
strsyl3
subroutine strsyl3(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, iwork, liwork, swork, ldswork, info)
STRSYL3
Definition strsyl3.f:181
Here is the call graph for this function:
Here is the caller graph for this function: