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

DERREC

Purpose: 
 DERREC tests the error exits for the routines for eigen- condition
 estimation for DOUBLE PRECISION matrices:
    DTRSYL, 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
November 2011

Definition at line 58 of file derrec.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  DOUBLE PRECISION one, zero
74  parameter ( nmax = 4, one = 1.0d0, zero = 0.0d0 )
75 * ..
76 * .. Local Scalars ..
77  INTEGER i, ifst, ilst, info, j, m, nt
78  DOUBLE PRECISION scale
79 * ..
80 * .. Local Arrays ..
81  LOGICAL sel( nmax )
82  INTEGER iwork( nmax )
83  DOUBLE PRECISION 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, dtrexc, dtrsen, dtrsna, dtrsyl
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 DTRSYL
119 *
120  srnamt = 'DTRSYL'
121  infot = 1
122  CALL dtrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
124  infot = 2
125  CALL dtrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
126  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
127  infot = 3
128  CALL dtrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
129  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
130  infot = 4
131  CALL dtrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
132  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
133  infot = 5
134  CALL dtrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
135  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
136  infot = 7
137  CALL dtrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
138  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
139  infot = 9
140  CALL dtrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
141  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
142  infot = 11
143  CALL dtrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
144  CALL chkxer( 'DTRSYL', infot, nout, lerr, ok )
145  nt = nt + 8
146 *
147 * Test DTREXC
148 *
149  srnamt = 'DTREXC'
150  ifst = 1
151  ilst = 1
152  infot = 1
153  CALL dtrexc( 'X', 1, a, 1, b, 1, ifst, ilst, work, info )
154  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
155  infot = 7
156  CALL dtrexc( 'N', 0, a, 1, b, 1, ifst, ilst, work, info )
157  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
158  infot = 4
159  ilst = 2
160  CALL dtrexc( 'N', 2, a, 1, b, 1, ifst, ilst, work, info )
161  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
162  infot = 6
163  CALL dtrexc( 'V', 2, a, 2, b, 1, ifst, ilst, work, info )
164  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
165  infot = 7
166  ifst = 0
167  ilst = 1
168  CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
169  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
170  infot = 7
171  ifst = 2
172  CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
173  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
174  infot = 8
175  ifst = 1
176  ilst = 0
177  CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
178  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
179  infot = 8
180  ilst = 2
181  CALL dtrexc( 'V', 1, a, 1, b, 1, ifst, ilst, work, info )
182  CALL chkxer( 'DTREXC', infot, nout, lerr, ok )
183  nt = nt + 8
184 *
185 * Test DTRSNA
186 *
187  srnamt = 'DTRSNA'
188  infot = 1
189  CALL dtrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
190  $ work, 1, iwork, info )
191  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
192  infot = 2
193  CALL dtrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
194  $ work, 1, iwork, info )
195  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
196  infot = 4
197  CALL dtrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
198  $ work, 1, iwork, info )
199  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
200  infot = 6
201  CALL dtrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
202  $ work, 2, iwork, info )
203  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
204  infot = 8
205  CALL dtrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
206  $ work, 2, iwork, info )
207  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
208  infot = 10
209  CALL dtrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
210  $ work, 2, iwork, info )
211  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
212  infot = 13
213  CALL dtrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
214  $ work, 1, iwork, info )
215  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
216  infot = 13
217  CALL dtrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
218  $ work, 2, iwork, info )
219  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
220  infot = 16
221  CALL dtrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
222  $ work, 1, iwork, info )
223  CALL chkxer( 'DTRSNA', infot, nout, lerr, ok )
224  nt = nt + 9
225 *
226 * Test DTRSEN
227 *
228  sel( 1 ) = .false.
229  srnamt = 'DTRSEN'
230  infot = 1
231  CALL dtrsen( 'X', 'N', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
232  $ sep( 1 ), work, 1, iwork, 1, info )
233  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
234  infot = 2
235  CALL dtrsen( 'N', 'X', sel, 0, a, 1, b, 1, wr, wi, m, s( 1 ),
236  $ sep( 1 ), work, 1, iwork, 1, info )
237  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
238  infot = 4
239  CALL dtrsen( 'N', 'N', sel, -1, a, 1, b, 1, wr, wi, m, s( 1 ),
240  $ sep( 1 ), work, 1, iwork, 1, info )
241  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
242  infot = 6
243  CALL dtrsen( 'N', 'N', sel, 2, a, 1, b, 1, wr, wi, m, s( 1 ),
244  $ sep( 1 ), work, 2, iwork, 1, info )
245  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
246  infot = 8
247  CALL dtrsen( 'N', 'V', sel, 2, a, 2, b, 1, wr, wi, m, s( 1 ),
248  $ sep( 1 ), work, 1, iwork, 1, info )
249  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
250  infot = 15
251  CALL dtrsen( 'N', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
252  $ sep( 1 ), work, 0, iwork, 1, info )
253  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
254  infot = 15
255  CALL dtrsen( 'E', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
256  $ sep( 1 ), work, 1, iwork, 1, info )
257  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
258  infot = 15
259  CALL dtrsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
260  $ sep( 1 ), work, 3, iwork, 2, info )
261  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
262  infot = 17
263  CALL dtrsen( 'E', 'V', sel, 2, a, 2, b, 2, wr, wi, m, s( 1 ),
264  $ sep( 1 ), work, 1, iwork, 0, info )
265  CALL chkxer( 'DTRSEN', infot, nout, lerr, ok )
266  infot = 17
267  CALL dtrsen( 'V', 'V', sel, 3, a, 3, b, 3, wr, wi, m, s( 1 ),
268  $ sep( 1 ), work, 4, iwork, 1, info )
269  CALL chkxer( 'DTRSEN', 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 DERREC
287 *
dtrexc
subroutine dtrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
DTREXC
Definition: dtrexc.f:148
dtrsna
subroutine dtrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
DTRSNA
Definition: dtrsna.f:267
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dtrsen
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
Definition: dtrsen.f:315
dtrsyl
subroutine dtrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
DTRSYL
Definition: dtrsyl.f:166

Here is the call graph for this function:

Here is the caller graph for this function: