LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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

Download DORGTR + dependencies [TGZ] [ZIP] [TXT]

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
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 125 of file dorgtr.f.

125 *
126 * -- LAPACK computational routine (version 3.4.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 * November 2011
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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130

Here is the call graph for this function:

Here is the caller graph for this function: