00001 SUBROUTINE CLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER LDA, M, N 00011 COMPLEX ALPHA, BETA 00012 * .. 00013 * .. Array Arguments .. 00014 COMPLEX A( LDA, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * CLASET initializes a 2-D array A to BETA on the diagonal and 00021 * ALPHA on the offdiagonals. 00022 * 00023 * Arguments 00024 * ========= 00025 * 00026 * UPLO (input) CHARACTER*1 00027 * Specifies the part of the matrix A to be set. 00028 * = 'U': Upper triangular part is set. The lower triangle 00029 * is unchanged. 00030 * = 'L': Lower triangular part is set. The upper triangle 00031 * is unchanged. 00032 * Otherwise: All of the matrix A is set. 00033 * 00034 * M (input) INTEGER 00035 * On entry, M specifies the number of rows of A. 00036 * 00037 * N (input) INTEGER 00038 * On entry, N specifies the number of columns of A. 00039 * 00040 * ALPHA (input) COMPLEX 00041 * All the offdiagonal array elements are set to ALPHA. 00042 * 00043 * BETA (input) COMPLEX 00044 * All the diagonal array elements are set to BETA. 00045 * 00046 * A (input/output) COMPLEX array, dimension (LDA,N) 00047 * On entry, the m by n matrix A. 00048 * On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j; 00049 * A(i,i) = BETA , 1 <= i <= min(m,n) 00050 * 00051 * LDA (input) INTEGER 00052 * The leading dimension of the array A. LDA >= max(1,M). 00053 * 00054 * ===================================================================== 00055 * 00056 * .. Local Scalars .. 00057 INTEGER I, J 00058 * .. 00059 * .. External Functions .. 00060 LOGICAL LSAME 00061 EXTERNAL LSAME 00062 * .. 00063 * .. Intrinsic Functions .. 00064 INTRINSIC MIN 00065 * .. 00066 * .. Executable Statements .. 00067 * 00068 IF( LSAME( UPLO, 'U' ) ) THEN 00069 * 00070 * Set the diagonal to BETA and the strictly upper triangular 00071 * part of the array to ALPHA. 00072 * 00073 DO 20 J = 2, N 00074 DO 10 I = 1, MIN( J-1, M ) 00075 A( I, J ) = ALPHA 00076 10 CONTINUE 00077 20 CONTINUE 00078 DO 30 I = 1, MIN( N, M ) 00079 A( I, I ) = BETA 00080 30 CONTINUE 00081 * 00082 ELSE IF( LSAME( UPLO, 'L' ) ) THEN 00083 * 00084 * Set the diagonal to BETA and the strictly lower triangular 00085 * part of the array to ALPHA. 00086 * 00087 DO 50 J = 1, MIN( M, N ) 00088 DO 40 I = J + 1, M 00089 A( I, J ) = ALPHA 00090 40 CONTINUE 00091 50 CONTINUE 00092 DO 60 I = 1, MIN( N, M ) 00093 A( I, I ) = BETA 00094 60 CONTINUE 00095 * 00096 ELSE 00097 * 00098 * Set the array to BETA on the diagonal and ALPHA on the 00099 * offdiagonal. 00100 * 00101 DO 80 J = 1, N 00102 DO 70 I = 1, M 00103 A( I, J ) = ALPHA 00104 70 CONTINUE 00105 80 CONTINUE 00106 DO 90 I = 1, MIN( M, N ) 00107 A( I, I ) = BETA 00108 90 CONTINUE 00109 END IF 00110 * 00111 RETURN 00112 * 00113 * End of CLASET 00114 * 00115 END
1.7.2