diff --git a/BLAS/SRC/cscal.f b/BLAS/SRC/cscal.f
index b72c08e74c..411098835c 100644
--- a/BLAS/SRC/cscal.f
+++ b/BLAS/SRC/cscal.f
@@ -93,7 +93,11 @@ SUBROUTINE CSCAL(N,CA,CX,INCX)
 *     .. Local Scalars ..
       INTEGER I,NINCX
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. CA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
diff --git a/BLAS/SRC/csscal.f b/BLAS/SRC/csscal.f
index 5c4da6d8db..b9a8ca5522 100644
--- a/BLAS/SRC/csscal.f
+++ b/BLAS/SRC/csscal.f
@@ -93,10 +93,14 @@ SUBROUTINE CSSCAL(N,SA,CX,INCX)
 *     .. Local Scalars ..
       INTEGER I,NINCX
 *     ..
+*     .. Parameters ..
+      REAL ONE
+      PARAMETER (ONE=1.0E+0)
+*     ..
 *     .. Intrinsic Functions ..
       INTRINSIC AIMAG,CMPLX,REAL
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. SA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
diff --git a/BLAS/SRC/dscal.f b/BLAS/SRC/dscal.f
index 3713427334..e055d198af 100644
--- a/BLAS/SRC/dscal.f
+++ b/BLAS/SRC/dscal.f
@@ -93,11 +93,14 @@ SUBROUTINE DSCAL(N,DA,DX,INCX)
 *
 *     .. Local Scalars ..
       INTEGER I,M,MP1,NINCX
+*     .. Parameters ..
+      DOUBLE PRECISION ONE
+      PARAMETER (ONE=1.0D+0)
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC MOD
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. DA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
diff --git a/BLAS/SRC/sscal.f b/BLAS/SRC/sscal.f
index 7d52c4253f..44d0437968 100644
--- a/BLAS/SRC/sscal.f
+++ b/BLAS/SRC/sscal.f
@@ -94,10 +94,14 @@ SUBROUTINE SSCAL(N,SA,SX,INCX)
 *     .. Local Scalars ..
       INTEGER I,M,MP1,NINCX
 *     ..
+*     .. Parameters ..
+      REAL ONE
+      PARAMETER (ONE=1.0E+0)
+*     ..
 *     .. Intrinsic Functions ..
       INTRINSIC MOD
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. SA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
diff --git a/BLAS/SRC/zdscal.f b/BLAS/SRC/zdscal.f
index b3546ba206..5a16048771 100644
--- a/BLAS/SRC/zdscal.f
+++ b/BLAS/SRC/zdscal.f
@@ -92,17 +92,20 @@ SUBROUTINE ZDSCAL(N,DA,ZX,INCX)
 *
 *     .. Local Scalars ..
       INTEGER I,NINCX
+*     .. Parameters ..
+      DOUBLE PRECISION ONE
+      PARAMETER (ONE=1.0D+0)
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC DCMPLX
+      INTRINSIC DBLE, DCMPLX, DIMAG
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. DA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
 *
          DO I = 1,N
-            ZX(I) = DCMPLX(DA,0.0d0)*ZX(I)
+            ZX(I) = DCMPLX(DA*DBLE(ZX(I)),DA*DIMAG(ZX(I)))
          END DO
       ELSE
 *
@@ -110,7 +113,7 @@ SUBROUTINE ZDSCAL(N,DA,ZX,INCX)
 *
          NINCX = N*INCX
          DO I = 1,NINCX,INCX
-            ZX(I) = DCMPLX(DA,0.0d0)*ZX(I)
+            ZX(I) = DCMPLX(DA*DBLE(ZX(I)),DA*DIMAG(ZX(I)))
          END DO
       END IF
       RETURN
diff --git a/BLAS/SRC/zscal.f b/BLAS/SRC/zscal.f
index 8085f5a399..8b8c2c8ab5 100644
--- a/BLAS/SRC/zscal.f
+++ b/BLAS/SRC/zscal.f
@@ -93,7 +93,11 @@ SUBROUTINE ZSCAL(N,ZA,ZX,INCX)
 *     .. Local Scalars ..
       INTEGER I,NINCX
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+*     .. Parameters ..
+      COMPLEX*16 ONE
+      PARAMETER (ONE= (1.0D+0,0.0D+0))
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. ZA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
diff --git a/SRC/clascl.f b/SRC/clascl.f
index 399af23a4b..f9aace0bc4 100644
--- a/SRC/clascl.f
+++ b/SRC/clascl.f
@@ -272,6 +272,8 @@ SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *
diff --git a/SRC/dlascl.f b/SRC/dlascl.f
index 05ad1c4f3c..0a4bf21ce1 100644
--- a/SRC/dlascl.f
+++ b/SRC/dlascl.f
@@ -272,6 +272,8 @@ SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *
diff --git a/SRC/slascl.f b/SRC/slascl.f
index e1cb420ea9..28cbd6514b 100644
--- a/SRC/slascl.f
+++ b/SRC/slascl.f
@@ -272,6 +272,8 @@ SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *
diff --git a/SRC/zlascl.f b/SRC/zlascl.f
index 3d53f5ae60..4cce5ff5e0 100644
--- a/SRC/zlascl.f
+++ b/SRC/zlascl.f
@@ -272,6 +272,8 @@ SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
          ELSE
             MUL = CTOC / CFROMC
             DONE = .TRUE.
+            IF (MUL .EQ. ONE)
+     $         RETURN
          END IF
       END IF
 *