LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
zerrac.f
Go to the documentation of this file.
1 *> \brief \b ZERRAC
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 ZERRAC( NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> ZERRPX tests the error exits for ZCPOSV.
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 complex16_lin
44 *
45 * =====================================================================
46  SUBROUTINE zerrac( 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  COMPLEX*16 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 RWORK( NMAX )
70  COMPLEX*16 WORK(NMAX*NMAX)
71  COMPLEX SWORK(NMAX*NMAX)
72 * ..
73 * .. External Subroutines ..
74  EXTERNAL chkxer, zcposv
75 * ..
76 * .. Scalars in Common ..
77  LOGICAL LERR, OK
78  CHARACTER*32 SRNAMT
79  INTEGER INFOT, NOUT
80 * ..
81 * .. Common blocks ..
82  COMMON / infoc / infot, nout, ok, lerr
83  COMMON / srnamc / srnamt
84 * ..
85 * .. Intrinsic Functions ..
86  INTRINSIC dble
87 * ..
88 * .. Executable Statements ..
89 *
90  nout = nunit
91  WRITE( nout, fmt = * )
92 *
93 * Set the variables to innocuous values.
94 *
95  DO 20 j = 1, nmax
96  DO 10 i = 1, nmax
97  a( i, j ) = 1.d0 / dble( i+j )
98  af( i, j ) = 1.d0 / dble( i+j )
99  10 CONTINUE
100  b( j ) = 0.d0
101  r1( j ) = 0.d0
102  r2( j ) = 0.d0
103  w( j ) = 0.d0
104  x( j ) = 0.d0
105  c( j ) = 0.d0
106  r( j ) = 0.d0
107  20 CONTINUE
108  ok = .true.
109 *
110  srnamt = 'ZCPOSV'
111  infot = 1
112  CALL zcposv('/',0,0,a,1,b,1,x,1,work,swork,rwork,iter,info)
113  CALL chkxer( 'ZCPOSV', infot, nout, lerr, ok )
114  infot = 2
115  CALL zcposv('U',-1,0,a,1,b,1,x,1,work,swork,rwork,iter,info)
116  CALL chkxer( 'ZCPOSV', infot, nout, lerr, ok )
117  infot = 3
118  CALL zcposv('U',0,-1,a,1,b,1,x,1,work,swork,rwork,iter,info)
119  CALL chkxer( 'ZCPOSV', infot, nout, lerr, ok )
120  infot = 5
121  CALL zcposv('U',2,1,a,1,b,2,x,2,work,swork,rwork,iter,info)
122  CALL chkxer( 'ZCPOSV', infot, nout, lerr, ok )
123  infot = 7
124  CALL zcposv('U',2,1,a,2,b,1,x,2,work,swork,rwork,iter,info)
125  CALL chkxer( 'ZCPOSV', infot, nout, lerr, ok )
126  infot = 9
127  CALL zcposv('U',2,1,a,2,b,2,x,1,work,swork,rwork,iter,info)
128  CALL chkxer( 'ZCPOSV', infot, nout, lerr, ok )
129 *
130 * Print a summary line.
131 *
132  IF( ok ) THEN
133  WRITE( nout, fmt = 9999 )'ZCPOSV'
134  ELSE
135  WRITE( nout, fmt = 9998 )'ZCPOSV'
136  END IF
137 *
138  9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
139  9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
140  $ 'exits ***' )
141 *
142  RETURN
143 *
144 * End of ZERRAC
145 *
146  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine zerrac(NUNIT)
ZERRAC
Definition: zerrac.f:47
subroutine zcposv(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, SWORK, RWORK, ITER, INFO)
ZCPOSV computes the solution to system of linear equations A * X = B for PO matrices
Definition: zcposv.f:209