Contents
     cstsv - compute the solution to a complex system  of  linear
     equations  A  *  X  =  B  where A is a Hermitian tridiagonal
     matrix
     SUBROUTINE CSTSV(N, NRHS, L, D, SUBL, B, LDB, IPIV, INFO)
     COMPLEX L(*), D(*), SUBL(*), B(LDB,*)
     INTEGER N, NRHS, LDB, INFO
     INTEGER IPIV(*)
     SUBROUTINE CSTSV_64(N, NRHS, L, D, SUBL, B, LDB, IPIV, INFO)
     COMPLEX L(*), D(*), SUBL(*), B(LDB,*)
     INTEGER*8 N, NRHS, LDB, INFO
     INTEGER*8 IPIV(*)
  F95 INTERFACE
     SUBROUTINE STSV([N], [NRHS], L, D, SUBL, B, [LDB], IPIV, [INFO])
     COMPLEX, DIMENSION(:) :: L, D, SUBL
     COMPLEX, DIMENSION(:,:) :: B
     INTEGER :: N, NRHS, LDB, INFO
     INTEGER, DIMENSION(:) :: IPIV
     SUBROUTINE STSV_64([N], [NRHS], L, D, SUBL, B, [LDB], IPIV, [INFO])
     COMPLEX, DIMENSION(:) :: L, D, SUBL
     COMPLEX, DIMENSION(:,:) :: B
     INTEGER(8) :: N, NRHS, LDB, INFO
     INTEGER(8), DIMENSION(:) :: IPIV
  C INTERFACE
     #include <sunperf.h>
     void cstsv(int n, int nrhs, complex *l, complex *d,  complex
               *subl, complex *b, int ldb, int *ipiv, int *info);
     void cstsv_64(long n, long nrhs,  complex  *l,  complex  *d,
               complex  *subl,  complex *b, long ldb, long *ipiv,
               long *info);
     cstsv computes the solution to a complex  system  of  linear
     equations  A  *  X  =  B  where A is a Hermitian tridiagonal
     matrix.
     N (input)
               The order of the matrix A.  N >= 0.
     NRHS (input)
               The number of right hand sides in B.
     L (input/output)
                COMPLEX array, dimension (N)
               On entry, the n-1 subdiagonal elements of the tri-
               diagonal  matrix A.  On exit, part of the factori-
               zation of A.
     D (input/output)
                REAL array, dimension (N)
               On entry, the n diagonal elements of the tridiago-
               nal matrix A.  On exit, the n diagonal elements of
               the diagonal matrix D from the factorization of A.
     SUBL (output)
                COMPLEX array, dimension (N)
               On exit, part of the factorization of A.
     B (input/output)
               The columns of B contain the right hand sides.
     LDB (input)
               The leading dimension of B as specified in a  type
               or DIMENSION statement.
     IPIV (output)
                INTEGER array, dimension (N)
               On exit, the pivot indices of the factorization.
     INFO (output)
                INTEGER
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille-
               gal value
               > 0:  if INFO = i, D(k,k) is  exactly  zero.   The
               factorization  has  been  completed, but the block
               diagonal matrix D is exactly singular and division
               by zero will occur if it is used to solve a system
               of equations.