LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ccklse.f
Go to the documentation of this file.
1*> \brief \b CCKLSE
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 CCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
12* NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
13* INFO )
14*
15* .. Scalar Arguments ..
16* INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT
17* REAL THRESH
18* ..
19* .. Array Arguments ..
20* INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
21* REAL RWORK( * )
22* COMPLEX A( * ), AF( * ), B( * ), BF( * ), WORK( * ),
23* $ X( * )
24* ..
25*
26*
27*> \par Purpose:
28* =============
29*>
30*> \verbatim
31*>
32*> CCKLSE tests CGGLSE - a subroutine for solving linear equality
33*> constrained least square problem (LSE).
34*> \endverbatim
35*
36* Arguments:
37* ==========
38*
39*> \param[in] NN
40*> \verbatim
41*> NN is INTEGER
42*> The number of values of (M,P,N) contained in the vectors
43*> (MVAL, PVAL, NVAL).
44*> \endverbatim
45*>
46*> \param[in] MVAL
47*> \verbatim
48*> MVAL is INTEGER array, dimension (NN)
49*> The values of the matrix row(column) dimension M.
50*> \endverbatim
51*>
52*> \param[in] PVAL
53*> \verbatim
54*> PVAL is INTEGER array, dimension (NN)
55*> The values of the matrix row(column) dimension P.
56*> \endverbatim
57*>
58*> \param[in] NVAL
59*> \verbatim
60*> NVAL is INTEGER array, dimension (NN)
61*> The values of the matrix column(row) dimension N.
62*> \endverbatim
63*>
64*> \param[in] NMATS
65*> \verbatim
66*> NMATS is INTEGER
67*> The number of matrix types to be tested for each combination
68*> of matrix dimensions. If NMATS >= NTYPES (the maximum
69*> number of matrix types), then all the different types are
70*> generated for testing. If NMATS < NTYPES, another input line
71*> is read to get the numbers of the matrix types to be used.
72*> \endverbatim
73*>
74*> \param[in,out] ISEED
75*> \verbatim
76*> ISEED is INTEGER array, dimension (4)
77*> On entry, the seed of the random number generator. The array
78*> elements should be between 0 and 4095, otherwise they will be
79*> reduced mod 4096, and ISEED(4) must be odd.
80*> On exit, the next seed in the random number sequence after
81*> all the test matrices have been generated.
82*> \endverbatim
83*>
84*> \param[in] THRESH
85*> \verbatim
86*> THRESH is REAL
87*> The threshold value for the test ratios. A result is
88*> included in the output file if RESULT >= THRESH. To have
89*> every test ratio printed, use THRESH = 0.
90*> \endverbatim
91*>
92*> \param[in] NMAX
93*> \verbatim
94*> NMAX is INTEGER
95*> The maximum value permitted for M or N, used in dimensioning
96*> the work arrays.
97*> \endverbatim
98*>
99*> \param[out] A
100*> \verbatim
101*> A is COMPLEX array, dimension (NMAX*NMAX)
102*> \endverbatim
103*>
104*> \param[out] AF
105*> \verbatim
106*> AF is COMPLEX array, dimension (NMAX*NMAX)
107*> \endverbatim
108*>
109*> \param[out] B
110*> \verbatim
111*> B is COMPLEX array, dimension (NMAX*NMAX)
112*> \endverbatim
113*>
114*> \param[out] BF
115*> \verbatim
116*> BF is COMPLEX array, dimension (NMAX*NMAX)
117*> \endverbatim
118*>
119*> \param[out] X
120*> \verbatim
121*> X is COMPLEX array, dimension (5*NMAX)
122*> \endverbatim
123*>
124*> \param[out] WORK
125*> \verbatim
126*> WORK is COMPLEX array, dimension (NMAX*NMAX)
127*> \endverbatim
128*>
129*> \param[out] RWORK
130*> \verbatim
131*> RWORK is REAL array, dimension (NMAX)
132*> \endverbatim
133*>
134*> \param[in] NIN
135*> \verbatim
136*> NIN is INTEGER
137*> The unit number for input.
138*> \endverbatim
139*>
140*> \param[in] NOUT
141*> \verbatim
142*> NOUT is INTEGER
143*> The unit number for output.
144*> \endverbatim
145*>
146*> \param[out] INFO
147*> \verbatim
148*> INFO is INTEGER
149*> = 0 : successful exit
150*> > 0 : If CLATMS returns an error code, the absolute value
151*> of it is returned.
152*> \endverbatim
153*
154* Authors:
155* ========
156*
157*> \author Univ. of Tennessee
158*> \author Univ. of California Berkeley
159*> \author Univ. of Colorado Denver
160*> \author NAG Ltd.
161*
162*> \ingroup complex_eig
163*
164* =====================================================================
165 SUBROUTINE ccklse( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
166 $ NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
167 $ INFO )
168*
169* -- LAPACK test routine --
170* -- LAPACK is a software package provided by Univ. of Tennessee, --
171* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172*
173* .. Scalar Arguments ..
174 INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT
175 REAL THRESH
176* ..
177* .. Array Arguments ..
178 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
179 REAL RWORK( * )
180 COMPLEX A( * ), AF( * ), B( * ), BF( * ), WORK( * ),
181 $ x( * )
182* ..
183*
184* =====================================================================
185*
186* .. Parameters ..
187 INTEGER NTESTS
188 PARAMETER ( NTESTS = 7 )
189 INTEGER NTYPES
190 parameter( ntypes = 8 )
191* ..
192* .. Local Scalars ..
193 LOGICAL FIRSTT
194 CHARACTER DISTA, DISTB, TYPE
195 CHARACTER*3 PATH
196 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
197 $ ldb, lwork, m, modea, modeb, n, nfail, nrun,
198 $ nt, p
199 REAL ANORM, BNORM, CNDNMA, CNDNMB
200* ..
201* .. Local Arrays ..
202 LOGICAL DOTYPE( NTYPES )
203 REAL RESULT( NTESTS )
204* ..
205* .. External Subroutines ..
206 EXTERNAL alahdg, alareq, alasum, clarhs, clatms, clsets,
207 $ slatb9
208* ..
209* .. Intrinsic Functions ..
210 INTRINSIC abs, max
211* ..
212* .. Executable Statements ..
213*
214* Initialize constants and the random number seed.
215*
216 path( 1: 3 ) = 'LSE'
217 info = 0
218 nrun = 0
219 nfail = 0
220 firstt = .true.
221 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
222 lda = nmax
223 ldb = nmax
224 lwork = nmax*nmax
225*
226* Check for valid input values.
227*
228 DO 10 ik = 1, nn
229 m = mval( ik )
230 p = pval( ik )
231 n = nval( ik )
232 IF( p.GT.n .OR. n.GT.m+p ) THEN
233 IF( firstt ) THEN
234 WRITE( nout, fmt = * )
235 firstt = .false.
236 END IF
237 WRITE( nout, fmt = 9997 )m, p, n
238 END IF
239 10 CONTINUE
240 firstt = .true.
241*
242* Do for each value of M in MVAL.
243*
244 DO 40 ik = 1, nn
245 m = mval( ik )
246 p = pval( ik )
247 n = nval( ik )
248 IF( p.GT.n .OR. n.GT.m+p )
249 $ GO TO 40
250*
251 DO 30 imat = 1, ntypes
252*
253* Do the tests only if DOTYPE( IMAT ) is true.
254*
255 IF( .NOT.dotype( imat ) )
256 $ GO TO 30
257*
258* Set up parameters with SLATB9 and generate test
259* matrices A and B with CLATMS.
260*
261 CALL slatb9( path, imat, m, p, n, TYPE, kla, kua, klb, kub,
262 $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
263 $ dista, distb )
264*
265 CALL clatms( m, n, dista, iseed, TYPE, rwork, modea, cndnma,
266 $ anorm, kla, kua, 'No packing', a, lda, work,
267 $ iinfo )
268 IF( iinfo.NE.0 ) THEN
269 WRITE( nout, fmt = 9999 )iinfo
270 info = abs( iinfo )
271 GO TO 30
272 END IF
273*
274 CALL clatms( p, n, distb, iseed, TYPE, rwork, modeb, cndnmb,
275 $ bnorm, klb, kub, 'No packing', b, ldb, work,
276 $ iinfo )
277 IF( iinfo.NE.0 ) THEN
278 WRITE( nout, fmt = 9999 )iinfo
279 info = abs( iinfo )
280 GO TO 30
281 END IF
282*
283* Generate the right-hand sides C and D for the LSE.
284*
285 CALL clarhs( 'CGE', 'New solution', 'Upper', 'N', m, n,
286 $ max( m-1, 0 ), max( n-1, 0 ), 1, a, lda,
287 $ x( 4*nmax+1 ), max( n, 1 ), x, max( m, 1 ),
288 $ iseed, iinfo )
289*
290 CALL clarhs( 'CGE', 'Computed', 'Upper', 'N', p, n,
291 $ max( p-1, 0 ), max( n-1, 0 ), 1, b, ldb,
292 $ x( 4*nmax+1 ), max( n, 1 ), x( 2*nmax+1 ),
293 $ max( p, 1 ), iseed, iinfo )
294*
295 nt = 2
296*
297 CALL clsets( m, p, n, a, af, lda, b, bf, ldb, x,
298 $ x( nmax+1 ), x( 2*nmax+1 ), x( 3*nmax+1 ),
299 $ x( 4*nmax+1 ), work, lwork, rwork,
300 $ result( 1 ) )
301*
302* Print information about the tests that did not
303* pass the threshold.
304*
305 DO 20 i = 1, nt
306 IF( result( i ).GE.thresh ) THEN
307 IF( nfail.EQ.0 .AND. firstt ) THEN
308 firstt = .false.
309 CALL alahdg( nout, path )
310 END IF
311 WRITE( nout, fmt = 9998 )m, p, n, imat, i,
312 $ result( i )
313 nfail = nfail + 1
314 END IF
315 20 CONTINUE
316 nrun = nrun + nt
317*
318 30 CONTINUE
319 40 CONTINUE
320*
321* Print a summary of the results.
322*
323 CALL alasum( path, nout, nfail, nrun, 0 )
324*
325 9999 FORMAT( ' CLATMS in CCKLSE INFO = ', i5 )
326 9998 FORMAT( ' M=', i4, ' P=', i4, ', N=', i4, ', type ', i2,
327 $ ', test ', i2, ', ratio=', g13.6 )
328 9997 FORMAT( ' *** Invalid input for LSE: M = ', i6, ', P = ', i6,
329 $ ', N = ', i6, ';', / ' must satisfy P <= N <= P+M ',
330 $ '(this set of values will be skipped)' )
331 RETURN
332*
333* End of CCKLSE
334*
335 END
alareq
subroutine alareq(path, nmats, dotype, ntypes, nin, nout)
ALAREQ
Definition alareq.f:90
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
clarhs
subroutine clarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
CLARHS
Definition clarhs.f:208
alahdg
subroutine alahdg(iounit, path)
ALAHDG
Definition alahdg.f:62
ccklse
subroutine ccklse(nn, mval, pval, nval, nmats, iseed, thresh, nmax, a, af, b, bf, x, work, rwork, nin, nout, info)
CCKLSE
Definition ccklse.f:168
clatms
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.f:332
clsets
subroutine clsets(m, p, n, a, af, lda, b, bf, ldb, c, cf, d, df, x, work, lwork, rwork, result)
CLSETS
Definition clsets.f:155
slatb9
subroutine slatb9(path, imat, m, p, n, type, kla, kua, klb, kub, anorm, bnorm, modea, modeb, cndnma, cndnmb, dista, distb)
SLATB9
Definition slatb9.f:170