CTITLESABSRT -- BUBBLE SORT ROUTINE 00001001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. O'NEILL 00002001 CA DESIGNER D. O'NEILL 00003001 CA LANGUAGE S/370 FORTRAN H 00004001 CA WRITTEN 11-30-83 00005001 C REVISED 03-11-88 TJT. OPTIMIZE DO LOOPS. 00006010 C REVISED MM-DD-YY PROGRAMMER 00006110 CA 00007001 CA 00008001 CA CALL SABSRT (SORT, NMEMB, NPTS, NSORT, NORDER, PRNTSW, 00009001 CA KPPRNT, *) 00009301 CA 00009401 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00009501 CA 00009601 CA IN/OUT SORT I4 INFORMATION TO BE SORTED; ON RETURN, 00100001 CA CONTAINS SORTED VERSION 00120001 CA IN NMEMB I4 1ST DIMENSION OF 'SORT'; THE NUMBER OF 00130001 CA ELEMENTS 00140001 CA IN NPTS I4 THE NUMBER OF ITEMS TO BE SORTED 00170001 CA 2ND DIMENSION OF 'SORT' 00180001 CA IN NSORT I4 THE FIRST DIMENSION INDEX OF THE ELEMENT 00210001 CA TO BE USED TO SORT ON 00220001 CA IN NORDER I4 ORDER FLAG 00250001 CA IN PRNTSW I4 PRINT SWITCH 00270001 CA IN KPPRNT I4 FORTRAN UNIT NUMBER FOR PRINTED OUTPUT 00271001 CA 00272001 CA THIS ROUTINE DOES A BUBBLE SORT ON A TWO DIMENSIONAL ARRAY 00273001 CA USING ONE OF THE ELEMENTS OF THE FIRST DIMENSION TO SORT ON. 00274001 CAEND 00275001 C EJECT 00280001 C SPACE LIMITATIONS: TWO ARRAYS USED AS WORK SPACE ARE LIMITED IN 00310001 C SIZE. "SORTED" IS (12,1000), AND "ELEMNT" IS (1000). 00320001 C THIS MEANS THAT "SORT" CAN HAVE MAXIMA OF 12 ELEMENTS 00330001 C PER ITEM TO BE SORTED AND 1000 ITEMS TO SORT. 00340001 C 00341001 C LOCAL OR INTERNAL ARRAYS 00342001 C 00343001 C ARGUMENT TYPE LENGTH DESCRIPTION 00344001 C SORT I4 (NMEMB, A TWO-DIMENSIONAL ARRAY CONTAINING THE 00350001 C NPTS) INFORMATION TO BE SORTED; ON RETURN, 00360001 C CONTAINS SORTED VERSION 00370001 C ELEMNT I4 1000 KEY MEMBER OF SORT TO BE SORTED 00370101 C SORTED I4 12,1000 WORK ARRAY TO SORT INTO 00370201 C 00370401 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00370501 C 00370601 C ARGUMENT TYPE DESCRIPTION 00370701 C MIN I4 VALUE OF PRESENT MINIMUM 00370801 C MINI I4 INDEX OF PRESENT MINIMUM IN SORT 00370901 C NPTS I4 SECOND DIMENSION OF "SORT"; THE NUMBER OF 00371001 C ITEMS TO BE SORTED (E.G., IF ONE YEAR'S 00371101 C WORTH OF DATES ARE TO BE SORTED, NPTS=365 00371201 C (366 FOR LEAP YEARS) 00371301 C NMEMB I4 FIRST DIMENSION OF "SORT"; THE NUMBER OF 00371401 C ELEMENTS; ASSOCIATED PIECES OF INFORMATION 00372001 C (E.G., TO SORT A LIST OF JULIAN DAYS, YEARS, 00373001 C AND DAILY RECEIPTS OF A STORE, NN=3) 00374001 C NSORT I4 THE ELEMENT OF THE FIRST DIMENSION OF 00379001 C 'SORT' BE ORDERED (E.G., IF YEAR IS (1,N), 00379101 C DAY IS (2,N), AND DAILY RECEIPTS ARE IN 00379201 C (3,N),NSORT=3 TO SORT BY RECEIPTS VALUE) 00379301 C NORDER I4 1 = SORT FROM LOWEST TO HIGHEST VALUE 00379401 C -1 = SORT FROM HIGHEST TO LOWEST VALUE 00379501 C PRNTSW I4 PRINT SWITCH; IF 1, PRINT ANY OUTPUT 00379601 C KPPRNT I4 FORTRAN UNIT NUMBER FOR PRINTED OUTPUT 00379701 C********************************************************************** 00380000 C 00390000 SUBROUTINE SABSRT(SORT,NMEMB,NPTS,NSORT,NORDER,PRNTSW,KPPRNT,*) 00400001 IMPLICIT INTEGER (A-Z) 00401000 INTEGER SORT(NMEMB,NPTS) 00410000 INTEGER SORTED(12,1000) 00411000 INTEGER ELEMNT(1000) 00412000 C 00420000 C TRANSFER THE KEY MEMBER OF "SORT" TO "ELEMNT" FOR SORTING 00430000 C 00440000 DO 10 I=1,NPTS 00450000 ELEMNT(I)=SORT(NSORT,I) 00460009 10 CONTINUE 00470000 C 00480000 C BUBBLE SORT "ELEMNT"; SORT "SORT" INTO "SORTED" USING RESULTS 00490000 C 00500000 MIN=ELEMNT(1) 00510000 MINI=1 00520000 START=999999*NORDER 00521001 DO 40 J=1,NPTS 00530000 MIN=START 00541001 IF(NORDER.EQ.1)GO TO 20 00542002 C 00543002 C SORT HIGHEST TO LOWEST 00544002 C 00545002 DO 15 I=1,NPTS 00550002 IF(ELEMNT(I).LT.MIN)GO TO 15 00570002 MIN=ELEMNT(I) 00580000 MINI=I 00590000 15 CONTINUE 00600002 GO TO 30 00600102 C 00600202 C SORT LOWEST TO HIGHEST 00600302 C 00600402 20 DO 25 I=1,NPTS 00601002 IF(ELEMNT(I).GT.MIN)GO TO 25 00602002 MIN=ELEMNT(I) 00604002 MINI=I 00605002 25 CONTINUE 00606002 C 00607002 C MOVE "SORT" INTO "SORTED" USING RESULTS OF BUBBLE SORT 00607102 C 00608002 30 DO 35 K=1,NMEMB 00610002 SORTED(K,J)=SORT(K,MINI) 00620000 35 CONTINUE 00630002 ELEMNT(MINI)=START 00640001 40 CONTINUE 00650000 C 00660000 C OVERWRITE ORIGINAL "SORT" WITH "SORTED" (SORTED "SORT") AND RETURN 00670000 C 00680000 DO 50 J=1,NPTS 00690000 DO 50 I=1,NMEMB 00700000 SORT(I,J)=SORTED(I,J) 00710000 50 CONTINUE 00720000 RETURN 00730000 END 00740000