Return to dlaset.f CVS log

Up to [local] / rpl / lapack / lapack

Patches pour OS/2

    1:       SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
    2: *
    3: *  -- LAPACK auxiliary routine (version 3.2) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *     November 2006
    7: *
    8: *     .. Scalar Arguments ..
    9:       CHARACTER          UPLO
   10:       INTEGER            LDA, M, N
   11:       DOUBLE PRECISION   ALPHA, BETA
   12: *     ..
   13: *     .. Array Arguments ..
   14:       DOUBLE PRECISION   A( LDA, * )
   15: *     ..
   16: *
   17: *  Purpose
   18: *  =======
   19: *
   20: *  DLASET initializes an m-by-n matrix A to BETA on the diagonal and
   21: *  ALPHA on the offdiagonals.
   22: *
   23: *  Arguments
   24: *  =========
   25: *
   26: *  UPLO    (input) CHARACTER*1
   27: *          Specifies the part of the matrix A to be set.
   28: *          = 'U':      Upper triangular part is set; the strictly lower
   29: *                      triangular part of A is not changed.
   30: *          = 'L':      Lower triangular part is set; the strictly upper
   31: *                      triangular part of A is not changed.
   32: *          Otherwise:  All of the matrix A is set.
   33: *
   34: *  M       (input) INTEGER
   35: *          The number of rows of the matrix A.  M >= 0.
   36: *
   37: *  N       (input) INTEGER
   38: *          The number of columns of the matrix A.  N >= 0.
   39: *
   40: *  ALPHA   (input) DOUBLE PRECISION
   41: *          The constant to which the offdiagonal elements are to be set.
   42: *
   43: *  BETA    (input) DOUBLE PRECISION
   44: *          The constant to which the diagonal elements are to be set.
   45: *
   46: *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
   47: *          On exit, the leading m-by-n submatrix of A is set as follows:
   48: *
   49: *          if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
   50: *          if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
   51: *          otherwise,     A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
   52: *
   53: *          and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
   54: *
   55: *  LDA     (input) INTEGER
   56: *          The leading dimension of the array A.  LDA >= max(1,M).
   57: *
   58: * =====================================================================
   59: *
   60: *     .. Local Scalars ..
   61:       INTEGER            I, J
   62: *     ..
   63: *     .. External Functions ..
   64:       LOGICAL            LSAME
   65:       EXTERNAL           LSAME
   66: *     ..
   67: *     .. Intrinsic Functions ..
   68:       INTRINSIC          MIN
   69: *     ..
   70: *     .. Executable Statements ..
   71: *
   72:       IF( LSAME( UPLO, 'U' ) ) THEN
   73: *
   74: *        Set the strictly upper triangular or trapezoidal part of the
   75: *        array to ALPHA.
   76: *
   77:          DO 20 J = 2, N
   78:             DO 10 I = 1, MIN( J-1, M )
   79:                A( I, J ) = ALPHA
   80:    10       CONTINUE
   81:    20    CONTINUE
   82: *
   83:       ELSE IF( LSAME( UPLO, 'L' ) ) THEN
   84: *
   85: *        Set the strictly lower triangular or trapezoidal part of the
   86: *        array to ALPHA.
   87: *
   88:          DO 40 J = 1, MIN( M, N )
   89:             DO 30 I = J + 1, M
   90:                A( I, J ) = ALPHA
   91:    30       CONTINUE
   92:    40    CONTINUE
   93: *
   94:       ELSE
   95: *
   96: *        Set the leading m-by-n submatrix to ALPHA.
   97: *
   98:          DO 60 J = 1, N
   99:             DO 50 I = 1, M
  100:                A( I, J ) = ALPHA
  101:    50       CONTINUE
  102:    60    CONTINUE
  103:       END IF
  104: *
  105: *     Set the first min(M,N) diagonal elements to BETA.
  106: *
  107:       DO 70 I = 1, MIN( M, N )
  108:          A( I, I ) = BETA
  109:    70 CONTINUE
  110: *
  111:       RETURN
  112: *
  113: *     End of DLASET
  114: *
  115:       END