LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrqp.f
Go to the documentation of this file.
1 *> \brief \b ZERRQP
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 ZERRQP( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> ZERRQP tests the error exits for ZGEQPF and CGEQP3.
25 *> \endverbatim
26 *
27 * Arguments:
28 * ==========
29 *
30 *> \param[in] PATH
31 *> \verbatim
32 *> PATH is CHARACTER*3
33 *> The LAPACK path name for the routines to be tested.
34 *> \endverbatim
35 *>
36 *> \param[in] NUNIT
37 *> \verbatim
38 *> NUNIT is INTEGER
39 *> The unit number for output.
40 *> \endverbatim
41 *
42 * Authors:
43 * ========
44 *
45 *> \author Univ. of Tennessee
46 *> \author Univ. of California Berkeley
47 *> \author Univ. of Colorado Denver
48 *> \author NAG Ltd.
49 *
50 *> \date November 2011
51 *
52 *> \ingroup complex16_lin
53 *
54 * =====================================================================
55  SUBROUTINE zerrqp( PATH, NUNIT )
56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  CHARACTER*3 path
64  INTEGER nunit
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  INTEGER nmax
71  parameter( nmax = 3 )
72 * ..
73 * .. Local Scalars ..
74  CHARACTER*2 c2
75  INTEGER info, lw
76 * ..
77 * .. Local Arrays ..
78  INTEGER ip( nmax )
79  DOUBLE PRECISION rw( 2*nmax )
80  COMPLEX*16 a( nmax, nmax ), tau( nmax ),
81  $ w( 2*nmax+3*nmax )
82 * ..
83 * .. External Functions ..
84  LOGICAL lsamen
85  EXTERNAL lsamen
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL alaesm, chkxer, zgeqp3, zgeqpf
89 * ..
90 * .. Scalars in Common ..
91  LOGICAL lerr, ok
92  CHARACTER*32 srnamt
93  INTEGER infot, nout
94 * ..
95 * .. Common blocks ..
96  common / infoc / infot, nout, ok, lerr
97  common / srnamc / srnamt
98 * ..
99 * .. Intrinsic Functions ..
100  INTRINSIC dcmplx
101 * ..
102 * .. Executable Statements ..
103 *
104  nout = nunit
105  c2 = path( 2: 3 )
106  lw = nmax + 1
107  a( 1, 1 ) = dcmplx( 1.0d+0, -1.0d+0 )
108  a( 1, 2 ) = dcmplx( 2.0d+0, -2.0d+0 )
109  a( 2, 2 ) = dcmplx( 3.0d+0, -3.0d+0 )
110  a( 2, 1 ) = dcmplx( 4.0d+0, -4.0d+0 )
111  ok = .true.
112  WRITE( nout, fmt = * )
113 *
114 * Test error exits for QR factorization with pivoting
115 *
116  IF( lsamen( 2, c2, 'QP' ) ) THEN
117 *
118 * ZGEQPF
119 *
120  srnamt = 'ZGEQPF'
121  infot = 1
122  CALL zgeqpf( -1, 0, a, 1, ip, tau, w, rw, info )
123  CALL chkxer( 'ZGEQPF', infot, nout, lerr, ok )
124  infot = 2
125  CALL zgeqpf( 0, -1, a, 1, ip, tau, w, rw, info )
126  CALL chkxer( 'ZGEQPF', infot, nout, lerr, ok )
127  infot = 4
128  CALL zgeqpf( 2, 0, a, 1, ip, tau, w, rw, info )
129  CALL chkxer( 'ZGEQPF', infot, nout, lerr, ok )
130 *
131 * ZGEQP3
132 *
133  srnamt = 'ZGEQP3'
134  infot = 1
135  CALL zgeqp3( -1, 0, a, 1, ip, tau, w, lw, rw, info )
136  CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
137  infot = 2
138  CALL zgeqp3( 1, -1, a, 1, ip, tau, w, lw, rw, info )
139  CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
140  infot = 4
141  CALL zgeqp3( 2, 3, a, 1, ip, tau, w, lw, rw, info )
142  CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
143  infot = 8
144  CALL zgeqp3( 2, 2, a, 2, ip, tau, w, lw-10, rw, info )
145  CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
146  END IF
147 *
148 * Print a summary line.
149 *
150  CALL alaesm( path, ok, nout )
151 *
152  return
153 *
154 * End of ZERRQP
155 *
156  END