LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ctpmqrt.f
Go to the documentation of this file.
00001 *> \brief \b CTPMQRT
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CTPMQRT + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctpmqrt.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctpmqrt.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctpmqrt.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
00022 *                           A, LDA, B, LDB, WORK, INFO )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER SIDE, TRANS
00026 *       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       COMPLEX   V( LDV, * ), A( LDA, * ), B( LDB, * ), T( LDT, * ), 
00030 *      $          WORK( * )
00031 *       ..
00032 *  
00033 *
00034 *> \par Purpose:
00035 *  =============
00036 *>
00037 *> \verbatim
00038 *>
00039 *> CTPMQRT applies a complex orthogonal matrix Q obtained from a 
00040 *> "triangular-pentagonal" complex block reflector H to a general
00041 *> complex matrix C, which consists of two blocks A and B.
00042 *> \endverbatim
00043 *
00044 *  Arguments:
00045 *  ==========
00046 *
00047 *> \param[in] SIDE
00048 *> \verbatim
00049 *>          SIDE is CHARACTER*1
00050 *>          = 'L': apply Q or Q**H from the Left;
00051 *>          = 'R': apply Q or Q**H from the Right.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] TRANS
00055 *> \verbatim
00056 *>          TRANS is CHARACTER*1
00057 *>          = 'N':  No transpose, apply Q;
00058 *>          = 'C':  Transpose, apply Q**H.
00059 *> \endverbatim
00060 *>
00061 *> \param[in] M
00062 *> \verbatim
00063 *>          M is INTEGER
00064 *>          The number of rows of the matrix B. M >= 0.
00065 *> \endverbatim
00066 *>
00067 *> \param[in] N
00068 *> \verbatim
00069 *>          N is INTEGER
00070 *>          The number of columns of the matrix B. N >= 0.
00071 *> \endverbatim
00072 *> 
00073 *> \param[in] K
00074 *> \verbatim
00075 *>          K is INTEGER
00076 *>          The number of elementary reflectors whose product defines
00077 *>          the matrix Q.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] L
00081 *> \verbatim
00082 *>          L is INTEGER
00083 *>          The order of the trapezoidal part of V.  
00084 *>          K >= L >= 0.  See Further Details.
00085 *> \endverbatim
00086 *>
00087 *> \param[in] NB
00088 *> \verbatim
00089 *>          NB is INTEGER
00090 *>          The block size used for the storage of T.  K >= NB >= 1.
00091 *>          This must be the same value of NB used to generate T
00092 *>          in CTPQRT.
00093 *> \endverbatim
00094 *>
00095 *> \param[in] V
00096 *> \verbatim
00097 *>          V is COMPLEX array, dimension (LDA,K)
00098 *>          The i-th column must contain the vector which defines the
00099 *>          elementary reflector H(i), for i = 1,2,...,k, as returned by
00100 *>          CTPQRT in B.  See Further Details.
00101 *> \endverbatim
00102 *>
00103 *> \param[in] LDV
00104 *> \verbatim
00105 *>          LDV is INTEGER
00106 *>          The leading dimension of the array V.
00107 *>          If SIDE = 'L', LDV >= max(1,M);
00108 *>          if SIDE = 'R', LDV >= max(1,N).
00109 *> \endverbatim
00110 *>
00111 *> \param[in] T
00112 *> \verbatim
00113 *>          T is COMPLEX array, dimension (LDT,K)
00114 *>          The upper triangular factors of the block reflectors
00115 *>          as returned by CTPQRT, stored as a NB-by-K matrix.
00116 *> \endverbatim
00117 *>
00118 *> \param[in] LDT
00119 *> \verbatim
00120 *>          LDT is INTEGER
00121 *>          The leading dimension of the array T.  LDT >= NB.
00122 *> \endverbatim
00123 *>
00124 *> \param[in,out] A
00125 *> \verbatim
00126 *>          A is COMPLEX array, dimension
00127 *>          (LDA,N) if SIDE = 'L' or 
00128 *>          (LDA,K) if SIDE = 'R'
00129 *>          On entry, the K-by-N or M-by-K matrix A.
00130 *>          On exit, A is overwritten by the corresponding block of 
00131 *>          Q*C or Q**H*C or C*Q or C*Q**H.  See Further Details.
00132 *> \endverbatim
00133 *>
00134 *> \param[in] LDA
00135 *> \verbatim
00136 *>          LDA is INTEGER
00137 *>          The leading dimension of the array A. 
00138 *>          If SIDE = 'L', LDC >= max(1,K);
00139 *>          If SIDE = 'R', LDC >= max(1,M). 
00140 *> \endverbatim
00141 *>
00142 *> \param[in,out] B
00143 *> \verbatim
00144 *>          B is COMPLEX array, dimension (LDB,N)
00145 *>          On entry, the M-by-N matrix B.
00146 *>          On exit, B is overwritten by the corresponding block of
00147 *>          Q*C or Q**H*C or C*Q or C*Q**H.  See Further Details.
00148 *> \endverbatim
00149 *>
00150 *> \param[in] LDB
00151 *> \verbatim
00152 *>          LDB is INTEGER
00153 *>          The leading dimension of the array B. 
00154 *>          LDB >= max(1,M).
00155 *> \endverbatim
00156 *>
00157 *> \param[out] WORK
00158 *> \verbatim
00159 *>          WORK is COMPLEX array. The dimension of WORK is
00160 *>           N*NB if SIDE = 'L', or  M*NB if SIDE = 'R'.
00161 *> \endverbatim
00162 *>
00163 *> \param[out] INFO
00164 *> \verbatim
00165 *>          INFO is INTEGER
00166 *>          = 0:  successful exit
00167 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00168 *> \endverbatim
00169 *
00170 *  Authors:
00171 *  ========
00172 *
00173 *> \author Univ. of Tennessee 
00174 *> \author Univ. of California Berkeley 
00175 *> \author Univ. of Colorado Denver 
00176 *> \author NAG Ltd. 
00177 *
00178 *> \date April 2012
00179 *
00180 *> \ingroup complexOTHERcomputational
00181 *
00182 *> \par Further Details:
00183 *  =====================
00184 *>
00185 *> \verbatim
00186 *>
00187 *>  The columns of the pentagonal matrix V contain the elementary reflectors
00188 *>  H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a 
00189 *>  trapezoidal block V2:
00190 *>
00191 *>        V = [V1]
00192 *>            [V2].
00193 *>
00194 *>  The size of the trapezoidal block V2 is determined by the parameter L, 
00195 *>  where 0 <= L <= K; V2 is upper trapezoidal, consisting of the first L
00196 *>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is upper triangular;
00197 *>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
00198 *>
00199 *>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is M-by-K. 
00200 *>                      [B]   
00201 *>  
00202 *>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is N-by-K.
00203 *>
00204 *>  The complex orthogonal matrix Q is formed from V and T.
00205 *>
00206 *>  If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
00207 *>
00208 *>  If TRANS='C' and SIDE='L', C is on exit replaced with Q**H * C.
00209 *>
00210 *>  If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
00211 *>
00212 *>  If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**H.
00213 *> \endverbatim
00214 *>
00215 *  =====================================================================
00216       SUBROUTINE CTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
00217      $                    A, LDA, B, LDB, WORK, INFO )
00218 *
00219 *  -- LAPACK computational routine (version 3.4.1) --
00220 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00221 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00222 *     April 2012
00223 *
00224 *     .. Scalar Arguments ..
00225       CHARACTER SIDE, TRANS
00226       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
00227 *     ..
00228 *     .. Array Arguments ..
00229       COMPLEX   V( LDV, * ), A( LDA, * ), B( LDB, * ), T( LDT, * ), 
00230      $          WORK( * )
00231 *     ..
00232 *
00233 *  =====================================================================
00234 *
00235 *     ..
00236 *     .. Local Scalars ..
00237       LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
00238       INTEGER            I, IB, MB, LB, KF, Q
00239 *     ..
00240 *     .. External Functions ..
00241       LOGICAL            LSAME
00242       EXTERNAL           LSAME
00243 *     ..
00244 *     .. External Subroutines ..
00245       EXTERNAL           XERBLA, CLARFB
00246 *     ..
00247 *     .. Intrinsic Functions ..
00248       INTRINSIC          MAX, MIN
00249 *     ..
00250 *     .. Executable Statements ..
00251 *
00252 *     .. Test the input arguments ..
00253 *
00254       INFO   = 0
00255       LEFT   = LSAME( SIDE,  'L' )
00256       RIGHT  = LSAME( SIDE,  'R' )
00257       TRAN   = LSAME( TRANS, 'C' )
00258       NOTRAN = LSAME( TRANS, 'N' )
00259 *      
00260       IF( LEFT ) THEN
00261          Q = M
00262       ELSE IF ( RIGHT ) THEN
00263          Q = N
00264       END IF
00265       IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
00266          INFO = -1
00267       ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
00268          INFO = -2
00269       ELSE IF( M.LT.0 ) THEN
00270          INFO = -3
00271       ELSE IF( N.LT.0 ) THEN
00272          INFO = -4
00273       ELSE IF( K.LT.0 ) THEN
00274          INFO = -5
00275       ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
00276          INFO = -6         
00277       ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN
00278          INFO = -7
00279       ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
00280          INFO = -9
00281       ELSE IF( LDT.LT.NB ) THEN
00282          INFO = -11
00283       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00284          INFO = -13
00285       ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
00286          INFO = -15
00287       END IF
00288 *
00289       IF( INFO.NE.0 ) THEN
00290          CALL XERBLA( 'CTPMQRT', -INFO )
00291          RETURN
00292       END IF
00293 *
00294 *     .. Quick return if possible ..
00295 *
00296       IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
00297 *
00298       IF( LEFT .AND. TRAN ) THEN
00299 *
00300          DO I = 1, K, NB
00301             IB = MIN( NB, K-I+1 )
00302             MB = MIN( M-L+I+IB-1, M )
00303             IF( I.GE.L ) THEN
00304                LB = 0
00305             ELSE
00306                LB = MB-M+L-I+1
00307             END IF
00308             CALL CTPRFB( 'L', 'C', 'F', 'C', MB, N, IB, LB, 
00309      $                   V( 1, I ), LDV, T( 1, I ), LDT, 
00310      $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
00311          END DO
00312 *         
00313       ELSE IF( RIGHT .AND. NOTRAN ) THEN
00314 *
00315          DO I = 1, K, NB
00316             IB = MIN( NB, K-I+1 )
00317             MB = MIN( N-L+I+IB-1, N )
00318             IF( I.GE.L ) THEN
00319                LB = 0
00320             ELSE
00321                LB = MB-N+L-I+1
00322             END IF
00323             CALL CTPRFB( 'R', 'N', 'F', 'C', M, MB, IB, LB, 
00324      $                   V( 1, I ), LDV, T( 1, I ), LDT, 
00325      $                   A( 1, I ), LDA, B, LDB, WORK, M )
00326          END DO
00327 *
00328       ELSE IF( LEFT .AND. NOTRAN ) THEN
00329 *
00330          KF = ((K-1)/NB)*NB+1
00331          DO I = KF, 1, -NB
00332             IB = MIN( NB, K-I+1 )  
00333             MB = MIN( M-L+I+IB-1, M )
00334             IF( I.GE.L ) THEN
00335                LB = 0
00336             ELSE
00337                LB = MB-M+L-I+1
00338             END IF                   
00339             CALL CTPRFB( 'L', 'N', 'F', 'C', MB, N, IB, LB,
00340      $                   V( 1, I ), LDV, T( 1, I ), LDT, 
00341      $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
00342          END DO
00343 *
00344       ELSE IF( RIGHT .AND. TRAN ) THEN
00345 *
00346          KF = ((K-1)/NB)*NB+1
00347          DO I = KF, 1, -NB
00348             IB = MIN( NB, K-I+1 )         
00349             MB = MIN( N-L+I+IB-1, N )
00350             IF( I.GE.L ) THEN
00351                LB = 0
00352             ELSE
00353                LB = MB-N+L-I+1
00354             END IF
00355             CALL CTPRFB( 'R', 'C', 'F', 'C', M, MB, IB, LB,
00356      $                   V( 1, I ), LDV, T( 1, I ), LDT, 
00357      $                   A( 1, I ), LDA, B, LDB, WORK, M )
00358          END DO
00359 *
00360       END IF
00361 *
00362       RETURN
00363 *
00364 *     End of CTPMQRT
00365 *
00366       END
 All Files Functions