LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
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 ).
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*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
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: