MAGMA  1.2.0
MatrixAlgebraonGPUandMulticoreArchitectures
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
serrps.f
Go to the documentation of this file.
1  SUBROUTINE serrps( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Craig Lucas, University of Manchester / NAG Ltd.
5 * October, 2008
6 *
7 * .. Scalar Arguments ..
8  INTEGER nunit
9  CHARACTER*3 path
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRPS tests the error exits for the REAL routines
16 * for SPSTRF..
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30  INTEGER nmax
31  parameter( nmax = 4 )
32 * ..
33 * .. Local Scalars ..
34  INTEGER i, info, j
35 * ..
36 * .. Local Arrays ..
37  REAL a( nmax, nmax ), work( 2*nmax )
38  INTEGER piv( nmax )
39 * ..
40 * .. External Subroutines ..
41  EXTERNAL alaesm, chkxer, spstf2, spstrf
42 * ..
43 * .. Scalars in Common ..
44  INTEGER infot, nout
45  LOGICAL lerr, ok
46  CHARACTER*32 srnamt
47 * ..
48 * .. Common blocks ..
49  common / infoc / infot, nout, ok, lerr
50  common / srnamc / srnamt
51 * ..
52 * .. Intrinsic Functions ..
53  INTRINSIC real
54 * ..
55 * .. Executable Statements ..
56 *
57  nout = nunit
58  WRITE( nout, fmt = * )
59 *
60 * Set the variables to innocuous values.
61 *
62  DO 110 j = 1, nmax
63  DO 100 i = 1, nmax
64  a( i, j ) = 1.0 / REAL( i+j )
65 *
66  100 continue
67  piv( j ) = j
68  work( j ) = 0.
69  work( nmax+j ) = 0.
70 *
71  110 continue
72  ok = .true.
73 *
74 *
75 * Test error exits of the routines that use the Cholesky
76 * decomposition of a symmetric positive semidefinite matrix.
77 *
78 * SPSTRF
79 *
80  srnamt = 'SPSTRF'
81  infot = 1
82  CALL spstrf( '/', 0, a, 1, piv, 1, -1.0, work, info )
83  CALL chkxer( 'SPSTRF', infot, nout, lerr, ok )
84  infot = 2
85  CALL spstrf( 'U', -1, a, 1, piv, 1, -1.0, work, info )
86  CALL chkxer( 'SPSTRF', infot, nout, lerr, ok )
87  infot = 4
88  CALL spstrf( 'U', 2, a, 1, piv, 1, -1.0, work, info )
89  CALL chkxer( 'SPSTRF', infot, nout, lerr, ok )
90 *
91 * SPSTF2
92 *
93  srnamt = 'SPSTF2'
94  infot = 1
95  CALL spstf2( '/', 0, a, 1, piv, 1, -1.0, work, info )
96  CALL chkxer( 'SPSTF2', infot, nout, lerr, ok )
97  infot = 2
98  CALL spstf2( 'U', -1, a, 1, piv, 1, -1.0, work, info )
99  CALL chkxer( 'SPSTF2', infot, nout, lerr, ok )
100  infot = 4
101  CALL spstf2( 'U', 2, a, 1, piv, 1, -1.0, work, info )
102  CALL chkxer( 'SPSTF2', infot, nout, lerr, ok )
103 *
104 *
105 * Print a summary line.
106 *
107  CALL alaesm( path, ok, nout )
108 *
109  return
110 *
111 * End of SERRPS
112 *
113  END