MAINT: move umath_linalg under numpy/linalg and use the same lapack_lite

Also, link umath_linalg against the system BLAS/LAPACK if available.

1 files changed, 0 insertions, 10660 deletions

diff --git a/numpy/linalg/blas_lite.c b/numpy/linalg/blas_lite.c
deleted file mode 100644
index d0de43478..000000000
--- a/numpy/linalg/blas_lite.c
+++ /dev/null
@@ -1,10660 +0,0 @@
-/*
-NOTE: This is generated code. Look in Misc/lapack_lite for information on
-      remaking this file.
-*/
-#include "f2c.h"
-
-#ifdef HAVE_CONFIG
-#include "config.h"
-#else
-extern doublereal dlamch_(char *);
-#define EPSILON dlamch_("Epsilon")
-#define SAFEMINIMUM dlamch_("Safe minimum")
-#define PRECISION dlamch_("Precision")
-#define BASE dlamch_("Base")
-#endif
-
-extern doublereal dlapy2_(doublereal *x, doublereal *y);
-
-
-
-/* Table of constant values */
-
-static integer c__1 = 1;
-static doublecomplex c_b359 = {1.,0.};
-
-/* Subroutine */ int daxpy_(integer *n, doublereal *da, doublereal *dx,
-	integer *incx, doublereal *dy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1;
-
-    /* Local variables */
-    static integer i__, m, ix, iy, mp1;
-
-
-/*
-       constant times a vector plus a vector.
-       uses unrolled loops for increments equal to one.
-       jack dongarra, linpack, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dy;
-    --dx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if (*da == 0.) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dy[iy] += *da * dx[ix];
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*
-          code for both increments equal to 1
-
-
-          clean-up loop
-*/
-
-L20:
-    m = *n % 4;
-    if (m == 0) {
-	goto L40;
-    }
-    i__1 = m;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dy[i__] += *da * dx[i__];
-/* L30: */
-    }
-    if (*n < 4) {
-	return 0;
-    }
-L40:
-    mp1 = m + 1;
-    i__1 = *n;
-    for (i__ = mp1; i__ <= i__1; i__ += 4) {
-	dy[i__] += *da * dx[i__];
-	dy[i__ + 1] += *da * dx[i__ + 1];
-	dy[i__ + 2] += *da * dx[i__ + 2];
-	dy[i__ + 3] += *da * dx[i__ + 3];
-/* L50: */
-    }
-    return 0;
-} /* daxpy_ */
-
-doublereal dcabs1_(doublecomplex *z__)
-{
-    /* System generated locals */
-    doublereal ret_val;
-    static doublecomplex equiv_0[1];
-
-    /* Local variables */
-#define t ((doublereal *)equiv_0)
-#define zz (equiv_0)
-
-    zz->r = z__->r, zz->i = z__->i;
-    ret_val = abs(t[0]) + abs(t[1]);
-    return ret_val;
-} /* dcabs1_ */
-
-#undef zz
-#undef t
-
-
-/* Subroutine */ int dcopy_(integer *n, doublereal *dx, integer *incx,
-	doublereal *dy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1;
-
-    /* Local variables */
-    static integer i__, m, ix, iy, mp1;
-
-
-/*
-       copies a vector, x, to a vector, y.
-       uses unrolled loops for increments equal to one.
-       jack dongarra, linpack, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dy;
-    --dx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dy[iy] = dx[ix];
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*
-          code for both increments equal to 1
-
-
-          clean-up loop
-*/
-
-L20:
-    m = *n % 7;
-    if (m == 0) {
-	goto L40;
-    }
-    i__1 = m;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dy[i__] = dx[i__];
-/* L30: */
-    }
-    if (*n < 7) {
-	return 0;
-    }
-L40:
-    mp1 = m + 1;
-    i__1 = *n;
-    for (i__ = mp1; i__ <= i__1; i__ += 7) {
-	dy[i__] = dx[i__];
-	dy[i__ + 1] = dx[i__ + 1];
-	dy[i__ + 2] = dx[i__ + 2];
-	dy[i__ + 3] = dx[i__ + 3];
-	dy[i__ + 4] = dx[i__ + 4];
-	dy[i__ + 5] = dx[i__ + 5];
-	dy[i__ + 6] = dx[i__ + 6];
-/* L50: */
-    }
-    return 0;
-} /* dcopy_ */
-
-doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
-	integer *incy)
-{
-    /* System generated locals */
-    integer i__1;
-    doublereal ret_val;
-
-    /* Local variables */
-    static integer i__, m, ix, iy, mp1;
-    static doublereal dtemp;
-
-
-/*
-       forms the dot product of two vectors.
-       uses unrolled loops for increments equal to one.
-       jack dongarra, linpack, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dy;
-    --dx;
-
-    /* Function Body */
-    ret_val = 0.;
-    dtemp = 0.;
-    if (*n <= 0) {
-	return ret_val;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dtemp += dx[ix] * dy[iy];
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    ret_val = dtemp;
-    return ret_val;
-
-/*
-          code for both increments equal to 1
-
-
-          clean-up loop
-*/
-
-L20:
-    m = *n % 5;
-    if (m == 0) {
-	goto L40;
-    }
-    i__1 = m;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dtemp += dx[i__] * dy[i__];
-/* L30: */
-    }
-    if (*n < 5) {
-	goto L60;
-    }
-L40:
-    mp1 = m + 1;
-    i__1 = *n;
-    for (i__ = mp1; i__ <= i__1; i__ += 5) {
-	dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[
-		i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ +
-		4] * dy[i__ + 4];
-/* L50: */
-    }
-L60:
-    ret_val = dtemp;
-    return ret_val;
-} /* ddot_ */
-
-/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *
-	n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
-	doublereal *b, integer *ldb, doublereal *beta, doublereal *c__,
-	integer *ldc)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
-	    i__3;
-
-    /* Local variables */
-    static integer i__, j, l, info;
-    static logical nota, notb;
-    static doublereal temp;
-    static integer ncola;
-    extern logical lsame_(char *, char *);
-    static integer nrowa, nrowb;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DGEMM  performs one of the matrix-matrix operations
-
-       C := alpha*op( A )*op( B ) + beta*C,
-
-    where  op( X ) is one of
-
-       op( X ) = X   or   op( X ) = X',
-
-    alpha and beta are scalars, and A, B and C are matrices, with op( A )
-    an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
-
-    Parameters
-    ==========
-
-    TRANSA - CHARACTER*1.
-             On entry, TRANSA specifies the form of op( A ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSA = 'N' or 'n',  op( A ) = A.
-
-                TRANSA = 'T' or 't',  op( A ) = A'.
-
-                TRANSA = 'C' or 'c',  op( A ) = A'.
-
-             Unchanged on exit.
-
-    TRANSB - CHARACTER*1.
-             On entry, TRANSB specifies the form of op( B ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSB = 'N' or 'n',  op( B ) = B.
-
-                TRANSB = 'T' or 't',  op( B ) = B'.
-
-                TRANSB = 'C' or 'c',  op( B ) = B'.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry,  M  specifies  the number  of rows  of the  matrix
-             op( A )  and of the  matrix  C.  M  must  be at least  zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry,  N  specifies the number  of columns of the matrix
-             op( B ) and the number of columns of the matrix C. N must be
-             at least zero.
-             Unchanged on exit.
-
-    K      - INTEGER.
-             On entry,  K  specifies  the number of columns of the matrix
-             op( A ) and the number of rows of the matrix op( B ). K must
-             be at least  zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-             k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
-             Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
-             part of the array  A  must contain the matrix  A,  otherwise
-             the leading  k by m  part of the array  A  must contain  the
-             matrix A.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. When  TRANSA = 'N' or 'n' then
-             LDA must be at least  max( 1, m ), otherwise  LDA must be at
-             least  max( 1, k ).
-             Unchanged on exit.
-
-    B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
-             n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
-             Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
-             part of the array  B  must contain the matrix  B,  otherwise
-             the leading  n by k  part of the array  B  must contain  the
-             matrix B.
-             Unchanged on exit.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in the calling (sub) program. When  TRANSB = 'N' or 'n' then
-             LDB must be at least  max( 1, k ), otherwise  LDB must be at
-             least  max( 1, n ).
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION.
-             On entry,  BETA  specifies the scalar  beta.  When  BETA  is
-             supplied as zero then C need not be set on input.
-             Unchanged on exit.
-
-    C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-             Before entry, the leading  m by n  part of the array  C must
-             contain the matrix  C,  except when  beta  is zero, in which
-             case C need not be set on entry.
-             On exit, the array  C  is overwritten by the  m by n  matrix
-             ( alpha*op( A )*op( B ) + beta*C ).
-
-    LDC    - INTEGER.
-             On entry, LDC specifies the first dimension of C as declared
-             in  the  calling  (sub)  program.   LDC  must  be  at  least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
-       transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
-       and  columns of  A  and the  number of  rows  of  B  respectively.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-    c_dim1 = *ldc;
-    c_offset = 1 + c_dim1 * 1;
-    c__ -= c_offset;
-
-    /* Function Body */
-    nota = lsame_(transa, "N");
-    notb = lsame_(transb, "N");
-    if (nota) {
-	nrowa = *m;
-	ncola = *k;
-    } else {
-	nrowa = *k;
-	ncola = *m;
-    }
-    if (notb) {
-	nrowb = *k;
-    } else {
-	nrowb = *n;
-    }
-
-/*     Test the input parameters. */
-
-    info = 0;
-    if (((! nota && ! lsame_(transa, "C")) && ! lsame_(
-	    transa, "T"))) {
-	info = 1;
-    } else if (((! notb && ! lsame_(transb, "C")) && !
-	    lsame_(transb, "T"))) {
-	info = 2;
-    } else if (*m < 0) {
-	info = 3;
-    } else if (*n < 0) {
-	info = 4;
-    } else if (*k < 0) {
-	info = 5;
-    } else if (*lda < max(1,nrowa)) {
-	info = 8;
-    } else if (*ldb < max(1,nrowb)) {
-	info = 10;
-    } else if (*ldc < max(1,*m)) {
-	info = 13;
-    }
-    if (info != 0) {
-	xerbla_("DGEMM ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
-	return 0;
-    }
-
-/*     And if  alpha.eq.zero. */
-
-    if (*alpha == 0.) {
-	if (*beta == 0.) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    c__[i__ + j * c_dim1] = 0.;
-/* L10: */
-		}
-/* L20: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L30: */
-		}
-/* L40: */
-	    }
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (notb) {
-	if (nota) {
-
-/*           Form  C := alpha*A*B + beta*C. */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L50: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L60: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    if (b[l + j * b_dim1] != 0.) {
-			temp = *alpha * b[l + j * b_dim1];
-			i__3 = *m;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    c__[i__ + j * c_dim1] += temp * a[i__ + l *
-				    a_dim1];
-/* L70: */
-			}
-		    }
-/* L80: */
-		}
-/* L90: */
-	    }
-	} else {
-
-/*           Form  C := alpha*A'*B + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];
-/* L100: */
-		    }
-		    if (*beta == 0.) {
-			c__[i__ + j * c_dim1] = *alpha * temp;
-		    } else {
-			c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
-				i__ + j * c_dim1];
-		    }
-/* L110: */
-		}
-/* L120: */
-	    }
-	}
-    } else {
-	if (nota) {
-
-/*           Form  C := alpha*A*B' + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L130: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L140: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    if (b[j + l * b_dim1] != 0.) {
-			temp = *alpha * b[j + l * b_dim1];
-			i__3 = *m;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    c__[i__ + j * c_dim1] += temp * a[i__ + l *
-				    a_dim1];
-/* L150: */
-			}
-		    }
-/* L160: */
-		}
-/* L170: */
-	    }
-	} else {
-
-/*           Form  C := alpha*A'*B' + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];
-/* L180: */
-		    }
-		    if (*beta == 0.) {
-			c__[i__ + j * c_dim1] = *alpha * temp;
-		    } else {
-			c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
-				i__ + j * c_dim1];
-		    }
-/* L190: */
-		}
-/* L200: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DGEMM . */
-
-} /* dgemm_ */
-
-/* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *
-	alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
-	doublereal *beta, doublereal *y, integer *incy)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2;
-
-    /* Local variables */
-    static integer i__, j, ix, iy, jx, jy, kx, ky, info;
-    static doublereal temp;
-    static integer lenx, leny;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DGEMV  performs one of the matrix-vector operations
-
-       y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
-
-    where alpha and beta are scalars, x and y are vectors and A is an
-    m by n matrix.
-
-    Parameters
-    ==========
-
-    TRANS  - CHARACTER*1.
-             On entry, TRANS specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
-
-                TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
-
-                TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of the matrix A.
-             M must be at least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-             Before entry, the leading m by n part of the array A must
-             contain the matrix of coefficients.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, m ).
-             Unchanged on exit.
-
-    X      - DOUBLE PRECISION array of DIMENSION at least
-             ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-             and at least
-             ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-             Before entry, the incremented array X must contain the
-             vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION.
-             On entry, BETA specifies the scalar beta. When BETA is
-             supplied as zero then Y need not be set on input.
-             Unchanged on exit.
-
-    Y      - DOUBLE PRECISION array of DIMENSION at least
-             ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-             and at least
-             ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-             Before entry with BETA non-zero, the incremented array Y
-             must contain the vector y. On exit, Y is overwritten by the
-             updated vector y.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-    --y;
-
-    /* Function Body */
-    info = 0;
-    if (((! lsame_(trans, "N") && ! lsame_(trans, "T")) && ! lsame_(trans, "C"))) {
-	info = 1;
-    } else if (*m < 0) {
-	info = 2;
-    } else if (*n < 0) {
-	info = 3;
-    } else if (*lda < max(1,*m)) {
-	info = 6;
-    } else if (*incx == 0) {
-	info = 8;
-    } else if (*incy == 0) {
-	info = 11;
-    }
-    if (info != 0) {
-	xerbla_("DGEMV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || (*alpha == 0. && *beta == 1.)) {
-	return 0;
-    }
-
-/*
-       Set  LENX  and  LENY, the lengths of the vectors x and y, and set
-       up the start points in  X  and  Y.
-*/
-
-    if (lsame_(trans, "N")) {
-	lenx = *n;
-	leny = *m;
-    } else {
-	lenx = *m;
-	leny = *n;
-    }
-    if (*incx > 0) {
-	kx = 1;
-    } else {
-	kx = 1 - (lenx - 1) * *incx;
-    }
-    if (*incy > 0) {
-	ky = 1;
-    } else {
-	ky = 1 - (leny - 1) * *incy;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-
-       First form  y := beta*y.
-*/
-
-    if (*beta != 1.) {
-	if (*incy == 1) {
-	    if (*beta == 0.) {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[i__] = 0.;
-/* L10: */
-		}
-	    } else {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[i__] = *beta * y[i__];
-/* L20: */
-		}
-	    }
-	} else {
-	    iy = ky;
-	    if (*beta == 0.) {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[iy] = 0.;
-		    iy += *incy;
-/* L30: */
-		}
-	    } else {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[iy] = *beta * y[iy];
-		    iy += *incy;
-/* L40: */
-		}
-	    }
-	}
-    }
-    if (*alpha == 0.) {
-	return 0;
-    }
-    if (lsame_(trans, "N")) {
-
-/*        Form  y := alpha*A*x + y. */
-
-	jx = kx;
-	if (*incy == 1) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (x[jx] != 0.) {
-		    temp = *alpha * x[jx];
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			y[i__] += temp * a[i__ + j * a_dim1];
-/* L50: */
-		    }
-		}
-		jx += *incx;
-/* L60: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (x[jx] != 0.) {
-		    temp = *alpha * x[jx];
-		    iy = ky;
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			y[iy] += temp * a[i__ + j * a_dim1];
-			iy += *incy;
-/* L70: */
-		    }
-		}
-		jx += *incx;
-/* L80: */
-	    }
-	}
-    } else {
-
-/*        Form  y := alpha*A'*x + y. */
-
-	jy = ky;
-	if (*incx == 1) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp = 0.;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp += a[i__ + j * a_dim1] * x[i__];
-/* L90: */
-		}
-		y[jy] += *alpha * temp;
-		jy += *incy;
-/* L100: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp = 0.;
-		ix = kx;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp += a[i__ + j * a_dim1] * x[ix];
-		    ix += *incx;
-/* L110: */
-		}
-		y[jy] += *alpha * temp;
-		jy += *incy;
-/* L120: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DGEMV . */
-
-} /* dgemv_ */
-
-/* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,
-	doublereal *x, integer *incx, doublereal *y, integer *incy,
-	doublereal *a, integer *lda)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2;
-
-    /* Local variables */
-    static integer i__, j, ix, jy, kx, info;
-    static doublereal temp;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DGER   performs the rank 1 operation
-
-       A := alpha*x*y' + A,
-
-    where alpha is a scalar, x is an m element vector, y is an n element
-    vector and A is an m by n matrix.
-
-    Parameters
-    ==========
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of the matrix A.
-             M must be at least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    X      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( m - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the m
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    Y      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y.
-             Unchanged on exit.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-             Before entry, the leading m by n part of the array A must
-             contain the matrix of coefficients. On exit, A is
-             overwritten by the updated matrix.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    --x;
-    --y;
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-
-    /* Function Body */
-    info = 0;
-    if (*m < 0) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*incx == 0) {
-	info = 5;
-    } else if (*incy == 0) {
-	info = 7;
-    } else if (*lda < max(1,*m)) {
-	info = 9;
-    }
-    if (info != 0) {
-	xerbla_("DGER  ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || *alpha == 0.) {
-	return 0;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-*/
-
-    if (*incy > 0) {
-	jy = 1;
-    } else {
-	jy = 1 - (*n - 1) * *incy;
-    }
-    if (*incx == 1) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    if (y[jy] != 0.) {
-		temp = *alpha * y[jy];
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    a[i__ + j * a_dim1] += x[i__] * temp;
-/* L10: */
-		}
-	    }
-	    jy += *incy;
-/* L20: */
-	}
-    } else {
-	if (*incx > 0) {
-	    kx = 1;
-	} else {
-	    kx = 1 - (*m - 1) * *incx;
-	}
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    if (y[jy] != 0.) {
-		temp = *alpha * y[jy];
-		ix = kx;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    a[i__ + j * a_dim1] += x[ix] * temp;
-		    ix += *incx;
-/* L30: */
-		}
-	    }
-	    jy += *incy;
-/* L40: */
-	}
-    }
-
-    return 0;
-
-/*     End of DGER  . */
-
-} /* dger_ */
-
-doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
-{
-    /* System generated locals */
-    integer i__1, i__2;
-    doublereal ret_val, d__1;
-
-    /* Builtin functions */
-    double sqrt(doublereal);
-
-    /* Local variables */
-    static integer ix;
-    static doublereal ssq, norm, scale, absxi;
-
-
-/*
-    DNRM2 returns the euclidean norm of a vector via the function
-    name, so that
-
-       DNRM2 := sqrt( x'*x )
-
-
-    -- This version written on 25-October-1982.
-       Modified on 14-October-1993 to inline the call to DLASSQ.
-       Sven Hammarling, Nag Ltd.
-*/
-
-
-    /* Parameter adjustments */
-    --x;
-
-    /* Function Body */
-    if (*n < 1 || *incx < 1) {
-	norm = 0.;
-    } else if (*n == 1) {
-	norm = abs(x[1]);
-    } else {
-	scale = 0.;
-	ssq = 1.;
-/*
-          The following loop is equivalent to this call to the LAPACK
-          auxiliary routine:
-          CALL DLASSQ( N, X, INCX, SCALE, SSQ )
-*/
-
-	i__1 = (*n - 1) * *incx + 1;
-	i__2 = *incx;
-	for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
-	    if (x[ix] != 0.) {
-		absxi = (d__1 = x[ix], abs(d__1));
-		if (scale < absxi) {
-/* Computing 2nd power */
-		    d__1 = scale / absxi;
-		    ssq = ssq * (d__1 * d__1) + 1.;
-		    scale = absxi;
-		} else {
-/* Computing 2nd power */
-		    d__1 = absxi / scale;
-		    ssq += d__1 * d__1;
-		}
-	    }
-/* L10: */
-	}
-	norm = scale * sqrt(ssq);
-    }
-
-    ret_val = norm;
-    return ret_val;
-
-/*     End of DNRM2. */
-
-} /* dnrm2_ */
-
-/* Subroutine */ int drot_(integer *n, doublereal *dx, integer *incx,
-	doublereal *dy, integer *incy, doublereal *c__, doublereal *s)
-{
-    /* System generated locals */
-    integer i__1;
-
-    /* Local variables */
-    static integer i__, ix, iy;
-    static doublereal dtemp;
-
-
-/*
-       applies a plane rotation.
-       jack dongarra, linpack, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dy;
-    --dx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-         code for unequal increments or equal increments not equal
-           to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dtemp = *c__ * dx[ix] + *s * dy[iy];
-	dy[iy] = *c__ * dy[iy] - *s * dx[ix];
-	dx[ix] = dtemp;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*       code for both increments equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dtemp = *c__ * dx[i__] + *s * dy[i__];
-	dy[i__] = *c__ * dy[i__] - *s * dx[i__];
-	dx[i__] = dtemp;
-/* L30: */
-    }
-    return 0;
-} /* drot_ */
-
-/* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx,
-	integer *incx)
-{
-    /* System generated locals */
-    integer i__1, i__2;
-
-    /* Local variables */
-    static integer i__, m, mp1, nincx;
-
-
-/*
-       scales a vector by a constant.
-       uses unrolled loops for increment equal to one.
-       jack dongarra, linpack, 3/11/78.
-       modified 3/93 to return if incx .le. 0.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dx;
-
-    /* Function Body */
-    if (*n <= 0 || *incx <= 0) {
-	return 0;
-    }
-    if (*incx == 1) {
-	goto L20;
-    }
-
-/*        code for increment not equal to 1 */
-
-    nincx = *n * *incx;
-    i__1 = nincx;
-    i__2 = *incx;
-    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
-	dx[i__] = *da * dx[i__];
-/* L10: */
-    }
-    return 0;
-
-/*
-          code for increment equal to 1
-
-
-          clean-up loop
-*/
-
-L20:
-    m = *n % 5;
-    if (m == 0) {
-	goto L40;
-    }
-    i__2 = m;
-    for (i__ = 1; i__ <= i__2; ++i__) {
-	dx[i__] = *da * dx[i__];
-/* L30: */
-    }
-    if (*n < 5) {
-	return 0;
-    }
-L40:
-    mp1 = m + 1;
-    i__2 = *n;
-    for (i__ = mp1; i__ <= i__2; i__ += 5) {
-	dx[i__] = *da * dx[i__];
-	dx[i__ + 1] = *da * dx[i__ + 1];
-	dx[i__ + 2] = *da * dx[i__ + 2];
-	dx[i__ + 3] = *da * dx[i__ + 3];
-	dx[i__ + 4] = *da * dx[i__ + 4];
-/* L50: */
-    }
-    return 0;
-} /* dscal_ */
-
-/* Subroutine */ int dswap_(integer *n, doublereal *dx, integer *incx,
-	doublereal *dy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1;
-
-    /* Local variables */
-    static integer i__, m, ix, iy, mp1;
-    static doublereal dtemp;
-
-
-/*
-       interchanges two vectors.
-       uses unrolled loops for increments equal one.
-       jack dongarra, linpack, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dy;
-    --dx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-         code for unequal increments or equal increments not equal
-           to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dtemp = dx[ix];
-	dx[ix] = dy[iy];
-	dy[iy] = dtemp;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*
-         code for both increments equal to 1
-
-
-         clean-up loop
-*/
-
-L20:
-    m = *n % 3;
-    if (m == 0) {
-	goto L40;
-    }
-    i__1 = m;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	dtemp = dx[i__];
-	dx[i__] = dy[i__];
-	dy[i__] = dtemp;
-/* L30: */
-    }
-    if (*n < 3) {
-	return 0;
-    }
-L40:
-    mp1 = m + 1;
-    i__1 = *n;
-    for (i__ = mp1; i__ <= i__1; i__ += 3) {
-	dtemp = dx[i__];
-	dx[i__] = dy[i__];
-	dy[i__] = dtemp;
-	dtemp = dx[i__ + 1];
-	dx[i__ + 1] = dy[i__ + 1];
-	dy[i__ + 1] = dtemp;
-	dtemp = dx[i__ + 2];
-	dx[i__ + 2] = dy[i__ + 2];
-	dy[i__ + 2] = dtemp;
-/* L50: */
-    }
-    return 0;
-} /* dswap_ */
-
-/* Subroutine */ int dsymv_(char *uplo, integer *n, doublereal *alpha,
-	doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal
-	*beta, doublereal *y, integer *incy)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2;
-
-    /* Local variables */
-    static integer i__, j, ix, iy, jx, jy, kx, ky, info;
-    static doublereal temp1, temp2;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DSYMV  performs the matrix-vector  operation
-
-       y := alpha*A*x + beta*y,
-
-    where alpha and beta are scalars, x and y are n element vectors and
-    A is an n by n symmetric matrix.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the upper or lower
-             triangular part of the array A is to be referenced as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the upper triangular part of A
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the lower triangular part of A
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular part of the symmetric matrix and the strictly
-             lower triangular part of A is not referenced.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular part of the symmetric matrix and the strictly
-             upper triangular part of A is not referenced.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-    X      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION.
-             On entry, BETA specifies the scalar beta. When BETA is
-             supplied as zero then Y need not be set on input.
-             Unchanged on exit.
-
-    Y      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y. On exit, Y is overwritten by the updated
-             vector y.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-    --y;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*lda < max(1,*n)) {
-	info = 5;
-    } else if (*incx == 0) {
-	info = 7;
-    } else if (*incy == 0) {
-	info = 10;
-    }
-    if (info != 0) {
-	xerbla_("DSYMV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
-	return 0;
-    }
-
-/*     Set up the start points in  X  and  Y. */
-
-    if (*incx > 0) {
-	kx = 1;
-    } else {
-	kx = 1 - (*n - 1) * *incx;
-    }
-    if (*incy > 0) {
-	ky = 1;
-    } else {
-	ky = 1 - (*n - 1) * *incy;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through the triangular part
-       of A.
-
-       First form  y := beta*y.
-*/
-
-    if (*beta != 1.) {
-	if (*incy == 1) {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[i__] = 0.;
-/* L10: */
-		}
-	    } else {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[i__] = *beta * y[i__];
-/* L20: */
-		}
-	    }
-	} else {
-	    iy = ky;
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[iy] = 0.;
-		    iy += *incy;
-/* L30: */
-		}
-	    } else {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    y[iy] = *beta * y[iy];
-		    iy += *incy;
-/* L40: */
-		}
-	    }
-	}
-    }
-    if (*alpha == 0.) {
-	return 0;
-    }
-    if (lsame_(uplo, "U")) {
-
-/*        Form  y  when A is stored in upper triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp1 = *alpha * x[j];
-		temp2 = 0.;
-		i__2 = j - 1;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    y[i__] += temp1 * a[i__ + j * a_dim1];
-		    temp2 += a[i__ + j * a_dim1] * x[i__];
-/* L50: */
-		}
-		y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
-/* L60: */
-	    }
-	} else {
-	    jx = kx;
-	    jy = ky;
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp1 = *alpha * x[jx];
-		temp2 = 0.;
-		ix = kx;
-		iy = ky;
-		i__2 = j - 1;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    y[iy] += temp1 * a[i__ + j * a_dim1];
-		    temp2 += a[i__ + j * a_dim1] * x[ix];
-		    ix += *incx;
-		    iy += *incy;
-/* L70: */
-		}
-		y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
-		jx += *incx;
-		jy += *incy;
-/* L80: */
-	    }
-	}
-    } else {
-
-/*        Form  y  when A is stored in lower triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp1 = *alpha * x[j];
-		temp2 = 0.;
-		y[j] += temp1 * a[j + j * a_dim1];
-		i__2 = *n;
-		for (i__ = j + 1; i__ <= i__2; ++i__) {
-		    y[i__] += temp1 * a[i__ + j * a_dim1];
-		    temp2 += a[i__ + j * a_dim1] * x[i__];
-/* L90: */
-		}
-		y[j] += *alpha * temp2;
-/* L100: */
-	    }
-	} else {
-	    jx = kx;
-	    jy = ky;
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp1 = *alpha * x[jx];
-		temp2 = 0.;
-		y[jy] += temp1 * a[j + j * a_dim1];
-		ix = jx;
-		iy = jy;
-		i__2 = *n;
-		for (i__ = j + 1; i__ <= i__2; ++i__) {
-		    ix += *incx;
-		    iy += *incy;
-		    y[iy] += temp1 * a[i__ + j * a_dim1];
-		    temp2 += a[i__ + j * a_dim1] * x[ix];
-/* L110: */
-		}
-		y[jy] += *alpha * temp2;
-		jx += *incx;
-		jy += *incy;
-/* L120: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DSYMV . */
-
-} /* dsymv_ */
-
-/* Subroutine */ int dsyr2_(char *uplo, integer *n, doublereal *alpha,
-	doublereal *x, integer *incx, doublereal *y, integer *incy,
-	doublereal *a, integer *lda)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2;
-
-    /* Local variables */
-    static integer i__, j, ix, iy, jx, jy, kx, ky, info;
-    static doublereal temp1, temp2;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DSYR2  performs the symmetric rank 2 operation
-
-       A := alpha*x*y' + alpha*y*x' + A,
-
-    where alpha is a scalar, x and y are n element vectors and A is an n
-    by n symmetric matrix.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the upper or lower
-             triangular part of the array A is to be referenced as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the upper triangular part of A
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the lower triangular part of A
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    X      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    Y      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y.
-             Unchanged on exit.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular part of the symmetric matrix and the strictly
-             lower triangular part of A is not referenced. On exit, the
-             upper triangular part of the array A is overwritten by the
-             upper triangular part of the updated matrix.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular part of the symmetric matrix and the strictly
-             upper triangular part of A is not referenced. On exit, the
-             lower triangular part of the array A is overwritten by the
-             lower triangular part of the updated matrix.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    --x;
-    --y;
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*incx == 0) {
-	info = 5;
-    } else if (*incy == 0) {
-	info = 7;
-    } else if (*lda < max(1,*n)) {
-	info = 9;
-    }
-    if (info != 0) {
-	xerbla_("DSYR2 ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || *alpha == 0.) {
-	return 0;
-    }
-
-/*
-       Set up the start points in X and Y if the increments are not both
-       unity.
-*/
-
-    if (*incx != 1 || *incy != 1) {
-	if (*incx > 0) {
-	    kx = 1;
-	} else {
-	    kx = 1 - (*n - 1) * *incx;
-	}
-	if (*incy > 0) {
-	    ky = 1;
-	} else {
-	    ky = 1 - (*n - 1) * *incy;
-	}
-	jx = kx;
-	jy = ky;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through the triangular part
-       of A.
-*/
-
-    if (lsame_(uplo, "U")) {
-
-/*        Form  A  when A is stored in the upper triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (x[j] != 0. || y[j] != 0.) {
-		    temp1 = *alpha * y[j];
-		    temp2 = *alpha * x[j];
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *
-				temp1 + y[i__] * temp2;
-/* L10: */
-		    }
-		}
-/* L20: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (x[jx] != 0. || y[jy] != 0.) {
-		    temp1 = *alpha * y[jy];
-		    temp2 = *alpha * x[jx];
-		    ix = kx;
-		    iy = ky;
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *
-				temp1 + y[iy] * temp2;
-			ix += *incx;
-			iy += *incy;
-/* L30: */
-		    }
-		}
-		jx += *incx;
-		jy += *incy;
-/* L40: */
-	    }
-	}
-    } else {
-
-/*        Form  A  when A is stored in the lower triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (x[j] != 0. || y[j] != 0.) {
-		    temp1 = *alpha * y[j];
-		    temp2 = *alpha * x[j];
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *
-				temp1 + y[i__] * temp2;
-/* L50: */
-		    }
-		}
-/* L60: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (x[jx] != 0. || y[jy] != 0.) {
-		    temp1 = *alpha * y[jy];
-		    temp2 = *alpha * x[jx];
-		    ix = jx;
-		    iy = jy;
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *
-				temp1 + y[iy] * temp2;
-			ix += *incx;
-			iy += *incy;
-/* L70: */
-		    }
-		}
-		jx += *incx;
-		jy += *incy;
-/* L80: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DSYR2 . */
-
-} /* dsyr2_ */
-
-/* Subroutine */ int dsyr2k_(char *uplo, char *trans, integer *n, integer *k,
-	doublereal *alpha, doublereal *a, integer *lda, doublereal *b,
-	integer *ldb, doublereal *beta, doublereal *c__, integer *ldc)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
-	    i__3;
-
-    /* Local variables */
-    static integer i__, j, l, info;
-    static doublereal temp1, temp2;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DSYR2K  performs one of the symmetric rank 2k operations
-
-       C := alpha*A*B' + alpha*B*A' + beta*C,
-
-    or
-
-       C := alpha*A'*B + alpha*B'*A + beta*C,
-
-    where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
-    and  A and B  are  n by k  matrices  in the  first  case  and  k by n
-    matrices in the second case.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On  entry,   UPLO  specifies  whether  the  upper  or  lower
-             triangular  part  of the  array  C  is to be  referenced  as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the  upper triangular part of  C
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the  lower triangular part of  C
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry,  TRANS  specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   C := alpha*A*B' + alpha*B*A' +
-                                          beta*C.
-
-                TRANS = 'T' or 't'   C := alpha*A'*B + alpha*B'*A +
-                                          beta*C.
-
-                TRANS = 'C' or 'c'   C := alpha*A'*B + alpha*B'*A +
-                                          beta*C.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry,  N specifies the order of the matrix C.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    K      - INTEGER.
-             On entry with  TRANS = 'N' or 'n',  K  specifies  the number
-             of  columns  of the  matrices  A and B,  and on  entry  with
-             TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
-             of rows of the matrices  A and B.  K must be at least  zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-             k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
-             Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
-             part of the array  A  must contain the matrix  A,  otherwise
-             the leading  k by n  part of the array  A  must contain  the
-             matrix A.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
-             then  LDA must be at least  max( 1, n ), otherwise  LDA must
-             be at least  max( 1, k ).
-             Unchanged on exit.
-
-    B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
-             k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
-             Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
-             part of the array  B  must contain the matrix  B,  otherwise
-             the leading  k by n  part of the array  B  must contain  the
-             matrix B.
-             Unchanged on exit.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
-             then  LDB must be at least  max( 1, n ), otherwise  LDB must
-             be at least  max( 1, k ).
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION.
-             On entry, BETA specifies the scalar beta.
-             Unchanged on exit.
-
-    C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-             Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
-             upper triangular part of the array C must contain the upper
-             triangular part  of the  symmetric matrix  and the strictly
-             lower triangular part of C is not referenced.  On exit, the
-             upper triangular part of the array  C is overwritten by the
-             upper triangular part of the updated matrix.
-             Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
-             lower triangular part of the array C must contain the lower
-             triangular part  of the  symmetric matrix  and the strictly
-             upper triangular part of C is not referenced.  On exit, the
-             lower triangular part of the array  C is overwritten by the
-             lower triangular part of the updated matrix.
-
-    LDC    - INTEGER.
-             On entry, LDC specifies the first dimension of C as declared
-             in  the  calling  (sub)  program.   LDC  must  be  at  least
-             max( 1, n ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-    c_dim1 = *ldc;
-    c_offset = 1 + c_dim1 * 1;
-    c__ -= c_offset;
-
-    /* Function Body */
-    if (lsame_(trans, "N")) {
-	nrowa = *n;
-    } else {
-	nrowa = *k;
-    }
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (((! lsame_(trans, "N") && ! lsame_(trans,
-	     "T")) && ! lsame_(trans, "C"))) {
-	info = 2;
-    } else if (*n < 0) {
-	info = 3;
-    } else if (*k < 0) {
-	info = 4;
-    } else if (*lda < max(1,nrowa)) {
-	info = 7;
-    } else if (*ldb < max(1,nrowa)) {
-	info = 9;
-    } else if (*ldc < max(1,*n)) {
-	info = 12;
-    }
-    if (info != 0) {
-	xerbla_("DSYR2K", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if (*alpha == 0.) {
-	if (upper) {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L10: */
-		    }
-/* L20: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L30: */
-		    }
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L50: */
-		    }
-/* L60: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L70: */
-		    }
-/* L80: */
-		}
-	    }
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lsame_(trans, "N")) {
-
-/*        Form  C := alpha*A*B' + alpha*B*A' + C. */
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L90: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L100: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {
-			temp1 = *alpha * b[j + l * b_dim1];
-			temp2 = *alpha * a[j + l * a_dim1];
-			i__3 = j;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[
-				    i__ + l * a_dim1] * temp1 + b[i__ + l *
-				    b_dim1] * temp2;
-/* L110: */
-			}
-		    }
-/* L120: */
-		}
-/* L130: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L140: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L150: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {
-			temp1 = *alpha * b[j + l * b_dim1];
-			temp2 = *alpha * a[j + l * a_dim1];
-			i__3 = *n;
-			for (i__ = j; i__ <= i__3; ++i__) {
-			    c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[
-				    i__ + l * a_dim1] * temp1 + b[i__ + l *
-				    b_dim1] * temp2;
-/* L160: */
-			}
-		    }
-/* L170: */
-		}
-/* L180: */
-	    }
-	}
-    } else {
-
-/*        Form  C := alpha*A'*B + alpha*B'*A + C. */
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp1 = 0.;
-		    temp2 = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];
-			temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];
-/* L190: */
-		    }
-		    if (*beta == 0.) {
-			c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *
-				temp2;
-		    } else {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]
-				+ *alpha * temp1 + *alpha * temp2;
-		    }
-/* L200: */
-		}
-/* L210: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *n;
-		for (i__ = j; i__ <= i__2; ++i__) {
-		    temp1 = 0.;
-		    temp2 = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];
-			temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];
-/* L220: */
-		    }
-		    if (*beta == 0.) {
-			c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *
-				temp2;
-		    } else {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]
-				+ *alpha * temp1 + *alpha * temp2;
-		    }
-/* L230: */
-		}
-/* L240: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DSYR2K. */
-
-} /* dsyr2k_ */
-
-/* Subroutine */ int dsyrk_(char *uplo, char *trans, integer *n, integer *k,
-	doublereal *alpha, doublereal *a, integer *lda, doublereal *beta,
-	doublereal *c__, integer *ldc)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
-
-    /* Local variables */
-    static integer i__, j, l, info;
-    static doublereal temp;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    DSYRK  performs one of the symmetric rank k operations
-
-       C := alpha*A*A' + beta*C,
-
-    or
-
-       C := alpha*A'*A + beta*C,
-
-    where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
-    and  A  is an  n by k  matrix in the first case and a  k by n  matrix
-    in the second case.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On  entry,   UPLO  specifies  whether  the  upper  or  lower
-             triangular  part  of the  array  C  is to be  referenced  as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the  upper triangular part of  C
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the  lower triangular part of  C
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry,  TRANS  specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   C := alpha*A*A' + beta*C.
-
-                TRANS = 'T' or 't'   C := alpha*A'*A + beta*C.
-
-                TRANS = 'C' or 'c'   C := alpha*A'*A + beta*C.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry,  N specifies the order of the matrix C.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    K      - INTEGER.
-             On entry with  TRANS = 'N' or 'n',  K  specifies  the number
-             of  columns   of  the   matrix   A,   and  on   entry   with
-             TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
-             of rows of the matrix  A.  K must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-             k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
-             Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
-             part of the array  A  must contain the matrix  A,  otherwise
-             the leading  k by n  part of the array  A  must contain  the
-             matrix A.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
-             then  LDA must be at least  max( 1, n ), otherwise  LDA must
-             be at least  max( 1, k ).
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION.
-             On entry, BETA specifies the scalar beta.
-             Unchanged on exit.
-
-    C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-             Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
-             upper triangular part of the array C must contain the upper
-             triangular part  of the  symmetric matrix  and the strictly
-             lower triangular part of C is not referenced.  On exit, the
-             upper triangular part of the array  C is overwritten by the
-             upper triangular part of the updated matrix.
-             Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
-             lower triangular part of the array C must contain the lower
-             triangular part  of the  symmetric matrix  and the strictly
-             upper triangular part of C is not referenced.  On exit, the
-             lower triangular part of the array  C is overwritten by the
-             lower triangular part of the updated matrix.
-
-    LDC    - INTEGER.
-             On entry, LDC specifies the first dimension of C as declared
-             in  the  calling  (sub)  program.   LDC  must  be  at  least
-             max( 1, n ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    c_dim1 = *ldc;
-    c_offset = 1 + c_dim1 * 1;
-    c__ -= c_offset;
-
-    /* Function Body */
-    if (lsame_(trans, "N")) {
-	nrowa = *n;
-    } else {
-	nrowa = *k;
-    }
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (((! lsame_(trans, "N") && ! lsame_(trans,
-	     "T")) && ! lsame_(trans, "C"))) {
-	info = 2;
-    } else if (*n < 0) {
-	info = 3;
-    } else if (*k < 0) {
-	info = 4;
-    } else if (*lda < max(1,nrowa)) {
-	info = 7;
-    } else if (*ldc < max(1,*n)) {
-	info = 10;
-    }
-    if (info != 0) {
-	xerbla_("DSYRK ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if (*alpha == 0.) {
-	if (upper) {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L10: */
-		    }
-/* L20: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L30: */
-		    }
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L50: */
-		    }
-/* L60: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L70: */
-		    }
-/* L80: */
-		}
-	    }
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lsame_(trans, "N")) {
-
-/*        Form  C := alpha*A*A' + beta*C. */
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L90: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L100: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    if (a[j + l * a_dim1] != 0.) {
-			temp = *alpha * a[j + l * a_dim1];
-			i__3 = j;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    c__[i__ + j * c_dim1] += temp * a[i__ + l *
-				    a_dim1];
-/* L110: */
-			}
-		    }
-/* L120: */
-		}
-/* L130: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = 0.;
-/* L140: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
-/* L150: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    if (a[j + l * a_dim1] != 0.) {
-			temp = *alpha * a[j + l * a_dim1];
-			i__3 = *n;
-			for (i__ = j; i__ <= i__3; ++i__) {
-			    c__[i__ + j * c_dim1] += temp * a[i__ + l *
-				    a_dim1];
-/* L160: */
-			}
-		    }
-/* L170: */
-		}
-/* L180: */
-	    }
-	}
-    } else {
-
-/*        Form  C := alpha*A'*A + beta*C. */
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];
-/* L190: */
-		    }
-		    if (*beta == 0.) {
-			c__[i__ + j * c_dim1] = *alpha * temp;
-		    } else {
-			c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
-				i__ + j * c_dim1];
-		    }
-/* L200: */
-		}
-/* L210: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *n;
-		for (i__ = j; i__ <= i__2; ++i__) {
-		    temp = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];
-/* L220: */
-		    }
-		    if (*beta == 0.) {
-			c__[i__ + j * c_dim1] = *alpha * temp;
-		    } else {
-			c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
-				i__ + j * c_dim1];
-		    }
-/* L230: */
-		}
-/* L240: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DSYRK . */
-
-} /* dsyrk_ */
-
-/* Subroutine */ int dtrmm_(char *side, char *uplo, char *transa, char *diag,
-	integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
-	lda, doublereal *b, integer *ldb)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
-
-    /* Local variables */
-    static integer i__, j, k, info;
-    static doublereal temp;
-    static logical lside;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical nounit;
-
-
-/*
-    Purpose
-    =======
-
-    DTRMM  performs one of the matrix-matrix operations
-
-       B := alpha*op( A )*B,   or   B := alpha*B*op( A ),
-
-    where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
-    non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
-
-       op( A ) = A   or   op( A ) = A'.
-
-    Parameters
-    ==========
-
-    SIDE   - CHARACTER*1.
-             On entry,  SIDE specifies whether  op( A ) multiplies B from
-             the left or right as follows:
-
-                SIDE = 'L' or 'l'   B := alpha*op( A )*B.
-
-                SIDE = 'R' or 'r'   B := alpha*B*op( A ).
-
-             Unchanged on exit.
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix A is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANSA - CHARACTER*1.
-             On entry, TRANSA specifies the form of op( A ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSA = 'N' or 'n'   op( A ) = A.
-
-                TRANSA = 'T' or 't'   op( A ) = A'.
-
-                TRANSA = 'C' or 'c'   op( A ) = A'.
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit triangular
-             as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of B. M must be at
-             least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of B.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry,  ALPHA specifies the scalar  alpha. When  alpha is
-             zero then  A is not referenced and  B need not be set before
-             entry.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
-             when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
-             Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
-             upper triangular part of the array  A must contain the upper
-             triangular matrix  and the strictly lower triangular part of
-             A is not referenced.
-             Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
-             lower triangular part of the array  A must contain the lower
-             triangular matrix  and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u',  the diagonal elements of
-             A  are not referenced either,  but are assumed to be  unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
-             LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
-             then LDA must be at least max( 1, n ).
-             Unchanged on exit.
-
-    B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-             Before entry,  the leading  m by n part of the array  B must
-             contain the matrix  B,  and  on exit  is overwritten  by the
-             transformed matrix.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in  the  calling  (sub)  program.   LDB  must  be  at  least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-
-    /* Function Body */
-    lside = lsame_(side, "L");
-    if (lside) {
-	nrowa = *m;
-    } else {
-	nrowa = *n;
-    }
-    nounit = lsame_(diag, "N");
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! lside && ! lsame_(side, "R"))) {
-	info = 1;
-    } else if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 2;
-    } else if (((! lsame_(transa, "N") && ! lsame_(
-	    transa, "T")) && ! lsame_(transa, "C"))) {
-	info = 3;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 4;
-    } else if (*m < 0) {
-	info = 5;
-    } else if (*n < 0) {
-	info = 6;
-    } else if (*lda < max(1,nrowa)) {
-	info = 9;
-    } else if (*ldb < max(1,*m)) {
-	info = 11;
-    }
-    if (info != 0) {
-	xerbla_("DTRMM ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if (*alpha == 0.) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = *m;
-	    for (i__ = 1; i__ <= i__2; ++i__) {
-		b[i__ + j * b_dim1] = 0.;
-/* L10: */
-	    }
-/* L20: */
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lside) {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*A*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *m;
-		    for (k = 1; k <= i__2; ++k) {
-			if (b[k + j * b_dim1] != 0.) {
-			    temp = *alpha * b[k + j * b_dim1];
-			    i__3 = k - 1;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				b[i__ + j * b_dim1] += temp * a[i__ + k *
-					a_dim1];
-/* L30: */
-			    }
-			    if (nounit) {
-				temp *= a[k + k * a_dim1];
-			    }
-			    b[k + j * b_dim1] = temp;
-			}
-/* L40: */
-		    }
-/* L50: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    for (k = *m; k >= 1; --k) {
-			if (b[k + j * b_dim1] != 0.) {
-			    temp = *alpha * b[k + j * b_dim1];
-			    b[k + j * b_dim1] = temp;
-			    if (nounit) {
-				b[k + j * b_dim1] *= a[k + k * a_dim1];
-			    }
-			    i__2 = *m;
-			    for (i__ = k + 1; i__ <= i__2; ++i__) {
-				b[i__ + j * b_dim1] += temp * a[i__ + k *
-					a_dim1];
-/* L60: */
-			    }
-			}
-/* L70: */
-		    }
-/* L80: */
-		}
-	    }
-	} else {
-
-/*           Form  B := alpha*A'*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    for (i__ = *m; i__ >= 1; --i__) {
-			temp = b[i__ + j * b_dim1];
-			if (nounit) {
-			    temp *= a[i__ + i__ * a_dim1];
-			}
-			i__2 = i__ - 1;
-			for (k = 1; k <= i__2; ++k) {
-			    temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
-/* L90: */
-			}
-			b[i__ + j * b_dim1] = *alpha * temp;
-/* L100: */
-		    }
-/* L110: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			temp = b[i__ + j * b_dim1];
-			if (nounit) {
-			    temp *= a[i__ + i__ * a_dim1];
-			}
-			i__3 = *m;
-			for (k = i__ + 1; k <= i__3; ++k) {
-			    temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
-/* L120: */
-			}
-			b[i__ + j * b_dim1] = *alpha * temp;
-/* L130: */
-		    }
-/* L140: */
-		}
-	    }
-	}
-    } else {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*B*A. */
-
-	    if (upper) {
-		for (j = *n; j >= 1; --j) {
-		    temp = *alpha;
-		    if (nounit) {
-			temp *= a[j + j * a_dim1];
-		    }
-		    i__1 = *m;
-		    for (i__ = 1; i__ <= i__1; ++i__) {
-			b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
-/* L150: */
-		    }
-		    i__1 = j - 1;
-		    for (k = 1; k <= i__1; ++k) {
-			if (a[k + j * a_dim1] != 0.) {
-			    temp = *alpha * a[k + j * a_dim1];
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				b[i__ + j * b_dim1] += temp * b[i__ + k *
-					b_dim1];
-/* L160: */
-			    }
-			}
-/* L170: */
-		    }
-/* L180: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    temp = *alpha;
-		    if (nounit) {
-			temp *= a[j + j * a_dim1];
-		    }
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
-/* L190: */
-		    }
-		    i__2 = *n;
-		    for (k = j + 1; k <= i__2; ++k) {
-			if (a[k + j * a_dim1] != 0.) {
-			    temp = *alpha * a[k + j * a_dim1];
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				b[i__ + j * b_dim1] += temp * b[i__ + k *
-					b_dim1];
-/* L200: */
-			    }
-			}
-/* L210: */
-		    }
-/* L220: */
-		}
-	    }
-	} else {
-
-/*           Form  B := alpha*B*A'. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (k = 1; k <= i__1; ++k) {
-		    i__2 = k - 1;
-		    for (j = 1; j <= i__2; ++j) {
-			if (a[j + k * a_dim1] != 0.) {
-			    temp = *alpha * a[j + k * a_dim1];
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				b[i__ + j * b_dim1] += temp * b[i__ + k *
-					b_dim1];
-/* L230: */
-			    }
-			}
-/* L240: */
-		    }
-		    temp = *alpha;
-		    if (nounit) {
-			temp *= a[k + k * a_dim1];
-		    }
-		    if (temp != 1.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
-/* L250: */
-			}
-		    }
-/* L260: */
-		}
-	    } else {
-		for (k = *n; k >= 1; --k) {
-		    i__1 = *n;
-		    for (j = k + 1; j <= i__1; ++j) {
-			if (a[j + k * a_dim1] != 0.) {
-			    temp = *alpha * a[j + k * a_dim1];
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				b[i__ + j * b_dim1] += temp * b[i__ + k *
-					b_dim1];
-/* L270: */
-			    }
-			}
-/* L280: */
-		    }
-		    temp = *alpha;
-		    if (nounit) {
-			temp *= a[k + k * a_dim1];
-		    }
-		    if (temp != 1.) {
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
-/* L290: */
-			}
-		    }
-/* L300: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DTRMM . */
-
-} /* dtrmm_ */
-
-/* Subroutine */ int dtrmv_(char *uplo, char *trans, char *diag, integer *n,
-	doublereal *a, integer *lda, doublereal *x, integer *incx)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2;
-
-    /* Local variables */
-    static integer i__, j, ix, jx, kx, info;
-    static doublereal temp;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical nounit;
-
-
-/*
-    Purpose
-    =======
-
-    DTRMV  performs one of the matrix-vector operations
-
-       x := A*x,   or   x := A'*x,
-
-    where x is an n element vector and  A is an n by n unit, or non-unit,
-    upper or lower triangular matrix.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry, TRANS specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   x := A*x.
-
-                TRANS = 'T' or 't'   x := A'*x.
-
-                TRANS = 'C' or 'c'   x := A'*x.
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit
-             triangular as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular matrix and the strictly lower triangular part of
-             A is not referenced.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular matrix and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u', the diagonal elements of
-             A are not referenced either, but are assumed to be unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-    X      - DOUBLE PRECISION array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element vector x. On exit, X is overwritten with the
-             tranformed vector x.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (((! lsame_(trans, "N") && ! lsame_(trans,
-	     "T")) && ! lsame_(trans, "C"))) {
-	info = 2;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 3;
-    } else if (*n < 0) {
-	info = 4;
-    } else if (*lda < max(1,*n)) {
-	info = 6;
-    } else if (*incx == 0) {
-	info = 8;
-    }
-    if (info != 0) {
-	xerbla_("DTRMV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-    nounit = lsame_(diag, "N");
-
-/*
-       Set up the start point in X if the increment is not unity. This
-       will be  ( N - 1 )*INCX  too small for descending loops.
-*/
-
-    if (*incx <= 0) {
-	kx = 1 - (*n - 1) * *incx;
-    } else if (*incx != 1) {
-	kx = 1;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-*/
-
-    if (lsame_(trans, "N")) {
-
-/*        Form  x := A*x. */
-
-	if (lsame_(uplo, "U")) {
-	    if (*incx == 1) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (x[j] != 0.) {
-			temp = x[j];
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    x[i__] += temp * a[i__ + j * a_dim1];
-/* L10: */
-			}
-			if (nounit) {
-			    x[j] *= a[j + j * a_dim1];
-			}
-		    }
-/* L20: */
-		}
-	    } else {
-		jx = kx;
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (x[jx] != 0.) {
-			temp = x[jx];
-			ix = kx;
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    x[ix] += temp * a[i__ + j * a_dim1];
-			    ix += *incx;
-/* L30: */
-			}
-			if (nounit) {
-			    x[jx] *= a[j + j * a_dim1];
-			}
-		    }
-		    jx += *incx;
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*incx == 1) {
-		for (j = *n; j >= 1; --j) {
-		    if (x[j] != 0.) {
-			temp = x[j];
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    x[i__] += temp * a[i__ + j * a_dim1];
-/* L50: */
-			}
-			if (nounit) {
-			    x[j] *= a[j + j * a_dim1];
-			}
-		    }
-/* L60: */
-		}
-	    } else {
-		kx += (*n - 1) * *incx;
-		jx = kx;
-		for (j = *n; j >= 1; --j) {
-		    if (x[jx] != 0.) {
-			temp = x[jx];
-			ix = kx;
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    x[ix] += temp * a[i__ + j * a_dim1];
-			    ix -= *incx;
-/* L70: */
-			}
-			if (nounit) {
-			    x[jx] *= a[j + j * a_dim1];
-			}
-		    }
-		    jx -= *incx;
-/* L80: */
-		}
-	    }
-	}
-    } else {
-
-/*        Form  x := A'*x. */
-
-	if (lsame_(uplo, "U")) {
-	    if (*incx == 1) {
-		for (j = *n; j >= 1; --j) {
-		    temp = x[j];
-		    if (nounit) {
-			temp *= a[j + j * a_dim1];
-		    }
-		    for (i__ = j - 1; i__ >= 1; --i__) {
-			temp += a[i__ + j * a_dim1] * x[i__];
-/* L90: */
-		    }
-		    x[j] = temp;
-/* L100: */
-		}
-	    } else {
-		jx = kx + (*n - 1) * *incx;
-		for (j = *n; j >= 1; --j) {
-		    temp = x[jx];
-		    ix = jx;
-		    if (nounit) {
-			temp *= a[j + j * a_dim1];
-		    }
-		    for (i__ = j - 1; i__ >= 1; --i__) {
-			ix -= *incx;
-			temp += a[i__ + j * a_dim1] * x[ix];
-/* L110: */
-		    }
-		    x[jx] = temp;
-		    jx -= *incx;
-/* L120: */
-		}
-	    }
-	} else {
-	    if (*incx == 1) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    temp = x[j];
-		    if (nounit) {
-			temp *= a[j + j * a_dim1];
-		    }
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			temp += a[i__ + j * a_dim1] * x[i__];
-/* L130: */
-		    }
-		    x[j] = temp;
-/* L140: */
-		}
-	    } else {
-		jx = kx;
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    temp = x[jx];
-		    ix = jx;
-		    if (nounit) {
-			temp *= a[j + j * a_dim1];
-		    }
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			ix += *incx;
-			temp += a[i__ + j * a_dim1] * x[ix];
-/* L150: */
-		    }
-		    x[jx] = temp;
-		    jx += *incx;
-/* L160: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DTRMV . */
-
-} /* dtrmv_ */
-
-/* Subroutine */ int dtrsm_(char *side, char *uplo, char *transa, char *diag,
-	integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
-	lda, doublereal *b, integer *ldb)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
-
-    /* Local variables */
-    static integer i__, j, k, info;
-    static doublereal temp;
-    static logical lside;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical nounit;
-
-
-/*
-    Purpose
-    =======
-
-    DTRSM  solves one of the matrix equations
-
-       op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
-
-    where alpha is a scalar, X and B are m by n matrices, A is a unit, or
-    non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
-
-       op( A ) = A   or   op( A ) = A'.
-
-    The matrix X is overwritten on B.
-
-    Parameters
-    ==========
-
-    SIDE   - CHARACTER*1.
-             On entry, SIDE specifies whether op( A ) appears on the left
-             or right of X as follows:
-
-                SIDE = 'L' or 'l'   op( A )*X = alpha*B.
-
-                SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
-
-             Unchanged on exit.
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix A is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANSA - CHARACTER*1.
-             On entry, TRANSA specifies the form of op( A ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSA = 'N' or 'n'   op( A ) = A.
-
-                TRANSA = 'T' or 't'   op( A ) = A'.
-
-                TRANSA = 'C' or 'c'   op( A ) = A'.
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit triangular
-             as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of B. M must be at
-             least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of B.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION.
-             On entry,  ALPHA specifies the scalar  alpha. When  alpha is
-             zero then  A is not referenced and  B need not be set before
-             entry.
-             Unchanged on exit.
-
-    A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
-             when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
-             Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
-             upper triangular part of the array  A must contain the upper
-             triangular matrix  and the strictly lower triangular part of
-             A is not referenced.
-             Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
-             lower triangular part of the array  A must contain the lower
-             triangular matrix  and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u',  the diagonal elements of
-             A  are not referenced either,  but are assumed to be  unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
-             LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
-             then LDA must be at least max( 1, n ).
-             Unchanged on exit.
-
-    B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-             Before entry,  the leading  m by n part of the array  B must
-             contain  the  right-hand  side  matrix  B,  and  on exit  is
-             overwritten by the solution matrix  X.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in  the  calling  (sub)  program.   LDB  must  be  at  least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-
-    /* Function Body */
-    lside = lsame_(side, "L");
-    if (lside) {
-	nrowa = *m;
-    } else {
-	nrowa = *n;
-    }
-    nounit = lsame_(diag, "N");
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! lside && ! lsame_(side, "R"))) {
-	info = 1;
-    } else if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 2;
-    } else if (((! lsame_(transa, "N") && ! lsame_(
-	    transa, "T")) && ! lsame_(transa, "C"))) {
-	info = 3;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 4;
-    } else if (*m < 0) {
-	info = 5;
-    } else if (*n < 0) {
-	info = 6;
-    } else if (*lda < max(1,nrowa)) {
-	info = 9;
-    } else if (*ldb < max(1,*m)) {
-	info = 11;
-    }
-    if (info != 0) {
-	xerbla_("DTRSM ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if (*alpha == 0.) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = *m;
-	    for (i__ = 1; i__ <= i__2; ++i__) {
-		b[i__ + j * b_dim1] = 0.;
-/* L10: */
-	    }
-/* L20: */
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lside) {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*inv( A )*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (*alpha != 1.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
-				    ;
-/* L30: */
-			}
-		    }
-		    for (k = *m; k >= 1; --k) {
-			if (b[k + j * b_dim1] != 0.) {
-			    if (nounit) {
-				b[k + j * b_dim1] /= a[k + k * a_dim1];
-			    }
-			    i__2 = k - 1;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
-					i__ + k * a_dim1];
-/* L40: */
-			    }
-			}
-/* L50: */
-		    }
-/* L60: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (*alpha != 1.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
-				    ;
-/* L70: */
-			}
-		    }
-		    i__2 = *m;
-		    for (k = 1; k <= i__2; ++k) {
-			if (b[k + j * b_dim1] != 0.) {
-			    if (nounit) {
-				b[k + j * b_dim1] /= a[k + k * a_dim1];
-			    }
-			    i__3 = *m;
-			    for (i__ = k + 1; i__ <= i__3; ++i__) {
-				b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
-					i__ + k * a_dim1];
-/* L80: */
-			    }
-			}
-/* L90: */
-		    }
-/* L100: */
-		}
-	    }
-	} else {
-
-/*           Form  B := alpha*inv( A' )*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			temp = *alpha * b[i__ + j * b_dim1];
-			i__3 = i__ - 1;
-			for (k = 1; k <= i__3; ++k) {
-			    temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
-/* L110: */
-			}
-			if (nounit) {
-			    temp /= a[i__ + i__ * a_dim1];
-			}
-			b[i__ + j * b_dim1] = temp;
-/* L120: */
-		    }
-/* L130: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    for (i__ = *m; i__ >= 1; --i__) {
-			temp = *alpha * b[i__ + j * b_dim1];
-			i__2 = *m;
-			for (k = i__ + 1; k <= i__2; ++k) {
-			    temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
-/* L140: */
-			}
-			if (nounit) {
-			    temp /= a[i__ + i__ * a_dim1];
-			}
-			b[i__ + j * b_dim1] = temp;
-/* L150: */
-		    }
-/* L160: */
-		}
-	    }
-	}
-    } else {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*B*inv( A ). */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (*alpha != 1.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
-				    ;
-/* L170: */
-			}
-		    }
-		    i__2 = j - 1;
-		    for (k = 1; k <= i__2; ++k) {
-			if (a[k + j * a_dim1] != 0.) {
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
-					i__ + k * b_dim1];
-/* L180: */
-			    }
-			}
-/* L190: */
-		    }
-		    if (nounit) {
-			temp = 1. / a[j + j * a_dim1];
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
-/* L200: */
-			}
-		    }
-/* L210: */
-		}
-	    } else {
-		for (j = *n; j >= 1; --j) {
-		    if (*alpha != 1.) {
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
-				    ;
-/* L220: */
-			}
-		    }
-		    i__1 = *n;
-		    for (k = j + 1; k <= i__1; ++k) {
-			if (a[k + j * a_dim1] != 0.) {
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
-					i__ + k * b_dim1];
-/* L230: */
-			    }
-			}
-/* L240: */
-		    }
-		    if (nounit) {
-			temp = 1. / a[j + j * a_dim1];
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
-/* L250: */
-			}
-		    }
-/* L260: */
-		}
-	    }
-	} else {
-
-/*           Form  B := alpha*B*inv( A' ). */
-
-	    if (upper) {
-		for (k = *n; k >= 1; --k) {
-		    if (nounit) {
-			temp = 1. / a[k + k * a_dim1];
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
-/* L270: */
-			}
-		    }
-		    i__1 = k - 1;
-		    for (j = 1; j <= i__1; ++j) {
-			if (a[j + k * a_dim1] != 0.) {
-			    temp = a[j + k * a_dim1];
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				b[i__ + j * b_dim1] -= temp * b[i__ + k *
-					b_dim1];
-/* L280: */
-			    }
-			}
-/* L290: */
-		    }
-		    if (*alpha != 1.) {
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
-				    ;
-/* L300: */
-			}
-		    }
-/* L310: */
-		}
-	    } else {
-		i__1 = *n;
-		for (k = 1; k <= i__1; ++k) {
-		    if (nounit) {
-			temp = 1. / a[k + k * a_dim1];
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
-/* L320: */
-			}
-		    }
-		    i__2 = *n;
-		    for (j = k + 1; j <= i__2; ++j) {
-			if (a[j + k * a_dim1] != 0.) {
-			    temp = a[j + k * a_dim1];
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				b[i__ + j * b_dim1] -= temp * b[i__ + k *
-					b_dim1];
-/* L330: */
-			    }
-			}
-/* L340: */
-		    }
-		    if (*alpha != 1.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
-				    ;
-/* L350: */
-			}
-		    }
-/* L360: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of DTRSM . */
-
-} /* dtrsm_ */
-
-doublereal dzasum_(integer *n, doublecomplex *zx, integer *incx)
-{
-    /* System generated locals */
-    integer i__1;
-    doublereal ret_val;
-
-    /* Local variables */
-    static integer i__, ix;
-    static doublereal stemp;
-    extern doublereal dcabs1_(doublecomplex *);
-
-
-/*
-       takes the sum of the absolute values.
-       jack dongarra, 3/11/78.
-       modified 3/93 to return if incx .le. 0.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --zx;
-
-    /* Function Body */
-    ret_val = 0.;
-    stemp = 0.;
-    if (*n <= 0 || *incx <= 0) {
-	return ret_val;
-    }
-    if (*incx == 1) {
-	goto L20;
-    }
-
-/*        code for increment not equal to 1 */
-
-    ix = 1;
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	stemp += dcabs1_(&zx[ix]);
-	ix += *incx;
-/* L10: */
-    }
-    ret_val = stemp;
-    return ret_val;
-
-/*        code for increment equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	stemp += dcabs1_(&zx[i__]);
-/* L30: */
-    }
-    ret_val = stemp;
-    return ret_val;
-} /* dzasum_ */
-
-doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3;
-    doublereal ret_val, d__1;
-
-    /* Builtin functions */
-    double d_imag(doublecomplex *), sqrt(doublereal);
-
-    /* Local variables */
-    static integer ix;
-    static doublereal ssq, temp, norm, scale;
-
-
-/*
-    DZNRM2 returns the euclidean norm of a vector via the function
-    name, so that
-
-       DZNRM2 := sqrt( conjg( x' )*x )
-
-
-    -- This version written on 25-October-1982.
-       Modified on 14-October-1993 to inline the call to ZLASSQ.
-       Sven Hammarling, Nag Ltd.
-*/
-
-
-    /* Parameter adjustments */
-    --x;
-
-    /* Function Body */
-    if (*n < 1 || *incx < 1) {
-	norm = 0.;
-    } else {
-	scale = 0.;
-	ssq = 1.;
-/*
-          The following loop is equivalent to this call to the LAPACK
-          auxiliary routine:
-          CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
-*/
-
-	i__1 = (*n - 1) * *incx + 1;
-	i__2 = *incx;
-	for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
-	    i__3 = ix;
-	    if (x[i__3].r != 0.) {
-		i__3 = ix;
-		temp = (d__1 = x[i__3].r, abs(d__1));
-		if (scale < temp) {
-/* Computing 2nd power */
-		    d__1 = scale / temp;
-		    ssq = ssq * (d__1 * d__1) + 1.;
-		    scale = temp;
-		} else {
-/* Computing 2nd power */
-		    d__1 = temp / scale;
-		    ssq += d__1 * d__1;
-		}
-	    }
-	    if (d_imag(&x[ix]) != 0.) {
-		temp = (d__1 = d_imag(&x[ix]), abs(d__1));
-		if (scale < temp) {
-/* Computing 2nd power */
-		    d__1 = scale / temp;
-		    ssq = ssq * (d__1 * d__1) + 1.;
-		    scale = temp;
-		} else {
-/* Computing 2nd power */
-		    d__1 = temp / scale;
-		    ssq += d__1 * d__1;
-		}
-	    }
-/* L10: */
-	}
-	norm = scale * sqrt(ssq);
-    }
-
-    ret_val = norm;
-    return ret_val;
-
-/*     End of DZNRM2. */
-
-} /* dznrm2_ */
-
-integer idamax_(integer *n, doublereal *dx, integer *incx)
-{
-    /* System generated locals */
-    integer ret_val, i__1;
-    doublereal d__1;
-
-    /* Local variables */
-    static integer i__, ix;
-    static doublereal dmax__;
-
-
-/*
-       finds the index of element having max. absolute value.
-       jack dongarra, linpack, 3/11/78.
-       modified 3/93 to return if incx .le. 0.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --dx;
-
-    /* Function Body */
-    ret_val = 0;
-    if (*n < 1 || *incx <= 0) {
-	return ret_val;
-    }
-    ret_val = 1;
-    if (*n == 1) {
-	return ret_val;
-    }
-    if (*incx == 1) {
-	goto L20;
-    }
-
-/*        code for increment not equal to 1 */
-
-    ix = 1;
-    dmax__ = abs(dx[1]);
-    ix += *incx;
-    i__1 = *n;
-    for (i__ = 2; i__ <= i__1; ++i__) {
-	if ((d__1 = dx[ix], abs(d__1)) <= dmax__) {
-	    goto L5;
-	}
-	ret_val = i__;
-	dmax__ = (d__1 = dx[ix], abs(d__1));
-L5:
-	ix += *incx;
-/* L10: */
-    }
-    return ret_val;
-
-/*        code for increment equal to 1 */
-
-L20:
-    dmax__ = abs(dx[1]);
-    i__1 = *n;
-    for (i__ = 2; i__ <= i__1; ++i__) {
-	if ((d__1 = dx[i__], abs(d__1)) <= dmax__) {
-	    goto L30;
-	}
-	ret_val = i__;
-	dmax__ = (d__1 = dx[i__], abs(d__1));
-L30:
-	;
-    }
-    return ret_val;
-} /* idamax_ */
-
-integer izamax_(integer *n, doublecomplex *zx, integer *incx)
-{
-    /* System generated locals */
-    integer ret_val, i__1;
-
-    /* Local variables */
-    static integer i__, ix;
-    static doublereal smax;
-    extern doublereal dcabs1_(doublecomplex *);
-
-
-/*
-       finds the index of element having max. absolute value.
-       jack dongarra, 1/15/85.
-       modified 3/93 to return if incx .le. 0.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --zx;
-
-    /* Function Body */
-    ret_val = 0;
-    if (*n < 1 || *incx <= 0) {
-	return ret_val;
-    }
-    ret_val = 1;
-    if (*n == 1) {
-	return ret_val;
-    }
-    if (*incx == 1) {
-	goto L20;
-    }
-
-/*        code for increment not equal to 1 */
-
-    ix = 1;
-    smax = dcabs1_(&zx[1]);
-    ix += *incx;
-    i__1 = *n;
-    for (i__ = 2; i__ <= i__1; ++i__) {
-	if (dcabs1_(&zx[ix]) <= smax) {
-	    goto L5;
-	}
-	ret_val = i__;
-	smax = dcabs1_(&zx[ix]);
-L5:
-	ix += *incx;
-/* L10: */
-    }
-    return ret_val;
-
-/*        code for increment equal to 1 */
-
-L20:
-    smax = dcabs1_(&zx[1]);
-    i__1 = *n;
-    for (i__ = 2; i__ <= i__1; ++i__) {
-	if (dcabs1_(&zx[i__]) <= smax) {
-	    goto L30;
-	}
-	ret_val = i__;
-	smax = dcabs1_(&zx[i__]);
-L30:
-	;
-    }
-    return ret_val;
-} /* izamax_ */
-
-logical lsame_(char *ca, char *cb)
-{
-    /* System generated locals */
-    logical ret_val;
-
-    /* Local variables */
-    static integer inta, intb, zcode;
-
-
-/*
-    -- LAPACK auxiliary 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
-    =======
-
-    LSAME returns .TRUE. if CA is the same letter as CB regardless of
-    case.
-
-    Arguments
-    =========
-
-    CA      (input) CHARACTER*1
-    CB      (input) CHARACTER*1
-            CA and CB specify the single characters to be compared.
-
-   =====================================================================
-
-
-       Test if the characters are equal
-*/
-
-    ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
-    if (ret_val) {
-	return ret_val;
-    }
-
-/*     Now test for equivalence if both characters are alphabetic. */
-
-    zcode = 'Z';
-
-/*
-       Use 'Z' rather than 'A' so that ASCII can be detected on Prime
-       machines, on which ICHAR returns a value with bit 8 set.
-       ICHAR('A') on Prime machines returns 193 which is the same as
-       ICHAR('A') on an EBCDIC machine.
-*/
-
-    inta = *(unsigned char *)ca;
-    intb = *(unsigned char *)cb;
-
-    if (zcode == 90 || zcode == 122) {
-
-/*
-          ASCII is assumed - ZCODE is the ASCII code of either lower or
-          upper case 'Z'.
-*/
-
-	if ((inta >= 97 && inta <= 122)) {
-	    inta += -32;
-	}
-	if ((intb >= 97 && intb <= 122)) {
-	    intb += -32;
-	}
-
-    } else if (zcode == 233 || zcode == 169) {
-
-/*
-          EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
-          upper case 'Z'.
-*/
-
-	if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (
-		inta >= 162 && inta <= 169)) {
-	    inta += 64;
-	}
-	if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (
-		intb >= 162 && intb <= 169)) {
-	    intb += 64;
-	}
-
-    } else if (zcode == 218 || zcode == 250) {
-
-/*
-          ASCII is assumed, on Prime machines - ZCODE is the ASCII code
-          plus 128 of either lower or upper case 'Z'.
-*/
-
-	if ((inta >= 225 && inta <= 250)) {
-	    inta += -32;
-	}
-	if ((intb >= 225 && intb <= 250)) {
-	    intb += -32;
-	}
-    }
-    ret_val = inta == intb;
-
-/*
-       RETURN
-
-       End of LSAME
-*/
-
-    return ret_val;
-} /* lsame_ */
-
-/* Using xerbla_ from pythonxerbla.c */
-/* Subroutine */ int xerbla_DISABLE(char *srname, integer *info)
-{
-    /* Format strings */
-    static char fmt_9999[] = "(\002 ** On entry to \002,a6,\002 parameter nu"
-	    "mber \002,i2,\002 had \002,\002an illegal value\002)";
-
-    /* Builtin functions */
-    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
-    /* Subroutine */ int s_stop(char *, ftnlen);
-
-    /* Fortran I/O blocks */
-    static cilist io___147 = { 0, 6, 0, fmt_9999, 0 };
-
-
-/*
-    -- LAPACK auxiliary routine (preliminary version) --
-       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-       Courant Institute, Argonne National Lab, and Rice University
-       February 29, 1992
-
-
-    Purpose
-    =======
-
-    XERBLA  is an error handler for the LAPACK routines.
-    It is called by an LAPACK routine if an input parameter has an
-    invalid value.  A message is printed and execution stops.
-
-    Installers may consider modifying the STOP statement in order to
-    call system-specific exception-handling facilities.
-
-    Arguments
-    =========
-
-    SRNAME  (input) CHARACTER*6
-            The name of the routine which called XERBLA.
-
-    INFO    (input) INTEGER
-            The position of the invalid parameter in the parameter list
-            of the calling routine.
-*/
-
-
-    s_wsfe(&io___147);
-    do_fio(&c__1, srname, (ftnlen)6);
-    do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
-    e_wsfe();
-
-    s_stop("", (ftnlen)0);
-
-
-/*     End of XERBLA */
-
-    return 0;
-} /* xerbla_ */
-
-/* Subroutine */ int zaxpy_(integer *n, doublecomplex *za, doublecomplex *zx,
-	integer *incx, doublecomplex *zy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3, i__4;
-    doublecomplex z__1, z__2;
-
-    /* Local variables */
-    static integer i__, ix, iy;
-    extern doublereal dcabs1_(doublecomplex *);
-
-
-/*
-       constant times a vector plus a vector.
-       jack dongarra, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-    /* Parameter adjustments */
-    --zy;
-    --zx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if (dcabs1_(za) == 0.) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = iy;
-	i__3 = iy;
-	i__4 = ix;
-	z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[
-		i__4].i + za->i * zx[i__4].r;
-	z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;
-	zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*        code for both increments equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = i__;
-	i__3 = i__;
-	i__4 = i__;
-	z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[
-		i__4].i + za->i * zx[i__4].r;
-	z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;
-	zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;
-/* L30: */
-    }
-    return 0;
-} /* zaxpy_ */
-
-/* Subroutine */ int zcopy_(integer *n, doublecomplex *zx, integer *incx,
-	doublecomplex *zy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3;
-
-    /* Local variables */
-    static integer i__, ix, iy;
-
-
-/*
-       copies a vector, x, to a vector, y.
-       jack dongarra, linpack, 4/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --zy;
-    --zx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = iy;
-	i__3 = ix;
-	zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*        code for both increments equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = i__;
-	i__3 = i__;
-	zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
-/* L30: */
-    }
-    return 0;
-} /* zcopy_ */
-
-/* Double Complex */ VOID zdotc_(doublecomplex * ret_val, integer *n,
-	doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1, i__2;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, ix, iy;
-    static doublecomplex ztemp;
-
-
-/*
-       forms the dot product of a vector.
-       jack dongarra, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-    /* Parameter adjustments */
-    --zy;
-    --zx;
-
-    /* Function Body */
-    ztemp.r = 0., ztemp.i = 0.;
-     ret_val->r = 0.,  ret_val->i = 0.;
-    if (*n <= 0) {
-	return ;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	d_cnjg(&z__3, &zx[ix]);
-	i__2 = iy;
-	z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r *
-		zy[i__2].i + z__3.i * zy[i__2].r;
-	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
-	ztemp.r = z__1.r, ztemp.i = z__1.i;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
-    return ;
-
-/*        code for both increments equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	d_cnjg(&z__3, &zx[i__]);
-	i__2 = i__;
-	z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r *
-		zy[i__2].i + z__3.i * zy[i__2].r;
-	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
-	ztemp.r = z__1.r, ztemp.i = z__1.i;
-/* L30: */
-    }
-     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
-    return ;
-} /* zdotc_ */
-
-/* Double Complex */ VOID zdotu_(doublecomplex * ret_val, integer *n,
-	doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3;
-    doublecomplex z__1, z__2;
-
-    /* Local variables */
-    static integer i__, ix, iy;
-    static doublecomplex ztemp;
-
-
-/*
-       forms the dot product of two vectors.
-       jack dongarra, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-    /* Parameter adjustments */
-    --zy;
-    --zx;
-
-    /* Function Body */
-    ztemp.r = 0., ztemp.i = 0.;
-     ret_val->r = 0.,  ret_val->i = 0.;
-    if (*n <= 0) {
-	return ;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-          code for unequal increments or equal increments
-            not equal to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = ix;
-	i__3 = iy;
-	z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i =
-		zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;
-	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
-	ztemp.r = z__1.r, ztemp.i = z__1.i;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
-    return ;
-
-/*        code for both increments equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = i__;
-	i__3 = i__;
-	z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i =
-		zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;
-	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
-	ztemp.r = z__1.r, ztemp.i = z__1.i;
-/* L30: */
-    }
-     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
-    return ;
-} /* zdotu_ */
-
-/* Subroutine */ int zdscal_(integer *n, doublereal *da, doublecomplex *zx,
-	integer *incx)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3;
-    doublecomplex z__1, z__2;
-
-    /* Local variables */
-    static integer i__, ix;
-
-
-/*
-       scales a vector by a constant.
-       jack dongarra, 3/11/78.
-       modified 3/93 to return if incx .le. 0.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --zx;
-
-    /* Function Body */
-    if (*n <= 0 || *incx <= 0) {
-	return 0;
-    }
-    if (*incx == 1) {
-	goto L20;
-    }
-
-/*        code for increment not equal to 1 */
-
-    ix = 1;
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = ix;
-	z__2.r = *da, z__2.i = 0.;
-	i__3 = ix;
-	z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r *
-		zx[i__3].i + z__2.i * zx[i__3].r;
-	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
-	ix += *incx;
-/* L10: */
-    }
-    return 0;
-
-/*        code for increment equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = i__;
-	z__2.r = *da, z__2.i = 0.;
-	i__3 = i__;
-	z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r *
-		zx[i__3].i + z__2.i * zx[i__3].r;
-	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
-/* L30: */
-    }
-    return 0;
-} /* zdscal_ */
-
-/* Subroutine */ int zgemm_(char *transa, char *transb, integer *m, integer *
-	n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,
-	doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex *
-	c__, integer *ldc)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
-	    i__3, i__4, i__5, i__6;
-    doublecomplex z__1, z__2, z__3, z__4;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, l, info;
-    static logical nota, notb;
-    static doublecomplex temp;
-    static logical conja, conjb;
-    static integer ncola;
-    extern logical lsame_(char *, char *);
-    static integer nrowa, nrowb;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZGEMM  performs one of the matrix-matrix operations
-
-       C := alpha*op( A )*op( B ) + beta*C,
-
-    where  op( X ) is one of
-
-       op( X ) = X   or   op( X ) = X'   or   op( X ) = conjg( X' ),
-
-    alpha and beta are scalars, and A, B and C are matrices, with op( A )
-    an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
-
-    Parameters
-    ==========
-
-    TRANSA - CHARACTER*1.
-             On entry, TRANSA specifies the form of op( A ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSA = 'N' or 'n',  op( A ) = A.
-
-                TRANSA = 'T' or 't',  op( A ) = A'.
-
-                TRANSA = 'C' or 'c',  op( A ) = conjg( A' ).
-
-             Unchanged on exit.
-
-    TRANSB - CHARACTER*1.
-             On entry, TRANSB specifies the form of op( B ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSB = 'N' or 'n',  op( B ) = B.
-
-                TRANSB = 'T' or 't',  op( B ) = B'.
-
-                TRANSB = 'C' or 'c',  op( B ) = conjg( B' ).
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry,  M  specifies  the number  of rows  of the  matrix
-             op( A )  and of the  matrix  C.  M  must  be at least  zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry,  N  specifies the number  of columns of the matrix
-             op( B ) and the number of columns of the matrix C. N must be
-             at least zero.
-             Unchanged on exit.
-
-    K      - INTEGER.
-             On entry,  K  specifies  the number of columns of the matrix
-             op( A ) and the number of rows of the matrix op( B ). K must
-             be at least  zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
-             k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
-             Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
-             part of the array  A  must contain the matrix  A,  otherwise
-             the leading  k by m  part of the array  A  must contain  the
-             matrix A.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. When  TRANSA = 'N' or 'n' then
-             LDA must be at least  max( 1, m ), otherwise  LDA must be at
-             least  max( 1, k ).
-             Unchanged on exit.
-
-    B      - COMPLEX*16       array of DIMENSION ( LDB, kb ), where kb is
-             n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
-             Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
-             part of the array  B  must contain the matrix  B,  otherwise
-             the leading  n by k  part of the array  B  must contain  the
-             matrix B.
-             Unchanged on exit.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in the calling (sub) program. When  TRANSB = 'N' or 'n' then
-             LDB must be at least  max( 1, k ), otherwise  LDB must be at
-             least  max( 1, n ).
-             Unchanged on exit.
-
-    BETA   - COMPLEX*16      .
-             On entry,  BETA  specifies the scalar  beta.  When  BETA  is
-             supplied as zero then C need not be set on input.
-             Unchanged on exit.
-
-    C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
-             Before entry, the leading  m by n  part of the array  C must
-             contain the matrix  C,  except when  beta  is zero, in which
-             case C need not be set on entry.
-             On exit, the array  C  is overwritten by the  m by n  matrix
-             ( alpha*op( A )*op( B ) + beta*C ).
-
-    LDC    - INTEGER.
-             On entry, LDC specifies the first dimension of C as declared
-             in  the  calling  (sub)  program.   LDC  must  be  at  least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
-       conjugated or transposed, set  CONJA and CONJB  as true if  A  and
-       B  respectively are to be  transposed but  not conjugated  and set
-       NROWA, NCOLA and  NROWB  as the number of rows and  columns  of  A
-       and the number of rows of  B  respectively.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-    c_dim1 = *ldc;
-    c_offset = 1 + c_dim1 * 1;
-    c__ -= c_offset;
-
-    /* Function Body */
-    nota = lsame_(transa, "N");
-    notb = lsame_(transb, "N");
-    conja = lsame_(transa, "C");
-    conjb = lsame_(transb, "C");
-    if (nota) {
-	nrowa = *m;
-	ncola = *k;
-    } else {
-	nrowa = *k;
-	ncola = *m;
-    }
-    if (notb) {
-	nrowb = *k;
-    } else {
-	nrowb = *n;
-    }
-
-/*     Test the input parameters. */
-
-    info = 0;
-    if (((! nota && ! conja) && ! lsame_(transa, "T")))
-	    {
-	info = 1;
-    } else if (((! notb && ! conjb) && ! lsame_(transb, "T"))) {
-	info = 2;
-    } else if (*m < 0) {
-	info = 3;
-    } else if (*n < 0) {
-	info = 4;
-    } else if (*k < 0) {
-	info = 5;
-    } else if (*lda < max(1,nrowa)) {
-	info = 8;
-    } else if (*ldb < max(1,nrowb)) {
-	info = 10;
-    } else if (*ldc < max(1,*m)) {
-	info = 13;
-    }
-    if (info != 0) {
-	xerbla_("ZGEMM ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || (((alpha->r == 0. && alpha->i == 0.) || *k == 0)
-	     && ((beta->r == 1. && beta->i == 0.)))) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if ((alpha->r == 0. && alpha->i == 0.)) {
-	if ((beta->r == 0. && beta->i == 0.)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__ + j * c_dim1;
-		    c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L10: */
-		}
-/* L20: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__ + j * c_dim1;
-		    i__4 = i__ + j * c_dim1;
-		    z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4].i,
-			    z__1.i = beta->r * c__[i__4].i + beta->i * c__[
-			    i__4].r;
-		    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L30: */
-		}
-/* L40: */
-	    }
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (notb) {
-	if (nota) {
-
-/*           Form  C := alpha*A*B + beta*C. */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if ((beta->r == 0. && beta->i == 0.)) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L50: */
-		    }
-		} else if (beta->r != 1. || beta->i != 0.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__1.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L60: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = l + j * b_dim1;
-		    if (b[i__3].r != 0. || b[i__3].i != 0.) {
-			i__3 = l + j * b_dim1;
-			z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
-				z__1.i = alpha->r * b[i__3].i + alpha->i * b[
-				i__3].r;
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__3 = *m;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
-				    z__2.i = temp.r * a[i__6].i + temp.i * a[
-				    i__6].r;
-			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
-				    .i + z__2.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L70: */
-			}
-		    }
-/* L80: */
-		}
-/* L90: */
-	    }
-	} else if (conja) {
-
-/*           Form  C := alpha*conjg( A' )*B + beta*C. */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			i__4 = l + j * b_dim1;
-			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
-				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
-				.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L100: */
-		    }
-		    if ((beta->r == 0. && beta->i == 0.)) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__2.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L110: */
-		}
-/* L120: */
-	    }
-	} else {
-
-/*           Form  C := alpha*A'*B + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			i__4 = l + i__ * a_dim1;
-			i__5 = l + j * b_dim1;
-			z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]
-				.i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]
-				.i * b[i__5].r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L130: */
-		    }
-		    if ((beta->r == 0. && beta->i == 0.)) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__2.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L140: */
-		}
-/* L150: */
-	    }
-	}
-    } else if (nota) {
-	if (conjb) {
-
-/*           Form  C := alpha*A*conjg( B' ) + beta*C. */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if ((beta->r == 0. && beta->i == 0.)) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L160: */
-		    }
-		} else if (beta->r != 1. || beta->i != 0.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__1.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L170: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = j + l * b_dim1;
-		    if (b[i__3].r != 0. || b[i__3].i != 0.) {
-			d_cnjg(&z__2, &b[j + l * b_dim1]);
-			z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
-				z__1.i = alpha->r * z__2.i + alpha->i *
-				z__2.r;
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__3 = *m;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
-				    z__2.i = temp.r * a[i__6].i + temp.i * a[
-				    i__6].r;
-			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
-				    .i + z__2.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L180: */
-			}
-		    }
-/* L190: */
-		}
-/* L200: */
-	    }
-	} else {
-
-/*           Form  C := alpha*A*B'          + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if ((beta->r == 0. && beta->i == 0.)) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L210: */
-		    }
-		} else if (beta->r != 1. || beta->i != 0.) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__1.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L220: */
-		    }
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = j + l * b_dim1;
-		    if (b[i__3].r != 0. || b[i__3].i != 0.) {
-			i__3 = j + l * b_dim1;
-			z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
-				z__1.i = alpha->r * b[i__3].i + alpha->i * b[
-				i__3].r;
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__3 = *m;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
-				    z__2.i = temp.r * a[i__6].i + temp.i * a[
-				    i__6].r;
-			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
-				    .i + z__2.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L230: */
-			}
-		    }
-/* L240: */
-		}
-/* L250: */
-	    }
-	}
-    } else if (conja) {
-	if (conjb) {
-
-/*           Form  C := alpha*conjg( A' )*conjg( B' ) + beta*C. */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			d_cnjg(&z__4, &b[j + l * b_dim1]);
-			z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i =
-				z__3.r * z__4.i + z__3.i * z__4.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L260: */
-		    }
-		    if ((beta->r == 0. && beta->i == 0.)) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__2.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L270: */
-		}
-/* L280: */
-	    }
-	} else {
-
-/*           Form  C := alpha*conjg( A' )*B' + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			i__4 = j + l * b_dim1;
-			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
-				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
-				.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L290: */
-		    }
-		    if ((beta->r == 0. && beta->i == 0.)) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__2.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L300: */
-		}
-/* L310: */
-	    }
-	}
-    } else {
-	if (conjb) {
-
-/*           Form  C := alpha*A'*conjg( B' ) + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			i__4 = l + i__ * a_dim1;
-			d_cnjg(&z__3, &b[j + l * b_dim1]);
-			z__2.r = a[i__4].r * z__3.r - a[i__4].i * z__3.i,
-				z__2.i = a[i__4].r * z__3.i + a[i__4].i *
-				z__3.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L320: */
-		    }
-		    if ((beta->r == 0. && beta->i == 0.)) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__2.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L330: */
-		}
-/* L340: */
-	    }
-	} else {
-
-/*           Form  C := alpha*A'*B' + beta*C */
-
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			i__4 = l + i__ * a_dim1;
-			i__5 = j + l * b_dim1;
-			z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]
-				.i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]
-				.i * b[i__5].r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L350: */
-		    }
-		    if ((beta->r == 0. && beta->i == 0.)) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__2.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
-				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
-				 c__[i__4].r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L360: */
-		}
-/* L370: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZGEMM . */
-
-} /* zgemm_ */
-
-/* Subroutine */ int zgemv_(char *trans, integer *m, integer *n,
-	doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
-	x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *
-	incy)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, ix, iy, jx, jy, kx, ky, info;
-    static doublecomplex temp;
-    static integer lenx, leny;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical noconj;
-
-
-/*
-    Purpose
-    =======
-
-    ZGEMV  performs one of the matrix-vector operations
-
-       y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
-
-       y := alpha*conjg( A' )*x + beta*y,
-
-    where alpha and beta are scalars, x and y are vectors and A is an
-    m by n matrix.
-
-    Parameters
-    ==========
-
-    TRANS  - CHARACTER*1.
-             On entry, TRANS specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
-
-                TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
-
-                TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of the matrix A.
-             M must be at least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry, the leading m by n part of the array A must
-             contain the matrix of coefficients.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, m ).
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of DIMENSION at least
-             ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-             and at least
-             ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-             Before entry, the incremented array X must contain the
-             vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    BETA   - COMPLEX*16      .
-             On entry, BETA specifies the scalar beta. When BETA is
-             supplied as zero then Y need not be set on input.
-             Unchanged on exit.
-
-    Y      - COMPLEX*16       array of DIMENSION at least
-             ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-             and at least
-             ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-             Before entry with BETA non-zero, the incremented array Y
-             must contain the vector y. On exit, Y is overwritten by the
-             updated vector y.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-    --y;
-
-    /* Function Body */
-    info = 0;
-    if (((! lsame_(trans, "N") && ! lsame_(trans, "T")) && ! lsame_(trans, "C"))) {
-	info = 1;
-    } else if (*m < 0) {
-	info = 2;
-    } else if (*n < 0) {
-	info = 3;
-    } else if (*lda < max(1,*m)) {
-	info = 6;
-    } else if (*incx == 0) {
-	info = 8;
-    } else if (*incy == 0) {
-	info = 11;
-    }
-    if (info != 0) {
-	xerbla_("ZGEMV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || ((alpha->r == 0. && alpha->i == 0.) && ((
-	    beta->r == 1. && beta->i == 0.)))) {
-	return 0;
-    }
-
-    noconj = lsame_(trans, "T");
-
-/*
-       Set  LENX  and  LENY, the lengths of the vectors x and y, and set
-       up the start points in  X  and  Y.
-*/
-
-    if (lsame_(trans, "N")) {
-	lenx = *n;
-	leny = *m;
-    } else {
-	lenx = *m;
-	leny = *n;
-    }
-    if (*incx > 0) {
-	kx = 1;
-    } else {
-	kx = 1 - (lenx - 1) * *incx;
-    }
-    if (*incy > 0) {
-	ky = 1;
-    } else {
-	ky = 1 - (leny - 1) * *incy;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-
-       First form  y := beta*y.
-*/
-
-    if (beta->r != 1. || beta->i != 0.) {
-	if (*incy == 1) {
-	    if ((beta->r == 0. && beta->i == 0.)) {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = i__;
-		    y[i__2].r = 0., y[i__2].i = 0.;
-/* L10: */
-		}
-	    } else {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = i__;
-		    i__3 = i__;
-		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
-			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
-			    .r;
-		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-/* L20: */
-		}
-	    }
-	} else {
-	    iy = ky;
-	    if ((beta->r == 0. && beta->i == 0.)) {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = iy;
-		    y[i__2].r = 0., y[i__2].i = 0.;
-		    iy += *incy;
-/* L30: */
-		}
-	    } else {
-		i__1 = leny;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = iy;
-		    i__3 = iy;
-		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
-			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
-			    .r;
-		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		    iy += *incy;
-/* L40: */
-		}
-	    }
-	}
-    }
-    if ((alpha->r == 0. && alpha->i == 0.)) {
-	return 0;
-    }
-    if (lsame_(trans, "N")) {
-
-/*        Form  y := alpha*A*x + y. */
-
-	jx = kx;
-	if (*incy == 1) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = jx;
-		if (x[i__2].r != 0. || x[i__2].i != 0.) {
-		    i__2 = jx;
-		    z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
-			    z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
-			    .r;
-		    temp.r = z__1.r, temp.i = z__1.i;
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__;
-			i__4 = i__;
-			i__5 = i__ + j * a_dim1;
-			z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
-				.r;
-			z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i +
-				z__2.i;
-			y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-/* L50: */
-		    }
-		}
-		jx += *incx;
-/* L60: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = jx;
-		if (x[i__2].r != 0. || x[i__2].i != 0.) {
-		    i__2 = jx;
-		    z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
-			    z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
-			    .r;
-		    temp.r = z__1.r, temp.i = z__1.i;
-		    iy = ky;
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = iy;
-			i__4 = iy;
-			i__5 = i__ + j * a_dim1;
-			z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
-				.r;
-			z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i +
-				z__2.i;
-			y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-			iy += *incy;
-/* L70: */
-		    }
-		}
-		jx += *incx;
-/* L80: */
-	    }
-	}
-    } else {
-
-/*        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y. */
-
-	jy = ky;
-	if (*incx == 1) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp.r = 0., temp.i = 0.;
-		if (noconj) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * a_dim1;
-			i__4 = i__;
-			z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
-				.i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]
-				.i * x[i__4].r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L90: */
-		    }
-		} else {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			i__3 = i__;
-			z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
-				z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
-				.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L100: */
-		    }
-		}
-		i__2 = jy;
-		i__3 = jy;
-		z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i =
-			alpha->r * temp.i + alpha->i * temp.r;
-		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		jy += *incy;
-/* L110: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		temp.r = 0., temp.i = 0.;
-		ix = kx;
-		if (noconj) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * a_dim1;
-			i__4 = ix;
-			z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
-				.i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]
-				.i * x[i__4].r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-			ix += *incx;
-/* L120: */
-		    }
-		} else {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			i__3 = ix;
-			z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
-				z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
-				.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-			ix += *incx;
-/* L130: */
-		    }
-		}
-		i__2 = jy;
-		i__3 = jy;
-		z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i =
-			alpha->r * temp.i + alpha->i * temp.r;
-		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		jy += *incy;
-/* L140: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZGEMV . */
-
-} /* zgemv_ */
-
-/* Subroutine */ int zgerc_(integer *m, integer *n, doublecomplex *alpha,
-	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
-	doublecomplex *a, integer *lda)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
-    doublecomplex z__1, z__2;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, ix, jy, kx, info;
-    static doublecomplex temp;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZGERC  performs the rank 1 operation
-
-       A := alpha*x*conjg( y' ) + A,
-
-    where alpha is a scalar, x is an m element vector, y is an n element
-    vector and A is an m by n matrix.
-
-    Parameters
-    ==========
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of the matrix A.
-             M must be at least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of dimension at least
-             ( 1 + ( m - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the m
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    Y      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y.
-             Unchanged on exit.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry, the leading m by n part of the array A must
-             contain the matrix of coefficients. On exit, A is
-             overwritten by the updated matrix.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    --x;
-    --y;
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-
-    /* Function Body */
-    info = 0;
-    if (*m < 0) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*incx == 0) {
-	info = 5;
-    } else if (*incy == 0) {
-	info = 7;
-    } else if (*lda < max(1,*m)) {
-	info = 9;
-    }
-    if (info != 0) {
-	xerbla_("ZGERC ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
-	return 0;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-*/
-
-    if (*incy > 0) {
-	jy = 1;
-    } else {
-	jy = 1 - (*n - 1) * *incy;
-    }
-    if (*incx == 1) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = jy;
-	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
-		d_cnjg(&z__2, &y[jy]);
-		z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
-			alpha->r * z__2.i + alpha->i * z__2.r;
-		temp.r = z__1.r, temp.i = z__1.i;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__ + j * a_dim1;
-		    i__4 = i__ + j * a_dim1;
-		    i__5 = i__;
-		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
-			     x[i__5].r * temp.i + x[i__5].i * temp.r;
-		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
-		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-/* L10: */
-		}
-	    }
-	    jy += *incy;
-/* L20: */
-	}
-    } else {
-	if (*incx > 0) {
-	    kx = 1;
-	} else {
-	    kx = 1 - (*m - 1) * *incx;
-	}
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = jy;
-	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
-		d_cnjg(&z__2, &y[jy]);
-		z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
-			alpha->r * z__2.i + alpha->i * z__2.r;
-		temp.r = z__1.r, temp.i = z__1.i;
-		ix = kx;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__ + j * a_dim1;
-		    i__4 = i__ + j * a_dim1;
-		    i__5 = ix;
-		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
-			     x[i__5].r * temp.i + x[i__5].i * temp.r;
-		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
-		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-		    ix += *incx;
-/* L30: */
-		}
-	    }
-	    jy += *incy;
-/* L40: */
-	}
-    }
-
-    return 0;
-
-/*     End of ZGERC . */
-
-} /* zgerc_ */
-
-/* Subroutine */ int zgeru_(integer *m, integer *n, doublecomplex *alpha,
-	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
-	doublecomplex *a, integer *lda)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
-    doublecomplex z__1, z__2;
-
-    /* Local variables */
-    static integer i__, j, ix, jy, kx, info;
-    static doublecomplex temp;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZGERU  performs the rank 1 operation
-
-       A := alpha*x*y' + A,
-
-    where alpha is a scalar, x is an m element vector, y is an n element
-    vector and A is an m by n matrix.
-
-    Parameters
-    ==========
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of the matrix A.
-             M must be at least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of dimension at least
-             ( 1 + ( m - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the m
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    Y      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y.
-             Unchanged on exit.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry, the leading m by n part of the array A must
-             contain the matrix of coefficients. On exit, A is
-             overwritten by the updated matrix.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    --x;
-    --y;
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-
-    /* Function Body */
-    info = 0;
-    if (*m < 0) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*incx == 0) {
-	info = 5;
-    } else if (*incy == 0) {
-	info = 7;
-    } else if (*lda < max(1,*m)) {
-	info = 9;
-    }
-    if (info != 0) {
-	xerbla_("ZGERU ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
-	return 0;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-*/
-
-    if (*incy > 0) {
-	jy = 1;
-    } else {
-	jy = 1 - (*n - 1) * *incy;
-    }
-    if (*incx == 1) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = jy;
-	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
-		i__2 = jy;
-		z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =
-			 alpha->r * y[i__2].i + alpha->i * y[i__2].r;
-		temp.r = z__1.r, temp.i = z__1.i;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__ + j * a_dim1;
-		    i__4 = i__ + j * a_dim1;
-		    i__5 = i__;
-		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
-			     x[i__5].r * temp.i + x[i__5].i * temp.r;
-		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
-		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-/* L10: */
-		}
-	    }
-	    jy += *incy;
-/* L20: */
-	}
-    } else {
-	if (*incx > 0) {
-	    kx = 1;
-	} else {
-	    kx = 1 - (*m - 1) * *incx;
-	}
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = jy;
-	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
-		i__2 = jy;
-		z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =
-			 alpha->r * y[i__2].i + alpha->i * y[i__2].r;
-		temp.r = z__1.r, temp.i = z__1.i;
-		ix = kx;
-		i__2 = *m;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__ + j * a_dim1;
-		    i__4 = i__ + j * a_dim1;
-		    i__5 = ix;
-		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
-			     x[i__5].r * temp.i + x[i__5].i * temp.r;
-		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
-		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-		    ix += *incx;
-/* L30: */
-		}
-	    }
-	    jy += *incy;
-/* L40: */
-	}
-    }
-
-    return 0;
-
-/*     End of ZGERU . */
-
-} /* zgeru_ */
-
-/* Subroutine */ int zhemv_(char *uplo, integer *n, doublecomplex *alpha,
-	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
-	doublecomplex *beta, doublecomplex *y, integer *incy)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
-    doublereal d__1;
-    doublecomplex z__1, z__2, z__3, z__4;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, ix, iy, jx, jy, kx, ky, info;
-    static doublecomplex temp1, temp2;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZHEMV  performs the matrix-vector  operation
-
-       y := alpha*A*x + beta*y,
-
-    where alpha and beta are scalars, x and y are n element vectors and
-    A is an n by n hermitian matrix.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the upper or lower
-             triangular part of the array A is to be referenced as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the upper triangular part of A
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the lower triangular part of A
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular part of the hermitian matrix and the strictly
-             lower triangular part of A is not referenced.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular part of the hermitian matrix and the strictly
-             upper triangular part of A is not referenced.
-             Note that the imaginary parts of the diagonal elements need
-             not be set and are assumed to be zero.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    BETA   - COMPLEX*16      .
-             On entry, BETA specifies the scalar beta. When BETA is
-             supplied as zero then Y need not be set on input.
-             Unchanged on exit.
-
-    Y      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y. On exit, Y is overwritten by the updated
-             vector y.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-    --y;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*lda < max(1,*n)) {
-	info = 5;
-    } else if (*incx == 0) {
-	info = 7;
-    } else if (*incy == 0) {
-	info = 10;
-    }
-    if (info != 0) {
-	xerbla_("ZHEMV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || ((alpha->r == 0. && alpha->i == 0.) && ((beta->r == 1. &&
-	    beta->i == 0.)))) {
-	return 0;
-    }
-
-/*     Set up the start points in  X  and  Y. */
-
-    if (*incx > 0) {
-	kx = 1;
-    } else {
-	kx = 1 - (*n - 1) * *incx;
-    }
-    if (*incy > 0) {
-	ky = 1;
-    } else {
-	ky = 1 - (*n - 1) * *incy;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through the triangular part
-       of A.
-
-       First form  y := beta*y.
-*/
-
-    if (beta->r != 1. || beta->i != 0.) {
-	if (*incy == 1) {
-	    if ((beta->r == 0. && beta->i == 0.)) {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = i__;
-		    y[i__2].r = 0., y[i__2].i = 0.;
-/* L10: */
-		}
-	    } else {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = i__;
-		    i__3 = i__;
-		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
-			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
-			    .r;
-		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-/* L20: */
-		}
-	    }
-	} else {
-	    iy = ky;
-	    if ((beta->r == 0. && beta->i == 0.)) {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = iy;
-		    y[i__2].r = 0., y[i__2].i = 0.;
-		    iy += *incy;
-/* L30: */
-		}
-	    } else {
-		i__1 = *n;
-		for (i__ = 1; i__ <= i__1; ++i__) {
-		    i__2 = iy;
-		    i__3 = iy;
-		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
-			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
-			    .r;
-		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		    iy += *incy;
-/* L40: */
-		}
-	    }
-	}
-    }
-    if ((alpha->r == 0. && alpha->i == 0.)) {
-	return 0;
-    }
-    if (lsame_(uplo, "U")) {
-
-/*        Form  y  when A is stored in upper triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
-			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
-		temp1.r = z__1.r, temp1.i = z__1.i;
-		temp2.r = 0., temp2.i = 0.;
-		i__2 = j - 1;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = i__;
-		    i__4 = i__;
-		    i__5 = i__ + j * a_dim1;
-		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
-			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
-			    .r;
-		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
-		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-		    i__3 = i__;
-		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
-			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
-		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-/* L50: */
-		}
-		i__2 = j;
-		i__3 = j;
-		i__4 = j + j * a_dim1;
-		d__1 = a[i__4].r;
-		z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
-		z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
-		z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
-			alpha->r * temp2.i + alpha->i * temp2.r;
-		z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-/* L60: */
-	    }
-	} else {
-	    jx = kx;
-	    jy = ky;
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = jx;
-		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
-			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
-		temp1.r = z__1.r, temp1.i = z__1.i;
-		temp2.r = 0., temp2.i = 0.;
-		ix = kx;
-		iy = ky;
-		i__2 = j - 1;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    i__3 = iy;
-		    i__4 = iy;
-		    i__5 = i__ + j * a_dim1;
-		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
-			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
-			    .r;
-		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
-		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-		    i__3 = ix;
-		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
-			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
-		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-		    ix += *incx;
-		    iy += *incy;
-/* L70: */
-		}
-		i__2 = jy;
-		i__3 = jy;
-		i__4 = j + j * a_dim1;
-		d__1 = a[i__4].r;
-		z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
-		z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
-		z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
-			alpha->r * temp2.i + alpha->i * temp2.r;
-		z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		jx += *incx;
-		jy += *incy;
-/* L80: */
-	    }
-	}
-    } else {
-
-/*        Form  y  when A is stored in lower triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
-			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
-		temp1.r = z__1.r, temp1.i = z__1.i;
-		temp2.r = 0., temp2.i = 0.;
-		i__2 = j;
-		i__3 = j;
-		i__4 = j + j * a_dim1;
-		d__1 = a[i__4].r;
-		z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
-		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		i__2 = *n;
-		for (i__ = j + 1; i__ <= i__2; ++i__) {
-		    i__3 = i__;
-		    i__4 = i__;
-		    i__5 = i__ + j * a_dim1;
-		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
-			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
-			    .r;
-		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
-		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-		    i__3 = i__;
-		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
-			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
-		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-/* L90: */
-		}
-		i__2 = j;
-		i__3 = j;
-		z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
-			alpha->r * temp2.i + alpha->i * temp2.r;
-		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-/* L100: */
-	    }
-	} else {
-	    jx = kx;
-	    jy = ky;
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = jx;
-		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
-			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
-		temp1.r = z__1.r, temp1.i = z__1.i;
-		temp2.r = 0., temp2.i = 0.;
-		i__2 = jy;
-		i__3 = jy;
-		i__4 = j + j * a_dim1;
-		d__1 = a[i__4].r;
-		z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
-		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		ix = jx;
-		iy = jy;
-		i__2 = *n;
-		for (i__ = j + 1; i__ <= i__2; ++i__) {
-		    ix += *incx;
-		    iy += *incy;
-		    i__3 = iy;
-		    i__4 = iy;
-		    i__5 = i__ + j * a_dim1;
-		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
-			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
-			    .r;
-		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
-		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
-		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-		    i__3 = ix;
-		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
-			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
-		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-/* L110: */
-		}
-		i__2 = jy;
-		i__3 = jy;
-		z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
-			alpha->r * temp2.i + alpha->i * temp2.r;
-		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
-		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
-		jx += *incx;
-		jy += *incy;
-/* L120: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZHEMV . */
-
-} /* zhemv_ */
-
-/* Subroutine */ int zher2_(char *uplo, integer *n, doublecomplex *alpha,
-	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
-	doublecomplex *a, integer *lda)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
-    doublereal d__1;
-    doublecomplex z__1, z__2, z__3, z__4;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, ix, iy, jx, jy, kx, ky, info;
-    static doublecomplex temp1, temp2;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZHER2  performs the hermitian rank 2 operation
-
-       A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,
-
-    where alpha is a scalar, x and y are n element vectors and A is an n
-    by n hermitian matrix.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the upper or lower
-             triangular part of the array A is to be referenced as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the upper triangular part of A
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the lower triangular part of A
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element vector x.
-             Unchanged on exit.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-    Y      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCY ) ).
-             Before entry, the incremented array Y must contain the n
-             element vector y.
-             Unchanged on exit.
-
-    INCY   - INTEGER.
-             On entry, INCY specifies the increment for the elements of
-             Y. INCY must not be zero.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular part of the hermitian matrix and the strictly
-             lower triangular part of A is not referenced. On exit, the
-             upper triangular part of the array A is overwritten by the
-             upper triangular part of the updated matrix.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular part of the hermitian matrix and the strictly
-             upper triangular part of A is not referenced. On exit, the
-             lower triangular part of the array A is overwritten by the
-             lower triangular part of the updated matrix.
-             Note that the imaginary parts of the diagonal elements need
-             not be set, they are assumed to be zero, and on exit they
-             are set to zero.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    --x;
-    --y;
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (*n < 0) {
-	info = 2;
-    } else if (*incx == 0) {
-	info = 5;
-    } else if (*incy == 0) {
-	info = 7;
-    } else if (*lda < max(1,*n)) {
-	info = 9;
-    }
-    if (info != 0) {
-	xerbla_("ZHER2 ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
-	return 0;
-    }
-
-/*
-       Set up the start points in X and Y if the increments are not both
-       unity.
-*/
-
-    if (*incx != 1 || *incy != 1) {
-	if (*incx > 0) {
-	    kx = 1;
-	} else {
-	    kx = 1 - (*n - 1) * *incx;
-	}
-	if (*incy > 0) {
-	    ky = 1;
-	} else {
-	    ky = 1 - (*n - 1) * *incy;
-	}
-	jx = kx;
-	jy = ky;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through the triangular part
-       of A.
-*/
-
-    if (lsame_(uplo, "U")) {
-
-/*        Form  A  when A is stored in the upper triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		i__3 = j;
-		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
-			y[i__3].i != 0.)) {
-		    d_cnjg(&z__2, &y[j]);
-		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
-			    alpha->r * z__2.i + alpha->i * z__2.r;
-		    temp1.r = z__1.r, temp1.i = z__1.i;
-		    i__2 = j;
-		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
-			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
-			    .r;
-		    d_cnjg(&z__1, &z__2);
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-		    i__2 = j - 1;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * a_dim1;
-			i__4 = i__ + j * a_dim1;
-			i__5 = i__;
-			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
-				z__3.i = x[i__5].r * temp1.i + x[i__5].i *
-				temp1.r;
-			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
-				z__3.i;
-			i__6 = i__;
-			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
-				z__4.i = y[i__6].r * temp2.i + y[i__6].i *
-				temp2.r;
-			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
-			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-/* L10: */
-		    }
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    i__4 = j;
-		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
-			    z__2.i = x[i__4].r * temp1.i + x[i__4].i *
-			    temp1.r;
-		    i__5 = j;
-		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
-			    z__3.i = y[i__5].r * temp2.i + y[i__5].i *
-			    temp2.r;
-		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-		    d__1 = a[i__3].r + z__1.r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    d__1 = a[i__3].r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		}
-/* L20: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = jx;
-		i__3 = jy;
-		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
-			y[i__3].i != 0.)) {
-		    d_cnjg(&z__2, &y[jy]);
-		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
-			    alpha->r * z__2.i + alpha->i * z__2.r;
-		    temp1.r = z__1.r, temp1.i = z__1.i;
-		    i__2 = jx;
-		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
-			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
-			    .r;
-		    d_cnjg(&z__1, &z__2);
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-		    ix = kx;
-		    iy = ky;
-		    i__2 = j - 1;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * a_dim1;
-			i__4 = i__ + j * a_dim1;
-			i__5 = ix;
-			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
-				z__3.i = x[i__5].r * temp1.i + x[i__5].i *
-				temp1.r;
-			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
-				z__3.i;
-			i__6 = iy;
-			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
-				z__4.i = y[i__6].r * temp2.i + y[i__6].i *
-				temp2.r;
-			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
-			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-			ix += *incx;
-			iy += *incy;
-/* L30: */
-		    }
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    i__4 = jx;
-		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
-			    z__2.i = x[i__4].r * temp1.i + x[i__4].i *
-			    temp1.r;
-		    i__5 = jy;
-		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
-			    z__3.i = y[i__5].r * temp2.i + y[i__5].i *
-			    temp2.r;
-		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-		    d__1 = a[i__3].r + z__1.r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    d__1 = a[i__3].r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		}
-		jx += *incx;
-		jy += *incy;
-/* L40: */
-	    }
-	}
-    } else {
-
-/*        Form  A  when A is stored in the lower triangle. */
-
-	if ((*incx == 1 && *incy == 1)) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		i__3 = j;
-		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
-			y[i__3].i != 0.)) {
-		    d_cnjg(&z__2, &y[j]);
-		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
-			    alpha->r * z__2.i + alpha->i * z__2.r;
-		    temp1.r = z__1.r, temp1.i = z__1.i;
-		    i__2 = j;
-		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
-			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
-			    .r;
-		    d_cnjg(&z__1, &z__2);
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    i__4 = j;
-		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
-			    z__2.i = x[i__4].r * temp1.i + x[i__4].i *
-			    temp1.r;
-		    i__5 = j;
-		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
-			    z__3.i = y[i__5].r * temp2.i + y[i__5].i *
-			    temp2.r;
-		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-		    d__1 = a[i__3].r + z__1.r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * a_dim1;
-			i__4 = i__ + j * a_dim1;
-			i__5 = i__;
-			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
-				z__3.i = x[i__5].r * temp1.i + x[i__5].i *
-				temp1.r;
-			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
-				z__3.i;
-			i__6 = i__;
-			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
-				z__4.i = y[i__6].r * temp2.i + y[i__6].i *
-				temp2.r;
-			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
-			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-/* L50: */
-		    }
-		} else {
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    d__1 = a[i__3].r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		}
-/* L60: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = jx;
-		i__3 = jy;
-		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
-			y[i__3].i != 0.)) {
-		    d_cnjg(&z__2, &y[jy]);
-		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
-			    alpha->r * z__2.i + alpha->i * z__2.r;
-		    temp1.r = z__1.r, temp1.i = z__1.i;
-		    i__2 = jx;
-		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
-			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
-			    .r;
-		    d_cnjg(&z__1, &z__2);
-		    temp2.r = z__1.r, temp2.i = z__1.i;
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    i__4 = jx;
-		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
-			    z__2.i = x[i__4].r * temp1.i + x[i__4].i *
-			    temp1.r;
-		    i__5 = jy;
-		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
-			    z__3.i = y[i__5].r * temp2.i + y[i__5].i *
-			    temp2.r;
-		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-		    d__1 = a[i__3].r + z__1.r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		    ix = jx;
-		    iy = jy;
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			ix += *incx;
-			iy += *incy;
-			i__3 = i__ + j * a_dim1;
-			i__4 = i__ + j * a_dim1;
-			i__5 = ix;
-			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
-				z__3.i = x[i__5].r * temp1.i + x[i__5].i *
-				temp1.r;
-			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
-				z__3.i;
-			i__6 = iy;
-			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
-				z__4.i = y[i__6].r * temp2.i + y[i__6].i *
-				temp2.r;
-			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
-			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
-/* L70: */
-		    }
-		} else {
-		    i__2 = j + j * a_dim1;
-		    i__3 = j + j * a_dim1;
-		    d__1 = a[i__3].r;
-		    a[i__2].r = d__1, a[i__2].i = 0.;
-		}
-		jx += *incx;
-		jy += *incy;
-/* L80: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZHER2 . */
-
-} /* zher2_ */
-
-/* Subroutine */ int zher2k_(char *uplo, char *trans, integer *n, integer *k,
-	doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
-	b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
-	    i__3, i__4, i__5, i__6, i__7;
-    doublereal d__1;
-    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, l, info;
-    static doublecomplex temp1, temp2;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZHER2K  performs one of the hermitian rank 2k operations
-
-       C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + beta*C,
-
-    or
-
-       C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + beta*C,
-
-    where  alpha and beta  are scalars with  beta  real,  C is an  n by n
-    hermitian matrix and  A and B  are  n by k matrices in the first case
-    and  k by n  matrices in the second case.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On  entry,   UPLO  specifies  whether  the  upper  or  lower
-             triangular  part  of the  array  C  is to be  referenced  as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the  upper triangular part of  C
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the  lower triangular part of  C
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry,  TRANS  specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'    C := alpha*A*conjg( B' )          +
-                                           conjg( alpha )*B*conjg( A' ) +
-                                           beta*C.
-
-                TRANS = 'C' or 'c'    C := alpha*conjg( A' )*B          +
-                                           conjg( alpha )*conjg( B' )*A +
-                                           beta*C.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry,  N specifies the order of the matrix C.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    K      - INTEGER.
-             On entry with  TRANS = 'N' or 'n',  K  specifies  the number
-             of  columns  of the  matrices  A and B,  and on  entry  with
-             TRANS = 'C' or 'c',  K  specifies  the number of rows of the
-             matrices  A and B.  K must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16         .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
-             k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
-             Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
-             part of the array  A  must contain the matrix  A,  otherwise
-             the leading  k by n  part of the array  A  must contain  the
-             matrix A.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
-             then  LDA must be at least  max( 1, n ), otherwise  LDA must
-             be at least  max( 1, k ).
-             Unchanged on exit.
-
-    B      - COMPLEX*16       array of DIMENSION ( LDB, kb ), where kb is
-             k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
-             Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
-             part of the array  B  must contain the matrix  B,  otherwise
-             the leading  k by n  part of the array  B  must contain  the
-             matrix B.
-             Unchanged on exit.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
-             then  LDB must be at least  max( 1, n ), otherwise  LDB must
-             be at least  max( 1, k ).
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION            .
-             On entry, BETA specifies the scalar beta.
-             Unchanged on exit.
-
-    C      - COMPLEX*16          array of DIMENSION ( LDC, n ).
-             Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
-             upper triangular part of the array C must contain the upper
-             triangular part  of the  hermitian matrix  and the strictly
-             lower triangular part of C is not referenced.  On exit, the
-             upper triangular part of the array  C is overwritten by the
-             upper triangular part of the updated matrix.
-             Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
-             lower triangular part of the array C must contain the lower
-             triangular part  of the  hermitian matrix  and the strictly
-             upper triangular part of C is not referenced.  On exit, the
-             lower triangular part of the array  C is overwritten by the
-             lower triangular part of the updated matrix.
-             Note that the imaginary parts of the diagonal elements need
-             not be set,  they are assumed to be zero,  and on exit they
-             are set to zero.
-
-    LDC    - INTEGER.
-             On entry, LDC specifies the first dimension of C as declared
-             in  the  calling  (sub)  program.   LDC  must  be  at  least
-             max( 1, n ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-    -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
-       Ed Anderson, Cray Research Inc.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-    c_dim1 = *ldc;
-    c_offset = 1 + c_dim1 * 1;
-    c__ -= c_offset;
-
-    /* Function Body */
-    if (lsame_(trans, "N")) {
-	nrowa = *n;
-    } else {
-	nrowa = *k;
-    }
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if ((! lsame_(trans, "N") && ! lsame_(trans,
-	    "C"))) {
-	info = 2;
-    } else if (*n < 0) {
-	info = 3;
-    } else if (*k < 0) {
-	info = 4;
-    } else if (*lda < max(1,nrowa)) {
-	info = 7;
-    } else if (*ldb < max(1,nrowa)) {
-	info = 9;
-    } else if (*ldc < max(1,*n)) {
-	info = 12;
-    }
-    if (info != 0) {
-	xerbla_("ZHER2K", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || (((alpha->r == 0. && alpha->i == 0.) || *k == 0) && *beta
-	    == 1.)) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if ((alpha->r == 0. && alpha->i == 0.)) {
-	if (upper) {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L10: */
-		    }
-/* L20: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j - 1;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L30: */
-		    }
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L50: */
-		    }
-/* L60: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L70: */
-		    }
-/* L80: */
-		}
-	    }
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lsame_(trans, "N")) {
-
-/*
-          Form  C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) +
-                     C.
-*/
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L90: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = j - 1;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L100: */
-		    }
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = j + l * a_dim1;
-		    i__4 = j + l * b_dim1;
-		    if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=
-			    0. || b[i__4].i != 0.)) {
-			d_cnjg(&z__2, &b[j + l * b_dim1]);
-			z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
-				z__1.i = alpha->r * z__2.i + alpha->i *
-				z__2.r;
-			temp1.r = z__1.r, temp1.i = z__1.i;
-			i__3 = j + l * a_dim1;
-			z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,
-				z__2.i = alpha->r * a[i__3].i + alpha->i * a[
-				i__3].r;
-			d_cnjg(&z__1, &z__2);
-			temp2.r = z__1.r, temp2.i = z__1.i;
-			i__3 = j - 1;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__3.r = a[i__6].r * temp1.r - a[i__6].i *
-				    temp1.i, z__3.i = a[i__6].r * temp1.i + a[
-				    i__6].i * temp1.r;
-			    z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
-				    .i + z__3.i;
-			    i__7 = i__ + l * b_dim1;
-			    z__4.r = b[i__7].r * temp2.r - b[i__7].i *
-				    temp2.i, z__4.i = b[i__7].r * temp2.i + b[
-				    i__7].i * temp2.r;
-			    z__1.r = z__2.r + z__4.r, z__1.i = z__2.i +
-				    z__4.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L110: */
-			}
-			i__3 = j + j * c_dim1;
-			i__4 = j + j * c_dim1;
-			i__5 = j + l * a_dim1;
-			z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,
-				z__2.i = a[i__5].r * temp1.i + a[i__5].i *
-				temp1.r;
-			i__6 = j + l * b_dim1;
-			z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,
-				z__3.i = b[i__6].r * temp2.i + b[i__6].i *
-				temp2.r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			d__1 = c__[i__4].r + z__1.r;
-			c__[i__3].r = d__1, c__[i__3].i = 0.;
-		    }
-/* L120: */
-		}
-/* L130: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L140: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L150: */
-		    }
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = j + l * a_dim1;
-		    i__4 = j + l * b_dim1;
-		    if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=
-			    0. || b[i__4].i != 0.)) {
-			d_cnjg(&z__2, &b[j + l * b_dim1]);
-			z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
-				z__1.i = alpha->r * z__2.i + alpha->i *
-				z__2.r;
-			temp1.r = z__1.r, temp1.i = z__1.i;
-			i__3 = j + l * a_dim1;
-			z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,
-				z__2.i = alpha->r * a[i__3].i + alpha->i * a[
-				i__3].r;
-			d_cnjg(&z__1, &z__2);
-			temp2.r = z__1.r, temp2.i = z__1.i;
-			i__3 = *n;
-			for (i__ = j + 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__3.r = a[i__6].r * temp1.r - a[i__6].i *
-				    temp1.i, z__3.i = a[i__6].r * temp1.i + a[
-				    i__6].i * temp1.r;
-			    z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
-				    .i + z__3.i;
-			    i__7 = i__ + l * b_dim1;
-			    z__4.r = b[i__7].r * temp2.r - b[i__7].i *
-				    temp2.i, z__4.i = b[i__7].r * temp2.i + b[
-				    i__7].i * temp2.r;
-			    z__1.r = z__2.r + z__4.r, z__1.i = z__2.i +
-				    z__4.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L160: */
-			}
-			i__3 = j + j * c_dim1;
-			i__4 = j + j * c_dim1;
-			i__5 = j + l * a_dim1;
-			z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,
-				z__2.i = a[i__5].r * temp1.i + a[i__5].i *
-				temp1.r;
-			i__6 = j + l * b_dim1;
-			z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,
-				z__3.i = b[i__6].r * temp2.i + b[i__6].i *
-				temp2.r;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			d__1 = c__[i__4].r + z__1.r;
-			c__[i__3].r = d__1, c__[i__3].i = 0.;
-		    }
-/* L170: */
-		}
-/* L180: */
-	    }
-	}
-    } else {
-
-/*
-          Form  C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A +
-                     C.
-*/
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp1.r = 0., temp1.i = 0.;
-		    temp2.r = 0., temp2.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			i__4 = l + j * b_dim1;
-			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
-				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
-				.r;
-			z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
-			temp1.r = z__1.r, temp1.i = z__1.i;
-			d_cnjg(&z__3, &b[l + i__ * b_dim1]);
-			i__4 = l + j * a_dim1;
-			z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
-				z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
-				.r;
-			z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
-			temp2.r = z__1.r, temp2.i = z__1.i;
-/* L190: */
-		    }
-		    if (i__ == j) {
-			if (*beta == 0.) {
-			    i__3 = j + j * c_dim1;
-			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__2.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    d_cnjg(&z__4, alpha);
-			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
-				    z__3.i = z__4.r * temp2.i + z__4.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
-				    z__3.i;
-			    d__1 = z__1.r;
-			    c__[i__3].r = d__1, c__[i__3].i = 0.;
-			} else {
-			    i__3 = j + j * c_dim1;
-			    i__4 = j + j * c_dim1;
-			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__2.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    d_cnjg(&z__4, alpha);
-			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
-				    z__3.i = z__4.r * temp2.i + z__4.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
-				    z__3.i;
-			    d__1 = *beta * c__[i__4].r + z__1.r;
-			    c__[i__3].r = d__1, c__[i__3].i = 0.;
-			}
-		    } else {
-			if (*beta == 0.) {
-			    i__3 = i__ + j * c_dim1;
-			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__2.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    d_cnjg(&z__4, alpha);
-			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
-				    z__3.i = z__4.r * temp2.i + z__4.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
-				    z__3.i;
-			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-			} else {
-			    i__3 = i__ + j * c_dim1;
-			    i__4 = i__ + j * c_dim1;
-			    z__3.r = *beta * c__[i__4].r, z__3.i = *beta *
-				    c__[i__4].i;
-			    z__4.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__4.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +
-				    z__4.i;
-			    d_cnjg(&z__6, alpha);
-			    z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,
-				    z__5.i = z__6.r * temp2.i + z__6.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__5.r, z__1.i = z__2.i +
-				    z__5.i;
-			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-			}
-		    }
-/* L200: */
-		}
-/* L210: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = *n;
-		for (i__ = j; i__ <= i__2; ++i__) {
-		    temp1.r = 0., temp1.i = 0.;
-		    temp2.r = 0., temp2.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			i__4 = l + j * b_dim1;
-			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
-				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
-				.r;
-			z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
-			temp1.r = z__1.r, temp1.i = z__1.i;
-			d_cnjg(&z__3, &b[l + i__ * b_dim1]);
-			i__4 = l + j * a_dim1;
-			z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
-				z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
-				.r;
-			z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
-			temp2.r = z__1.r, temp2.i = z__1.i;
-/* L220: */
-		    }
-		    if (i__ == j) {
-			if (*beta == 0.) {
-			    i__3 = j + j * c_dim1;
-			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__2.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    d_cnjg(&z__4, alpha);
-			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
-				    z__3.i = z__4.r * temp2.i + z__4.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
-				    z__3.i;
-			    d__1 = z__1.r;
-			    c__[i__3].r = d__1, c__[i__3].i = 0.;
-			} else {
-			    i__3 = j + j * c_dim1;
-			    i__4 = j + j * c_dim1;
-			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__2.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    d_cnjg(&z__4, alpha);
-			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
-				    z__3.i = z__4.r * temp2.i + z__4.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
-				    z__3.i;
-			    d__1 = *beta * c__[i__4].r + z__1.r;
-			    c__[i__3].r = d__1, c__[i__3].i = 0.;
-			}
-		    } else {
-			if (*beta == 0.) {
-			    i__3 = i__ + j * c_dim1;
-			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__2.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    d_cnjg(&z__4, alpha);
-			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
-				    z__3.i = z__4.r * temp2.i + z__4.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
-				    z__3.i;
-			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-			} else {
-			    i__3 = i__ + j * c_dim1;
-			    i__4 = i__ + j * c_dim1;
-			    z__3.r = *beta * c__[i__4].r, z__3.i = *beta *
-				    c__[i__4].i;
-			    z__4.r = alpha->r * temp1.r - alpha->i * temp1.i,
-				    z__4.i = alpha->r * temp1.i + alpha->i *
-				    temp1.r;
-			    z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +
-				    z__4.i;
-			    d_cnjg(&z__6, alpha);
-			    z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,
-				    z__5.i = z__6.r * temp2.i + z__6.i *
-				    temp2.r;
-			    z__1.r = z__2.r + z__5.r, z__1.i = z__2.i +
-				    z__5.i;
-			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-			}
-		    }
-/* L230: */
-		}
-/* L240: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZHER2K. */
-
-} /* zher2k_ */
-
-/* Subroutine */ int zherk_(char *uplo, char *trans, integer *n, integer *k,
-	doublereal *alpha, doublecomplex *a, integer *lda, doublereal *beta,
-	doublecomplex *c__, integer *ldc)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5,
-	    i__6;
-    doublereal d__1;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, l, info;
-    static doublecomplex temp;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static doublereal rtemp;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-
-
-/*
-    Purpose
-    =======
-
-    ZHERK  performs one of the hermitian rank k operations
-
-       C := alpha*A*conjg( A' ) + beta*C,
-
-    or
-
-       C := alpha*conjg( A' )*A + beta*C,
-
-    where  alpha and beta  are  real scalars,  C is an  n by n  hermitian
-    matrix and  A  is an  n by k  matrix in the  first case and a  k by n
-    matrix in the second case.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On  entry,   UPLO  specifies  whether  the  upper  or  lower
-             triangular  part  of the  array  C  is to be  referenced  as
-             follows:
-
-                UPLO = 'U' or 'u'   Only the  upper triangular part of  C
-                                    is to be referenced.
-
-                UPLO = 'L' or 'l'   Only the  lower triangular part of  C
-                                    is to be referenced.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry,  TRANS  specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   C := alpha*A*conjg( A' ) + beta*C.
-
-                TRANS = 'C' or 'c'   C := alpha*conjg( A' )*A + beta*C.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry,  N specifies the order of the matrix C.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    K      - INTEGER.
-             On entry with  TRANS = 'N' or 'n',  K  specifies  the number
-             of  columns   of  the   matrix   A,   and  on   entry   with
-             TRANS = 'C' or 'c',  K  specifies  the number of rows of the
-             matrix A.  K must be at least zero.
-             Unchanged on exit.
-
-    ALPHA  - DOUBLE PRECISION            .
-             On entry, ALPHA specifies the scalar alpha.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
-             k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
-             Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
-             part of the array  A  must contain the matrix  A,  otherwise
-             the leading  k by n  part of the array  A  must contain  the
-             matrix A.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
-             then  LDA must be at least  max( 1, n ), otherwise  LDA must
-             be at least  max( 1, k ).
-             Unchanged on exit.
-
-    BETA   - DOUBLE PRECISION.
-             On entry, BETA specifies the scalar beta.
-             Unchanged on exit.
-
-    C      - COMPLEX*16          array of DIMENSION ( LDC, n ).
-             Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
-             upper triangular part of the array C must contain the upper
-             triangular part  of the  hermitian matrix  and the strictly
-             lower triangular part of C is not referenced.  On exit, the
-             upper triangular part of the array  C is overwritten by the
-             upper triangular part of the updated matrix.
-             Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
-             lower triangular part of the array C must contain the lower
-             triangular part  of the  hermitian matrix  and the strictly
-             upper triangular part of C is not referenced.  On exit, the
-             lower triangular part of the array  C is overwritten by the
-             lower triangular part of the updated matrix.
-             Note that the imaginary parts of the diagonal elements need
-             not be set,  they are assumed to be zero,  and on exit they
-             are set to zero.
-
-    LDC    - INTEGER.
-             On entry, LDC specifies the first dimension of C as declared
-             in  the  calling  (sub)  program.   LDC  must  be  at  least
-             max( 1, n ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-    -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
-       Ed Anderson, Cray Research Inc.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    c_dim1 = *ldc;
-    c_offset = 1 + c_dim1 * 1;
-    c__ -= c_offset;
-
-    /* Function Body */
-    if (lsame_(trans, "N")) {
-	nrowa = *n;
-    } else {
-	nrowa = *k;
-    }
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if ((! lsame_(trans, "N") && ! lsame_(trans,
-	    "C"))) {
-	info = 2;
-    } else if (*n < 0) {
-	info = 3;
-    } else if (*k < 0) {
-	info = 4;
-    } else if (*lda < max(1,nrowa)) {
-	info = 7;
-    } else if (*ldc < max(1,*n)) {
-	info = 10;
-    }
-    if (info != 0) {
-	xerbla_("ZHERK ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if (*alpha == 0.) {
-	if (upper) {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L10: */
-		    }
-/* L20: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j - 1;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L30: */
-		    }
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*beta == 0.) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L50: */
-		    }
-/* L60: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L70: */
-		    }
-/* L80: */
-		}
-	    }
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lsame_(trans, "N")) {
-
-/*        Form  C := alpha*A*conjg( A' ) + beta*C. */
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = j;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L90: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = j - 1;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L100: */
-		    }
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = j + l * a_dim1;
-		    if (a[i__3].r != 0. || a[i__3].i != 0.) {
-			d_cnjg(&z__2, &a[j + l * a_dim1]);
-			z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__3 = j - 1;
-			for (i__ = 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
-				    z__2.i = temp.r * a[i__6].i + temp.i * a[
-				    i__6].r;
-			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
-				    .i + z__2.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L110: */
-			}
-			i__3 = j + j * c_dim1;
-			i__4 = j + j * c_dim1;
-			i__5 = i__ + l * a_dim1;
-			z__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				z__1.i = temp.r * a[i__5].i + temp.i * a[i__5]
-				.r;
-			d__1 = c__[i__4].r + z__1.r;
-			c__[i__3].r = d__1, c__[i__3].i = 0.;
-		    }
-/* L120: */
-		}
-/* L130: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		if (*beta == 0.) {
-		    i__2 = *n;
-		    for (i__ = j; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			c__[i__3].r = 0., c__[i__3].i = 0.;
-/* L140: */
-		    }
-		} else if (*beta != 1.) {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		    i__2 = *n;
-		    for (i__ = j + 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * c_dim1;
-			i__4 = i__ + j * c_dim1;
-			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
-				i__4].i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-/* L150: */
-		    }
-		} else {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		}
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    i__3 = j + l * a_dim1;
-		    if (a[i__3].r != 0. || a[i__3].i != 0.) {
-			d_cnjg(&z__2, &a[j + l * a_dim1]);
-			z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__3 = j + j * c_dim1;
-			i__4 = j + j * c_dim1;
-			i__5 = j + l * a_dim1;
-			z__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				z__1.i = temp.r * a[i__5].i + temp.i * a[i__5]
-				.r;
-			d__1 = c__[i__4].r + z__1.r;
-			c__[i__3].r = d__1, c__[i__3].i = 0.;
-			i__3 = *n;
-			for (i__ = j + 1; i__ <= i__3; ++i__) {
-			    i__4 = i__ + j * c_dim1;
-			    i__5 = i__ + j * c_dim1;
-			    i__6 = i__ + l * a_dim1;
-			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
-				    z__2.i = temp.r * a[i__6].i + temp.i * a[
-				    i__6].r;
-			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
-				    .i + z__2.i;
-			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
-/* L160: */
-			}
-		    }
-/* L170: */
-		}
-/* L180: */
-	    }
-	}
-    } else {
-
-/*        Form  C := alpha*conjg( A' )*A + beta*C. */
-
-	if (upper) {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		i__2 = j - 1;
-		for (i__ = 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			i__4 = l + j * a_dim1;
-			z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
-				z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
-				.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L190: */
-		    }
-		    if (*beta == 0.) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = *alpha * temp.r, z__1.i = *alpha * temp.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = *alpha * temp.r, z__2.i = *alpha * temp.i;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = *beta * c__[i__4].r, z__3.i = *beta * c__[
-				i__4].i;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L200: */
-		}
-		rtemp = 0.;
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    d_cnjg(&z__3, &a[l + j * a_dim1]);
-		    i__3 = l + j * a_dim1;
-		    z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i =
-			     z__3.r * a[i__3].i + z__3.i * a[i__3].r;
-		    z__1.r = rtemp + z__2.r, z__1.i = z__2.i;
-		    rtemp = z__1.r;
-/* L210: */
-		}
-		if (*beta == 0.) {
-		    i__2 = j + j * c_dim1;
-		    d__1 = *alpha * rtemp;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *alpha * rtemp + *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		}
-/* L220: */
-	    }
-	} else {
-	    i__1 = *n;
-	    for (j = 1; j <= i__1; ++j) {
-		rtemp = 0.;
-		i__2 = *k;
-		for (l = 1; l <= i__2; ++l) {
-		    d_cnjg(&z__3, &a[l + j * a_dim1]);
-		    i__3 = l + j * a_dim1;
-		    z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i =
-			     z__3.r * a[i__3].i + z__3.i * a[i__3].r;
-		    z__1.r = rtemp + z__2.r, z__1.i = z__2.i;
-		    rtemp = z__1.r;
-/* L230: */
-		}
-		if (*beta == 0.) {
-		    i__2 = j + j * c_dim1;
-		    d__1 = *alpha * rtemp;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		} else {
-		    i__2 = j + j * c_dim1;
-		    i__3 = j + j * c_dim1;
-		    d__1 = *alpha * rtemp + *beta * c__[i__3].r;
-		    c__[i__2].r = d__1, c__[i__2].i = 0.;
-		}
-		i__2 = *n;
-		for (i__ = j + 1; i__ <= i__2; ++i__) {
-		    temp.r = 0., temp.i = 0.;
-		    i__3 = *k;
-		    for (l = 1; l <= i__3; ++l) {
-			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
-			i__4 = l + j * a_dim1;
-			z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
-				z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
-				.r;
-			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
-			temp.r = z__1.r, temp.i = z__1.i;
-/* L240: */
-		    }
-		    if (*beta == 0.) {
-			i__3 = i__ + j * c_dim1;
-			z__1.r = *alpha * temp.r, z__1.i = *alpha * temp.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    } else {
-			i__3 = i__ + j * c_dim1;
-			z__2.r = *alpha * temp.r, z__2.i = *alpha * temp.i;
-			i__4 = i__ + j * c_dim1;
-			z__3.r = *beta * c__[i__4].r, z__3.i = *beta * c__[
-				i__4].i;
-			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
-			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
-		    }
-/* L250: */
-		}
-/* L260: */
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZHERK . */
-
-} /* zherk_ */
-
-/* Subroutine */ int zscal_(integer *n, doublecomplex *za, doublecomplex *zx,
-	integer *incx)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3;
-    doublecomplex z__1;
-
-    /* Local variables */
-    static integer i__, ix;
-
-
-/*
-       scales a vector by a constant.
-       jack dongarra, 3/11/78.
-       modified 3/93 to return if incx .le. 0.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --zx;
-
-    /* Function Body */
-    if (*n <= 0 || *incx <= 0) {
-	return 0;
-    }
-    if (*incx == 1) {
-	goto L20;
-    }
-
-/*        code for increment not equal to 1 */
-
-    ix = 1;
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = ix;
-	i__3 = ix;
-	z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[
-		i__3].i + za->i * zx[i__3].r;
-	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
-	ix += *incx;
-/* L10: */
-    }
-    return 0;
-
-/*        code for increment equal to 1 */
-
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = i__;
-	i__3 = i__;
-	z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[
-		i__3].i + za->i * zx[i__3].r;
-	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
-/* L30: */
-    }
-    return 0;
-} /* zscal_ */
-
-/* Subroutine */ int zswap_(integer *n, doublecomplex *zx, integer *incx,
-	doublecomplex *zy, integer *incy)
-{
-    /* System generated locals */
-    integer i__1, i__2, i__3;
-
-    /* Local variables */
-    static integer i__, ix, iy;
-    static doublecomplex ztemp;
-
-
-/*
-       interchanges two vectors.
-       jack dongarra, 3/11/78.
-       modified 12/3/93, array(1) declarations changed to array(*)
-*/
-
-
-    /* Parameter adjustments */
-    --zy;
-    --zx;
-
-    /* Function Body */
-    if (*n <= 0) {
-	return 0;
-    }
-    if ((*incx == 1 && *incy == 1)) {
-	goto L20;
-    }
-
-/*
-         code for unequal increments or equal increments not equal
-           to 1
-*/
-
-    ix = 1;
-    iy = 1;
-    if (*incx < 0) {
-	ix = (-(*n) + 1) * *incx + 1;
-    }
-    if (*incy < 0) {
-	iy = (-(*n) + 1) * *incy + 1;
-    }
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = ix;
-	ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;
-	i__2 = ix;
-	i__3 = iy;
-	zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;
-	i__2 = iy;
-	zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;
-	ix += *incx;
-	iy += *incy;
-/* L10: */
-    }
-    return 0;
-
-/*       code for both increments equal to 1 */
-L20:
-    i__1 = *n;
-    for (i__ = 1; i__ <= i__1; ++i__) {
-	i__2 = i__;
-	ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;
-	i__2 = i__;
-	i__3 = i__;
-	zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;
-	i__2 = i__;
-	zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;
-/* L30: */
-    }
-    return 0;
-} /* zswap_ */
-
-/* Subroutine */ int ztrmm_(char *side, char *uplo, char *transa, char *diag,
-	integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
-	integer *lda, doublecomplex *b, integer *ldb)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,
-	    i__6;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, k, info;
-    static doublecomplex temp;
-    static logical lside;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical noconj, nounit;
-
-
-/*
-    Purpose
-    =======
-
-    ZTRMM  performs one of the matrix-matrix operations
-
-       B := alpha*op( A )*B,   or   B := alpha*B*op( A )
-
-    where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
-    non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
-
-       op( A ) = A   or   op( A ) = A'   or   op( A ) = conjg( A' ).
-
-    Parameters
-    ==========
-
-    SIDE   - CHARACTER*1.
-             On entry,  SIDE specifies whether  op( A ) multiplies B from
-             the left or right as follows:
-
-                SIDE = 'L' or 'l'   B := alpha*op( A )*B.
-
-                SIDE = 'R' or 'r'   B := alpha*B*op( A ).
-
-             Unchanged on exit.
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix A is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANSA - CHARACTER*1.
-             On entry, TRANSA specifies the form of op( A ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSA = 'N' or 'n'   op( A ) = A.
-
-                TRANSA = 'T' or 't'   op( A ) = A'.
-
-                TRANSA = 'C' or 'c'   op( A ) = conjg( A' ).
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit triangular
-             as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of B. M must be at
-             least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of B.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry,  ALPHA specifies the scalar  alpha. When  alpha is
-             zero then  A is not referenced and  B need not be set before
-             entry.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, k ), where k is m
-             when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
-             Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
-             upper triangular part of the array  A must contain the upper
-             triangular matrix  and the strictly lower triangular part of
-             A is not referenced.
-             Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
-             lower triangular part of the array  A must contain the lower
-             triangular matrix  and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u',  the diagonal elements of
-             A  are not referenced either,  but are assumed to be  unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
-             LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
-             then LDA must be at least max( 1, n ).
-             Unchanged on exit.
-
-    B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
-             Before entry,  the leading  m by n part of the array  B must
-             contain the matrix  B,  and  on exit  is overwritten  by the
-             transformed matrix.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in  the  calling  (sub)  program.   LDB  must  be  at  least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-
-    /* Function Body */
-    lside = lsame_(side, "L");
-    if (lside) {
-	nrowa = *m;
-    } else {
-	nrowa = *n;
-    }
-    noconj = lsame_(transa, "T");
-    nounit = lsame_(diag, "N");
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! lside && ! lsame_(side, "R"))) {
-	info = 1;
-    } else if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 2;
-    } else if (((! lsame_(transa, "N") && ! lsame_(
-	    transa, "T")) && ! lsame_(transa, "C"))) {
-	info = 3;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 4;
-    } else if (*m < 0) {
-	info = 5;
-    } else if (*n < 0) {
-	info = 6;
-    } else if (*lda < max(1,nrowa)) {
-	info = 9;
-    } else if (*ldb < max(1,*m)) {
-	info = 11;
-    }
-    if (info != 0) {
-	xerbla_("ZTRMM ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if ((alpha->r == 0. && alpha->i == 0.)) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = *m;
-	    for (i__ = 1; i__ <= i__2; ++i__) {
-		i__3 = i__ + j * b_dim1;
-		b[i__3].r = 0., b[i__3].i = 0.;
-/* L10: */
-	    }
-/* L20: */
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lside) {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*A*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *m;
-		    for (k = 1; k <= i__2; ++k) {
-			i__3 = k + j * b_dim1;
-			if (b[i__3].r != 0. || b[i__3].i != 0.) {
-			    i__3 = k + j * b_dim1;
-			    z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
-				    .i, z__1.i = alpha->r * b[i__3].i +
-				    alpha->i * b[i__3].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    i__3 = k - 1;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + j * b_dim1;
-				i__6 = i__ + k * a_dim1;
-				z__2.r = temp.r * a[i__6].r - temp.i * a[i__6]
-					.i, z__2.i = temp.r * a[i__6].i +
-					temp.i * a[i__6].r;
-				z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
-					.i + z__2.i;
-				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
-/* L30: */
-			    }
-			    if (nounit) {
-				i__3 = k + k * a_dim1;
-				z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
-					.i, z__1.i = temp.r * a[i__3].i +
-					temp.i * a[i__3].r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__3 = k + j * b_dim1;
-			    b[i__3].r = temp.r, b[i__3].i = temp.i;
-			}
-/* L40: */
-		    }
-/* L50: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    for (k = *m; k >= 1; --k) {
-			i__2 = k + j * b_dim1;
-			if (b[i__2].r != 0. || b[i__2].i != 0.) {
-			    i__2 = k + j * b_dim1;
-			    z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2]
-				    .i, z__1.i = alpha->r * b[i__2].i +
-				    alpha->i * b[i__2].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    i__2 = k + j * b_dim1;
-			    b[i__2].r = temp.r, b[i__2].i = temp.i;
-			    if (nounit) {
-				i__2 = k + j * b_dim1;
-				i__3 = k + j * b_dim1;
-				i__4 = k + k * a_dim1;
-				z__1.r = b[i__3].r * a[i__4].r - b[i__3].i *
-					a[i__4].i, z__1.i = b[i__3].r * a[
-					i__4].i + b[i__3].i * a[i__4].r;
-				b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-			    }
-			    i__2 = *m;
-			    for (i__ = k + 1; i__ <= i__2; ++i__) {
-				i__3 = i__ + j * b_dim1;
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + k * a_dim1;
-				z__2.r = temp.r * a[i__5].r - temp.i * a[i__5]
-					.i, z__2.i = temp.r * a[i__5].i +
-					temp.i * a[i__5].r;
-				z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
-					.i + z__2.i;
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L60: */
-			    }
-			}
-/* L70: */
-		    }
-/* L80: */
-		}
-	    }
-	} else {
-
-/*           Form  B := alpha*A'*B   or   B := alpha*conjg( A' )*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    for (i__ = *m; i__ >= 1; --i__) {
-			i__2 = i__ + j * b_dim1;
-			temp.r = b[i__2].r, temp.i = b[i__2].i;
-			if (noconj) {
-			    if (nounit) {
-				i__2 = i__ + i__ * a_dim1;
-				z__1.r = temp.r * a[i__2].r - temp.i * a[i__2]
-					.i, z__1.i = temp.r * a[i__2].i +
-					temp.i * a[i__2].r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__2 = i__ - 1;
-			    for (k = 1; k <= i__2; ++k) {
-				i__3 = k + i__ * a_dim1;
-				i__4 = k + j * b_dim1;
-				z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *
-					b[i__4].i, z__2.i = a[i__3].r * b[
-					i__4].i + a[i__3].i * b[i__4].r;
-				z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L90: */
-			    }
-			} else {
-			    if (nounit) {
-				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
-				z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-					z__1.i = temp.r * z__2.i + temp.i *
-					z__2.r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__2 = i__ - 1;
-			    for (k = 1; k <= i__2; ++k) {
-				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
-				i__3 = k + j * b_dim1;
-				z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
-					.i, z__2.i = z__3.r * b[i__3].i +
-					z__3.i * b[i__3].r;
-				z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L100: */
-			    }
-			}
-			i__2 = i__ + j * b_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L110: */
-		    }
-/* L120: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * b_dim1;
-			temp.r = b[i__3].r, temp.i = b[i__3].i;
-			if (noconj) {
-			    if (nounit) {
-				i__3 = i__ + i__ * a_dim1;
-				z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
-					.i, z__1.i = temp.r * a[i__3].i +
-					temp.i * a[i__3].r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__3 = *m;
-			    for (k = i__ + 1; k <= i__3; ++k) {
-				i__4 = k + i__ * a_dim1;
-				i__5 = k + j * b_dim1;
-				z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *
-					b[i__5].i, z__2.i = a[i__4].r * b[
-					i__5].i + a[i__4].i * b[i__5].r;
-				z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L130: */
-			    }
-			} else {
-			    if (nounit) {
-				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
-				z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-					z__1.i = temp.r * z__2.i + temp.i *
-					z__2.r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__3 = *m;
-			    for (k = i__ + 1; k <= i__3; ++k) {
-				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
-				i__4 = k + j * b_dim1;
-				z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
-					.i, z__2.i = z__3.r * b[i__4].i +
-					z__3.i * b[i__4].r;
-				z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L140: */
-			    }
-			}
-			i__3 = i__ + j * b_dim1;
-			z__1.r = alpha->r * temp.r - alpha->i * temp.i,
-				z__1.i = alpha->r * temp.i + alpha->i *
-				temp.r;
-			b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L150: */
-		    }
-/* L160: */
-		}
-	    }
-	}
-    } else {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*B*A. */
-
-	    if (upper) {
-		for (j = *n; j >= 1; --j) {
-		    temp.r = alpha->r, temp.i = alpha->i;
-		    if (nounit) {
-			i__1 = j + j * a_dim1;
-			z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
-				z__1.i = temp.r * a[i__1].i + temp.i * a[i__1]
-				.r;
-			temp.r = z__1.r, temp.i = z__1.i;
-		    }
-		    i__1 = *m;
-		    for (i__ = 1; i__ <= i__1; ++i__) {
-			i__2 = i__ + j * b_dim1;
-			i__3 = i__ + j * b_dim1;
-			z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
-				z__1.i = temp.r * b[i__3].i + temp.i * b[i__3]
-				.r;
-			b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L170: */
-		    }
-		    i__1 = j - 1;
-		    for (k = 1; k <= i__1; ++k) {
-			i__2 = k + j * a_dim1;
-			if (a[i__2].r != 0. || a[i__2].i != 0.) {
-			    i__2 = k + j * a_dim1;
-			    z__1.r = alpha->r * a[i__2].r - alpha->i * a[i__2]
-				    .i, z__1.i = alpha->r * a[i__2].i +
-				    alpha->i * a[i__2].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				i__3 = i__ + j * b_dim1;
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + k * b_dim1;
-				z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
-					.i, z__2.i = temp.r * b[i__5].i +
-					temp.i * b[i__5].r;
-				z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
-					.i + z__2.i;
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L180: */
-			    }
-			}
-/* L190: */
-		    }
-/* L200: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    temp.r = alpha->r, temp.i = alpha->i;
-		    if (nounit) {
-			i__2 = j + j * a_dim1;
-			z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
-				z__1.i = temp.r * a[i__2].i + temp.i * a[i__2]
-				.r;
-			temp.r = z__1.r, temp.i = z__1.i;
-		    }
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * b_dim1;
-			i__4 = i__ + j * b_dim1;
-			z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
-				z__1.i = temp.r * b[i__4].i + temp.i * b[i__4]
-				.r;
-			b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L210: */
-		    }
-		    i__2 = *n;
-		    for (k = j + 1; k <= i__2; ++k) {
-			i__3 = k + j * a_dim1;
-			if (a[i__3].r != 0. || a[i__3].i != 0.) {
-			    i__3 = k + j * a_dim1;
-			    z__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3]
-				    .i, z__1.i = alpha->r * a[i__3].i +
-				    alpha->i * a[i__3].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + j * b_dim1;
-				i__6 = i__ + k * b_dim1;
-				z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
-					.i, z__2.i = temp.r * b[i__6].i +
-					temp.i * b[i__6].r;
-				z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
-					.i + z__2.i;
-				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
-/* L220: */
-			    }
-			}
-/* L230: */
-		    }
-/* L240: */
-		}
-	    }
-	} else {
-
-/*           Form  B := alpha*B*A'   or   B := alpha*B*conjg( A' ). */
-
-	    if (upper) {
-		i__1 = *n;
-		for (k = 1; k <= i__1; ++k) {
-		    i__2 = k - 1;
-		    for (j = 1; j <= i__2; ++j) {
-			i__3 = j + k * a_dim1;
-			if (a[i__3].r != 0. || a[i__3].i != 0.) {
-			    if (noconj) {
-				i__3 = j + k * a_dim1;
-				z__1.r = alpha->r * a[i__3].r - alpha->i * a[
-					i__3].i, z__1.i = alpha->r * a[i__3]
-					.i + alpha->i * a[i__3].r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    } else {
-				d_cnjg(&z__2, &a[j + k * a_dim1]);
-				z__1.r = alpha->r * z__2.r - alpha->i *
-					z__2.i, z__1.i = alpha->r * z__2.i +
-					alpha->i * z__2.r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + j * b_dim1;
-				i__6 = i__ + k * b_dim1;
-				z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
-					.i, z__2.i = temp.r * b[i__6].i +
-					temp.i * b[i__6].r;
-				z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
-					.i + z__2.i;
-				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
-/* L250: */
-			    }
-			}
-/* L260: */
-		    }
-		    temp.r = alpha->r, temp.i = alpha->i;
-		    if (nounit) {
-			if (noconj) {
-			    i__2 = k + k * a_dim1;
-			    z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
-				    z__1.i = temp.r * a[i__2].i + temp.i * a[
-				    i__2].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			} else {
-			    d_cnjg(&z__2, &a[k + k * a_dim1]);
-			    z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-				    z__1.i = temp.r * z__2.i + temp.i *
-				    z__2.r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    }
-		    if (temp.r != 1. || temp.i != 0.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + k * b_dim1;
-			    i__4 = i__ + k * b_dim1;
-			    z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
-				    z__1.i = temp.r * b[i__4].i + temp.i * b[
-				    i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L270: */
-			}
-		    }
-/* L280: */
-		}
-	    } else {
-		for (k = *n; k >= 1; --k) {
-		    i__1 = *n;
-		    for (j = k + 1; j <= i__1; ++j) {
-			i__2 = j + k * a_dim1;
-			if (a[i__2].r != 0. || a[i__2].i != 0.) {
-			    if (noconj) {
-				i__2 = j + k * a_dim1;
-				z__1.r = alpha->r * a[i__2].r - alpha->i * a[
-					i__2].i, z__1.i = alpha->r * a[i__2]
-					.i + alpha->i * a[i__2].r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    } else {
-				d_cnjg(&z__2, &a[j + k * a_dim1]);
-				z__1.r = alpha->r * z__2.r - alpha->i *
-					z__2.i, z__1.i = alpha->r * z__2.i +
-					alpha->i * z__2.r;
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				i__3 = i__ + j * b_dim1;
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + k * b_dim1;
-				z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
-					.i, z__2.i = temp.r * b[i__5].i +
-					temp.i * b[i__5].r;
-				z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
-					.i + z__2.i;
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L290: */
-			    }
-			}
-/* L300: */
-		    }
-		    temp.r = alpha->r, temp.i = alpha->i;
-		    if (nounit) {
-			if (noconj) {
-			    i__1 = k + k * a_dim1;
-			    z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
-				    z__1.i = temp.r * a[i__1].i + temp.i * a[
-				    i__1].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			} else {
-			    d_cnjg(&z__2, &a[k + k * a_dim1]);
-			    z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-				    z__1.i = temp.r * z__2.i + temp.i *
-				    z__2.r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    }
-		    if (temp.r != 1. || temp.i != 0.) {
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    i__2 = i__ + k * b_dim1;
-			    i__3 = i__ + k * b_dim1;
-			    z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
-				    z__1.i = temp.r * b[i__3].i + temp.i * b[
-				    i__3].r;
-			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L310: */
-			}
-		    }
-/* L320: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZTRMM . */
-
-} /* ztrmm_ */
-
-/* Subroutine */ int ztrmv_(char *uplo, char *trans, char *diag, integer *n,
-	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void d_cnjg(doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, ix, jx, kx, info;
-    static doublecomplex temp;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical noconj, nounit;
-
-
-/*
-    Purpose
-    =======
-
-    ZTRMV  performs one of the matrix-vector operations
-
-       x := A*x,   or   x := A'*x,   or   x := conjg( A' )*x,
-
-    where x is an n element vector and  A is an n by n unit, or non-unit,
-    upper or lower triangular matrix.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry, TRANS specifies the operation to be performed as
-             follows:
-
-                TRANS = 'N' or 'n'   x := A*x.
-
-                TRANS = 'T' or 't'   x := A'*x.
-
-                TRANS = 'C' or 'c'   x := conjg( A' )*x.
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit
-             triangular as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular matrix and the strictly lower triangular part of
-             A is not referenced.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular matrix and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u', the diagonal elements of
-             A are not referenced either, but are assumed to be unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element vector x. On exit, X is overwritten with the
-             tranformed vector x.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (((! lsame_(trans, "N") && ! lsame_(trans,
-	     "T")) && ! lsame_(trans, "C"))) {
-	info = 2;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 3;
-    } else if (*n < 0) {
-	info = 4;
-    } else if (*lda < max(1,*n)) {
-	info = 6;
-    } else if (*incx == 0) {
-	info = 8;
-    }
-    if (info != 0) {
-	xerbla_("ZTRMV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-    noconj = lsame_(trans, "T");
-    nounit = lsame_(diag, "N");
-
-/*
-       Set up the start point in X if the increment is not unity. This
-       will be  ( N - 1 )*INCX  too small for descending loops.
-*/
-
-    if (*incx <= 0) {
-	kx = 1 - (*n - 1) * *incx;
-    } else if (*incx != 1) {
-	kx = 1;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-*/
-
-    if (lsame_(trans, "N")) {
-
-/*        Form  x := A*x. */
-
-	if (lsame_(uplo, "U")) {
-	    if (*incx == 1) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
-			i__2 = j;
-			temp.r = x[i__2].r, temp.i = x[i__2].i;
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__;
-			    i__4 = i__;
-			    i__5 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				    z__2.i = temp.r * a[i__5].i + temp.i * a[
-				    i__5].r;
-			    z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i +
-				    z__2.i;
-			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
-/* L10: */
-			}
-			if (nounit) {
-			    i__2 = j;
-			    i__3 = j;
-			    i__4 = j + j * a_dim1;
-			    z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[
-				    i__4].i, z__1.i = x[i__3].r * a[i__4].i +
-				    x[i__3].i * a[i__4].r;
-			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-			}
-		    }
-/* L20: */
-		}
-	    } else {
-		jx = kx;
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = jx;
-		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
-			i__2 = jx;
-			temp.r = x[i__2].r, temp.i = x[i__2].i;
-			ix = kx;
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = ix;
-			    i__4 = ix;
-			    i__5 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				    z__2.i = temp.r * a[i__5].i + temp.i * a[
-				    i__5].r;
-			    z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i +
-				    z__2.i;
-			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
-			    ix += *incx;
-/* L30: */
-			}
-			if (nounit) {
-			    i__2 = jx;
-			    i__3 = jx;
-			    i__4 = j + j * a_dim1;
-			    z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[
-				    i__4].i, z__1.i = x[i__3].r * a[i__4].i +
-				    x[i__3].i * a[i__4].r;
-			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-			}
-		    }
-		    jx += *incx;
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*incx == 1) {
-		for (j = *n; j >= 1; --j) {
-		    i__1 = j;
-		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
-			i__1 = j;
-			temp.r = x[i__1].r, temp.i = x[i__1].i;
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    i__2 = i__;
-			    i__3 = i__;
-			    i__4 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
-				    z__2.i = temp.r * a[i__4].i + temp.i * a[
-				    i__4].r;
-			    z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +
-				    z__2.i;
-			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-/* L50: */
-			}
-			if (nounit) {
-			    i__1 = j;
-			    i__2 = j;
-			    i__3 = j + j * a_dim1;
-			    z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
-				    i__3].i, z__1.i = x[i__2].r * a[i__3].i +
-				    x[i__2].i * a[i__3].r;
-			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-			}
-		    }
-/* L60: */
-		}
-	    } else {
-		kx += (*n - 1) * *incx;
-		jx = kx;
-		for (j = *n; j >= 1; --j) {
-		    i__1 = jx;
-		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
-			i__1 = jx;
-			temp.r = x[i__1].r, temp.i = x[i__1].i;
-			ix = kx;
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    i__2 = ix;
-			    i__3 = ix;
-			    i__4 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
-				    z__2.i = temp.r * a[i__4].i + temp.i * a[
-				    i__4].r;
-			    z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +
-				    z__2.i;
-			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-			    ix -= *incx;
-/* L70: */
-			}
-			if (nounit) {
-			    i__1 = jx;
-			    i__2 = jx;
-			    i__3 = j + j * a_dim1;
-			    z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
-				    i__3].i, z__1.i = x[i__2].r * a[i__3].i +
-				    x[i__2].i * a[i__3].r;
-			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-			}
-		    }
-		    jx -= *incx;
-/* L80: */
-		}
-	    }
-	}
-    } else {
-
-/*        Form  x := A'*x  or  x := conjg( A' )*x. */
-
-	if (lsame_(uplo, "U")) {
-	    if (*incx == 1) {
-		for (j = *n; j >= 1; --j) {
-		    i__1 = j;
-		    temp.r = x[i__1].r, temp.i = x[i__1].i;
-		    if (noconj) {
-			if (nounit) {
-			    i__1 = j + j * a_dim1;
-			    z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
-				    z__1.i = temp.r * a[i__1].i + temp.i * a[
-				    i__1].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			for (i__ = j - 1; i__ >= 1; --i__) {
-			    i__1 = i__ + j * a_dim1;
-			    i__2 = i__;
-			    z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
-				    i__2].i, z__2.i = a[i__1].r * x[i__2].i +
-				    a[i__1].i * x[i__2].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L90: */
-			}
-		    } else {
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-				    z__1.i = temp.r * z__2.i + temp.i *
-				    z__2.r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			for (i__ = j - 1; i__ >= 1; --i__) {
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__1 = i__;
-			    z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
-				    z__2.i = z__3.r * x[i__1].i + z__3.i * x[
-				    i__1].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L100: */
-			}
-		    }
-		    i__1 = j;
-		    x[i__1].r = temp.r, x[i__1].i = temp.i;
-/* L110: */
-		}
-	    } else {
-		jx = kx + (*n - 1) * *incx;
-		for (j = *n; j >= 1; --j) {
-		    i__1 = jx;
-		    temp.r = x[i__1].r, temp.i = x[i__1].i;
-		    ix = jx;
-		    if (noconj) {
-			if (nounit) {
-			    i__1 = j + j * a_dim1;
-			    z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
-				    z__1.i = temp.r * a[i__1].i + temp.i * a[
-				    i__1].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			for (i__ = j - 1; i__ >= 1; --i__) {
-			    ix -= *incx;
-			    i__1 = i__ + j * a_dim1;
-			    i__2 = ix;
-			    z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
-				    i__2].i, z__2.i = a[i__1].r * x[i__2].i +
-				    a[i__1].i * x[i__2].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L120: */
-			}
-		    } else {
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-				    z__1.i = temp.r * z__2.i + temp.i *
-				    z__2.r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			for (i__ = j - 1; i__ >= 1; --i__) {
-			    ix -= *incx;
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__1 = ix;
-			    z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
-				    z__2.i = z__3.r * x[i__1].i + z__3.i * x[
-				    i__1].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L130: */
-			}
-		    }
-		    i__1 = jx;
-		    x[i__1].r = temp.r, x[i__1].i = temp.i;
-		    jx -= *incx;
-/* L140: */
-		}
-	    }
-	} else {
-	    if (*incx == 1) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    temp.r = x[i__2].r, temp.i = x[i__2].i;
-		    if (noconj) {
-			if (nounit) {
-			    i__2 = j + j * a_dim1;
-			    z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
-				    z__1.i = temp.r * a[i__2].i + temp.i * a[
-				    i__2].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			i__2 = *n;
-			for (i__ = j + 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * a_dim1;
-			    i__4 = i__;
-			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
-				    i__4].i, z__2.i = a[i__3].r * x[i__4].i +
-				    a[i__3].i * x[i__4].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L150: */
-			}
-		    } else {
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-				    z__1.i = temp.r * z__2.i + temp.i *
-				    z__2.r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			i__2 = *n;
-			for (i__ = j + 1; i__ <= i__2; ++i__) {
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__3 = i__;
-			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
-				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
-				    i__3].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L160: */
-			}
-		    }
-		    i__2 = j;
-		    x[i__2].r = temp.r, x[i__2].i = temp.i;
-/* L170: */
-		}
-	    } else {
-		jx = kx;
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = jx;
-		    temp.r = x[i__2].r, temp.i = x[i__2].i;
-		    ix = jx;
-		    if (noconj) {
-			if (nounit) {
-			    i__2 = j + j * a_dim1;
-			    z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
-				    z__1.i = temp.r * a[i__2].i + temp.i * a[
-				    i__2].r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			i__2 = *n;
-			for (i__ = j + 1; i__ <= i__2; ++i__) {
-			    ix += *incx;
-			    i__3 = i__ + j * a_dim1;
-			    i__4 = ix;
-			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
-				    i__4].i, z__2.i = a[i__3].r * x[i__4].i +
-				    a[i__3].i * x[i__4].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L180: */
-			}
-		    } else {
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z__1.r = temp.r * z__2.r - temp.i * z__2.i,
-				    z__1.i = temp.r * z__2.i + temp.i *
-				    z__2.r;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			i__2 = *n;
-			for (i__ = j + 1; i__ <= i__2; ++i__) {
-			    ix += *incx;
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__3 = ix;
-			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
-				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
-				    i__3].r;
-			    z__1.r = temp.r + z__2.r, z__1.i = temp.i +
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L190: */
-			}
-		    }
-		    i__2 = jx;
-		    x[i__2].r = temp.r, x[i__2].i = temp.i;
-		    jx += *incx;
-/* L200: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZTRMV . */
-
-} /* ztrmv_ */
-
-/* Subroutine */ int ztrsm_(char *side, char *uplo, char *transa, char *diag,
-	integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
-	integer *lda, doublecomplex *b, integer *ldb)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,
-	    i__6, i__7;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
-	    doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, k, info;
-    static doublecomplex temp;
-    static logical lside;
-    extern logical lsame_(char *, char *);
-    static integer nrowa;
-    static logical upper;
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical noconj, nounit;
-
-
-/*
-    Purpose
-    =======
-
-    ZTRSM  solves one of the matrix equations
-
-       op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
-
-    where alpha is a scalar, X and B are m by n matrices, A is a unit, or
-    non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
-
-       op( A ) = A   or   op( A ) = A'   or   op( A ) = conjg( A' ).
-
-    The matrix X is overwritten on B.
-
-    Parameters
-    ==========
-
-    SIDE   - CHARACTER*1.
-             On entry, SIDE specifies whether op( A ) appears on the left
-             or right of X as follows:
-
-                SIDE = 'L' or 'l'   op( A )*X = alpha*B.
-
-                SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
-
-             Unchanged on exit.
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix A is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANSA - CHARACTER*1.
-             On entry, TRANSA specifies the form of op( A ) to be used in
-             the matrix multiplication as follows:
-
-                TRANSA = 'N' or 'n'   op( A ) = A.
-
-                TRANSA = 'T' or 't'   op( A ) = A'.
-
-                TRANSA = 'C' or 'c'   op( A ) = conjg( A' ).
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit triangular
-             as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    M      - INTEGER.
-             On entry, M specifies the number of rows of B. M must be at
-             least zero.
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the number of columns of B.  N must be
-             at least zero.
-             Unchanged on exit.
-
-    ALPHA  - COMPLEX*16      .
-             On entry,  ALPHA specifies the scalar  alpha. When  alpha is
-             zero then  A is not referenced and  B need not be set before
-             entry.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, k ), where k is m
-             when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
-             Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
-             upper triangular part of the array  A must contain the upper
-             triangular matrix  and the strictly lower triangular part of
-             A is not referenced.
-             Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
-             lower triangular part of the array  A must contain the lower
-             triangular matrix  and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u',  the diagonal elements of
-             A  are not referenced either,  but are assumed to be  unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
-             LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
-             then LDA must be at least max( 1, n ).
-             Unchanged on exit.
-
-    B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
-             Before entry,  the leading  m by n part of the array  B must
-             contain  the  right-hand  side  matrix  B,  and  on exit  is
-             overwritten by the solution matrix  X.
-
-    LDB    - INTEGER.
-             On entry, LDB specifies the first dimension of B as declared
-             in  the  calling  (sub)  program.   LDB  must  be  at  least
-             max( 1, m ).
-             Unchanged on exit.
-
-
-    Level 3 Blas routine.
-
-    -- Written on 8-February-1989.
-       Jack Dongarra, Argonne National Laboratory.
-       Iain Duff, AERE Harwell.
-       Jeremy Du Croz, Numerical Algorithms Group Ltd.
-       Sven Hammarling, Numerical Algorithms Group Ltd.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    b_dim1 = *ldb;
-    b_offset = 1 + b_dim1 * 1;
-    b -= b_offset;
-
-    /* Function Body */
-    lside = lsame_(side, "L");
-    if (lside) {
-	nrowa = *m;
-    } else {
-	nrowa = *n;
-    }
-    noconj = lsame_(transa, "T");
-    nounit = lsame_(diag, "N");
-    upper = lsame_(uplo, "U");
-
-    info = 0;
-    if ((! lside && ! lsame_(side, "R"))) {
-	info = 1;
-    } else if ((! upper && ! lsame_(uplo, "L"))) {
-	info = 2;
-    } else if (((! lsame_(transa, "N") && ! lsame_(
-	    transa, "T")) && ! lsame_(transa, "C"))) {
-	info = 3;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 4;
-    } else if (*m < 0) {
-	info = 5;
-    } else if (*n < 0) {
-	info = 6;
-    } else if (*lda < max(1,nrowa)) {
-	info = 9;
-    } else if (*ldb < max(1,*m)) {
-	info = 11;
-    }
-    if (info != 0) {
-	xerbla_("ZTRSM ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-/*     And when  alpha.eq.zero. */
-
-    if ((alpha->r == 0. && alpha->i == 0.)) {
-	i__1 = *n;
-	for (j = 1; j <= i__1; ++j) {
-	    i__2 = *m;
-	    for (i__ = 1; i__ <= i__2; ++i__) {
-		i__3 = i__ + j * b_dim1;
-		b[i__3].r = 0., b[i__3].i = 0.;
-/* L10: */
-	    }
-/* L20: */
-	}
-	return 0;
-    }
-
-/*     Start the operations. */
-
-    if (lside) {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*inv( A )*B. */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (alpha->r != 1. || alpha->i != 0.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * b_dim1;
-			    i__4 = i__ + j * b_dim1;
-			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
-				    .i, z__1.i = alpha->r * b[i__4].i +
-				    alpha->i * b[i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L30: */
-			}
-		    }
-		    for (k = *m; k >= 1; --k) {
-			i__2 = k + j * b_dim1;
-			if (b[i__2].r != 0. || b[i__2].i != 0.) {
-			    if (nounit) {
-				i__2 = k + j * b_dim1;
-				z_div(&z__1, &b[k + j * b_dim1], &a[k + k *
-					a_dim1]);
-				b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-			    }
-			    i__2 = k - 1;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				i__3 = i__ + j * b_dim1;
-				i__4 = i__ + j * b_dim1;
-				i__5 = k + j * b_dim1;
-				i__6 = i__ + k * a_dim1;
-				z__2.r = b[i__5].r * a[i__6].r - b[i__5].i *
-					a[i__6].i, z__2.i = b[i__5].r * a[
-					i__6].i + b[i__5].i * a[i__6].r;
-				z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
-					.i - z__2.i;
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L40: */
-			    }
-			}
-/* L50: */
-		    }
-/* L60: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (alpha->r != 1. || alpha->i != 0.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * b_dim1;
-			    i__4 = i__ + j * b_dim1;
-			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
-				    .i, z__1.i = alpha->r * b[i__4].i +
-				    alpha->i * b[i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L70: */
-			}
-		    }
-		    i__2 = *m;
-		    for (k = 1; k <= i__2; ++k) {
-			i__3 = k + j * b_dim1;
-			if (b[i__3].r != 0. || b[i__3].i != 0.) {
-			    if (nounit) {
-				i__3 = k + j * b_dim1;
-				z_div(&z__1, &b[k + j * b_dim1], &a[k + k *
-					a_dim1]);
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-			    }
-			    i__3 = *m;
-			    for (i__ = k + 1; i__ <= i__3; ++i__) {
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + j * b_dim1;
-				i__6 = k + j * b_dim1;
-				i__7 = i__ + k * a_dim1;
-				z__2.r = b[i__6].r * a[i__7].r - b[i__6].i *
-					a[i__7].i, z__2.i = b[i__6].r * a[
-					i__7].i + b[i__6].i * a[i__7].r;
-				z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
-					.i - z__2.i;
-				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
-/* L80: */
-			    }
-			}
-/* L90: */
-		    }
-/* L100: */
-		}
-	    }
-	} else {
-
-/*
-             Form  B := alpha*inv( A' )*B
-             or    B := alpha*inv( conjg( A' ) )*B.
-*/
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = *m;
-		    for (i__ = 1; i__ <= i__2; ++i__) {
-			i__3 = i__ + j * b_dim1;
-			z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
-				z__1.i = alpha->r * b[i__3].i + alpha->i * b[
-				i__3].r;
-			temp.r = z__1.r, temp.i = z__1.i;
-			if (noconj) {
-			    i__3 = i__ - 1;
-			    for (k = 1; k <= i__3; ++k) {
-				i__4 = k + i__ * a_dim1;
-				i__5 = k + j * b_dim1;
-				z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *
-					b[i__5].i, z__2.i = a[i__4].r * b[
-					i__5].i + a[i__4].i * b[i__5].r;
-				z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L110: */
-			    }
-			    if (nounit) {
-				z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			} else {
-			    i__3 = i__ - 1;
-			    for (k = 1; k <= i__3; ++k) {
-				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
-				i__4 = k + j * b_dim1;
-				z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
-					.i, z__2.i = z__3.r * b[i__4].i +
-					z__3.i * b[i__4].r;
-				z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L120: */
-			    }
-			    if (nounit) {
-				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
-				z_div(&z__1, &temp, &z__2);
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			}
-			i__3 = i__ + j * b_dim1;
-			b[i__3].r = temp.r, b[i__3].i = temp.i;
-/* L130: */
-		    }
-/* L140: */
-		}
-	    } else {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    for (i__ = *m; i__ >= 1; --i__) {
-			i__2 = i__ + j * b_dim1;
-			z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,
-				z__1.i = alpha->r * b[i__2].i + alpha->i * b[
-				i__2].r;
-			temp.r = z__1.r, temp.i = z__1.i;
-			if (noconj) {
-			    i__2 = *m;
-			    for (k = i__ + 1; k <= i__2; ++k) {
-				i__3 = k + i__ * a_dim1;
-				i__4 = k + j * b_dim1;
-				z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *
-					b[i__4].i, z__2.i = a[i__3].r * b[
-					i__4].i + a[i__3].i * b[i__4].r;
-				z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L150: */
-			    }
-			    if (nounit) {
-				z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			} else {
-			    i__2 = *m;
-			    for (k = i__ + 1; k <= i__2; ++k) {
-				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
-				i__3 = k + j * b_dim1;
-				z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
-					.i, z__2.i = z__3.r * b[i__3].i +
-					z__3.i * b[i__3].r;
-				z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-					z__2.i;
-				temp.r = z__1.r, temp.i = z__1.i;
-/* L160: */
-			    }
-			    if (nounit) {
-				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
-				z_div(&z__1, &temp, &z__2);
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			}
-			i__2 = i__ + j * b_dim1;
-			b[i__2].r = temp.r, b[i__2].i = temp.i;
-/* L170: */
-		    }
-/* L180: */
-		}
-	    }
-	}
-    } else {
-	if (lsame_(transa, "N")) {
-
-/*           Form  B := alpha*B*inv( A ). */
-
-	    if (upper) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    if (alpha->r != 1. || alpha->i != 0.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * b_dim1;
-			    i__4 = i__ + j * b_dim1;
-			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
-				    .i, z__1.i = alpha->r * b[i__4].i +
-				    alpha->i * b[i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L190: */
-			}
-		    }
-		    i__2 = j - 1;
-		    for (k = 1; k <= i__2; ++k) {
-			i__3 = k + j * a_dim1;
-			if (a[i__3].r != 0. || a[i__3].i != 0.) {
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + j * b_dim1;
-				i__6 = k + j * a_dim1;
-				i__7 = i__ + k * b_dim1;
-				z__2.r = a[i__6].r * b[i__7].r - a[i__6].i *
-					b[i__7].i, z__2.i = a[i__6].r * b[
-					i__7].i + a[i__6].i * b[i__7].r;
-				z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
-					.i - z__2.i;
-				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
-/* L200: */
-			    }
-			}
-/* L210: */
-		    }
-		    if (nounit) {
-			z_div(&z__1, &c_b359, &a[j + j * a_dim1]);
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * b_dim1;
-			    i__4 = i__ + j * b_dim1;
-			    z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
-				    z__1.i = temp.r * b[i__4].i + temp.i * b[
-				    i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L220: */
-			}
-		    }
-/* L230: */
-		}
-	    } else {
-		for (j = *n; j >= 1; --j) {
-		    if (alpha->r != 1. || alpha->i != 0.) {
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    i__2 = i__ + j * b_dim1;
-			    i__3 = i__ + j * b_dim1;
-			    z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
-				    .i, z__1.i = alpha->r * b[i__3].i +
-				    alpha->i * b[i__3].r;
-			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L240: */
-			}
-		    }
-		    i__1 = *n;
-		    for (k = j + 1; k <= i__1; ++k) {
-			i__2 = k + j * a_dim1;
-			if (a[i__2].r != 0. || a[i__2].i != 0.) {
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				i__3 = i__ + j * b_dim1;
-				i__4 = i__ + j * b_dim1;
-				i__5 = k + j * a_dim1;
-				i__6 = i__ + k * b_dim1;
-				z__2.r = a[i__5].r * b[i__6].r - a[i__5].i *
-					b[i__6].i, z__2.i = a[i__5].r * b[
-					i__6].i + a[i__5].i * b[i__6].r;
-				z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
-					.i - z__2.i;
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L250: */
-			    }
-			}
-/* L260: */
-		    }
-		    if (nounit) {
-			z_div(&z__1, &c_b359, &a[j + j * a_dim1]);
-			temp.r = z__1.r, temp.i = z__1.i;
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    i__2 = i__ + j * b_dim1;
-			    i__3 = i__ + j * b_dim1;
-			    z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
-				    z__1.i = temp.r * b[i__3].i + temp.i * b[
-				    i__3].r;
-			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L270: */
-			}
-		    }
-/* L280: */
-		}
-	    }
-	} else {
-
-/*
-             Form  B := alpha*B*inv( A' )
-             or    B := alpha*B*inv( conjg( A' ) ).
-*/
-
-	    if (upper) {
-		for (k = *n; k >= 1; --k) {
-		    if (nounit) {
-			if (noconj) {
-			    z_div(&z__1, &c_b359, &a[k + k * a_dim1]);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			} else {
-			    d_cnjg(&z__2, &a[k + k * a_dim1]);
-			    z_div(&z__1, &c_b359, &z__2);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    i__2 = i__ + k * b_dim1;
-			    i__3 = i__ + k * b_dim1;
-			    z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
-				    z__1.i = temp.r * b[i__3].i + temp.i * b[
-				    i__3].r;
-			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L290: */
-			}
-		    }
-		    i__1 = k - 1;
-		    for (j = 1; j <= i__1; ++j) {
-			i__2 = j + k * a_dim1;
-			if (a[i__2].r != 0. || a[i__2].i != 0.) {
-			    if (noconj) {
-				i__2 = j + k * a_dim1;
-				temp.r = a[i__2].r, temp.i = a[i__2].i;
-			    } else {
-				d_cnjg(&z__1, &a[j + k * a_dim1]);
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__2 = *m;
-			    for (i__ = 1; i__ <= i__2; ++i__) {
-				i__3 = i__ + j * b_dim1;
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + k * b_dim1;
-				z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
-					.i, z__2.i = temp.r * b[i__5].i +
-					temp.i * b[i__5].r;
-				z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
-					.i - z__2.i;
-				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L300: */
-			    }
-			}
-/* L310: */
-		    }
-		    if (alpha->r != 1. || alpha->i != 0.) {
-			i__1 = *m;
-			for (i__ = 1; i__ <= i__1; ++i__) {
-			    i__2 = i__ + k * b_dim1;
-			    i__3 = i__ + k * b_dim1;
-			    z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
-				    .i, z__1.i = alpha->r * b[i__3].i +
-				    alpha->i * b[i__3].r;
-			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
-/* L320: */
-			}
-		    }
-/* L330: */
-		}
-	    } else {
-		i__1 = *n;
-		for (k = 1; k <= i__1; ++k) {
-		    if (nounit) {
-			if (noconj) {
-			    z_div(&z__1, &c_b359, &a[k + k * a_dim1]);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			} else {
-			    d_cnjg(&z__2, &a[k + k * a_dim1]);
-			    z_div(&z__1, &c_b359, &z__2);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + k * b_dim1;
-			    i__4 = i__ + k * b_dim1;
-			    z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
-				    z__1.i = temp.r * b[i__4].i + temp.i * b[
-				    i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L340: */
-			}
-		    }
-		    i__2 = *n;
-		    for (j = k + 1; j <= i__2; ++j) {
-			i__3 = j + k * a_dim1;
-			if (a[i__3].r != 0. || a[i__3].i != 0.) {
-			    if (noconj) {
-				i__3 = j + k * a_dim1;
-				temp.r = a[i__3].r, temp.i = a[i__3].i;
-			    } else {
-				d_cnjg(&z__1, &a[j + k * a_dim1]);
-				temp.r = z__1.r, temp.i = z__1.i;
-			    }
-			    i__3 = *m;
-			    for (i__ = 1; i__ <= i__3; ++i__) {
-				i__4 = i__ + j * b_dim1;
-				i__5 = i__ + j * b_dim1;
-				i__6 = i__ + k * b_dim1;
-				z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
-					.i, z__2.i = temp.r * b[i__6].i +
-					temp.i * b[i__6].r;
-				z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
-					.i - z__2.i;
-				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
-/* L350: */
-			    }
-			}
-/* L360: */
-		    }
-		    if (alpha->r != 1. || alpha->i != 0.) {
-			i__2 = *m;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + k * b_dim1;
-			    i__4 = i__ + k * b_dim1;
-			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
-				    .i, z__1.i = alpha->r * b[i__4].i +
-				    alpha->i * b[i__4].r;
-			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
-/* L370: */
-			}
-		    }
-/* L380: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZTRSM . */
-
-} /* ztrsm_ */
-
-/* Subroutine */ int ztrsv_(char *uplo, char *trans, char *diag, integer *n,
-	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)
-{
-    /* System generated locals */
-    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
-    doublecomplex z__1, z__2, z__3;
-
-    /* Builtin functions */
-    void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
-	    doublecomplex *, doublecomplex *);
-
-    /* Local variables */
-    static integer i__, j, ix, jx, kx, info;
-    static doublecomplex temp;
-    extern logical lsame_(char *, char *);
-    extern /* Subroutine */ int xerbla_(char *, integer *);
-    static logical noconj, nounit;
-
-
-/*
-    Purpose
-    =======
-
-    ZTRSV  solves one of the systems of equations
-
-       A*x = b,   or   A'*x = b,   or   conjg( A' )*x = b,
-
-    where b and x are n element vectors and A is an n by n unit, or
-    non-unit, upper or lower triangular matrix.
-
-    No test for singularity or near-singularity is included in this
-    routine. Such tests must be performed before calling this routine.
-
-    Parameters
-    ==========
-
-    UPLO   - CHARACTER*1.
-             On entry, UPLO specifies whether the matrix is an upper or
-             lower triangular matrix as follows:
-
-                UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-                UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-             Unchanged on exit.
-
-    TRANS  - CHARACTER*1.
-             On entry, TRANS specifies the equations to be solved as
-             follows:
-
-                TRANS = 'N' or 'n'   A*x = b.
-
-                TRANS = 'T' or 't'   A'*x = b.
-
-                TRANS = 'C' or 'c'   conjg( A' )*x = b.
-
-             Unchanged on exit.
-
-    DIAG   - CHARACTER*1.
-             On entry, DIAG specifies whether or not A is unit
-             triangular as follows:
-
-                DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-                DIAG = 'N' or 'n'   A is not assumed to be unit
-                                    triangular.
-
-             Unchanged on exit.
-
-    N      - INTEGER.
-             On entry, N specifies the order of the matrix A.
-             N must be at least zero.
-             Unchanged on exit.
-
-    A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
-             Before entry with  UPLO = 'U' or 'u', the leading n by n
-             upper triangular part of the array A must contain the upper
-             triangular matrix and the strictly lower triangular part of
-             A is not referenced.
-             Before entry with UPLO = 'L' or 'l', the leading n by n
-             lower triangular part of the array A must contain the lower
-             triangular matrix and the strictly upper triangular part of
-             A is not referenced.
-             Note that when  DIAG = 'U' or 'u', the diagonal elements of
-             A are not referenced either, but are assumed to be unity.
-             Unchanged on exit.
-
-    LDA    - INTEGER.
-             On entry, LDA specifies the first dimension of A as declared
-             in the calling (sub) program. LDA must be at least
-             max( 1, n ).
-             Unchanged on exit.
-
-    X      - COMPLEX*16       array of dimension at least
-             ( 1 + ( n - 1 )*abs( INCX ) ).
-             Before entry, the incremented array X must contain the n
-             element right-hand side vector b. On exit, X is overwritten
-             with the solution vector x.
-
-    INCX   - INTEGER.
-             On entry, INCX specifies the increment for the elements of
-             X. INCX must not be zero.
-             Unchanged on exit.
-
-
-    Level 2 Blas routine.
-
-    -- Written on 22-October-1986.
-       Jack Dongarra, Argonne National Lab.
-       Jeremy Du Croz, Nag Central Office.
-       Sven Hammarling, Nag Central Office.
-       Richard Hanson, Sandia National Labs.
-
-
-       Test the input parameters.
-*/
-
-    /* Parameter adjustments */
-    a_dim1 = *lda;
-    a_offset = 1 + a_dim1 * 1;
-    a -= a_offset;
-    --x;
-
-    /* Function Body */
-    info = 0;
-    if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
-	info = 1;
-    } else if (((! lsame_(trans, "N") && ! lsame_(trans,
-	     "T")) && ! lsame_(trans, "C"))) {
-	info = 2;
-    } else if ((! lsame_(diag, "U") && ! lsame_(diag,
-	    "N"))) {
-	info = 3;
-    } else if (*n < 0) {
-	info = 4;
-    } else if (*lda < max(1,*n)) {
-	info = 6;
-    } else if (*incx == 0) {
-	info = 8;
-    }
-    if (info != 0) {
-	xerbla_("ZTRSV ", &info);
-	return 0;
-    }
-
-/*     Quick return if possible. */
-
-    if (*n == 0) {
-	return 0;
-    }
-
-    noconj = lsame_(trans, "T");
-    nounit = lsame_(diag, "N");
-
-/*
-       Set up the start point in X if the increment is not unity. This
-       will be  ( N - 1 )*INCX  too small for descending loops.
-*/
-
-    if (*incx <= 0) {
-	kx = 1 - (*n - 1) * *incx;
-    } else if (*incx != 1) {
-	kx = 1;
-    }
-
-/*
-       Start the operations. In this version the elements of A are
-       accessed sequentially with one pass through A.
-*/
-
-    if (lsame_(trans, "N")) {
-
-/*        Form  x := inv( A )*x. */
-
-	if (lsame_(uplo, "U")) {
-	    if (*incx == 1) {
-		for (j = *n; j >= 1; --j) {
-		    i__1 = j;
-		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
-			if (nounit) {
-			    i__1 = j;
-			    z_div(&z__1, &x[j], &a[j + j * a_dim1]);
-			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-			}
-			i__1 = j;
-			temp.r = x[i__1].r, temp.i = x[i__1].i;
-			for (i__ = j - 1; i__ >= 1; --i__) {
-			    i__1 = i__;
-			    i__2 = i__;
-			    i__3 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
-				    z__2.i = temp.r * a[i__3].i + temp.i * a[
-				    i__3].r;
-			    z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i -
-				    z__2.i;
-			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-/* L10: */
-			}
-		    }
-/* L20: */
-		}
-	    } else {
-		jx = kx + (*n - 1) * *incx;
-		for (j = *n; j >= 1; --j) {
-		    i__1 = jx;
-		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
-			if (nounit) {
-			    i__1 = jx;
-			    z_div(&z__1, &x[jx], &a[j + j * a_dim1]);
-			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-			}
-			i__1 = jx;
-			temp.r = x[i__1].r, temp.i = x[i__1].i;
-			ix = jx;
-			for (i__ = j - 1; i__ >= 1; --i__) {
-			    ix -= *incx;
-			    i__1 = ix;
-			    i__2 = ix;
-			    i__3 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
-				    z__2.i = temp.r * a[i__3].i + temp.i * a[
-				    i__3].r;
-			    z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i -
-				    z__2.i;
-			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
-/* L30: */
-			}
-		    }
-		    jx -= *incx;
-/* L40: */
-		}
-	    }
-	} else {
-	    if (*incx == 1) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
-			if (nounit) {
-			    i__2 = j;
-			    z_div(&z__1, &x[j], &a[j + j * a_dim1]);
-			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-			}
-			i__2 = j;
-			temp.r = x[i__2].r, temp.i = x[i__2].i;
-			i__2 = *n;
-			for (i__ = j + 1; i__ <= i__2; ++i__) {
-			    i__3 = i__;
-			    i__4 = i__;
-			    i__5 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				    z__2.i = temp.r * a[i__5].i + temp.i * a[
-				    i__5].r;
-			    z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i -
-				    z__2.i;
-			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
-/* L50: */
-			}
-		    }
-/* L60: */
-		}
-	    } else {
-		jx = kx;
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = jx;
-		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
-			if (nounit) {
-			    i__2 = jx;
-			    z_div(&z__1, &x[jx], &a[j + j * a_dim1]);
-			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
-			}
-			i__2 = jx;
-			temp.r = x[i__2].r, temp.i = x[i__2].i;
-			ix = jx;
-			i__2 = *n;
-			for (i__ = j + 1; i__ <= i__2; ++i__) {
-			    ix += *incx;
-			    i__3 = ix;
-			    i__4 = ix;
-			    i__5 = i__ + j * a_dim1;
-			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
-				    z__2.i = temp.r * a[i__5].i + temp.i * a[
-				    i__5].r;
-			    z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i -
-				    z__2.i;
-			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
-/* L70: */
-			}
-		    }
-		    jx += *incx;
-/* L80: */
-		}
-	    }
-	}
-    } else {
-
-/*        Form  x := inv( A' )*x  or  x := inv( conjg( A' ) )*x. */
-
-	if (lsame_(uplo, "U")) {
-	    if (*incx == 1) {
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    i__2 = j;
-		    temp.r = x[i__2].r, temp.i = x[i__2].i;
-		    if (noconj) {
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * a_dim1;
-			    i__4 = i__;
-			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
-				    i__4].i, z__2.i = a[i__3].r * x[i__4].i +
-				    a[i__3].i * x[i__4].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L90: */
-			}
-			if (nounit) {
-			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    } else {
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__3 = i__;
-			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
-				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
-				    i__3].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L100: */
-			}
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z_div(&z__1, &temp, &z__2);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    }
-		    i__2 = j;
-		    x[i__2].r = temp.r, x[i__2].i = temp.i;
-/* L110: */
-		}
-	    } else {
-		jx = kx;
-		i__1 = *n;
-		for (j = 1; j <= i__1; ++j) {
-		    ix = kx;
-		    i__2 = jx;
-		    temp.r = x[i__2].r, temp.i = x[i__2].i;
-		    if (noconj) {
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    i__3 = i__ + j * a_dim1;
-			    i__4 = ix;
-			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
-				    i__4].i, z__2.i = a[i__3].r * x[i__4].i +
-				    a[i__3].i * x[i__4].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    ix += *incx;
-/* L120: */
-			}
-			if (nounit) {
-			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    } else {
-			i__2 = j - 1;
-			for (i__ = 1; i__ <= i__2; ++i__) {
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__3 = ix;
-			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
-				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
-				    i__3].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    ix += *incx;
-/* L130: */
-			}
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z_div(&z__1, &temp, &z__2);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    }
-		    i__2 = jx;
-		    x[i__2].r = temp.r, x[i__2].i = temp.i;
-		    jx += *incx;
-/* L140: */
-		}
-	    }
-	} else {
-	    if (*incx == 1) {
-		for (j = *n; j >= 1; --j) {
-		    i__1 = j;
-		    temp.r = x[i__1].r, temp.i = x[i__1].i;
-		    if (noconj) {
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    i__2 = i__ + j * a_dim1;
-			    i__3 = i__;
-			    z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[
-				    i__3].i, z__2.i = a[i__2].r * x[i__3].i +
-				    a[i__2].i * x[i__3].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L150: */
-			}
-			if (nounit) {
-			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    } else {
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__2 = i__;
-			    z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
-				    z__2.i = z__3.r * x[i__2].i + z__3.i * x[
-				    i__2].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-/* L160: */
-			}
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z_div(&z__1, &temp, &z__2);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    }
-		    i__1 = j;
-		    x[i__1].r = temp.r, x[i__1].i = temp.i;
-/* L170: */
-		}
-	    } else {
-		kx += (*n - 1) * *incx;
-		jx = kx;
-		for (j = *n; j >= 1; --j) {
-		    ix = kx;
-		    i__1 = jx;
-		    temp.r = x[i__1].r, temp.i = x[i__1].i;
-		    if (noconj) {
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    i__2 = i__ + j * a_dim1;
-			    i__3 = ix;
-			    z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[
-				    i__3].i, z__2.i = a[i__2].r * x[i__3].i +
-				    a[i__2].i * x[i__3].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    ix -= *incx;
-/* L180: */
-			}
-			if (nounit) {
-			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    } else {
-			i__1 = j + 1;
-			for (i__ = *n; i__ >= i__1; --i__) {
-			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
-			    i__2 = ix;
-			    z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
-				    z__2.i = z__3.r * x[i__2].i + z__3.i * x[
-				    i__2].r;
-			    z__1.r = temp.r - z__2.r, z__1.i = temp.i -
-				    z__2.i;
-			    temp.r = z__1.r, temp.i = z__1.i;
-			    ix -= *incx;
-/* L190: */
-			}
-			if (nounit) {
-			    d_cnjg(&z__2, &a[j + j * a_dim1]);
-			    z_div(&z__1, &temp, &z__2);
-			    temp.r = z__1.r, temp.i = z__1.i;
-			}
-		    }
-		    i__1 = jx;
-		    x[i__1].r = temp.r, x[i__1].i = temp.i;
-		    jx -= *incx;
-/* L200: */
-		}
-	    }
-	}
-    }
-
-    return 0;
-
-/*     End of ZTRSV . */
-
-} /* ztrsv_ */
-