LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
derrsy.f
Go to the documentation of this file.
1 *> \brief \b DERRSY
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE DERRSY( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> DERRSY tests the error exits for the DOUBLE PRECISION routines
25 *> for symmetric indefinite matrices.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \date November 2015
52 *
53 *> \ingroup double_lin
54 *
55 * =====================================================================
56  SUBROUTINE derrsy( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.6.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2015
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX
72  parameter ( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 C2
76  INTEGER I, INFO, J
77  DOUBLE PRECISION ANRM, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IP( nmax ), IW( nmax )
81  DOUBLE PRECISION A( nmax, nmax ), AF( nmax, nmax ), B( nmax ),
82  $ r1( nmax ), r2( nmax ), w( 3*nmax ), x( nmax )
83 * ..
84 * .. External Functions ..
85  LOGICAL LSAMEN
86  EXTERNAL lsamen
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL alaesm, chkxer, dspcon, dsprfs, dsptrf, dsptri,
90  $ dsptrs, dsycon, dsycon_rook, dsyrfs, dsytf2,
91  $ dsytf2_rook, dsytrf, dsytrf_rook, dsytri,
92  $ dsytri_rook, dsytri2, dsytrs, dsytrs_rook
93 * ..
94 * .. Scalars in Common ..
95  LOGICAL LERR, OK
96  CHARACTER*32 SRNAMT
97  INTEGER INFOT, NOUT
98 * ..
99 * .. Common blocks ..
100  COMMON / infoc / infot, nout, ok, lerr
101  COMMON / srnamc / srnamt
102 * ..
103 * .. Intrinsic Functions ..
104  INTRINSIC dble
105 * ..
106 * .. Executable Statements ..
107 *
108  nout = nunit
109  WRITE( nout, fmt = * )
110  c2 = path( 2: 3 )
111 *
112 * Set the variables to innocuous values.
113 *
114  DO 20 j = 1, nmax
115  DO 10 i = 1, nmax
116  a( i, j ) = 1.d0 / dble( i+j )
117  af( i, j ) = 1.d0 / dble( i+j )
118  10 CONTINUE
119  b( j ) = 0.d0
120  r1( j ) = 0.d0
121  r2( j ) = 0.d0
122  w( j ) = 0.d0
123  x( j ) = 0.d0
124  ip( j ) = j
125  iw( j ) = j
126  20 CONTINUE
127  anrm = 1.0d0
128  rcond = 1.0d0
129  ok = .true.
130 *
131  IF( lsamen( 2, c2, 'SY' ) ) THEN
132 *
133 * Test error exits of the routines that use factorization
134 * of a symmetric indefinite matrix with patrial
135 * (Bunch-Kaufman) pivoting.
136 *
137 * DSYTRF
138 *
139  srnamt = 'DSYTRF'
140  infot = 1
141  CALL dsytrf( '/', 0, a, 1, ip, w, 1, info )
142  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
143  infot = 2
144  CALL dsytrf( 'U', -1, a, 1, ip, w, 1, info )
145  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
146  infot = 4
147  CALL dsytrf( 'U', 2, a, 1, ip, w, 4, info )
148  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
149 *
150 * DSYTF2
151 *
152  srnamt = 'DSYTF2'
153  infot = 1
154  CALL dsytf2( '/', 0, a, 1, ip, info )
155  CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
156  infot = 2
157  CALL dsytf2( 'U', -1, a, 1, ip, info )
158  CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
159  infot = 4
160  CALL dsytf2( 'U', 2, a, 1, ip, info )
161  CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
162 *
163 * DSYTRI
164 *
165  srnamt = 'DSYTRI'
166  infot = 1
167  CALL dsytri( '/', 0, a, 1, ip, w, info )
168  CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
169  infot = 2
170  CALL dsytri( 'U', -1, a, 1, ip, w, info )
171  CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
172  infot = 4
173  CALL dsytri( 'U', 2, a, 1, ip, w, info )
174  CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
175 *
176 * DSYTRI2
177 *
178  srnamt = 'DSYTRI2'
179  infot = 1
180  CALL dsytri2( '/', 0, a, 1, ip, w, iw(1), info )
181  CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
182  infot = 2
183  CALL dsytri2( 'U', -1, a, 1, ip, w, iw(1), info )
184  CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
185  infot = 4
186  CALL dsytri2( 'U', 2, a, 1, ip, w, iw(1), info )
187  CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
188 *
189 * DSYTRS
190 *
191  srnamt = 'DSYTRS'
192  infot = 1
193  CALL dsytrs( '/', 0, 0, a, 1, ip, b, 1, info )
194  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
195  infot = 2
196  CALL dsytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
197  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
198  infot = 3
199  CALL dsytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
200  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
201  infot = 5
202  CALL dsytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
203  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
204  infot = 8
205  CALL dsytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
206  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
207 *
208 * DSYRFS
209 *
210  srnamt = 'DSYRFS'
211  infot = 1
212  CALL dsyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
213  $ iw, info )
214  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
215  infot = 2
216  CALL dsyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
217  $ w, iw, info )
218  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
219  infot = 3
220  CALL dsyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
221  $ w, iw, info )
222  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
223  infot = 5
224  CALL dsyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
225  $ iw, info )
226  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
227  infot = 7
228  CALL dsyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
229  $ iw, info )
230  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
231  infot = 10
232  CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
233  $ iw, info )
234  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
235  infot = 12
236  CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
237  $ iw, info )
238  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
239 *
240 * DSYCON
241 *
242  srnamt = 'DSYCON'
243  infot = 1
244  CALL dsycon( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
245  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
246  infot = 2
247  CALL dsycon( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
248  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
249  infot = 4
250  CALL dsycon( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
251  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
252  infot = 6
253  CALL dsycon( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
254  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
255 *
256  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
257 *
258 * Test error exits of the routines that use factorization
259 * of a symmetric indefinite matrix with rook
260 * (bounded Bunch-Kaufman) pivoting.
261 *
262 * DSYTRF_ROOK
263 *
264  srnamt = 'DSYTRF_ROOK'
265  infot = 1
266  CALL dsytrf_rook( '/', 0, a, 1, ip, w, 1, info )
267  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
268  infot = 2
269  CALL dsytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
270  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
271  infot = 4
272  CALL dsytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
273  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
274 *
275 * DSYTF2_ROOK
276 *
277  srnamt = 'DSYTF2_ROOK'
278  infot = 1
279  CALL dsytf2_rook( '/', 0, a, 1, ip, info )
280  CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
281  infot = 2
282  CALL dsytf2_rook( 'U', -1, a, 1, ip, info )
283  CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
284  infot = 4
285  CALL dsytf2_rook( 'U', 2, a, 1, ip, info )
286  CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
287 *
288 * DSYTRI_ROOK
289 *
290  srnamt = 'DSYTRI_ROOK'
291  infot = 1
292  CALL dsytri_rook( '/', 0, a, 1, ip, w, info )
293  CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
294  infot = 2
295  CALL dsytri_rook( 'U', -1, a, 1, ip, w, info )
296  CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
297  infot = 4
298  CALL dsytri_rook( 'U', 2, a, 1, ip, w, info )
299  CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
300 *
301 * DSYTRS_ROOK
302 *
303  srnamt = 'DSYTRS_ROOK'
304  infot = 1
305  CALL dsytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
306  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
307  infot = 2
308  CALL dsytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
309  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
310  infot = 3
311  CALL dsytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
312  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
313  infot = 5
314  CALL dsytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
315  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
316  infot = 8
317  CALL dsytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
318  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
319 *
320 * DSYCON_ROOK
321 *
322  srnamt = 'DSYCON_ROOK'
323  infot = 1
324  CALL dsycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
325  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
326  infot = 2
327  CALL dsycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
328  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
329  infot = 4
330  CALL dsycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
331  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
332  infot = 6
333  CALL dsycon_rook( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
334  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
335 *
336  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
337 *
338 * Test error exits of the routines that use factorization
339 * of a symmetric indefinite packed matrix with patrial
340 * (Bunch-Kaufman) pivoting.
341 *
342 * DSPTRF
343 *
344  srnamt = 'DSPTRF'
345  infot = 1
346  CALL dsptrf( '/', 0, a, ip, info )
347  CALL chkxer( 'DSPTRF', infot, nout, lerr, ok )
348  infot = 2
349  CALL dsptrf( 'U', -1, a, ip, info )
350  CALL chkxer( 'DSPTRF', infot, nout, lerr, ok )
351 *
352 * DSPTRI
353 *
354  srnamt = 'DSPTRI'
355  infot = 1
356  CALL dsptri( '/', 0, a, ip, w, info )
357  CALL chkxer( 'DSPTRI', infot, nout, lerr, ok )
358  infot = 2
359  CALL dsptri( 'U', -1, a, ip, w, info )
360  CALL chkxer( 'DSPTRI', infot, nout, lerr, ok )
361 *
362 * DSPTRS
363 *
364  srnamt = 'DSPTRS'
365  infot = 1
366  CALL dsptrs( '/', 0, 0, a, ip, b, 1, info )
367  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
368  infot = 2
369  CALL dsptrs( 'U', -1, 0, a, ip, b, 1, info )
370  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
371  infot = 3
372  CALL dsptrs( 'U', 0, -1, a, ip, b, 1, info )
373  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
374  infot = 7
375  CALL dsptrs( 'U', 2, 1, a, ip, b, 1, info )
376  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
377 *
378 * DSPRFS
379 *
380  srnamt = 'DSPRFS'
381  infot = 1
382  CALL dsprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
383  $ info )
384  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
385  infot = 2
386  CALL dsprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
387  $ info )
388  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
389  infot = 3
390  CALL dsprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
391  $ info )
392  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
393  infot = 8
394  CALL dsprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
395  $ info )
396  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
397  infot = 10
398  CALL dsprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
399  $ info )
400  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
401 *
402 * DSPCON
403 *
404  srnamt = 'DSPCON'
405  infot = 1
406  CALL dspcon( '/', 0, a, ip, anrm, rcond, w, iw, info )
407  CALL chkxer( 'DSPCON', infot, nout, lerr, ok )
408  infot = 2
409  CALL dspcon( 'U', -1, a, ip, anrm, rcond, w, iw, info )
410  CALL chkxer( 'DSPCON', infot, nout, lerr, ok )
411  infot = 5
412  CALL dspcon( 'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
413  CALL chkxer( 'DSPCON', infot, nout, lerr, ok )
414  END IF
415 *
416 * Print a summary line.
417 *
418  CALL alaesm( path, ok, nout )
419 *
420  RETURN
421 *
422 * End of DERRSY
423 *
424  END
dsytrs_rook
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
Definition: dsytrs_rook.f:138
dsptrs
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
Definition: dsptrs.f:117
dsyrfs
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
Definition: dsyrfs.f:193
dsytri2
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
Definition: dsytri2.f:129
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
dsytf2
subroutine dsytf2(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition: dsytf2.f:196
dsytri_rook
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
Definition: dsytri_rook.f:131
dsytri
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
Definition: dsytri.f:116
dsprfs
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
Definition: dsprfs.f:181
dsptri
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
Definition: dsptri.f:111
dsycon
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
Definition: dsycon.f:132
dsycon_rook
subroutine dsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_ROOK
Definition: dsycon_rook.f:146
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dspcon
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
Definition: dspcon.f:127
dsytrs
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
Definition: dsytrs.f:122
dsytrf
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
Definition: dsytrf.f:184
derrsy
subroutine derrsy(PATH, NUNIT)
DERRSY
Definition: derrsy.f:57
dsptrf
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
Definition: dsptrf.f:161
dsytrf_rook
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_ROOK
Definition: dsytrf_rook.f:210
dsytf2_rook
subroutine dsytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
Definition: dsytf2_rook.f:196