Листинг3 (1035699)

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла

unit UnitTrenie;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Chart1: TChart;

Chart2: TChart;

Chart3: TChart;

Chart4: TChart;

Chart5: TChart;

Chart6: TChart;

Series1: TLineSeries;

Series2: TLineSeries;

Series3: TLineSeries;

Series4: TLineSeries;

Series5: TLineSeries;

Series6: TLineSeries;

Edit1: TEdit;

Series7: TLineSeries;

Series8: TLineSeries;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

CONST MaxInt = 32767; N = 4; F0 = 22.775e3; dF = 0.25e3;

M = 4;

Vo=5e1;

ro11 = 7810; Vc11 = 5110; E11 = 204e9; Psi11 = 0.72e-2;

h11 = 3e-3; a11 = 40e-3;

ro12 = 7600; Vc12 = 3000; E12 = 76e9; Psi12 = 0.35e-2;

h12 = 2*4e-3; a12 = 30e-3;

l1 = 60e-3;

ro2 = 7810; Vc2 = 5110; E2 = 204e9; l2 = l1+48.6e-3; Psi2 = 0.72e-2;

ro3 = ro2; Vc3 = Vc2; E3 = E2; l3 = l2+20e-3; Psi3 = Psi2;

ro4 = 7850; Vc4 = 2950; E4 = 206e9; l4 = l3+81.6e-3; Psi4 = 0.18e-2;

AA1 = a11*h11+a12*h12; E0 = 1e11;

h2 = h11; a2 = 40e-3; AA2 = a2*h2; u0 = 1e-6;

h3 = h2; a3 = a2; AA3 = a3*h3; l0 = l4;

h4 = 1.4e-3; a4o = a3; AA4o = a4o*h4; AA0 = 1e-6;

a4k = 20e-3; AA4k = a4k*h4; u00 = -5e-6;

hh = 30e-3;

epsilon = 1600;

epsilon0 = 8.85e-12;

e31 = 5;

e33 = -15;

Npoints = 1000;

Np = 1000;

V1o = Vo; V2o = 0.000;

V3o = Vo; V4o = 0.000;

aa = 0.5;

Xn = aa;

Yn = 2*aa;

TYPE RealType = double;

ProcType = procedure (T: RealType; var YI; n: integer; var YPI);

RealTypeArray = array[1..(2*MaxInt) div SizeOf(RealType)] of RealType;

TGeom = function(z: real): real;

TFexRunge = array[1..M] of ProcType;

TA = array[1..M] of TGeom;

Mas = array[0..M] of real;

Vector = array[1..N] of RealType;

Matrix =array[1..N,1..N] of RealType;

TComplex = record

Re: real;

Im: real

end;

VAR ss: integer;

hs: RealType;

zin,eps,eta,zout: RealType;

yin,yout,yxN,yxpred,y1,y2,y0,yx,dyx,b,b0,b0N,bN: Vector;

prim : boolean;

MA,MA_1: Matrix;

MA_C,MA_B: Vector;

tex,Stext: string;

num,step: byte;

FexRunge: TFexRunge;

A: TA;

Ao,Ak,l,E,ee1e,ee2e,Psi,ro: Mas;

arg,argN,argpred,Fi,z,F,Fval,F1,F2,deltaF,Vc1,E1,ro1,Psi1: real;

Xx0,Yy0,Xxk,Yyk,code: integer;

Ze,Zm,Pe,up,uk,I1,I2,I3,I4,V1,V2,V3,V4,E1e,E2e,du1,du2,No,Ku,uz,Nz,u1,u2,u3,u4,u5: TComplex;

ZeN,ZmN,PeN,upN,ukN,I1N,I2N,V1N,V2N,V3N,V4N,E1eN,E2eN,du1N,du2N,

NoN,KuN,uzN,vk,vkN,Ipe,IpeN: TComplex;

ukpred,Kupred,Zmpred,Pepred,Zepred: TComplex;

M_uk,M_Ku,M_Zm,M_Pe,M_Ze,M_arg,uu,NN,Sigma: array[0..NPoints] of real;

M_ukN,M_KuN,M_ZmN,M_PeN,M_ZeN,M_argN,uuN,NNN,SigmaN: array[0..NPoints] of real;

var

Form1: TForm1;

implementation

{$R *.dfm}

function comp(a,b,c: RealType): RealType;

var ae,be,ce,i,aae: longint; co,com: RealType;

function expon(x: RealType): longint;

begin

if x=0.0 then expon:=-324 else expon:= round(0.4342944819*ln(abs(x))+1)

end; { expon }

begin

ae:=expon(a); be:=expon(b); ce:=expon(c);

if ae < be then ae:=be;

if ae < ce then ae:=ce; co:=1; aae:=abs(ae);

if ae<>0 then

begin

for i:=1 to aae do co:=co*10;

if ae<0 then co:=1.0/co;

end;

comp:=abs(a-b)/co;

end; { comp }

procedure RungeK(Fex: ProcType; x: RealType; var y5; n: integer;

var eps,eta,xfin: RealType; var prim: boolean;

var yfin1);

label 1,11,12,13,100;

const nn=100; { max order of diff.equations }

var

x1,x2,x3,h : RealType;

k,j : integer;

out : boolean;

z,y1,y2,y3 : Array[1..nn] of realType;

y : RealTypeArray absolute y5;

yfin : RealTypeArray absolute yfin1;

procedure rk1step(Fex: ProcType; x: RealType; var y1; h: RealType;

var xh: RealType; var yh1);

var

j,k : integer;

a : array[1..5] of RealType;

w : array[1..nn] of RealType;

y : RealTypeArray absolute y1;

yh: RealTypeArray absolute yh1;

begin

a[1]:=0.5*h;

a[2]:=0.5*h;

a[5]:=0.5*h;

a[3]:=h; a[4]:=h; xh:=x;

for k:=1 to n do

begin

yh[k]:=y[k];w[k]:=y[k];

end;

for j:=1 to 4 do

begin Fex(xh,w,n,z);

xh:=x+a[j];

for k:=1 to n do

begin yh[k]:=yh[k]+a[j+1]*z[k]/3;

w[k]:=y[k]+a[j]*z[k];

end; {k}

end; {j}

end; {rk1step}

begin

1: if prim then

begin

h:=xfin-x; ss:=0;

end

else h:=hs;

out:=false;

11: if((x+2.01*h-xfin)*h>0.0) then

begin hs:=h; out:=true; h:=(xfin-x)/2.0; end;

rk1step(Fex,x,y,2*h,x1,y1);

12: rk1step(Fex,x,y,h,x2,y2);

rk1step(Fex,x2,y2,h,x3,y3);

for k:=1 to n do

if comp(y1[k],y3[k],eta) > eps then goto 13;

x:=x3;

if out then goto 100;

for k:=1 to n do y[k]:=y3[k];

if ss=5 then begin ss:=0; h:=2*h end;

ss:=ss+1; goto 11;

13: h:=0.5*h; out:=false; x1:=x2;

for k:=1 to n do y1[k]:=y2[k];

goto 12;

100:for k:=1 to n do yfin[k]:=y3[k];

end; {RungeK}

procedure invert(var matr2,matr11; n: integer; var s: integer);

{ Algorithm 42b, "CACM", adapted by S.Kvashnin, 25.07.88 }

label test0,fin;

var t : Real;

i,j,k,m : integer;

aa : array[1..4,1..8] of Real; {1..n,1..2*n}

matr : array[1..1000] of Real absolute matr2;

matr1 : array[1..1000] of Real absolute matr11;

Function Indx(n,i,j : integer):integer;

begin Indx:=n*pred(i)+j end;

begin

m:=2*n; s:=0;

for i:=1 to n do

for j:=1 to m do

if j<=n then aa[i,j]:=matr[Indx(n,i,j)] else

if j=n+i then aa[i,j]:=1 else aa[i,j]:=0;

for i:=1 to n do

begin k:=i;

test0: if aa[k,i]=0 then

begin s:=1;

if k<n then k:=k+1 else goto fin;

goto test0

end;

if s=1 then

for j:=1 to m do

begin

t:=aa[k,j]; aa[k,j]:=aa[i,j]; aa[i,j]:=t

end;

for j:=m downto i do aa[i,j]:=aa[i,j]/aa[i,i];

for k:=1 to n do

if k<>i then

for j:=m downto i do

aa[k,j]:=aa[k,j]-aa[i,j]*aa[k,i]

end; {i}

for i:=1 to n do

for j:=1 to n do matr1[Indx(n,i,j)]:=aa[i,j+n];

s:=0;

fin: END; {invert}

Procedure MultyMV( n:integer; var Matr1,Vect1,Rez1);

var i,k:integer;

Matr :array[1..1000] of Real absolute Matr1;

Vect :array[1..1000] of Real absolute Vect1;

Rez: array[1..1000] of Real absolute Rez1;

Function Indx(n,i,j:integer):integer;

begin

Indx:=n*pred(i)+j;

end;

begin

for i:=1 to n do

begin

Rez[i]:=0;

for k:=1 to n do

Rez[i]:=Rez[i]+Matr[Indx(n,i,k)] *Vect[k];

end;

end ;{MultyMV}

procedure findY(z: real; b: Vector; var yx: Vector);

var step,j: byte;

begin

if (z>=0) and (z<l1) then step:=1;

if (z>=l1) and (z<l2) then step:=2;

if (z>=l2) and (z<l3) then step:=3;

if (z>=l3) and (z<=l4) then step:=4;

yin:=b;

if step<>1 then

for j:=0 to step-2 do

begin

num:=j+1;

zin:=l[j]/l0;

eps:=1e-6;

eta:=0.0;

prim:=true;

zout:=l[j+1]/l0;

RungeK(FexRunge[j+1],zin,yin,N,eps,eta,zout,prim,yout);

yin:=yout

end;

num:=step;

zin:=l[step-1]/l0;

eps:=1e-6;

eta:=0.0;

prim:=true;

zout:=(z+1e-15)/l0;

RungeK(FexRunge[step],zin,yin,N,eps,eta,zout,prim,yout);

yx:=yout

end;

function Apar(z: real): real;

begin

Apar:=Ao[num]

end;

function Acon(z: real): real;

begin

Acon:=(a3-(z*l0-l3)*(a3-a4k)/(l4-l3))*h4

end;

function Az(z: real): real;

begin

if (z>=0) and (z<l1) then Az:=AA1;

if (z>=l1) and (z<l2) then Az:=AA2;

if (z>=l2) and (z<l3) then Az:=AA3;

if (z>=l3) and (z<=l4) then Az:=AA4o;

end;

function absZ(z: TComplex): real;

begin

absZ:=sqrt(sqr(z.Re)+sqr(z.Im))

end;

function XorY(z1,z2: TComplex): TComplex;

begin

XorY.Re:=z1.Re+z2.Re;

XorY.Im:=z1.Im+z2.Im

end;

function XandY(z1,z2: TComplex): TComplex;

begin

XandY.Re:=z1.Re*z2.Re-z1.Im*z2.Im;

XandY.Im:=z1.Re*z2.Im+z1.Im*z2.Re

end;

function XdivY(z1,z2: TComplex): TComplex;

begin

XdivY.Re:=(z1.Re*z2.Re+z1.Im*z2.Im)/(sqr(z2.Re)+sqr(z2.Im));

XdivY.Im:=(z2.Re*z1.Im-z1.Re*z2.Im)/(sqr(z2.Re)+sqr(z2.Im))

end;

procedure FexRungeP(z: RealType; var y1; n: integer; var yp1);

var

w : RealTypeArray absolute Y1;

yp : RealTypeArray absolute Yp1;

begin

yp[1]:=l0/(E[num]*A[num](z)*(1+Psi[num]*Psi[num]/4/pi/pi))*(w[3]-Psi[num]/2/pi*w[4])/u0*E0*AA0;

yp[2]:=l0/(E[num]*A[num](z)*(1+Psi[num]*Psi[num]/4/pi/pi))*(w[4]+Psi[num]/2/pi*w[3])/u0*E0*AA0;

yp[3]:=-ro[num]*A[num](z)*4*pi*pi*F*F*l0*w[1]*u0/E0/AA0;

yp[4]:=-ro[num]*A[num](z)*4*pi*pi*F*F*l0*w[2]*u0/E0/AA0;

end;

procedure FexRungeA(z: RealType; var y1; n: integer; var yp1);

var

w : RealTypeArray absolute Y1;

yp : RealTypeArray absolute Yp1;

begin

yp[1]:=l0/(E[num]*A[num](z)*(1+Psi[num]*Psi[num]/4/pi/pi))*((w[3]-Psi[num]/2/pi*w[4])*E0*AA0+e31*A[num](z)*(ee1e[num]-Psi[num]/2/pi*ee2e[num]))/u0;

yp[2]:=l0/(E[num]*A[num](z)*(1+Psi[num]*Psi[num]/4/pi/pi))*((w[4]+Psi[num]/2/pi*w[3])*E0*AA0+e31*A[num](z)*(ee2e[num]+Psi[num]/2/pi*ee1e[num]))/u0;

yp[3]:=-ro[num]*A[num](z)*4*pi*pi*F*F*l0*w[1]*u0/E0/AA0;

yp[4]:=-ro[num]*A[num](z)*4*pi*pi*F*F*l0*w[2]*u0/E0/AA0;

end;

procedure Calc();

begin

E1 := (a11*h11*E11+a12*h12*E12)/(a11*h11+a12*h12);

ro1 := (a11*h11*ro11+a12*h12*ro12)/(a11*h11+a12*h12);

Psi1 := (a11*h11*Psi11+a12*h12*Psi12)/(a11*h11+a12*h12);

Vc1 := sqrt(E1/ro1);

l[0]:=0;

l[1]:=l1; Psi[1]:=Psi1; Ao[1]:=AA1; ro[1]:=ro1; E[1]:=E1;

l[2]:=l2; Psi[2]:=Psi2; Ao[2]:=AA2; ro[2]:=ro2; E[2]:=E2;

l[3]:=l3; Psi[3]:=Psi3; Ao[3]:=AA3; ro[3]:=ro3; E[3]:=E3;

l[4]:=l4; Psi[4]:=Psi4; Ao[4]:=AA4o; ro[4]:=ro4; E[4]:=E4;

num:=1; A[num]:=Apar;

num:=2; A[num]:=Apar;

num:=3; A[num]:=Apar;

num:=4; A[num]:=Acon;

FexRunge[1]:=FexRungeA;

FexRunge[2]:=FexRungeP;

FexRunge[3]:=FexRungeP;

FexRunge[4]:=FexRungeP;

end;

procedure FindVin();

var j,i:integer;

begin

F2:=F0+dF;

F1:=F0-dF;

deltaF:=(F2-F1)/Npoints;

for i:=0 to Npoints do

begin

F:=F1+i*deltaF;

ee1e[1]:=0; ee2e[1]:=0;

yin[1]:=1; yin[2]:=0; yin[3]:=0; yin[4]:=0;

for j:=0 to M-1 do

begin

num:=j+1;

zin:=l[j]/l0;

eps:=1e-6;

eta:=0.0;

prim:=true;

zout:=l[j+1]/l0;

RungeK(FexRunge[j+1],zin,yin,N,eps,eta,zout,prim,yout);

yin:=yout

end;

y1:=yout;

yin[1]:=0; yin[2]:=1; yin[3]:=0; yin[4]:=0;

for j:=0 to M-1 do

begin

num:=j+1;

zin:=l[j]/l0;

eps:=1e-6;

eta:=0.0;

prim:=true;

zout:=l[j+1]/l0;

RungeK(FexRunge[j+1],zin,yin,N,eps,eta,zout,prim,yout);

yin:=yout

end;

y2:=yout;

ee1e[1]:=-V1o/(hh);

ee2e[1]:=-V2o/(hh);

yin[1]:=0; yin[2]:=0; yin[3]:=0; yin[4]:=0;

for j:=0 to M-1 do

begin

num:=j+1;

zin:=l[j]/l0;

eps:=1e-6;

eta:=0.0;

prim:=true;

zout:=l[j+1]/l0;

RungeK(FexRunge[j+1],zin,yin,N,eps,eta,zout,prim,yout);

yin:=yout

end;

y0:=yout;

b[1]:=(-y0[3]*y2[4]+y0[4]*y2[3])/(y1[3]*y2[4]-y1[4]*y2[3]);

b[2]:=(-y1[3]*y0[4]+y1[4]*y0[3])/(y1[3]*y2[4]-y1[4]*y2[3]);

b[3]:=0; b[4]:=0;

uk.Re:=(b[1]*y1[1]+b[2]*y2[1]+y0[1])*u00/u0;

uk.Im:=(b[1]*y1[2]+b[2]*y2[2]+y0[2])*u00/u0;

Характеристики

Тип файла документ

Документы такого типа открываются такими программами, как Microsoft Office Word на компьютерах Windows, Apple Pages на компьютерах Mac, Open Office - бесплатная альтернатива на различных платформах, в том числе Linux. Наиболее простым и современным решением будут Google документы, так как открываются онлайн без скачивания прямо в браузере на любой платформе. Существуют российские качественные аналоги, например от Яндекса.

Будьте внимательны на мобильных устройствах, так как там используются упрощённый функционал даже в официальном приложении от Microsoft, поэтому для просмотра скачивайте PDF-версию. А если нужно редактировать файл, то используйте оригинальный файл.

Файлы такого типа обычно разбиты на страницы, а текст может быть форматированным (жирный, курсив, выбор шрифта, таблицы и т.п.), а также в него можно добавлять изображения. Формат идеально подходит для рефератов, докладов и РПЗ курсовых проектов, которые необходимо распечатать. Кстати перед печатью также сохраняйте файл в PDF, так как принтер может начудить со шрифтами.

Список файлов домашнего задания