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 November 2016
 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.0) --
 176 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 177 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 178 *     November 2016
 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      TRFCON, 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, RCOND, RCONDC
 215 *     ..
 216 *     .. Local Arrays ..
 217       CHARACTER    UPLOS( 2 )
 218       INTEGER      ISEED( 4 ), ISEEDY( 4 )
 219       REAL         RESULT( NTESTS )
 220 *     ..
 221 *     .. External Functions ..
 222       REAL         DGET06, CLANHE
 223       EXTERNAL     DGET06, CLANHE
 224 *     ..
 225 *     .. External Subroutines ..
 226       EXTERNAL     ALAERH, ALAHD, ALASUM, XLAENV, CERRHE, CGET04,
 227      $             ZHECON, CHERFS, CHET01, CHETRF_AA, ZHETRI2,
 228      $             CHETRS_AA, CLACPY, CLAIPD, CLARHS, CLATB4,
 229      $             CLATMS, CPOT02, ZPOT03, ZPOT05
 230 *     ..
 231 *     .. Intrinsic Functions ..
 232       INTRINSIC    REAL, IMAG, MAX, MIN
 233 *     ..
 234 *     .. Scalars in Common ..
 235       LOGICAL      LERR, OK
 236       CHARACTER*32 SRNAMT
 237       INTEGER      INFOT, NUNIT
 238 *     ..
 239 *     .. Common blocks ..
 240       COMMON       / INFOC / INFOT, NUNIT, OK, LERR
 241       COMMON       / SRNAMC / SRNAMT
 242 *     ..
 243 *     .. Data statements ..
 244       DATA         ISEEDY / 1988, 1989, 1990, 1991 /
 245       DATA         UPLOS / 'U', 'L' /
 246 *     ..
 247 *     .. Executable Statements ..
 248 *
 249 *     Initialize constants and the random number seed.
 250 *
 251 *
 252 *     Test path
 253 *
 254       PATH( 1: 1 ) = 'Complex precision'
 255       PATH( 2: 3 ) = 'HA'
 256 *
 257 *     Path to generate matrices
 258 *
 259       MATPATH( 1: 1 ) = 'Complex precision'
 260       MATPATH( 2: 3 ) = 'HE'
 261       NRUN = 0
 262       NFAIL = 0
 263       NERRS = 0
 264       DO 10 I = 1, 4
 265          ISEED( I ) = ISEEDY( I )
 266    10 CONTINUE
 267 *
 268 *     Test the error exits
 269 *
 270       IF( TSTERR )
 271      $   CALL CERRHE( PATH, NOUT )
 272       INFOT = 0
 273 *
 274 *     Set the minimum block size for which the block routine should
 275 *     be used, which will be later returned by ILAENV
 276 *
 277       CALL XLAENV( 2, 2 )
 278 *
 279 *     Do for each value of N in NVAL
 280 *
 281       DO 180 IN = 1, NN
 282          N = NVAL( IN )
 283          IF( N .GT. NMAX ) THEN
 284             NFAIL = NFAIL + 1
 285             WRITE(NOUT, 9995) 'M ', N, NMAX
 286             GO TO 180
 287          END IF
 288          LDA = MAX( N, 1 )
 289          XTYPE = 'N'
 290          NIMAT = NTYPES
 291          IF( N.LE.0 )
 292      $      NIMAT = 1
 293 *
 294          IZERO = 0
 295          DO 170 IMAT = 1, NIMAT
 296 *
 297 *           Do the tests only if DOTYPE( IMAT ) is true.
 298 *
 299             IF( .NOT.DOTYPE( IMAT ) )
 300      $         GO TO 170
 301 *
 302 *           Skip types 3, 4, 5, or 6 if the matrix size is too small.
 303 *
 304             ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
 305             IF( ZEROT .AND. N.LT.IMAT-2 )
 306      $         GO TO 170
 307 *
 308 *           Do first for UPLO = 'U', then for UPLO = 'L'
 309 *
 310             DO 160 IUPLO = 1, 2
 311                UPLO = UPLOS( IUPLO )
 312 *
 313 *              Set up parameters with CLATB4 for the matrix generator
 314 *              based on the type of matrix to be generated.
 315 *
 316                CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
 317      $                      ANORM, MODE, CNDNUM, DIST )
 318 *
 319 *              Generate a matrix with CLATMS.
 320 *
 321                SRNAMT = 'CLATMS'
 322                CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
 323      $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
 324      $                      INFO )
 325 *
 326 *              Check error code from CLATMS and handle error.
 327 *
 328                IF( INFO.NE.0 ) THEN
 329                   CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
 330      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
 331 *
 332 *                 Skip all tests for this generated matrix
 333 *
 334                   GO TO 160
 335                END IF
 336 *
 337 *              For types 3-6, zero one or more rows and columns of
 338 *              the matrix to test that INFO is returned correctly.
 339 *
 340                IF( ZEROT ) THEN
 341                   IF( IMAT.EQ.3 ) THEN
 342                      IZERO = 1
 343                   ELSE IF( IMAT.EQ.4 ) THEN
 344                      IZERO = N
 345                   ELSE
 346                      IZERO = N / 2 + 1
 347                   END IF
 348 *
 349                   IF( IMAT.LT.6 ) THEN
 350 *
 351 *                    Set row and column IZERO to zero.
 352 *
 353                      IF( IUPLO.EQ.1 ) THEN
 354                         IOFF = ( IZERO-1 )*LDA
 355                         DO 20 I = 1, IZERO - 1
 356                            A( IOFF+I ) = CZERO
 357    20                   CONTINUE
 358                         IOFF = IOFF + IZERO
 359                         DO 30 I = IZERO, N
 360                            A( IOFF ) = CZERO
 361                            IOFF = IOFF + LDA
 362    30                   CONTINUE
 363                      ELSE
 364                         IOFF = IZERO
 365                         DO 40 I = 1, IZERO - 1
 366                            A( IOFF ) = CZERO
 367                            IOFF = IOFF + LDA
 368    40                   CONTINUE
 369                         IOFF = IOFF - IZERO
 370                         DO 50 I = IZERO, N
 371                            A( IOFF+I ) = CZERO
 372    50                   CONTINUE
 373                      END IF
 374                   ELSE
 375                      IF( IUPLO.EQ.1 ) THEN
 376 *
 377 *                       Set the first IZERO rows and columns to zero.
 378 *
 379                         IOFF = 0
 380                         DO 70 J = 1, N
 381                            I2 = MIN( J, IZERO )
 382                            DO 60 I = 1, I2
 383                               A( IOFF+I ) = CZERO
 384    60                      CONTINUE
 385                            IOFF = IOFF + LDA
 386    70                   CONTINUE
 387                         IZERO = 1
 388                      ELSE
 389 *
 390 *                       Set the last IZERO rows and columns to zero.
 391 *
 392                         IOFF = 0
 393                         DO 90 J = 1, N
 394                            I1 = MAX( J, IZERO )
 395                            DO 80 I = I1, N
 396                               A( IOFF+I ) = CZERO
 397    80                      CONTINUE
 398                            IOFF = IOFF + LDA
 399    90                   CONTINUE
 400                      END IF
 401                   END IF
 402                ELSE
 403                   IZERO = 0
 404                END IF
 405 *
 406 *              End generate test matrix A.
 407 *
 408 *
 409 *              Set the imaginary part of the diagonals.
 410 *
 411                CALL CLAIPD( N, A, LDA+1, 0 )
 412 *
 413 *              Do for each value of NB in NBVAL
 414 *
 415                DO 150 INB = 1, NNB
 416 *
 417 *                 Set the optimal blocksize, which will be later
 418 *                 returned by ILAENV.
 419 *
 420                   NB = NBVAL( INB )
 421                   CALL XLAENV( 1, NB )
 422 *
 423 *                 Copy the test matrix A into matrix AFAC which
 424 *                 will be factorized in place. This is needed to
 425 *                 preserve the test matrix A for subsequent tests.
 426 *
 427                   CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
 428 *
 429 *                 Compute the L*D*L**T or U*D*U**T factorization of the
 430 *                 matrix. IWORK stores details of the interchanges and
 431 *                 the block structure of D. AINV is a work array for
 432 *                 block factorization, LWORK is the length of AINV.
 433 *
 434                   LWORK = ( NB+1 )*LDA
 435                   SRNAMT = 'CHETRF_AA'
 436                   CALL CHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
 437      $                               LWORK, INFO )
 438 *
 439 *                 Adjust the expected value of INFO to account for
 440 *                 pivoting.
 441 *
 442                   IF( IZERO.GT.0 ) THEN
 443                      J = 1
 444                      K = IZERO
 445   100                CONTINUE
 446                      IF( J.EQ.K ) THEN
 447                         K = IWORK( J )
 448                      ELSE IF( IWORK( J ).EQ.K ) THEN
 449                         K = J
 450                      END IF
 451                      IF( J.LT.K ) THEN
 452                         J = J + 1
 453                         GO TO 100
 454                      END IF
 455                   ELSE
 456                      K = 0
 457                   END IF
 458 *
 459 *                 Check error code from CHETRF and handle error.
 460 *
 461                   IF( INFO.NE.K ) THEN
 462                      CALL ALAERH( PATH, 'CHETRF_AA', INFO, K, UPLO,
 463      $                            N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
 464      $                            NOUT )
 465                   END IF
 466 *
 467 *                 Set the condition estimate flag if the INFO is not 0.
 468 *
 469                   IF( INFO.NE.0 ) THEN
 470                      TRFCON = .TRUE.
 471                   ELSE
 472                      TRFCON = .FALSE.
 473                   END IF
 474 *
 475 *+    TEST 1
 476 *                 Reconstruct matrix from factors and compute residual.
 477 *
 478                   CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
 479      $                               AINV, LDA, RWORK, RESULT( 1 ) )
 480                   NT = 1
 481 *
 482 *
 483 *                 Print information about the tests that did not pass
 484 *                 the threshold.
 485 *
 486                   DO 110 K = 1, NT
 487                      IF( RESULT( K ).GE.THRESH ) THEN
 488                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 489      $                     CALL ALAHD( NOUT, PATH )
 490                         WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
 491      $                     RESULT( K )
 492                         NFAIL = NFAIL + 1
 493                      END IF
 494   110             CONTINUE
 495                   NRUN = NRUN + NT
 496 *
 497 *                 Do only the condition estimate if INFO is not 0.
 498 *
 499                   IF( TRFCON ) THEN
 500                      RCONDC = ZERO
 501                      GO TO 140
 502                   END IF
 503 *
 504 *                 Do for each value of NRHS in NSVAL.
 505 *
 506                   DO 130 IRHS = 1, NNS
 507                      NRHS = NSVAL( IRHS )
 508 *
 509 *+    TEST 3 (Using TRS)
 510 *                 Solve and compute residual for  A * X = B.
 511 *
 512 *                    Choose a set of NRHS random solution vectors
 513 *                    stored in XACT and set up the right hand side B
 514 *
 515                      SRNAMT = 'CLARHS'
 516                      CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
 517      $                            KL, KU, NRHS, A, LDA, XACT, LDA,
 518      $                            B, LDA, ISEED, INFO )
 519                      CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 520 *
 521                      SRNAMT = 'CHETRS_AA'
 522                      LWORK = 3*N-2
 523                      CALL CHETRS_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
 524      $                                  X, LDA, WORK, LWORK, INFO )
 525 *
 526 *                    Check error code from CHETRS and handle error.
 527 *
 528                      IF( INFO.NE.0 ) THEN
 529                         CALL ALAERH( PATH, 'CHETRS_AA', INFO, 0,
 530      $                                UPLO, N, N, -1, -1, NRHS, IMAT,
 531      $                                NFAIL, NERRS, NOUT )
 532                      END IF
 533 *
 534                      CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
 535 *
 536 *                    Compute the residual for the solution
 537 *
 538                      CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
 539      $                            LDA, RWORK, RESULT( 2 ) )
 540 *
 541 *                    Print information about the tests that did not pass
 542 *                    the threshold.
 543 *
 544                      DO 120 K = 2, 2
 545                         IF( RESULT( K ).GE.THRESH ) THEN
 546                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 547      $                        CALL ALAHD( NOUT, PATH )
 548                            WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
 549      $                        IMAT, K, RESULT( K )
 550                            NFAIL = NFAIL + 1
 551                         END IF
 552   120                CONTINUE
 553                      NRUN = NRUN + 1
 554 *
 555 *                 End do for each value of NRHS in NSVAL.
 556 *
 557   130             CONTINUE
 558   140             CONTINUE
 559   150          CONTINUE
 560   160       CONTINUE
 561   170    CONTINUE
 562   180 CONTINUE
 563 *
 564 *     Print a summary of the results.
 565 *
 566       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 567 *
 568  9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
 569      $      I2, ', test ', I2, ', ratio =', G12.5 )
 570  9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
 571      $      I2, ', test(', I2, ') =', G12.5 )
 572  9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
 573      $      I6 )
 574       RETURN
 575 *
 576 *     End of CCHKHE_AA
 577 *
 578       END