1*> \brief \b DCHKPS 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 DCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, 12* THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, 13* RWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* DOUBLE PRECISION THRESH 17* INTEGER NMAX, NN, NNB, NOUT, NRANK 18* LOGICAL TSTERR 19* .. 20* .. Array Arguments .. 21* DOUBLE PRECISION A( * ), AFAC( * ), PERM( * ), RWORK( * ), 22* $ WORK( * ) 23* INTEGER NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * ) 24* LOGICAL DOTYPE( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> DCHKPS tests DPSTRF. 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] NN 48*> \verbatim 49*> NN is INTEGER 50*> The number of values of N contained in the vector NVAL. 51*> \endverbatim 52*> 53*> \param[in] NVAL 54*> \verbatim 55*> NVAL is INTEGER array, dimension (NN) 56*> The values of the matrix dimension N. 57*> \endverbatim 58*> 59*> \param[in] NNB 60*> \verbatim 61*> NNB is INTEGER 62*> The number of values of NB contained in the vector NBVAL. 63*> \endverbatim 64*> 65*> \param[in] NBVAL 66*> \verbatim 67*> NBVAL is INTEGER array, dimension (NNB) 68*> The values of the block size NB. 69*> \endverbatim 70*> 71*> \param[in] NRANK 72*> \verbatim 73*> NRANK is INTEGER 74*> The number of values of RANK contained in the vector RANKVAL. 75*> \endverbatim 76*> 77*> \param[in] RANKVAL 78*> \verbatim 79*> RANKVAL is INTEGER array, dimension (NBVAL) 80*> The values of the block size NB. 81*> \endverbatim 82*> 83*> \param[in] THRESH 84*> \verbatim 85*> THRESH is DOUBLE PRECISION 86*> The threshold value for the test ratios. A result is 87*> included in the output file if RESULT >= THRESH. To have 88*> every test ratio printed, use THRESH = 0. 89*> \endverbatim 90*> 91*> \param[in] TSTERR 92*> \verbatim 93*> TSTERR is LOGICAL 94*> Flag that indicates whether error exits are to be tested. 95*> \endverbatim 96*> 97*> \param[in] NMAX 98*> \verbatim 99*> NMAX is INTEGER 100*> The maximum value permitted for N, used in dimensioning the 101*> work arrays. 102*> \endverbatim 103*> 104*> \param[out] A 105*> \verbatim 106*> A is DOUBLE PRECISION array, dimension (NMAX*NMAX) 107*> \endverbatim 108*> 109*> \param[out] AFAC 110*> \verbatim 111*> AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX) 112*> \endverbatim 113*> 114*> \param[out] PERM 115*> \verbatim 116*> PERM is DOUBLE PRECISION array, dimension (NMAX*NMAX) 117*> \endverbatim 118*> 119*> \param[out] PIV 120*> \verbatim 121*> PIV is INTEGER array, dimension (NMAX) 122*> \endverbatim 123*> 124*> \param[out] WORK 125*> \verbatim 126*> WORK is DOUBLE PRECISION array, dimension (NMAX*3) 127*> \endverbatim 128*> 129*> \param[out] RWORK 130*> \verbatim 131*> RWORK is DOUBLE PRECISION array, dimension (NMAX) 132*> \endverbatim 133*> 134*> \param[in] NOUT 135*> \verbatim 136*> NOUT is INTEGER 137*> The unit number for output. 138*> \endverbatim 139* 140* Authors: 141* ======== 142* 143*> \author Univ. of Tennessee 144*> \author Univ. of California Berkeley 145*> \author Univ. of Colorado Denver 146*> \author NAG Ltd. 147* 148*> \ingroup double_lin 149* 150* ===================================================================== 151 SUBROUTINE DCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, 152 $ THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, 153 $ RWORK, NOUT ) 154* 155* -- LAPACK test routine -- 156* -- LAPACK is a software package provided by Univ. of Tennessee, -- 157* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 158* 159* .. Scalar Arguments .. 160 DOUBLE PRECISION THRESH 161 INTEGER NMAX, NN, NNB, NOUT, NRANK 162 LOGICAL TSTERR 163* .. 164* .. Array Arguments .. 165 DOUBLE PRECISION A( * ), AFAC( * ), PERM( * ), RWORK( * ), 166 $ WORK( * ) 167 INTEGER NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * ) 168 LOGICAL DOTYPE( * ) 169* .. 170* 171* ===================================================================== 172* 173* .. Parameters .. 174 DOUBLE PRECISION ONE 175 PARAMETER ( ONE = 1.0D+0 ) 176 INTEGER NTYPES 177 PARAMETER ( NTYPES = 9 ) 178* .. 179* .. Local Scalars .. 180 DOUBLE PRECISION ANORM, CNDNUM, RESULT, TOL 181 INTEGER COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO, 182 $ IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL, 183 $ NIMAT, NRUN, RANK, RANKDIFF 184 CHARACTER DIST, TYPE, UPLO 185 CHARACTER*3 PATH 186* .. 187* .. Local Arrays .. 188 INTEGER ISEED( 4 ), ISEEDY( 4 ) 189 CHARACTER UPLOS( 2 ) 190* .. 191* .. External Subroutines .. 192 EXTERNAL ALAERH, ALAHD, ALASUM, DERRPS, DLACPY, DLATB5, 193 $ DLATMT, DPST01, DPSTRF, XLAENV 194* .. 195* .. Scalars in Common .. 196 INTEGER INFOT, NUNIT 197 LOGICAL LERR, OK 198 CHARACTER*32 SRNAMT 199* .. 200* .. Common blocks .. 201 COMMON / INFOC / INFOT, NUNIT, OK, LERR 202 COMMON / SRNAMC / SRNAMT 203* .. 204* .. Intrinsic Functions .. 205 INTRINSIC DBLE, MAX, CEILING 206* .. 207* .. Data statements .. 208 DATA ISEEDY / 1988, 1989, 1990, 1991 / 209 DATA UPLOS / 'U', 'L' / 210* .. 211* .. Executable Statements .. 212* 213* Initialize constants and the random number seed. 214* 215 PATH( 1: 1 ) = 'Double precision' 216 PATH( 2: 3 ) = 'PS' 217 NRUN = 0 218 NFAIL = 0 219 NERRS = 0 220 DO 100 I = 1, 4 221 ISEED( I ) = ISEEDY( I ) 222 100 CONTINUE 223* 224* Test the error exits 225* 226 IF( TSTERR ) 227 $ CALL DERRPS( PATH, NOUT ) 228 INFOT = 0 229 CALL XLAENV( 2, 2 ) 230* 231* Do for each value of N in NVAL 232* 233 DO 150 IN = 1, NN 234 N = NVAL( IN ) 235 LDA = MAX( N, 1 ) 236 NIMAT = NTYPES 237 IF( N.LE.0 ) 238 $ NIMAT = 1 239* 240 IZERO = 0 241 DO 140 IMAT = 1, NIMAT 242* 243* Do the tests only if DOTYPE( IMAT ) is true. 244* 245 IF( .NOT.DOTYPE( IMAT ) ) 246 $ GO TO 140 247* 248* Do for each value of RANK in RANKVAL 249* 250 DO 130 IRANK = 1, NRANK 251* 252* Only repeat test 3 to 5 for different ranks 253* Other tests use full rank 254* 255 IF( ( IMAT.LT.3 .OR. IMAT.GT.5 ) .AND. IRANK.GT.1 ) 256 $ GO TO 130 257* 258 RANK = CEILING( ( N * DBLE( RANKVAL( IRANK ) ) ) 259 $ / 100.D+0 ) 260* 261* 262* Do first for UPLO = 'U', then for UPLO = 'L' 263* 264 DO 120 IUPLO = 1, 2 265 UPLO = UPLOS( IUPLO ) 266* 267* Set up parameters with DLATB5 and generate a test matrix 268* with DLATMT. 269* 270 CALL DLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, 271 $ MODE, CNDNUM, DIST ) 272* 273 SRNAMT = 'DLATMT' 274 CALL DLATMT( N, N, DIST, ISEED, TYPE, RWORK, MODE, 275 $ CNDNUM, ANORM, RANK, KL, KU, UPLO, A, 276 $ LDA, WORK, INFO ) 277* 278* Check error code from DLATMT. 279* 280 IF( INFO.NE.0 ) THEN 281 CALL ALAERH( PATH, 'DLATMT', INFO, 0, UPLO, N, 282 $ N, -1, -1, -1, IMAT, NFAIL, NERRS, 283 $ NOUT ) 284 GO TO 120 285 END IF 286* 287* Do for each value of NB in NBVAL 288* 289 DO 110 INB = 1, NNB 290 NB = NBVAL( INB ) 291 CALL XLAENV( 1, NB ) 292* 293* Compute the pivoted L*L' or U'*U factorization 294* of the matrix. 295* 296 CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 297 SRNAMT = 'DPSTRF' 298* 299* Use default tolerance 300* 301 TOL = -ONE 302 CALL DPSTRF( UPLO, N, AFAC, LDA, PIV, COMPRANK, 303 $ TOL, WORK, INFO ) 304* 305* Check error code from DPSTRF. 306* 307 IF( (INFO.LT.IZERO) 308 $ .OR.(INFO.NE.IZERO.AND.RANK.EQ.N) 309 $ .OR.(INFO.LE.IZERO.AND.RANK.LT.N) ) THEN 310 CALL ALAERH( PATH, 'DPSTRF', INFO, IZERO, 311 $ UPLO, N, N, -1, -1, NB, IMAT, 312 $ NFAIL, NERRS, NOUT ) 313 GO TO 110 314 END IF 315* 316* Skip the test if INFO is not 0. 317* 318 IF( INFO.NE.0 ) 319 $ GO TO 110 320* 321* Reconstruct matrix from factors and compute residual. 322* 323* PERM holds permuted L*L^T or U^T*U 324* 325 CALL DPST01( UPLO, N, A, LDA, AFAC, LDA, PERM, LDA, 326 $ PIV, RWORK, RESULT, COMPRANK ) 327* 328* Print information about the tests that did not pass 329* the threshold or where computed rank was not RANK. 330* 331 IF( N.EQ.0 ) 332 $ COMPRANK = 0 333 RANKDIFF = RANK - COMPRANK 334 IF( RESULT.GE.THRESH ) THEN 335 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 336 $ CALL ALAHD( NOUT, PATH ) 337 WRITE( NOUT, FMT = 9999 )UPLO, N, RANK, 338 $ RANKDIFF, NB, IMAT, RESULT 339 NFAIL = NFAIL + 1 340 END IF 341 NRUN = NRUN + 1 342 110 CONTINUE 343* 344 120 CONTINUE 345 130 CONTINUE 346 140 CONTINUE 347 150 CONTINUE 348* 349* Print a summary of the results. 350* 351 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 352* 353 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', RANK =', I3, 354 $ ', Diff =', I5, ', NB =', I4, ', type ', I2, ', Ratio =', 355 $ G12.5 ) 356 RETURN 357* 358* End of DCHKPS 359* 360 END 361