ЭВМ и химия. Раздел содержит программы для Turbo Pascal.
Единственное, что
нужно – создать файл данных.
Так как вариантов
куча, то мы воздержимся от его написания. Дерзайте…
Программа 1. Молекулярно-статистические и
термодинамические величины для двухатомных идеальных
газов
{$N+,E+}
program
Oxygen;
const
hpl=6.63E-34;
c=3E8;
pi=3.14;
k=1.38E-23;
R=8.31;
Na=6.02E23;
var
Up,Uv,Uk,Ue,Us,Hp,Hv,Hk,He,Hs,Cvp,Cvv,Cvk,Cve,Cvs,Cpp,Cpv,Cpk,Cpe,Cps,Sp,Sv,
Sk,Se,Ss,Fp,Fv,Fk,Fe,Fs,Gp,Gv,Gk,Ge,Gs,A,B,m,m1,m2,I,I1,I2,X,p,w,rad,sigma,
tetta,tetta1,g0:
real;
dat,res:
text;
t,t1,t2,dt,j:
integer;
Begin
assign (dat,'h:\temp\nx-303\alex\alexey1.dat');
assign (res,'h:\temp\nx-303\alex\alexey1.res');
reset (dat);
rewrite (res);
readln (dat,t1,t2,dt,m1,m2,g0,p,rad,w,sigma);
m:=m1/1000+m2/1000;
t:=t1;
for j:=1 to 4
do
begin
A:=(SQRT(2*pi*m)/hpl)*(3*exp(2.5*ln(k*T))/p);
{I:=m1*m2*rad*rad/(m1+m2);}
I1:=m1*rad/(m1+m2);
I2:=m2*rad;
tetta:=hpl*hpl/(8*pi*I1*I2*k);
X:=c*hpl*w/(k*T);
B:=X/(exp(x)-1);
Up:=1.5*R*T;
Uv:=R*T;
Ue:=0;
Us:=Up+Uv+
Hp:=2.5*R*T;
Hv:=R*T;
Hk:=R*T*B;
He:=0;
Hs:=Hp+Hv+Hk+He;
Cvp:=1.5*R;
Cvv:=R;
Cvk:=R*B*B*exp(x);
Cve:=0;
Cvs:=Cvp+Cvv+Cvk+Cve;
Cpp:=2.5*R;
Cpv:=R;
Cpk:=R*B*B*exp(x);
Cpe:=0;
Cps:=Cpp+Cpv+Cpk+Cpe;
Sp:=R*(Ln(A)+2.5);
Sv:=R*Ln(2.7*T/sigma*tetta);
Sk:=R*(B-Ln(1-(EXP(-X))));
Se:=R*Ln(g0);
Ss:=Sp+Sv+Sk+Se;
Fp:=-R*T*LN(A*2.7);
Fv:=-R*T*LN(T/sigma*tetta);
Fk:=R*T*LN(1-exp(-x));
Fe:=-R*T*LN(g0);
Fs:=Fp+Fv+Fk+Fe;
Gp:=-R*T*LN(A);
Gv:=-R*T*LN(T/sigma*tetta);
Gk:=R*T*LN(1-exp(-x));
Ge:=-R*T*LN(g0);
Gs:=Gp+Gv+Gk+Ge;
writeln
(res,'U',Up:11,' ',Uv:11,' ',Uk:11,' ',Ue:11);
writeln
(res,'H',Hp:11,' ',Hv:11,' ',Hk:11,' ',He:11);
writeln
(res,'Cv',Cvp:11,' ',Cvv:11,' ',Cvk:11,' ',Cve:11);
writeln
(res,'Cp',Cpp:11,' ',Cpv:11,' ',Cpk:11,' ',Cpe:11);
writeln
(res,'S',Sp:11,' ',Sv:11,' ',Sk:11,' ',Se:11);
writeln
(res,'F',Fp:11,' ',Fv:11,' ',Fk:11,' ',Fe:11);
writeln
(res,'G',Gp:11,' ',Gv:11,' ',Gk:11,' ',Ge:11);
writeln
(res,'Us=',Us:11);
writeln
(res,'Hs=',Hs:11);
writeln
(res,'Cvs=',Cvs:11);
writeln
(res,'Cps=',Cps:11);
writeln
(res,'Fs=',Fs:11);
writeln
(res,'Gs=',Gs:11);
t:=t+dt;
end;
close (dat);
close (res);
end.
Программа 2. Метод наименьших квадратов (МНК)
program MNK;
uses matrix;
const
k=10;
type
vectype=array
[1..k] of real;
mattype=array
[1..k,1..k] of real;
var
ATWAF,FOBR:tnmatrix;
d:byte;
dat,res:text;
w,atwy,teta,xexp,yexp,xlin,ylin,yreg:vectype;
A,AT,AD,ATW,FOB,ADAT,ATWA,DIS:mattype;
s,sig2,tan,delta,yleft,yright:real;
i,j,n,m:integer;
procedure strm (n:integer; xexp,yexp:vectype; var
xlin,ylin:vectype;
var
A:mattype);
begin
for i:=1
to n do begin
ylin[i]:=yexp[i];
ylin[i]:=xexp[i];
A[i,1]:=1;
A[i,2]:=xlin[i];
end;
end;
procedure multw (l1,l2:integer; matA:mattype;
w:vectype; var c:mattype);
begin
for i:=1
to l2 do
for j:=1
to l1 do c[i,j]:=matA[i,j]*w[j];
end;
procedure multvec (l1,l2:integer; matA:mattype;
b:vectype; var c:vectype);
begin
for i:=1
to l1 do begin
s:=0;
for j:=1 to l2 do begin
s:=s+matA[i,j]*b[j]; end;
c[i]:=s;
end;
end;
procedure multm (l1,l2,l3:integer; A,B:mattype; var
c:mattype);
var
k:integer;
begin
for i:=1
to l1 do
for j:=1
to l3 do begin
s:=0;
for k:=1
to l2 do s:=s+A[i,k]*B[k,j];
c[i,j]:=s;
end;
end;
begin
assign
(dat,'c:\alexey2.dat');
assign
(res,'c:\alexey2.res');
reset
(dat);
rewrite
(res);
readln
(dat,n,m,tan);
for i:=1
to n do readln (dat,xexp[i],yexp[i],w[i]);
strm
(n,xexp,yexp,xlin,ylin,A);
for i:=1
to m do
for j:=1
to n do AT[i,j]:=A[i,j];
multw
(n,m,AT,w,ATW);
multvec
(m,n,ATW,ylin,atwy);
multm
(m,n,m,ATW,A,ATWA);
for i:=1
to m do
for j:=1
to m do ATWAF[i,j]:=ATWA[i,j];
inverse
(m,ATWAF,FOBR,d);
for i:=1
to m do
for j:=1
to m do FOB[i,j]:=FOBR[i,j];
multvec
(m,m,FOB,ATWY,teta);
multvec
(n,m,A,teta,yreg);
s:=0;
for i:=1
to n do s:=s+ sqr(ylin[i]-yreg[i]*W[i]);
sig2:=s/(n-m);
for i:=1
to m do
for j:=1
to m do DIS[i,j]:=sig2*FOB[i,j];
multm
(n,m,m,A,DIS,AD);
multm
(n,m,n,AD,AT,ADAT);
for i:=1
to n do begin
delta:=sqrt(ADAT[i,j]*tan);
yleft:=yreg[i]-delta;
yright:=yreg[i]+delta;
end;
writeln
(res,' ');
writeln
(res,'n=',n,' d=',d,' m=',m,'
tan=',tan:10);
writeln
(res,' xexp yexp xlin ylin');
for i:=1
to n do writeln (res,xexp[i]:12:6,yexp[i]:12:6,xlin[i]:12:6,ylin[i]:12:6);
writeln
(res,' ');
writeln
(res,' xlin yreg yleft yright');
for i:=1
to n do writeln (res,xlin[i]:12:6,yreg[i]:12:6,yleft:12:6,yright:12:6);
writeln
(res,' ');
writeln
(res,' teta1 teta2');
for i:=1
to m do write (res,teta[i]:7:3);
close (dat);
close (res);
end.