LAPACK 3.3.1
Linear Algebra PACKage
|
00001 DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) 00002 * .. Scalar Arguments .. 00003 INTEGER INCX,INCY,N 00004 * .. 00005 * .. Array Arguments .. 00006 DOUBLE PRECISION DX(*),DY(*) 00007 * .. 00008 * 00009 * Purpose 00010 * ======= 00011 * 00012 * DDOT forms the dot product of two vectors. 00013 * uses unrolled loops for increments equal to one. 00014 * 00015 * Further Details 00016 * =============== 00017 * 00018 * jack dongarra, linpack, 3/11/78. 00019 * modified 12/3/93, array(1) declarations changed to array(*) 00020 * 00021 * ===================================================================== 00022 * 00023 * .. Local Scalars .. 00024 DOUBLE PRECISION DTEMP 00025 INTEGER I,IX,IY,M,MP1 00026 * .. 00027 * .. Intrinsic Functions .. 00028 INTRINSIC MOD 00029 * .. 00030 DDOT = 0.0d0 00031 DTEMP = 0.0d0 00032 IF (N.LE.0) RETURN 00033 IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 00034 * 00035 * code for both increments equal to 1 00036 * 00037 * 00038 * clean-up loop 00039 * 00040 M = MOD(N,5) 00041 IF (M.NE.0) THEN 00042 DO I = 1,M 00043 DTEMP = DTEMP + DX(I)*DY(I) 00044 END DO 00045 IF (N.LT.5) THEN 00046 DDOT=DTEMP 00047 RETURN 00048 END IF 00049 END IF 00050 MP1 = M + 1 00051 DO I = MP1,N,5 00052 DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) + 00053 $ DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4) 00054 END DO 00055 ELSE 00056 * 00057 * code for unequal increments or equal increments 00058 * not equal to 1 00059 * 00060 IX = 1 00061 IY = 1 00062 IF (INCX.LT.0) IX = (-N+1)*INCX + 1 00063 IF (INCY.LT.0) IY = (-N+1)*INCY + 1 00064 DO I = 1,N 00065 DTEMP = DTEMP + DX(IX)*DY(IY) 00066 IX = IX + INCX 00067 IY = IY + INCY 00068 END DO 00069 END IF 00070 DDOT = DTEMP 00071 RETURN 00072 END