Поиск циклов в перестановках

findcicles.pas

type
    ArrayType = array[1..7] of integer;

procedure findCicles(a: ArrayType; var dst: ArrayType);
var
    startOfCicle: integer;
    globalPointer: integer;
    localPointer: integer;
    address: integer;
    i: integer;
begin

    i := 1;
    for globalPointer := 1 to 7 do begin
        if (a[globalPointer] = 1) and not (globalPointer = 1) then
            continue;
        localPointer := globalPointer;
        startOfCicle := localPointer;

        while true do begin
            if startOfCicle = localPointer then
                dst[i] := -localPointer
            else
                dst[i] := localPointer;
            inc(i);
            
            address := a[localPointer];
            a[localPointer] := 1;
            localPointer := address;

            if localPointer = startOfCicle then 
                break;
        end;

    end;
end;

            
var
    a, dst: ArrayType;
    i: integer;
begin
    for i := 1 to 7 do 
        read(a[i]);

    findCicles(a, dst);

    for i := 1 to 7 do
        write(dst[i], ' ');
    writeln;

end.