802 lines
24 KiB
Diff
802 lines
24 KiB
Diff
--- LAPACK/BLAS/SRC/drotmg.f.BAD 2005-09-28 17:59:56.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/drotmg.f 2005-09-28 18:01:04.000000000 -0500
|
|
@@ -0,0 +1,169 @@
|
|
+ SUBROUTINE DROTMG (DD1,DD2,DX1,DY1,DPARAM)
|
|
+C
|
|
+C CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
|
|
+C THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*
|
|
+C DY2)**T.
|
|
+C WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
|
|
+C
|
|
+C DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
|
|
+C
|
|
+C (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
|
|
+C H=( ) ( ) ( ) ( )
|
|
+C (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
|
|
+C LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
|
|
+C RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
|
|
+C VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
|
|
+C
|
|
+C THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
|
|
+C INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
|
|
+C OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
|
|
+C
|
|
+ DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM,DP2,
|
|
+ 1 DQ2,DU,DY1,ZERO,GAMSQ,DD1,DFLAG,DH12,DH22,DP1,DQ1,
|
|
+ 2 DTEMP,DX1,TWO
|
|
+ DIMENSION DPARAM(5)
|
|
+C
|
|
+ DATA ZERO,ONE,TWO /0.D0,1.D0,2.D0/
|
|
+ DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
|
|
+ IF(.NOT. DD1 .LT. ZERO) GO TO 10
|
|
+C GO ZERO-H-D-AND-DX1..
|
|
+ GO TO 60
|
|
+ 10 CONTINUE
|
|
+C CASE-DD1-NONNEGATIVE
|
|
+ DP2=DD2*DY1
|
|
+ IF(.NOT. DP2 .EQ. ZERO) GO TO 20
|
|
+ DFLAG=-TWO
|
|
+ GO TO 260
|
|
+C REGULAR-CASE..
|
|
+ 20 CONTINUE
|
|
+ DP1=DD1*DX1
|
|
+ DQ2=DP2*DY1
|
|
+ DQ1=DP1*DX1
|
|
+C
|
|
+ IF(.NOT. DABS(DQ1) .GT. DABS(DQ2)) GO TO 40
|
|
+ DH21=-DY1/DX1
|
|
+ DH12=DP2/DP1
|
|
+C
|
|
+ DU=ONE-DH12*DH21
|
|
+C
|
|
+ IF(.NOT. DU .LE. ZERO) GO TO 30
|
|
+C GO ZERO-H-D-AND-DX1..
|
|
+ GO TO 60
|
|
+ 30 CONTINUE
|
|
+ DFLAG=ZERO
|
|
+ DD1=DD1/DU
|
|
+ DD2=DD2/DU
|
|
+ DX1=DX1*DU
|
|
+C GO SCALE-CHECK..
|
|
+ GO TO 100
|
|
+ 40 CONTINUE
|
|
+ IF(.NOT. DQ2 .LT. ZERO) GO TO 50
|
|
+C GO ZERO-H-D-AND-DX1..
|
|
+ GO TO 60
|
|
+ 50 CONTINUE
|
|
+ DFLAG=ONE
|
|
+ DH11=DP1/DP2
|
|
+ DH22=DX1/DY1
|
|
+ DU=ONE+DH11*DH22
|
|
+ DTEMP=DD2/DU
|
|
+ DD2=DD1/DU
|
|
+ DD1=DTEMP
|
|
+ DX1=DY1*DU
|
|
+C GO SCALE-CHECK
|
|
+ GO TO 100
|
|
+C PROCEDURE..ZERO-H-D-AND-DX1..
|
|
+ 60 CONTINUE
|
|
+ DFLAG=-ONE
|
|
+ DH11=ZERO
|
|
+ DH12=ZERO
|
|
+ DH21=ZERO
|
|
+ DH22=ZERO
|
|
+C
|
|
+ DD1=ZERO
|
|
+ DD2=ZERO
|
|
+ DX1=ZERO
|
|
+C RETURN..
|
|
+ GO TO 220
|
|
+C PROCEDURE..FIX-H..
|
|
+ 70 CONTINUE
|
|
+ IF(.NOT. DFLAG .GE. ZERO) GO TO 90
|
|
+C
|
|
+ IF(.NOT. DFLAG .EQ. ZERO) GO TO 80
|
|
+ DH11=ONE
|
|
+ DH22=ONE
|
|
+ DFLAG=-ONE
|
|
+ GO TO 90
|
|
+ 80 CONTINUE
|
|
+ DH21=-ONE
|
|
+ DH12=ONE
|
|
+ DFLAG=-ONE
|
|
+ 90 CONTINUE
|
|
+ GO TO IGO,(120,150,180,210)
|
|
+C PROCEDURE..SCALE-CHECK
|
|
+ 100 CONTINUE
|
|
+ 110 CONTINUE
|
|
+ IF(.NOT. DD1 .LE. RGAMSQ) GO TO 130
|
|
+ IF(DD1 .EQ. ZERO) GO TO 160
|
|
+ ASSIGN 120 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 120 CONTINUE
|
|
+ DD1=DD1*GAM**2
|
|
+ DX1=DX1/GAM
|
|
+ DH11=DH11/GAM
|
|
+ DH12=DH12/GAM
|
|
+ GO TO 110
|
|
+ 130 CONTINUE
|
|
+ 140 CONTINUE
|
|
+ IF(.NOT. DD1 .GE. GAMSQ) GO TO 160
|
|
+ ASSIGN 150 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 150 CONTINUE
|
|
+ DD1=DD1/GAM**2
|
|
+ DX1=DX1*GAM
|
|
+ DH11=DH11*GAM
|
|
+ DH12=DH12*GAM
|
|
+ GO TO 140
|
|
+ 160 CONTINUE
|
|
+ 170 CONTINUE
|
|
+ IF(.NOT. DABS(DD2) .LE. RGAMSQ) GO TO 190
|
|
+ IF(DD2 .EQ. ZERO) GO TO 220
|
|
+ ASSIGN 180 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 180 CONTINUE
|
|
+ DD2=DD2*GAM**2
|
|
+ DH21=DH21/GAM
|
|
+ DH22=DH22/GAM
|
|
+ GO TO 170
|
|
+ 190 CONTINUE
|
|
+ 200 CONTINUE
|
|
+ IF(.NOT. DABS(DD2) .GE. GAMSQ) GO TO 220
|
|
+ ASSIGN 210 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 210 CONTINUE
|
|
+ DD2=DD2/GAM**2
|
|
+ DH21=DH21*GAM
|
|
+ DH22=DH22*GAM
|
|
+ GO TO 200
|
|
+ 220 CONTINUE
|
|
+ IF(DFLAG)250,230,240
|
|
+ 230 CONTINUE
|
|
+ DPARAM(3)=DH21
|
|
+ DPARAM(4)=DH12
|
|
+ GO TO 260
|
|
+ 240 CONTINUE
|
|
+ DPARAM(2)=DH11
|
|
+ DPARAM(5)=DH22
|
|
+ GO TO 260
|
|
+ 250 CONTINUE
|
|
+ DPARAM(2)=DH11
|
|
+ DPARAM(3)=DH21
|
|
+ DPARAM(4)=DH12
|
|
+ DPARAM(5)=DH22
|
|
+ 260 CONTINUE
|
|
+ DPARAM(1)=DFLAG
|
|
+ RETURN
|
|
+ END
|
|
--- LAPACK/BLAS/SRC/sdsdot.f.BAD 2005-09-28 18:00:11.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/sdsdot.f 2005-09-28 18:01:23.000000000 -0500
|
|
@@ -0,0 +1,78 @@
|
|
+*DECK SDSDOT
|
|
+ REAL FUNCTION SDSDOT (N, SB, SX, INCX, SY, INCY)
|
|
+C***BEGIN PROLOGUE SDSDOT
|
|
+C***PURPOSE Compute the inner product of two vectors with extended
|
|
+C precision accumulation.
|
|
+C***LIBRARY SLATEC (BLAS)
|
|
+C***CATEGORY D1A4
|
|
+C***TYPE SINGLE PRECISION (SDSDOT-S, CDCDOT-C)
|
|
+C***KEYWORDS BLAS, DOT PRODUCT, INNER PRODUCT, LINEAR ALGEBRA, VECTOR
|
|
+C***AUTHOR Lawson, C. L., (JPL)
|
|
+C Hanson, R. J., (SNLA)
|
|
+C Kincaid, D. R., (U. of Texas)
|
|
+C Krogh, F. T., (JPL)
|
|
+C***DESCRIPTION
|
|
+C
|
|
+C B L A S Subprogram
|
|
+C Description of Parameters
|
|
+C
|
|
+C --Input--
|
|
+C N number of elements in input vector(s)
|
|
+C SB single precision scalar to be added to inner product
|
|
+C SX single precision vector with N elements
|
|
+C INCX storage spacing between elements of SX
|
|
+C SY single precision vector with N elements
|
|
+C INCY storage spacing between elements of SY
|
|
+C
|
|
+C --Output--
|
|
+C SDSDOT single precision dot product (SB if N .LE. 0)
|
|
+C
|
|
+C Returns S.P. result with dot product accumulated in D.P.
|
|
+C SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
|
|
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
|
|
+C defined in a similar way using INCY.
|
|
+C
|
|
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
|
|
+C Krogh, Basic linear algebra subprograms for Fortran
|
|
+C usage, Algorithm No. 539, Transactions on Mathematical
|
|
+C Software 5, 3 (September 1979), pp. 308-323.
|
|
+C***ROUTINES CALLED (NONE)
|
|
+C***REVISION HISTORY (YYMMDD)
|
|
+C 791001 DATE WRITTEN
|
|
+C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
+C 890831 Modified array declarations. (WRB)
|
|
+C 890831 REVISION DATE from Version 3.2
|
|
+C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
|
|
+C 920501 Reformatted the REFERENCES section. (WRB)
|
|
+C***END PROLOGUE SDSDOT
|
|
+ REAL SX(*), SY(*), SB
|
|
+ DOUBLE PRECISION DSDOT
|
|
+C***FIRST EXECUTABLE STATEMENT SDSDOT
|
|
+ DSDOT = SB
|
|
+ IF (N .LE. 0) GO TO 30
|
|
+ IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40
|
|
+C
|
|
+C Code for unequal or nonpositive increments.
|
|
+C
|
|
+ KX = 1
|
|
+ KY = 1
|
|
+ IF (INCX .LT. 0) KX = 1+(1-N)*INCX
|
|
+ IF (INCY .LT. 0) KY = 1+(1-N)*INCY
|
|
+ DO 10 I = 1,N
|
|
+ DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
|
|
+ KX = KX + INCX
|
|
+ KY = KY + INCY
|
|
+ 10 CONTINUE
|
|
+ 30 SDSDOT = DSDOT
|
|
+ RETURN
|
|
+C
|
|
+C Code for equal and positive increments.
|
|
+C
|
|
+ 40 NS = N*INCX
|
|
+ DO 50 I = 1,NS,INCX
|
|
+ DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
|
|
+ 50 CONTINUE
|
|
+ SDSDOT = DSDOT
|
|
+ RETURN
|
|
+ END
|
|
--- LAPACK/BLAS/SRC/csrot.f.BAD 2005-09-28 17:59:45.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/csrot.f 2005-09-28 18:00:41.000000000 -0500
|
|
@@ -0,0 +1,38 @@
|
|
+ subroutine csrot (n,cx,incx,cy,incy,c,s)
|
|
+c
|
|
+c applies a plane rotation, where the cos and sin (c and s) are real
|
|
+c and the vectors cx and cy are complex.
|
|
+c jack dongarra, linpack, 3/11/78.
|
|
+c
|
|
+ complex cx(1),cy(1),ctemp
|
|
+ real c,s
|
|
+ integer i,incx,incy,ix,iy,n
|
|
+c
|
|
+ if(n.le.0)return
|
|
+ if(incx.eq.1.and.incy.eq.1)go to 20
|
|
+c
|
|
+c code for unequal increments or equal increments not equal
|
|
+c to 1
|
|
+c
|
|
+ ix = 1
|
|
+ iy = 1
|
|
+ if(incx.lt.0)ix = (-n+1)*incx + 1
|
|
+ if(incy.lt.0)iy = (-n+1)*incy + 1
|
|
+ do 10 i = 1,n
|
|
+ ctemp = c*cx(ix) + s*cy(iy)
|
|
+ cy(iy) = c*cy(iy) - s*cx(ix)
|
|
+ cx(ix) = ctemp
|
|
+ ix = ix + incx
|
|
+ iy = iy + incy
|
|
+ 10 continue
|
|
+ return
|
|
+c
|
|
+c code for both increments equal to 1
|
|
+c
|
|
+ 20 do 30 i = 1,n
|
|
+ ctemp = c*cx(i) + s*cy(i)
|
|
+ cy(i) = c*cy(i) - s*cx(i)
|
|
+ cx(i) = ctemp
|
|
+ 30 continue
|
|
+ return
|
|
+ end
|
|
--- LAPACK/BLAS/SRC/srotmg.f.BAD 2005-09-28 18:00:24.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/srotmg.f 2005-09-28 18:01:45.000000000 -0500
|
|
@@ -0,0 +1,166 @@
|
|
+ SUBROUTINE SROTMG (SD1,SD2,SX1,SY1,SPARAM)
|
|
+C
|
|
+C CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
|
|
+C THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)*
|
|
+C SY2)**T.
|
|
+C WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
|
|
+C
|
|
+C SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
|
|
+C
|
|
+C (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
|
|
+C H=( ) ( ) ( ) ( )
|
|
+C (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
|
|
+C LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22
|
|
+C RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE
|
|
+C VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.)
|
|
+C
|
|
+C THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
|
|
+C INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
|
|
+C OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
|
|
+C
|
|
+ DIMENSION SPARAM(5)
|
|
+C
|
|
+ DATA ZERO,ONE,TWO /0.E0,1.E0,2.E0/
|
|
+ DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/
|
|
+ IF(.NOT. SD1 .LT. ZERO) GO TO 10
|
|
+C GO ZERO-H-D-AND-SX1..
|
|
+ GO TO 60
|
|
+ 10 CONTINUE
|
|
+C CASE-SD1-NONNEGATIVE
|
|
+ SP2=SD2*SY1
|
|
+ IF(.NOT. SP2 .EQ. ZERO) GO TO 20
|
|
+ SFLAG=-TWO
|
|
+ GO TO 260
|
|
+C REGULAR-CASE..
|
|
+ 20 CONTINUE
|
|
+ SP1=SD1*SX1
|
|
+ SQ2=SP2*SY1
|
|
+ SQ1=SP1*SX1
|
|
+C
|
|
+ IF(.NOT. ABS(SQ1) .GT. ABS(SQ2)) GO TO 40
|
|
+ SH21=-SY1/SX1
|
|
+ SH12=SP2/SP1
|
|
+C
|
|
+ SU=ONE-SH12*SH21
|
|
+C
|
|
+ IF(.NOT. SU .LE. ZERO) GO TO 30
|
|
+C GO ZERO-H-D-AND-SX1..
|
|
+ GO TO 60
|
|
+ 30 CONTINUE
|
|
+ SFLAG=ZERO
|
|
+ SD1=SD1/SU
|
|
+ SD2=SD2/SU
|
|
+ SX1=SX1*SU
|
|
+C GO SCALE-CHECK..
|
|
+ GO TO 100
|
|
+ 40 CONTINUE
|
|
+ IF(.NOT. SQ2 .LT. ZERO) GO TO 50
|
|
+C GO ZERO-H-D-AND-SX1..
|
|
+ GO TO 60
|
|
+ 50 CONTINUE
|
|
+ SFLAG=ONE
|
|
+ SH11=SP1/SP2
|
|
+ SH22=SX1/SY1
|
|
+ SU=ONE+SH11*SH22
|
|
+ STEMP=SD2/SU
|
|
+ SD2=SD1/SU
|
|
+ SD1=STEMP
|
|
+ SX1=SY1*SU
|
|
+C GO SCALE-CHECK
|
|
+ GO TO 100
|
|
+C PROCEDURE..ZERO-H-D-AND-SX1..
|
|
+ 60 CONTINUE
|
|
+ SFLAG=-ONE
|
|
+ SH11=ZERO
|
|
+ SH12=ZERO
|
|
+ SH21=ZERO
|
|
+ SH22=ZERO
|
|
+C
|
|
+ SD1=ZERO
|
|
+ SD2=ZERO
|
|
+ SX1=ZERO
|
|
+C RETURN..
|
|
+ GO TO 220
|
|
+C PROCEDURE..FIX-H..
|
|
+ 70 CONTINUE
|
|
+ IF(.NOT. SFLAG .GE. ZERO) GO TO 90
|
|
+C
|
|
+ IF(.NOT. SFLAG .EQ. ZERO) GO TO 80
|
|
+ SH11=ONE
|
|
+ SH22=ONE
|
|
+ SFLAG=-ONE
|
|
+ GO TO 90
|
|
+ 80 CONTINUE
|
|
+ SH21=-ONE
|
|
+ SH12=ONE
|
|
+ SFLAG=-ONE
|
|
+ 90 CONTINUE
|
|
+ GO TO IGO,(120,150,180,210)
|
|
+C PROCEDURE..SCALE-CHECK
|
|
+ 100 CONTINUE
|
|
+ 110 CONTINUE
|
|
+ IF(.NOT. SD1 .LE. RGAMSQ) GO TO 130
|
|
+ IF(SD1 .EQ. ZERO) GO TO 160
|
|
+ ASSIGN 120 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 120 CONTINUE
|
|
+ SD1=SD1*GAM**2
|
|
+ SX1=SX1/GAM
|
|
+ SH11=SH11/GAM
|
|
+ SH12=SH12/GAM
|
|
+ GO TO 110
|
|
+ 130 CONTINUE
|
|
+ 140 CONTINUE
|
|
+ IF(.NOT. SD1 .GE. GAMSQ) GO TO 160
|
|
+ ASSIGN 150 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 150 CONTINUE
|
|
+ SD1=SD1/GAM**2
|
|
+ SX1=SX1*GAM
|
|
+ SH11=SH11*GAM
|
|
+ SH12=SH12*GAM
|
|
+ GO TO 140
|
|
+ 160 CONTINUE
|
|
+ 170 CONTINUE
|
|
+ IF(.NOT. ABS(SD2) .LE. RGAMSQ) GO TO 190
|
|
+ IF(SD2 .EQ. ZERO) GO TO 220
|
|
+ ASSIGN 180 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 180 CONTINUE
|
|
+ SD2=SD2*GAM**2
|
|
+ SH21=SH21/GAM
|
|
+ SH22=SH22/GAM
|
|
+ GO TO 170
|
|
+ 190 CONTINUE
|
|
+ 200 CONTINUE
|
|
+ IF(.NOT. ABS(SD2) .GE. GAMSQ) GO TO 220
|
|
+ ASSIGN 210 TO IGO
|
|
+C FIX-H..
|
|
+ GO TO 70
|
|
+ 210 CONTINUE
|
|
+ SD2=SD2/GAM**2
|
|
+ SH21=SH21*GAM
|
|
+ SH22=SH22*GAM
|
|
+ GO TO 200
|
|
+ 220 CONTINUE
|
|
+ IF(SFLAG)250,230,240
|
|
+ 230 CONTINUE
|
|
+ SPARAM(3)=SH21
|
|
+ SPARAM(4)=SH12
|
|
+ GO TO 260
|
|
+ 240 CONTINUE
|
|
+ SPARAM(2)=SH11
|
|
+ SPARAM(5)=SH22
|
|
+ GO TO 260
|
|
+ 250 CONTINUE
|
|
+ SPARAM(2)=SH11
|
|
+ SPARAM(3)=SH21
|
|
+ SPARAM(4)=SH12
|
|
+ SPARAM(5)=SH22
|
|
+ 260 CONTINUE
|
|
+ SPARAM(1)=SFLAG
|
|
+ RETURN
|
|
+ END
|
|
--- LAPACK/BLAS/SRC/dsdot.f.BAD 2005-09-28 18:00:03.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/dsdot.f 2005-09-28 18:01:11.000000000 -0500
|
|
@@ -0,0 +1,74 @@
|
|
+*DECK DSDOT
|
|
+ DOUBLE PRECISION FUNCTION DSDOT (N, SX, INCX, SY, INCY)
|
|
+C***BEGIN PROLOGUE DSDOT
|
|
+C***PURPOSE Compute the inner product of two vectors with extended
|
|
+C precision accumulation and result.
|
|
+C***LIBRARY SLATEC (BLAS)
|
|
+C***CATEGORY D1A4
|
|
+C***TYPE DOUBLE PRECISION (DSDOT-D, DCDOT-C)
|
|
+C***KEYWORDS BLAS, COMPLEX VECTORS, DOT PRODUCT, INNER PRODUCT,
|
|
+C LINEAR ALGEBRA, VECTOR
|
|
+C***AUTHOR Lawson, C. L., (JPL)
|
|
+C Hanson, R. J., (SNLA)
|
|
+C Kincaid, D. R., (U. of Texas)
|
|
+C Krogh, F. T., (JPL)
|
|
+C***DESCRIPTION
|
|
+C
|
|
+C B L A S Subprogram
|
|
+C Description of Parameters
|
|
+C
|
|
+C --Input--
|
|
+C N number of elements in input vector(s)
|
|
+C SX single precision vector with N elements
|
|
+C INCX storage spacing between elements of SX
|
|
+C SY single precision vector with N elements
|
|
+C INCY storage spacing between elements of SY
|
|
+C
|
|
+C --Output--
|
|
+C DSDOT double precision dot product (zero if N.LE.0)
|
|
+C
|
|
+C Returns D.P. dot product accumulated in D.P., for S.P. SX and SY
|
|
+C DSDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY),
|
|
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
|
|
+C defined in a similar way using INCY.
|
|
+C
|
|
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
|
|
+C Krogh, Basic linear algebra subprograms for Fortran
|
|
+C usage, Algorithm No. 539, Transactions on Mathematical
|
|
+C Software 5, 3 (September 1979), pp. 308-323.
|
|
+C***ROUTINES CALLED (NONE)
|
|
+C***REVISION HISTORY (YYMMDD)
|
|
+C 791001 DATE WRITTEN
|
|
+C 890831 Modified array declarations. (WRB)
|
|
+C 890831 REVISION DATE from Version 3.2
|
|
+C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
|
|
+C 920501 Reformatted the REFERENCES section. (WRB)
|
|
+C***END PROLOGUE DSDOT
|
|
+ REAL SX(*),SY(*)
|
|
+C***FIRST EXECUTABLE STATEMENT DSDOT
|
|
+ DSDOT = 0.0D0
|
|
+ IF (N .LE. 0) RETURN
|
|
+ IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 20
|
|
+C
|
|
+C Code for unequal or nonpositive increments.
|
|
+C
|
|
+ KX = 1
|
|
+ KY = 1
|
|
+ IF (INCX .LT. 0) KX = 1+(1-N)*INCX
|
|
+ IF (INCY .LT. 0) KY = 1+(1-N)*INCY
|
|
+ DO 10 I = 1,N
|
|
+ DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
|
|
+ KX = KX + INCX
|
|
+ KY = KY + INCY
|
|
+ 10 CONTINUE
|
|
+ RETURN
|
|
+C
|
|
+C Code for equal, positive, non-unit increments.
|
|
+C
|
|
+ 20 NS = N*INCX
|
|
+ DO 30 I = 1,NS,INCX
|
|
+ DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
|
|
+ 30 CONTINUE
|
|
+ RETURN
|
|
+ END
|
|
--- LAPACK/BLAS/SRC/srotm.f.BAD 2005-09-28 18:00:17.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/srotm.f 2005-09-28 18:01:34.000000000 -0500
|
|
@@ -0,0 +1,106 @@
|
|
+ SUBROUTINE SROTM (N,SX,INCX,SY,INCY,SPARAM)
|
|
+C
|
|
+C APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
|
|
+C
|
|
+C (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
|
|
+C (DX**T)
|
|
+C
|
|
+C SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
|
|
+C LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
|
|
+C WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
|
|
+C
|
|
+C SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
|
|
+C
|
|
+C (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
|
|
+C H=( ) ( ) ( ) ( )
|
|
+C (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
|
|
+C SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
|
|
+C
|
|
+ DIMENSION SX(1),SY(1),SPARAM(5)
|
|
+ DATA ZERO,TWO/0.E0,2.E0/
|
|
+C
|
|
+ SFLAG=SPARAM(1)
|
|
+ IF(N .LE. 0 .OR.(SFLAG+TWO.EQ.ZERO)) GO TO 140
|
|
+ IF(.NOT.(INCX.EQ.INCY.AND. INCX .GT.0)) GO TO 70
|
|
+C
|
|
+ NSTEPS=N*INCX
|
|
+ IF(SFLAG) 50,10,30
|
|
+ 10 CONTINUE
|
|
+ SH12=SPARAM(4)
|
|
+ SH21=SPARAM(3)
|
|
+ DO 20 I=1,NSTEPS,INCX
|
|
+ W=SX(I)
|
|
+ Z=SY(I)
|
|
+ SX(I)=W+Z*SH12
|
|
+ SY(I)=W*SH21+Z
|
|
+ 20 CONTINUE
|
|
+ GO TO 140
|
|
+ 30 CONTINUE
|
|
+ SH11=SPARAM(2)
|
|
+ SH22=SPARAM(5)
|
|
+ DO 40 I=1,NSTEPS,INCX
|
|
+ W=SX(I)
|
|
+ Z=SY(I)
|
|
+ SX(I)=W*SH11+Z
|
|
+ SY(I)=-W+SH22*Z
|
|
+ 40 CONTINUE
|
|
+ GO TO 140
|
|
+ 50 CONTINUE
|
|
+ SH11=SPARAM(2)
|
|
+ SH12=SPARAM(4)
|
|
+ SH21=SPARAM(3)
|
|
+ SH22=SPARAM(5)
|
|
+ DO 60 I=1,NSTEPS,INCX
|
|
+ W=SX(I)
|
|
+ Z=SY(I)
|
|
+ SX(I)=W*SH11+Z*SH12
|
|
+ SY(I)=W*SH21+Z*SH22
|
|
+ 60 CONTINUE
|
|
+ GO TO 140
|
|
+ 70 CONTINUE
|
|
+ KX=1
|
|
+ KY=1
|
|
+ IF(INCX .LT. 0) KX=1+(1-N)*INCX
|
|
+ IF(INCY .LT. 0) KY=1+(1-N)*INCY
|
|
+C
|
|
+ IF(SFLAG)120,80,100
|
|
+ 80 CONTINUE
|
|
+ SH12=SPARAM(4)
|
|
+ SH21=SPARAM(3)
|
|
+ DO 90 I=1,N
|
|
+ W=SX(KX)
|
|
+ Z=SY(KY)
|
|
+ SX(KX)=W+Z*SH12
|
|
+ SY(KY)=W*SH21+Z
|
|
+ KX=KX+INCX
|
|
+ KY=KY+INCY
|
|
+ 90 CONTINUE
|
|
+ GO TO 140
|
|
+ 100 CONTINUE
|
|
+ SH11=SPARAM(2)
|
|
+ SH22=SPARAM(5)
|
|
+ DO 110 I=1,N
|
|
+ W=SX(KX)
|
|
+ Z=SY(KY)
|
|
+ SX(KX)=W*SH11+Z
|
|
+ SY(KY)=-W+SH22*Z
|
|
+ KX=KX+INCX
|
|
+ KY=KY+INCY
|
|
+ 110 CONTINUE
|
|
+ GO TO 140
|
|
+ 120 CONTINUE
|
|
+ SH11=SPARAM(2)
|
|
+ SH12=SPARAM(4)
|
|
+ SH21=SPARAM(3)
|
|
+ SH22=SPARAM(5)
|
|
+ DO 130 I=1,N
|
|
+ W=SX(KX)
|
|
+ Z=SY(KY)
|
|
+ SX(KX)=W*SH11+Z*SH12
|
|
+ SY(KY)=W*SH21+Z*SH22
|
|
+ KX=KX+INCX
|
|
+ KY=KY+INCY
|
|
+ 130 CONTINUE
|
|
+ 140 CONTINUE
|
|
+ RETURN
|
|
+ END
|
|
--- LAPACK/BLAS/SRC/zdrot.f.BAD 2005-09-28 18:00:31.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/zdrot.f 2005-09-28 18:02:00.000000000 -0500
|
|
@@ -0,0 +1,38 @@
|
|
+ subroutine zdrot (n,zx,incx,zy,incy,c,s)
|
|
+c
|
|
+c applies a plane rotation, where the cos and sin (c and s) are
|
|
+c double precision and the vectors zx and zy are double complex.
|
|
+c jack dongarra, linpack, 3/11/78.
|
|
+c
|
|
+ double complex zx(1),zy(1),ztemp
|
|
+ double precision c,s
|
|
+ integer i,incx,incy,ix,iy,n
|
|
+c
|
|
+ if(n.le.0)return
|
|
+ if(incx.eq.1.and.incy.eq.1)go to 20
|
|
+c
|
|
+c code for unequal increments or equal increments not equal
|
|
+c to 1
|
|
+c
|
|
+ ix = 1
|
|
+ iy = 1
|
|
+ if(incx.lt.0)ix = (-n+1)*incx + 1
|
|
+ if(incy.lt.0)iy = (-n+1)*incy + 1
|
|
+ do 10 i = 1,n
|
|
+ ztemp = c*zx(ix) + s*zy(iy)
|
|
+ zy(iy) = c*zy(iy) - s*zx(ix)
|
|
+ zx(ix) = ztemp
|
|
+ ix = ix + incx
|
|
+ iy = iy + incy
|
|
+ 10 continue
|
|
+ return
|
|
+c
|
|
+c code for both increments equal to 1
|
|
+c
|
|
+ 20 do 30 i = 1,n
|
|
+ ztemp = c*zx(i) + s*zy(i)
|
|
+ zy(i) = c*zy(i) - s*zx(i)
|
|
+ zx(i) = ztemp
|
|
+ 30 continue
|
|
+ return
|
|
+ end
|
|
--- LAPACK/BLAS/SRC/drotm.f.BAD 2005-09-28 17:59:52.000000000 -0500
|
|
+++ LAPACK/BLAS/SRC/drotm.f 2005-09-28 18:00:50.000000000 -0500
|
|
@@ -0,0 +1,108 @@
|
|
+ SUBROUTINE DROTM (N,DX,INCX,DY,INCY,DPARAM)
|
|
+C
|
|
+C APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
|
|
+C
|
|
+C (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
|
|
+C (DY**T)
|
|
+C
|
|
+C DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
|
|
+C LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
|
|
+C WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
|
|
+C
|
|
+C DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
|
|
+C
|
|
+C (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
|
|
+C H=( ) ( ) ( ) ( )
|
|
+C (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
|
|
+C SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
|
|
+C
|
|
+ DOUBLE PRECISION DFLAG,DH12,DH22,DX,TWO,Z,DH11,DH21,
|
|
+ 1 DPARAM,DY,W,ZERO
|
|
+ DIMENSION DX(1),DY(1),DPARAM(5)
|
|
+ DATA ZERO,TWO/0.D0,2.D0/
|
|
+C
|
|
+ DFLAG=DPARAM(1)
|
|
+ IF(N .LE. 0 .OR.(DFLAG+TWO.EQ.ZERO)) GO TO 140
|
|
+ IF(.NOT.(INCX.EQ.INCY.AND. INCX .GT.0)) GO TO 70
|
|
+C
|
|
+ NSTEPS=N*INCX
|
|
+ IF(DFLAG) 50,10,30
|
|
+ 10 CONTINUE
|
|
+ DH12=DPARAM(4)
|
|
+ DH21=DPARAM(3)
|
|
+ DO 20 I=1,NSTEPS,INCX
|
|
+ W=DX(I)
|
|
+ Z=DY(I)
|
|
+ DX(I)=W+Z*DH12
|
|
+ DY(I)=W*DH21+Z
|
|
+ 20 CONTINUE
|
|
+ GO TO 140
|
|
+ 30 CONTINUE
|
|
+ DH11=DPARAM(2)
|
|
+ DH22=DPARAM(5)
|
|
+ DO 40 I=1,NSTEPS,INCX
|
|
+ W=DX(I)
|
|
+ Z=DY(I)
|
|
+ DX(I)=W*DH11+Z
|
|
+ DY(I)=-W+DH22*Z
|
|
+ 40 CONTINUE
|
|
+ GO TO 140
|
|
+ 50 CONTINUE
|
|
+ DH11=DPARAM(2)
|
|
+ DH12=DPARAM(4)
|
|
+ DH21=DPARAM(3)
|
|
+ DH22=DPARAM(5)
|
|
+ DO 60 I=1,NSTEPS,INCX
|
|
+ W=DX(I)
|
|
+ Z=DY(I)
|
|
+ DX(I)=W*DH11+Z*DH12
|
|
+ DY(I)=W*DH21+Z*DH22
|
|
+ 60 CONTINUE
|
|
+ GO TO 140
|
|
+ 70 CONTINUE
|
|
+ KX=1
|
|
+ KY=1
|
|
+ IF(INCX .LT. 0) KX=1+(1-N)*INCX
|
|
+ IF(INCY .LT. 0) KY=1+(1-N)*INCY
|
|
+C
|
|
+ IF(DFLAG)120,80,100
|
|
+ 80 CONTINUE
|
|
+ DH12=DPARAM(4)
|
|
+ DH21=DPARAM(3)
|
|
+ DO 90 I=1,N
|
|
+ W=DX(KX)
|
|
+ Z=DY(KY)
|
|
+ DX(KX)=W+Z*DH12
|
|
+ DY(KY)=W*DH21+Z
|
|
+ KX=KX+INCX
|
|
+ KY=KY+INCY
|
|
+ 90 CONTINUE
|
|
+ GO TO 140
|
|
+ 100 CONTINUE
|
|
+ DH11=DPARAM(2)
|
|
+ DH22=DPARAM(5)
|
|
+ DO 110 I=1,N
|
|
+ W=DX(KX)
|
|
+ Z=DY(KY)
|
|
+ DX(KX)=W*DH11+Z
|
|
+ DY(KY)=-W+DH22*Z
|
|
+ KX=KX+INCX
|
|
+ KY=KY+INCY
|
|
+ 110 CONTINUE
|
|
+ GO TO 140
|
|
+ 120 CONTINUE
|
|
+ DH11=DPARAM(2)
|
|
+ DH12=DPARAM(4)
|
|
+ DH21=DPARAM(3)
|
|
+ DH22=DPARAM(5)
|
|
+ DO 130 I=1,N
|
|
+ W=DX(KX)
|
|
+ Z=DY(KY)
|
|
+ DX(KX)=W*DH11+Z*DH12
|
|
+ DY(KY)=W*DH21+Z*DH22
|
|
+ KX=KX+INCX
|
|
+ KY=KY+INCY
|
|
+ 130 CONTINUE
|
|
+ 140 CONTINUE
|
|
+ RETURN
|
|
+ END
|