CodeSOD: I (fort)RAN So Far Away

[ad_1]

A few years in the past, Matt left a place the place he developed in FORTRAN, and went off to do different issues. The corporate employed a alternative, and since nobody else actually understood FORTRAN, they assumed issues have been high quality. Over the course of a decade, their growth prices bought dearer, their software program bought buggier, and deadlines began flying by and not using a single new characteristic being launched. It took a very long time, however they ultimately fired Matt's alternative. Since Matt was in search of a brand new place round that point, he ended up again within the FORTRAN store: simply when he thought he was out, they pulled him again in.

Matt began going via the code that'd been carried out, and… properly, right here's an instance perform signature:

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

Now, if you happen to're studying this, you may assume OUT_ARRAY is an output parameter. You'd be mistaken. It's simply the identify of an array which occurs to be outlined in Frequent (which is Fortran's time period for world variables).

Inside this subroutine, the code begins by fetching some knowledge from a database, after which begins doing issues 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 primary line, there, accesses the primary ingredient of the array, and compares it to G– it's a "begins with" verify. If it begins with G, then we verify if the array is the same as GRP . Why the additional begins with? My solely guess is that it's a micro-optimization to reduce the linear search on string comparisons.

If the array is GRP , then we loop from 1 to NID, and pull knowledge out of the TBLITEMS assortment, accumulating them right into a GRP assortment. Why? I do not know. The traces marked wit h! are feedback.

However we do that many, many extra occasions, full with the optimization(?) of checking the primary 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 really like this code pattern, as a result of I don't know Fortran, and it's nonetheless straightforward to see that this code is dangerous. It's repetitive, it's cryptic, and it's clearly fragile and tough to switch. Matt provides:

The true WTF is, after all, that we're nonetheless utilizing FORTRAN. That's as a result of the client nonetheless insists on their experiences being produced on fan-feed line-printer (chunka-chunka-chunka) paper 122-columns broad and many others. and many others.

[Advertisement]
Make the most of BuildMaster to launch your software program with confidence, on the tempo your corporation calls for. Obtain at present!

[ad_2]

Leave a Comment

Your email address will not be published. Required fields are marked *