contoh prosedur fungsi

Algoritma HitungGajiKaryawan
Deklarasi
NIK,Nama,Jabatan : String
Gaji, Tunj, Pajak, Gaber : Real
Procedure MasukDataKaryawan
Algoritma
Write('NIK ') Read(NIK)
Write('Nama Karyawan ') Read(Nama)
Write('Jabatan ') Read (Jabat)
Procedure HitungGaji
Algoritma
If Jabat='Direktur' Then
Gaji<-10000000
Tunj<-20%*Gaji
Else
If Jabat='Manajer' then
Gaji<-5000000
Tunj<-10%*Gaji
Else
Gaji<-3000000
Tunj<-5%*Gaji
Endif
Endif
Pajak<-2.5%*Gaji
Gaber<-Gaji+Tunj-Pajak
Algoritma {algoritma utama}
MasukDataKaryawan
HitungGaji
Write(NIK,Nama,Gaji,Tunj,Pajak,Gaber)
program indeks_kesukaran;
uses crt;
const max = 100;
var pilih : byte;
data : array [1..max,1..max] of integer; {data masukan nilai berupa matriks}
jx : array [1..max] of integer;{jumlah skor tiap item soal}
y : array [1..max] of integer;{jumlah tiap peserta}
kelas_atas,kelas_bawah : array [1..max] of integer;{kelas atas dan kelas bawah matriks masukan}
maks,min : array [1..max] of integer;{nilai maksimum dan nilai minimum data masukan tiap item soal}
nama_max,item_max: integer;{jumlah peserta dan jumlah item soal pada data masukan}
ik1: array [1..max] of real;{indeks kesukaran soal objektif}
ik2: array [1..max] of real;{indeks kesukaran soal uraian}
procedure masukan_data_matriksnya;
var nama,item : integer;
begin
writeln('masukan data matriksnya:');
write('jumlah peserta ');readln (nama_max);
write('jumlah item soal '); readln (item_max);
for nama:= 1 to nama_max do
begin
for item:= 1 to item_max do
begin
write ('siswa ke : ',nama,',','item ke: ',item,' ='); readln(data[nama,item]);
end;
end;
end;
procedure jumlah_skor_tiap_item_soal;
var nama,item: integer;
begin
{writeln('menghitung jumlah skor tiap item soal');}
for item:= 1 to item_max do
begin
jx[item]:= 0;
for nama:= 1 to nama_max do
begin
jx[item] := jx[item] + data[nama,item];
end;
end;
end;
procedure tampilkan_data_matriks;
var nama,item : integer;
begin
writeln('data matriksnya adalah');
for nama:= 1 to nama_max do
begin
for item:= 1 to item_max do
write(data[nama,item]:3);
writeln;
end;
for item:= 1 to item_max do
write(jx[item]:3);
writeln;
end;
procedure rumus_indeks_kesukaran;
var nama,item : integer;
begin
writeln('menghitung indeks kesukaran soal objektif');
for item:= 1 to item_max do
begin
ik1[item] := 0;
for nama:= 1 to nama_max do
begin
ik1[item]:= jx[item] / nama_max;
end;
end;
end;
procedure tampilan_rumus_indeks_kesukaran_soal_objektif;
var nama,item : integer;
begin
for item:= 1 to item_max do
begin
write ('indeks kesukaran item ke ',item,'','=',ik1[item]);
if ik1[item] > 0.70 then
writeln(' -----> mudah')
else if ik1[item] > 0.30 then
writeln(' -----> sedang')
else
writeln(' -----> sukar');
end;
end;
procedure menghitung_indeks_kesukaran_soal_objektif;
begin
masukan_data_matriksnya;
jumlah_skor_tiap_item_soal;
tampilkan_data_matriks;
rumus_indeks_kesukaran;
tampilan_rumus_indeks_kesukaran_soal_objektif;
end;
procedure jumlah_skor_tiap_peserta;
var nama,item : integer;
begin
{writeln('menghitung jumlah skor tiap peserta');}
for nama:= 1 to nama_max do
begin
y[nama]:= 0;
for item:= 1 to item_max do
begin
y[nama]:= y[nama] + data[nama,item];
end;
end;
end;
procedure tampilkan_data_matriks_II;
var nama,item: integer;
begin
writeln ('data matriksnya adalah');
for nama := 1 to nama_max do
begin
for item:= 1 to item_max do
write (data[nama,item]:3);
write (y[nama]:3);
writeln;
end;
end;
procedure sorting;
var i,nama,item,simpan,simpan2: integer;
begin
writeln('data setelah diurutkan');
for i := 1 to nama_max do
for nama:= 1 to nama_max -i do
if y[nama] < y[nama+1] then
begin
for item:= 1 to item_max do
begin
simpan:=data[nama,item];
data[nama,item]:=data[nama+1,item];
data[nama+1,item]:=simpan;
end;
simpan2:=y[nama];
y[nama]:=y[nama+1];
y[nama+1]:=simpan2;
end;
end;
procedure menghitung_kelas_atas;
var nama,item,z:integer;
begin
writeln ('kelas atas');
z:= nama_max div 2;
for nama := 1 to z do
begin
for item := 1 to item_max do
write(data[nama,item]:3); write(y[nama]:3);
writeln;
readln;
end;
end;
procedure jumlah_kelas_atas;
var nama,item,z: integer;
begin
for item:= 1 to item_max do
begin
kelas_atas[item]:=0;
for nama:= 1 to z do
begin
kelas_atas[item]:= kelas_atas[item] + data[nama,item];
end;
end;
end;
procedure matriks_kelas_atas;
var nama,item,z :integer;
begin
writeln ('data matriks kelas atas adalah');
for nama := 1 to z do
begin
for item := 1 to item_max do
write (data[nama,item]:3); write(y[nama]:3);
writeln;
readln;
end;
for item:= 1 to item_max do
write(kelas_atas[item]:3);
writeln;
end;
procedure menghitung_kelas_bawah;
var nama,item,z: integer;
begin
writeln('kelas bawah');
z:=nama_max div 2;
if nama_max mod 2 = 0 then
begin
for nama:=(z+1) to nama_max do
for item:= 1 to item_max do
begin
write (data[nama,item]:3);
write (y[nama]:3);
writeln;
end;
end
else
for nama := (z+2) to nama_max do
begin
for item:= 1 to item_max do
write (data[nama,item]:3);
write (y[nama]:3);
write;
end;
write;
readln;
end;
procedure jumlah_kelas_bawah;
var nama,item,z: integer;
begin
if nama_max mod 2 = 0 then
for item:= 1 to item_max do
begin
kelas_bawah[item]:= 0;
for nama:= (z+1) to nama_max do
begin
kelas_bawah[item]:= kelas_bawah[item]+data[nama,item];
end;
end
else
for item:= 1 to item_max do
begin
kelas_bawah[item]:= 0;
for nama:= (z+2) to nama_max do
begin
kelas_bawah[item]:= kelas_bawah[item] + data[nama,item];
end;
end;
end;
procedure matriks_kelas_bawah;
var nama,item,z: integer;
begin
writeln ('data matriks kelas bawah adalah');
if nama_max mod 2 = 0 then
begin
for nama:= (z+1) to nama_max do
begin
for item:= 1 to item_max do
write(data[nama,item]:3);
write(y[nama]:3);
writeln;
end;
for item:= 1 to item_max do
write(kelas_bawah[item]:3);
writeln;
end
else
for nama:=(z+2) to nama_max do
begin
for item:= 1 to item_max do
write(data[nama,item]:3);
write(y[nama]:3);
writeln;
end;
for item:= 1 to item_max do
write(kelas_bawah[item]:3);
writeln;
end;
procedure maksimum_minimum;
var nama,item: integer;
begin
for item:=1 to item_max do
begin
min[item]:=100;
for nama:= 1 to nama_max do
if (data[nama,item] < min[item]) then
min[item]:= data[nama,item];
writeln('data terkecil soal ke ',item,'',min[item]:3);
end;
readln;
writeln;
for item:= 1 to item_max do
begin
maks[item]:=0;
for nama:= 1 to nama_max do
if (data[nama,item] >= maks[item]) then
maks[item]:=data[nama,item];
writeln('data terbesar soal ke ',item,'',maks[item]:3);
end;
readln;
writeln;
end;
procedure rumus_indeks_kesukaran_uraian;
var nama,item : integer;
begin
for item:= 1 to item_max do
begin
ik2[item]:= 0;
ik2[item]:= ((kelas_atas[item] + kelas_bawah[item]) - (2*min[item])) / ((2*nama_max)*(maks[item] -
min [item]));
end;
end;
procedure tampilan_rumus_indeks_kesukaran_soal_uraian;
var nama,item: integer;
begin
writeln('menghitung indeks kesukaran soal uraian');
for item:= 1 to item_max do
begin
write ('indeks kesukaran item ke ',item);
writeln (ik2[item]);
if ik2[item] > 0.70 then
writeln(' -----> mudah')
else if ik2[item] > 0.30 then
writeln(' -----> sedang')
else
writeln(' -----> sukar');
end;
writeln;
readln;
end;
procedure menghitung_indeks_kesukaran_soal_uraian;
begin
masukan_data_matriksnya;
jumlah_skor_tiap_peserta;
tampilkan_data_matriks_II;
sorting;
tampilkan_data_matriks_II;
menghitung_kelas_atas;
jumlah_kelas_atas;
matriks_kelas_atas;
jumlah_kelas_bawah;
matriks_kelas_bawah;
maksimum_minimum;
rumus_indeks_kesukaran_uraian;
tampilan_rumus_indeks_kesukaran_soal_uraian;
end;
{program utama}
begin
while true do
begin
clrscr;
write('**********************<<MENU>>************************');writeln;
write('******************************************************');writeln;
write('1. MENGHITUNG INDEKS KESUKARAN SOAL OBJEKTIF');writeln;
write('2. MENGHITUNG INDEKS KESUKARAN SOAL URAIAN');writeln;
write('3. KELUAR');writeln;
write('*******************************************************');writeln;
pilih:=0;
while (pilih > 1) or (pilih < 3) do
begin
write('pilih nomor (1 - 3)?????');
readln(pilih);
if (pilih > 1) or (pilih < 3) then
begin
case pilih of
1: Menghitung_indeks_kesukaran_soal_objektif;
2: Menghitung_indeks_kesukaran_soal_uraian;
3: Exit;
end;
end;
end;
end;
end.