Home | History | Annotate | Download | only in lapack
      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
    233