Program ConstMadelungNaCl;
{$N+,E-,G+,D-}
Uses Crt;
const
  maxk = 175;
  _Pi_ : Extended = 3.1415926535897932384626433832795;
var
  D : array [1..61776] of Byte; {350} {n*(n+1) div 2}
  k, n : Longint; {maxn=351}
  i, j : Longint;
  iD : Word;
  alpha : Extended;
  Sgn : Extended;
Function Sn(n : Longint) : Longint;
var
  i : Longint;
  S : Longint;
begin
  S := 0;
  for i := 1 to n do S := S + i;
  Sn := S;
end;
Function C(n : Longint) : Extended;
var
  i : Longint;
  S : Longint;
  k : Longint;
  m6, m3 : Longint;
begin
  i := 0;
  S := 0;
  While n>=S do
  begin
    inc(i);
    S := S + Sn(i);
  end;
  k := i-1;
  m3 := Sn(k)+1;
  iD := Sn(i)-S+n+1;
  C := D[iD]*0.25*cos(_Pi_*i);{вершины}{2.0}
  if iD <> Sn(i) then C := D[iD]*0.75*cos(_Pi_*i);{рёбра}{3.0}
  if iD < m3 then C := D[iD]*3.0*cos(_Pi_*i);{грани}{6.0}
end;
begin
  alpha := 0.0;
  iD := 1;
  D[iD] := 1;
  for k := 1 to maxk do
  begin
    n := 2*k;
    for j := 0 to k do
      begin
        inc(iD);
        if (j=0) or (j=k) then D[iD] := 4 else D[iD] := 8;
      end;
  end;
  ClrScr;
  Sgn := 1.0;
  for i := 1 to 1000000 do
   begin
    alpha := alpha + C(i)/sqrt(1.0*i)*Sgn;
     if i mod 10000 = 0 then
     begin
      WriteLn(i, ' : iD = ', iD, ' ', C(i)/sqrt(1.0*i)*Sgn:1:3, ' ', alpha:1:10);
      if KeyPressed then Break;
     end;
    Sgn := Sgn*(-1.0);
   end;
  WriteLn(C(i)/sqrt(1.0*i):1:3, ' ', alpha:1:5);
end.

Назад