LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
chfrk.f
Go to the documentation of this file.
00001 *> \brief \b CHFRK
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CHFRK + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chfrk.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chfrk.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chfrk.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
00022 *                         C )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       REAL               ALPHA, BETA
00026 *       INTEGER            K, LDA, N
00027 *       CHARACTER          TRANS, TRANSR, UPLO
00028 *       ..
00029 *       .. Array Arguments ..
00030 *       COMPLEX            A( LDA, * ), C( * )
00031 *       ..
00032 *  
00033 *
00034 *> \par Purpose:
00035 *  =============
00036 *>
00037 *> \verbatim
00038 *>
00039 *> Level 3 BLAS like routine for C in RFP Format.
00040 *>
00041 *> CHFRK performs one of the Hermitian rank--k operations
00042 *>
00043 *>    C := alpha*A*A**H + beta*C,
00044 *>
00045 *> or
00046 *>
00047 *>    C := alpha*A**H*A + beta*C,
00048 *>
00049 *> where alpha and beta are real scalars, C is an n--by--n Hermitian
00050 *> matrix and A is an n--by--k matrix in the first case and a k--by--n
00051 *> matrix in the second case.
00052 *> \endverbatim
00053 *
00054 *  Arguments:
00055 *  ==========
00056 *
00057 *> \param[in] TRANSR
00058 *> \verbatim
00059 *>          TRANSR is CHARACTER*1
00060 *>          = 'N':  The Normal Form of RFP A is stored;
00061 *>          = 'C':  The Conjugate-transpose Form of RFP A is stored.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] UPLO
00065 *> \verbatim
00066 *>          UPLO is CHARACTER*1
00067 *>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
00068 *>           triangular  part  of the  array  C  is to be  referenced  as
00069 *>           follows:
00070 *>
00071 *>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
00072 *>                                  is to be referenced.
00073 *>
00074 *>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
00075 *>                                  is to be referenced.
00076 *>
00077 *>           Unchanged on exit.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] TRANS
00081 *> \verbatim
00082 *>          TRANS is CHARACTER*1
00083 *>           On entry,  TRANS  specifies the operation to be performed as
00084 *>           follows:
00085 *>
00086 *>              TRANS = 'N' or 'n'   C := alpha*A*A**H + beta*C.
00087 *>
00088 *>              TRANS = 'C' or 'c'   C := alpha*A**H*A + beta*C.
00089 *>
00090 *>           Unchanged on exit.
00091 *> \endverbatim
00092 *>
00093 *> \param[in] N
00094 *> \verbatim
00095 *>          N is INTEGER
00096 *>           On entry,  N specifies the order of the matrix C.  N must be
00097 *>           at least zero.
00098 *>           Unchanged on exit.
00099 *> \endverbatim
00100 *>
00101 *> \param[in] K
00102 *> \verbatim
00103 *>          K is INTEGER
00104 *>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
00105 *>           of  columns   of  the   matrix   A,   and  on   entry   with
00106 *>           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
00107 *>           matrix A.  K must be at least zero.
00108 *>           Unchanged on exit.
00109 *> \endverbatim
00110 *>
00111 *> \param[in] ALPHA
00112 *> \verbatim
00113 *>          ALPHA is REAL
00114 *>           On entry, ALPHA specifies the scalar alpha.
00115 *>           Unchanged on exit.
00116 *> \endverbatim
00117 *>
00118 *> \param[in] A
00119 *> \verbatim
00120 *>          A is COMPLEX array, dimension (LDA,ka)
00121 *>           where KA
00122 *>           is K  when TRANS = 'N' or 'n', and is N otherwise. Before
00123 *>           entry with TRANS = 'N' or 'n', the leading N--by--K part of
00124 *>           the array A must contain the matrix A, otherwise the leading
00125 *>           K--by--N part of the array A must contain the matrix A.
00126 *>           Unchanged on exit.
00127 *> \endverbatim
00128 *>
00129 *> \param[in] LDA
00130 *> \verbatim
00131 *>          LDA is INTEGER
00132 *>           On entry, LDA specifies the first dimension of A as declared
00133 *>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
00134 *>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
00135 *>           be at least  max( 1, k ).
00136 *>           Unchanged on exit.
00137 *> \endverbatim
00138 *>
00139 *> \param[in] BETA
00140 *> \verbatim
00141 *>          BETA is REAL
00142 *>           On entry, BETA specifies the scalar beta.
00143 *>           Unchanged on exit.
00144 *> \endverbatim
00145 *>
00146 *> \param[in,out] C
00147 *> \verbatim
00148 *>          C is COMPLEX array, dimension (N*(N+1)/2)
00149 *>           On entry, the matrix A in RFP Format. RFP Format is
00150 *>           described by TRANSR, UPLO and N. Note that the imaginary
00151 *>           parts of the diagonal elements need not be set, they are
00152 *>           assumed to be zero, and on exit they are set to zero.
00153 *> \endverbatim
00154 *
00155 *  Authors:
00156 *  ========
00157 *
00158 *> \author Univ. of Tennessee 
00159 *> \author Univ. of California Berkeley 
00160 *> \author Univ. of Colorado Denver 
00161 *> \author NAG Ltd. 
00162 *
00163 *> \date November 2011
00164 *
00165 *> \ingroup complexOTHERcomputational
00166 *
00167 *  =====================================================================
00168       SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
00169      $                  C )
00170 *
00171 *  -- LAPACK computational routine (version 3.4.0) --
00172 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00173 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00174 *     November 2011
00175 *
00176 *     .. Scalar Arguments ..
00177       REAL               ALPHA, BETA
00178       INTEGER            K, LDA, N
00179       CHARACTER          TRANS, TRANSR, UPLO
00180 *     ..
00181 *     .. Array Arguments ..
00182       COMPLEX            A( LDA, * ), C( * )
00183 *     ..
00184 *
00185 *  =====================================================================
00186 *
00187 *     ..
00188 *     .. Parameters ..
00189       REAL               ONE, ZERO
00190       COMPLEX            CZERO
00191       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00192       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
00193 *     ..
00194 *     .. Local Scalars ..
00195       LOGICAL            LOWER, NORMALTRANSR, NISODD, NOTRANS
00196       INTEGER            INFO, NROWA, J, NK, N1, N2
00197       COMPLEX            CALPHA, CBETA
00198 *     ..
00199 *     .. External Functions ..
00200       LOGICAL            LSAME
00201       EXTERNAL           LSAME
00202 *     ..
00203 *     .. External Subroutines ..
00204       EXTERNAL           CGEMM, CHERK, XERBLA
00205 *     ..
00206 *     .. Intrinsic Functions ..
00207       INTRINSIC          MAX, CMPLX
00208 *     ..
00209 *     .. Executable Statements ..
00210 *
00211 *
00212 *     Test the input parameters.
00213 *
00214       INFO = 0
00215       NORMALTRANSR = LSAME( TRANSR, 'N' )
00216       LOWER = LSAME( UPLO, 'L' )
00217       NOTRANS = LSAME( TRANS, 'N' )
00218 *
00219       IF( NOTRANS ) THEN
00220          NROWA = N
00221       ELSE
00222          NROWA = K
00223       END IF
00224 *
00225       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
00226          INFO = -1
00227       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
00228          INFO = -2
00229       ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
00230          INFO = -3
00231       ELSE IF( N.LT.0 ) THEN
00232          INFO = -4
00233       ELSE IF( K.LT.0 ) THEN
00234          INFO = -5
00235       ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
00236          INFO = -8
00237       END IF
00238       IF( INFO.NE.0 ) THEN
00239          CALL XERBLA( 'CHFRK ', -INFO )
00240          RETURN
00241       END IF
00242 *
00243 *     Quick return if possible.
00244 *
00245 *     The quick return case: ((ALPHA.EQ.0).AND.(BETA.NE.ZERO)) is not
00246 *     done (it is in CHERK for example) and left in the general case.
00247 *
00248       IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
00249      $    ( BETA.EQ.ONE ) ) )RETURN
00250 *
00251       IF( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ZERO ) ) THEN
00252          DO J = 1, ( ( N*( N+1 ) ) / 2 )
00253             C( J ) = CZERO
00254          END DO
00255          RETURN
00256       END IF
00257 *
00258       CALPHA = CMPLX( ALPHA, ZERO )
00259       CBETA = CMPLX( BETA, ZERO )
00260 *
00261 *     C is N-by-N.
00262 *     If N is odd, set NISODD = .TRUE., and N1 and N2.
00263 *     If N is even, NISODD = .FALSE., and NK.
00264 *
00265       IF( MOD( N, 2 ).EQ.0 ) THEN
00266          NISODD = .FALSE.
00267          NK = N / 2
00268       ELSE
00269          NISODD = .TRUE.
00270          IF( LOWER ) THEN
00271             N2 = N / 2
00272             N1 = N - N2
00273          ELSE
00274             N1 = N / 2
00275             N2 = N - N1
00276          END IF
00277       END IF
00278 *
00279       IF( NISODD ) THEN
00280 *
00281 *        N is odd
00282 *
00283          IF( NORMALTRANSR ) THEN
00284 *
00285 *           N is odd and TRANSR = 'N'
00286 *
00287             IF( LOWER ) THEN
00288 *
00289 *              N is odd, TRANSR = 'N', and UPLO = 'L'
00290 *
00291                IF( NOTRANS ) THEN
00292 *
00293 *                 N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
00294 *
00295                   CALL CHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00296      $                        BETA, C( 1 ), N )
00297                   CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
00298      $                        BETA, C( N+1 ), N )
00299                   CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
00300      $                        LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
00301 *
00302                ELSE
00303 *
00304 *                 N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
00305 *
00306                   CALL CHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00307      $                        BETA, C( 1 ), N )
00308                   CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
00309      $                        BETA, C( N+1 ), N )
00310                   CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
00311      $                        LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
00312 *
00313                END IF
00314 *
00315             ELSE
00316 *
00317 *              N is odd, TRANSR = 'N', and UPLO = 'U'
00318 *
00319                IF( NOTRANS ) THEN
00320 *
00321 *                 N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
00322 *
00323                   CALL CHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00324      $                        BETA, C( N2+1 ), N )
00325                   CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
00326      $                        BETA, C( N1+1 ), N )
00327                   CALL CGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
00328      $                        LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N )
00329 *
00330                ELSE
00331 *
00332 *                 N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
00333 *
00334                   CALL CHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00335      $                        BETA, C( N2+1 ), N )
00336                   CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), LDA,
00337      $                        BETA, C( N1+1 ), N )
00338                   CALL CGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
00339      $                        LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N )
00340 *
00341                END IF
00342 *
00343             END IF
00344 *
00345          ELSE
00346 *
00347 *           N is odd, and TRANSR = 'C'
00348 *
00349             IF( LOWER ) THEN
00350 *
00351 *              N is odd, TRANSR = 'C', and UPLO = 'L'
00352 *
00353                IF( NOTRANS ) THEN
00354 *
00355 *                 N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
00356 *
00357                   CALL CHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00358      $                        BETA, C( 1 ), N1 )
00359                   CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
00360      $                        BETA, C( 2 ), N1 )
00361                   CALL CGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
00362      $                        LDA, A( N1+1, 1 ), LDA, CBETA,
00363      $                        C( N1*N1+1 ), N1 )
00364 *
00365                ELSE
00366 *
00367 *                 N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
00368 *
00369                   CALL CHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00370      $                        BETA, C( 1 ), N1 )
00371                   CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
00372      $                        BETA, C( 2 ), N1 )
00373                   CALL CGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
00374      $                        LDA, A( 1, N1+1 ), LDA, CBETA,
00375      $                        C( N1*N1+1 ), N1 )
00376 *
00377                END IF
00378 *
00379             ELSE
00380 *
00381 *              N is odd, TRANSR = 'C', and UPLO = 'U'
00382 *
00383                IF( NOTRANS ) THEN
00384 *
00385 *                 N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
00386 *
00387                   CALL CHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00388      $                        BETA, C( N2*N2+1 ), N2 )
00389                   CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
00390      $                        BETA, C( N1*N2+1 ), N2 )
00391                   CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
00392      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
00393 *
00394                ELSE
00395 *
00396 *                 N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
00397 *
00398                   CALL CHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00399      $                        BETA, C( N2*N2+1 ), N2 )
00400                   CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
00401      $                        BETA, C( N1*N2+1 ), N2 )
00402                   CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
00403      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
00404 *
00405                END IF
00406 *
00407             END IF
00408 *
00409          END IF
00410 *
00411       ELSE
00412 *
00413 *        N is even
00414 *
00415          IF( NORMALTRANSR ) THEN
00416 *
00417 *           N is even and TRANSR = 'N'
00418 *
00419             IF( LOWER ) THEN
00420 *
00421 *              N is even, TRANSR = 'N', and UPLO = 'L'
00422 *
00423                IF( NOTRANS ) THEN
00424 *
00425 *                 N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
00426 *
00427                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00428      $                        BETA, C( 2 ), N+1 )
00429                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00430      $                        BETA, C( 1 ), N+1 )
00431                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
00432      $                        LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
00433      $                        N+1 )
00434 *
00435                ELSE
00436 *
00437 *                 N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
00438 *
00439                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00440      $                        BETA, C( 2 ), N+1 )
00441                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00442      $                        BETA, C( 1 ), N+1 )
00443                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
00444      $                        LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
00445      $                        N+1 )
00446 *
00447                END IF
00448 *
00449             ELSE
00450 *
00451 *              N is even, TRANSR = 'N', and UPLO = 'U'
00452 *
00453                IF( NOTRANS ) THEN
00454 *
00455 *                 N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
00456 *
00457                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00458      $                        BETA, C( NK+2 ), N+1 )
00459                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00460      $                        BETA, C( NK+1 ), N+1 )
00461                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
00462      $                        LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ),
00463      $                        N+1 )
00464 *
00465                ELSE
00466 *
00467 *                 N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
00468 *
00469                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00470      $                        BETA, C( NK+2 ), N+1 )
00471                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00472      $                        BETA, C( NK+1 ), N+1 )
00473                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
00474      $                        LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ),
00475      $                        N+1 )
00476 *
00477                END IF
00478 *
00479             END IF
00480 *
00481          ELSE
00482 *
00483 *           N is even, and TRANSR = 'C'
00484 *
00485             IF( LOWER ) THEN
00486 *
00487 *              N is even, TRANSR = 'C', and UPLO = 'L'
00488 *
00489                IF( NOTRANS ) THEN
00490 *
00491 *                 N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
00492 *
00493                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00494      $                        BETA, C( NK+1 ), NK )
00495                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00496      $                        BETA, C( 1 ), NK )
00497                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
00498      $                        LDA, A( NK+1, 1 ), LDA, CBETA,
00499      $                        C( ( ( NK+1 )*NK )+1 ), NK )
00500 *
00501                ELSE
00502 *
00503 *                 N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
00504 *
00505                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00506      $                        BETA, C( NK+1 ), NK )
00507                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00508      $                        BETA, C( 1 ), NK )
00509                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
00510      $                        LDA, A( 1, NK+1 ), LDA, CBETA,
00511      $                        C( ( ( NK+1 )*NK )+1 ), NK )
00512 *
00513                END IF
00514 *
00515             ELSE
00516 *
00517 *              N is even, TRANSR = 'C', and UPLO = 'U'
00518 *
00519                IF( NOTRANS ) THEN
00520 *
00521 *                 N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
00522 *
00523                   CALL CHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00524      $                        BETA, C( NK*( NK+1 )+1 ), NK )
00525                   CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00526      $                        BETA, C( NK*NK+1 ), NK )
00527                   CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
00528      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
00529 *
00530                ELSE
00531 *
00532 *                 N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
00533 *
00534                   CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00535      $                        BETA, C( NK*( NK+1 )+1 ), NK )
00536                   CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00537      $                        BETA, C( NK*NK+1 ), NK )
00538                   CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
00539      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
00540 *
00541                END IF
00542 *
00543             END IF
00544 *
00545          END IF
00546 *
00547       END IF
00548 *
00549       RETURN
00550 *
00551 *     End of CHFRK
00552 *
00553       END
 All Files Functions