Return to zlarf.f CVS log

Up to [local] / rpl / lapack / lapack

Première mise à jour de lapack et blas.

    1: *> \brief \b ZLARF applies an elementary reflector to a general rectangular matrix.
    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: *> \ingroup complex16OTHERauxiliary
  125: *
  126: *  =====================================================================
  127:       SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
  128: *
  129: *  -- LAPACK auxiliary routine --
  130: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  131: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  132: *
  133: *     .. Scalar Arguments ..
  134:       CHARACTER          SIDE
  135:       INTEGER            INCV, LDC, M, N
  136:       COMPLEX*16         TAU
  137: *     ..
  138: *     .. Array Arguments ..
  139:       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
  140: *     ..
  141: *
  142: *  =====================================================================
  143: *
  144: *     .. Parameters ..
  145:       COMPLEX*16         ONE, ZERO
  146:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
  147:      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
  148: *     ..
  149: *     .. Local Scalars ..
  150:       LOGICAL            APPLYLEFT
  151:       INTEGER            I, LASTV, LASTC
  152: *     ..
  153: *     .. External Subroutines ..
  154:       EXTERNAL           ZGEMV, ZGERC
  155: *     ..
  156: *     .. External Functions ..
  157:       LOGICAL            LSAME
  158:       INTEGER            ILAZLR, ILAZLC
  159:       EXTERNAL           LSAME, ILAZLR, ILAZLC
  160: *     ..
  161: *     .. Executable Statements ..
  162: *
  163:       APPLYLEFT = LSAME( SIDE, 'L' )
  164:       LASTV = 0
  165:       LASTC = 0
  166:       IF( TAU.NE.ZERO ) THEN
  167: *     Set up variables for scanning V.  LASTV begins pointing to the end
  168: *     of V.
  169:          IF( APPLYLEFT ) THEN
  170:             LASTV = M
  171:          ELSE
  172:             LASTV = N
  173:          END IF
  174:          IF( INCV.GT.0 ) THEN
  175:             I = 1 + (LASTV-1) * INCV
  176:          ELSE
  177:             I = 1
  178:          END IF
  179: *     Look for the last non-zero row in V.
  180:          DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
  181:             LASTV = LASTV - 1
  182:             I = I - INCV
  183:          END DO
  184:          IF( APPLYLEFT ) THEN
  185: *     Scan for the last non-zero column in C(1:lastv,:).
  186:             LASTC = ILAZLC(LASTV, N, C, LDC)
  187:          ELSE
  188: *     Scan for the last non-zero row in C(:,1:lastv).
  189:             LASTC = ILAZLR(M, LASTV, C, LDC)
  190:          END IF
  191:       END IF
  192: *     Note that lastc.eq.0 renders the BLAS operations null; no special
  193: *     case is needed at this level.
  194:       IF( APPLYLEFT ) THEN
  195: *
  196: *        Form  H * C
  197: *
  198:          IF( LASTV.GT.0 ) THEN
  199: *
  200: *           w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
  201: *
  202:             CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
  203:      $           C, LDC, V, INCV, ZERO, WORK, 1 )
  204: *
  205: *           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
  206: *
  207:             CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
  208:          END IF
  209:       ELSE
  210: *
  211: *        Form  C * H
  212: *
  213:          IF( LASTV.GT.0 ) THEN
  214: *
  215: *           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
  216: *
  217:             CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
  218:      $           V, INCV, ZERO, WORK, 1 )
  219: *
  220: *           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
  221: *
  222:             CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
  223:          END IF
  224:       END IF
  225:       RETURN
  226: *
  227: *     End of ZLARF
  228: *
  229:       END