![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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