001:       REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY)
002: *     .. Scalar Arguments ..
003:       REAL SB
004:       INTEGER INCX,INCY,N
005: *     ..
006: *     .. Array Arguments ..
007:       REAL SX(*),SY(*)
008: *     ..
009: *
010: *  PURPOSE
011: *  =======
012: *
013: *  Compute the inner product of two vectors with extended
014: *  precision accumulation.
015: *
016: *  Returns S.P. result with dot product accumulated in D.P.
017: *  SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
018: *  where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
019: *  defined in a similar way using INCY.
020: *
021: *  AUTHOR
022: *  ======
023: *  Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
024: *  Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
025: *
026: *  ARGUMENTS 
027: *  =========
028: *
029: *  N      (input) INTEGER
030: *         number of elements in input vector(s)
031: *
032: *  SB     (input) REAL
033: *         single precision scalar to be added to inner product
034: *
035: *  SX     (input) REAL array, dimension (N)
036: *         single precision vector with N elements
037: *
038: *  INCX   (input) INTEGER
039: *         storage spacing between elements of SX
040: *
041: *  SY     (input) REAL array, dimension (N)
042: *         single precision vector with N elements
043: *
044: *  INCY   (input) INTEGER
045: *         storage spacing between elements of SY
046: *
047: *  SDSDOT (output) REAL
048: *         single precision dot product (SB if N .LE. 0)
049: *
050: *  Further Details
051: *  ===============
052: *
053: *  REFERENCES
054: *
055: *  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
056: *  Krogh, Basic linear algebra subprograms for Fortran
057: *  usage, Algorithm No. 539, Transactions on Mathematical
058: *  Software 5, 3 (September 1979), pp. 308-323.
059: *
060: *  REVISION HISTORY  (YYMMDD)
061: *      
062: *  791001  DATE WRITTEN
063: *  890531  Changed all specific intrinsics to generic.  (WRB)
064: *  890831  Modified array declarations.  (WRB)
065: *  890831  REVISION DATE from Version 3.2
066: *  891214  Prologue converted to Version 4.0 format.  (BAB)
067: *  920310  Corrected definition of LX in DESCRIPTION.  (WRB)
068: *  920501  Reformatted the REFERENCES section.  (WRB)
069: *  070118  Reformat to LAPACK coding style
070: *
071: *  =====================================================================
072: *
073: *     .. Local Scalars ..
074:       DOUBLE PRECISION DSDOT
075:       INTEGER I,KX,KY,NS
076: *     ..
077: *     .. Intrinsic Functions ..
078:       INTRINSIC DBLE
079: *     ..
080:       DSDOT = SB
081:       IF (N.LE.0) GO TO 30
082:       IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40
083: *
084: *     Code for unequal or nonpositive increments.
085: *
086:       KX = 1
087:       KY = 1
088:       IF (INCX.LT.0) KX = 1 + (1-N)*INCX
089:       IF (INCY.LT.0) KY = 1 + (1-N)*INCY
090:       DO 10 I = 1,N
091:           DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
092:           KX = KX + INCX
093:           KY = KY + INCY
094:    10 CONTINUE
095:    30 SDSDOT = DSDOT
096:       RETURN
097: *
098: *     Code for equal and positive increments.
099: *
100:    40 NS = N*INCX
101:       DO 50 I = 1,NS,INCX
102:           DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
103:    50 CONTINUE
104:       SDSDOT = DSDOT
105:       RETURN
106:       END
107: