program luas keliling lingkaran

program luas_keliling_lungkaran;
uses wincrt;
label ulang;

var
r:integer;
l:real;
k:real;
ab:char;
const
phi=3.14;

begin
ulang:
clrscr;

writeln(’PROGRAM MENCARI LUAS DAN KELILING LINGKARAN’);
write(’jari-jari= ‘);readln(r);
l:=phi*r*r;
k:=2*phi*r;
writeln(’luas lingkaran= ‘,l:4:2);
write(’keliling lingkaran= ‘,k:4:2);
writeln(’Apakah anda ingin mengulanginya (y/t): ‘);
readln(ab);
if (ab=’y’) or (ab=’Y’) then
begin
goto ulang;
end
else
donewincrt;
readln
end.

program mencari akar persamaan kuadrat

program mencari_akar_persamaan_kuadrat;
uses wincrt;
label ulang;

var
x1,x2:real;
a,b,c,d:integer;
ab:char;

begin
ulang:
clrscr;
writeln(’Nama   : Afit Miranto’);
writeln(’NPM    : G1D009001′);
writeln(’Prodi  : Teknik Elektro’);
writeln(’PROGRAM MENCARI AKAR PERSAMAAN KUADRAT ax^2+bx+c=0′);
write(’diketahui nilai a =’);read(a);
write(’diketahui nilai b =’);read(b);
write(’diketahui nilai c =’);read(c);

d:=b*b-4*a*c;
if d<0 then writeln(’tidak ada hasil akar real’)
else
begin
x1:=(-b+(sqrt(d)))/2*a;
x2:=(-b-(sqrt(d)))/2*a;
writeln(’x1= ‘,x1:4:2);
writeln(’x2= ‘,x2:4:2);
end;
readln;
writeln(’Apakah anda ingin mengulanginya (y/t): ‘);
readln(ab);
if (ab=’y’) or (ab=’Y’) then
begin
goto ulang;
end
else
donewincrt;
end.

Program nilai_mahasiswa

Program nilai_mahasiswa;
uses wincrt;
Var
Nilai : Real ;
Grade : Char ;
nama  : string ;
Begin
write(’NAMA ANDA:  ‘,nama);
read(nama);
Write(’NILAI YANG ANDA PEROLEH : ‘);
Read(Nilai);

If Nilai > 85 Then
Grade := ‘A’
else
If Nilai>65 Then
Grade := ‘B’
Else
If  Nilai > 55 Then
Grade := ‘C’
Else
If Nilai > 40 Then
Grade := ‘D’
Else
Grade := ‘E’ ;
Writeln(nama,’  KETERANGAN NILAI ANDA ADALAH : ‘,grade) ;
readln;
End.

program faktorial

program faktorial;
uses wincrt;

var
i,j,n,a:integer;

begin
a:=1;
writeln(’nama     : Afit Miranto’);
writeln(’NPM      : G1D009001′);
writeln(’PRODI    : Teknik Elektro’);
write(’masukkan nilai n: ‘);
readln(n);
writeln(n,’!= ‘);
for i:=n downto 1  do
begin
a:=i*a;
if i>1 then
begin
write(i, ‘ x ‘);

end
else
begin
write(i,’ = ‘);
end;
end;
write(a);
readln;
donewincrt
end.

program data_string

program data_string;
uses wincrt;
var
nama,npm,prodi,fakultas:string;
tahunlahir,umur:integer;
jeniskelamin:char;

begin
writeln(’        welcome         ‘);
writeln(’————————-’);
write(’Nama        :   ‘);
readln(nama);
write(’NPM         :   ‘);
readln(npm);
write(’Prodi       :   ‘);
readln(prodi);
write(’Fakultas    :   ‘);
readln(fakultas);
write(’Tahun Lahir :   ‘);
readln(tahunlahir);
write(’jenis kelamin anda (L/P)? ‘);
readln(jeniskelamin);
umur:=2010-tahunlahir;
writeln(’hello good morning ‘,nama,  ‘ how are you today….????’);
writeln(’npm anda: ‘,npm);
writeln(’dari prodi : ‘  ,prodi);
writeln(’umur anda saat ini: ‘,umur,’ tahun’);
write(’anda seorang  ‘);
begin;
if (jeniskelamin=’L’) or (jeniskelamin=’l’) then write(’laki-laki’)
else write(’perempuan’);
end;

readln;
donewincrt;
end.

Program Faktorial

Program Faktorial_pascal;
uses wincrt;
function Faktorial(a:integer):longint;
begin
if (A=1)then
Faktorial:=1
else
Faktorial:=a*faktorial(a-1);
end;
var
x:integer;
begin
clrscr;
writeln(’Faktorial Sequence’);
writeln;
write(’Berapa Faktorial : ‘);readln(x);
writeln(x,’ faktorial ‘,’= ‘,faktorial(x));
writeln;
write(’Tekan Sembarang Tombol untuk keluar…’);
readln;
donewincrt
end.

program faktorial

program faktorial;
uses wincrt;

var
i,j,n,a:integer;

begin
writeln(’nama     : Afit Miranto’);
writeln(’NPM      : G1D009001′);
writeln(’PRODI    : Teknik Elektro’);
write(’masukkan nilai n: ‘);
readln(n);
writeln(’nilai faktorialnya adalah ‘);
for i:=1 to n do
begin
for j:=1 to i do
begin
a:=1;
for j:=1 to i do
a:=a*j;
end;
write(a, ‘   ‘);
end;
readln;
donewincrt
end.

Program Persamaan Kuadrat

Program Persamaan_Kuadrat;
Uses Wincrt;
label ulang;
Var A,B,C:integer;
D,X1,X2:real;
ab:char;
Begin
ulang:
clrscr;
writeln(’Nama : Afit Miranto’);
writeln(’NPM  : G1D009001′);
writeln(’Prodi: Teknik Elektro’);
Writeln(’Program Persamaan Kuadrat’);
Writeln(’=========================’);
Writeln;
Write(’Masukkan Nilai A: ‘);readln(A);
Write(’Masukkan Nilai B: ‘);readln(B);
Write(’Masukkan Nilai C: ‘);readln(C);
Writeln;

D:=sqr(B)-(4*A*C);
if (D>0) then
begin
X1:=(-B+sqrt(D))/2*A;
X2:=(-B-sqrt(D))/2*A;
Writeln(’X1= ‘,X1:4:1);
writeln(’X2= ‘,X2:4:1);
end
else if (D=0) then
begin
X1:=-B/(2*A);
Writeln(’X1=X2=’,X1:4:1);
end
else
Writeln(’Akar Imajiner!’);
writeln(’Apakah anda ingin mengulanginya (y/t): ‘);
readln(ab);
if (ab=’y’) or (ab=’Y’) then
begin
goto ulang;
end
else
donewincrt;
readln
End.

program input matrix

program input_matrix;
uses wincrt;

var
i,j,b,a:integer;

begin
a:=1;
writeln;
writeln;
write(’masukan baris  ‘);read(a);
write(’masukan kolom  ‘);read(b);

for i:= 1 to a  do
begin
for j:= 1 to b do
begin
writeln(’ (’ ,i,’ , ‘ ,j,  ‘) ‘);
end;
end;
end.

Program metode tabulasi

Program metode_tabulasi;
uses wincrt;
label ulang;
var
x,x1,x2,xa,xb,xc,y,y1,y2,ya,yb:real;
I,j,k:integer;
ab:char;
begin
ulang:
clrscr;
writeln(’Tentukan akar penyelesaian dengan Metode Tabulasi dari f(x)=x^3-7x+1′);
writeln;
write(’masukkan nilai x1 =’); { * Nilai variable X pertama * }
readln(x1);
y1 := x1* x1* x1 - 7 * x1 + 1;
Writeln(’   f(’,x1:0:2,’)=’,y1:0:4);
repeat
begin
write(’masukkan nilai x2 =’);
readln(x2);
y2 := x2 * x2 * x2 - 7 * x2 + 1;
writeln(’   f(’,x2:0:2,’)=’,y2:0:4);
writeln;
writeln(’Syarat (x1*x2)<0′);
write(’   x1*x2=’,y1*y2:0:5);
if (y1*y2)<0 then write(’   Nilai OK’)   else write(’   Nilai Tidak Sesuai’);
readln;
end;
until(y1 * y2) <0;
clrscr;
k:=0;
repeat
begin
k:=k+1;
if x1 > x2 then
begin
xa := x1;
xb := x2;
end
else
begin
xa := x2;
xb := x1;
end;
xc := (xa - xb) /10;
i:=0;
repeat
begin
i:=i+1;
x := xb + xc * I;
ya := x * x * x - 7 * x +1;
yb :=( x - xc) *(x - xc) *(x - xc) - 7 * (x - xc)+1;
end;
until (ya * yb) <0;
x1 :=x;
x2 :=x - xc;
writeln (’tabulasi ke-’,k);
writeln (’————————————————————————–’);
writeln (’ n           x                     f(x)                     error’);
writeln (’————————————————————————–’);
for j:=1 to 9 do
begin
x := xb + xc * (j -1);
y := x * x * x - 7 * x + 1;
writeln (’ ‘,j,’::  ‘,x,’  ::  ‘,y,’  ::  ‘,abs(y),’  ::’);
end;
for j:=10 to 11 do
begin
x := xb + xc * (j -1);
y := x * x * x - 7 * x + 1;
writeln (j,’::  ‘,x,’  ::  ‘,y,’  ::  ‘,abs(y),’  ::’);
end;
writeln(’—————————————————————————’);
end;
readln;
until abs(y)<10e-8;
writeln (’akar pendekatannya adalah x=’,x);
writeln (’error=’,abs(y));
writeln;
write (’apakah anda ingin mengulangi(y/t):’);
readln(ab);
if (ab=’Y’) or (ab=’y’) then
begin
goto ulang;
end
else
donewincrt;
end.

Soal:
Cari akar-akar penyelesaian dari persamaan nonlinear di bawah ini dengan metode Tabulasi:
1.  x3

- x2

- x + 1 = 0      2.   2 - 5x + sinx = 0

http://afitmiranto.blogdetik.com/category/program-bahasa-pascal/