File:  [local] / rpl / lapack / lapack / zlarz.f
Revision 1.19: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:32 2023 UTC (9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b ZLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZLARZ + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarz.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarz.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarz.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          SIDE
   25: *       INTEGER            INCV, L, 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: *> ZLARZ applies a complex elementary reflector H to a complex
   39: *> M-by-N matrix C, from either the left or the right. H is represented
   40: *> in the 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 (the conjugate transpose of H), supply conjg(tau) instead
   49: *> tau.
   50: *>
   51: *> H is a product of k elementary reflectors as returned by ZTZRZF.
   52: *> \endverbatim
   53: *
   54: *  Arguments:
   55: *  ==========
   56: *
   57: *> \param[in] SIDE
   58: *> \verbatim
   59: *>          SIDE is CHARACTER*1
   60: *>          = 'L': form  H * C
   61: *>          = 'R': form  C * H
   62: *> \endverbatim
   63: *>
   64: *> \param[in] M
   65: *> \verbatim
   66: *>          M is INTEGER
   67: *>          The number of rows of the matrix C.
   68: *> \endverbatim
   69: *>
   70: *> \param[in] N
   71: *> \verbatim
   72: *>          N is INTEGER
   73: *>          The number of columns of the matrix C.
   74: *> \endverbatim
   75: *>
   76: *> \param[in] L
   77: *> \verbatim
   78: *>          L is INTEGER
   79: *>          The number of entries of the vector V containing
   80: *>          the meaningful part of the Householder vectors.
   81: *>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
   82: *> \endverbatim
   83: *>
   84: *> \param[in] V
   85: *> \verbatim
   86: *>          V is COMPLEX*16 array, dimension (1+(L-1)*abs(INCV))
   87: *>          The vector v in the representation of H as returned by
   88: *>          ZTZRZF. V is not used if TAU = 0.
   89: *> \endverbatim
   90: *>
   91: *> \param[in] INCV
   92: *> \verbatim
   93: *>          INCV is INTEGER
   94: *>          The increment between elements of v. INCV <> 0.
   95: *> \endverbatim
   96: *>
   97: *> \param[in] TAU
   98: *> \verbatim
   99: *>          TAU is COMPLEX*16
  100: *>          The value tau in the representation of H.
  101: *> \endverbatim
  102: *>
  103: *> \param[in,out] C
  104: *> \verbatim
  105: *>          C is COMPLEX*16 array, dimension (LDC,N)
  106: *>          On entry, the M-by-N matrix C.
  107: *>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
  108: *>          or C * H if SIDE = 'R'.
  109: *> \endverbatim
  110: *>
  111: *> \param[in] LDC
  112: *> \verbatim
  113: *>          LDC is INTEGER
  114: *>          The leading dimension of the array C. LDC >= max(1,M).
  115: *> \endverbatim
  116: *>
  117: *> \param[out] WORK
  118: *> \verbatim
  119: *>          WORK is COMPLEX*16 array, dimension
  120: *>                         (N) if SIDE = 'L'
  121: *>                      or (M) if SIDE = 'R'
  122: *> \endverbatim
  123: *
  124: *  Authors:
  125: *  ========
  126: *
  127: *> \author Univ. of Tennessee
  128: *> \author Univ. of California Berkeley
  129: *> \author Univ. of Colorado Denver
  130: *> \author NAG Ltd.
  131: *
  132: *> \ingroup complex16OTHERcomputational
  133: *
  134: *> \par Contributors:
  135: *  ==================
  136: *>
  137: *>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
  138: *
  139: *> \par Further Details:
  140: *  =====================
  141: *>
  142: *> \verbatim
  143: *> \endverbatim
  144: *>
  145: *  =====================================================================
  146:       SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
  147: *
  148: *  -- LAPACK computational routine --
  149: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  150: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  151: *
  152: *     .. Scalar Arguments ..
  153:       CHARACTER          SIDE
  154:       INTEGER            INCV, L, LDC, M, N
  155:       COMPLEX*16         TAU
  156: *     ..
  157: *     .. Array Arguments ..
  158:       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
  159: *     ..
  160: *
  161: *  =====================================================================
  162: *
  163: *     .. Parameters ..
  164:       COMPLEX*16         ONE, ZERO
  165:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
  166:      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
  167: *     ..
  168: *     .. External Subroutines ..
  169:       EXTERNAL           ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
  170: *     ..
  171: *     .. External Functions ..
  172:       LOGICAL            LSAME
  173:       EXTERNAL           LSAME
  174: *     ..
  175: *     .. Executable Statements ..
  176: *
  177:       IF( LSAME( SIDE, 'L' ) ) THEN
  178: *
  179: *        Form  H * C
  180: *
  181:          IF( TAU.NE.ZERO ) THEN
  182: *
  183: *           w( 1:n ) = conjg( C( 1, 1:n ) )
  184: *
  185:             CALL ZCOPY( N, C, LDC, WORK, 1 )
  186:             CALL ZLACGV( N, WORK, 1 )
  187: *
  188: *           w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )**H * v( 1:l ) )
  189: *
  190:             CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ),
  191:      $                  LDC, V, INCV, ONE, WORK, 1 )
  192:             CALL ZLACGV( N, WORK, 1 )
  193: *
  194: *           C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
  195: *
  196:             CALL ZAXPY( N, -TAU, WORK, 1, C, LDC )
  197: *
  198: *           C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
  199: *                               tau * v( 1:l ) * w( 1:n )**H
  200: *
  201:             CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
  202:      $                  LDC )
  203:          END IF
  204: *
  205:       ELSE
  206: *
  207: *        Form  C * H
  208: *
  209:          IF( TAU.NE.ZERO ) THEN
  210: *
  211: *           w( 1:m ) = C( 1:m, 1 )
  212: *
  213:             CALL ZCOPY( M, C, 1, WORK, 1 )
  214: *
  215: *           w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
  216: *
  217:             CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
  218:      $                  V, INCV, ONE, WORK, 1 )
  219: *
  220: *           C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
  221: *
  222:             CALL ZAXPY( M, -TAU, WORK, 1, C, 1 )
  223: *
  224: *           C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
  225: *                               tau * w( 1:m ) * v( 1:l )**H
  226: *
  227:             CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
  228:      $                  LDC )
  229: *
  230:          END IF
  231: *
  232:       END IF
  233: *
  234:       RETURN
  235: *
  236: *     End of ZLARZ
  237: *
  238:       END

CVSweb interface <joel.bertrand@systella.fr>