1*> \brief \b DCHKLQ 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 DCHKLQ( 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* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), 23* $ NXVAL( * ) 24* DOUBLE PRECISION 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*> DCHKLQ tests DGELQF, DORGLQ and DORMLQ. 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (NMAX*NMAX) 124*> \endverbatim 125*> 126*> \param[out] AF 127*> \verbatim 128*> AF is DOUBLE PRECISION array, dimension (NMAX*NMAX) 129*> \endverbatim 130*> 131*> \param[out] AQ 132*> \verbatim 133*> AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX) 134*> \endverbatim 135*> 136*> \param[out] AL 137*> \verbatim 138*> AL is DOUBLE PRECISION array, dimension (NMAX*NMAX) 139*> \endverbatim 140*> 141*> \param[out] AC 142*> \verbatim 143*> AC is DOUBLE PRECISION array, dimension (NMAX*NMAX) 144*> \endverbatim 145*> 146*> \param[out] B 147*> \verbatim 148*> B is DOUBLE PRECISION array, dimension (NMAX*NRHS) 149*> \endverbatim 150*> 151*> \param[out] X 152*> \verbatim 153*> X is DOUBLE PRECISION array, dimension (NMAX*NRHS) 154*> \endverbatim 155*> 156*> \param[out] XACT 157*> \verbatim 158*> XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS) 159*> \endverbatim 160*> 161*> \param[out] TAU 162*> \verbatim 163*> TAU is DOUBLE PRECISION array, dimension (NMAX) 164*> \endverbatim 165*> 166*> \param[out] WORK 167*> \verbatim 168*> WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX) 169*> \endverbatim 170*> 171*> \param[out] RWORK 172*> \verbatim 173*> RWORK is DOUBLE PRECISION 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 double_lin 193* 194* ===================================================================== 195 SUBROUTINE DCHKLQ( 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 DOUBLE PRECISION THRESH 208* .. 209* .. Array Arguments .. 210 LOGICAL DOTYPE( * ) 211 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), 212 $ NXVAL( * ) 213 DOUBLE PRECISION 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 DOUBLE PRECISION ZERO 226 PARAMETER ( ZERO = 0.0D0 ) 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 DOUBLE PRECISION ANORM, CNDNUM 235* .. 236* .. Local Arrays .. 237 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) 238 DOUBLE PRECISION RESULT( NTESTS ) 239* .. 240* .. External Subroutines .. 241 EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELQS, DGET02, 242 $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02, 243 $ DLQT03, 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 ) = 'Double 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 DERRLQ( 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 DLATB4 and generate a test matrix 301* with DLATMS. 302* 303 CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, 304 $ CNDNUM, DIST ) 305* 306 SRNAMT = 'DLATMS' 307 CALL DLATMS( 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 DLATMS. 312* 313 IF( INFO.NE.0 ) THEN 314 CALL ALAERH( PATH, 'DLATMS', 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 DLQT01; other values are 321* used in the calls of DLQT02, 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 DGELQF 356* 357 CALL DLQT01( M, N, A, AF, AQ, AL, LDA, TAU, 358 $ WORK, LWORK, RWORK, RESULT( 1 ) ) 359 ELSE IF( M.LE.N ) THEN 360* 361* Test DORGLQ, using factorization 362* returned by DLQT01 363* 364 CALL DLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, 365 $ WORK, LWORK, RWORK, RESULT( 1 ) ) 366 ELSE 367 RESULT( 1 ) = ZERO 368 RESULT( 2 ) = ZERO 369 END IF 370 IF( M.GE.K ) THEN 371* 372* Test DORMLQ, using factorization returned 373* by DLQT01 374* 375 CALL DLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, 376 $ WORK, LWORK, RWORK, RESULT( 3 ) ) 377 NT = NT + 4 378* 379* If M>=N and K=N, call DGELQS to solve a system 380* with NRHS right hand sides and compute the 381* residual. 382* 383 IF( K.EQ.M .AND. INB.EQ.1 ) THEN 384* 385* Generate a solution and set the right 386* hand side. 387* 388 SRNAMT = 'DLARHS' 389 CALL DLARHS( PATH, 'New', 'Full', 390 $ 'No transpose', M, N, 0, 0, 391 $ NRHS, A, LDA, XACT, LDA, B, LDA, 392 $ ISEED, INFO ) 393* 394 CALL DLACPY( 'Full', M, NRHS, B, LDA, X, 395 $ LDA ) 396 SRNAMT = 'DGELQS' 397 CALL DGELQS( M, N, NRHS, AF, LDA, TAU, X, 398 $ LDA, WORK, LWORK, INFO ) 399* 400* Check error code from DGELQS. 401* 402 IF( INFO.NE.0 ) 403 $ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ', 404 $ M, N, NRHS, -1, NB, IMAT, 405 $ NFAIL, NERRS, NOUT ) 406* 407 CALL DGET02( 'No transpose', M, N, NRHS, A, 408 $ LDA, X, LDA, B, LDA, RWORK, 409 $ RESULT( 7 ) ) 410 NT = NT + 1 411 ELSE 412 RESULT( 7 ) = ZERO 413 END IF 414 ELSE 415 RESULT( 3 ) = ZERO 416 RESULT( 4 ) = ZERO 417 RESULT( 5 ) = ZERO 418 RESULT( 6 ) = ZERO 419 END IF 420* 421* Print information about the tests that did not 422* pass the threshold. 423* 424 DO 20 I = 1, NT 425 IF( RESULT( I ).GE.THRESH ) THEN 426 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 427 $ CALL ALAHD( NOUT, PATH ) 428 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, 429 $ IMAT, I, RESULT( I ) 430 NFAIL = NFAIL + 1 431 END IF 432 20 CONTINUE 433 NRUN = NRUN + NT 434 30 CONTINUE 435 40 CONTINUE 436 50 CONTINUE 437 60 CONTINUE 438 70 CONTINUE 439* 440* Print a summary of the results. 441* 442 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 443* 444 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', 445 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) 446 RETURN 447* 448* End of DCHKLQ 449* 450 END 451