1 SUBROUTINE ZLASET( 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 COMPLEX*16 ALPHA, BETA
12 * ..
13 * .. Array Arguments ..
14 COMPLEX*16 A( LDA, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZLASET initializes a 2-D array 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 lower triangle
29 * is unchanged.
30 * = 'L': Lower triangular part is set. The upper triangle
31 * is unchanged.
32 * Otherwise: All of the matrix A is set.
33 *
34 * M (input) INTEGER
35 * On entry, M specifies the number of rows of A.
36 *
37 * N (input) INTEGER
38 * On entry, N specifies the number of columns of A.
39 *
40 * ALPHA (input) COMPLEX*16
41 * All the offdiagonal array elements are set to ALPHA.
42 *
43 * BETA (input) COMPLEX*16
44 * All the diagonal array elements are set to BETA.
45 *
46 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
47 * On entry, the m by n matrix A.
48 * On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
49 * A(i,i) = BETA , 1 <= i <= min(m,n)
50 *
51 * LDA (input) INTEGER
52 * The leading dimension of the array A. LDA >= max(1,M).
53 *
54 * =====================================================================
55 *
56 * .. Local Scalars ..
57 INTEGER I, J
58 * ..
59 * .. External Functions ..
60 LOGICAL LSAME
61 EXTERNAL LSAME
62 * ..
63 * .. Intrinsic Functions ..
64 INTRINSIC MIN
65 * ..
66 * .. Executable Statements ..
67 *
68 IF( LSAME( UPLO, 'U' ) ) THEN
69 *
70 * Set the diagonal to BETA and the strictly upper triangular
71 * part of the array to ALPHA.
72 *
73 DO 20 J = 2, N
74 DO 10 I = 1, MIN( J-1, M )
75 A( I, J ) = ALPHA
76 10 CONTINUE
77 20 CONTINUE
78 DO 30 I = 1, MIN( N, M )
79 A( I, I ) = BETA
80 30 CONTINUE
81 *
82 ELSE IF( LSAME( UPLO, 'L' ) ) THEN
83 *
84 * Set the diagonal to BETA and the strictly lower triangular
85 * part of the array to ALPHA.
86 *
87 DO 50 J = 1, MIN( M, N )
88 DO 40 I = J + 1, M
89 A( I, J ) = ALPHA
90 40 CONTINUE
91 50 CONTINUE
92 DO 60 I = 1, MIN( N, M )
93 A( I, I ) = BETA
94 60 CONTINUE
95 *
96 ELSE
97 *
98 * Set the array to BETA on the diagonal and ALPHA on the
99 * offdiagonal.
100 *
101 DO 80 J = 1, N
102 DO 70 I = 1, M
103 A( I, J ) = ALPHA
104 70 CONTINUE
105 80 CONTINUE
106 DO 90 I = 1, MIN( M, N )
107 A( I, I ) = BETA
108 90 CONTINUE
109 END IF
110 *
111 RETURN
112 *
113 * End of ZLASET
114 *
115 END
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 COMPLEX*16 ALPHA, BETA
12 * ..
13 * .. Array Arguments ..
14 COMPLEX*16 A( LDA, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZLASET initializes a 2-D array 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 lower triangle
29 * is unchanged.
30 * = 'L': Lower triangular part is set. The upper triangle
31 * is unchanged.
32 * Otherwise: All of the matrix A is set.
33 *
34 * M (input) INTEGER
35 * On entry, M specifies the number of rows of A.
36 *
37 * N (input) INTEGER
38 * On entry, N specifies the number of columns of A.
39 *
40 * ALPHA (input) COMPLEX*16
41 * All the offdiagonal array elements are set to ALPHA.
42 *
43 * BETA (input) COMPLEX*16
44 * All the diagonal array elements are set to BETA.
45 *
46 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
47 * On entry, the m by n matrix A.
48 * On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
49 * A(i,i) = BETA , 1 <= i <= min(m,n)
50 *
51 * LDA (input) INTEGER
52 * The leading dimension of the array A. LDA >= max(1,M).
53 *
54 * =====================================================================
55 *
56 * .. Local Scalars ..
57 INTEGER I, J
58 * ..
59 * .. External Functions ..
60 LOGICAL LSAME
61 EXTERNAL LSAME
62 * ..
63 * .. Intrinsic Functions ..
64 INTRINSIC MIN
65 * ..
66 * .. Executable Statements ..
67 *
68 IF( LSAME( UPLO, 'U' ) ) THEN
69 *
70 * Set the diagonal to BETA and the strictly upper triangular
71 * part of the array to ALPHA.
72 *
73 DO 20 J = 2, N
74 DO 10 I = 1, MIN( J-1, M )
75 A( I, J ) = ALPHA
76 10 CONTINUE
77 20 CONTINUE
78 DO 30 I = 1, MIN( N, M )
79 A( I, I ) = BETA
80 30 CONTINUE
81 *
82 ELSE IF( LSAME( UPLO, 'L' ) ) THEN
83 *
84 * Set the diagonal to BETA and the strictly lower triangular
85 * part of the array to ALPHA.
86 *
87 DO 50 J = 1, MIN( M, N )
88 DO 40 I = J + 1, M
89 A( I, J ) = ALPHA
90 40 CONTINUE
91 50 CONTINUE
92 DO 60 I = 1, MIN( N, M )
93 A( I, I ) = BETA
94 60 CONTINUE
95 *
96 ELSE
97 *
98 * Set the array to BETA on the diagonal and ALPHA on the
99 * offdiagonal.
100 *
101 DO 80 J = 1, N
102 DO 70 I = 1, M
103 A( I, J ) = ALPHA
104 70 CONTINUE
105 80 CONTINUE
106 DO 90 I = 1, MIN( M, N )
107 A( I, I ) = BETA
108 90 CONTINUE
109 END IF
110 *
111 RETURN
112 *
113 * End of ZLASET
114 *
115 END