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

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.

Сайт управляется системой uCoz