Pomoc przy programie

0

Witam,
jestem studentem matematyki i muszę poprawić program tak aby działał xD tylko jest jeden mały problem nie jestem programistą :) Oto kod programu:

program Test_GaussJordan;
uses Crt;
type vector       = array [1..121] of Extended;
     vector1      = array [1..21] of Extended;
     vector2      = array [1..21] of Integer;
     coefficients = procedure (i, n  : Integer; var a : vector1);
var i, n, st : Integer;
    x        : vector;
    a        : vector1;
procedure GaussJordan (n:Integer; oneeqn:coefficients; var x:vector;var st:Integer);

var i,j,jh,k,kh,l,lh,n1,p,q,rh : Integer;
    max,s                      : Extended;
    a,b                        : vector1;
    r                          : vector2;
begin
  st:=0;
  if n<1
    then st:=1;
  if st=0
    then begin
           n1:=n+1;
           p:=n1;
           for i:=1 to n1 do
             r[i]:=0;
           k:=0;
           repeat
             k:=k+1;
             oneeqn (k,n1,a);
             for i:=1 to n do
               begin
                 rh:=r[i];
                 if rh<>0
                   then b[rh]:=a[i]
               end;
             kh:=k-1;
             l:=0;
             max:=0;
             for j:=1 to n1 do
               if r[j]=0
                 then begin
                        s:=a[j];
                        l:=l+1;
                        q:=l;
                        for i:=1 to kh do
                          begin
                            s:=s-b[i]*x[q];
                            q:=q+p
                          end;
                        a[l]:=s;
                        s:=abs(s);
                        if (j<n1) and (s>max)
                          then begin
                                 max:=s;
                                 jh:=j;
                                 lh:=l
                               end
                      end;
             if max=0
               then st:=2
               else begin
                      max:=1/a[lh];
                      r[jh]:=k;
                      for i:=1 to p do
                        a[i]:=max*a[i];
                      jh:=0;
                      q:=0;
                      for j:=1 to kh do
                        begin
                          s:=x[q+lh];
                          for i:=1 to p do
                            if i<>lh
                              then begin
                                     jh:=jh+1;
                                     x[jh]:=x[q+i]-s*a[i]
                                   end;
                          q:=q+p
                        end;
                      for i:=1 to p do
                        if i<>lh
                          then begin
                                 jh:=jh+1;
                                 x[jh]:=a[i]
                               end;
                      p:=p-1
                    end
           until (k=n) or (st=2);
           if st=0
             then for k:=1 to n do
                    begin
                      rh:=r[k];
                      if rh<>k
                        then begin
                               s:=x[k];
                               x[k]:=x[rh];
                               i:=r[rh];
                               while i<>k do
                                 begin
                                   x[rh]:=x[i];
                                   r[rh]:=rh;
                                   rh:=i;
                                   i:=r[rh]
                                 end;
                               x[rh]:=s;
                               r[rh]:=rh
                             end
                    end
         end
end;

procedure oneeqn (i,n:Integer; var a:vector1); far;
begin
  case i of
    1:begin
          a[1]:=3;  a[2]:=1;  a[3]:=6;  a[4]:=2
        end;
    2:begin
          a[1]:=2;  a[2]:=1;  a[3]:=3;  a[4]:=7
        end;
    3:begin
          a[1]:=1;  a[2]:=1;  a[3]:=1;  a[4]:=4
        end
  end
end;


begin
  ClrScr;
  Writeln ('* GaussJordan test *');
  Writeln;
  Write ('n (<=20 due to the definitions of types "vector", "vector1" ');
  Write ('and "vector2") = ');
  Readln (n);

  Writeln;
  GaussJordan (n,oneeqn(i,n,a),x,st);
  for i:=1 to n do
    Writeln ('x[', i, '] = ', x[i]);
  Writeln ('st = ', st);
  Readln
end.

Z góry dzięki za pomoc :)

2

Pomoc?
Przeczytaj kurs języka Pascal, a zapewne doszukasz się błędu w tym nieczytelnie sformatowanym kodzie.
Hint: błąd (na poziomie kompilacji) jest tylko jeden i znajduje się w 136 linijce - nie mam natomiast ochoty sprawdzać samego algorytmu działania.

Gotowiec?
Dział Praca.

0

Na podstawie tego programu (dostałem go od wykładowcy) mam zrobić sprawozdanie tylko program niestety się nie kompiluje więc pisze o pomoc ludzi, którzy mają coś konkretnego do powiedzenia.

1 użytkowników online, w tym zalogowanych: 0, gości: 1