PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
clauu2.f
Go to the documentation of this file.
1  SUBROUTINE clauu2( UPLO, N, A, LDA, INFO )
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 info, lda, n
11 * ..
12 * .. Array Arguments ..
13  COMPLEX a( lda, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * CLAUU2 computes the product U * U' or L' * L, where the triangular
20 * factor U or L is stored in the upper or lower triangular part of
21 * the array A.
22 *
23 * If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
24 * overwriting the factor U in A.
25 * If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
26 * overwriting the factor L in A.
27 *
28 * This is the unblocked form of the algorithm, calling Level 2 BLAS.
29 *
30 * Arguments
31 * =========
32 *
33 * UPLO (input) CHARACTER*1
34 * Specifies whether the triangular factor stored in the array A
35 * is upper or lower triangular:
36 * = 'U': Upper triangular
37 * = 'L': Lower triangular
38 *
39 * N (input) INTEGER
40 * The order of the triangular factor U or L. N >= 0.
41 *
42 * A (input/output) COMPLEX array, dimension (LDA,N)
43 * On entry, the triangular factor U or L.
44 * On exit, if UPLO = 'U', the upper triangle of A is
45 * overwritten with the upper triangle of the product U * U';
46 * if UPLO = 'L', the lower triangle of A is overwritten with
47 * the lower triangle of the product L' * L.
48 *
49 * LDA (input) INTEGER
50 * The leading dimension of the array A. LDA >= max(1,N).
51 *
52 * INFO (output) INTEGER
53 * = 0: successful exit
54 * < 0: if INFO = -k, the k-th argument had an illegal value
55 *
56 * =====================================================================
57 *
58 * .. Parameters ..
59  COMPLEX one
60  parameter( one = ( 1.0e+0, 0.0e+0 ) )
61 * ..
62 * .. Local Scalars ..
63  LOGICAL upper
64  INTEGER i
65  REAL aii
66 * ..
67 * .. External Functions ..
68  LOGICAL lsame
69  COMPLEX cdotc
70  EXTERNAL lsame, cdotc
71 * ..
72 * .. External Subroutines ..
73  EXTERNAL cgemv, clacgv, csscal, xerbla
74 * ..
75 * .. Intrinsic Functions ..
76  INTRINSIC cmplx, max, real
77 * ..
78 * .. Executable Statements ..
79 *
80 * Test the input parameters.
81 *
82  info = 0
83  upper = lsame( uplo, 'U' )
84  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
85  info = -1
86  ELSE IF( n.LT.0 ) THEN
87  info = -2
88  ELSE IF( lda.LT.max( 1, n ) ) THEN
89  info = -4
90  END IF
91  IF( info.NE.0 ) THEN
92  CALL xerbla( 'CLAUU2', -info )
93  return
94  END IF
95 *
96 * Quick return if possible
97 *
98  IF( n.EQ.0 )
99  $ return
100 *
101  IF( upper ) THEN
102 *
103 * Compute the product U * U'.
104 *
105  DO 10 i = 1, n
106  aii = a( i, i )
107  IF( i.LT.n ) THEN
108  a( i, i ) = aii*aii + REAL( CDOTC( N-I, A( I, I+1 ), LDA, $ A( I, I+1 ), LDA ) )
109  CALL clacgv( n-i, a( i, i+1 ), lda )
110  CALL cgemv( 'No transpose', i-1, n-i, one, a( 1, i+1 ),
111  $ lda, a( i, i+1 ), lda, cmplx( aii ),
112  $ a( 1, i ), 1 )
113  CALL clacgv( n-i, a( i, i+1 ), lda )
114  ELSE
115  CALL csscal( i, aii, a( 1, i ), 1 )
116  END IF
117  10 continue
118 *
119  ELSE
120 *
121 * Compute the product L' * L.
122 *
123  DO 20 i = 1, n
124  aii = a( i, i )
125  IF( i.LT.n ) THEN
126  a( i, i ) = aii*aii + REAL( CDOTC( N-I, A( I+1, I ), 1, $ A( I+1, I ), 1 ) )
127  CALL clacgv( i-1, a( i, 1 ), lda )
128  CALL cgemv( 'Conjugate transpose', n-i, i-1, one,
129  $ a( i+1, 1 ), lda, a( i+1, i ), 1,
130  $ cmplx( aii ), a( i, 1 ), lda )
131  CALL clacgv( i-1, a( i, 1 ), lda )
132  ELSE
133  CALL csscal( i, aii, a( i, 1 ), lda )
134  END IF
135  20 continue
136  END IF
137 *
138  return
139 *
140 * End of CLAUU2
141 *
142  END
143