Cobol, ordinare una tabella in memoria

Sort di una tabella.

Spesso capita di dover ordinare, in gergo sorteggiare, tabelle memorizzate nei record di un file, oppure sorteggiare delle tabelle prima di essere stampate o visualizzate come da questo esempio:

Esempio sort di una tabella

Questa semplice routine ha lo scopo di ordinare in modo crescente gli elementi di una tabella.
Il sort avviene in memoria ed è perciò molto veloce anche per tabelle di grandi dimensioni.
Non sono necessarie tabelle di appoggio, la tabella IN-TAB viene utilizzata solo in questo esempio per popolare la tabella da sorteggiare.
Il sort avviene in base alla chiave definita nel campo T-KEY.
Essa può essere composta di più campi numerici, alfanumerici, numerici paccati (COMP-3 o COMP-6).

Questa è la parte relativa alla WORKING-STORAGE SECTION :

Il campo POSTE contiene il numero degli elementi della tabella.
Il gruppo H-POSTEN rappresenta un elemento della tabella, serve quale campo di appoggio.
T-KEY è il la chiave da sorteggiare e deve essere definita come gruppo.
T-DATEN è il resto dell’elemento.

000023*            Campi per il sort di una tabella
000024*
000025*
000026*    Numero poste dalla tabella
000027*
000028 1   POSTE    PIC 9(3)      VALUE 10.
000029*
000030*    Struttura della tabella   
000031*
000032 1   H-POSTEN.
000033  2  H-KEY    PIC X(3).                 *> Criteri sorteggio (key)
000034  2  FILLER   PIC X(10).                *> Dati   
000035*
000036*    Tabella da sorteggiare      
000037*
000038 1   TABELLA.
000039  2  T-POSTEN    OCCURS  10 INDEXED BY  J1  J2  J3.
000040   3 T-KEY.
000041   4 T-TR     PIC X.
000042   4 T-NR     PIC 99.
000043   3 T-DATIN.
000044   4 DATI     PIC X(10).
000045*
000046*
000047*    Tabella con dati da sorteggiare (esempio)      
000048*
000049 1   IN-TAB.
000050  2  FILLER   PIC X(13) VALUE "B15 Record 1 ".
000051  2  FILLER   PIC X(13) VALUE "Z15 Record 2 ".
000052  2  FILLER   PIC X(13) VALUE "B35 Record 3 ".
000053  2  FILLER   PIC X(13) VALUE "F42 Record 4 ".
000054  2  FILLER   PIC X(13) VALUE "A01 Record 5 ".
000055  2  FILLER   PIC X(13) VALUE "R41 Record 6 ".
000056  2  FILLER   PIC X(13) VALUE "C05 Record 7 ".
000057  2  FILLER   PIC X(13) VALUE "W99 Record 8 ".
000058  2  FILLER   PIC X(13) VALUE "T36 Record 9 ".
000059  2  FILLER   PIC X(13) VALUE "A08 Record 10".
000060*
000061 1   IN-TABR REDEFINES IN-TAB.
000062  2  IN-POSTEN    OCCURS 10 INDEXED BY J4.
000063   3 IN-KEY.
000064   4 IN-TR    PIC X.
000065   4 IN-NR    PIC 99.
000066   3 IN-DATI  PIC X(10).
000067*
000068*
000069*

Questa è la parte relativa alla PROCEDURE DIVISION :

La prima parte della routine, ossia da SORT1 fino a SORT2 serve per popolare la tabella da sorteggiare.
Il sort vero e proprio inizia da SORT2.

000001*             SORT DI UNA TABELLA 
000002*
000003 SORT0.
000004     SET J1 J2 J4 TO 1.
000005*
000006     INITIALIZE TABELLA.
000007*
000008*             Popolare tabella da sorteggiare
000009*
000010 SORT1.
000011     MOVE IN-POSTEN(J4)      TO T-DATEN(J1).
000012     SET J1 UP BY 1.
000013     SET J4 UP BY 1.
000014     IF J4  > POSTE          GO SORT2.
000015     GO SORT1.
000016*
000017*              Inizio sorteggio
000018*
000019 SORT2.
000020     SET J1 J2 TO 1.
000021*
000022 SORT05.
000023     MOVE T-POSTEN(J1)       TO H-POSTEN.
000024     SET J3 TO J2.
000025*
000026 SORT10.
000027     IF J1 >  POSTE          GO  SORT20.
000028     IF T-KEY(J1) <  H-KEY
000029         MOVE T-POSTEN(J1)   TO  H-POSTEN
000030         SET  J3 TO J1.
000031     SET  J1  UP BY  1.
000032     GO  SORT10.
000033*
000034 SORT20.
000035     IF J2  NOT =  J3
000036         MOVE  T-POSTEN (J2)  TO  T-POSTEN(J3)
000037         MOVE  H-POSTEN       TO  T-POSTEN(J2).
000038     SET  J2  UP BY  1.
000039*
000040     IF  J2  NOT <  POSTE     GO  SORT99.
000041     SET J1  TO J2.
000042     GO  SORT05.
000043*
000044*
000045 SORT99.
000046     EXIT.

Come prelevare questi codici

Cobol in pratica

Sort di una tabella.