Please help me !!!!
What's wrong in my code ????????????????????????

var  a:array[1..100,1..100]of integer;
     nn:array[1..100]of string;
     s,s1:string;
     kol:integer;
     w:integer;
function find(s:string):integer;
var i:integer;
begin
 for i:=1 to kol do
  if nn[i]=s then
   begin
    find:=i;
    exit;
   end;
 find:=kol+1;
end;
procedure init;
var k:integer;
    ch1,ch2,pp:integer;
begin
 kol:=1;
 {assign(input,'input.txt');
 reset(input);}
  readln(s);
  nn[kol]:=s;
  readln(s);
  while s<>'#' do
   begin
    k:=pos('-',s);
    s1:=copy(s,1,k-1);
    delete(s,1,k);
    pp:=find(s1);
    if pp> kol then kol:=pp;
    nn[pp]:=s1;
    ch1:=pp;
    pp:=find(s);
    if pp> kol then kol:=pp;
    nn[pp]:=s;
    ch2:=pp;
    a[ch1,ch2]:=1;
    a[ch2,ch1]:=1;
    readln(s);
   end;
 {close(input);}
end;
procedure solve;
var i,k,l,p:integer;
    ss,sp:set of 1..200;
    min,t,j:integer;
    ok:boolean;
begin
 ss:=[1..kol];sp:=[];
 for i:=1 to kol do
  if a[1,i]<>0 then
   begin
    p:=i;
    break;
   end;
 w:=1;
 ss:=ss-[1,p];sp:=[1,p];
 while ss<>[] do
  begin
   for i:=1 to kol do
    begin
     ok:=false;
     if not(i in sp)then
      for j:=1 to kol do
       if (j in sp)and(a[i,j]<>0)then
        begin
         ss:=ss-[i,j];
         sp:=sp+[i,j];
         inc(w);
         break;
         ok:=true;
        end;
     if ok then break;
    end;
 end;
end;
procedure outt;
begin
 writeln(w);
end;
begin
 init;
 solve;
 outt;
end.

> Please help me !!!!
> What's wrong in my code ????????????????????????
>
> var  a:array[1..100,1..100]of integer;
>      nn:array[1..100]of string;
>      s,s1:string;
>      kol:integer;
>      w:integer;
> function find(s:string):integer;
> var i:integer;
> begin
>  for i:=1 to kol do
>   if nn[i]=s then
>    begin
>     find:=i;
>     exit;
>    end;
>  find:=kol+1;
> end;
> procedure init;
> var k:integer;
>     ch1,ch2,pp:integer;
> begin
>  kol:=1;
>  {assign(input,'input.txt');
>  reset(input);}
>   readln(s);
>   nn[kol]:=s;
>   readln(s);
>   while s<>'#' do
>    begin
>     k:=pos('-',s);
>     s1:=copy(s,1,k-1);
>     delete(s,1,k);
>     pp:=find(s1);
>     if pp> kol then kol:=pp;
>     nn[pp]:=s1;
>     ch1:=pp;
>     pp:=find(s);
>     if pp> kol then kol:=pp;
>     nn[pp]:=s;
>     ch2:=pp;
>     a[ch1,ch2]:=1;
>     a[ch2,ch1]:=1;
>     readln(s);
>    end;
>  {close(input);}
> end;
> procedure solve;
> var i,k,l,p:integer;
>     ss,sp:set of 1..200;
>     min,t,j:integer;
>     ok:boolean;
> begin
>  ss:=[1..kol];sp:=[];
>  for i:=1 to kol do
>   if a[1,i]<>0 then
>    begin
>     p:=i;
>     break;
>    end;
>  w:=1;
>  ss:=ss-[1,p];sp:=[1,p];
>  while ss<>[] do
>   begin
>    for i:=1 to kol do
>     begin
>      ok:=false;
>      if not(i in sp)then
>       for j:=1 to kol do
>        if (j in sp)and(a[i,j]<>0)then
>         begin
>          ss:=ss-[i,j];
>          sp:=sp+[i,j];
>          inc(w);
>          break;
>          ok:=true;
>         end;
>      if ok then break;
>     end;
>  end;
> end;
> procedure outt;
> begin
>  writeln(w);
> end;
> begin
>  init;
>  solve;
>  outt;
> end.

Don't forget about min and max tests))