LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrls.f
Go to the documentation of this file.
1 *> \brief \b CERRLS
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 CERRLS( 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 *> CERRLS tests the error exits for the COMPLEX least squares
25 *> driver routines (CGELS, CGELSS, CGELSX, CGELSY, CGELSD).
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 *> \date November 2011
52 *
53 *> \ingroup complex_lin
54 *
55 * =====================================================================
56  SUBROUTINE cerrls( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.4.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2011
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter( nmax = 2 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 c2
76  INTEGER info, irnk
77  REAL rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER ip( nmax )
81  REAL rw( nmax ), s( nmax )
82  COMPLEX a( nmax, nmax ), b( nmax, nmax ), w( nmax )
83 * ..
84 * .. External Functions ..
85  LOGICAL lsamen
86  EXTERNAL lsamen
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL alaesm, cgels, cgelsd, cgelss, cgelsx, cgelsy,
90  $ chkxer
91 * ..
92 * .. Scalars in Common ..
93  LOGICAL lerr, ok
94  CHARACTER*32 srnamt
95  INTEGER infot, nout
96 * ..
97 * .. Common blocks ..
98  common / infoc / infot, nout, ok, lerr
99  common / srnamc / srnamt
100 * ..
101 * .. Executable Statements ..
102 *
103  nout = nunit
104  c2 = path( 2: 3 )
105  a( 1, 1 ) = ( 1.0e+0, 0.0e+0 )
106  a( 1, 2 ) = ( 2.0e+0, 0.0e+0 )
107  a( 2, 2 ) = ( 3.0e+0, 0.0e+0 )
108  a( 2, 1 ) = ( 4.0e+0, 0.0e+0 )
109  ok = .true.
110  WRITE( nout, fmt = * )
111 *
112 * Test error exits for the least squares driver routines.
113 *
114  IF( lsamen( 2, c2, 'LS' ) ) THEN
115 *
116 * CGELS
117 *
118  srnamt = 'CGELS '
119  infot = 1
120  CALL cgels( '/', 0, 0, 0, a, 1, b, 1, w, 1, info )
121  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
122  infot = 2
123  CALL cgels( 'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
124  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
125  infot = 3
126  CALL cgels( 'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
127  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
128  infot = 4
129  CALL cgels( 'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
130  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
131  infot = 6
132  CALL cgels( 'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
133  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
134  infot = 8
135  CALL cgels( 'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
136  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
137  infot = 10
138  CALL cgels( 'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
139  CALL chkxer( 'CGELS ', infot, nout, lerr, ok )
140 *
141 * CGELSS
142 *
143  srnamt = 'CGELSS'
144  infot = 1
145  CALL cgelss( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 1, rw,
146  $ info )
147  CALL chkxer( 'CGELSS', infot, nout, lerr, ok )
148  infot = 2
149  CALL cgelss( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 1, rw,
150  $ info )
151  CALL chkxer( 'CGELSS', infot, nout, lerr, ok )
152  infot = 3
153  CALL cgelss( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 1, rw,
154  $ info )
155  CALL chkxer( 'CGELSS', infot, nout, lerr, ok )
156  infot = 5
157  CALL cgelss( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 2, rw,
158  $ info )
159  CALL chkxer( 'CGELSS', infot, nout, lerr, ok )
160  infot = 7
161  CALL cgelss( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 2, rw,
162  $ info )
163  CALL chkxer( 'CGELSS', infot, nout, lerr, ok )
164 *
165 * CGELSX
166 *
167  srnamt = 'CGELSX'
168  infot = 1
169  CALL cgelsx( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, rw,
170  $ info )
171  CALL chkxer( 'CGELSX', infot, nout, lerr, ok )
172  infot = 2
173  CALL cgelsx( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, rw,
174  $ info )
175  CALL chkxer( 'CGELSX', infot, nout, lerr, ok )
176  infot = 3
177  CALL cgelsx( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, rw,
178  $ info )
179  CALL chkxer( 'CGELSX', infot, nout, lerr, ok )
180  infot = 5
181  CALL cgelsx( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, rw,
182  $ info )
183  CALL chkxer( 'CGELSX', infot, nout, lerr, ok )
184  infot = 7
185  CALL cgelsx( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, rw,
186  $ info )
187  CALL chkxer( 'CGELSX', infot, nout, lerr, ok )
188 *
189 * CGELSY
190 *
191  srnamt = 'CGELSY'
192  infot = 1
193  CALL cgelsy( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, 10, rw,
194  $ info )
195  CALL chkxer( 'CGELSY', infot, nout, lerr, ok )
196  infot = 2
197  CALL cgelsy( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, 10, rw,
198  $ info )
199  CALL chkxer( 'CGELSY', infot, nout, lerr, ok )
200  infot = 3
201  CALL cgelsy( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, 10, rw,
202  $ info )
203  CALL chkxer( 'CGELSY', infot, nout, lerr, ok )
204  infot = 5
205  CALL cgelsy( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, 10, rw,
206  $ info )
207  CALL chkxer( 'CGELSY', infot, nout, lerr, ok )
208  infot = 7
209  CALL cgelsy( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, 10, rw,
210  $ info )
211  CALL chkxer( 'CGELSY', infot, nout, lerr, ok )
212  infot = 12
213  CALL cgelsy( 0, 3, 0, a, 1, b, 3, ip, rcond, irnk, w, 1, rw,
214  $ info )
215  CALL chkxer( 'CGELSY', infot, nout, lerr, ok )
216 *
217 * CGELSD
218 *
219  srnamt = 'CGELSD'
220  infot = 1
221  CALL cgelsd( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
222  $ rw, ip, info )
223  CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
224  infot = 2
225  CALL cgelsd( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
226  $ rw, ip, info )
227  CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
228  infot = 3
229  CALL cgelsd( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 10,
230  $ rw, ip, info )
231  CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
232  infot = 5
233  CALL cgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10,
234  $ rw, ip, info )
235  CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
236  infot = 7
237  CALL cgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10,
238  $ rw, ip, info )
239  CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
240  infot = 12
241  CALL cgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1,
242  $ rw, ip, info )
243  CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
244  END IF
245 *
246 * Print a summary line.
247 *
248  CALL alaesm( path, ok, nout )
249 *
250  return
251 *
252 * End of CERRLS
253 *
254  END