var
   a:array[1..150,1..200] of integer;

   i,j,l,n,poz:integer;
begin
{   assign(Input,'input.txt'); assign(Output,'output.txt');
   reset(Input);              rewrite(Output);}
   readln(n);

   if n=1 then begin readln(l); writeln(l); end
   else begin
   for i:=1 to n do
   for j:=1 to n do
   read(a[i,j]);

   write(a[1,1],' ');
   inc(poz);
    i:=1; j:=2;
   repeat
      if (i=n) and (j=1) then
      begin
        i:=2; j:=n;
      end
    else
      begin
          if (j=1) then
          begin
             l:=i; i:=j; j:=l;
             inc(j);
          end
        else
          if (i=n) then
          begin
             l:=i; i:=j; j:=l;
             inc(i);
          end;
      end;

      while not (j=1) and not (i=n)  do
      begin
         write(a[j,i],' '); ;dec(j); inc(i);
      end;
      write(a[j,i],' ');
   until (i=n) and(j=n);
   writeln(a[n,n]);






             end;
{   close(Input);       close(Output);}
end.

Change
-------
writeln(a[n,n]);
-------
to
-------
writeln;
-------
and you'll get AC
758634 16:08:25
15 фев 2005 TECTOBOP 1313 Pascal Accepted 231 КБ