home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / SMOOFT.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.3 KB  |  60 lines
  1. PROGRAM d13r20(input,output);
  2. (* driver for routine SMOOFT *)
  3. CONST
  4.    n=100;
  5.    hash=0.05;
  6.    scale=100.0;
  7.    pts=10.0;
  8.    m=258;  (* 2 + first integral power of 2 that is greater or
  9.          equal to (n+2*pts) *)
  10. TYPE
  11.    glyarray = ARRAY [1..m] OF real;
  12.    gldarray = glyarray;
  13. VAR
  14.    glinext,glinextp : integer;
  15.    glma : ARRAY [1..55] OF real;
  16.    gliset : integer;
  17.    glgset : real;
  18.    bar : real;
  19.    i,ii,idum,j,k,nstp : integer;
  20.    y : glyarray;
  21.    txt : PACKED ARRAY [1..50] OF char;
  22.  
  23. (*$I MODFILE.PAS *)
  24. (*$I RAN3.PAS *)
  25.  
  26. (*$I GASDEV.PAS *)
  27.  
  28. (*$I FOUR1.PAS *)
  29.  
  30. (*$I REALFT.PAS *)
  31.  
  32. (*$I SMOOFT.PAS *)
  33.  
  34. BEGIN
  35.    gliset := 0;
  36.    idum := -7;
  37.    FOR i := 1 to n DO BEGIN
  38.       y[i] := 3.0*i/n*exp(-3.0*i/n);
  39.       y[i] := y[i]+hash*gasdev(idum)
  40.    END;
  41.    FOR k := 1 to 3 DO BEGIN
  42.       nstp := n DIV 20;
  43.       writeln('data':8,'graph':11);
  44.       FOR i := 1 to 20 DO BEGIN
  45.          ii := nstp*(i-1)+1;
  46.          FOR j := 1 to 50 DO BEGIN
  47.             txt[j] := ' '
  48.          END;
  49.          bar := round(scale*y[ii]);
  50.          FOR j := 1 to 64 DO BEGIN
  51.             IF (j <= bar) THEN txt[j] := '*'
  52.          END;
  53.          writeln (y[ii]:10:6,' ':4,txt)
  54.       END;
  55.       writeln(' press return to smooth ...');
  56.       readln;
  57.       smooft(y,n,pts)
  58.    END
  59. END.
  60.