#include "f2c.h" #include "blaswrap.h" /* Table of constant values */ static doublecomplex c_b1 = {1.,0.}; static integer c__1 = 1; /* Subroutine */ int ztrti2_(char *uplo, char *diag, integer *n, doublecomplex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; doublecomplex z__1; /* Builtin functions */ void z_div(doublecomplex *, doublecomplex *, doublecomplex *); /* Local variables */ integer j; doublecomplex ajj; extern logical lsame_(char *, char *); extern /* Subroutine */ int zscal_(integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ int ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); logical nounit; /* -- LAPACK routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZTRTI2 computes the inverse of a complex upper or lower triangular */ /* matrix. */ /* This is the Level 2 BLAS version of the algorithm. */ /* Arguments */ /* ========= */ /* UPLO (input) CHARACTER*1 */ /* Specifies whether the matrix A is upper or lower triangular. */ /* = 'U': Upper triangular */ /* = 'L': Lower triangular */ /* DIAG (input) CHARACTER*1 */ /* Specifies whether or not the matrix A is unit triangular. */ /* = 'N': Non-unit triangular */ /* = 'U': Unit triangular */ /* N (input) INTEGER */ /* The order of the matrix A. N >= 0. */ /* A (input/output) COMPLEX*16 array, dimension (LDA,N) */ /* On entry, the triangular matrix A. If UPLO = 'U', the */ /* leading n by n upper triangular part of the array A contains */ /* the upper triangular matrix, and the strictly lower */ /* triangular part of A is not referenced. If UPLO = 'L', the */ /* leading n by n lower triangular part of the array A contains */ /* the lower triangular matrix, and the strictly upper */ /* triangular part of A is not referenced. If DIAG = 'U', the */ /* diagonal elements of A are also not referenced and are */ /* assumed to be 1. */ /* On exit, the (triangular) inverse of the original matrix, in */ /* the same storage format. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,N). */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -k, the k-th argument had an illegal value */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Test the input parameters. */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); nounit = lsame_(diag, "N"); if (! upper && ! lsame_(uplo, "L")) { *info = -1; } else if (! nounit && ! lsame_(diag, "U")) { *info = -2; } else if (*n < 0) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } if (*info != 0) { i__1 = -(*info); xerbla_("ZTRTI2", &i__1); return 0; } if (upper) { /* Compute inverse of upper triangular matrix. */ i__1 = *n; for (j = 1; j <= i__1; ++j) { if (nounit) { i__2 = j + j * a_dim1; z_div(&z__1, &c_b1, &a[j + j * a_dim1]); a[i__2].r = z__1.r, a[i__2].i = z__1.i; i__2 = j + j * a_dim1; z__1.r = -a[i__2].r, z__1.i = -a[i__2].i; ajj.r = z__1.r, ajj.i = z__1.i; } else { z__1.r = -1., z__1.i = -0.; ajj.r = z__1.r, ajj.i = z__1.i; } /* Compute elements 1:j-1 of j-th column. */ i__2 = j - 1; ztrmv_("Upper", "No transpose", diag, &i__2, &a[a_offset], lda, & a[j * a_dim1 + 1], &c__1); i__2 = j - 1; zscal_(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1); /* L10: */ } } else { /* Compute inverse of lower triangular matrix. */ for (j = *n; j >= 1; --j) { if (nounit) { i__1 = j + j * a_dim1; z_div(&z__1, &c_b1, &a[j + j * a_dim1]); a[i__1].r = z__1.r, a[i__1].i = z__1.i; i__1 = j + j * a_dim1; z__1.r = -a[i__1].r, z__1.i = -a[i__1].i; ajj.r = z__1.r, ajj.i = z__1.i; } else { z__1.r = -1., z__1.i = -0.; ajj.r = z__1.r, ajj.i = z__1.i; } if (j < *n) { /* Compute elements j+1:n of j-th column. */ i__1 = *n - j; ztrmv_("Lower", "No transpose", diag, &i__1, &a[j + 1 + (j + 1) * a_dim1], lda, &a[j + 1 + j * a_dim1], &c__1); i__1 = *n - j; zscal_(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1); } /* L20: */ } } return 0; /* End of ZTRTI2 */ } /* ztrti2_ */