I (fort)RAN So Far Away

Many years ago, Matt left a position where he developed in FORTRAN, and went off to do other things. The company hired a replacement, and since no one else really understood FORTRAN, they assumed things were fine. Over the course of a decade, their development costs got more expensive, their software got buggier, and deadlines started flying by without a single new feature being released. It took a long time, but they eventually fired Matt's replacement. Since Matt was looking for a new position around that time, he ended up back in the FORTRAN shop: just when he thought he was out, they pulled him back in.

Matt started going through the code that'd been implemented, and… well, here's an example function signature:

      SUBROUTINE TREND_ORA_GET (AASTAT, DATATYPE, ORA_CODE
     >                          , MON, YEAR, IN_OPTION, OUT_ARRAY)

Now, if you're reading this, you might think OUT_ARRAY is an output parameter. You'd be mistaken. It's just the name of an array which happens to be defined in Common (which is Fortran's term for global variables).

Inside this subroutine, the code starts by fetching some data from a database, and then starts doing things like:

       IF (OUT_ARRAY(1:1) .EQ. 'G') THEN
            IF (OUT_ARRAY .EQ. 'GRP ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)

                  IF (RNUM .LE. max_results) THEN
                     GRP (RNUM) = TBLDATA (I)
                  ENDIF
!                  IF (RNUM .LT.10) THEN
!                      WRITE (*,*) 'GRP(RNUM) = ',GRP(RNUM),TBLDATA(I)
!                  ENDIF
               ENDDO
            ENDIF
       ENDIF

The first line, there, accesses the first element of the array, and compares it to G- it's a "starts with" check. If it starts with G, then we check if the array is equal to GRP . Why the extra starts with? My only guess is that it's a micro-optimization to minimize the linear search on string comparisons.

If the array is GRP , then we loop from 1 to NID, and pull data out of the TBLITEMS collection, collecting them into a GRP collection. Why? I have no idea. The lines marked wit h! are comments.

But we do this many, many more times, complete with the optimization(?) of checking the first character in OUT_ARRAY.

       IF (OUT_ARRAY(1:1) .EQ. 'M') THEN
            IF (OUT_ARRAY .EQ. 'M6R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     M6R (RNUM) = TBLDATA (I)
                  ENDIF


                  IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN
                      M6R (RNUM) = TBLDATA (I)
!                      WRITE (*,*) 'M6R(RNUM) = ',M6R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF


               ENDDO

            ELSE IF (OUT_ARRAY .EQ. 'M5R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     M5R (RNUM) = TBLDATA (I)
                  ENDIF
                  IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN
                      M5R (RNUM) = TBLDATA (I)
!                      WRITE (*,*) 'M5R(RNUM) = ',M5R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF

               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'M4R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     M4R (RNUM) = TBLDATA (I)
                  ENDIF
                  IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN
                     M4R (RNUM) = TBLDATA (I)
!                      WRITE (*,*) 'M4R(RNUM) = ',M6R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF

               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'M3R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     M3R (RNUM) = TBLDATA (I)
                  ENDIF

                IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN
                     M3R (RNUM) = TBLDATA (I)
!                      WRITE (*,*) 'M3R(RNUM) = ',M3R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF

                ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'M2R ') THEN
!               write (*,*)'NID = ', nid
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     M2R (RNUM) = TBLDATA (I)
                  ENDIF
!                  If (tblitems (i) .gt. 60000) then
!                     write(*,*) 'tblitems(i) = ',tblitems(i), 'I = ',i
!                  endif
                  IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN
                     M2R (RNUM) = TBLDATA (I)
!                      WRITE (*,*) 'M2R(RNUM) = ',M2R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF

               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'M1R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     M1R (RNUM) = TBLDATA (I)
                  ENDIF

                  IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN
                     M1R (RNUM) = TBLDATA (I)
!                      WRITE (*,*) 'M1R(RNUM) = ',M1R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF

               ENDDO
            ENDIF
       ENDIF

        IF (OUT_ARRAY(1:1) .EQ. 'Y') THEN
            IF (OUT_ARRAY .EQ. 'Y1R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     Y1R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO

            ELSE IF (OUT_ARRAY .EQ. 'Y2R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     Y2R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'Y5R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     Y5R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ENDIF
       ENDIF


       IF (OUT_ARRAY(1:1) .EQ. 'R') THEN
            IF (OUT_ARRAY .EQ. 'R6R ') THEN
                DO I = 1, NID
                   RNUM = TBLITEMS (I)
                   IF (RNUM .LE. MAX_RESULTS) THEN
                     R6R (RNUM) = TBLDATA (I)
                   ENDIF
                ENDDO
             ELSE IF (OUT_ARRAY .EQ. 'R5R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     R5R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'R4R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     R4R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'R3R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     R3R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'R2R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     R2R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'R1R ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     R1R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ENDIF
       ENDIF


         IF (OUT_ARRAY(2:2) .EQ. 'Y') THEN
            IF (OUT_ARRAY .EQ. 'PY5R') THEN
                DO I = 1, NID
                   RNUM = TBLITEMS (I)
                   IF (RNUM .LE. MAX_RESULTS) THEN
                     PY5R (RNUM) = TBLDATA (I)
                   ENDIF
                ENDDO
             ELSE IF (OUT_ARRAY .EQ. 'ZY1R') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     ZY1R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'RY1R') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     RY1R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
             ELSE IF (OUT_ARRAY .EQ. 'RY5R') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     RY5R (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'RY6R') THEN
               DO I = 1, NID

                  RNUM = TBLITEMS (I)
                  IF ((RNUM .GE. 15722) .AND. (RNUM .LE.15727)) THEN
                     RY6R (RNUM) = TBLDATA (I)
!                     WRITE (*,*) 'RY6R(RNUM) = ',RY6R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF
                  IF ((RNUM .GE. 41708) .AND. (RNUM .LE.41759)) THEN
                     RY6R (RNUM) = TBLDATA (I)
!                     WRITE (*,*) 'RY6R(RNUM) = ',RY6R(RNUM),'RNUM = ',RNUM,TBLDATA(I)
                  ENDIF
               ENDDO
            ENDIF

         ENDIF

         IF (OUT_ARRAY .EQ. 'TOT ') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     TOT (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
            ELSE IF (OUT_ARRAY .EQ. 'RTOT') THEN
               DO I = 1, NID
                  RNUM = TBLITEMS (I)
                  IF (RNUM .LE. MAX_RESULTS) THEN
                     RTOT (RNUM) = TBLDATA (I)
                  ENDIF
               ENDDO
          ENDIF

I love this code sample, because I don't know Fortran, and it's still easy to see that this code is bad. It's repetitive, it's cryptic, and it's obviously fragile and difficult to modify. Matt adds:

The real WTF is, of course, that we're still using FORTRAN. That's because the customer still insists on their reports being produced on fan-feed line-printer (chunka-chunka-chunka) paper 122-columns wide etc. etc.

[Advertisement] Utilize BuildMaster to release your software with confidence, at the pace your business demands. Download today!