Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

SORT copybooks

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
View previous topic :: :: View next topic  
Author Message
TG Murphy

Active User


Joined: 23 Mar 2007
Posts: 149
Location: Ottawa Canada

PostPosted: Mon Dec 10, 2007 9:12 pm    Post subject: SORT copybooks
Reply with quote

In previous threads we discussed ways to sort a COBOL table. I had mentioned that I planned on creating a pair of COBOL copybooks that would be generic in nature in that they could be used to sort any table using an efficient sort algorithm (heapsort).

I have finished a first cut of these copybooks. I have tested them and they appear to work. My guess is that some of you may be interested in trying the copybooks out and if so, I would appreciate it if you could test them out and report back any problems. Of course feel free to use once you are confident that they work well.

1. Working Storage copybook SORTWORK

Code:
     
      *-----------------------------------------------------------------
      * Sort Utility : Working storage
      *-----------------------------------------------------------------
       01 SORT-SORT-UTILITY-GRP.
           05 SORT-SORT-SEQUENCE    PIC X(1).
              88 SORT-ASCENDING               VALUE "A".
              88 SORT-DESCENDING              VALUE "D".
           05 SORT-OK               PIC X.
           05 SORT-IDX              PIC S9(9) COMP.
           05 SORT-IDX2             PIC S9(9) COMP.
           05 SORT-GAP              PIC S9(9) COMP.
           05 SORT-NBR-OF-ELEMENTS  PIC S9(9) COMP.
           05 SORT-LOOP             PIC S9(9) COMP.
           05 SORT-TEMP             PIC X(1000).



2. Procedure Division copybook SORTPROC

Code:
     
      *-----------------------------------------------------------------
      * Sort a COBOL table - procedure division copybook
      *
      * This copybook provides a section that can be performed to sort
      * a COBOL table.  It is very efficient because it uses the
      * heapsort algorithm.  As a result it can be used in CICS.
      *
      * In order to use this copybook you must also copy in its
      * working storage counterpart SORTWORK.
      *
      * Sample Table
      *
      *     05 WS-MONTH-TABLE.
      *        10  WS-NBR-OF-ELEMENTS        PIC S9(4) COMP VALUE +12.
      *        10  WS-MONTH-TABLE-MAXSIZE    PIC S9(4) COMP VALUE +12.
      *        10  WS-MONTH-VALUES.
      *            15  WS-JANUARY       PIC X(12) VALUE '01January'.
      *            15  WS-FEBRUARY      PIC X(12) VALUE '02February'.
      *            15  WS-MARCH         PIC X(12) VALUE '03March'.
      *            15  WS-APRIL         PIC X(12) VALUE '04April'.
      *            15  WS-MAY           PIC X(12) VALUE '05May'.
      *            15  WS-JUNE          PIC X(12) VALUE '06June'.
      *            15  WS-JULY          PIC X(12) VALUE '07July'.
      *            15  WS-AUGUST        PIC X(12) VALUE '08August'.
      *            15  WS-SEPTEMBER     PIC X(12) VALUE '09September'.
      *            15  WS-OCTOBER       PIC X(12) VALUE '10October'.
      *            15  WS-NOVEMBER      PIC X(12) VALUE '11November'.
      *            15  WS-DECEMBER      PIC X(12) VALUE '12December'.
      *
      *        10  WS-MONTH-ENTRY            REDEFINES WS-MONTH-VALUES
      *                                      OCCURS 12 TIMES.
      *            15  WS-MONTH-NBR          PIC 9(2).
      *            15  WS-MONTH-NM           PIC X(10).
      *
      * Example of how to copy SORTWORK into working storage.
      *
      *    COPY SORTWORK.
      *
      * Example of how to copy SORTPROC into procedure division.
      *
      *    COPY SORTPROC REPLACING
      *         ==:SUFFIX:==           BY MYSORT
      *         ==:SORT-SEQUENCE:==    BY SORT-ASCENDING
      *         ==:SORTROW:==          BY WS-MONTH-ENTRY
      *         ==:SORTKEY:==          BY WS-MONTH-NM
      *         ==:NBR-OF-ELEMENTS:==  BY WS-NBR-OF-ELEMENTS.
      *
      *    where SUFFIX is concatenated to the end of the section
      *          names used within the copybook to ensure unique
      *          section names.
      *
      *    where SORT-SEQUENCE must be either SORT-ASCENDING
      *          or SORT-DESCENDING.
      *
      *    where SORTROW specifies the COBOL group variable (within
      *          the table that you want sorted) that contains a
      *          a single table element.
      *
      *    where SORTKEY specifies the sort key that gets compared.
      *
      *    where NBR-OF-ELEMENTS specifies how many elements are in
      *          the table.  This number cannot exceed the maximum
      *          size of the table but it can be less.
      *
      * How to perform the sort:
      *
      *    PERFORM SORT-TABLE-MYSORT
      *
      *    (Note that -MYSORT will differ depending on what you set
      *     the REPLACING parm SUFFIX to)
      *
      * Usage Notes
      *
      * 1. You may copy the procedure division copybook in as many
      *    times as necessary.  Just make sure to specify unique
      *    values for the REPLACING parm SUFFIX. However, the working
      *    storage copybook should only ever be copied in once.
      *
      * 2. Your sortkey may specify either an elementary field or a
      *    group field.  If elementary, then there are no restrictions
      *    as to what datatype the field can be.  It can be alpha or
      *    PIC 9 or COMP or COMP-3.
      *
      *    However, if sortkey is a group field, then remember that
      *    the comparison will be an alphanumeric comparison.  As
      *    a result, make sure that none of your sort key sub-fields
      *    use packed decimal (COMP-3) or the sort will not work
      *    as you intend it to.  There are workarounds for this.
      *----------------------------------------------------------------
      *
      *----------------------------------------------------------------

       SORT-TABLE-:SUFFIX: SECTION.
           SET :SORT-SEQUENCE: TO TRUE
           MOVE :NBR-OF-ELEMENTS: TO SORT-NBR-OF-ELEMENTS
      *
      * Gap divides the table into parts.  The gap will get increasingly
      * smaller as the table is sorted.
      *
           DIVIDE 2 INTO SORT-NBR-OF-ELEMENTS GIVING SORT-GAP.
      *
      * Perform the outer loop until the gap reaches zero.
      *
           PERFORM PASS-LOOP-:SUFFIX: UNTIL SORT-GAP = 0
           .


       PASS-LOOP-:SUFFIX: SECTION.
           PERFORM PASS-TABLE-:SUFFIX:
               VARYING SORT-LOOP FROM 1 BY 1
                  UNTIL SORT-LOOP =
                        SORT-NBR-OF-ELEMENTS - SORT-GAP + 1
           DIVIDE 2 INTO SORT-GAP
           .


       PASS-TABLE-:SUFFIX: SECTION.
      *
      * Test items starting with ;SORT-LOOP.
      * The distance between keys being compared is ;SORT-GAP.
      * If when a set of keys are found out of order, the rows
      * are swaped AND the index is reduced by 'gap'.  This
      * causes the compares to back up to see if the key just
      * moved up, might need to be moved up again.  Essentially,
      * causing the row to 'bubble-up' quickly and optimizes
      * for rows that are very much out of order.
      *
            MOVE SORT-LOOP TO SORT-IDX.
            PERFORM COMPARISONS-:SUFFIX:
                    UNTIL SORT-IDX < 0 OR SORT-IDX = 0
            .


       COMPARISONS-:SUFFIX: SECTION.
           ADD SORT-IDX SORT-GAP GIVING SORT-IDX2
           PERFORM COMPARE-KEYS-:SUFFIX:
           IF SORT-OK = "N"
              PERFORM SWAP-ROWS-:SUFFIX:
              SUBTRACT SORT-GAP FROM SORT-IDX
           ELSE
              MOVE 0 TO SORT-IDX
           END-IF
           .



        COMPARE-KEYS-:SUFFIX: SECTION.
      *
      * Compare keys here.
      * This routine returns ;SORT-OK = N if the comparison is true.
      * This means that the keys being compared are out of order and
      * must be switched.
      *
           MOVE "Y" TO SORT-OK
           IF ( SORT-ASCENDING AND
                :SORTKEY: (SORT-IDX) >
                :SORTKEY: (SORT-IDX2) )
           OR ( SORT-DESCENDING AND
                :SORTKEY: (SORT-IDX) <
                :SORTKEY: (SORT-IDX2) )
              MOVE "N" TO SORT-OK
           END-IF
           .



       SWAP-ROWS-:SUFFIX: SECTION.
            MOVE :SORTROW: (SORT-IDX)
              TO SORT-TEMP (1:LENGTH OF :SORTROW: (1))
            MOVE :SORTROW: (SORT-IDX2) TO :SORTROW: (SORT-IDX)
            MOVE SORT-TEMP (1: LENGTH OF :SORTROW: (1))
              TO :SORTROW: (SORT-IDX2)
            .
Back to top
View user's profile Send private message

TG Murphy

Active User


Joined: 23 Mar 2007
Posts: 149
Location: Ottawa Canada

PostPosted: Fri Jan 04, 2008 11:14 pm    Post subject:
Reply with quote

No responses to my previous posting yet.

Has anybody tried using them?

The topic of sorting seems to interest many people on this forum and I still see recent posts that ask the "How do I sort?" question...
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts How to change 'K' or 'M' use Sort vice_versa DFSORT/ICETOOL 5 Thu May 18, 2017 7:11 am
No new posts Adding big TEXT lines to each record ... bshkris SYNCSORT 4 Sat May 06, 2017 1:40 am
This topic is locked: you cannot edit posts or make replies. SORT trick needed bshkris SYNCSORT 6 Tue May 02, 2017 4:35 am
No new posts SORT JSON type of data maxsubrat DFSORT/ICETOOL 8 Wed Apr 19, 2017 6:01 pm
No new posts Sort Large record length cmsmoon DFSORT/ICETOOL 14 Tue Apr 11, 2017 5:49 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us