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

SERRSY

SERRSYX

Purpose: 
 SERRSY tests the error exits for the REAL 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: 
 SERRSY tests the error exits for the REAL routines
 for symmetric indefinite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise serrsy.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 serrsy.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  REAL anrm, rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER ip( nmax ), iw( nmax )
81  REAL 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, sspcon, ssycon_rook, ssprfs,
90  $ ssptrf, ssptri, ssptrs, ssycon, ssyrfs, ssytf2,
91  $ ssytf2_rook, ssytrf, ssytrf_rook, ssytri,
92  $ ssytri_rook, ssytri2, ssytrs, ssytrs_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 real
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. / REAL( i+j )
117  af( i, j ) = 1. / REAL( i+j )
118  10 CONTINUE
119  b( j ) = 0.
120  r1( j ) = 0.
121  r2( j ) = 0.
122  w( j ) = 0.
123  x( j ) = 0.
124  ip( j ) = j
125  iw( j ) = j
126  20 CONTINUE
127  anrm = 1.0
128  rcond = 1.0
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 * SSYTRF
138 *
139  srnamt = 'SSYTRF'
140  infot = 1
141  CALL ssytrf( '/', 0, a, 1, ip, w, 1, info )
142  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
143  infot = 2
144  CALL ssytrf( 'U', -1, a, 1, ip, w, 1, info )
145  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
146  infot = 4
147  CALL ssytrf( 'U', 2, a, 1, ip, w, 4, info )
148  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
149 *
150 * SSYTF2
151 *
152  srnamt = 'SSYTF2'
153  infot = 1
154  CALL ssytf2( '/', 0, a, 1, ip, info )
155  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
156  infot = 2
157  CALL ssytf2( 'U', -1, a, 1, ip, info )
158  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
159  infot = 4
160  CALL ssytf2( 'U', 2, a, 1, ip, info )
161  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
162 *
163 * SSYTRI
164 *
165  srnamt = 'SSYTRI'
166  infot = 1
167  CALL ssytri( '/', 0, a, 1, ip, w, info )
168  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
169  infot = 2
170  CALL ssytri( 'U', -1, a, 1, ip, w, info )
171  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
172  infot = 4
173  CALL ssytri( 'U', 2, a, 1, ip, w, info )
174  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
175 *
176 * SSYTRI2
177 *
178  srnamt = 'SSYTRI2'
179  infot = 1
180  CALL ssytri2( '/', 0, a, 1, ip, w, iw(1), info )
181  CALL chkxer( 'SSYTRI2', infot, nout, lerr, ok )
182  infot = 2
183  CALL ssytri2( 'U', -1, a, 1, ip, w, iw(1), info )
184  CALL chkxer( 'SSYTRI2', infot, nout, lerr, ok )
185  infot = 4
186  CALL ssytri2( 'U', 2, a, 1, ip, w, iw(1), info )
187  CALL chkxer( 'SSYTRI2', infot, nout, lerr, ok )
188 *
189 * SSYTRS
190 *
191  srnamt = 'SSYTRS'
192  infot = 1
193  CALL ssytrs( '/', 0, 0, a, 1, ip, b, 1, info )
194  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
195  infot = 2
196  CALL ssytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
197  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
198  infot = 3
199  CALL ssytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
200  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
201  infot = 5
202  CALL ssytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
203  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
204  infot = 8
205  CALL ssytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
206  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
207 *
208 * SSYRFS
209 *
210  srnamt = 'SSYRFS'
211  infot = 1
212  CALL ssyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
213  $ iw, info )
214  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
215  infot = 2
216  CALL ssyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
217  $ w, iw, info )
218  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
219  infot = 3
220  CALL ssyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
221  $ w, iw, info )
222  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
223  infot = 5
224  CALL ssyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
225  $ iw, info )
226  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
227  infot = 7
228  CALL ssyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
229  $ iw, info )
230  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
231  infot = 10
232  CALL ssyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
233  $ iw, info )
234  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
235  infot = 12
236  CALL ssyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
237  $ iw, info )
238  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
239 *
240 * SSYCON
241 *
242  srnamt = 'SSYCON'
243  infot = 1
244  CALL ssycon( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
245  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
246  infot = 2
247  CALL ssycon( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
248  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
249  infot = 4
250  CALL ssycon( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
251  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
252  infot = 6
253  CALL ssycon( 'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
254  CALL chkxer( 'SSYCON', 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 * SSYTRF_ROOK
263 *
264  srnamt = 'SSYTRF_ROOK'
265  infot = 1
266  CALL ssytrf_rook( '/', 0, a, 1, ip, w, 1, info )
267  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
268  infot = 2
269  CALL ssytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
270  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
271  infot = 4
272  CALL ssytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
273  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
274 *
275 * SSYTF2_ROOK
276 *
277  srnamt = 'SSYTF2_ROOK'
278  infot = 1
279  CALL ssytf2_rook( '/', 0, a, 1, ip, info )
280  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
281  infot = 2
282  CALL ssytf2_rook( 'U', -1, a, 1, ip, info )
283  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
284  infot = 4
285  CALL ssytf2_rook( 'U', 2, a, 1, ip, info )
286  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
287 *
288 * SSYTRI_ROOK
289 *
290  srnamt = 'SSYTRI_ROOK'
291  infot = 1
292  CALL ssytri_rook( '/', 0, a, 1, ip, w, info )
293  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
294  infot = 2
295  CALL ssytri_rook( 'U', -1, a, 1, ip, w, info )
296  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
297  infot = 4
298  CALL ssytri_rook( 'U', 2, a, 1, ip, w, info )
299  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
300 *
301 * SSYTRS_ROOK
302 *
303  srnamt = 'SSYTRS_ROOK'
304  infot = 1
305  CALL ssytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
306  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
307  infot = 2
308  CALL ssytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
309  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
310  infot = 3
311  CALL ssytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
312  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
313  infot = 5
314  CALL ssytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
315  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
316  infot = 8
317  CALL ssytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
318  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
319 *
320 * SSYCON_ROOK
321 *
322  srnamt = 'SSYCON_ROOK'
323  infot = 1
324  CALL ssycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
325  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
326  infot = 2
327  CALL ssycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
328  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
329  infot = 4
330  CALL ssycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
331  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
332  infot = 6
333  CALL ssycon_rook( 'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
334  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
335 *
336 * Test error exits of the routines that use factorization
337 * of a symmetric indefinite packed matrix with patrial
338 * (Bunch-Kaufman) pivoting.
339 *
340  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
341 *
342 * SSPTRF
343 *
344  srnamt = 'SSPTRF'
345  infot = 1
346  CALL ssptrf( '/', 0, a, ip, info )
347  CALL chkxer( 'SSPTRF', infot, nout, lerr, ok )
348  infot = 2
349  CALL ssptrf( 'U', -1, a, ip, info )
350  CALL chkxer( 'SSPTRF', infot, nout, lerr, ok )
351 *
352 * SSPTRI
353 *
354  srnamt = 'SSPTRI'
355  infot = 1
356  CALL ssptri( '/', 0, a, ip, w, info )
357  CALL chkxer( 'SSPTRI', infot, nout, lerr, ok )
358  infot = 2
359  CALL ssptri( 'U', -1, a, ip, w, info )
360  CALL chkxer( 'SSPTRI', infot, nout, lerr, ok )
361 *
362 * SSPTRS
363 *
364  srnamt = 'SSPTRS'
365  infot = 1
366  CALL ssptrs( '/', 0, 0, a, ip, b, 1, info )
367  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
368  infot = 2
369  CALL ssptrs( 'U', -1, 0, a, ip, b, 1, info )
370  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
371  infot = 3
372  CALL ssptrs( 'U', 0, -1, a, ip, b, 1, info )
373  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
374  infot = 7
375  CALL ssptrs( 'U', 2, 1, a, ip, b, 1, info )
376  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
377 *
378 * SSPRFS
379 *
380  srnamt = 'SSPRFS'
381  infot = 1
382  CALL ssprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
383  $ info )
384  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
385  infot = 2
386  CALL ssprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
387  $ info )
388  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
389  infot = 3
390  CALL ssprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
391  $ info )
392  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
393  infot = 8
394  CALL ssprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
395  $ info )
396  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
397  infot = 10
398  CALL ssprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
399  $ info )
400  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
401 *
402 * SSPCON
403 *
404  srnamt = 'SSPCON'
405  infot = 1
406  CALL sspcon( '/', 0, a, ip, anrm, rcond, w, iw, info )
407  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
408  infot = 2
409  CALL sspcon( 'U', -1, a, ip, anrm, rcond, w, iw, info )
410  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
411  infot = 5
412  CALL sspcon( 'U', 1, a, ip, -1.0, rcond, w, iw, info )
413  CALL chkxer( 'SSPCON', 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 SERRSY
423 *
ssytri2
subroutine ssytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRI2
Definition: ssytri2.f:129
ssptrs
subroutine ssptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
SSPTRS
Definition: ssptrs.f:117
ssytrf_rook
subroutine ssytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_ROOK
Definition: ssytrf_rook.f:210
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
ssytrs
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
Definition: ssytrs.f:122
ssytrf
subroutine ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
Definition: ssytrf.f:184
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
ssytf2_rook
subroutine ssytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
Definition: ssytf2_rook.f:196
ssytri
subroutine ssytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI
Definition: ssytri.f:116
ssycon
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
Definition: ssycon.f:132
ssycon_rook
subroutine ssycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_ROOK
Definition: ssycon_rook.f:146
ssytri_rook
subroutine ssytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK
Definition: ssytri_rook.f:131
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
ssytrs_rook
subroutine ssytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS_ROOK
Definition: ssytrs_rook.f:138
ssptri
subroutine ssptri(UPLO, N, AP, IPIV, WORK, INFO)
SSPTRI
Definition: ssptri.f:111
ssprfs
subroutine ssprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSPRFS
Definition: ssprfs.f:181
ssptrf
subroutine ssptrf(UPLO, N, AP, IPIV, INFO)
SSPTRF
Definition: ssptrf.f:159
sspcon
subroutine sspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSPCON
Definition: sspcon.f:127
ssyrfs
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
Definition: ssyrfs.f:193
ssytf2
subroutine ssytf2(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition: ssytf2.f:197

Here is the call graph for this function:

Here is the caller graph for this function: