code 33012 ;
procedure RK2(X, A, B, Y, YA, Z, ZA, FXYZ, E, D, FI);
value B, FI; real X, A, B, Y, YA, Z, ZA, FXYZ; boolean FI;
array E, D;
begin real E1, E2, E3, E4, XL, YL, ZL, H, INT, HMIN, HL,
ABSH, K0, K1, K2, K3, K4, K5, DISCRY, DISCRZ, TOLY,
TOLZ, MU, MU1, FHY, FHZ;
boolean LAST, FIRST, REJECT;
if FI then
begin D[3]:= A; D[4]:= YA; D[5]:= ZA end;
D[1]:= 0; XL:= D[3]; YL:= D[4]; ZL:= D[5];
if FI then D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]);
if B - XL < 0 then H:= - H; INT:= ABS(B - XL);
HMIN:= INT * E[1] + E[2]; HL:= INT * E[3] + E[4];
if HL < HMIN then HMIN:= HL; E1:= E[1] / INT;
E2:= E[2] / INT; E3:= E[3] / INT; E4:= E[4] / INT;
FIRST:= true; if FI then
begin LAST:= true; goto STEP end;
TEST: ABSH:= ABS(H); if ABSH < HMIN then
begin H:= if H > 0 then HMIN else - HMIN; ABSH:= HMIN
end;
if H >= B - XL eqv H >= 0 then
begin D[2]:= H; LAST:= true; H:= B - XL;
ABSH:= ABS(H)
end
else LAST:= false;
STEP: X:= XL; Y:= YL; Z:= ZL; K0:= FXYZ * H;
X:= XL + H / 4.5;
Y:= YL + (ZL * 18 + K0 * 2) / 81 * H;
Z:= ZL + K0 / 4.5 ; K1:= FXYZ * H; X:= XL + H / 3;
Y:= YL + (ZL * 6 + K0) / 18 * H;
Z:= ZL + (K0 + K1 * 3) / 12; K2:= FXYZ * H;
X:= XL + H * .5;
Y:= YL + (ZL * 8 + K0 + K2) / 16 * H;
Z:= ZL + (K0 + K2 * 3) / 8; K3:= FXYZ * H;
X:= XL + H * .8;
Y:= YL + (ZL * 100 + K0 * 12 + K3 * 28) / 125 * H;
Z:= ZL + (K0 * 53 - K1 * 135 + K2 * 126 + K3 * 56)
/ 125; K4:= FXYZ * H; X:= if LAST then B else XL + H;
Y:= YL + (ZL * 336 + K0 * 21 + K2 * 92 + K4 * 55) /
336 * H;
Z:= ZL + (K0 * 133 - K1 * 378 + K2 * 276 + K3 * 112
+ K4 * 25) / 168; K5:= FXYZ * H;
DISCRY:= ABS(( - K0 * 21 + K2 * 108 - K3 * 112 + K4
* 25) / 56 * H);
DISCRZ:= ABS(K0 * 21 - K2 * 162 + K3 * 224 - K4 *
125 + K5 * 42) / 14;
TOLY:= ABSH * (ABS(ZL) * E1 + E2);
TOLZ:= ABS(K0) * E3 + ABSH * E4;
REJECT:= DISCRY > TOLY or DISCRZ > TOLZ;
FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ;
if FHZ > FHY then FHY:= FHZ;
MU:= 1 / (1 + FHY) + .45; if REJECT then
begin if ABSH <= HMIN then
begin D[1]:= D[1] + 1; Y:= YL; Z:= ZL;
FIRST:= true; goto NEXT
end;
H:= MU * H; goto TEST
end;
if FIRST then
begin FIRST:= false; HL:= H; H:= MU * H; goto ACC
end;
FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H;
ACC: MU1:= MU;
Y:= YL + (ZL * 56 + K0 * 7 + K2 * 36 - K4 * 15) / 56
* HL;
Z:= ZL + ( - K0 * 63 + K1 * 189 - K2 * 36 - K3 * 112
+ K4 * 50) / 28; K5:= FXYZ * HL;
Y:= YL + (ZL * 336 + K0 * 35 + K2 * 108 + K4 * 25)
/ 336 * HL;
Z:= ZL + (K0 * 35 + K2 * 162 + K4 * 125 + K5 * 14)
/ 336;
NEXT: if B ^= X then
begin XL:= X; YL:= Y; ZL:= Z; goto TEST end;
if not LAST then D[2]:= H; D[3]:= X; D[4]:= Y; D[5]:= Z
end RK2;
eop