Важная информация
Показано с 1 по 1 из 1

Тема: помогите исправить ошибки в методе Бройдена

  1. #1 помогите исправить ошибки в методе Бройдена 
    Новичок
    Регистрация
    01.05.2013
    Сообщений
    1
    Сказал(а) спасибо
    0
    Поблагодарили 0 раз(а) в 0 сообщениях
    Код pascal:
    program broiden;
    uses crt;
    const m=20;
          n=20;
    type matr=array[1..m, 1..n] of real;
         mass=array[1..m, 1..n] of real;
         P=array[1..n] of real;
         V=array[1..n] of real;
         Bnach=array[1..n] of real;
         Q=array[1..n] of real;
         XJ=array [1..n] of real;
         Y=array [1..n] of real;
         VB=array [1..m,1..n] of real;
         ymnMAS=array [1..n] of real;
         PRMAS=array [1..n] of real;
         
     
    var x0,x1,f,e,S,SYM,pomny,zap,promq,mq,nq:real;
         a,w: matr;
         k:Bnach;
         z:mass;
         r:V;
         t:P;
         m1:Q;
         u:XJ;
         q1:Y;
         b:VB;
         mn:ymnMAS;
         nm:PRMAS;
         iteraz,i,j,n1,maunI,naid,stop,iter,l,h:integer;
    Function f1(x,y:real):real;
    begin
         f1:=x+y-3;
    end;
    Function f2(x,y:real):real;
    begin
         f2:=x*x+y*y-9;
    end;
          begin
          clrscr;
          write('Введите начальный вектор= ');
          readln(x1);
          write ('Введите точность e= ');
          readln(e);
          maunI:=0; naid:=0; stop:=0; S:=0;
          write(' Матрица Якоби= ');
             for i := 1 to n do
             for j := 1 to n do
             begin
            write(a[i,j]);
            writeln;
          end;
          while ((maunI)<>10) and ((naid)<>1) and ((stop)<>1) do
           begin
           inc(maunI);
         k[0]:=r[0]+r[1]-3;
         k[1]:=r[0]*r[0]+r[1]*r[1]-9;
          iteraz:=0;
                      for i:=0 to n do
                      for j:=0 to n do
                      begin
                      w[i,j]:=a[i,j];
          end;
          end;
          while ((iteraz)<> n-1) do
          for h:=0 to n do
          begin
          k[h]:=k[h]*(-1);
          end;
          pomny:=z[iter,iter];
          for i:=iter+1 to n do
          begin
          z[iter,j]:=z[iter,j]/pomny;
          end;
          
          t[iter]:=t[iter]/pomny;
          for  i:=iter+1 to n do
          
          zap:=z[i,iter];
          for j:=iter to n do
          begin
          z[i,j]:=z[i,j]-z[iter,j]*zap;
          
          t[i]:=t[i]-t[iter]*zap;
          inc(iter);
          end;
          if  z[n-1,n-1]<>0 then
              m1[n-1]:=t[n-1]/z[n-1,n-1]
     
              else
              begin
              m1[n-1]:=0;
              end;
              SYM:=0;
              l:=n-2;
              for i:=n-2 to n do
              begin
              SYM:=0;
              for j:=i+1 to n-1 do
              begin
              SYM:=SYM+z[i,j]*t[j];
              if z[i,l]<>0 then
               t[i]:=(t[i]-SYM)/z[i,j]
                 else
                 begin
                 t[i]:=0;
                 dec(l);
                 end;
                 end;
                 end;
              promq:=0; mq:=0; nq:=0;
              S:=0;
              for i:=i+1 to n do
              begin
              u[i]:=r[i]+m1[i];
              if r[i]>=0 then
               promq:=m1[i]+promq
               else
               begin
               promq:=-m1[i]+promq;
               if r[i]>=0 then
               mq:=mq+r[i]
               else
               begin
               mq:=mq-r[i];
               if u[i]>=0 then
               nq:=nq +u[i]
               else
               begin
               nq:=nq-u[i];
               if mq<>0 then
               S:=promq/mq
               else
               begin
               S:=promq/nq;
               if S<0 then S:=-S;
               if S<e then
               writeln(S);
               naid:=1;
               writeln('Найдено решение ');
               end;
               for i:=0 to n do
               writeln(u[i]);
               writeln('Количество итераций ', maunI)
               else
               begin
               if S>20 then
               writeln('Процесс расходится ');
               stop:=1;
               else
               begin
               if maunI=10  then
               writeln('за 10 итераций решение не найдено ');
               else
               begin
               q[0]:=(u[0]+u[1]-3)-k[0];
               q[1]:=(u[0]*u[0]+u[1]*u[1]-9)-k[1];
               end;
               end;
               for i:=1 to n do
               for j:=1 to n do
               b[i,j]:=yakob[i,j];
               yakob[i,j]:=0;
               for i:=0 to n do
               Ymn:=0;
               for j:=0 to n do
               begin
               Ymn:=Ymn+b[i,j]*m[j];
               mn[i]:=Ymn;
               nm[i]:=Y[i]-mn[i];
               del:=0;
               for i:=0 to n do
               begin
               del:=del+m[i]*m[i];
               for i:=0 to n do
               for j:=0 to n do
               begin
               yakob[i,j]:=b[i,j]+(( nm[i]*m[j]/del);
               for i:=0 to n do
               begin
               r[i]:=u[i];
               end;
               end;
               end;
               end;
               end;
          end.
    Последний раз редактировалось Абадябер; 02.05.2013 в 19:16.
     

Информация о теме
Пользователи, просматривающие эту тему

Эту тему просматривают: 1 (пользователей: 0 , гостей: 1)

Похожие темы

  1. Ошибки на форуме
    от Абадябер в разделе Архив
    Ответов: 77
    Последнее сообщение: 18.02.2016, 21:01
  2. Помогите исправить код программы
    от azalivin в разделе QBasic
    Ответов: 3
    Последнее сообщение: 10.05.2011, 18:52
  3. Ответов: 3
    Последнее сообщение: 05.03.2011, 23:46
Ваши права
  • Вы не можете создавать новые темы
  • Вы не можете отвечать в темах
  • Вы не можете прикреплять вложения
  • Вы не можете редактировать свои сообщения
  •