000100 cbl lib
000200 Identification Division.
000300 Program-Id. FREQMILD.
000400 Environment Division.
000500 Input-Output Section.
000600 File-Control.
000700     Select FREQMILE Assign to FREQMDD
000800            Organization is Sequential
000900            Access is Sequential
001000            .
001100     Select SORTFILE Assign to SORTWORK
001200     .
001300 Data Division.
001400 File Section.
001500 FD FREQMILE Recording Mode F.
001600 01 Mile-Record.
001700    88 No-More-Mile-Records Value High-Value.
001800    05 MR-City-Pair     Pic X(07).
001900    05                  Pic X(01).
002000    05 MR-Mileage       Pic 9(05).
002100    05                  Pic X(67).
002200 SD SORTFILE.
002300 01 Sort-Record.
002400    88 No-More-Sort-Records Value High-Value.
002500    05 SR-City-Pair     Pic X(07).
002600    05                  Pic X(01).
002700    05 SR-Mileage       Pic 9(05).
002800    05                  Pic X(67).
002900 Working-Storage Section.
003000 01 Pgmstatus  Pic 9(01) Value 0.
003100    88 Table-Not-Filled  Value 0.
003200    88 Table-Filled      Value 1.
003300
003400 01 WS-City-Pair.
003500    05 WS-Dest  Pic X(03).
003600    05          Pic X(01) Value '-'.
003700    05 WS-Org   Pic X(03).
003800
003900 01 Number-Of-Rows    Pic S9(04).
004000 01 Number-Of-Records Pic S9(04) Binary Value 0.
004100 01 Heap-Id           Pic S9(08) Binary Value 0.
004200 01 Storage-Size      Pic S9(08) Binary.
004300 01 Storage-Pointer   Pointer.
004400 01 Storage-RC        Pic S9(08) Binary.
004500    88 Storage-OK     Value 0.
004600
004700 Linkage Section.
004800 01 LS-Tabpointer      Pointer.
004900 01 LS-City-Pair.
005000    05 LS-Org   Pic X(03).
005100    05          Pic X(01).
005200    05 LS-Dest  Pic X(03).
005300
005400 01 Mile-Table.
005500    05 City-Pair-Tab Occurs 10
005600          Depending on Number-Of-Rows
005700          Ascending Key is MT-City-Pair
005800          Indexed By X1.
005900       10 MT-City-Pair Pic X(07).
006000       10              Pic X(01).
006100       10 MT-Mileage   Pic 9(05).
006200
006300 Procedure Division Using LS-City-Pair, LS-Tabpointer.
006400     If Table-Not-Filled
006500        Perform Fill-Mile-Table
006600        Set Table-Filled to True
006700     End-If
006800     Perform Search-Mile-Table
006900     GoBack
007000     .
007100*-------------------------------------------
007200 Search-Mile-Table.
007300*-------------------------------------------
007400
007500     Search All City-Pair-Tab
007600        At End
007700           Set LS-Tabpointer to Null
007800           Display '*** City-Pair: ' LS-City-Pair
007900              ' Saknas första sökning...'
008000              Perform Search-Mile-Table-Reverse
008100        When MT-City-Pair(X1) = LS-City-Pair
008200           Display '*** City-Pair: ' LS-City-Pair ' OK'
008300           Set LS-Tabpointer to
008400              Address of Mt-Mileage(X1)
008500     End-Search
008600     .
008700*-------------------------------------------
008800 Search-Mile-Table-Reverse.
008900*-------------------------------------------
009000     Move LS-Org  to WS-Org
009100     Move LS-Dest to WS-Dest
009200     Search All City-Pair-Tab
009300        At End
009400           Set LS-Tabpointer to Null
009500           Display '*** City-Pair: ' WS-City-Pair
009600              ' Saknas'
009700        When MT-City-Pair(X1) = WS-City-Pair
009800           Display '*** City-Pair: ' WS-City-Pair ' OK'
009900           Set LS-Tabpointer to
010000              Address of Mt-Mileage(X1)
010100     End-Search
010200     .
010300*-------------------------------------------
010400 Fill-Mile-Table.
010500*-------------------------------------------
010600     Open Input FREQMILE
010700     Sort SORTFILE
010800          On Ascending Key Sr-City-Pair
010900          Input Procedure Count-Number-Of-Records
011000          Output Procedure Handle-Sorted-Records
011100
011200     Display 'Sort-Return: ' Sort-Return
011300     Display 'Number of records: ' Number-of-Records
011400     Display 'Number of bytes  : ' Storage-Size
011500     .
011600*-------------------------------------------
011700 Count-Number-Of-Records.
011800*-------------------------------------------
011900     Perform Until No-More-Mile-Records
012000        Read FREQMILE
012100           At End
012200              Set No-More-Mile-Records to True
012300           Not At End
012400              Add 1 to Number-of-Records
012500              Release Sort-Record from Mile-Record
012600        End-Read
012700        Multiply Number-of-Records by 13
012800            giving Storage-Size
012900     End-Perform
013000     .
013100*-------------------------------------------
013200 Handle-Sorted-Records.
013300*-------------------------------------------
013400     Perform Allocate-Storage
013500     If Storage-OK
013600        Set Address of Mile-Table to Storage-Pointer
013700
013800        Perform Varying Number-Of-Rows from 1 by 1
013900             Until No-More-Sort-Records
014000           Return SORTFILE
014100              At End
014200                Set No-More-Sort-Records to True
014300              Not At End
014400                Move Sort-Record to
014500                   City-Pair-Tab(Number-of-Rows)
014600*               Display 'Rad: ' City-Pair-Tab(Number-of-Rows)
014700           End-Return
014800        End-Perform
014900        Display '*** Number of Rows:   '
015000            Number-of-Rows
015100        Display '*** Number-of-Records '
015200            Number-of-Records
015300     Else
015400       Stop Run
015500     End-If
015600     .
015700*-------------------------------------------
015800 Allocate-Storage.
015900*-------------------------------------------
016000     Call 'CEEGTST' Using
016100        Heap-Id,
016200        Storage-Size,
016300        Storage-Pointer,
016400        Storage-RC
016500     If Storage-OK
016600        Display 'Allocation of storage '
016700          Storage-Size ' OK'
016800     Else
016900        Display '*** Allocation of Storage failed'
017000        Move 998 to Return-Code
017100     End-If
017200     .
017300*-------------------------------------------
017400 End Program FREQMILD.
017500*-------------------------------------------
017600