SRC/chfrk.f

   1 *> \brief \b CHFRK performs a Hermitian rank-k operation for matrix in RFP format.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CHFRK + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chfrk.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chfrk.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chfrk.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
  22 *                         C )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       REAL               ALPHA, BETA
  26 *       INTEGER            K, LDA, N
  27 *       CHARACTER          TRANS, TRANSR, UPLO
  28 *       ..
  29 *       .. Array Arguments ..
  30 *       COMPLEX            A( LDA, * ), C( * )
  31 *       ..
  32 *
  33 *
  34 *> \par Purpose:
  35 *  =============
  36 *>
  37 *> \verbatim
  38 *>
  39 *> Level 3 BLAS like routine for C in RFP Format.
  40 *>
  41 *> CHFRK performs one of the Hermitian rank--k operations
  42 *>
  43 *>    C := alpha*A*A**H + beta*C,
  44 *>
  45 *> or
  46 *>
  47 *>    C := alpha*A**H*A + beta*C,
  48 *>
  49 *> where alpha and beta are real scalars, C is an n--by--n Hermitian
  50 *> matrix and A is an n--by--k matrix in the first case and a k--by--n
  51 *> matrix in the second case.
  52 *> \endverbatim
  53 *
  54 *  Arguments:
  55 *  ==========
  56 *
  57 *> \param[in] TRANSR
  58 *> \verbatim
  59 *>          TRANSR is CHARACTER*1
  60 *>          = 'N':  The Normal Form of RFP A is stored;
  61 *>          = 'C':  The Conjugate-transpose Form of RFP A is stored.
  62 *> \endverbatim
  63 *>
  64 *> \param[in] UPLO
  65 *> \verbatim
  66 *>          UPLO is CHARACTER*1
  67 *>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
  68 *>           triangular  part  of the  array  C  is to be  referenced  as
  69 *>           follows:
  70 *>
  71 *>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
  72 *>                                  is to be referenced.
  73 *>
  74 *>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
  75 *>                                  is to be referenced.
  76 *>
  77 *>           Unchanged on exit.
  78 *> \endverbatim
  79 *>
  80 *> \param[in] TRANS
  81 *> \verbatim
  82 *>          TRANS is CHARACTER*1
  83 *>           On entry,  TRANS  specifies the operation to be performed as
  84 *>           follows:
  85 *>
  86 *>              TRANS = 'N' or 'n'   C := alpha*A*A**H + beta*C.
  87 *>
  88 *>              TRANS = 'C' or 'c'   C := alpha*A**H*A + beta*C.
  89 *>
  90 *>           Unchanged on exit.
  91 *> \endverbatim
  92 *>
  93 *> \param[in] N
  94 *> \verbatim
  95 *>          N is INTEGER
  96 *>           On entry,  N specifies the order of the matrix C.  N must be
  97 *>           at least zero.
  98 *>           Unchanged on exit.
  99 *> \endverbatim
 100 *>
 101 *> \param[in] K
 102 *> \verbatim
 103 *>          K is INTEGER
 104 *>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
 105 *>           of  columns   of  the   matrix   A,   and  on   entry   with
 106 *>           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
 107 *>           matrix A.  K must be at least zero.
 108 *>           Unchanged on exit.
 109 *> \endverbatim
 110 *>
 111 *> \param[in] ALPHA
 112 *> \verbatim
 113 *>          ALPHA is REAL
 114 *>           On entry, ALPHA specifies the scalar alpha.
 115 *>           Unchanged on exit.
 116 *> \endverbatim
 117 *>
 118 *> \param[in] A
 119 *> \verbatim
 120 *>          A is COMPLEX array, dimension (LDA,ka)
 121 *>           where KA
 122 *>           is K  when TRANS = 'N' or 'n', and is N otherwise. Before
 123 *>           entry with TRANS = 'N' or 'n', the leading N--by--K part of
 124 *>           the array A must contain the matrix A, otherwise the leading
 125 *>           K--by--N part of the array A must contain the matrix A.
 126 *>           Unchanged on exit.
 127 *> \endverbatim
 128 *>
 129 *> \param[in] LDA
 130 *> \verbatim
 131 *>          LDA is INTEGER
 132 *>           On entry, LDA specifies the first dimension of A as declared
 133 *>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
 134 *>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
 135 *>           be at least  max( 1, k ).
 136 *>           Unchanged on exit.
 137 *> \endverbatim
 138 *>
 139 *> \param[in] BETA
 140 *> \verbatim
 141 *>          BETA is REAL
 142 *>           On entry, BETA specifies the scalar beta.
 143 *>           Unchanged on exit.
 144 *> \endverbatim
 145 *>
 146 *> \param[in,out] C
 147 *> \verbatim
 148 *>          C is COMPLEX array, dimension (N*(N+1)/2)
 149 *>           On entry, the matrix A in RFP Format. RFP Format is
 150 *>           described by TRANSR, UPLO and N. Note that the imaginary
 151 *>           parts of the diagonal elements need not be set, they are
 152 *>           assumed to be zero, and on exit they are set to zero.
 153 *> \endverbatim
 154 *
 155 *  Authors:
 156 *  ========
 157 *
 158 *> \author Univ. of Tennessee
 159 *> \author Univ. of California Berkeley
 160 *> \author Univ. of Colorado Denver
 161 *> \author NAG Ltd.
 162 *
 163 *> \date September 2012
 164 *
 165 *> \ingroup complexOTHERcomputational
 166 *
 167 *  =====================================================================
 168       SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
 169      $                  C )
 170 *
 171 *  -- LAPACK computational routine (version 3.4.2) --
 172 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 173 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 174 *     September 2012
 175 *
 176 *     .. Scalar Arguments ..
 177       REAL               ALPHA, BETA
 178       INTEGER            K, LDA, N
 179       CHARACTER          TRANS, TRANSR, UPLO
 180 *     ..
 181 *     .. Array Arguments ..
 182       COMPLEX            A( LDA, * ), C( * )
 183 *     ..
 184 *
 185 *  =====================================================================
 186 *
 187 *     ..
 188 *     .. Parameters ..
 189       REAL               ONE, ZERO
 190       COMPLEX            CZERO
 191       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 192       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
 193 *     ..
 194 *     .. Local Scalars ..
 195       LOGICAL            LOWER, NORMALTRANSR, NISODD, NOTRANS
 196       INTEGER            INFO, NROWA, J, NK, N1, N2
 197       COMPLEX            CALPHA, CBETA
 198 *     ..
 199 *     .. External Functions ..
 200       LOGICAL            LSAME
 201       EXTERNAL           LSAME
 202 *     ..
 203 *     .. External Subroutines ..
 204       EXTERNAL           CGEMM, CHERK, XERBLA
 205 *     ..
 206 *     .. Intrinsic Functions ..
 207       INTRINSIC          MAX, CMPLX
 208 *     ..
 209 *     .. Executable Statements ..
 210 *
 211 *
 212 *     Test the input parameters.
 213 *
 214       INFO = 0
 215       NORMALTRANSR = LSAME( TRANSR, 'N' )
 216       LOWER = LSAME( UPLO, 'L' )
 217       NOTRANS = LSAME( TRANS, 'N' )
 218 *
 219       IF( NOTRANS ) THEN
 220          NROWA = N
 221       ELSE
 222          NROWA = K
 223       END IF
 224 *
 225       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
 226          INFO = -1
 227       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
 228          INFO = -2
 229       ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
 230          INFO = -3
 231       ELSE IF( N.LT.0 ) THEN
 232          INFO = -4
 233       ELSE IF( K.LT.0 ) THEN
 234          INFO = -5
 235       ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
 236          INFO = -8
 237       END IF
 238       IF( INFO.NE.0 ) THEN
 239          CALL XERBLA( 'CHFRK ', -INFO )
 240          RETURN
 241       END IF
 242 *
 243 *     Quick return if possible.
 244 *
 245 *     The quick return case: ((ALPHA.EQ.0).AND.(BETA.NE.ZERO)) is not
 246 *     done (it is in CHERK for example) and left in the general case.
 247 *
 248       IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
 249      $    ( BETA.EQ.ONE ) ) )RETURN
 250 *
 251       IF( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ZERO ) ) THEN
 252          DO J = 1, ( ( N*( N+1 ) ) / 2 )
 253             C( J ) = CZERO
 254          END DO
 255          RETURN
 256       END IF
 257 *
 258       CALPHA = CMPLX( ALPHA, ZERO )
 259       CBETA = CMPLX( BETA, ZERO )
 260 *
 261 *     C is N-by-N.
 262 *     If N is odd, set NISODD = .TRUE., and N1 and N2.
 263 *     If N is even, NISODD = .FALSE., and NK.
 264 *
 265       IF( MOD( N, 2 ).EQ.0 ) THEN
 266          NISODD = .FALSE.
 267          NK = N / 2
 268       ELSE
 269          NISODD = .TRUE.
 270          IF( LOWER ) THEN
 271             N2 = N / 2
 272             N1 = N - N2
 273          ELSE
 274             N1 = N / 2
 275             N2 = N - N1
 276          END IF
 277       END IF
 278 *
 279       IF( NISODD ) THEN
 280 *
 281 *        N is odd
 282 *
 283          IF( NORMALTRANSR ) THEN
 284 *
 285 *           N is odd and TRANSR = 'N'
 286 *
 287             IF( LOWER ) THEN
 288 *
 289 *              N is odd, TRANSR = 'N', and UPLO = 'L'
 290 *
 291                IF( NOTRANS ) THEN
 292 *
 293 *                 N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
 294 *
 295                   CALL CHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
 296      $                        BETA, C( 1 ), N )
 297                   CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
 298      $                        BETA, C( N+1 ), N )
 299                   CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
 300      $                        LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
 301 *
 302                ELSE
 303 *
 304 *                 N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
 305 *
 306                   CALL CHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
 307      $                        BETA, C( 1 ), N )
 308                   CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
 309      $                        BETA, C( N+1 ), N )
 310                   CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
 311      $                        LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
 312 *
 313                END IF
 314 *
 315             ELSE
 316 *
 317 *              N is odd, TRANSR = 'N', and UPLO = 'U'
 318 *
 319                IF( NOTRANS ) THEN
 320 *
 321 *                 N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
 322 *
 323                   CALL CHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
 324      $                        BETA, C( N2+1 ), N )
 325                   CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
 326      $                        BETA, C( N1+1 ), N )
 327                   CALL CGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
 328      $                        LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N )
 329 *
 330                ELSE
 331 *
 332 *                 N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
 333 *
 334                   CALL CHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
 335      $                        BETA, C( N2+1 ), N )
 336                   CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), LDA,
 337      $                        BETA, C( N1+1 ), N )
 338                   CALL CGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
 339      $                        LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N )
 340 *
 341                END IF
 342 *
 343             END IF
 344 *
 345          ELSE
 346 *
 347 *           N is odd, and TRANSR = 'C'
 348 *
 349             IF( LOWER ) THEN
 350 *
 351 *              N is odd, TRANSR = 'C', and UPLO = 'L'
 352 *
 353                IF( NOTRANS ) THEN
 354 *
 355 *                 N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
 356 *
 357                   CALL CHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
 358      $                        BETA, C( 1 ), N1 )
 359                   CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
 360      $                        BETA, C( 2 ), N1 )
 361                   CALL CGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
 362      $                        LDA, A( N1+1, 1 ), LDA, CBETA,
 363      $                        C( N1*N1+1 ), N1 )
 364 *
 365                ELSE
 366 *
 367 *                 N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
 368 *
 369                   CALL CHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
 370      $                        BETA, C( 1 ), N1 )
 371                   CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
 372      $                        BETA, C( 2 ), N1 )
 373                   CALL CGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
 374      $                        LDA, A( 1, N1+1 ), LDA, CBETA,
 375      $                        C( N1*N1+1 ), N1 )
 376 *
 377                END IF
 378 *
 379             ELSE
 380 *
 381 *              N is odd, TRANSR = 'C', and UPLO = 'U'
 382 *
 383                IF( NOTRANS ) THEN
 384 *
 385 *                 N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
 386 *
 387                   CALL CHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
 388      $                        BETA, C( N2*N2+1 ), N2 )
 389                   CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
 390      $                        BETA, C( N1*N2+1 ), N2 )
 391                   CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
 392      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
 393 *
 394                ELSE
 395 *
 396 *                 N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
 397 *
 398                   CALL CHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
 399      $                        BETA, C( N2*N2+1 ), N2 )
 400                   CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
 401      $                        BETA, C( N1*N2+1 ), N2 )
 402                   CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
 403      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
 404 *
 405                END IF
 406 *
 407             END IF
 408 *
 409          END IF
 410 *
 411       ELSE
 412 *
 413 *        N is even
 414 *
 415          IF( NORMALTRANSR ) THEN
 416 *
 417 *           N is even and TRANSR = 'N'
 418 *
 419             IF( LOWER ) THEN
 420 *
 421 *              N is even, TRANSR = 'N', and UPLO = 'L'
 422 *
 423                IF( NOTRANS ) THEN
 424 *
 425 *                 N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
 426 *
 427                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
 428      $                        BETA, C( 2 ), N+1 )
 429                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
 430      $                        BETA, C( 1 ), N+1 )
 431                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
 432      $                        LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
 433      $                        N+1 )
 434 *
 435                ELSE
 436 *
 437 *                 N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
 438 *
 439                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
 440      $                        BETA, C( 2 ), N+1 )
 441                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
 442      $                        BETA, C( 1 ), N+1 )
 443                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
 444      $                        LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
 445      $                        N+1 )
 446 *
 447                END IF
 448 *
 449             ELSE
 450 *
 451 *              N is even, TRANSR = 'N', and UPLO = 'U'
 452 *
 453                IF( NOTRANS ) THEN
 454 *
 455 *                 N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
 456 *
 457                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
 458      $                        BETA, C( NK+2 ), N+1 )
 459                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
 460      $                        BETA, C( NK+1 ), N+1 )
 461                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
 462      $                        LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ),
 463      $                        N+1 )
 464 *
 465                ELSE
 466 *
 467 *                 N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
 468 *
 469                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
 470      $                        BETA, C( NK+2 ), N+1 )
 471                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
 472      $                        BETA, C( NK+1 ), N+1 )
 473                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
 474      $                        LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ),
 475      $                        N+1 )
 476 *
 477                END IF
 478 *
 479             END IF
 480 *
 481          ELSE
 482 *
 483 *           N is even, and TRANSR = 'C'
 484 *
 485             IF( LOWER ) THEN
 486 *
 487 *              N is even, TRANSR = 'C', and UPLO = 'L'
 488 *
 489                IF( NOTRANS ) THEN
 490 *
 491 *                 N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
 492 *
 493                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
 494      $                        BETA, C( NK+1 ), NK )
 495                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
 496      $                        BETA, C( 1 ), NK )
 497                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
 498      $                        LDA, A( NK+1, 1 ), LDA, CBETA,
 499      $                        C( ( ( NK+1 )*NK )+1 ), NK )
 500 *
 501                ELSE
 502 *
 503 *                 N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
 504 *
 505                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
 506      $                        BETA, C( NK+1 ), NK )
 507                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
 508      $                        BETA, C( 1 ), NK )
 509                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
 510      $                        LDA, A( 1, NK+1 ), LDA, CBETA,
 511      $                        C( ( ( NK+1 )*NK )+1 ), NK )
 512 *
 513                END IF
 514 *
 515             ELSE
 516 *
 517 *              N is even, TRANSR = 'C', and UPLO = 'U'
 518 *
 519                IF( NOTRANS ) THEN
 520 *
 521 *                 N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
 522 *
 523                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
 524      $                        BETA, C( NK*( NK+1 )+1 ), NK )
 525                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
 526      $                        BETA, C( NK*NK+1 ), NK )
 527                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
 528      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
 529 *
 530                ELSE
 531 *
 532 *                 N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
 533 *
 534                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
 535      $                        BETA, C( NK*( NK+1 )+1 ), NK )
 536                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
 537      $                        BETA, C( NK*NK+1 ), NK )
 538                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
 539      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
 540 *
 541                END IF
 542 *
 543             END IF
 544 *
 545          END IF
 546 *
 547       END IF
 548 *
 549       RETURN
 550 *
 551 *     End of CHFRK
 552 *
 553       END