1:
2:

Carry:= Sum div NUMBER_BASE;
Dig:= Sum mod NUMBER_BASE;					

1:

   1826000 it    756082 dig       20260.0 s					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

  for p:= 0 to high(Summand) do 
    begin
    Sum:= Carry + Number[p] + Summand[p];
//  DivMod(Sum, NUMBER_BASE, Carry, Dig); ersatz   
    Carry := 0;
    IF  SUM >= NUMBER_BASE then
      begin
      dec(sum,NUMBER_BASE);      
      Carry := 1;
      end;
    Number[p]:= Sum;
  end;					

1:
2:
3:
4:
5:

60112339269111851140389301806586681291351507449752782263142146284398312681631144
80513403906695460975689940797209307853656534423943491142030348495051500816735422
60147073619478325530666484993268957414968737533136622157990802952584506637311513

    241389 it    100000 dig    269.473066 s					

1:
2:
3:
4:
5:

60112339269111851140389301806586681291351507449752782263142146284398312681631144
80513403906695460975689940797209307853656534423943491142030348495051500816735422
60147073619478325530666484993268957414968737533136622157990802952584506637311513

    241389 it    100000 dig    167.871914 s					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

Zahl/Sum  123456
Kopie     123 
ich summiere dann in die Zahl 
Zahl[1]=Zahl[1]+Zahl[6]
Zahl[2]=Zahl[2]+Zahl[5]
Zahl[3]=Zahl[3]+Zahl[4]
jetzt bei der Hälfte 
Zahl[4]=Zahl[4]+Kopie[3]
Zahl[5]=Zahl[5]+Kopie[2]
Zahl[6]=Zahl[6]+Kopie[1]					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

Startzahl: 196
Iteration   maximale Anzahl der Vergleiche auf Palindrom
         1   1
         6   2
        13   3
        16   4
        25   5
        70   8
       105  12
      1237  13
      1430  14
      3461  16
      3940  17
      9777  29
    429911  31
=
    483101 it    200000 dig 1.00391500000000E+003 s					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:

{{$APPTYPE console}
program p196;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$Optimization ON}
  {$Optimization RegVar}
  {$Optimization PEEPHOLE}
  {$Optimization CSE}
  {$Optimization ASMCSE}
{$Endif}

uses
  SysUtils;

const
  NUMBER_BASE = 10;
type
  TDigit = Byte;
  TSumCar = record
              s,c : byte;
            end;
  TSumCarFeld = array[0..19] of TsumCar;          
  TNumber = array of TDigit;                                // Rückwärts! Niederwertigste Stelle ist [0]
const  
  SumCarFeld : TSumCarFeld =((s:0;c:0),(s:1;c:0),(s:2;c:0),(s:3;c:0),(s:4;c:0),
                             (s:5;c:0),(s:6;c:0),(s:7;c:0),(s:8;c:0),(s:9;c:0),
                             (s:0;c:1),(s:1;c:1),(s:2;c:1),(s:3;c:1),(s:4;c:1),
                             (s:5;c:1),(s:6;c:1),(s:7;c:1),(s:8;c:1),(s:9;c:1));
var
  MaxIndex : integer;
  Cycle: Cardinal;
  
procedure NumberFromString(var Number: TNumber; Str: string);
var
  i: integer;
begin
  SetLength(Number, Length(Str));
  for i:= 0 to Length(Str) - 1 do
    Number[i]:= Ord(Str[Length(Str) - i]) - Ord('0');
end;

function NumberToString(var Number: TNumber): string;
var
  i: integer;
begin
  SetLength(Result, Length(Number));
  for i:= 0 to High(Number) do
    Result[Length(Result) - i]:= Chr(Ord('0') + Number[i]);
end;

procedure NumberAdd(var Number, Summand: TNumber);
var
  pb1,pB2 : pByte;
  p: integer;
  Carry: integer;
begin
  Carry:= 0;
  pb1 := @Number[0]; 
  pb2 := @Summand[0]; 
  for p:=  high(Summand) downto 0 do 
    begin
//  DivMod(Sum, NUMBER_BASE, Carry, Dig);    
    With SumCarFeld[Carry + pb1^ + pb2^] do
      begin
      inc(pb2);
      pb1^ := s;
      inc(pb1);        
      Carry := c;
      end;
  end;
  
  IF Carry = 1 then
    begin
    p := Length(Summand)+1;
    setlength(Summand, p);
    SetLength(Number, p);
    Number[p-1] :=1;
    end;
end;

procedure NumberReverse(var Reversed, Number: TNumber);
var
  i: integer;
begin
  SetLength(Reversed, Length(Number));
  for i:= 0 to high(Number) do
    Reversed[high(Reversed) - i]:= Number[i];
end;

function NumberCompare(var A, B: TNumber): boolean;
begin
  Result:= (high(A) = high(B)) and
    CompareMem(@A[0], @B[0], Length(A));
end;

function NumberCompareB(var A: TNumber): boolean;
var 
  i,j: integer;
begin
  i := Low(A);
  j := High(A);
  repeat
    Result:= A[i]=A[j];
    inc(i);
    dec(j);
  until Not(Result) OR (J<I); 
  IF  MaxIndex <i then
    begin
     MaxIndex := i;
     writeln(cycle:10,i:4)
     end;
end;

var
  Work, Rev: TNumber;

  Time1, Time2 : TDateTime;
  s: string;
begin
  repeat
    Write('Startzahl: ');
    ReadLn(s);
    if s='' then
      break;
    NumberFromString(Work, s);
    Cycle:= 0; // das erste ist kein cycle...
    Time1 := time;
    NumberReverse(Rev, Work);
    repeat
      NumberAdd(Work, Rev);
      NumberReverse(Rev, Work);
      inc(Cycle);
      //Keine Ausgabe !
      if Cycle AND cardinal(-1) = 0 then 
        begin
        Time2 := time;
        WriteLn(Cycle:10,' it',Length(Work):10,' dig',(Time2-Time1)*86400.0:14:1,' s');
        end;
    until NumberCompareB(REv) OR (Length(Work)>99999);
    Time2 := time;
    WriteLn('=');
    WriteLn(NumberToString(Work));
    WriteLn(Cycle:10,' it',Length(Work):10,' dig',(Time2-Time1)*86400.0,' s');

    WriteLn;
    WriteLn;
    WriteLn;
  until false;
end.
{
Startzahl: 196
         1   1
         6   2
        13   3
        16   4
        25   5
        70   8
       105  12
      1237  13
      1430  14
      3461  16
      3940  17
      9777  29
    429911  31
=
    483101 it    200000 dig 1.00391500000000E+003 s
NoteBook:
Vorher: NumberAdd
    241389 it    100000 dig 2.53229000000001E+002 s
Nachher: NumberAdd mit Pointerarithmetik
    241389 it    100000 dig 1.27149000000000E+002 s					

1:
2:
3:
4:
5:

if checkbox1.checked then begin
  k:='';
  for i:=0 to laenge-1 do k:=chr(z[i]+48)+k;
  memo1.lines.add(inttostr(anz)+#9+k+' ('+inttostr(laenge)+')');
end;					

1:
2:
3:
4:

k:='';
for i:=0 to laenge-1 do k:=chr(z[i]+48)+k;
if checkbox1.checked then
  memo1.lines.add(inttostr(anz)+#9+k+' ('+inttostr(laenge)+')');					

1:
2:
3:
4:

      if Cycle >= 100000 then
        break;
statt
until NumberCompareB(REv)or (Length(Work)>99999);					

1:
2:
3:

....086914228293595882210473480636969512153155697087

    603567 it    250000 dig 5.92248000000005E+002 s					

1:
2:
3:

=
    241389 it    100000 dig    293.801473 s
1316113735615475349297100 ... 5799080295258450663731151					

1:

    603567 it    250000 dig 3.23028000000001E+002 s					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:

procedure NumberAdd_1Feld(var Number: TNumber);
var
  pb1,pB2 : pByte;
  p: integer;
  Carry: integer;
begin
  // LenghtNum und LengthRev sind globale Variable, wie die Felder auch
  // MIst, die Übergabe hätte ich mir sparen können
  pb2 := @Number[LengthNum-1];
  pb1 := @Number[0]; 
  Move(Number[0],Rev[0],LengthRev);
  Carry:= 0;

  for p:=  LengthRev-1  downto 0 do 
    begin
    With SumCarFeld[Carry + pb1^ + pb2^] do
      begin
      dec(pb2);
      pb1^ := s;
      inc(pb1);        
      Carry := c;
      end;
  end;

  //mittlere Zahl auf sich selbst addieren
  IF ODD(LengthNum) then
    begin
    With SumCarFeld[Carry + pb1^ + pb1^] do
      begin
      pb1^ := s;
      inc(pb1);        
      Carry := c;
      end;
    end;

  pb2 := @rev[LengthRev-1];
  for p:=  LengthRev-1  downto 0 do 
    begin
    With SumCarFeld[Carry + pb1^ + pb2^] do
      begin
 //     writeln(pb1^:3,'+',pb2^:3,'+',c);      
      dec(pb2);
      pb1^ := s;
//  writeln('Num ',NumberToString  (Number));

      inc(pb1);        
      Carry := c;
      end;
  end;
  //Korrektur der Laenge
 IF Carry = 1 then
    begin
    inc(LengthNum);
    SetLength(Number, LengthNum);
    Number[LengthNum-1] :=1;
    IF NOT(ODD(LengthNum)) then
       begin
       inc(LengthRev);
       SetLength(Rev, LengthRev);
       end;
    end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:

procedure TForm1.Button1Click(Sender: TObject);
const zmax:integer=999;
var k:string;
    i,anz,laenge:integer;
    gefunden:boolean;
    z,e:array of byte;
    Time1, Time2, Freq: Int64;
begin
    if abbruch=false then begin abbruch:=true; exit end;
    button1.caption:='Abbruch';
    label3.caption:='';
    abbruch:=false;
    memo1.clear;
    application.processmessages;

    zmax:=strtoint(edit2.text);
    if zmax<100 then zmax:=100;

    setlength(z,zmax+2);
    setlength(e,zmax+2);
    for i:=0 to zmax do begin z[i]:=0; e[i]:=0 end;
    k:=edit1.text;
    if k='' then k:='196';
    laenge:=length(k);
    for i:=laenge downto 1 do z[laenge-i]:=ord(k[i])-48;
    anz:=0;

    QueryPerformanceFrequency(Freq);
    QueryPerformanceCounter(Time1);

    repeat
      inc(anz);
      if checkbox1.checked then begin
        k:='';
        if laenge>50 then
        begin
          for i:=0 to 25 do k:=chr(z[i]+48)+k;
          k:=' ... '+k;
          for i:=laenge-26 to laenge-1 do k:=chr(z[i]+48)+k;
        end
        else
          for i:=0 to laenge-1 do k:=chr(z[i]+48)+k;
        memo1.lines.add(inttostr(anz)+#9+k+' ('+inttostr(laenge)+')');
      end;

      for i:=0 to laenge-1 do
        e[i]:=z[i]+z[laenge-1-i];
      for i:=0 to laenge-1 do begin
        if e[i]>9 then begin
          inc(e[i+1]);
          dec(e[i],10);
        end;
      end;
      if e[laenge]>0 then inc(laenge);

      gefunden:=true;
      i:=0;
      repeat
        if e[i]<>e[laenge-1-i] then gefunden:=false;
        inc(i);
      until (not gefunden) or (i>laenge div 2);

      if gefunden then
      begin
        memo1.lines.add('Palindrom gefunden im Schritt '+inttostr(anz));
        k:='';
        for i:=0 to laenge-1 do k:=chr(e[i]+48)+k;
        memo1.lines.add(k);
      end
      else
        z:=copy(e,0,laenge);

      if anz mod 1000 = 0 then begin
        label4.caption:=inttostr(laenge);
        QueryPerformanceCounter(Time2);
        label6.caption:=inttostr(anz)+' Zyklen | '+floattostrf((Time2-Time1)/freq,ffgeneral,10,6)+' s';
        application.processmessages;
      end;
    until abbruch or gefunden or (laenge>zmax);

    label4.caption:=inttostr(laenge);
    QueryPerformanceCounter(Time2);
    label6.caption:=inttostr(anz)+' Zyklen | '+floattostrf((Time2-Time1)/freq,ffgeneral,10,6)+' s';
    if abbruch or (laenge>zmax) then
    begin
      memo1.lines.add('Folgenglied im Schritt '+inttostr(anz));
      memo1.lines.add('Länge '+inttostr(laenge));
      k:='';
      for i:=0 to 25 do k:=chr(z[i]+48)+k;
      k:=' ... '+k;
      for i:=laenge-26 to laenge-1 do k:=chr(z[i]+48)+k;
      memo1.lines.add(k);
    end;
    button1.caption:='Berechnung';
    abbruch:=true;
    setlength(z,0);
    setlength(e,0);
end;