Performance in perform loops

From: Joern (m6v100_at_web.de)
Date: 01/28/04 

Date: 28 Jan 2004 02:45:52 -0800

Hello, I am looking for some tips in order to improve the performance
of the following COBOL code. Our investigation has shown, that the
section C032 is the most time consuming part of the whole program.
We spend more than 60% of the cpu time in the simple perform loops of
the 'C032-PRUEFE-BEDG' section.
  
The program works as designed and in my opinion all the coding is
needed for the correct performing. I am not a expert in COBOL
programming, so I am not sure if I can perform the code in a better
way. Maybe you can help me.
  

01 SWITCH-DIMSCHL-FOUND PIC 9 COMP.
    88 SW-DIMSCHL-NOT-FOUND VALUE 0.
    88 SW-DIMSCHL-FOUND VALUE 1.

01 WS-BED-HILFSFELDER.
    05 PS-TREFFER PIC S9(1) COMP.
        88 PS-TREFFER-NEIN VALUE ZERO.
        88 PS-TREFFER-JA VALUE 1.
    05 WS-FORMAT PIC X(1).
    05 WS-VFELD PIC X(10).
    ...
    05 ABG-END PIC S9(8) COMP.

01 MAX-FELDNR PIC 9(4) COMP VALUE 2000.
01 TB-FELD-TAB.
    03 TB-FELD-ELEMENT
        OCCURS 2000 INDEXED BY F-I1 F-I2.
        05 TB-FELDNR PIC S9(9) COMP.
        05 TB-FELDPOS PIC S9(9) COMP.
        05 TB-FELDLAENGE PIC S9(9) COMP.
        05 TB-FELDFRM PIC X.
        05 TB-SUCHFELD PIC X(10).
        05 TB-SUCHFELD-N REDEFINES
                         TB-SUCHFELD PIC S9(18) COMP-3.

****************************************************************
  - TABELLE MIT DEN ABGRENZUNGEN
****************************************************************
01 MAX-ABG-ELEM PIC 9(9) COMP VALUE 400000.
01 TB-ABGRENZUNG.
    03 FILLER OCCURS 400000 INDEXED BY ABG-IND.
        05 TB-ABG-FELD-INDEX PIC S9(9) COMP.
        05 TB-ABG-FELDNR PIC S9(9) COMP.
        05 TB-ABG-OPERATOR PIC X.
        05 TB-ABG-ABGRVON PIC X(10).
        05 TB-ABG-ABGRVON-N REDEFINES
            TB-ABG-ABGRVON PIC S9(18) COMP-3.
        05 TB-ABG-ABGRBIS PIC X(10).
        05 TB-ABG-ABGRBIS-N REDEFINES
            TB-ABG-ABGRBIS PIC S9(18) COMP-3.

C032-PRUEFE-BEDG SECTION.
****************************************************************
    eine Bedingung aus TB-BED prüfen (BED-IND):
****************************************************************
C032-BEG.

    SET SW-DIMSCHL-FOUND TO TRUE
    MOVE ZERO TO WS-FELDNR-PREV
    SET ABG-IND TO TB-BED-ANF (BED-IND)
    MOVE TB-BED-END (BED-IND) TO ABG-END

    PERFORM UNTIL ABG-IND > ABG-END
               OR SW-DIMSCHL-NOT-FOUND
       MOVE TB-ABG-FELDNR (ABG-IND) TO WS-FELDNR
       IF WS-FELDNR NOT = WS-FELDNR-PREV
          MOVE WS-FELDNR TO WS-FELDNR-PREV
          set F-I1 TO TB-ABG-FELD-INDEX (ABG-IND)
          MOVE TB-FELDFRM (F-I1) TO WS-FORMAT
          MOVE TB-SUCHFELD (F-I1) TO WS-VFELD
       END-IF

Bedingung prüfen je Feld:
       PERFORM UNTIL TB-ABG-FELDNR (ABG-IND)
                     NOT = WS-FELDNR-PREV
                  OR ABG-IND > ABG-END
                  OR SW-DIMSCHL-NOT-FOUND
          IF TB-ABG-OPERATOR (ABG-IND) = 'A'
             IF WS-FORMAT = 'X'
                IF WS-VFELD NOT < TB-ABG-ABGRVON (ABG-IND)
                AND WS-VFELD NOT > TB-ABG-ABGRBIS (ABG-IND)
                   SET SW-DIMSCHL-NOT-FOUND TO TRUE
                END-IF
             ELSE
                IF WS-VFELD-N NOT < TB-ABG-ABGRVON-N(ABG-IND)
                AND WS-VFELD-N NOT > TB-ABG-ABGRBIS-N(ABG-IND)
                   SET SW-DIMSCHL-NOT-FOUND TO TRUE
                END-IF
             END-IF
             SET ABG-IND UP BY 1
          ELSE
             SET PS-TREFFER-NEIN TO TRUE
             PERFORM UNTIL TB-ABG-FELDNR (ABG-IND)
                           NOT = WS-FELDNR-PREV
                        OR ABG-IND > ABG-END
                        OR PS-TREFFER-JA
                IF WS-FORMAT = 'X'
                   IF WS-VFELD NOT < TB-ABG-ABGRVON (ABG-IND)
                   AND WS-VFELD NOT > TB-ABG-ABGRBIS (ABG-IND)
                      SET PS-TREFFER-JA TO TRUE
                   END-IF
                ELSE
                   IF WS-VFELD-N NOT < TB-ABG-ABGRVON-N(ABG-IND)
                   AND WS-VFELD-N NOT > TB-ABG-ABGRBIS-N(ABG-IND)
                      SET PS-TREFFER-JA TO TRUE
                   END-IF
                END-IF
                SET ABG-IND UP BY 1
             END-PERFORM
             IF PS-TREFFER-JA
                PERFORM UNTIL TB-ABG-FELDNR (ABG-IND)
                              NOT = WS-FELDNR-PREV
                            OR ABG-IND > ABG-END
                   SET ABG-IND UP BY 1
                END-PERFORM
             ELSE
                SET SW-DIMSCHL-NOT-FOUND TO TRUE
             END-IF
          END-IF
       END-PERFORM

    END-PERFORM

    CONTINUE.
C032-EX.

As you see, the index abg-ind of the table is used.
Someone told me, that the comparisons of the index with the data item
abg-end (binary) in the "until" statements of the loops are very time
expensive. I don't have any idea, whether it is right and how I can
handle the comparison in a better way

Thanks in advance, Joern