Задача такова:
задан массив из 40 случайных элементов, переписать из массива в линейный двунаправленный список чётные элементы массива, добавить в начало списка среднее арифметическое элементов списка и в конец добавить среднее геометрическое элементов списка.

В принципе решить я ее смог...

Program list;
uses crt;

type
TPList= ^TList;

TList= record
Data: real;
Next: TPList;
Prev: TPList;
end;

const
n=40;  {эт так, чтоб проверять легче было ))}

var
Head, Curr, PrevEl: TPList;
i, kol: byte;
SrAr, SrGeom, sum, prod: real;
ElArr: array [1..n] of real;


procedure Add_el; {добавляет очередную запись в список}
begin
  if i=2 then
  begin
	new(Head);
	Head^.Data:= ElArr[i];
	PrevEl:=Head;
  end
  else
  begin
	new(Curr);
	Curr^.Data:=ElArr[i];
	Curr^.Prev:=PrevEl;
	PrevEl^.Next:=Curr;
	PrevEl:=Curr;
  end;
end;

procedure Add_SrAr; {добавляет в начало среднее арифметическое}
begin
  new(Curr);
  Curr^.Data:=SrAr;
  Curr^.Next:=Head;
  Head^.Prev:=Curr;
  Head:=Curr;
end;

procedure Add_SrGeom; {и, соответственно, среднее пропорцианальное}
begin
  new(Curr);
  Curr^.Data:=SrGeom;
  Curr^.Prev:=PrevEl;
  PrevEl^.Next:=Curr;
  PrevEl:=Curr;
end;

procedure Main;
begin
  randomize;
  for i:=1 to n do ElArr[i]:=random;

  sum:=0; prod:=1;
  for i:=1 to n do
  if not odd(i) then
  begin
	Add_el;
	sum:=sum+ElArr[i];
	prod:=prod*ElArr[i];
	inc(kol);
  end;

  SrAr:=sum/kol;
  Add_SrAr;
  SrGeom:=sqrt(prod);
  Add_SrGeom;
end;


begin
clrscr;
Main
end.

проверял...вроде работает... но для меня тема списков, динамических переменных и т.д. новая, поэтому если кто найдет ошибки - напишите, плиз, буду благодарен!!!

Ага, и ты описываешь массив вещественных чисел, да? Как определяешь их четность (с учетом того, что Random выдает числа в интервале 0..1)? Или речь об элементах с четными индексами?

Как ты проверял? В отладчике? Сделал бы вывод на экран, все стало бы проще...

Кстати, ты память выделил, а освобождать кто будет? При прогоне под FPC имеем:

Я написал процедуру вывода:

procedure WriteList;
var
List: text;
begin
Assign(List, 'List.list');
rewrite(List);

Curr:= Head;
repeat
write(List, Curr^.Data:0:3, ' ');
Curr:=Curr^.Next;
until Curr=NIL;

close(List);
end;

проверял с ее же использованием....

под четными элементами имеются в виду элементы с четными индексами.

еще нашел свой касяк....среднее геометрическое надо было искать по формуле SrGeom:=exp((1/kol) * ln(prod).
А освобождать надо в самом конце???

Да...

Но перед этим я бы все-таки порекомендовал тебе немного подкорректировать программу. Не привыкай работать через глобальные переменные. У процедур могут быть параметры - пользуйся этим. Смотри:

Program list;
uses crt;

type
  TPList= ^TList;
  TList = record
    Data: real;
    Next: TPList;
    Prev: TPList;
  end;

const
  n = 10;

{ Процедура добавляющая value в начало списка L }
procedure AddFirst(var L: TPList; value: real);
var curr: TPList;
begin
  new(curr);
  curr^.data := value;
  curr^.prev := nil;
  curr^.next := L;

  if L <> nil then begin
    L^.prev := curr;
    L := curr;
  end;
end;

{ Процедура добавляющая value в конец списка L }
procedure AddLast(var L: TPlist; value: real);
var curr, tail: TPList;
begin

  new(curr);
  curr^.data := value;
  curr^.prev := nil;
  curr^.next := nil;

  if L = nil then L := curr
  else begin
    tail := L;
    while tail^.next <> nil do tail := tail^.next;
    tail^.next := curr;
    curr^.prev := tail;
  end;

end;

var
  Head: TPList;

procedure WriteList;
var curr: TPList;
begin
  Curr:= Head;
  repeat
    write(Curr^.Data:0:3, ' ');
    Curr:=Curr^.Next;
  until Curr=NIL;
  writeln;
end;


procedure Main;
{ Все переменные - локальные }
var
  i, kol: integer;
  ElArr: array [1..n] of real;
  SrAr, SrGeom, sum, prod: real;

begin
  randomize;
  for i:=1 to n do ElArr[i]:=random;

  sum:=0; prod:=1;
  for i:=1 to n do
  if not odd(i) then
  begin
    AddLast(Head, ElArr[i]);

    sum:=sum+ElArr[i];
    prod:=prod*ElArr[i];
    inc(kol);
  end;

  writelist;

  SrAr:=sum/kol;
  AddFirst(Head, SrAr);
  SrGeom:=exp((1/kol) * ln(prod));
  AddLast(Head, SrGeom);

  writelist;
end;


begin
  clrscr;
  Main;
  { Здесь добавишь код освобождения памяти }
end.

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

procedure AddFirst(var L: TPList; value: real);
var curr: TPList;
begin
  new(curr);
  curr^.data := value;
  curr^.prev := nil;
  curr^.next := L;

 if L <> nil then begin 
	L^.prev := curr;
	L := curr;
  end;
end;

if L <> nil then begin
а это условие для универсальности??? ведь в качаестве фактического параметра в функцию возвращается указатель на первый узел, а он в любом случае не пустой...

и еще вопрос по поводу освобождения памяти... освобождать надо только те динамические структуры, на которые память выделялась при помощи new()???

При добавлении первого элемента в список он как раз пустой...

Да, именно их и надо освобождать...

Но новые элементы добавляются в конец! Я пробовал прогонять... это условие выполняется, т.е. L <> nil... или это условие на случай,если список будет создаваться добавлением в начало???

Сегодня у тебя новые элементы добавляются в конец, завтра - надо будет добавлять в начало. Не надо подгонять процедуру под конкретные условия только этой задачи, когда можно сделать более универсальной (особенно если для этого не нужно прилагать большие усилия: всего навсего одна проверка на nil), такой, чтобы можно было ее использовать неоднократно...

Ясно, спасибо!!!
Вроде более или менее разобрался))