Return to zlauum.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de Lapack vers la version 3.4.2 et des scripts de compilation
pour rplcas. En particulier, le Makefile.am de giac a été modifié pour ne
compiler que le répertoire src.

    1: *> \brief \b ZLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm).
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZLAUUM + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlauum.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlauum.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlauum.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZLAUUM( 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: *> ZLAUUM 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 blocked form of the algorithm, calling Level 3 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 September 2012
   99: *
  100: *> \ingroup complex16OTHERauxiliary
  101: *
  102: *  =====================================================================
  103:       SUBROUTINE ZLAUUM( UPLO, N, A, LDA, INFO )
  104: *
  105: *  -- LAPACK auxiliary routine (version 3.4.2) --
  106: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  107: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  108: *     September 2012
  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:       DOUBLE PRECISION   ONE
  122:       PARAMETER          ( ONE = 1.0D+0 )
  123:       COMPLEX*16         CONE
  124:       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
  125: *     ..
  126: *     .. Local Scalars ..
  127:       LOGICAL            UPPER
  128:       INTEGER            I, IB, NB
  129: *     ..
  130: *     .. External Functions ..
  131:       LOGICAL            LSAME
  132:       INTEGER            ILAENV
  133:       EXTERNAL           LSAME, ILAENV
  134: *     ..
  135: *     .. External Subroutines ..
  136:       EXTERNAL           XERBLA, ZGEMM, ZHERK, ZLAUU2, ZTRMM
  137: *     ..
  138: *     .. Intrinsic Functions ..
  139:       INTRINSIC          MAX, MIN
  140: *     ..
  141: *     .. Executable Statements ..
  142: *
  143: *     Test the input parameters.
  144: *
  145:       INFO = 0
  146:       UPPER = LSAME( UPLO, 'U' )
  147:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  148:          INFO = -1
  149:       ELSE IF( N.LT.0 ) THEN
  150:          INFO = -2
  151:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  152:          INFO = -4
  153:       END IF
  154:       IF( INFO.NE.0 ) THEN
  155:          CALL XERBLA( 'ZLAUUM', -INFO )
  156:          RETURN
  157:       END IF
  158: *
  159: *     Quick return if possible
  160: *
  161:       IF( N.EQ.0 )
  162:      $   RETURN
  163: *
  164: *     Determine the block size for this environment.
  165: *
  166:       NB = ILAENV( 1, 'ZLAUUM', UPLO, N, -1, -1, -1 )
  167: *
  168:       IF( NB.LE.1 .OR. NB.GE.N ) THEN
  169: *
  170: *        Use unblocked code
  171: *
  172:          CALL ZLAUU2( UPLO, N, A, LDA, INFO )
  173:       ELSE
  174: *
  175: *        Use blocked code
  176: *
  177:          IF( UPPER ) THEN
  178: *
  179: *           Compute the product U * U**H.
  180: *
  181:             DO 10 I = 1, N, NB
  182:                IB = MIN( NB, N-I+1 )
  183:                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
  184:      $                     'Non-unit', I-1, IB, CONE, A( I, I ), LDA,
  185:      $                     A( 1, I ), LDA )
  186:                CALL ZLAUU2( 'Upper', IB, A( I, I ), LDA, INFO )
  187:                IF( I+IB.LE.N ) THEN
  188:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
  189:      $                        I-1, IB, N-I-IB+1, CONE, A( 1, I+IB ),
  190:      $                        LDA, A( I, I+IB ), LDA, CONE, A( 1, I ),
  191:      $                        LDA )
  192:                   CALL ZHERK( 'Upper', 'No transpose', IB, N-I-IB+1,
  193:      $                        ONE, A( I, I+IB ), LDA, ONE, A( I, I ),
  194:      $                        LDA )
  195:                END IF
  196:    10       CONTINUE
  197:          ELSE
  198: *
  199: *           Compute the product L**H * L.
  200: *
  201:             DO 20 I = 1, N, NB
  202:                IB = MIN( NB, N-I+1 )
  203:                CALL ZTRMM( 'Left', 'Lower', 'Conjugate transpose',
  204:      $                     'Non-unit', IB, I-1, CONE, A( I, I ), LDA,
  205:      $                     A( I, 1 ), LDA )
  206:                CALL ZLAUU2( 'Lower', IB, A( I, I ), LDA, INFO )
  207:                IF( I+IB.LE.N ) THEN
  208:                   CALL ZGEMM( 'Conjugate transpose', 'No transpose', IB,
  209:      $                        I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA,
  210:      $                        A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA )
  211:                   CALL ZHERK( 'Lower', 'Conjugate transpose', IB,
  212:      $                        N-I-IB+1, ONE, A( I+IB, I ), LDA, ONE,
  213:      $                        A( I, I ), LDA )
  214:                END IF
  215:    20       CONTINUE
  216:          END IF
  217:       END IF
  218: *
  219:       RETURN
  220: *
  221: *     End of ZLAUUM
  222: *
  223:       END