Показать сообщение отдельно
Старый 10.12.2009, 23:10   #22 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Так, ну отладил я Вашу программу. Ошибок очень много, но ничего страшного, научитесь. Пара замечаний общего характера:
1. Вы, похоже, не разобрались с заданием параметров процедур и функций, тех, что идут в скобках после имени подпрограммы. Тут так. Слово "var" при перечислении параметров ФУНКЦИИ вообще ставить не надо; в то же время в ПРОЦЕДУРЕ оно играет ключевую роль: ВХОДНЫЕ параметры перечисляются БЕЗ "var", ВЫХОДНЫЕ - с "var".
2. Не обязательно, но ОЧЕНЬ желательно - пользуйтесь при написании программы паскалевскими "лесенками"! Без них читать текст программы очень трудно. А у Вас на вид прямо не Паскаль, а Фортран какой-то.
Теперь сама программа:
Код:
Program Tipovik;
uses crt;
Type MAS=Array [1..10,1..10] of Real;
     Vec=Array [1..10] of Real;
Var A,B,A1,B1:MAS;
    W:Vec;
    N,M,k:Byte;
    Q1,Q2:real;

Procedure VVOD (var x:mas; C:Byte);
 Var i,j:Byte;
  Begin
   For i:=1 to C do
    For j:=1 to C do
     begin
      WriteLn ('vvedite element s indeksom',i,' ',j);
      ReadLn (x[i,j]);
     end;
  end;

Procedure VYVOD (x:mas; C:Byte);
 Var i,j:Byte;
 Begin
  For i:=1 to C do
   begin
    For j:=1 to C do
     Write (x[i,j]:6:2);
    WriteLn;
    end;
 end;

Procedure VYVOD_Vec (y:vec; C:Byte);
 Var j:Byte;
  begin
   For j:=1 to C do
    Write (y[j]:6:2);
    WriteLn;
   end;


Function Up (x:mas; C:Byte):Real;
 Var i,j,T:byte;
     Fl:boolean;
Begin
 T:=0;
 For i:=1 to C do
  begin
   Fl:=true;
   For j:=1 to C-1 do
    If x[i,j]<x[i,j+1] then Fl:=false;
   if Fl then  T:=T+1;
  end;
 Up:=T;
End;

Procedure perestanovka (x:mas; C,z:Byte; var y:mas);
 Var i,j,m,Jfix:Byte;
     Fl:boolean;
     dub:real;
     v:Vec;
 Begin
  For j:=1 to C do
   v[j]:=x[z,j];
  For m:=1 to C do
   begin
    dub:=1000000.0;
    For j:=1 to C do
     if v[j]<dub then
      begin
       dub:=v[j];
       Jfix:=j;
      end;
    v[Jfix]:=1000000.0;
    For i:=1 to C do
     y[i,m]:=x[i,Jfix];
   end;
 End;

Procedure FV (x:mas; var y:vec; C:Byte);
 Var i,j:Byte;
     max:Real;
 Begin
  For i:=1 to C do
   begin
    max:=x[i,1];
    For j:=1 to C do
     If Abs(x[i,j])>max then
      begin
       max:=x[i,j];
       W[i]:=max;
      end;
   end;
 End;

Begin
 clrscr;
 WriteLn ('Vvedite kol-vo strok i stolbcov matrici A ');
 ReadLn (N);
 WriteLn ('Vvedite kol-vo strok i stolbcov matrici B');
 ReadLn (M);
 If (N<=0) or (N>10) or (M<=0) or (M>10) then
  WriteLn ('neverno vvedeni znacheniy')
 else
 begin
  WriteLn ('Vvod matrici A');
  VVOD (A,N);
  WriteLn ('Vvod matrici B');
  VVOD (B,M);
  clrscr;
  WriteLn ('Isxodniy massiv A');
  VYVOD (A,N);
  WriteLn;
  WriteLn ('Isxodniy massiv B');
  VYVOD (B,M);
  WriteLn;
  WriteLn ('Vvedite K-yu stroku');
  ReadLn (k);
  WriteLn;
  Q1:=Up(A,N);
  WriteLn ('Kol-vo uporyd strok A',' ',Q1:6:2);
  WriteLn;
  Q2:=Up(B,M);
  WriteLn ('Kol-vo uporyd strok B',' ',Q2:6:2);
  WriteLn;
  If Q1>Q2 then
  begin
   perestanovka (A,N,k,A1);
   WriteLn ('konechnay matrica');
   VYVOD (A1,N);
   WriteLn;
   FV (B,W,M);
   VYVOD_Vec (W,N);
  end
  else
  begin
   perestanovka (B,M,k,B1);
   WriteLn ('konechnay matrica');
   VYVOD (B1,M);
   WriteLn;
   FV (A,W,N);
   VYVOD_Vec (W,N);
  end;
  WriteLn ('Enter');
  ReadLn;
 end;
end.
Успехов!
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070