Fix bug0023: SROTMG and DROTMG uses deprecated Fortran ASSIGN statement and assigned GOTO statement, actually fixed ROTM also

4 files changed, 64 insertions, 26 deletions

diff --git a/BLAS/SRC/drotm.f b/BLAS/SRC/drotm.f
index 63a3b113..25fea5a3 100644
--- a/BLAS/SRC/drotm.f
+++ b/BLAS/SRC/drotm.f
@@ -65,7 +65,13 @@
       IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
 *
       NSTEPS = N*INCX
-      IF (DFLAG) 50,10,30
+      IF (DFLAG.LT.ZERO) THEN
+         GO TO 50
+      ELSE IF (DFLAG.EQ.ZERO) THEN
+         GO TO 10 
+      ELSE
+         GO TO 30
+      END IF
    10 CONTINUE
       DH12 = DPARAM(4)
       DH21 = DPARAM(3)
@@ -104,7 +110,13 @@
       IF (INCX.LT.0) KX = 1 + (1-N)*INCX
       IF (INCY.LT.0) KY = 1 + (1-N)*INCY
 *
-      IF (DFLAG) 120,80,100
+      IF (DFLAG.LT.ZERO) THEN
+         GO TO 120
+      ELSE IF (DFLAG.EQ.ZERO) THEN
+         GO TO 80 
+      ELSE
+         GO TO 100
+      END IF
    80 CONTINUE
       DH12 = DPARAM(4)
       DH21 = DPARAM(3)
diff --git a/BLAS/SRC/drotmg.f b/BLAS/SRC/drotmg.f
index 3ae647b0..f257843f 100644
--- a/BLAS/SRC/drotmg.f
+++ b/BLAS/SRC/drotmg.f
@@ -33,9 +33,9 @@
 *
 *  DD1    (input/output) DOUBLE PRECISION
 *
-*  DD2    (input/output) DOUBLE PRECISION 
+*  DD2    (input/output) DOUBLE PRECISION
 *
-*  DX1    (input/output) DOUBLE PRECISION 
+*  DX1    (input/output) DOUBLE PRECISION
 *
 *  DY1    (input) DOUBLE PRECISION
 *
@@ -71,8 +71,8 @@
       IF (.NOT.DP2.EQ.ZERO) GO TO 20
       DFLAG = -TWO
       GO TO 260
-*     REGULAR-CASE..
    20 CONTINUE
+*     REGULAR-CASE..
       DP1 = DD1*DX1
       DQ2 = DP2*DY1
       DQ1 = DP1*DX1
@@ -108,8 +108,8 @@
       DX1 = DY1*DU
 *         GO SCALE-CHECK
       GO TO 100
-*     PROCEDURE..ZERO-H-D-AND-DX1..
    60 CONTINUE
+*     PROCEDURE..ZERO-H-D-AND-DX1..
       DFLAG = -ONE
       DH11 = ZERO
       DH12 = ZERO
@@ -121,8 +121,8 @@
       DX1 = ZERO
 *         RETURN..
       GO TO 220
-*     PROCEDURE..FIX-H..
    70 CONTINUE
+*     PROCEDURE..FIX-H..
       IF (.NOT.DFLAG.GE.ZERO) GO TO 90
 *
       IF (.NOT.DFLAG.EQ.ZERO) GO TO 80
@@ -135,13 +135,14 @@
       DH12 = ONE
       DFLAG = -ONE
    90 CONTINUE
-      GO TO IGO(120,150,180,210)
-*     PROCEDURE..SCALE-CHECK
+      GO TO (150,180,210) IGO
+      GO TO 120
   100 CONTINUE
+*     PROCEDURE..SCALE-CHECK
   110 CONTINUE
       IF (.NOT.DD1.LE.RGAMSQ) GO TO 130
       IF (DD1.EQ.ZERO) GO TO 160
-      ASSIGN 120 TO IGO
+      IGO = 0
 *              FIX-H..
       GO TO 70
   120 CONTINUE
@@ -153,7 +154,7 @@
   130 CONTINUE
   140 CONTINUE
       IF (.NOT.DD1.GE.GAMSQ) GO TO 160
-      ASSIGN 150 TO IGO
+      IGO = 1
 *              FIX-H..
       GO TO 70
   150 CONTINUE
@@ -166,7 +167,7 @@
   170 CONTINUE
       IF (.NOT.DABS(DD2).LE.RGAMSQ) GO TO 190
       IF (DD2.EQ.ZERO) GO TO 220
-      ASSIGN 180 TO IGO
+      IGO = 2
 *              FIX-H..
       GO TO 70
   180 CONTINUE
@@ -177,7 +178,7 @@
   190 CONTINUE
   200 CONTINUE
       IF (.NOT.DABS(DD2).GE.GAMSQ) GO TO 220
-      ASSIGN 210 TO IGO
+      IGO = 3
 *              FIX-H..
       GO TO 70
   210 CONTINUE
@@ -186,7 +187,13 @@
       DH22 = DH22*GAM
       GO TO 200
   220 CONTINUE
-      IF (DFLAG) 250,230,240
+      IF (DFLAG.LT.ZERO) THEN
+         GO TO 250
+      ELSE IF (DFLAG.EQ.ZERO) THEN
+         GO TO 230 
+      ELSE
+         GO TO 240
+      END IF
   230 CONTINUE
       DPARAM(3) = DH21
       DPARAM(4) = DH12
diff --git a/BLAS/SRC/srotm.f b/BLAS/SRC/srotm.f
index fc5a5933..dd378fcc 100644
--- a/BLAS/SRC/srotm.f
+++ b/BLAS/SRC/srotm.f
@@ -66,7 +66,13 @@
       IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
 *
       NSTEPS = N*INCX
-      IF (SFLAG) 50,10,30
+      IF (SFLAG.LT.ZERO) THEN
+         GO TO 50
+      ELSE IF (SFLAG.EQ.ZERO) THEN
+         GO TO 10
+      ELSE
+         GO TO 30
+      END IF
    10 CONTINUE
       SH12 = SPARAM(4)
       SH21 = SPARAM(3)
@@ -105,7 +111,13 @@
       IF (INCX.LT.0) KX = 1 + (1-N)*INCX
       IF (INCY.LT.0) KY = 1 + (1-N)*INCY
 *
-      IF (SFLAG) 120,80,100
+      IF (SFLAG.LT.ZERO) THEN
+         GO TO 120
+      ELSE IF (SFLAG.EQ.ZERO) THEN
+         GO TO 80
+      ELSE
+         GO TO 100
+      END IF
    80 CONTINUE
       SH12 = SPARAM(4)
       SH21 = SPARAM(3)
diff --git a/BLAS/SRC/srotmg.f b/BLAS/SRC/srotmg.f
index 7b3bd427..423160a5 100644
--- a/BLAS/SRC/srotmg.f
+++ b/BLAS/SRC/srotmg.f
@@ -73,8 +73,8 @@
       IF (.NOT.SP2.EQ.ZERO) GO TO 20
       SFLAG = -TWO
       GO TO 260
-*     REGULAR-CASE..
    20 CONTINUE
+*     REGULAR-CASE..
       SP1 = SD1*SX1
       SQ2 = SP2*SY1
       SQ1 = SP1*SX1
@@ -110,8 +110,8 @@
       SX1 = SY1*SU
 *         GO SCALE-CHECK
       GO TO 100
-*     PROCEDURE..ZERO-H-D-AND-SX1..
    60 CONTINUE
+*     PROCEDURE..ZERO-H-D-AND-SX1..
       SFLAG = -ONE
       SH11 = ZERO
       SH12 = ZERO
@@ -123,8 +123,8 @@
       SX1 = ZERO
 *         RETURN..
       GO TO 220
-*     PROCEDURE..FIX-H..
    70 CONTINUE
+*     PROCEDURE..FIX-H..
       IF (.NOT.SFLAG.GE.ZERO) GO TO 90
 *
       IF (.NOT.SFLAG.EQ.ZERO) GO TO 80
@@ -137,13 +137,14 @@
       SH12 = ONE
       SFLAG = -ONE
    90 CONTINUE
-      GO TO IGO(120,150,180,210)
-*     PROCEDURE..SCALE-CHECK
+      GO TO (150,180,210) IGO
+      GO TO 120
   100 CONTINUE
+*     PROCEDURE..SCALE-CHECK
   110 CONTINUE
       IF (.NOT.SD1.LE.RGAMSQ) GO TO 130
       IF (SD1.EQ.ZERO) GO TO 160
-      ASSIGN 120 TO IGO
+      IGO = 0
 *              FIX-H..
       GO TO 70
   120 CONTINUE
@@ -155,7 +156,7 @@
   130 CONTINUE
   140 CONTINUE
       IF (.NOT.SD1.GE.GAMSQ) GO TO 160
-      ASSIGN 150 TO IGO
+      IGO = 1
 *              FIX-H..
       GO TO 70
   150 CONTINUE
@@ -168,7 +169,7 @@
   170 CONTINUE
       IF (.NOT.ABS(SD2).LE.RGAMSQ) GO TO 190
       IF (SD2.EQ.ZERO) GO TO 220
-      ASSIGN 180 TO IGO
+      IGO = 2
 *              FIX-H..
       GO TO 70
   180 CONTINUE
@@ -179,7 +180,7 @@
   190 CONTINUE
   200 CONTINUE
       IF (.NOT.ABS(SD2).GE.GAMSQ) GO TO 220
-      ASSIGN 210 TO IGO
+      IGO = 3
 *              FIX-H..
       GO TO 70
   210 CONTINUE
@@ -188,7 +189,13 @@
       SH22 = SH22*GAM
       GO TO 200
   220 CONTINUE
-      IF (SFLAG) 250,230,240
+      IF (SFLAG.LT.ZERO) THEN
+         GO TO 250
+      ELSE IF (SFLAG.EQ.ZERO) THEN
+         GO TO 230
+      ELSE 
+         GO TO 240
+      END IF
   230 CONTINUE
       SPARAM(3) = SH21
       SPARAM(4) = SH12