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

[Наташа]

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

М

Наташа, используй теги, пожалуйста (выделить текст, выбрать нужный тег в меню 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.