Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

zhesv_rook (3p)

Name

zhesv_rook - compute the solution to a system of linear equations A*X=B for Hermitian matrices using the bounded Bunch-Kaufman ("rook") diago- nal pivoting method

Synopsis

SUBROUTINE ZHESV_ROOK(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK,
INFO)


CHARACTER*1 UPLO

INTEGER INFO, LDA, LDB, LWORK, N, NRHS

INTEGER IPIV(*)

DOUBLE COMPLEX A(LDA,*), B(LDB,*), WORK(*)


SUBROUTINE ZHESV_ROOK_64(UPLO, N, NRHS, A, LDA,  IPIV,  B,  LDB,  WORK,
LWORK, INFO)


CHARACTER*1 UPLO

INTEGER*8 INFO, LDA, LDB, LWORK, N, NRHS

INTEGER*8 IPIV(*)

DOUBLE COMPLEX A(LDA,*), B(LDB,*), WORK(*)


F95 INTERFACE
SUBROUTINE  HESV_ROOK(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK,
INFO)


INTEGER :: N, NRHS, LDA, LDB, LWORK, INFO

CHARACTER(LEN=1) :: UPLO

INTEGER, DIMENSION(:) :: IPIV

COMPLEX(8), DIMENSION(:) :: WORK

COMPLEX(8), DIMENSION(:,:) :: A, B


SUBROUTINE HESV_ROOK_64(UPLO, N, NRHS, A,  LDA,  IPIV,  B,  LDB,  WORK,
LWORK, INFO)


INTEGER(8) :: N, NRHS, LDA, LDB, LWORK, INFO

CHARACTER(LEN=1) :: UPLO

INTEGER(8), DIMENSION(:) :: IPIV

COMPLEX(8), DIMENSION(:) :: WORK

COMPLEX(8), DIMENSION(:,:) :: A, B


C INTERFACE
#include <sunperf.h>

void zhesv_rook (char uplo, int n, int nrhs, doublecomplex *a, int lda,
int *ipiv, doublecomplex *b, int ldb, int *info);


void zhesv_rook_64 (char uplo, long n,  long  nrhs,  doublecomplex  *a,
long  lda,  long  *ipiv,  doublecomplex  *b,  long  ldb, long
*info);

Description

Oracle Solaris Studio Performance Library                       zhesv_rook(3P)



NAME
       zhesv_rook - compute the solution to a system of linear equations A*X=B
       for Hermitian matrices using the bounded Bunch-Kaufman ("rook")  diago-
       nal pivoting method


SYNOPSIS
       SUBROUTINE ZHESV_ROOK(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK,
                 INFO)


       CHARACTER*1 UPLO

       INTEGER INFO, LDA, LDB, LWORK, N, NRHS

       INTEGER IPIV(*)

       DOUBLE COMPLEX A(LDA,*), B(LDB,*), WORK(*)


       SUBROUTINE ZHESV_ROOK_64(UPLO, N, NRHS, A, LDA,  IPIV,  B,  LDB,  WORK,
                 LWORK, INFO)


       CHARACTER*1 UPLO

       INTEGER*8 INFO, LDA, LDB, LWORK, N, NRHS

       INTEGER*8 IPIV(*)

       DOUBLE COMPLEX A(LDA,*), B(LDB,*), WORK(*)


   F95 INTERFACE
       SUBROUTINE  HESV_ROOK(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK,
                 INFO)


       INTEGER :: N, NRHS, LDA, LDB, LWORK, INFO

       CHARACTER(LEN=1) :: UPLO

       INTEGER, DIMENSION(:) :: IPIV

       COMPLEX(8), DIMENSION(:) :: WORK

       COMPLEX(8), DIMENSION(:,:) :: A, B


       SUBROUTINE HESV_ROOK_64(UPLO, N, NRHS, A,  LDA,  IPIV,  B,  LDB,  WORK,
                 LWORK, INFO)


       INTEGER(8) :: N, NRHS, LDA, LDB, LWORK, INFO

       CHARACTER(LEN=1) :: UPLO

       INTEGER(8), DIMENSION(:) :: IPIV

       COMPLEX(8), DIMENSION(:) :: WORK

       COMPLEX(8), DIMENSION(:,:) :: A, B


   C INTERFACE
       #include <sunperf.h>

       void zhesv_rook (char uplo, int n, int nrhs, doublecomplex *a, int lda,
                 int *ipiv, doublecomplex *b, int ldb, int *info);


       void zhesv_rook_64 (char uplo, long n,  long  nrhs,  doublecomplex  *a,
                 long  lda,  long  *ipiv,  doublecomplex  *b,  long  ldb, long
                 *info);


PURPOSE
       zhesv_rook computes the solution to a complex system  of  linear  equa-
       tions  A * X = B, where A is an N-by-N Hermitian matrix and X and B are
       N-by-NRHS matrices.

       The bounded Bunch-Kaufman ("rook") diagonal pivoting method is used  to
       factor A as
       A = U * D * U**T,  if UPLO = 'U', or
       A = L * D * L**T,  if UPLO = 'L',
       where  U (or L) is a product of permutation and unit upper (lower) tri-
       angular matrices, and D is Hermitian and block diagonal with 1-by-1 and
       2-by-2 diagonal blocks.

       ZHETRF_ROOK  is called to compute the factorization of a complex Hermi-
       tion matrix A using the bounded Bunch-Kaufman ("rook") diagonal  pivot-
       ing method.

       The  factored form of A is then used to solve the system of equations A
       * X = B by calling ZHETRS_ROOK (uses BLAS 2).


ARGUMENTS
       UPLO (input)
                 UPLO is CHARACTER*1
                 = 'U':  Upper triangle of A is stored;
                 = 'L':  Lower triangle of A is stored.


       N (input)
                 N is INTEGER
                 The number of linear equations, i.e., the order of the matrix
                 A. N >= 0.


       NRHS (input)
                 NRHS is INTEGER
                 The  number  of right hand sides, i.e., the number of columns
                 of the matrix B. NRHS >= 0.


       A (input/output)
                 A is COMPLEX*16 array, dimension (LDA,N)
                 On entry, the Hermitian matrix A. If UPLO = 'U', the  leading
                 N-by-N upper triangular part of A contains the upper triangu-
                 lar part of the matrix A, and the strictly  lower  triangular
                 part of A is not referenced. If UPLO = 'L', the leading N-by-
                 N lower triangular part of A contains  the  lower  triangular
                 part  of the matrix A, and the strictly upper triangular part
                 of A is not referenced.
                 On exit, if INFO = 0, the block diagonal  matrix  D  and  the
                 multipliers used to obtain the factor U or L from the factor-
                 ization  A  =  U*D*U**H  or  A  =  L*D*L**H  as  computed  by
                 ZHETRF_ROOK.


       LDA (input)
                 LDA is INTEGER
                 The leading dimension of the array A. LDA >= max(1,N).


       IPIV (output)
                 IPIV is INTEGER array, dimension (N)
                 Details of the interchanges and the block structure of D.
                 If UPLO = 'U':
                 Only the last KB elements of IPIV are set.
                 If  IPIV(k)  >  0,  then  rows and columns k and IPIV(k) were
                 interchanged and D(k,k) is a 1-by-1 diagonal block.
                 If IPIV(k) < 0 and IPIV(k-1) < 0, then rows and columns k and
                 -IPIV(k)  were  interchanged  and  rows  and  columns k-1 and
                 -IPIV(k-1) were inerchaged,
                 D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
                 If UPLO = 'L':
                 Only the first KB elements of IPIV are set.
                 If IPIV(k) > 0, then rows and  columns  k  and  IPIV(k)  were
                 interchanged and D(k,k) is a 1-by-1 diagonal block.
                 If IPIV(k) < 0 and IPIV(k+1) < 0, then rows and columns k and
                 -IPIV(k) were interchanged  and  rows  and  columns  k+1  and
                 -IPIV(k+1) were inerchaged, D(k:k+1,k:k+1) is a 2-by-2 diago-
                 nal block.


       B (input/output)
                 B is COMPLEX*16 array, dimension (LDB,NRHS)
                 On entry, the N-by-NRHS right hand side matrix B.   On  exit,
                 if INFO = 0, the N-by-NRHS solution matrix X.


       LDB (input)
                 LDB is INTEGER
                 The leading dimension of the array B. LDB >= max(1,N).


       WORK (output)
                 WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
                 On exit, if INFO = 0, WORK(1) returns the optimal LWORK.


       LWORK (input)
                 LWORK is INTEGER
                 The  length  of  WORK.  LWORK  >= 1, and for best performance
                 LWORK >= max(1,N*NB), where NB is the optimal  blocksize  for
                 ZHETRF_ROOK.
                 for LWORK < N, TRS will be done with Level BLAS 2;
                 for LWORK >= N, TRS will be done with Level BLAS 3;
                 If LWORK = -1, then a workspace query is assumed; the routine
                 only calculates the optimal size of the WORK  array,  returns
                 this value as the first entry of the WORK array, and no error
                 message related to LWORK is issued by XERBLA.


       INFO (output)
                 INFO is INTEGER
                 = 0: successful exit;
                 < 0: if INFO = -i, the i-th argument had an illegal value;
                 > 0: if INFO = i, D(i,i) is exactly zero.  The  factorization
                 has  been  completed,  but  the  block  diagonal  matrix D is
                 exactly singular, so the solution could not be computed.




                                  7 Nov 2015                    zhesv_rook(3P)