1*> \brief \b DERRTSQR
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 DERRTSQR( 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*> DERRTSQR tests the error exits for the DOUBLE PRECISION routines
25*> that use the TSQR decomposition of a general matrix.
26*> \endverbatim
27*
28*  Arguments:
29*  ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*>          PATH is CHARACTER*3
34*>          The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*>          NUNIT is INTEGER
40*>          The unit number for output.
41*> \endverbatim
42*
43*  Authors:
44*  ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup double_lin
52*
53*  =====================================================================
54      SUBROUTINE DERRTSQR( PATH, NUNIT )
55      IMPLICIT NONE
56*
57*  -- LAPACK test routine --
58*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
59*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60*
61*     .. Scalar Arguments ..
62      CHARACTER*3        PATH
63      INTEGER            NUNIT
64*     ..
65*
66*  =====================================================================
67*
68*     .. Parameters ..
69      INTEGER            NMAX
70      PARAMETER          ( NMAX = 2 )
71*     ..
72*     .. Local Scalars ..
73      INTEGER            I, INFO, J, NB
74*     ..
75*     .. Local Arrays ..
76      DOUBLE PRECISION   A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77     $                   C( NMAX, NMAX ), TAU(NMAX*2)
78*     ..
79*     .. External Subroutines ..
80      EXTERNAL           ALAESM, CHKXER, DGEQR,
81     $                   DGEMQR, DGELQ, DGEMLQ
82*     ..
83*     .. Scalars in Common ..
84      LOGICAL            LERR, OK
85      CHARACTER*32       SRNAMT
86      INTEGER            INFOT, NOUT
87*     ..
88*     .. Common blocks ..
89      COMMON             / INFOC / INFOT, NOUT, OK, LERR
90      COMMON             / SRNAMC / SRNAMT
91*     ..
92*     .. Intrinsic Functions ..
93      INTRINSIC          DBLE
94*     ..
95*     .. Executable Statements ..
96*
97      NOUT = NUNIT
98      WRITE( NOUT, FMT = * )
99*
100*     Set the variables to innocuous values.
101*
102      DO J = 1, NMAX
103         DO I = 1, NMAX
104            A( I, J ) = 1.D0 / DBLE( I+J )
105            C( I, J ) = 1.D0 / DBLE( I+J )
106            T( I, J ) = 1.D0 / DBLE( I+J )
107         END DO
108         W( J ) = 0.D0
109      END DO
110      OK = .TRUE.
111*
112*     Error exits for TS factorization
113*
114*     DGEQR
115*
116      SRNAMT = 'DGEQR'
117      INFOT = 1
118      CALL DGEQR( -1, 0, A, 1, TAU, 1, W, 1, INFO )
119      CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK )
120      INFOT = 2
121      CALL DGEQR( 0, -1, A, 1, TAU, 1, W, 1, INFO )
122      CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK )
123      INFOT = 4
124      CALL DGEQR( 1, 1, A, 0, TAU, 1, W, 1, INFO )
125      CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK )
126      INFOT = 6
127      CALL DGEQR( 3, 2, A, 3, TAU, 1, W, 1, INFO )
128      CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK )
129      INFOT = 8
130      CALL DGEQR( 3, 2, A, 3, TAU, 7, W, 0, INFO )
131      CALL CHKXER( 'DGEQR', INFOT, NOUT, LERR, OK )
132*
133*     DGEMQR
134*
135      TAU(1)=1
136      TAU(2)=1
137      TAU(3)=1
138      TAU(4)=1
139      SRNAMT = 'DGEMQR'
140      NB=1
141      INFOT = 1
142      CALL DGEMQR( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
143      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
144      INFOT = 2
145      CALL DGEMQR( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
146      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
147      INFOT = 3
148      CALL DGEMQR( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO)
149      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
150      INFOT = 4
151      CALL DGEMQR( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO)
152      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
153      INFOT = 5
154      CALL DGEMQR( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO)
155      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
156      INFOT = 5
157      CALL DGEMQR( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO)
158      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
159      INFOT = 7
160      CALL DGEMQR( 'L', 'N', 2, 1, 0, A, 0, TAU, 1, C, 1, W, 1,INFO)
161      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
162      INFOT = 9
163      CALL DGEMQR( 'R', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO)
164      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
165      INFOT = 9
166      CALL DGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO)
167      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
168      INFOT = 11
169      CALL DGEMQR( 'L', 'N', 2, 1, 1, A, 2, TAU, 6, C, 0, W, 1,INFO)
170      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
171      INFOT = 13
172      CALL DGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO)
173      CALL CHKXER( 'DGEMQR', INFOT, NOUT, LERR, OK )
174*
175*     DGELQ
176*
177      SRNAMT = 'DGELQ'
178      INFOT = 1
179      CALL DGELQ( -1, 0, A, 1, TAU, 1, W, 1, INFO )
180      CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK )
181      INFOT = 2
182      CALL DGELQ( 0, -1, A, 1, TAU, 1, W, 1, INFO )
183      CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK )
184      INFOT = 4
185      CALL DGELQ( 1, 1, A, 0, TAU, 1, W, 1, INFO )
186      CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK )
187      INFOT = 6
188      CALL DGELQ( 2, 3, A, 3, TAU, 1, W, 1, INFO )
189      CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK )
190      INFOT = 8
191      CALL DGELQ( 2, 3, A, 3, TAU, 7, W, 0, INFO )
192      CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK )
193*
194*     DGEMLQ
195*
196      TAU(1)=1
197      TAU(2)=1
198      SRNAMT = 'DGEMLQ'
199      NB=1
200      INFOT = 1
201      CALL DGEMLQ( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
202      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
203      INFOT = 2
204      CALL DGEMLQ( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
205      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
206      INFOT = 3
207      CALL DGEMLQ( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO)
208      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
209      INFOT = 4
210      CALL DGEMLQ( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO)
211      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
212      INFOT = 5
213      CALL DGEMLQ( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO)
214      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
215      INFOT = 5
216      CALL DGEMLQ( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO)
217      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
218      INFOT = 7
219      CALL DGEMLQ( 'L', 'N', 1, 2, 0, A, 0, TAU, 1, C, 1, W, 1,INFO)
220      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
221      INFOT = 9
222      CALL DGEMLQ( 'R', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO)
223      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
224      INFOT = 9
225      CALL DGEMLQ( 'L', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO)
226      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
227      INFOT = 11
228      CALL DGEMLQ( 'L', 'N', 1, 2, 1, A, 1, TAU, 6, C, 0, W, 1,INFO)
229      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
230      INFOT = 13
231      CALL DGEMLQ( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO)
232      CALL CHKXER( 'DGEMLQ', INFOT, NOUT, LERR, OK )
233*
234*     Print a summary line.
235*
236      CALL ALAESM( PATH, OK, NOUT )
237*
238      RETURN
239*
240*     End of DERRTSQR
241*
242      END
243