LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ serrpo()

subroutine serrpo ( character*3  PATH,
integer  NUNIT 
)

SERRPO

SERRPOX

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

 Note that this file is used only when the XBLAS are available,
 otherwise serrpo.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.

Definition at line 54 of file serrpo.f.

55 *
56 * -- LAPACK test routine --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 *
60 * .. Scalar Arguments ..
61  CHARACTER*3 PATH
62  INTEGER NUNIT
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER NMAX
69  parameter( nmax = 4 )
70 * ..
71 * .. Local Scalars ..
72  CHARACTER*2 C2
73  INTEGER I, INFO, J
74  REAL ANRM, RCOND
75 * ..
76 * .. Local Arrays ..
77  INTEGER IW( NMAX )
78  REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79  $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
80 * ..
81 * .. External Functions ..
82  LOGICAL LSAMEN
83  EXTERNAL lsamen
84 * ..
85 * .. External Subroutines ..
86  EXTERNAL alaesm, chkxer, spbcon, spbequ, spbrfs, spbtf2,
89  $ spptrf, spptri, spptrs
90 * ..
91 * .. Scalars in Common ..
92  LOGICAL LERR, OK
93  CHARACTER*32 SRNAMT
94  INTEGER INFOT, NOUT
95 * ..
96 * .. Common blocks ..
97  COMMON / infoc / infot, nout, ok, lerr
98  COMMON / srnamc / srnamt
99 * ..
100 * .. Intrinsic Functions ..
101  INTRINSIC real
102 * ..
103 * .. Executable Statements ..
104 *
105  nout = nunit
106  WRITE( nout, fmt = * )
107  c2 = path( 2: 3 )
108 *
109 * Set the variables to innocuous values.
110 *
111  DO 20 j = 1, nmax
112  DO 10 i = 1, nmax
113  a( i, j ) = 1. / real( i+j )
114  af( i, j ) = 1. / real( i+j )
115  10 CONTINUE
116  b( j ) = 0.
117  r1( j ) = 0.
118  r2( j ) = 0.
119  w( j ) = 0.
120  x( j ) = 0.
121  iw( j ) = j
122  20 CONTINUE
123  ok = .true.
124 *
125  IF( lsamen( 2, c2, 'PO' ) ) THEN
126 *
127 * Test error exits of the routines that use the Cholesky
128 * decomposition of a symmetric positive definite matrix.
129 *
130 * SPOTRF
131 *
132  srnamt = 'SPOTRF'
133  infot = 1
134  CALL spotrf( '/', 0, a, 1, info )
135  CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
136  infot = 2
137  CALL spotrf( 'U', -1, a, 1, info )
138  CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
139  infot = 4
140  CALL spotrf( 'U', 2, a, 1, info )
141  CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
142 *
143 * SPOTF2
144 *
145  srnamt = 'SPOTF2'
146  infot = 1
147  CALL spotf2( '/', 0, a, 1, info )
148  CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
149  infot = 2
150  CALL spotf2( 'U', -1, a, 1, info )
151  CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
152  infot = 4
153  CALL spotf2( 'U', 2, a, 1, info )
154  CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
155 *
156 * SPOTRI
157 *
158  srnamt = 'SPOTRI'
159  infot = 1
160  CALL spotri( '/', 0, a, 1, info )
161  CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
162  infot = 2
163  CALL spotri( 'U', -1, a, 1, info )
164  CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
165  infot = 4
166  CALL spotri( 'U', 2, a, 1, info )
167  CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
168 *
169 * SPOTRS
170 *
171  srnamt = 'SPOTRS'
172  infot = 1
173  CALL spotrs( '/', 0, 0, a, 1, b, 1, info )
174  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
175  infot = 2
176  CALL spotrs( 'U', -1, 0, a, 1, b, 1, info )
177  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
178  infot = 3
179  CALL spotrs( 'U', 0, -1, a, 1, b, 1, info )
180  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
181  infot = 5
182  CALL spotrs( 'U', 2, 1, a, 1, b, 2, info )
183  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
184  infot = 7
185  CALL spotrs( 'U', 2, 1, a, 2, b, 1, info )
186  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
187 *
188 * SPORFS
189 *
190  srnamt = 'SPORFS'
191  infot = 1
192  CALL sporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, iw,
193  $ info )
194  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
195  infot = 2
196  CALL sporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
197  $ iw, info )
198  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
199  infot = 3
200  CALL sporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
201  $ iw, info )
202  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
203  infot = 5
204  CALL sporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, iw,
205  $ info )
206  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
207  infot = 7
208  CALL sporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, iw,
209  $ info )
210  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
211  infot = 9
212  CALL sporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, iw,
213  $ info )
214  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
215  infot = 11
216  CALL sporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, iw,
217  $ info )
218  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
219 *
220 * SPOCON
221 *
222  srnamt = 'SPOCON'
223  infot = 1
224  CALL spocon( '/', 0, a, 1, anrm, rcond, w, iw, info )
225  CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
226  infot = 2
227  CALL spocon( 'U', -1, a, 1, anrm, rcond, w, iw, info )
228  CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
229  infot = 4
230  CALL spocon( 'U', 2, a, 1, anrm, rcond, w, iw, info )
231  CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
232 *
233 * SPOEQU
234 *
235  srnamt = 'SPOEQU'
236  infot = 1
237  CALL spoequ( -1, a, 1, r1, rcond, anrm, info )
238  CALL chkxer( 'SPOEQU', infot, nout, lerr, ok )
239  infot = 3
240  CALL spoequ( 2, a, 1, r1, rcond, anrm, info )
241  CALL chkxer( 'SPOEQU', infot, nout, lerr, ok )
242 *
243  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
244 *
245 * Test error exits of the routines that use the Cholesky
246 * decomposition of a symmetric positive definite packed matrix.
247 *
248 * SPPTRF
249 *
250  srnamt = 'SPPTRF'
251  infot = 1
252  CALL spptrf( '/', 0, a, info )
253  CALL chkxer( 'SPPTRF', infot, nout, lerr, ok )
254  infot = 2
255  CALL spptrf( 'U', -1, a, info )
256  CALL chkxer( 'SPPTRF', infot, nout, lerr, ok )
257 *
258 * SPPTRI
259 *
260  srnamt = 'SPPTRI'
261  infot = 1
262  CALL spptri( '/', 0, a, info )
263  CALL chkxer( 'SPPTRI', infot, nout, lerr, ok )
264  infot = 2
265  CALL spptri( 'U', -1, a, info )
266  CALL chkxer( 'SPPTRI', infot, nout, lerr, ok )
267 *
268 * SPPTRS
269 *
270  srnamt = 'SPPTRS'
271  infot = 1
272  CALL spptrs( '/', 0, 0, a, b, 1, info )
273  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
274  infot = 2
275  CALL spptrs( 'U', -1, 0, a, b, 1, info )
276  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
277  infot = 3
278  CALL spptrs( 'U', 0, -1, a, b, 1, info )
279  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
280  infot = 6
281  CALL spptrs( 'U', 2, 1, a, b, 1, info )
282  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
283 *
284 * SPPRFS
285 *
286  srnamt = 'SPPRFS'
287  infot = 1
288  CALL spprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
289  $ info )
290  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
291  infot = 2
292  CALL spprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
293  $ info )
294  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
295  infot = 3
296  CALL spprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, iw,
297  $ info )
298  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
299  infot = 7
300  CALL spprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, iw,
301  $ info )
302  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
303  infot = 9
304  CALL spprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, iw,
305  $ info )
306  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
307 *
308 * SPPCON
309 *
310  srnamt = 'SPPCON'
311  infot = 1
312  CALL sppcon( '/', 0, a, anrm, rcond, w, iw, info )
313  CALL chkxer( 'SPPCON', infot, nout, lerr, ok )
314  infot = 2
315  CALL sppcon( 'U', -1, a, anrm, rcond, w, iw, info )
316  CALL chkxer( 'SPPCON', infot, nout, lerr, ok )
317 *
318 * SPPEQU
319 *
320  srnamt = 'SPPEQU'
321  infot = 1
322  CALL sppequ( '/', 0, a, r1, rcond, anrm, info )
323  CALL chkxer( 'SPPEQU', infot, nout, lerr, ok )
324  infot = 2
325  CALL sppequ( 'U', -1, a, r1, rcond, anrm, info )
326  CALL chkxer( 'SPPEQU', infot, nout, lerr, ok )
327 *
328  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
329 *
330 * Test error exits of the routines that use the Cholesky
331 * decomposition of a symmetric positive definite band matrix.
332 *
333 * SPBTRF
334 *
335  srnamt = 'SPBTRF'
336  infot = 1
337  CALL spbtrf( '/', 0, 0, a, 1, info )
338  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
339  infot = 2
340  CALL spbtrf( 'U', -1, 0, a, 1, info )
341  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
342  infot = 3
343  CALL spbtrf( 'U', 1, -1, a, 1, info )
344  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
345  infot = 5
346  CALL spbtrf( 'U', 2, 1, a, 1, info )
347  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
348 *
349 * SPBTF2
350 *
351  srnamt = 'SPBTF2'
352  infot = 1
353  CALL spbtf2( '/', 0, 0, a, 1, info )
354  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
355  infot = 2
356  CALL spbtf2( 'U', -1, 0, a, 1, info )
357  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
358  infot = 3
359  CALL spbtf2( 'U', 1, -1, a, 1, info )
360  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
361  infot = 5
362  CALL spbtf2( 'U', 2, 1, a, 1, info )
363  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
364 *
365 * SPBTRS
366 *
367  srnamt = 'SPBTRS'
368  infot = 1
369  CALL spbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
370  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
371  infot = 2
372  CALL spbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
373  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
374  infot = 3
375  CALL spbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
376  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
377  infot = 4
378  CALL spbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
379  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
380  infot = 6
381  CALL spbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
382  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
383  infot = 8
384  CALL spbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
385  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
386 *
387 * SPBRFS
388 *
389  srnamt = 'SPBRFS'
390  infot = 1
391  CALL spbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
392  $ iw, info )
393  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
394  infot = 2
395  CALL spbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
396  $ iw, info )
397  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
398  infot = 3
399  CALL spbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
400  $ iw, info )
401  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
402  infot = 4
403  CALL spbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
404  $ iw, info )
405  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
406  infot = 6
407  CALL spbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
408  $ iw, info )
409  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
410  infot = 8
411  CALL spbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
412  $ iw, info )
413  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
414  infot = 10
415  CALL spbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
416  $ iw, info )
417  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
418  infot = 12
419  CALL spbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
420  $ iw, info )
421  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
422 *
423 * SPBCON
424 *
425  srnamt = 'SPBCON'
426  infot = 1
427  CALL spbcon( '/', 0, 0, a, 1, anrm, rcond, w, iw, info )
428  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
429  infot = 2
430  CALL spbcon( 'U', -1, 0, a, 1, anrm, rcond, w, iw, info )
431  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
432  infot = 3
433  CALL spbcon( 'U', 1, -1, a, 1, anrm, rcond, w, iw, info )
434  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
435  infot = 5
436  CALL spbcon( 'U', 2, 1, a, 1, anrm, rcond, w, iw, info )
437  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
438 *
439 * SPBEQU
440 *
441  srnamt = 'SPBEQU'
442  infot = 1
443  CALL spbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
444  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
445  infot = 2
446  CALL spbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
447  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
448  infot = 3
449  CALL spbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
450  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
451  infot = 5
452  CALL spbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
453  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
454  END IF
455 *
456 * Print a summary line.
457 *
458  CALL alaesm( path, ok, nout )
459 *
460  RETURN
461 *
462 * End of SERRPO
463 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine spptrf(UPLO, N, AP, INFO)
SPPTRF
Definition: spptrf.f:119
subroutine spbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPBRFS
Definition: spbrfs.f:189
subroutine sppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
SPPEQU
Definition: sppequ.f:116
subroutine spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS
Definition: spptrs.f:108
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
Definition: spprfs.f:171
subroutine spbtf2(UPLO, N, KD, AB, LDAB, INFO)
SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
Definition: spbtf2.f:142
subroutine spbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBTRS
Definition: spbtrs.f:121
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
Definition: sppcon.f:118
subroutine spptri(UPLO, N, AP, INFO)
SPPTRI
Definition: spptri.f:93
subroutine spbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
SPBEQU
Definition: spbequ.f:129
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
Definition: spbcon.f:132
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF
Definition: spbtrf.f:142
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
Definition: spotri.f:95
subroutine spotf2(UPLO, N, A, LDA, INFO)
SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: spotf2.f:109
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
Definition: spotrf.f:107
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
Definition: spocon.f:121
subroutine sporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPORFS
Definition: sporfs.f:183
subroutine spoequ(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQU
Definition: spoequ.f:112
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
Definition: spotrs.f:110
Here is the call graph for this function:
Here is the caller graph for this function: