summaryrefslogtreecommitdiff
path: root/BLAS
diff options
context:
space:
mode:
authorjulie <julielangou@users.noreply.github.com>2011-03-10 23:33:40 +0000
committerjulie <julielangou@users.noreply.github.com>2011-03-10 23:33:40 +0000
commite9dac1f3c4684d925d3bfd5214125a89ef228e39 (patch)
tree2d0533814195d69c832daa63975e882f14104d34 /BLAS
parent1923c69f7e9857d19b67f9e9befd1b1f37c644ef (diff)
downloadlapack-e9dac1f3c4684d925d3bfd5214125a89ef228e39.tar.gz
lapack-e9dac1f3c4684d925d3bfd5214125a89ef228e39.tar.bz2
lapack-e9dac1f3c4684d925d3bfd5214125a89ef228e39.zip
Remove the easy GO TO statments....still 13 to remove in drotm.f and 36 in drotmg.f
Diffstat (limited to 'BLAS')
-rw-r--r--BLAS/SRC/caxpy.f34
-rw-r--r--BLAS/SRC/ccopy.f35
-rw-r--r--BLAS/SRC/cdotc.f36
-rw-r--r--BLAS/SRC/cdotu.f36
-rw-r--r--BLAS/SRC/crotg.f25
-rw-r--r--BLAS/SRC/cscal.f23
-rw-r--r--BLAS/SRC/csrot.f48
-rw-r--r--BLAS/SRC/csscal.f23
-rw-r--r--BLAS/SRC/cswap.f41
-rw-r--r--BLAS/SRC/dasum.f50
-rw-r--r--BLAS/SRC/daxpy.f56
-rw-r--r--BLAS/SRC/dcopy.f64
-rw-r--r--BLAS/SRC/ddot.f58
-rw-r--r--BLAS/SRC/drot.f43
-rw-r--r--BLAS/SRC/drotg.f29
-rw-r--r--BLAS/SRC/dscal.f48
-rw-r--r--BLAS/SRC/dsdot.f35
-rw-r--r--BLAS/SRC/dswap.f76
-rw-r--r--BLAS/SRC/dzasum.f27
-rw-r--r--BLAS/SRC/icamax.f41
-rw-r--r--BLAS/SRC/idamax.f41
-rw-r--r--BLAS/SRC/isamax.f41
-rw-r--r--BLAS/SRC/izamax.f43
-rw-r--r--BLAS/SRC/sasum.f50
-rw-r--r--BLAS/SRC/saxpy.f58
-rw-r--r--BLAS/SRC/scasum.f24
-rw-r--r--BLAS/SRC/scopy.f64
-rw-r--r--BLAS/SRC/sdot.f58
-rw-r--r--BLAS/SRC/sdsdot.f41
-rw-r--r--BLAS/SRC/srot.f43
-rw-r--r--BLAS/SRC/srotg.f29
-rw-r--r--BLAS/SRC/sscal.f48
-rw-r--r--BLAS/SRC/sswap.f76
-rw-r--r--BLAS/SRC/zaxpy.f34
-rw-r--r--BLAS/SRC/zcopy.f35
-rw-r--r--BLAS/SRC/zdotc.f36
-rw-r--r--BLAS/SRC/zdotu.f36
-rw-r--r--BLAS/SRC/zdrot.f49
-rw-r--r--BLAS/SRC/zdscal.f26
-rw-r--r--BLAS/SRC/zrotg.f27
-rw-r--r--BLAS/SRC/zscal.f26
-rw-r--r--BLAS/SRC/zswap.f41
42 files changed, 906 insertions, 848 deletions
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