Annotation of rpl/lapack/lapack/dlauum.f, revision 1.9
1.9 ! bertrand 1: *> \brief \b DLAUUM
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download DLAUUM + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlauum.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlauum.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlauum.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE DLAUUM( UPLO, N, A, LDA, INFO )
! 22: *
! 23: * .. Scalar Arguments ..
! 24: * CHARACTER UPLO
! 25: * INTEGER INFO, LDA, N
! 26: * ..
! 27: * .. Array Arguments ..
! 28: * DOUBLE PRECISION A( LDA, * )
! 29: * ..
! 30: *
! 31: *
! 32: *> \par Purpose:
! 33: * =============
! 34: *>
! 35: *> \verbatim
! 36: *>
! 37: *> DLAUUM 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 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 DOUBLE PRECISION 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: *> \date November 2011
! 99: *
! 100: *> \ingroup doubleOTHERauxiliary
! 101: *
! 102: * =====================================================================
1.1 bertrand 103: SUBROUTINE DLAUUM( UPLO, N, A, LDA, INFO )
104: *
1.9 ! bertrand 105: * -- LAPACK auxiliary routine (version 3.4.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.9 ! bertrand 108: * November 2011
1.1 bertrand 109: *
110: * .. Scalar Arguments ..
111: CHARACTER UPLO
112: INTEGER INFO, LDA, N
113: * ..
114: * .. Array Arguments ..
115: DOUBLE PRECISION A( LDA, * )
116: * ..
117: *
118: * =====================================================================
119: *
120: * .. Parameters ..
121: DOUBLE PRECISION ONE
122: PARAMETER ( ONE = 1.0D+0 )
123: * ..
124: * .. Local Scalars ..
125: LOGICAL UPPER
126: INTEGER I, IB, NB
127: * ..
128: * .. External Functions ..
129: LOGICAL LSAME
130: INTEGER ILAENV
131: EXTERNAL LSAME, ILAENV
132: * ..
133: * .. External Subroutines ..
134: EXTERNAL DGEMM, DLAUU2, DSYRK, DTRMM, XERBLA
135: * ..
136: * .. Intrinsic Functions ..
137: INTRINSIC MAX, MIN
138: * ..
139: * .. Executable Statements ..
140: *
141: * Test the input parameters.
142: *
143: INFO = 0
144: UPPER = LSAME( UPLO, 'U' )
145: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
146: INFO = -1
147: ELSE IF( N.LT.0 ) THEN
148: INFO = -2
149: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
150: INFO = -4
151: END IF
152: IF( INFO.NE.0 ) THEN
153: CALL XERBLA( 'DLAUUM', -INFO )
154: RETURN
155: END IF
156: *
157: * Quick return if possible
158: *
159: IF( N.EQ.0 )
160: $ RETURN
161: *
162: * Determine the block size for this environment.
163: *
164: NB = ILAENV( 1, 'DLAUUM', UPLO, N, -1, -1, -1 )
165: *
166: IF( NB.LE.1 .OR. NB.GE.N ) THEN
167: *
168: * Use unblocked code
169: *
170: CALL DLAUU2( UPLO, N, A, LDA, INFO )
171: ELSE
172: *
173: * Use blocked code
174: *
175: IF( UPPER ) THEN
176: *
1.8 bertrand 177: * Compute the product U * U**T.
1.1 bertrand 178: *
179: DO 10 I = 1, N, NB
180: IB = MIN( NB, N-I+1 )
181: CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Non-unit',
182: $ I-1, IB, ONE, A( I, I ), LDA, A( 1, I ),
183: $ LDA )
184: CALL DLAUU2( 'Upper', IB, A( I, I ), LDA, INFO )
185: IF( I+IB.LE.N ) THEN
186: CALL DGEMM( 'No transpose', 'Transpose', I-1, IB,
187: $ N-I-IB+1, ONE, A( 1, I+IB ), LDA,
188: $ A( I, I+IB ), LDA, ONE, A( 1, I ), LDA )
189: CALL DSYRK( 'Upper', 'No transpose', IB, N-I-IB+1,
190: $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ),
191: $ LDA )
192: END IF
193: 10 CONTINUE
194: ELSE
195: *
1.8 bertrand 196: * Compute the product L**T * L.
1.1 bertrand 197: *
198: DO 20 I = 1, N, NB
199: IB = MIN( NB, N-I+1 )
200: CALL DTRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB,
201: $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA )
202: CALL DLAUU2( 'Lower', IB, A( I, I ), LDA, INFO )
203: IF( I+IB.LE.N ) THEN
204: CALL DGEMM( 'Transpose', 'No transpose', IB, I-1,
205: $ N-I-IB+1, ONE, A( I+IB, I ), LDA,
206: $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA )
207: CALL DSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE,
208: $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA )
209: END IF
210: 20 CONTINUE
211: END IF
212: END IF
213: *
214: RETURN
215: *
216: * End of DLAUUM
217: *
218: END
CVSweb interface <joel.bertrand@systella.fr>