1 | REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) |
---|
2 | * .. Scalar Arguments .. |
---|
3 | REAL SB |
---|
4 | INTEGER INCX,INCY,N |
---|
5 | * .. |
---|
6 | * .. Array Arguments .. |
---|
7 | REAL SX(*),SY(*) |
---|
8 | * .. |
---|
9 | * |
---|
10 | * PURPOSE |
---|
11 | * ======= |
---|
12 | * |
---|
13 | * Compute the inner product of two vectors with extended |
---|
14 | * precision accumulation. |
---|
15 | * |
---|
16 | * Returns S.P. result with dot product accumulated in D.P. |
---|
17 | * SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), |
---|
18 | * where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is |
---|
19 | * defined in a similar way using INCY. |
---|
20 | * |
---|
21 | * AUTHOR |
---|
22 | * ====== |
---|
23 | * Lawson, C. L., (JPL), Hanson, R. J., (SNLA), |
---|
24 | * Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) |
---|
25 | * |
---|
26 | * ARGUMENTS |
---|
27 | * ========= |
---|
28 | * |
---|
29 | * N (input) INTEGER |
---|
30 | * number of elements in input vector(s) |
---|
31 | * |
---|
32 | * SB (input) REAL |
---|
33 | * single precision scalar to be added to inner product |
---|
34 | * |
---|
35 | * SX (input) REAL array, dimension (N) |
---|
36 | * single precision vector with N elements |
---|
37 | * |
---|
38 | * INCX (input) INTEGER |
---|
39 | * storage spacing between elements of SX |
---|
40 | * |
---|
41 | * SY (input) REAL array, dimension (N) |
---|
42 | * single precision vector with N elements |
---|
43 | * |
---|
44 | * INCY (input) INTEGER |
---|
45 | * storage spacing between elements of SY |
---|
46 | * |
---|
47 | * SDSDOT (output) REAL |
---|
48 | * single precision dot product (SB if N .LE. 0) |
---|
49 | * |
---|
50 | * REFERENCES |
---|
51 | * ========== |
---|
52 | * |
---|
53 | * C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. |
---|
54 | * Krogh, Basic linear algebra subprograms for Fortran |
---|
55 | * usage, Algorithm No. 539, Transactions on Mathematical |
---|
56 | * Software 5, 3 (September 1979), pp. 308-323. |
---|
57 | * |
---|
58 | * REVISION HISTORY (YYMMDD) |
---|
59 | * ========================== |
---|
60 | * |
---|
61 | * 791001 DATE WRITTEN |
---|
62 | * 890531 Changed all specific intrinsics to generic. (WRB) |
---|
63 | * 890831 Modified array declarations. (WRB) |
---|
64 | * 890831 REVISION DATE from Version 3.2 |
---|
65 | * 891214 Prologue converted to Version 4.0 format. (BAB) |
---|
66 | * 920310 Corrected definition of LX in DESCRIPTION. (WRB) |
---|
67 | * 920501 Reformatted the REFERENCES section. (WRB) |
---|
68 | * 070118 Reformat to LAPACK coding style |
---|
69 | * |
---|
70 | * ===================================================================== |
---|
71 | * |
---|
72 | * .. Local Scalars .. |
---|
73 | DOUBLE PRECISION DSDOT |
---|
74 | INTEGER I,KX,KY,NS |
---|
75 | * .. |
---|
76 | * .. Intrinsic Functions .. |
---|
77 | INTRINSIC DBLE |
---|
78 | * .. |
---|
79 | DSDOT = SB |
---|
80 | IF (N.LE.0) GO TO 30 |
---|
81 | IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40 |
---|
82 | * |
---|
83 | * Code for unequal or nonpositive increments. |
---|
84 | * |
---|
85 | KX = 1 |
---|
86 | KY = 1 |
---|
87 | IF (INCX.LT.0) KX = 1 + (1-N)*INCX |
---|
88 | IF (INCY.LT.0) KY = 1 + (1-N)*INCY |
---|
89 | DO 10 I = 1,N |
---|
90 | DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) |
---|
91 | KX = KX + INCX |
---|
92 | KY = KY + INCY |
---|
93 | 10 CONTINUE |
---|
94 | 30 SDSDOT = DSDOT |
---|
95 | RETURN |
---|
96 | * |
---|
97 | * Code for equal and positive increments. |
---|
98 | * |
---|
99 | 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 |
---|