Annotation of rpl/lapack/blas/dspr.f, revision 1.8

1.8     ! bertrand    1: *> \brief \b DSPR
        !             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 DSPR(UPLO,N,ALPHA,X,INCX,AP)
        !            12: * 
        !            13: *       .. Scalar Arguments ..
        !            14: *       DOUBLE PRECISION ALPHA
        !            15: *       INTEGER INCX,N
        !            16: *       CHARACTER UPLO
        !            17: *       ..
        !            18: *       .. Array Arguments ..
        !            19: *       DOUBLE PRECISION AP(*),X(*)
        !            20: *       ..
        !            21: *  
        !            22: *
        !            23: *> \par Purpose:
        !            24: *  =============
        !            25: *>
        !            26: *> \verbatim
        !            27: *>
        !            28: *> DSPR    performs the symmetric rank 1 operation
        !            29: *>
        !            30: *>    A := alpha*x*x**T + A,
        !            31: *>
        !            32: *> where alpha is a real scalar, x is an n element vector and A is an
        !            33: *> n by n symmetric matrix, supplied in packed form.
        !            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 matrix A is supplied in the packed
        !            44: *>           array AP as follows:
        !            45: *>
        !            46: *>              UPLO = 'U' or 'u'   The upper triangular part of A is
        !            47: *>                                  supplied in AP.
        !            48: *>
        !            49: *>              UPLO = 'L' or 'l'   The lower triangular part of A is
        !            50: *>                                  supplied in AP.
        !            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 DOUBLE PRECISION 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] AP
        !            82: *> \verbatim
        !            83: *>          AP is DOUBLE PRECISION array of DIMENSION at least
        !            84: *>           ( ( n*( n + 1 ) )/2 ).
        !            85: *>           Before entry with  UPLO = 'U' or 'u', the array AP must
        !            86: *>           contain the upper triangular part of the symmetric matrix
        !            87: *>           packed sequentially, column by column, so that AP( 1 )
        !            88: *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
        !            89: *>           and a( 2, 2 ) respectively, and so on. On exit, the array
        !            90: *>           AP is overwritten by the upper triangular part of the
        !            91: *>           updated matrix.
        !            92: *>           Before entry with UPLO = 'L' or 'l', the array AP must
        !            93: *>           contain the lower triangular part of the symmetric matrix
        !            94: *>           packed sequentially, column by column, so that AP( 1 )
        !            95: *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
        !            96: *>           and a( 3, 1 ) respectively, and so on. On exit, the array
        !            97: *>           AP is overwritten by the lower triangular part of the
        !            98: *>           updated matrix.
        !            99: *> \endverbatim
        !           100: *
        !           101: *  Authors:
        !           102: *  ========
        !           103: *
        !           104: *> \author Univ. of Tennessee 
        !           105: *> \author Univ. of California Berkeley 
        !           106: *> \author Univ. of Colorado Denver 
        !           107: *> \author NAG Ltd. 
        !           108: *
        !           109: *> \date November 2011
        !           110: *
        !           111: *> \ingroup double_blas_level2
        !           112: *
        !           113: *> \par Further Details:
        !           114: *  =====================
        !           115: *>
        !           116: *> \verbatim
        !           117: *>
        !           118: *>  Level 2 Blas routine.
        !           119: *>
        !           120: *>  -- Written on 22-October-1986.
        !           121: *>     Jack Dongarra, Argonne National Lab.
        !           122: *>     Jeremy Du Croz, Nag Central Office.
        !           123: *>     Sven Hammarling, Nag Central Office.
        !           124: *>     Richard Hanson, Sandia National Labs.
        !           125: *> \endverbatim
        !           126: *>
        !           127: *  =====================================================================
1.1       bertrand  128:       SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
1.8     ! bertrand  129: *
        !           130: *  -- Reference BLAS level2 routine (version 3.4.0) --
        !           131: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
        !           132: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
        !           133: *     November 2011
        !           134: *
1.1       bertrand  135: *     .. Scalar Arguments ..
                    136:       DOUBLE PRECISION ALPHA
                    137:       INTEGER INCX,N
                    138:       CHARACTER UPLO
                    139: *     ..
                    140: *     .. Array Arguments ..
                    141:       DOUBLE PRECISION AP(*),X(*)
                    142: *     ..
                    143: *
                    144: *  =====================================================================
                    145: *
                    146: *     .. Parameters ..
                    147:       DOUBLE PRECISION ZERO
                    148:       PARAMETER (ZERO=0.0D+0)
                    149: *     ..
                    150: *     .. Local Scalars ..
                    151:       DOUBLE PRECISION TEMP
                    152:       INTEGER I,INFO,IX,J,JX,K,KK,KX
                    153: *     ..
                    154: *     .. External Functions ..
                    155:       LOGICAL LSAME
                    156:       EXTERNAL LSAME
                    157: *     ..
                    158: *     .. External Subroutines ..
                    159:       EXTERNAL XERBLA
                    160: *     ..
                    161: *
                    162: *     Test the input parameters.
                    163: *
                    164:       INFO = 0
                    165:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
                    166:           INFO = 1
                    167:       ELSE IF (N.LT.0) THEN
                    168:           INFO = 2
                    169:       ELSE IF (INCX.EQ.0) THEN
                    170:           INFO = 5
                    171:       END IF
                    172:       IF (INFO.NE.0) THEN
                    173:           CALL XERBLA('DSPR  ',INFO)
                    174:           RETURN
                    175:       END IF
                    176: *
                    177: *     Quick return if possible.
                    178: *
                    179:       IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
                    180: *
                    181: *     Set the start point in X if the increment is not unity.
                    182: *
                    183:       IF (INCX.LE.0) THEN
                    184:           KX = 1 - (N-1)*INCX
                    185:       ELSE IF (INCX.NE.1) THEN
                    186:           KX = 1
                    187:       END IF
                    188: *
                    189: *     Start the operations. In this version the elements of the array AP
                    190: *     are accessed sequentially with one pass through AP.
                    191: *
                    192:       KK = 1
                    193:       IF (LSAME(UPLO,'U')) THEN
                    194: *
                    195: *        Form  A  when upper triangle is stored in AP.
                    196: *
                    197:           IF (INCX.EQ.1) THEN
                    198:               DO 20 J = 1,N
                    199:                   IF (X(J).NE.ZERO) THEN
                    200:                       TEMP = ALPHA*X(J)
                    201:                       K = KK
                    202:                       DO 10 I = 1,J
                    203:                           AP(K) = AP(K) + X(I)*TEMP
                    204:                           K = K + 1
                    205:    10                 CONTINUE
                    206:                   END IF
                    207:                   KK = KK + J
                    208:    20         CONTINUE
                    209:           ELSE
                    210:               JX = KX
                    211:               DO 40 J = 1,N
                    212:                   IF (X(JX).NE.ZERO) THEN
                    213:                       TEMP = ALPHA*X(JX)
                    214:                       IX = KX
                    215:                       DO 30 K = KK,KK + J - 1
                    216:                           AP(K) = AP(K) + X(IX)*TEMP
                    217:                           IX = IX + INCX
                    218:    30                 CONTINUE
                    219:                   END IF
                    220:                   JX = JX + INCX
                    221:                   KK = KK + J
                    222:    40         CONTINUE
                    223:           END IF
                    224:       ELSE
                    225: *
                    226: *        Form  A  when lower triangle is stored in AP.
                    227: *
                    228:           IF (INCX.EQ.1) THEN
                    229:               DO 60 J = 1,N
                    230:                   IF (X(J).NE.ZERO) THEN
                    231:                       TEMP = ALPHA*X(J)
                    232:                       K = KK
                    233:                       DO 50 I = J,N
                    234:                           AP(K) = AP(K) + X(I)*TEMP
                    235:                           K = K + 1
                    236:    50                 CONTINUE
                    237:                   END IF
                    238:                   KK = KK + N - J + 1
                    239:    60         CONTINUE
                    240:           ELSE
                    241:               JX = KX
                    242:               DO 80 J = 1,N
                    243:                   IF (X(JX).NE.ZERO) THEN
                    244:                       TEMP = ALPHA*X(JX)
                    245:                       IX = JX
                    246:                       DO 70 K = KK,KK + N - J
                    247:                           AP(K) = AP(K) + X(IX)*TEMP
                    248:                           IX = IX + INCX
                    249:    70                 CONTINUE
                    250:                   END IF
                    251:                   JX = JX + INCX
                    252:                   KK = KK + N - J + 1
                    253:    80         CONTINUE
                    254:           END IF
                    255:       END IF
                    256: *
                    257:       RETURN
                    258: *
                    259: *     End of DSPR  .
                    260: *
                    261:       END

CVSweb interface <joel.bertrand@systella.fr>