LAPACK  3.8.0
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 *> \date December 2016
44 *
45 *> \ingroup double_lin
46 *
47 * =====================================================================
48  SUBROUTINE derrac( NUNIT )
49 *
50 * -- LAPACK test routine (version 3.7.0) --
51 * -- LAPACK is a software package provided by Univ. of Tennessee, --
52 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
53 * December 2016
54 *
55 * .. Scalar Arguments ..
56  INTEGER NUNIT
57 * ..
58 *
59 * =====================================================================
60 *
61 * .. Parameters ..
62  INTEGER NMAX
63  parameter( nmax = 4 )
64 * ..
65 * .. Local Scalars ..
66  INTEGER I, INFO, ITER, J
67 * ..
68 * .. Local Arrays ..
69  DOUBLE PRECISION A( nmax, nmax ), AF( nmax, nmax ), B( nmax ),
70  $ c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
71  $ w( 2*nmax ), x( nmax )
72  DOUBLE PRECISION WORK(nmax*nmax)
73  REAL SWORK(nmax*nmax)
74 * ..
75 * .. External Subroutines ..
76  EXTERNAL chkxer, dsposv
77 * ..
78 * .. Scalars in Common ..
79  LOGICAL LERR, OK
80  CHARACTER*32 SRNAMT
81  INTEGER INFOT, NOUT
82 * ..
83 * .. Common blocks ..
84  COMMON / infoc / infot, nout, ok, lerr
85  COMMON / srnamc / srnamt
86 * ..
87 * .. Intrinsic Functions ..
88  INTRINSIC dble
89 * ..
90 * .. Executable Statements ..
91 *
92  nout = nunit
93  WRITE( nout, fmt = * )
94 *
95 * Set the variables to innocuous values.
96 *
97  DO 20 j = 1, nmax
98  DO 10 i = 1, nmax
99  a( i, j ) = 1.d0 / dble( i+j )
100  af( i, j ) = 1.d0 / dble( i+j )
101  10 CONTINUE
102  b( j ) = 0.d0
103  r1( j ) = 0.d0
104  r2( j ) = 0.d0
105  w( j ) = 0.d0
106  x( j ) = 0.d0
107  c( j ) = 0.d0
108  r( j ) = 0.d0
109  20 CONTINUE
110  ok = .true.
111 *
112  srnamt = 'DSPOSV'
113  infot = 1
114  CALL dsposv('/',0,0,a,1,b,1,x,1,work,swork,iter,info)
115  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
116  infot = 2
117  CALL dsposv('U',-1,0,a,1,b,1,x,1,work,swork,iter,info)
118  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
119  infot = 3
120  CALL dsposv('U',0,-1,a,1,b,1,x,1,work,swork,iter,info)
121  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
122  infot = 5
123  CALL dsposv('U',2,1,a,1,b,2,x,2,work,swork,iter,info)
124  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
125  infot = 7
126  CALL dsposv('U',2,1,a,2,b,1,x,2,work,swork,iter,info)
127  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
128  infot = 9
129  CALL dsposv('U',2,1,a,2,b,2,x,1,work,swork,iter,info)
130  CALL chkxer( 'DSPOSV', infot, nout, lerr, ok )
131 *
132 * Print a summary line.
133 *
134  IF( ok ) THEN
135  WRITE( nout, fmt = 9999 )'DSPOSV'
136  ELSE
137  WRITE( nout, fmt = 9998 )'DSPOSV'
138  END IF
139 *
140  9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
141  9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
142  $ 'exits ***' )
143 *
144  RETURN
145 *
146 * End of DERRAC
147 *
148  END
subroutine derrac(NUNIT)
DERRAC
Definition: derrac.f:49
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
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:201