Statistiques
| Révision :

root / src / lapack / double / dlaset.f @ 1

Historique | Voir | Annoter | Télécharger (3,15 ko)

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