Задача Коши дописать процедуру

[Gonzo]

Составить программу решения задачи Коши dy/dx=f(x,y), x_принадлежит_[a,b], y(a)=y0, шаг

h=0.05 экстраполяционным четырехшаговым методом Адамса. "Начальный отрезок" вычислить по

методу Рунге-Кутта. f(x)=y*ln(y)/x, a=1,b=2,y0=e.

Есть такие наработки, но начальный отрезок находится по Эйлеру. Никто не поможет теорией, а

лучше процедуркой?

USES CRT;
TYPE MAS=ARRAY[1..100] OF REAL;
VAR YI_:MAS;
    I_:byte;

FUNCTION FUNC(X,Y:REAL):REAL;
 BEGIN
  FUNC:=y*ln(y)/x;
 END;

FUNCTION EYLER(X,Y,H,EPS:REAL):REAL;
 VAR YK,Y0:REAL;
     DN:BOOLEAN;
 BEGIN
  DN:=FALSE;
  Y0:=Y+FUNC(X,Y)*H;
  REPEAT
   YK:=Y+FUNC(X,Y0)*H*0.5;
   IF ABS(YK-Y0)<EPS THEN
   DN:=TRUE;
   Y0:=YK;
  UNTIL DN;
  EYLER:=Y0;
 END;

PROCEDURE ADAMS(A,B,H,EPS,YN:REAL;VAR YI:MAS);
 VAR X0,Y0,Y:REAL;
     FF:TEXT;
     I,L:INTEGER;
     XI,DYI,YSH,QI,DQI,D2QI,D3QI:MAS;
 BEGIN
  TEXTMODE(259);
  FOR I:=1 TO 20 DO XI[I]:=0.0;
  DYI:=XI;
  Y0:=YN;
  YI:=XI;
  QI:=XI;
  DQI:=XI;
  D2QI:=XI;
  D3QI:=XI;
  YSH:=XI;
  X0:=A;
  XI[1]:=X0;
  YI[1]:=Y0;
  I:=1;
  YSH[1]:=FUNC(X0,Y0);
  QI[1]:=H*YSH[1];
  REPEAT
   Y:=EYLER(X0,Y0,H,EPS);
   INC(I);
   X0:=X0+H;
   Y0:=Y;
   XI[I]:=X0;
   YI[I]:=Y;
   YSH[I]:=FUNC(X0,Y0);
   QI[I]:=H*YSH[I];
   DQI[I-1]:=QI[I]-QI[I-1];
   IF I>2 THEN
   D2QI[I-2]:=DQI[I-1]-DQI[I-2];
   IF I>3 THEN
   D3QI[I-3]:=D2QI[I-2]-D2QI[I-3];
  UNTIL I>=4;
  REPEAT
   DYI[I]:=QI[I]+0.5*DQI[I-1]+5*D2QI[I-2]/12+3*D3QI[I-3]/8;
   INC(I);
   X0:=X0+H;
   XI[I]:=X0;
   YI[I]:=YI[I-1]+DYI[I-1];
   YSH[I]:=FUNC(XI[I],YI[I]);
   QI[I]:=H*YSH[I];
   DQI[I-1]:=QI[I]-QI[I-1];
   D2QI[I-2]:=DQI[I-1]-DQI[I-2];
   D3QI[I-3]:=D2QI[I-2]-D2QI[I-3];
   L:=I;
  UNTIL (xi[i]>b-h) or (I=100);
  writeln(' ----------------------');
  writeln('|  i | x[i] |    y[i]  |');
  writeln(' ----------------------');
  I:=0;
  WHILE I<L DO
   BEGIN
    I:=I+1;
    WRITELN('|',i:3,' | ',XI[I]:4:2,' | ',YI[I]:8:5,' |');
    IF I mod 48 = 0 then
     begin
      writeln;
      write('Press any key to CONTINUE... ');
      readkey;
      clrscr;
     end;
   END;
  writeln(' ----------------------');
END;

 begin
  clrscr;
  writeln;
  writeln('KOSHI/ADAMS/AILER');
  write('Press any key to CONTINUE... ');
  readkey;
  ADAMS(1,2,0.05,0.00001,exp(1),YI_);
  writeln;
  write('Press any key to EXIT... ');
  readkey;
 end.

За мной отзывы