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

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
1.14      bertrand   68: *>          X is DOUBLE PRECISION array, dimension at least
1.8       bertrand   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
1.14      bertrand   83: *>          Y is DOUBLE PRECISION array, dimension at least
1.8       bertrand   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
1.14      bertrand   98: *>          A is DOUBLE PRECISION array, dimension ( LDA, N )
1.8       bertrand   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: *
                    129: *> \ingroup double_blas_level2
                    130: *
                    131: *> \par Further Details:
                    132: *  =====================
                    133: *>
                    134: *> \verbatim
                    135: *>
                    136: *>  Level 2 Blas routine.
                    137: *>
                    138: *>  -- Written on 22-October-1986.
                    139: *>     Jack Dongarra, Argonne National Lab.
                    140: *>     Jeremy Du Croz, Nag Central Office.
                    141: *>     Sven Hammarling, Nag Central Office.
                    142: *>     Richard Hanson, Sandia National Labs.
                    143: *> \endverbatim
                    144: *>
                    145: *  =====================================================================
1.1       bertrand  146:       SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
1.8       bertrand  147: *
1.16    ! bertrand  148: *  -- Reference BLAS level2 routine --
1.8       bertrand  149: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
                    150: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    151: *
1.1       bertrand  152: *     .. Scalar Arguments ..
                    153:       DOUBLE PRECISION ALPHA
                    154:       INTEGER INCX,INCY,LDA,N
                    155:       CHARACTER UPLO
                    156: *     ..
                    157: *     .. Array Arguments ..
                    158:       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
                    159: *     ..
                    160: *
                    161: *  =====================================================================
                    162: *
                    163: *     .. Parameters ..
                    164:       DOUBLE PRECISION ZERO
                    165:       PARAMETER (ZERO=0.0D+0)
                    166: *     ..
                    167: *     .. Local Scalars ..
                    168:       DOUBLE PRECISION TEMP1,TEMP2
                    169:       INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
                    170: *     ..
                    171: *     .. External Functions ..
                    172:       LOGICAL LSAME
                    173:       EXTERNAL LSAME
                    174: *     ..
                    175: *     .. External Subroutines ..
                    176:       EXTERNAL XERBLA
                    177: *     ..
                    178: *     .. Intrinsic Functions ..
                    179:       INTRINSIC MAX
                    180: *     ..
                    181: *
                    182: *     Test the input parameters.
                    183: *
                    184:       INFO = 0
                    185:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
                    186:           INFO = 1
                    187:       ELSE IF (N.LT.0) THEN
                    188:           INFO = 2
                    189:       ELSE IF (INCX.EQ.0) THEN
                    190:           INFO = 5
                    191:       ELSE IF (INCY.EQ.0) THEN
                    192:           INFO = 7
                    193:       ELSE IF (LDA.LT.MAX(1,N)) THEN
                    194:           INFO = 9
                    195:       END IF
                    196:       IF (INFO.NE.0) THEN
                    197:           CALL XERBLA('DSYR2 ',INFO)
                    198:           RETURN
                    199:       END IF
                    200: *
                    201: *     Quick return if possible.
                    202: *
                    203:       IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
                    204: *
                    205: *     Set up the start points in X and Y if the increments are not both
                    206: *     unity.
                    207: *
                    208:       IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
                    209:           IF (INCX.GT.0) THEN
                    210:               KX = 1
                    211:           ELSE
                    212:               KX = 1 - (N-1)*INCX
                    213:           END IF
                    214:           IF (INCY.GT.0) THEN
                    215:               KY = 1
                    216:           ELSE
                    217:               KY = 1 - (N-1)*INCY
                    218:           END IF
                    219:           JX = KX
                    220:           JY = KY
                    221:       END IF
                    222: *
                    223: *     Start the operations. In this version the elements of A are
                    224: *     accessed sequentially with one pass through the triangular part
                    225: *     of A.
                    226: *
                    227:       IF (LSAME(UPLO,'U')) THEN
                    228: *
                    229: *        Form  A  when A is stored in the upper triangle.
                    230: *
                    231:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
                    232:               DO 20 J = 1,N
                    233:                   IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
                    234:                       TEMP1 = ALPHA*Y(J)
                    235:                       TEMP2 = ALPHA*X(J)
                    236:                       DO 10 I = 1,J
                    237:                           A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
                    238:    10                 CONTINUE
                    239:                   END IF
                    240:    20         CONTINUE
                    241:           ELSE
                    242:               DO 40 J = 1,N
                    243:                   IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
                    244:                       TEMP1 = ALPHA*Y(JY)
                    245:                       TEMP2 = ALPHA*X(JX)
                    246:                       IX = KX
                    247:                       IY = KY
                    248:                       DO 30 I = 1,J
                    249:                           A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
                    250:                           IX = IX + INCX
                    251:                           IY = IY + INCY
                    252:    30                 CONTINUE
                    253:                   END IF
                    254:                   JX = JX + INCX
                    255:                   JY = JY + INCY
                    256:    40         CONTINUE
                    257:           END IF
                    258:       ELSE
                    259: *
                    260: *        Form  A  when A is stored in the lower triangle.
                    261: *
                    262:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
                    263:               DO 60 J = 1,N
                    264:                   IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
                    265:                       TEMP1 = ALPHA*Y(J)
                    266:                       TEMP2 = ALPHA*X(J)
                    267:                       DO 50 I = J,N
                    268:                           A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
                    269:    50                 CONTINUE
                    270:                   END IF
                    271:    60         CONTINUE
                    272:           ELSE
                    273:               DO 80 J = 1,N
                    274:                   IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
                    275:                       TEMP1 = ALPHA*Y(JY)
                    276:                       TEMP2 = ALPHA*X(JX)
                    277:                       IX = JX
                    278:                       IY = JY
                    279:                       DO 70 I = J,N
                    280:                           A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
                    281:                           IX = IX + INCX
                    282:                           IY = IY + INCY
                    283:    70                 CONTINUE
                    284:                   END IF
                    285:                   JX = JX + INCX
                    286:                   JY = JY + INCY
                    287:    80         CONTINUE
                    288:           END IF
                    289:       END IF
                    290: *
                    291:       RETURN
                    292: *
1.16    ! bertrand  293: *     End of DSYR2
1.1       bertrand  294: *
                    295:       END

CVSweb interface <joel.bertrand@systella.fr>