Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
21
Добавлен:
09.12.2013
Размер:
2 Кб
Скачать
Program Matr;
 uses crt;
 const n=8;
       n1=7;
       x:array [0..n] of real=(-4, -3, -2, -1, 0, 1, 2, 3, 4);
       y:array [0..n] of real=(0,   2,  0, -1, 0, 1, 0,-2, 0);
 var m:array [0..n] of real;
     a:array [1..7,1..8] of real;
     i,j:integer;

 procedure Holess;
  var m,t,i1,k:integer;
      max,p,s:real;
      a1:array [0..n] of real;
   begin
    for m:=1 to n1 do
     begin
      if m=1 then
       for j:=2 to n1+1 do a[1,j]:=a[1,j]/a[1,1];
      if m>=2 then
       begin
        max:=abs(a[m,m]);
        for t:=m to n1 do
         if abs(a[t,m])>=max then
          begin
           max:=abs(a[t,m]);
           i1:=t;
          end;
        for i:=1 to n1+1 do a1[i]:=a[m,i];
        for i:=1 to n1+1 do
         begin
          a[m,i]:=a[i1,i];
          a[i1,i]:=a1[i];
         end;
        for i:=m to n1 do
         begin
          p:=0;
          for k:=1 to m-1 do p:=p+a[i,k]*a[k,m];
          a[i,m]:=a[i,m]-p
         end;
        for j:=m+1 to n1+1 do
         begin
          s:=0;
          for k:=1 to m-1 do s:=s+a[m,k]*a[k,j];
          a[m,j]:=(a[m,j]-s)/a[m,m];
         end;
       end;
     end;
   end;

 procedure Res;
  var i,k:integer;
      s:real;
   begin
    for i:=n1 downto 1 do
     begin
      if n1=1 then x[i]:=a[n1,n1+1];
      s:=0;
      for k:=i+1 to n1 do
       s:=s+a[i,k]*x[k];
      x[i]:=a[i,n1+1]-s;
      writeln('M[',i,']=',x[i]:6:5);
     end;
    writeln(x[4]+4*x[5]+x[6]:6:5);
   end;

  begin
   clrscr;
   m[0]:=(-11*y[0]+18*y[1]-9*y[2]+2*y[3])/6;
   m[n]:=(11*y[n]-18*y[n-1]+9*y[n-2]-2*y[n-3])/6;
   for i:=1 to 7 do
    for j:=1 to 8 do a[i,j]:=0;
   for i:=1 to 7 do a[i,i]:=4;
   for i:=1 to 6 do
    begin
     a[i,i+1]:=1;
     a[i+1,i]:=1;
    end;
   a[1,8]:=3*(y[2]-y[0])-m[0];
   a[7,8]:=3*(y[8]-y[6])-m[8];
   for i:=2 to 6 do a[i,8]:=3*(y[i+1]-y[i-1]);
   for i:=1 to 7 do
    begin
     for j:=1 to 8 do write(a[i,j]:6:5,' | ');
     writeln;
    end;
   Holess;
   Res;

   {

   for i:=1 to 7 do
    begin
     for j:=1 to 8 do write(a[i,j]:6:5,' | ');
     writeln;
    end;}
   writeln(-2.06599+4*(-0.90034):6:5);
   readln;
  end.
Соседние файлы в папке лаба №1 крэс-05