Mercurial > octave-nkf

comparison libcruft/lapack/claset.f @ 7789:82be108cc558

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First attempt at single precision tyeps * * * corrections to qrupdate single precision routines * * * prefer demotion to single over promotion to double * * * Add single precision support to log2 function * * * Trivial PROJECT file update * * * Cache optimized hermitian/transpose methods * * * Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author David Bateman <dbateman@free.fr>
date Sun, 27 Apr 2008 22:34:17 +0200
parents
children
comparison
equal deleted inserted replaced
7788:45f5faba05a2 7789:82be108cc558
1 SUBROUTINE CLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
2 *
3 * -- LAPACK auxiliary routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER UPLO
9 INTEGER LDA, M, N
10 COMPLEX ALPHA, BETA
11 * ..
12 * .. Array Arguments ..
13 COMPLEX A( LDA, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * CLASET initializes a 2-D array A to BETA on the diagonal and
20 * ALPHA on the offdiagonals.
21 *
22 * Arguments
23 * =========
24 *
25 * UPLO (input) CHARACTER*1
26 * Specifies the part of the matrix A to be set.
27 * = 'U': Upper triangular part is set. The lower triangle
28 * is unchanged.
29 * = 'L': Lower triangular part is set. The upper triangle
30 * is unchanged.
31 * Otherwise: All of the matrix A is set.
32 *
33 * M (input) INTEGER
34 * On entry, M specifies the number of rows of A.
35 *
36 * N (input) INTEGER
37 * On entry, N specifies the number of columns of A.
38 *
39 * ALPHA (input) COMPLEX
40 * All the offdiagonal array elements are set to ALPHA.
41 *
42 * BETA (input) COMPLEX
43 * All the diagonal array elements are set to BETA.
44 *
45 * A (input/output) COMPLEX array, dimension (LDA,N)
46 * On entry, the m by n matrix A.
47 * On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
48 * A(i,i) = BETA , 1 <= i <= min(m,n)
49 *
50 * LDA (input) INTEGER
51 * The leading dimension of the array A. LDA >= max(1,M).
52 *
53 * =====================================================================
54 *
55 * .. Local Scalars ..
56 INTEGER I, J
57 * ..
58 * .. External Functions ..
59 LOGICAL LSAME
60 EXTERNAL LSAME
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC MIN
64 * ..
65 * .. Executable Statements ..
66 *
67 IF( LSAME( UPLO, 'U' ) ) THEN
68 *
69 * Set the diagonal to BETA and the strictly upper triangular
70 * part of the array to ALPHA.
71 *
72 DO 20 J = 2, N
73 DO 10 I = 1, MIN( J-1, M )
74 A( I, J ) = ALPHA
75 10 CONTINUE
76 20 CONTINUE
77 DO 30 I = 1, MIN( N, M )
78 A( I, I ) = BETA
79 30 CONTINUE
80 *
81 ELSE IF( LSAME( UPLO, 'L' ) ) THEN
82 *
83 * Set the diagonal to BETA and the strictly lower triangular
84 * part of the array to ALPHA.
85 *
86 DO 50 J = 1, MIN( M, N )
87 DO 40 I = J + 1, M
88 A( I, J ) = ALPHA
89 40 CONTINUE
90 50 CONTINUE
91 DO 60 I = 1, MIN( N, M )
92 A( I, I ) = BETA
93 60 CONTINUE
94 *
95 ELSE
96 *
97 * Set the array to BETA on the diagonal and ALPHA on the
98 * offdiagonal.
99 *
100 DO 80 J = 1, N
101 DO 70 I = 1, M
102 A( I, J ) = ALPHA
103 70 CONTINUE
104 80 CONTINUE
105 DO 90 I = 1, MIN( M, N )
106 A( I, I ) = BETA
107 90 CONTINUE
108 END IF
109 *
110 RETURN
111 *
112 * End of CLASET
113 *
114 END