LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ sorgtr()

subroutine sorgtr ( character  UPLO,
integer  N,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

SORGTR

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

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

 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 SSYTRD;
          = 'L': Lower triangle of A contains elementary reflectors
                 from SSYTRD.
[in]N
          N is INTEGER
          The order of the matrix Q. N >= 0.
[in,out]A
          A is REAL array, dimension (LDA,N)
          On entry, the vectors which define the elementary reflectors,
          as returned by SSYTRD.
          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 REAL array, dimension (N-1)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by SSYTRD.
[out]WORK
          WORK is REAL 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.

Definition at line 122 of file sorgtr.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  REAL A( LDA, * ), TAU( * ), WORK( * )
134 * ..
135 *
136 * =====================================================================
137 *
138 * .. Parameters ..
139  REAL ZERO, ONE
140  parameter( zero = 0.0e+0, one = 1.0e+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 ilaenv, lsame
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL sorgql, sorgqr, 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, 'SORGQL', ' ', n-1, n-1, n-1, -1 )
177  ELSE
178  nb = ilaenv( 1, 'SORGQR', ' ', 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( 'SORGTR', -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 SSYTRD 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 sorgql( n-1, n-1, n-1, a, lda, tau, work, lwork, iinfo )
220 *
221  ELSE
222 *
223 * Q was determined by a call to SSYTRD 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 sorgqr( 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 SORGTR
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 sorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQL
Definition: sorgql.f:128
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:128
Here is the call graph for this function:
Here is the caller graph for this function: