00001 REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) 00002 * .. Scalar Arguments .. 00003 REAL SB 00004 INTEGER INCX,INCY,N 00005 * .. 00006 * .. Array Arguments .. 00007 REAL SX(*),SY(*) 00008 * .. 00009 * 00010 * PURPOSE 00011 * ======= 00012 * 00013 * Compute the inner product of two vectors with extended 00014 * precision accumulation. 00015 * 00016 * Returns S.P. result with dot product accumulated in D.P. 00017 * SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), 00018 * where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is 00019 * defined in a similar way using INCY. 00020 * 00021 * AUTHOR 00022 * ====== 00023 * Lawson, C. L., (JPL), Hanson, R. J., (SNLA), 00024 * Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) 00025 * 00026 * ARGUMENTS 00027 * ========= 00028 * 00029 * N (input) INTEGER 00030 * number of elements in input vector(s) 00031 * 00032 * SB (input) REAL 00033 * single precision scalar to be added to inner product 00034 * 00035 * SX (input) REAL array, dimension (N) 00036 * single precision vector with N elements 00037 * 00038 * INCX (input) INTEGER 00039 * storage spacing between elements of SX 00040 * 00041 * SY (input) REAL array, dimension (N) 00042 * single precision vector with N elements 00043 * 00044 * INCY (input) INTEGER 00045 * storage spacing between elements of SY 00046 * 00047 * SDSDOT (output) REAL 00048 * single precision dot product (SB if N .LE. 0) 00049 * 00050 * Further Details 00051 * =============== 00052 * 00053 * REFERENCES 00054 * 00055 * C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. 00056 * Krogh, Basic linear algebra subprograms for Fortran 00057 * usage, Algorithm No. 539, Transactions on Mathematical 00058 * Software 5, 3 (September 1979), pp. 308-323. 00059 * 00060 * REVISION HISTORY (YYMMDD) 00061 * 00062 * 791001 DATE WRITTEN 00063 * 890531 Changed all specific intrinsics to generic. (WRB) 00064 * 890831 Modified array declarations. (WRB) 00065 * 890831 REVISION DATE from Version 3.2 00066 * 891214 Prologue converted to Version 4.0 format. (BAB) 00067 * 920310 Corrected definition of LX in DESCRIPTION. (WRB) 00068 * 920501 Reformatted the REFERENCES section. (WRB) 00069 * 070118 Reformat to LAPACK coding style 00070 * 00071 * ===================================================================== 00072 * 00073 * .. Local Scalars .. 00074 DOUBLE PRECISION DSDOT 00075 INTEGER I,KX,KY,NS 00076 * .. 00077 * .. Intrinsic Functions .. 00078 INTRINSIC DBLE 00079 * .. 00080 DSDOT = SB 00081 IF (N.LE.0) GO TO 30 00082 IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40 00083 * 00084 * Code for unequal or nonpositive increments. 00085 * 00086 KX = 1 00087 KY = 1 00088 IF (INCX.LT.0) KX = 1 + (1-N)*INCX 00089 IF (INCY.LT.0) KY = 1 + (1-N)*INCY 00090 DO 10 I = 1,N 00091 DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) 00092 KX = KX + INCX 00093 KY = KY + INCY 00094 10 CONTINUE 00095 30 SDSDOT = DSDOT 00096 RETURN 00097 * 00098 * Code for equal and positive increments. 00099 * 00100 40 NS = N*INCX 00101 DO 50 I = 1,NS,INCX 00102 DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) 00103 50 CONTINUE 00104 SDSDOT = DSDOT 00105 RETURN 00106 END
1.7.2