LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sckgqr()

subroutine sckgqr ( integer nm,
integer, dimension( * ) mval,
integer np,
integer, dimension( * ) pval,
integer nn,
integer, dimension( * ) nval,
integer nmats,
integer, dimension( 4 ) iseed,
real thresh,
integer nmax,
real, dimension( * ) a,
real, dimension( * ) af,
real, dimension( * ) aq,
real, dimension( * ) ar,
real, dimension( * ) taua,
real, dimension( * ) b,
real, dimension( * ) bf,
real, dimension( * ) bz,
real, dimension( * ) bt,
real, dimension( * ) bwk,
real, dimension( * ) taub,
real, dimension( * ) work,
real, dimension( * ) rwork,
integer nin,
integer nout,
integer info )

SCKGQR

Purpose:
!>
!> SCKGQR tests
!> SGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B,
!> SGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B.
!>
Parameters
[in]NM
!>          NM is INTEGER
!>          The number of values of M contained in the vector MVAL.
!>
[in]MVAL
!>          MVAL is INTEGER array, dimension (NM)
!>          The values of the matrix row(column) dimension M.
!>
[in]NP
!>          NP is INTEGER
!>          The number of values of P contained in the vector PVAL.
!>
[in]PVAL
!>          PVAL is INTEGER array, dimension (NP)
!>          The values of the matrix row(column) dimension P.
!>
[in]NN
!>          NN is INTEGER
!>          The number of values of N contained in the vector NVAL.
!>
[in]NVAL
!>          NVAL is INTEGER array, dimension (NN)
!>          The values of the matrix column(row) dimension N.
!>
[in]NMATS
!>          NMATS is INTEGER
!>          The number of matrix types to be tested for each combination
!>          of matrix dimensions.  If NMATS >= NTYPES (the maximum
!>          number of matrix types), then all the different types are
!>          generated for testing.  If NMATS < NTYPES, another input line
!>          is read to get the numbers of the matrix types to be used.
!>
[in,out]ISEED
!>          ISEED is INTEGER array, dimension (4)
!>          On entry, the seed of the random number generator.  The array
!>          elements should be between 0 and 4095, otherwise they will be
!>          reduced mod 4096, and ISEED(4) must be odd.
!>          On exit, the next seed in the random number sequence after
!>          all the test matrices have been generated.
!>
[in]THRESH
!>          THRESH is REAL
!>          The threshold value for the test ratios.  A result is
!>          included in the output file if RESULT >= THRESH.  To have
!>          every test ratio printed, use THRESH = 0.
!>
[in]NMAX
!>          NMAX is INTEGER
!>          The maximum value permitted for M or N, used in dimensioning
!>          the work arrays.
!>
[out]A
!>          A is REAL array, dimension (NMAX*NMAX)
!>
[out]AF
!>          AF is REAL array, dimension (NMAX*NMAX)
!>
[out]AQ
!>          AQ is REAL array, dimension (NMAX*NMAX)
!>
[out]AR
!>          AR is REAL array, dimension (NMAX*NMAX)
!>
[out]TAUA
!>          TAUA is REAL array, dimension (NMAX)
!>
[out]B
!>          B is REAL array, dimension (NMAX*NMAX)
!>
[out]BF
!>          BF is REAL array, dimension (NMAX*NMAX)
!>
[out]BZ
!>          BZ is REAL array, dimension (NMAX*NMAX)
!>
[out]BT
!>          BT is REAL array, dimension (NMAX*NMAX)
!>
[out]BWK
!>          BWK is REAL array, dimension (NMAX*NMAX)
!>
[out]TAUB
!>          TAUB is REAL array, dimension (NMAX)
!>
[out]WORK
!>          WORK is REAL array, dimension (NMAX*NMAX)
!>
[out]RWORK
!>          RWORK is REAL array, dimension (NMAX)
!>
[in]NIN
!>          NIN is INTEGER
!>          The unit number for input.
!>
[in]NOUT
!>          NOUT is INTEGER
!>          The unit number for output.
!>
[out]INFO
!>          INFO is INTEGER
!>          = 0 :  successful exit
!>          > 0 :  If SLATMS returns an error code, the absolute value
!>                 of it is returned.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 207 of file sckgqr.f.

210*
211* -- LAPACK test routine --
212* -- LAPACK is a software package provided by Univ. of Tennessee, --
213* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
214*
215* .. Scalar Arguments ..
216 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
217 REAL THRESH
218* ..
219* .. Array Arguments ..
220 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
221 REAL A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
222 $ BF( * ), BT( * ), BWK( * ), BZ( * ),
223 $ RWORK( * ), TAUA( * ), TAUB( * ), WORK( * )
224* ..
225*
226* =====================================================================
227*
228* .. Parameters ..
229 INTEGER NTESTS
230 parameter( ntests = 7 )
231 INTEGER NTYPES
232 parameter( ntypes = 8 )
233* ..
234* .. Local Scalars ..
235 LOGICAL FIRSTT
236 CHARACTER DISTA, DISTB, TYPE
237 CHARACTER*3 PATH
238 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
239 $ LDA, LDB, LWORK, M, MODEA, MODEB, N, NFAIL,
240 $ NRUN, NT, P
241 REAL ANORM, BNORM, CNDNMA, CNDNMB
242* ..
243* .. Local Arrays ..
244 LOGICAL DOTYPE( NTYPES )
245 REAL RESULT( NTESTS )
246* ..
247* .. External Subroutines ..
248 EXTERNAL alahdg, alareq, alasum, sgqrts, sgrqts, slatb9,
249 $ slatms
250* ..
251* .. Intrinsic Functions ..
252 INTRINSIC abs
253* ..
254* .. Executable Statements ..
255*
256* Initialize constants.
257*
258 path( 1: 3 ) = 'GQR'
259 info = 0
260 nrun = 0
261 nfail = 0
262 firstt = .true.
263 CALL alareq( path, nmats, dotype, ntypes, nin, nout )
264 lda = nmax
265 ldb = nmax
266 lwork = nmax*nmax
267*
268* Do for each value of M in MVAL.
269*
270 DO 60 im = 1, nm
271 m = mval( im )
272*
273* Do for each value of P in PVAL.
274*
275 DO 50 ip = 1, np
276 p = pval( ip )
277*
278* Do for each value of N in NVAL.
279*
280 DO 40 in = 1, nn
281 n = nval( in )
282*
283 DO 30 imat = 1, ntypes
284*
285* Do the tests only if DOTYPE( IMAT ) is true.
286*
287 IF( .NOT.dotype( imat ) )
288 $ GO TO 30
289*
290* Test SGGRQF
291*
292* Set up parameters with SLATB9 and generate test
293* matrices A and B with SLATMS.
294*
295 CALL slatb9( 'GRQ', imat, m, p, n, TYPE, KLA, KUA,
296 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
297 $ CNDNMA, CNDNMB, DISTA, DISTB )
298*
299* Generate M by N matrix A
300*
301 CALL slatms( m, n, dista, iseed, TYPE, RWORK, MODEA,
302 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A,
303 $ LDA, WORK, IINFO )
304 IF( iinfo.NE.0 ) THEN
305 WRITE( nout, fmt = 9999 )iinfo
306 info = abs( iinfo )
307 GO TO 30
308 END IF
309*
310* Generate P by N matrix B
311*
312 CALL slatms( p, n, distb, iseed, TYPE, RWORK, MODEB,
313 $ CNDNMB, BNORM, KLB, KUB, 'No packing', B,
314 $ LDB, WORK, IINFO )
315 IF( iinfo.NE.0 ) THEN
316 WRITE( nout, fmt = 9999 )iinfo
317 info = abs( iinfo )
318 GO TO 30
319 END IF
320*
321 nt = 4
322*
323 CALL sgrqts( m, p, n, a, af, aq, ar, lda, taua, b, bf,
324 $ bz, bt, bwk, ldb, taub, work, lwork,
325 $ rwork, result )
326*
327* Print information about the tests that did not
328* pass the threshold.
329*
330 DO 10 i = 1, nt
331 IF( result( i ).GE.thresh ) THEN
332 IF( nfail.EQ.0 .AND. firstt ) THEN
333 firstt = .false.
334 CALL alahdg( nout, 'GRQ' )
335 END IF
336 WRITE( nout, fmt = 9998 )m, p, n, imat, i,
337 $ result( i )
338 nfail = nfail + 1
339 END IF
340 10 CONTINUE
341 nrun = nrun + nt
342*
343* Test SGGQRF
344*
345* Set up parameters with SLATB9 and generate test
346* matrices A and B with SLATMS.
347*
348 CALL slatb9( 'GQR', imat, m, p, n, TYPE, KLA, KUA,
349 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
350 $ CNDNMA, CNDNMB, DISTA, DISTB )
351*
352* Generate N-by-M matrix A
353*
354 CALL slatms( n, m, dista, iseed, TYPE, RWORK, MODEA,
355 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A,
356 $ LDA, WORK, IINFO )
357 IF( iinfo.NE.0 ) THEN
358 WRITE( nout, fmt = 9999 )iinfo
359 info = abs( iinfo )
360 GO TO 30
361 END IF
362*
363* Generate N-by-P matrix B
364*
365 CALL slatms( n, p, distb, iseed, TYPE, RWORK, MODEA,
366 $ CNDNMA, BNORM, KLB, KUB, 'No packing', B,
367 $ LDB, WORK, IINFO )
368 IF( iinfo.NE.0 ) THEN
369 WRITE( nout, fmt = 9999 )iinfo
370 info = abs( iinfo )
371 GO TO 30
372 END IF
373*
374 nt = 4
375*
376 CALL sgqrts( n, m, p, a, af, aq, ar, lda, taua, b, bf,
377 $ bz, bt, bwk, ldb, taub, work, lwork,
378 $ rwork, result )
379*
380* Print information about the tests that did not
381* pass the threshold.
382*
383 DO 20 i = 1, nt
384 IF( result( i ).GE.thresh ) THEN
385 IF( nfail.EQ.0 .AND. firstt ) THEN
386 firstt = .false.
387 CALL alahdg( nout, path )
388 END IF
389 WRITE( nout, fmt = 9997 )n, m, p, imat, i,
390 $ result( i )
391 nfail = nfail + 1
392 END IF
393 20 CONTINUE
394 nrun = nrun + nt
395*
396 30 CONTINUE
397 40 CONTINUE
398 50 CONTINUE
399 60 CONTINUE
400*
401* Print a summary of the results.
402*
403 CALL alasum( path, nout, nfail, nrun, 0 )
404*
405 9999 FORMAT( ' SLATMS in SCKGQR: INFO = ', i5 )
406 9998 FORMAT( ' M=', i4, ' P=', i4, ', N=', i4, ', type ', i2,
407 $ ', test ', i2, ', ratio=', g13.6 )
408 9997 FORMAT( ' N=', i4, ' M=', i4, ', P=', i4, ', type ', i2,
409 $ ', test ', i2, ', ratio=', g13.6 )
410 RETURN
411*
412* End of SCKGQR
413*
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
sgqrts
subroutine sgqrts(n, m, p, a, af, q, r, lda, taua, b, bf, z, t, bwk, ldb, taub, work, lwork, rwork, result)
SGQRTS
Definition sgqrts.f:176
sgrqts
subroutine sgrqts(m, p, n, a, af, q, r, lda, taua, b, bf, z, t, bwk, ldb, taub, work, lwork, rwork, result)
SGRQTS
Definition sgrqts.f:177
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
slatms
subroutine slatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
SLATMS
Definition slatms.f:321
Here is the call graph for this function:
Here is the caller graph for this function: