LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
cckglm.f
Go to the documentation of this file.
1 *> \brief \b CCKGLM
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 CCKGLM( NN, NVAL, MVAL, PVAL, 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 *> CCKGLM tests CGGGLM - subroutine for solving generalized linear
33 *> model problem.
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] NN
40 *> \verbatim
41 *> NN is INTEGER
42 *> The number of values of N, M and P contained in the vectors
43 *> NVAL, MVAL and PVAL.
44 *> \endverbatim
45 *>
46 *> \param[in] NVAL
47 *> \verbatim
48 *> NVAL is INTEGER array, dimension (NN)
49 *> The values of the matrix row dimension N.
50 *> \endverbatim
51 *>
52 *> \param[in] MVAL
53 *> \verbatim
54 *> MVAL is INTEGER array, dimension (NN)
55 *> The values of the matrix column dimension M.
56 *> \endverbatim
57 *>
58 *> \param[in] PVAL
59 *> \verbatim
60 *> PVAL is INTEGER array, dimension (NN)
61 *> The values of the matrix column dimension P.
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 RESID >= 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 (4*NMAX)
122 *> \endverbatim
123 *>
124 *> \param[out] RWORK
125 *> \verbatim
126 *> RWORK is REAL array, dimension (NMAX)
127 *> \endverbatim
128 *>
129 *> \param[out] WORK
130 *> \verbatim
131 *> WORK is COMPLEX array, dimension (NMAX*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 November 2011
163 *
164 *> \ingroup complex_eig
165 *
166 * =====================================================================
167  SUBROUTINE cckglm( NN, NVAL, MVAL, PVAL, NMATS, ISEED, THRESH,
168  $ nmax, a, af, b, bf, x, work, rwork, nin, nout,
169  $ info )
170 *
171 * -- LAPACK test routine (version 3.4.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 * November 2011
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 NTYPES
191  parameter ( ntypes = 8 )
192 * ..
193 * .. Local Scalars ..
194  LOGICAL FIRSTT
195  CHARACTER DISTA, DISTB, TYPE
196  CHARACTER*3 PATH
197  INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
198  $ ldb, lwork, m, modea, modeb, n, nfail, nrun, p
199  REAL ANORM, BNORM, CNDNMA, CNDNMB, RESID
200 * ..
201 * .. Local Arrays ..
202  LOGICAL DOTYPE( ntypes )
203 * ..
204 * .. External Functions ..
205  COMPLEX CLARND
206  EXTERNAL clarnd
207 * ..
208 * .. External Subroutines ..
209  EXTERNAL alahdg, alareq, alasum, cglmts, clatms, slatb9
210 * ..
211 * .. Intrinsic Functions ..
212  INTRINSIC abs
213 * ..
214 * .. Executable Statements ..
215 *
216 * Initialize constants.
217 *
218  path( 1: 3 ) = 'GLM'
219  info = 0
220  nrun = 0
221  nfail = 0
222  firstt = .true.
223  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
224  lda = nmax
225  ldb = nmax
226  lwork = nmax*nmax
227 *
228 * Check for valid input values.
229 *
230  DO 10 ik = 1, nn
231  m = mval( ik )
232  p = pval( ik )
233  n = nval( ik )
234  IF( m.GT.n .OR. n.GT.m+p ) THEN
235  IF( firstt ) THEN
236  WRITE( nout, fmt = * )
237  firstt = .false.
238  END IF
239  WRITE( nout, fmt = 9997 )m, p, n
240  END IF
241  10 CONTINUE
242  firstt = .true.
243 *
244 * Do for each value of M in MVAL.
245 *
246  DO 40 ik = 1, nn
247  m = mval( ik )
248  p = pval( ik )
249  n = nval( ik )
250  IF( m.GT.n .OR. n.GT.m+p )
251  $ GO TO 40
252 *
253  DO 30 imat = 1, ntypes
254 *
255 * Do the tests only if DOTYPE( IMAT ) is true.
256 *
257  IF( .NOT.dotype( imat ) )
258  $ GO TO 30
259 *
260 * Set up parameters with SLATB9 and generate test
261 * matrices A and B with CLATMS.
262 *
263  CALL slatb9( path, imat, m, p, n, TYPE, KLA, KUA, KLB, KUB,
264  $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
265  $ dista, distb )
266 *
267  CALL clatms( n, m, dista, iseed, TYPE, RWORK, MODEA, CNDNMA,
268  $ anorm, kla, kua, 'No packing', a, lda, work,
269  $ iinfo )
270  IF( iinfo.NE.0 ) THEN
271  WRITE( nout, fmt = 9999 )iinfo
272  info = abs( iinfo )
273  GO TO 30
274  END IF
275 *
276  CALL clatms( n, p, distb, iseed, TYPE, RWORK, MODEB, CNDNMB,
277  $ bnorm, klb, kub, 'No packing', b, ldb, work,
278  $ iinfo )
279  IF( iinfo.NE.0 ) THEN
280  WRITE( nout, fmt = 9999 )iinfo
281  info = abs( iinfo )
282  GO TO 30
283  END IF
284 *
285 * Generate random left hand side vector of GLM
286 *
287  DO 20 i = 1, n
288  x( i ) = clarnd( 2, iseed )
289  20 CONTINUE
290 *
291  CALL cglmts( n, m, p, a, af, lda, b, bf, ldb, x,
292  $ x( nmax+1 ), x( 2*nmax+1 ), x( 3*nmax+1 ),
293  $ work, lwork, rwork, resid )
294 *
295 * Print information about the tests that did not
296 * pass the threshold.
297 *
298  IF( resid.GE.thresh ) THEN
299  IF( nfail.EQ.0 .AND. firstt ) THEN
300  firstt = .false.
301  CALL alahdg( nout, path )
302  END IF
303  WRITE( nout, fmt = 9998 )n, m, p, imat, 1, resid
304  nfail = nfail + 1
305  END IF
306  nrun = nrun + 1
307 *
308  30 CONTINUE
309  40 CONTINUE
310 *
311 * Print a summary of the results.
312 *
313  CALL alasum( path, nout, nfail, nrun, 0 )
314 *
315  9999 FORMAT( ' CLATMS in CCKGLM INFO = ', i5 )
316  9998 FORMAT( ' N=', i4, ' M=', i4, ', P=', i4, ', type ', i2,
317  $ ', test ', i2, ', ratio=', g13.6 )
318  9997 FORMAT( ' *** Invalid input for GLM: M = ', i6, ', P = ', i6,
319  $ ', N = ', i6, ';', / ' must satisfy M <= N <= M+P ',
320  $ '(this set of values will be skipped)' )
321  RETURN
322 *
323 * End of CCKGLM
324 *
325  END
cglmts
subroutine cglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
CGLMTS
Definition: cglmts.f:152
alareq
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:92
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
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
alahdg
subroutine alahdg(IOUNIT, PATH)
ALAHDG
Definition: alahdg.f:64
cckglm
subroutine cckglm(NN, NVAL, MVAL, PVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
CCKGLM
Definition: cckglm.f:170
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75