Go To Statement Considered Harmful: Fortran examples

ivanpribec · November 7, 2023, 12:53am

I bet many of you have heard of the famous “consider harmful” article (PDF, 609 KB) from Edsger W. Dijkstra. Luckily, Fortran has come a long way since those days, and now has good support for structured programming making go to obsolete more or less. (The Craft of Coding blog has several insightful essays on go to.)

So what’s the purpose of this thread? Use this thread to share the worst cases of GOTO out in the wild. Nasty snippets using arithmetic if are also allowed.

Image source: The Craft of Coding - Is goto evil?

We are looking for the go to’s that deserve Dijkstra’s criticism; the ones which suck all the joy out of reading code . The more -like and hard to refactor the better. Feel free to also share pretty re-engineered (untangled) snippets, in case you have them.

You can think of this thread as a kind of memorial - a place of contemplation and warning , similar to the memorials erected after wars or the plague . Simultaneously, it’s also a tribute to the ingenious Fortran programmers who did the best they could with what was available.

To start off the thread, here is a snippet I’m currently trying to untangle from a sparse LU factorization routine,

      if(iflag(4).ne.1)go to 480
      if(lfr.gt.ha(r1,9))ha(r1,9)=lfr
      if(lfc.gt.ha(r2,10))ha(r2,10)=lfc
  480 if(i1.eq.1)go to 490
      if(snr(i1-1).eq.0)go to 600
  490 if(rr2.eq.nn)go to 500
      if(snr(rr2+1).eq.0)go to 580
  500 r10=nn-lfr
C     
C ... 60 lines later ...
C     
      go to 590
  580 rr2=rr2+1
      ha(r1,3)=rr2
      l1=rr2
      if(rr2.le.r4)go to 610
  590 r4=rr2
      if(r4.lt.nn)snr(r4+1)=0
      go to 610
  600 rr1=rr1-1
      i1=i1-1
      ha(r1,1)=i1
      ha(r1,2)=rr1
      l1=rr1
      snr(i1)=snr(l1)
      a(i1)=a(l1)
  610 a(l1)=tol3

everythingfunctional · November 7, 2023, 2:55am

I not too long ago refactored a pretty gnarly implementation of Forsythe’s method for sampling from a normal distribution. Page 935 in the following paper:

I’ll see if I can get permission to share the before and after.

rwmsu · November 7, 2023, 3:33am

Several years ago I came across one of the occasional discussions / flame wars online about the evils of GO TO. Linus Torvald joined the discussion and basically said GO TO in and of itself was not necessarily evil, it was how it was implemented in some languages. I presume he was thinking about Fortran (or FORTRAN) and its numerical only statement labels. I agree that if at all possible, GO TO in all its forms should be avoided. However, I still find there is one instance (jumping to the end of a code to do error/exit processing) that it is a simpler solution than the alternatives even if it is “evil”. I’ve always believed that GO TO would be much more palatable if we could use alpha-numeric statement labels ala

GO TO error_handler
.
.
.
error_handler: print some stuff and then return/exit

Sadly, I’m not naive enough to think that will ever be implemented

rwmsu · November 7, 2023, 3:52am

I’ll throw this out since I recently went through the exercise of refactoring it but Hiroshi Akima’s original univariate interpolation code has some interesting GO TO challenges. See the Supplemental material link at:

jacobwilliams · November 7, 2023, 3:57am

Some of the worst spaghetti I’ve ever seen is in the MATH77 library. Here’s a sample:

c     **** Check integration order control (KGO=3) and
c     **** error tolerance equation grouping (KGO=4).
         if (J - NTE) 500, 565, 620
  500    if (J) 510, 530, 540
  510    if ((JL .le. 0) .and. (IHI .ne. ILOW)) go to 620
         if (J .lt. JLIM) then
c                         Output an error message.
            IDAT(2) = JLIM
            IDAT(3) = 0
            go to 630
         end if
  520    JL = -JL
         go to 560
  530    if (KGO .eq. 3) go to 520
         KFERR = NTOLF + IHI - ILOW
         if (F(KFERR) .eq. CM1) go to 510
c                         Set up error message, TOL must be -1.
            IDAT(1) = KFERR
            KGO = 11
            go to 650
  540    if (abs(JL) .ge. abs(J)) go to 620
  550    JL = J
  560    continue
  565 NXTCHK = NXTCHK + 3
      INTCHK(NXTCHK-2) = ILOW
      INTCHK(NXTCHK-1) = IHI - ILOW + 1
      go to (30, 110, 120, 150), KGO
c
c     **** AN ERROR HAS BEEN MADE
c                  Error in setting up TSPECS for extra output
  600 IHI = IHI + 2
  610 ILOW = -IOP5
      go to 630
c                  Error in KORD indices
  620 IDAT(2) = abs(JL) + 1
      IDAT(3) = NTE
c                  Set up for print of message about KORD
  630 IDAT(1) = INTCHK(NXTCHK)
  640 IDAT(4) = IHI
      IDAT(5) = KORD(IHI)
c
c ***************** Process Errors *************************************
c
  650 KORD2I = -4
      MACT(4) = LTXTAF
      if (KGO .ge. 8) MACT(4) = -1
      MACT(6) = MLOC(KGO)
c--D Next line special: P=>S, X=>D
      CALL DMESS(MACT, MTXTAA, IDAT, FDAT)
      if (KGO .lt. 8) then
         MACT(10) = ILOW
         MACT(13) = ILOW
         MACT(15) = -min(IHI+2, IDIMK)
         CALL MESS(MACT(9), MTXTAB, KORD)
         if (KGO .le. 4) go to 565
      end if
c              5   6   7    8    9   10   11  12
      go to (100, 25, 25, 320, 100, 150, 660, 25), KGO - 4
  660 KGO = 4
      go to 565
      endc     **** Check integration order control (KGO=3) and
c     **** error tolerance equation grouping (KGO=4).
         if (J - NTE) 500, 565, 620
  500    if (J) 510, 530, 540
  510    if ((JL .le. 0) .and. (IHI .ne. ILOW)) go to 620
         if (J .lt. JLIM) then
c                         Output an error message.
            IDAT(2) = JLIM
            IDAT(3) = 0
            go to 630
         end if
  520    JL = -JL
         go to 560
  530    if (KGO .eq. 3) go to 520
         KFERR = NTOLF + IHI - ILOW
         if (F(KFERR) .eq. CM1) go to 510
c                         Set up error message, TOL must be -1.
            IDAT(1) = KFERR
            KGO = 11
            go to 650
  540    if (abs(JL) .ge. abs(J)) go to 620
  550    JL = J
  560    continue
  565 NXTCHK = NXTCHK + 3
      INTCHK(NXTCHK-2) = ILOW
      INTCHK(NXTCHK-1) = IHI - ILOW + 1
      go to (30, 110, 120, 150), KGO
c
c     **** AN ERROR HAS BEEN MADE
c                  Error in setting up TSPECS for extra output
  600 IHI = IHI + 2
  610 ILOW = -IOP5
      go to 630
c                  Error in KORD indices
  620 IDAT(2) = abs(JL) + 1
      IDAT(3) = NTE
c                  Set up for print of message about KORD
  630 IDAT(1) = INTCHK(NXTCHK)
  640 IDAT(4) = IHI
      IDAT(5) = KORD(IHI)
c
c ***************** Process Errors *************************************
c
  650 KORD2I = -4
      MACT(4) = LTXTAF
      if (KGO .ge. 8) MACT(4) = -1
      MACT(6) = MLOC(KGO)
c--D Next line special: P=>S, X=>D
      CALL DMESS(MACT, MTXTAA, IDAT, FDAT)
      if (KGO .lt. 8) then
         MACT(10) = ILOW
         MACT(13) = ILOW
         MACT(15) = -min(IHI+2, IDIMK)
         CALL MESS(MACT(9), MTXTAB, KORD)
         if (KGO .le. 4) go to 565
      end if
c              5   6   7    8    9   10   11  12
      go to (100, 25, 25, 320, 100, 150, 660, 25), KGO - 4
  660 KGO = 4
      go to 565
      end

ivanpribec · November 7, 2023, 4:12am

I’ve wondered myself why aren’t jumps to named constructs supported.

The jump could go to any block construct including do, if, and select case:

return 

error_handler: if (warn)
   write(error_unit,*) "An error occured"
else
   error stop
end if error_handler

MarDie · November 7, 2023, 6:43am

This is off-topic, but I can’t (or don’t know to) start a new thread:

Are you familiar with the sampling methods? I use the Box–Muller transform (Box–Muller transform - Wikipedia and Random numbers) and was wondering whether it has any disadvantages.

vmagnin · November 7, 2023, 8:37am

GOTO is JUMP/JMP,
GOTO is assembly language, the language of the machine,
GOTO is testing, looping, subroutines and functions,
GOTO is therefore one of the greatest inventions of all times,
the core of computer science,
and as such it deserves the deepest respect
(that kind of deep respect that make you keep your distance )

Arjen · November 7, 2023, 9:59am

It feels a bit respectless to call the routine below spaghetti or a bad example of GOTO use, as it comes from our code base and has been in use for several decades for good reasons. It is rather compact, though and to give some statistics:

I removed the comments (to make it even more terse), so that it is now 173 lines
I counted 26 GOTO statements

The routine solves a system of linear equations, where the matrix is a band matrix. Here is the source:

      SUBROUTINE INVMAT (N,NUC,NLC,M,A,B,IOPT)

      REAL :: A(*), B(*)

      integer NUC, NLC, N, NMUC, NMLC, NDM1, ND, N1
      integer L1, L2, L3, L4, L5
      integer K1, K2, K3, K4, K5, K6
      integer M, IOPT

      real F, P

      NMUC = N - NUC
      NMLC = N - NLC
      NDM1 = NUC + NLC
      ND   = NDM1 + 1
      IF (IOPT.EQ.2) GOTO 1000

      K1 = NLC + 1
      L1 = K1 + NMLC*ND
  100 P  = A(K1)
      IF ( ABS(P) .LT. 1.0E-35 ) THEN
          WRITE(6, '('' Matrix singular at element:'',I5)')
     *          K1/ND + 1
          STOP
      ENDIF

      K2 = K1
      L2 = K1 + NLC*NDM1
  200 K2 = K2 + NDM1
      F  = A(K2)/P
      A(K2) = F
      K3 = K1

      K4 = K2
      L4 = K2 + NUC
  300 K3 = K3 + 1
      K4 = K4 + 1
      A(K4) = A(K4) - F * A(K3)

      IF (K4.LT.L4) GOTO 300
      IF (K2.LT.L2) GOTO 200
      K1 = K1 + ND
      IF (K1.LT.L1) GOTO 100
      IF (NLC.EQ.1) GOTO 700

      N1 = NLC
      L1 = (N-1) * ND
  400 N1 = N1 - 1
      P  = A(K1)
      IF ( ABS(P) .LT. 1.0E-35 ) THEN
         WRITE(6,'('' Matrix singular at element:'',I5)')
     *         K1/ND + 1
         STOP
      ENDIF
      K2 = K1
      L2 = K1 + N1*NDM1
  500 K2 = K2 + NDM1
      F  = A(K2)/P
      A(K2) = F
      K3 = K1
      K4 = K2
      L4 = K2 + NUC
  600 K3 = K3 + 1
      K4 = K4 + 1
      A(K4) = A(K4) - F * A(K3)
      IF (K4.LT.L4) GOTO 600
      IF (K2.LT.L2) GOTO 500
      K1 = K1 + ND
      IF (K1.LT.L1) GOTO 400

  700 IF(IOPT.EQ.1) goto 9999  !   RETURN
 1000 CONTINUE

      K1 = - NUC
      L1 = K1 + NMLC*ND
      K5 = - M
 1100 K1 = K1 + ND
      K5 = K5 + M
      K2 = K1
      L2 = K1 + NLC*NDM1
      K3 = K5 + M
      L3 = K3
 1200 K2 = K2 + NDM1
      F  = A(K2)
      L3 = L3 + M
      K4 = K5
 1300 K3 = K3 + 1
      K4 = K4 + 1
      B(K3) = B(K3) - F * B(K4)
      IF (K3.LT.L3) GOTO 1300
      IF (K2.LT.L2) GOTO 1200
      IF (K1.LT.L1) GOTO 1100
      IF (NLC.EQ.1) GOTO 2000

      N1 = NLC
      L1 = (N-2) * ND
 1400 K1 = K1 + ND
      K5 = K5 + M
      K2 = K1
      N1 = N1 - 1
      L2 = K1 + N1*NDM1
      K3 = K5 + M
      L3 = K3
 1500 K2 = K2 + NDM1
      F  = A(K2)
      L3 = L3 + M
      K4 = K5
 1600 K3 = K3 + 1
      K4 = K4 + 1
      B(K3) = B(K3) - F * B(K4)
      IF (K3.LT.L3) GOTO 1600
      IF (K2.LT.L2) GOTO 1500
      IF (K1.LT.L1) GOTO 1400

 2000 K1 = N*ND + NLC + 1
      L1 = K1 - NMUC*ND
      K5 = N*M +1
 2100 K1 = K1 - ND
      L5 = K5 - M
      F  = A(K1)
 2200 K5 = K5 - 1
      B(K5) = B(K5)/F
      IF (K5.GT.L5) GOTO 2200
      K2 = K1
      L2 = K1 - NUC * NDM1
      K3 = K5
      L3 = K5
      K6 = K5 + M
 2300 K2 = K2 - NDM1
      F = A(K2)
      L3 = L3 - M
      K4 = K6
 2400 K3 = K3 - 1
      K4 = K4 - 1
      B(K3) = B(K3) - F * B(K4)
      IF (K3.GT.L3) GOTO 2400
      IF (K2.GT.L2) GOTO 2300
      IF (K1.GT.L1) GOTO 2100
      IF (NUC.EQ.1) GOTO 2850
      N1 = NUC
      L1 = 2*ND
 2500 K1 = K1 - ND
      L5 = K5 - M
      F  = A(K1)
      N1 = N1 - 1
 2600 K5 = K5 - 1
      B(K5) = B(K5)/F
      IF (K5.GT.L5) GOTO 2600
      K2 = K1
      L2 = K1 - N1 * NDM1
      K3 = K5
      L3 = K5
      K6 = K5 + M
 2700 K2 = K2 - NDM1
      F = A(K2)
      L3 = L3 - M
      K4 = K6
 2800 K3 = K3 - 1
      K4 = K4 - 1
      B(K3) = B(K3) - F * B(K4)
      IF (K3.GT.L3) GOTO 2800
      IF (K2.GT.L2) GOTO 2700
      IF (K1.GT.L1) GOTO 2500
 2850 K1 = K1 - ND
      L5 = K5 - M
      F  = A(K1)
 2900 K5 = K5 - 1
      B(K5) = B(K5)/F
      IF (K5.GT.L5) GOTO 2900

 9999 CONTINUE
      RETURN
      END

rwmsu · November 7, 2023, 12:35pm

Sort of off topic, but I would also like the ability to CYCLE a BLOCK construct in addtion to exiting it. I use BLOCK and EXIT as a way to get rid of some GO TO cases but it would nice to not have to use an unindexed DO imbedded in a BLOCK to do the “jump up” loops you see a lot in old codes using a GO TO. ie

iterate: block
.
.
  if (converged) then
    EXIT iterate
  end if

! do some other stuff here
  
   CYCLE iterate

end  block iterate

instead of

iterate: block
   loop: do
   
      if (converged) then
        exit iterate
     end if
! do some more stuff
   end do loop
end block iterate

to replace

10 continue

     if (converged) go to 20
     go to 10

20 continue

My objection to unidexed DO is that I think the language has too many DO constructs already and that leads to confusion with new users.

everythingfunctional · November 7, 2023, 2:31pm

I’ve only just dipped my toe into random numbers. This was modernising an existing codebase, so I only needed to learn enough to understand the existing algorithm, not evaluate alternatives.

everythingfunctional · November 7, 2023, 2:35pm

I’m not sure I understand what the block buys you here. Why not just

iterate: do
  ! stuff
  if (converged) exit iterate
  ! more stuff
end do iterate

rwmsu · November 7, 2023, 3:47pm

Brad, its mostly personal preference for what I consider to be a cleaner syntax. However, here is a scenario I encounter many times in old codes.

You have multiple “branch up” GO TOs that are used for iterative loops covering several hundreds of lines of code
Embedded in those hundreds of lines of codes are several error tests and associated GO TOs that branch to multiple WRITE/PRINT/CONTINUE statements at the end of the code. Here is an
example

! Top of code

10 continue

! do a lot of stuff over several lines of code

   If (error1) GO TO 100
   if (error2) GO TO 200
   if (error3) GO TO 300
! etc
  20 continue
      ! Do hundreds of lines of more stuff
       If (condition1) go to 10
       if (error4) go to 400
       if (condition2) go to 30
       if (condition3) go to 20
  30 continue
! hundreds of more lines of code
        return
100 Print *, ' error1'
       Return
200 Print *, ' error2'
       Return
300 Print *, ' error3'
       Return
400 print *,' error4'
       Return

Here’s how I normally refactor codes like these

I define an interger variable (usually named error_code) to hold an error_code value. I normally just use the statement label number of the associated PRINT, WRITE, or CONTINUE statement.
I use nested BLOCK constructs and/or unindexed DOs to wrap the lines of code around where that cover 1. the most of the code between the 10 continue and the error prints and around the 20 continue loop

If I could just cycle the BLOCK constructs I can avoid what could be a potential error where an unindexed loop trys to loop forever.

Here is what the above contrived example might look like using just BLOCKs that can be cycled.

! Top of code

error_code = 0
block10: block

! do a lot of stuff over several lines of code

   If (error1) then
     error_code = 100
     exit block10
   end if
   if (error2) then
      error_code = 200
      exit block10
   end if
   if (error3) then
     error_code = 300
     exit block10
   end if
!etc
  block20: block
      ! Do hundreds of lines of more stuff
       If (condition1) cycle block10
       if (error4) then
         error_code = 400
         exit block10
      end if
       if (condition2) exit block20
       if (condition3) cycle block20
   end block block20
! hundreds of more lines of code
  end block block10
  select case (error_code)
    case(100}
        Print *, ' error1'
   case(200) 
        Print *, ' error2'
    case(300}
       Print *, ' error3'
    case(400)
       Print *, ' error4'
   end select
       Return

Currently , I have to add either DO WHILE or an unindexed do to the block10 construct to perform the embedded iterations. Note the main purpose of the block10 construct is to allow me a clean way of jumping to the error statements without explicit GO TO statements. If I could just CYCLE the block constructs I would save having to keep up with where the DO ENDO constructs begin and end plus eliminate one more potential source of error. So yes for short blocks of code the unindexed do is fine, its when you have to cover serveral 10s or 100s of lines of code that I think allowing BLOCKs to CYCLE lead to a cleaner syntax. Plus I’ll admit to a certain bias. I considered unindexed DOs one of the syntax crimes that previous standards committees committed that we are now stuck with.

PierU · November 7, 2023, 4:17pm

I do like the unindexed DO, and actually do not hesitate using it. I find it clearer than cycling in a block construct…

The other way, I woud like all constructs like DO, IF/THEN/ELSE/ENDIF to fully behave like BLOCK construct, i.e. being able to declare local variables:

do i = 1, n
   integer :: a
   <instructions>
end do

rwmsu · November 7, 2023, 4:55pm

To each his own. I just don’t see unindexed DOs providing anything that you couldn’t already do with a DO WHILE. For some reason, standard committee’s for the last 30 or so years insist on introducing new features that basically do the same thing as an existing feature and provide little extra value

PierU · November 7, 2023, 5:08pm

do while can do, yes, but sometimes you just don’t need to test the continuation of the loop right at the beginning of the loop, so why forcing a test here? I have seen several times people unaware of the unindexed do write code like:

do while (.true.)
   ...
end do

Harper · November 7, 2023, 8:25pm

I like unindexed DO myself because DO i = 0,huge(i)-1 with i an otherwise superfluous variable is an inelegant way to get the same effect unless you might go more than huge(i) times round the loop before executing EXIT, RETURN, STOP, ERROR STOP or (shock horror) GOTO.

rwmsu · November 7, 2023, 8:56pm

Yes but my point is that

exit_flag = .FALSE.
do while (.NOT. exit_flag)

if (some_condition) exit
end do

will do the exact same thing as

do
   if (some_condition) exit
end do

I just question why unindexed DO was needed in the first place.

PierU · November 7, 2023, 9:16pm

Why have cycle and exit been introduced in the first place? After all, everything could be done with goto’s

Harper · November 7, 2023, 9:34pm

I think the do while is the one that was not needed, rather than unindexed do, which is more concise because it does not need @rwmsu’s extra variable exit_flag to be declared, given a value before the loop, and tested each time round.

Topic		Replies	Views
Tips on modernizing old fortran code? Help	18	2216	June 8, 2023
Chapters 2, 3, and 4 of Modern Fortran are now free Announcements	9	1023	September 21, 2020
Happy Christmas Eve! 🎄	7	551	December 25, 2020
Description of old FORTRAN idioms Announcements	11	1149	April 10, 2024
GSoC'22 : Fortran playground - LIVE NOW GSoC-2022	10	1054	October 13, 2022

Go To Statement Considered Harmful: Fortran examples

Related topics