LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
clauu2.f
Go to the documentation of this file.
1*> \brief \b CLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm).
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLAUU2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clauu2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clauu2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clauu2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CLAUU2( UPLO, N, A, LDA, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER INFO, LDA, N
26* ..
27* .. Array Arguments ..
28* COMPLEX A( LDA, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CLAUU2 computes the product U * U**H or L**H * L, where the triangular
38*> factor U or L is stored in the upper or lower triangular part of
39*> the array A.
40*>
41*> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
42*> overwriting the factor U in A.
43*> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
44*> overwriting the factor L in A.
45*>
46*> This is the unblocked form of the algorithm, calling Level 2 BLAS.
47*> \endverbatim
48*
49* Arguments:
50* ==========
51*
52*> \param[in] UPLO
53*> \verbatim
54*> UPLO is CHARACTER*1
55*> Specifies whether the triangular factor stored in the array A
56*> is upper or lower triangular:
57*> = 'U': Upper triangular
58*> = 'L': Lower triangular
59*> \endverbatim
60*>
61*> \param[in] N
62*> \verbatim
63*> N is INTEGER
64*> The order of the triangular factor U or L. N >= 0.
65*> \endverbatim
66*>
67*> \param[in,out] A
68*> \verbatim
69*> A is COMPLEX array, dimension (LDA,N)
70*> On entry, the triangular factor U or L.
71*> On exit, if UPLO = 'U', the upper triangle of A is
72*> overwritten with the upper triangle of the product U * U**H;
73*> if UPLO = 'L', the lower triangle of A is overwritten with
74*> the lower triangle of the product L**H * L.
75*> \endverbatim
76*>
77*> \param[in] LDA
78*> \verbatim
79*> LDA is INTEGER
80*> The leading dimension of the array A. LDA >= max(1,N).
81*> \endverbatim
82*>
83*> \param[out] INFO
84*> \verbatim
85*> INFO is INTEGER
86*> = 0: successful exit
87*> < 0: if INFO = -k, the k-th argument had an illegal value
88*> \endverbatim
89*
90* Authors:
91* ========
92*
93*> \author Univ. of Tennessee
94*> \author Univ. of California Berkeley
95*> \author Univ. of Colorado Denver
96*> \author NAG Ltd.
97*
98*> \ingroup lauu2
99*
100* =====================================================================
101 SUBROUTINE clauu2( UPLO, N, A, LDA, INFO )
102*
103* -- LAPACK auxiliary routine --
104* -- LAPACK is a software package provided by Univ. of Tennessee, --
105* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
106*
107* .. Scalar Arguments ..
108 CHARACTER UPLO
109 INTEGER INFO, LDA, N
110* ..
111* .. Array Arguments ..
112 COMPLEX A( LDA, * )
113* ..
114*
115* =====================================================================
116*
117* .. Parameters ..
118 COMPLEX ONE
119 parameter( one = ( 1.0e+0, 0.0e+0 ) )
120* ..
121* .. Local Scalars ..
122 LOGICAL UPPER
123 INTEGER I
124 REAL AII
125* ..
126* .. External Functions ..
127 LOGICAL LSAME
128 COMPLEX CDOTC
129 EXTERNAL lsame, cdotc
130* ..
131* .. External Subroutines ..
132 EXTERNAL cgemv, clacgv, csscal, xerbla
133* ..
134* .. Intrinsic Functions ..
135 INTRINSIC cmplx, max, real
136* ..
137* .. Executable Statements ..
138*
139* Test the input parameters.
140*
141 info = 0
142 upper = lsame( uplo, 'U' )
143 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
144 info = -1
145 ELSE IF( n.LT.0 ) THEN
146 info = -2
147 ELSE IF( lda.LT.max( 1, n ) ) THEN
148 info = -4
149 END IF
150 IF( info.NE.0 ) THEN
151 CALL xerbla( 'CLAUU2', -info )
152 RETURN
153 END IF
154*
155* Quick return if possible
156*
157 IF( n.EQ.0 )
158 $ RETURN
159*
160 IF( upper ) THEN
161*
162* Compute the product U * U**H.
163*
164 DO 10 i = 1, n
165 aii = real( a( i, i ) )
166 IF( i.LT.n ) THEN
167 a( i, i ) = aii*aii + real( cdotc( n-i, a( i, i+1 ), lda,
168 $ a( i, i+1 ), lda ) )
169 CALL clacgv( n-i, a( i, i+1 ), lda )
170 CALL cgemv( 'No transpose', i-1, n-i, one, a( 1, i+1 ),
171 $ lda, a( i, i+1 ), lda, cmplx( aii ),
172 $ a( 1, i ), 1 )
173 CALL clacgv( n-i, a( i, i+1 ), lda )
174 ELSE
175 CALL csscal( i, aii, a( 1, i ), 1 )
176 END IF
177 10 CONTINUE
178*
179 ELSE
180*
181* Compute the product L**H * L.
182*
183 DO 20 i = 1, n
184 aii = real( a( i, i ) )
185 IF( i.LT.n ) THEN
186 a( i, i ) = aii*aii + real( cdotc( n-i, a( i+1, i ), 1,
187 $ a( i+1, i ), 1 ) )
188 CALL clacgv( i-1, a( i, 1 ), lda )
189 CALL cgemv( 'Conjugate transpose', n-i, i-1, one,
190 $ a( i+1, 1 ), lda, a( i+1, i ), 1,
191 $ cmplx( aii ), a( i, 1 ), lda )
192 CALL clacgv( i-1, a( i, 1 ), lda )
193 ELSE
194 CALL csscal( i, aii, a( i, 1 ), lda )
195 END IF
196 20 CONTINUE
197 END IF
198*
199 RETURN
200*
201* End of CLAUU2
202*
203 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
CGEMV
Definition cgemv.f:160
subroutine clacgv(n, x, incx)
CLACGV conjugates a complex vector.
Definition clacgv.f:74
subroutine clauu2(uplo, n, a, lda, info)
CLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblock...
Definition clauu2.f:102
subroutine csscal(n, sa, cx, incx)
CSSCAL
Definition csscal.f:78