 LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ dorgtr()

 subroutine dorgtr ( character UPLO, integer N, double precision, dimension( lda, * ) A, integer LDA, double precision, dimension( * ) TAU, double precision, dimension( * ) WORK, integer LWORK, integer INFO )

DORGTR

Purpose:
``` DORGTR generates a real orthogonal matrix Q which is defined as the
product of n-1 elementary reflectors of order N, as returned by
DSYTRD:

if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),

if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).```
Parameters
 [in] UPLO ``` UPLO is CHARACTER*1 = 'U': Upper triangle of A contains elementary reflectors from DSYTRD; = 'L': Lower triangle of A contains elementary reflectors from DSYTRD.``` [in] N ``` N is INTEGER The order of the matrix Q. N >= 0.``` [in,out] A ``` A is DOUBLE PRECISION array, dimension (LDA,N) On entry, the vectors which define the elementary reflectors, as returned by DSYTRD. On exit, the N-by-N orthogonal matrix Q.``` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N).``` [in] TAU ``` TAU is DOUBLE PRECISION array, dimension (N-1) TAU(i) must contain the scalar factor of the elementary reflector H(i), as returned by DSYTRD.``` [out] WORK ``` WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) On exit, if INFO = 0, WORK(1) returns the optimal LWORK.``` [in] LWORK ``` LWORK is INTEGER The dimension of the array WORK. LWORK >= max(1,N-1). For optimum performance LWORK >= (N-1)*NB, where NB is the optimal blocksize. If LWORK = -1, then a workspace query is assumed; the routine only calculates the optimal size of the WORK array, returns this value as the first entry of the WORK array, and no error message related to LWORK is issued by XERBLA.``` [out] INFO ``` INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value```

Definition at line 122 of file dorgtr.f.

123*
124* -- LAPACK computational routine --
125* -- LAPACK is a software package provided by Univ. of Tennessee, --
126* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128* .. Scalar Arguments ..
129 CHARACTER UPLO
130 INTEGER INFO, LDA, LWORK, N
131* ..
132* .. Array Arguments ..
133 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
134* ..
135*
136* =====================================================================
137*
138* .. Parameters ..
139 DOUBLE PRECISION ZERO, ONE
140 parameter( zero = 0.0d+0, one = 1.0d+0 )
141* ..
142* .. Local Scalars ..
143 LOGICAL LQUERY, UPPER
144 INTEGER I, IINFO, J, LWKOPT, NB
145* ..
146* .. External Functions ..
147 LOGICAL LSAME
148 INTEGER ILAENV
149 EXTERNAL lsame, ilaenv
150* ..
151* .. External Subroutines ..
152 EXTERNAL dorgql, dorgqr, xerbla
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC max
156* ..
157* .. Executable Statements ..
158*
159* Test the input arguments
160*
161 info = 0
162 lquery = ( lwork.EQ.-1 )
163 upper = lsame( uplo, 'U' )
164 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
165 info = -1
166 ELSE IF( n.LT.0 ) THEN
167 info = -2
168 ELSE IF( lda.LT.max( 1, n ) ) THEN
169 info = -4
170 ELSE IF( lwork.LT.max( 1, n-1 ) .AND. .NOT.lquery ) THEN
171 info = -7
172 END IF
173*
174 IF( info.EQ.0 ) THEN
175 IF( upper ) THEN
176 nb = ilaenv( 1, 'DORGQL', ' ', n-1, n-1, n-1, -1 )
177 ELSE
178 nb = ilaenv( 1, 'DORGQR', ' ', n-1, n-1, n-1, -1 )
179 END IF
180 lwkopt = max( 1, n-1 )*nb
181 work( 1 ) = lwkopt
182 END IF
183*
184 IF( info.NE.0 ) THEN
185 CALL xerbla( 'DORGTR', -info )
186 RETURN
187 ELSE IF( lquery ) THEN
188 RETURN
189 END IF
190*
191* Quick return if possible
192*
193 IF( n.EQ.0 ) THEN
194 work( 1 ) = 1
195 RETURN
196 END IF
197*
198 IF( upper ) THEN
199*
200* Q was determined by a call to DSYTRD with UPLO = 'U'
201*
202* Shift the vectors which define the elementary reflectors one
203* column to the left, and set the last row and column of Q to
204* those of the unit matrix
205*
206 DO 20 j = 1, n - 1
207 DO 10 i = 1, j - 1
208 a( i, j ) = a( i, j+1 )
209 10 CONTINUE
210 a( n, j ) = zero
211 20 CONTINUE
212 DO 30 i = 1, n - 1
213 a( i, n ) = zero
214 30 CONTINUE
215 a( n, n ) = one
216*
217* Generate Q(1:n-1,1:n-1)
218*
219 CALL dorgql( n-1, n-1, n-1, a, lda, tau, work, lwork, iinfo )
220*
221 ELSE
222*
223* Q was determined by a call to DSYTRD with UPLO = 'L'.
224*
225* Shift the vectors which define the elementary reflectors one
226* column to the right, and set the first row and column of Q to
227* those of the unit matrix
228*
229 DO 50 j = n, 2, -1
230 a( 1, j ) = zero
231 DO 40 i = j + 1, n
232 a( i, j ) = a( i, j-1 )
233 40 CONTINUE
234 50 CONTINUE
235 a( 1, 1 ) = one
236 DO 60 i = 2, n
237 a( i, 1 ) = zero
238 60 CONTINUE
239 IF( n.GT.1 ) THEN
240*
241* Generate Q(2:n,2:n)
242*
243 CALL dorgqr( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
244 \$ lwork, iinfo )
245 END IF
246 END IF
247 work( 1 ) = lwkopt
248 RETURN
249*
250* End of DORGTR
251*
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:128
subroutine dorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQL
Definition: dorgql.f:128
Here is the call graph for this function:
Here is the caller graph for this function: