1*> \brief \b ZLAUU2 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 ZLAUU2 + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlauu2.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlauu2.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlauu2.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO ) 22* 23* .. Scalar Arguments .. 24* CHARACTER UPLO 25* INTEGER INFO, LDA, N 26* .. 27* .. Array Arguments .. 28* COMPLEX*16 A( LDA, * ) 29* .. 30* 31* 32*> \par Purpose: 33* ============= 34*> 35*> \verbatim 36*> 37*> ZLAUU2 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*16 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 complex16OTHERauxiliary 99* 100* ===================================================================== 101 SUBROUTINE ZLAUU2( 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*16 A( LDA, * ) 113* .. 114* 115* ===================================================================== 116* 117* .. Parameters .. 118 COMPLEX*16 ONE 119 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) 120* .. 121* .. Local Scalars .. 122 LOGICAL UPPER 123 INTEGER I 124 DOUBLE PRECISION AII 125* .. 126* .. External Functions .. 127 LOGICAL LSAME 128 COMPLEX*16 ZDOTC 129 EXTERNAL LSAME, ZDOTC 130* .. 131* .. External Subroutines .. 132 EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZLACGV 133* .. 134* .. Intrinsic Functions .. 135 INTRINSIC DBLE, DCMPLX, 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( 'ZLAUU2', -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 = DBLE( A( I, I ) ) 166 IF( I.LT.N ) THEN 167 A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA, 168 $ A( I, I+1 ), LDA ) ) 169 CALL ZLACGV( N-I, A( I, I+1 ), LDA ) 170 CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), 171 $ LDA, A( I, I+1 ), LDA, DCMPLX( AII ), 172 $ A( 1, I ), 1 ) 173 CALL ZLACGV( N-I, A( I, I+1 ), LDA ) 174 ELSE 175 CALL ZDSCAL( 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 = DBLE( A( I, I ) ) 185 IF( I.LT.N ) THEN 186 A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1, 187 $ A( I+1, I ), 1 ) ) 188 CALL ZLACGV( I-1, A( I, 1 ), LDA ) 189 CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE, 190 $ A( I+1, 1 ), LDA, A( I+1, I ), 1, 191 $ DCMPLX( AII ), A( I, 1 ), LDA ) 192 CALL ZLACGV( I-1, A( I, 1 ), LDA ) 193 ELSE 194 CALL ZDSCAL( I, AII, A( I, 1 ), LDA ) 195 END IF 196 20 CONTINUE 197 END IF 198* 199 RETURN 200* 201* End of ZLAUU2 202* 203 END 204