Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

zpbstf (3p)

Name

zpbstf - compute a split Cholesky factorization of a complex Hermitian positive definite band matrix A

Synopsis

SUBROUTINE ZPBSTF(UPLO, N, KD, AB, LDAB, INFO)

CHARACTER*1 UPLO
DOUBLE COMPLEX AB(LDAB,*)
INTEGER N, KD, LDAB, INFO

SUBROUTINE ZPBSTF_64(UPLO, N, KD, AB, LDAB, INFO)

CHARACTER*1 UPLO
DOUBLE COMPLEX AB(LDAB,*)
INTEGER*8 N, KD, LDAB, INFO




F95 INTERFACE
SUBROUTINE PBSTF(UPLO, N, KD, AB, LDAB, INFO)

CHARACTER(LEN=1) :: UPLO
COMPLEX(8), DIMENSION(:,:) :: AB
INTEGER :: N, KD, LDAB, INFO

SUBROUTINE PBSTF_64(UPLO, N, KD, AB, LDAB, INFO)

CHARACTER(LEN=1) :: UPLO
COMPLEX(8), DIMENSION(:,:) :: AB
INTEGER(8) :: N, KD, LDAB, INFO




C INTERFACE
#include <sunperf.h>

void zpbstf(char uplo, int n, int kd, doublecomplex *ab, int ldab,  int
*info);

void  zpbstf_64(char  uplo,  long  n,  long kd, doublecomplex *ab, long
ldab, long *info);

Description

Oracle Solaris Studio Performance Library                           zpbstf(3P)



NAME
       zpbstf  - compute a split Cholesky factorization of a complex Hermitian
       positive definite band matrix A


SYNOPSIS
       SUBROUTINE ZPBSTF(UPLO, N, KD, AB, LDAB, INFO)

       CHARACTER*1 UPLO
       DOUBLE COMPLEX AB(LDAB,*)
       INTEGER N, KD, LDAB, INFO

       SUBROUTINE ZPBSTF_64(UPLO, N, KD, AB, LDAB, INFO)

       CHARACTER*1 UPLO
       DOUBLE COMPLEX AB(LDAB,*)
       INTEGER*8 N, KD, LDAB, INFO




   F95 INTERFACE
       SUBROUTINE PBSTF(UPLO, N, KD, AB, LDAB, INFO)

       CHARACTER(LEN=1) :: UPLO
       COMPLEX(8), DIMENSION(:,:) :: AB
       INTEGER :: N, KD, LDAB, INFO

       SUBROUTINE PBSTF_64(UPLO, N, KD, AB, LDAB, INFO)

       CHARACTER(LEN=1) :: UPLO
       COMPLEX(8), DIMENSION(:,:) :: AB
       INTEGER(8) :: N, KD, LDAB, INFO




   C INTERFACE
       #include <sunperf.h>

       void zpbstf(char uplo, int n, int kd, doublecomplex *ab, int ldab,  int
                 *info);

       void  zpbstf_64(char  uplo,  long  n,  long kd, doublecomplex *ab, long
                 ldab, long *info);



PURPOSE
       zpbstf computes a split Cholesky factorization of a  complex  Hermitian
       positive definite band matrix A.

       This routine is designed to be used in conjunction with CHBGST.

       The factorization has the form  A = S**H*S  where S is a band matrix of
       the same bandwidth as A and the following structure:

         S = ( U    )
             ( M  L )

       where U is upper triangular of order m = (n+kd)/2, and L is lower  tri-
       angular of order n-m.


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


       N (input) The order of the matrix A. N >= 0.


       KD (input)
                 The  number  of superdiagonals of the matrix A if UPLO = 'U',
                 or the number of subdiagonals if UPLO = 'L'. KD >= 0.


       AB (input/output)
                 On entry, the upper or lower triangle of the  Hermitian  band
                 matrix A, stored in the first kd+1 rows of the array.
                 The  j-th  column  of  A  is stored in the j-th column of the
                 array AB as follows:
                 if UPLO = 'U', AB(kd+1+i-j,j)=A(i,j) for max(1,j-kd)<=i<=j;
                 if UPLO = 'L', AB(1+i-j,j)   =A(i,j) for j<=i<=min(n,j+kd).

                 On exit, if INFO = 0, the factor S from  the  split  Cholesky
                 factorization A=S**H*S. See Further Details.


       LDAB (input)
                 The leading dimension of the array AB. LDAB >= KD+1.


       INFO (output)
                 = 0: successful exit;
                 < 0: if INFO = -i, the i-th argument had an illegal value;
                 >  0:  if INFO = i, the factorization could not be completed,
                 because the updated element a(i,i) was negative; the matrix A
                 is not positive definite.


FURTHER DETAILS
       The band storage scheme is illustrated by the following example, when N
       = 7, KD = 2:

       S = ( s11  s12  s13                     )
           (      s22  s23  s24                )
           (           s33  s34                )
           (                s44                )
           (           s53  s54  s55           )
           (                s64  s65  s66      )
           (                     s75  s76  s77 )

       If UPLO = 'U', the array AB holds:

       on entry:                          on exit:

        *   *  a13 a24 a35 a46 a57   *   *  s13 s24 s53' s64' s75'
        *  a12 a23 a34 a45 a56 a67   *  s12 s23 s34 s54' s65' s76' a11 a22 a33
       a44 a55 a66 a77  s11 s22 s33 s44 s55  s66  s77

       If UPLO = 'L', the array AB holds:

       on entry:                          on exit:

       a11 a22 a33 a44 a55 a66 a77  s11  s22  s33  s44 s55 s66 s77 a21 a32 a43
       a54 a65 a76  *   s12' s23' s34' s54 s65 s76  * a31 a42 a53 a64  a64   *
       *   s13' s24' s53  s64 s75  *   *

       Array  elements  marked  *  are  not  used by the routine; s12' denotes
       conjg(s12); the diagonal elements of S are real.




                                  7 Nov 2015                        zpbstf(3P)