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