Упорядочьте заданные числа по уменьшению "круглости" - Pascal ABC

Формулировка задачи:

Число считается круглым, если на конце его стоит 0. Чем больше нулей на конце, тем более круглым считается число. Если количество нулей одинаково, то большее число считается более круглым. Упорядочьте заданные числа по уменьшению круглости. Смотрите примеры для уточнения. Формат файла входных данных: В первой строке записано число n (1 ≤ n ≤ 1000). Далее в n строках записаны натуральные числа ai (1 ≤ ai ≤ 30000). Формат файла выходных данных: Выведите числа в требуемом порядке. Пример: Ввод: 5 100 7890 12 25 70 Вывод: 100 7890 70 25 12 Решил задачу так :

                    Листинг программы
                
 
                        
                          
                    
var n,y1,z,z1,g,i,q,y,j,k,x,l:longint;a,c:array [1..1000] of longint;m:string;
begin
//assign(input,'round.in');
//assign(output,'round.out');
//reset(input);
//rewrite(output);
k:=0;g:=0;
readln(n);
for i:=1 to n do
readln(a[i]);
for i:=1 to n do begin
str(a[i],m);
for j:=1 to length(m) do begin
if m[j]='0' then c[i]:=c[i]+1;
end;end;
For i := 2 to n do 
For j := 1 to i-1 do 
If c[j] < c[i] then 
begin 
Z := a[i];
For Y := i downto j+1 do 
a[Y] := a[Y-1]; 
a[j] := Z ;
 
Z1 := c[i];
For Y1 := i downto j+1 do 
c[y1] := c[Y1-1]; 
c[j] := Z1 ;
end ;
 
for i:=1 to n do
if c[i]=c[i+1] then begin
if a[i]<a[i+1] then begin g:=a[i];a[i]:=a[i+1];a[i+1]:=g;end;
end;
for i:=1 to n do
writeln(a[i]);
//close(input);close(output);
end.

Но проходит не на все тесты , напишите код или скажите что неправильно в моём !

Решение задачи: «Упорядочьте заданные числа по уменьшению "круглости"»

textual
                            Листинг программы 
                        
 
                        
                          
                    
program test;
 
var
  n: integer;
  a, c: array [1..1000] of integer;
  temp: integer;
  i, j: integer;
begin
  Assign(input, 'round.in');
  //assign(output,'round.out');
  reset(input);
  //rewrite(output);
  readln(n);
  for i := 1 to n do
  begin
    readln(a[i]);
    c[i] := 0;
    temp := a[i];
    while temp mod 10 = 0 do
    begin
      temp := temp div 10;
      Inc(c[i]);
    end;
  end;
 
  for i := n downto 2 do
    for j := 2 to i do
      if (c[j] > c[j - 1]) or (c[j] = c[j - 1]) and (a[j] > a[j - 1]) then
      begin
        temp := A[j];
        A[j] := A[j - 1];
        A[j - 1] := temp;
 
        temp := c[j];
        c[j] := c[j - 1];
        c[j - 1] := temp;
      end;
 
  for i := 1 to n do
    writeln(a[i]);
  Close(input);
  //close(output);
end.