Return to zlauu2.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence

    1: *> \brief \b ZLAUU2
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZLAUU2 + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlauu2.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlauu2.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlauu2.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO )
   22: * 
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          UPLO
   25: *       INTEGER            INFO, LDA, N
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       COMPLEX*16         A( LDA, * )
   29: *       ..
   30: *  
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> ZLAUU2 computes the product U * U**H or L**H * L, where the triangular
   38: *> factor U or L is stored in the upper or lower triangular part of
   39: *> the array A.
   40: *>
   41: *> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
   42: *> overwriting the factor U in A.
   43: *> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
   44: *> overwriting the factor L in A.
   45: *>
   46: *> This is the unblocked form of the algorithm, calling Level 2 BLAS.
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] UPLO
   53: *> \verbatim
   54: *>          UPLO is CHARACTER*1
   55: *>          Specifies whether the triangular factor stored in the array A
   56: *>          is upper or lower triangular:
   57: *>          = 'U':  Upper triangular
   58: *>          = 'L':  Lower triangular
   59: *> \endverbatim
   60: *>
   61: *> \param[in] N
   62: *> \verbatim
   63: *>          N is INTEGER
   64: *>          The order of the triangular factor U or L.  N >= 0.
   65: *> \endverbatim
   66: *>
   67: *> \param[in,out] A
   68: *> \verbatim
   69: *>          A is COMPLEX*16 array, dimension (LDA,N)
   70: *>          On entry, the triangular factor U or L.
   71: *>          On exit, if UPLO = 'U', the upper triangle of A is
   72: *>          overwritten with the upper triangle of the product U * U**H;
   73: *>          if UPLO = 'L', the lower triangle of A is overwritten with
   74: *>          the lower triangle of the product L**H * L.
   75: *> \endverbatim
   76: *>
   77: *> \param[in] LDA
   78: *> \verbatim
   79: *>          LDA is INTEGER
   80: *>          The leading dimension of the array A.  LDA >= max(1,N).
   81: *> \endverbatim
   82: *>
   83: *> \param[out] INFO
   84: *> \verbatim
   85: *>          INFO is INTEGER
   86: *>          = 0: successful exit
   87: *>          < 0: if INFO = -k, the k-th argument had an illegal value
   88: *> \endverbatim
   89: *
   90: *  Authors:
   91: *  ========
   92: *
   93: *> \author Univ. of Tennessee 
   94: *> \author Univ. of California Berkeley 
   95: *> \author Univ. of Colorado Denver 
   96: *> \author NAG Ltd. 
   97: *
   98: *> \date November 2011
   99: *
  100: *> \ingroup complex16OTHERauxiliary
  101: *
  102: *  =====================================================================
  103:       SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO )
  104: *
  105: *  -- LAPACK auxiliary routine (version 3.4.0) --
  106: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  107: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  108: *     November 2011
  109: *
  110: *     .. Scalar Arguments ..
  111:       CHARACTER          UPLO
  112:       INTEGER            INFO, LDA, N
  113: *     ..
  114: *     .. Array Arguments ..
  115:       COMPLEX*16         A( LDA, * )
  116: *     ..
  117: *
  118: *  =====================================================================
  119: *
  120: *     .. Parameters ..
  121:       COMPLEX*16         ONE
  122:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
  123: *     ..
  124: *     .. Local Scalars ..
  125:       LOGICAL            UPPER
  126:       INTEGER            I
  127:       DOUBLE PRECISION   AII
  128: *     ..
  129: *     .. External Functions ..
  130:       LOGICAL            LSAME
  131:       COMPLEX*16         ZDOTC
  132:       EXTERNAL           LSAME, ZDOTC
  133: *     ..
  134: *     .. External Subroutines ..
  135:       EXTERNAL           XERBLA, ZDSCAL, ZGEMV, ZLACGV
  136: *     ..
  137: *     .. Intrinsic Functions ..
  138:       INTRINSIC          DBLE, DCMPLX, MAX
  139: *     ..
  140: *     .. Executable Statements ..
  141: *
  142: *     Test the input parameters.
  143: *
  144:       INFO = 0
  145:       UPPER = LSAME( UPLO, 'U' )
  146:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  147:          INFO = -1
  148:       ELSE IF( N.LT.0 ) THEN
  149:          INFO = -2
  150:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  151:          INFO = -4
  152:       END IF
  153:       IF( INFO.NE.0 ) THEN
  154:          CALL XERBLA( 'ZLAUU2', -INFO )
  155:          RETURN
  156:       END IF
  157: *
  158: *     Quick return if possible
  159: *
  160:       IF( N.EQ.0 )
  161:      $   RETURN
  162: *
  163:       IF( UPPER ) THEN
  164: *
  165: *        Compute the product U * U**H.
  166: *
  167:          DO 10 I = 1, N
  168:             AII = A( I, I )
  169:             IF( I.LT.N ) THEN
  170:                A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA,
  171:      $                     A( I, I+1 ), LDA ) )
  172:                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
  173:                CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
  174:      $                     LDA, A( I, I+1 ), LDA, DCMPLX( AII ),
  175:      $                     A( 1, I ), 1 )
  176:                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
  177:             ELSE
  178:                CALL ZDSCAL( I, AII, A( 1, I ), 1 )
  179:             END IF
  180:    10    CONTINUE
  181: *
  182:       ELSE
  183: *
  184: *        Compute the product L**H * L.
  185: *
  186:          DO 20 I = 1, N
  187:             AII = A( I, I )
  188:             IF( I.LT.N ) THEN
  189:                A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1,
  190:      $                     A( I+1, I ), 1 ) )
  191:                CALL ZLACGV( I-1, A( I, 1 ), LDA )
  192:                CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
  193:      $                     A( I+1, 1 ), LDA, A( I+1, I ), 1,
  194:      $                     DCMPLX( AII ), A( I, 1 ), LDA )
  195:                CALL ZLACGV( I-1, A( I, 1 ), LDA )
  196:             ELSE
  197:                CALL ZDSCAL( I, AII, A( I, 1 ), LDA )
  198:             END IF
  199:    20    CONTINUE
  200:       END IF
  201: *
  202:       RETURN
  203: *
  204: *     End of ZLAUU2
  205: *
  206:       END