SRC/zgemqrt.f

   1 *> \brief \b ZGEMQRT
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZGEMQRT + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemqrt.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemqrt.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgemqrt.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE ZGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
  22 *                          C, LDC, WORK, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER SIDE, TRANS
  26 *       INTEGER   INFO, K, LDV, LDC, M, N, NB, LDT
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       COMPLEX*16   V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> ZGEMQRT overwrites the general complex M-by-N matrix C with
  39 *>
  40 *>                 SIDE = 'L'     SIDE = 'R'
  41 *> TRANS = 'N':      Q C            C Q
  42 *> TRANS = 'C':    Q**H C            C Q**H
  43 *>
  44 *> where Q is a complex orthogonal matrix defined as the product of K
  45 *> elementary reflectors:
  46 *>
  47 *>       Q = H(1) H(2) . . . H(K) = I - V T V**H
  48 *>
  49 *> generated using the compact WY representation as returned by ZGEQRT.
  50 *>
  51 *> Q is of order M if SIDE = 'L' and of order N  if SIDE = 'R'.
  52 *> \endverbatim
  53 *
  54 *  Arguments:
  55 *  ==========
  56 *
  57 *> \param[in] SIDE
  58 *> \verbatim
  59 *>          SIDE is CHARACTER*1
  60 *>          = 'L': apply Q or Q**H from the Left;
  61 *>          = 'R': apply Q or Q**H from the Right.
  62 *> \endverbatim
  63 *>
  64 *> \param[in] TRANS
  65 *> \verbatim
  66 *>          TRANS is CHARACTER*1
  67 *>          = 'N':  No transpose, apply Q;
  68 *>          = 'C':  Transpose, apply Q**H.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] M
  72 *> \verbatim
  73 *>          M is INTEGER
  74 *>          The number of rows of the matrix C. M >= 0.
  75 *> \endverbatim
  76 *>
  77 *> \param[in] N
  78 *> \verbatim
  79 *>          N is INTEGER
  80 *>          The number of columns of the matrix C. N >= 0.
  81 *> \endverbatim
  82 *>
  83 *> \param[in] K
  84 *> \verbatim
  85 *>          K is INTEGER
  86 *>          The number of elementary reflectors whose product defines
  87 *>          the matrix Q.
  88 *>          If SIDE = 'L', M >= K >= 0;
  89 *>          if SIDE = 'R', N >= K >= 0.
  90 *> \endverbatim
  91 *>
  92 *> \param[in] NB
  93 *> \verbatim
  94 *>          NB is INTEGER
  95 *>          The block size used for the storage of T.  K >= NB >= 1.
  96 *>          This must be the same value of NB used to generate T
  97 *>          in CGEQRT.
  98 *> \endverbatim
  99 *>
 100 *> \param[in] V
 101 *> \verbatim
 102 *>          V is COMPLEX*16 array, dimension (LDV,K)
 103 *>          The i-th column must contain the vector which defines the
 104 *>          elementary reflector H(i), for i = 1,2,...,k, as returned by
 105 *>          CGEQRT in the first K columns of its array argument A.
 106 *> \endverbatim
 107 *>
 108 *> \param[in] LDV
 109 *> \verbatim
 110 *>          LDV is INTEGER
 111 *>          The leading dimension of the array V.
 112 *>          If SIDE = 'L', LDA >= max(1,M);
 113 *>          if SIDE = 'R', LDA >= max(1,N).
 114 *> \endverbatim
 115 *>
 116 *> \param[in] T
 117 *> \verbatim
 118 *>          T is COMPLEX*16 array, dimension (LDT,K)
 119 *>          The upper triangular factors of the block reflectors
 120 *>          as returned by CGEQRT, stored as a NB-by-N matrix.
 121 *> \endverbatim
 122 *>
 123 *> \param[in] LDT
 124 *> \verbatim
 125 *>          LDT is INTEGER
 126 *>          The leading dimension of the array T.  LDT >= NB.
 127 *> \endverbatim
 128 *>
 129 *> \param[in,out] C
 130 *> \verbatim
 131 *>          C is COMPLEX*16 array, dimension (LDC,N)
 132 *>          On entry, the M-by-N matrix C.
 133 *>          On exit, C is overwritten by Q C, Q**H C, C Q**H or C Q.
 134 *> \endverbatim
 135 *>
 136 *> \param[in] LDC
 137 *> \verbatim
 138 *>          LDC is INTEGER
 139 *>          The leading dimension of the array C. LDC >= max(1,M).
 140 *> \endverbatim
 141 *>
 142 *> \param[out] WORK
 143 *> \verbatim
 144 *>          WORK is COMPLEX*16 array. The dimension of WORK is
 145 *>           N*NB if SIDE = 'L', or  M*NB if SIDE = 'R'.
 146 *> \endverbatim
 147 *>
 148 *> \param[out] INFO
 149 *> \verbatim
 150 *>          INFO is INTEGER
 151 *>          = 0:  successful exit
 152 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 153 *> \endverbatim
 154 *
 155 *  Authors:
 156 *  ========
 157 *
 158 *> \author Univ. of Tennessee
 159 *> \author Univ. of California Berkeley
 160 *> \author Univ. of Colorado Denver
 161 *> \author NAG Ltd.
 162 *
 163 *> \date November 2013
 164 *
 165 *> \ingroup complex16GEcomputational
 166 *
 167 *  =====================================================================
 168       SUBROUTINE ZGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
 169      $                   C, LDC, WORK, INFO )
 170 *
 171 *  -- LAPACK computational routine (version 3.5.0) --
 172 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 173 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 174 *     November 2013
 175 *
 176 *     .. Scalar Arguments ..
 177       CHARACTER SIDE, TRANS
 178       INTEGER   INFO, K, LDV, LDC, M, N, NB, LDT
 179 *     ..
 180 *     .. Array Arguments ..
 181       COMPLEX*16   V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
 182 *     ..
 183 *
 184 *  =====================================================================
 185 *
 186 *     ..
 187 *     .. Local Scalars ..
 188       LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
 189       INTEGER            I, IB, LDWORK, KF, Q
 190 *     ..
 191 *     .. External Functions ..
 192       LOGICAL            LSAME
 193       EXTERNAL           LSAME
 194 *     ..
 195 *     .. External Subroutines ..
 196       EXTERNAL           XERBLA, ZLARFB
 197 *     ..
 198 *     .. Intrinsic Functions ..
 199       INTRINSIC          MAX, MIN
 200 *     ..
 201 *     .. Executable Statements ..
 202 *
 203 *     .. Test the input arguments ..
 204 *
 205       INFO   = 0
 206       LEFT   = LSAME( SIDE,  'L' )
 207       RIGHT  = LSAME( SIDE,  'R' )
 208       TRAN   = LSAME( TRANS, 'C' )
 209       NOTRAN = LSAME( TRANS, 'N' )
 210 *
 211       IF( LEFT ) THEN
 212          LDWORK = MAX( 1, N )
 213          Q = M
 214       ELSE IF ( RIGHT ) THEN
 215          LDWORK = MAX( 1, M )
 216          Q = N
 217       END IF
 218       IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
 219          INFO = -1
 220       ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
 221          INFO = -2
 222       ELSE IF( M.LT.0 ) THEN
 223          INFO = -3
 224       ELSE IF( N.LT.0 ) THEN
 225          INFO = -4
 226       ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN
 227          INFO = -5
 228       ELSE IF( NB.LT.1 .OR. (NB.GT.K .AND. K.GT.0)) THEN
 229          INFO = -6
 230       ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
 231          INFO = -8
 232       ELSE IF( LDT.LT.NB ) THEN
 233          INFO = -10
 234       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
 235          INFO = -12
 236       END IF
 237 *
 238       IF( INFO.NE.0 ) THEN
 239          CALL XERBLA( 'ZGEMQRT', -INFO )
 240          RETURN
 241       END IF
 242 *
 243 *     .. Quick return if possible ..
 244 *
 245       IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
 246 *
 247       IF( LEFT .AND. TRAN ) THEN
 248 *
 249          DO I = 1, K, NB
 250             IB = MIN( NB, K-I+1 )
 251             CALL ZLARFB( 'L', 'C', 'F', 'C', M-I+1, N, IB,
 252      $                   V( I, I ), LDV, T( 1, I ), LDT,
 253      $                   C( I, 1 ), LDC, WORK, LDWORK )
 254          END DO
 255 *
 256       ELSE IF( RIGHT .AND. NOTRAN ) THEN
 257 *
 258          DO I = 1, K, NB
 259             IB = MIN( NB, K-I+1 )
 260             CALL ZLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB,
 261      $                   V( I, I ), LDV, T( 1, I ), LDT,
 262      $                   C( 1, I ), LDC, WORK, LDWORK )
 263          END DO
 264 *
 265       ELSE IF( LEFT .AND. NOTRAN ) THEN
 266 *
 267          KF = ((K-1)/NB)*NB+1
 268          DO I = KF, 1, -NB
 269             IB = MIN( NB, K-I+1 )
 270             CALL ZLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB,
 271      $                   V( I, I ), LDV, T( 1, I ), LDT,
 272      $                   C( I, 1 ), LDC, WORK, LDWORK )
 273          END DO
 274 *
 275       ELSE IF( RIGHT .AND. TRAN ) THEN
 276 *
 277          KF = ((K-1)/NB)*NB+1
 278          DO I = KF, 1, -NB
 279             IB = MIN( NB, K-I+1 )
 280             CALL ZLARFB( 'R', 'C', 'F', 'C', M, N-I+1, IB,
 281      $                   V( I, I ), LDV, T( 1, I ), LDT,
 282      $                   C( 1, I ), LDC, WORK, LDWORK )
 283          END DO
 284 *
 285       END IF
 286 *
 287       RETURN
 288 *
 289 *     End of ZGEMQRT
 290 *
 291       END