1*> \brief \b DCHKRQ 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 DCHKRQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 12* NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, 13* B, X, XACT, TAU, WORK, RWORK, IWORK, 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 IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), 23* $ NXVAL( * ) 24* DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ), 25* $ B( * ), RWORK( * ), TAU( * ), WORK( * ), 26* $ X( * ), XACT( * ) 27* .. 28* 29* 30*> \par Purpose: 31* ============= 32*> 33*> \verbatim 34*> 35*> DCHKRQ tests DGERQF, DORGRQ and DORMRQ. 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] AR 137*> \verbatim 138*> AR 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[out] IWORK 177*> \verbatim 178*> IWORK is INTEGER array, dimension (NMAX) 179*> \endverbatim 180*> 181*> \param[in] NOUT 182*> \verbatim 183*> NOUT is INTEGER 184*> The unit number for output. 185*> \endverbatim 186* 187* Authors: 188* ======== 189* 190*> \author Univ. of Tennessee 191*> \author Univ. of California Berkeley 192*> \author Univ. of Colorado Denver 193*> \author NAG Ltd. 194* 195*> \date December 2016 196* 197*> \ingroup double_lin 198* 199* ===================================================================== 200 SUBROUTINE DCHKRQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 201 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, 202 $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) 203* 204* -- LAPACK test routine (version 3.7.0) -- 205* -- LAPACK is a software package provided by Univ. of Tennessee, -- 206* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 207* December 2016 208* 209* .. Scalar Arguments .. 210 LOGICAL TSTERR 211 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS 212 DOUBLE PRECISION THRESH 213* .. 214* .. Array Arguments .. 215 LOGICAL DOTYPE( * ) 216 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), 217 $ NXVAL( * ) 218 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ), 219 $ B( * ), RWORK( * ), TAU( * ), WORK( * ), 220 $ X( * ), XACT( * ) 221* .. 222* 223* ===================================================================== 224* 225* .. Parameters .. 226 INTEGER NTESTS 227 PARAMETER ( NTESTS = 7 ) 228 INTEGER NTYPES 229 PARAMETER ( NTYPES = 8 ) 230 DOUBLE PRECISION ZERO 231 PARAMETER ( ZERO = 0.0D0 ) 232* .. 233* .. Local Scalars .. 234 CHARACTER DIST, TYPE 235 CHARACTER*3 PATH 236 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, 237 $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, 238 $ NRUN, NT, NX 239 DOUBLE PRECISION ANORM, CNDNUM 240* .. 241* .. Local Arrays .. 242 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) 243 DOUBLE PRECISION RESULT( NTESTS ) 244* .. 245* .. External Subroutines .. 246 EXTERNAL ALAERH, ALAHD, ALASUM, DERRRQ, DGERQS, DGET02, 247 $ DLACPY, DLARHS, DLATB4, DLATMS, DRQT01, DRQT02, 248 $ DRQT03, XLAENV 249* .. 250* .. Intrinsic Functions .. 251 INTRINSIC MAX, MIN 252* .. 253* .. Scalars in Common .. 254 LOGICAL LERR, OK 255 CHARACTER*32 SRNAMT 256 INTEGER INFOT, NUNIT 257* .. 258* .. Common blocks .. 259 COMMON / INFOC / INFOT, NUNIT, OK, LERR 260 COMMON / SRNAMC / SRNAMT 261* .. 262* .. Data statements .. 263 DATA ISEEDY / 1988, 1989, 1990, 1991 / 264* .. 265* .. Executable Statements .. 266* 267* Initialize constants and the random number seed. 268* 269 PATH( 1: 1 ) = 'Double precision' 270 PATH( 2: 3 ) = 'RQ' 271 NRUN = 0 272 NFAIL = 0 273 NERRS = 0 274 DO 10 I = 1, 4 275 ISEED( I ) = ISEEDY( I ) 276 10 CONTINUE 277* 278* Test the error exits 279* 280 IF( TSTERR ) 281 $ CALL DERRRQ( PATH, NOUT ) 282 INFOT = 0 283 CALL XLAENV( 2, 2 ) 284* 285 LDA = NMAX 286 LWORK = NMAX*MAX( NMAX, NRHS ) 287* 288* Do for each value of M in MVAL. 289* 290 DO 70 IM = 1, NM 291 M = MVAL( IM ) 292* 293* Do for each value of N in NVAL. 294* 295 DO 60 IN = 1, NN 296 N = NVAL( IN ) 297 MINMN = MIN( M, N ) 298 DO 50 IMAT = 1, NTYPES 299* 300* Do the tests only if DOTYPE( IMAT ) is true. 301* 302 IF( .NOT.DOTYPE( IMAT ) ) 303 $ GO TO 50 304* 305* Set up parameters with DLATB4 and generate a test matrix 306* with DLATMS. 307* 308 CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, 309 $ CNDNUM, DIST ) 310* 311 SRNAMT = 'DLATMS' 312 CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, 313 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, 314 $ WORK, INFO ) 315* 316* Check error code from DLATMS. 317* 318 IF( INFO.NE.0 ) THEN 319 CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1, 320 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 321 GO TO 50 322 END IF 323* 324* Set some values for K: the first value must be MINMN, 325* corresponding to the call of DRQT01; other values are 326* used in the calls of DRQT02, and must not exceed MINMN. 327* 328 KVAL( 1 ) = MINMN 329 KVAL( 2 ) = 0 330 KVAL( 3 ) = 1 331 KVAL( 4 ) = MINMN / 2 332 IF( MINMN.EQ.0 ) THEN 333 NK = 1 334 ELSE IF( MINMN.EQ.1 ) THEN 335 NK = 2 336 ELSE IF( MINMN.LE.3 ) THEN 337 NK = 3 338 ELSE 339 NK = 4 340 END IF 341* 342* Do for each value of K in KVAL 343* 344 DO 40 IK = 1, NK 345 K = KVAL( IK ) 346* 347* Do for each pair of values (NB,NX) in NBVAL and NXVAL. 348* 349 DO 30 INB = 1, NNB 350 NB = NBVAL( INB ) 351 CALL XLAENV( 1, NB ) 352 NX = NXVAL( INB ) 353 CALL XLAENV( 3, NX ) 354 DO I = 1, NTESTS 355 RESULT( I ) = ZERO 356 END DO 357 NT = 2 358 IF( IK.EQ.1 ) THEN 359* 360* Test DGERQF 361* 362 CALL DRQT01( M, N, A, AF, AQ, AR, LDA, TAU, 363 $ WORK, LWORK, RWORK, RESULT( 1 ) ) 364 ELSE IF( M.LE.N ) THEN 365* 366* Test DORGRQ, using factorization 367* returned by DRQT01 368* 369 CALL DRQT02( M, N, K, A, AF, AQ, AR, LDA, TAU, 370 $ WORK, LWORK, RWORK, RESULT( 1 ) ) 371 372 END IF 373 IF( M.GE.K ) THEN 374* 375* Test DORMRQ, using factorization returned 376* by DRQT01 377* 378 CALL DRQT03( M, N, K, AF, AC, AR, AQ, LDA, TAU, 379 $ WORK, LWORK, RWORK, RESULT( 3 ) ) 380 NT = NT + 4 381* 382* If M>=N and K=N, call DGERQS to solve a system 383* with NRHS right hand sides and compute the 384* residual. 385* 386 IF( K.EQ.M .AND. INB.EQ.1 ) THEN 387* 388* Generate a solution and set the right 389* hand side. 390* 391 SRNAMT = 'DLARHS' 392 CALL DLARHS( PATH, 'New', 'Full', 393 $ 'No transpose', M, N, 0, 0, 394 $ NRHS, A, LDA, XACT, LDA, B, LDA, 395 $ ISEED, INFO ) 396* 397 CALL DLACPY( 'Full', M, NRHS, B, LDA, 398 $ X( N-M+1 ), LDA ) 399 SRNAMT = 'DGERQS' 400 CALL DGERQS( M, N, NRHS, AF, LDA, TAU, X, 401 $ LDA, WORK, LWORK, INFO ) 402* 403* Check error code from DGERQS. 404* 405 IF( INFO.NE.0 ) 406 $ CALL ALAERH( PATH, 'DGERQS', INFO, 0, ' ', 407 $ M, N, NRHS, -1, NB, IMAT, 408 $ NFAIL, NERRS, NOUT ) 409* 410 CALL DGET02( 'No transpose', M, N, NRHS, A, 411 $ LDA, X, LDA, B, LDA, RWORK, 412 $ RESULT( 7 ) ) 413 NT = NT + 1 414 END IF 415 END IF 416* 417* Print information about the tests that did not 418* pass the threshold. 419* 420 DO 20 I = 1, NT 421 IF( RESULT( I ).GE.THRESH ) THEN 422 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 423 $ CALL ALAHD( NOUT, PATH ) 424 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, 425 $ IMAT, I, RESULT( I ) 426 NFAIL = NFAIL + 1 427 END IF 428 20 CONTINUE 429 NRUN = NRUN + NT 430 30 CONTINUE 431 40 CONTINUE 432 50 CONTINUE 433 60 CONTINUE 434 70 CONTINUE 435* 436* Print a summary of the results. 437* 438 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 439* 440 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', 441 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) 442 RETURN 443* 444* End of DCHKRQ 445* 446 END 447