CTITLEUSSORTF -- SORT MULTIPLE WORD ELEMENTS (floating point) 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR G. WHIPPLE 00020000 CA DESIGNER G. WHIPPLE 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM (SEE CRAY) 00050000 CA WRITTEN 06-26-77 00060000 C REVISED 01-17-85 BY ESN. FOR CRAY COMPATABILITY. 00070000 C REVISED 07-06-90 BY JDB/ESN. CALL USSHELL. 00080000 C REVISED 10-18-90 BY ESN. DERIVED FROM USSORT. 00090000 CA 00100000 CA 00110000 CA CALL USSORTf (NEL, NWPE, KEY, ARRAY, UPDOWN) 00120001 CA 00130000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00140000 CA 00150000 CA IN NEL I4 NUMBER OF ELEMENTS TO SORT. 00160000 CA IN NWPE I4 NUMBER OF WORDS PER ELEMENT. 00170000 CA IN KEY I4 WORD WITHIN ELEMENTS TO SORT ON - 00180000 CA 1 INDICATES FIRST WORD. 00190000 CA IN ARRAY R4 ARRAY OF INPUT ELEMENTS TO SORT. 00200000 CA IN UPDOWN A4 'DOWN' IF ELEMENTS ARE TO BE SORTED 00210000 CA INTO DECREASING ORDER; ANY OTHER 00220000 CA 4-BYTE VARIABLE IF ELEMENTS ARE TO 00230000 CA BE SORTED INTO INCREASING ORDER. 00240000 CA 00250000 CA 00260000 CA THIS SUBROUTINE SORTS MULTIPLE-WORD ELEMENTS INTO ASCENDING 00270000 CA OR DESCENDING ORDER. CALLS A SHELL SORT ROUTINE. 00280000 CAEND 00290000 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00300000 C* This is a complete rewrite of the old USSORT. All of the 00310000 C* specifications are identical. 00320000 C* 00330000 C* This module builds an array of double-precision values in XCOM. 00340000 C* The first word of each element is the value of the KEY word from an 00350000 C* element in ARRAY (ARRAY is to be sorted by KEY). The second word 00360000 C* of each element is an index representing the original element # 00370000 C* of KEY in ARRAY. We found it necessary to include the original 00380000 C* index because in sorting seismic traces, some of the original order 00390000 C* does need to be preserved. In the example below, the recordsare 00400000 C* sorted by trace. Notice that the results from a bubble sort and 00410000 C* a shell sort are different (denoted with a '.' over the numbers). 00420000 C* 00430000 C* ARRAY: ShotPt 1 1 1 1 2 2 2 2 3 3 3 3 00440000 C* Trace 1 2 3 4 1 2 3 4 1 2 3 4 00450000 C* . . . . . . 00460000 C* Bubble- ShotPt 1 2 3 1 2 3 1 2 3 1 2 3 00470000 C* Sorted Trace 1 1 1 2 2 2 3 3 3 4 4 4 00480000 C* . . . . . . 00490000 C* Shell- ShotPt 1 2 3 3 1 2 2 3 1 1 2 3 00500000 C* Sorted Trace 1 1 1 2 2 2 3 3 3 4 4 4 00510000 C* . . . . . . 00511002 C* While both results are indeed in order by trace number, what we 00530000 C* really need is the result put out by the bubble sort. If the 00540000 C* shell-sorted array were to later be sorted by some other key 00550000 C* (i.e. not shotpoint or trace), the data will most likely be 00560000 C* so jumbled up that the seismic display will look like a bunch 00570000 C* of static. Because the elements of the double-precision array 00580000 C* (built by this module) are unique, other fields sharing the 00590000 C* key-field value will not be mixed up as they were above. 00600000 C* . . . . . . 00601002 C* USSHELL is then called to sort the values in COM. Finally, 00620000 C* ARRAY is rearranged according to the indeces (2nd words) in COM 00630000 C* so that ARRAY is returned in sorted order. 00640000 C* Belive it or not, all of this runs orders of magnitude faster 00650000 C* than a simple routine using a bubble sort. 00660000 C* - JDB 00670000 C* LOCAL 00680000 C* VARIABLE TYPE DESCRIPTION 00690000 C* 00700000 C* XCOM R4 Common storage to hold the double-precision 00710000 C* array values. 00720000 C* ILEN, I4 00730000 C* OLEN, IPTR 00740000 C* MinKey R4 Minimum value of the key elements in ARRAY. 00750000 C* Indx I4 Index for an element in ARRAY. 00760000 C* Elem I4 Loop variable representing element index. 00770000 C* 00780000 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00790000 C EJECT 00800000 SUBROUTINE USSORTf (NEL, NWPE, KEY, ARRAY, UPDOWN) 00810001 C 00820000 C* I don't like IMPLICITs, but somebody wants it here! * 00830000 IMPLICIT INTEGER (A-Z) 00840000 INTEGER NEL, NWPE, KEY 00850000 REAL MINKEY 00860000 CHARACTER*4 UPDOWN 00870000 REAL ARRAY (1) 00880000 C 00890000 INTEGER ILEN, OLEN, IPTR, INDX, ELEM 00900000 COMMON COM (1) 00910000 REAL XCOM (1) 00920000 EQUIVALENCE (COM(1), XCOM(1)) 00930000 C 00940000 C** make sure there's something to sort ** 00950000 IF(NEL .LE. 1 ) GO TO 70 00960000 C 00970000 C** Allocate memory ** 00980000 ILEN = NEL*(NWPE+2) 00990000 CALL GETMN2 (COM, ILEN, IPTR, OLEN) 01000000 IF (ILEN .GT. OLEN) CALL XDUMPX 01010000 C 01020000 C** Find minimum value of KEYs in ARRAY ** 01030000 MINKEY = 1.0 01040000 DO 10 ELEM = 1, NEL 01050000 IF (ARRAY(NWPE*(ELEM-1)+KEY) .LT. MINKEY) 01060000 * MINKEY = ARRAY(NWPE*(ELEM-1)+KEY) 01070000 10 CONTINUE 01080000 MINKEY = 1.0 - MINKEY 01090000 C* MINKEY = 0 if all of the key values are positive. 01100000 C* If the minimum key value is negative, say, -25, then MINKEY will 01110000 C* be 26. When the array is built (in the next step), MINKEY is 01120000 C* added to each of the KEY values for storage in the first word of 01130000 C* the double-precision element. This ensures that each of those 01140000 C* values is positive, so that when combined with the index #s, they 01150000 C* will be sorted correctly. Since the double-precision array is 01160000 C* needed only to order the indeces (not to order the actual ARRAY), 01170000 C* the actual value of the 1st words is irrelevant - as long as they 01180000 C* have the same relative values as did the original KEYs. 01190000 C 01200000 C* Build double-precision array: 1st word = key value * 01210000 C* 2nd word = index * * * 01220000 C ** First word (for each element): ** 01230000 DO 20 ELEM = 1, NEL 01240000 XCOM(IPTR+2*ELEM-1)= ARRAY(NWPE*(ELEM-1)+KEY) + MINKEY 01250000 20 CONTINUE 01260000 C ** Second word : ** 01270000 C ** To preserve the order as described above, indeces must ** 01280000 C ** go in different directions for UP sorts & DOWN sorts. ** 01290000 IF (UPDOWN .EQ. 'DOWN') THEN 01300000 DO 30 ELEM = 1, NEL 01310000 COM(IPTR+2*ELEM) = NEL + 1 - ELEM 01320000 30 CONTINUE 01330000 ELSE 01340000 DO 40 ELEM = 1, NEL 01350000 COM(IPTR+2*ELEM) = ELEM 01360000 40 CONTINUE 01370000 ENDIF 01380000 C 01390000 C** Sort double-precision array: ** 01400000 CALL USSHELL (NEL, COM(IPTR+1)) 01410000 C 01420000 C 01430000 C* Elements in COM are now sorted by KEY and INDEX. * 01440000 C* Use the sorted indeces to rewrite ARRAY in sorted order. * 01450000 C 01460000 IF (UPDOWN .EQ. 'DOWN') THEN 01470000 DO 50 ELEM = 1, NEL 01480000 INDX = NEL + 1 - COM(IPTR+2*ELEM) 01490000 CALL ARMVE (ARRAY(NWPE*(INDX-1)+1), 01500000 * COM(IPTR+2*NEL+1+NWPE*(NEL-ELEM)), NWPE) 01510000 50 CONTINUE 01520000 ELSE 01530000 DO 60 ELEM = 1, NEL 01540000 INDX = COM(IPTR+2*ELEM) 01550000 CALL ARMVE (ARRAY(NWPE*(INDX-1)+1), 01560000 * COM(IPTR+2*NEL+1+NWPE*(ELEM-1)), NWPE) 01570000 60 CONTINUE 01580000 ENDIF 01590000 CALL ARMVE (COM(IPTR+2*NEL+1), ARRAY, NWPE*NEL) 01600000 C 01610000 C** Free memory: ** 01620000 CALL FREMN2 (COM(IPTR+1), OLEN) 01630000 C 01640000 70 RETURN 01650000 END 01660000