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] today!
SOCIAL SHARE CARD GENERATOR