Statistiques
| Révision :

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

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

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