--- 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