[BACK]Return to zunmrq.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zunmrq.f between versions 1.9 and 1.20

version 1.9, 2011/11/21 20:43:24 version 1.20, 2023/08/07 08:39:45
Line 2 Line 2
 *  *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
 * Online html documentation available at   * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/   *            http://www.netlib.org/lapack/explore-html/
 *  *
 *> \htmlonly  *> \htmlonly
 *> Download ZUNMRQ + dependencies   *> Download ZUNMRQ + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunmrq.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunmrq.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunmrq.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunmrq.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunmrq.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunmrq.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,  *       SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
 *                          WORK, LWORK, INFO )  *                          WORK, LWORK, INFO )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       CHARACTER          SIDE, TRANS  *       CHARACTER          SIDE, TRANS
 *       INTEGER            INFO, K, LDA, LDC, LWORK, M, N  *       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
Line 28 Line 28
 *       .. Array Arguments ..  *       .. Array Arguments ..
 *       COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )  *       COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
Line 64 Line 64
 *> \verbatim  *> \verbatim
 *>          TRANS is CHARACTER*1  *>          TRANS is CHARACTER*1
 *>          = 'N':  No transpose, apply Q;  *>          = 'N':  No transpose, apply Q;
 *>          = 'C':  Transpose, apply Q**H.  *>          = 'C':  Conjugate transpose, apply Q**H.
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in] M  *> \param[in] M
Line 96 Line 96
 *>          The i-th row must contain the vector which defines the  *>          The i-th row must contain the vector which defines the
 *>          elementary reflector H(i), for i = 1,2,...,k, as returned by  *>          elementary reflector H(i), for i = 1,2,...,k, as returned by
 *>          ZGERQF in the last k rows of its array argument A.  *>          ZGERQF in the last k rows of its array argument A.
 *>          A is modified by the routine but restored on exit.  
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in] LDA  *> \param[in] LDA
Line 137 Line 136
 *>          The dimension of the array WORK.  *>          The dimension of the array WORK.
 *>          If SIDE = 'L', LWORK >= max(1,N);  *>          If SIDE = 'L', LWORK >= max(1,N);
 *>          if SIDE = 'R', LWORK >= max(1,M).  *>          if SIDE = 'R', LWORK >= max(1,M).
 *>          For optimum performance LWORK >= N*NB if SIDE = 'L', and  *>          For good performance, LWORK should generally be larger.
 *>          LWORK >= M*NB if SIDE = 'R', where NB is the optimal  
 *>          blocksize.  
 *>  *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine  *>          If LWORK = -1, then a workspace query is assumed; the routine
 *>          only calculates the optimal size of the WORK array, returns  *>          only calculates the optimal size of the WORK array, returns
Line 157 Line 154
 *  Authors:  *  Authors:
 *  ========  *  ========
 *  *
 *> \author Univ. of Tennessee   *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley   *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.   *> \author NAG Ltd.
 *  
 *> \date November 2011  
 *  *
 *> \ingroup complex16OTHERcomputational  *> \ingroup complex16OTHERcomputational
 *  *
Line 170 Line 165
       SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,        SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, LWORK, INFO )       $                   WORK, LWORK, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.4.0) --  *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2011  
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS        CHARACTER          SIDE, TRANS
Line 186 Line 180
 *  =====================================================================  *  =====================================================================
 *  *
 *     .. Parameters ..  *     .. Parameters ..
       INTEGER            NBMAX, LDT        INTEGER            NBMAX, LDT, TSIZE
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )        PARAMETER          ( NBMAX = 64, LDT = NBMAX+1,
        $                     TSIZE = LDT*NBMAX )
 *     ..  *     ..
 *     .. Local Scalars ..  *     .. Local Scalars ..
       LOGICAL            LEFT, LQUERY, NOTRAN        LOGICAL            LEFT, LQUERY, NOTRAN
       CHARACTER          TRANST        CHARACTER          TRANST
       INTEGER            I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,        INTEGER            I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT,
      $                   MI, NB, NBMIN, NI, NQ, NW       $                   MI, NB, NBMIN, NI, NQ, NW
 *     ..  *     ..
 *     .. Local Arrays ..  
       COMPLEX*16         T( LDT, NBMAX )  
 *     ..  
 *     .. External Functions ..  *     .. External Functions ..
       LOGICAL            LSAME        LOGICAL            LSAME
       INTEGER            ILAENV        INTEGER            ILAENV
Line 241 Line 233
          INFO = -7           INFO = -7
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN        ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -10           INFO = -10
         ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
            INFO = -12
       END IF        END IF
 *  *
       IF( INFO.EQ.0 ) THEN        IF( INFO.EQ.0 ) THEN
   *
   *        Compute the workspace requirements
   *
          IF( M.EQ.0 .OR. N.EQ.0 ) THEN           IF( M.EQ.0 .OR. N.EQ.0 ) THEN
             LWKOPT = 1              LWKOPT = 1
          ELSE           ELSE
 *  
 *           Determine the block size.  NB may be at most NBMAX, where  
 *           NBMAX is used to define the local array T.  
 *  
             NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, N,              NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, N,
      $                               K, -1 ) )       $                               K, -1 ) )
             LWKOPT = NW*NB              LWKOPT = NW*NB + TSIZE
          END IF           END IF
          WORK( 1 ) = LWKOPT           WORK( 1 ) = LWKOPT
 *  
          IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN  
             INFO = -12  
          END IF  
       END IF        END IF
 *  *
       IF( INFO.NE.0 ) THEN        IF( INFO.NE.0 ) THEN
Line 278 Line 267
       NBMIN = 2        NBMIN = 2
       LDWORK = NW        LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN        IF( NB.GT.1 .AND. NB.LT.K ) THEN
          IWS = NW*NB           IF( LWORK.LT.LWKOPT ) THEN
          IF( LWORK.LT.IWS ) THEN              NB = (LWORK-TSIZE) / LDWORK
             NB = LWORK / LDWORK  
             NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, K,              NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, K,
      $              -1 ) )       $                              -1 ) )
          END IF           END IF
       ELSE  
          IWS = NW  
       END IF        END IF
 *  *
       IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN        IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
Line 298 Line 284
 *  *
 *        Use blocked code  *        Use blocked code
 *  *
            IWT = 1 + NW*NB
          IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.           IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
      $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN       $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
             I1 = 1              I1 = 1
Line 328 Line 315
 *           H = H(i+ib-1) . . . H(i+1) H(i)  *           H = H(i+ib-1) . . . H(i+1) H(i)
 *  *
             CALL ZLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,              CALL ZLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,
      $                   A( I, 1 ), LDA, TAU( I ), T, LDT )       $                   A( I, 1 ), LDA, TAU( I ), WORK( IWT ), LDT )
             IF( LEFT ) THEN              IF( LEFT ) THEN
 *  *
 *              H or H**H is applied to C(1:m-k+i+ib-1,1:n)  *              H or H**H is applied to C(1:m-k+i+ib-1,1:n)
Line 344 Line 331
 *           Apply H or H**H  *           Apply H or H**H
 *  *
             CALL ZLARFB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,              CALL ZLARFB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
      $                   IB, A( I, 1 ), LDA, T, LDT, C, LDC, WORK,       $                   IB, A( I, 1 ), LDA, WORK( IWT ), LDT, C, LDC,
      $                   LDWORK )       $                   WORK, LDWORK )
    10    CONTINUE     10    CONTINUE
       END IF        END IF
       WORK( 1 ) = LWKOPT        WORK( 1 ) = LWKOPT
Removed from v.1.9  
changed lines
  Added in v.1.20

CVSweb interface <joel.bertrand@systella.fr>