LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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 ZGEQP3.
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*> \ingroup complex16_lin
51*
52* =====================================================================
53 SUBROUTINE zerrqp( PATH, NUNIT )
54*
55* -- LAPACK test routine --
56* -- LAPACK is a software package provided by Univ. of Tennessee, --
57* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
58*
59* .. Scalar Arguments ..
60 CHARACTER*3 PATH
61 INTEGER NUNIT
62* ..
63*
64* =====================================================================
65*
66* .. Parameters ..
67 INTEGER NMAX
68 parameter( nmax = 3 )
69* ..
70* .. Local Scalars ..
71 CHARACTER*2 C2
72 INTEGER INFO, LW
73* ..
74* .. Local Arrays ..
75 INTEGER IP( NMAX )
76 DOUBLE PRECISION RW( 2*NMAX )
77 COMPLEX*16 A( NMAX, NMAX ), TAU( NMAX ),
78 $ W( 2*NMAX+3*NMAX )
79* ..
80* .. External Functions ..
81 LOGICAL LSAMEN
82 EXTERNAL lsamen
83* ..
84* .. External Subroutines ..
85 EXTERNAL alaesm, chkxer, zgeqp3
86* ..
87* .. Scalars in Common ..
88 LOGICAL LERR, OK
89 CHARACTER*32 SRNAMT
90 INTEGER INFOT, NOUT
91* ..
92* .. Common blocks ..
93 COMMON / infoc / infot, nout, ok, lerr
94 COMMON / srnamc / srnamt
95* ..
96* .. Intrinsic Functions ..
97 INTRINSIC dcmplx
98* ..
99* .. Executable Statements ..
100*
101 nout = nunit
102 c2 = path( 2: 3 )
103 lw = nmax + 1
104 a( 1, 1 ) = dcmplx( 1.0d+0, -1.0d+0 )
105 a( 1, 2 ) = dcmplx( 2.0d+0, -2.0d+0 )
106 a( 2, 2 ) = dcmplx( 3.0d+0, -3.0d+0 )
107 a( 2, 1 ) = dcmplx( 4.0d+0, -4.0d+0 )
108 ok = .true.
109 WRITE( nout, fmt = * )
110*
111* Test error exits for QR factorization with pivoting
112*
113 IF( lsamen( 2, c2, 'QP' ) ) THEN
114*
115* ZGEQP3
116*
117 srnamt = 'ZGEQP3'
118 infot = 1
119 CALL zgeqp3( -1, 0, a, 1, ip, tau, w, lw, rw, info )
120 CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
121 infot = 2
122 CALL zgeqp3( 1, -1, a, 1, ip, tau, w, lw, rw, info )
123 CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
124 infot = 4
125 CALL zgeqp3( 2, 3, a, 1, ip, tau, w, lw, rw, info )
126 CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
127 infot = 8
128 CALL zgeqp3( 2, 2, a, 2, ip, tau, w, lw-10, rw, info )
129 CALL chkxer( 'ZGEQP3', infot, nout, lerr, ok )
130 END IF
131*
132* Print a summary line.
133*
134 CALL alaesm( path, ok, nout )
135*
136 RETURN
137*
138* End of ZERRQP
139*
140 END
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine zgeqp3(m, n, a, lda, jpvt, tau, work, lwork, rwork, info)
ZGEQP3
Definition zgeqp3.f:159
subroutine zerrqp(path, nunit)
ZERRQP
Definition zerrqp.f:54