ЭВМ и химия

ЭВМ и химия. Раздел содержит программы для 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;

Uk:=R*T*B;

Ue:=0;

Us:=Up+Uv+Uk+Ue;

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;

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;

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;

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.