void dsyr(const UPLO Uplo,
const int N,
const double alpha,
const double *X,
const int incX,
double *A,
const int lda) {
dsyr_(UploChar[Uplo], &N, &alpha, X, &incX, A, &lda);
}
int
f2c_dsyr(char* uplo, integer* N,
doublereal* alpha,
doublereal* X, integer* incX,
doublereal* A, integer* lda)
{
dsyr_(uplo, N, alpha, X, incX, A, lda);
return 0;
}
static int stepy_ (integer *n, integer *p, doublereal *a,
doublereal *d, doublereal *b, doublereal *ada,
integer *info)
{
integer i, m = *p * *p;
int attempt = 0;
int err = 0;
try_again:
for (i=0; i<m; i++) {
ada[i] = 0.0;
}
for (i=0; i<*n; i++) {
dsyr_("U", p, &d[i], &a[i * *p], &one, ada, p);
}
if (attempt == 0) {
dposv_("U", p, &one, ada, p, b, p, info);
if (*info != 0) {
fprintf(stderr, "stepy: dposv gave info = %d\n", *info);
attempt = 1;
goto try_again;
}
} else {
gretl_matrix A, B;
gretl_matrix_init(&A);
gretl_matrix_init(&B);
A.rows = A.cols = *p;
A.val = ada;
B.rows = *p;
B.cols = 1;
B.val = b;
err = gretl_LU_solve(&A, &B);
if (err) {
fprintf(stderr, "stepy: gretl_LU_solve: err = %d\n", err);
}
}
return err;
}
void DenseStorage::atAddOuterProductOf(int row, int col, double alpha,
double * x, int incx, int nx )
{
assert( row >= 0 && row + nx <= m );
assert( col >= 0 && col + nx <= n );
// If assertions are turned off, clip to the actual size of this matrix
row = ( row >= 0 ) ? row : 0;
col = ( col >= 0 ) ? col : 0;
nx = ( row + nx <= m ) ? nx : m - row;
nx = ( col + nx <= n ) ? nx : n - col;
char fortranUplo = 'U';
dsyr_( &fortranUplo, &nx, &alpha, x, &incx,
&M[row][col], &n );
}
/* Subroutine */ int dsytf2_(char *uplo, integer *n, doublereal *a, integer *
lda, integer *ipiv, integer *info)
{
/* -- LAPACK routine (version 3.1) --
Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
November 2006
Purpose
=======
DSYTF2 computes the factorization of a real symmetric matrix A using
the Bunch-Kaufman diagonal pivoting method:
A = U*D*U' or A = L*D*L'
where U (or L) is a product of permutation and unit upper (lower)
triangular matrices, U' is the transpose of U, and D is symmetric and
block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
This is the unblocked version of the algorithm, calling Level 2 BLAS.
Arguments
=========
UPLO (input) CHARACTER*1
Specifies whether the upper or lower triangular part of the
symmetric matrix A is stored:
= 'U': Upper triangular
= 'L': Lower triangular
N (input) INTEGER
The order of the matrix A. N >= 0.
A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
On entry, the symmetric matrix A. If UPLO = 'U', the leading
n-by-n upper triangular part of A contains the upper
triangular 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, the block diagonal matrix D and the multipliers used
to obtain the factor U or L (see below for further details).
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
IPIV (output) INTEGER array, dimension (N)
Details of the interchanges and the block structure of D.
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 UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -k, the k-th argument had an illegal value
> 0: if INFO = k, 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.
Further Details
===============
09-29-06 - patch from
Bobby Cheng, MathWorks
Replace l.204 and l.372
IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
by
IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
01-01-96 - Based on modifications by
J. Lewis, Boeing Computer Services Company
A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
1-96 - Based on modifications by J. Lewis, Boeing Computer Services
Company
If UPLO = 'U', then A = U*D*U', where
U = P(n)*U(n)* ... *P(k)U(k)* ...,
i.e., U is a product of terms P(k)*U(k), where k decreases from n to
1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
that if the diagonal block D(k) is of order s (s = 1 or 2), then
( I v 0 ) k-s
U(k) = ( 0 I 0 ) s
( 0 0 I ) n-k
k-s s n-k
If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
and A(k,k), and v overwrites A(1:k-2,k-1:k).
If UPLO = 'L', then A = L*D*L', where
L = P(1)*L(1)* ... *P(k)*L(k)* ...,
i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as
defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
that if the diagonal block D(k) is of order s (s = 1 or 2), then
( I 0 0 ) k-1
L(k) = ( 0 I 0 ) s
( 0 v I ) n-k-s+1
k-1 s n-k-s+1
If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static const integer c__1 = 1;
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2;
doublereal d__1, d__2, d__3;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
_THREAD_STATIC_ integer i__, j, k;
_THREAD_STATIC_ doublereal t, r1, d11, d12, d21, d22;
_THREAD_STATIC_ integer kk, kp;
_THREAD_STATIC_ doublereal wk, wkm1, wkp1;
_THREAD_STATIC_ integer imax, jmax;
extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *);
_THREAD_STATIC_ doublereal alpha;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
extern logical lsame_(char *, char *);
extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
doublereal *, integer *);
_THREAD_STATIC_ integer kstep;
_THREAD_STATIC_ logical upper;
_THREAD_STATIC_ doublereal absakk;
extern integer idamax_(integer *, doublereal *, integer *);
extern logical disnan_(doublereal *);
extern /* Subroutine */ int xerbla_(char *, integer *);
_THREAD_STATIC_ doublereal colmax, rowmax;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--ipiv;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L")) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*lda < max(1,*n)) {
*info = -4;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DSYTF2", &i__1);
return 0;
}
/* Initialize ALPHA for use in choosing pivot block size. */
alpha = (sqrt(17.) + 1.) / 8.;
if (upper) {
/* Factorize A as U*D*U' using the upper triangle of A
K is the main loop index, decreasing from N to 1 in steps of
1 or 2 */
k = *n;
L10:
/* If K < 1, exit from loop */
if (k < 1) {
goto L70;
}
kstep = 1;
/* Determine rows and columns to be interchanged and whether
a 1-by-1 or 2-by-2 pivot block will be used */
absakk = (d__1 = a[k + k * a_dim1], abs(d__1));
/* IMAX is the row-index of the largest off-diagonal element in
column K, and COLMAX is its absolute value */
if (k > 1) {
i__1 = k - 1;
imax = idamax_(&i__1, &a[k * a_dim1 + 1], &c__1);
colmax = (d__1 = a[imax + k * a_dim1], abs(d__1));
} else {
colmax = 0.;
}
if (max(absakk,colmax) == 0. || disnan_(&absakk)) {
/* Column K is zero or contains a NaN: set INFO and continue */
if (*info == 0) {
*info = k;
}
kp = k;
} else {
if (absakk >= alpha * colmax) {
/* no interchange, use 1-by-1 pivot block */
kp = k;
} else {
/* JMAX is the column-index of the largest off-diagonal
element in row IMAX, and ROWMAX is its absolute value */
i__1 = k - imax;
jmax = imax + idamax_(&i__1, &a[imax + (imax + 1) * a_dim1],
lda);
rowmax = (d__1 = a[imax + jmax * a_dim1], abs(d__1));
if (imax > 1) {
i__1 = imax - 1;
jmax = idamax_(&i__1, &a[imax * a_dim1 + 1], &c__1);
/* Computing MAX */
d__2 = rowmax, d__3 = (d__1 = a[jmax + imax * a_dim1],
abs(d__1));
rowmax = max(d__2,d__3);
}
if (absakk >= alpha * colmax * (colmax / rowmax)) {
/* no interchange, use 1-by-1 pivot block */
kp = k;
} else if ((d__1 = a[imax + imax * a_dim1], abs(d__1)) >=
alpha * rowmax) {
/* interchange rows and columns K and IMAX, use 1-by-1
pivot block */
kp = imax;
} else {
/* interchange rows and columns K-1 and IMAX, use 2-by-2
pivot block */
kp = imax;
kstep = 2;
}
}
kk = k - kstep + 1;
if (kp != kk) {
/* Interchange rows and columns KK and KP in the leading
submatrix A(1:k,1:k) */
i__1 = kp - 1;
dswap_(&i__1, &a[kk * a_dim1 + 1], &c__1, &a[kp * a_dim1 + 1],
&c__1);
i__1 = kk - kp - 1;
dswap_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + (kp +
1) * a_dim1], lda);
t = a[kk + kk * a_dim1];
a[kk + kk * a_dim1] = a[kp + kp * a_dim1];
a[kp + kp * a_dim1] = t;
if (kstep == 2) {
t = a[k - 1 + k * a_dim1];
a[k - 1 + k * a_dim1] = a[kp + k * a_dim1];
a[kp + k * a_dim1] = t;
}
}
/* Update the leading submatrix */
if (kstep == 1) {
/* 1-by-1 pivot block D(k): column k now holds
W(k) = U(k)*D(k)
where U(k) is the k-th column of U
Perform a rank-1 update of A(1:k-1,1:k-1) as
A := A - U(k)*D(k)*U(k)' = A - W(k)*1/D(k)*W(k)' */
r1 = 1. / a[k + k * a_dim1];
i__1 = k - 1;
d__1 = -r1;
dsyr_(uplo, &i__1, &d__1, &a[k * a_dim1 + 1], &c__1, &a[
a_offset], lda);
/* Store U(k) in column k */
i__1 = k - 1;
dscal_(&i__1, &r1, &a[k * a_dim1 + 1], &c__1);
} else {
/* 2-by-2 pivot block D(k): columns k and k-1 now hold
( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
where U(k) and U(k-1) are the k-th and (k-1)-th columns
of U
Perform a rank-2 update of A(1:k-2,1:k-2) as
A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )'
= A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )' */
if (k > 2) {
d12 = a[k - 1 + k * a_dim1];
d22 = a[k - 1 + (k - 1) * a_dim1] / d12;
d11 = a[k + k * a_dim1] / d12;
t = 1. / (d11 * d22 - 1.);
d12 = t / d12;
for (j = k - 2; j >= 1; --j) {
wkm1 = d12 * (d11 * a[j + (k - 1) * a_dim1] - a[j + k
* a_dim1]);
wk = d12 * (d22 * a[j + k * a_dim1] - a[j + (k - 1) *
a_dim1]);
for (i__ = j; i__ >= 1; --i__) {
a[i__ + j * a_dim1] = a[i__ + j * a_dim1] - a[i__
+ k * a_dim1] * wk - a[i__ + (k - 1) *
a_dim1] * wkm1;
/* L20: */
}
a[j + k * a_dim1] = wk;
a[j + (k - 1) * a_dim1] = wkm1;
/* L30: */
}
}
}
}
/* Store details of the interchanges in IPIV */
if (kstep == 1) {
ipiv[k] = kp;
} else {
ipiv[k] = -kp;
ipiv[k - 1] = -kp;
}
/* Decrease K and return to the start of the main loop */
k -= kstep;
goto L10;
} else {
/* Factorize A as L*D*L' using the lower triangle of A
K is the main loop index, increasing from 1 to N in steps of
1 or 2 */
k = 1;
L40:
/* If K > N, exit from loop */
if (k > *n) {
goto L70;
}
kstep = 1;
/* Determine rows and columns to be interchanged and whether
a 1-by-1 or 2-by-2 pivot block will be used */
absakk = (d__1 = a[k + k * a_dim1], abs(d__1));
/* IMAX is the row-index of the largest off-diagonal element in
column K, and COLMAX is its absolute value */
if (k < *n) {
i__1 = *n - k;
imax = k + idamax_(&i__1, &a[k + 1 + k * a_dim1], &c__1);
colmax = (d__1 = a[imax + k * a_dim1], abs(d__1));
} else {
colmax = 0.;
}
if (max(absakk,colmax) == 0. || disnan_(&absakk)) {
/* Column K is zero or contains a NaN: set INFO and continue */
if (*info == 0) {
*info = k;
}
kp = k;
} else {
if (absakk >= alpha * colmax) {
/* no interchange, use 1-by-1 pivot block */
kp = k;
} else {
/* JMAX is the column-index of the largest off-diagonal
element in row IMAX, and ROWMAX is its absolute value */
i__1 = imax - k;
jmax = k - 1 + idamax_(&i__1, &a[imax + k * a_dim1], lda);
rowmax = (d__1 = a[imax + jmax * a_dim1], abs(d__1));
if (imax < *n) {
i__1 = *n - imax;
jmax = imax + idamax_(&i__1, &a[imax + 1 + imax * a_dim1],
&c__1);
/* Computing MAX */
d__2 = rowmax, d__3 = (d__1 = a[jmax + imax * a_dim1],
abs(d__1));
rowmax = max(d__2,d__3);
}
if (absakk >= alpha * colmax * (colmax / rowmax)) {
/* no interchange, use 1-by-1 pivot block */
kp = k;
} else if ((d__1 = a[imax + imax * a_dim1], abs(d__1)) >=
alpha * rowmax) {
/* interchange rows and columns K and IMAX, use 1-by-1
pivot block */
kp = imax;
} else {
/* interchange rows and columns K+1 and IMAX, use 2-by-2
pivot block */
kp = imax;
kstep = 2;
}
}
kk = k + kstep - 1;
if (kp != kk) {
/* Interchange rows and columns KK and KP in the trailing
submatrix A(k:n,k:n) */
if (kp < *n) {
i__1 = *n - kp;
dswap_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + 1
+ kp * a_dim1], &c__1);
}
i__1 = kp - kk - 1;
dswap_(&i__1, &a[kk + 1 + kk * a_dim1], &c__1, &a[kp + (kk +
1) * a_dim1], lda);
t = a[kk + kk * a_dim1];
a[kk + kk * a_dim1] = a[kp + kp * a_dim1];
a[kp + kp * a_dim1] = t;
if (kstep == 2) {
t = a[k + 1 + k * a_dim1];
a[k + 1 + k * a_dim1] = a[kp + k * a_dim1];
a[kp + k * a_dim1] = t;
}
}
/* Update the trailing submatrix */
if (kstep == 1) {
/* 1-by-1 pivot block D(k): column k now holds
W(k) = L(k)*D(k)
where L(k) is the k-th column of L */
if (k < *n) {
/* Perform a rank-1 update of A(k+1:n,k+1:n) as
A := A - L(k)*D(k)*L(k)' = A - W(k)*(1/D(k))*W(k)' */
d11 = 1. / a[k + k * a_dim1];
i__1 = *n - k;
d__1 = -d11;
dsyr_(uplo, &i__1, &d__1, &a[k + 1 + k * a_dim1], &c__1, &
a[k + 1 + (k + 1) * a_dim1], lda);
/* Store L(k) in column K */
i__1 = *n - k;
dscal_(&i__1, &d11, &a[k + 1 + k * a_dim1], &c__1);
}
} else {
/* 2-by-2 pivot block D(k) */
if (k < *n - 1) {
/* Perform a rank-2 update of A(k+2:n,k+2:n) as
A := A - ( (A(k) A(k+1))*D(k)**(-1) ) * (A(k) A(k+1))'
where L(k) and L(k+1) are the k-th and (k+1)-th
columns of L */
d21 = a[k + 1 + k * a_dim1];
d11 = a[k + 1 + (k + 1) * a_dim1] / d21;
d22 = a[k + k * a_dim1] / d21;
t = 1. / (d11 * d22 - 1.);
d21 = t / d21;
i__1 = *n;
for (j = k + 2; j <= i__1; ++j) {
wk = d21 * (d11 * a[j + k * a_dim1] - a[j + (k + 1) *
a_dim1]);
wkp1 = d21 * (d22 * a[j + (k + 1) * a_dim1] - a[j + k
* a_dim1]);
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
a[i__ + j * a_dim1] = a[i__ + j * a_dim1] - a[i__
+ k * a_dim1] * wk - a[i__ + (k + 1) *
a_dim1] * wkp1;
/* L50: */
}
a[j + k * a_dim1] = wk;
a[j + (k + 1) * a_dim1] = wkp1;
/* L60: */
}
}
}
}
/* Store details of the interchanges in IPIV */
if (kstep == 1) {
ipiv[k] = kp;
} else {
ipiv[k] = -kp;
ipiv[k + 1] = -kp;
}
/* Increase K and return to the start of the main loop */
k += kstep;
goto L40;
}
L70:
return 0;
/* End of DSYTF2 */
} /* dsytf2_ */
void
dsyr(char uplo, int n, double alpha, double *x, int incx, double *a, int lda)
{
dsyr_( &uplo, &n, &alpha, x, &incx, a, &lda);
}
int main( int argc, char** argv )
{
obj_t a, x;
obj_t a_save;
obj_t alpha;
dim_t m;
dim_t p;
dim_t p_begin, p_end, p_inc;
int m_input;
num_t dt_a, dt_x;
num_t dt_alpha;
int r, n_repeats;
uplo_t uplo;
double dtime;
double dtime_save;
double gflops;
//bli_init();
n_repeats = 3;
#ifndef PRINT
p_begin = 40;
p_end = 2000;
p_inc = 40;
m_input = -1;
#else
p_begin = 16;
p_end = 16;
p_inc = 1;
m_input = 6;
#endif
#if 1
dt_alpha = dt_x = dt_a = BLIS_DOUBLE;
#else
dt_alpha = dt_x = dt_a = BLIS_DCOMPLEX;
#endif
uplo = BLIS_LOWER;
// Begin with initializing the last entry to zero so that
// matlab allocates space for the entire array once up-front.
for ( p = p_begin; p + p_inc <= p_end; p += p_inc ) ;
#ifdef BLIS
printf( "data_her_blis" );
#else
printf( "data_her_%s", BLAS );
#endif
printf( "( %2lu, 1:2 ) = [ %4lu %7.2f ];\n",
( unsigned long )(p - p_begin + 1)/p_inc + 1,
( unsigned long )0, 0.0 );
for ( p = p_begin; p <= p_end; p += p_inc )
{
if ( m_input < 0 ) m = p * ( dim_t )abs(m_input);
else m = ( dim_t ) m_input;
bli_obj_create( dt_alpha, 1, 1, 0, 0, &alpha );
bli_obj_create( dt_x, m, 1, 0, 0, &x );
bli_obj_create( dt_a, m, m, 0, 0, &a );
bli_obj_create( dt_a, m, m, 0, 0, &a_save );
bli_randm( &x );
bli_randm( &a );
bli_obj_set_struc( BLIS_HERMITIAN, &a );
//bli_obj_set_struc( BLIS_SYMMETRIC, &a );
bli_obj_set_uplo( uplo, &a );
bli_setsc( (2.0/1.0), 0.0, &alpha );
bli_copym( &a, &a_save );
dtime_save = DBL_MAX;
for ( r = 0; r < n_repeats; ++r )
{
bli_copym( &a_save, &a );
dtime = bli_clock();
#ifdef PRINT
bli_printm( "x", &x, "%4.1f", "" );
bli_printm( "a", &a, "%4.1f", "" );
#endif
#ifdef BLIS
//bli_obj_toggle_conj( &x );
//bli_syr( &alpha,
bli_her( &alpha,
&x,
&a );
#else
f77_char uplo = 'L';
f77_int mm = bli_obj_length( &a );
f77_int incx = bli_obj_vector_inc( &x );
f77_int lda = bli_obj_col_stride( &a );
double* alphap = bli_obj_buffer( &alpha );
double* xp = bli_obj_buffer( &x );
double* ap = bli_obj_buffer( &a );
/*
dcomplex* xp = bli_obj_buffer( x );
dcomplex* ap = bli_obj_buffer( &a );
*/
dsyr_( &uplo,
//zher_( &uplo,
&mm,
alphap,
xp, &incx,
ap, &lda );
#endif
#ifdef PRINT
bli_printm( "a after", &a, "%4.1f", "" );
exit(1);
#endif
dtime_save = bli_clock_min_diff( dtime_save, dtime );
}
gflops = ( 1.0 * m * m ) / ( dtime_save * 1.0e9 );
#ifdef BLIS
printf( "data_her_blis" );
#else
printf( "data_her_%s", BLAS );
#endif
printf( "( %2lu, 1:2 ) = [ %4lu %7.2f ];\n",
( unsigned long )(p - p_begin + 1)/p_inc + 1,
( unsigned long )m, gflops );
bli_obj_free( &alpha );
bli_obj_free( &x );
bli_obj_free( &a );
bli_obj_free( &a_save );
}
//bli_finalize();
return 0;
}
/* Subroutine */ int dstt21_(integer *n, integer *kband, doublereal *ad,
doublereal *ae, doublereal *sd, doublereal *se, doublereal *u,
integer *ldu, doublereal *work, doublereal *result)
{
/* System generated locals */
integer u_dim1, u_offset, i__1;
doublereal d__1, d__2, d__3;
/* Local variables */
static doublereal unfl;
extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *);
static doublereal temp1, temp2;
extern /* Subroutine */ int dsyr2_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *);
static integer j;
extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *);
static doublereal anorm, wnorm;
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
extern /* Subroutine */ int dlaset_(char *, integer *, integer *,
doublereal *, doublereal *, doublereal *, integer *);
extern doublereal dlansy_(char *, char *, integer *, doublereal *,
integer *, doublereal *);
static doublereal ulp;
#define u_ref(a_1,a_2) u[(a_2)*u_dim1 + a_1]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
DSTT21 checks a decomposition of the form
A = U S U'
where ' means transpose, A is symmetric tridiagonal, U is orthogonal,
and S is diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1).
Two tests are performed:
RESULT(1) = | A - U S U' | / ( |A| n ulp )
RESULT(2) = | I - UU' | / ( n ulp )
Arguments
=========
N (input) INTEGER
The size of the matrix. If it is zero, DSTT21 does nothing.
It must be at least zero.
KBAND (input) INTEGER
The bandwidth of the matrix S. It may only be zero or one.
If zero, then S is diagonal, and SE is not referenced. If
one, then S is symmetric tri-diagonal.
AD (input) DOUBLE PRECISION array, dimension (N)
The diagonal of the original (unfactored) matrix A. A is
assumed to be symmetric tridiagonal.
AE (input) DOUBLE PRECISION array, dimension (N-1)
The off-diagonal of the original (unfactored) matrix A. A
is assumed to be symmetric tridiagonal. AE(1) is the (1,2)
and (2,1) element, AE(2) is the (2,3) and (3,2) element, etc.
SD (input) DOUBLE PRECISION array, dimension (N)
The diagonal of the (symmetric tri-) diagonal matrix S.
SE (input) DOUBLE PRECISION array, dimension (N-1)
The off-diagonal of the (symmetric tri-) diagonal matrix S.
Not referenced if KBSND=0. If KBAND=1, then AE(1) is the
(1,2) and (2,1) element, SE(2) is the (2,3) and (3,2)
element, etc.
U (input) DOUBLE PRECISION array, dimension (LDU, N)
The orthogonal matrix in the decomposition.
LDU (input) INTEGER
The leading dimension of U. LDU must be at least N.
WORK (workspace) DOUBLE PRECISION array, dimension (N*(N+1))
RESULT (output) DOUBLE PRECISION array, dimension (2)
The values computed by the two tests described above. The
values are currently limited to 1/ulp, to avoid overflow.
RESULT(1) is always modified.
=====================================================================
1) Constants
Parameter adjustments */
--ad;
--ae;
--sd;
--se;
u_dim1 = *ldu;
u_offset = 1 + u_dim1 * 1;
u -= u_offset;
--work;
--result;
/* Function Body */
result[1] = 0.;
result[2] = 0.;
if (*n <= 0) {
return 0;
}
unfl = dlamch_("Safe minimum");
ulp = dlamch_("Precision");
/* Do Test 1
Copy A & Compute its 1-Norm: */
dlaset_("Full", n, n, &c_b5, &c_b5, &work[1], n);
anorm = 0.;
temp1 = 0.;
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
work[(*n + 1) * (j - 1) + 1] = ad[j];
work[(*n + 1) * (j - 1) + 2] = ae[j];
temp2 = (d__1 = ae[j], abs(d__1));
/* Computing MAX */
d__2 = anorm, d__3 = (d__1 = ad[j], abs(d__1)) + temp1 + temp2;
anorm = max(d__2,d__3);
temp1 = temp2;
/* L10: */
}
/* Computing 2nd power */
i__1 = *n;
work[i__1 * i__1] = ad[*n];
/* Computing MAX */
d__2 = anorm, d__3 = (d__1 = ad[*n], abs(d__1)) + temp1, d__2 = max(d__2,
d__3);
anorm = max(d__2,unfl);
/* Norm of A - USU' */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
d__1 = -sd[j];
dsyr_("L", n, &d__1, &u_ref(1, j), &c__1, &work[1], n);
/* L20: */
}
if (*n > 1 && *kband == 1) {
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
d__1 = -se[j];
dsyr2_("L", n, &d__1, &u_ref(1, j), &c__1, &u_ref(1, j + 1), &
c__1, &work[1], n);
/* L30: */
}
}
/* Computing 2nd power */
i__1 = *n;
wnorm = dlansy_("1", "L", n, &work[1], n, &work[i__1 * i__1 + 1]);
if (anorm > wnorm) {
result[1] = wnorm / anorm / (*n * ulp);
} else {
if (anorm < 1.) {
/* Computing MIN */
d__1 = wnorm, d__2 = *n * anorm;
result[1] = min(d__1,d__2) / anorm / (*n * ulp);
} else {
/* Computing MIN */
d__1 = wnorm / anorm, d__2 = (doublereal) (*n);
result[1] = min(d__1,d__2) / (*n * ulp);
}
}
/* Do Test 2
Compute UU' - I */
dgemm_("N", "C", n, n, n, &c_b19, &u[u_offset], ldu, &u[u_offset], ldu, &
c_b5, &work[1], n);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
work[(*n + 1) * (j - 1) + 1] += -1.;
/* L40: */
}
/* Computing MIN
Computing 2nd power */
i__1 = *n;
d__1 = (doublereal) (*n), d__2 = dlange_("1", n, n, &work[1], n, &work[
i__1 * i__1 + 1]);
result[2] = min(d__1,d__2) / (*n * ulp);
return 0;
/* End of DSTT21 */
} /* dstt21_ */
/* Subroutine */ int dpbstf_(char *uplo, integer *n, integer *kd, doublereal *
ab, integer *ldab, integer *info)
{
/* System generated locals */
integer ab_dim1, ab_offset, i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer j, m, km;
doublereal ajj;
integer kld;
extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *), dscal_(
integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
logical upper;
extern /* Subroutine */ int xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DPBSTF computes a split Cholesky factorization of a real */
/* symmetric positive definite band matrix A. */
/* This routine is designed to be used in conjunction with DSBGST. */
/* The factorization has the form A = S**T*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 */
/* triangular of order n-m. */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER*1 */
/* = 'U': Upper triangle of A is stored; */
/* = 'L': Lower triangle of A is stored. */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* KD (input) INTEGER */
/* The number of superdiagonals of the matrix A if UPLO = 'U', */
/* or the number of subdiagonals if UPLO = 'L'. KD >= 0. */
/* AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N) */
/* On entry, the upper or lower triangle of the symmetric 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**T*S. See Further Details. */
/* LDAB (input) INTEGER */
/* The leading dimension of the array AB. LDAB >= KD+1. */
/* INFO (output) INTEGER */
/* = 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. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
ab_dim1 = *ldab;
ab_offset = 1 + ab_dim1;
ab -= ab_offset;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L")) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*kd < 0) {
*info = -3;
} else if (*ldab < *kd + 1) {
*info = -5;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DPBSTF", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Computing MAX */
i__1 = 1, i__2 = *ldab - 1;
kld = max(i__1,i__2);
/* Set the splitting point m. */
m = (*n + *kd) / 2;
if (upper) {
/* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m). */
i__1 = m + 1;
for (j = *n; j >= i__1; --j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab[*kd + 1 + j * ab_dim1];
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab[*kd + 1 + j * ab_dim1] = ajj;
/* Computing MIN */
i__2 = j - 1;
km = min(i__2,*kd);
/* Compute elements j-km:j-1 of the j-th column and update the */
/* the leading submatrix within the band. */
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab[*kd + 1 - km + j * ab_dim1], &c__1);
dsyr_("Upper", &km, &c_b9, &ab[*kd + 1 - km + j * ab_dim1], &c__1,
&ab[*kd + 1 + (j - km) * ab_dim1], &kld);
/* L10: */
}
/* Factorize the updated submatrix A(1:m,1:m) as U**T*U. */
i__1 = m;
for (j = 1; j <= i__1; ++j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab[*kd + 1 + j * ab_dim1];
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab[*kd + 1 + j * ab_dim1] = ajj;
/* Computing MIN */
i__2 = *kd, i__3 = m - j;
km = min(i__2,i__3);
/* Compute elements j+1:j+km of the j-th row and update the */
/* trailing submatrix within the band. */
if (km > 0) {
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab[*kd + (j + 1) * ab_dim1], &kld);
dsyr_("Upper", &km, &c_b9, &ab[*kd + (j + 1) * ab_dim1], &kld,
&ab[*kd + 1 + (j + 1) * ab_dim1], &kld);
}
/* L20: */
}
} else {
/* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m). */
i__1 = m + 1;
for (j = *n; j >= i__1; --j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab[j * ab_dim1 + 1];
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab[j * ab_dim1 + 1] = ajj;
/* Computing MIN */
i__2 = j - 1;
km = min(i__2,*kd);
/* Compute elements j-km:j-1 of the j-th row and update the */
/* trailing submatrix within the band. */
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab[km + 1 + (j - km) * ab_dim1], &kld);
dsyr_("Lower", &km, &c_b9, &ab[km + 1 + (j - km) * ab_dim1], &kld,
&ab[(j - km) * ab_dim1 + 1], &kld);
/* L30: */
}
/* Factorize the updated submatrix A(1:m,1:m) as U**T*U. */
i__1 = m;
for (j = 1; j <= i__1; ++j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab[j * ab_dim1 + 1];
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab[j * ab_dim1 + 1] = ajj;
/* Computing MIN */
i__2 = *kd, i__3 = m - j;
km = min(i__2,i__3);
/* Compute elements j+1:j+km of the j-th column and update the */
/* trailing submatrix within the band. */
if (km > 0) {
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab[j * ab_dim1 + 2], &c__1);
dsyr_("Lower", &km, &c_b9, &ab[j * ab_dim1 + 2], &c__1, &ab[(
j + 1) * ab_dim1 + 1], &kld);
}
/* L40: */
}
}
return 0;
L50:
*info = j;
return 0;
/* End of DPBSTF */
} /* dpbstf_ */
/* Subroutine */ int dpbstf_(char *uplo, integer *n, integer *kd, doublereal *
ab, integer *ldab, integer *info)
{
/* -- LAPACK routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
DPBSTF computes a split Cholesky factorization of a real
symmetric positive definite band matrix A.
This routine is designed to be used in conjunction with DSBGST.
The factorization has the form A = S**T*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
triangular of order n-m.
Arguments
=========
UPLO (input) CHARACTER*1
= 'U': Upper triangle of A is stored;
= 'L': Lower triangle of A is stored.
N (input) INTEGER
The order of the matrix A. N >= 0.
KD (input) INTEGER
The number of superdiagonals of the matrix A if UPLO = 'U',
or the number of subdiagonals if UPLO = 'L'. KD >= 0.
AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
On entry, the upper or lower triangle of the symmetric 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**T*S. See Further Details.
LDAB (input) INTEGER
The leading dimension of the array AB. LDAB >= KD+1.
INFO (output) INTEGER
= 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.
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static doublereal c_b9 = -1.;
/* System generated locals */
integer ab_dim1, ab_offset, i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *);
static integer j, m;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
extern logical lsame_(char *, char *);
static logical upper;
static integer km;
extern /* Subroutine */ int xerbla_(char *, integer *);
static doublereal ajj;
static integer kld;
#define ab_ref(a_1,a_2) ab[(a_2)*ab_dim1 + a_1]
ab_dim1 = *ldab;
ab_offset = 1 + ab_dim1 * 1;
ab -= ab_offset;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L")) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*kd < 0) {
*info = -3;
} else if (*ldab < *kd + 1) {
*info = -5;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DPBSTF", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Computing MAX */
i__1 = 1, i__2 = *ldab - 1;
kld = max(i__1,i__2);
/* Set the splitting point m. */
m = (*n + *kd) / 2;
if (upper) {
/* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m). */
i__1 = m + 1;
for (j = *n; j >= i__1; --j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab_ref(*kd + 1, j);
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab_ref(*kd + 1, j) = ajj;
/* Computing MIN */
i__2 = j - 1;
km = min(i__2,*kd);
/* Compute elements j-km:j-1 of the j-th column and update the
the leading submatrix within the band. */
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab_ref(*kd + 1 - km, j), &c__1);
dsyr_("Upper", &km, &c_b9, &ab_ref(*kd + 1 - km, j), &c__1, &
ab_ref(*kd + 1, j - km), &kld);
/* L10: */
}
/* Factorize the updated submatrix A(1:m,1:m) as U**T*U. */
i__1 = m;
for (j = 1; j <= i__1; ++j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab_ref(*kd + 1, j);
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab_ref(*kd + 1, j) = ajj;
/* Computing MIN */
i__2 = *kd, i__3 = m - j;
km = min(i__2,i__3);
/* Compute elements j+1:j+km of the j-th row and update the
trailing submatrix within the band. */
if (km > 0) {
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab_ref(*kd, j + 1), &kld);
dsyr_("Upper", &km, &c_b9, &ab_ref(*kd, j + 1), &kld, &ab_ref(
*kd + 1, j + 1), &kld);
}
/* L20: */
}
} else {
/* Factorize A(m+1:n,m+1:n) as L**T*L, and update A(1:m,1:m). */
i__1 = m + 1;
for (j = *n; j >= i__1; --j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab_ref(1, j);
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab_ref(1, j) = ajj;
/* Computing MIN */
i__2 = j - 1;
km = min(i__2,*kd);
/* Compute elements j-km:j-1 of the j-th row and update the
trailing submatrix within the band. */
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab_ref(km + 1, j - km), &kld);
dsyr_("Lower", &km, &c_b9, &ab_ref(km + 1, j - km), &kld, &ab_ref(
1, j - km), &kld);
/* L30: */
}
/* Factorize the updated submatrix A(1:m,1:m) as U**T*U. */
i__1 = m;
for (j = 1; j <= i__1; ++j) {
/* Compute s(j,j) and test for non-positive-definiteness. */
ajj = ab_ref(1, j);
if (ajj <= 0.) {
goto L50;
}
ajj = sqrt(ajj);
ab_ref(1, j) = ajj;
/* Computing MIN */
i__2 = *kd, i__3 = m - j;
km = min(i__2,i__3);
/* Compute elements j+1:j+km of the j-th column and update the
trailing submatrix within the band. */
if (km > 0) {
d__1 = 1. / ajj;
dscal_(&km, &d__1, &ab_ref(2, j), &c__1);
dsyr_("Lower", &km, &c_b9, &ab_ref(2, j), &c__1, &ab_ref(1, j
+ 1), &kld);
}
/* L40: */
}
}
return 0;
L50:
*info = j;
return 0;
/* End of DPBSTF */
} /* dpbstf_ */
/* Subroutine */ int dpbtf2_(char *uplo, integer *n, integer *kd, doublereal *
ab, integer *ldab, integer *info)
{
/* System generated locals */
integer ab_dim1, ab_offset, i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer j, kn;
doublereal ajj;
integer kld;
extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *), dscal_(
integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
logical upper;
extern /* Subroutine */ int xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DPBTF2 computes the Cholesky factorization of a real symmetric */
/* positive definite band matrix A. */
/* The factorization has the form */
/* A = U' * U , if UPLO = 'U', or */
/* A = L * L', if UPLO = 'L', */
/* where U is an upper triangular matrix, U' is the transpose of U, and */
/* L is lower triangular. */
/* This is the unblocked version of the algorithm, calling Level 2 BLAS. */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER*1 */
/* Specifies whether the upper or lower triangular part of the */
/* symmetric matrix A is stored: */
/* = 'U': Upper triangular */
/* = 'L': Lower triangular */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* KD (input) INTEGER */
/* The number of super-diagonals of the matrix A if UPLO = 'U', */
/* or the number of sub-diagonals if UPLO = 'L'. KD >= 0. */
/* AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N) */
/* On entry, the upper or lower triangle of the symmetric 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 triangular factor U or L from the */
/* Cholesky factorization A = U'*U or A = L*L' of the band */
/* matrix A, in the same storage format as A. */
/* LDAB (input) INTEGER */
/* The leading dimension of the array AB. LDAB >= KD+1. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -k, the k-th argument had an illegal value */
/* > 0: if INFO = k, the leading minor of order k is not */
/* positive definite, and the factorization could not be */
/* completed. */
/* Further Details */
/* =============== */
/* The band storage scheme is illustrated by the following example, when */
/* N = 6, KD = 2, and UPLO = 'U': */
/* On entry: On exit: */
/* * * a13 a24 a35 a46 * * u13 u24 u35 u46 */
/* * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56 */
/* a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66 */
/* Similarly, if UPLO = 'L' the format of A is as follows: */
/* On entry: On exit: */
/* a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66 */
/* a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 * */
/* a31 a42 a53 a64 * * l31 l42 l53 l64 * * */
/* Array elements marked * are not used by the routine. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
ab_dim1 = *ldab;
ab_offset = 1 + ab_dim1;
ab -= ab_offset;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L")) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*kd < 0) {
*info = -3;
} else if (*ldab < *kd + 1) {
*info = -5;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DPBTF2", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Computing MAX */
i__1 = 1, i__2 = *ldab - 1;
kld = MAX(i__1,i__2);
if (upper) {
/* Compute the Cholesky factorization A = U'*U. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Compute U(J,J) and test for non-positive-definiteness. */
ajj = ab[*kd + 1 + j * ab_dim1];
if (ajj <= 0.) {
goto L30;
}
ajj = sqrt(ajj);
ab[*kd + 1 + j * ab_dim1] = ajj;
/* Compute elements J+1:J+KN of row J and update the */
/* trailing submatrix within the band. */
/* Computing MIN */
i__2 = *kd, i__3 = *n - j;
kn = MIN(i__2,i__3);
if (kn > 0) {
d__1 = 1. / ajj;
dscal_(&kn, &d__1, &ab[*kd + (j + 1) * ab_dim1], &kld);
dsyr_("Upper", &kn, &c_b8, &ab[*kd + (j + 1) * ab_dim1], &kld,
&ab[*kd + 1 + (j + 1) * ab_dim1], &kld);
}
/* L10: */
}
} else {
/* Compute the Cholesky factorization A = L*L'. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Compute L(J,J) and test for non-positive-definiteness. */
ajj = ab[j * ab_dim1 + 1];
if (ajj <= 0.) {
goto L30;
}
ajj = sqrt(ajj);
ab[j * ab_dim1 + 1] = ajj;
/* Compute elements J+1:J+KN of column J and update the */
/* trailing submatrix within the band. */
/* Computing MIN */
i__2 = *kd, i__3 = *n - j;
kn = MIN(i__2,i__3);
if (kn > 0) {
d__1 = 1. / ajj;
dscal_(&kn, &d__1, &ab[j * ab_dim1 + 2], &c__1);
dsyr_("Lower", &kn, &c_b8, &ab[j * ab_dim1 + 2], &c__1, &ab[(
j + 1) * ab_dim1 + 1], &kld);
}
/* L20: */
}
}
return 0;
L30:
*info = j;
return 0;
/* End of DPBTF2 */
} /* dpbtf2_ */
/* Subroutine */ int dsyt21_(integer *itype, char *uplo, integer *n, integer *
kband, doublereal *a, integer *lda, doublereal *d__, doublereal *e,
doublereal *u, integer *ldu, doublereal *v, integer *ldv, doublereal *
tau, doublereal *work, doublereal *result)
{
/* System generated locals */
integer a_dim1, a_offset, u_dim1, u_offset, v_dim1, v_offset, i__1, i__2,
i__3;
doublereal d__1, d__2;
/* Local variables */
integer j, jr;
doublereal ulp;
integer jcol;
doublereal unfl;
integer jrow;
extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *), dsyr2_(
char *, integer *, doublereal *, doublereal *, integer *,
doublereal *, integer *, doublereal *, integer *), dgemm_(
char *, char *, integer *, integer *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *);
extern logical lsame_(char *, char *);
integer iinfo;
doublereal anorm;
char cuplo[1];
doublereal vsave;
logical lower;
doublereal wnorm;
extern /* Subroutine */ int dorm2l_(char *, char *, integer *, integer *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), dorm2r_(char
*, char *, integer *, integer *, integer *, doublereal *, integer
*, doublereal *, doublereal *, integer *, doublereal *, integer *);
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *),
dlaset_(char *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *), dlarfy_(char *, integer *,
doublereal *, integer *, doublereal *, doublereal *, integer *,
doublereal *);
extern doublereal dlansy_(char *, char *, integer *, doublereal *,
integer *, doublereal *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DSYT21 generally checks a decomposition of the form */
/* A = U S U' */
/* where ' means transpose, A is symmetric, U is orthogonal, and S is */
/* diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1). */
/* If ITYPE=1, then U is represented as a dense matrix; otherwise U is */
/* expressed as a product of Householder transformations, whose vectors */
/* are stored in the array "V" and whose scaling constants are in "TAU". */
/* We shall use the letter "V" to refer to the product of Householder */
/* transformations (which should be equal to U). */
/* Specifically, if ITYPE=1, then: */
/* RESULT(1) = | A - U S U' | / ( |A| n ulp ) *and* */
/* RESULT(2) = | I - UU' | / ( n ulp ) */
/* If ITYPE=2, then: */
/* RESULT(1) = | A - V S V' | / ( |A| n ulp ) */
/* If ITYPE=3, then: */
/* RESULT(1) = | I - VU' | / ( n ulp ) */
/* For ITYPE > 1, the transformation U is expressed as a product */
/* V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)' and each */
/* vector v(j) has its first j elements 0 and the remaining n-j elements */
/* stored in V(j+1:n,j). */
/* Arguments */
/* ========= */
/* ITYPE (input) INTEGER */
/* Specifies the type of tests to be performed. */
/* 1: U expressed as a dense orthogonal matrix: */
/* RESULT(1) = | A - U S U' | / ( |A| n ulp ) *and* */
/* RESULT(2) = | I - UU' | / ( n ulp ) */
/* 2: U expressed as a product V of Housholder transformations: */
/* RESULT(1) = | A - V S V' | / ( |A| n ulp ) */
/* 3: U expressed both as a dense orthogonal matrix and */
/* as a product of Housholder transformations: */
/* RESULT(1) = | I - VU' | / ( n ulp ) */
/* UPLO (input) CHARACTER */
/* If UPLO='U', the upper triangle of A and V will be used and */
/* the (strictly) lower triangle will not be referenced. */
/* If UPLO='L', the lower triangle of A and V will be used and */
/* the (strictly) upper triangle will not be referenced. */
/* N (input) INTEGER */
/* The size of the matrix. If it is zero, DSYT21 does nothing. */
/* It must be at least zero. */
/* KBAND (input) INTEGER */
/* The bandwidth of the matrix. It may only be zero or one. */
/* If zero, then S is diagonal, and E is not referenced. If */
/* one, then S is symmetric tri-diagonal. */
/* A (input) DOUBLE PRECISION array, dimension (LDA, N) */
/* The original (unfactored) matrix. It is assumed to be */
/* symmetric, and only the upper (UPLO='U') or only the lower */
/* (UPLO='L') will be referenced. */
/* LDA (input) INTEGER */
/* The leading dimension of A. It must be at least 1 */
/* and at least N. */
/* D (input) DOUBLE PRECISION array, dimension (N) */
/* The diagonal of the (symmetric tri-) diagonal matrix. */
/* E (input) DOUBLE PRECISION array, dimension (N-1) */
/* The off-diagonal of the (symmetric tri-) diagonal matrix. */
/* E(1) is the (1,2) and (2,1) element, E(2) is the (2,3) and */
/* (3,2) element, etc. */
/* Not referenced if KBAND=0. */
/* U (input) DOUBLE PRECISION array, dimension (LDU, N) */
/* If ITYPE=1 or 3, this contains the orthogonal matrix in */
/* the decomposition, expressed as a dense matrix. If ITYPE=2, */
/* then it is not referenced. */
/* LDU (input) INTEGER */
/* The leading dimension of U. LDU must be at least N and */
/* at least 1. */
/* V (input) DOUBLE PRECISION array, dimension (LDV, N) */
/* If ITYPE=2 or 3, the columns of this array contain the */
/* Householder vectors used to describe the orthogonal matrix */
/* in the decomposition. If UPLO='L', then the vectors are in */
/* the lower triangle, if UPLO='U', then in the upper */
/* triangle. */
/* *NOTE* If ITYPE=2 or 3, V is modified and restored. The */
/* subdiagonal (if UPLO='L') or the superdiagonal (if UPLO='U') */
/* is set to one, and later reset to its original value, during */
/* the course of the calculation. */
/* If ITYPE=1, then it is neither referenced nor modified. */
/* LDV (input) INTEGER */
/* The leading dimension of V. LDV must be at least N and */
/* at least 1. */
/* TAU (input) DOUBLE PRECISION array, dimension (N) */
/* If ITYPE >= 2, then TAU(j) is the scalar factor of */
/* v(j) v(j)' in the Householder transformation H(j) of */
/* the product U = H(1)...H(n-2) */
/* If ITYPE < 2, then TAU is not referenced. */
/* WORK (workspace) DOUBLE PRECISION array, dimension (2*N**2) */
/* RESULT (output) DOUBLE PRECISION array, dimension (2) */
/* The values computed by the two tests described above. The */
/* values are currently limited to 1/ulp, to avoid overflow. */
/* RESULT(1) is always modified. RESULT(2) is modified only */
/* if ITYPE=1. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--d__;
--e;
u_dim1 = *ldu;
u_offset = 1 + u_dim1;
u -= u_offset;
v_dim1 = *ldv;
v_offset = 1 + v_dim1;
v -= v_offset;
--tau;
--work;
--result;
/* Function Body */
result[1] = 0.;
if (*itype == 1) {
result[2] = 0.;
}
if (*n <= 0) {
return 0;
}
if (lsame_(uplo, "U")) {
lower = FALSE_;
*(unsigned char *)cuplo = 'U';
} else {
lower = TRUE_;
*(unsigned char *)cuplo = 'L';
}
unfl = dlamch_("Safe minimum");
ulp = dlamch_("Epsilon") * dlamch_("Base");
/* Some Error Checks */
if (*itype < 1 || *itype > 3) {
result[1] = 10. / ulp;
return 0;
}
/* Do Test 1 */
/* Norm of A: */
if (*itype == 3) {
anorm = 1.;
} else {
/* Computing MAX */
d__1 = dlansy_("1", cuplo, n, &a[a_offset], lda, &work[1]);
anorm = max(d__1,unfl);
}
/* Compute error matrix: */
if (*itype == 1) {
/* ITYPE=1: error = A - U S U' */
dlaset_("Full", n, n, &c_b10, &c_b10, &work[1], n);
dlacpy_(cuplo, n, n, &a[a_offset], lda, &work[1], n);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
d__1 = -d__[j];
dsyr_(cuplo, n, &d__1, &u[j * u_dim1 + 1], &c__1, &work[1], n);
/* L10: */
}
if (*n > 1 && *kband == 1) {
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
d__1 = -e[j];
dsyr2_(cuplo, n, &d__1, &u[j * u_dim1 + 1], &c__1, &u[(j + 1)
* u_dim1 + 1], &c__1, &work[1], n);
/* L20: */
}
}
/* Computing 2nd power */
i__1 = *n;
wnorm = dlansy_("1", cuplo, n, &work[1], n, &work[i__1 * i__1 + 1]);
} else if (*itype == 2) {
/* ITYPE=2: error = V S V' - A */
dlaset_("Full", n, n, &c_b10, &c_b10, &work[1], n);
if (lower) {
/* Computing 2nd power */
i__1 = *n;
work[i__1 * i__1] = d__[*n];
for (j = *n - 1; j >= 1; --j) {
if (*kband == 1) {
work[(*n + 1) * (j - 1) + 2] = (1. - tau[j]) * e[j];
i__1 = *n;
for (jr = j + 2; jr <= i__1; ++jr) {
work[(j - 1) * *n + jr] = -tau[j] * e[j] * v[jr + j *
v_dim1];
/* L30: */
}
}
vsave = v[j + 1 + j * v_dim1];
v[j + 1 + j * v_dim1] = 1.;
i__1 = *n - j;
/* Computing 2nd power */
i__2 = *n;
dlarfy_("L", &i__1, &v[j + 1 + j * v_dim1], &c__1, &tau[j], &
work[(*n + 1) * j + 1], n, &work[i__2 * i__2 + 1]);
v[j + 1 + j * v_dim1] = vsave;
work[(*n + 1) * (j - 1) + 1] = d__[j];
/* L40: */
}
} else {
work[1] = d__[1];
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
if (*kband == 1) {
work[(*n + 1) * j] = (1. - tau[j]) * e[j];
i__2 = j - 1;
for (jr = 1; jr <= i__2; ++jr) {
work[j * *n + jr] = -tau[j] * e[j] * v[jr + (j + 1) *
v_dim1];
/* L50: */
}
}
vsave = v[j + (j + 1) * v_dim1];
v[j + (j + 1) * v_dim1] = 1.;
/* Computing 2nd power */
i__2 = *n;
dlarfy_("U", &j, &v[(j + 1) * v_dim1 + 1], &c__1, &tau[j], &
work[1], n, &work[i__2 * i__2 + 1]);
v[j + (j + 1) * v_dim1] = vsave;
work[(*n + 1) * j + 1] = d__[j + 1];
/* L60: */
}
}
i__1 = *n;
for (jcol = 1; jcol <= i__1; ++jcol) {
if (lower) {
i__2 = *n;
for (jrow = jcol; jrow <= i__2; ++jrow) {
work[jrow + *n * (jcol - 1)] -= a[jrow + jcol * a_dim1];
/* L70: */
}
} else {
i__2 = jcol;
for (jrow = 1; jrow <= i__2; ++jrow) {
work[jrow + *n * (jcol - 1)] -= a[jrow + jcol * a_dim1];
/* L80: */
}
}
/* L90: */
}
/* Computing 2nd power */
i__1 = *n;
wnorm = dlansy_("1", cuplo, n, &work[1], n, &work[i__1 * i__1 + 1]);
} else if (*itype == 3) {
/* ITYPE=3: error = U V' - I */
if (*n < 2) {
return 0;
}
dlacpy_(" ", n, n, &u[u_offset], ldu, &work[1], n);
if (lower) {
i__1 = *n - 1;
i__2 = *n - 1;
/* Computing 2nd power */
i__3 = *n;
dorm2r_("R", "T", n, &i__1, &i__2, &v[v_dim1 + 2], ldv, &tau[1], &
work[*n + 1], n, &work[i__3 * i__3 + 1], &iinfo);
} else {
i__1 = *n - 1;
i__2 = *n - 1;
/* Computing 2nd power */
i__3 = *n;
dorm2l_("R", "T", n, &i__1, &i__2, &v[(v_dim1 << 1) + 1], ldv, &
tau[1], &work[1], n, &work[i__3 * i__3 + 1], &iinfo);
}
if (iinfo != 0) {
result[1] = 10. / ulp;
return 0;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
work[(*n + 1) * (j - 1) + 1] += -1.;
/* L100: */
}
/* Computing 2nd power */
i__1 = *n;
wnorm = dlange_("1", n, n, &work[1], n, &work[i__1 * i__1 + 1]);
}
if (anorm > wnorm) {
result[1] = wnorm / anorm / (*n * ulp);
} else {
if (anorm < 1.) {
/* Computing MIN */
d__1 = wnorm, d__2 = *n * anorm;
result[1] = min(d__1,d__2) / anorm / (*n * ulp);
} else {
/* Computing MIN */
d__1 = wnorm / anorm, d__2 = (doublereal) (*n);
result[1] = min(d__1,d__2) / (*n * ulp);
}
}
/* Do Test 2 */
/* Compute UU' - I */
if (*itype == 1) {
dgemm_("N", "C", n, n, n, &c_b42, &u[u_offset], ldu, &u[u_offset],
ldu, &c_b10, &work[1], n);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
work[(*n + 1) * (j - 1) + 1] += -1.;
/* L110: */
}
/* Computing MIN */
/* Computing 2nd power */
i__1 = *n;
d__1 = dlange_("1", n, n, &work[1], n, &work[i__1 * i__1 + 1]), d__2 = (doublereal) (*n);
result[2] = min(d__1,d__2) / (*n * ulp);
}
return 0;
/* End of DSYT21 */
} /* dsyt21_ */
/* Subroutine */
int dpbtf2_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, integer *info)
{
/* System generated locals */
integer ab_dim1, ab_offset, i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer j, kn;
doublereal ajj;
integer kld;
extern /* Subroutine */
int dsyr_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dscal_( integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
logical upper;
extern /* Subroutine */
int xerbla_(char *, integer *);
/* -- LAPACK computational routine (version 3.4.2) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* September 2012 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
ab_dim1 = *ldab;
ab_offset = 1 + ab_dim1;
ab -= ab_offset;
/* Function Body */
*info = 0;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L"))
{
*info = -1;
}
else if (*n < 0)
{
*info = -2;
}
else if (*kd < 0)
{
*info = -3;
}
else if (*ldab < *kd + 1)
{
*info = -5;
}
if (*info != 0)
{
i__1 = -(*info);
xerbla_("DPBTF2", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0)
{
return 0;
}
/* Computing MAX */
i__1 = 1;
i__2 = *ldab - 1; // , expr subst
kld = max(i__1,i__2);
if (upper)
{
/* Compute the Cholesky factorization A = U**T*U. */
i__1 = *n;
for (j = 1;
j <= i__1;
++j)
{
/* Compute U(J,J) and test for non-positive-definiteness. */
ajj = ab[*kd + 1 + j * ab_dim1];
if (ajj <= 0.)
{
goto L30;
}
ajj = sqrt(ajj);
ab[*kd + 1 + j * ab_dim1] = ajj;
/* Compute elements J+1:J+KN of row J and update the */
/* trailing submatrix within the band. */
/* Computing MIN */
i__2 = *kd;
i__3 = *n - j; // , expr subst
kn = min(i__2,i__3);
if (kn > 0)
{
d__1 = 1. / ajj;
dscal_(&kn, &d__1, &ab[*kd + (j + 1) * ab_dim1], &kld);
dsyr_("Upper", &kn, &c_b8, &ab[*kd + (j + 1) * ab_dim1], &kld, &ab[*kd + 1 + (j + 1) * ab_dim1], &kld);
}
/* L10: */
}
}
else
{
/* Compute the Cholesky factorization A = L*L**T. */
i__1 = *n;
for (j = 1;
j <= i__1;
++j)
{
/* Compute L(J,J) and test for non-positive-definiteness. */
ajj = ab[j * ab_dim1 + 1];
if (ajj <= 0.)
{
goto L30;
}
ajj = sqrt(ajj);
ab[j * ab_dim1 + 1] = ajj;
/* Compute elements J+1:J+KN of column J and update the */
/* trailing submatrix within the band. */
/* Computing MIN */
i__2 = *kd;
i__3 = *n - j; // , expr subst
kn = min(i__2,i__3);
if (kn > 0)
{
d__1 = 1. / ajj;
dscal_(&kn, &d__1, &ab[j * ab_dim1 + 2], &c__1);
dsyr_("Lower", &kn, &c_b8, &ab[j * ab_dim1 + 2], &c__1, &ab[( j + 1) * ab_dim1 + 1], &kld);
}
/* L20: */
}
}
return 0;
L30:
*info = j;
return 0;
/* End of DPBTF2 */
}
