LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sgemqrt.f
Go to the documentation of this file.
00001 *> \brief \b SGEMQRT
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SGEMQRT + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgemqrt.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgemqrt.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgemqrt.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, 
00022 *                          C, LDC, WORK, INFO )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER SIDE, TRANS
00026 *       INTEGER   INFO, K, LDV, LDC, M, N, NB, LDT
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       REAL   V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> SGEMQRT overwrites the general real M-by-N matrix C with
00039 *>
00040 *>                 SIDE = 'L'     SIDE = 'R'
00041 *> TRANS = 'N':      Q C            C Q
00042 *> TRANS = 'T':   Q**T C            C Q**T
00043 *>
00044 *> where Q is a real orthogonal matrix defined as the product of K
00045 *> elementary reflectors:
00046 *>
00047 *>       Q = H(1) H(2) . . . H(K) = I - V T V**T
00048 *>
00049 *> generated using the compact WY representation as returned by SGEQRT. 
00050 *>
00051 *> Q is of order M if SIDE = 'L' and of order N  if SIDE = 'R'.
00052 *> \endverbatim
00053 *
00054 *  Arguments:
00055 *  ==========
00056 *
00057 *> \param[in] SIDE
00058 *> \verbatim
00059 *>          SIDE is CHARACTER*1
00060 *>          = 'L': apply Q or Q**T from the Left;
00061 *>          = 'R': apply Q or Q**T from the Right.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] TRANS
00065 *> \verbatim
00066 *>          TRANS is CHARACTER*1
00067 *>          = 'N':  No transpose, apply Q;
00068 *>          = 'T':  Transpose, apply Q**T.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] M
00072 *> \verbatim
00073 *>          M is INTEGER
00074 *>          The number of rows of the matrix C. M >= 0.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] N
00078 *> \verbatim
00079 *>          N is INTEGER
00080 *>          The number of columns of the matrix C. N >= 0.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] K
00084 *> \verbatim
00085 *>          K is INTEGER
00086 *>          The number of elementary reflectors whose product defines
00087 *>          the matrix Q.
00088 *>          If SIDE = 'L', M >= K >= 0;
00089 *>          if SIDE = 'R', N >= K >= 0.
00090 *> \endverbatim
00091 *>
00092 *> \param[in] NB
00093 *> \verbatim
00094 *>          NB is INTEGER
00095 *>          The block size used for the storage of T.  K >= NB >= 1.
00096 *>          This must be the same value of NB used to generate T
00097 *>          in CGEQRT.
00098 *> \endverbatim
00099 *>
00100 *> \param[in] V
00101 *> \verbatim
00102 *>          V is REAL array, dimension (LDV,K)
00103 *>          The i-th column must contain the vector which defines the
00104 *>          elementary reflector H(i), for i = 1,2,...,k, as returned by
00105 *>          CGEQRT in the first K columns of its array argument A.
00106 *> \endverbatim
00107 *>
00108 *> \param[in] LDV
00109 *> \verbatim
00110 *>          LDV is INTEGER
00111 *>          The leading dimension of the array V.
00112 *>          If SIDE = 'L', LDA >= max(1,M);
00113 *>          if SIDE = 'R', LDA >= max(1,N).
00114 *> \endverbatim
00115 *>
00116 *> \param[in] T
00117 *> \verbatim
00118 *>          T is REAL array, dimension (LDT,K)
00119 *>          The upper triangular factors of the block reflectors
00120 *>          as returned by CGEQRT, stored as a NB-by-N matrix.
00121 *> \endverbatim
00122 *>
00123 *> \param[in] LDT
00124 *> \verbatim
00125 *>          LDT is INTEGER
00126 *>          The leading dimension of the array T.  LDT >= NB.
00127 *> \endverbatim
00128 *>
00129 *> \param[in,out] C
00130 *> \verbatim
00131 *>          C is REAL array, dimension (LDC,N)
00132 *>          On entry, the M-by-N matrix C.
00133 *>          On exit, C is overwritten by Q C, Q**T C, C Q**T or C Q.
00134 *> \endverbatim
00135 *>
00136 *> \param[in] LDC
00137 *> \verbatim
00138 *>          LDC is INTEGER
00139 *>          The leading dimension of the array C. LDC >= max(1,M).
00140 *> \endverbatim
00141 *>
00142 *> \param[out] WORK
00143 *> \verbatim
00144 *>          WORK is REAL array. The dimension of WORK is
00145 *>           N*NB if SIDE = 'L', or  M*NB if SIDE = 'R'.
00146 *> \endverbatim
00147 *>
00148 *> \param[out] INFO
00149 *> \verbatim
00150 *>          INFO is INTEGER
00151 *>          = 0:  successful exit
00152 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00153 *> \endverbatim
00154 *
00155 *  Authors:
00156 *  ========
00157 *
00158 *> \author Univ. of Tennessee 
00159 *> \author Univ. of California Berkeley 
00160 *> \author Univ. of Colorado Denver 
00161 *> \author NAG Ltd. 
00162 *
00163 *> \date November 2011
00164 *
00165 *> \ingroup realGEcomputational
00166 *
00167 *  =====================================================================
00168       SUBROUTINE SGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, 
00169      $                   C, LDC, WORK, INFO )
00170 *
00171 *  -- LAPACK computational routine (version 3.4.0) --
00172 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00173 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00174 *     November 2011
00175 *
00176 *     .. Scalar Arguments ..
00177       CHARACTER SIDE, TRANS
00178       INTEGER   INFO, K, LDV, LDC, M, N, NB, LDT
00179 *     ..
00180 *     .. Array Arguments ..
00181       REAL   V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
00182 *     ..
00183 *
00184 *  =====================================================================
00185 *
00186 *     ..
00187 *     .. Local Scalars ..
00188       LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
00189       INTEGER            I, IB, LDWORK, KF, Q
00190 *     ..
00191 *     .. External Functions ..
00192       LOGICAL            LSAME
00193       EXTERNAL           LSAME
00194 *     ..
00195 *     .. External Subroutines ..
00196       EXTERNAL           XERBLA, SLARFB
00197 *     ..
00198 *     .. Intrinsic Functions ..
00199       INTRINSIC          MAX, MIN
00200 *     ..
00201 *     .. Executable Statements ..
00202 *
00203 *     .. Test the input arguments ..
00204 *
00205       INFO   = 0
00206       LEFT   = LSAME( SIDE,  'L' )
00207       RIGHT  = LSAME( SIDE,  'R' )
00208       TRAN   = LSAME( TRANS, 'T' )
00209       NOTRAN = LSAME( TRANS, 'N' )
00210 *      
00211       IF( LEFT ) THEN
00212          LDWORK = MAX( 1, N )
00213          Q = M
00214       ELSE IF ( RIGHT ) THEN
00215          LDWORK = MAX( 1, M )
00216          Q = N
00217       END IF
00218       IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
00219          INFO = -1
00220       ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
00221          INFO = -2
00222       ELSE IF( M.LT.0 ) THEN
00223          INFO = -3
00224       ELSE IF( N.LT.0 ) THEN
00225          INFO = -4
00226       ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN
00227          INFO = -5
00228       ELSE IF( NB.LT.1 .OR. NB.GT.K ) THEN
00229          INFO = -6
00230       ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
00231          INFO = -8
00232       ELSE IF( LDT.LT.NB ) THEN
00233          INFO = -10
00234       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
00235          INFO = -12
00236       END IF
00237 *
00238       IF( INFO.NE.0 ) THEN
00239          CALL XERBLA( 'SGEMQRT', -INFO )
00240          RETURN
00241       END IF
00242 *
00243 *     .. Quick return if possible ..
00244 *
00245       IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
00246 *
00247       IF( LEFT .AND. TRAN ) THEN
00248 *
00249          DO I = 1, K, NB
00250             IB = MIN( NB, K-I+1 )
00251             CALL SLARFB( 'L', 'T', 'F', 'C', M-I+1, N, IB, 
00252      $                   V( I, I ), LDV, T( 1, I ), LDT, 
00253      $                   C( I, 1 ), LDC, WORK, LDWORK )
00254          END DO
00255 *         
00256       ELSE IF( RIGHT .AND. NOTRAN ) THEN
00257 *
00258          DO I = 1, K, NB
00259             IB = MIN( NB, K-I+1 )
00260             CALL SLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB, 
00261      $                   V( I, I ), LDV, T( 1, I ), LDT, 
00262      $                   C( 1, I ), LDC, WORK, LDWORK )
00263          END DO
00264 *
00265       ELSE IF( LEFT .AND. NOTRAN ) THEN
00266 *
00267          KF = ((K-1)/NB)*NB+1
00268          DO I = KF, 1, -NB
00269             IB = MIN( NB, K-I+1 )         
00270             CALL SLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB, 
00271      $                   V( I, I ), LDV, T( 1, I ), LDT, 
00272      $                   C( I, 1 ), LDC, WORK, LDWORK )
00273          END DO
00274 *
00275       ELSE IF( RIGHT .AND. TRAN ) THEN
00276 *
00277          KF = ((K-1)/NB)*NB+1
00278          DO I = KF, 1, -NB
00279             IB = MIN( NB, K-I+1 )         
00280             CALL SLARFB( 'R', 'T', 'F', 'C', M, N-I+1, IB, 
00281      $                   V( I, I ), LDV, T( 1, I ), LDT, 
00282      $                   C( 1, I ), LDC, WORK, LDWORK )
00283          END DO
00284 *
00285       END IF
00286 *
00287       RETURN
00288 *
00289 *     End of SGEMQRT
00290 *
00291       END
 All Files Functions