OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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, 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*> \ingroup complex_lin
52*
53* =====================================================================
54 SUBROUTINE cerrls( PATH, NUNIT )
55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX
69 parameter( nmax = 2 )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER INFO, IRNK
74 REAL RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX )
78 REAL RW( NMAX ), S( NMAX )
79 COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX )
80* ..
81* .. External Functions ..
82 LOGICAL LSAMEN
83 EXTERNAL lsamen
84* ..
85* .. External Subroutines ..
86 EXTERNAL alaesm, cgels, cgelsd, cgelss, cgelsy, chkxer
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 c2 = path( 2: 3 )
101 a( 1, 1 ) = ( 1.0e+0, 0.0e+0 )
102 a( 1, 2 ) = ( 2.0e+0, 0.0e+0 )
103 a( 2, 2 ) = ( 3.0e+0, 0.0e+0 )
104 a( 2, 1 ) = ( 4.0e+0, 0.0e+0 )
105 ok = .true.
106 WRITE( nout, fmt = * )
107*
108* Test error exits for the least squares driver routines.
109*
110 IF( lsamen( 2, c2, 'LS' ) ) THEN
111*
112* CGELS
113*
114 srnamt = 'cgels '
115 INFOT = 1
116 CALL CGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
117 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
118 INFOT = 2
119 CALL CGELS( 'n', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
120 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
121 INFOT = 3
122 CALL CGELS( 'n', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
123 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
124 INFOT = 4
125 CALL CGELS( 'n', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
126 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
127 INFOT = 6
128 CALL CGELS( 'n', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
129 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
130 INFOT = 8
131 CALL CGELS( 'n', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
132 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
133 INFOT = 10
134 CALL CGELS( 'n', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
135 CALL CHKXER( 'cgels ', INFOT, NOUT, LERR, OK )
136*
137* CGELSS
138*
139 SRNAMT = 'cgelss'
140 INFOT = 1
141 CALL CGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
142 $ INFO )
143 CALL CHKXER( 'cgelss', INFOT, NOUT, LERR, OK )
144 INFOT = 2
145 CALL CGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
146 $ INFO )
147 CALL CHKXER( 'cgelss', INFOT, NOUT, LERR, OK )
148 INFOT = 3
149 CALL CGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
150 $ INFO )
151 CALL CHKXER( 'cgelss', INFOT, NOUT, LERR, OK )
152 INFOT = 5
153 CALL CGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, RW,
154 $ INFO )
155 CALL CHKXER( 'cgelss', INFOT, NOUT, LERR, OK )
156 INFOT = 7
157 CALL CGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, RW,
158 $ INFO )
159 CALL CHKXER( 'cgelss', INFOT, NOUT, LERR, OK )
160*
161* CGELSY
162*
163 SRNAMT = 'cgelsy'
164 INFOT = 1
165 CALL CGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
166 $ INFO )
167 CALL CHKXER( 'cgelsy', INFOT, NOUT, LERR, OK )
168 INFOT = 2
169 CALL CGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
170 $ INFO )
171 CALL CHKXER( 'cgelsy', INFOT, NOUT, LERR, OK )
172 INFOT = 3
173 CALL CGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
174 $ INFO )
175 CALL CHKXER( 'cgelsy', INFOT, NOUT, LERR, OK )
176 INFOT = 5
177 CALL CGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, RW,
178 $ INFO )
179 CALL CHKXER( 'cgelsy', INFOT, NOUT, LERR, OK )
180 INFOT = 7
181 CALL CGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, RW,
182 $ INFO )
183 CALL CHKXER( 'cgelsy', INFOT, NOUT, LERR, OK )
184 INFOT = 12
185 CALL CGELSY( 0, 3, 0, A, 1, B, 3, IP, RCOND, IRNK, W, 1, RW,
186 $ INFO )
187 CALL CHKXER( 'cgelsy', INFOT, NOUT, LERR, OK )
188*
189* CGELSD
190*
191 SRNAMT = 'cgelsd'
192 INFOT = 1
193 CALL CGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
194 $ RW, IP, INFO )
195 CALL CHKXER( 'cgelsd', INFOT, NOUT, LERR, OK )
196 INFOT = 2
197 CALL CGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
198 $ RW, IP, INFO )
199 CALL CHKXER( 'cgelsd', INFOT, NOUT, LERR, OK )
200 INFOT = 3
201 CALL CGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10,
202 $ RW, IP, INFO )
203 CALL CHKXER( 'cgelsd', infot, nout, lerr, ok )
204 infot = 5
205 CALL cgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10,
206 $ rw, ip, info )
207 CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
208 infot = 7
209 CALL cgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10,
210 $ rw, ip, info )
211 CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
212 infot = 12
213 CALL cgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1,
214 $ rw, ip, info )
215 CALL chkxer( 'CGELSD', infot, nout, lerr, ok )
216 END IF
217*
218* Print a summary line.
219*
220 CALL alaesm( path, ok, nout )
221*
222 RETURN
223*
224* End of CERRLS
225*
226 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
cgels
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:182
cgelsy
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:210
cgelss
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:178
cgelsd
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:225
cerrls
subroutine cerrls(path, nunit)
CERRLS
Definition cerrls.f:55