LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ 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```
Date
December 2016

Definition at line 125 of file dorgtr.f.

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