: I need to combine 4 programms in one. I tried with exec and swapvectors,but it's not working. Please help!
: This is how I tried to unite them:
: program final;
: {$M 4000,0,0}
: uses dos,crt;
:
: procedure bessel;
: begin
: swapvectors;
: exec('c:\program files\tp\work', 'bessel');
: swapvectors;
: exec('bessel.exe','');
: swapvectors;end;
:
: procedure kelvin;
: begin
: swapvectors;
: exec('c:\program files\tp\work', 'kelvin');
: swapvectors;
: exec('kelvin.exe','');
: swapvectors;end;
:
: procedure regresie_polinomiala;
: begin
: swapvectors;
: exec('c:\program files\tp\work', 'regresie_polinomiala');
: swapvectors;
: exec('regresie_polinomiala.exe','');
: swapvectors;end;
:
: procedure newton_stanga;
: begin
: swapvectors;
: exec('c:\program files\tp\work', 'newton_stanga');
: swapvectors;
: exec('newton_stanga.exe','');
: swapvectors;end;
:
: begin
: writeln('loading...');
: bessel;
: kelvin;
: regresie_polinomiala;
: newton_stanga;
: readln;
: readkey;
: end.
:
: these are the original programms:
: PROGRAM Bessel;
: USES Crt;
: {$M 4000,0,0 }
: CONST eps1=1E-164;
: VAR x:Real;
:
: FUNCTION Jn(n:Integer;x:real):real;
: VAR i : integer;
: z1,z2,z3,zs : real;
:
: BEGIN
: zs:=1;
: FOR i:=1 TO n DO BEGIN
: z1:=x/2/i;
: zs:=zs*z1;END;
: z2:=zs;
: i:=0;
: REPEAT
: z1:=-x/2/(i+1); z3:=x/2/(n+i+1);
: z2:=z2*z1*z3; zs:=zs+z2; i:=i+1
: UNTIL (Abs(z2) < eps1);
: Jn:=zs
: END;
:
: FUNCTION J0(x:real):real;
: VAR y,f,t:real;
: BEGIN
: IF (x<3)THEN BEGIN
: y:=Sqr(x/3);
: J0:=(((((0.00021*y-0.0039444)*y+0.0444479)*y-0.3163866)*y+1.2656208)*y-2.2499997)*y+1
: END
: ELSE BEGIN
: y:=3/x;
: f:=(((((0.00014476*y-0.00072805)*y+0.00137237)*y-0.00009512)*y-0.0055274)*y-0.00000077)*y+0.79788456;
: t:=(((((0.00013558*y-0.00029333)*y-0.00054125)*y+0.00262573)*y-0.00003954)*y-0.04166397)*y-
: 0.78539816+x;
: J0:=1/Sqrt(x)*f*Cos(t)
: END;
: END;
:
: FUNCTION J1(x:real):real;
: VAR y,f,t:real;
: BEGIN
: IF (x<3)THEN BEGIN
: y:=Sqr(x/3);
: J1:=((((((0.00001109*y-0.00031761)*y+
: 0.00443319)*y-0.03954289)*y+
: 0.21093573)*y-0.56249985)*y+0.5)*x
: END
: ELSE
: BEGIN
: y:=3/x;
: f:=(((((-0.00020033*y+0.00113653)*y-0.00249511)*y+0.00017105)*y+
: 0.01659667)*y+0.00000156)*y+0.79788456;
: t:=(((((-0.00029166*y+0.00079824)*y+0.00074348)*y-0.00637879)*y+0.00005659)*
: y+0.12499612)*y-2.35619449+x;
: J1:=1/Sqrt(x)*f*Cos(t)
: END
: END;
:
: BEGIN {Main Prog}
: ClrScr;
: REPEAT
: Write('x=');ReadLn(x);
: WriteLn('J0=',J0(x):10:7,' J1=',J1(x):10:7);
: WriteLn('J0=',Jn(0,x):10:7,'J1=',Jn(1,x):10:7)
: UNTIL (x<0);
: readkey;
: END.
:
: PROGRAM KELVIN;
: USES Crt,Printer,Graph;
: TYPE
: VECTOR = ARRAY[1..8] OF real;
: VALKELVIN = RECORD
: Z:real;
: KEL: VECTOR;
: END;
: FILETYPE = file OF VALKELVIN;
: VAR
: SETKELVIN: VALKELVIN;
: FILEKELVIN: FILETYPE;
: NUMAR: integer;
: RASPUNS: string[2];
: X,XINF,XSUP,DELTAX,EPS: real;
: KELVIN: VECTOR;
: PROCEDURE CALCUL_KELVIN(X,EPS:real;VAR KELVIN: VECTOR);
: {CALCULUL VALORILOR FUNCTIILOR KELVIN SI ALE DERIVATELOR ACESTORA, PENTRU...}
: {ARGUMENTUL X SI DIFERENTA MAXIMA ADMISA DINTRE DOUA SUME PARTIALE EPS}
: CONST GAMA = 0.5772156649015328606065;
: VAR
: B1,B2,BD1,BD2,A1,A2:real;
: TKEL,SKEL: VECTOR;
: PRECISE: boolean;
: n,m: real;
: i: integer;
: BEGIN
: B1 := 1;
: B2 := sqr(X/2);
: BD1 := 2/X;
: BD2 := X/2;
: TKEL[1] := 1;
: TKEL[2] := sqr(X/2);
: TKEL[3] := 0;
: TKEL[4] := X/2;
: A1 := 0;
: A2 := 1;
: TKEL[5] := -ln(X/2) - GAMA + PI/4*sqr(X/2);
: TKEL[6] := -PI/4 + sqr(X/2)*(1-ln(X/2)-GAMA);
: TKEL[7] := -1/X + PI/4*(X/2);
: TKEL[8] := (X/2)*((1-ln(X/2)-GAMA)-1/2);
: n := 0;
: m := 1;
: REPEAT
: PRECISE := TRUE;
: n := n + 2;
: m := m + 2;
: B1 :=-B1/((n-1)*(n-1)*n*n)*sqr(X/2)*sqr(X/2);
: B2 :=-B2/((m-1)*(m-1)*m*m)*sqr(X/2)*sqr(X/2);
: BD1 :=-BD1/((n-1)*(n-1)*n*n)*sqr(X/2)*sqr(X/2);
: BD2:=-BD2/((m-1)*(m-1)*m*m)*
: sqr(X/2)*sqr(X/2);
: A1 := A1 + 1/(n-1) + 1/n;
: A2 := A2 + 1/(m-1) + 1/m;
: SKEL[1]:=TKEL[1] + B1;
: SKEL[2]:=TKEL[2] + B2;
: SKEL[3]:=TKEL[3] + n*BD1;
: SKEL[4]:=TKEL[4] + m*BD2;
: SKEL[5]:=TKEL[5]+B1*(A1-ln(X/2)-GAMA)+PI/4*B2;
: SKEL[6]:=TKEL[6]-PI/4*B1+B2*(A2-ln(X/2)-GAMA);
: SKEL[7]:=TKEL[7]+BD1*(n*(A1-ln(X/2)-GAMA)-1/2)+PI/4*m*BD2;
: SKEL[8]:=TKEL[8]-PI/4*n*BD1+BD2*(m*(A2-ln(X/2)-GAMA)-1/2);
: FOR i := 1 TO 8 DO
: IF abs(SKEL[i]-TKEL[i]) >= EPS THEN
: PRECISE := FALSE;
: FOR i := 1 TO 8 DO
: TKEL[i] := SKEL[i]
: UNTIL PRECISE;
: FOR i := 1 TO 8 DO
: KELVIN[i] := SKEL[i]
: END;{CALCUL_KELVIN}
: PROCEDURE CREARE(VAR FILEKELVIN:FILETYPE);
: {CREEAZA FISIERUL VALORILOR FUNCTIILOR KELVIN SI ALE DERIVATELOR ACESTORA}
: VAR i: integer;
: BEGIN
: assign(FILEKELVIN,'KELVIN.dat');
: rewrite(FILEKELVIN);
: write('X inf = ');
: readln(XINF);
: write('X sup = ');
: readln(XSUP);
: write('DELTA X = ');
: readln(DELTAX);
: write('EPSILON = ');
: readln(EPS);
: X := XINF;
: WHILE X <= XSUP + 1E-10 DO
: BEGIN
: CALCUL_KELVIN(X,EPS,KELVIN);
: WITH SETKELVIN DO
: BEGIN
: Z := X;
: FOR i := 1 TO 8 DO
: KEL[i] := KELVIN[i]
: END;
: write(FILEKELVIN,SETKELVIN);
: writeln('X= ',X:7:3);
: X := X + DELTAX
: END;
: close(FILEKELVIN);
: writeln;
: writeln;
: writeln('FISIERul CU VALORILE FUNCTIILOR KELVIN A FOST CREAT')
: END;{CREARE}
: PROCEDURE LISTARE(VAR FILEKELVIN:FILETYPE);
: {LISTEAZA VALORILE FUNCTIILOR KELVIN SI ALE DERIVATELOR ACESTORA}
: VAR
: LIM1,LIM2,i,POZ:longint;
: ALFA,BETA,GAMA: real;
: BEGIN
: assign(FILEKELVIN,'KELVIN.dat');
: reset(FILEKELVIN);
: read(FILEKELVIN,SETKELVIN);
: ALFA := SETKELVIN.Z;
: read(FILEKELVIN,SETKELVIN);
: BETA := SETKELVIN.Z;
: GAMA := BETA - ALFA;
: write('X inf = ');
: readln(XINF);
: write('X sup = ');
: readln(XSUP);
: LIM1 := trunc((XINF-ALFA)/GAMA+1E-06);
: LIM2 := trunc((XSUP-ALFA)/GAMA+1E-06);
: writeln(lst,'X':3,'ber(x)':18,'bei(x)':19,'d(ber)/dx':19,'d(bei)/dx':19);
: writeln(lst);
: FOR i := LIM1 TO LIM2 DO
: BEGIN
: seek(FILEKELVIN,i);
: read(FILEKELVIN,SETKELVIN);
: WITH SETKELVIN DO
: writeln(lst,Z:7:3,' ',KEL[1],' ',KEL[2],' ',KEL[3],' ',KEL[4])
: END;
: writeln(lst);
: writeln(lst);
: readln;
: writeln(lst,'X':3,'ker(x)':18,'kei(x)':19,'d(ker)/dx':19,'d(kei)/dx':19);
: writeln(lst);
: FOR i := LIM1 TO LIM2 DO
: BEGIN
: seek(FILEKELVIN,i);
: read(FILEKELVIN,SETKELVIN);
: WITH SETKELVIN DO
: writeln(lst,Z:7:3,' ',KEL[5],' ',KEL[6],' ',KEL[7],' ',KEL[8])
: END;
: close(FILEKELVIN)
: END;{LISTARE}
: PROCEDURE GRAFIC(VAR FILEKELVIN: FILETYPE);
: {TRASEAZA GRAFICELE FUNCTIILOR KELVIN SI ALE DERIVATELOR ACESTORA}
: VAR
: GrDriver,GrMode,GrError: integer;
: SETKELVIN: VALKELVIN;
: FUNC: ARRAY[1..8] OF string[10];
: MAXIM,MINIM: real;
: RASPUNS,RASP: string[2];
: LIM1,LIM2,i,POZ: longint;
: k: integer;
: DIMX,DIMY,ORIGINE,DELTA,X0,Y0,N1,N2,N3: word;
: X,Y: array[1..2] OF word;
: ALFA,BETA,GAMA,VALX,VALY: real;
: SX,SY,S1Y,S2Y,S3Y: string[10];
: TEXTY: string;
: BEGIN
: assign(FILEKELVIN,'KELVIN.dat');
: reset(FILEKELVIN);
: FUNC[1] := 'ber(x)';
: FUNC[2] := 'bei(x)';
: FUNC[3] := 'd(ber)/dx';
: FUNC[4] := 'd(bei)/dx';
: FUNC[5] := 'ker(x)';
: FUNC[6] := 'kei(x)';
: FUNC[7] := 'd(ker)/dx';
: FUNC[8] := 'd(kei)/dx';
: RASPUNS := 'DA';
: WHILE (RASPUNS = 'DA') or (RASPUNS = 'da') DO
: BEGIN
: i := 1;
: RASP := 'NU';
: WHILE (i <= 8) AND ((RASP = 'NU') OR (RASP = 'nu')) DO
: BEGIN
: write('GRAFICUL FUNCTIEI ',FUNC[i],'...DA(da)/ NU(nu)?...');
: readln(RASP);
: IF (RASP='DA') or (RASP='da') THEN
: k:=i;
: i := i + 1
: END;
: seek(FILEKELVIN,0);
: read(FILEKELVIN,SETKELVIN);
: ALFA := SETKELVIN.Z;
: read(FILEKELVIN,SETKELVIN);
: BETA := SETKELVIN.Z;
: GAMA := BETA - ALFA;
: write('X inf = ');
: readln(XINF);
: write('X sup = ');
: readln(XSUP);
: LIM1 := trunc((XINF-ALFA)/GAMA+1E-06);
: LIM2 := trunc((XSUP-ALFA)/GAMA+1E-06);
: seek(FILEKELVIN,LIM1);
: read(FILEKELVIN,SETKELVIN);
: WITH SETKELVIN DO
: BEGIN
: MAXIM := KEL[k];
: MINIM := KEL[k]
: END;
: FOR i := LIM1 TO LIM2 DO
: BEGIN
: seek(FILEKELVIN,i);
: read(FILEKELVIN,SETKELVIN);
: WITH SETKELVIN DO
: BEGIN
: IF MAXIM<KEL[k] THEN
: MAXIM:= KEL[k];
: IF MINIM>KEL[k] THEN
: MINIM := KEL[k]
: END
: END;
: DetectGraph(GrDriver,GrMode);
: InitGraph(GrDriver,GrMode,'d:\pascal\BGI');
: GrError := GraphResult;
: IF GrError <> GrOK THEN
: BEGIN
: writeln('EROARE:,GraphErrorMsg(GrError)');
: CloseGraph;
: close(FILEKELVIN);
: Exit
: END;
: SetGraphMode(GetMaxMode);
: DIMX := GetMaxX - 20;
: DIMY := GetMaxY - 20;
: IF MAXIM*MINIM < 0 THEN
: ORIGINE:=trunc(DIMY/(MAXIM-MINIM)*MAXIM)
: ELSE
: ORIGINE := DIMY;
: DELTA := ORIGINE - 10;
: SetTextStyle(SmallFont,HorizDir,2);
: SetColor(Green);
: Line(0,0,0,DIMY);
: Line(0,ORIGINE,DIMX+20,ORIGINE);
: MoveTo(DIMX,DELTA);
: OutText('x');
: MoveTo(20,20);
: OutText(FUNC[k]);
: SetColor(Cyan);
: FOR i := 0 TO 9 DO
: BEGIN
: X0 := trunc(DIMX*i/10);
: Y0 := DIMY - trunc(DIMY*i/10);
: Line(X0,DELTA,X0,ORIGINE+10);
: IF i > 0 THEN
: MoveTo(X0 - 40,ORIGINE - 20)
: ELSE MoveTo(X0,ORIGINE - 20);
: VALX := XINF + (XSUP - XINF)*i/10;
: Str(VALX:8:3,SX);
: IF i > 1 THEN OutText(SX);
: Line(0,Y0,20,Y0);
: MoveTo(30,Y0);
: VALY := MINIM + (MAXIM - MINIM)*i/10;
: IF (abs(VALY)<1E3) and (abs(VALY)>=0.1) THEN
: BEGIN
: Str(VALY:8:4,SY);
: OutText(SY)
: END
: ELSE
: BEGIN
: Str(VALY,TEXTY);
: N1 := pos('.',TEXTY);
: N2 := pos('E',TEXTY);
: N3 := length(TEXTY);
: S1Y := copy(TEXTY,1,N1);
: S2Y := copy(TEXTY,N1+1,3);
: S3Y := copy(TEXTY,N2,N3-N2+1);
: OutText(S1Y+S2Y+S3Y)
: END
: END;
: SetColor(Red);
: seek(FILEKELVIN,LIM1);
: read(FILEKELVIN,SETKELVIN);
: X[1]:=trunc((SETKELVIN.Z-XINF)*DIMX/(XSUP-XINF));
: Y[1] := DIMY-trunc((SETKELVIN.KEL[k]-MINIM)*DIMY/(MAXIM-MINIM));
: FOR i := LIM1+1 TO LIM2 DO
: BEGIN
: seek(FILEKELVIN,i);
: read(FILEKELVIN,SETKELVIN);
: X[2]:=trunc((SETKELVIN.Z-XINF)*DIMX/(XSUP-XINF));
: Y[2]:=DIMY-trunc((SETKELVIN.KEL[k]- MINIM)* DIMY/(MAXIM - MINIM));
: Line(X[1],Y[1],X[2],Y[2]);
: X[1] := X[2];
: Y[1] := Y[2];
: END;
: readln;
: CloseGraph;
: write('DORITI TRASAREA ALTUI GRAFIC?.DA/NU');
: readln(RASPUNS)
: END;{WHILE}
: close(FILEKELVIN)
: END;{GRAFIC}
: BEGIN{FUNCTII_KELVIN}
: RASPUNS := 'DA';
: WHILE (RASPUNS = 'DA') or (RASPUNS = 'da') DO
: BEGIN
: writeln('1: CREARE FISIERE FUNCTII KELVIN');
: writeln('2: LISTARE VALORI FUNCTII KELVIN');
: writeln('3: TRASARE GRAFIC FUNCTII KELVIN');
: writeln;
: writeln;
: write('TASTATI NUMARUL VARIANTEI ');
: readln(NUMAR);
: CASE NUMAR OF
: 1: CREARE(FILEKELVIN);
: 2: LISTARE(FILEKELVIN);
: 3: GRAFIC(FILEKELVIN)
: END;
: writeln;
: writeln;
: write('CONTINUATI?...DA(da)/NU(nu)... ');
: readln(RASPUNS)
: END
: END{FUNCTII_KELVIN}.
:
: PROGRAM Regresie_polinomiala;
: USES Crt;
: CONST
: nmax=20;
: mmax=10;
: TYPE
: index=1..nmax;
: grad=0..mmax;
: mat=ARRAY[index,index] OF Real;
: vec=ARRAY[index] OF Real;
: vec1=ARRAY[grad] OF Real;
: VAR
: a:mat;
: x,y,xsol:vec;
: c:vec1;
: n:index;
: m:grad;
: flg:Boolean;
: PROCEDURE Gauss(n:index;a:mat;VAR xsol:vec;VAR flg:Boolean);
: VAR
: i,j,jp,k:index;
: max,x:Real;
: PROCEDURE schimba(i,j:index);
: VAR
: k:index;
: x:Real;
: BEGIN
: FOR k:=1 TO nmax DO
: BEGIN
: x:=a[i,k]; a[i,k]:=a[j,k]; a[j,k]:=x
: END
: END; {Proc. schimba}
: BEGIN
: flg:=True;
: FOR i:=1 TO n-1 DO
: BEGIN
: jp:=i; max:=Abs(a[i,i]);
: FOR j:=i+1 TO n DO
: IF Abs(a[j,i])>max THEN
: BEGIN max:=Abs(a[j,i]); jp:=j; END;
: IF max=0 THEN
: BEGIN flg:=False; Exit END;
: IF jp<>i THEN schimba(i,jp);
: FOR j:=i+1 TO n DO
: BEGIN
: x:=a[j,i]/a[i,i];
: FOR k:=i+1 TO n+1 DO
: a[j,k]:=a[j,k]-a[i,k]*x
: END
: END;
: IF a[n,n]=0 THEN BEGIN flg:=False; Exit END;
: a[n+1,n]:=a[n,n+1]/a[n,n];
: FOR i:=n-1 DOWNTO 1 DO
: BEGIN
: a[n+1,i]:=0;
: FOR k:=i+1 TO n DO
: a[n+1,i]:=a[n+1,i]+a[i,k]*a[n+1,k];
: a[n+1,i]:=(a[i,n+1]-a[n+1,i])/a[i,i]
: END;
: FOR i:=1 TO n DO xsol[i]:=a[n+1,i]
: END;
: PROCEDURE Wait;
: VAR
: cc:Char;
: BEGIN
: WriteLn('Press a Key !');
: REPEAT cc:=ReadKey; UNTIL cc<>''
: END;
: PROCEDURE Sistem(n:index;m:grad;VAR a:mat);
: VAR
: i,j,k,e : Integer;
: sc,st : Real;
: FUNCTION pr(baza:Real;exponent:Integer):Real;
: VAR
: i : Integer;
: tr : Real;
: BEGIN
: tr:=1;
: IF (exponent=0) THEN tr:=1
: ELSE FOR i:=1 TO exponent DO
: tr:=tr*baza;
: pr:=tr;
: END;
: BEGIN
: FOR i:=1 TO m+1 DO
: BEGIN
: st:=0;
: FOR k:=1 TO n DO st:=st+y[k]*pr(x[k],i-1);
: a[i,m+2]:=st;
: FOR j:=i TO m+1 DO
: BEGIN
: sc:=0; e:=i+j-2;
: FOR k:=1 TO n DO sc:=sc+pr(x[k],e);
: a[i,j]:=sc; a[j,i]:=sc
: END
: END
: END;
: PROCEDURE scriesist;
: VAR
: i,j:index;
: BEGIN
: WriteLn;
: FOR i:=1 TO m+1 DO
: BEGIN
: FOR j:=1 TO m+1 DO Write(a[i,j]:12:2);
: WriteLn(' ',a[i,m+2]:12:2)
: END;
: WriteLn
: END;
: PROCEDURE Date;
: VAR
: k:Integer;
: BEGIN
: Write('Nr. date experimentale=');ReadLn(n);WriteLn;
: FOR k:=1 TO n DO
: BEGIN
: Write('x(',k,')=');ReadLn(x[k]);Write('y(',k,')=');ReadLn(y[k])
: END;
: Write('Gradul polinomului de regresie=');ReadLn(m);WriteLn;
: END;
: PROCEDURE scriesol;
: VAR
: i:Integer;
: BEGIN
: WriteLn; WriteLn('Solutia');
: FOR i:=1 TO m+1 DO Write(xsol[i]:12:3); WriteLn
: END;
: BEGIN {Main Prog.}
: ClrScr; Date; Sistem(n,m,a); Scriesist;
: Gauss(m+1,a,xsol,flg); Scriesol; Wait
: END {Regresie_polinomiala}.
:
: program newtown_stanga;
: var a,b,n,i,k:integer; {a si b sunt extemitatile intervalului pe care e definita f}
: x,y,c:array[0..10] of real;
: xd,h,p,t:real;
: function deltayO(k:integer):real;
: var d:real;
: begin
: if k mod 2=0 then c[0]:=1
: else c[0]:=-1;
: for i:=n downto 1 do
: c[i]:=0;
: d:=0;
: for i:=n downto 1 do
: c[i]:=c[i-1]*(k-i+1)/i;
: for i:=k downto 0 do
: d:=d+c[i]*y[i];
: deltayO:=d;
: end;
: begin
: write('introduce a:');
: readln(a);
: write('introduce b:');
: readln(b);
: write('nr de noduri:');
: readln(n);
: writeln('introduce valoare functiei in nodurile date:');
: for i:=1 to n do
: read(y[i]);readln;
: write('introduce valoarea argumentului in care vrem sa interpolam:');
: readln(xd);
: x[0]:=a;
: x[n]:=b;
: h:=(b-a)/n;
: for i:=n-1 downto 1 do
: x[i]:=x[n]+i*h;
: t:=1;
: p:=y[n];
: for k:=n downto 1 do begin
: t:=t*(xd-x[k-1])/(k*h);
: p:=p+deltayO(k)*t;end;
: writeln('valoarea interpolata in punctul ',xd:6:3,' este:',p:7:3);
: readln;
: end.
:
:
:
Change each program into a procedure. The use a code like this to combine them into a single program:
var
i: integer;
begin
repeat
writeln('1: bessel');
writeln('2: Kelvin');
{ etc. }
writeln('99: Quit');
readln(i);
case i of
1: CallBessel;
2: CallKelvin;
{ etc. }
end;
until i = 99;
end.
