Remove GOTO statment in iparam2stage.F

1 files changed, 138 insertions, 140 deletions

diff --git a/SRC/iparam2stage.F b/SRC/iparam2stage.F
index 6443f16e..e725a0ce 100644
--- a/SRC/iparam2stage.F
+++ b/SRC/iparam2stage.F
@@ -199,132 +199,131 @@
 !$OMP END PARALLEL
 #endif
 *      WRITE(*,*) 'IPARAM VOICI NTHREADS ISPEC ',NTHREADS, ISPEC
-      IF( ISPEC.EQ.19 ) GOTO 19
 *
-*     Convert NAME to upper case if the first character is lower case.
-*
-      IPARAM2STAGE = -1
-      SUBNAM = NAME
-      IC = ICHAR( SUBNAM( 1: 1 ) )
-      IZ = ICHAR( 'Z' )
-      IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
-*
-*        ASCII character set
-*
-         IF( IC.GE.97 .AND. IC.LE.122 ) THEN
-            SUBNAM( 1: 1 ) = CHAR( IC-32 )
-            DO 100 I = 2, 12
-               IC = ICHAR( SUBNAM( I: I ) )
-               IF( IC.GE.97 .AND. IC.LE.122 )
-     $            SUBNAM( I: I ) = CHAR( IC-32 )
-  100       CONTINUE
+      IF( ISPEC .NE. 19 ) THEN
+*
+*        Convert NAME to upper case if the first character is lower case.
+*
+         IPARAM2STAGE = -1
+         SUBNAM = NAME
+         IC = ICHAR( SUBNAM( 1: 1 ) )
+         IZ = ICHAR( 'Z' )
+         IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
+*
+*           ASCII character set
+*
+            IF( IC.GE.97 .AND. IC.LE.122 ) THEN
+               SUBNAM( 1: 1 ) = CHAR( IC-32 )
+               DO 100 I = 2, 12
+                  IC = ICHAR( SUBNAM( I: I ) )
+                  IF( IC.GE.97 .AND. IC.LE.122 )
+     $               SUBNAM( I: I ) = CHAR( IC-32 )
+  100          CONTINUE
+            END IF
+*
+         ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
+*
+*           EBCDIC character set
+*
+            IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
+     $          ( IC.GE.145 .AND. IC.LE.153 ) .OR.
+     $          ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
+               SUBNAM( 1: 1 ) = CHAR( IC+64 )
+               DO 110 I = 2, 12
+                  IC = ICHAR( SUBNAM( I: I ) )
+                  IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
+     $                ( IC.GE.145 .AND. IC.LE.153 ) .OR.
+     $                ( IC.GE.162 .AND. IC.LE.169 ) )SUBNAM( I:
+     $                I ) = CHAR( IC+64 )
+  110          CONTINUE
+            END IF
+*
+         ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
+*
+*           Prime machines:  ASCII+128
+*
+            IF( IC.GE.225 .AND. IC.LE.250 ) THEN
+               SUBNAM( 1: 1 ) = CHAR( IC-32 )
+               DO 120 I = 2, 12
+                 IC = ICHAR( SUBNAM( I: I ) )
+                 IF( IC.GE.225 .AND. IC.LE.250 )
+     $             SUBNAM( I: I ) = CHAR( IC-32 )
+  120          CONTINUE
+            END IF
          END IF
 *
-      ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
-*
-*        EBCDIC character set
-*
-         IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
-     $       ( IC.GE.145 .AND. IC.LE.153 ) .OR.
-     $       ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
-            SUBNAM( 1: 1 ) = CHAR( IC+64 )
-            DO 110 I = 2, 12
-               IC = ICHAR( SUBNAM( I: I ) )
-               IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
-     $             ( IC.GE.145 .AND. IC.LE.153 ) .OR.
-     $             ( IC.GE.162 .AND. IC.LE.169 ) )SUBNAM( I:
-     $             I ) = CHAR( IC+64 )
-  110       CONTINUE
-         END IF
-*
-      ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
-*
-*        Prime machines:  ASCII+128
+         PREC  = SUBNAM( 1: 1 )
+         ALGO  = SUBNAM( 4: 6 )
+         STAG  = SUBNAM( 8:12 )
+         RPREC = PREC.EQ.'S' .OR. PREC.EQ.'D'
+         CPREC = PREC.EQ.'C' .OR. PREC.EQ.'Z'
 *
-         IF( IC.GE.225 .AND. IC.LE.250 ) THEN
-            SUBNAM( 1: 1 ) = CHAR( IC-32 )
-            DO 120 I = 2, 12
-               IC = ICHAR( SUBNAM( I: I ) )
-               IF( IC.GE.225 .AND. IC.LE.250 )
-     $            SUBNAM( I: I ) = CHAR( IC-32 )
-  120       CONTINUE
-         END IF
-      END IF
-*
-      PREC  = SUBNAM( 1: 1 )
-      ALGO  = SUBNAM( 4: 6 )
-      STAG  = SUBNAM( 8:12 )
-      RPREC = PREC.EQ.'S' .OR. PREC.EQ.'D'
-      CPREC = PREC.EQ.'C' .OR. PREC.EQ.'Z'
-*
-*     Invalid value for PRECISION
+*        Invalid value for PRECISION
 *      
-      IF( .NOT.( RPREC .OR. CPREC ) ) THEN
-          IPARAM2STAGE = -1
-          RETURN
+         IF( .NOT.( RPREC .OR. CPREC ) ) THEN
+             IPARAM2STAGE = -1
+             RETURN
+         ENDIF
       ENDIF
 *      WRITE(*,*),'RPREC,CPREC ',RPREC,CPREC,
 *     $           '   ALGO ',ALGO,'    STAGE ',STAG
 *      
-      GO TO ( 17, 17, 19, 20, 21 ) ISPEC-16
 *
-   17 CONTINUE
+      IF (( ISPEC .EQ. 17 ) .OR. ( ISPEC .EQ. 18 )) THEN 
 *
 *     ISPEC = 17, 18:  block size KD, IB
 *     Could be also dependent from N but for now it
 *     depend only on sequential or parallel
 *
-      IF( NTHREADS.GT.4 ) THEN
-          IF( CPREC ) THEN
-              KD = 128
-              IB = 32
-          ELSE
-              KD = 160
-              IB = 40
-          ENDIF
-      ELSE IF( NTHREADS.GT.1 ) THEN
-          IF( CPREC ) THEN
-              KD = 64
-              IB = 32
-          ELSE
-              KD = 64
-              IB = 32
-          ENDIF
-      ELSE
-          IF( CPREC ) THEN
-              KD = 16
-              IB = 16
-          ELSE
-              KD = 32
-              IB = 16
-          ENDIF
-      ENDIF
-      IF( ISPEC.EQ.17 ) IPARAM2STAGE = KD
-      IF( ISPEC.EQ.18 ) IPARAM2STAGE = IB
-      RETURN
-*
-   19 CONTINUE
+         IF( NTHREADS.GT.4 ) THEN
+            IF( CPREC ) THEN
+               KD = 128
+               IB = 32
+            ELSE
+               KD = 160
+               IB = 40
+            ENDIF
+         ELSE IF( NTHREADS.GT.1 ) THEN
+            IF( CPREC ) THEN
+               KD = 64
+               IB = 32
+            ELSE
+               KD = 64
+               IB = 32
+            ENDIF
+         ELSE
+            IF( CPREC ) THEN
+               KD = 16
+               IB = 16
+            ELSE
+               KD = 32
+               IB = 16
+            ENDIF
+         ENDIF
+         IF( ISPEC.EQ.17 ) IPARAM2STAGE = KD
+         IF( ISPEC.EQ.18 ) IPARAM2STAGE = IB
+*
+      ELSE IF ( ISPEC .EQ. 19 ) THEN
 *
 *     ISPEC = 19:  
 *     LHOUS length of the Houselholder representation
 *     matrix (V,T) of the second stage. should be >= 1.
 *
 *     Will add the VECT OPTION HERE next release
-      VECT  = OPTS(1:1)
-      IF( VECT.EQ.'N' ) THEN
-          LHOUS = MAX( 1, 4*NI )
-      ELSE
-*         This is not correct, it need to call the ALGO and the stage2
-          LHOUS = MAX( 1, 4*NI ) + IBI
-      ENDIF
-      IF( LHOUS.GE.0 ) THEN
-          IPARAM2STAGE = LHOUS
-      ELSE
-          IPARAM2STAGE = -1
-      ENDIF
-      RETURN
-*
-   20 CONTINUE
+         VECT  = OPTS(1:1)
+         IF( VECT.EQ.'N' ) THEN
+            LHOUS = MAX( 1, 4*NI )
+         ELSE
+*           This is not correct, it need to call the ALGO and the stage2
+            LHOUS = MAX( 1, 4*NI ) + IBI
+         ENDIF
+         IF( LHOUS.GE.0 ) THEN
+            IPARAM2STAGE = LHOUS
+         ELSE
+            IPARAM2STAGE = -1
+         ENDIF
+*
+      ELSE IF ( ISPEC .EQ. 20 ) THEN
 *
 *     ISPEC = 20: (21 for future use)  
 *     LWORK length of the workspace for 
@@ -339,49 +338,48 @@
 *                  = N*KD + N*max(KD+1,FACTOPTNB) 
 *                    + max(2*KD*KD, KD*NTHREADS) 
 *                    + (KD+1)*N
-      LWORK        = -1
-      SUBNAM(1:1)  = PREC
-      SUBNAM(2:6)  = 'GEQRF'
-      QROPTNB      = ILAENV( 1, SUBNAM, ' ', NI, NBI, -1, -1 )
-      SUBNAM(2:6)  = 'GELQF'
-      LQOPTNB      = ILAENV( 1, SUBNAM, ' ', NBI, NI, -1, -1 )
-*     Could be QR or LQ for TRD and the max for BRD
-      FACTOPTNB    = MAX(QROPTNB, LQOPTNB)
-      IF( ALGO.EQ.'TRD' ) THEN
-          IF( STAG.EQ.'2STAG' ) THEN
-              LWORK = NI*NBI + NI*MAX(NBI+1,FACTOPTNB) 
+         LWORK        = -1
+         SUBNAM(1:1)  = PREC
+         SUBNAM(2:6)  = 'GEQRF'
+         QROPTNB      = ILAENV( 1, SUBNAM, ' ', NI, NBI, -1, -1 )
+         SUBNAM(2:6)  = 'GELQF'
+         LQOPTNB      = ILAENV( 1, SUBNAM, ' ', NBI, NI, -1, -1 )
+*        Could be QR or LQ for TRD and the max for BRD
+         FACTOPTNB    = MAX(QROPTNB, LQOPTNB)
+         IF( ALGO.EQ.'TRD' ) THEN
+            IF( STAG.EQ.'2STAG' ) THEN
+               LWORK = NI*NBI + NI*MAX(NBI+1,FACTOPTNB) 
      $              + MAX(2*NBI*NBI, NBI*NTHREADS) 
      $              + (NBI+1)*NI
-          ELSE IF( (STAG.EQ.'HE2HB').OR.(STAG.EQ.'SY2SB') ) THEN
-              LWORK = NI*NBI + NI*MAX(NBI,FACTOPTNB) + 2*NBI*NBI
-          ELSE IF( (STAG.EQ.'HB2ST').OR.(STAG.EQ.'SB2ST') ) THEN
-              LWORK = (2*NBI+1)*NI + NBI*NTHREADS
-          ENDIF
-      ELSE IF( ALGO.EQ.'BRD' ) THEN
-          IF( STAG.EQ.'2STAG' ) THEN
-              LWORK = 2*NI*NBI + NI*MAX(NBI+1,FACTOPTNB) 
+            ELSE IF( (STAG.EQ.'HE2HB').OR.(STAG.EQ.'SY2SB') ) THEN
+               LWORK = NI*NBI + NI*MAX(NBI,FACTOPTNB) + 2*NBI*NBI
+            ELSE IF( (STAG.EQ.'HB2ST').OR.(STAG.EQ.'SB2ST') ) THEN
+               LWORK = (2*NBI+1)*NI + NBI*NTHREADS
+            ENDIF
+         ELSE IF( ALGO.EQ.'BRD' ) THEN
+            IF( STAG.EQ.'2STAG' ) THEN
+               LWORK = 2*NI*NBI + NI*MAX(NBI+1,FACTOPTNB) 
      $              + MAX(2*NBI*NBI, NBI*NTHREADS) 
      $              + (NBI+1)*NI
-          ELSE IF( STAG.EQ.'GE2GB' ) THEN
-              LWORK = NI*NBI + NI*MAX(NBI,FACTOPTNB) + 2*NBI*NBI
-          ELSE IF( STAG.EQ.'GB2BD' ) THEN
-              LWORK = (3*NBI+1)*NI + NBI*NTHREADS
-          ENDIF
-      ENDIF
-      LWORK = MAX ( 1, LWORK )
+            ELSE IF( STAG.EQ.'GE2GB' ) THEN
+               LWORK = NI*NBI + NI*MAX(NBI,FACTOPTNB) + 2*NBI*NBI
+            ELSE IF( STAG.EQ.'GB2BD' ) THEN
+               LWORK = (3*NBI+1)*NI + NBI*NTHREADS
+            ENDIF
+         ENDIF
+         LWORK = MAX ( 1, LWORK )
 
-      IF( LWORK.GT.0 ) THEN
-          IPARAM2STAGE = LWORK
-      ELSE
-          IPARAM2STAGE = -1
-      ENDIF
-      RETURN
+         IF( LWORK.GT.0 ) THEN
+            IPARAM2STAGE = LWORK
+         ELSE
+            IPARAM2STAGE = -1
+         ENDIF
 *
-   21 CONTINUE
+      ELSE IF ( ISPEC .EQ. 21 ) THEN
 *
 *     ISPEC = 21 for future use 
-      IPARAM2STAGE = NXI
-      RETURN
+         IPARAM2STAGE = NXI
+      ENDIF
 *
 *     ==== End of IPARAM2STAGE ====
 *