/* Subroutine */ int spotri_(char *uplo, integer *n, real *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1; /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *), slauum_( char *, integer *, real *, integer *, integer *), strtri_( char *, char *, integer *, real *, integer *, integer *); /* -- LAPACK routine (version 3.2) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SPOTRI computes the inverse of a real symmetric positive definite */ /* matrix A using the Cholesky factorization A = U**T*U or A = L*L**T */ /* computed by SPOTRF. */ /* Arguments */ /* ========= */ /* UPLO (input) CHARACTER*1 */ /* = 'U': Upper triangle of A is stored; */ /* = 'L': Lower triangle of A is stored. */ /* N (input) INTEGER */ /* The order of the matrix A. N >= 0. */ /* A (input/output) REAL array, dimension (LDA,N) */ /* On entry, the triangular factor U or L from the Cholesky */ /* factorization A = U**T*U or A = L*L**T, as computed by */ /* SPOTRF. */ /* On exit, the upper or lower triangle of the (symmetric) */ /* inverse of A, overwriting the input factor U or L. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,N). */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value */ /* > 0: if INFO = i, the (i,i) element of the factor U or L is */ /* zero, and the inverse could not be computed. */ /* ===================================================================== */ /* .. 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; if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) { *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < max(1,*n)) { *info = -4; } if (*info != 0) { i__1 = -(*info); xerbla_("SPOTRI", &i__1); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Invert the triangular Cholesky factor U or L. */ strtri_(uplo, "Non-unit", n, &a[a_offset], lda, info); if (*info > 0) { return 0; } /* Form inv(U)*inv(U)' or inv(L)'*inv(L). */ slauum_(uplo, n, &a[a_offset], lda, info); return 0; /* End of SPOTRI */ } /* spotri_ */
/* Subroutine */ int sgetri_(integer *n, real *a, integer *lda, integer *ipiv, real *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ integer i__, j, jb, nb, jj, jp, nn, iws, nbmin; extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; extern /* Subroutine */ int strtri_(char *, char *, integer *, real *, integer *, integer *); /* -- LAPACK routine (version 3.2) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SGETRI computes the inverse of a matrix using the LU factorization */ /* computed by SGETRF. */ /* This method inverts U and then computes inv(A) by solving the system */ /* inv(A)*L = inv(U) for inv(A). */ /* Arguments */ /* ========= */ /* N (input) INTEGER */ /* The order of the matrix A. N >= 0. */ /* A (input/output) REAL array, dimension (LDA,N) */ /* On entry, the factors L and U from the factorization */ /* A = P*L*U as computed by SGETRF. */ /* On exit, if INFO = 0, the inverse of the original matrix A. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,N). */ /* IPIV (input) INTEGER array, dimension (N) */ /* The pivot indices from SGETRF; for 1<=i<=N, row i of the */ /* matrix was interchanged with row IPIV(i). */ /* WORK (workspace/output) REAL array, dimension (MAX(1,LWORK)) */ /* On exit, if INFO=0, then WORK(1) returns the optimal LWORK. */ /* LWORK (input) INTEGER */ /* The dimension of the array WORK. LWORK >= max(1,N). */ /* For optimal performance LWORK >= N*NB, where NB is */ /* the optimal blocksize returned by ILAENV. */ /* If LWORK = -1, then a workspace query is assumed; the routine */ /* only calculates the optimal size of the WORK array, returns */ /* this value as the first entry of the WORK array, and no error */ /* message related to LWORK is issued by XERBLA. */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value */ /* > 0: if INFO = i, U(i,i) is exactly zero; the matrix is */ /* singular and its inverse could not be computed. */ /* ===================================================================== */ /* .. 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; --ipiv; --work; /* Function Body */ *info = 0; nb = ilaenv_(&c__1, "SGETRI", " ", n, &c_n1, &c_n1, &c_n1); lwkopt = *n * nb; work[1] = (real) lwkopt; lquery = *lwork == -1; if (*n < 0) { *info = -1; } else if (*lda < max(1,*n)) { *info = -3; } else if (*lwork < max(1,*n) && ! lquery) { *info = -6; } if (*info != 0) { i__1 = -(*info); xerbla_("SGETRI", &i__1); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Form inv(U). If INFO > 0 from STRTRI, then U is singular, */ /* and the inverse is not computed. */ strtri_("Upper", "Non-unit", n, &a[a_offset], lda, info); if (*info > 0) { return 0; } nbmin = 2; ldwork = *n; if (nb > 1 && nb < *n) { /* Computing MAX */ i__1 = ldwork * nb; iws = max(i__1,1); if (*lwork < iws) { nb = *lwork / ldwork; /* Computing MAX */ i__1 = 2, i__2 = ilaenv_(&c__2, "SGETRI", " ", n, &c_n1, &c_n1, & c_n1); nbmin = max(i__1,i__2); } } else { iws = *n; } /* Solve the equation inv(A)*L = inv(U) for inv(A). */ if (nb < nbmin || nb >= *n) { /* Use unblocked code. */ for (j = *n; j >= 1; --j) { /* Copy current column of L to WORK and replace with zeros. */ i__1 = *n; for (i__ = j + 1; i__ <= i__1; ++i__) { work[i__] = a[i__ + j * a_dim1]; a[i__ + j * a_dim1] = 0.f; /* L10: */ } /* Compute current column of inv(A). */ if (j < *n) { i__1 = *n - j; sgemv_("No transpose", n, &i__1, &c_b20, &a[(j + 1) * a_dim1 + 1], lda, &work[j + 1], &c__1, &c_b22, &a[j * a_dim1 + 1], &c__1); } /* L20: */ } } else { /* Use blocked code. */ nn = (*n - 1) / nb * nb + 1; i__1 = -nb; for (j = nn; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) { /* Computing MIN */ i__2 = nb, i__3 = *n - j + 1; jb = min(i__2,i__3); /* Copy current block column of L to WORK and replace with */ /* zeros. */ i__2 = j + jb - 1; for (jj = j; jj <= i__2; ++jj) { i__3 = *n; for (i__ = jj + 1; i__ <= i__3; ++i__) { work[i__ + (jj - j) * ldwork] = a[i__ + jj * a_dim1]; a[i__ + jj * a_dim1] = 0.f; /* L30: */ } /* L40: */ } /* Compute current block column of inv(A). */ if (j + jb <= *n) { i__2 = *n - j - jb + 1; sgemm_("No transpose", "No transpose", n, &jb, &i__2, &c_b20, &a[(j + jb) * a_dim1 + 1], lda, &work[j + jb], & ldwork, &c_b22, &a[j * a_dim1 + 1], lda); } strsm_("Right", "Lower", "No transpose", "Unit", n, &jb, &c_b22, & work[j], &ldwork, &a[j * a_dim1 + 1], lda); /* L50: */ } } /* Apply column interchanges. */ for (j = *n - 1; j >= 1; --j) { jp = ipiv[j]; if (jp != j) { sswap_(n, &a[j * a_dim1 + 1], &c__1, &a[jp * a_dim1 + 1], &c__1); } /* L60: */ } work[1] = (real) iws; return 0; /* End of SGETRI */ } /* sgetri_ */
int stftri_(char *transr, char *uplo, char *diag, int *n, float *a, int *info) { /* System generated locals */ int i__1, i__2; /* Local variables */ int k, n1, n2; int normaltransr; extern int lsame_(char *, char *); int lower; extern int strmm_(char *, char *, char *, char *, int *, int *, float *, float *, int *, float *, int * ), xerbla_(char *, int *); int nisodd; extern int strtri_(char *, char *, int *, float *, int *, int *); /* -- LAPACK routine (version 3.2) -- */ /* -- Contributed by Fred Gustavson of the IBM Watson Research Center -- */ /* -- November 2008 -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* STFTRI computes the inverse of a triangular matrix A stored in RFP */ /* format. */ /* This is a Level 3 BLAS version of the algorithm. */ /* Arguments */ /* ========= */ /* TRANSR (input) CHARACTER */ /* = 'N': The Normal TRANSR of RFP A is stored; */ /* = 'T': The Transpose TRANSR of RFP A is stored. */ /* UPLO (input) CHARACTER */ /* = 'U': A is upper triangular; */ /* = 'L': A is lower triangular. */ /* DIAG (input) CHARACTER */ /* = 'N': A is non-unit triangular; */ /* = 'U': A is unit triangular. */ /* N (input) INTEGER */ /* The order of the matrix A. N >= 0. */ /* A (input/output) REAL array, dimension (NT); */ /* NT=N*(N+1)/2. On entry, the triangular factor of a Hermitian */ /* Positive Definite matrix A in RFP format. RFP format is */ /* described by TRANSR, UPLO, and N as follows: If TRANSR = 'N' */ /* then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is */ /* (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'T' then RFP is */ /* the transpose of RFP A as defined when */ /* TRANSR = 'N'. The contents of RFP A are defined by UPLO as */ /* follows: If UPLO = 'U' the RFP A contains the nt elements of */ /* upper packed A; If UPLO = 'L' the RFP A contains the nt */ /* elements of lower packed A. The LDA of RFP A is (N+1)/2 when */ /* TRANSR = 'T'. When TRANSR is 'N' the LDA is N+1 when N is */ /* even and N is odd. See the Note below for more details. */ /* On exit, the (triangular) inverse of the original matrix, in */ /* the same storage format. */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value */ /* > 0: if INFO = i, A(i,i) is exactly zero. The triangular */ /* matrix is singular and its inverse can not be computed. */ /* Notes */ /* ===== */ /* We first consider Rectangular Full Packed (RFP) Format when N is */ /* even. We give an example where N = 6. */ /* AP is Upper AP is Lower */ /* 00 01 02 03 04 05 00 */ /* 11 12 13 14 15 10 11 */ /* 22 23 24 25 20 21 22 */ /* 33 34 35 30 31 32 33 */ /* 44 45 40 41 42 43 44 */ /* 55 50 51 52 53 54 55 */ /* Let TRANSR = 'N'. RFP holds AP as follows: */ /* For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last */ /* three columns of AP upper. The lower triangle A(4:6,0:2) consists of */ /* the transpose of the first three columns of AP upper. */ /* For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first */ /* three columns of AP lower. The upper triangle A(0:2,0:2) consists of */ /* the transpose of the last three columns of AP lower. */ /* This covers the case N even and TRANSR = 'N'. */ /* RFP A RFP A */ /* 03 04 05 33 43 53 */ /* 13 14 15 00 44 54 */ /* 23 24 25 10 11 55 */ /* 33 34 35 20 21 22 */ /* 00 44 45 30 31 32 */ /* 01 11 55 40 41 42 */ /* 02 12 22 50 51 52 */ /* Now let TRANSR = 'T'. RFP A in both UPLO cases is just the */ /* transpose of RFP A above. One therefore gets: */ /* RFP A RFP A */ /* 03 13 23 33 00 01 02 33 00 10 20 30 40 50 */ /* 04 14 24 34 44 11 12 43 44 11 21 31 41 51 */ /* 05 15 25 35 45 55 22 53 54 55 22 32 42 52 */ /* We first consider Rectangular Full Packed (RFP) Format when N is */ /* odd. We give an example where N = 5. */ /* AP is Upper AP is Lower */ /* 00 01 02 03 04 00 */ /* 11 12 13 14 10 11 */ /* 22 23 24 20 21 22 */ /* 33 34 30 31 32 33 */ /* 44 40 41 42 43 44 */ /* Let TRANSR = 'N'. RFP holds AP as follows: */ /* For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last */ /* three columns of AP upper. The lower triangle A(3:4,0:1) consists of */ /* the transpose of the first two columns of AP upper. */ /* For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first */ /* three columns of AP lower. The upper triangle A(0:1,1:2) consists of */ /* the transpose of the last two columns of AP lower. */ /* This covers the case N odd and TRANSR = 'N'. */ /* RFP A RFP A */ /* 02 03 04 00 33 43 */ /* 12 13 14 10 11 44 */ /* 22 23 24 20 21 22 */ /* 00 33 34 30 31 32 */ /* 01 11 44 40 41 42 */ /* Now let TRANSR = 'T'. RFP A in both UPLO cases is just the */ /* transpose of RFP A above. One therefore gets: */ /* RFP A RFP A */ /* 02 12 22 00 01 00 10 20 30 40 50 */ /* 03 13 23 33 11 33 11 21 31 41 51 */ /* 04 14 24 34 44 43 44 22 32 42 52 */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Test the input parameters. */ *info = 0; normaltransr = lsame_(transr, "N"); lower = lsame_(uplo, "L"); if (! normaltransr && ! lsame_(transr, "T")) { *info = -1; } else if (! lower && ! lsame_(uplo, "U")) { *info = -2; } else if (! lsame_(diag, "N") && ! lsame_(diag, "U")) { *info = -3; } else if (*n < 0) { *info = -4; } if (*info != 0) { i__1 = -(*info); xerbla_("STFTRI", &i__1); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* If N is odd, set NISODD = .TRUE. */ /* If N is even, set K = N/2 and NISODD = .FALSE. */ if (*n % 2 == 0) { k = *n / 2; nisodd = FALSE; } else { nisodd = TRUE; } /* Set N1 and N2 depending on LOWER */ if (lower) { n2 = *n / 2; n1 = *n - n2; } else { n1 = *n / 2; n2 = *n - n1; } /* start execution: there are eight cases */ if (nisodd) { /* N is odd */ if (normaltransr) { /* N is odd and TRANSR = 'N' */ if (lower) { /* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) ) */ /* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0) */ /* T1 -> a(0), T2 -> a(n), S -> a(n1) */ strtri_("L", diag, &n1, a, n, info); if (*info > 0) { return 0; } strmm_("R", "L", "N", diag, &n2, &n1, &c_b13, a, n, &a[n1], n); strtri_("U", diag, &n2, &a[*n], n, info) ; if (*info > 0) { *info += n1; } if (*info > 0) { return 0; } strmm_("L", "U", "T", diag, &n2, &n1, &c_b18, &a[*n], n, &a[ n1], n); } else { /* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1) */ /* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0) */ /* T1 -> a(n2), T2 -> a(n1), S -> a(0) */ strtri_("L", diag, &n1, &a[n2], n, info) ; if (*info > 0) { return 0; } strmm_("L", "L", "T", diag, &n1, &n2, &c_b13, &a[n2], n, a, n); strtri_("U", diag, &n2, &a[n1], n, info) ; if (*info > 0) { *info += n1; } if (*info > 0) { return 0; } strmm_("R", "U", "N", diag, &n1, &n2, &c_b18, &a[n1], n, a, n); } } else { /* N is odd and TRANSR = 'T' */ if (lower) { /* SRPA for LOWER, TRANSPOSE and N is odd */ /* T1 -> a(0), T2 -> a(1), S -> a(0+n1*n1) */ strtri_("U", diag, &n1, a, &n1, info); if (*info > 0) { return 0; } strmm_("L", "U", "N", diag, &n1, &n2, &c_b13, a, &n1, &a[n1 * n1], &n1); strtri_("L", diag, &n2, &a[1], &n1, info); if (*info > 0) { *info += n1; } if (*info > 0) { return 0; } strmm_("R", "L", "T", diag, &n1, &n2, &c_b18, &a[1], &n1, &a[ n1 * n1], &n1); } else { /* SRPA for UPPER, TRANSPOSE and N is odd */ /* T1 -> a(0+n2*n2), T2 -> a(0+n1*n2), S -> a(0) */ strtri_("U", diag, &n1, &a[n2 * n2], &n2, info); if (*info > 0) { return 0; } strmm_("R", "U", "T", diag, &n2, &n1, &c_b13, &a[n2 * n2], & n2, a, &n2); strtri_("L", diag, &n2, &a[n1 * n2], &n2, info); if (*info > 0) { *info += n1; } if (*info > 0) { return 0; } strmm_("L", "L", "N", diag, &n2, &n1, &c_b18, &a[n1 * n2], & n2, a, &n2); } } } else { /* N is even */ if (normaltransr) { /* N is even and TRANSR = 'N' */ if (lower) { /* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) ) */ /* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0) */ /* T1 -> a(1), T2 -> a(0), S -> a(k+1) */ i__1 = *n + 1; strtri_("L", diag, &k, &a[1], &i__1, info); if (*info > 0) { return 0; } i__1 = *n + 1; i__2 = *n + 1; strmm_("R", "L", "N", diag, &k, &k, &c_b13, &a[1], &i__1, &a[ k + 1], &i__2); i__1 = *n + 1; strtri_("U", diag, &k, a, &i__1, info); if (*info > 0) { *info += k; } if (*info > 0) { return 0; } i__1 = *n + 1; i__2 = *n + 1; strmm_("L", "U", "T", diag, &k, &k, &c_b18, a, &i__1, &a[k + 1], &i__2) ; } else { /* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) ) */ /* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0) */ /* T1 -> a(k+1), T2 -> a(k), S -> a(0) */ i__1 = *n + 1; strtri_("L", diag, &k, &a[k + 1], &i__1, info); if (*info > 0) { return 0; } i__1 = *n + 1; i__2 = *n + 1; strmm_("L", "L", "T", diag, &k, &k, &c_b13, &a[k + 1], &i__1, a, &i__2); i__1 = *n + 1; strtri_("U", diag, &k, &a[k], &i__1, info); if (*info > 0) { *info += k; } if (*info > 0) { return 0; } i__1 = *n + 1; i__2 = *n + 1; strmm_("R", "U", "N", diag, &k, &k, &c_b18, &a[k], &i__1, a, & i__2); } } else { /* N is even and TRANSR = 'T' */ if (lower) { /* SRPA for LOWER, TRANSPOSE and N is even (see paper) */ /* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1) */ /* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k */ strtri_("U", diag, &k, &a[k], &k, info); if (*info > 0) { return 0; } strmm_("L", "U", "N", diag, &k, &k, &c_b13, &a[k], &k, &a[k * (k + 1)], &k); strtri_("L", diag, &k, a, &k, info); if (*info > 0) { *info += k; } if (*info > 0) { return 0; } strmm_("R", "L", "T", diag, &k, &k, &c_b18, a, &k, &a[k * (k + 1)], &k) ; } else { /* SRPA for UPPER, TRANSPOSE and N is even (see paper) */ /* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0) */ /* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k */ strtri_("U", diag, &k, &a[k * (k + 1)], &k, info); if (*info > 0) { return 0; } strmm_("R", "U", "T", diag, &k, &k, &c_b13, &a[k * (k + 1)], & k, a, &k); strtri_("L", diag, &k, &a[k * k], &k, info); if (*info > 0) { *info += k; } if (*info > 0) { return 0; } strmm_("L", "L", "N", diag, &k, &k, &c_b18, &a[k * k], &k, a, &k); } } } return 0; /* End of STFTRI */ } /* stftri_ */
/* Subroutine */ int spotri_(char *uplo, integer *n, real *a, integer *lda, integer *info) { /* -- LAPACK routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University March 31, 1993 Purpose ======= SPOTRI computes the inverse of a real symmetric positive definite matrix A using the Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF. Arguments ========= UPLO (input) CHARACTER*1 = 'U': Upper triangle of A is stored; = 'L': Lower triangle of A is stored. N (input) INTEGER The order of the matrix A. N >= 0. A (input/output) REAL array, dimension (LDA,N) On entry, the triangular factor U or L from the Cholesky factorization A = U**T*U or A = L*L**T, as computed by SPOTRF. On exit, the upper or lower triangle of the (symmetric) inverse of A, overwriting the input factor U or L. LDA (input) INTEGER The leading dimension of the array A. LDA >= max(1,N). INFO (output) INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value > 0: if INFO = i, the (i,i) element of the factor U or L is zero, and the inverse could not be computed. ===================================================================== Test the input parameters. Parameter adjustments */ /* System generated locals */ integer a_dim1, a_offset, i__1; /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *), slauum_( char *, integer *, real *, integer *, integer *), strtri_( char *, char *, integer *, real *, integer *, integer *); 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 (*lda < max(1,*n)) { *info = -4; } if (*info != 0) { i__1 = -(*info); xerbla_("SPOTRI", &i__1); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Invert the triangular Cholesky factor U or L. */ strtri_(uplo, "Non-unit", n, &a[a_offset], lda, info); if (*info > 0) { return 0; } /* Form inv(U)*inv(U)' or inv(L)'*inv(L). */ slauum_(uplo, n, &a[a_offset], lda, info); return 0; /* End of SPOTRI */ } /* spotri_ */
/* Subroutine */ int serrtr_(char *path, integer *nunit) { /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ real a[4] /* was [2][2] */, b[2], w[2], x[2]; char c2[2]; real r1[2], r2[2]; integer iw[2], info; real scale, rcond; extern /* Subroutine */ int strti2_(char *, char *, integer *, real *, integer *, integer *), alaesm_(char *, logical *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), slatbs_(char *, char *, char *, char *, integer *, integer *, real *, integer *, real *, real *, real *, integer *), stbcon_(char *, char * , char *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), stbrfs_(char *, char *, char *, integer *, integer *, integer *, real *, integer * , real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), slatps_(char *, char *, char *, char *, integer *, real *, real *, real *, real *, integer *), stpcon_(char *, char *, char *, integer *, real *, real *, real *, integer *, integer * ), slatrs_(char *, char *, char *, char *, integer *, real *, integer *, real *, real *, real *, integer *), strcon_(char *, char *, char *, integer *, real *, integer *, real *, real *, integer *, integer * ), stbtrs_(char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *), stprfs_(char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), strrfs_(char *, char *, char *, integer * , integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), stptri_(char *, char *, integer *, real *, integer *), strtri_(char *, char *, integer *, real *, integer *, integer *), stptrs_(char *, char *, char *, integer *, integer *, real *, real *, integer *, integer *), strtrs_(char *, char *, char * , integer *, integer *, real *, integer *, real *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SERRTR tests the error exits for the REAL triangular */ /* routines. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); a[0] = 1.f; a[2] = 2.f; a[3] = 3.f; a[1] = 4.f; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "TR")) { /* Test error exits for the general triangular routines. */ /* STRTRI */ s_copy(srnamc_1.srnamt, "STRTRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strtri_("/", "N", &c__0, a, &c__1, &info); chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strtri_("U", "/", &c__0, a, &c__1, &info); chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strtri_("U", "N", &c_n1, a, &c__1, &info); chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strtri_("U", "N", &c__2, a, &c__1, &info); chkxer_("STRTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STRTI2 */ s_copy(srnamc_1.srnamt, "STRTI2", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strti2_("/", "N", &c__0, a, &c__1, &info); chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strti2_("U", "/", &c__0, a, &c__1, &info); chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strti2_("U", "N", &c_n1, a, &c__1, &info); chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strti2_("U", "N", &c__2, a, &c__1, &info); chkxer_("STRTI2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STRTRS */ s_copy(srnamc_1.srnamt, "STRTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strtrs_("/", "N", "N", &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strtrs_("U", "/", "N", &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strtrs_("U", "N", "/", &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strtrs_("U", "N", "N", &c_n1, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strtrs_("U", "N", "N", &c__0, &c_n1, a, &c__1, x, &c__1, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strtrs_("U", "N", "N", &c__2, &c__1, a, &c__1, x, &c__2, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; strtrs_("U", "N", "N", &c__2, &c__1, a, &c__2, x, &c__1, &info); chkxer_("STRTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STRRFS */ s_copy(srnamc_1.srnamt, "STRRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strrfs_("/", "N", "N", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strrfs_("U", "/", "N", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strrfs_("U", "N", "/", &c__0, &c__0, a, &c__1, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strrfs_("U", "N", "N", &c_n1, &c__0, a, &c__1, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strrfs_("U", "N", "N", &c__0, &c_n1, a, &c__1, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strrfs_("U", "N", "N", &c__2, &c__1, a, &c__1, b, &c__2, x, &c__2, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; strrfs_("U", "N", "N", &c__2, &c__1, a, &c__2, b, &c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; strrfs_("U", "N", "N", &c__2, &c__1, a, &c__2, b, &c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("STRRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STRCON */ s_copy(srnamc_1.srnamt, "STRCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strcon_("/", "U", "N", &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strcon_("1", "/", "N", &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strcon_("1", "U", "/", &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strcon_("1", "U", "N", &c_n1, a, &c__1, &rcond, w, iw, &info); chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strcon_("1", "U", "N", &c__2, a, &c__1, &rcond, w, iw, &info); chkxer_("STRCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SLATRS */ s_copy(srnamc_1.srnamt, "SLATRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; slatrs_("/", "N", "N", "N", &c__0, a, &c__1, x, &scale, w, &info); chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; slatrs_("U", "/", "N", "N", &c__0, a, &c__1, x, &scale, w, &info); chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; slatrs_("U", "N", "/", "N", &c__0, a, &c__1, x, &scale, w, &info); chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; slatrs_("U", "N", "N", "/", &c__0, a, &c__1, x, &scale, w, &info); chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; slatrs_("U", "N", "N", "N", &c_n1, a, &c__1, x, &scale, w, &info); chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; slatrs_("U", "N", "N", "N", &c__2, a, &c__1, x, &scale, w, &info); chkxer_("SLATRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "TP")) { /* Test error exits for the packed triangular routines. */ /* STPTRI */ s_copy(srnamc_1.srnamt, "STPTRI", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stptri_("/", "N", &c__0, a, &info); chkxer_("STPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stptri_("U", "/", &c__0, a, &info); chkxer_("STPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stptri_("U", "N", &c_n1, a, &info); chkxer_("STPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STPTRS */ s_copy(srnamc_1.srnamt, "STPTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stptrs_("/", "N", "N", &c__0, &c__0, a, x, &c__1, &info); chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stptrs_("U", "/", "N", &c__0, &c__0, a, x, &c__1, &info); chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stptrs_("U", "N", "/", &c__0, &c__0, a, x, &c__1, &info); chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stptrs_("U", "N", "N", &c_n1, &c__0, a, x, &c__1, &info); chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stptrs_("U", "N", "N", &c__0, &c_n1, a, x, &c__1, &info); chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stptrs_("U", "N", "N", &c__2, &c__1, a, x, &c__1, &info); chkxer_("STPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STPRFS */ s_copy(srnamc_1.srnamt, "STPRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stprfs_("/", "N", "N", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stprfs_("U", "/", "N", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stprfs_("U", "N", "/", &c__0, &c__0, a, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stprfs_("U", "N", "N", &c_n1, &c__0, a, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stprfs_("U", "N", "N", &c__0, &c_n1, a, b, &c__1, x, &c__1, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stprfs_("U", "N", "N", &c__2, &c__1, a, b, &c__1, x, &c__2, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stprfs_("U", "N", "N", &c__2, &c__1, a, b, &c__2, x, &c__1, r1, r2, w, iw, &info); chkxer_("STPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STPCON */ s_copy(srnamc_1.srnamt, "STPCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stpcon_("/", "U", "N", &c__0, a, &rcond, w, iw, &info); chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stpcon_("1", "/", "N", &c__0, a, &rcond, w, iw, &info); chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stpcon_("1", "U", "/", &c__0, a, &rcond, w, iw, &info); chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stpcon_("1", "U", "N", &c_n1, a, &rcond, w, iw, &info); chkxer_("STPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SLATPS */ s_copy(srnamc_1.srnamt, "SLATPS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; slatps_("/", "N", "N", "N", &c__0, a, x, &scale, w, &info); chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; slatps_("U", "/", "N", "N", &c__0, a, x, &scale, w, &info); chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; slatps_("U", "N", "/", "N", &c__0, a, x, &scale, w, &info); chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; slatps_("U", "N", "N", "/", &c__0, a, x, &scale, w, &info); chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; slatps_("U", "N", "N", "N", &c_n1, a, x, &scale, w, &info); chkxer_("SLATPS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "TB")) { /* Test error exits for the banded triangular routines. */ /* STBTRS */ s_copy(srnamc_1.srnamt, "STBTRS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stbtrs_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stbtrs_("U", "/", "N", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stbtrs_("U", "N", "/", &c__0, &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stbtrs_("U", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stbtrs_("U", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; stbtrs_("U", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stbtrs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__1, x, &c__2, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stbtrs_("U", "N", "N", &c__2, &c__0, &c__1, a, &c__1, x, &c__1, &info); chkxer_("STBTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STBRFS */ s_copy(srnamc_1.srnamt, "STBRFS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stbrfs_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stbrfs_("U", "/", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stbrfs_("U", "N", "/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stbrfs_("U", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stbrfs_("U", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; stbrfs_("U", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, x, & c__2, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, x, & c__2, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; stbrfs_("U", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, x, & c__1, r1, r2, w, iw, &info); chkxer_("STBRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* STBCON */ s_copy(srnamc_1.srnamt, "STBCON", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; stbcon_("/", "U", "N", &c__0, &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stbcon_("1", "/", "N", &c__0, &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stbcon_("1", "U", "/", &c__0, &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stbcon_("1", "U", "N", &c_n1, &c__0, a, &c__1, &rcond, w, iw, &info); chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stbcon_("1", "U", "N", &c__0, &c_n1, a, &c__1, &rcond, w, iw, &info); chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; stbcon_("1", "U", "N", &c__2, &c__1, a, &c__1, &rcond, w, iw, &info); chkxer_("STBCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* SLATBS */ s_copy(srnamc_1.srnamt, "SLATBS", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; slatbs_("/", "N", "N", "N", &c__0, &c__0, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; slatbs_("U", "/", "N", "N", &c__0, &c__0, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; slatbs_("U", "N", "/", "N", &c__0, &c__0, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; slatbs_("U", "N", "N", "/", &c__0, &c__0, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; slatbs_("U", "N", "N", "N", &c_n1, &c__0, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; slatbs_("U", "N", "N", "N", &c__1, &c_n1, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; slatbs_("U", "N", "N", "N", &c__2, &c__1, a, &c__1, x, &scale, w, & info); chkxer_("SLATBS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ alaesm_(path, &infoc_1.ok, &infoc_1.nout); return 0; /* End of SERRTR */ } /* serrtr_ */