LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cungqr.f
Go to the documentation of this file.
00001 *> \brief \b CUNGQR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CUNGQR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cungqr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cungqr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cungqr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CUNGQR( 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            A( LDA, * ), TAU( * ), WORK( * )
00028 *       ..
00029 *  
00030 *
00031 *> \par Purpose:
00032 *  =============
00033 *>
00034 *> \verbatim
00035 *>
00036 *> CUNGQR generates an M-by-N complex matrix Q with orthonormal columns,
00037 *> which is defined as the first N columns of a product of K elementary
00038 *> reflectors of order M
00039 *>
00040 *>       Q  =  H(1) H(2) . . . H(k)
00041 *>
00042 *> as returned by CGEQRF.
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 array, dimension (LDA,N)
00070 *>          On entry, the i-th column must contain the vector which
00071 *>          defines the elementary reflector H(i), for i = 1,2,...,k, as
00072 *>          returned by CGEQRF in the first 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 array, dimension (K)
00086 *>          TAU(i) must contain the scalar factor of the elementary
00087 *>          reflector H(i), as returned by CGEQRF.
00088 *> \endverbatim
00089 *>
00090 *> \param[out] WORK
00091 *> \verbatim
00092 *>          WORK is COMPLEX 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 complexOTHERcomputational
00127 *
00128 *  =====================================================================
00129       SUBROUTINE CUNGQR( 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            A( LDA, * ), TAU( * ), WORK( * )
00141 *     ..
00142 *
00143 *  =====================================================================
00144 *
00145 *     .. Parameters ..
00146       COMPLEX            ZERO
00147       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00148 *     ..
00149 *     .. Local Scalars ..
00150       LOGICAL            LQUERY
00151       INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
00152      $                   LWKOPT, NB, NBMIN, NX
00153 *     ..
00154 *     .. External Subroutines ..
00155       EXTERNAL           CLARFB, CLARFT, CUNG2R, XERBLA
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       NB = ILAENV( 1, 'CUNGQR', ' ', M, N, K, -1 )
00170       LWKOPT = MAX( 1, N )*NB
00171       WORK( 1 ) = LWKOPT
00172       LQUERY = ( LWORK.EQ.-1 )
00173       IF( M.LT.0 ) THEN
00174          INFO = -1
00175       ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
00176          INFO = -2
00177       ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
00178          INFO = -3
00179       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00180          INFO = -5
00181       ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
00182          INFO = -8
00183       END IF
00184       IF( INFO.NE.0 ) THEN
00185          CALL XERBLA( 'CUNGQR', -INFO )
00186          RETURN
00187       ELSE IF( LQUERY ) THEN
00188          RETURN
00189       END IF
00190 *
00191 *     Quick return if possible
00192 *
00193       IF( N.LE.0 ) THEN
00194          WORK( 1 ) = 1
00195          RETURN
00196       END IF
00197 *
00198       NBMIN = 2
00199       NX = 0
00200       IWS = N
00201       IF( NB.GT.1 .AND. NB.LT.K ) THEN
00202 *
00203 *        Determine when to cross over from blocked to unblocked code.
00204 *
00205          NX = MAX( 0, ILAENV( 3, 'CUNGQR', ' ', M, N, K, -1 ) )
00206          IF( NX.LT.K ) THEN
00207 *
00208 *           Determine if workspace is large enough for blocked code.
00209 *
00210             LDWORK = N
00211             IWS = LDWORK*NB
00212             IF( LWORK.LT.IWS ) THEN
00213 *
00214 *              Not enough workspace to use optimal NB:  reduce NB and
00215 *              determine the minimum value of NB.
00216 *
00217                NB = LWORK / LDWORK
00218                NBMIN = MAX( 2, ILAENV( 2, 'CUNGQR', ' ', M, N, K, -1 ) )
00219             END IF
00220          END IF
00221       END IF
00222 *
00223       IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
00224 *
00225 *        Use blocked code after the last block.
00226 *        The first kk columns are handled by the block method.
00227 *
00228          KI = ( ( K-NX-1 ) / NB )*NB
00229          KK = MIN( K, KI+NB )
00230 *
00231 *        Set A(1:kk,kk+1:n) to zero.
00232 *
00233          DO 20 J = KK + 1, N
00234             DO 10 I = 1, KK
00235                A( I, J ) = ZERO
00236    10       CONTINUE
00237    20    CONTINUE
00238       ELSE
00239          KK = 0
00240       END IF
00241 *
00242 *     Use unblocked code for the last or only block.
00243 *
00244       IF( KK.LT.N )
00245      $   CALL CUNG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
00246      $                TAU( KK+1 ), WORK, IINFO )
00247 *
00248       IF( KK.GT.0 ) THEN
00249 *
00250 *        Use blocked code
00251 *
00252          DO 50 I = KI + 1, 1, -NB
00253             IB = MIN( NB, K-I+1 )
00254             IF( I+IB.LE.N ) THEN
00255 *
00256 *              Form the triangular factor of the block reflector
00257 *              H = H(i) H(i+1) . . . H(i+ib-1)
00258 *
00259                CALL CLARFT( 'Forward', 'Columnwise', M-I+1, IB,
00260      $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
00261 *
00262 *              Apply H to A(i:m,i+ib:n) from the left
00263 *
00264                CALL CLARFB( 'Left', 'No transpose', 'Forward',
00265      $                      'Columnwise', M-I+1, N-I-IB+1, IB,
00266      $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
00267      $                      LDA, WORK( IB+1 ), LDWORK )
00268             END IF
00269 *
00270 *           Apply H to rows i:m of current block
00271 *
00272             CALL CUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
00273      $                   IINFO )
00274 *
00275 *           Set rows 1:i-1 of current block to zero
00276 *
00277             DO 40 J = I, I + IB - 1
00278                DO 30 L = 1, I - 1
00279                   A( L, J ) = ZERO
00280    30          CONTINUE
00281    40       CONTINUE
00282    50    CONTINUE
00283       END IF
00284 *
00285       WORK( 1 ) = IWS
00286       RETURN
00287 *
00288 *     End of CUNGQR
00289 *
00290       END
 All Files Functions