1*> \brief \b ZLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm).
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLAUUM + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlauum.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlauum.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlauum.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZLAUUM( 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*> ZLAUUM 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 blocked form of the algorithm, calling Level 3 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*> \date September 2012
99*
100*> \ingroup complex16OTHERauxiliary
101*
102*  =====================================================================
103      SUBROUTINE ZLAUUM( UPLO, N, A, LDA, INFO )
104*
105*  -- LAPACK auxiliary routine (version 3.4.2) --
106*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
107*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108*     September 2012
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      DOUBLE PRECISION   ONE
122      PARAMETER          ( ONE = 1.0D+0 )
123      COMPLEX*16         CONE
124      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
125*     ..
126*     .. Local Scalars ..
127      LOGICAL            UPPER
128      INTEGER            I, IB, NB
129*     ..
130*     .. External Functions ..
131      LOGICAL            LSAME
132      INTEGER            ILAENV
133      EXTERNAL           LSAME, ILAENV
134*     ..
135*     .. External Subroutines ..
136      EXTERNAL           XERBLA, ZGEMM, ZHERK, ZLAUU2, ZTRMM
137*     ..
138*     .. Intrinsic Functions ..
139      INTRINSIC          MAX, MIN
140*     ..
141*     .. Executable Statements ..
142*
143*     Test the input parameters.
144*
145      INFO = 0
146      UPPER = LSAME( UPLO, 'U' )
147      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
148         INFO = -1
149      ELSE IF( N.LT.0 ) THEN
150         INFO = -2
151      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
152         INFO = -4
153      END IF
154      IF( INFO.NE.0 ) THEN
155         CALL XERBLA( 'ZLAUUM', -INFO )
156         RETURN
157      END IF
158*
159*     Quick return if possible
160*
161      IF( N.EQ.0 )
162     $   RETURN
163*
164*     Determine the block size for this environment.
165*
166      NB = ILAENV( 1, 'ZLAUUM', UPLO, N, -1, -1, -1 )
167*
168      IF( NB.LE.1 .OR. NB.GE.N ) THEN
169*
170*        Use unblocked code
171*
172         CALL ZLAUU2( UPLO, N, A, LDA, INFO )
173      ELSE
174*
175*        Use blocked code
176*
177         IF( UPPER ) THEN
178*
179*           Compute the product U * U**H.
180*
181            DO 10 I = 1, N, NB
182               IB = MIN( NB, N-I+1 )
183               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
184     $                     'Non-unit', I-1, IB, CONE, A( I, I ), LDA,
185     $                     A( 1, I ), LDA )
186               CALL ZLAUU2( 'Upper', IB, A( I, I ), LDA, INFO )
187               IF( I+IB.LE.N ) THEN
188                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
189     $                        I-1, IB, N-I-IB+1, CONE, A( 1, I+IB ),
190     $                        LDA, A( I, I+IB ), LDA, CONE, A( 1, I ),
191     $                        LDA )
192                  CALL ZHERK( 'Upper', 'No transpose', IB, N-I-IB+1,
193     $                        ONE, A( I, I+IB ), LDA, ONE, A( I, I ),
194     $                        LDA )
195               END IF
196   10       CONTINUE
197         ELSE
198*
199*           Compute the product L**H * L.
200*
201            DO 20 I = 1, N, NB
202               IB = MIN( NB, N-I+1 )
203               CALL ZTRMM( 'Left', 'Lower', 'Conjugate transpose',
204     $                     'Non-unit', IB, I-1, CONE, A( I, I ), LDA,
205     $                     A( I, 1 ), LDA )
206               CALL ZLAUU2( 'Lower', IB, A( I, I ), LDA, INFO )
207               IF( I+IB.LE.N ) THEN
208                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', IB,
209     $                        I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA,
210     $                        A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA )
211                  CALL ZHERK( 'Lower', 'Conjugate transpose', IB,
212     $                        N-I-IB+1, ONE, A( I+IB, I ), LDA, ONE,
213     $                        A( I, I ), LDA )
214               END IF
215   20       CONTINUE
216         END IF
217      END IF
218*
219      RETURN
220*
221*     End of ZLAUUM
222*
223      END
224