program students;

uses crt;

type ptest = ^test;

     test = record
      name: string;
      mark: integer;
      next: ptest;
     end;

     pstud = ^stud;

     stud = record
      fio: string[20];
      kaf_1,kaf_2: integer;
      sess: array  [1..3] of ptest;
      next: pstud;
      prev: pstud;
      com:integer;
     end;




procedure input(var n,m:integer; var first_st:pstud);
var i,k1,k2,mark,st,sess,com: integer;
    st_name,t:string;
    curr_st,new_st:pstud;
    curr_t,new_t:ptest;

 begin
 writeln ('enter number of students');
 readln (n);
 writeln ('enter number of tests in each session');
 readln (m);
 curr_st:=nil;
 for st:=1 to n do
 begin
  com:=0;
  if curr_st = nil then   {первый студент}
   begin
    new(new_st);
    curr_st:=new_st;
    first_st:=curr_st;
    curr_st^.prev:=nil;

    writeln ('enter name of ',st,'student');
    readln (st_name);

    curr_st^.fio:=st_name;

    Writeln ('enter codes of departments    {1..255}');
    readln (k1,k2);

    curr_st^.kaf_1:=k1;
    curr_st^.kaf_2:=k2;

    for sess:= 1 to 3 do     {3 сессии}
    begin

     for i:= 1 to m do
     begin
      if i=1 then         {первый зкзамен}
      begin
       new (new_t);
       curr_t:=new_t;
       curr_st^.sess[sess]:=curr_t;

   {    writeln ('enter name of ',i,' test');
       readln (t);

       curr_t^.name:=t;  }

       writeln ('enter mark');
       readln (mark);
       com:=com+mark;

       curr_t^.mark:=mark;

       curr_t^.next:=nil;
      end else               {НЕ первый экзамен}
      begin
      new (new_t);
      curr_t^.next:=new_t;
      curr_t:=new_t;

   {   writeln ('enter name of ',i,' test');
       readln (t);

       curr_t^.name:=t; }

       writeln ('enter mark');
       readln (mark);
       com:=com+mark;

       curr_t^.mark:=mark;

       curr_t^.next:=nil;

      end;
     end;
    end;
    curr_st^.com:=com;
    curr_st^.next:=nil;
   end  else

    begin
     new (new_st);          {НЕ первый студент}
     new_st^.prev:=curr_st;
     curr_st^.next:=new_st;
     curr_st:=new_st;


     writeln ('enter name of ',st,'student');
     readln (st_name);

     curr_st^.fio:=st_name;

     Writeln ('enter codes of departments   {1..255}');
     readln (k1,k2);

     curr_st^.kaf_1:=k1;
     curr_st^.kaf_2:=k2;


    for sess:= 1 to 3 do
    begin

     for i:= 1 to m do
     begin
      if i=1 then
      begin
       new (new_t);
       curr_t:=new_t;
       curr_st^.sess[sess]:=curr_t;

    {   writeln ('enter name of ',i,' test');
       readln (t);

       curr_t^.name:=t; }

       writeln ('enter mark');
       readln (mark);
       com:=com+mark;

       curr_t^.mark:=mark;

       curr_t^.next:=nil;
      end else
      begin
      new (new_t);
      curr_t^.next:=new_t;
      curr_t:=new_t;

    {  writeln ('enter name of ',i,' test');
       readln (t);

       curr_t^.name:=t; }

       writeln ('enter mark');
       readln (mark);
       com:=com+mark;

       curr_t^.mark:=mark;

       curr_t^.next:=nil;

      end;
     end;
    end;
    curr_st^.com:=com;
    curr_st^.next:=nil;
   end;
  end;
 end;

               {теперь сортировка...}
procedure  sort (var first_st:pstud; n:integer);
var i,j,should:integer;
    curr_st,nexter:pstud;
begin

  for i:= n-1 downto 1 do
  begin
   curr_st:=first_st;
   for j:= 1 to i do
   begin

    if curr_st^.com<curr_st^.next^.com then
    begin

     if (curr_st^.next^.next <> nil) and (curr_st^.prev <> nil) then
     should:=1;
     if (curr_st^.prev = nil) and (curr_st^.next^.next = nil) then
     should:=2;
     if (curr_st^.prev = nil) and (curr_st^.next^.next <> nil) then
     should:=3;
     if (curr_st^.prev <> nil) and (curr_st^.next^.next = nil) then
     should:=4;

     case should of
     1:
     begin
       nexter:=curr_st^.next^.next;
       curr_st^.next^.prev:=curr_st^.prev;
       curr_st^.next^.next^.prev:=curr_st;
       curr_st^.prev:=curr_st^.next;

       curr_st^.prev^.prev^.next:=curr_st^.prev;
       curr_st^.prev^.next:=curr_st;
       curr_st^.next:=nexter;
     end;

     2:
     begin
       curr_st^.next^.next:=curr_st;
       curr_st^.next^.prev:=nil;
       curr_st^.prev:=curr_st^.next;
       curr_st^.next:=nil;
       first_st:=curr_st^.prev;
     end;

     3:
     begin
       nexter:=curr_st^.next^.next;
       curr_st^.next^.prev:=nil;
       curr_st^.prev:=curr_st^.next;
       curr_st^.next^.next^.prev:=curr_st;
       curr_st^.next^.next:=curr_st;
       curr_st^.next:=nexter;
       first_st:=curr_st^.prev;
     end;

     4:
     begin
       curr_st^.next^.prev:=curr_st^.prev;
       curr_st^.prev:=curr_st^.next;
       curr_st^.prev^.prev^.next:=curr_st^.next;
       curr_st^.next^.next:=curr_st;
       curr_st^.next:=nil;
     end;
     end
    end else
     curr_st:=curr_st^.next;
   end;
  end;
end;


procedure output (first_st: pstud; n:integer);
var kaf_set:set of 1..255;
    i,j,timer:integer;
    k: 1..255;
    curr_st: pstud;
begin
 curr_st:=first_st;
 timer:=1;
 kaf_set:=[];
 repeat
   if not (curr_st^.kaf_1 in kaf_set) then
   begin
     k:=curr_st^.kaf_1;
     kaf_set:=kaf_set+[k];

     writeln ('Department number: ',k);
     writeln ('Students, that have chosen this department:');
     for j:= timer to n do
     begin
       if curr_st^.kaf_1 = k then
       begin
        write (curr_st^.fio,' ');
        writeln ('- ',curr_st^.com,' marks');
       end;
       if curr_st^.next <> nil then
        curr_st:= curr_st^.next;

     end;
     curr_st:=first_st;
     timer:=1;
   end else
   begin
     if curr_st^.next <> nil then
     curr_st:=curr_st^.next;
     inc(timer);
   end;
 until timer = n+1;
end;

procedure dispose_all (first_st:pstud; n:integer);
var i:integer;
    curr_st:pstud;
begin
 curr_st:=first_st;
 for i:= 1 to n do
 begin
  if curr_st^.next <> nil then
  begin
   curr_st:=curr_st^.next;
   dispose (curr_st^.prev);
  end else
   dispose(curr_st);
 end;
end;


var m,n:integer;
    first_stud: pstud;


begin
clrscr;
input(n,m,first_stud);
sort (first_stud,n);
output (first_stud,n);
dispose_all (first_stud,n);
readln;


end.