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