home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / RANK.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.3 KB  |  59 lines
  1. PROGRAM d8r7(input,output,dfile);
  2. (* driver for routine RANK *)
  3. CONST
  4.    np=100;
  5. TYPE
  6.    gliarray = ARRAY [1..np] OF integer;
  7.    glsarray = ARRAY [1..np] OF real;
  8. VAR
  9.    i,j,k,l : integer;
  10.    a : glsarray;
  11.    b : ARRAY [1..10] OF real;
  12.    indx,irank : gliarray;
  13.    dfile : text;
  14.  
  15. (*$I MODFILE.PAS *)
  16. (*$I INDEXX.PAS *)
  17.  
  18. (*$I RANK.PAS *)
  19.  
  20. BEGIN
  21.    glopen(dfile,'tarray.dat');
  22.    readln(dfile);
  23.    FOR i := 1 to 100 DO BEGIN
  24.       read(dfile,a[i])
  25.    END;
  26.    close(dfile);
  27.    indexx(np,a,indx);
  28.    rank(np,indx,irank);
  29.    writeln('original array is:');
  30.    FOR i := 1 to 10 DO BEGIN
  31.       FOR j := 1 to 10 DO BEGIN
  32.          write (a[10*(i-1)+j]:6:2)
  33.       END;
  34.       writeln
  35.    END;
  36.    writeln('table of ranks is:');
  37.    FOR i := 1 to 10 DO BEGIN
  38.       FOR j := 1 to 10 DO BEGIN
  39.          write(irank[10*(i-1)+j]:6)
  40.       END;
  41.       writeln
  42.    END;
  43.    writeln('press return to continue...');
  44.    readln;
  45.    writeln('array sorted according to rank table:');
  46.    FOR i := 1 to 10 DO BEGIN
  47.       FOR j := 1 to 10 DO BEGIN
  48.          k := 10*(i-1)+j;
  49.          FOR l := 1 to 100 DO BEGIN
  50.             IF (irank[l] = k) THEN b[j] := a[l]
  51.          END
  52.       END;
  53.       FOR j := 1 to 10 DO BEGIN
  54.          write(b[j]:6:2)
  55.       END;
  56.    writeln
  57.    END
  58. END.
  59.