LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zher2k()

 subroutine zher2k ( character uplo, character trans, integer n, integer k, complex*16 alpha, complex*16, dimension(lda,*) a, integer lda, complex*16, dimension(ldb,*) b, integer ldb, double precision beta, complex*16, dimension(ldc,*) c, integer ldc )

ZHER2K

Purpose:
``` ZHER2K  performs one of the hermitian rank 2k operations

C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C,

or

C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C,

where  alpha and beta  are scalars with  beta  real,  C is an  n by n
hermitian matrix and  A and B  are  n by k matrices in the first case
and  k by n  matrices in the second case.```
Parameters
 [in] UPLO ``` UPLO is CHARACTER*1 On entry, UPLO specifies whether the upper or lower triangular part of the array C is to be referenced as follows: UPLO = 'U' or 'u' Only the upper triangular part of C is to be referenced. UPLO = 'L' or 'l' Only the lower triangular part of C is to be referenced.``` [in] TRANS ``` TRANS is CHARACTER*1 On entry, TRANS specifies the operation to be performed as follows: TRANS = 'N' or 'n' C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C. TRANS = 'C' or 'c' C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C.``` [in] N ``` N is INTEGER On entry, N specifies the order of the matrix C. N must be at least zero.``` [in] K ``` K is INTEGER On entry with TRANS = 'N' or 'n', K specifies the number of columns of the matrices A and B, and on entry with TRANS = 'C' or 'c', K specifies the number of rows of the matrices A and B. K must be at least zero.``` [in] ALPHA ``` ALPHA is COMPLEX*16 . On entry, ALPHA specifies the scalar alpha.``` [in] A ``` A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is k when TRANS = 'N' or 'n', and is n otherwise. Before entry with TRANS = 'N' or 'n', the leading n by k part of the array A must contain the matrix A, otherwise the leading k by n part of the array A must contain the matrix A.``` [in] LDA ``` LDA is INTEGER On entry, LDA specifies the first dimension of A as declared in the calling (sub) program. When TRANS = 'N' or 'n' then LDA must be at least max( 1, n ), otherwise LDA must be at least max( 1, k ).``` [in] B ``` B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is k when TRANS = 'N' or 'n', and is n otherwise. Before entry with TRANS = 'N' or 'n', the leading n by k part of the array B must contain the matrix B, otherwise the leading k by n part of the array B must contain the matrix B.``` [in] LDB ``` LDB is INTEGER On entry, LDB specifies the first dimension of B as declared in the calling (sub) program. When TRANS = 'N' or 'n' then LDB must be at least max( 1, n ), otherwise LDB must be at least max( 1, k ). Unchanged on exit.``` [in] BETA ``` BETA is DOUBLE PRECISION . On entry, BETA specifies the scalar beta.``` [in,out] C ``` C is COMPLEX*16 array, dimension ( LDC, N ) Before entry with UPLO = 'U' or 'u', the leading n by n upper triangular part of the array C must contain the upper triangular part of the hermitian matrix and the strictly lower triangular part of C is not referenced. On exit, the upper triangular part of the array C is overwritten by the upper triangular part of the updated matrix. Before entry with UPLO = 'L' or 'l', the leading n by n lower triangular part of the array C must contain the lower triangular part of the hermitian matrix and the strictly upper triangular part of C is not referenced. On exit, the lower triangular part of the array C is overwritten by the lower triangular part of the updated matrix. Note that the imaginary parts of the diagonal elements need not be set, they are assumed to be zero, and on exit they are set to zero.``` [in] LDC ``` LDC is INTEGER On entry, LDC specifies the first dimension of C as declared in the calling (sub) program. LDC must be at least max( 1, n ).```
Further Details:
```  Level 3 Blas routine.

-- Written on 8-February-1989.
Jack Dongarra, Argonne National Laboratory.
Iain Duff, AERE Harwell.
Jeremy Du Croz, Numerical Algorithms Group Ltd.
Sven Hammarling, Numerical Algorithms Group Ltd.

-- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
Ed Anderson, Cray Research Inc.```

Definition at line 197 of file zher2k.f.

198*
199* -- Reference BLAS level3 routine --
200* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
201* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202*
203* .. Scalar Arguments ..
204 COMPLEX*16 ALPHA
205 DOUBLE PRECISION BETA
206 INTEGER K,LDA,LDB,LDC,N
207 CHARACTER TRANS,UPLO
208* ..
209* .. Array Arguments ..
210 COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
211* ..
212*
213* =====================================================================
214*
215* .. External Functions ..
216 LOGICAL LSAME
217 EXTERNAL lsame
218* ..
219* .. External Subroutines ..
220 EXTERNAL xerbla
221* ..
222* .. Intrinsic Functions ..
223 INTRINSIC dble,dconjg,max
224* ..
225* .. Local Scalars ..
226 COMPLEX*16 TEMP1,TEMP2
227 INTEGER I,INFO,J,L,NROWA
228 LOGICAL UPPER
229* ..
230* .. Parameters ..
231 DOUBLE PRECISION ONE
232 parameter(one=1.0d+0)
233 COMPLEX*16 ZERO
234 parameter(zero= (0.0d+0,0.0d+0))
235* ..
236*
237* Test the input parameters.
238*
239 IF (lsame(trans,'N')) THEN
240 nrowa = n
241 ELSE
242 nrowa = k
243 END IF
244 upper = lsame(uplo,'U')
245*
246 info = 0
247 IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
248 info = 1
249 ELSE IF ((.NOT.lsame(trans,'N')) .AND.
250 + (.NOT.lsame(trans,'C'))) THEN
251 info = 2
252 ELSE IF (n.LT.0) THEN
253 info = 3
254 ELSE IF (k.LT.0) THEN
255 info = 4
256 ELSE IF (lda.LT.max(1,nrowa)) THEN
257 info = 7
258 ELSE IF (ldb.LT.max(1,nrowa)) THEN
259 info = 9
260 ELSE IF (ldc.LT.max(1,n)) THEN
261 info = 12
262 END IF
263 IF (info.NE.0) THEN
264 CALL xerbla('ZHER2K',info)
265 RETURN
266 END IF
267*
268* Quick return if possible.
269*
270 IF ((n.EQ.0) .OR. (((alpha.EQ.zero).OR.
271 + (k.EQ.0)).AND. (beta.EQ.one))) RETURN
272*
273* And when alpha.eq.zero.
274*
275 IF (alpha.EQ.zero) THEN
276 IF (upper) THEN
277 IF (beta.EQ.dble(zero)) THEN
278 DO 20 j = 1,n
279 DO 10 i = 1,j
280 c(i,j) = zero
281 10 CONTINUE
282 20 CONTINUE
283 ELSE
284 DO 40 j = 1,n
285 DO 30 i = 1,j - 1
286 c(i,j) = beta*c(i,j)
287 30 CONTINUE
288 c(j,j) = beta*dble(c(j,j))
289 40 CONTINUE
290 END IF
291 ELSE
292 IF (beta.EQ.dble(zero)) THEN
293 DO 60 j = 1,n
294 DO 50 i = j,n
295 c(i,j) = zero
296 50 CONTINUE
297 60 CONTINUE
298 ELSE
299 DO 80 j = 1,n
300 c(j,j) = beta*dble(c(j,j))
301 DO 70 i = j + 1,n
302 c(i,j) = beta*c(i,j)
303 70 CONTINUE
304 80 CONTINUE
305 END IF
306 END IF
307 RETURN
308 END IF
309*
310* Start the operations.
311*
312 IF (lsame(trans,'N')) THEN
313*
314* Form C := alpha*A*B**H + conjg( alpha )*B*A**H +
315* C.
316*
317 IF (upper) THEN
318 DO 130 j = 1,n
319 IF (beta.EQ.dble(zero)) THEN
320 DO 90 i = 1,j
321 c(i,j) = zero
322 90 CONTINUE
323 ELSE IF (beta.NE.one) THEN
324 DO 100 i = 1,j - 1
325 c(i,j) = beta*c(i,j)
326 100 CONTINUE
327 c(j,j) = beta*dble(c(j,j))
328 ELSE
329 c(j,j) = dble(c(j,j))
330 END IF
331 DO 120 l = 1,k
332 IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
333 temp1 = alpha*dconjg(b(j,l))
334 temp2 = dconjg(alpha*a(j,l))
335 DO 110 i = 1,j - 1
336 c(i,j) = c(i,j) + a(i,l)*temp1 +
337 + b(i,l)*temp2
338 110 CONTINUE
339 c(j,j) = dble(c(j,j)) +
340 + dble(a(j,l)*temp1+b(j,l)*temp2)
341 END IF
342 120 CONTINUE
343 130 CONTINUE
344 ELSE
345 DO 180 j = 1,n
346 IF (beta.EQ.dble(zero)) THEN
347 DO 140 i = j,n
348 c(i,j) = zero
349 140 CONTINUE
350 ELSE IF (beta.NE.one) THEN
351 DO 150 i = j + 1,n
352 c(i,j) = beta*c(i,j)
353 150 CONTINUE
354 c(j,j) = beta*dble(c(j,j))
355 ELSE
356 c(j,j) = dble(c(j,j))
357 END IF
358 DO 170 l = 1,k
359 IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
360 temp1 = alpha*dconjg(b(j,l))
361 temp2 = dconjg(alpha*a(j,l))
362 DO 160 i = j + 1,n
363 c(i,j) = c(i,j) + a(i,l)*temp1 +
364 + b(i,l)*temp2
365 160 CONTINUE
366 c(j,j) = dble(c(j,j)) +
367 + dble(a(j,l)*temp1+b(j,l)*temp2)
368 END IF
369 170 CONTINUE
370 180 CONTINUE
371 END IF
372 ELSE
373*
374* Form C := alpha*A**H*B + conjg( alpha )*B**H*A +
375* C.
376*
377 IF (upper) THEN
378 DO 210 j = 1,n
379 DO 200 i = 1,j
380 temp1 = zero
381 temp2 = zero
382 DO 190 l = 1,k
383 temp1 = temp1 + dconjg(a(l,i))*b(l,j)
384 temp2 = temp2 + dconjg(b(l,i))*a(l,j)
385 190 CONTINUE
386 IF (i.EQ.j) THEN
387 IF (beta.EQ.dble(zero)) THEN
388 c(j,j) = dble(alpha*temp1+
389 + dconjg(alpha)*temp2)
390 ELSE
391 c(j,j) = beta*dble(c(j,j)) +
392 + dble(alpha*temp1+
393 + dconjg(alpha)*temp2)
394 END IF
395 ELSE
396 IF (beta.EQ.dble(zero)) THEN
397 c(i,j) = alpha*temp1 + dconjg(alpha)*temp2
398 ELSE
399 c(i,j) = beta*c(i,j) + alpha*temp1 +
400 + dconjg(alpha)*temp2
401 END IF
402 END IF
403 200 CONTINUE
404 210 CONTINUE
405 ELSE
406 DO 240 j = 1,n
407 DO 230 i = j,n
408 temp1 = zero
409 temp2 = zero
410 DO 220 l = 1,k
411 temp1 = temp1 + dconjg(a(l,i))*b(l,j)
412 temp2 = temp2 + dconjg(b(l,i))*a(l,j)
413 220 CONTINUE
414 IF (i.EQ.j) THEN
415 IF (beta.EQ.dble(zero)) THEN
416 c(j,j) = dble(alpha*temp1+
417 + dconjg(alpha)*temp2)
418 ELSE
419 c(j,j) = beta*dble(c(j,j)) +
420 + dble(alpha*temp1+
421 + dconjg(alpha)*temp2)
422 END IF
423 ELSE
424 IF (beta.EQ.dble(zero)) THEN
425 c(i,j) = alpha*temp1 + dconjg(alpha)*temp2
426 ELSE
427 c(i,j) = beta*c(i,j) + alpha*temp1 +
428 + dconjg(alpha)*temp2
429 END IF
430 END IF
431 230 CONTINUE
432 240 CONTINUE
433 END IF
434 END IF
435*
436 RETURN
437*
438* End of ZHER2K
439*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: