contoh program pascal

contoh program pascal

uses wincrt;

const

JmlPers = 3;

type

Matrik = array[1..JmlPers+1, 1..JmlPers+1] of real;

var

Koefs : matrik;

procedure Identitas;

begin

Writeln('Tugas Analisa Metode Numerik');

Writeln('---------------------------');

Writeln;

Writeln('Nama :Aghy Gilar Pratama');

Writeln('NIM : 4003080002 / s-1');

Writeln;

end;

procedure Judul;

begin

Writeln('Program Penyelesaian 3 Persamaan Linier');

Writeln;

Writeln('Bentuk persamaan : a1 x + b1 y + c1 z = k1');

Writeln(' a2 x + b2 y + c2 z = k2');

Writeln(' a3 x + b3 y + c3 z = k3');

Writeln;

end;

procedure BacaData;

var

I, J : integer;

begin

for I := 1 to JmlPers do

begin

for J := 1 to JmlPers + 1 do

begin

if J = JmlPers + 1 then

begin

Write('Masukkan konstanta k',I,' : ');

Readln(Koefs[I,J]);

end

else

begin

Write('Masukkan nilai ',chr(96+J),I,' : ');

Readln(Koefs[I,J]);

end;

end;

Writeln;

end;

end;

function Det3x3(var Mat : matrik) : real;

var

Det3, H : real;

I, J, K, L : integer;

Det2 : array[1..4] of real;

begin

K := 0;

Det3 := 0;

for L := 1 to 4 do Det2[L] := 0;

for I := 1 to 3 do

begin

for L := 2 to 3 do

begin

for J := 1 to 3 do

begin

if I <> J then

begin

K := K + 1;

Det2[K] := Mat[L,J];

end;

end;

end;

H := Mat[1,I];

if I mod 2 = 0 then H := -H;

Det3 := Det3 + (Det2[1]*Det2[4] - Det2[2]*Det2[3]) * H;

for L := 1 to 4 do Det2[L] := 0;

K := 0;

end;

Det3x3 := Det3;

end;

procedure EliminasiMatrik;

var

MatElim : matrik;

I, J : integer;

A, B : real;

begin

MatElim := Koefs;

for J := 1 to JmlPers do

begin

for I := 1 to JmlPers do

MatElim[I,J] := Koefs[I,JmlPers+1];

A := Det3x3(MatElim);

B := Det3x3(Koefs);

Koefs[JmlPers+1,J] := A/B;

MatElim := Koefs;

end;

end;

procedure TampilkanHasil;

var

I : integer;

begin

ClrScr;

Identitas;

Writeln('Program Penyelesaian 3 Persamaan Linier');

Writeln;

Writeln('Bentuk persamaan : ');

for I := 1 to JmlPers do

begin

Write(Koefs[I,1]:5:2,'x + ',Koefs[I,2]:5:2,'y + ');

Writeln(Koefs[I,3]:5:2,'z = ',Koefs[I,4]:5:2);

end;

Writeln;

Writeln('Penyelesaian persamaan :');

for I := 1 to JmlPers do

Writeln(chr(119+I):5,' = ',Koefs[JmlPers+1,I]:5:2);

end;

begin

ClrScr;

Identitas;

Judul;

BacaData;

EliminasiMatrik;

TampilkanHasil;

Writeln;

Write('Tekan Enter...');

Readln;

end.