LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
cerrls.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cerrls (PATH, NUNIT)
 CERRLS More...
 

Function/Subroutine Documentation

subroutine cerrls ( character*3  PATH,
integer  NUNIT 
)

CERRLS

Purpose:
 CERRLS tests the error exits for the COMPLEX least squares
 driver routines (CGELS, CGELSS, CGELSX, CGELSY, CGELSD).
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 57 of file cerrls.f.

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 *
subroutine cgelsy(M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, WORK, LWORK, RWORK, INFO)
CGELSY solves overdetermined or underdetermined systems for GE matrices
Definition: cgelsy.f:212
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine cgelsd(M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, WORK, LWORK, RWORK, IWORK, INFO)
CGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices ...
Definition: cgelsd.f:227
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine cgelss(M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, WORK, LWORK, RWORK, INFO)
CGELSS solves overdetermined or underdetermined systems for GE matrices
Definition: cgelss.f:180
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine cgelsx(M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, WORK, RWORK, INFO)
CGELSX solves overdetermined or underdetermined systems for GE matrices
Definition: cgelsx.f:186
subroutine cgels(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO)
CGELS solves overdetermined or underdetermined systems for GE matrices
Definition: cgels.f:184

Here is the call graph for this function:

Here is the caller graph for this function: