LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dckgsv.f
Go to the documentation of this file.
1*> \brief \b DCKGSV
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 DCKGSV( NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
12* NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R,
13* IWORK, WORK, RWORK, NIN, NOUT, INFO )
14*
15* .. Scalar Arguments ..
16* INTEGER INFO, NIN, NM, NMATS, NMAX, NOUT
17* DOUBLE PRECISION THRESH
18* ..
19* .. Array Arguments ..
20* INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ),
21* $ PVAL( * )
22* DOUBLE PRECISION A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ),
23* $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ),
24* $ V( * ), WORK( * )
25* ..
26*
27*
28*> \par Purpose:
29* =============
30*>
31*> \verbatim
32*>
33*> DCKGSV tests DGGSVD:
34*> the GSVD for M-by-N matrix A and P-by-N matrix B.
35*> \endverbatim
36*
37* Arguments:
38* ==========
39*
40*> \param[in] NM
41*> \verbatim
42*> NM is INTEGER
43*> The number of values of M contained in the vector MVAL.
44*> \endverbatim
45*>
46*> \param[in] MVAL
47*> \verbatim
48*> MVAL is INTEGER array, dimension (NM)
49*> The values of the matrix row dimension M.
50*> \endverbatim
51*>
52*> \param[in] PVAL
53*> \verbatim
54*> PVAL is INTEGER array, dimension (NP)
55*> The values of the matrix row 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 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 DOUBLE PRECISION
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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
102*> \endverbatim
103*>
104*> \param[out] AF
105*> \verbatim
106*> AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
107*> \endverbatim
108*>
109*> \param[out] B
110*> \verbatim
111*> B is DOUBLE PRECISION array, dimension (NMAX*NMAX)
112*> \endverbatim
113*>
114*> \param[out] BF
115*> \verbatim
116*> BF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
117*> \endverbatim
118*>
119*> \param[out] U
120*> \verbatim
121*> U is DOUBLE PRECISION array, dimension (NMAX*NMAX)
122*> \endverbatim
123*>
124*> \param[out] V
125*> \verbatim
126*> V is DOUBLE PRECISION array, dimension (NMAX*NMAX)
127*> \endverbatim
128*>
129*> \param[out] Q
130*> \verbatim
131*> Q is DOUBLE PRECISION array, dimension (NMAX*NMAX)
132*> \endverbatim
133*>
134*> \param[out] ALPHA
135*> \verbatim
136*> ALPHA is DOUBLE PRECISION array, dimension (NMAX)
137*> \endverbatim
138*>
139*> \param[out] BETA
140*> \verbatim
141*> BETA is DOUBLE PRECISION array, dimension (NMAX)
142*> \endverbatim
143*>
144*> \param[out] R
145*> \verbatim
146*> R is DOUBLE PRECISION array, dimension (NMAX*NMAX)
147*> \endverbatim
148*>
149*> \param[out] IWORK
150*> \verbatim
151*> IWORK is INTEGER array, dimension (NMAX)
152*> \endverbatim
153*>
154*> \param[out] WORK
155*> \verbatim
156*> WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX)
157*> \endverbatim
158*>
159*> \param[out] RWORK
160*> \verbatim
161*> RWORK is DOUBLE PRECISION array, dimension (NMAX)
162*> \endverbatim
163*>
164*> \param[in] NIN
165*> \verbatim
166*> NIN is INTEGER
167*> The unit number for input.
168*> \endverbatim
169*>
170*> \param[in] NOUT
171*> \verbatim
172*> NOUT is INTEGER
173*> The unit number for output.
174*> \endverbatim
175*>
176*> \param[out] INFO
177*> \verbatim
178*> INFO is INTEGER
179*> = 0 : successful exit
180*> > 0 : If DLATMS returns an error code, the absolute value
181*> of it is returned.
182*> \endverbatim
183*
184* Authors:
185* ========
186*
187*> \author Univ. of Tennessee
188*> \author Univ. of California Berkeley
189*> \author Univ. of Colorado Denver
190*> \author NAG Ltd.
191*
192*> \ingroup double_eig
193*
194* =====================================================================
195 SUBROUTINE dckgsv( NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
196 $ NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R,
197 $ IWORK, WORK, RWORK, NIN, NOUT, INFO )
198*
199* -- LAPACK test routine --
200* -- LAPACK is a software package provided by Univ. of Tennessee, --
201* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202*
203* .. Scalar Arguments ..
204 INTEGER INFO, NIN, NM, NMATS, NMAX, NOUT
205 DOUBLE PRECISION THRESH
206* ..
207* .. Array Arguments ..
208 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ),
209 $ PVAL( * )
210 DOUBLE PRECISION A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ),
211 $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ),
212 $ v( * ), work( * )
213* ..
214*
215* =====================================================================
216*
217* .. Parameters ..
218 INTEGER NTESTS
219 PARAMETER ( NTESTS = 12 )
220 INTEGER NTYPES
221 parameter( ntypes = 8 )
222* ..
223* .. Local Scalars ..
224 LOGICAL FIRSTT
225 CHARACTER DISTA, DISTB, TYPE
226 CHARACTER*3 PATH
227 INTEGER I, IINFO, IM, IMAT, KLA, KLB, KUA, KUB, LDA,
228 $ ldb, ldq, ldr, ldu, ldv, lwork, m, modea,
229 $ modeb, n, nfail, nrun, nt, p
230 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
231* ..
232* .. Local Arrays ..
233 LOGICAL DOTYPE( NTYPES )
234 DOUBLE PRECISION RESULT( NTESTS )
235* ..
236* .. External Subroutines ..
237 EXTERNAL alahdg, alareq, alasum, dgsvts3, dlatb9, dlatms
238* ..
239* .. Intrinsic Functions ..
240 INTRINSIC abs
241* ..
242* .. Executable Statements ..
243*
244* Initialize constants and the random number seed.
245*
246 path( 1: 3 ) = 'GSV'
247 info = 0
248 nrun = 0
249 nfail = 0
250 firstt = .true.
251 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
252 lda = nmax
253 ldb = nmax
254 ldu = nmax
255 ldv = nmax
256 ldq = nmax
257 ldr = nmax
258 lwork = nmax*nmax
259*
260* Do for each value of M in MVAL.
261*
262 DO 30 im = 1, nm
263 m = mval( im )
264 p = pval( im )
265 n = nval( im )
266*
267 DO 20 imat = 1, ntypes
268*
269* Do the tests only if DOTYPE( IMAT ) is true.
270*
271 IF( .NOT.dotype( imat ) )
272 $ GO TO 20
273*
274* Set up parameters with DLATB9 and generate test
275* matrices A and B with DLATMS.
276*
277 CALL dlatb9( path, imat, m, p, n, TYPE, kla, kua, klb, kub,
278 $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
279 $ dista, distb )
280*
281* Generate M by N matrix A
282*
283 CALL dlatms( m, n, dista, iseed, TYPE, rwork, modea, cndnma,
284 $ anorm, kla, kua, 'No packing', a, lda, work,
285 $ iinfo )
286 IF( iinfo.NE.0 ) THEN
287 WRITE( nout, fmt = 9999 )iinfo
288 info = abs( iinfo )
289 GO TO 20
290 END IF
291*
292 CALL dlatms( p, n, distb, iseed, TYPE, rwork, modeb, cndnmb,
293 $ bnorm, klb, kub, 'No packing', b, ldb, work,
294 $ iinfo )
295 IF( iinfo.NE.0 ) THEN
296 WRITE( nout, fmt = 9999 )iinfo
297 info = abs( iinfo )
298 GO TO 20
299 END IF
300*
301 nt = 6
302*
303 CALL dgsvts3( m, p, n, a, af, lda, b, bf, ldb, u, ldu, v,
304 $ ldv, q, ldq, alpha, beta, r, ldr, iwork, work,
305 $ lwork, rwork, result )
306*
307* Print information about the tests that did not
308* pass the threshold.
309*
310 DO 10 i = 1, nt
311 IF( result( i ).GE.thresh ) THEN
312 IF( nfail.EQ.0 .AND. firstt ) THEN
313 firstt = .false.
314 CALL alahdg( nout, path )
315 END IF
316 WRITE( nout, fmt = 9998 )m, p, n, imat, i,
317 $ result( i )
318 nfail = nfail + 1
319 END IF
320 10 CONTINUE
321 nrun = nrun + nt
322 20 CONTINUE
323 30 CONTINUE
324*
325* Print a summary of the results.
326*
327 CALL alasum( path, nout, nfail, nrun, 0 )
328*
329 9999 FORMAT( ' DLATMS in DCKGSV INFO = ', i5 )
330 9998 FORMAT( ' M=', i4, ' P=', i4, ', N=', i4, ', type ', i2,
331 $ ', test ', i2, ', ratio=', g13.6 )
332 RETURN
333*
334* End of DCKGSV
335*
336 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
alahdg
subroutine alahdg(iounit, path)
ALAHDG
Definition alahdg.f:62
dckgsv
subroutine dckgsv(nm, mval, pval, nval, nmats, iseed, thresh, nmax, a, af, b, bf, u, v, q, alpha, beta, r, iwork, work, rwork, nin, nout, info)
DCKGSV
Definition dckgsv.f:198
dgsvts3
subroutine dgsvts3(m, p, n, a, af, lda, b, bf, ldb, u, ldu, v, ldv, q, ldq, alpha, beta, r, ldr, iwork, work, lwork, rwork, result)
DGSVTS3
Definition dgsvts3.f:210
dlatb9
subroutine dlatb9(path, imat, m, p, n, type, kla, kua, klb, kub, anorm, bnorm, modea, modeb, cndnma, cndnmb, dista, distb)
DLATB9
Definition dlatb9.f:170
dlatms
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
DLATMS
Definition dlatms.f:321