|
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: 7680 (0x1e00)
Types: TextFile
Names: »burffttxt«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »burffttxt«
burfft=set 1
scope day burfft
burfft=algol
program for fft transformation of experimental m6800 analog data
29 02 80 17 00 00
fpinit: source. test.false channel. timeb.0 timed.0 m.
jump.1 plotter. bextr.false mode.log
begin
integer n,m,jump,i,ndata,idata,ch,nch,chl,chh,mv,mvmin,mvmax,
date,clock,mode,nunit,p,nave;
real r,g,dt,timeb,timed,timel,timee,timeunit,gmin,gmax,sigmag;
boolean bextr,test;
integer field inf;
real array BSAREA,DAREA,PLNAME(1:3),MODE(1:2);
zone DATA(128,1,stderror);
integer procedure inreca(idata);
integer idata;
begin
own integer oidata,datap;
inreca:= 0;
if idata<oidata then
begin setposition(DATA,0,0); inrec(DATA,4);
datap:= 0; oidata:= 0 end;
datap:= datap-idata+oidata;
oidata:= idata;
l1:if datap<0 then
begin inrec(DATA,1); datap:= datap+3; goto l1 end;
mv:= DATA(1) shift(-16*datap)extract 16;
if mv shift(-14)<>3 then
begin inreca:= -1; goto endd end;
mv:= if mv shift(-13)extract 1=0 then
mv extract 12 else -(mv extract 12);
endd:
end;
readbfp(<:test:>,test,false);
if -,readsfp(<:source:>,BSAREA,<: :>) then
begin write(out,"nl",1,<:source area name = :>);
setposition(out,0,0); readstring(in,BSAREA,1) end;
open(DATA,4,string inc(BSAREA),0);
inrec(DATA,4);
for inf:= 2 step 2 until 14 do
case inf//2 of
begin
if DATA.inf<>1 shift 5+1 then alarm(<:no data present:>);
begin chl:= DATA.inf extract 3;
chh:= DATA.inf shift(-3)extract 3 end;
ndata:= DATA.inf+1;
dt:= (DATA.inf+1)*2/1000000;
dt:= dt*(DATA.inf+1)*2;
date:= DATA.inf;
clock:= DATA.inf;
end;
write(out,"nl",1,<:time of experiment = :>,
<< dd dd dd>,date,clock,
"nl",1,<:channel limits = :>,<<d>,chl,<: - :>,chh,
"nl",1,<:number of datapoints = :>,ndata,
"nl",1,<:timeinterval = :>,<<d.dd>,dt,
"nl",1,<:maxtime = :>,ndata*dt);
setposition(out,0,0);
if -,readifp(<:channel:>,ch,0) then ch:=readi(<:channel:>);
nch:= chh-chl+1;
nave:= 0;
readrfp(<:timeb:>,timeb,0);
readrfp(<:timed:>,timed,0);
readbfp(<:bextr:>,bextr,false);
if bextr then
begin mvmin:= 4097; mvmax:= -4097;
for idata:= ch-chl+1 step nch until ndata do
begin inreca(idata);
if mv>mvmax then mvmax:= mv;
if mv<mvmin then mvmin:= mv;
end;
write(out,"nl",1,<<-dddd>,<: mvmin = :>,mvmin,
<: mvmax = :>,mvmax);
end;
if -,readifp(<:m:>,m,0) then m:= readi(<:m:>); n:= 2**m;
readifp(<:jump:>,jump,1);
readsfp(<:mode:>,MODE,<: :>);
begin
real array G(0:n/2);
begin
integer array TAIL(1:10);
close(DATA,true);
cleararray(TAIL); TAIL(1):= 1+entier(n/256);
generaten(DAREA);
createentry(DAREA,TAIL);
open(DATA,4,string inc(DAREA),0);
p:= 0;
for i:= 0 step 1 until n/2 do
begin outrec(DATA,1); DATA(1):= 0; end;
close(DATA,true);
end;
timel:= n*dt*nch*jump; sigmag:= 0;
for timeb:= timeb, timeb+timed while timed>0 and
timeb+timel<ndata*dt do
begin
open(DATA,4,string inc(BSAREA),0); inrec(DATA,4);
idata:= round(timeb/dt/nch)*nch+ch-chl+1;
timeb:= (idata-1)*dt; timee:= timeb+n*dt*nch*jump;
r:= 0; i:= 0;
for inf:= 0 step 2 until 2*n-2 do
begin
if idata<=ndata then
begin inreca(idata); G.inf:= mv; r:= r+mv; i:= i+1 end
else G.inf:= r/i;
idata:= idata+nch*jump;
end;
close(DATA,true);
if test then
for inf:= 0 step 2 until 2*n-2 do write(out,"nl",1,G.inf);
r:= 0;
for inf:= 0 step 2 until 2*n-2 do r:= r+G.inf;
r:= r/n;
for inf:= 0 step 2 until 2*n-2 do G.inf:= G.inf-r;
for i:= 0 step 1 until n*0.1-1 do
begin
r:= sin((i+1)*5*pi/n)**2;
inf:= 2*i;
G.inf:= G.inf*r;
inf:= (n-i-1)*2;
G.inf:= G.inf*r;
end hanning window;
fftipowa(m,G);
if test then
begin p:= 0;
for i:= 0 step 1 until n/2 do
begin write(out,"nl",1,G(p)); p:= n/2-p+(i extract 1) end;
end;
for i:= 0 step 1 until n/2 do
G(i):= 2*(nch*dt*jump)*G(i)/0.875;
if bextr then
begin
gmin:= gmax:= G(0);
for i:= 1 step 1 until n/2 do
begin if G(i)>gmax then gmax:= G(i);
if G(i)<gmin then gmin:= G(i);
end;
write(out,"nl",1,<:gmin = :>,gmin,<: gmax = :>,gmax);
end;
open(DATA,4,string inc(DAREA),0);
p:= 0;
for i:= 0 step 1 until n/2 do
begin swoprec(DATA,1); DATA(1):= DATA(1)+G(p);
sigmag:= sigmag+G(p); p:= n/2-p+(i extract 1); end;
nave:= nave+1; close(DATA,true);
end timeb;
end fft;
if -,readsfp(<:plotter:>,PLNAME,<: :>) then goto lend;
i:=1;
setplotname(string PLNAME(increase(i)),0);
nunit:= 16;
if MODE(1)=real <:cum:> then
begin plotform(0,nunit+3,14);
setmargin(2,13);
writeplot(<:<12><14>S<15>G(<14>n<15>):>,"sp",10,
<< dd dd dd>,date,clock);
writeplot(<<d>,<:<10> time (:>,round timeb,<:,:>,
round timee,<:) n = :>,n,
<: <14>S<15>G = :>,<<d.d'd>,sigmag);
plotsubform(0,nunit+3,0,12,false);
setcoor(2,0,0.005,1,0,.1);
plotframe(0.0,0.0);
open(DATA,4,string inc(DAREA),0);
inrec(DATA,1); g:= DATA(1);
plotmove(0,g/nave/sigmag); pendown;
for i:= 1 step 1 until n/2 do
begin
r:= i/(dt*nch*jump*n); if r>0.005*nunit then goto lptc;
inrec(DATA,1); g:= g+DATA(1);
plotmove(r,g/nave/sigmag);
end;
end else
if MODE(1)=real<:lin:> then
begin plotform(0,nunit+3,12);
setmargin(2,11);
writeplot(<:<12>G(<14>n<15>):>,"sp",10,
<< dd dd dd>,date,clock);
writeplot(<<d>,<:<10> time(:>,round timeb,<:,:>,
round timee,<:) n = :>,n);
plotsubform(0,nunit+3,0,10,false);
plotautcoor(0,0.08,0,gmax);
open(DATA,4,string inc(DAREA),0);
inrec(DATA,1);
plotmove(0,DATA(1)/nave); pendown;
for i:=1 step 1 until n/2 do
begin
r:=i/(dt*nch*jump*n);
if r>0.005*nunit then goto lptc;
inrec(DATA,1);
plotmove(r,DATA(1));
end;
end else
begin
plotform(0,nunit+3,12);
setmargin(2,11);
writeplot(<:<12>log G(<14>n<15>):>,"sp",10,
<< dd dd dd>,date,clock);
writeplot(<<d>,<:<10> time (:>,round timeb,<:,:>,round timee,
<:) n = :>,n);
plotsubform(0,nunit+3,0,10,false);
setcoor(2,0,0.005,1,0,1);
plotframe(0.0,0.0);
open(DATA,4,string inc(DAREA),0);
inrec(DATA,1);
plotmove(0,ln(DATA(1)/nave)/ln(10)); pendown;
for i:= 1 step 1 until n/2 do
begin
r:= i/(dt*nch*jump*n); if r>0.005*nunit then goto lptc;
inrec(DATA,1);
plotmove(r,if DATA(1)>0 then ln(DATA(1)/nave)/ln(10) else 0);
end;
end mode;
lptc:penup;
plotclose;
lend:close(DATA,true);
end
▶EOF◀