LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slauu2.f
Go to the documentation of this file.
1*> \brief \b SLAUU2 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 SLAUU2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slauu2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slauu2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slauu2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SLAUU2( UPLO, N, A, LDA, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER INFO, LDA, N
26* ..
27* .. Array Arguments ..
28* REAL A( LDA, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> SLAUU2 computes the product U * U**T or L**T * 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 REAL 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**T;
73*> if UPLO = 'L', the lower triangle of A is overwritten with
74*> the lower triangle of the product L**T * 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 slauu2( 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 REAL A( LDA, * )
113* ..
114*
115* =====================================================================
116*
117* .. Parameters ..
118 REAL ONE
119 parameter( one = 1.0e+0 )
120* ..
121* .. Local Scalars ..
122 LOGICAL UPPER
123 INTEGER I
124 REAL AII
125* ..
126* .. External Functions ..
127 LOGICAL LSAME
128 REAL SDOT
129 EXTERNAL lsame, sdot
130* ..
131* .. External Subroutines ..
132 EXTERNAL sgemv, sscal, xerbla
133* ..
134* .. Intrinsic Functions ..
135 INTRINSIC max
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( 'SLAUU2', -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**T.
163*
164 DO 10 i = 1, n
165 aii = a( i, i )
166 IF( i.LT.n ) THEN
167 a( i, i ) = sdot( n-i+1, a( i, i ), lda, a( i, i ), lda )
168 CALL sgemv( 'No transpose', i-1, n-i, one, a( 1, i+1 ),
169 $ lda, a( i, i+1 ), lda, aii, a( 1, i ), 1 )
170 ELSE
171 CALL sscal( i, aii, a( 1, i ), 1 )
172 END IF
173 10 CONTINUE
174*
175 ELSE
176*
177* Compute the product L**T * L.
178*
179 DO 20 i = 1, n
180 aii = a( i, i )
181 IF( i.LT.n ) THEN
182 a( i, i ) = sdot( n-i+1, a( i, i ), 1, a( i, i ), 1 )
183 CALL sgemv( 'Transpose', n-i, i-1, one, a( i+1, 1 ), lda,
184 $ a( i+1, i ), 1, aii, a( i, 1 ), lda )
185 ELSE
186 CALL sscal( i, aii, a( i, 1 ), lda )
187 END IF
188 20 CONTINUE
189 END IF
190*
191 RETURN
192*
193* End of SLAUU2
194*
195 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
Definition sgemv.f:158
subroutine slauu2(uplo, n, a, lda, info)
SLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblock...
Definition slauu2.f:102
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79