var
 line:array[1..2500] of record x,y:integer; end;
 d,c:array[1..50] of integer;
 path:array[1..2500] of integer;
 a,b:array[1..50,1..50] of integer;
 use:array[1..2500] of boolean;
 i,j,n,m:integer;

Function Gcd(a,b:integer):integer;
begin
 if a mod b=0 then Gcd:=b else
  Gcd:=Gcd(b,a mod b);
end;

Function OK(k:integer):boolean;
var i,j:integer;
begin
 OK:=true; if (d[k]<=1) then exit;
 j:=a[k,1];
 for i:=2 to d[k] do
  begin
   j:=GCD(j,b[k,a[k,i]]);
   if j=1 then exit;
  end;
 OK:=false;
end;

Procedure Print;
begin
 writeln('YES');
 for i:=1 to m-1 do write(path[i],' '); writeln(path[m]);
 halt;
end;

Procedure Get(k:integer);
var i:integer;
begin
if k=m+1 then
  Print;
 for i:=1 to m do if use[i] then
  begin
   path[k]:=i; use[i]:=false;
   b[line[k].x,line[k].y]:=i;
   b[line[k].y,line[k].x]:=i;
   inc(c[line[k].x]); inc(c[line[k].y]);
   if c[line[k].x]=d[line[k].x]
    then
     if OK(line[k].x)
      then
       if c[line[k].y]=d[line[k].y]
        then
         if OK(line[k].y) then Get(k+1)
                          else
        else Get(k+1)
      else
    else
   if c[line[k].y]=d[line[k].y]
    then
     if OK(line[k].y) then Get(k+1)
                      else
   else Get(k+1);
   use[i]:=true;
   dec(c[line[k].x]); dec(c[line[k].y]);
  end;
end;

begin
// assign(input,'1040.in'); reset(input);
 readln(n,m); fillchar(d,sizeof(d),0);
 for i:=1 to m do
  begin
   readln(line[i].x,line[i].y);
   inc(d[line[i].x]); inc(d[line[i].y]);
   a[line[i].x,d[line[i].x]]:=line[i].y;
   a[line[i].y,d[line[i].y]]:=line[i].x;
  end;
 fillchar(use,sizeof(use),true);
 fillchar(c,sizeof(c),0);
 Get(1);
 writeln('NO');
end.

const
  MAX = 60;
  MAXL = 5000;
type
  Arr = array [1 .. MAX, 0 .. MAXL] of integer;

var
  Save : Arr;
  List : array [1 .. MAXL] of integer;
  Use : array [1 .. MAXL] of boolean;
  n, i, a, m : integer;

function GCD (ga, gb : integer) : integer;
  var
    gt : integer;
  begin
    while ga mod gb > 0 do
      begin
        gt := ga mod gb;
        ga := gb;
        gb := gt;
      end;
    Gcd := gb;
  end;

function Judge : boolean;
  var
    ji, jj, jt : integer;
    jb : boolean;
  begin
    ji := 1;
    jb := true;
    while (ji <= n) and jb do
      begin
        if Save [ji, 0] > 1
          then begin
                jt := List [Save [ji, 1]];
                for jj := 2 to Save [ji, 0] do
                  jt := GCD (jt, List [Save [ji, jj]]);
               end
          else jt := 1;
        jb := (jt = 1);
        ji := ji + 1;
      end;
    Judge := jb;
  end;

procedure Out;
  var
    oi : integer;
  begin
    writeln ('YES');
    for oi := 1 to m do
      write (List [oi], ' ');
    halt;
  end;

procedure Search (st : integer);
  var
    si : integer;
  begin
    for si := 1 to m do
      if Use [si]
        then begin
               Use [si] := false;
               List [st] := si;
               if st < m
                 then Search (st + 1)
                 else if Judge
                        then Out;
               Use [si] := true;
             end;
  end;

begin
  fillchar (Save, sizeof (Save), 0);
  readln (n, m);
  for i := 1 to n do
    Use [i] := true;
  for i := 1 to m do
    begin
      read (a);
      Save [a, 0] := Save [a, 0] + 1;
      Save [a, Save [a, 0]] := i;
      readln (a);
      Save [a, 0] := Save [a, 0] + 1;
      Save [a, Save [a, 0]] := i;
    end;
  Search (1);
  writeln ('NO');
end.

I didn't understand the problem properly at first, i thought the sum
of the flight number at one airport must be prime number. So i worte
a 200 lines prog. which the judge function is so strict that it won't
give an answer in 5s on the last one or two test data. Then i do the
optimization work here and there , but of couse it won't work.
Finally , i got AC!!!!!!!!!!!

program airline;
 const
  max=50;
 var
  map:array[1..max*max,1..2] of longint;
  cover:array[1..max*max] of boolean;
  list:array[1..max*max] of longint;
  n,m:longint;

 procedure readdata;
  var
   i:longint;
  begin
   fillchar(map,sizeof(map),0);
   readln(n,m);
   for i:=1 to m do readln(map[i][1],map[i][2]);
  end;

 procedure print;
  var
   i:longint;
  begin
   writeln('YES');
   for i:=1 to m-1 do write(list[i],' ');
   writeln(list[m]);
   halt;
  end;

 function zhi(x,p,i:longint):boolean;
  var
   j,k,min,t,j1:longint;
   link:array[1..max*max] of longint;
  begin
   fillchar(link,sizeof(link),0);
   k:=0;
   min:=maxint;
   for j:=1 to m do
    if ((map[j][1]=x)or(map[j][2]=x)) then
     if (list[j]=0)and(p<>j) then
       begin
        zhi:=true;
        exit;
       end
      else if p<>j then
        begin
         inc(k);
         link[k]:=list[j];
         if list[j]<min then min:=list[j];
        end;
   inc(k);
   link[k]:=i;
   if k=1 then
     begin
      zhi:=true;
      exit;
     end;
   for j:=2 to min do
    begin
     t:=0;
     for j1:=1 to k do
      if link[j1] mod j=0 then inc(t);
     if t>=k then
       begin
        zhi:=false;
        exit;
       end;
    end;
   zhi:=true;
  end;

 procedure search(p:longint);
  var
   t,i:longint;
  begin
   if p>m then print
    else
     begin
      for i:=1 to n do
       if not cover[i] then
        if zhi(map[p][1],p,i) then
         if zhi(map[p][2],p,i) then
           begin
            cover[i]:=true;
            list[p]:=i;
            search(p+1);
            list[p]:=0;
            cover[i]:=false;
           end;
     end;
  end;

 procedure main;
  var
   i,j:longint;
  begin
   fillchar(list,sizeof(list),0);
   fillchar(cover,sizeof(cover),0);
   search(1);
  end;

BEGIN
 readdata;
 main;
 writeln('NO');
END.

Can you help me speed up my algorithm?

VAR
  N, M, I, A0, A1 : LongInt;
  Dep : ARRAY[1..50, 0..50] OF LongInt;
  Num : ARRAY[1..1225] OF LongInt;

  FUNCTION GCD(A, B : LongInt) : LongInt;
  BEGIN
    IF A = 0 THEN
      GCD := B
    ELSE
      GCD := GCD(B MOD A, A);
  END;

  PROCEDURE QSort(iLo, iHi : LongInt);
  VAR
    Lo, Hi, Mid, T : LongInt;
  BEGIN
    IF iLo >= iHi THEN Exit;
    Lo := iLo;
    Hi := iHi;
    Mid := Num[(Lo+Hi) DIV 2];
    REPEAT
      WHILE Num[Lo] > Mid DO Inc(Lo);
      WHILE Num[Hi] < Mid DO Dec(Hi);
      IF Lo <= Hi THEN
        BEGIN
          T := Num[Lo];
          Num[Lo] := Num[Hi];
          Num[Hi] := T;
          Inc(Lo);
          Dec(Hi);
        END;
    UNTIL Lo > Hi;
    IF Hi > iLo THEN QSort(iLo, Hi);
    IF Lo < iHi THEN QSort(Lo, iHi);
  END;

  FUNCTION Test : Boolean;
  VAR
    I, J, GCDTst, L, Max : LongInt;
    Ok : Boolean;
  BEGIN
    Ok := True;
    L := M+1;
    FOR I := 1 TO N DO
      IF Dep[I, 0] > 1 THEN
        BEGIN
          GCDTst := Num[Dep[I, 1]];
          Max := Dep[I, 1];
          FOR J := 2 TO Dep[I, 0] DO
            BEGIN
              GCDTst := GCD(Num[Dep[I, J]], GCDTst);
              IF Dep[I, J] > Max THEN Max := Dep[I, J];
            END;
          IF GCDTst <> 1 THEN
            BEGIN
              Ok := False;
              IF L < Max THEN L := Max;
            END;
        END;
    IF Ok THEN
      BEGIN
        WriteLn('YES');
        FOR I := 1 TO M-1 DO Write(Num[I], ' ');
        Write(Num[M]);
        Halt;
      END;
    QSort(L+1, M);
  END;

  FUNCTION Next : Boolean;
  VAR
    I, J, T : LongInt;
  BEGIN
    I := M;
    WHILE (I > 1) AND (Num[I-1] >= Num[I]) DO Dec(I);
    IF I > 1 THEN
      BEGIN
        J := M;
        WHILE (Num[I-1] >= Num[J]) DO Dec(J);
        T := Num[I-1];
        Num[I-1] := Num[J];
        Num[J] := T;
        FOR J := 0 TO (M-I+1) DIV 2-1 DO
          BEGIN
            T := Num[I+J];
            Num[I+J] := Num[M-J];
            Num[M-J] := T;
          END;
        Next := False;
        Exit;
      END;
    Next := True;
  END;

BEGIN
  ReadLn(N, M);
  FOR I := 1 TO M DO
    BEGIN
      ReadLn(A0, A1);
      Inc(Dep[A0, 0]);
      Dep[A0, Dep[A0, 0]] := I;
      Inc(Dep[A1, 0]);
      Dep[A1, Dep[A1, 0]] := I;
    END;
  FOR I := 1 TO M DO Num[I] := I;
  REPEAT
    Test;
  UNTIL Next;
  Write('NO');
END.

type btype=record
       x,y:integer
       end;
var b,c:array[1..1000] of integer;
    a:array[1..1000] of btype;
    m,n,i:integer;
    v:array[1..1000] of boolean;
function ok(x,dep:integer):boolean;
var ff,min,t,f1,f2,i,j:integer;
    e:array[1..1000] of integer;
begin
  ok:=true;
  if b[a[x].x]=1 then
  begin
    t:=0;
    f1:=0;
    f2:=0;
    for i:=1 to dep-1 do
    if (a[c[i]].x=a[x].x) then
    begin
      inc(t);
      e[t]:=i;
      if i mod 2=0 then inc(f2)
      else inc(f1);
    end
    else if (a[c[i]].y=a[x].x) then
    begin
      inc(t);
      e[t]:=i;
      if i mod 2=0 then inc(f2)
      else inc(f1);
    end;
    inc(t);
    e[t]:=dep;
    if dep mod 2=0 then inc(f2)
    else inc(f1);
    if (t=1) then exit;
    if (t>=2) and (f1=0) then
    begin
      ok:=false;
      exit;
    end;
    min:=0;
    min:=e[1];
    for i:=2 to t do
    if e[i]<min then min:=e[i];
    if min=1 then exit;
    for i:=2 to min do
    begin
       ff:=0;
       for j:=1 to t do
       if e[j] mod i=0 then inc(ff)
       else break;
       if ff=t then
       begin
         ok:=false;
         exit;
       end;
    end;
    if b[a[x].y]=1 then
  begin
    t:=0;
    f1:=0;
    f2:=0;
    for i:=1 to dep-1 do
    if (a[c[i]].x=a[x].y) then
    begin
      inc(t);
      e[t]:=i;
      if i mod 2=0 then inc(f2)
      else inc(f1);
    end
    else if (a[c[i]].y=a[x].y) then
    begin
      inc(t);
      e[t]:=i;
      if i mod 2=0 then inc(f2)
      else inc(f1);
    end;
    inc(t);
    e[t]:=dep;
    if (t=1) then exit;
    if (t=2) and (f1=0) then
    begin
      ok:=false;
      exit;
    end;
    if (t>2) and (f1=0) then
    begin
      ok:=false;
      exit;
    end;
    min:=e[1];
    for i:=2 to t do
    if e[i]<min then min:=e[i];
    for i:=2 to min do
    begin
       ff:=0;
       for j:=1 to t do
       if e[j] mod i=0 then inc(ff)
       else break;
       if ff=t then
       begin
         ok:=false;
         exit;
       end;
    end;
end;
end;
end;
procedure search(dep:integer);
var i,j:integer;
begin
  for i:=1 to m do
  if ok(i,dep) and (v[i]=false) then
  begin
    v[i]:=true;
    c[dep]:=i;
    dec(b[a[i].x]);
    dec(b[a[i].y]);
    if dep=m then
    begin
      writeln('YES');
      for j:=1 to m do
        write(c[j]:5);
        halt;
    end
    else search(dep+1);
    c[dep]:=0;
    inc(b[a[i].x]);
    inc(b[a[i].y]);
    v[i]:=false;
  end;
end;
begin
  read(n,m);
  fillchar(v,sizeof(v),0);
  fillchar(a,sizeof(a),0);
  fillchar(b,sizeof(b),0);
  for i:=1 to m do
  begin
    read(a[i].x,a[i].y);
    inc(b[a[i].x]);
    inc(b[a[i].y]);
  end;
  search(1);
  writeln('NO');
end.

  Please consider the Sample input and output :
  The 1st flight ( connects 1 and 2 ) and the 2-nd flight ( 2-3)
are flights that depart from one airport ( airport 2 ) ( The flight
are 2 directions flight ) . But the sample output indicates
that their numbers are 4 and 2 , so their greatest common divisor
can't be 1 as the problem description !
   I don't know if I wrong . I got WA too . Please explain for me
Thanks a lot !

I solved it just by this method, but it's very shame...
Can anybody tell something about REAL solution of it?