Contents


NAME

     zpttrf - compute the L*D*L' factorization of a complex  Her-
     mitian positive definite tridiagonal matrix A

SYNOPSIS

     SUBROUTINE ZPTTRF(N, DIAG, OFFD, INFO)

     DOUBLE COMPLEX OFFD(*)
     INTEGER N, INFO
     DOUBLE PRECISION DIAG(*)

     SUBROUTINE ZPTTRF_64(N, DIAG, OFFD, INFO)

     DOUBLE COMPLEX OFFD(*)
     INTEGER*8 N, INFO
     DOUBLE PRECISION DIAG(*)

  F95 INTERFACE
     SUBROUTINE PTTRF([N], DIAG, OFFD, [INFO])

     COMPLEX(8), DIMENSION(:) :: OFFD
     INTEGER :: N, INFO
     REAL(8), DIMENSION(:) :: DIAG

     SUBROUTINE PTTRF_64([N], DIAG, OFFD, [INFO])

     COMPLEX(8), DIMENSION(:) :: OFFD
     INTEGER(8) :: N, INFO
     REAL(8), DIMENSION(:) :: DIAG

  C INTERFACE
     #include <sunperf.h>

     void zpttrf(int n, double *diag,  doublecomplex  *offd,  int
               *info);

     void zpttrf_64(long n, double  *diag,  doublecomplex  *offd,
               long *info);

PURPOSE

     zpttrf computes the L*D*L' factorization of a complex Hermi-
     tian positive definite tridiagonal matrix A.  The factoriza-
     tion may also be regarded as having the form A = U'*D*U.

ARGUMENTS

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

     DIAG (input/output)
               On entry, the n diagonal elements of the tridiago-
               nal matrix A.  On exit, the n diagonal elements of
               the diagonal matrix DIAG from the  L*DIAG*L'  fac-
               torization of A.

     OFFD (input/output)
               On entry, the (n-1) subdiagonal  elements  of  the
               tridiagonal matrix A.  On exit, the (n-1) subdiag-
               onal elements of the unit bidiagonal factor L from
               the  L*DIAG*L'  factorization of A.  OFFD can also
               be regarded as the superdiagonal of the unit bidi-
               agonal  factor  U from the U'*DIAG*U factorization
               of A.

     INFO (output)
               = 0: successful exit
               < 0: if INFO = -k, the k-th argument had an  ille-
               gal value
               > 0: if INFO = k, the leading minor of order k  is
               not positive definite; if k < N, the factorization
               could not be completed, while if k = N,  the  fac-
               torization was completed, but DIAG(N) = 0.