Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.02.2009, 18:40   #1
Andrew_st
 
Регистрация: 14.12.2008
Сообщений: 6
По умолчанию помогите подкоректировать прогу в паскале

Unit STUD_MM;


Interface

Uses Crt;

Type
A=array[1..10,1..11] of Real;
OTWET=array[1..10] of Real;

Procedure WWOD(Var MAS:A;Var n:byte);
Procedure Gauss(Mas:A;n:Byte;Var X:OTWET);
Procedure WYWOD(n:Byte;X:Otwet);
Function Krit(n:byte;XP,XM:OTWET;Eps:Real):b oolean;
Procedure Iteracia(Var n:Byte;Mas:A;Eps:Real;Var X:Otwet);

Implementation

Procedure WWOD;
Var
i,j:Byte;

Begin
ClrScr;
TextColor(Yellow);
Write('Cislo urawneniy: ');
TextColor(Red);
Readln(n);
TextColor(Yellow);
Writeln('Wwedite postrocno matricu:');
For I:=1 to n do begin
Writeln(I,'-e urawnenie:');
For J:=1 to n+1 do read(Mas[I,J]);
Writeln
end;
End;

Procedure Gauss;
Var
I,J,L,M:Byte;
B:Real;

Begin
For I:=1 to n-1 do begin
For J:=I+1 to n do begin
If Mas[I,I]=0 then begin
For L:=I+1 to n do begin
If Mas[L,I]<>0 then begin
For M:=1 to n+1 do begin
B:=Mas[L,M];
Mas[L,M]:=Mas[I,M];
Mas[I,M]:=B
end;
end else begin
Writeln('ERROR_GAUSS:DELTA=0!!!!');
Sound(1000);
Delay(10000);
NoSound;
Exit;
end;
end;
end;

B:=-MAS[J,I]/MAS[I,I];
For L:=I to n+1 do MAS[J,L]:=MAS[J,L]+MAS[I,L]*B;
end;
end;
X[n]:=MAS[n,n+1]/MAS[n,n];
For I:= n-1 downto 1 do begin
B:=0;
For J:=n downto I+1 do B:=B+MAS[I,J]*X[J];
X[I]:=(MAS[I,N+1]-B)/MAS[I,I]
end;
End;

Procedure WYWOD;
Var I:Byte;

Begin
TextColor(LightMagenta);
Writeln('Reshenie systemy urawnenij:');
For I:=1 to n do begin
TextColor(Yellow);
Write('X',I,'= =');
TextColor(LightRed);
Writeln(X[I]:9:5)
end;
TextColor(White)
End;

Function Krit;
Var
S:boolean;
I:byte;
Begin
S:=True;
For I:=1 to n do If Abs(XP[i]-XM[I])<Eps then S:=S and True else S:=S and False;
Krit:=S
End;

Procedure Iteracia;
Var
Rab:Real;
I,J:Byte;
X0,X1:Otwet;
Begin
For I:=1 to n do begin
Rab:=Mas[I,I];
For J:=1 to n+1 do Mas[I,J]:=Mas[I,J]/Rab;
X0[I]:=Mas[I,n+1];
end;

For I:=1 to n do begin
X1[I]:=Mas[I,n+1];
For J:=1 to n do begin
If I<>J Then X1[I]:=X1[I]-Mas[I,J]*X0[J]
end;
end;
While not Krit(n,X1,X0,Eps) do begin
For I:=1 to n do X0[I]:=X1[I];
For I:=1 to n do begin
X1[I]:=Mas[I,n+1];
For J:=1 to n do begin
If I<>J Then X1[I]:=X1[I]-Mas[I,J]*X0[J]
end;
end;

end;
For I:=1 to n do X[I]:=X1[I]
End;

BEGIN
End.




Подпрограма!!

Program Lab_3m;
Uses Crt,Stud_mm;
Var
M:A;
R:Otwet;
K:Byte;

Begin
Wwod(M,K);
Iteracia(k,M,0.005,R);
Wywod(k,R)
End.
Andrew_st вне форума Ответить с цитированием
Старый 28.02.2009, 18:43   #2
Andrew_st
 
Регистрация: 14.12.2008
Сообщений: 6
По умолчанию

прога ищет корени матриці методом итерации
Andrew_st вне форума Ответить с цитированием
Старый 28.02.2009, 19:13   #3
NeshSoft
Максим Николаев
Форумчанин
 
Аватар для NeshSoft
 
Регистрация: 15.02.2009
Сообщений: 170
По умолчанию

Если были бы отступы, комментарии, и указание на проблему - было бы значительно лучше
NeshSoft. Программирование на заказ для студентов. Delphi/Pascal. Подробнее на сайте neshsoft.narod.ru
NeshSoft вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ПОмогите подкоректировать задачу на Паскале maziLa Помощь студентам 1 24.12.2008 23:14
Помогите подкоректировать программу Killdgedan Помощь студентам 7 24.12.2008 22:10
HELP! Нужно подкоректировать прогу на СИ. NEWLOGIN Помощь студентам 3 10.05.2008 18:11
помогите подкоректировать задачи ,а то не правильно выдают ответы!! chelsi Общие вопросы Delphi 3 25.04.2008 10:35