File:  [local] / rpl / lapack / lapack / zlatzm.f
Revision 1.18: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:33 2023 UTC (8 months, 3 weeks 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 ZLATZM
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZLATZM + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlatzm.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlatzm.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlatzm.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, 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         C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
   30: *       ..
   31: *
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *>
   38: *> This routine is deprecated and has been replaced by routine ZUNMRZ.
   39: *>
   40: *> ZLATZM applies a Householder matrix generated by ZTZRQF to a matrix.
   41: *>
   42: *> Let P = I - tau*u*u**H,   u = ( 1 ),
   43: *>                               ( v )
   44: *> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
   45: *> SIDE = 'R'.
   46: *>
   47: *> If SIDE equals 'L', let
   48: *>        C = [ C1 ] 1
   49: *>            [ C2 ] m-1
   50: *>              n
   51: *> Then C is overwritten by P*C.
   52: *>
   53: *> If SIDE equals 'R', let
   54: *>        C = [ C1, C2 ] m
   55: *>               1  n-1
   56: *> Then C is overwritten by C*P.
   57: *> \endverbatim
   58: *
   59: *  Arguments:
   60: *  ==========
   61: *
   62: *> \param[in] SIDE
   63: *> \verbatim
   64: *>          SIDE is CHARACTER*1
   65: *>          = 'L': form P * C
   66: *>          = 'R': form C * P
   67: *> \endverbatim
   68: *>
   69: *> \param[in] M
   70: *> \verbatim
   71: *>          M is INTEGER
   72: *>          The number of rows of the matrix C.
   73: *> \endverbatim
   74: *>
   75: *> \param[in] N
   76: *> \verbatim
   77: *>          N is INTEGER
   78: *>          The number of columns of the matrix C.
   79: *> \endverbatim
   80: *>
   81: *> \param[in] V
   82: *> \verbatim
   83: *>          V is COMPLEX*16 array, dimension
   84: *>                  (1 + (M-1)*abs(INCV)) if SIDE = 'L'
   85: *>                  (1 + (N-1)*abs(INCV)) if SIDE = 'R'
   86: *>          The vector v in the representation of P. V is not used
   87: *>          if TAU = 0.
   88: *> \endverbatim
   89: *>
   90: *> \param[in] INCV
   91: *> \verbatim
   92: *>          INCV is INTEGER
   93: *>          The increment between elements of v. INCV <> 0
   94: *> \endverbatim
   95: *>
   96: *> \param[in] TAU
   97: *> \verbatim
   98: *>          TAU is COMPLEX*16
   99: *>          The value tau in the representation of P.
  100: *> \endverbatim
  101: *>
  102: *> \param[in,out] C1
  103: *> \verbatim
  104: *>          C1 is COMPLEX*16 array, dimension
  105: *>                         (LDC,N) if SIDE = 'L'
  106: *>                         (M,1)   if SIDE = 'R'
  107: *>          On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
  108: *>          if SIDE = 'R'.
  109: *>
  110: *>          On exit, the first row of P*C if SIDE = 'L', or the first
  111: *>          column of C*P if SIDE = 'R'.
  112: *> \endverbatim
  113: *>
  114: *> \param[in,out] C2
  115: *> \verbatim
  116: *>          C2 is COMPLEX*16 array, dimension
  117: *>                         (LDC, N)   if SIDE = 'L'
  118: *>                         (LDC, N-1) if SIDE = 'R'
  119: *>          On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
  120: *>          m x (n - 1) matrix C2 if SIDE = 'R'.
  121: *>
  122: *>          On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
  123: *>          if SIDE = 'R'.
  124: *> \endverbatim
  125: *>
  126: *> \param[in] LDC
  127: *> \verbatim
  128: *>          LDC is INTEGER
  129: *>          The leading dimension of the arrays C1 and C2.
  130: *>          LDC >= max(1,M).
  131: *> \endverbatim
  132: *>
  133: *> \param[out] WORK
  134: *> \verbatim
  135: *>          WORK is COMPLEX*16 array, dimension
  136: *>                      (N) if SIDE = 'L'
  137: *>                      (M) if SIDE = 'R'
  138: *> \endverbatim
  139: *
  140: *  Authors:
  141: *  ========
  142: *
  143: *> \author Univ. of Tennessee
  144: *> \author Univ. of California Berkeley
  145: *> \author Univ. of Colorado Denver
  146: *> \author NAG Ltd.
  147: *
  148: *> \ingroup complex16OTHERcomputational
  149: *
  150: *  =====================================================================
  151:       SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
  152: *
  153: *  -- LAPACK computational routine --
  154: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  155: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  156: *
  157: *     .. Scalar Arguments ..
  158:       CHARACTER          SIDE
  159:       INTEGER            INCV, LDC, M, N
  160:       COMPLEX*16         TAU
  161: *     ..
  162: *     .. Array Arguments ..
  163:       COMPLEX*16         C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
  164: *     ..
  165: *
  166: *  =====================================================================
  167: *
  168: *     .. Parameters ..
  169:       COMPLEX*16         ONE, ZERO
  170:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
  171:      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
  172: *     ..
  173: *     .. External Subroutines ..
  174:       EXTERNAL           ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
  175: *     ..
  176: *     .. External Functions ..
  177:       LOGICAL            LSAME
  178:       EXTERNAL           LSAME
  179: *     ..
  180: *     .. Intrinsic Functions ..
  181:       INTRINSIC          MIN
  182: *     ..
  183: *     .. Executable Statements ..
  184: *
  185:       IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
  186:      $   RETURN
  187: *
  188:       IF( LSAME( SIDE, 'L' ) ) THEN
  189: *
  190: *        w :=  ( C1 + v**H * C2 )**H
  191: *
  192:          CALL ZCOPY( N, C1, LDC, WORK, 1 )
  193:          CALL ZLACGV( N, WORK, 1 )
  194:          CALL ZGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V,
  195:      $               INCV, ONE, WORK, 1 )
  196: *
  197: *        [ C1 ] := [ C1 ] - tau* [ 1 ] * w**H
  198: *        [ C2 ]    [ C2 ]        [ v ]
  199: *
  200:          CALL ZLACGV( N, WORK, 1 )
  201:          CALL ZAXPY( N, -TAU, WORK, 1, C1, LDC )
  202:          CALL ZGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
  203: *
  204:       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  205: *
  206: *        w := C1 + C2 * v
  207: *
  208:          CALL ZCOPY( M, C1, 1, WORK, 1 )
  209:          CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
  210:      $               WORK, 1 )
  211: *
  212: *        [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H]
  213: *
  214:          CALL ZAXPY( M, -TAU, WORK, 1, C1, 1 )
  215:          CALL ZGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
  216:       END IF
  217: *
  218:       RETURN
  219: *
  220: *     End of ZLATZM
  221: *
  222:       END

CVSweb interface <joel.bertrand@systella.fr>