облегчить готовую программу

[Azizus]

Смысл в том что написал программу по палиндромам(4х значные),все пашет хорошо
только есть одно но программа долго думает
помогите хотябы мыслями как ее можно облегчить? мб циклы другие юзать?
(
uses crt;
var i,j,c,d,n,e,x,k,y,s,w,m,t,r,z:integ er;
a:array[1..250] of integer;
begin
clrscr;
readln(n);
i:=1;
while i<=n do begin
read(a[i]); end;
for j:=1 to n-1 do
for e:=j+1 to n do
begin
c:=a[j] div 100;
k:=a[e] mod 100;
m:=c div 10;
s:=k mod 10;
t:=c mod 10;
r:=k div 10;
if (m=s)and(t=r) then
d:=d+1;
end;
d:=d*2;
writeln(d);
readkey;
end.

)

[New man]

Как я понял надо наййти равные палиндромы?

uses crt;
function Palindrom(x:integer):boolean;
begin
   Palindrom:=(x div 1000 = x mod 10)and(x div 100-x mod 100 = x div 10 - x mod 10)
end;
var i,j,n:integer;
a:array[1..250] of integer;
begin
clrscr;
readln(n);
i:=1;
while i<=n do begin
read(a[i]);inc(i); end;
d:=0;
for i:=1 to n-1 do
for j:=i+1 to n do
if Palindrom(a[i])and Palindrom(a[j])and (a[i]=a[j]) then
  inc(d)
writeln(d);
readkey;
end.

или найти число всеч чисел которые равны
обротно записанным числам др числа?
Тада

Procedure Prover(x,y:integer):boolean;
begin
Prover:=(x div 1000 = y mod 10)and(x div 100-x mod 100 = y div 10 - y mod 10)
end;
var a: array[1..250]of integer;
  i,j,n,f:integer;
begin
readln(n);
for i:=1 to 250 do
read(a[i]);
f:=0;
for i:= 1 to n-1 do
for j:=i+1 to n do
 if Prover(a[i],a[j])then inc(f);
writeln(f);
writeln('Vce');
readln
end.

[evg_m]

вынести операции НЕ использующие ii из внутреннего цикла
( зачем n-j раз считать ОДНО и тоже).

for j:=1 to n-1 do begin
  c:=a[j] div 100;
  m:=c div 10;
  t:=c mod 10;
  for e:=j+1 to n do begin
    k:=a[e] mod 100;
    s:=k mod 10;
    r:=k div 10;
    if (m=s)and(t=r) then
      d:=d+1;
  end;
end;