Quelle  Cobug.5.cob   Sprache: Cobol

         Identification Division.
         Program-Id. Cobug5.
      *-----------------------------------------
      *  aus Cobug Language 10.6.2100
      *-----------------------------------------
         Data Division.
         Working-Storage Section.
          01 WS-SELECT-FILE-KEY PIC 9(08).
        
         01 WS-INCREMENT-BY-ONE-SW PIC X(01).
          88 WS-INCREMENT-BY-ONE VALUE 'Y'.
         
         01 WS-WORK-AREAS.
          05 WS-SELECT-SEQ-NUM PIC 9(08) VALUE ZEROS.
          05 WS-HOLD-TOTAL-CNT PIC 9(08) VALUE ZEROS.
          05 WS-MAX-RECORDS PIC 9(03) VALUE ZEROS.
          05 SUB PIC 9(04) VALUE ZEROS.
          05 WS-SAVE-TABLE-ENTRY PIC 9(04) VALUE ZEROS.
        
         01 WS-RANDOM-TABLE.
           05 FILLER OCCURS 999 TIMES.
            10 WS-RANDOM-NUMBER PIC 9(09) VALUE ZEROS.
            10 WS-RANDOM-NUMBER-X REDEFINES WS-RANDOM-NUMBER PIC X(09).
        
         01 WS-FIFTEEN-DIGIT-NUMBER PIC 9(15).
         01 WS-DUMMY-NUMBER PIC 9(10).
         01 WS-RANDOM-SEED3 PIC 9(03).
         01 WS-NEW-RANDOM-NUMBER3 REDEFINES WS-RANDOM-SEED3
         01 WS-RANDOM-SEED4 PIC 9(04).
         01 WS-NEW-RANDOM-NUMBER4 REDEFINES WS-RANDOM-SEED4
         01 WS-RANDOM-SEED5 PIC 9(05).
         01 WS-NEW-RANDOM-NUMBER5 REDEFINES WS-RANDOM-SEED5
         01 WS-RANDOM-SEED6 PIC 9(06).
         01 WS-NEW-RANDOM-NUMBER6 REDEFINES WS-RANDOM-SEED6
         01 WS-RANDOM-SEED7 PIC 9(07).
         01 WS-NEW-RANDOM-NUMBER7 REDEFINES WS-RANDOM-SEED7
         01 WS-RANDOM-SEED8 PIC 9(08).
         01 WS-NEW-RANDOM-NUMBER8 REDEFINES WS-RANDOM-SEED8
         01 SYS-TIME PIC 9(08).
         01 SYS-TIME-2 PIC 9(08).
        procedure division
        
      * PRIOR TO THIS, THE FOLLOWING FIELDS ARE SET
      * WS-HOLD-TOTAL-CNT CONTAINS THE NUMBER OF RECORDS ON FILE
      * WS-MAX-RECORDS CONTAINS THE NUMBER OF RECORDS TO BE SELECTE
        PERFORM 6000-RANDOM-SETUP
        PERFORM UNTIL WS-SAVE-TABLE-ENTRY NOT <
        WS-MAX-RECORDS OR
        WS-HOLD-TOTAL-CNT NOT >
        WS-SAVE-TABLE-ENTRY - 1
        PERFORM 6100-GET-RANDOM-NUMBER
        END-PERFORM
        
        6000-RANDOM-SETUP.
        
         MOVE 'N' TO WS-INCREMENT-BY-ONE-SW
         INITIALIZE WS-RANDOM-TABLE
        WS-SAVE-TABLE-ENTRY
         IF WS-HOLD-TOTAL-CNT NOT > WS-MAX-RECORDS
          MOVE 0 TO WS-SELECT-FILE-KEY
          MOVE 'Y' TO WS-INCREMENT-BY-ONE-SW
         ELSE
          COMPUTE WS-SELECT-FILE-KEY =
          WS-MAX-RECORDS - WS-HOLD-TOTAL-CNT
          IF WS-SELECT-FILE-KEY < 11
           COMPUTE WS-SELECT-FILE-KEY =
           WS-SELECT-FILE-KEY * .5
           MOVE 'Y' TO WS-INCREMENT-BY-ONE-SW
          ELSE
            MOVE WS-HOLD-TOTAL-CNT TO WS-SELECT-FILE-KEY
          END-IF
        END-IF.
      ***************************************************************
      * CREATE RANDOM NUMBER
      ***************************************************************
        6100-GET-RANDOM-NUMBER.
        EVALUATE TRUE
        WHEN WS-INCREMENT-BY-ONE
         ADD 1 TO WS-SELECT-FILE-KEY
        WHEN WS-HOLD-TOTAL-CNT < 1000
         MOVE WS-SELECT-FILE-KEY TO WS-RANDOM-SEED3
         MULTIPLY WS-RANDOM-SEED3 BY 16807 GIVING
          WS-FIFTEEN-DIGIT-NUMBER
         DIVIDE 2147483647 INTO WS-FIFTEEN-DIGIT-NUMBER GIVING
          WS-DUMMY-NUMBER REMAINDER WS-NEW-RANDOM-NUMBER3
         MOVE WS-NEW-RANDOM-NUMBER3 TO WS-SELECT-FILE-KEY
          WS-SELECT-SEQ-NUM
        WHEN WS-HOLD-TOTAL-CNT < 10000
         MOVE WS-SELECT-FILE-KEY TO WS-RANDOM-SEED4
         MULTIPLY WS-RANDOM-SEED4 BY 16807 GIVING
          WS-FIFTEEN-DIGIT-NUMBER
         DIVIDE 2147483647 INTO WS-FIFTEEN-DIGIT-NUMBER GIVING
          WS-DUMMY-NUMBER REMAINDER WS-NEW-RANDOM-NUMBER4
         MOVE WS-NEW-RANDOM-NUMBER4 TO WS-SELECT-FILE-KEY
         WS-SELECT-SEQ-NUM
        WHEN WS-HOLD-TOTAL-CNT < 100000
         MOVE WS-SELECT-FILE-KEY TO WS-RANDOM-SEED5
         MULTIPLY WS-RANDOM-SEED5 BY 16807 GIVING
          WS-FIFTEEN-DIGIT-NUMBER
         DIVIDE 2147483647 INTO WS-FIFTEEN-DIGIT-NUMBER GIVING
          WS-DUMMY-NUMBER REMAINDER WS-NEW-RANDOM-NUMBER5
         MOVE WS-NEW-RANDOM-NUMBER5 TO WS-SELECT-FILE-KEY
          WS-SELECT-SEQ-NUM
        WHEN WS-HOLD-TOTAL-CNT < 1000000
         MOVE WS-SELECT-FILE-KEY TO WS-RANDOM-SEED6
         MULTIPLY WS-RANDOM-SEED6 BY 16807 GIVING
         WS-FIFTEEN-DIGIT-NUMBER
         DIVIDE 2147483647 INTO WS-FIFTEEN-DIGIT-NUMBER GIVING
         WS-DUMMY-NUMBER REMAINDER WS-NEW-RANDOM-NUMBER6
         MOVE WS-NEW-RANDOM-NUMBER6 TO WS-SELECT-FILE-KEY
         WS-SELECT-SEQ-NUM
        WHEN WS-HOLD-TOTAL-CNT < 10000000
         MOVE WS-SELECT-FILE-KEY TO WS-RANDOM-SEED7
         MULTIPLY WS-RANDOM-SEED7 BY 16807 GIVING
         WS-FIFTEEN-DIGIT-NUMBER
         DIVIDE 2147483647 INTO WS-FIFTEEN-DIGIT-NUMBER GIVING
         WS-DUMMY-NUMBER REMAINDER WS-NEW-RANDOM-NUMBER7
         MOVE WS-NEW-RANDOM-NUMBER7 TO WS-SELECT-FILE-KEY
         WS-SELECT-SEQ-NUM
        WHEN OTHER
         MOVE WS-SELECT-FILE-KEY TO WS-RANDOM-SEED8
         MULTIPLY WS-RANDOM-SEED8 BY 16807 GIVING
         WS-FIFTEEN-DIGIT-NUMBER
         DIVIDE 2147483647 INTO WS-FIFTEEN-DIGIT-NUMBER GIVING
         WS-DUMMY-NUMBER REMAINDER WS-NEW-RANDOM-NUMBER8
         MOVE WS-NEW-RANDOM-NUMBER8 TO WS-SELECT-FILE-KEY
         WS-SELECT-SEQ-NUM
        END-EVALUATE .
        
        IF WS-SELECT-FILE-KEY = 0
         MOVE 1 TO WS-SELECT-FILE-KEY
        END-IF
        PERFORM 6150-NEW-KEY-DUP-CHECK.
      ***************************************************************
      * VERIFY THAT THE SAME RANDOM NUMBER ISN'T USED TWICE
      ***************************************************************
        6150-NEW-KEY-DUP-CHECK.
        
        IF WS-HOLD-TOTAL-CNT > WS-MAX-RECORDS
         IF WS-SELECT-FILE-KEY NOT < WS-HOLD-TOTAL-CNT
          PERFORM 6155-GET-TIME
          PERFORM UNTIL WS-SELECT-FILE-KEY <
           SYS-TIME
           COMPUTE WS-SELECT-FILE-KEY =
           WS-SELECT-FILE-KEY -
           SYS-TIME
           IF WS-SELECT-FILE-KEY < 1
            PERFORM 6155-GET-TIME
           END-IF
          END-PERFORM
         END-IF
        END-IF.
        
        MOVE 1 TO SUB
        PERFORM UNTIL WS-RANDOM-NUMBER (SUB) =
          ZERO OR
          SUB > 999 OR
          WS-SELECT-FILE-KEY =
      *  . . . . . . . . . . . . . . . . . . .
         WS-RANDOM-NUMBER (SUB)
         ADD 1 TO SUB
        END-PERFORM.
        
        IF WS-RANDOM-NUMBER (SUB) = ZEROES
         MOVE WS-SELECT-FILE-KEY TO
         WS-RANDOM-NUMBER (SUB)
         MOVE SUB TO WS-SAVE-TABLE-ENTRY
        ELSE
         IF NOT WS-INCREMENT-BY-ONE
          ACCEPT SYS-TIME FROM TIME
          MOVE SYS-TIME TO WS-SELECT-FILE-KEY
         END-IF
        END-IF.
      /**************************************************************
      * GET SYSTEM TIME
      ***************************************************************
        6155-GET-TIME.
        
        ACCEPT SYS-TIME FROM TIME.
        
        MOVE SYS-TIME TO SYS-TIME-2
        MOVE SYS-TIME-2 TO SYS-TIME
        COMPUTE SYS-TIME = SYS-TIME * .50
        IF SYS-TIME > WS-HOLD-TOTAL-CNT
         PERFORM UNTIL SYS-TIME <
                   WS-HOLD-TOTAL-CNT
          COMPUTE SYS-TIME =
          SYS-TIME -
          WS-HOLD-TOTAL-CNT
          IF SYS-TIME < 1
            ACCEPT SYS-TIME FROM TIME
            MOVE SYS-TIME TO SYS-TIME-2
            MOVE SYS-TIME-2 TO SYS-TIME
            COMPUTE SYS-TIME = SYS-TIME * .50
          END-IF
         END-PERFORM
        END-IF.
        End-program cobug5.