LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zungql.f
Go to the documentation of this file.
00001 *> \brief \b ZUNGQL
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZUNGQL + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungql.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungql.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungql.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZUNGQL( 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 *> ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns,
00037 *> which is defined as the last N columns of a product of K elementary
00038 *> reflectors of order M
00039 *>
00040 *>       Q  =  H(k) . . . H(2) H(1)
00041 *>
00042 *> as returned by ZGEQLF.
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. M >= N >= 0.
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. N >= 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 (n-k+i)-th column must contain the vector which
00071 *>          defines the elementary reflector H(i), for i = 1,2,...,k, as
00072 *>          returned by ZGEQLF in the last k columns of its array
00073 *>          argument 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 ZGEQLF.
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,N).
00100 *>          For optimum performance LWORK >= N*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 ZUNGQL( 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, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
00152      $                   NB, NBMIN, NX
00153 *     ..
00154 *     .. External Subroutines ..
00155       EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNG2L
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.0 .OR. N.GT.M ) THEN
00173          INFO = -2
00174       ELSE IF( K.LT.0 .OR. K.GT.N ) 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( N.EQ.0 ) THEN
00182             LWKOPT = 1
00183          ELSE
00184             NB = ILAENV( 1, 'ZUNGQL', ' ', M, N, K, -1 )
00185             LWKOPT = N*NB
00186          END IF
00187          WORK( 1 ) = LWKOPT
00188 *
00189          IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
00190             INFO = -8
00191          END IF
00192       END IF
00193 *
00194       IF( INFO.NE.0 ) THEN
00195          CALL XERBLA( 'ZUNGQL', -INFO )
00196          RETURN
00197       ELSE IF( LQUERY ) THEN
00198          RETURN
00199       END IF
00200 *
00201 *     Quick return if possible
00202 *
00203       IF( N.LE.0 ) THEN
00204          RETURN
00205       END IF
00206 *
00207       NBMIN = 2
00208       NX = 0
00209       IWS = N
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, 'ZUNGQL', ' ', M, N, K, -1 ) )
00215          IF( NX.LT.K ) THEN
00216 *
00217 *           Determine if workspace is large enough for blocked code.
00218 *
00219             LDWORK = N
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, 'ZUNGQL', ' ', 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 columns are handled by the block method.
00236 *
00237          KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
00238 *
00239 *        Set A(m-kk+1:m,1:n-kk) to zero.
00240 *
00241          DO 20 J = 1, N - KK
00242             DO 10 I = M - KK + 1, M
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 ZUNG2L( 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             IF( N-K+I.GT.1 ) THEN
00261 *
00262 *              Form the triangular factor of the block reflector
00263 *              H = H(i+ib-1) . . . H(i+1) H(i)
00264 *
00265                CALL ZLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
00266      $                      A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
00267 *
00268 *              Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
00269 *
00270                CALL ZLARFB( 'Left', 'No transpose', 'Backward',
00271      $                      'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
00272      $                      A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
00273      $                      WORK( IB+1 ), LDWORK )
00274             END IF
00275 *
00276 *           Apply H to rows 1:m-k+i+ib-1 of current block
00277 *
00278             CALL ZUNG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
00279      $                   TAU( I ), WORK, IINFO )
00280 *
00281 *           Set rows m-k+i+ib:m of current block to zero
00282 *
00283             DO 40 J = N - K + I, N - K + I + IB - 1
00284                DO 30 L = M - K + I + IB, M
00285                   A( L, J ) = ZERO
00286    30          CONTINUE
00287    40       CONTINUE
00288    50    CONTINUE
00289       END IF
00290 *
00291       WORK( 1 ) = IWS
00292       RETURN
00293 *
00294 *     End of ZUNGQL
00295 *
00296       END
 All Files Functions