LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zhfrk.f
Go to the documentation of this file.
00001 *> \brief \b ZHFRK
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZHFRK + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhfrk.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhfrk.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhfrk.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
00022 *                         C )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       DOUBLE PRECISION   ALPHA, BETA
00026 *       INTEGER            K, LDA, N
00027 *       CHARACTER          TRANS, TRANSR, UPLO
00028 *       ..
00029 *       .. Array Arguments ..
00030 *       COMPLEX*16         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 *> ZHFRK 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 DOUBLE PRECISION
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*16 array of 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 DOUBLE PRECISION
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*16 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 complex16OTHERcomputational
00166 *
00167 *  =====================================================================
00168       SUBROUTINE ZHFRK( 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       DOUBLE PRECISION   ALPHA, BETA
00178       INTEGER            K, LDA, N
00179       CHARACTER          TRANS, TRANSR, UPLO
00180 *     ..
00181 *     .. Array Arguments ..
00182       COMPLEX*16         A( LDA, * ), C( * )
00183 *     ..
00184 *
00185 *  =====================================================================
00186 *
00187 *     .. Parameters ..
00188       DOUBLE PRECISION   ONE, ZERO
00189       COMPLEX*16         CZERO
00190       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00191       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
00192 *     ..
00193 *     .. Local Scalars ..
00194       LOGICAL            LOWER, NORMALTRANSR, NISODD, NOTRANS
00195       INTEGER            INFO, NROWA, J, NK, N1, N2
00196       COMPLEX*16         CALPHA, CBETA
00197 *     ..
00198 *     .. External Functions ..
00199       LOGICAL            LSAME
00200       EXTERNAL           LSAME
00201 *     ..
00202 *     .. External Subroutines ..
00203       EXTERNAL           XERBLA, ZGEMM, ZHERK
00204 *     ..
00205 *     .. Intrinsic Functions ..
00206       INTRINSIC          MAX, DCMPLX
00207 *     ..
00208 *     .. Executable Statements ..
00209 *
00210 *
00211 *     Test the input parameters.
00212 *
00213       INFO = 0
00214       NORMALTRANSR = LSAME( TRANSR, 'N' )
00215       LOWER = LSAME( UPLO, 'L' )
00216       NOTRANS = LSAME( TRANS, 'N' )
00217 *
00218       IF( NOTRANS ) THEN
00219          NROWA = N
00220       ELSE
00221          NROWA = K
00222       END IF
00223 *
00224       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
00225          INFO = -1
00226       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
00227          INFO = -2
00228       ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
00229          INFO = -3
00230       ELSE IF( N.LT.0 ) THEN
00231          INFO = -4
00232       ELSE IF( K.LT.0 ) THEN
00233          INFO = -5
00234       ELSE IF( LDA.LT.MAX( 1, NROWA ) ) THEN
00235          INFO = -8
00236       END IF
00237       IF( INFO.NE.0 ) THEN
00238          CALL XERBLA( 'ZHFRK ', -INFO )
00239          RETURN
00240       END IF
00241 *
00242 *     Quick return if possible.
00243 *
00244 *     The quick return case: ((ALPHA.EQ.0).AND.(BETA.NE.ZERO)) is not
00245 *     done (it is in ZHERK for example) and left in the general case.
00246 *
00247       IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
00248      $    ( BETA.EQ.ONE ) ) )RETURN
00249 *
00250       IF( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ZERO ) ) THEN
00251          DO J = 1, ( ( N*( N+1 ) ) / 2 )
00252             C( J ) = CZERO
00253          END DO
00254          RETURN
00255       END IF
00256 *
00257       CALPHA = DCMPLX( ALPHA, ZERO )
00258       CBETA = DCMPLX( BETA, ZERO )
00259 *
00260 *     C is N-by-N.
00261 *     If N is odd, set NISODD = .TRUE., and N1 and N2.
00262 *     If N is even, NISODD = .FALSE., and NK.
00263 *
00264       IF( MOD( N, 2 ).EQ.0 ) THEN
00265          NISODD = .FALSE.
00266          NK = N / 2
00267       ELSE
00268          NISODD = .TRUE.
00269          IF( LOWER ) THEN
00270             N2 = N / 2
00271             N1 = N - N2
00272          ELSE
00273             N1 = N / 2
00274             N2 = N - N1
00275          END IF
00276       END IF
00277 *
00278       IF( NISODD ) THEN
00279 *
00280 *        N is odd
00281 *
00282          IF( NORMALTRANSR ) THEN
00283 *
00284 *           N is odd and TRANSR = 'N'
00285 *
00286             IF( LOWER ) THEN
00287 *
00288 *              N is odd, TRANSR = 'N', and UPLO = 'L'
00289 *
00290                IF( NOTRANS ) THEN
00291 *
00292 *                 N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
00293 *
00294                   CALL ZHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00295      $                        BETA, C( 1 ), N )
00296                   CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
00297      $                        BETA, C( N+1 ), N )
00298                   CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
00299      $                        LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
00300 *
00301                ELSE
00302 *
00303 *                 N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
00304 *
00305                   CALL ZHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00306      $                        BETA, C( 1 ), N )
00307                   CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
00308      $                        BETA, C( N+1 ), N )
00309                   CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
00310      $                        LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
00311 *
00312                END IF
00313 *
00314             ELSE
00315 *
00316 *              N is odd, TRANSR = 'N', and UPLO = 'U'
00317 *
00318                IF( NOTRANS ) THEN
00319 *
00320 *                 N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
00321 *
00322                   CALL ZHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00323      $                        BETA, C( N2+1 ), N )
00324                   CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
00325      $                        BETA, C( N1+1 ), N )
00326                   CALL ZGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
00327      $                        LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N )
00328 *
00329                ELSE
00330 *
00331 *                 N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
00332 *
00333                   CALL ZHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00334      $                        BETA, C( N2+1 ), N )
00335                   CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), LDA,
00336      $                        BETA, C( N1+1 ), N )
00337                   CALL ZGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
00338      $                        LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N )
00339 *
00340                END IF
00341 *
00342             END IF
00343 *
00344          ELSE
00345 *
00346 *           N is odd, and TRANSR = 'C'
00347 *
00348             IF( LOWER ) THEN
00349 *
00350 *              N is odd, TRANSR = 'C', and UPLO = 'L'
00351 *
00352                IF( NOTRANS ) THEN
00353 *
00354 *                 N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
00355 *
00356                   CALL ZHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00357      $                        BETA, C( 1 ), N1 )
00358                   CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
00359      $                        BETA, C( 2 ), N1 )
00360                   CALL ZGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
00361      $                        LDA, A( N1+1, 1 ), LDA, CBETA,
00362      $                        C( N1*N1+1 ), N1 )
00363 *
00364                ELSE
00365 *
00366 *                 N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
00367 *
00368                   CALL ZHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00369      $                        BETA, C( 1 ), N1 )
00370                   CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
00371      $                        BETA, C( 2 ), N1 )
00372                   CALL ZGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
00373      $                        LDA, A( 1, N1+1 ), LDA, CBETA,
00374      $                        C( N1*N1+1 ), N1 )
00375 *
00376                END IF
00377 *
00378             ELSE
00379 *
00380 *              N is odd, TRANSR = 'C', and UPLO = 'U'
00381 *
00382                IF( NOTRANS ) THEN
00383 *
00384 *                 N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
00385 *
00386                   CALL ZHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
00387      $                        BETA, C( N2*N2+1 ), N2 )
00388                   CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
00389      $                        BETA, C( N1*N2+1 ), N2 )
00390                   CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
00391      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
00392 *
00393                ELSE
00394 *
00395 *                 N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
00396 *
00397                   CALL ZHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
00398      $                        BETA, C( N2*N2+1 ), N2 )
00399                   CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
00400      $                        BETA, C( N1*N2+1 ), N2 )
00401                   CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
00402      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
00403 *
00404                END IF
00405 *
00406             END IF
00407 *
00408          END IF
00409 *
00410       ELSE
00411 *
00412 *        N is even
00413 *
00414          IF( NORMALTRANSR ) THEN
00415 *
00416 *           N is even and TRANSR = 'N'
00417 *
00418             IF( LOWER ) THEN
00419 *
00420 *              N is even, TRANSR = 'N', and UPLO = 'L'
00421 *
00422                IF( NOTRANS ) THEN
00423 *
00424 *                 N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
00425 *
00426                   CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00427      $                        BETA, C( 2 ), N+1 )
00428                   CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00429      $                        BETA, C( 1 ), N+1 )
00430                   CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
00431      $                        LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
00432      $                        N+1 )
00433 *
00434                ELSE
00435 *
00436 *                 N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
00437 *
00438                   CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00439      $                        BETA, C( 2 ), N+1 )
00440                   CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00441      $                        BETA, C( 1 ), N+1 )
00442                   CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
00443      $                        LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
00444      $                        N+1 )
00445 *
00446                END IF
00447 *
00448             ELSE
00449 *
00450 *              N is even, TRANSR = 'N', and UPLO = 'U'
00451 *
00452                IF( NOTRANS ) THEN
00453 *
00454 *                 N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
00455 *
00456                   CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00457      $                        BETA, C( NK+2 ), N+1 )
00458                   CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00459      $                        BETA, C( NK+1 ), N+1 )
00460                   CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
00461      $                        LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ),
00462      $                        N+1 )
00463 *
00464                ELSE
00465 *
00466 *                 N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
00467 *
00468                   CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00469      $                        BETA, C( NK+2 ), N+1 )
00470                   CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00471      $                        BETA, C( NK+1 ), N+1 )
00472                   CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
00473      $                        LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ),
00474      $                        N+1 )
00475 *
00476                END IF
00477 *
00478             END IF
00479 *
00480          ELSE
00481 *
00482 *           N is even, and TRANSR = 'C'
00483 *
00484             IF( LOWER ) THEN
00485 *
00486 *              N is even, TRANSR = 'C', and UPLO = 'L'
00487 *
00488                IF( NOTRANS ) THEN
00489 *
00490 *                 N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
00491 *
00492                   CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00493      $                        BETA, C( NK+1 ), NK )
00494                   CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00495      $                        BETA, C( 1 ), NK )
00496                   CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
00497      $                        LDA, A( NK+1, 1 ), LDA, CBETA,
00498      $                        C( ( ( NK+1 )*NK )+1 ), NK )
00499 *
00500                ELSE
00501 *
00502 *                 N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
00503 *
00504                   CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00505      $                        BETA, C( NK+1 ), NK )
00506                   CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00507      $                        BETA, C( 1 ), NK )
00508                   CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
00509      $                        LDA, A( 1, NK+1 ), LDA, CBETA,
00510      $                        C( ( ( NK+1 )*NK )+1 ), NK )
00511 *
00512                END IF
00513 *
00514             ELSE
00515 *
00516 *              N is even, TRANSR = 'C', and UPLO = 'U'
00517 *
00518                IF( NOTRANS ) THEN
00519 *
00520 *                 N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
00521 *
00522                   CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
00523      $                        BETA, C( NK*( NK+1 )+1 ), NK )
00524                   CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
00525      $                        BETA, C( NK*NK+1 ), NK )
00526                   CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
00527      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
00528 *
00529                ELSE
00530 *
00531 *                 N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
00532 *
00533                   CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
00534      $                        BETA, C( NK*( NK+1 )+1 ), NK )
00535                   CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
00536      $                        BETA, C( NK*NK+1 ), NK )
00537                   CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
00538      $                        LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
00539 *
00540                END IF
00541 *
00542             END IF
00543 *
00544          END IF
00545 *
00546       END IF
00547 *
00548       RETURN
00549 *
00550 *     End of ZHFRK
00551 *
00552       END
 All Files Functions