Scribd
Upload
138 views19 pages

Program Pascal Segitiga Atas Dan Bawah (Untuk Menentukan Nilai x1, x2,..,xn)

1. The document contains programs to solve systems of linear equations using Jacobi iteration method for 2 equations and 3 equations. 2. It also contains the code to input the constants, initial values, calculate the new values in each iteration, and check for convergence based on a specified tolerance. 3. The programs output the iteration number, variable values, and relative error at each step until convergence is reached.

Uploaded by

Yustika
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
138 views19 pages

Program Pascal Segitiga Atas Dan Bawah (Untuk Menentukan Nilai x1, x2,..,xn)

1. The document contains programs to solve systems of linear equations using Jacobi iteration method for 2 equations and 3 equations. 2. It also contains the code to input the constants, initial values, calculate the new values in each iteration, and check for convergence based on a specified tolerance. 3. The programs output the iteration number, variable values, and relative error at each step until convergence is reached.

Uploaded by

Yustika
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd

Program Pascal Segitiga atas dan bawah ( untuk menentukan nilai x1,x2,..

,xn)
program spl;
uses crt;
var i,j,n:integer;
jm:real;
a:array [0..99,0..99] of integer;
c,x:array [0..99] of real;
begin
clrscr;
writeln('PROGRAM SEGITIGA ATAS ');
writeln('NAMA : Aulia Rindu Permata');
writeln('NIM : 14030022');
writeln;
write('Masukkan ukuran matriks : ');readln(n);
for i:=1 to n do
begin
for j:=i to n do
begin
write('a(',i,',',j,')= ');readln(a[i,j]);
end;
end;
for i:=1 to n do
begin
write('c(',i,')= ');readln(c[i]);
end;
x[n]:=(c[n]/a[n,n]);
for i:=n-1 downto 1 do
begin
jm:= 0;
for j:=i+1 to n do
begin
jm:=jm+a[i,j]*x[j];
end;
x[i]:=(c[i]-jm)/a[i,i];
end;
for i:=1 to n do
begin
write('x(',i,')= ',x[i]:1:2,', ');
end;
readln;

end.
PROGRAM PASCAL ELIMINASI GAUSS

program eliminasi_gauss;
uses crt;

Type
Matrik = record
Row, col : byte;
Element : array [1..99, 1..99] of real;
End;
Vektor = record
Row : byte;
Element : array [1..99] of real;
End;
Var
x, b : vektor;
A : matrik;
n : integer;
c : real;
Err : boolean;
Procedure masukkandata;
Var i,j : byte;
Begin
Writeln(' Penyelesaian Perhitungan SPL dengan Metode Eliminasi Gauss
');
writeln;
writeln('NAMA : AULIA RINDU PERMATA');
WRITELN('NIM : 14030030');
WRITELN('PRODI : MATEMATIKA(NK)');
Write ('Banyaknya persamaan adalah : ');Readln (n);
[Link] := n;
[Link] := n ;
[Link] := n;
for i := 1 to n do
begin writeln;
writeln ('Persamaan ke-',i );
for j := 1 to n do
begin
write ('X[',i,',',j,'] = ');readln ([Link][i,j]);
end;
write('Y[',i,'] = '); readln([Link][i,n+1]);
writeln;
end;
end;
procedure eliminasigauss;
var I,j,k : integer;
temp, S : real;
Begin
Err := false;
For i := 1 to n do
Begin
If ([Link][i,i] = 0 ) then
Begin
write([Link][i,i]) ;
Err := true;
Exit;
End;
temp := [Link][i,i];
for k := 1 to n+1 do
begin
[Link][i,k] := [Link][i,k] / temp;
end;
For j := 1 to n do
begin
if(j<>i) then
begin
c := [Link][j,i];
for k := 1 to n+1 do
begin
[Link][j,k] := [Link] [j,k] - (c * [Link][i,k]);
end;
end;
end;
end;
[Link] := n;
for i := n downto 1 do
begin
if ([Link] [i,i] = 0.0 ) then
Begin
Err := true;
Exit;
End;
[Link][i] := [Link][i,n+1];
end;
end;
Procedure tulishasil;
Var i : byte;
Begin
If (err) then
Begin
Writeln ('Persamaan linear tidak dapat diselesaikan');
End
Else
Begin
Writeln;
Writeln ('Jadi Penyelesaian persamaan linear dengan menggunakan
eliminasi gauss adalah :');
writeln('______________________________________________________________
_________________');
For i := 1 to [Link] do
Writeln('X',i,' = ',[Link][i]:6:2);
End;
End;
Begin
clrscr;
Masukkandata;
Eliminasigauss;
Tulishasil;
readln;
end.
PROGRAM PASCAL PEMBALIKAN / INVERS MATRIK

program matriks_invers;
uses crt;

var n,i,j,x,y,k,l,m: integer;


a:array[1..20,1..20] of real;

begin
clrscr;
writeln ('Program Pencarian Invers Matriks');
writeln ('Nama : Aulia Rindu Permata');
writeln ('NIM : 14030022 ');
writeln ('Tugas : Metode Numerik');
writeln;
writeln ('Masukkan ordo matrik (n x n).');
write ('n : ');
readln (n);
writeln;
for i:=1 to n do
begin
for j:=1 to n do
begin
write ('A(',i,',',j,') : ');
readln (a[i,j]);
end;
end;
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write (' ',a[i,j]:0:0);
writeln;
end;

for j:=n+1 to n+n do


begin
i:=j-n;
a[i,j]:=1;
end;
for j:=n+1 to n+n do
begin
for i:=1 to n do
if i<>j-n then a[i,j]:=0;
end;

for i:=1 to n do
begin
for j:=1 to n+n do
begin
if i<>j then a[i,j]:=a[i,j]/a[i,i];
end;
for j:=1 to n+n do
begin
if i=j then a[i,j]:=1;
end;

for l:=1 to n do
begin
if i<>l then
begin
for j:=i+1 to n+n do
begin
a[l,j]:=a[l,j]-(a[i,j]*a[l,i]);
end;
end;
end;

for k:=1 to n do
begin
if i<>k then
begin
a[k,i]:=0;
end;
end;
end;

readln;
writeln('Maka invers dari matrik adalah :');
for i:=1 to n do
begin
for j:=n+1 to n+n do
write (' ',a[i,j]:0:2);
writeln;
end;

readln;
end.
PROGRAM PASCAL METODE BAGI DUA UNTUK F(X)=X+COS(X)

program metode_bagidua;
uses crt;
var a,b,eps,T,akar,galat:real;
i:integer;

function f(x:real):real;
begin
f:=x+cos(x);
end;

begin
clrscr;
writeln(' Mencari akar dari f(x)= x + cos (x) dengan Metode Bagi Dua');

write('Masukan selang kiri (a) = ');readln(a);


write('Masukan selang kanan (b) = ');readln(b);
write('Masukan nilai epsilon = ');readln(eps);
writeln('ITERASI a b T f(a) f(T) galat');
writeln('________________________________________________________ ');

i:=0;
repeat
i:=1+i;
T:=(a+b)/2;
galat:=b-a;
writeln(i:5, [Link], T:12:6, f(a):12:6, f(b):12:6, f(T):12:6, galat:12:6);

if f(a)*f(T)<0 then b:=T


else a:=T;
if (b-a)<eps then
writeln('akarnya = ',T:5:6);

until (b-a)<eps;
readln;
end.
PROGRAM METODE POSISI PALSU UNTUK F(X)=X+COS(X)

program metode_posisi_palsu;
uses crt;

var a,b,eps,akar,galat,clama,c:real;
i:integer;

function f(x:real):real;
begin
f:=x+cos(x);
end;

begin
clrscr;
writeln(' Mencari akar dari f(x)=x+cos(x) , dengan Metode Posisi Palsu ');
writeln;
write('Masukan selang kiri (a) = ');readln(a);
write('Masukan selang kanan (b) = ');readln(b);
write('Masukan nilai epsilon = ');readln(eps);
writeln;
writeln('ITERASI a b f(a) f(b) f(c) galat');
writeln('_______________________________________________________________');
i:=0;
repeat
i:=1+i;
clama:=(2*b)-a;
c:=b-((f(b)*(b-a))/(f(b)-f(a)));
galat:=b-a;
writeln(i:5, [Link], [Link], f(a):12:6, f(b):12:6, f(c):12:6, galat:12:6);
if f(a)*f(c)<0 then b:=c
else a:=c;

if abs((c-clama)/c)<=eps then
begin
writeln;
writeln('akar = ',[Link]);
end;
until abs((c-clama)/c)<=eps;

readln; end.
PROGRAM NEWTON RAPHSON UNTUK F(X)=X+COS(X)

program newton_raphson;
uses crt;
var eps,a,c,akar:real;
m,i:integer;
function

f(x:real):real;
begin
f:=x+cos(x);
end;
function
g(y:real):real;
begin
g:=1-sin(y);
end;

begin
clrscr;
writeln('Mencari akar dari persamaan f(x):=x+cos(x) , dengan newton raphson');
write('Masukan maksimum banyaknya iterasi = ');readln(m);
write('Masukan x awal = ');readln(a);
writeln('ITERASI a f(a) f.(a) c');
i:=1;
repeat
i:=1+i;
writeln(i:5, [Link], f(a):10:6, g(a):10:6, [Link]);
if g(a)=0 then writeln('Proses gagal')
else
begin
c:=a-(f(a)/g(a));
if abs((c-a)/c)<=eps then writeln('akar = ',[Link]);
end;
a:=c

until i>=m;
readln;
end.
1) Program Jacobi untuk 2 persamaan
program jacobi;
uses crt;
label ulang;
var
i:integer;

a,b,c,p,q,r,u,v,w,d,s,t,x,y,z,f,x1,y1,z1,xn,yn,zn,galat:real;
begin
clrscr;
writeln('----------------------------------');
writeln(' Aulia Rindu Permata (14030022) ');
writeln('----------------------------------');
writeln(' PROGRAM ITERASI JACOBI ');
writeln('----------------------------------');
writeln; writeln;
writeln('Persamaan : ');
writeln('ax+by=c');
writeln('px+qy=r');
writeln; writeln;

writeln('Masukkan kostanta persamaan 1');


gotoxy(2,14); write(' a='); readln(a);
gotoxy(10,14); write(' b='); readln(b);
gotoxy(18,14); write(' c='); readln(c);

writeln;
writeln('Masukkan kostanta persamaan 2');
gotoxy(2,17); write(' p='); readln(p);
gotoxy(10,17); write(' q='); readln(q);
gotoxy(18,17); write(' r='); readln(r);

writeln;
write('Masukkan galat : '); readln(f);

writeln;
writeln('Jadi bentuk sistem persamaan adalah ');
writeln('(',[Link],'x)+(',[Link],'y)=',[Link]);
writeln('(',p:0:0,'x)+(',q:0:0,'y)=',r:0:0);

writeln;
writeln('Masukkan nilai awal');
write('x0 = '); readln(x);
write('y0 = '); readln(y);

writeln('---------------------------------------------------')
;
writeln('iterasi x y galat relatif
');
writeln('---------------------------------------------------')
;

i:=0;
repeat
i:=i+1;
x1:=x; y1:=y;
xn:=(c-y1)/a;
yn:=(r-x1)/q;
x:=xn; y:=yn;
galat:=abs(xn-x1)/xn;
write(' ',i);
write(' ',x:0:6);
write(' ',y:0:6);
write(' ',galat:0:6);
writeln;

until galat<= f;
writeln;
writeln;
writeln('Proses konvergen pada iterasi ke ',i);
readln;
readln;
end.

2) Program Jacobi Untuk 3 Persamaan


program jacobi;
uses crt;
label ulang;
var
i:integer;

a,b,c,p,q,r,u,v,w,d,s,t,x,y,z,f,x1,y1,z1,xn,yn,zn,galat:real;
begin
clrscr;
writeln('
------------------------------------');
writeln(' Aulia Rindu Permata (14030022)
');
writeln('
------------------------------------');
writeln(' PROGRAM ITERASI JACOBI
');
writeln('
------------------------------------');
writeln; writeln;
writeln('Persamaan : ');
writeln('ax+by+cz=d');
writeln('px+qy+rz=s');
writeln('ux+vy+wz=t');
writeln; writeln;

writeln('Masukkan kostanta persamaan 1');


gotoxy(2,15); write(' a='); readln(a);
gotoxy(10,15); write(' b='); readln(b);
gotoxy(18,15); write(' c='); readln(c);
gotoxy(24,15); write(' d='); readln(d);

writeln;
writeln('Masukkan kostanta persamaan 2');
gotoxy(2,18); write(' p='); readln(p);
gotoxy(10,18); write(' q='); readln(q);
gotoxy(18,18); write(' r='); readln(r);
gotoxy(24,18); write(' s='); readln(s);

writeln;
writeln('Masukkan kostanta persamaan 3');
gotoxy(2,21); write(' u='); readln(u);
gotoxy(10,21); write(' v='); readln(v);
gotoxy(18,21); write(' w='); readln(w);
gotoxy(24,21); write(' t='); readln(t);

writeln;
write('Masukkan galat : '); readln(f);

writeln;
writeln('Jadi bentuk sistem persamaan adalah ');
writeln('(',[Link],'x)+(',[Link],'y)+(',[Link],'z)=',[Link]);
writeln('(',p:0:0,'x)+(',q:0:0,'y)+(',r:0:0,'z)=',s:0:0);
writeln('(',u:0:0,'x)+(',v:0:0,'y)+(',w:0:0,'z)=',t:0:0);

writeln;
writeln('Masukkan nilai awal');
write('x0 = '); readln(x);
write('y0 = '); readln(y);
write('z0 = '); readln(z);

writeln('_____________________________________________________
____________');
writeln('iterasi x y z
galat relatif');

writeln('-----------------------------------------------------
------------');

i:=0;
repeat
i:=i+1;
x1:=x; y1:=y; z1:=z;
xn:=(d-b*y1-c*z1)/a;
yn:=(s-p*x1-r*z1)/q;
zn:=(t-u*x1-v*y1)/w;
x:=xn; y:=yn; z:=zn;
galat:=abs(xn-x1)/xn;
write(' ',i);
write(' ',x:0:6);
write(' ',y:0:6);
write(' ',z:0:6);
write(' ',galat:0:6);
writeln;

until galat<= f;
writeln;
writeln;
writeln('Proses konvergen pada iterasi ke ',i);
readln;
readln;
end.

3) Program Gauss_Seidel untuk 2 persamaan


program gauss_seidel;
uses crt;
label ulang;
var
i:integer;

a,b,c,p,q,r,u,v,w,d,s,t,x,y,z,f,x1,y1,z1,xn,yn,zn,galat:real;
begin
clrscr;

writeln('-----------------------------------------------------
-----------');
writeln(' Aulia Rindu Permata (14030022)
');

writeln('-----------------------------------------------------
-----------');
writeln(' PROGRAM ITERASI GAUSS-SEIDEL
');

writeln('-----------------------------------------------------
-----------');
writeln('Persamaan : ');
writeln('ax+by=c');
writeln('px+qy=r');
writeln; writeln;

writeln('Masukkan kostanta persamaan 1');


gotoxy(2,14); write(' a='); readln(a);
gotoxy(10,14); write(' b='); readln(b);
gotoxy(18,14); write(' c='); readln(c);

writeln;
writeln('Masukkan kostanta persamaan 2');
gotoxy(2,17); write(' p='); readln(p);
gotoxy(10,17); write(' q='); readln(q);
gotoxy(18,17); write(' r='); readln(r);

writeln;
write('Masukkan galat : '); readln(f);

writeln;
writeln('Jadi bentuk sistem persamaan adalah ');
writeln('(',[Link],'x)+(',[Link],'y)=',[Link]);
writeln('(',p:0:0,'x)+(',q:0:0,'y)=',r:0:0);

writeln;
writeln('Masukkan nilai awal');
write('x0 = '); readln(x);
write('y0 = '); readln(y);

writeln('_____________________________________________________
________');
writeln('iterasi x y galat
relatif');

writeln('-----------------------------------------------------
--------');

i:=0;
repeat
i:=i+1;
x1:=x; y1:=y;
xn:=(c-y1)/a;
yn:=(r-xn)/q;
x:=xn; y:=yn;
galat:=abs(xn-x1)/xn;
write(' ',i);
write(' ',x:0:6);
write(' ',y:0:6);
write(' ',galat:0:6);
writeln;

until galat<= f;
writeln;
writeln;
writeln('Proses konvergen pada iterasi ke ',i);
readln;
readln;
end.

4) Program Gauss-Seidel untuk 3 Persamaan


program gauss_seidel;
uses crt;
label ulang;
var
i:integer;

a,b,c,p,q,r,u,v,w,d,s,t,x,y,z,f,x1,y1,z1,xn,yn,zn,galat:real;
begin
clrscr;

writeln('-----------------------------------------------------
-----------');
writeln(' Aulia Rindu Permata (14030022)
');

writeln('-----------------------------------------------------
-----------');
writeln(' PROGRAM ITERASI GAUSS-SEIDEL
');

writeln('-----------------------------------------------------
-----------');
writeln; writeln;
writeln('Persamaan : ');
writeln('ax+by+cz=d');
writeln('px+qy+rz=s');
writeln('ux+vy+wz=t');
writeln; writeln;

writeln('Masukkan kostanta persamaan 1');


gotoxy(2,15); write(' a='); readln(a);
gotoxy(10,15); write(' b='); readln(b);
gotoxy(18,15); write(' c='); readln(c);
gotoxy(24,15); write(' d='); readln(d);

writeln;
writeln('Masukkan kostanta persamaan 2');
gotoxy(2,18); write(' p='); readln(p);
gotoxy(10,18); write(' q='); readln(q);
gotoxy(18,18); write(' r='); readln(r);
gotoxy(24,18); write(' s='); readln(s);

writeln;
writeln('Masukkan kostanta persamaan 3');
gotoxy(2,21); write(' u='); readln(u);
gotoxy(10,21); write(' v='); readln(v);
gotoxy(18,21); write(' w='); readln(w);
gotoxy(24,21); write(' t='); readln(t);

writeln;
write('Masukkan galat : '); readln(f);

writeln;
writeln('Jadi bentuk sistem persamaan adalah ');
writeln('(',[Link],'x)+(',[Link],'y)+(',[Link],'z)=',[Link]);
writeln('(',p:0:0,'x)+(',q:0:0,'y)+(',r:0:0,'z)=',s:0:0);
writeln('(',u:0:0,'x)+(',v:0:0,'y)+(',w:0:0,'z)=',t:0:0);

writeln;
writeln('Masukkan nilai awal');
write('x0 = '); readln(x);
write('y0 = '); readln(y);
write('z0 = '); readln(z);

writeln('_____________________________________________________
_________');
writeln('iterasi x y z
galat realtif');

writeln('-----------------------------------------------------
---------');

i:=0;
repeat
i:=i+1;
x1:=x; y1:=y; z1:=z;
xn:=(d-b*y1-c*z1)/a;
yn:=(s-p*xn-r*z1)/q;
zn:=(t-u*xn-v*yn)/w;
x:=xn; y:=yn; z:=zn;
galat:=abs(xn-x1)/xn;
write(' ',i);
write(' ',x:0:6);
write(' ',y:0:6);
write(' ',z:0:6);
write(' ',galat:0:6);
writeln;

until galat<= f;
writeln;
writeln;
writeln('Proses konvergen pada iterasi ke ',i);
readln;
readln;
end.
Program Jacobi

Program Jacobi;

uses crt;

var

M,i,j,n,iterasi,t : integer;

a : array[1..10,1..10] of integer;

c : array[1..10] of integer;

x : array[1..10] of real;

x0 : array[1..10] of real;

eps,galat,selisih : real;

begin

clrscr;

gotoxy(30,2) ;writeln ( '|


***************************************| ');

gotoxy(30,3) ;writeln ( '| Nama : Esti Wahyuni


| ');

gotoxy(30,4) ;writeln ( '| NIM : 1301397


| ');

gotoxy(30,5) ;writeln ( '| Metode Iterasi Jacobi


| ');

gotoxy(30,6) ;writeln ( '|


***************************************| ');
writeln;

writeln;

write('Banyak n = '); readln(n);

write('Galat = '); readln(eps);

write('Iterasi Maksimum = '); readln(m);

writeln ;

for i:=1 to n do

begin

for j:=1 to n do

begin

write('a(',i,',',j,')=');readln(a[i,j]);

end;

write('c(',i,')='); readln(c[i]);

writeln;

end;

writeln; writeln('Masukan Tebakan Awal:');

for i:=1 to n do

begin

write('x0(',i,')='); readln(x0[i]);

end;

clrscr;

writeln (' Metode Iterasi Jacobi


'); writeln; writeln;

writeln
('-----------------------------------------------------------------'
);

writeln ('i Xk Yk Zk ');


writeln
('-----------------------------------------------------------------'
);

for iterasi:=1 to M do

begin

galat:=0;

for i:=1 to n do

begin

x[i]:=c[i];

for j:=1 to n do

begin

if j<>i then x[i]:=x[i]-a[i,j]*x0[j];

end;

x[i]:=x[i]/a[i,i];

selisih:=abs((x[i]-x0[i])/x[i]);

if selisih>galat then galat:=selisih;

end;

if galat>=eps then t:=iterasi;

write(iterasi,' ');

for i:=1 to n do

begin

x0[i]:=x[i];

write(x[i]:11:8,' ');

end;

writeln;

end;

writeln('-----------------------------------------------------------
------');
writeln; writeln('Maka solusi konvergen pada iterasi ke ',t);

readln;

end.

You might also like