File:  [local] / rpl / lapack / lapack / ztzrqf.f
Revision 1.17: download - view: text, annotated - select for diffs - revision graph
Sat Jun 17 11:07:05 2017 UTC (6 years, 11 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_27, rpl-4_1_26, HEAD
Cohérence.

    1: *> \brief \b ZTZRQF
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZTZRQF + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztzrqf.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztzrqf.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztzrqf.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZTZRQF( M, N, A, LDA, TAU, INFO )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       INTEGER            INFO, LDA, M, N
   25: *       ..
   26: *       .. Array Arguments ..
   27: *       COMPLEX*16         A( LDA, * ), TAU( * )
   28: *       ..
   29: *
   30: *
   31: *> \par Purpose:
   32: *  =============
   33: *>
   34: *> \verbatim
   35: *>
   36: *> This routine is deprecated and has been replaced by routine ZTZRZF.
   37: *>
   38: *> ZTZRQF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A
   39: *> to upper triangular form by means of unitary transformations.
   40: *>
   41: *> The upper trapezoidal matrix A is factored as
   42: *>
   43: *>    A = ( R  0 ) * Z,
   44: *>
   45: *> where Z is an N-by-N unitary matrix and R is an M-by-M upper
   46: *> triangular matrix.
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] M
   53: *> \verbatim
   54: *>          M is INTEGER
   55: *>          The number of rows of the matrix A.  M >= 0.
   56: *> \endverbatim
   57: *>
   58: *> \param[in] N
   59: *> \verbatim
   60: *>          N is INTEGER
   61: *>          The number of columns of the matrix A.  N >= M.
   62: *> \endverbatim
   63: *>
   64: *> \param[in,out] A
   65: *> \verbatim
   66: *>          A is COMPLEX*16 array, dimension (LDA,N)
   67: *>          On entry, the leading M-by-N upper trapezoidal part of the
   68: *>          array A must contain the matrix to be factorized.
   69: *>          On exit, the leading M-by-M upper triangular part of A
   70: *>          contains the upper triangular matrix R, and elements M+1 to
   71: *>          N of the first M rows of A, with the array TAU, represent the
   72: *>          unitary matrix Z as a product of M elementary reflectors.
   73: *> \endverbatim
   74: *>
   75: *> \param[in] LDA
   76: *> \verbatim
   77: *>          LDA is INTEGER
   78: *>          The leading dimension of the array A.  LDA >= max(1,M).
   79: *> \endverbatim
   80: *>
   81: *> \param[out] TAU
   82: *> \verbatim
   83: *>          TAU is COMPLEX*16 array, dimension (M)
   84: *>          The scalar factors of the elementary reflectors.
   85: *> \endverbatim
   86: *>
   87: *> \param[out] INFO
   88: *> \verbatim
   89: *>          INFO is INTEGER
   90: *>          = 0: successful exit
   91: *>          < 0: if INFO = -i, the i-th argument had an illegal value
   92: *> \endverbatim
   93: *
   94: *  Authors:
   95: *  ========
   96: *
   97: *> \author Univ. of Tennessee
   98: *> \author Univ. of California Berkeley
   99: *> \author Univ. of Colorado Denver
  100: *> \author NAG Ltd.
  101: *
  102: *> \date December 2016
  103: *
  104: *> \ingroup complex16OTHERcomputational
  105: *
  106: *> \par Further Details:
  107: *  =====================
  108: *>
  109: *> \verbatim
  110: *>
  111: *>  The  factorization is obtained by Householder's method.  The kth
  112: *>  transformation matrix, Z( k ), whose conjugate transpose is used to
  113: *>  introduce zeros into the (m - k + 1)th row of A, is given in the form
  114: *>
  115: *>     Z( k ) = ( I     0   ),
  116: *>              ( 0  T( k ) )
  117: *>
  118: *>  where
  119: *>
  120: *>     T( k ) = I - tau*u( k )*u( k )**H,   u( k ) = (   1    ),
  121: *>                                                   (   0    )
  122: *>                                                   ( z( k ) )
  123: *>
  124: *>  tau is a scalar and z( k ) is an ( n - m ) element vector.
  125: *>  tau and z( k ) are chosen to annihilate the elements of the kth row
  126: *>  of X.
  127: *>
  128: *>  The scalar tau is returned in the kth element of TAU and the vector
  129: *>  u( k ) in the kth row of A, such that the elements of z( k ) are
  130: *>  in  a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
  131: *>  the upper triangular part of A.
  132: *>
  133: *>  Z is given by
  134: *>
  135: *>     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
  136: *> \endverbatim
  137: *>
  138: *  =====================================================================
  139:       SUBROUTINE ZTZRQF( M, N, A, LDA, TAU, INFO )
  140: *
  141: *  -- LAPACK computational routine (version 3.7.0) --
  142: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  143: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  144: *     December 2016
  145: *
  146: *     .. Scalar Arguments ..
  147:       INTEGER            INFO, LDA, M, N
  148: *     ..
  149: *     .. Array Arguments ..
  150:       COMPLEX*16         A( LDA, * ), TAU( * )
  151: *     ..
  152: *
  153: * =====================================================================
  154: *
  155: *     .. Parameters ..
  156:       COMPLEX*16         CONE, CZERO
  157:       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
  158:      $                   CZERO = ( 0.0D+0, 0.0D+0 ) )
  159: *     ..
  160: *     .. Local Scalars ..
  161:       INTEGER            I, K, M1
  162:       COMPLEX*16         ALPHA
  163: *     ..
  164: *     .. Intrinsic Functions ..
  165:       INTRINSIC          DCONJG, MAX, MIN
  166: *     ..
  167: *     .. External Subroutines ..
  168:       EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGERC, ZLACGV,
  169:      $                   ZLARFG
  170: *     ..
  171: *     .. Executable Statements ..
  172: *
  173: *     Test the input parameters.
  174: *
  175:       INFO = 0
  176:       IF( M.LT.0 ) THEN
  177:          INFO = -1
  178:       ELSE IF( N.LT.M ) THEN
  179:          INFO = -2
  180:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  181:          INFO = -4
  182:       END IF
  183:       IF( INFO.NE.0 ) THEN
  184:          CALL XERBLA( 'ZTZRQF', -INFO )
  185:          RETURN
  186:       END IF
  187: *
  188: *     Perform the factorization.
  189: *
  190:       IF( M.EQ.0 )
  191:      $   RETURN
  192:       IF( M.EQ.N ) THEN
  193:          DO 10 I = 1, N
  194:             TAU( I ) = CZERO
  195:    10    CONTINUE
  196:       ELSE
  197:          M1 = MIN( M+1, N )
  198:          DO 20 K = M, 1, -1
  199: *
  200: *           Use a Householder reflection to zero the kth row of A.
  201: *           First set up the reflection.
  202: *
  203:             A( K, K ) = DCONJG( A( K, K ) )
  204:             CALL ZLACGV( N-M, A( K, M1 ), LDA )
  205:             ALPHA = A( K, K )
  206:             CALL ZLARFG( N-M+1, ALPHA, A( K, M1 ), LDA, TAU( K ) )
  207:             A( K, K ) = ALPHA
  208:             TAU( K ) = DCONJG( TAU( K ) )
  209: *
  210:             IF( TAU( K ).NE.CZERO .AND. K.GT.1 ) THEN
  211: *
  212: *              We now perform the operation  A := A*P( k )**H.
  213: *
  214: *              Use the first ( k - 1 ) elements of TAU to store  a( k ),
  215: *              where  a( k ) consists of the first ( k - 1 ) elements of
  216: *              the  kth column  of  A.  Also  let  B  denote  the  first
  217: *              ( k - 1 ) rows of the last ( n - m ) columns of A.
  218: *
  219:                CALL ZCOPY( K-1, A( 1, K ), 1, TAU, 1 )
  220: *
  221: *              Form   w = a( k ) + B*z( k )  in TAU.
  222: *
  223:                CALL ZGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ),
  224:      $                     LDA, A( K, M1 ), LDA, CONE, TAU, 1 )
  225: *
  226: *              Now form  a( k ) := a( k ) - conjg(tau)*w
  227: *              and       B      := B      - conjg(tau)*w*z( k )**H.
  228: *
  229:                CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, A( 1, K ),
  230:      $                     1 )
  231:                CALL ZGERC( K-1, N-M, -DCONJG( TAU( K ) ), TAU, 1,
  232:      $                     A( K, M1 ), LDA, A( 1, M1 ), LDA )
  233:             END IF
  234:    20    CONTINUE
  235:       END IF
  236: *
  237:       RETURN
  238: *
  239: *     End of ZTZRQF
  240: *
  241:       END

CVSweb interface <joel.bertrand@systella.fr>