#include "blaswrap.h" #include "f2c.h" /* Subroutine */ int ztrti2_(char *uplo, char *diag, integer *n, doublecomplex *a, integer *lda, integer *info) { /* -- LAPACK routine (version 3.1) -- Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. November 2006 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 ===================================================================== Test the input parameters. Parameter adjustments */ /* Table of constant values */ static doublecomplex c_b1 = {1.,0.}; static integer c__1 = 1; /* 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 */ static integer j; static doublecomplex ajj; extern logical lsame_(char *, char *); extern /* Subroutine */ int zscal_(integer *, doublecomplex *, doublecomplex *, integer *); static logical upper; extern /* Subroutine */ int ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); static logical nounit; 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_ */