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

DERRSY

DERRSYX

Purpose: 
 DERRSY tests the error exits for the DOUBLE PRECISION routines
 for symmetric indefinite matrices.
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 2015
Purpose: 
 DERRSY tests the error exits for the DOUBLE PRECISION routines
 for symmetric indefinite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise derrsy.f defines this subroutine.
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 2015

Definition at line 57 of file derrsy.f.

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 *
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
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
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
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

Here is the call graph for this function:

Here is the caller graph for this function: