git.maemo.org Git - opencv/blob - 3rdparty/lapack/strtrs.c

   1 #include "clapack.h"
   2
   3 /* Table of constant values */
   4
   5 static real c_b12 = 1.f;
   6
   7 /* Subroutine */ int strtrs_(char *uplo, char *trans, char *diag, integer *n,
   8         integer *nrhs, real *a, integer *lda, real *b, integer *ldb, integer *
   9         info)
  10 {
  11     /* System generated locals */
  12     integer a_dim1, a_offset, b_dim1, b_offset, i__1;
  13
  14     /* Local variables */
  15     extern logical lsame_(char *, char *);
  16     extern /* Subroutine */ int strsm_(char *, char *, char *, char *,
  17             integer *, integer *, real *, real *, integer *, real *, integer *
  18 ), xerbla_(char *, integer *);
  19     logical nounit;
  20
  21
  22 /*  -- LAPACK routine (version 3.1) -- */
  23 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  24 /*     November 2006 */
  25
  26 /*     .. Scalar Arguments .. */
  27 /*     .. */
  28 /*     .. Array Arguments .. */
  29 /*     .. */
  30
  31 /*  Purpose */
  32 /*  ======= */
  33
  34 /*  STRTRS solves a triangular system of the form */
  35
  36 /*     A * X = B  or  A**T * X = B, */
  37
  38 /*  where A is a triangular matrix of order N, and B is an N-by-NRHS */
  39 /*  matrix.  A check is made to verify that A is nonsingular. */
  40
  41 /*  Arguments */
  42 /*  ========= */
  43
  44 /*  UPLO    (input) CHARACTER*1 */
  45 /*          = 'U':  A is upper triangular; */
  46 /*          = 'L':  A is lower triangular. */
  47
  48 /*  TRANS   (input) CHARACTER*1 */
  49 /*          Specifies the form of the system of equations: */
  50 /*          = 'N':  A * X = B  (No transpose) */
  51 /*          = 'T':  A**T * X = B  (Transpose) */
  52 /*          = 'C':  A**H * X = B  (Conjugate transpose = Transpose) */
  53
  54 /*  DIAG    (input) CHARACTER*1 */
  55 /*          = 'N':  A is non-unit triangular; */
  56 /*          = 'U':  A is unit triangular. */
  57
  58 /*  N       (input) INTEGER */
  59 /*          The order of the matrix A.  N >= 0. */
  60
  61 /*  NRHS    (input) INTEGER */
  62 /*          The number of right hand sides, i.e., the number of columns */
  63 /*          of the matrix B.  NRHS >= 0. */
  64
  65 /*  A       (input) REAL array, dimension (LDA,N) */
  66 /*          The triangular matrix A.  If UPLO = 'U', the leading N-by-N */
  67 /*          upper triangular part of the array A contains the upper */
  68 /*          triangular matrix, and the strictly lower triangular part of */
  69 /*          A is not referenced.  If UPLO = 'L', the leading N-by-N lower */
  70 /*          triangular part of the array A contains the lower triangular */
  71 /*          matrix, and the strictly upper triangular part of A is not */
  72 /*          referenced.  If DIAG = 'U', the diagonal elements of A are */
  73 /*          also not referenced and are assumed to be 1. */
  74
  75 /*  LDA     (input) INTEGER */
  76 /*          The leading dimension of the array A.  LDA >= max(1,N). */
  77
  78 /*  B       (input/output) REAL array, dimension (LDB,NRHS) */
  79 /*          On entry, the right hand side matrix B. */
  80 /*          On exit, if INFO = 0, the solution matrix X. */
  81
  82 /*  LDB     (input) INTEGER */
  83 /*          The leading dimension of the array B.  LDB >= max(1,N). */
  84
  85 /*  INFO    (output) INTEGER */
  86 /*          = 0:  successful exit */
  87 /*          < 0: if INFO = -i, the i-th argument had an illegal value */
  88 /*          > 0: if INFO = i, the i-th diagonal element of A is zero, */
  89 /*               indicating that the matrix is singular and the solutions */
  90 /*               X have not been computed. */
  91
  92 /*  ===================================================================== */
  93
  94 /*     .. Parameters .. */
  95 /*     .. */
  96 /*     .. Local Scalars .. */
  97 /*     .. */
  98 /*     .. External Functions .. */
  99 /*     .. */
 100 /*     .. External Subroutines .. */
 101 /*     .. */
 102 /*     .. Intrinsic Functions .. */
 103 /*     .. */
 104 /*     .. Executable Statements .. */
 105
 106 /*     Test the input parameters. */
 107
 108     /* Parameter adjustments */
 109     a_dim1 = *lda;
 110     a_offset = 1 + a_dim1;
 111     a -= a_offset;
 112     b_dim1 = *ldb;
 113     b_offset = 1 + b_dim1;
 114     b -= b_offset;
 115
 116     /* Function Body */
 117     *info = 0;
 118     nounit = lsame_(diag, "N");
 119     if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
 120         *info = -1;
 121     } else if (! lsame_(trans, "N") && ! lsame_(trans,
 122             "T") && ! lsame_(trans, "C")) {
 123         *info = -2;
 124     } else if (! nounit && ! lsame_(diag, "U")) {
 125         *info = -3;
 126     } else if (*n < 0) {
 127         *info = -4;
 128     } else if (*nrhs < 0) {
 129         *info = -5;
 130     } else if (*lda < max(1,*n)) {
 131         *info = -7;
 132     } else if (*ldb < max(1,*n)) {
 133         *info = -9;
 134     }
 135     if (*info != 0) {
 136         i__1 = -(*info);
 137         xerbla_("STRTRS", &i__1);
 138         return 0;
 139     }
 140
 141 /*     Quick return if possible */
 142
 143     if (*n == 0) {
 144         return 0;
 145     }
 146
 147 /*     Check for singularity. */
 148
 149     if (nounit) {
 150         i__1 = *n;
 151         for (*info = 1; *info <= i__1; ++(*info)) {
 152             if (a[*info + *info * a_dim1] == 0.f) {
 153                 return 0;
 154             }
 155 /* L10: */
 156         }
 157     }
 158     *info = 0;
 159
 160 /*     Solve A * x = b  or  A' * x = b. */
 161
 162     strsm_("Left", uplo, trans, diag, n, nrhs, &c_b12, &a[a_offset], lda, &b[
 163             b_offset], ldb);
 164
 165     return 0;
 166
 167 /*     End of STRTRS */
 168
 169 } /* strtrs_ */