LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
derrac.f
Go to the documentation of this file.
1 *> \brief \b DERRAC
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE DERRAC( NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> DERRAC tests the error exits for DSPOSV.
24 *> \endverbatim
25 *
26 * Arguments:
27 * ==========
28 *
29 *> \param[in] NUNIT
30 *> \verbatim
31 *> NUNIT is INTEGER
32 *> The unit number for output.
33 *> \endverbatim
34 *
35 * Authors:
36 * ========
37 *
38 *> \author Univ. of Tennessee
39 *> \author Univ. of California Berkeley
40 *> \author Univ. of Colorado Denver
41 *> \author NAG Ltd.
42 *
43 *> \ingroup double_lin
44 *
45 * =====================================================================
46  SUBROUTINE derrac( NUNIT )
47 *
48 * -- LAPACK test routine --
49 * -- LAPACK is a software package provided by Univ. of Tennessee, --
50 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
51 *
52 * .. Scalar Arguments ..
53  INTEGER NUNIT
54 * ..
55 *
56 * =====================================================================
57 *
58 * .. Parameters ..
59  INTEGER NMAX
60  parameter( nmax = 4 )
61 * ..
62 * .. Local Scalars ..
63  INTEGER I, INFO, ITER, J
64 * ..
65 * .. Local Arrays ..
66  DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
67  $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
68  $ W( 2*NMAX ), X( NMAX )
69  DOUBLE PRECISION WORK(NMAX*NMAX)
70  REAL SWORK(NMAX*NMAX)
71 * ..
72 * .. External Subroutines ..
73  EXTERNAL chkxer, dsposv
74 * ..
75 * .. Scalars in Common ..
76  LOGICAL LERR, OK
77  CHARACTER*32 SRNAMT
78  INTEGER INFOT, NOUT
79 * ..
80 * .. Common blocks ..
81  COMMON / infoc / infot, nout, ok, lerr
82  COMMON / srnamc / srnamt
83 * ..
84 * .. Intrinsic Functions ..
85  INTRINSIC dble
86 * ..
87 * .. Executable Statements ..
88 *
89  nout = nunit
90  WRITE( nout, fmt = * )
91 *
92 * Set the variables to innocuous values.
93 *
94  DO 20 j = 1, nmax
95  DO 10 i = 1, nmax
96  a( i, j ) = 1.d0 / dble( i+j )
97  af( i, j ) = 1.d0 / dble( i+j )
98  10 CONTINUE
99  b( j ) = 0.d0
100  r1( j ) = 0.d0
101  r2( j ) = 0.d0
102  w( j ) = 0.d0
103  x( j ) = 0.d0
104  c( j ) = 0.d0
105  r( j ) = 0.d0
106  20 CONTINUE
107  ok = .true.
108 *
109  srnamt = 'DSPOSV'
110  infot = 1
111  CALL dsposv('/',0,0,a,1,b,1,x,1,work,swork,iter,info)
112  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
113  infot = 2
114  CALL dsposv('U',-1,0,a,1,b,1,x,1,work,swork,iter,info)
115  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
116  infot = 3
117  CALL dsposv('U',0,-1,a,1,b,1,x,1,work,swork,iter,info)
118  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
119  infot = 5
120  CALL dsposv('U',2,1,a,1,b,2,x,2,work,swork,iter,info)
121  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
122  infot = 7
123  CALL dsposv('U',2,1,a,2,b,1,x,2,work,swork,iter,info)
124  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
125  infot = 9
126  CALL dsposv('U',2,1,a,2,b,2,x,1,work,swork,iter,info)
127  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
128 *
129 * Print a summary line.
130 *
131  IF( ok ) THEN
132  WRITE( nout, fmt = 9999 )'DSPOSV'
133  ELSE
134  WRITE( nout, fmt = 9998 )'DSPOSV'
135  END IF
136 *
137  9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
138  9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
139  $ 'exits ***' )
140 *
141  RETURN
142 *
143 * End of DERRAC
144 *
145  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine derrac(NUNIT)
DERRAC
Definition: derrac.f:47
subroutine dsposv(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, SWORK, ITER, INFO)
DSPOSV computes the solution to system of linear equations A * X = B for PO matrices
Definition: dsposv.f:199