LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages

◆ clauum()

subroutine clauum ( character uplo,
integer n,
complex, dimension( lda, * ) a,
integer lda,
integer info )

CLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm).

Download CLAUUM + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!> !> CLAUUM computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, !> overwriting the factor U in A. !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> !> This is the blocked form of the algorithm, calling Level 3 BLAS. !>
Parameters
[in]UPLO
!> UPLO is CHARACTER*1 !> Specifies whether the triangular factor stored in the array A !> is upper or lower triangular: !> = 'U': Upper triangular !> = 'L': Lower triangular !>
[in]N
!> N is INTEGER !> The order of the triangular factor U or L. N >= 0. !>
[in,out]A
!> A is COMPLEX array, dimension (LDA,N) !> On entry, the triangular factor U or L. !> On exit, if UPLO = 'U', the upper triangle of A is !> overwritten with the upper triangle of the product U * U**H; !> if UPLO = 'L', the lower triangle of A is overwritten with !> the lower triangle of the product L**H * L. !>
[in]LDA
!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1,N). !>
[out]INFO
!> INFO is INTEGER !> = 0: successful exit !> < 0: if INFO = -k, the k-th argument had an illegal value !>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 99 of file clauum.f.

100*
101* -- LAPACK auxiliary routine --
102* -- LAPACK is a software package provided by Univ. of Tennessee, --
103* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
104*
105* .. Scalar Arguments ..
106 CHARACTER UPLO
107 INTEGER INFO, LDA, N
108* ..
109* .. Array Arguments ..
110 COMPLEX A( LDA, * )
111* ..
112*
113* =====================================================================
114*
115* .. Parameters ..
116 REAL ONE
117 parameter( one = 1.0e+0 )
118 COMPLEX CONE
119 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
120* ..
121* .. Local Scalars ..
122 LOGICAL UPPER
123 INTEGER I, IB, NB
124* ..
125* .. External Functions ..
126 LOGICAL LSAME
127 INTEGER ILAENV
128 EXTERNAL lsame, ilaenv
129* ..
130* .. External Subroutines ..
131 EXTERNAL cgemm, cherk, clauu2, ctrmm, xerbla
132* ..
133* .. Intrinsic Functions ..
134 INTRINSIC max, min
135* ..
136* .. Executable Statements ..
137*
138* Test the input parameters.
139*
140 info = 0
141 upper = lsame( uplo, 'U' )
142 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
143 info = -1
144 ELSE IF( n.LT.0 ) THEN
145 info = -2
146 ELSE IF( lda.LT.max( 1, n ) ) THEN
147 info = -4
148 END IF
149 IF( info.NE.0 ) THEN
150 CALL xerbla( 'CLAUUM', -info )
151 RETURN
152 END IF
153*
154* Quick return if possible
155*
156 IF( n.EQ.0 )
157 $ RETURN
158*
159* Determine the block size for this environment.
160*
161 nb = ilaenv( 1, 'CLAUUM', uplo, n, -1, -1, -1 )
162*
163 IF( nb.LE.1 .OR. nb.GE.n ) THEN
164*
165* Use unblocked code
166*
167 CALL clauu2( uplo, n, a, lda, info )
168 ELSE
169*
170* Use blocked code
171*
172 IF( upper ) THEN
173*
174* Compute the product U * U**H.
175*
176 DO 10 i = 1, n, nb
177 ib = min( nb, n-i+1 )
178 CALL ctrmm( 'Right', 'Upper', 'Conjugate transpose',
179 $ 'Non-unit', i-1, ib, cone, a( i, i ), lda,
180 $ a( 1, i ), lda )
181 CALL clauu2( 'Upper', ib, a( i, i ), lda, info )
182 IF( i+ib.LE.n ) THEN
183 CALL cgemm( 'No transpose', 'Conjugate transpose',
184 $ i-1, ib, n-i-ib+1, cone, a( 1, i+ib ),
185 $ lda, a( i, i+ib ), lda, cone, a( 1, i ),
186 $ lda )
187 CALL cherk( 'Upper', 'No transpose', ib, n-i-ib+1,
188 $ one, a( i, i+ib ), lda, one, a( i, i ),
189 $ lda )
190 END IF
191 10 CONTINUE
192 ELSE
193*
194* Compute the product L**H * L.
195*
196 DO 20 i = 1, n, nb
197 ib = min( nb, n-i+1 )
198 CALL ctrmm( 'Left', 'Lower', 'Conjugate transpose',
199 $ 'Non-unit', ib, i-1, cone, a( i, i ), lda,
200 $ a( i, 1 ), lda )
201 CALL clauu2( 'Lower', ib, a( i, i ), lda, info )
202 IF( i+ib.LE.n ) THEN
203 CALL cgemm( 'Conjugate transpose', 'No transpose',
204 $ ib,
205 $ i-1, n-i-ib+1, cone, a( i+ib, i ), lda,
206 $ a( i+ib, 1 ), lda, cone, a( i, 1 ), lda )
207 CALL cherk( 'Lower', 'Conjugate transpose', ib,
208 $ n-i-ib+1, one, a( i+ib, i ), lda, one,
209 $ a( i, i ), lda )
210 END IF
211 20 CONTINUE
212 END IF
213 END IF
214*
215 RETURN
216*
217* End of CLAUUM
218*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
CGEMM
Definition cgemm.f:188
subroutine cherk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
CHERK
Definition cherk.f:173
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:160
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:100
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
subroutine ctrmm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRMM
Definition ctrmm.f:177
Here is the call graph for this function:
Here is the caller graph for this function: