Annotation of rpl/lapack/lapack/zlauu2.f, revision 1.17
1.12 bertrand 1: *> \brief \b ZLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm).
1.9 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.16 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.9 bertrand 7: *
8: *> \htmlonly
1.16 bertrand 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">
1.9 bertrand 15: *> [TXT]</a>
1.16 bertrand 16: *> \endhtmlonly
1.9 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO )
1.16 bertrand 22: *
1.9 bertrand 23: * .. Scalar Arguments ..
24: * CHARACTER UPLO
25: * INTEGER INFO, LDA, N
26: * ..
27: * .. Array Arguments ..
28: * COMPLEX*16 A( LDA, * )
29: * ..
1.16 bertrand 30: *
1.9 bertrand 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: *
1.16 bertrand 93: *> \author Univ. of Tennessee
94: *> \author Univ. of California Berkeley
95: *> \author Univ. of Colorado Denver
96: *> \author NAG Ltd.
1.9 bertrand 97: *
1.16 bertrand 98: *> \date December 2016
1.9 bertrand 99: *
100: *> \ingroup complex16OTHERauxiliary
101: *
102: * =====================================================================
1.1 bertrand 103: SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO )
104: *
1.16 bertrand 105: * -- LAPACK auxiliary routine (version 3.7.0) --
1.1 bertrand 106: * -- LAPACK is a software package provided by Univ. of Tennessee, --
107: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.16 bertrand 108: * December 2016
1.1 bertrand 109: *
110: * .. Scalar Arguments ..
111: CHARACTER UPLO
112: INTEGER INFO, LDA, N
113: * ..
114: * .. Array Arguments ..
115: COMPLEX*16 A( LDA, * )
116: * ..
117: *
118: * =====================================================================
119: *
120: * .. Parameters ..
121: COMPLEX*16 ONE
122: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
123: * ..
124: * .. Local Scalars ..
125: LOGICAL UPPER
126: INTEGER I
127: DOUBLE PRECISION AII
128: * ..
129: * .. External Functions ..
130: LOGICAL LSAME
131: COMPLEX*16 ZDOTC
132: EXTERNAL LSAME, ZDOTC
133: * ..
134: * .. External Subroutines ..
135: EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZLACGV
136: * ..
137: * .. Intrinsic Functions ..
138: INTRINSIC DBLE, DCMPLX, MAX
139: * ..
140: * .. Executable Statements ..
141: *
142: * Test the input parameters.
143: *
144: INFO = 0
145: UPPER = LSAME( UPLO, 'U' )
146: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
147: INFO = -1
148: ELSE IF( N.LT.0 ) THEN
149: INFO = -2
150: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
151: INFO = -4
152: END IF
153: IF( INFO.NE.0 ) THEN
154: CALL XERBLA( 'ZLAUU2', -INFO )
155: RETURN
156: END IF
157: *
158: * Quick return if possible
159: *
160: IF( N.EQ.0 )
161: $ RETURN
162: *
163: IF( UPPER ) THEN
164: *
1.8 bertrand 165: * Compute the product U * U**H.
1.1 bertrand 166: *
167: DO 10 I = 1, N
168: AII = A( I, I )
169: IF( I.LT.N ) THEN
170: A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA,
171: $ A( I, I+1 ), LDA ) )
172: CALL ZLACGV( N-I, A( I, I+1 ), LDA )
173: CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
174: $ LDA, A( I, I+1 ), LDA, DCMPLX( AII ),
175: $ A( 1, I ), 1 )
176: CALL ZLACGV( N-I, A( I, I+1 ), LDA )
177: ELSE
178: CALL ZDSCAL( I, AII, A( 1, I ), 1 )
179: END IF
180: 10 CONTINUE
181: *
182: ELSE
183: *
1.8 bertrand 184: * Compute the product L**H * L.
1.1 bertrand 185: *
186: DO 20 I = 1, N
187: AII = A( I, I )
188: IF( I.LT.N ) THEN
189: A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1,
190: $ A( I+1, I ), 1 ) )
191: CALL ZLACGV( I-1, A( I, 1 ), LDA )
192: CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
193: $ A( I+1, 1 ), LDA, A( I+1, I ), 1,
194: $ DCMPLX( AII ), A( I, 1 ), LDA )
195: CALL ZLACGV( I-1, A( I, 1 ), LDA )
196: ELSE
197: CALL ZDSCAL( I, AII, A( I, 1 ), LDA )
198: END IF
199: 20 CONTINUE
200: END IF
201: *
202: RETURN
203: *
204: * End of ZLAUU2
205: *
206: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlauu2.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack