code 33180;
procedure DIFFSYS(X,XE,N,Y,DERIVATIVE,AETA,RETA,S,H0,OUTPUT);
value N;
integer N;
real X,XE,AETA,RETA,H0;
array Y,S;
procedure DERIVATIVE,OUTPUT;
begin real A,B,B1,C,G,H,U,V,TA,FC; integer I,J,K,KK,JJ,L,M,R,SR;
array YA,YL,YM,DY,DZ[1:N],DT[1:N,0:6],D[0:6],YG,YH[0:7,1:N];
boolean KONV,B0,BH,LAST;
LAST:=false; H:=H0;
NEXT: if H*1.1>=XE-X then
begin LAST:=true; H0:=H; H:=XE-X+"-13 end;
DERIVATIVE(X,Y,DZ); BH:=false;
for I:=1 step 1 until N do YA[I]:=Y[I];
ANF: A:=H+X; FC:=1.5; B0:=false; M:=1; R:=2; SR:=3; JJ:=-1;
for J:=0 step 1 until 9 do
begin if B0 then
begin D[1]:=16/9; D[3]:=64/9; D[5]:=256/9 end
else begin D[1]:=9/4; D[3]:=9; D[5]:=36 end;
KONV:=true;
if J>6 then begin L:=6; D[6]:=64; FC:=.6*FC end
else begin L:=J; D[L]:=M*M end;
M:=M*2; G:=H/M; B:=G*2;
if BH and J<8 then
begin for I:=1 step 1 until N do
begin YM[I]:=YH[J,I]; YL[I]:=YG[J,I] end
end
else
KK:=(M-2)/2; M:=M-1;
for I:=1 step 1 until N do
begin YL[I]:=YA[I]; YM[I]:=YA[I]+G*DZ[I] end;
for K:=1 step 1 until M do
begin DERIVATIVE(X+K*G,YM,DY);
for I:=1 step 1 until N do
begin U:=YL[I]+B*DY[I]; YL[I]:=YM[I]; YM[I]:=U;
U:=ABS(U); if U>S[I] then S[I]:=U
end;
if K=KK and K^=2 then
begin JJ:=JJ+1; for I:=1 step 1 until N do
begin YH[JJ,I]:=YM[I]; YG[JJ,I]:=YL[I] end
end
end
end;
DERIVATIVE(A,YM,DY);
for I:=1 step 1 until N do
begin V:=DT[I,0]; TA:=C:=DT[I,0]:=(YM[I]+YL[I]+G*DY[I])/2;
for K:=1 step 1 until L do
begin B1:=D[K]*V; B:=B1-C; U:=V;
if B^=0 then
begin B:=(C-V)/B; U:=C*B; C:=B1*B end;
V:=DT[I,K]; DT[I,K]:=U; TA:=U+TA
end;
if ABS(Y[I]-TA)>RETA*S[I]+AETA then KONV:=false;
Y[I]:=TA
end;
if KONV then goto END;
D[2]:=4; D[4]:=16; B0:=^B0; M:=R; R:=SR; SR:=M*2
end;
BH:=^BH; LAST:=false; H:=H/2; goto ANF;
END: H:=FC*H; X:=A; OUTPUT; if not LAST then goto NEXT;
end DIFFSYS;
eop