home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / INDEXX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.2 KB  |  48 lines
  1. PROCEDURE indexx(n: integer; arrin: glsarray; VAR indx: gliarray);
  2. (* Programs using routine INDEXX must define the types
  3. TYPE
  4.    glsarray = ARRAY [1..np] OF real;
  5.    gliarray = ARRAY [1..np] OF integer;
  6. in the main routine, with np >= n.   *)
  7. LABEL 99;
  8. VAR
  9.    l,j,ir,indxt,i: integer;
  10.    q: real;
  11. BEGIN
  12.    FOR j := 1 TO n DO BEGIN
  13.       indx[j] := j
  14.    END;
  15.    l := (n DIV 2) + 1;
  16.    ir := n;
  17.    WHILE true DO BEGIN
  18.       IF (l > 1) THEN BEGIN
  19.             l := l-1;
  20.             indxt := indx[l];
  21.             q := arrin[indxt]
  22.       END ELSE BEGIN
  23.          indxt := indx[ir];
  24.          q := arrin[indxt];
  25.          indx[ir] := indx[1];
  26.          ir := ir-1;
  27.          IF (ir = 1) THEN BEGIN
  28.             indx[1] := indxt;
  29.             GOTO 99
  30.          END
  31.       END;
  32.       i := l;
  33.       j := l+l;
  34.       WHILE (j <= ir) DO BEGIN
  35.          IF (j < ir) THEN BEGIN
  36.              IF (arrin[indx[j]] < arrin[indx[j+1]]) THEN j := j+1
  37.          END;
  38.          IF (q < arrin[indx[j]]) THEN BEGIN
  39.             indx[i] := indx[j];
  40.             i := j;
  41.             j := j+j
  42.          END ELSE
  43.             j := ir+1
  44.       END;
  45.       indx[i] := indxt
  46.    END;
  47. 99:   END;
  48.