home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / CRANK.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.7 KB  |  73 lines
  1. PROGRAM d13r17(input,output,dfile);
  2. (* driver for routine CRANK *)
  3. CONST
  4.    ndat=20;
  5.    nmon=12;
  6. TYPE
  7.    narray = ARRAY [1..ndat] OF real;
  8.    glsarray = narray;
  9.    cityname = string[15];
  10.    monthname = string[4];
  11. VAR
  12.    i,j : integer;
  13.    data,order,s : narray;
  14.    rays : ARRAY [1..ndat,1..nmon] OF real;
  15.    city : ARRAY [1..ndat] OF cityname;
  16.    mon : ARRAY [1..12] OF monthname;
  17.    txt : string[64];
  18.    dfile : text;
  19.  
  20. (*$I MODFILE.PAS *)
  21. (*$I SORT2.PAS *)
  22.  
  23. (*$I CRANK.PAS *)
  24.  
  25. BEGIN
  26.    glopen(dfile,'table2.dat');
  27.    readln(dfile);
  28.    readln(dfile,txt);
  29.    read(dfile,city[1]);
  30.    FOR i := 1 to 12 DO read(dfile,mon[i]);
  31.    readln(dfile);
  32.    readln(dfile);
  33.    FOR i := 1 to ndat DO BEGIN
  34.       read(dfile,city[i]);
  35.       FOR j := 1 to 12 DO read(dfile,rays[i,j]);
  36.       readln(dfile)
  37.    END;
  38.    close(dfile);
  39.    writeln(txt);
  40.    write(' ':15);
  41.    FOR i := 1 to 12 DO write(mon[i]:4);
  42.    writeln;
  43.    FOR i := 1 to ndat DO BEGIN
  44.       write(city[i]);
  45.       FOR j := 1 to 12 DO write(round(rays[i,j]):4);
  46.       writeln
  47.    END;
  48.    writeln(' press return to continue ...');
  49.    readln;
  50. (* replace solar flux in each column by rank order *)
  51.    FOR j := 1 to 12 DO BEGIN
  52.       FOR i := 1 to ndat DO BEGIN
  53.          data[i] := rays[i,j];
  54.          order[i] := i
  55.       END;
  56.       sort2(ndat,data,order);
  57.       crank(ndat,data,s[i]);
  58.       FOR i := 1 to ndat DO BEGIN
  59.          rays[round(order[i]),j] := data[i]
  60.       END
  61.    END;
  62.    write(' ':15);
  63.    FOR i := 1 to 12 DO write(mon[i]:4);
  64.    writeln;
  65.    FOR i := 1 to ndat DO BEGIN
  66.       write(city[i]);
  67.       FOR j := 1 to 12 DO BEGIN
  68.          write(round(rays[i,j]):4)
  69.       END;
  70.       writeln
  71.    END
  72. END.
  73.