انجام پایان نامه

درخواست همکاری انجام پایان نامه  بانک مقالات رایگان انجام پایان نامه

سفارش پایان نامه

|

انجام پایان نامه ارشد

 پایان نامه 

پایان نامه‏ کامپیوتر

انجام پایان نامه‏ ارشد کامپیوتر

program PLAI;
{**************************************}
const MAXCIMUM_JOINT= 10; MAXCIMUM_PLAIN= 100; MAX= 7; 1_ENGHT_MATRIS= 20;
ENTER_FILE- 'inpplain.txt';
OUTPUT__FILE= 'out1.txt' ;
n:integer=1;
COUNTER :integer=l;
{**************************************}
type
ak=array [1..7,1..7] of real;av=array [1..7] of real;
ach=array[l..4] of real;
Jot nt=record
x,y:rea1;
px,py:rea1;
end;
P1ain=record
i,j,m:integer;
distans:av;
t:ach;
k:ak;
end;
Support=record
nojoint: integer;
rool:char; end;
nuu=array [1 .. LENGHT_MATRIS] of real;
aj=array [1 ..MAXCIMUM_JOINT] of joint;
aj2=array [1..2*MAXCIMUM__JOINT] of integer;
aj4=array [1..2*MAXCIMUM_JOINT, 1..2*MAXCIMUM_JOINT] of real;
ar=array [1..2*MAXCIMUM_JOINT] of real;
anu=array [1..LENGHT_MATRIS,1..LENGHT_MATRIS] of real;
an4=array [1..20,1..20] of real;
pk=^p1ain;
{**************************************}
var
E:longint;
V,T,N2:rea1;
v3,i3,j3,w,q,NUMBER_JOINT,NUMBER_PLAIN,NUMBER_SUPPORT:integer;
F,FI:text;
m:ar;
y:array [1..10] of ^plain;
pdel item:aj2;
b,BT,C,MATRIC_D:ak;
tk:array [1..7,1..7] of real;
optimat, K:aj4;
JOINT_RECORD:aj;
PEAIN RECORD:array [1..MAXCIMUM_PLAIN]of plain;
Suppor :array [1 ..MAXCIMUM_JOINT] of support;
tempoptimat :an4;
g:anu;
bx,py,px:nuu;
{**************************************}
procedure INPUT_NUMBER_TO_PROGRAM;
var
c:char;
i : integer;
FILEPUT:text;
 
begin
assign(FILEPUT,ENTER_FILE);
reset(FILEPUT);
read(FILEPUT,E);
read(FILEPUT,V);
read(FILEPUT,T);
read(FILEPUT,NUMBER__JOINT);
for i:=1 to NUMBER_JOINT do
begin
read(FILEPUT,JOINT_RECORD[i] .x);
read(FILEPUT,JOINT_RECORD[i].y);
read(FILEPUT,JOINT_RECORD[i] .px);
read(FILEPUT,JOIMT_RECORD[i] .py) ;
end;
read(FILEPUT,NUMBER_PLAIN);
for i:=1 to NUMBER_PLAIN do
begin
read(FILEPUT,PLAIN_RECORD[i]-i);
read(FILEPUT,PLAIN_RECORD[i].j);
read(FILEPUT,PLAIN_RECORD[i].m);
end;
read(FILEPUT,NUMBER_SUPPORT);
for i:=1 to NUMBER_SUPPORT do
begin
read (FI LEPUT, suppor [i] .nojoint) ;
read (FILEPUT,c);
read (FILEPUT , suppor[i].rool);
end;
close(FILEPUT);
end;
{**************************************}
procedure DISPLAY_ON_FILEINPUT;
var
i :integer;
begin
writeln(E,' ',V:3:2 ,' ',T:3:2);
for i:=1 to NUMBER_JOINT do
writeln(JOINT_RECORD[i] .x:7:2 ,' ' ,JOINT_RECORD[i] .y : 7 :2 ,' ',
JOINT_RECORD[i].px:7:2 ,' ',JOINT_RECORD[i].py:7:2);
for i:=1 to NUMBER_PLAIN do
writeln (PLAIN_RECORD[i] .i , ' ', PLAIN_RECORD [i] .j,' ', PLAIN_RECO,RD[i] .m) ;
for i:=1 to NUMBER_SUPPORT do
writeln (suppor[i] .no joint, ' ' ,suppor[i] .rool ) ;
end;
{**************************************}
function determinal (p:plain;jn;aj):real;
var
T:array [1..3,1..3] of real;
Temp1 ,temp2 ,tenip3 : real ;
begin
T[1,1]:=1
T[2,1:=1
T[3,1]:=1;
T[1,2] :=jn[p.i] .x;
T[2.2] :=jn[p.j] .x;
T[3,2] :=jn[p.m] .x;
 
T[l,3]:=jn[p.i].y;
T[2.3] :=jn[p.j] .y;
T[3,3]:=jn[p.m].y;
Temp1:= T[l,l]*( (T[2 ,2] *T[3,3] ) - ( (T[2 ,3] *[3,2] )   );
Temp2:= T[l,2]*( (T[2 ,1] *T[3,3] ) - ( (T[2 ,3] *[3,1] )   );
Temp3:= T[l,l]*( (T[2 ,1] *T[3,2] ) - ( (T[2 ,2] *[3,1] )   );
Determinal:=Temp1-Temp2+Temp3;

end;
{**************************************}
procedure calc _d(e:1ongint;v:real);
var
Temp:rea1;
begin
Temp:=0;
Temp:=E/(1-V*V);

MATRIC_D[1,1]: =1*Temp;
MATRIC_D[1,2]: =V*Temp;
MATRIC_D[1,3]: =0.0;

MATRIC_D[2,1]: =V*Temp;
MATRIC_D[3,1]: =0.0;

MATRIC_D[2,2]: =1.0*Temp;
MATRIC_D[2,3]: =0.0 ;

MATRIC_D[3,2]: =0.0 ;

MATRIC_D[3,3]: =((1-V)/2)*Temp;

end;
{**************************************}
procedure Transpos(var m:ak;var mt:ak);
var
i,j:integer;
begin
For i : =1 to 6 do
for j:=1 to 3 do
   begin
mt[I,j] := m[j,i] ;

end;
end;
{**************************************}
procedure multiply1(var a:ak;var b:ak;var c:ak);
var
i,j,k:integer;
begin
for i : =1 to 6 do
for j : =1 to 3 do
c[i,j] :=0.0;
for i : =1 to 6 do
for j : =1 to 3 do
for k:=1 to 3 do
C[i,j] :=c[i,j]+(a[i,k]*b[k,j]);
end;
 
{**************************************}
procedure multiply2(a:ak;b:ak;var ct:ak);
var
i,J ,k: integer;
begi n
for i :=1 to 6 do
for j : =1 to 6 do
ct[I,j] :=0.0;
for i : =1 to 6 do
for j :=1 to 6 do
for k: = 1 to 3 do
ct[i,j]:=(ct[i,j])+(a[i,k]*b[k,j]);
end;
{**************************************}
procedure multiply3 (var a:ak;b:ak;var ct:ak);
var
i,j,k:integer;
begin
for i:=1 to 3 do
for j : =1 to 6 do
ct[i,j] :=0.0;
for i :=1 to 3 do
for j:=1 to 6 do
for k:=1 to 3 do
begin
ct[I,j]:=(ct[i,j])+(a[i,k]*b[k,j]);
end;
end;
{**************************************}
procedure multiply4(a:ak;var b:av;var ct:ach);
var
i.J,k:integer;
begin
for i:=2 to 4 do
ct[i] :=0.0;
for i:=1 to 3 do
for j:=1 to 6 do
begin
ct[i]:=(ct[i])+(a[i+1,j+1]*b[j]);
end;
end;
{**************************************}
procedure dis_mat (ab : ak;m: integer ;n : integer) ;
var
i ,j:integer;
begin
for i:=2 to m do
begin
for j : =2 to n do
begin
write(ab[i ,j] :3:5, '  ') ;
end;
writeln;
end;
end;
 
{*****************************************************}
procedure calc_b (p:plain;tjoint:aj);
var
i ,j : integer;
a:real ;
begin
for i : =1 to 4 do
for j : =1 to 7 do
begin
b[i,j]:=0.0;
end;
a : =determinal (p,tjoint) ;
if (a<>0.0) then a:=1/a;
b[l,1]:=tjoint[p.j] .y-tjoint[p,m] .y;
b[l,2]: =0.0;
b[l,3]: =tjoint[p.m].y-tjoint[p.i].y;
b[l,4]: =0.0;
b[l,5]: =tjoint[p.i].y-tjoint[p.j].y;
b[l,6]: =0.0;
b[2,1]: =0.0;
b[2,2]: =tjoint[p.m].x-tjoint [p.j] .x;
b[2,3]: =0.0;
b[2,4]: =tjoint[p.i] .x-tjoint [p.m].x;
b[2,5]: =0.0;
b[2,6]: =tjoint [p.j] .x-tjoint [p.i].x;
b[3,1]: =tjoint [p.m] .x-tjoint [p.j] .x;
b[3,2]: =tjoint [p.j] .y-tjoint [p.m] .y;
b[3,3]: =tjoint [p.i] .x-tjoint [p.m] .x;
b[3,4]: =tjoint [p.m] .y-tjoint [p.i] .y;
b[3,5]: =tjoint [p.j] .x-tjoint [p.i] .x;
b[3,6]: =tjoint [p.i] .y-tjoint [p.j] .y;
writeln('eshgh:   ',a:3:7);
for i : =1 to 3 do
for j : =1 to 6 do
begin
b[i,j] :=b[i,j]*a;
end;
dis_mat(b,3,6);
end;
{*****************************************************}
procedure calc_k_plain( p:pk ;jn:aj);
var
i,j:integer;
    det:real;
begin
calc_b(p^,jn) ;
transpos(b,bt);
multiply1(bt,MATRIC_D,c);
multiply2(c,b,p^.k);
for i : =1 to 6 do
begin
for j : =1 to 6 do
begin
write(p^.k[i,j]:7:1,' ');
end;
 
writeln;
end;
det: =determinal (p^,jn)*T/2;
for i : =1 to 6 do
for j: =1 to 6 do
begin
P^.k[i,j] :=det*(p^.k[i,j]);
end;
readln;
end;
{*****************************************************}
procedure calc_all_k_plain;
var
i:integer;
begi n
for i:=1 to NUMBER_PLAIN do
begin
calc_k_plain(PLAIN_RECORD[i],JOINT_RECORD);
end;
end;
{*****************************************************}
procedure Kset (m:real);
var
i,j:integer;
begin
for i:=1 to 2*MAXCIMUM_JOINT+1 do
for j:=1 to 2*MAXCIMUM_JOINT+1 do
begin
K[i,j]:=m;
end;
end;
{*****************************************************}
procedure Kgenerator;
var
j,i,n,satr,soton:integer;
begin
Kset(0.0);
for n:=1 to NUMBER_PLAIN do
for i : =1 to 6 do
for j : =1 to 6 do
begin
if (i =1) then satr =2*PLAIN_RECORD[n].i-1;
if (i=2) then satr: =2*PLAIN_RECORD [n] .i ;
if (i =3) then satr =2*PLAIN_RECORD[n].j-1;
if (i =4) then satr =2*PLAIN_RECORD[n].j;
if (i =5) then satr:=2*PLAIN_RECORD[n].m-1;
if (i =6) then satr :=2*PLAIN_RECORD [n] .m;
if (j =1) then soton:=2*PLAIN_RECORD[n].i-1;
if (j=2) then soton :=2*PLAIN_RECORD[n].i;
if (j=3) then soton :=2*PLAIN_RECORD[n].j-1;
it (j=4) then soton :=2*PLAIN_RECORD[n].j;
if (j=5) then soton :=2*PLAIN_RECORD[n].m-1;
if (j=6) then soton :=2*PLAIN_RECORD[n].m;
K[satr,soton]:=K[satr,soton]+PLAIN_RECORD[n].k[i,j];
end;
end;
end;

 
{*****************************************************}
function searc(a:aj2;p:integer; count:integer):integer;
var
i:integer;
begin
for i:=COUNTER to count do
begin
if a [i] =p then
begin
searc:=1;
exit;
end;
end;
searc:=0;
end;
{*****************************************************}
procedure addlist (var a:aj2;n:integer) ;
var
k, i:integer;
begin
if searc(a,n,a[1])=1 then searc(a,n,a [1])
else
begin
a[1] :=a[1]+1;
a[a[1]+1] :=n;
end;
end;
{*****************************************************}
procedure setdelitem(var ret:aj2);
var
deltemp:aj2;
c:integer;
begin
deltemp[1]:=0;
for c:=1 to NUMBER_SUPPORT do
begin
if (suppor[c].rool='r') then
begin
addlist(deltemp,2*suppor[c].nojoint);
end;
if (suppor[c].rool='f') then
begin
addlist(deltemp,2*suppor[c].nojoint-1);
addlist(deltemp,2*suppor[c].nojoint);
end;
end;
for c:=1 to deltemp [1]+1 do
begin
ret[c]:=deltemp [c];
writeln(ret[c]);
end;
end;
{*****************************************************}
procedure koptimize(k:aj4;j:aj;d:aj2;var retmat:aj4);
var
c,row,col,i,j2,i2:integer;
 
out:text;
begin
col : =1;
row:=1;
c: =1;
assign(out,OUTPUT_FILE);
rewrite(out);
COUNTER:=2;
writeln ( '-------------—-----K matrix----------------------- ') ;
for i:=1 to 2*NUMBER_JOINT do
begin
if (searc(d,i,d[1] )=1) then c:=0
else c : =1;
if c=1 then
begi n
for j2:=1 to 2*NUMBER_JOINT do
begin
if (searc (d,j2,d[1])<>1) then
begin
retmat[row,col]:=k[i,j2];
col:=col+1;
if col > 2*NUMBER JOINT-d[1] then
begin
row:=row+l;
col : =1;
end;
end;
end;
end;
end;
writeln(out);
writeln;
close (out);
for i:=1 to 2*NUMBER_JOINT-d[1] do
begin
for i2:=1 to 2*NUMBER_JOINT-d[1] do
begin
write(retmat [i,i2]:7:2, '  ') ;
end;
writeln;
end;
end;
{*****************************************************}
procedure pgenerator(var p:ar;delmat:aj2) ;
var
k,i,f:integer;
temp:array [1..2*MAXCIMUM_JOINT+1] of real ;
retmat:array [1..2*MAXCIMUM_JOINT+1] of integer;
begin
k: =1;
for i:=1 to NUMBER_JOINT do
begin
temp[k]:=JOINT_RECORD[i].px;
k:=k+1;
temp[k]:=JOINT_RECORD[i].py;
k:=k+1;
 
end;
k:=1;
readln;
retmat[1]:=0;
for i:=1 to 2*1MUMBER_JOINT-1 do
begin
if (searc(delmat,i,delmat[1] )=0) then
begin
k:=k+1;
retmat[k]:=round(temp[i] ) ;
retmat[1]:=retmat[1]+1;
end;
end;
for f:=1 to retmat [1]+1 do
begin
P[f]: =retmat[f];
end;
end;
{*****************************************************}
procedure choloski(a:an4;var g:anu);
var
k,d:integer;
tempk,tempd:real;
begin
J3:=1;
n2:=n2+1;
g[1,1]:=sqrt(a[1,1]);
i 3:=j3+1;
while (i3<>N2) do
begin
g[i3,1] :=a[i3,1]/g[1,1];
i3:=i3+1;
end;
while(j3<>N2-1) do{while 1}
begin
j3:=j3+1;
tempk:=0;
for k:=1 to j3-1 do
begin
tempk:=tempk+(g[j3,k]*g[j3,k]);
end;
g[J3,j3] :=sqrt(a[j3,j3]-tempk) ;
i3:=j3+1;
while(i3<>N2 ) do {2}
begin
tempd:=0;
for d:=1 to j3 do
begin
tempd:=tempd+(g[i 3,d]*g[j 3,d])
end;
g[i3,j3] :=(a[i3,j3]-tempd)/g[j3,j3] ;
i3:=i3+1;
end;
end;
end;
{*****************************************************}
 
procedure nmajhol (var g:anu;var y:nuu);
var
i, k: integer;
dtemp:real;
begin
dtemp:=0.0;
y[2]:=(bx[2]) / (g[1,1]);
for i:=2 to round(n2) - 1 do
begin
for k:=1 to i-1 do
begin
dtemp:=dtemp+(g[i, k]*y[k+1]);
end;
y[i+1]:=(bx[i+1]-dtemp)/g[i,i] ;
dtemp:=0.0;
end;
end;
{*****************************************************}
procedure xmajhol (g:anu;var yz:nuu;var x:nuu);
var
i , k: integer;
dtemp:real;
begin
dtemp:=0.0;
n:=round(n2) ;
x[N] :=(yz[N]) / (g[N-1,N-1]);
for i:=N-1 downto 1 do
begin
for k:=N-1 downto i+1 do
begin
dtemp:=dtemp+(g[k,i]*x[k+1]);
end;
x[i+1] : = (yz [i+1] -dtemp) /g[i,i] ;
dtemp:=0.0;
end;
end;
{*****************************************************}
procedure setxmat(del:aj2;var mx:nuu);
var
temp:array [1..LENGHT_MATRIS]of real;
c,i:integer;
begin
c:=2;
for i:=1 to 2*NUMBER_JOINT do
temp[i]:=14.14;
for i:=2 to del[1]+1 do
temp[del[i]]:=0.0;
for  i:=1 to 2*NUMBER_JOINT do
begin
if (temp[i]<>0.00) then
begin
temp[i] :=mx[c] ;
c:=c+1;
end;
end;
for i:=1 to 2*NUMBER JOINT do
 
mx[i] : =temp [i] ;
end;
{*****************************************************}
procedure calc_distans_plain(p:pk;x:nuu) ;
var
i:integer;
begin
p^.distans[1] =x[2*(p^. i )-1] ;
p^.distans[2] =x[2*(p^.i)] ;
p^.distans[3] =x[2*(p^.j)-1] ;
p^.distans[4] =x[2*(p^.j)];
p^.distans[5] =x[2*(p^.m)-1] ;
p^.distans[6] =x[2*(p^ .m)] ;
readln;
writeln('distans') ;
for i : =1 to 6 do
writeln(p^.distans [i]:10:10);
end;
{*****************************************************}
procedure calc_stress_plain(p:pk);
var
tempc:ak;
tempb:ak;
begin
calc_b(p^,JOINT_RECORD);
multiply3(MATRIC_D,b,tempb);
multiply4(tempb,p^.distans,p^.t);
readln;
end;
{*****************************************************}
begin
INPUT_NUMBER_TO_PROGRAM;
DISPLAY_ON_FILEINPUT;
writeln('Enter E: ',E);
writeln('Enter v: ',v);
writeln('Enter t: ',t);
writeln('Enter Number of Nods : ' ,numjoint);
calc_d(E, V);
readln;
for k:=1 to numjoint do
writeln ('Node',i, '(X,Y,Px,Py) : ',temp[i] ,temp[j] ,temp[Px] ,temp[Py]);
writeln ('Enter Number of Elements :',aj);
wriletn ( 'Element', PLAIN-RECORD [i 3] ,':', k[q ,w,e]);
writeln ('Enter suports:' , suport [aj3]);
writeln ('(f:Fixsuport. r:Ruol suport) ');
calc_all_k_plain;
assign(fi,'ali,txt');
rewrite(fi);
Kgenerator;
readln;
for i3:=1 to 2*numjoint do
begin
for j3:=1 to 2*numjoint do
write(fi,K[i3,j3]:7:3,'  ');
wriletln(fi);
 
end;








انجام پایان نامه

انجام پایان نامه کامپیوتر، انجام پایان نامه ارشد کامپیوتر، انجام پایان نامه، پایان نامه

برای دیدن ادامه مطلب از لینک زیر استفاده نمایید

 دانلود مقاله | انجام پایان نامه

سفارش پایان نامه