Diff for /rpl/lapack/lapack/zgehrd.f between versions 1.13 and 1.14

version 1.13, 2014/01/27 09:28:32 version 1.14, 2015/11/26 11:44:21
Line 97 Line 97
 *> \verbatim  *> \verbatim
 *>          LWORK is INTEGER  *>          LWORK is INTEGER
 *>          The length of the array WORK.  LWORK >= max(1,N).  *>          The length of the array WORK.  LWORK >= max(1,N).
 *>          For optimum performance LWORK >= N*NB, where NB is the  *>          For good performance, LWORK should generally be larger.
 *>          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 121 Line 120
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver 
 *> \author NAG Ltd.   *> \author NAG Ltd. 
 *  *
 *> \date November 2011  *> \date November 2015
 *  *
 *> \ingroup complex16GEcomputational  *> \ingroup complex16GEcomputational
 *  *
Line 168 Line 167
 *  =====================================================================  *  =====================================================================
       SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )        SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.4.0) --  *  -- LAPACK computational routine (version 3.6.0) --
 *  -- 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  *     November 2015
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       INTEGER            IHI, ILO, INFO, LDA, LWORK, N        INTEGER            IHI, ILO, INFO, LDA, LWORK, N
Line 183 Line 182
 *  =====================================================================  *  =====================================================================
 *  *
 *     .. Parameters ..  *     .. Parameters ..
       INTEGER            NBMAX, LDT        INTEGER            NBMAX, LDT, TSIZE
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )        PARAMETER          ( NBMAX = 64, LDT = NBMAX+1,
        $                     TSIZE = LDT*NBMAX )
       COMPLEX*16        ZERO, ONE        COMPLEX*16        ZERO, ONE
       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),         PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ), 
      $                     ONE = ( 1.0D+0, 0.0D+0 ) )       $                     ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..  *     ..
 *     .. Local Scalars ..  *     .. Local Scalars ..
       LOGICAL            LQUERY        LOGICAL            LQUERY
       INTEGER            I, IB, IINFO, IWS, J, LDWORK, LWKOPT, NB,        INTEGER            I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
      $                   NBMIN, NH, NX       $                   NBMIN, NH, NX
       COMPLEX*16        EI        COMPLEX*16        EI
 *     ..  *     ..
 *     .. Local Arrays ..  
       COMPLEX*16        T( LDT, NBMAX )  
 *     ..  
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM,        EXTERNAL           ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM,
      $                   XERBLA       $                   XERBLA
Line 214 Line 211
 *     Test the input parameters  *     Test the input parameters
 *  *
       INFO = 0        INFO = 0
       NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )  
       LWKOPT = N*NB  
       WORK( 1 ) = LWKOPT  
       LQUERY = ( LWORK.EQ.-1 )        LQUERY = ( LWORK.EQ.-1 )
       IF( N.LT.0 ) THEN        IF( N.LT.0 ) THEN
          INFO = -1           INFO = -1
Line 229 Line 223
       ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN        ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8           INFO = -8
       END IF        END IF
   *
         IF( INFO.EQ.0 ) THEN
   *
   *        Compute the workspace requirements
   *
            NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
            LWKOPT = N*NB + TSIZE
            WORK( 1 ) = LWKOPT
         ENDIF
   *
       IF( INFO.NE.0 ) THEN        IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGEHRD', -INFO )           CALL XERBLA( 'ZGEHRD', -INFO )
          RETURN           RETURN
Line 257 Line 261
 *  *
       NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )        NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
       NBMIN = 2        NBMIN = 2
       IWS = 1  
       IF( NB.GT.1 .AND. NB.LT.NH ) THEN        IF( NB.GT.1 .AND. NB.LT.NH ) THEN
 *  *
 *        Determine when to cross over from blocked to unblocked code  *        Determine when to cross over from blocked to unblocked code
Line 268 Line 271
 *  *
 *           Determine if workspace is large enough for blocked code  *           Determine if workspace is large enough for blocked code
 *  *
             IWS = N*NB              IF( LWORK.LT.N*NB+TSIZE ) THEN
             IF( LWORK.LT.IWS ) THEN  
 *  *
 *              Not enough workspace to use optimal NB:  determine the  *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of  *              minimum value of NB, and reduce NB or force use of
Line 277 Line 279
 *  *
                NBMIN = MAX( 2, ILAENV( 2, 'ZGEHRD', ' ', N, ILO, IHI,                 NBMIN = MAX( 2, ILAENV( 2, 'ZGEHRD', ' ', N, ILO, IHI,
      $                 -1 ) )       $                 -1 ) )
                IF( LWORK.GE.N*NBMIN ) THEN                 IF( LWORK.GE.(N*NBMIN + TSIZE) ) THEN
                   NB = LWORK / N                    NB = (LWORK-TSIZE) / N
                ELSE                 ELSE
                   NB = 1                    NB = 1
                END IF                 END IF
Line 297 Line 299
 *  *
 *        Use blocked code  *        Use blocked code
 *  *
            IWT = 1 + N*NB
          DO 40 I = ILO, IHI - 1 - NX, NB           DO 40 I = ILO, IHI - 1 - NX, NB
             IB = MIN( NB, IHI-I )              IB = MIN( NB, IHI-I )
 *  *
Line 304 Line 307
 *           matrices V and T of the block reflector H = I - V*T*V**H  *           matrices V and T of the block reflector H = I - V*T*V**H
 *           which performs the reduction, and also the matrix Y = A*V*T  *           which performs the reduction, and also the matrix Y = A*V*T
 *  *
             CALL ZLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,              CALL ZLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ),
      $                   WORK, LDWORK )       $                   WORK( IWT ), LDT, WORK, LDWORK )
 *  *
 *           Apply the block reflector H to A(1:ihi,i+ib:ihi) from the  *           Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
 *           right, computing  A := A - Y * V**H. V(i+ib,ib-1) must be set  *           right, computing  A := A - Y * V**H. V(i+ib,ib-1) must be set
Line 335 Line 338
 *  *
             CALL ZLARFB( 'Left', 'Conjugate transpose', 'Forward',              CALL ZLARFB( 'Left', 'Conjugate transpose', 'Forward',
      $                   'Columnwise',       $                   'Columnwise',
      $                   IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT,       $                   IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA,
      $                   A( I+1, I+IB ), LDA, WORK, LDWORK )       $                   WORK( IWT ), LDT, A( I+1, I+IB ), LDA,
        $                   WORK, LDWORK )
    40    CONTINUE     40    CONTINUE
       END IF        END IF
 *  *
 *     Use unblocked code to reduce the rest of the matrix  *     Use unblocked code to reduce the rest of the matrix
 *  *
       CALL ZGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )        CALL ZGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
       WORK( 1 ) = IWS        WORK( 1 ) = LWKOPT
 *  *
       RETURN        RETURN
 *  *

Removed from v.1.13  
changed lines
  Added in v.1.14


CVSweb interface <joel.bertrand@systella.fr>