LAPACK  3.7.1
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 *> \date December 2016
163 *
164 *> \ingroup complex_eig
165 *
166 * =====================================================================
167  SUBROUTINE ccklse( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
168  $ NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
169  $ INFO )
170 *
171 * -- LAPACK test routine (version 3.7.0) --
172 * -- LAPACK is a software package provided by Univ. of Tennessee, --
173 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174 * December 2016
175 *
176 * .. Scalar Arguments ..
177  INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT
178  REAL THRESH
179 * ..
180 * .. Array Arguments ..
181  INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
182  REAL RWORK( * )
183  COMPLEX A( * ), AF( * ), B( * ), BF( * ), WORK( * ),
184  $ x( * )
185 * ..
186 *
187 * =====================================================================
188 *
189 * .. Parameters ..
190  INTEGER NTESTS
191  parameter( ntests = 7 )
192  INTEGER NTYPES
193  parameter( ntypes = 8 )
194 * ..
195 * .. Local Scalars ..
196  LOGICAL FIRSTT
197  CHARACTER DISTA, DISTB, TYPE
198  CHARACTER*3 PATH
199  INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
200  $ ldb, lwork, m, modea, modeb, n, nfail, nrun,
201  $ nt, p
202  REAL ANORM, BNORM, CNDNMA, CNDNMB
203 * ..
204 * .. Local Arrays ..
205  LOGICAL DOTYPE( ntypes )
206  REAL RESULT( ntests )
207 * ..
208 * .. External Subroutines ..
209  EXTERNAL alahdg, alareq, alasum, clarhs, clatms, clsets,
210  $ slatb9
211 * ..
212 * .. Intrinsic Functions ..
213  INTRINSIC abs, max
214 * ..
215 * .. Executable Statements ..
216 *
217 * Initialize constants and the random number seed.
218 *
219  path( 1: 3 ) = 'LSE'
220  info = 0
221  nrun = 0
222  nfail = 0
223  firstt = .true.
224  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
225  lda = nmax
226  ldb = nmax
227  lwork = nmax*nmax
228 *
229 * Check for valid input values.
230 *
231  DO 10 ik = 1, nn
232  m = mval( ik )
233  p = pval( ik )
234  n = nval( ik )
235  IF( p.GT.n .OR. n.GT.m+p ) THEN
236  IF( firstt ) THEN
237  WRITE( nout, fmt = * )
238  firstt = .false.
239  END IF
240  WRITE( nout, fmt = 9997 )m, p, n
241  END IF
242  10 CONTINUE
243  firstt = .true.
244 *
245 * Do for each value of M in MVAL.
246 *
247  DO 40 ik = 1, nn
248  m = mval( ik )
249  p = pval( ik )
250  n = nval( ik )
251  IF( p.GT.n .OR. n.GT.m+p )
252  $ GO TO 40
253 *
254  DO 30 imat = 1, ntypes
255 *
256 * Do the tests only if DOTYPE( IMAT ) is true.
257 *
258  IF( .NOT.dotype( imat ) )
259  $ GO TO 30
260 *
261 * Set up parameters with SLATB9 and generate test
262 * matrices A and B with CLATMS.
263 *
264  CALL slatb9( path, imat, m, p, n, TYPE, KLA, KUA, KLB, KUB,
265  $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
266  $ dista, distb )
267 *
268  CALL clatms( m, n, dista, iseed, TYPE, RWORK, MODEA, CNDNMA,
269  $ anorm, kla, kua, 'No packing', a, lda, work,
270  $ iinfo )
271  IF( iinfo.NE.0 ) THEN
272  WRITE( nout, fmt = 9999 )iinfo
273  info = abs( iinfo )
274  GO TO 30
275  END IF
276 *
277  CALL clatms( p, n, distb, iseed, TYPE, RWORK, MODEB, CNDNMB,
278  $ bnorm, klb, kub, 'No packing', b, ldb, work,
279  $ iinfo )
280  IF( iinfo.NE.0 ) THEN
281  WRITE( nout, fmt = 9999 )iinfo
282  info = abs( iinfo )
283  GO TO 30
284  END IF
285 *
286 * Generate the right-hand sides C and D for the LSE.
287 *
288  CALL clarhs( 'CGE', 'New solution', 'Upper', 'N', m, n,
289  $ max( m-1, 0 ), max( n-1, 0 ), 1, a, lda,
290  $ x( 4*nmax+1 ), max( n, 1 ), x, max( m, 1 ),
291  $ iseed, iinfo )
292 *
293  CALL clarhs( 'CGE', 'Computed', 'Upper', 'N', p, n,
294  $ max( p-1, 0 ), max( n-1, 0 ), 1, b, ldb,
295  $ x( 4*nmax+1 ), max( n, 1 ), x( 2*nmax+1 ),
296  $ max( p, 1 ), iseed, iinfo )
297 *
298  nt = 2
299 *
300  CALL clsets( m, p, n, a, af, lda, b, bf, ldb, x,
301  $ x( nmax+1 ), x( 2*nmax+1 ), x( 3*nmax+1 ),
302  $ x( 4*nmax+1 ), work, lwork, rwork,
303  $ result( 1 ) )
304 *
305 * Print information about the tests that did not
306 * pass the threshold.
307 *
308  DO 20 i = 1, nt
309  IF( result( i ).GE.thresh ) THEN
310  IF( nfail.EQ.0 .AND. firstt ) THEN
311  firstt = .false.
312  CALL alahdg( nout, path )
313  END IF
314  WRITE( nout, fmt = 9998 )m, p, n, imat, i,
315  $ result( i )
316  nfail = nfail + 1
317  END IF
318  20 CONTINUE
319  nrun = nrun + nt
320 *
321  30 CONTINUE
322  40 CONTINUE
323 *
324 * Print a summary of the results.
325 *
326  CALL alasum( path, nout, nfail, nrun, 0 )
327 *
328  9999 FORMAT( ' CLATMS in CCKLSE INFO = ', i5 )
329  9998 FORMAT( ' M=', i4, ' P=', i4, ', N=', i4, ', type ', i2,
330  $ ', test ', i2, ', ratio=', g13.6 )
331  9997 FORMAT( ' *** Invalid input for LSE: M = ', i6, ', P = ', i6,
332  $ ', N = ', i6, ';', / ' must satisfy P <= N <= P+M ',
333  $ '(this set of values will be skipped)' )
334  RETURN
335 *
336 * End of CCKLSE
337 *
338  END
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:170
alareq
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:92
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:157
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
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:172
alahdg
subroutine alahdg(IOUNIT, PATH)
ALAHDG
Definition: alahdg.f:64
clarhs
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75