LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:90
subroutine alahdg(IOUNIT, PATH)
ALAHDG
Definition: alahdg.f:62
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:208
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
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
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:332
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