Turbo Pascal. Нужна помощь

[Светик123]

Turbo Pascal. Нужна помощь

задание: Задана последовательность из N вещественных чисел. Вычислить порядковый номер числа наиболее приближенному к среднему арифметическому максимального и минимального чисел данной последовательности.
проблема: при вводе одинаковых значений нужно чтобы ВСЕ номера наиболее приближенных элементов выводились на экран, а не как у меня - только последний
текст программы:
program srednee;
uses crt;
const H=30;
procedure vvod(z:integer; var N:integer);
begin
repeat
{$i-}
writeln ('Vvedite kolichestvo elementov posledovatelnosti (tseloe chislo), 1<N<30'); readln (N);
z:=ioresult;
{$I+}
if ioresult <>0 then
begin
writeln ('Nekorrektnii vvod. Vvedite kolichestvo elementov posledovatelnosti (tseloe chislo), 1<N<30'); readln(N);
end
until z = 0;
end;
procedure deistvie(min, max:real; var sr:real);
begin
sr:=(min+max)/2;
writeln('srednee = ',sr:3:2);
end;
procedure vivod(var nomer:integer);
begin
writeln(' poriadkovii nomer chisla naibolee pribligennogo k srednemy arifmeticheskom - ',nomer);
end;
var A,B:array [1..H] of real;
N, i, nomer,z:integer;
max,min,sr,prib:real;
begin
{$I-}
clrscr;
writeln('Programma nahodit poriadkovii nomer chisla naibolee pribligennogo');
writeln('k srednemy arifmeticheskomy max i min chisel dannoi posledovatelnosti');
repeat
vvod(z,N);
if (N > H) or (N<=1) then
begin
writeln ('Necorrektnii vvod. 1<N<30');
writeln ('Vvedite kolichestvo elementov posledovatelnosti (tseloe chislo), 1<N<30'); readln (N);
end;
until (N < H) and (N > 1);
for i:=1 to N do
begin
repeat
{$I-}
write('element[', i, ']=');
readln (A);
z:=ioresult;
{$I+}
if z <>0
then
begin
writeln('Vvedennoe chislo nekorrectno! Povtorite vvod.');
end;
until z = 0;
end;
writeln ('rezyltat vvoda: ');
write('array: [');
for i:= 1 to N do
begin
write(',',A:1:2);
end;
write (']');
readln;
min:=A[1];
for i:=1 to N do if (A <= min) then min:=A;
writeln('min = ',min:3:2);
max:=A[1];
for i:=1 to N do if (A >= max) then max:=A;
writeln('max = ',max:3:2);
deistvie (min,max,sr);
for i:=1 to N do B:=abs(sr-A);
prib:=B;
nomer:=1;
for i:=1 to N do if (B <= prib) then
begin
prib:=B;
nomer:=i;
end;
vivod (nomer);
readkey;
end.
заранее спасибо за внимание

 

[Vladimir_S]

Да, Света, - наворотили от души! Нет, оно, конечно, прекрасно, что Вы стараетесь использовать подпрограммы, но это не значит, что каждый чих (типа нахождения среднего арифметического двух чисел) нужно непременно оформлять в виде процедуры или функции. Кроме того, Вы, похоже, несколько путаетесь со статусами переменных (параметров) подпрограмм (глобальные, формальные, внутренние). Но ничего, разберетесь. Очень много лишнего.
Ну вот, как вариант:

Uses CRT;

const
 H=30;

var
 A,B:array[1..H] of real;
 N,i:integer;
 max,min,sr,prib:real;

procedure vvod;
var z,q:Integer;
begin
 {$I-}
 repeat
  writeln ('Vvedite kolichestvo elementov posledovatelnosti (tseloe chislo), 1<N<30');
  readln(N);
  z:=ioresult;
  if (z<>0) or (N<1) or (N>H) then writeln ('Nekorrektnii vvod!');
 until (z=0) and (N>0) and (N<=H);
 for q:=1 to N do
  begin
   repeat
    write('element[', q:2, ']= ');
    readln(A[q]);
    z:=ioresult;
    if z<>0 then writeln('Vvedennoe chislo nekorrectno! Povtorite vvod.');
   until z=0;
  end;
 writeln;
 writeln ('rezyltat vvoda: ');
 for q:= 1 to N do write(A[q]:8:2);
 writeln;
end;

Begin
 {$I-}
 clrscr;
 writeln('Programma nahodit poriadkovii nomer chisla naibolee pribligennogo');
 writeln('k srednemy arifmeticheskomy max i min chisel dannoi posledovatelnosti');
 vvod;
 min:=A[1];
 max:=A[1];
 for i:=2 to N do
  begin
   if (A[i]<min) then min:=A[i];
   if (A[i]>max) then max:=A[i];
  end;
 writeln('min = ',min:3:2);
 writeln('max = ',max:3:2);
 writeln;
 sr:=(min+max)/2;
 for i:=1 to N do B[i]:=abs(sr-A[i]);
 prib:=B[1];
 for i:=2 to N do if B[i]<prib then prib:=B[i];
 writeln('Iskomyie nomera:');
 for i:=1 to N do if B[i]=prib then write(i:3);
 readkey;
End.

 

[Светик123]

спасибо))
насчет процедур и функций - нас так заставляют делать с целью познакомиться со всей этой конструкцией. но да, я, наверное, слишком сильно раздробила программу
еще раз спасибо за помощь)