Исправить ошибку в цикле - Pascal

Формулировка задачи:

Program Lab13;
label 20;
label 10;
Var
x,y,x1,y1,a,a0,e,g,dx,dy,grad,f0,f1:real;
i,j,n:integer;
  Function f(x,y:real):real;
  begin
  f:=6*x-0.9*y+exp(0.36*x*x+0.16*y*y);
  End;
       begin
       x:=1;
       y:=1;
       i:=1;
       j:=0;
       a:=0.1;
       a0:=a;
       e:=0.1;
       n:=20;
       g:=0.0001;
       Writeln(' N      a       x    y    df/dx   df/dy    grad f(x,y)        f(x,y)');
       dx:=(f(x+g,y)-f(x,y))/g;
       dy:=(f(x,y+g)-f(x,y)/g);
       grad:=dx*dx+dy*dy;
       grad:=sqrt(grad);
       while e<=grad   do
       
       begin
       f0:=f(x,y);
 
       writeln(i:3,' ',a:4:4,' ',x:4:4,' ',y:4:4,' ',dx:4:4,' ',dy:4:4,'grad:4:4',' ',f(x,y):4:4);
       x1:=x;
       y1:=y;
       x:=x-dx*a;
       y:=y=dx*a;
       f1:=f(x,y);
     
       while f0>f1 do
       begin
       j:=j+1:
       f:=f1;
       x1:=x;
       y1:=y;
       x:=x-dx*a*j;
       y:=y=dy*a*j:
       f1:=f(x,y);
       end;
       x:=x1;
       y:=y1;
       inc(i);
       if i<n then
       begin a:=a*(j-1);
       if a<o tjem
       begom a:=a0/10;
       a0:=a;
       end;
       goto 10;
       end;
        if i=n then
        goto 20;
        end;
        end;
        20:
        Writeln(i:3,' ',a:4:4,' ',x:4:4,' ',y:4:4,' ',dx:4:4,' ',dy:4:4,' ',grad:4:4,' ',f(x.y):4;4);
        end.

Код к задаче: «Исправить ошибку в цикле - Pascal»

textual
Function f(x,y:real):real;
begin
  f:=6*x-0.9*y+exp(0.36*x*x+0.16*y*y);
End;
 
Var
  x,y,x1,y1,a,a0,e,g,dx,dy,grad,f0,f1:real;
  i,j,n:integer;
 
begin
  x:=1;
  y:=1;
  i:=1;
  j:=0;
  a:=0.1;
  a0:=a;
  e:=0.1;
  n:=20;
  g:=0.0001;
  Writeln(' N      a       x    y    df/dx   df/dy    grad f(x,y)        f(x,y)');
  dx:=(f(x+g,y)-f(x,y))/g;
  dy:=(f(x,y+g)-f(x,y)/g);
  grad:=dx*dx+dy*dy;
  grad:=sqrt(grad);
  while (e<=grad) and (i<>n) do
    begin
      f0:=f(x,y);
      writeln(i:3,' ',a:4:4,' ',x:4:4,' ',y:4:4,' ',dx:4:4,' ',dy:4:4,' ', grad:4:4,' ',f(x,y):4:4);
      x1:=x;
      y1:=y;
      x:=x-dx*a;
      y:=y-dx*a;
      f1:=f(x,y);
      while f0>f1 do
        begin
          j:=j+1;
          f0:=f1;
          x1:=x;
          y1:=y;
          x:=x-dx*a*j;
          y:=y-dy*a*j;
          f1:=f(x,y);
        end;
      x:=x1;
      y:=y1;
      inc(i);
      if i<n then
        begin
          a:=a*(j-1);
          if a<0 then
            begin
              a:=a0/10;
              a0:=a;
            end;
        end;
    end;
  Writeln(i:3,' ',a:4:4,' ',x:4:4,' ',y:4:4,' ',dx:4:4,' ',dy:4:4,' ',grad:4:4,' ',f(x,y):4:4);
end.

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

13   голосов, оценка 4.231 из 5


СОХРАНИТЬ ССЫЛКУ