home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / SPLINT.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.6 KB  |  65 lines
  1. PROGRAM d3r4 (input,output);
  2. (* driver for routine SPLINT *)
  3. LABEL 1;
  4. CONST
  5.    np=10;
  6.    pi=3.1415926;
  7. TYPE
  8.    glnarray = ARRAY [1..np] OF real;
  9. VAR
  10.    i,nfunc : integer;
  11.    f,x,y,yp1,yp2,ypn : real;
  12.    xa,ya,y2 : glnarray;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I SPLINE.PAS *)
  16.  
  17. (*$I SPLINT.PAS *)
  18.  
  19. BEGIN
  20.    FOR nfunc := 1 to 2 DO BEGIN
  21.       IF (nfunc = 1) THEN BEGIN
  22.          writeln;
  23.          writeln ('sine function from 0 to pi');
  24.          FOR i := 1 to np DO BEGIN
  25.             xa[i] := i*pi/np;
  26.             ya[i] := sin(xa[i])
  27.          END;
  28.          yp1 := cos(xa[1]);
  29.          ypn := cos(xa[np])
  30.       END ELSE IF (nfunc = 2) THEN BEGIN
  31.          writeln;
  32.          writeln ('exponential function from 0 to 1');
  33.          FOR i := 1 to np DO BEGIN
  34.             xa[i] := 1.0*i/np;
  35.             ya[i] := exp(xa[i])
  36.          END;
  37.          yp1 := exp(xa[1]);
  38.          ypn := exp(xa[np])
  39.       END ELSE BEGIN
  40.          GOTO 1
  41.       END;
  42. (* call spline to get second derivatives *)
  43.       spline(xa,ya,np,yp1,yp2,y2);
  44. (* call splint FOR interpolations *)
  45.       writeln;
  46.       writeln ('x':9,'f(x)':13,'interpolation':17);
  47.       FOR i := 1 to 10 DO BEGIN
  48.          IF (nfunc = 1) THEN BEGIN
  49.             x := (-0.05+i/10.0)*pi;
  50.             f := sin(x)
  51.          END ELSE IF (nfunc = 2) THEN BEGIN
  52.             x := -0.05+i/10.0;
  53.             f := exp(x)
  54.          END;
  55.          splint(xa,ya,y2,np,x,y);
  56.          writeln (x:12:6,f:12:6,y:12:6)
  57.       END;
  58.       writeln;
  59.       writeln ('***********************************');
  60.       writeln ('press RETURN');
  61.       readln
  62.    END;
  63. 1:
  64. END.
  65.