TESTING/LIN/cchkhe_aa.f

   1 *> \brief \b CCHKHE_AA
   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 CCHKHE_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
  12 *                             THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
  13 *                             XACT, WORK, RWORK, IWORK, NOUT )
  14 *
  15 *       .. Scalar Arguments ..
  16 *       LOGICAL    TSTERR
  17 *       INTEGER    NN, NNB, NNS, NOUT
  18 *       REAL       THRESH
  19 *       ..
  20 *       .. Array Arguments ..
  21 *       LOGICAL    DOTYPE( * )
  22 *       INTEGER    IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
  23 *       REAL       RWORK( * )
  24 *       COMPLEX    A( * ), AFAC( * ), AINV( * ), B( * ),
  25 *      $           WORK( * ), X( * ), XACT( * )
  26 *       ..
  27 *
  28 *
  29 *> \par Purpose:
  30 *  =============
  31 *>
  32 *> \verbatim
  33 *>
  34 *> CCHKHE_AA tests CHETRF_AA, -TRS_AA.
  35 *> \endverbatim
  36 *
  37 *  Arguments:
  38 *  ==========
  39 *
  40 *> \param[in] DOTYPE
  41 *> \verbatim
  42 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
  43 *>          The matrix types to be used for testing.  Matrices of type j
  44 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  45 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  46 *> \endverbatim
  47 *>
  48 *> \param[in] NN
  49 *> \verbatim
  50 *>          NN is INTEGER
  51 *>          The number of values of N contained in the vector NVAL.
  52 *> \endverbatim
  53 *>
  54 *> \param[in] NVAL
  55 *> \verbatim
  56 *>          NVAL is INTEGER array, dimension (NN)
  57 *>          The values of the matrix dimension N.
  58 *> \endverbatim
  59 *>
  60 *> \param[in] NNB
  61 *> \verbatim
  62 *>          NNB is INTEGER
  63 *>          The number of values of NB contained in the vector NBVAL.
  64 *> \endverbatim
  65 *>
  66 *> \param[in] NBVAL
  67 *> \verbatim
  68 *>          NBVAL is INTEGER array, dimension (NBVAL)
  69 *>          The values of the blocksize NB.
  70 *> \endverbatim
  71 *>
  72 *> \param[in] NNS
  73 *> \verbatim
  74 *>          NNS is INTEGER
  75 *>          The number of values of NRHS contained in the vector NSVAL.
  76 *> \endverbatim
  77 *>
  78 *> \param[in] NSVAL
  79 *> \verbatim
  80 *>          NSVAL is INTEGER array, dimension (NNS)
  81 *>          The values of the number of right hand sides NRHS.
  82 *> \endverbatim
  83 *>
  84 *> \param[in] THRESH
  85 *> \verbatim
  86 *>          THRESH is REAL
  87 *>          The threshold value for the test ratios.  A result is
  88 *>          included in the output file if RESULT >= THRESH.  To have
  89 *>          every test ratio printed, use THRESH = 0.
  90 *> \endverbatim
  91 *>
  92 *> \param[in] TSTERR
  93 *> \verbatim
  94 *>          TSTERR is LOGICAL
  95 *>          Flag that indicates whether error exits are to be tested.
  96 *> \endverbatim
  97 *>
  98 *> \param[in] NMAX
  99 *> \verbatim
 100 *>          NMAX is INTEGER
 101 *>          The maximum value permitted for N, used in dimensioning the
 102 *>          work arrays.
 103 *> \endverbatim
 104 *>
 105 *> \param[out] A
 106 *> \verbatim
 107 *>          A is COMPLEX array, dimension (NMAX*NMAX)
 108 *> \endverbatim
 109 *>
 110 *> \param[out] AFAC
 111 *> \verbatim
 112 *>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
 113 *> \endverbatim
 114 *>
 115 *> \param[out] AINV
 116 *> \verbatim
 117 *>          AINV is COMPLEX array, dimension (NMAX*NMAX)
 118 *> \endverbatim
 119 *>
 120 *> \param[out] B
 121 *> \verbatim
 122 *>          B is COMPLEX array, dimension (NMAX*NSMAX)
 123 *>          where NSMAX is the largest entry in NSVAL.
 124 *> \endverbatim
 125 *>
 126 *> \param[out] X
 127 *> \verbatim
 128 *>          X is COMPLEX array, dimension (NMAX*NSMAX)
 129 *> \endverbatim
 130 *>
 131 *> \param[out] XACT
 132 *> \verbatim
 133 *>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
 134 *> \endverbatim
 135 *>
 136 *> \param[out] WORK
 137 *> \verbatim
 138 *>          WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
 139 *> \endverbatim
 140 *>
 141 *> \param[out] RWORK
 142 *> \verbatim
 143 *>          RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
 144 *> \endverbatim
 145 *>
 146 *> \param[out] IWORK
 147 *> \verbatim
 148 *>          IWORK is INTEGER array, dimension (NMAX)
 149 *> \endverbatim
 150 *>
 151 *> \param[in] NOUT
 152 *> \verbatim
 153 *>          NOUT is INTEGER
 154 *>          The unit number for output.
 155 *> \endverbatim
 156 *
 157 *  Authors:
 158 *  ========
 159 *
 160 *> \author Univ. of Tennessee
 161 *> \author Univ. of California Berkeley
 162 *> \author Univ. of Colorado Denver
 163 *> \author NAG Ltd.
 164 *
 165 *> \date June 2017
 166 *
 167 *
 168 *> \ingroup complex_lin
 169 *
 170 *  =====================================================================
 171       SUBROUTINE CCHKHE_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
 172      $                      THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
 173      $                      X, XACT, WORK, RWORK, IWORK, NOUT )
 174 *
 175 *  -- LAPACK test routine (version 3.7.1) --
 176 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 177 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 178 *     June 2017
 179 *
 180       IMPLICIT NONE
 181 *
 182 *     .. Scalar Arguments ..
 183       LOGICAL      TSTERR
 184       INTEGER      NMAX, NN, NNB, NNS, NOUT
 185       REAL         THRESH
 186 *     ..
 187 *     .. Array Arguments ..
 188       LOGICAL      DOTYPE( * )
 189       INTEGER      IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
 190       REAL         RWORK( * )
 191       COMPLEX      A( * ), AFAC( * ), AINV( * ), B( * ),
 192      $             WORK( * ), X( * ), XACT( * )
 193 *     ..
 194 *
 195 *  =====================================================================
 196 *
 197 *     .. Parameters ..
 198       REAL         ZERO
 199       PARAMETER    ( ZERO = 0.0E+0 )
 200       COMPLEX      CZERO
 201       PARAMETER    ( CZERO = ( 0.0E+0, 0.0E+0 ) )
 202       INTEGER      NTYPES
 203       PARAMETER    ( NTYPES = 10 )
 204       INTEGER      NTESTS
 205       PARAMETER    ( NTESTS = 9 )
 206 *     ..
 207 *     .. Local Scalars ..
 208       LOGICAL      ZEROT
 209       CHARACTER    DIST, TYPE, UPLO, XTYPE
 210       CHARACTER*3  PATH, MATPATH
 211       INTEGER      I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
 212      $             IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
 213      $             N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
 214       REAL         ANORM, CNDNUM
 215 *     ..
 216 *     .. Local Arrays ..
 217       CHARACTER    UPLOS( 2 )
 218       INTEGER      ISEED( 4 ), ISEEDY( 4 )
 219       REAL         RESULT( NTESTS )
 220 *     ..
 221 *     .. External Subroutines ..
 222       EXTERNAL     ALAERH, ALAHD, ALASUM, XLAENV, CERRHE, CHET01_AA,
 223      $             CHETRF_AA, CHETRS_AA, CLACPY, CLAIPD, CLARHS,
 224      $             CLATB4, CLATMS, CPOT02
 225 *     ..
 226 *     .. Intrinsic Functions ..
 227       INTRINSIC    MAX, MIN
 228 *     ..
 229 *     .. Scalars in Common ..
 230       LOGICAL      LERR, OK
 231       CHARACTER*32 SRNAMT
 232       INTEGER      INFOT, NUNIT
 233 *     ..
 234 *     .. Common blocks ..
 235       COMMON       / INFOC / INFOT, NUNIT, OK, LERR
 236       COMMON       / SRNAMC / SRNAMT
 237 *     ..
 238 *     .. Data statements ..
 239       DATA         ISEEDY / 1988, 1989, 1990, 1991 /
 240       DATA         UPLOS / 'U', 'L' /
 241 *     ..
 242 *     .. Executable Statements ..
 243 *
 244 *     Initialize constants and the random number seed.
 245 *
 246 *
 247 *     Test path
 248 *
 249       PATH( 1: 1 ) = 'Complex precision'
 250       PATH( 2: 3 ) = 'HA'
 251 *
 252 *     Path to generate matrices
 253 *
 254       MATPATH( 1: 1 ) = 'Complex precision'
 255       MATPATH( 2: 3 ) = 'HE'
 256       NRUN = 0
 257       NFAIL = 0
 258       NERRS = 0
 259       DO 10 I = 1, 4
 260          ISEED( I ) = ISEEDY( I )
 261    10 CONTINUE
 262 *
 263 *     Test the error exits
 264 *
 265       IF( TSTERR )
 266      $   CALL CERRHE( PATH, NOUT )
 267       INFOT = 0
 268 *
 269 *     Set the minimum block size for which the block routine should
 270 *     be used, which will be later returned by ILAENV
 271 *
 272       CALL XLAENV( 2, 2 )
 273 *
 274 *     Do for each value of N in NVAL
 275 *
 276       DO 180 IN = 1, NN
 277          N = NVAL( IN )
 278          IF( N .GT. NMAX ) THEN
 279             NFAIL = NFAIL + 1
 280             WRITE(NOUT, 9995) 'M ', N, NMAX
 281             GO TO 180
 282          END IF
 283          LDA = MAX( N, 1 )
 284          XTYPE = 'N'
 285          NIMAT = NTYPES
 286          IF( N.LE.0 )
 287      $      NIMAT = 1
 288 *
 289          IZERO = 0
 290          DO 170 IMAT = 1, NIMAT
 291 *
 292 *           Do the tests only if DOTYPE( IMAT ) is true.
 293 *
 294             IF( .NOT.DOTYPE( IMAT ) )
 295      $         GO TO 170
 296 *
 297 *           Skip types 3, 4, 5, or 6 if the matrix size is too small.
 298 *
 299             ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
 300             IF( ZEROT .AND. N.LT.IMAT-2 )
 301      $         GO TO 170
 302 *
 303 *           Do first for UPLO = 'U', then for UPLO = 'L'
 304 *
 305             DO 160 IUPLO = 1, 2
 306                UPLO = UPLOS( IUPLO )
 307 *
 308 *              Set up parameters with CLATB4 for the matrix generator
 309 *              based on the type of matrix to be generated.
 310 *
 311                CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
 312      $                      ANORM, MODE, CNDNUM, DIST )
 313 *
 314 *              Generate a matrix with CLATMS.
 315 *
 316                SRNAMT = 'CLATMS'
 317                CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
 318      $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
 319      $                      INFO )
 320 *
 321 *              Check error code from CLATMS and handle error.
 322 *
 323                IF( INFO.NE.0 ) THEN
 324                   CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
 325      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
 326 *
 327 *                 Skip all tests for this generated matrix
 328 *
 329                   GO TO 160
 330                END IF
 331 *
 332 *              For types 3-6, zero one or more rows and columns of
 333 *              the matrix to test that INFO is returned correctly.
 334 *
 335                IF( ZEROT ) THEN
 336                   IF( IMAT.EQ.3 ) THEN
 337                      IZERO = 1
 338                   ELSE IF( IMAT.EQ.4 ) THEN
 339                      IZERO = N
 340                   ELSE
 341                      IZERO = N / 2 + 1
 342                   END IF
 343 *
 344                   IF( IMAT.LT.6 ) THEN
 345 *
 346 *                    Set row and column IZERO to zero.
 347 *
 348                      IF( IUPLO.EQ.1 ) THEN
 349                         IOFF = ( IZERO-1 )*LDA
 350                         DO 20 I = 1, IZERO - 1
 351                            A( IOFF+I ) = CZERO
 352    20                   CONTINUE
 353                         IOFF = IOFF + IZERO
 354                         DO 30 I = IZERO, N
 355                            A( IOFF ) = CZERO
 356                            IOFF = IOFF + LDA
 357    30                   CONTINUE
 358                      ELSE
 359                         IOFF = IZERO
 360                         DO 40 I = 1, IZERO - 1
 361                            A( IOFF ) = CZERO
 362                            IOFF = IOFF + LDA
 363    40                   CONTINUE
 364                         IOFF = IOFF - IZERO
 365                         DO 50 I = IZERO, N
 366                            A( IOFF+I ) = CZERO
 367    50                   CONTINUE
 368                      END IF
 369                   ELSE
 370                      IF( IUPLO.EQ.1 ) THEN
 371 *
 372 *                       Set the first IZERO rows and columns to zero.
 373 *
 374                         IOFF = 0
 375                         DO 70 J = 1, N
 376                            I2 = MIN( J, IZERO )
 377                            DO 60 I = 1, I2
 378                               A( IOFF+I ) = CZERO
 379    60                      CONTINUE
 380                            IOFF = IOFF + LDA
 381    70                   CONTINUE
 382                         IZERO = 1
 383                      ELSE
 384 *
 385 *                       Set the last IZERO rows and columns to zero.
 386 *
 387                         IOFF = 0
 388                         DO 90 J = 1, N
 389                            I1 = MAX( J, IZERO )
 390                            DO 80 I = I1, N
 391                               A( IOFF+I ) = CZERO
 392    80                      CONTINUE
 393                            IOFF = IOFF + LDA
 394    90                   CONTINUE
 395                      END IF
 396                   END IF
 397                ELSE
 398                   IZERO = 0
 399                END IF
 400 *
 401 *              End generate test matrix A.
 402 *
 403 *
 404 *              Set the imaginary part of the diagonals.
 405 *
 406                CALL CLAIPD( N, A, LDA+1, 0 )
 407 *
 408 *              Do for each value of NB in NBVAL
 409 *
 410                DO 150 INB = 1, NNB
 411 *
 412 *                 Set the optimal blocksize, which will be later
 413 *                 returned by ILAENV.
 414 *
 415                   NB = NBVAL( INB )
 416                   CALL XLAENV( 1, NB )
 417 *
 418 *                 Copy the test matrix A into matrix AFAC which
 419 *                 will be factorized in place. This is needed to
 420 *                 preserve the test matrix A for subsequent tests.
 421 *
 422                   CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
 423 *
 424 *                 Compute the L*D*L**T or U*D*U**T factorization of the
 425 *                 matrix. IWORK stores details of the interchanges and
 426 *                 the block structure of D. AINV is a work array for
 427 *                 block factorization, LWORK is the length of AINV.
 428 *
 429                   LWORK = MAX( 1, ( NB+1 )*LDA )
 430                   SRNAMT = 'CHETRF_AA'
 431                   CALL CHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
 432      $                            LWORK, INFO )
 433 *
 434 *                 Adjust the expected value of INFO to account for
 435 *                 pivoting.
 436 *
 437 c                  IF( IZERO.GT.0 ) THEN
 438 c                     J = 1
 439 c                     K = IZERO
 440 c  100                CONTINUE
 441 c                     IF( J.EQ.K ) THEN
 442 c                        K = IWORK( J )
 443 c                     ELSE IF( IWORK( J ).EQ.K ) THEN
 444 c                        K = J
 445 c                     END IF
 446 c                     IF( J.LT.K ) THEN
 447 c                        J = J + 1
 448 c                        GO TO 100
 449 c                     END IF
 450 c                  ELSE
 451                      K = 0
 452 c                  END IF
 453 *
 454 *                 Check error code from CHETRF and handle error.
 455 *
 456                   IF( INFO.NE.K ) THEN
 457                      CALL ALAERH( PATH, 'CHETRF_AA', INFO, K, UPLO,
 458      $                            N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
 459      $                            NOUT )
 460                   END IF
 461 *
 462 *+    TEST 1
 463 *                 Reconstruct matrix from factors and compute residual.
 464 *
 465                   CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
 466      $                            AINV, LDA, RWORK, RESULT( 1 ) )
 467                   NT = 1
 468 *
 469 *
 470 *                 Print information about the tests that did not pass
 471 *                 the threshold.
 472 *
 473                   DO 110 K = 1, NT
 474                      IF( RESULT( K ).GE.THRESH ) THEN
 475                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 476      $                     CALL ALAHD( NOUT, PATH )
 477                         WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
 478      $                     RESULT( K )
 479                         NFAIL = NFAIL + 1
 480                      END IF
 481   110             CONTINUE
 482                   NRUN = NRUN + NT
 483 *
 484 *                 Skip solver test if INFO is not 0.
 485 *
 486                   IF( INFO.NE.0 ) THEN
 487                      GO TO 140
 488                   END IF
 489 *
 490 *                 Do for each value of NRHS in NSVAL.
 491 *
 492                   DO 130 IRHS = 1, NNS
 493                      NRHS = NSVAL( IRHS )
 494 *
 495 *+    TEST 2 (Using TRS)
 496 *                 Solve and compute residual for  A * X = B.
 497 *
 498 *                    Choose a set of NRHS random solution vectors
 499 *                    stored in XACT and set up the right hand side B
 500 *
 501                      SRNAMT = 'CLARHS'
 502                      CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
 503      $                            KL, KU, NRHS, A, LDA, XACT, LDA,
 504      $                            B, LDA, ISEED, INFO )
 505                      CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 506 *
 507                      SRNAMT = 'CHETRS_AA'
 508                      LWORK = MAX( 1, 3*N-2 )
 509                      CALL CHETRS_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
 510      $                               X, LDA, WORK, LWORK, INFO )
 511 *
 512 *                    Check error code from CHETRS and handle error.
 513 *
 514                      IF( INFO.NE.0 ) THEN
 515                         IF( IZERO.EQ.0 ) THEN
 516                            CALL ALAERH( PATH, 'CHETRS_AA', INFO, 0,
 517      $                                   UPLO, N, N, -1, -1, NRHS, IMAT,
 518      $                                   NFAIL, NERRS, NOUT )
 519                         END IF
 520                      ELSE
 521                         CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
 522      $                               )
 523 *
 524 *                       Compute the residual for the solution
 525 *
 526                         CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
 527      $                               WORK, LDA, RWORK, RESULT( 2 ) )
 528 *
 529 *                       Print information about the tests that did not pass
 530 *                       the threshold.
 531 *
 532                         DO 120 K = 2, 2
 533                            IF( RESULT( K ).GE.THRESH ) THEN
 534                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 535      $                           CALL ALAHD( NOUT, PATH )
 536                               WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
 537      $                           IMAT, K, RESULT( K )
 538                               NFAIL = NFAIL + 1
 539                            END IF
 540   120                   CONTINUE
 541                      END IF
 542                      NRUN = NRUN + 1
 543 *
 544 *                 End do for each value of NRHS in NSVAL.
 545 *
 546   130             CONTINUE
 547   140             CONTINUE
 548   150          CONTINUE
 549   160       CONTINUE
 550   170    CONTINUE
 551   180 CONTINUE
 552 *
 553 *     Print a summary of the results.
 554 *
 555       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 556 *
 557  9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
 558      $      I2, ', test ', I2, ', ratio =', G12.5 )
 559  9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
 560      $      I2, ', test(', I2, ') =', G12.5 )
 561  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
 562      $      I6 )
 563       RETURN
 564 *
 565 *     End of CCHKHE_AA
 566 *
 567       END