PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
serrpo.f
Go to the documentation of this file.
1  SUBROUTINE serrpo( PATH, NUNIT )
2 *
3  include 'plasmaf.h'
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10  CHARACTER*3 path
11  INTEGER nunit
12 * ..
13 *
14 * Purpose
15 * =======
16 *
17 * SERRPO tests the error exits for the REAL routines
18 * for symmetric positive definite matrices.
19 *
20 * Arguments
21 * =========
22 *
23 * PATH (input) CHARACTER*3
24 * The LAPACK path name for the routines to be tested.
25 *
26 * NUNIT (input) INTEGER
27 * The unit number for output.
28 *
29 * =====================================================================
30 *
31 * .. Parameters ..
32  INTEGER nmax
33  parameter( nmax = 4 )
34 * ..
35 * .. Local Scalars ..
36  CHARACTER*2 c2
37  INTEGER i, info, j
38  REAL anrm, rcond
39 * ..
40 * .. Local Arrays ..
41  INTEGER iw( nmax )
42  REAL a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
43  $ r1( nmax ), r2( nmax ), w( 3*nmax ), x( nmax )
44 * ..
45 * .. External Functions ..
46  LOGICAL lsamen
47  EXTERNAL lsamen
48 * ..
49 * .. External Subroutines ..
50  EXTERNAL alaesm, chkxer, spbcon, spbequ, spbrfs, spbtf2,
51  $ spbtrf, spbtrs, spocon, spoequ, sporfs, spotf2,
52  $ spotrf, spotri, spotrs, sppcon, sppequ, spprfs,
53  $ spptrf, spptri, spptrs
54 * ..
55 * .. Scalars in Common ..
56  LOGICAL lerr, ok
57  CHARACTER*32 srnamt
58  INTEGER infot, nout
59 * ..
60 * .. Common blocks ..
61  common / infoc / infot, nout, ok, lerr
62  common / srnamc / srnamt
63 * ..
64 * .. Intrinsic Functions ..
65  INTRINSIC real
66 * ..
67 * .. Executable Statements ..
68 *
69  nout = nunit
70  WRITE( nout, fmt = * )
71  c2 = path( 2: 3 )
72 *
73 * Disable PLASMA warnings/errors
74 *
75  CALL plasma_disable( plasma_warnings, info )
76  CALL plasma_disable( plasma_errors, info )
77 *
78 * Set the variables to innocuous values.
79 *
80  DO 20 j = 1, nmax
81  DO 10 i = 1, nmax
82  a( i, j ) = 1. / REAL( i+j )
83  af( i, j ) = 1. / REAL( i+j )
84  10 continue
85  b( j ) = 0.
86  r1( j ) = 0.
87  r2( j ) = 0.
88  w( j ) = 0.
89  x( j ) = 0.
90  iw( j ) = j
91  20 continue
92  ok = .true.
93 *
94  IF( lsamen( 2, c2, 'PO' ) ) THEN
95 *
96 * Test error exits of the routines that use the Cholesky
97 * decomposition of a symmetric positive definite matrix.
98 *
99 * SPOTRF
100 *
101  srnamt = 'SPOTRF'
102  infot = 1
103  CALL plasma_spotrf( '/', 0, a, 1, info )
104  CALL chkxer( 'SPOTRF', infot, nout, info, ok )
105  infot = 2
106  CALL plasma_spotrf( plasmaupper, -1, a, 1, info )
107  CALL chkxer( 'SPOTRF', infot, nout, info, ok )
108  infot = 4
109  CALL plasma_spotrf( plasmaupper, 2, a, 1, info )
110  CALL chkxer( 'SPOTRF', infot, nout, info, ok )
111 *
112 * SPOTRS
113 *
114  srnamt = 'SPOTRS'
115  infot = 1
116  CALL plasma_spotrs( '/', 0, 0, a, 1, b, 1, info )
117  CALL chkxer( 'SPOTRS', infot, nout, info, ok )
118  infot = 2
119  CALL plasma_spotrs( plasmaupper, -1, 0, a, 1, b, 1, info )
120  CALL chkxer( 'SPOTRS', infot, nout, info, ok )
121  infot = 3
122  CALL plasma_spotrs( plasmaupper, 0, -1, a, 1, b, 1, info )
123  CALL chkxer( 'SPOTRS', infot, nout, info, ok )
124  infot = 5
125  CALL plasma_spotrs( plasmaupper, 2, 1, a, 1, b, 2, info )
126  CALL chkxer( 'SPOTRS', infot, nout, info, ok )
127  infot = 7
128  CALL plasma_spotrs( plasmaupper, 2, 1, a, 2, b, 1, info )
129  CALL chkxer( 'SPOTRS', infot, nout, info, ok )
130  END IF
131 *
132 * Print a summary line.
133 *
134  CALL alaesm( path, ok, nout )
135 *
136 * Enable PLASMA warnings/errors
137 *
138  CALL plasma_enable( plasma_warnings, info )
139  CALL plasma_enable( plasma_errors, info )
140 *
141  return
142 *
143 * End of SERRPO
144 *
145  END