# How can I combine more programms?

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 pwork', 'bessel');
swapvectors;
exec('bessel.exe','');
swapvectors;end;

procedure kelvin;
begin
swapvectors;
exec('c:program files pwork', 'kelvin');
swapvectors;
exec('kelvin.exe','');
swapvectors;end;

procedure regresie_polinomiala;
begin
swapvectors;
exec('c:program files pwork', 'regresie_polinomiala');
swapvectors;
exec('regresie_polinomiala.exe','');
swapvectors;end;

procedure newton_stanga;
begin
swapvectors;
exec('c:program files pwork', 'newton_stanga');
swapvectors;
exec('newton_stanga.exe','');
swapvectors;end;

begin
bessel;
kelvin;
regresie_polinomiala;
newton_stanga;
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
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);
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 = ');
write('X sup = ');
write('DELTA X = ');
write('EPSILON = ');
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);
ALFA := SETKELVIN.Z;
BETA := SETKELVIN.Z;
GAMA := BETA - ALFA;
write('X inf = ');
write('X sup = ');
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);
WITH SETKELVIN DO
writeln(lst,Z:7:3,' ',KEL[1],' ',KEL[2],' ',KEL[3],' ',KEL[4])
END;
writeln(lst);
writeln(lst);
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);
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)?...');
IF (RASP='DA') or (RASP='da') THEN
k:=i;
i := i + 1
END;
seek(FILEKELVIN,0);
ALFA := SETKELVIN.Z;
BETA := SETKELVIN.Z;
GAMA := BETA - ALFA;
write('X inf = ');
write('X sup = ');
LIM1 := trunc((XINF-ALFA)/GAMA+1E-06);
LIM2 := trunc((XSUP-ALFA)/GAMA+1E-06);
seek(FILEKELVIN,LIM1);
WITH SETKELVIN DO
BEGIN
MAXIM := KEL[k];
MINIM := KEL[k]
END;
FOR i := LIM1 TO LIM2 DO
BEGIN
seek(FILEKELVIN,i);
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:pascalBGI');
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);
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);
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;
CloseGraph;
write('DORITI TRASAREA ALTUI GRAFIC?.DA/NU');
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 ');
CASE NUMAR OF
1: CREARE(FILEKELVIN);
2: LISTARE(FILEKELVIN);
3: GRAFIC(FILEKELVIN)
END;
writeln;
writeln;
write('CONTINUATI?...DA(da)/NU(nu)... ');
END
END{FUNCTII_KELVIN}.

PROGRAM Regresie_polinomiala;
USES Crt;
CONST
nmax=20;
mmax=10;
TYPE
index=1..nmax;
mat=ARRAY[index,index] OF Real;
vec=ARRAY[index] OF Real;
VAR
a:mat;
x,y,xsol:vec;
c:vec1;
n:index;
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 !');
END;
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
FOR k:=1 TO n DO
BEGIN
END;
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:');
write('introduce b:');
write('nr de noduri:');
writeln('introduce valoare functiei in nodurile date:');
for i:=1 to n do
write('introduce valoarea argumentului in care vrem sa interpolam:');
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);
end.

• : 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 pwork', 'bessel');
: swapvectors;
: exec('bessel.exe','');
: swapvectors;end;
:
: procedure kelvin;
: begin
: swapvectors;
: exec('c:program files pwork', 'kelvin');
: swapvectors;
: exec('kelvin.exe','');
: swapvectors;end;
:
: procedure regresie_polinomiala;
: begin
: swapvectors;
: exec('c:program files pwork', 'regresie_polinomiala');
: swapvectors;
: exec('regresie_polinomiala.exe','');
: swapvectors;end;
:
: procedure newton_stanga;
: begin
: swapvectors;
: exec('c:program files pwork', 'newton_stanga');
: swapvectors;
: exec('newton_stanga.exe','');
: swapvectors;end;
:
: begin
: bessel;
: kelvin;
: regresie_polinomiala;
: newton_stanga;
: 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
: 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);
: 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 = ');
: write('X sup = ');
: write('DELTA X = ');
: write('EPSILON = ');
: 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);
: ALFA := SETKELVIN.Z;
: BETA := SETKELVIN.Z;
: GAMA := BETA - ALFA;
: write('X inf = ');
: write('X sup = ');
: 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);
: WITH SETKELVIN DO
: writeln(lst,Z:7:3,' ',KEL[1],' ',KEL[2],' ',KEL[3],' ',KEL[4])
: END;
: writeln(lst);
: writeln(lst);
: 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);
: 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)?...');
: IF (RASP='DA') or (RASP='da') THEN
: k:=i;
: i := i + 1
: END;
: seek(FILEKELVIN,0);
: ALFA := SETKELVIN.Z;
: BETA := SETKELVIN.Z;
: GAMA := BETA - ALFA;
: write('X inf = ');
: write('X sup = ');
: LIM1 := trunc((XINF-ALFA)/GAMA+1E-06);
: LIM2 := trunc((XSUP-ALFA)/GAMA+1E-06);
: seek(FILEKELVIN,LIM1);
: WITH SETKELVIN DO
: BEGIN
: MAXIM := KEL[k];
: MINIM := KEL[k]
: END;
: FOR i := LIM1 TO LIM2 DO
: BEGIN
: seek(FILEKELVIN,i);
: 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:pascalBGI');
: 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);
: 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);
: 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;
: CloseGraph;
: write('DORITI TRASAREA ALTUI GRAFIC?.DA/NU');
: 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 ');
: CASE NUMAR OF
: 1: CREARE(FILEKELVIN);
: 2: LISTARE(FILEKELVIN);
: 3: GRAFIC(FILEKELVIN)
: END;
: writeln;
: writeln;
: write('CONTINUATI?...DA(da)/NU(nu)... ');
: END
: END{FUNCTII_KELVIN}.
:
: PROGRAM Regresie_polinomiala;
: USES Crt;
: CONST
: nmax=20;
: mmax=10;
: TYPE
: index=1..nmax;
: mat=ARRAY[index,index] OF Real;
: vec=ARRAY[index] OF Real;
: VAR
: a:mat;
: x,y,xsol:vec;
: c:vec1;
: n:index;
: 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 !');
: END;
: 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
: FOR k:=1 TO n DO
: BEGIN
: END;
: 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:');
: write('introduce b:');
: write('nr de noduri:');
: writeln('introduce valoare functiei in nodurile date:');
: for i:=1 to n do
: write('introduce valoarea argumentului in care vrem sa interpolam:');
: 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);
: end.
:
:
:
Change each program into a procedure. The use a code like this to combine them into a single program:
[code]
var
i: integer;
begin
repeat
writeln('1: bessel');
writeln('2: Kelvin');
{ etc. }
writeln('99: Quit');
case i of
1: CallBessel;
2: CallKelvin;
{ etc. }
end;
until i = 99;
end.
[/code]
• : Change each program into a procedure. The use a code like this to combine them into a single program:
: [code]
: var
: i: integer;
: begin
: repeat
: writeln('1: bessel');
: writeln('2: Kelvin');
: { etc. }
: writeln('99: Quit');
: case i of
: 1: CallBessel;
: 2: CallKelvin;
: { etc. }
: end;
: until i = 99;
: end.
: [/code]
:

Thank you.