From e9dac1f3c4684d925d3bfd5214125a89ef228e39 Mon Sep 17 00:00:00 2001 From: julie Date: Thu, 10 Mar 2011 23:33:40 +0000 Subject: Remove the easy GO TO statments....still 13 to remove in drotm.f and 36 in drotmg.f --- BLAS/SRC/caxpy.f | 34 +++++++++++++------------ BLAS/SRC/ccopy.f | 35 ++++++++++++------------- BLAS/SRC/cdotc.f | 36 +++++++++++++------------- BLAS/SRC/cdotu.f | 36 +++++++++++++------------- BLAS/SRC/crotg.f | 25 +++++++++--------- BLAS/SRC/cscal.f | 23 +++++++++-------- BLAS/SRC/csrot.f | 48 +++++++++++++++++------------------ BLAS/SRC/csscal.f | 23 +++++++++-------- BLAS/SRC/cswap.f | 41 +++++++++++++++--------------- BLAS/SRC/dasum.f | 50 +++++++++++++++++++----------------- BLAS/SRC/daxpy.f | 56 ++++++++++++++++++++-------------------- BLAS/SRC/dcopy.f | 64 +++++++++++++++++++++++----------------------- BLAS/SRC/ddot.f | 58 ++++++++++++++++++++++-------------------- BLAS/SRC/drot.f | 43 ++++++++++++++++--------------- BLAS/SRC/drotg.f | 29 +++++++++++---------- BLAS/SRC/dscal.f | 48 ++++++++++++++++++----------------- BLAS/SRC/dsdot.f | 35 ++++++++++++------------- BLAS/SRC/dswap.f | 76 ++++++++++++++++++++++++++++--------------------------- BLAS/SRC/dzasum.f | 27 ++++++++++---------- BLAS/SRC/icamax.f | 41 ++++++++++++++++-------------- BLAS/SRC/idamax.f | 41 ++++++++++++++++-------------- BLAS/SRC/isamax.f | 41 ++++++++++++++++-------------- BLAS/SRC/izamax.f | 43 ++++++++++++++++--------------- BLAS/SRC/sasum.f | 50 +++++++++++++++++++----------------- BLAS/SRC/saxpy.f | 58 ++++++++++++++++++++++-------------------- BLAS/SRC/scasum.f | 24 +++++++++--------- BLAS/SRC/scopy.f | 64 +++++++++++++++++++++++----------------------- BLAS/SRC/sdot.f | 58 ++++++++++++++++++++++-------------------- BLAS/SRC/sdsdot.f | 41 ++++++++++++++++-------------- BLAS/SRC/srot.f | 43 ++++++++++++++++--------------- BLAS/SRC/srotg.f | 29 +++++++++++---------- BLAS/SRC/sscal.f | 48 ++++++++++++++++++----------------- BLAS/SRC/sswap.f | 76 ++++++++++++++++++++++++++++--------------------------- BLAS/SRC/zaxpy.f | 34 +++++++++++++------------ BLAS/SRC/zcopy.f | 35 ++++++++++++------------- BLAS/SRC/zdotc.f | 36 +++++++++++++------------- BLAS/SRC/zdotu.f | 36 +++++++++++++------------- BLAS/SRC/zdrot.f | 49 ++++++++++++++++++----------------- BLAS/SRC/zdscal.f | 26 +++++++++---------- BLAS/SRC/zrotg.f | 27 ++++++++++---------- BLAS/SRC/zscal.f | 26 +++++++++---------- BLAS/SRC/zswap.f | 41 +++++++++++++++--------------- 42 files changed, 906 insertions(+), 848 deletions(-) (limited to 'BLAS') diff --git a/BLAS/SRC/caxpy.f b/BLAS/SRC/caxpy.f index 763236d7..c0bb7661 100644 --- a/BLAS/SRC/caxpy.f +++ b/BLAS/SRC/caxpy.f @@ -29,26 +29,28 @@ * .. IF (N.LE.0) RETURN IF (SCABS1(CA).EQ.0.0E+0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + CY(I) = CY(I) + CA*CX(I) + END DO + ELSE * * code for unequal increments or equal increments * not equal to 1 * - 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 - CY(IY) = CY(IY) + CA*CX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -* -* code for both increments equal to 1 + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CY(IY) = CY(IY) + CA*CX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF * - 20 DO 30 I = 1,N - CY(I) = CY(I) + CA*CX(I) - 30 CONTINUE RETURN END diff --git a/BLAS/SRC/ccopy.f b/BLAS/SRC/ccopy.f index 89503807..87446f7b 100644 --- a/BLAS/SRC/ccopy.f +++ b/BLAS/SRC/ccopy.f @@ -23,26 +23,27 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments -* not equal to 1 +* code for both increments equal to 1 * - 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 - CY(IY) = CX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + DO I = 1,N + CY(I) = CX(I) + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments +* not equal to 1 * - 20 DO 30 I = 1,N - CY(I) = CX(I) - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CY(IY) = CX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/cdotc.f b/BLAS/SRC/cdotc.f index 0c121dd8..025d1636 100644 --- a/BLAS/SRC/cdotc.f +++ b/BLAS/SRC/cdotc.f @@ -30,28 +30,28 @@ CTEMP = (0.0,0.0) CDOTC = (0.0,0.0) IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments -* not equal to 1 +* code for both increments equal to 1 * - 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 = CTEMP + CONJG(CX(IX))*CY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - CDOTC = CTEMP - RETURN + DO I = 1,N + CTEMP = CTEMP + CONJG(CX(I))*CY(I) + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments +* not equal to 1 * - 20 DO 30 I = 1,N - CTEMP = CTEMP + CONJG(CX(I))*CY(I) - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CTEMP = CTEMP + CONJG(CX(IX))*CY(IY) + IX = IX + INCX + IY = IY + INCY + END DO + END IF CDOTC = CTEMP RETURN END diff --git a/BLAS/SRC/cdotu.f b/BLAS/SRC/cdotu.f index 01d6beac..d31c16f0 100644 --- a/BLAS/SRC/cdotu.f +++ b/BLAS/SRC/cdotu.f @@ -26,28 +26,28 @@ CTEMP = (0.0,0.0) CDOTU = (0.0,0.0) IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments -* not equal to 1 +* code for both increments equal to 1 * - 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 = CTEMP + CX(IX)*CY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - CDOTU = CTEMP - RETURN + DO I = 1,N + CTEMP = CTEMP + CX(I)*CY(I) + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments +* not equal to 1 * - 20 DO 30 I = 1,N - CTEMP = CTEMP + CX(I)*CY(I) - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CTEMP = CTEMP + CX(IX)*CY(IY) + IX = IX + INCX + IY = IY + INCY + END DO + END IF CDOTU = CTEMP RETURN END diff --git a/BLAS/SRC/crotg.f b/BLAS/SRC/crotg.f index e9095454..360028cc 100644 --- a/BLAS/SRC/crotg.f +++ b/BLAS/SRC/crotg.f @@ -18,18 +18,17 @@ * .. Intrinsic Functions .. INTRINSIC CABS,CONJG,SQRT * .. - IF (CABS(CA).NE.0.) GO TO 10 - C = 0. - S = (1.,0.) - CA = CB - GO TO 20 - 10 CONTINUE - SCALE = CABS(CA) + CABS(CB) - NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2) - ALPHA = CA/CABS(CA) - C = CABS(CA)/NORM - S = ALPHA*CONJG(CB)/NORM - CA = ALPHA*NORM - 20 CONTINUE + IF (CABS(CA).EQ.0.) THEN + C = 0. + S = (1.,0.) + CA = CB + ELSE + SCALE = CABS(CA) + CABS(CB) + NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2) + ALPHA = CA/CABS(CA) + C = CABS(CA)/NORM + S = ALPHA*CONJG(CB)/NORM + CA = ALPHA*NORM + END IF RETURN END diff --git a/BLAS/SRC/cscal.f b/BLAS/SRC/cscal.f index fdba3599..ce1ae155 100644 --- a/BLAS/SRC/cscal.f +++ b/BLAS/SRC/cscal.f @@ -25,20 +25,21 @@ INTEGER I,NINCX * .. IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - CX(I) = CA*CX(I) - 10 CONTINUE - RETURN + DO I = 1,N + CX(I) = CA*CX(I) + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DO 30 I = 1,N - CX(I) = CA*CX(I) - 30 CONTINUE + NINCX = N*INCX + DO I = 1,NINCX,INCX + CX(I) = CA*CX(I) + END DO + END IF RETURN END diff --git a/BLAS/SRC/csrot.f b/BLAS/SRC/csrot.f index 09e72b27..4178079a 100644 --- a/BLAS/SRC/csrot.f +++ b/BLAS/SRC/csrot.f @@ -63,33 +63,33 @@ * IF( N.LE.0 ) $ RETURN - IF( INCX.EQ.1 .AND. INCY.EQ.1 ) - $ GO TO 20 + IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN * -* code for unequal increments or equal increments not equal -* to 1 +* code for both increments equal to 1 * - 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 + DO I = 1, N + CTEMP = C*CX( I ) + S*CY( I ) + CY( I ) = C*CY( I ) - S*CX( I ) + CX( I ) = CTEMP + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments not equal +* to 1 * - 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 + IX = 1 + IY = 1 + IF( INCX.LT.0 ) + $ IX = ( -N+1 )*INCX + 1 + IF( INCY.LT.0 ) + $ IY = ( -N+1 )*INCY + 1 + DO 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 + END DO + END IF RETURN END diff --git a/BLAS/SRC/csscal.f b/BLAS/SRC/csscal.f index 338f6296..8ec2eade 100644 --- a/BLAS/SRC/csscal.f +++ b/BLAS/SRC/csscal.f @@ -28,20 +28,21 @@ INTRINSIC AIMAG,CMPLX,REAL * .. IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I))) - 10 CONTINUE - RETURN + DO I = 1,N + CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I))) + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DO 30 I = 1,N - CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I))) - 30 CONTINUE + NINCX = N*INCX + DO I = 1,NINCX,INCX + CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I))) + END DO + END IF RETURN END diff --git a/BLAS/SRC/cswap.f b/BLAS/SRC/cswap.f index 40dd71f1..1e267179 100644 --- a/BLAS/SRC/cswap.f +++ b/BLAS/SRC/cswap.f @@ -24,29 +24,30 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 + DO I = 1,N + CTEMP = CX(I) + CX(I) = CY(I) + CY(I) = CTEMP + END DO + ELSE * * code for unequal increments or equal increments not equal * to 1 * - 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 = CX(IX) - CX(IX) = CY(IY) - CY(IY) = CTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -* -* code for both increments equal to 1 - 20 DO 30 I = 1,N - CTEMP = CX(I) - CX(I) = CY(I) - CY(I) = CTEMP - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CTEMP = CX(IX) + CX(IX) = CY(IY) + CY(IY) = CTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/dasum.f b/BLAS/SRC/dasum.f index 8705ecd9..e673554c 100644 --- a/BLAS/SRC/dasum.f +++ b/BLAS/SRC/dasum.f @@ -30,33 +30,37 @@ DASUM = 0.0d0 DTEMP = 0.0d0 IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 -* -* code for increment not equal to 1 -* - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - DTEMP = DTEMP + DABS(DX(I)) - 10 CONTINUE - DASUM = DTEMP - RETURN -* + IF (INCX.EQ.1) THEN * code for increment equal to 1 * * * clean-up loop * - 20 M = MOD(N,6) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + DABS(DX(I)) - 30 CONTINUE - IF (N.LT.6) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,6 - DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + DABS(DX(I+2)) + - + DABS(DX(I+3)) + DABS(DX(I+4)) + DABS(DX(I+5)) - 50 CONTINUE - 60 DASUM = DTEMP + M = MOD(N,6) + IF (M.NE.0) THEN + DO I = 1,M + DTEMP = DTEMP + DABS(DX(I)) + END DO + IF (N.LT.6) THEN + DASUM = DTEMP + RETURN + END IF + END IF + MP1 = M + 1 + DO I = MP1,N,6 + DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + + $ DABS(DX(I+2)) + DABS(DX(I+3)) + + $ DABS(DX(I+4)) + DABS(DX(I+5)) + END DO + ELSE +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO I = 1,NINCX,INCX + DTEMP = DTEMP + DABS(DX(I)) + END DO + END IF + DASUM = DTEMP RETURN END diff --git a/BLAS/SRC/daxpy.f b/BLAS/SRC/daxpy.f index 4f92db2f..ddc7449a 100644 --- a/BLAS/SRC/daxpy.f +++ b/BLAS/SRC/daxpy.f @@ -29,39 +29,41 @@ * .. IF (N.LE.0) RETURN IF (DA.EQ.0.0d0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + M = MOD(N,4) + IF (M.NE.0) THEN + DO I = 1,M + DY(I) = DY(I) + DA*DX(I) + END DO + END IF + IF (N.LT.4) RETURN + MP1 = M + 1 + DO I = MP1,N,4 + DY(I) = DY(I) + DA*DX(I) + DY(I+1) = DY(I+1) + DA*DX(I+1) + DY(I+2) = DY(I+2) + DA*DX(I+2) + DY(I+3) = DY(I+3) + DA*DX(I+3) + END DO + ELSE * * code for unequal increments or equal increments * not equal to 1 * - 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 + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N DY(IY) = DY(IY) + DA*DX(IX) IX = IX + INCX IY = IY + INCY - 10 CONTINUE - RETURN -* -* code for both increments equal to 1 -* -* -* clean-up loop -* - 20 M = MOD(N,4) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DY(I) = DY(I) + DA*DX(I) - 30 CONTINUE - IF (N.LT.4) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,4 - DY(I) = DY(I) + DA*DX(I) - DY(I+1) = DY(I+1) + DA*DX(I+1) - DY(I+2) = DY(I+2) + DA*DX(I+2) - DY(I+3) = DY(I+3) + DA*DX(I+3) - 50 CONTINUE + END DO + END IF RETURN END diff --git a/BLAS/SRC/dcopy.f b/BLAS/SRC/dcopy.f index dcc8a0c1..a4414509 100644 --- a/BLAS/SRC/dcopy.f +++ b/BLAS/SRC/dcopy.f @@ -27,42 +27,44 @@ INTRINSIC MOD * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments -* not equal to 1 -* - 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 - DY(IY) = DX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * * * clean-up loop * - 20 M = MOD(N,7) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DY(I) = DX(I) - 30 CONTINUE - IF (N.LT.7) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,7 - DY(I) = DX(I) - DY(I+1) = DX(I+1) - DY(I+2) = DX(I+2) - DY(I+3) = DX(I+3) - DY(I+4) = DX(I+4) - DY(I+5) = DX(I+5) - DY(I+6) = DX(I+6) - 50 CONTINUE + M = MOD(N,7) + IF (M.NE.0) THEN + DO I = 1,M + DY(I) = DX(I) + END DO + IF (N.LT.7) RETURN + END IF + MP1 = M + 1 + DO I = MP1,N,7 + DY(I) = DX(I) + DY(I+1) = DX(I+1) + DY(I+2) = DX(I+2) + DY(I+3) = DX(I+3) + DY(I+4) = DX(I+4) + DY(I+5) = DX(I+5) + DY(I+6) = DX(I+6) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DY(IY) = DX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/ddot.f b/BLAS/SRC/ddot.f index 3df03aec..33719eed 100644 --- a/BLAS/SRC/ddot.f +++ b/BLAS/SRC/ddot.f @@ -30,39 +30,43 @@ DDOT = 0.0d0 DTEMP = 0.0d0 IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments -* not equal to 1 -* - 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 - DTEMP = DTEMP + DX(IX)*DY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - DDOT = DTEMP - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * * * clean-up loop * - 20 M = MOD(N,5) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + DX(I)*DY(I) - 30 CONTINUE - IF (N.LT.5) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 + M = MOD(N,5) + IF (M.NE.0) THEN + DO I = 1,M + DTEMP = DTEMP + DX(I)*DY(I) + END DO + IF (N.LT.5) THEN + DDOT=DTEMP + RETURN + END IF + END IF + MP1 = M + 1 + DO I = MP1,N,5 DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) + - + DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4) - 50 CONTINUE - 60 DDOT = DTEMP + $ DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DTEMP = DTEMP + DX(IX)*DY(IY) + IX = IX + INCX + IY = IY + INCY + END DO + END IF + DDOT = DTEMP RETURN END diff --git a/BLAS/SRC/drot.f b/BLAS/SRC/drot.f index 2075314b..a02bda37 100644 --- a/BLAS/SRC/drot.f +++ b/BLAS/SRC/drot.f @@ -25,30 +25,31 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments not equal -* to 1 +* code for both increments equal to 1 * - 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 - DTEMP = C*DX(IX) + S*DY(IY) - DY(IY) = C*DY(IY) - S*DX(IX) - DX(IX) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + DO I = 1,N + DTEMP = C*DX(I) + S*DY(I) + DY(I) = C*DY(I) - S*DX(I) + DX(I) = DTEMP + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments not equal +* to 1 * - 20 DO 30 I = 1,N - DTEMP = C*DX(I) + S*DY(I) - DY(I) = C*DY(I) - S*DX(I) - DX(I) = DTEMP - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DTEMP = C*DX(IX) + S*DY(IY) + DY(IY) = C*DY(IY) - S*DX(IX) + DX(IX) = DTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/drotg.f b/BLAS/SRC/drotg.f index a6ba96ab..3819f473 100644 --- a/BLAS/SRC/drotg.f +++ b/BLAS/SRC/drotg.f @@ -24,20 +24,21 @@ ROE = DB IF (DABS(DA).GT.DABS(DB)) ROE = DA SCALE = DABS(DA) + DABS(DB) - IF (SCALE.NE.0.0d0) GO TO 10 - C = 1.0d0 - S = 0.0d0 - R = 0.0d0 - Z = 0.0d0 - GO TO 20 - 10 R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2) - R = DSIGN(1.0d0,ROE)*R - C = DA/R - S = DB/R - Z = 1.0d0 - IF (DABS(DA).GT.DABS(DB)) Z = S - IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C - 20 DA = R + IF (SCALE.EQ.0.0d0) THEN + C = 1.0d0 + S = 0.0d0 + R = 0.0d0 + Z = 0.0d0 + ELSE + R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2) + R = DSIGN(1.0d0,ROE)*R + C = DA/R + S = DB/R + Z = 1.0d0 + IF (DABS(DA).GT.DABS(DB)) Z = S + IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C + END IF + DA = R DB = Z RETURN END diff --git a/BLAS/SRC/dscal.f b/BLAS/SRC/dscal.f index 81425a94..986c24eb 100644 --- a/BLAS/SRC/dscal.f +++ b/BLAS/SRC/dscal.f @@ -29,34 +29,36 @@ INTRINSIC MOD * .. IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 -* -* code for increment not equal to 1 -* - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - DX(I) = DA*DX(I) - 10 CONTINUE - RETURN + IF (INCX.EQ.1) THEN * * code for increment equal to 1 * * * clean-up loop * - 20 M = MOD(N,5) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DX(I) = DA*DX(I) - 30 CONTINUE - IF (N.LT.5) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 - DX(I) = DA*DX(I) - DX(I+1) = DA*DX(I+1) - DX(I+2) = DA*DX(I+2) - DX(I+3) = DA*DX(I+3) - DX(I+4) = DA*DX(I+4) - 50 CONTINUE + M = MOD(N,5) + IF (M.NE.0) THEN + DO I = 1,M + DX(I) = DA*DX(I) + END DO + IF (N.LT.5) RETURN + END IF + MP1 = M + 1 + DO I = MP1,N,5 + DX(I) = DA*DX(I) + DX(I+1) = DA*DX(I+1) + DX(I+2) = DA*DX(I+2) + DX(I+3) = DA*DX(I+3) + DX(I+4) = DA*DX(I+4) + END DO + ELSE +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO I = 1,NINCX,INCX + DX(I) = DA*DX(I) + END DO + END IF RETURN END diff --git a/BLAS/SRC/dsdot.f b/BLAS/SRC/dsdot.f index 457873b5..8f8ebfdb 100644 --- a/BLAS/SRC/dsdot.f +++ b/BLAS/SRC/dsdot.f @@ -72,26 +72,27 @@ * .. DSDOT = 0.0D0 IF (N.LE.0) RETURN - IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 20 + IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN * -* Code for unequal or nonpositive increments. +* Code for equal, positive, non-unit increments. * - 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 + NS = N*INCX + DO I = 1,NS,INCX + DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) + END DO + ELSE * -* Code for equal, positive, non-unit increments. +* Code for unequal or nonpositive increments. * - 20 NS = N*INCX - DO 30 I = 1,NS,INCX - DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) - 30 CONTINUE + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY + DO I = 1,N + DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) + KX = KX + INCX + KY = KY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/dswap.f b/BLAS/SRC/dswap.f index 3595fd8c..93db05cb 100644 --- a/BLAS/SRC/dswap.f +++ b/BLAS/SRC/dswap.f @@ -28,48 +28,50 @@ INTRINSIC MOD * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments not equal -* to 1 -* - 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 - DTEMP = DX(IX) - DX(IX) = DY(IY) - DY(IY) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * * * clean-up loop * - 20 M = MOD(N,3) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - 30 CONTINUE - IF (N.LT.3) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,3 - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - DTEMP = DX(I+1) - DX(I+1) = DY(I+1) - DY(I+1) = DTEMP - DTEMP = DX(I+2) - DX(I+2) = DY(I+2) - DY(I+2) = DTEMP - 50 CONTINUE + M = MOD(N,3) + IF (M.NE.0) THEN + DO I = 1,M + DTEMP = DX(I) + DX(I) = DY(I) + DY(I) = DTEMP + END DO + IF (N.LT.3) RETURN + END IF + MP1 = M + 1 + DO I = MP1,N,3 + DTEMP = DX(I) + DX(I) = DY(I) + DY(I) = DTEMP + DTEMP = DX(I+1) + DX(I+1) = DY(I+1) + DY(I+1) = DTEMP + DTEMP = DX(I+2) + DX(I+2) = DY(I+2) + DY(I+2) = DTEMP + END DO + ELSE +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DTEMP = DX(IX) + DX(IX) = DY(IY) + DY(IY) = DTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/dzasum.f b/BLAS/SRC/dzasum.f index 5eabc60f..a5c440c5 100644 --- a/BLAS/SRC/dzasum.f +++ b/BLAS/SRC/dzasum.f @@ -22,7 +22,7 @@ * * .. Local Scalars .. DOUBLE PRECISION STEMP - INTEGER I,IX + INTEGER I,NINCX * .. * .. External Functions .. DOUBLE PRECISION DCABS1 @@ -31,23 +31,22 @@ DZASUM = 0.0d0 STEMP = 0.0d0 IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - DO 10 I = 1,N - STEMP = STEMP + DCABS1(ZX(IX)) - IX = IX + INCX - 10 CONTINUE - DZASUM = STEMP - RETURN + DO I = 1,N + STEMP = STEMP + DCABS1(ZX(I)) + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DO 30 I = 1,N - STEMP = STEMP + DCABS1(ZX(I)) - 30 CONTINUE + NINCX = N*INCX + DO I = 1,NINCX,INCX + STEMP = STEMP + DCABS1(ZX(I)) + END DO + END IF DZASUM = STEMP RETURN END diff --git a/BLAS/SRC/icamax.f b/BLAS/SRC/icamax.f index 4fd4b920..2c941f97 100644 --- a/BLAS/SRC/icamax.f +++ b/BLAS/SRC/icamax.f @@ -32,28 +32,31 @@ IF (N.LT.1 .OR. INCX.LE.0) RETURN ICAMAX = 1 IF (N.EQ.1) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - SMAX = SCABS1(CX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF (SCABS1(CX(IX)).LE.SMAX) GO TO 5 - ICAMAX = I - SMAX = SCABS1(CX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN + SMAX = SCABS1(CX(1)) + DO I = 2,N + IF (SCABS1(CX(I)).GT.SMAX) THEN + ICAMAX = I + SMAX = SCABS1(CX(I)) + END IF + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 SMAX = SCABS1(CX(1)) - DO 30 I = 2,N - IF (SCABS1(CX(I)).LE.SMAX) GO TO 30 - ICAMAX = I - SMAX = SCABS1(CX(I)) - 30 CONTINUE + IX = 1 + SMAX = SCABS1(CX(1)) + IX = IX + INCX + DO I = 2,N + IF (SCABS1(CX(IX)).GT.SMAX) THEN + ICAMAX = I + SMAX = SCABS1(CX(IX)) + END IF + IX = IX + INCX + END DO + END IF RETURN END diff --git a/BLAS/SRC/idamax.f b/BLAS/SRC/idamax.f index fa45c1d6..2cc0f9a5 100644 --- a/BLAS/SRC/idamax.f +++ b/BLAS/SRC/idamax.f @@ -31,28 +31,31 @@ IF (N.LT.1 .OR. INCX.LE.0) RETURN IDAMAX = 1 IF (N.EQ.1) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - DMAX = DABS(DX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF (DABS(DX(IX)).LE.DMAX) GO TO 5 - IDAMAX = I - DMAX = DABS(DX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN + DMAX = DABS(DX(1)) + DO I = 2,N + IF (DABS(DX(I)).GT.DMAX) THEN + IDAMAX = I + DMAX = DABS(DX(I)) + END IF + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DMAX = DABS(DX(1)) - DO 30 I = 2,N - IF (DABS(DX(I)).LE.DMAX) GO TO 30 - IDAMAX = I - DMAX = DABS(DX(I)) - 30 CONTINUE + IX = 1 + DMAX = DABS(DX(1)) + IX = IX + INCX + DO I = 2,N + IF (DABS(DX(IX)).GT.DMAX) THEN + IDAMAX = I + DMAX = DABS(DX(IX)) + END IF + IX = IX + INCX + END DO + END IF RETURN END diff --git a/BLAS/SRC/isamax.f b/BLAS/SRC/isamax.f index 88741e7e..26a98dd5 100644 --- a/BLAS/SRC/isamax.f +++ b/BLAS/SRC/isamax.f @@ -31,28 +31,31 @@ IF (N.LT.1 .OR. INCX.LE.0) RETURN ISAMAX = 1 IF (N.EQ.1) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - SMAX = ABS(SX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF (ABS(SX(IX)).LE.SMAX) GO TO 5 - ISAMAX = I - SMAX = ABS(SX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN + SMAX = ABS(SX(1)) + DO I = 2,N + IF (ABS(SX(I)).GT.SMAX) THEN + ISAMAX = I + SMAX = ABS(SX(I)) + END IF + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 SMAX = ABS(SX(1)) - DO 30 I = 2,N - IF (ABS(SX(I)).LE.SMAX) GO TO 30 - ISAMAX = I - SMAX = ABS(SX(I)) - 30 CONTINUE + IX = 1 + SMAX = ABS(SX(1)) + IX = IX + INCX + DO I = 2,N + IF (ABS(SX(IX)).GT.SMAX) THEN + ISAMAX = I + SMAX = ABS(SX(IX)) + END IF + IX = IX + INCX + END DO + END IF RETURN END diff --git a/BLAS/SRC/izamax.f b/BLAS/SRC/izamax.f index 27c56874..af14fb16 100644 --- a/BLAS/SRC/izamax.f +++ b/BLAS/SRC/izamax.f @@ -21,7 +21,7 @@ * ===================================================================== * * .. Local Scalars .. - DOUBLE PRECISION SMAX + DOUBLE PRECISION DMAX INTEGER I,IX * .. * .. External Functions .. @@ -32,28 +32,31 @@ IF (N.LT.1 .OR. INCX.LE.0) RETURN IZAMAX = 1 IF (N.EQ.1) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - SMAX = DCABS1(ZX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF (DCABS1(ZX(IX)).LE.SMAX) GO TO 5 - IZAMAX = I - SMAX = DCABS1(ZX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN + DMAX = DCABS1(ZX(1)) + DO I = 2,N + IF (DCABS1(ZX(I)).GT.DMAX) THEN + IZAMAX = I + DMAX = DCABS1(ZX(I)) + END IF + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 SMAX = DCABS1(ZX(1)) - DO 30 I = 2,N - IF (DCABS1(ZX(I)).LE.SMAX) GO TO 30 - IZAMAX = I - SMAX = DCABS1(ZX(I)) - 30 CONTINUE + IX = 1 + DMAX = DCABS1(ZX(1)) + IX = IX + INCX + DO I = 2,N + IF (DCABS1(ZX(IX)).GT.DMAX) THEN + IZAMAX = I + DMAX = DCABS1(ZX(IX)) + END IF + IX = IX + INCX + END DO + END IF RETURN END diff --git a/BLAS/SRC/sasum.f b/BLAS/SRC/sasum.f index 83513335..1e3f7db8 100644 --- a/BLAS/SRC/sasum.f +++ b/BLAS/SRC/sasum.f @@ -31,33 +31,37 @@ SASUM = 0.0e0 STEMP = 0.0e0 IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 -* -* code for increment not equal to 1 -* - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - STEMP = STEMP + ABS(SX(I)) - 10 CONTINUE - SASUM = STEMP - RETURN -* + IF (INCX.EQ.1) THEN * code for increment equal to 1 * * * clean-up loop * - 20 M = MOD(N,6) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - STEMP = STEMP + ABS(SX(I)) - 30 CONTINUE - IF (N.LT.6) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,6 - STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) + ABS(SX(I+2)) + - + ABS(SX(I+3)) + ABS(SX(I+4)) + ABS(SX(I+5)) - 50 CONTINUE - 60 SASUM = STEMP + M = MOD(N,6) + IF (M.NE.0) THEN + DO I = 1,M + STEMP = STEMP + ABS(SX(I)) + END DO + IF (N.LT.6) THEN + SASUM = STEMP + RETURN + END IF + END IF + MP1 = M + 1 + DO I = MP1,N,6 + STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) + + $ ABS(SX(I+2)) + ABS(SX(I+3)) + + $ ABS(SX(I+4)) + ABS(SX(I+5)) + END DO + ELSE +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO I = 1,NINCX,INCX + STEMP = STEMP + ABS(SX(I)) + END DO + END IF + SASUM = STEMP RETURN END diff --git a/BLAS/SRC/saxpy.f b/BLAS/SRC/saxpy.f index 00fc145d..c0d8b3a0 100644 --- a/BLAS/SRC/saxpy.f +++ b/BLAS/SRC/saxpy.f @@ -11,7 +11,7 @@ * ======= * * SAXPY constant times a vector plus a vector. -* uses unrolled loop for increments equal to one. +* uses unrolled loops for increments equal to one. * * Further Details * =============== @@ -29,39 +29,41 @@ * .. IF (N.LE.0) RETURN IF (SA.EQ.0.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + M = MOD(N,4) + IF (M.NE.0) THEN + DO I = 1,M + SY(I) = SY(I) + SA*SX(I) + END DO + END IF + IF (N.LT.4) RETURN + MP1 = M + 1 + DO I = MP1,N,4 + SY(I) = SY(I) + SA*SX(I) + SY(I+1) = SY(I+1) + SA*SX(I+1) + SY(I+2) = SY(I+2) + SA*SX(I+2) + SY(I+3) = SY(I+3) + SA*SX(I+3) + END DO + ELSE * * code for unequal increments or equal increments * not equal to 1 * - 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 + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N SY(IY) = SY(IY) + SA*SX(IX) IX = IX + INCX IY = IY + INCY - 10 CONTINUE - RETURN -* -* code for both increments equal to 1 -* -* -* clean-up loop -* - 20 M = MOD(N,4) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - SY(I) = SY(I) + SA*SX(I) - 30 CONTINUE - IF (N.LT.4) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,4 - SY(I) = SY(I) + SA*SX(I) - SY(I+1) = SY(I+1) + SA*SX(I+1) - SY(I+2) = SY(I+2) + SA*SX(I+2) - SY(I+3) = SY(I+3) + SA*SX(I+3) - 50 CONTINUE + END DO + END IF RETURN END diff --git a/BLAS/SRC/scasum.f b/BLAS/SRC/scasum.f index 2fa01859..d090110c 100644 --- a/BLAS/SRC/scasum.f +++ b/BLAS/SRC/scasum.f @@ -31,22 +31,22 @@ SCASUM = 0.0e0 STEMP = 0.0e0 IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) - 10 CONTINUE - SCASUM = STEMP - RETURN + DO I = 1,N + STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DO 30 I = 1,N - STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) - 30 CONTINUE + NINCX = N*INCX + DO I = 1,NINCX,INCX + STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) + END DO + END IF SCASUM = STEMP RETURN END diff --git a/BLAS/SRC/scopy.f b/BLAS/SRC/scopy.f index e0f41fe8..905a64cb 100644 --- a/BLAS/SRC/scopy.f +++ b/BLAS/SRC/scopy.f @@ -27,42 +27,44 @@ INTRINSIC MOD * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments -* not equal to 1 -* - 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 - SY(IY) = SX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * * * clean-up loop * - 20 M = MOD(N,7) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - SY(I) = SX(I) - 30 CONTINUE - IF (N.LT.7) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,7 - SY(I) = SX(I) - SY(I+1) = SX(I+1) - SY(I+2) = SX(I+2) - SY(I+3) = SX(I+3) - SY(I+4) = SX(I+4) - SY(I+5) = SX(I+5) - SY(I+6) = SX(I+6) - 50 CONTINUE + M = MOD(N,7) + IF (M.NE.0) THEN + DO I = 1,M + SY(I) = SX(I) + END DO + IF (N.LT.7) RETURN + END IF + MP1 = M + 1 + DO I = MP1,N,7 + SY(I) = SX(I) + SY(I+1) = SX(I+1) + SY(I+2) = SX(I+2) + SY(I+3) = SX(I+3) + SY(I+4) = SX(I+4) + SY(I+5) = SX(I+5) + SY(I+6) = SX(I+6) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + SY(IY) = SX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/sdot.f b/BLAS/SRC/sdot.f index e0df5700..4629bbba 100644 --- a/BLAS/SRC/sdot.f +++ b/BLAS/SRC/sdot.f @@ -30,39 +30,43 @@ STEMP = 0.0e0 SDOT = 0.0e0 IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments -* not equal to 1 -* - 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 - STEMP = STEMP + SX(IX)*SY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - SDOT = STEMP - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * * * clean-up loop * - 20 M = MOD(N,5) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - STEMP = STEMP + SX(I)*SY(I) - 30 CONTINUE - IF (N.LT.5) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 + M = MOD(N,5) + IF (M.NE.0) THEN + DO I = 1,M + STEMP = STEMP + SX(I)*SY(I) + END DO + IF (N.LT.5) THEN + SDOT=STEMP + RETURN + END IF + END IF + MP1 = M + 1 + DO I = MP1,N,5 STEMP = STEMP + SX(I)*SY(I) + SX(I+1)*SY(I+1) + - + SX(I+2)*SY(I+2) + SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4) - 50 CONTINUE - 60 SDOT = STEMP + $ SX(I+2)*SY(I+2) + SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + STEMP = STEMP + SX(IX)*SY(IY) + IX = IX + INCX + IY = IY + INCY + END DO + END IF + SDOT = STEMP RETURN END diff --git a/BLAS/SRC/sdsdot.f b/BLAS/SRC/sdsdot.f index 5b9e6c41..b84a6c51 100644 --- a/BLAS/SRC/sdsdot.f +++ b/BLAS/SRC/sdsdot.f @@ -78,29 +78,32 @@ INTRINSIC DBLE * .. DSDOT = SB - IF (N.LE.0) GO TO 30 - IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40 + IF (N.LE.0) THEN + SDSDOT = DSDOT + RETURN + END IF + IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN * -* Code for unequal or nonpositive increments. +* Code for equal and positive increments. * - 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 + NS = N*INCX + DO I = 1,NS,INCX + DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) + END DO + ELSE * -* Code for equal and positive increments. +* Code for unequal or nonpositive increments. * - 40 NS = N*INCX - DO 50 I = 1,NS,INCX - DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) - 50 CONTINUE + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY + DO I = 1,N + DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) + KX = KX + INCX + KY = KY + INCY + END DO + END IF SDSDOT = DSDOT RETURN END diff --git a/BLAS/SRC/srot.f b/BLAS/SRC/srot.f index 5903b561..b53b0fdb 100644 --- a/BLAS/SRC/srot.f +++ b/BLAS/SRC/srot.f @@ -25,30 +25,31 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments not equal -* to 1 +* code for both increments equal to 1 * - 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 - STEMP = C*SX(IX) + S*SY(IY) - SY(IY) = C*SY(IY) - S*SX(IX) - SX(IX) = STEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + DO I = 1,N + STEMP = C*SX(I) + S*SY(I) + SY(I) = C*SY(I) - S*SX(I) + SX(I) = STEMP + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments not equal +* to 1 * - 20 DO 30 I = 1,N - STEMP = C*SX(I) + S*SY(I) - SY(I) = C*SY(I) - S*SX(I) - SX(I) = STEMP - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + STEMP = C*SX(IX) + S*SY(IY) + SY(IY) = C*SY(IY) - S*SX(IX) + SX(IX) = STEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/srotg.f b/BLAS/SRC/srotg.f index 4f2a8411..4f4258be 100644 --- a/BLAS/SRC/srotg.f +++ b/BLAS/SRC/srotg.f @@ -24,20 +24,21 @@ ROE = SB IF (ABS(SA).GT.ABS(SB)) ROE = SA SCALE = ABS(SA) + ABS(SB) - IF (SCALE.NE.0.0) GO TO 10 - C = 1.0 - S = 0.0 - R = 0.0 - Z = 0.0 - GO TO 20 - 10 R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2) - R = SIGN(1.0,ROE)*R - C = SA/R - S = SB/R - Z = 1.0 - IF (ABS(SA).GT.ABS(SB)) Z = S - IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C - 20 SA = R + IF (SCALE.EQ.0.0) THEN + C = 1.0 + S = 0.0 + R = 0.0 + Z = 0.0 + ELSE + R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2) + R = SIGN(1.0,ROE)*R + C = SA/R + S = SB/R + Z = 1.0 + IF (ABS(SA).GT.ABS(SB)) Z = S + IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C + END IF + SA = R SB = Z RETURN END diff --git a/BLAS/SRC/sscal.f b/BLAS/SRC/sscal.f index 312aeaf1..dd0a68d9 100644 --- a/BLAS/SRC/sscal.f +++ b/BLAS/SRC/sscal.f @@ -29,34 +29,36 @@ INTRINSIC MOD * .. IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 -* -* code for increment not equal to 1 -* - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - SX(I) = SA*SX(I) - 10 CONTINUE - RETURN + IF (INCX.EQ.1) THEN * * code for increment equal to 1 * * * clean-up loop * - 20 M = MOD(N,5) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - SX(I) = SA*SX(I) - 30 CONTINUE - IF (N.LT.5) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 - SX(I) = SA*SX(I) - SX(I+1) = SA*SX(I+1) - SX(I+2) = SA*SX(I+2) - SX(I+3) = SA*SX(I+3) - SX(I+4) = SA*SX(I+4) - 50 CONTINUE + M = MOD(N,5) + IF (M.NE.0) THEN + DO I = 1,M + SX(I) = SA*SX(I) + END DO + IF (N.LT.5) RETURN + END IF + MP1 = M + 1 + DO I = MP1,N,5 + SX(I) = SA*SX(I) + SX(I+1) = SA*SX(I+1) + SX(I+2) = SA*SX(I+2) + SX(I+3) = SA*SX(I+3) + SX(I+4) = SA*SX(I+4) + END DO + ELSE +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO I = 1,NINCX,INCX + SX(I) = SA*SX(I) + END DO + END IF RETURN END diff --git a/BLAS/SRC/sswap.f b/BLAS/SRC/sswap.f index 736d4974..e1a75f49 100644 --- a/BLAS/SRC/sswap.f +++ b/BLAS/SRC/sswap.f @@ -28,48 +28,50 @@ INTRINSIC MOD * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments not equal -* to 1 -* - 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 - STEMP = SX(IX) - SX(IX) = SY(IY) - SY(IY) = STEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * * * clean-up loop * - 20 M = MOD(N,3) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - STEMP = SX(I) - SX(I) = SY(I) - SY(I) = STEMP - 30 CONTINUE - IF (N.LT.3) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,3 - STEMP = SX(I) - SX(I) = SY(I) - SY(I) = STEMP - STEMP = SX(I+1) - SX(I+1) = SY(I+1) - SY(I+1) = STEMP - STEMP = SX(I+2) - SX(I+2) = SY(I+2) - SY(I+2) = STEMP - 50 CONTINUE + M = MOD(N,3) + IF (M.NE.0) THEN + DO I = 1,M + STEMP = SX(I) + SX(I) = SY(I) + SY(I) = STEMP + END DO + IF (N.LT.3) RETURN + END IF + MP1 = M + 1 + DO I = MP1,N,3 + STEMP = SX(I) + SX(I) = SY(I) + SY(I) = STEMP + STEMP = SX(I+1) + SX(I+1) = SY(I+1) + SY(I+1) = STEMP + STEMP = SX(I+2) + SX(I+2) = SY(I+2) + SY(I+2) = STEMP + END DO + ELSE +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + STEMP = SX(IX) + SX(IX) = SY(IY) + SY(IY) = STEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/zaxpy.f b/BLAS/SRC/zaxpy.f index b05d9d2b..fc32a86e 100644 --- a/BLAS/SRC/zaxpy.f +++ b/BLAS/SRC/zaxpy.f @@ -29,26 +29,28 @@ * .. IF (N.LE.0) RETURN IF (DCABS1(ZA).EQ.0.0d0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + ZY(I) = ZY(I) + ZA*ZX(I) + END DO + ELSE * * code for unequal increments or equal increments * not equal to 1 * - 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 - ZY(IY) = ZY(IY) + ZA*ZX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -* -* code for both increments equal to 1 + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZY(IY) = ZY(IY) + ZA*ZX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF * - 20 DO 30 I = 1,N - ZY(I) = ZY(I) + ZA*ZX(I) - 30 CONTINUE RETURN END diff --git a/BLAS/SRC/zcopy.f b/BLAS/SRC/zcopy.f index 793be5c5..49bf4aca 100644 --- a/BLAS/SRC/zcopy.f +++ b/BLAS/SRC/zcopy.f @@ -23,26 +23,27 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 -* -* code for unequal increments or equal increments -* not equal to 1 -* - 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 - ZY(IY) = ZX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 * - 20 DO 30 I = 1,N + DO I = 1,N ZY(I) = ZX(I) - 30 CONTINUE + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZY(IY) = ZX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END diff --git a/BLAS/SRC/zdotc.f b/BLAS/SRC/zdotc.f index b97cc41f..506ee9ef 100644 --- a/BLAS/SRC/zdotc.f +++ b/BLAS/SRC/zdotc.f @@ -29,28 +29,28 @@ ZTEMP = (0.0d0,0.0d0) ZDOTC = (0.0d0,0.0d0) IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments -* not equal to 1 +* code for both increments equal to 1 * - 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 = ZTEMP + DCONJG(ZX(IX))*ZY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - ZDOTC = ZTEMP - RETURN + DO I = 1,N + ZTEMP = ZTEMP + DCONJG(ZX(I))*ZY(I) + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments +* not equal to 1 * - 20 DO 30 I = 1,N - ZTEMP = ZTEMP + DCONJG(ZX(I))*ZY(I) - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZTEMP = ZTEMP + DCONJG(ZX(IX))*ZY(IY) + IX = IX + INCX + IY = IY + INCY + END DO + END IF ZDOTC = ZTEMP RETURN END diff --git a/BLAS/SRC/zdotu.f b/BLAS/SRC/zdotu.f index 4c6dc9bc..816b2014 100644 --- a/BLAS/SRC/zdotu.f +++ b/BLAS/SRC/zdotu.f @@ -26,28 +26,28 @@ ZTEMP = (0.0d0,0.0d0) ZDOTU = (0.0d0,0.0d0) IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments -* not equal to 1 +* code for both increments equal to 1 * - 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 = ZTEMP + ZX(IX)*ZY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - ZDOTU = ZTEMP - RETURN + DO I = 1,N + ZTEMP = ZTEMP + ZX(I)*ZY(I) + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments +* not equal to 1 * - 20 DO 30 I = 1,N - ZTEMP = ZTEMP + ZX(I)*ZY(I) - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZTEMP = ZTEMP + ZX(IX)*ZY(IY) + IX = IX + INCX + IY = IY + INCY + END DO + END IF ZDOTU = ZTEMP RETURN END diff --git a/BLAS/SRC/zdrot.f b/BLAS/SRC/zdrot.f index 3b946e99..20d04361 100644 --- a/BLAS/SRC/zdrot.f +++ b/BLAS/SRC/zdrot.f @@ -63,34 +63,33 @@ * IF( N.LE.0 ) $ RETURN - IF( INCX.EQ.1 .AND. INCY.EQ.1 ) - $ GO TO 20 + IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN * -* code for unequal increments or equal increments not equal -* to 1 +* code for both increments equal to 1 * - 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 + DO I = 1, N + CTEMP = C*CX( I ) + S*CY( I ) + CY( I ) = C*CY( I ) - S*CX( I ) + CX( I ) = CTEMP + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments not equal +* to 1 * - 20 CONTINUE - 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 + IX = 1 + IY = 1 + IF( INCX.LT.0 ) + $ IX = ( -N+1 )*INCX + 1 + IF( INCY.LT.0 ) + $ IY = ( -N+1 )*INCY + 1 + DO 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 + END DO + END IF RETURN END diff --git a/BLAS/SRC/zdscal.f b/BLAS/SRC/zdscal.f index aa0fa905..23030e10 100644 --- a/BLAS/SRC/zdscal.f +++ b/BLAS/SRC/zdscal.f @@ -22,27 +22,27 @@ * ===================================================================== * * .. Local Scalars .. - INTEGER I,IX + INTEGER I,NINCX * .. * .. Intrinsic Functions .. INTRINSIC DCMPLX * .. IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - DO 10 I = 1,N - ZX(IX) = DCMPLX(DA,0.0d0)*ZX(IX) - IX = IX + INCX - 10 CONTINUE - RETURN + DO I = 1,N + ZX(I) = DCMPLX(DA,0.0d0)*ZX(I) + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DO 30 I = 1,N - ZX(I) = DCMPLX(DA,0.0d0)*ZX(I) - 30 CONTINUE + NINCX = N*INCX + DO I = 1,NINCX,INCX + ZX(I) = DCMPLX(DA,0.0d0)*ZX(I) + END DO + END IF RETURN END diff --git a/BLAS/SRC/zrotg.f b/BLAS/SRC/zrotg.f index 99190c37..6656302f 100644 --- a/BLAS/SRC/zrotg.f +++ b/BLAS/SRC/zrotg.f @@ -18,19 +18,18 @@ * .. Intrinsic Functions .. INTRINSIC CDABS,DCMPLX,DCONJG,DSQRT * .. - IF (CDABS(CA).NE.0.0d0) GO TO 10 - C = 0.0d0 - S = (1.0d0,0.0d0) - CA = CB - GO TO 20 - 10 CONTINUE - SCALE = CDABS(CA) + CDABS(CB) - NORM = SCALE*DSQRT((CDABS(CA/DCMPLX(SCALE,0.0d0)))**2+ - + (CDABS(CB/DCMPLX(SCALE,0.0d0)))**2) - ALPHA = CA/CDABS(CA) - C = CDABS(CA)/NORM - S = ALPHA*DCONJG(CB)/NORM - CA = ALPHA*NORM - 20 CONTINUE + IF (CDABS(CA).EQ.0.0d0) THEN + C = 0.0d0 + S = (1.0d0,0.0d0) + CA = CB + ELSE + SCALE = CDABS(CA) + CDABS(CB) + NORM = SCALE*DSQRT((CDABS(CA/DCMPLX(SCALE,0.0d0)))**2+ + $ (CDABS(CB/DCMPLX(SCALE,0.0d0)))**2) + ALPHA = CA/CDABS(CA) + C = CDABS(CA)/NORM + S = ALPHA*DCONJG(CB)/NORM + CA = ALPHA*NORM + END IF RETURN END diff --git a/BLAS/SRC/zscal.f b/BLAS/SRC/zscal.f index 42fba167..a84c618a 100644 --- a/BLAS/SRC/zscal.f +++ b/BLAS/SRC/zscal.f @@ -22,24 +22,24 @@ * ===================================================================== * * .. Local Scalars .. - INTEGER I,IX + INTEGER I,NINCX * .. IF (N.LE.0 .OR. INCX.LE.0) RETURN - IF (INCX.EQ.1) GO TO 20 + IF (INCX.EQ.1) THEN * -* code for increment not equal to 1 +* code for increment equal to 1 * - IX = 1 - DO 10 I = 1,N - ZX(IX) = ZA*ZX(IX) - IX = IX + INCX - 10 CONTINUE - RETURN + DO I = 1,N + ZX(I) = ZA*ZX(I) + END DO + ELSE * -* code for increment equal to 1 +* code for increment not equal to 1 * - 20 DO 30 I = 1,N - ZX(I) = ZA*ZX(I) - 30 CONTINUE + NINCX = N*INCX + DO I = 1,NINCX,INCX + ZX(I) = ZA*ZX(I) + END DO + END IF RETURN END diff --git a/BLAS/SRC/zswap.f b/BLAS/SRC/zswap.f index 6ce8c09a..47894581 100644 --- a/BLAS/SRC/zswap.f +++ b/BLAS/SRC/zswap.f @@ -24,29 +24,30 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 + DO I = 1,N + ZTEMP = ZX(I) + ZX(I) = ZY(I) + ZY(I) = ZTEMP + END DO + ELSE * * code for unequal increments or equal increments not equal * to 1 * - 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 = ZX(IX) - ZX(IX) = ZY(IY) - ZY(IY) = ZTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -* -* code for both increments equal to 1 - 20 DO 30 I = 1,N - ZTEMP = ZX(I) - ZX(I) = ZY(I) - ZY(I) = ZTEMP - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZTEMP = ZX(IX) + ZX(IX) = ZY(IY) + ZY(IY) = ZTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END -- cgit v1.2.3