|
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: 8448 (0x2100)
Types: TextFile
Names: »chdemotx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »chdemotx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »chdemotx«
clear temp chem
chem=set 200
chem=algol
program for demonstration of chemical kinetics
fp: nmol.20 npl.30 bplot.true test1.false test2.false
plotter.(tek4006b)
17 02 82 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);
readbfp(<:bplot:>,bplot,true);
readbfp(<:test1:>,test1,false);
readbfp(<:test2:>,test2,false);
readsfp(<:plotter:>,PLOTTER,<:tek4006b:>);
s:= 1;
setplotname(string PLOTTER(increase(s)),0);
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>:>); outendcur(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 i,rho,ny,ni,nm,jpl,mfac;
real t,tm,xm,g,h,dt,eps;
boolean test,bfinal,reactants,bb;
integer array N,R(1:n,1:r);
real array G,E,F(1:r),C(1:n),PLT(0:npl),X(1:n),PLX(1:n,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)); pendown;
for j:= 1 step 1 until jpl-1 do
plotmove(PLT(j),PLX(i,j));
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,<< dd.d00'-d>,X(i)); outendcur(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 parameters;
begin
dt:= readr(<:time interval:>);
eps:= readr(<:epsilon:>);
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)),<: = :>);
outendcur(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,<:: :>);
outendcur(0); read(in,F(ri)); end;
end;
procedure v(t,X,Y);
real t;
real array X,Y;
begin
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) else
G(rho):= G(rho)*X(ny)**R(ny,rho);
end;
for ny:= 1 step 1 until n do
begin Y(ny):= 0;
for rho:= 1 step 1 until r do
Y(ny):= Y(ny)+N(ny,rho)*G(rho) 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;
parameters;
plotnew;
l:for ny:= 1 step 1 until n do
X(ny):= C(ny);
PLT(0):= t:= 0; jpl:= 1;
for ny:= 1 step 1 until n do PLX(ny,0):= X(ny);
for t:= t while t<tm and -,bfinal do
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;
rkfifth(v,t,X,t+dt,eps,n,bb);
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 parameters:>) then parameters;
if readb(<:new plot:>) and bplot then plotnew;
bfinal:= false;
goto l;
end;
lend:outpl;
if bplot then plotclose;
end;
end;
end
▶EOF◀