3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download DORGL2 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgl2.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgl2.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgl2.f">
21 * SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
23 * .. Scalar Arguments ..
24 * INTEGER INFO, K, LDA, M, N
26 * .. Array Arguments ..
27 * DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
36 *> DORGL2 generates an m by n real matrix Q with orthonormal rows,
37 *> which is defined as the first m rows of a product of k elementary
38 *> reflectors of order n
40 *> Q = H(k) . . . H(2) H(1)
42 *> as returned by DGELQF.
51 *> The number of rows of the matrix Q. M >= 0.
57 *> The number of columns of the matrix Q. N >= M.
63 *> The number of elementary reflectors whose product defines the
64 *> matrix Q. M >= K >= 0.
69 *> A is DOUBLE PRECISION array, dimension (LDA,N)
70 *> On entry, the i-th row must contain the vector which defines
71 *> the elementary reflector H(i), for i = 1,2,...,k, as returned
72 *> by DGELQF in the first k rows of its array argument A.
73 *> On exit, the m-by-n matrix Q.
79 *> The first dimension of the array A. LDA >= max(1,M).
84 *> TAU is DOUBLE PRECISION array, dimension (K)
85 *> TAU(i) must contain the scalar factor of the elementary
86 *> reflector H(i), as returned by DGELQF.
91 *> WORK is DOUBLE PRECISION array, dimension (M)
97 *> = 0: successful exit
98 *> < 0: if INFO = -i, the i-th argument has an illegal value
104 *> \author Univ. of Tennessee
105 *> \author Univ. of California Berkeley
106 *> \author Univ. of Colorado Denver
109 *> \date November 2011
111 *> \ingroup doubleOTHERcomputational
113 * =====================================================================
114 SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
116 * -- LAPACK computational routine (version 3.4.0) --
117 * -- LAPACK is a software package provided by Univ. of Tennessee, --
118 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
121 * .. Scalar Arguments ..
122 INTEGER INFO, K, LDA, M, N
124 * .. Array Arguments ..
125 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
128 * =====================================================================
131 DOUBLE PRECISION ONE, ZERO
132 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
134 * .. Local Scalars ..
137 * .. External Subroutines ..
138 EXTERNAL DLARF, DSCAL, XERBLA
140 * .. Intrinsic Functions ..
143 * .. Executable Statements ..
145 * Test the input arguments
150 ELSE IF( N.LT.M ) THEN
152 ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
154 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
158 CALL XERBLA( 'DORGL2', -INFO )
162 * Quick return if possible
169 * Initialise rows k+1:m to rows of the unit matrix
175 IF( J.GT.K .AND. J.LE.M )
182 * Apply H(i) to A(i:m,i:n) from the right
187 CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
188 $ TAU( I ), A( I+1, I ), LDA, WORK )
190 CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
192 A( I, I ) = ONE - TAU( I )
194 * Set A(i,1:i-1) to zero