Модераторы: javastic
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Численное интегрирование.Переписать с Delphi на C#, Переписать с Delphi 7 на C# 
:(
    Опции темы
hollywinston
Дата 11.6.2017, 04:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 11.6.2017

Репутация: нет
Всего: нет



Код

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,      Math, ExtCtrls, graphDtrans, CheckLst;
type
 TMain=class(TForm)
  Label1:TLabel;
  CheckListBox1:TCheckListBox;
  Panel1:TPanel;
  procedure FormCreate(Sender:TObject);
 private
  { Private declarations }
 public
  { Public declaration}
 end;
const nn=100;
Type func=function(x:double):double;
var
  Main:TMain;
  b:massiv;
  y,ymax,bk,a,a1,ak,h,h1,Gamast,Gamag,Rml,g,gm,l,fk:double;
  m,ksi,V0,Tau,s,lambda,alfak,Mu0,delta:double;
  result,bbb:double;
  j:integer;




implementation
{$R *.dfm}

//-------------------------зависимость Psi от M и Ksi--------------------------------\\
function Psi(m,ksi:double):double;
begin
if (Ksi<=a*Pi/Tau) then Psi:=1/m-(1-s)*V0
else Psi:=Gamast/(m*Gamag);
end;

 //-------------------------зависимость P от M -----------------------------------------\\
function p(x:double):double;
begin
p:=(2*h*abs(x))/(exp(2*abs(x))-1)*(1-exp(-abs(x)*m));
end;

//-----------------------------------------sign-------------------------------------------------\\
function sign(x:double):integer;
begin
if x>0 then sign:=1 else sign:=-1;
//if x=0 then sign:=0;
end;


//---------------------------------------поиск корней-------------------------------------------\\
{$F+}
function fkorn(x:double):double;
begin
if x<>Pi/2 then fkorn:=a1*tan(x)*x-abs(m);
end;
{$F-}

//--------------------------------Численное деление пополам-----------------------------------\\
function korny(aa,bb,e:double;f:func):double;
var c:double;
begin
bb:=70;
repeat
aa:=0.000013;
bb:=bb+0.03999;
until f(aa)*f(bb)<0;
bbb:=bb;
if(bb-aa<=0) then begin showmessage(‘Интервал указан неправильно!’);halt and else
if f(aa)*f(bb)>0 then begin showmessage(‘Указанный интервал не подходит для данного метода, т.к. значения ф-ции на’);
showmessage(‘концах отрезка’+flosttostr(aa)+’,’+floattostr(bb)+’ не удовлетворяют неравенству:(‘+floattostr(f(a))+’)*(‘+floattostr(f(bb))+’)<0’);halt end else
  repeat
  c:=(aa+bb)/2;
  if f(a)=0 then c:=aa;
  if f(bb)=0 then c:=bb;
  if (f(aa)*f(c)<0) then bb:=c else aa:=c;
  until(bb-aa<e)or(f(c)=0);
  korny:=c;
 end;


//--------------------------------подынтегральная функция-----------------------------------\\
{$F+}
function fx(x:double):double;
var B0:double;
test:double;
begin
B0:=(2*Mu0*sign(m)*cosh(m*y))/((m-alfak)*sinh(abs(m)*delta))*((cos(m*1)-1)+j*sin(m*l));
test:=gm*B0*fk;
fx:=test;
end;
{$F-}
//--------------------------------Численное интегрирование-----------------------------------\\
//--------------------------------метод прямоугольников -----------------------------------\\
function rectangls(a,b,e:double;f:func):double;
var s1,s2,h:double;I,n:integer;
begin
 if(b-s<=0) then begin showmessage(‘Интервал указан неправильно!’);halt; and else
  n:=100;
 repeat
  s1:=0;
  s2:=0;
  h:=(b-a)/n;
   for i:=1 to n do
   s1:=s1+h*f(h*i-h/2);
  n:=n*2;
  h:=(b-a)/n;
   for i:=1 to n do
   s2:=s2+h*f(h*i-h/2);
  until abs(s2-s1)<e;
rectangls:=s2;
end;

//--------------------------------расчет суммы Ak и Fk--------------------------------------\\
procedure ras4et;
var k:integer;
begin
result:=0;
for k:=1 to 160 do
 begin
  m:=79.5+(k-1);
  alfak:=korny(0,bbb,0.0001,fkorn);
  gm:=p(m)*psi(m,Ksi);
  lamdak:=(alfak*alfak+m*m)/(abs(m)*abs(gm));
  bk:=sign(lamdak)*rectangls(-h1,h1,0.001,fx);
  ak:=(lambda*bk)/(lambda+j*Rml);
  fk:=((2*alfak)/(2*alfak*a1+sin(2*alfak)*a1*abs(gm))*cos(alfak)*y);
  result:=result+ak*fk;
 end;
end;

procedure TMain.FormCreate(Sender:TObject);
 begin
y:=0;
ymax:=1;
h:=0.0104;
Tau:=0.09;
h1:=h*Pi/Tau;
l:=0.2502;
Mu0:=12.56e-7;
Gamag:=5e6;
Gamast:=2.5e6;
ksi:=1;
delta:=0.0116;
a:=0.0063;
a1:=a*Pi/Tau;
bbb:=1;
Rml:=5;
end;
end.





                  


PM MAIL   Вверх
Анна01
  Дата 13.6.2017, 11:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 3
Регистрация: 13.6.2017

Репутация: нет
Всего: нет



 smile  thanks ,, but i have problem i cant correctly use this web site

Это сообщение отредактировал(а) Анна01 - 13.6.2017, 11:56
PM MAIL WWW   Вверх
Google
  Дата 18.11.2017, 03:48 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Android | Следующая тема »


 




[ Время генерации скрипта: 0.0547 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.