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:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:

type TSettings = record
  Epsilon0, Epsilon1, Epsilon2, Frequenz, Laenge1, Laenge2, My0, My1, My2, Radius1, Radius2, Sigma1, Sigma2, Sondenhoehe, Wanddicke : Real;
  Windungen: Integer;
end;

function AIRCO(Setup : TSettings) : Real;
var R1, R2, R3, rm, L, S1, S2, I6, B1, B2, I9, X, Z, A1, E1, P1, P2, P3, Q1, I1, I2, F2 : Real;
    L5 : Integer;
    Data : Variant;
label Zeile140;

procedure GOSUB1000;
var F1, Q2: Real;
    N : Integer;
begin
  if Z > 5 then
  begin
    if Z > 30 then
    begin
      P3:=1/(Z*Z);
      P1:=Z*(-1+P3*(-0.5546875+2.48062114*P3));
      P2:=0.875+P3*(-0.93457031+8.98975114*P3);
      F2:=1+0.79788456*(P1*COS(Z-Pi/4)+P2*SIN(Z-Pi/4))/SQRT(Z);
      F2:=F2/(X*X);
    end
    else
    begin
      Q1:=(((-188.1357/Z+109.1142)/Z-23.79333)/Z+2.050931)/Z;
      Q1:=((Q1-0.1730503)/Z+0.7034845)/Z-0.064109E-3;
      Q2:=(((-5.817517/Z+2.105874)/Z-0.6896196)/Z+0.4952024)/Z;
      Q2:=(Q2-0.187344E-2)/Z+0.7979095;
      F2:=(1-SQRT(Z)*(Q2*COS(Z-Pi/4)-Q1*SIN(Z-Pi/4)))/(X*X);
    end;
  end
  else
  begin
    L5:=floor(2*Z)+3;
    F1:=0.5*Q1*Q1*Z;
    F2:=F1/3;

    for N:=1 to L5 do
    begin
      F1:=-F1*0.25*Z*Z/(N*N+N);
      F2:=F2+F1/(2*N+3);
    end;
  end;
end;

begin
  rm:=(Setup.Radius1+Setup.Radius2)/2;
  {R1:=Setup.Radius1 / rm;
  R2:=Setup.Radius2 / rm;
  L:=Setup.Sondenhoehe / rm;
  R3:=rm; }

  R1:=0.5; //siehe Seite 8 f. in der PDF-Datei zur Evaluierung meines Quellcodes. Mit diesen Werten sollte als Ergebnis der Wert 0.160405 herauskommen. Leider erhalte ich 0,157265...
  R2:=1.5;
  L:=1;
  R3:=0.25;
  //I3:=1;

  Data:=0;

  S1:=1E-2;
  S2:=1;
  E1:=0.1;
  I6:=0;
  B1:=0;
  B2:=S2;

  Zeile140:
  I9:=I6;
  X:=B1+S1/2;
  while X <= B2 do
  begin
    Z:=R2*X;
    Q1:=R2;
    GOSUB1000();
    I2:=F2;
    Z:=R1*X;
    Q1:=R1;
    GOSUB1000;
    I1:=F2;

    if X*L > 0.005 then
      A1:=L+(EXP(-X*L)-1)/X
    else
      A1:=0.5*X*L*L-X*X*L*L*L/6;

    I6:=I6+S1*SQR(I2-I1)*A1/X;

    X:=X+S1;
  end;

  if (I6-I9)/I6>E1 then
  begin
    B1:=B2;
    B2:=B2+S2;
    GOTO Zeile140;
  end
  else
  begin

    S1:=VarArrayLowCut(Data,1)[0];
    S2:=VarArrayLowCut(Data,1)[0];
    E1:=VarArrayLowCut(Data,1)[0];

    if E1 > 0 then
    begin
      B1:=B2;
      B2:=B2+S2;
      GOTO Zeile140;
    end
    else
    begin
      VarArrayAdd(Data,[2E-2,2,1E-2,5E-2,5,1E-3,1E-1,10,1E-4,0.5,50,1E-5,2,200,1E-6,1,1,-1]);
      Result:=I6;
    end;
  end;
end;

function VarArrayLowCut(var Dest: Variant; Count: Integer) : Variant; //Entfernt vordere Einträge aus einem Var-Array
var NewVariant: Variant;
    CutOut: Variant;
    i, LowBound: Integer;
begin
  if Count > 0 then
  begin
    CutOut:=VarArrayCreate([0,Count-1], VarVariant);
    if VarArrayDimCount(Dest) > 0 then
    begin
      NewVariant:= VarArrayCreate([0,VarArrayHighBound(Dest,1)-Count],VarVariant);
      LowBound:=VarArrayLowBound(Dest,1);
      for i:=0 to VarArrayHighBound(Dest,1)-Count do
      begin
        NewVariant[i]:=Dest[i+LowBound+Count];
      end;
      for i:=0 to Count-1 do
      begin
        CutOut[i]:=Dest[i+LowBound];
      end;
      Dest := NewVariant;
      Result:=CutOut;
    end
    else
    begin
      CutOut:=VarArrayCreate([0,0],VarVariant);
      CutOut[0]:=Dest;
      Result:=CutOut;
      Dest:=0;
    end;
  end
  else
  begin
    CutOut:=VarArrayCreate([0,0],VarVariant);
    CutOut[0]:=0;
    Result:=CutOut;
  end;
end;

procedure VarArrayAdd(var Dest: Variant; Value: Variant); //fügt einem Var-Array einen Wert hinzu
var New: Boolean;
begin
  New:=false;
  if VarArrayDimCount(Dest) = 0 then
  begin
    Dest:=VarArrayCreate([0,0],VarVariant);
    New:=true;
  end;
  if New then
  begin
    Dest[VarArrayHighBound(Dest,1)]:=Value;
  end
  else
  begin
    VarArrayResize(Dest,VarArrayHighBound(Dest,1)+1);
    Dest[VarArrayHighBound(Dest,1)]:=Value;
  end;
end;

procedure VarArrayAdd(var Dest: Variant; ValueArray: Array of Variant); //fügt einem Var-Array mehrere Werte hinzu
var i : Integer;
begin
  for i:=0 to Length(ValueArray)-1 do
  begin
    VarArrayAdd(Dest,ValueArray[i]);
  end;
end;