PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
slauu2.f
Go to the documentation of this file.
1  SUBROUTINE slauu2( UPLO, N, A, LDA, INFO )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9  CHARACTER uplo
10  INTEGER info, lda, n
11 * ..
12 * .. Array Arguments ..
13  REAL a( lda, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * SLAUU2 computes the product U * U' or L' * L, where the triangular
20 * factor U or L is stored in the upper or lower triangular part of
21 * the array A.
22 *
23 * If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
24 * overwriting the factor U in A.
25 * If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
26 * overwriting the factor L in A.
27 *
28 * This is the unblocked form of the algorithm, calling Level 2 BLAS.
29 *
30 * Arguments
31 * =========
32 *
33 * UPLO (input) CHARACTER*1
34 * Specifies whether the triangular factor stored in the array A
35 * is upper or lower triangular:
36 * = 'U': Upper triangular
37 * = 'L': Lower triangular
38 *
39 * N (input) INTEGER
40 * The order of the triangular factor U or L. N >= 0.
41 *
42 * A (input/output) REAL array, dimension (LDA,N)
43 * On entry, the triangular factor U or L.
44 * On exit, if UPLO = 'U', the upper triangle of A is
45 * overwritten with the upper triangle of the product U * U';
46 * if UPLO = 'L', the lower triangle of A is overwritten with
47 * the lower triangle of the product L' * L.
48 *
49 * LDA (input) INTEGER
50 * The leading dimension of the array A. LDA >= max(1,N).
51 *
52 * INFO (output) INTEGER
53 * = 0: successful exit
54 * < 0: if INFO = -k, the k-th argument had an illegal value
55 *
56 * =====================================================================
57 *
58 * .. Parameters ..
59  REAL one
60  parameter( one = 1.0e+0 )
61 * ..
62 * .. Local Scalars ..
63  LOGICAL upper
64  INTEGER i
65  REAL aii
66 * ..
67 * .. External Functions ..
68  LOGICAL lsame
69  REAL sdot
70  EXTERNAL lsame, sdot
71 * ..
72 * .. External Subroutines ..
73  EXTERNAL sgemv, sscal, xerbla
74 * ..
75 * .. Intrinsic Functions ..
76  INTRINSIC max
77 * ..
78 * .. Executable Statements ..
79 *
80 * Test the input parameters.
81 *
82  info = 0
83  upper = lsame( uplo, 'U' )
84  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
85  info = -1
86  ELSE IF( n.LT.0 ) THEN
87  info = -2
88  ELSE IF( lda.LT.max( 1, n ) ) THEN
89  info = -4
90  END IF
91  IF( info.NE.0 ) THEN
92  CALL xerbla( 'SLAUU2', -info )
93  return
94  END IF
95 *
96 * Quick return if possible
97 *
98  IF( n.EQ.0 )
99  $ return
100 *
101  IF( upper ) THEN
102 *
103 * Compute the product U * U'.
104 *
105  DO 10 i = 1, n
106  aii = a( i, i )
107  IF( i.LT.n ) THEN
108  a( i, i ) = sdot( n-i+1, a( i, i ), lda, a( i, i ), lda )
109  CALL sgemv( 'No transpose', i-1, n-i, one, a( 1, i+1 ),
110  $ lda, a( i, i+1 ), lda, aii, a( 1, i ), 1 )
111  ELSE
112  CALL sscal( i, aii, a( 1, i ), 1 )
113  END IF
114  10 continue
115 *
116  ELSE
117 *
118 * Compute the product L' * L.
119 *
120  DO 20 i = 1, n
121  aii = a( i, i )
122  IF( i.LT.n ) THEN
123  a( i, i ) = sdot( n-i+1, a( i, i ), 1, a( i, i ), 1 )
124  CALL sgemv( 'Transpose', n-i, i-1, one, a( i+1, 1 ), lda,
125  $ a( i+1, i ), 1, aii, a( i, 1 ), lda )
126  ELSE
127  CALL sscal( i, aii, a( i, 1 ), lda )
128  END IF
129  20 continue
130  END IF
131 *
132  return
133 *
134 * End of SLAUU2
135 *
136  END