 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ 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 ).```
Date
December 2016
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 200 of file zher2k.f.

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