![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE ZLAUU2( 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: COMPLEX*16 A( LDA, * ) 14: * .. 15: * 16: * Purpose 17: * ======= 18: * 19: * ZLAUU2 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) COMPLEX*16 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: COMPLEX*16 ONE 60: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) 61: * .. 62: * .. Local Scalars .. 63: LOGICAL UPPER 64: INTEGER I 65: DOUBLE PRECISION AII 66: * .. 67: * .. External Functions .. 68: LOGICAL LSAME 69: COMPLEX*16 ZDOTC 70: EXTERNAL LSAME, ZDOTC 71: * .. 72: * .. External Subroutines .. 73: EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZLACGV 74: * .. 75: * .. Intrinsic Functions .. 76: INTRINSIC DBLE, DCMPLX, 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( 'ZLAUU2', -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 ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA, 109: $ A( I, I+1 ), LDA ) ) 110: CALL ZLACGV( N-I, A( I, I+1 ), LDA ) 111: CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), 112: $ LDA, A( I, I+1 ), LDA, DCMPLX( AII ), 113: $ A( 1, I ), 1 ) 114: CALL ZLACGV( N-I, A( I, I+1 ), LDA ) 115: ELSE 116: CALL ZDSCAL( I, AII, A( 1, I ), 1 ) 117: END IF 118: 10 CONTINUE 119: * 120: ELSE 121: * 122: * Compute the product L' * L. 123: * 124: DO 20 I = 1, N 125: AII = A( I, I ) 126: IF( I.LT.N ) THEN 127: A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1, 128: $ A( I+1, I ), 1 ) ) 129: CALL ZLACGV( I-1, A( I, 1 ), LDA ) 130: CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE, 131: $ A( I+1, 1 ), LDA, A( I+1, I ), 1, 132: $ DCMPLX( AII ), A( I, 1 ), LDA ) 133: CALL ZLACGV( I-1, A( I, 1 ), LDA ) 134: ELSE 135: CALL ZDSCAL( I, AII, A( I, 1 ), LDA ) 136: END IF 137: 20 CONTINUE 138: END IF 139: * 140: RETURN 141: * 142: * End of ZLAUU2 143: * 144: END