LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zungrq.f
Go to the documentation of this file.
00001 *> \brief \b ZUNGRQ
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZUNGRQ + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungrq.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungrq.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungrq.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INFO, K, LDA, LWORK, M, N
00025 *       ..
00026 *       .. Array Arguments ..
00027 *       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
00028 *       ..
00029 *  
00030 *
00031 *> \par Purpose:
00032 *  =============
00033 *>
00034 *> \verbatim
00035 *>
00036 *> ZUNGRQ generates an M-by-N complex matrix Q with orthonormal rows,
00037 *> which is defined as the last M rows of a product of K elementary
00038 *> reflectors of order N
00039 *>
00040 *>       Q  =  H(1)**H H(2)**H . . . H(k)**H
00041 *>
00042 *> as returned by ZGERQF.
00043 *> \endverbatim
00044 *
00045 *  Arguments:
00046 *  ==========
00047 *
00048 *> \param[in] M
00049 *> \verbatim
00050 *>          M is INTEGER
00051 *>          The number of rows of the matrix Q. M >= 0.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] N
00055 *> \verbatim
00056 *>          N is INTEGER
00057 *>          The number of columns of the matrix Q. N >= M.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] K
00061 *> \verbatim
00062 *>          K is INTEGER
00063 *>          The number of elementary reflectors whose product defines the
00064 *>          matrix Q. M >= K >= 0.
00065 *> \endverbatim
00066 *>
00067 *> \param[in,out] A
00068 *> \verbatim
00069 *>          A is COMPLEX*16 array, dimension (LDA,N)
00070 *>          On entry, the (m-k+i)-th row must contain the vector which
00071 *>          defines the elementary reflector H(i), for i = 1,2,...,k, as
00072 *>          returned by ZGERQF in the last k rows of its array argument
00073 *>          A.
00074 *>          On exit, the M-by-N matrix Q.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] LDA
00078 *> \verbatim
00079 *>          LDA is INTEGER
00080 *>          The first dimension of the array A. LDA >= max(1,M).
00081 *> \endverbatim
00082 *>
00083 *> \param[in] TAU
00084 *> \verbatim
00085 *>          TAU is COMPLEX*16 array, dimension (K)
00086 *>          TAU(i) must contain the scalar factor of the elementary
00087 *>          reflector H(i), as returned by ZGERQF.
00088 *> \endverbatim
00089 *>
00090 *> \param[out] WORK
00091 *> \verbatim
00092 *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
00093 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
00094 *> \endverbatim
00095 *>
00096 *> \param[in] LWORK
00097 *> \verbatim
00098 *>          LWORK is INTEGER
00099 *>          The dimension of the array WORK. LWORK >= max(1,M).
00100 *>          For optimum performance LWORK >= M*NB, where NB is the
00101 *>          optimal blocksize.
00102 *>
00103 *>          If LWORK = -1, then a workspace query is assumed; the routine
00104 *>          only calculates the optimal size of the WORK array, returns
00105 *>          this value as the first entry of the WORK array, and no error
00106 *>          message related to LWORK is issued by XERBLA.
00107 *> \endverbatim
00108 *>
00109 *> \param[out] INFO
00110 *> \verbatim
00111 *>          INFO is INTEGER
00112 *>          = 0:  successful exit
00113 *>          < 0:  if INFO = -i, the i-th argument has an illegal value
00114 *> \endverbatim
00115 *
00116 *  Authors:
00117 *  ========
00118 *
00119 *> \author Univ. of Tennessee 
00120 *> \author Univ. of California Berkeley 
00121 *> \author Univ. of Colorado Denver 
00122 *> \author NAG Ltd. 
00123 *
00124 *> \date November 2011
00125 *
00126 *> \ingroup complex16OTHERcomputational
00127 *
00128 *  =====================================================================
00129       SUBROUTINE ZUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
00130 *
00131 *  -- LAPACK computational routine (version 3.4.0) --
00132 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00133 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00134 *     November 2011
00135 *
00136 *     .. Scalar Arguments ..
00137       INTEGER            INFO, K, LDA, LWORK, M, N
00138 *     ..
00139 *     .. Array Arguments ..
00140       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
00141 *     ..
00142 *
00143 *  =====================================================================
00144 *
00145 *     .. Parameters ..
00146       COMPLEX*16         ZERO
00147       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
00148 *     ..
00149 *     .. Local Scalars ..
00150       LOGICAL            LQUERY
00151       INTEGER            I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
00152      $                   LWKOPT, NB, NBMIN, NX
00153 *     ..
00154 *     .. External Subroutines ..
00155       EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNGR2
00156 *     ..
00157 *     .. Intrinsic Functions ..
00158       INTRINSIC          MAX, MIN
00159 *     ..
00160 *     .. External Functions ..
00161       INTEGER            ILAENV
00162       EXTERNAL           ILAENV
00163 *     ..
00164 *     .. Executable Statements ..
00165 *
00166 *     Test the input arguments
00167 *
00168       INFO = 0
00169       LQUERY = ( LWORK.EQ.-1 )
00170       IF( M.LT.0 ) THEN
00171          INFO = -1
00172       ELSE IF( N.LT.M ) THEN
00173          INFO = -2
00174       ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
00175          INFO = -3
00176       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00177          INFO = -5
00178       END IF
00179 *
00180       IF( INFO.EQ.0 ) THEN
00181          IF( M.LE.0 ) THEN
00182             LWKOPT = 1
00183          ELSE
00184             NB = ILAENV( 1, 'ZUNGRQ', ' ', M, N, K, -1 )
00185             LWKOPT = M*NB
00186          END IF
00187          WORK( 1 ) = LWKOPT
00188 *
00189          IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
00190             INFO = -8
00191          END IF
00192       END IF
00193 *
00194       IF( INFO.NE.0 ) THEN
00195          CALL XERBLA( 'ZUNGRQ', -INFO )
00196          RETURN
00197       ELSE IF( LQUERY ) THEN
00198          RETURN
00199       END IF
00200 *
00201 *     Quick return if possible
00202 *
00203       IF( M.LE.0 ) THEN
00204          RETURN
00205       END IF
00206 *
00207       NBMIN = 2
00208       NX = 0
00209       IWS = M
00210       IF( NB.GT.1 .AND. NB.LT.K ) THEN
00211 *
00212 *        Determine when to cross over from blocked to unblocked code.
00213 *
00214          NX = MAX( 0, ILAENV( 3, 'ZUNGRQ', ' ', M, N, K, -1 ) )
00215          IF( NX.LT.K ) THEN
00216 *
00217 *           Determine if workspace is large enough for blocked code.
00218 *
00219             LDWORK = M
00220             IWS = LDWORK*NB
00221             IF( LWORK.LT.IWS ) THEN
00222 *
00223 *              Not enough workspace to use optimal NB:  reduce NB and
00224 *              determine the minimum value of NB.
00225 *
00226                NB = LWORK / LDWORK
00227                NBMIN = MAX( 2, ILAENV( 2, 'ZUNGRQ', ' ', M, N, K, -1 ) )
00228             END IF
00229          END IF
00230       END IF
00231 *
00232       IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
00233 *
00234 *        Use blocked code after the first block.
00235 *        The last kk rows are handled by the block method.
00236 *
00237          KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
00238 *
00239 *        Set A(1:m-kk,n-kk+1:n) to zero.
00240 *
00241          DO 20 J = N - KK + 1, N
00242             DO 10 I = 1, M - KK
00243                A( I, J ) = ZERO
00244    10       CONTINUE
00245    20    CONTINUE
00246       ELSE
00247          KK = 0
00248       END IF
00249 *
00250 *     Use unblocked code for the first or only block.
00251 *
00252       CALL ZUNGR2( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
00253 *
00254       IF( KK.GT.0 ) THEN
00255 *
00256 *        Use blocked code
00257 *
00258          DO 50 I = K - KK + 1, K, NB
00259             IB = MIN( NB, K-I+1 )
00260             II = M - K + I
00261             IF( II.GT.1 ) THEN
00262 *
00263 *              Form the triangular factor of the block reflector
00264 *              H = H(i+ib-1) . . . H(i+1) H(i)
00265 *
00266                CALL ZLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
00267      $                      A( II, 1 ), LDA, TAU( I ), WORK, LDWORK )
00268 *
00269 *              Apply H**H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
00270 *
00271                CALL ZLARFB( 'Right', 'Conjugate transpose', 'Backward',
00272      $                      'Rowwise', II-1, N-K+I+IB-1, IB, A( II, 1 ),
00273      $                      LDA, WORK, LDWORK, A, LDA, WORK( IB+1 ),
00274      $                      LDWORK )
00275             END IF
00276 *
00277 *           Apply H**H to columns 1:n-k+i+ib-1 of current block
00278 *
00279             CALL ZUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ),
00280      $                   WORK, IINFO )
00281 *
00282 *           Set columns n-k+i+ib:n of current block to zero
00283 *
00284             DO 40 L = N - K + I + IB, N
00285                DO 30 J = II, II + IB - 1
00286                   A( J, L ) = ZERO
00287    30          CONTINUE
00288    40       CONTINUE
00289    50    CONTINUE
00290       END IF
00291 *
00292       WORK( 1 ) = IWS
00293       RETURN
00294 *
00295 *     End of ZUNGRQ
00296 *
00297       END
 All Files Functions