DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »algthermo«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦7e928b248⟧ »algbib« 
            └─⟦this⟧ 

TextFile

;kemlab5 1
thermo=set 50
permanent thermo.15
thermo=algol index.no  
\f


THERMO  DC/PAL  74
begin
comment Program til beregning af thermodynamiske funktioner ud fra
spektroskopiske data

Programmet beregner for givne temperaturer og givet tryk
1) det vibrationelle bidrag til de thermodynamiske funktioner i
   harmonisk-oscillator approximationen. 
2) de totale thermodynamiske funktioner i stiv-rotor-harmonisk -
   oscillator approximationen. 
(Litt.: G. Herzberg, Molecular Spectra and Molecular Structure, II
Kap. 5)

Inputregler:

1) moleculets navn i <>
2) antallet af ikke degenererede normalvibrationer 
   antallet af dobbelt degenererede normalvibrationer 
   antallet af tredobbelt degenererede normalvibrationer 
3) antallet af temperaturer
4) 0 for linæert molecule
   1 for ikke-linæert molecule
5) temperaturer i Kelvin grader
6) normalvibrationsfrekvenser efter stigende degeneration
7) trykket i atm.
8) moleculmasse i u
9) symmetrital (se Herzberg  tabel 140 (p. 508))
10) et tal der angiver i hvilke enheder rotationskonstanterne/
    inertimomenterne er angivet:
    1  for  1/cm        3  for uA**2
    2  for  Mc/s        4  for gcm**2
11) rotationskonstanterne/inertimomenterne;


integer n0,n1,n2,n3,n,t,r,d,u,v,i,j,sigma;
real h,c,k,N,R,pi,atm,cf1,cf2,p,y,y0,y1,y2,y3,y4,A,B,C,M;
array head(1:12);
boolean nl,sp;
h:=6.6256'-27; c:=2.997925'10; k:=1.38054'-16;
N:=6.02252'23; R:=1.98717; pi:=3.1414926536;
atm:=1.01325'6; cf1:=16.8575; cf2:=27.9908'40;

nl:=false add 10; sp:=false add 32; readhead(in,head,1);
read(in,n1,n2,n3,t,r); n0:=n1+n2+n3;
begin
array T(1:t), F(1:4,1:t); read(in,T);
if n0>0 then
begin
array V(1:n0); read(in,V);
for u:=1 step 1 until t do
begin y1:=y3:=y4:=0;
      for v:=1 step 1 until n0 do
      begin d:=if v>n1 then 2 else if v>n1+n2 then 3 else 1;
            y:=h*c*V(v)/k/T(u); y0:=exp(-y);
            y1:=y1-d*ln(1-y0); y2:=d*y*y0/(1-y0);
            y3:=y3+y2*y/(1-y0); y4:=y4+y2;
      end;
      F(1,u):=R*y1; F(2,u):=R*(y4+y1);
      F(3,u):=R*y4; F(4,u):=R*y3;
end;
i:=1; write(out,<:<12>:>,nl,4,<:
Thermodynamiske funktioner for :>,
string head(increase(i)),nl,2,<:
                frekvens        d:>,nl,2);
for v:=1 step 1 until n0 do
begin d:=if v>n1 then 2 else if v>n1+n2 then 3 else 1;
      write(out,sp,4,<<dd>,v,sp,11,<<dddd.d>,V(v),sp,9,
      <<d>,d,nl,1);
end;
read(in,p,M,sigma,n,A);
A:=case n of(A, A*'6/c, cf1/A, cf2/A);
if r=1 then
begin read(in,B,C);
      B:=case n of(B, B*'6/c, cf1/B, cf2/B);
      C:=case n of(C, C*'6/c, cf1/C, cf2/C);
end;
if r=0 then write(out,nl,2,<:Inertimoment        ::>,sp,3,
<<dddd.dddddd>,cf1/A,sp,3,nl,1,<:Rotationskonstant   ::>,sp,3,A);

if r=1 then write(out,nl,2,<:Inertimomenter      ::>,sp,3,
<<dddd.dddddd>,cf1/A,sp,3,cf1/B,sp,3,cf1/C,nl,1,
<:Rotationskonstanter ::>,sp,3,A,sp,3,B,sp,3,C);
write(out,nl,1,<:Moleculmasse        ::>,sp,3,<<dddd.dddddd>,M);
write(out,nl,5,<:
Normalvibrationernes bidrag til de thermodynamiske funktioner
enhed: cal/grad/mol
-------------------------------------------------------------------
T (K)         -(F-Eo)/T           S              H             Cp
-------------------------------------------------------------------
:>);
for u:=1 step 1 until t do
begin write(out,nl,1,<<dddd.dd>,T(u));
      for j:=1 step 1 until 4 do
      write(out,sp,8,<<ddd.ddd>,F(j,u));
end;
write(out,<:
-------------------------------------------------------------------
:>,<:<12>:>,nl,4);
y2:=if r=0 then 7 else 8; y3:=p*atm; y4:=R/2;
y:=if r=0 then 2*ln(k/c/h)-2*ln(A)-2*ln(sigma)
else ln(pi)+3*ln(k/c/h)-ln(A*B*C)-2*ln(sigma);
y0:=3*ln(M*2*pi/N)+5*ln(k)-6*ln(h)-2*ln(y3)+y;
i:=1; write(out,<:
Thermodynamiske funktioner for  :>,
string head(increase(i)),<:
enhed: cal/grad/mol          
tryk:  :>,<<dd.dd>,p,<:  atm:>,<:
-------------------------------------------------------------------
T (K)         -(F-Eo)/T           S          (H-Eo)/T          Cp
-------------------------------------------------------------------
:>);
for u:=1 step 1 until t do
begin write(out,nl,1,<<dddd.dd>,T(u)); y1:=y0+y2*ln(T(u));
      write(out,<<ddd.ddd>,sp,8,F(1,u)+y1*y4,sp,8,
      F(2,u)+(y1+y2)*y4,sp,8,F(3,u)+y2*y4,sp,8,F(4,u)+y2*y4);
end;
write(out,<:
-------------------------------------------------------------------
:>,<:<12>:>);
end; end; end;
▶EOF◀