root / src / blas / sdsdot.f @ 4
Historique | Voir | Annoter | Télécharger (2,78 ko)
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 |