Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

zher2 (3p)

Name

zher2 - perform the hermitian rank 2 operation A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A

Synopsis

SUBROUTINE ZHER2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

CHARACTER*1 UPLO
DOUBLE COMPLEX ALPHA
DOUBLE COMPLEX X(*), Y(*), A(LDA,*)
INTEGER N, INCX, INCY, LDA

SUBROUTINE ZHER2_64(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

CHARACTER*1 UPLO
DOUBLE COMPLEX ALPHA
DOUBLE COMPLEX X(*), Y(*), A(LDA,*)
INTEGER*8 N, INCX, INCY, LDA




F95 INTERFACE
SUBROUTINE HER2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

CHARACTER(LEN=1) :: UPLO
COMPLEX(8) :: ALPHA
COMPLEX(8), DIMENSION(:) :: X, Y
COMPLEX(8), DIMENSION(:,:) :: A
INTEGER :: N, INCX, INCY, LDA

SUBROUTINE HER2_64(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

CHARACTER(LEN=1) :: UPLO
COMPLEX(8) :: ALPHA
COMPLEX(8), DIMENSION(:) :: X, Y
COMPLEX(8), DIMENSION(:,:) :: A
INTEGER(8) :: N, INCX, INCY, LDA




C INTERFACE
#include <sunperf.h>

void zher2(char uplo, int n, doublecomplex  *alpha,  doublecomplex  *x,
int  incx,  doublecomplex *y, int incy, doublecomplex *a, int
lda);

void zher2_64(char uplo, long n,  doublecomplex  *alpha,  doublecomplex
*x, long incx, doublecomplex *y, long incy, doublecomplex *a,
long lda);

Description

Oracle Solaris Studio Performance Library                            zher2(3P)



NAME
       zher2 - perform the hermitian rank 2 operation   A := alpha*x*conjg( y'
       ) + conjg( alpha )*y*conjg( x' ) + A


SYNOPSIS
       SUBROUTINE ZHER2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

       CHARACTER*1 UPLO
       DOUBLE COMPLEX ALPHA
       DOUBLE COMPLEX X(*), Y(*), A(LDA,*)
       INTEGER N, INCX, INCY, LDA

       SUBROUTINE ZHER2_64(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

       CHARACTER*1 UPLO
       DOUBLE COMPLEX ALPHA
       DOUBLE COMPLEX X(*), Y(*), A(LDA,*)
       INTEGER*8 N, INCX, INCY, LDA




   F95 INTERFACE
       SUBROUTINE HER2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

       CHARACTER(LEN=1) :: UPLO
       COMPLEX(8) :: ALPHA
       COMPLEX(8), DIMENSION(:) :: X, Y
       COMPLEX(8), DIMENSION(:,:) :: A
       INTEGER :: N, INCX, INCY, LDA

       SUBROUTINE HER2_64(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)

       CHARACTER(LEN=1) :: UPLO
       COMPLEX(8) :: ALPHA
       COMPLEX(8), DIMENSION(:) :: X, Y
       COMPLEX(8), DIMENSION(:,:) :: A
       INTEGER(8) :: N, INCX, INCY, LDA




   C INTERFACE
       #include <sunperf.h>

       void zher2(char uplo, int n, doublecomplex  *alpha,  doublecomplex  *x,
                 int  incx,  doublecomplex *y, int incy, doublecomplex *a, int
                 lda);

       void zher2_64(char uplo, long n,  doublecomplex  *alpha,  doublecomplex
                 *x, long incx, doublecomplex *y, long incy, doublecomplex *a,
                 long lda);



PURPOSE
       zher2 performs the hermitian rank 2 operation A := alpha*x*conjg( y'  )
       + conjg( alpha )*y*conjg( x' ) + A where alpha is a scalar, x and y are
       n element vectors and A is an n by n hermitian matrix.


ARGUMENTS
       UPLO (input)
                 On entry, UPLO specifies whether the upper or lower  triangu-
                 lar part of the array A is to be referenced as follows:

                 UPLO = 'U' or 'u'   Only the upper triangular part of A is to
                 be referenced.

                 UPLO = 'L' or 'l'   Only the lower triangular part of A is to
                 be referenced.

                 Unchanged on exit.


       N (input)
                 On  entry,  N  specifies  the order of the matrix A.  N >= 0.
                 Unchanged on exit.


       ALPHA (input)
                 On entry, ALPHA specifies the  scalar  alpha.   Unchanged  on
                 exit.


       X (input)
                 ( 1 + ( n - 1 )*abs( INCX ) ).  Before entry, the incremented
                 array X must contain the n element vector  x.   Unchanged  on
                 exit.


       INCX (input)
                 On entry, INCX specifies the increment for the elements of X.
                 INCX <> 0.  Unchanged on exit.


       Y (input)
                 ( 1 + ( n - 1 )*abs( INCY ) ).  Before entry, the incremented
                 array  Y  must  contain the n element vector y.  Unchanged on
                 exit.


       INCY (input)
                 On entry, INCY specifies the increment for the elements of Y.
                 INCY <> 0.  Unchanged on exit.


       A (input/output)
                 Before  entry  with   UPLO  =  'U' or 'u', the leading n by n
                 upper triangular part of the array A must contain  the  upper
                 triangular  part  of  the  hermitian  matrix and the strictly
                 lower triangular part of A is not referenced.  On  exit,  the
                 upper  triangular  part  of the array A 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 A must contain the lower triangular part of
                 the  hermitian  matrix and the strictly upper triangular part
                 of A is not referenced. On exit, the lower triangular part of
                 the  array  A  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.


       LDA (input)
                 On entry, LDA specifies the first dimension of A as  declared
                 in  the calling (sub) program. LDA >= max( 1, n ).  Unchanged
                 on exit.




                                  7 Nov 2015                         zher2(3P)