ground/gcs/src/libs/eigen/lapack/zlarf.f

   1 *> \brief \b ZLARF
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZLARF + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          SIDE
  25 *       INTEGER            INCV, LDC, M, N
  26 *       COMPLEX*16         TAU
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> ZLARF applies a complex elementary reflector H to a complex M-by-N
  39 *> matrix C, from either the left or the right. H is represented in the
  40 *> form
  41 *>
  42 *>       H = I - tau * v * v**H
  43 *>
  44 *> where tau is a complex scalar and v is a complex vector.
  45 *>
  46 *> If tau = 0, then H is taken to be the unit matrix.
  47 *>
  48 *> To apply H**H, supply conjg(tau) instead
  49 *> tau.
  50 *> \endverbatim
  51 *
  52 *  Arguments:
  53 *  ==========
  54 *
  55 *> \param[in] SIDE
  56 *> \verbatim
  57 *>          SIDE is CHARACTER*1
  58 *>          = 'L': form  H * C
  59 *>          = 'R': form  C * H
  60 *> \endverbatim
  61 *>
  62 *> \param[in] M
  63 *> \verbatim
  64 *>          M is INTEGER
  65 *>          The number of rows of the matrix C.
  66 *> \endverbatim
  67 *>
  68 *> \param[in] N
  69 *> \verbatim
  70 *>          N is INTEGER
  71 *>          The number of columns of the matrix C.
  72 *> \endverbatim
  73 *>
  74 *> \param[in] V
  75 *> \verbatim
  76 *>          V is COMPLEX*16 array, dimension
  77 *>                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
  78 *>                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
  79 *>          The vector v in the representation of H. V is not used if
  80 *>          TAU = 0.
  81 *> \endverbatim
  82 *>
  83 *> \param[in] INCV
  84 *> \verbatim
  85 *>          INCV is INTEGER
  86 *>          The increment between elements of v. INCV <> 0.
  87 *> \endverbatim
  88 *>
  89 *> \param[in] TAU
  90 *> \verbatim
  91 *>          TAU is COMPLEX*16
  92 *>          The value tau in the representation of H.
  93 *> \endverbatim
  94 *>
  95 *> \param[in,out] C
  96 *> \verbatim
  97 *>          C is COMPLEX*16 array, dimension (LDC,N)
  98 *>          On entry, the M-by-N matrix C.
  99 *>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
 100 *>          or C * H if SIDE = 'R'.
 101 *> \endverbatim
 102 *>
 103 *> \param[in] LDC
 104 *> \verbatim
 105 *>          LDC is INTEGER
 106 *>          The leading dimension of the array C. LDC >= max(1,M).
 107 *> \endverbatim
 108 *>
 109 *> \param[out] WORK
 110 *> \verbatim
 111 *>          WORK is COMPLEX*16 array, dimension
 112 *>                         (N) if SIDE = 'L'
 113 *>                      or (M) if SIDE = 'R'
 114 *> \endverbatim
 115 *
 116 *  Authors:
 117 *  ========
 118 *
 119 *> \author Univ. of Tennessee
 120 *> \author Univ. of California Berkeley
 121 *> \author Univ. of Colorado Denver
 122 *> \author NAG Ltd.
 123 *
 124 *> \date November 2011
 125 *
 126 *> \ingroup complex16OTHERauxiliary
 127 *
 128 *  =====================================================================
 129       SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
 130 *
 131 *  -- LAPACK auxiliary routine (version 3.4.0) --
 132 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 133 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 134 *     November 2011
 135 *
 136 *     .. Scalar Arguments ..
 137       CHARACTER          SIDE
 138       INTEGER            INCV, LDC, M, N
 139       COMPLEX*16         TAU
 140 *     ..
 141 *     .. Array Arguments ..
 142       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
 143 *     ..
 144 *
 145 *  =====================================================================
 146 *
 147 *     .. Parameters ..
 148       COMPLEX*16         ONE, ZERO
 149       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
 150      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
 151 *     ..
 152 *     .. Local Scalars ..
 153       LOGICAL            APPLYLEFT
 154       INTEGER            I, LASTV, LASTC
 155 *     ..
 156 *     .. External Subroutines ..
 157       EXTERNAL           ZGEMV, ZGERC
 158 *     ..
 159 *     .. External Functions ..
 160       LOGICAL            LSAME
 161       INTEGER            ILAZLR, ILAZLC
 162       EXTERNAL           LSAME, ILAZLR, ILAZLC
 163 *     ..
 164 *     .. Executable Statements ..
 165 *
 166       APPLYLEFT = LSAME( SIDE, 'L' )
 167       LASTV = 0
 168       LASTC = 0
 169       IF( TAU.NE.ZERO ) THEN
 170 *     Set up variables for scanning V.  LASTV begins pointing to the end
 171 *     of V.
 172          IF( APPLYLEFT ) THEN
 173             LASTV = M
 174          ELSE
 175             LASTV = N
 176          END IF
 177          IF( INCV.GT.0 ) THEN
 178             I = 1 + (LASTV-1) * INCV
 179          ELSE
 180             I = 1
 181          END IF
 182 *     Look for the last non-zero row in V.
 183          DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
 184             LASTV = LASTV - 1
 185             I = I - INCV
 186          END DO
 187          IF( APPLYLEFT ) THEN
 188 *     Scan for the last non-zero column in C(1:lastv,:).
 189             LASTC = ILAZLC(LASTV, N, C, LDC)
 190          ELSE
 191 *     Scan for the last non-zero row in C(:,1:lastv).
 192             LASTC = ILAZLR(M, LASTV, C, LDC)
 193          END IF
 194       END IF
 195 *     Note that lastc.eq.0 renders the BLAS operations null; no special
 196 *     case is needed at this level.
 197       IF( APPLYLEFT ) THEN
 198 *
 199 *        Form  H * C
 200 *
 201          IF( LASTV.GT.0 ) THEN
 202 *
 203 *           w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
 204 *
 205             CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
 206      $           C, LDC, V, INCV, ZERO, WORK, 1 )
 207 *
 208 *           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
 209 *
 210             CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
 211          END IF
 212       ELSE
 213 *
 214 *        Form  C * H
 215 *
 216          IF( LASTV.GT.0 ) THEN
 217 *
 218 *           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
 219 *
 220             CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
 221      $           V, INCV, ZERO, WORK, 1 )
 222 *
 223 *           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
 224 *
 225             CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
 226          END IF
 227       END IF
 228       RETURN
 229 *
 230 *     End of ZLARF
 231 *
 232       END