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

   1 #include "clapack.h"
   2
   3 /* Table of constant values */
   4
   5 static real c_b9 = 1.f;
   6
   7 /* Subroutine */ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a,
   8         integer *lda, real *b, integer *ldb, integer *info)
   9 {
  10     /* System generated locals */
  11     integer a_dim1, a_offset, b_dim1, b_offset, i__1;
  12
  13     /* Local variables */
  14     extern logical lsame_(char *, char *);
  15     logical upper;
  16     extern /* Subroutine */ int strsm_(char *, char *, char *, char *,
  17             integer *, integer *, real *, real *, integer *, real *, integer *
  18 ), xerbla_(char *, integer *);
  19
  20
  21 /*  -- LAPACK routine (version 3.1) -- */
  22 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  23 /*     November 2006 */
  24
  25 /*     .. Scalar Arguments .. */
  26 /*     .. */
  27 /*     .. Array Arguments .. */
  28 /*     .. */
  29
  30 /*  Purpose */
  31 /*  ======= */
  32
  33 /*  SPOTRS solves a system of linear equations A*X = B with a symmetric */
  34 /*  positive definite matrix A using the Cholesky factorization */
  35 /*  A = U**T*U or A = L*L**T computed by SPOTRF. */
  36
  37 /*  Arguments */
  38 /*  ========= */
  39
  40 /*  UPLO    (input) CHARACTER*1 */
  41 /*          = 'U':  Upper triangle of A is stored; */
  42 /*          = 'L':  Lower triangle of A is stored. */
  43
  44 /*  N       (input) INTEGER */
  45 /*          The order of the matrix A.  N >= 0. */
  46
  47 /*  NRHS    (input) INTEGER */
  48 /*          The number of right hand sides, i.e., the number of columns */
  49 /*          of the matrix B.  NRHS >= 0. */
  50
  51 /*  A       (input) REAL array, dimension (LDA,N) */
  52 /*          The triangular factor U or L from the Cholesky factorization */
  53 /*          A = U**T*U or A = L*L**T, as computed by SPOTRF. */
  54
  55 /*  LDA     (input) INTEGER */
  56 /*          The leading dimension of the array A.  LDA >= max(1,N). */
  57
  58 /*  B       (input/output) REAL array, dimension (LDB,NRHS) */
  59 /*          On entry, the right hand side matrix B. */
  60 /*          On exit, the solution matrix X. */
  61
  62 /*  LDB     (input) INTEGER */
  63 /*          The leading dimension of the array B.  LDB >= max(1,N). */
  64
  65 /*  INFO    (output) INTEGER */
  66 /*          = 0:  successful exit */
  67 /*          < 0:  if INFO = -i, the i-th argument had an illegal value */
  68
  69 /*  ===================================================================== */
  70
  71 /*     .. Parameters .. */
  72 /*     .. */
  73 /*     .. Local Scalars .. */
  74 /*     .. */
  75 /*     .. External Functions .. */
  76 /*     .. */
  77 /*     .. External Subroutines .. */
  78 /*     .. */
  79 /*     .. Intrinsic Functions .. */
  80 /*     .. */
  81 /*     .. Executable Statements .. */
  82
  83 /*     Test the input parameters. */
  84
  85     /* Parameter adjustments */
  86     a_dim1 = *lda;
  87     a_offset = 1 + a_dim1;
  88     a -= a_offset;
  89     b_dim1 = *ldb;
  90     b_offset = 1 + b_dim1;
  91     b -= b_offset;
  92
  93     /* Function Body */
  94     *info = 0;
  95     upper = lsame_(uplo, "U");
  96     if (! upper && ! lsame_(uplo, "L")) {
  97         *info = -1;
  98     } else if (*n < 0) {
  99         *info = -2;
 100     } else if (*nrhs < 0) {
 101         *info = -3;
 102     } else if (*lda < max(1,*n)) {
 103         *info = -5;
 104     } else if (*ldb < max(1,*n)) {
 105         *info = -7;
 106     }
 107     if (*info != 0) {
 108         i__1 = -(*info);
 109         xerbla_("SPOTRS", &i__1);
 110         return 0;
 111     }
 112
 113 /*     Quick return if possible */
 114
 115     if (*n == 0 || *nrhs == 0) {
 116         return 0;
 117     }
 118
 119     if (upper) {
 120
 121 /*        Solve A*X = B where A = U'*U. */
 122
 123 /*        Solve U'*X = B, overwriting B with X. */
 124
 125         strsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b9, &a[
 126                 a_offset], lda, &b[b_offset], ldb);
 127
 128 /*        Solve U*X = B, overwriting B with X. */
 129
 130         strsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b9, &
 131                 a[a_offset], lda, &b[b_offset], ldb);
 132     } else {
 133
 134 /*        Solve A*X = B where A = L*L'. */
 135
 136 /*        Solve L*X = B, overwriting B with X. */
 137
 138         strsm_("Left", "Lower", "No transpose", "Non-unit", n, nrhs, &c_b9, &
 139                 a[a_offset], lda, &b[b_offset], ldb);
 140
 141 /*        Solve L'*X = B, overwriting B with X. */
 142
 143         strsm_("Left", "Lower", "Transpose", "Non-unit", n, nrhs, &c_b9, &a[
 144                 a_offset], lda, &b[b_offset], ldb);
 145     }
 146
 147     return 0;
 148
 149 /*     End of SPOTRS */
 150
 151 } /* spotrs_ */