LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ 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, 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.
Date
December 2016

Definition at line 58 of file serrec.f.

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
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 = 2
156  CALL strexc( 'N', -1, 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 *
Here is the call graph for this function:
Here is the caller graph for this function:
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:316
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:267
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
strsyl
subroutine strsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
STRSYL
Definition: strsyl.f:166
strexc
subroutine strexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
STREXC
Definition: strexc.f:150