Annotation of rpl/lapack/lapack/dopgtr.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE DOPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
! 2: *
! 3: * -- LAPACK 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, LDQ, N
! 11: * ..
! 12: * .. Array Arguments ..
! 13: DOUBLE PRECISION AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
! 14: * ..
! 15: *
! 16: * Purpose
! 17: * =======
! 18: *
! 19: * DOPGTR generates a real orthogonal matrix Q which is defined as the
! 20: * product of n-1 elementary reflectors H(i) of order n, as returned by
! 21: * DSPTRD using packed storage:
! 22: *
! 23: * if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
! 24: *
! 25: * if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
! 26: *
! 27: * Arguments
! 28: * =========
! 29: *
! 30: * UPLO (input) CHARACTER*1
! 31: * = 'U': Upper triangular packed storage used in previous
! 32: * call to DSPTRD;
! 33: * = 'L': Lower triangular packed storage used in previous
! 34: * call to DSPTRD.
! 35: *
! 36: * N (input) INTEGER
! 37: * The order of the matrix Q. N >= 0.
! 38: *
! 39: * AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
! 40: * The vectors which define the elementary reflectors, as
! 41: * returned by DSPTRD.
! 42: *
! 43: * TAU (input) DOUBLE PRECISION array, dimension (N-1)
! 44: * TAU(i) must contain the scalar factor of the elementary
! 45: * reflector H(i), as returned by DSPTRD.
! 46: *
! 47: * Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
! 48: * The N-by-N orthogonal matrix Q.
! 49: *
! 50: * LDQ (input) INTEGER
! 51: * The leading dimension of the array Q. LDQ >= max(1,N).
! 52: *
! 53: * WORK (workspace) DOUBLE PRECISION array, dimension (N-1)
! 54: *
! 55: * INFO (output) INTEGER
! 56: * = 0: successful exit
! 57: * < 0: if INFO = -i, the i-th argument had an illegal value
! 58: *
! 59: * =====================================================================
! 60: *
! 61: * .. Parameters ..
! 62: DOUBLE PRECISION ZERO, ONE
! 63: PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
! 64: * ..
! 65: * .. Local Scalars ..
! 66: LOGICAL UPPER
! 67: INTEGER I, IINFO, IJ, J
! 68: * ..
! 69: * .. External Functions ..
! 70: LOGICAL LSAME
! 71: EXTERNAL LSAME
! 72: * ..
! 73: * .. External Subroutines ..
! 74: EXTERNAL DORG2L, DORG2R, XERBLA
! 75: * ..
! 76: * .. Intrinsic Functions ..
! 77: INTRINSIC MAX
! 78: * ..
! 79: * .. Executable Statements ..
! 80: *
! 81: * Test the input arguments
! 82: *
! 83: INFO = 0
! 84: UPPER = LSAME( UPLO, 'U' )
! 85: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
! 86: INFO = -1
! 87: ELSE IF( N.LT.0 ) THEN
! 88: INFO = -2
! 89: ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
! 90: INFO = -6
! 91: END IF
! 92: IF( INFO.NE.0 ) THEN
! 93: CALL XERBLA( 'DOPGTR', -INFO )
! 94: RETURN
! 95: END IF
! 96: *
! 97: * Quick return if possible
! 98: *
! 99: IF( N.EQ.0 )
! 100: $ RETURN
! 101: *
! 102: IF( UPPER ) THEN
! 103: *
! 104: * Q was determined by a call to DSPTRD with UPLO = 'U'
! 105: *
! 106: * Unpack the vectors which define the elementary reflectors and
! 107: * set the last row and column of Q equal to those of the unit
! 108: * matrix
! 109: *
! 110: IJ = 2
! 111: DO 20 J = 1, N - 1
! 112: DO 10 I = 1, J - 1
! 113: Q( I, J ) = AP( IJ )
! 114: IJ = IJ + 1
! 115: 10 CONTINUE
! 116: IJ = IJ + 2
! 117: Q( N, J ) = ZERO
! 118: 20 CONTINUE
! 119: DO 30 I = 1, N - 1
! 120: Q( I, N ) = ZERO
! 121: 30 CONTINUE
! 122: Q( N, N ) = ONE
! 123: *
! 124: * Generate Q(1:n-1,1:n-1)
! 125: *
! 126: CALL DORG2L( N-1, N-1, N-1, Q, LDQ, TAU, WORK, IINFO )
! 127: *
! 128: ELSE
! 129: *
! 130: * Q was determined by a call to DSPTRD with UPLO = 'L'.
! 131: *
! 132: * Unpack the vectors which define the elementary reflectors and
! 133: * set the first row and column of Q equal to those of the unit
! 134: * matrix
! 135: *
! 136: Q( 1, 1 ) = ONE
! 137: DO 40 I = 2, N
! 138: Q( I, 1 ) = ZERO
! 139: 40 CONTINUE
! 140: IJ = 3
! 141: DO 60 J = 2, N
! 142: Q( 1, J ) = ZERO
! 143: DO 50 I = J + 1, N
! 144: Q( I, J ) = AP( IJ )
! 145: IJ = IJ + 1
! 146: 50 CONTINUE
! 147: IJ = IJ + 2
! 148: 60 CONTINUE
! 149: IF( N.GT.1 ) THEN
! 150: *
! 151: * Generate Q(2:n,2:n)
! 152: *
! 153: CALL DORG2R( N-1, N-1, N-1, Q( 2, 2 ), LDQ, TAU, WORK,
! 154: $ IINFO )
! 155: END IF
! 156: END IF
! 157: RETURN
! 158: *
! 159: * End of DOPGTR
! 160: *
! 161: END
CVSweb interface <joel.bertrand@systella.fr>