Annotation of rpl/lapack/blas/dsyr2.f, revision 1.13

1.8       bertrand    1: *> \brief \b DSYR2
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.13    ! bertrand    5: * Online html documentation available at
        !             6: *            http://www.netlib.org/lapack/explore-html/
1.8       bertrand    7: *
                      8: *  Definition:
                      9: *  ===========
                     10: *
                     11: *       SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
1.13    ! bertrand   12: *
1.8       bertrand   13: *       .. Scalar Arguments ..
                     14: *       DOUBLE PRECISION ALPHA
                     15: *       INTEGER INCX,INCY,LDA,N
                     16: *       CHARACTER UPLO
                     17: *       ..
                     18: *       .. Array Arguments ..
                     19: *       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
                     20: *       ..
1.13    ! bertrand   21: *
1.8       bertrand   22: *
                     23: *> \par Purpose:
                     24: *  =============
                     25: *>
                     26: *> \verbatim
                     27: *>
                     28: *> DSYR2  performs the symmetric rank 2 operation
                     29: *>
                     30: *>    A := alpha*x*y**T + alpha*y*x**T + A,
                     31: *>
                     32: *> where alpha is a scalar, x and y are n element vectors and A is an n
                     33: *> by n symmetric 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 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] Y
                     82: *> \verbatim
                     83: *>          Y is DOUBLE PRECISION array of dimension at least
                     84: *>           ( 1 + ( n - 1 )*abs( INCY ) ).
                     85: *>           Before entry, the incremented array Y must contain the n
                     86: *>           element vector y.
                     87: *> \endverbatim
                     88: *>
                     89: *> \param[in] INCY
                     90: *> \verbatim
                     91: *>          INCY is INTEGER
                     92: *>           On entry, INCY specifies the increment for the elements of
                     93: *>           Y. INCY must not be zero.
                     94: *> \endverbatim
                     95: *>
                     96: *> \param[in,out] A
                     97: *> \verbatim
                     98: *>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
                     99: *>           Before entry with  UPLO = 'U' or 'u', the leading n by n
                    100: *>           upper triangular part of the array A must contain the upper
                    101: *>           triangular part of the symmetric matrix and the strictly
                    102: *>           lower triangular part of A is not referenced. On exit, the
                    103: *>           upper triangular part of the array A is overwritten by the
                    104: *>           upper triangular part of the updated matrix.
                    105: *>           Before entry with UPLO = 'L' or 'l', the leading n by n
                    106: *>           lower triangular part of the array A must contain the lower
                    107: *>           triangular part of the symmetric matrix and the strictly
                    108: *>           upper triangular part of A is not referenced. On exit, the
                    109: *>           lower triangular part of the array A is overwritten by the
                    110: *>           lower triangular part of the updated matrix.
                    111: *> \endverbatim
                    112: *>
                    113: *> \param[in] LDA
                    114: *> \verbatim
                    115: *>          LDA is INTEGER
                    116: *>           On entry, LDA specifies the first dimension of A as declared
                    117: *>           in the calling (sub) program. LDA must be at least
                    118: *>           max( 1, n ).
                    119: *> \endverbatim
                    120: *
                    121: *  Authors:
                    122: *  ========
                    123: *
1.13    ! bertrand  124: *> \author Univ. of Tennessee
        !           125: *> \author Univ. of California Berkeley
        !           126: *> \author Univ. of Colorado Denver
        !           127: *> \author NAG Ltd.
1.8       bertrand  128: *
1.13    ! bertrand  129: *> \date December 2016
1.8       bertrand  130: *
                    131: *> \ingroup double_blas_level2
                    132: *
                    133: *> \par Further Details:
                    134: *  =====================
                    135: *>
                    136: *> \verbatim
                    137: *>
                    138: *>  Level 2 Blas routine.
                    139: *>
                    140: *>  -- Written on 22-October-1986.
                    141: *>     Jack Dongarra, Argonne National Lab.
                    142: *>     Jeremy Du Croz, Nag Central Office.
                    143: *>     Sven Hammarling, Nag Central Office.
                    144: *>     Richard Hanson, Sandia National Labs.
                    145: *> \endverbatim
                    146: *>
                    147: *  =====================================================================
1.1       bertrand  148:       SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
1.8       bertrand  149: *
1.13    ! bertrand  150: *  -- Reference BLAS level2 routine (version 3.7.0) --
1.8       bertrand  151: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
                    152: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.13    ! bertrand  153: *     December 2016
1.8       bertrand  154: *
1.1       bertrand  155: *     .. Scalar Arguments ..
                    156:       DOUBLE PRECISION ALPHA
                    157:       INTEGER INCX,INCY,LDA,N
                    158:       CHARACTER UPLO
                    159: *     ..
                    160: *     .. Array Arguments ..
                    161:       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
                    162: *     ..
                    163: *
                    164: *  =====================================================================
                    165: *
                    166: *     .. Parameters ..
                    167:       DOUBLE PRECISION ZERO
                    168:       PARAMETER (ZERO=0.0D+0)
                    169: *     ..
                    170: *     .. Local Scalars ..
                    171:       DOUBLE PRECISION TEMP1,TEMP2
                    172:       INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
                    173: *     ..
                    174: *     .. External Functions ..
                    175:       LOGICAL LSAME
                    176:       EXTERNAL LSAME
                    177: *     ..
                    178: *     .. External Subroutines ..
                    179:       EXTERNAL XERBLA
                    180: *     ..
                    181: *     .. Intrinsic Functions ..
                    182:       INTRINSIC MAX
                    183: *     ..
                    184: *
                    185: *     Test the input parameters.
                    186: *
                    187:       INFO = 0
                    188:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
                    189:           INFO = 1
                    190:       ELSE IF (N.LT.0) THEN
                    191:           INFO = 2
                    192:       ELSE IF (INCX.EQ.0) THEN
                    193:           INFO = 5
                    194:       ELSE IF (INCY.EQ.0) THEN
                    195:           INFO = 7
                    196:       ELSE IF (LDA.LT.MAX(1,N)) THEN
                    197:           INFO = 9
                    198:       END IF
                    199:       IF (INFO.NE.0) THEN
                    200:           CALL XERBLA('DSYR2 ',INFO)
                    201:           RETURN
                    202:       END IF
                    203: *
                    204: *     Quick return if possible.
                    205: *
                    206:       IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
                    207: *
                    208: *     Set up the start points in X and Y if the increments are not both
                    209: *     unity.
                    210: *
                    211:       IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
                    212:           IF (INCX.GT.0) THEN
                    213:               KX = 1
                    214:           ELSE
                    215:               KX = 1 - (N-1)*INCX
                    216:           END IF
                    217:           IF (INCY.GT.0) THEN
                    218:               KY = 1
                    219:           ELSE
                    220:               KY = 1 - (N-1)*INCY
                    221:           END IF
                    222:           JX = KX
                    223:           JY = KY
                    224:       END IF
                    225: *
                    226: *     Start the operations. In this version the elements of A are
                    227: *     accessed sequentially with one pass through the triangular part
                    228: *     of A.
                    229: *
                    230:       IF (LSAME(UPLO,'U')) THEN
                    231: *
                    232: *        Form  A  when A is stored in the upper triangle.
                    233: *
                    234:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
                    235:               DO 20 J = 1,N
                    236:                   IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
                    237:                       TEMP1 = ALPHA*Y(J)
                    238:                       TEMP2 = ALPHA*X(J)
                    239:                       DO 10 I = 1,J
                    240:                           A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
                    241:    10                 CONTINUE
                    242:                   END IF
                    243:    20         CONTINUE
                    244:           ELSE
                    245:               DO 40 J = 1,N
                    246:                   IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
                    247:                       TEMP1 = ALPHA*Y(JY)
                    248:                       TEMP2 = ALPHA*X(JX)
                    249:                       IX = KX
                    250:                       IY = KY
                    251:                       DO 30 I = 1,J
                    252:                           A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
                    253:                           IX = IX + INCX
                    254:                           IY = IY + INCY
                    255:    30                 CONTINUE
                    256:                   END IF
                    257:                   JX = JX + INCX
                    258:                   JY = JY + INCY
                    259:    40         CONTINUE
                    260:           END IF
                    261:       ELSE
                    262: *
                    263: *        Form  A  when A is stored in the lower triangle.
                    264: *
                    265:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
                    266:               DO 60 J = 1,N
                    267:                   IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
                    268:                       TEMP1 = ALPHA*Y(J)
                    269:                       TEMP2 = ALPHA*X(J)
                    270:                       DO 50 I = J,N
                    271:                           A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
                    272:    50                 CONTINUE
                    273:                   END IF
                    274:    60         CONTINUE
                    275:           ELSE
                    276:               DO 80 J = 1,N
                    277:                   IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
                    278:                       TEMP1 = ALPHA*Y(JY)
                    279:                       TEMP2 = ALPHA*X(JX)
                    280:                       IX = JX
                    281:                       IY = JY
                    282:                       DO 70 I = J,N
                    283:                           A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
                    284:                           IX = IX + INCX
                    285:                           IY = IY + INCY
                    286:    70                 CONTINUE
                    287:                   END IF
                    288:                   JX = JX + INCX
                    289:                   JY = JY + INCY
                    290:    80         CONTINUE
                    291:           END IF
                    292:       END IF
                    293: *
                    294:       RETURN
                    295: *
                    296: *     End of DSYR2 .
                    297: *
                    298:       END

CVSweb interface <joel.bertrand@systella.fr>