I have a WA on the test 2. Who nows it, please, help me.

My program:

var  i,j,n,m,x:longint;
     s:array[1..50,1..50]of string[1];
     a:array[1..50,1..50]of integer;

 procedure redata;
  begin
    fillchar(a,sizeof(a),0);
   readln(n,m);
   for i:=1 to n do begin
   for j:=1 to m do
    read(s[i,j]);
    readln;   end;
   for i:=1 to n do begin
   for j:=1 to m do begin
    read(x);
    if x mod 2=1 then a[i,j]:=1; end;
    readln;   end;


  end;

  procedure zamena;
   var k,x,y:integer;
   begin
    for k:=1 to m do
     if s[i,k]='W' then s[i,k]:='B' else s[i,k]:='W';
    for k:=1 to n do
     if s[k,j]='W' then s[k,j]:='B' else s[k,j]:='W';

    if s[i,j]='W' then s[i,j]:='B' else s[i,j]:='W';

    for X:=1 to 50 do
     for Y:=X to 50 do

     if frac(sqrt((X*X)+(Y*Y)))=0 then begin

     if (i-x>0)and(j-y>0) then BEGIN
     if s[i-x,j-y]='W' then s[i-x,j-y]:='B' else s[i-x,j-y]:='W';END;

     if (i-y>0)and(j-x>0) then BEGIN
     if s[i-y,j-x]='W' then s[i-y,j-x]:='B' else s[i-y,j-x]:='W';END;

     if (i-y>0)and(j+x<=N) then BEGIN
     if s[i-y,j+x]='W' then s[i-y,j+x]:='B' else s[i-y,j+x]:='W';END;

     if (i+y<=M)and(j-x>0) then BEGIN
     if s[i+y,j-x]='W' then s[i+y,j-x]:='B' else s[i+y,j-x]:='W';END;

     if (i-x>0)and(j+y<=N) then BEGIN
     if s[i-x,j+y]='W' then s[i-x,j+y]:='B' else s[i-x,j+y]:='W';END;

     if (i+x<M)and(j-y>0) then  BEGIN
     if s[i+x,j-y]='W' then s[i+x,j-y]:='B' else s[i+x,j-y]:='W';END;

     if (i+x<=M)and(j+y<=N) then BEGIN
     if s[i+x,j+y]='W' then s[i+x,j+y]:='B' else s[i+x,j+y]:='W';END;

     if (i+y<=M)and(j+x<=M) then BEGIN
     if s[i+y,j+x]='W' then s[i+y,j+x]:='B' else s[i+y,j+x]:='W';END;

                           end;
   end;

 procedure main;
  begin
   for i:=1 to n do
   for j:=1 to m do
    if a[i,j]=1 then zamena;
  end;

 procedure outdata;
  begin
   for i:=1 to n do begin
   for j:=1 to m do
   write(s[i,j]);
   writeln;  end;

  end;

 begin
  redata;
  main;
  outdata;
 end.