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: *  REFERENCES
051: *  ==========
052: *
053: *  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
054: *  Krogh, Basic linear algebra subprograms for Fortran
055: *  usage, Algorithm No. 539, Transactions on Mathematical
056: *  Software 5, 3 (September 1979), pp. 308-323.
057: *
058: *  REVISION HISTORY  (YYMMDD)
059: *  ==========================
060: *      
061: *  791001  DATE WRITTEN
062: *  890531  Changed all specific intrinsics to generic.  (WRB)
063: *  890831  Modified array declarations.  (WRB)
064: *  890831  REVISION DATE from Version 3.2
065: *  891214  Prologue converted to Version 4.0 format.  (BAB)
066: *  920310  Corrected definition of LX in DESCRIPTION.  (WRB)
067: *  920501  Reformatted the REFERENCES section.  (WRB)
068: *  070118  Reformat to LAPACK coding style
069: *
070: *  =====================================================================
071: *
072: *     .. Local Scalars ..
073:       DOUBLE PRECISION DSDOT
074:       INTEGER I,KX,KY,NS
075: *     ..
076: *     .. Intrinsic Functions ..
077:       INTRINSIC DBLE
078: *     ..
079:       DSDOT = SB
080:       IF (N.LE.0) GO TO 30
081:       IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40
082: *
083: *     Code for unequal or nonpositive increments.
084: *
085:       KX = 1
086:       KY = 1
087:       IF (INCX.LT.0) KX = 1 + (1-N)*INCX
088:       IF (INCY.LT.0) KY = 1 + (1-N)*INCY
089:       DO 10 I = 1,N
090:           DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
091:           KX = KX + INCX
092:           KY = KY + INCY
093:    10 CONTINUE
094:    30 SDSDOT = DSDOT
095:       RETURN
096: *
097: *     Code for equal and positive increments.
098: *
099:    40 NS = N*INCX
100:       DO 50 I = 1,NS,INCX
101:           DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
102:    50 CONTINUE
103:       SDSDOT = DSDOT
104:       RETURN
105:       END
106: