Showing posts with label program bahasa pascal. Show all posts
Showing posts with label program bahasa pascal. Show all posts

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 grade nilai

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
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 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


program resistor

program resistor;
uses wincrt;
var
nilai:real;
n1,n2,n3,n4,nilaimax,nilaimin:real;
g1,g2,g3,g4:string;

const
h=0;
c=1;
m=2;
o=3;
k=4;
hj=5;
b=6;

u=7;
a=8;
p=9;
e=1/2;
per=1.10;

begin
writeln('PROGRAM MENGETAHUI NILAI SUATU RESISTOR');
writeln('NAMA : AFIT MIRANTO');
writeln('NPM : G1D009001');
writeln('TEKNIK ELEKTRO UNIVERSITAS BENGKULU');
writeln(' ');
writeln('tulis warna gelang resistor dengan huruf kecil semua');
write('warna gelang 1= ');readln(g1);
write('warna gelang 2= ');readln(g2);
write('warna gelang 3= ');readln(g3);
write('warna gelang 4= ');readln(g4);

if (g1='hitam') then n1:=h;
if (g1='coklat') then n1:=c;
if (g1='merah') then n1:=m;
if (g1='oranye') then n1:=o;
if (g1='kuning') then n1:=k;
if (g1='hijau') then n1:=hj;
if (g1='biru') then n1:=b;
if (g1='ungu') then n1:=u;
if (g1='abu-abu')then n1:=a;
if (g1='putih') then n1:=p;

if (g2='hitam') then n2:=h;
if (g2='coklat') then n2:=c;
if (g2='merah') then n2:=m;
if (g2='oranye') then n2:=o;
if (g2='kuning') then n2:=k;
if (g2='hijau') then n2:=hj;
if (g2='biru') then n2:=b;
if (g2='ungu') then n2:=u;
if (g2='abu-abu')then n2:=a;
if (g2='putih') then n2:=p;


if (g3='hitam') then n3:=h;
if (g3='coklat') then n3:=c;
if (g3='merah') then n3:=m;
if (g3='oranye') then n3:=o;
if (g3='kuning') then n3:=k;
if (g3='hijau') then n3:=hj;
if (g3='biru') then n3:=b;
if (g3='ungu') then n3:=u;
if (g3='abu-abu')then n3:=a;
if (g3='putih') then n3:=p;
if (g3='perak') then n3:=0.01;
if (g3='emas') then n3:=0.1;

if (g4='perak') then n4:=10/100;
if (g4='emas') then n4:=50/100;


nilai:=((10*n1)+n2)*(exp(n3*ln(10)));
nilaimax:=nilai+n4;
nilaimin:=nilai-n4;
writeln('nilai resistor = ',nilai:4:2,' ohm');
writeln('toleransi +/- ',n4 :4:2);
writeln('nilaimax resistor = ',nilaimax:4:2,' ohm');
writeln('nilaimin resistor = ',nilaimin:4:2,' ohm');

readln;

donewincrt;
end.

Program Analisa Numerik dengan Metode Biseksi

Program Biseksi;
uses wincrt;
label ulang;
var
x1,x2,x3,y1,y2,y3 : real;
i : integer;
ab : char;
begin
ulang :
clrscr;
writeln('Tentukan nilai akar dari persamaan f(x)=x^3+x^2-3x-3=0 dengan Metode Biseksi');
write( 'Masukan nilai x1 = ' );
readln( x1 );

y1 := x1 * x1 * x1 * + x1 * x1 - 3 * x1 -3;
writeln(' Nilai f(x1)= ',y1:0:4);
repeat
begin
write( 'Masukan nilai x2 = ');
readln(x2);
y2 := x2 * x2 * x2 + x2 * x2 - 3 * x2 - 3;
write(' Nilai f(x2)= ',y2:0:4);
end;
if (y1*y2)<0 then
Writeln(' Syarat Nilai Ok')
else
Writeln(' Nilai X2 Belum Sesuai');
until ( y1 * y2 ) < 0;
I :=2;
Writeln;
writeln('Penyelesaian Persamaan Dengan Metode Biseksi, Nilai x1= ',x1:0:2,' & x2= ',x2:0:2);
writeln('--------------------------------------------------------------------------');
writeln('n x f(x) error ');
writeln('--------------------------------------------------------------------------');
repeat
begin
i :=i + 1 ; x3 := ( x1 + x2) / 2;
y3 := x3 * x3 * x3 + x3 * x3 - 3 * x3 -3;
if (i mod 10)=0 then readln;
if i<10 then
writeln(' ',i,' :: ',x3,' :: ',y3,' :: ',abs( y3 ),' ::')
else writeln(i,' :: ',x3,' :: ',y3,' :: ',abs( y3 ),' ::');
if ( y1* y3) <0 then
begin
x2 :=x3;
end else
begin
x1 := x3;
end;
end;
until abs( y3 )<1E-07;
writeln('-------------------------------------------------------------------------');
writeln('akar persamaanya = ',x3);
writeln('errornya =',abs( y3 ));
writeln('-------------------------------------------------------------------------');
write('Apakah anda ingin mengulanginya (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 degan metode Biseksi:
1. x3
- x2
- 2x + 1 = 0 2. Xx
= 10

Program MencariPangkat

Program MencariPangkat;
uses wincrt;
Var x : real; y : integer; z : real;

function pangkatBulat(a : real, b : integer) : real;
var i : integer; temp : real;
begin
temp := 1;
for i := 1 to b do
begin
temp := temp * a;

end;
pangkat := temp;
end;

function pangkatRiil(a : real, b : real) : real;
begin
pangkatRiil := exp(b * ln(a));
end;

Begin
x := 5;
y := 3;
z := 3.5;
Write('Nilai ',x,' pangkat ',y,' adalah ',
pangkatBulat(x,y):3:0);
Write('Nilai ',x,' pangkat ',z,' adalah ',
pangkatRiil(x,z):3:4);
End.

program rata-rata

program rata_rata;
uses wincrt;

var
a, mahasiswa : integer;
nilai, total, tinggi, rendah, rata : real;
nama:string;

begin
total := 0;
write ('jumlah mahasiswa : '); readln (mahasiswa);
writeln;
for a := 1 to mahasiswa do

begin
write ('nama mahasiswa ke ',a,' ');readln (nama);
write ('nilai ',nama,' : '); readln (nilai);

total := total + nilai;
if a = 1 then
begin
tinggi := nilai;
rendah := nilai;
end
else begin
if nilai > tinggi then tinggi := nilai
else begin
if nilai < rendah then rendah := nilai
else begin
end;
end;
end;
end;
rata := total / mahasiswa;
writeln;
writeln ('nilai terendah : ',rendah :1:2);
writeln ('nilai tertinggi : ',tinggi :1:2);
writeln ('rata-rata nilai mahasiswa : ',rata :1:2);
readln;
donewincrt
end.

program rata rata

program rata_rata;
uses wincrt;

var
a, mahasiswa : integer;
nilai, total, tinggi, rendah, rata : real;
nama:string;

begin
total := 0;
write ('jumlah mahasiswa : '); readln (mahasiswa);
writeln;
for a := 1 to mahasiswa do

begin
write ('nama mahasiswa ke ',a,' ');readln (nama);
write ('nilai ',nama,' : '); readln (nilai);
total := total + nilai;
end;
rata := total / mahasiswa;
writeln ('rata-rata nilai mahasiswa : ',rata :1:2);
readln;
donewincrt
end.

PROGRAM MENGETAHUI NILAI SUATU RESISTOR

program resistor;
uses wincrt;
var
nilai:real;
n1,n2,n3,n4,nilaimax,nilaimin:real;
g1,g2,g3,g4:string;

begin
writeln('PROGRAM MENGETAHUI NILAI SUATU RESISTOR');
writeln('NAMA : AFIT MIRANTO');
writeln('NPM : G1D009001');
writeln('TEKNIK ELEKTRO UNIVERSITAS BENGKULU');
writeln(' ');
writeln('tulis warna gelang resistor dengan huruf kecil semua');

write('warna gelang 1= ');readln(g1);
write('warna gelang 2= ');readln(g2);
write('warna gelang 3= ');readln(g3);
write('warna gelang 4= ');readln(g4);

if (g1='hitam') then n1:= 0;
if (g1='coklat') then n1:=10;
if (g1='merah') then n1:=20;
if (g1='oranye') then n1:=30;
if (g1='kuning') then n1:=40;
if (g1='hijau') then n1:=50;
if (g1='biru') then n1:=60;
if (g1='ungu') then n1:=70;
if (g1='abu-abu')then n1:=80;
if (g1='putih') then n1:=90;

if (g2='hitam') then n2:=0;
if (g2='coklat') then n2:=1;
if (g2='merah') then n2:=2;
if (g2='oranye') then n2:=3;
if (g2='kuning') then n2:=4;
if (g2='hijau') then n2:=5;
if (g2='biru') then n2:=6;
if (g2='ungu') then n2:=7;
if (g2='abu-abu')then n2:=7;
if (g2='putih') then n2:=9;

if (g3='hitam') then n3:=1;
if (g3='coklat') then n3:=10;
if (g3='merah') then n3:=100;
if (g3='oranye') then n3:=1000;
if (g3='kuning') then n3:=10000;
if (g3='hijau') then n3:=100000;
if (g3='biru') then n3:=1000000;
if (g3='ungu') then n3:=10000000;
if (g3='abu-abu')then n3:=100000000;
if (g3='putih') then n3:=1000000000;
if (g3='perak') then n3:=0.01;
if (g3='emas') then n3:=0.1;

if (g4='perak') then n4:=10/100;
if (g4='emas') then n4:=5/100;


nilai:=((n1+n2)*n3);
nilaimax:=nilai+n4;
nilaimin:=nilai-n4;
writeln('nilai resistor = ',nilai :2:2,' ohm');
writeln('toleransi +/- ',n4:2:2);
writeln('nilai max resistor = ',nilaimax:2:2,' ohm');
writeln('nilai min resistor = ',nilaimin:2:2,' ohm');

readln;

donewincrt;
end.

program mencari akar persamaan kuadrat

program mencari_akar_persamaan_kuadrat;
uses wincrt;

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

begin
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;
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('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('Bukan Akar Real!');
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 nilai mahasiswa

Program nilai_mahasiswa;
uses wincrt;
Var
Nilai : Real ;
Grade : Char ;
nama : string ;
Begin
write('NAMA: ',nama);
read(nama);
Write('NILAI ANDA : ');
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,' KETERANGANNYA : ',grade) ;
readln;
End.

program bahasa pascal bagian 3


program analisa numerik dengan 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'); x2="',y1*y2:0:5);"> 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; x="',x);" error="',abs(y));" ab="'Y')" ab="'y')" style="font-weight: bold;">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 mencari 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 faktorial2
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 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 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 bahasa pascal bagian 2


program mencari nilai rata2
program rata_rata;
uses wincrt;

var
a, mahasiswa : integer;
nilai, total, tinggi, rendah, rata : real;
nama:string;

begin
total := 0;
.
write ('jumlah mahasiswa : '); readln (mahasiswa);
writeln;
for a := 1 to mahasiswa do
begin
write ('nama mahasiswa ke ',a,' ');readln (nama);
write ('nilai ',nama,' : '); readln (nilai);

total := total + nilai;
if a = 1 then
begin
tinggi := nilai;
rendah := nilai;
end
else begin
if nilai > tinggi then tinggi := nilai
else begin
if nilai < style="font-weight: bold;">program input nilai mahasiswa
Program Input_nilai_mhs;
Uses WinCrt;
Const
garis='-------------------------------------------------------------------------------';
Var
nil1,nil2 : Array [1..10] Of 0..100; {Array dgn Type subjangkauan}
nim : Array [1..10] Of String [8];
nama : Array [1..10] Of String [50];
n,i,bar : Integer;
jum : Real;
tl : Char;
Begin
ClrScr;
{ pemasukan data dalam array }
Writeln ('Maximize dulu windows anda,');
Writeln ('untuk mendapat hasil yang maksimal!!!');
Write ('Berapa Data Mahasiswa yang aka diinput :');
Readln (n);
For i:= 1 To n Do
Begin
ClrScr;
GotoXY(30,4+1); Write('Data Ke-:',i:2);
GotoXY(10,5+i); Write('NIM :'); Readln(nim[i]);
GotoXY(10,6+i); Write('Nama :'); Readln(nama[i]);
GotoXY(10,7+i); Write('Nilai 1 :'); Readln(nil1[i]);
GotoXY(10,8+i); Write('Nilai 2 :'); Readln(nil2[i]);
End;
{ proses data dalam array }
ClrScr;
GotoXY(5,4); Write(Garis);
GotoXY(5,5); Write ('No');
GotoXY(9,5); Write ('NIM');
GotoXY(18,5); Write ('Nama');
GotoXY(38,5); Write ('Nilai 1');
GotoXY(45,5); Write ('Nilai 2');
GotoXY(52,5); Write ('Rata');
GotoXY(59,5); Write ('Abjad');
GotoXY(5,6); Write (Garis);
{ proses Cetak isi array dan seleksi kondisi }
bar := 7;
For i:= 1 To n Do
Begin
jum:=(nil1[i]+nil2[i])/2;
If jum&gt:= 90 Then tl:='A'
Else
If jum>80 Then tl:='B'
Else
If jum>60 then tl:='C'
Else
If jum >50 Then tl:='D'
Else
tl:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyeleksian kondisi }
GotoXY(5,bar); Writeln(i:2);
GotoXY(9,bar); Writeln (NIM[i]);
GotoXY(18,bar); Writeln (NAMA[i]);
GotoXY(38,bar); Writeln (NIL1[i]:4);
GotoXY(45,bar); Writeln (NIL2[i]:4);
GotoXY(52,bar); Writeln (jum:5:1);
GotoXY(59,bar); Writeln (tl);
bar:=bar+1;
End;
GotoXY(5,bar+1);Writeln(garis);
Readln;
End.



program analisa numerik metode biseksi
Program Biseksi;
uses wincrt;
label ulang;
var
x1,x2,x3,y1,y2,y3 : real;
i : integer;
ab : char;
begin
ulang :
clrscr;
writeln('Tentukan nilai akar dari persamaan f(x)=x^3+x^2-3x-3=0 dengan Metode Biseksi');
write( 'Masukan nilai x1 = ' );
readln( x1 );
y1 := x1 * x1 * x1 * + x1 * x1 - 3 * x1 -3;
writeln(' Nilai f(x1)= ',y1:0:4);
repeat
begin
write( 'Masukan nilai x2 = ');
readln(x2);
y2 := x2 * x2 * x2 + x2 * x2 - 3 * x2 - 3;
write(' Nilai f(x2)= ',y2:0:4);
end;
if (y1*y2)<0 x1=" ',x1:0:2,'" x2=" ',x2:0:2);" persamaanya =" ',x3);" errornya ="',abs(" ab="'y')" ab="'Y')" style="font-weight: bold;">program mencari pangkat
Program MencariPangkat;
uses wincrt;
Var x : real; y : integer; z : real;

function pangkatBulat(a : real, b : integer) : real;
var i : integer; temp : real;
begin
temp := 1;
for i := 1 to b do
begin
temp := temp * a;
end;
pangkat := temp;
end;

function pangkatRiil(a : real, b : real) : real;
begin
pangkatRiil := exp(b * ln(a));
end;

Begin
x := 5;
y := 3;
z := 3.5;
Write('Nilai ',x,' pangkat ',y,' adalah ',
pangkatBulat(x,y):3:0);
Write('Nilai ',x,' pangkat ',z,' adalah ',
pangkatRiil(x,z):3:4);
End.



program penggunaan array dengan menggunakan for
Program Pemakaian_Array_Untuk_10_data_dengan_menggunakan_For;
Uses winCrt;
Const
garis='------------------------------------------------------';
Var
nil1,nil2 : Array [1..10] Of 0..100; {Array dgn Type subjangkauan}
npm : Array [1..10] Of String [8];
nama : Array [1..10] Of String [15];
n,i,bar : Integer;
jum : Real;
tl : Char;
Begin
ClrScr;
{ pemasukan data dalam array }
Write ('Mau Isi Berapa Data:');
Readln (n);
For i:= 1 To n Do
Begin
ClrScr;
GotoXY(30,4+1); Write('Data Ke-:',i:2);
GotoXY(10,5+i); Write('NPM :'); Readln (npm[i]);
GotoXY(10,6+i); Write('Nama :'); Readln (nama[i]);
GotoXY(10,7+i); Write('Nilai 1 :'); Readln(nil1[i]);
GotoXY(10,8+i); Write('Nilai 2 :'); Readln(nil2[i]);
End;
{ proses data dalam array }
ClrScr;
GotoXY(5,4); Write(Garis);
GotoXY(5,5); Write ('No');
GotoXY(9,5); Write ('NPM');
GotoXY(18,5); Write ('Nama');
GotoXY(34,5); Write ('Nilai 1');
GotoXY(41,5); Write ('Nilai 2');
GotoXY(47,5); Write ('Rata');
GotoXY(54,5); Write ('Abjad');
GotoXY(5,6); Write (Garis);
{ proses Cetak isi array dan seleksi kondisi }
bar := 7;
For i:= 1 To n Do
Begin
jum:=(nil1[i]+nil2[i])/2;
If jum>= 90 Then tl:='A'
Else
If jum>80 Then tl:='B'
Else
If jum>60 then tl:='C'
Else
If jum>50 Then tl:='D'
Else
tl:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyeleksian kondisi };
GotoYX(5,bar); Writeln(i:2);
GotoYX(9,bar); Writeln (NPM[i]);
GotoYX(18,bar); Writeln (NAMA[i]);
GotoYX(34,bar); Writeln (NIL1[i]:4);
GotoYX(41,bar); Writeln (NIL2[i]:4);
GotoYX(47,bar); Writeln (jum:5:1);
GotoYX(54,bar); Writeln (tl);
bar:=bar+1;
End;
GotoXY(5,bar+1);Writeln(garis);
Readln;
End.

program bahasa pascal bagian 1


Program menentukan grade nilai mahasiswa

Program nilai_mahasiswa;
uses wincrt;
Var
Nilai : Real ;
Grade : Char ;
nama : string ;
Begin
write('NAMA: ',nama);
read(nama);
Write('NILAI ANDA : ');
.
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,' KETERANGANNYA : ',grade) ;
readln;
End.



program mencari persamaan kuadrat

Program Persamaan_Kuadrat;
Uses Wincrt;
label ulang;
Var A,B,C:integer;
D,X1,X2:real;
ab:char;
Begin
ulang:
clrscr;
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('Bukan Akar Real!');
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 persamaan kuadrat 2
program mencari_akar_persamaan_kuadrat;
uses wincrt;

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

begin
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;
end.


program mencari nilai suatu resistor
program resistor;
uses wincrt;
var
nilai:real;
n1,n2,n3,n4,nilaimax,nilaimin:real;
g1,g2,g3,g4:string;

begin
writeln('PROGRAM MENGETAHUI NILAI SUATU RESISTOR');
writeln('NAMA : AFIT MIRANTO');
writeln('NPM : G1D009001');
writeln('TEKNIK ELEKTRO UNIVERSITAS BENGKULU');
writeln(' ');
writeln('tulis warna gelang resistor dengan huruf kecil semua');
write('warna gelang 1= ');readln(g1);
write('warna gelang 2= ');readln(g2);
write('warna gelang 3= ');readln(g3);
write('warna gelang 4= ');readln(g4);

if (g1='hitam') then n1:= 0;
if (g1='coklat') then n1:=10;
if (g1='merah') then n1:=20;
if (g1='oranye') then n1:=30;
if (g1='kuning') then n1:=40;
if (g1='hijau') then n1:=50;
if (g1='biru') then n1:=60;
if (g1='ungu') then n1:=70;
if (g1='abu-abu')then n1:=80;
if (g1='putih') then n1:=90;

if (g2='hitam') then n2:=0;
if (g2='coklat') then n2:=1;
if (g2='merah') then n2:=2;
if (g2='oranye') then n2:=3;
if (g2='kuning') then n2:=4;
if (g2='hijau') then n2:=5;
if (g2='biru') then n2:=6;
if (g2='ungu') then n2:=7;
if (g2='abu-abu')then n2:=7;
if (g2='putih') then n2:=9;

if (g3='hitam') then n3:=1;
if (g3='coklat') then n3:=10;
if (g3='merah') then n3:=100;
if (g3='oranye') then n3:=1000;
if (g3='kuning') then n3:=10000;
if (g3='hijau') then n3:=100000;
if (g3='biru') then n3:=1000000;
if (g3='ungu') then n3:=10000000;
if (g3='abu-abu')then n3:=100000000;
if (g3='putih') then n3:=1000000000;
if (g3='perak') then n3:=0.01;
if (g3='emas') then n3:=0.1;

if (g4='perak') then n4:=10/100;
if (g4='emas') then n4:=5/100;


nilai:=((n1+n2)*n3);
nilaimax:=nilai+n4;
nilaimin:=nilai-n4;
writeln('nilai resistor = ',nilai :2:2,' ohm');
writeln('toleransi +/- ',n4:2:2);
writeln('nilai max resistor = ',nilaimax:2:2,' ohm');
writeln('nilai min resistor = ',nilaimin:2:2,' ohm');

readln;

donewincrt;
end.


program mencari nilai rata2
program rata_rata;
uses wincrt;

var
a, mahasiswa : integer;
nilai, total, tinggi, rendah, rata : real;
nama:string;

begin
total := 0;
write ('jumlah mahasiswa : '); readln (mahasiswa);
writeln;
for a := 1 to mahasiswa do
begin
write ('nama mahasiswa ke ',a,' ');readln (nama);
write ('nilai ',nama,' : '); readln (nilai);
total := total + nilai;
end;
rata := total / mahasiswa;
writeln ('rata-rata nilai mahasiswa : ',rata :1:2);
readln;
donewincrt
end.