1*> \brief \b SCHKLQ 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 SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 12* NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, 13* B, X, XACT, TAU, WORK, RWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NM, NMAX, NN, NNB, NOUT, NRHS 18* REAL THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), 23* $ NXVAL( * ) 24* REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), 25* $ B( * ), RWORK( * ), TAU( * ), WORK( * ), 26* $ X( * ), XACT( * ) 27* .. 28* 29* 30*> \par Purpose: 31* ============= 32*> 33*> \verbatim 34*> 35*> SCHKLQ tests SGELQF, SORGLQ and SORMLQ. 36*> \endverbatim 37* 38* Arguments: 39* ========== 40* 41*> \param[in] DOTYPE 42*> \verbatim 43*> DOTYPE is LOGICAL array, dimension (NTYPES) 44*> The matrix types to be used for testing. Matrices of type j 45*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 46*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 47*> \endverbatim 48*> 49*> \param[in] NM 50*> \verbatim 51*> NM is INTEGER 52*> The number of values of M contained in the vector MVAL. 53*> \endverbatim 54*> 55*> \param[in] MVAL 56*> \verbatim 57*> MVAL is INTEGER array, dimension (NM) 58*> The values of the matrix row dimension M. 59*> \endverbatim 60*> 61*> \param[in] NN 62*> \verbatim 63*> NN is INTEGER 64*> The number of values of N contained in the vector NVAL. 65*> \endverbatim 66*> 67*> \param[in] NVAL 68*> \verbatim 69*> NVAL is INTEGER array, dimension (NN) 70*> The values of the matrix column dimension N. 71*> \endverbatim 72*> 73*> \param[in] NNB 74*> \verbatim 75*> NNB is INTEGER 76*> The number of values of NB and NX contained in the 77*> vectors NBVAL and NXVAL. The blocking parameters are used 78*> in pairs (NB,NX). 79*> \endverbatim 80*> 81*> \param[in] NBVAL 82*> \verbatim 83*> NBVAL is INTEGER array, dimension (NNB) 84*> The values of the blocksize NB. 85*> \endverbatim 86*> 87*> \param[in] NXVAL 88*> \verbatim 89*> NXVAL is INTEGER array, dimension (NNB) 90*> The values of the crossover point NX. 91*> \endverbatim 92*> 93*> \param[in] NRHS 94*> \verbatim 95*> NRHS is INTEGER 96*> The number of right hand side vectors to be generated for 97*> each linear system. 98*> \endverbatim 99*> 100*> \param[in] THRESH 101*> \verbatim 102*> THRESH is REAL 103*> The threshold value for the test ratios. A result is 104*> included in the output file if RESULT >= THRESH. To have 105*> every test ratio printed, use THRESH = 0. 106*> \endverbatim 107*> 108*> \param[in] TSTERR 109*> \verbatim 110*> TSTERR is LOGICAL 111*> Flag that indicates whether error exits are to be tested. 112*> \endverbatim 113*> 114*> \param[in] NMAX 115*> \verbatim 116*> NMAX is INTEGER 117*> The maximum value permitted for M or N, used in dimensioning 118*> the work arrays. 119*> \endverbatim 120*> 121*> \param[out] A 122*> \verbatim 123*> A is REAL array, dimension (NMAX*NMAX) 124*> \endverbatim 125*> 126*> \param[out] AF 127*> \verbatim 128*> AF is REAL array, dimension (NMAX*NMAX) 129*> \endverbatim 130*> 131*> \param[out] AQ 132*> \verbatim 133*> AQ is REAL array, dimension (NMAX*NMAX) 134*> \endverbatim 135*> 136*> \param[out] AL 137*> \verbatim 138*> AL is REAL array, dimension (NMAX*NMAX) 139*> \endverbatim 140*> 141*> \param[out] AC 142*> \verbatim 143*> AC is REAL array, dimension (NMAX*NMAX) 144*> \endverbatim 145*> 146*> \param[out] B 147*> \verbatim 148*> B is REAL array, dimension (NMAX*NRHS) 149*> \endverbatim 150*> 151*> \param[out] X 152*> \verbatim 153*> X is REAL array, dimension (NMAX*NRHS) 154*> \endverbatim 155*> 156*> \param[out] XACT 157*> \verbatim 158*> XACT is REAL array, dimension (NMAX*NRHS) 159*> \endverbatim 160*> 161*> \param[out] TAU 162*> \verbatim 163*> TAU is REAL array, dimension (NMAX) 164*> \endverbatim 165*> 166*> \param[out] WORK 167*> \verbatim 168*> WORK is REAL array, dimension (NMAX*NMAX) 169*> \endverbatim 170*> 171*> \param[out] RWORK 172*> \verbatim 173*> RWORK is REAL array, dimension (NMAX) 174*> \endverbatim 175*> 176*> \param[in] NOUT 177*> \verbatim 178*> NOUT is INTEGER 179*> The unit number for output. 180*> \endverbatim 181* 182* Authors: 183* ======== 184* 185*> \author Univ. of Tennessee 186*> \author Univ. of California Berkeley 187*> \author Univ. of Colorado Denver 188*> \author NAG Ltd. 189* 190*> \date November 2011 191* 192*> \ingroup single_lin 193* 194* ===================================================================== 195 SUBROUTINE SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 196 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, 197 $ B, X, XACT, TAU, WORK, RWORK, NOUT ) 198* 199* -- LAPACK test routine (version 3.4.0) -- 200* -- LAPACK is a software package provided by Univ. of Tennessee, -- 201* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 202* November 2011 203* 204* .. Scalar Arguments .. 205 LOGICAL TSTERR 206 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS 207 REAL THRESH 208* .. 209* .. Array Arguments .. 210 LOGICAL DOTYPE( * ) 211 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), 212 $ NXVAL( * ) 213 REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), 214 $ B( * ), RWORK( * ), TAU( * ), WORK( * ), 215 $ X( * ), XACT( * ) 216* .. 217* 218* ===================================================================== 219* 220* .. Parameters .. 221 INTEGER NTESTS 222 PARAMETER ( NTESTS = 7 ) 223 INTEGER NTYPES 224 PARAMETER ( NTYPES = 8 ) 225 REAL ZERO 226 PARAMETER ( ZERO = 0.0E0 ) 227* .. 228* .. Local Scalars .. 229 CHARACTER DIST, TYPE 230 CHARACTER*3 PATH 231 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, 232 $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, 233 $ NRUN, NT, NX 234 REAL ANORM, CNDNUM 235* .. 236* .. Local Arrays .. 237 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) 238 REAL RESULT( NTESTS ) 239* .. 240* .. External Subroutines .. 241 EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGELQS, SGET02, 242 $ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02, 243 $ SLQT03, XLAENV 244* .. 245* .. Intrinsic Functions .. 246 INTRINSIC MAX, MIN 247* .. 248* .. Scalars in Common .. 249 LOGICAL LERR, OK 250 CHARACTER*32 SRNAMT 251 INTEGER INFOT, NUNIT 252* .. 253* .. Common blocks .. 254 COMMON / INFOC / INFOT, NUNIT, OK, LERR 255 COMMON / SRNAMC / SRNAMT 256* .. 257* .. Data statements .. 258 DATA ISEEDY / 1988, 1989, 1990, 1991 / 259* .. 260* .. Executable Statements .. 261* 262* Initialize constants and the random number seed. 263* 264 PATH( 1: 1 ) = 'Single precision' 265 PATH( 2: 3 ) = 'LQ' 266 NRUN = 0 267 NFAIL = 0 268 NERRS = 0 269 DO 10 I = 1, 4 270 ISEED( I ) = ISEEDY( I ) 271 10 CONTINUE 272* 273* Test the error exits 274* 275 IF( TSTERR ) 276 $ CALL SERRLQ( PATH, NOUT ) 277 INFOT = 0 278 CALL XLAENV( 2, 2 ) 279* 280 LDA = NMAX 281 LWORK = NMAX*MAX( NMAX, NRHS ) 282* 283* Do for each value of M in MVAL. 284* 285 DO 70 IM = 1, NM 286 M = MVAL( IM ) 287* 288* Do for each value of N in NVAL. 289* 290 DO 60 IN = 1, NN 291 N = NVAL( IN ) 292 MINMN = MIN( M, N ) 293 DO 50 IMAT = 1, NTYPES 294* 295* Do the tests only if DOTYPE( IMAT ) is true. 296* 297 IF( .NOT.DOTYPE( IMAT ) ) 298 $ GO TO 50 299* 300* Set up parameters with SLATB4 and generate a test matrix 301* with SLATMS. 302* 303 CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, 304 $ CNDNUM, DIST ) 305* 306 SRNAMT = 'SLATMS' 307 CALL SLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, 308 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, 309 $ WORK, INFO ) 310* 311* Check error code from SLATMS. 312* 313 IF( INFO.NE.0 ) THEN 314 CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', M, N, -1, 315 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 316 GO TO 50 317 END IF 318* 319* Set some values for K: the first value must be MINMN, 320* corresponding to the call of SLQT01; other values are 321* used in the calls of SLQT02, and must not exceed MINMN. 322* 323 KVAL( 1 ) = MINMN 324 KVAL( 2 ) = 0 325 KVAL( 3 ) = 1 326 KVAL( 4 ) = MINMN / 2 327 IF( MINMN.EQ.0 ) THEN 328 NK = 1 329 ELSE IF( MINMN.EQ.1 ) THEN 330 NK = 2 331 ELSE IF( MINMN.LE.3 ) THEN 332 NK = 3 333 ELSE 334 NK = 4 335 END IF 336* 337* Do for each value of K in KVAL 338* 339 DO 40 IK = 1, NK 340 K = KVAL( IK ) 341* 342* Do for each pair of values (NB,NX) in NBVAL and NXVAL. 343* 344 DO 30 INB = 1, NNB 345 NB = NBVAL( INB ) 346 CALL XLAENV( 1, NB ) 347 NX = NXVAL( INB ) 348 CALL XLAENV( 3, NX ) 349 DO I = 1, NTESTS 350 RESULT( I ) = ZERO 351 END DO 352 NT = 2 353 IF( IK.EQ.1 ) THEN 354* 355* Test SGELQF 356* 357 CALL SLQT01( M, N, A, AF, AQ, AL, LDA, TAU, 358 $ WORK, LWORK, RWORK, RESULT( 1 ) ) 359 ELSE IF( M.LE.N ) THEN 360* 361* Test SORGLQ, using factorization 362* returned by SLQT01 363* 364 CALL SLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, 365 $ WORK, LWORK, RWORK, RESULT( 1 ) ) 366 END IF 367 IF( M.GE.K ) THEN 368* 369* Test SORMLQ, using factorization returned 370* by SLQT01 371* 372 CALL SLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, 373 $ WORK, LWORK, RWORK, RESULT( 3 ) ) 374 NT = NT + 4 375* 376* If M>=N and K=N, call SGELQS to solve a system 377* with NRHS right hand sides and compute the 378* residual. 379* 380 IF( K.EQ.M .AND. INB.EQ.1 ) THEN 381* 382* Generate a solution and set the right 383* hand side. 384* 385 SRNAMT = 'SLARHS' 386 CALL SLARHS( PATH, 'New', 'Full', 387 $ 'No transpose', M, N, 0, 0, 388 $ NRHS, A, LDA, XACT, LDA, B, LDA, 389 $ ISEED, INFO ) 390* 391 CALL SLACPY( 'Full', M, NRHS, B, LDA, X, 392 $ LDA ) 393 SRNAMT = 'SGELQS' 394 CALL SGELQS( M, N, NRHS, AF, LDA, TAU, X, 395 $ LDA, WORK, LWORK, INFO ) 396* 397* Check error code from SGELQS. 398* 399 IF( INFO.NE.0 ) 400 $ CALL ALAERH( PATH, 'SGELQS', INFO, 0, ' ', 401 $ M, N, NRHS, -1, NB, IMAT, 402 $ NFAIL, NERRS, NOUT ) 403* 404 CALL SGET02( 'No transpose', M, N, NRHS, A, 405 $ LDA, X, LDA, B, LDA, RWORK, 406 $ RESULT( 7 ) ) 407 NT = NT + 1 408 END IF 409 END IF 410* 411* Print information about the tests that did not 412* pass the threshold. 413* 414 DO 20 I = 1, NTESTS 415 IF( RESULT( I ).GE.THRESH ) THEN 416 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 417 $ CALL ALAHD( NOUT, PATH ) 418 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, 419 $ IMAT, I, RESULT( I ) 420 NFAIL = NFAIL + 1 421 END IF 422 20 CONTINUE 423 NRUN = NRUN + NT 424 30 CONTINUE 425 40 CONTINUE 426 50 CONTINUE 427 60 CONTINUE 428 70 CONTINUE 429* 430* Print a summary of the results. 431* 432 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 433* 434 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', 435 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) 436 RETURN 437* 438* End of SCHKLQ 439* 440 END 441