LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 of 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 of 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 of 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 ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
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.4.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 * November 2011
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 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
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: