Deponentlanadigan materiallarning titul varag‘i

Deponentlanadigan materiallarning titul varag‘i
EHM uchun dastur (Ma’lumotlar bazasi) nomi:
“Grunt bilan o‘zaro munosabati ideal elastik-plastik modelda bo‘lgan yer osti quvurida seysmik to‘lqinlar ta’siridagi dinamik jarayonlarni hisoblash dasturi.”

Huquq ega(lar)si :

1. 
   Mirzaev Ibraxim
   
2. 
   Shomurodov Jaxongir Farxodovich
   

Muallif(lar):

1. 
   Mirzaev Ibraxim
   
2. 
   Shomurodov Jaxongir Farxodovich
   

EHM uchun dasturni identifikatsiya qiluvchi materiallar dastlabki matni (Dastur kodi)
«Grunt bilan o‘zaro munosabati ideal elastik-plastik modelda bo‘lgan yer osti quvurida seysmik to‘lqinlar ta’siridagi dinamik jarayonlarni hisoblash dasturi»


07.05.2022 yildagi versiyasi
Mualliflar: Mirzayev I.
Shomurodov J.F.

unit Unit1;

interface

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

Dialogs, StdCtrls,
IWControl,
IWCompEdit, IWDBStdCtrls;

type
TForm1 = class(TForm)

Button1: TButton;
Button2: TButton;
Label1: TLabel;
Edit1: TEdit;
nsht: TEdit;
dupre: TEdit;
dupre1: TEdit;
dupre2: TEdit;
procedure rkmtu(STEPNUM:INTEGER);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);

begin
application.Terminate;
end;

procedure TForm1.rkmtu(STEPNUM:INTEGER);

label 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26;
var
A : string;
v,vv, vg, vg0, V0, S, S0, S1: ARRAY [1..4001] OF real;
pr: ARRAY [1..4001] OF INTEGER;
u0, u1,ug, ug0,uost,uost0,f,f0,fp,up,dv,q,q0,fp0: ARRAY [1..4001] OF real;
I, J, N, M,im,k: INTEGER;
L0, D0, hp, Cp, Ro,CR,Cg,Rog, Ph,Av, kf,kg,kt,t,dt,E,T0,tm,Cs,FT,H,ff,ff00,nf,nf1,w,upr,dupr,dupr0,
vgm,egm,kz,qr,kx,taum,tkt, kl: real;
FILE_I: textfile;
FU, FQ , UU, UUg,FPR, FTI,FV,FVG,DVG : TEXTfile;

{0} begin

Assignfile ( file_i, 'isxdata.dat' );

Reset ( file_i );
Assignfile(FU, 'u.txt'); Assignfile(FQ, 'uz.txt');
Rewrite (FU); Rewrite (FQ);
Assignfile(UU, 'uu.txt'); Assignfile(UUg, 'uuz.txt');
Rewrite (UU); Rewrite (UUg);
Assignfile(FPR, 'upr.txt'); Assignfile(FTI, 'fti.txt');
Rewrite (FPR); Rewrite (FTI);
Assignfile(FV, 'v.txt'); Assignfile(FVG, 'vg.txt');
Rewrite (FV); Rewrite (FVG);

Assignfile(DVG, 'dv.txt');

Rewrite (DVG);

ReadLn ( FILE_I, A );

readLn (FILE_I, L0, D0, hp, Cp, Ro,Cg,Rog, Ph, Av, T0,kg,kf,kt,upr,dt, N);

closefile (file_i);

STEPNUM :=n;

E := Cp * Cp * Ro;

CS := pi / 4 * (D0 * D0 - (D0 - 2 * hp) * (D0 - 2 * hp));
tm := dt * N; H := Cp * dt;

dt:=1*dt;

M := round(L0 / H + 1);

CR := Cp * Ro;
im := M;
kg := kg{*pi*D0/CS; };
kx := kf;
kt := kf*upr;
qr:=pi*D0/(CS*Ro);
vgm:= Av*pi/T0; egm := vgm/Cg; taum:=kt;

FOR i := 1 TO M do begin

vg[i] := 0; vg0[i] := 0; ug[i] := 0; ug0[i] := 0;
u0[i] := 0; v[i] := 0; V0[i] := 0; S[i] := 0; S0[i] := 0;
uost[i] := 0;uost0[i] := 0; pr[i] := 1; F0[i]:=0; F[i]:=0; Fp[i]:=0; up[i]:=0; fp0[i]:=0;
end;
w:=0;

{1} FOR j := 1 TO N do begin

t := (j-1) * dt;
nsht.Text:=inttostr(j); nsht.update;

{2} FOR i := 1 TO M - 1 do begin

IF ((t-(i-1) * H/Cg) >= 0) {and ((t-(i-1) * H/Cg) <= T0) } THEN begin

vg[i] :=Av*pi/T0*cos(pi * (t-(i-1) * H/Cg)/T0);
ug[i] := Av*sin(pi * (t-(i-1) * H/Cg)/T0); end ELSE
begin vg[i] := 0; ug[i] := 0; end;

ug[i] := ug0[i]+(vg[i]+ vg0[i])*dt/2;

{5} IF pr[i]=1 then begin

v[i] :=(2*Cp*(S0[i + 1]- S0[i])+ 2*V0[i]+(kx*qr*dt)*(ug[i]+ug0[i]-2*u0[i]))/(2+kx*qr*dt*dt);

F[i]:=kx*(ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2+(vg[i]-v[i]) * dt/2);

{6} if (F[i]>=kt) then begin

up[i]:=ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2;

fp[i]:=kt;
pr[i]:=2;

k:=0; dv[i]:=0;

10: dv[i]:=-v[i]+(2*Cp*(S0[i+1]-S0[i])+2*v0[i]+2*qr*dt*fp[i])/(2);
k:=k+1;
v[i]:=v[i]+dv[i];
if abs(dv[i])>0.000001 then goto 10;
F[i]:= kt;
{6 y} goto 4; end;

{7} if (F[i]<-kt) then begin

up[i]:=ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2;

fp[i]:=-kt;
pr[i]:=3;

k:=0; dv[i]:=0;

11: dv[i]:=-v[i]+(2*Cp*(S0[i+1]-S0[i])+2*v0[i]+2*qr*dt*fp[i])/(2);
k:=k+1;
v[i]:=v[i]+dv[i];
if abs(dv[i])>0.000001 then goto 11;
F[i]:= -kt;
{7 y} goto 4; end; goto 4;
{5 y} end; {pr[i]=1 ning tugashi}

{11} IF pr[i]=2 then begin

v[i] := (2*Cp*(S0[i + 1] - S0[i]) + 2*V0[i]+2*qr*dt*fp[i])/(2);

F[i]:= kt;

{12} if (vg[i]-v[i])*(vg0[i]-v0[i])<0 then begin

up[i]:=ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2;
fp[i]:=kt;
pr[i] :=4;

k:=0; dv[i]:=0;

16: dv[i]:=-v[i]+(2*Cp*(S0[i+1]-S0[i])+2*v0[i]+2*qr*dt*fp[i]+(kx*qr*dt)*(ug[i]+ug0[i]-2*u0[i]-2*up[i]))/(2+qr*kx*dt*dt);
k:=k+1;
v[i]:=v[i]+dv[i];
if abs(dv[i])>0.000001 then goto 16;
F[i]:= fp[i]+ kx*(ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2+(vg[i]-v[i]) * dt/2-up[i]);
{12 y} goto 4; end; goto 4;
{11 y} end;
{13} IF pr[i]=3 then begin

v[i] := (2*Cp*(S0[i + 1] - S0[i]) + 2*V0[i]+2*qr*dt*fp[i])/(2);

F[i]:= -kt;

{14} if (vg[i]-v[i])*(vg0[i]-v0[i])<0 then begin

up[i]:=ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2;
fp[i]:=-kt;
pr[i] :=4;

k:=0; dv[i]:=0;

23: dv[i]:=-v[i]+(2*Cp*(S0[i+1]-S0[i])+2*v0[i]+2*qr*dt*fp[i]+(kx*qr*dt)*(ug[i]+ug0[i]-2*u0[i]-2*up[i]))/(2+qr*kx*dt*dt);
k:=k+1;
v[i]:=v[i]+dv[i];
if abs(dv[i])>0.000001 then goto 23;
F[i]:= fp[i]+kx*(ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2+(vg[i]-v[i]) * dt/2-up[i]);
{14 y} goto 4; end; goto 4;
{13 y} end;
{18} IF pr[i]=4 then begin

v[i] := (2*Cp*(S0[i + 1] - S0[i]) + 2*V0[i]+2*qr*dt*fp[i]+(kx*qr*dt)*(ug[i]+ug0[i]-2*u0[i]-2*up[i]))/(2+qr*kx*dt*dt);

F[i]:= fp[i]+kx*(ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2+(vg[i]-v[i]) * dt/2-up[i]);

if (F[i]>=kt) then begin

up[i]:=ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2;

fp[i]:=kt;
pr[i] :=2;

k:=0; dv[i]:=0;

24: dv[i]:=-v[i]+(2*Cp*(S0[i+1]-S0[i])+2*v0[i]+2*qr*dt*fp[i])/(2);
k:=k+1;
v[i]:=v[i]+dv[i];
if abs(dv[i])>0.000001 then goto 24;
F[i]:= kt;
goto 4; end;

if (F[i]<-kt) then begin

up[i]:=ug0[i]-u0[i]+(vg0[i]-v0[i]) * dt/2;

fp[i]:=-kt;
pr[i] :=3;

k:=0; dv[i]:=0;

25: dv[i]:=-v[i]+(2*Cp*(S0[i+1]-S0[i])+2*v0[i]+2*qr*dt*fp[i])/(2);
k:=k+1;
v[i]:=v[i]+dv[i];
if abs(dv[i])>0.000001 then goto 25;
F[i]:= -kt;
goto 4; end; goto 4;
{18 y} end;

{2 y} 4: end;

{18-18 y}FOR i := 2 TO M-1 do begin S[i] := S0[i] + (v[i] - v[i - 1])/Cp; end;
{19} FOR i := 1 TO M do begin
u1[i] := u0[i] + (v[i]+v0[i]) * dt/2;
F0[i] := F[i];

{19 y} end;

{20} FOR i := 1 TO M do begin

S0[i] := S[i]; fp0[i]:=fp[i]; V0[i] := v[i]; vg0[i] := vg[i]; ug0[i] := ug[i]; u0[i] := u1[i]; uost0[i] := uost[i];
Write (FQ, (-vg[i]/(Cg*egm)):12 ,' '); Write (UUg, ug[i]:12 ,' ');
{20 y} end;

Writeln (FQ); Writeln (UUg);

{21} FOR i := 1 TO M do begin

Write (FU, (S[i]/egm):11 ,' '); Write (UU, u1[i]:11 ,' ');
Write (FPR, (pr[i]*Av {*pi/(T0)}):11 ,' '); Write (FTI, (F[i]/taum):11 ,' ');
Write (FV, (v[i]/vgm):11 ,' '); Write (FVG, (vg[i]/vgm):11 ,' ');
{Write (DVG, (dv[i]):11 ,' '); }
{21 y} end;

Writeln (FU); Writeln (UU); Writeln (FPR); Writeln (FTI); Writeln (FV); Writeln (FVG);

{1 y} end;
closefile(DVG); closefile(FU); closefile (FQ); closefile (UU); closefile (UUg); closefile (FPR); closefile (FTI); closefile (FV); closefile (FVG);

{0} end; (**** RKMTU ****)

procedure TForm1.Button1Click(Sender: TObject);

var n:integer;
begin
n:=0;
edit1.Font.Color:=clnavy;
edit1.text:='ÈÄÅÒ ÏÐÎÖÅÑÑ';
edit1.update;
rkmtu(n);
Edit1.Font.Color:=clGreen;
Edit1.Text:='ÂÛ×ÈÑËÅÍÈß ÇÀÂÅÐØÅÍÛ';
end;

end.