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