|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 4608 (0x1200)
Types: TextFile
Names: »gok3«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦1248b0c55⟧ »gobib«
└─⟦this⟧
;kemlab5 1
k3prg=set 50
permanent k3prg.15
k3prg=algol list.no
begin
integer i,j,k,n,J,Jmin,Jmax;
real kT,torr,dny,my,JJ,B,D,c,p,q,s;
boolean nl,sp,cd,mhz;
array head(1:12);
nl:=false add 10; sp:= false add 32; c:=29979.25;
readhead(in,head,1); read(in,n);
begin
array mass(1:n), r(2:n);
if atomic(mass,n) then goto stop;
read(in,r,Jmin,Jmax,kT,torr,dny,my); i:=1;
write(out,<:<12>:>,nl,3,string head(increase(i)),nl,3,
<:Atomic masses (uÅ**2)::>,nl,1);
for i:=1 step 1 until n do write(out,<<dddd.dddddd>,mass(i));
write(out,nl,2,<:Distances (Å)::>,nl,1);
for i:=2 step 1 until n do begin
write(out,<<dddd.dddddd>,r(i));
if i>2 then r(i):=r(i)+r(i-1)
end;
p:=sum(mass(i),i,1,n);
q:=sum(mass(i)*r(i),i,2,n);
p:=sum(mass(i)*r(i)*r(i),i,2,n)-q*q/p;
B:=16.8575/p;
write(out,nl,2,<:Moment of Inertia (uÅ**2) ::>,<<ddd.dddddd>,p,
nl,1,<:Rotational Constant (1/cm)::>,B,<<dddddd.000>,
nl,1,<: " " (MHz) ::>,B*c);
cd:= n=2; q:=0;
if cd then read(in,q);
cd:= q<>0;
if cd then begin real ny2;
ny2:=q*1.69737'6*(mass(1)+mass(2))/(mass(1)*mass(2));
D:=B**3*4/ny2;
write(out,nl,2,<:Force constant (mdyn/Å): :>,<<dd.ddd>,q,
nl,1,<:Vib. Frequency (1/cm) : :>,<<dddd.d>,sqrt(ny2),
nl,1,<:C.D. Constant (1/cm) : :>,<<d.dd'-d>,D,
nl,1,<: " " (MHz) : :>,<<ddd.000>,D*c)
end else D:= 0;
JJ:=(Jmax+1)*Jmax;
mhz:=(-D*JJ+B)*JJ*c<'6;
q:=real(if mhz then <:MHz :> else <:1/cm:>);
write(out,nl,3,<: J E(J),:>,string q);
if cd then write(out,<: C.D.,:>,string q);
write(out,<: Rel.Pop.(:>,<<ddd>,kT,<: K):>,nl,1);
kT:=kT*0.69503;
for J:=Jmin step 1 until Jmax do begin
JJ:=(J+1)*J; q:=-D*JJ*JJ; p:=B*JJ+q;
write(out,nl,1,<< ddd>,J,sp,7,<<dddddd.dd>,
if mhz then p*c else p);
if cd then write(out,sp,6,<<-ddd.dd>,if mhz then q*c else q);
write(out,sp,11,<<ddd.dddd>,exp(-p/kT)*(J+J+1))
end;
write(out,nl,3,<:Dipole Moment (Debye)::>,<<dd.dddd>,my,
nl,1,<:Sample Pressure (Torr)::>,<<dddd.ddd>,torr,
nl,1,<:Line Width (1/cm)::>,<< d.dd'-d>,dny,
nl,2,<: J Freq.(J - J+1):>);
if cd then write(out,<: C.D. :>);
write(out,<: Intensity(1/cm):>,nl,1);
q:=0.44475*torr*my*my/(dny*kT*kT);
for J:=Jmin+1 step 1 until Jmax do begin
p:=(-D*J*J*2+B)*J*2; JJ:=(J-1)*J; s:=-4*D*J**3;
write(out,nl,1,<< ddd>,J-1,sp,7,<<dddddd.dd>,
if mhz then p*c else p);
if cd then write(out,sp,6,<<-ddd.dd>,if mhz then s*c else s);
write(out,sp,13,<<d.dd'-dd>,
(1-exp(-p/kT))*exp(-(-D*JJ+B)*JJ/kT)*p*p*q)
end;
if mhz and n>2 then begin real E,a,b,ij,im;
igen: read(in,E); if E=0 then goto stop;
write(out,nl,3,<:Stark-effekt, E= :>,<<dddd>,E,<: V/cm:>,nl,2,
<: J Stark-forskydning M = 0 - J (intensitet):>,nl,1);
s:=(0.503448*my*E)**2/(2*B*c); J:=Jmin;
JJ:=(J+1)*J; p:=(J+J-1)*(J+J+3);
for J:=J step 1 until Jmax-1 do begin
a:=-1/p; b:=if J=0 then 1 else 3/(JJ*p);
JJ:=(J+1)*(J+2); p:=(J+J+1)*(J+J+5);
a:=(a+1/p)*s; b:=(b-3/(JJ*p))*s; write(out,nl,1,<<ddd>,J);
im:=(J+J+1)*(J+J+3); ij:=(J+1)*300/im; im:=-300/((J+1)*im);
for i:=0 step 1 until J do begin
if i//4*4-i=0 and i<>0 then write(out,nl,1,sp,3);
write(out,sp,3,<<-ddd.dd>,a+b*i*i,<: (:>,
if J=0 then <<ddd> else <<dd.d>,
(ij+im*i*i)*(if i=0 then 1 else 2),<:):>);
end end;
goto igen
end;
stop: end end;
k3prg
<H 35-Cl> 2 H 35Cl 1.2839 0 15 300 100 0.5 1.12 4.806
k3prg
<D 35-Cl> 2 D 35Cl 1.2839 0 15 300 100 0.5 1.12 4.806
k3prg
<H 79Br> 2 H 79Br 1.424 0 15 300 100 0.5 0.828 3.840
k3prg
<D 79Br> 2 D 79Br 1.424 0 15 300 100 0.5 0.828 3.840
k3prg
<H 127I> 2 H 127I 1.620 0 15 300 100 0.5 0.448 2.929
k3prg
<D 127I> 2 D 127I 1.620 0 15 300 100 0.5 0.448 2.929
k3prg
<D F> 2 D F 0.9232 0 15 300 50 0.5 1.819 8.835
k3prg
<OCS> 3 OCS 1.1647 1.5576 0 8 300 0.01 '-5 0.71 1000 0
k3prg
<18O CS> 3 18O CS 1.1647 1.5576 0 8 300 0.01 '-5 0.71 1000 0
k3prg
<O 13C S> 3 O 13C S 1.1647 1.5576 0 8 300 0.01 '-5 0.71 1000 0
k3prg
<OC 34S> 3 OC 34S 1.1647 1.5576 0 8 300 0.01 '-5 0.71 1000 0
k3prg
<CO> 2 CO 1.1309 0 15 300 100 0.5 0.112 18.71
k3prg
<Cl CN> 3 35Cl CN 1.629 1.163 0 8 300 0.01 '-5 2.8 200 0
k3prg
<37Cl CN> 3 37Cl CN 1.629 1.163 0 8 300 0.01 '-5 2.8 200 0
k3prg
<HCN> 3 HCN 1.068 1.156 0 16 300 100 2 3
k3prg
<OCS> 3 OCS 1.1647 1.5576 0 3 300 0.01 '-5 0.71512 3000 2000 1000 0
k3prg
<15-N2 O> 3 15N 15N O 1.1286 1.1876 0 2 300 0.01 '-5 0.1608 2000 1000 500 0
k3prg
<OC 80-Se> 3 OC 79.916527 1.159 1.709 0 3 300 0.01 '-5 0.753 3000 2000 1000 0
▶EOF◀