![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE DLAUU2( 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: DOUBLE PRECISION A( LDA, * ) 14: * .. 15: * 16: * Purpose 17: * ======= 18: * 19: * DLAUU2 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) DOUBLE PRECISION 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: DOUBLE PRECISION ONE 60: PARAMETER ( ONE = 1.0D+0 ) 61: * .. 62: * .. Local Scalars .. 63: LOGICAL UPPER 64: INTEGER I 65: DOUBLE PRECISION AII 66: * .. 67: * .. External Functions .. 68: LOGICAL LSAME 69: DOUBLE PRECISION DDOT 70: EXTERNAL LSAME, DDOT 71: * .. 72: * .. External Subroutines .. 73: EXTERNAL DGEMV, DSCAL, 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( 'DLAUU2', -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 ) = DDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA ) 109: CALL DGEMV( '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 DSCAL( 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 ) = DDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 ) 124: CALL DGEMV( '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 DSCAL( I, AII, A( I, 1 ), LDA ) 128: END IF 129: 20 CONTINUE 130: END IF 131: * 132: RETURN 133: * 134: * End of DLAUU2 135: * 136: END