Однонаправленный список (Студенты), работа со списком Опции

[Наташа]

Помогите, пожалуйста, не могу никак найти ошибку. Замучалась, вроде всё правильно, но на четвёртом блоке программа сбивается.

М

Наташа, используй теги, пожалуйста (выделить текст, выбрать нужный тег в меню CODE). А вообще, такие большие тексты лучше прикреплять файлами. -- Lapp

program Spisok;
 uses crt;
type
   oc=record
    mat,ang,inf,alg,fiz:integer;
   end;
   tsp=^sp;
   sp=record
    next:tsp;
    name:string[15];
    voz:integer;
    pol:char;
    ocen:oc;
   end;
var
  head,head1,pl,pr:tsp;
  k,n,m,i,u,j,g:integer;
  yl,yr:tsp;
  s:string;
  MASS:array [1..100] of integer;
  f1:text;
  sl,sc,sr:tsp;
{1***********************}
begin
   n:=6;
   k:=0;
   g:=0;
   pr:=nil;
   assign(f1,'stu.txt');
   reset(f1);
   if n=0 then writeln('” ©« stu.txt Їгбв') else for i:=1 to n do
  begin
    if k=0 then
   begin
     k:=k+1;
     new(head);
    readln(f1,head^.name); write(head^.name,' ');
    readln(f1,head^.voz); write(head^.voz,' ');
    readln(f1,head^.pol); write(head^.pol,' ');
    readln(f1,head^.ocen.mat); write(head^.ocen.mat,' ');
    readln(f1,head^.ocen.ang); write(head^.ocen.ang,' ');
    readln(f1,head^.ocen.inf); write(head^.ocen.inf,' ');
    readln(f1,head^.ocen.alg); write(head^.ocen.alg,' ');
    readln(f1,head^.ocen.fiz); writeln(head^.ocen.fiz);
     new(pr);
     head^.next:=pr;
     pl:=head;
   end
    else
   begin
    readln(f1,pr^.name); write(pr^.name,' ');
    readln(f1,pr^.voz); write(pr^.voz,' ');
    readln(f1,pr^.pol); write(pr^.pol,' ');
    readln(f1,pr^.ocen.mat); write(pr^.ocen.mat,' ');
    readln(f1,pr^.ocen.ang); write(pr^.ocen.ang,' ');
    readln(f1,pr^.ocen.inf); write(pr^.ocen.inf,' ');
    readln(f1,pr^.ocen.alg); write(pr^.ocen.alg,' ');
    readln(f1,pr^.ocen.fiz); writeln(pr^.ocen.fiz);
    if i<n then
     begin
       pl:=pr;
       new(pr);
       pl^.next:=pr;
     end
    else pr^.next:=nil;
   end;
  end;
   pl:=nil;
{2***********************}
     new(pr);
     pr:=head;
     pr^.next:=head^.next;
     i:=0;
  for i:=1 to n do
   begin
     if pr^.voz<=17 then
    begin
      writeln('(1) ');
      write(pr^.name);
      write(pr^.voz);
      write(pr^.pol);
      write(pr^.ocen.mat);
      write(pr^.ocen.ang);
      write(pr^.ocen.inf);
      write(pr^.ocen.alg);
      writeln(pr^.ocen.fiz);
      break;
    end
     else
    begin
      if (pr^.voz<=15)or(pr^.voz>=80) then Writeln('ЋиЁЎ®з­л© ў®§а бв ў ЇЁбЄҐ');
      if i = n then
     begin
       Writeln('‘в㤥­в®ў 17 «Ґв Ё ¬« ¤иҐ ­Ґв ў бЇбЄҐ');
       break;
     end
      else
     begin
       pr:=pr^.next;
     end;
    end;
   end;
     pr:=nil;
{3************************}
  new(sl);
  sl:=head;
  sr:=sl^.next;k:=0;
  if (head^.pol='m') then
    Begin
     new(sc);
     sc:=head;
     head:=sl^.next;

    end
  else
    while (sr<>nil) do
     if (sr^.pol='m') then
      Begin
        sl^.next:=sr^.next;
        dispose(sr);
        sl:=nil;
      end
     else
      begin
       sl:=sr;
       sr:=sr^.next; k:=k+1;
      end;

{4************************}
     if k<>n then n:=n-1 else writeln('Њг¦зЁ­ ­Ґв ў бЇЁбЄҐ');
     new(pl);
     new(pr);
     new(head1);
     pr:=head;
     pr^.next:=head^.next;
     i:=0;
  for i:=1 to n do
   begin
     if i<>1 then pr:=pr^.next;
     mass[i]:=(pr^.ocen.mat + pr^.ocen.ang + pr^.ocen.inf + pr^.ocen.alg + pr^.ocen.fiz);
     writeln(mass[i]);
   end;
     pr:=nil;
  for i:=1 to n do
   begin
    m:=0;
    for j:=1 to n do
     begin
      if mass[j]>m then
       begin
         k:=j;
         m:=mass[j];
       end;
     end;
    writeln(k);

     pr:=head;

   while j<=(k-1) do
      Begin
       sr:=pr^.next;
       pr:=sr;
       j:=j+1;
      end;
      write(pr^.name);
      write(pr^.voz);
      write(pr^.pol);
      write(pr^.ocen.mat);
      write(pr^.ocen.ang);
      write(pr^.ocen.inf);
      write(pr^.ocen.alg);
      writeln(pr^.ocen.fiz);

    if i=1 then head1:=pr
    else
     if i<n then
        if i=2 then
         begin pl:=pr; head1^.next:=pl;
         end
        else
         if g=0 then
          begin new(sl); sl:=pr; pl^.next:=sl; g:=g+1;
          end
         else
          begin new(pl); pl:=pr; sl^.next:=pl; g:=g-1;
          end
     else
      begin
        if g=0 then pl^.next:=pr else sl^.next:=pr;
        pr^.next:=nil;
      end;
    mass[k]:=0;
   end;
     head:=head1;
     head^.next:=head1^.next;
     head1:=nil;

{5************************}
   new(pr);
   pr:=head;
   pr^.next:=head^.next;
  for i:=1 to n do
   begin
      write(pr^.name);
      write(pr^.voz);
      write(pr^.pol);
      write(pr^.ocen.mat);
      write(pr^.ocen.ang);
      write(pr^.ocen.inf);
      write(pr^.ocen.alg);
      writeln(pr^.ocen.fiz);
    if i = n then
     begin
       break;
     end
    else
     begin
       pr:=pr^.next;
     end;
   end;
     pr:=nil;

{*************************}
   close(f1);
   readln;
end.

[Наташа]

Вот условие задачи:

Информация о студенте состоит из его фамилии, возраста (число лет), пола и успеваемости (оценки по пяти предметам). Ввести информацию о группе студентов, представляя ее в виде связанного одностороннего списка. Один элемент списка содержит информацию об одном студенте.
А). Найти студента первого по порядку студента, возраст которого менее 17 лет.
Б). Удалить из списка первого по порядку мужчину.
В). Переупорядочить данный список по убыванию суммы оценок каждого студента по всем предметам.