1*> \brief \b SCHKQ3 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 SCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 12* THRESH, A, COPYA, S, TAU, WORK, IWORK, 13* NOUT ) 14* 15* .. Scalar Arguments .. 16* INTEGER NM, NN, NNB, NOUT 17* REAL THRESH 18* .. 19* .. Array Arguments .. 20* LOGICAL DOTYPE( * ) 21* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), 22* $ NXVAL( * ) 23* REAL A( * ), COPYA( * ), S( * ), 24* $ TAU( * ), WORK( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> SCHKQ3 tests SGEQP3. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] DOTYPE 40*> \verbatim 41*> DOTYPE is LOGICAL array, dimension (NTYPES) 42*> The matrix types to be used for testing. Matrices of type j 43*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 44*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 45*> \endverbatim 46*> 47*> \param[in] NM 48*> \verbatim 49*> NM is INTEGER 50*> The number of values of M contained in the vector MVAL. 51*> \endverbatim 52*> 53*> \param[in] MVAL 54*> \verbatim 55*> MVAL is INTEGER array, dimension (NM) 56*> The values of the matrix row dimension M. 57*> \endverbatim 58*> 59*> \param[in] NN 60*> \verbatim 61*> NN is INTEGER 62*> The number of values of N contained in the vector NVAL. 63*> \endverbatim 64*> 65*> \param[in] NVAL 66*> \verbatim 67*> NVAL is INTEGER array, dimension (NN) 68*> The values of the matrix column dimension N. 69*> \endverbatim 70*> 71*> \param[in] NNB 72*> \verbatim 73*> NNB is INTEGER 74*> The number of values of NB and NX contained in the 75*> vectors NBVAL and NXVAL. The blocking parameters are used 76*> in pairs (NB,NX). 77*> \endverbatim 78*> 79*> \param[in] NBVAL 80*> \verbatim 81*> NBVAL is INTEGER array, dimension (NNB) 82*> The values of the blocksize NB. 83*> \endverbatim 84*> 85*> \param[in] NXVAL 86*> \verbatim 87*> NXVAL is INTEGER array, dimension (NNB) 88*> The values of the crossover point NX. 89*> \endverbatim 90*> 91*> \param[in] THRESH 92*> \verbatim 93*> THRESH is REAL 94*> The threshold value for the test ratios. A result is 95*> included in the output file if RESULT >= THRESH. To have 96*> every test ratio printed, use THRESH = 0. 97*> \endverbatim 98*> 99*> \param[out] A 100*> \verbatim 101*> A is REAL array, dimension (MMAX*NMAX) 102*> where MMAX is the maximum value of M in MVAL and NMAX is the 103*> maximum value of N in NVAL. 104*> \endverbatim 105*> 106*> \param[out] COPYA 107*> \verbatim 108*> COPYA is REAL array, dimension (MMAX*NMAX) 109*> \endverbatim 110*> 111*> \param[out] S 112*> \verbatim 113*> S is REAL array, dimension 114*> (min(MMAX,NMAX)) 115*> \endverbatim 116*> 117*> \param[out] TAU 118*> \verbatim 119*> TAU is REAL array, dimension (MMAX) 120*> \endverbatim 121*> 122*> \param[out] WORK 123*> \verbatim 124*> WORK is REAL array, dimension 125*> (MMAX*NMAX + 4*NMAX + MMAX) 126*> \endverbatim 127*> 128*> \param[out] IWORK 129*> \verbatim 130*> IWORK is INTEGER array, dimension (2*NMAX) 131*> \endverbatim 132*> 133*> \param[in] NOUT 134*> \verbatim 135*> NOUT is INTEGER 136*> The unit number for output. 137*> \endverbatim 138* 139* Authors: 140* ======== 141* 142*> \author Univ. of Tennessee 143*> \author Univ. of California Berkeley 144*> \author Univ. of Colorado Denver 145*> \author NAG Ltd. 146* 147*> \date December 2016 148* 149*> \ingroup single_lin 150* 151* ===================================================================== 152 SUBROUTINE SCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 153 $ THRESH, A, COPYA, S, TAU, WORK, IWORK, 154 $ NOUT ) 155* 156* -- LAPACK test routine (version 3.7.0) -- 157* -- LAPACK is a software package provided by Univ. of Tennessee, -- 158* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 159* December 2016 160* 161* .. Scalar Arguments .. 162 INTEGER NM, NN, NNB, NOUT 163 REAL THRESH 164* .. 165* .. Array Arguments .. 166 LOGICAL DOTYPE( * ) 167 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), 168 $ NXVAL( * ) 169 REAL A( * ), COPYA( * ), S( * ), 170 $ TAU( * ), WORK( * ) 171* .. 172* 173* ===================================================================== 174* 175* .. Parameters .. 176 INTEGER NTYPES 177 PARAMETER ( NTYPES = 6 ) 178 INTEGER NTESTS 179 PARAMETER ( NTESTS = 3 ) 180 REAL ONE, ZERO 181 PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 ) 182* .. 183* .. Local Scalars .. 184 CHARACTER*3 PATH 185 INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO, 186 $ ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N, 187 $ NB, NERRS, NFAIL, NRUN, NX 188 REAL EPS 189* .. 190* .. Local Arrays .. 191 INTEGER ISEED( 4 ), ISEEDY( 4 ) 192 REAL RESULT( NTESTS ) 193* .. 194* .. External Functions .. 195 REAL SLAMCH, SQPT01, SQRT11, SQRT12 196 EXTERNAL SLAMCH, SQPT01, SQRT11, SQRT12 197* .. 198* .. External Subroutines .. 199 EXTERNAL ALAHD, ALASUM, ICOPY, SGEQP3, SLACPY, SLAORD, 200 $ SLASET, SLATMS, XLAENV 201* .. 202* .. Intrinsic Functions .. 203 INTRINSIC MAX, MIN 204* .. 205* .. Scalars in Common .. 206 LOGICAL LERR, OK 207 CHARACTER*32 SRNAMT 208 INTEGER INFOT, IOUNIT 209* .. 210* .. Common blocks .. 211 COMMON / INFOC / INFOT, IOUNIT, OK, LERR 212 COMMON / SRNAMC / SRNAMT 213* .. 214* .. Data statements .. 215 DATA ISEEDY / 1988, 1989, 1990, 1991 / 216* .. 217* .. Executable Statements .. 218* 219* Initialize constants and the random number seed. 220* 221 PATH( 1: 1 ) = 'Single precision' 222 PATH( 2: 3 ) = 'Q3' 223 NRUN = 0 224 NFAIL = 0 225 NERRS = 0 226 DO 10 I = 1, 4 227 ISEED( I ) = ISEEDY( I ) 228 10 CONTINUE 229 EPS = SLAMCH( 'Epsilon' ) 230 INFOT = 0 231* 232 DO 90 IM = 1, NM 233* 234* Do for each value of M in MVAL. 235* 236 M = MVAL( IM ) 237 LDA = MAX( 1, M ) 238* 239 DO 80 IN = 1, NN 240* 241* Do for each value of N in NVAL. 242* 243 N = NVAL( IN ) 244 MNMIN = MIN( M, N ) 245 LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ), 246 $ M*N + 2*MNMIN + 4*N ) 247* 248 DO 70 IMODE = 1, NTYPES 249 IF( .NOT.DOTYPE( IMODE ) ) 250 $ GO TO 70 251* 252* Do for each type of matrix 253* 1: zero matrix 254* 2: one small singular value 255* 3: geometric distribution of singular values 256* 4: first n/2 columns fixed 257* 5: last n/2 columns fixed 258* 6: every second column fixed 259* 260 MODE = IMODE 261 IF( IMODE.GT.3 ) 262 $ MODE = 1 263* 264* Generate test matrix of size m by n using 265* singular value distribution indicated by `mode'. 266* 267 DO 20 I = 1, N 268 IWORK( I ) = 0 269 20 CONTINUE 270 IF( IMODE.EQ.1 ) THEN 271 CALL SLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA ) 272 DO 30 I = 1, MNMIN 273 S( I ) = ZERO 274 30 CONTINUE 275 ELSE 276 CALL SLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, 277 $ MODE, ONE / EPS, ONE, M, N, 'No packing', 278 $ COPYA, LDA, WORK, INFO ) 279 IF( IMODE.GE.4 ) THEN 280 IF( IMODE.EQ.4 ) THEN 281 ILOW = 1 282 ISTEP = 1 283 IHIGH = MAX( 1, N / 2 ) 284 ELSE IF( IMODE.EQ.5 ) THEN 285 ILOW = MAX( 1, N / 2 ) 286 ISTEP = 1 287 IHIGH = N 288 ELSE IF( IMODE.EQ.6 ) THEN 289 ILOW = 1 290 ISTEP = 2 291 IHIGH = N 292 END IF 293 DO 40 I = ILOW, IHIGH, ISTEP 294 IWORK( I ) = 1 295 40 CONTINUE 296 END IF 297 CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) 298 END IF 299* 300 DO 60 INB = 1, NNB 301* 302* Do for each pair of values (NB,NX) in NBVAL and NXVAL. 303* 304 NB = NBVAL( INB ) 305 CALL XLAENV( 1, NB ) 306 NX = NXVAL( INB ) 307 CALL XLAENV( 3, NX ) 308* 309* Get a working copy of COPYA into A and a copy of 310* vector IWORK. 311* 312 CALL SLACPY( 'All', M, N, COPYA, LDA, A, LDA ) 313 CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) 314* 315* Compute the QR factorization with pivoting of A 316* 317 LW = MAX( 1, 2*N+NB*( N+1 ) ) 318* 319* Compute the QP3 factorization of A 320* 321 SRNAMT = 'SGEQP3' 322 CALL SGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK, 323 $ LW, INFO ) 324* 325* Compute norm(svd(a) - svd(r)) 326* 327 RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, 328 $ LWORK ) 329* 330* Compute norm( A*P - Q*R ) 331* 332 RESULT( 2 ) = SQPT01( M, N, MNMIN, COPYA, A, LDA, TAU, 333 $ IWORK( N+1 ), WORK, LWORK ) 334* 335* Compute Q'*Q 336* 337 RESULT( 3 ) = SQRT11( M, MNMIN, A, LDA, TAU, WORK, 338 $ LWORK ) 339* 340* Print information about the tests that did not pass 341* the threshold. 342* 343 DO 50 K = 1, NTESTS 344 IF( RESULT( K ).GE.THRESH ) THEN 345 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 346 $ CALL ALAHD( NOUT, PATH ) 347 WRITE( NOUT, FMT = 9999 )'SGEQP3', M, N, NB, 348 $ IMODE, K, RESULT( K ) 349 NFAIL = NFAIL + 1 350 END IF 351 50 CONTINUE 352 NRUN = NRUN + NTESTS 353* 354 60 CONTINUE 355 70 CONTINUE 356 80 CONTINUE 357 90 CONTINUE 358* 359* Print a summary of the results. 360* 361 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 362* 363 9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ', 364 $ I2, ', test ', I2, ', ratio =', G12.5 ) 365* 366* End of SCHKQ3 367* 368 END 369