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

   1 #include "clapack.h"
   2
   3 /* Subroutine */ int slaset_(char *uplo, integer *m, integer *n, real *alpha,
   4         real *beta, real *a, integer *lda)
   5 {
   6     /* System generated locals */
   7     integer a_dim1, a_offset, i__1, i__2, i__3;
   8
   9     /* Local variables */
  10     integer i__, j;
  11     extern logical lsame_(char *, char *);
  12
  13
  14 /*  -- LAPACK auxiliary routine (version 3.1) -- */
  15 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  16 /*     November 2006 */
  17
  18 /*     .. Scalar Arguments .. */
  19 /*     .. */
  20 /*     .. Array Arguments .. */
  21 /*     .. */
  22
  23 /*  Purpose */
  24 /*  ======= */
  25
  26 /*  SLASET initializes an m-by-n matrix A to BETA on the diagonal and */
  27 /*  ALPHA on the offdiagonals. */
  28
  29 /*  Arguments */
  30 /*  ========= */
  31
  32 /*  UPLO    (input) CHARACTER*1 */
  33 /*          Specifies the part of the matrix A to be set. */
  34 /*          = 'U':      Upper triangular part is set; the strictly lower */
  35 /*                      triangular part of A is not changed. */
  36 /*          = 'L':      Lower triangular part is set; the strictly upper */
  37 /*                      triangular part of A is not changed. */
  38 /*          Otherwise:  All of the matrix A is set. */
  39
  40 /*  M       (input) INTEGER */
  41 /*          The number of rows of the matrix A.  M >= 0. */
  42
  43 /*  N       (input) INTEGER */
  44 /*          The number of columns of the matrix A.  N >= 0. */
  45
  46 /*  ALPHA   (input) REAL */
  47 /*          The constant to which the offdiagonal elements are to be set. */
  48
  49 /*  BETA    (input) REAL */
  50 /*          The constant to which the diagonal elements are to be set. */
  51
  52 /*  A       (input/output) REAL array, dimension (LDA,N) */
  53 /*          On exit, the leading m-by-n submatrix of A is set as follows: */
  54
  55 /*          if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, */
  56 /*          if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, */
  57 /*          otherwise,     A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, */
  58
  59 /*          and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). */
  60
  61 /*  LDA     (input) INTEGER */
  62 /*          The leading dimension of the array A.  LDA >= max(1,M). */
  63
  64 /* ===================================================================== */
  65
  66 /*     .. Local Scalars .. */
  67 /*     .. */
  68 /*     .. External Functions .. */
  69 /*     .. */
  70 /*     .. Intrinsic Functions .. */
  71 /*     .. */
  72 /*     .. Executable Statements .. */
  73
  74     /* Parameter adjustments */
  75     a_dim1 = *lda;
  76     a_offset = 1 + a_dim1;
  77     a -= a_offset;
  78
  79     /* Function Body */
  80     if (lsame_(uplo, "U")) {
  81
  82 /*        Set the strictly upper triangular or trapezoidal part of the */
  83 /*        array to ALPHA. */
  84
  85         i__1 = *n;
  86         for (j = 2; j <= i__1; ++j) {
  87 /* Computing MIN */
  88             i__3 = j - 1;
  89             i__2 = min(i__3,*m);
  90             for (i__ = 1; i__ <= i__2; ++i__) {
  91                 a[i__ + j * a_dim1] = *alpha;
  92 /* L10: */
  93             }
  94 /* L20: */
  95         }
  96
  97     } else if (lsame_(uplo, "L")) {
  98
  99 /*        Set the strictly lower triangular or trapezoidal part of the */
 100 /*        array to ALPHA. */
 101
 102         i__1 = min(*m,*n);
 103         for (j = 1; j <= i__1; ++j) {
 104             i__2 = *m;
 105             for (i__ = j + 1; i__ <= i__2; ++i__) {
 106                 a[i__ + j * a_dim1] = *alpha;
 107 /* L30: */
 108             }
 109 /* L40: */
 110         }
 111
 112     } else {
 113
 114 /*        Set the leading m-by-n submatrix to ALPHA. */
 115
 116         i__1 = *n;
 117         for (j = 1; j <= i__1; ++j) {
 118             i__2 = *m;
 119             for (i__ = 1; i__ <= i__2; ++i__) {
 120                 a[i__ + j * a_dim1] = *alpha;
 121 /* L50: */
 122             }
 123 /* L60: */
 124         }
 125     }
 126
 127 /*     Set the first min(M,N) diagonal elements to BETA. */
 128
 129     i__1 = min(*m,*n);
 130     for (i__ = 1; i__ <= i__1; ++i__) {
 131         a[i__ + i__ * a_dim1] = *beta;
 132 /* L70: */
 133     }
 134
 135     return 0;
 136
 137 /*     End of SLASET */
 138
 139 } /* slaset_ */