|
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: 9216 (0x2400)
Types: TextFile
Names: »chmardemotx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »chmardemotx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »chmardemotx«
chmar=algol list.no
program for demonstration of chemical kinetics as a markov process
fp: nmol.20 npl.30 ns.10 bplot.true test1.false test2.false
plotter.(standard)
23 02 81 18 00 00
begin
integer ntext,nmol,npl,ns,s;
boolean bplot,test1,test2;
real array PLOTTER(1:2);
readifp(<:ntext:>,ntext,100);
readifp(<:nmol:>,nmol,20);
readifp(<:npl:>,npl,30);
readifp(<:ns:>,ns,10);
readbfp(<:bplot:>,bplot,true);
readbfp(<:test1:>,test1,false);
readbfp(<:test2:>,test2,false);
if readsfp(<:plotter:>,PLOTTER,<::>) then
begin s:= 1; setplotname(string PLOTTER(increase(s)),0) end;
begin
integer mi,mn,ri,rn,vki,n,r;
integer array V,K(1:ntext),MOL,REA(1:nmol);
procedure writevkmr;
begin
integer i;
write(out,<:<10> V , K:>);
for i:= 1 step 1 until vki do
write(out,<:<10>:>,<< ddddddd>,V(i),<< d>,K(i));
write(out,<:<10>MOL:>);
for i:= 1 step 1 until mn do
write(out,<< d>,MOL(i));
write(out,<:<10>REA:>);
for i:= 1 step 1 until rn do
write(out,<< d>,REA(i));
end;
procedure syntaxerror;
begin write(out,<:<10>syntax error:>);
if test1 then write(out,
<:<10>vki = :>,vki,<: mn = :>,mn,<: rn = :>,rn);
if test1 then writevkmr;
alarm(<:<10>error:>,0);
end;
integer procedure searchmol(a);
integer a;
begin integer i,mi;
boolean found,comp;
found:= false; searchmol:= 0;
mi:= 0;
for mi:= mi+1 while MOL(mi)>0 and -,found do
begin
comp:= true;
for i:= 0,i+1 while K(a+i)=6 and K(MOL(mi)+i)=6 do
if V(a+i)<>V(MOL(mi)+i) then comp:= false;
if comp then
begin found:= true; searchmol:= mi end;
end
end;
begin
integer i;
integer array alfabet(0:255);
for i:= 0 step 1 until 9, 11 step 1 until 24,
26 step 1 until 42, 44, 46, 47, 58, 59, 60, 61,
63, 64, 94, 95, 96, 126 step 1 until 255 do
alfabet(i):= i;
for i:= 48 step 1 until 57 do alfabet(i):= 2 shift 12+i;
for i:= 65 step 1 until 93, 97 step 1 until 125 do
alfabet(i):= 6 shift 12 + i;
for i:= 10, 43, 45, 62 do alfabet(i):= 7 shift 12 + i;
alfabet(25):= 8 shift 12 + 25;
intable(alfabet);
write(out,<:reactions<10>:>); setposition(out,0,0);
i:= readall(in,V,K,1);
if i<0 then alarm(<:textbuf size:>,i);
intable(0);
end;
mn:= rn:= 1; vki:= 1;
cleararray(MOL); cleararray(REA);
REA(1):= 1;
if -,(V(1)=10 or K(1)=2 or K(1)=6 or V(1)=45) then
syntaxerror;
for vki:= vki while -,K(vki)=8 do
if K(vki)=2 and K(vki+1)=6 then
vki:= vki+1 else
if K(vki)=6 then
begin
if searchmol(vki)=0 then
begin MOL(mn):= vki; mn:= mn+1 end;
for vki:= vki+1 while K(vki)=6 do;
if V(vki)=62 and K(vki)<>7 and K(vki)<>8 then
syntaxerror;
end else
if V(vki)=10 and V(vki+1)=10 then vki:= vki+1 else
if V(vki)=10 and
(K(vki+1)=2 or K(vki+1)=6 or K(vki+1)=8 or V(vki+1)=45) then
begin vki:= vki+1; REA(rn):= vki end else
if V(vki)=43 and (K(vki+1)=2 or K(vki+1)=6) then
vki:= vki+1 else
if V(vki)=45 and V(vki+1)=62 and
(K(vki+2)=2 or K(vki+2)=6
or V(vki+2)=10 or K(vki+2)=8) then
begin rn:= rn+1; vki:= vki+2; REA(rn):= vki end else
syntaxerror;
n:= mn:= mn-1; r:= rn:= rn-1;
begin
integer ran,rant,i,rho,ny,ni,nm,jpl,mfac;
real t,tm,xm,g,v,h;
boolean test,bfinal,reactants;
integer array X(1:n),N,R(1:n,1:r),PLX(1:n,0:npl);
real array G,E,F(1:r),C(1:n),PLT(0:npl);
real array field f;
procedure operator;
begin if opkey then
begin outpl;
bfinal:= readb(<:stop:>);
if -,bfinal then test:=readb(<:test:>);
end
end;
procedure outpl;
begin integer i,j;
if bplot then
begin
for i:= 1 step 1 until n do
begin plotmove(PLT(0),PLX(i,0)/v); pendown;
for j:= 1 step 1 until jpl-1 do
plotmove(PLT(j),PLX(i,j)/v);
penup;
end;
plotend;
PLT(0):= PLT(npl);
for i:= 1 step 1 until n do
PLX(i,0):= PLX(i,npl);
end bplot;
jpl:= 1;
end;
procedure writex;
begin integer i;
write(out,<:<10>:>,<<dd.d00'-d>,t,<: :>);
for i:= 1 step 1 until n do
write(out,<< dddd>,X(i)); setposition(out,0,0);
if opkey then test:= false;
end;
procedure writern;
begin write(out,<:<10><10>R:>);
for mi:= 1 step 1 until mn do
begin write(out,<:<10>:>);
for ri:= 1 step 1 until rn do
write(out,<< d>,R(mi,ri)) end;
write(out,<:<10><10>N:>);
for mi:= 1 step 1 until mn do
begin write(out,<:<10>:>);
for ri:= 1 step 1 until rn do
write(out,<< d>,N(mi,ri)) end;
end;
procedure plotnew;
begin
tm:= readr(<:maximal time:>);
if bplot then
begin
xm:= readr(<:maximal concentration:>);
plotform(0,15,10);
scalexcoor(0,tm,2,15-0.5);
scaleycoor(0,xm,1,10-2.5);
plotframe(0.0,0.0);
plotend;
end bplot;
end;
procedure concentrations;
begin write(out,<:<10>start concentrations<10><10>:>);
for mi:= 1 step 1 until mn do
begin f:= 2*MOL(mi)-2; mfac:= 1;
write(out,string V.f(increase(mfac)),<: = :>);
setposition(out,0,0); read(in,C(mi)); end;
end;
procedure rates;
begin write(out,<:<10>reaction rates<10><10>:>);
for ri:= 1 step 1 until rn do
begin
write(out,<<dd>,ri,<:: :>);
setposition(out,0,0); read(in,E(ri)); end;
end;
cleararray(N); cleararray(R);
for ri:= 1 step 1 until rn do
begin vki:= REA(ri); mfac:= 1; reactants:= true;
for vki:= vki while -,(K(vki)=8 or V(vki)=10
or(V(vki)=45 and -,reactants)) do
if K(vki)=2 then
begin mfac:= V(vki); vki:= vki+1 end else
if K(vki)=6 then
begin mi:= searchmol(vki);
if reactants then R(mi,ri):= R(mi,ri)+mfac else
N(mi,ri):= N(mi,ri)+mfac;
mfac:= 1; for vki:= vki+1 while K(vki)=6 do;
end else
if V(vki)=43 then vki:= vki+1 else
if V(vki)=45 then
begin reactants:= false; vki:= vki+2 end else
begin write(out,<:<10>programerror:>);
writern; alarm(<:<10>error:>,0); end;
end;
if test1 then begin writevkmr; writern end;
for mi:= 1 step 1 until mn do
for ri:= 1 step 1 until rn do
N(mi,ri):= N(mi,ri)-R(mi,ri);
bfinal:= false;
if bplot then test:= false else test:= true;
if test2 then writern;
rates;
concentrations;
v:= readr(<:volume:>);
plotnew;
l:for ny:= 1 step 1 until n do
X(ny):= v*C(ny);
for rho:= 1 step 1 until r do
begin h:= 0;
for ny:= 1 step 1 until n do
h:= h+R(ny,rho);
F(rho):= E(rho)/v**(h-1) end;
ran:= getclock extract 12;
rant:= getclock extract 24;
PLT(0):= t:= 0; jpl:= 1;
for ny:= 1 step 1 until n do PLX(ny,0):= X(ny);
for ni:= 0,ni+1 while t<tm and -,bfinal do
begin
if ni mod ns=0 then
begin PLT(jpl):= t;
for ny:= 1 step 1 until n do PLX(ny,jpl):= X(ny);
jpl:= jpl+1;
if jpl>npl then outpl;
if test then writex;
end;
if ni mod 1000 = 0 then operator;
for rho:= 1 step 1 until r do
begin G(rho):= F(rho);
for ny:= 1 step 1 until n do
if R(ny,rho)=0 then else
if R(ny,rho)=1 then G(rho):= G(rho)*X(ny) else
if R(ny,rho)=2 then G(rho):= G(rho)*X(ny)*(X(ny)-1) else
for i:= R(ny,rho)-1 step -1 until 0 do
G(rho):= G(rho)*(X(ny)-i);
end;
g:= 0; for rho:= 1 step 1 until r do g:= g+G(rho);
h:= random(rant);
if g>0 and h>0 then begin t:= t-1/g*ln(h);
g:= g*random(ran);
rho:= r;
for g:= g-G(rho) while g>0 do rho:= rho-1;
for ny:= 1 step 1 until n do
X(ny):= X(ny)+N(ny,rho) end else
begin bfinal:=true; t:= tm end;
end;
PLT(jpl):= t;
for ny:= 1 step 1 until n do PLX(ny,jpl):= X(ny);
jpl:= jpl+1;
outpl;
if -,readb(<:end:>) then
begin
if readb(<:new start concentrations:>) then concentrations;
if readb(<:new reaction rates:>) then rates;
if readb(<:new volume:>) then v:= readr(<:volume:>);
if readb(<:new plot:>) and bplot then plotnew;
bfinal:= false;
goto l;
end;
lend:outpl;
if bplot then plotclose;
end;
end;
end
▶EOF◀