Return to zher.f CVS log

Up to [local] / rpl / lapack / blas

Cohérence.

    1: *> \brief \b ZHER
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *  Definition:
    9: *  ===========
   10: *
   11: *       SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA)
   12: * 
   13: *       .. Scalar Arguments ..
   14: *       DOUBLE PRECISION ALPHA
   15: *       INTEGER INCX,LDA,N
   16: *       CHARACTER UPLO
   17: *       ..
   18: *       .. Array Arguments ..
   19: *       COMPLEX*16 A(LDA,*),X(*)
   20: *       ..
   21: *  
   22: *
   23: *> \par Purpose:
   24: *  =============
   25: *>
   26: *> \verbatim
   27: *>
   28: *> ZHER   performs the hermitian rank 1 operation
   29: *>
   30: *>    A := alpha*x*x**H + A,
   31: *>
   32: *> where alpha is a real scalar, x is an n element vector and A is an
   33: *> n by n hermitian matrix.
   34: *> \endverbatim
   35: *
   36: *  Arguments:
   37: *  ==========
   38: *
   39: *> \param[in] UPLO
   40: *> \verbatim
   41: *>          UPLO is CHARACTER*1
   42: *>           On entry, UPLO specifies whether the upper or lower
   43: *>           triangular part of the array A is to be referenced as
   44: *>           follows:
   45: *>
   46: *>              UPLO = 'U' or 'u'   Only the upper triangular part of A
   47: *>                                  is to be referenced.
   48: *>
   49: *>              UPLO = 'L' or 'l'   Only the lower triangular part of A
   50: *>                                  is to be referenced.
   51: *> \endverbatim
   52: *>
   53: *> \param[in] N
   54: *> \verbatim
   55: *>          N is INTEGER
   56: *>           On entry, N specifies the order of the matrix A.
   57: *>           N must be at least zero.
   58: *> \endverbatim
   59: *>
   60: *> \param[in] ALPHA
   61: *> \verbatim
   62: *>          ALPHA is DOUBLE PRECISION.
   63: *>           On entry, ALPHA specifies the scalar alpha.
   64: *> \endverbatim
   65: *>
   66: *> \param[in] X
   67: *> \verbatim
   68: *>          X is COMPLEX*16 array of dimension at least
   69: *>           ( 1 + ( n - 1 )*abs( INCX ) ).
   70: *>           Before entry, the incremented array X must contain the n
   71: *>           element vector x.
   72: *> \endverbatim
   73: *>
   74: *> \param[in] INCX
   75: *> \verbatim
   76: *>          INCX is INTEGER
   77: *>           On entry, INCX specifies the increment for the elements of
   78: *>           X. INCX must not be zero.
   79: *> \endverbatim
   80: *>
   81: *> \param[in,out] A
   82: *> \verbatim
   83: *>          A is COMPLEX*16 array of DIMENSION ( LDA, n ).
   84: *>           Before entry with  UPLO = 'U' or 'u', the leading n by n
   85: *>           upper triangular part of the array A must contain the upper
   86: *>           triangular part of the hermitian matrix and the strictly
   87: *>           lower triangular part of A is not referenced. On exit, the
   88: *>           upper triangular part of the array A is overwritten by the
   89: *>           upper triangular part of the updated matrix.
   90: *>           Before entry with UPLO = 'L' or 'l', the leading n by n
   91: *>           lower triangular part of the array A must contain the lower
   92: *>           triangular part of the hermitian matrix and the strictly
   93: *>           upper triangular part of A is not referenced. On exit, the
   94: *>           lower triangular part of the array A is overwritten by the
   95: *>           lower triangular part of the updated matrix.
   96: *>           Note that the imaginary parts of the diagonal elements need
   97: *>           not be set, they are assumed to be zero, and on exit they
   98: *>           are set to zero.
   99: *> \endverbatim
  100: *>
  101: *> \param[in] LDA
  102: *> \verbatim
  103: *>          LDA is INTEGER
  104: *>           On entry, LDA specifies the first dimension of A as declared
  105: *>           in the calling (sub) program. LDA must be at least
  106: *>           max( 1, n ).
  107: *> \endverbatim
  108: *
  109: *  Authors:
  110: *  ========
  111: *
  112: *> \author Univ. of Tennessee 
  113: *> \author Univ. of California Berkeley 
  114: *> \author Univ. of Colorado Denver 
  115: *> \author NAG Ltd. 
  116: *
  117: *> \date November 2011
  118: *
  119: *> \ingroup complex16_blas_level2
  120: *
  121: *> \par Further Details:
  122: *  =====================
  123: *>
  124: *> \verbatim
  125: *>
  126: *>  Level 2 Blas routine.
  127: *>
  128: *>  -- Written on 22-October-1986.
  129: *>     Jack Dongarra, Argonne National Lab.
  130: *>     Jeremy Du Croz, Nag Central Office.
  131: *>     Sven Hammarling, Nag Central Office.
  132: *>     Richard Hanson, Sandia National Labs.
  133: *> \endverbatim
  134: *>
  135: *  =====================================================================
  136:       SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA)
  137: *
  138: *  -- Reference BLAS level2 routine (version 3.4.0) --
  139: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  140: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  141: *     November 2011
  142: *
  143: *     .. Scalar Arguments ..
  144:       DOUBLE PRECISION ALPHA
  145:       INTEGER INCX,LDA,N
  146:       CHARACTER UPLO
  147: *     ..
  148: *     .. Array Arguments ..
  149:       COMPLEX*16 A(LDA,*),X(*)
  150: *     ..
  151: *
  152: *  =====================================================================
  153: *
  154: *     .. Parameters ..
  155:       COMPLEX*16 ZERO
  156:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
  157: *     ..
  158: *     .. Local Scalars ..
  159:       COMPLEX*16 TEMP
  160:       INTEGER I,INFO,IX,J,JX,KX
  161: *     ..
  162: *     .. External Functions ..
  163:       LOGICAL LSAME
  164:       EXTERNAL LSAME
  165: *     ..
  166: *     .. External Subroutines ..
  167:       EXTERNAL XERBLA
  168: *     ..
  169: *     .. Intrinsic Functions ..
  170:       INTRINSIC DBLE,DCONJG,MAX
  171: *     ..
  172: *
  173: *     Test the input parameters.
  174: *
  175:       INFO = 0
  176:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
  177:           INFO = 1
  178:       ELSE IF (N.LT.0) THEN
  179:           INFO = 2
  180:       ELSE IF (INCX.EQ.0) THEN
  181:           INFO = 5
  182:       ELSE IF (LDA.LT.MAX(1,N)) THEN
  183:           INFO = 7
  184:       END IF
  185:       IF (INFO.NE.0) THEN
  186:           CALL XERBLA('ZHER  ',INFO)
  187:           RETURN
  188:       END IF
  189: *
  190: *     Quick return if possible.
  191: *
  192:       IF ((N.EQ.0) .OR. (ALPHA.EQ.DBLE(ZERO))) RETURN
  193: *
  194: *     Set the start point in X if the increment is not unity.
  195: *
  196:       IF (INCX.LE.0) THEN
  197:           KX = 1 - (N-1)*INCX
  198:       ELSE IF (INCX.NE.1) THEN
  199:           KX = 1
  200:       END IF
  201: *
  202: *     Start the operations. In this version the elements of A are
  203: *     accessed sequentially with one pass through the triangular part
  204: *     of A.
  205: *
  206:       IF (LSAME(UPLO,'U')) THEN
  207: *
  208: *        Form  A  when A is stored in upper triangle.
  209: *
  210:           IF (INCX.EQ.1) THEN
  211:               DO 20 J = 1,N
  212:                   IF (X(J).NE.ZERO) THEN
  213:                       TEMP = ALPHA*DCONJG(X(J))
  214:                       DO 10 I = 1,J - 1
  215:                           A(I,J) = A(I,J) + X(I)*TEMP
  216:    10                 CONTINUE
  217:                       A(J,J) = DBLE(A(J,J)) + DBLE(X(J)*TEMP)
  218:                   ELSE
  219:                       A(J,J) = DBLE(A(J,J))
  220:                   END IF
  221:    20         CONTINUE
  222:           ELSE
  223:               JX = KX
  224:               DO 40 J = 1,N
  225:                   IF (X(JX).NE.ZERO) THEN
  226:                       TEMP = ALPHA*DCONJG(X(JX))
  227:                       IX = KX
  228:                       DO 30 I = 1,J - 1
  229:                           A(I,J) = A(I,J) + X(IX)*TEMP
  230:                           IX = IX + INCX
  231:    30                 CONTINUE
  232:                       A(J,J) = DBLE(A(J,J)) + DBLE(X(JX)*TEMP)
  233:                   ELSE
  234:                       A(J,J) = DBLE(A(J,J))
  235:                   END IF
  236:                   JX = JX + INCX
  237:    40         CONTINUE
  238:           END IF
  239:       ELSE
  240: *
  241: *        Form  A  when A is stored in lower triangle.
  242: *
  243:           IF (INCX.EQ.1) THEN
  244:               DO 60 J = 1,N
  245:                   IF (X(J).NE.ZERO) THEN
  246:                       TEMP = ALPHA*DCONJG(X(J))
  247:                       A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(J))
  248:                       DO 50 I = J + 1,N
  249:                           A(I,J) = A(I,J) + X(I)*TEMP
  250:    50                 CONTINUE
  251:                   ELSE
  252:                       A(J,J) = DBLE(A(J,J))
  253:                   END IF
  254:    60         CONTINUE
  255:           ELSE
  256:               JX = KX
  257:               DO 80 J = 1,N
  258:                   IF (X(JX).NE.ZERO) THEN
  259:                       TEMP = ALPHA*DCONJG(X(JX))
  260:                       A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(JX))
  261:                       IX = JX
  262:                       DO 70 I = J + 1,N
  263:                           IX = IX + INCX
  264:                           A(I,J) = A(I,J) + X(IX)*TEMP
  265:    70                 CONTINUE
  266:                   ELSE
  267:                       A(J,J) = DBLE(A(J,J))
  268:                   END IF
  269:                   JX = JX + INCX
  270:    80         CONTINUE
  271:           END IF
  272:       END IF
  273: *
  274:       RETURN
  275: *
  276: *     End of ZHER  .
  277: *
  278:       END