code 33010; procedure RK1(X, A, B, Y, YA, FXY, E, D, FI); value B, FI; real X, A, B, Y, YA, FXY; boolean FI; array E, D; begin real E1, E2, XL, YL, H, INT, HMIN, ABSH, K0, K1, K2, K3, K4, K5, DISCR, TOL, MU, MU1, FH, HL; boolean LAST, FIRST, REJECT; if FI then begin D[3]:= A; D[4]:= YA end; D[1]:= 0; XL:= D[3]; YL:= D[4]; 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]; E1:= E[1] / INT; E2:= E[2] / 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; K0:= FXY * H; X:= XL + H / 4.5; Y:= YL + K0 / 4.5; K1:= FXY * H; X:= XL + H / 3; Y:= YL + (K0 + K1 * 3) / 12; K2:= FXY * H; X:= XL + H * .5; Y:= YL + (K0 + K2 * 3) / 8; K3:= FXY * H; X:= XL + H * .8; Y:= YL + (K0 * 53 - K1 * 135 + K2 * 126 + K3 * 56) / 125; K4:= FXY * H; X:= if LAST then B else XL + H; Y:= YL + (K0 * 133 - K1 * 378 + K2 * 276 + K3 * 112 + K4 * 25) / 168; K5:= FXY * H; DISCR:= ABS(K0 * 21 - K2 * 162 + K3 * 224 - K4 * 125 + K5 * 42) / 14; TOL:= ABS(K0) * E1 + ABSH * E2; REJECT:= DISCR > TOL; MU:= TOL / (TOL + DISCR) + .45; if REJECT then begin if ABSH <= HMIN then begin D[1]:= D[1] + 1; Y:= YL; 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; FH:= MU * H / HL + MU - MU1; HL:= H; H:= FH * H; ACC: MU1:= MU; Y:= YL + ( - K0 * 63 + K1 * 189 - K2 * 36 - K3 * 112 + K4 * 50) / 28; K5:= FXY * HL; Y:= YL + (K0 * 35 + K2 * 162 + K4 * 125 + K5 * 14) / 336; NEXT: if B ^= X then begin XL:= X; YL:= Y; goto TEST end; if not LAST then D[2]:= H; D[3]:= X; D[4]:= Y end RK1; eop