LAPACK  3.10.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 ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
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)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: