1*> \brief \b DERRQP
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 DERRQP( 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*> DERRQP tests the error exits for DGEQPF and DGEQP3.
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 double_lin
53*
54*  =====================================================================
55      SUBROUTINE DERRQP( 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   A( NMAX, NMAX ), TAU( NMAX ), W( 3*NMAX+1 )
80*     ..
81*     .. External Functions ..
82      LOGICAL            LSAMEN
83      EXTERNAL           LSAMEN
84*     ..
85*     .. External Subroutines ..
86      EXTERNAL           ALAESM, CHKXER, DGEQP3, DGEQPF
87*     ..
88*     .. Scalars in Common ..
89      LOGICAL            LERR, OK
90      CHARACTER*32       SRNAMT
91      INTEGER            INFOT, NOUT
92*     ..
93*     .. Common blocks ..
94      COMMON             / INFOC / INFOT, NOUT, OK, LERR
95      COMMON             / SRNAMC / SRNAMT
96*     ..
97*     .. Executable Statements ..
98*
99      NOUT = NUNIT
100      WRITE( NOUT, FMT = * )
101      C2 = PATH( 2: 3 )
102      LW = 3*NMAX + 1
103      A( 1, 1 ) = 1.0D+0
104      A( 1, 2 ) = 2.0D+0
105      A( 2, 2 ) = 3.0D+0
106      A( 2, 1 ) = 4.0D+0
107      OK = .TRUE.
108*
109      IF( LSAMEN( 2, C2, 'QP' ) ) THEN
110*
111*        Test error exits for QR factorization with pivoting
112*
113*        DGEQPF
114*
115         SRNAMT = 'DGEQPF'
116         INFOT = 1
117         CALL DGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
118         CALL CHKXER( 'DGEQPF', INFOT, NOUT, LERR, OK )
119         INFOT = 2
120         CALL DGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
121         CALL CHKXER( 'DGEQPF', INFOT, NOUT, LERR, OK )
122         INFOT = 4
123         CALL DGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
124         CALL CHKXER( 'DGEQPF', INFOT, NOUT, LERR, OK )
125*
126*        DGEQP3
127*
128         SRNAMT = 'DGEQP3'
129         INFOT = 1
130         CALL DGEQP3( -1, 0, A, 1, IP, TAU, W, LW, INFO )
131         CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
132         INFOT = 2
133         CALL DGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
134         CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
135         INFOT = 4
136         CALL DGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
137         CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
138         INFOT = 8
139         CALL DGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
140         CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
141      END IF
142*
143*     Print a summary line.
144*
145      CALL ALAESM( PATH, OK, NOUT )
146*
147      RETURN
148*
149*     End of DERRQP
150*
151      END
152