CTITLEUSSHELL -- SHELL SORT DOUBLEWORD ENTRIES 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. BOWLING 00020005 CA DESIGNER J. BOWLING 00030005 CA LANGUAGE FORTRAN 00040005 CA SYSTEM IBM (SEE CRAY) 00050005 CA WRITTEN 07-05-90 00060005 C REVISED MM-DD-YY BY PROGRAMMER FOR REASON 00070005 CA 00080002 CA 00090002 CA CALL USSHELL (NEL, ARRAY) 00100002 CA 00110002 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00120005 CA 00121005 CA IN NEL I4 NUMBER OF ELEMENTS TO SORT. 00130005 CA IN ARRAY R8 ARRAY OF ELEMENTS TO SORT; RETURNS IN 00140005 CA SORTED ORDER. 00141005 CA 00150002 CA 00160002 CA THIS SUBROUTINE USES A SHELL SORT TO SORT DOUBLE-WORD 00170005 CA ELEMENTS INTO ASCENDING ORDER. 00180005 CAEND 00190002 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00191003 C* This module is a rewrite of USSORT by G. Whipple 06/26/77 00199203 C* and revised 01/17/85 by ESN for Cray compatability. It does NOT 00199303 C* replace the original USSORT. This module must be called from 00199403 C* the new USSORT, which passes in an array of unique double- 00199503 C* precision elements. 00199603 C* The algorithm has been changed from a bubble sort to a 00199703 C* shell sort for faster(!) execution. 00199803 C* 00199903 C* LOCAL 00201103 C* VARIABLE TYPE DESCRIPTION 00201203 C* 00201303 C* Index I4 Loop variable for making a comparison pass 00201403 C* (3rd level loop variable). 00201503 C* Limit I4 Element to sort up to in current pass. 00201603 C* Offset I4 # of elements away to which you are comparing curren00201703 C* element ({outermost} 1st level loop variable). 00201803 C* Switch I4 Element that was swapped in last pass, zero if 00202303 C* no swap in last pass (2nd level loop variable). 00202403 C* Temp I4 Variable for making a swap of Array elements. 00202503 C* 00202603 C* This programmer does not believe in IMPLICIT declarations. 00202703 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00202803 C* 00202903 C* A shell-sort begins by comparing elements that are far apart 00203003 C* (separated by the value of the Offset, which is initially half 00203103 C* the distance between the first and last elements), then compares 00203203 C* elements that are closer together. 00203303 C* The last iteration (Offset = 1) is merely a bubble sort. 00203403 C* 00203503 C* Suppose that the elements of Array are A1..A13 as below, 00203603 C* and that NEL = 13. The algorithm begins: 00203703 C* Offset := NEL/2 = 6 00204003 C* Limit := NEL-Offset = 7 00204103 C* Index := 1 00204303 C* 00204403 C* A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 A11 A12 A13 00204703 C* \/ \/ 00204803 C* Array(Index) Array(Index+Offset) 00204903 C* 00205603 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00205703 SUBROUTINE USSHELL (NEL, ARRAY) 00213002 C 00214002 IMPLICIT INTEGER (A-Z) 00215005 INTEGER NEL 00220003 DOUBLE PRECISION ARRAY(NEL) 00230003 C 00240002 INTEGER OFFSET, LIMIT, SWITCH, INDEX 00250003 DOUBLE PRECISION TEMP 00270003 C 00280002 C * initialize comparison offset to half of # elements. * 00290003 OFFSET = NEL / 2 00300002 IF (OFFSET .LT. 1) GOTO 99 00310002 C 00320002 C**** DO UNTIL OFFSET = 0 ***** 00330002 10 LIMIT = NEL - OFFSET 00340002 C 00360002 C **WHILE Switch > 0 (when last pass made a swap) DO ** 00370003 C ** compare elements separated by OFFSET ** 00380003 C * no switches in this loop b/c it just started! * 00390003 20 SWITCH = 0 00400002 C 00410002 DO 40 INDEX = 1,LIMIT 00420002 IF (ARRAY(INDEX) .LE. ARRAY(INDEX+OFFSET)) GOTO 40 00430003 C *** swap these two elements *** 00440003 TEMP = ARRAY(INDEX) 00460003 ARRAY(INDEX) = ARRAY(INDEX + OFFSET) 00470003 ARRAY(INDEX + OFFSET) = TEMP 00480003 SWITCH = INDEX 00490003 C ** NEXT INDEX ** 00510002 40 CONTINUE 00520002 C 00530002 C * on next pass, only sort up to place of last switch * 00540003 LIMIT = SWITCH - OFFSET 00550002 IF (SWITCH .GT. 0) GOTO 20 00560002 C **end of WHILE loop** 00570003 C 00580002 C * no swaps on last offset; try offset half as big * 00590003 OFFSET = OFFSET / 2 00600002 C 00610002 IF (OFFSET .GT. 0) GOTO 10 00620002 C**** end of DO UNTIL Offset = 0 ***** 00630003 C 00640002 99 RETURN 00650002 END 00660002