|
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: »ramindx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »ramindx«
;pal
clear user ramind
ramind=set 1 disc5
scope user ramind
ramind=algol
\f
RAMAN ANALYSE IND
external procedure ramind(nr);
integer nr;
begin
integer i,k,j,t,umax,umin,nc,v,u,u0,a;
long array BS,nspo(1:2); array head(1:12);
integer array D(1:1), Z(1:20), tsp1,tsp2,tspi,tspo,trs,npft(1:10);
integer field fi;
real tmin,tmax,min,max,bmin,bmax,b,p,del,u1,alfa,to,t1;
zone sp1,sp2, spi,spo,zrs(128,1,stderror);
ramng(nr,BS,1); if lookuptail(BS,tspi) <> 0 then
begin write(out,"nl",1,<:***:>,BS,<: unknown:>);
goto slut;
end;
ramng(nr,nspo,2);
lookuptail(<:ramnpf:>,npft); alfa:=npft(9)/1000; t1:=npft(10)/10;
open(spi,4,BS,0); inrec(spi,128);
for j:=1 step 1 until 12 do head(j):=spi(j);
tmin:=tspi(9); tmax:=tspi(10);
p:=1.1904; to:=6361;
b:=tmin*alfa-to-t1-6368*(alfa-1);
bmin:=(entier(b*10+1))*0.1;
bmax:=tmax*alfa-to-t1-6368*(alfa-1);
if lookupentry(<:ramsp1:>) = 0 then removeentry(<:ramsp1:>);
cleararray(tsp1);
tsp1(1):=400;
reservesegm(<:ramsp1:>, tsp1(1)); permentry(<:ramsp1:>,15);
open(sp1,4,<:ramsp1:>,0);
if tspi(8)>0 then setposition(spi,0,1); setposition(sp1,0,2);
t:=0; max:=0; min:=maxinteger;
getzone(spi,Z); redefarray(D,Z(14)+1,256);
for j:=inrec(spi,128) while spi(1) shift (-40) extract 8=0, j do
begin k:=D(1) extract 16;
for j:=1 step 1 until k do
begin outrec(sp1,1);
i:=D(j+1); sp1(1):=i;
end j;
t:=t+k;
end inrec;
tsp1(1):=2 + (t+127)//128;
monitor(44,sp1,15,tsp1);
setposition(sp1,0,2); swoprec(sp1,128);
sp1(1):=sp1(2):=sp1(3):=sp1(4):=sp1(5);
close(spi,true);
write(out,"nl",1,<:fre. int.= :>,<< dddd>,bmin,bmax,<: cm-1:>,
<: r=:>,<< d.dddd>,t/(tmax-tmin)/8.4,"nl",2);
setposition(out,0,0);
if lookupentry(<:ramsp2:>) = 0 then removeentry(<:ramsp2:>);
cleararray(tsp2);
tsp2(1):=400;
reservesegm(<:ramsp2:>, tsp2(1)); permentry(<:ramsp2:>,15);
open(sp2,4,<:ramsp2:>,0); setposition(sp2,0,2); tsp2(1):=2;
setposition(sp1,0,2); inrec(sp1,128);
a:=0; u0:=0;
for k:=0 step 1 until 400 do
begin tsp2(1):=tsp2(1)+1; outrec(sp2,128);
for i:=1 step 1 until 128 do
begin v:=k*128+i;
u:=entier(v/p); if u>=t-1 then goto L1; del:=v/p-u;
if u mod 128=1 and u>10 and u>u0 then
begin a:=a+1; inrec(sp1,128);
end;
u0:=u;
j:=u-a*128; if j<1 then goto B1;
if j=128 then
sp2(i):=sp1(j)
else
sp2(i):=sp1(j)+(sp1(j+1)-sp1(j))*del;
B1: end i;
end k;
L1:
monitor(44,sp2,15,tsp2);
setposition(sp1,0,2); setposition(sp2,0,2);
inrec(sp1,128); swoprec(sp2,128); sp2(1):=sp1(1);
t:=v;
close(sp1,true);
if lookupentry(nspo) = 0 then removeentry(nspo);
cleararray(tspo);
tspo(1):=400;
reservesegm(nspo,tspo(1)); permentry(nspo, 0);
open(spo,4,nspo,0); setposition(spo,0,2); tspo(1):=2;
setposition(sp2,0,2); inrec(sp2,128);
a:=0; u0:=0;
for k:=0 step 1 until 400 do
begin tspo(1):=tspo(1)+1; outrec(spo,128);
for i:=1 step 1 until 128 do
begin v:=k*128+i;
u1:=(bmin+0.1*(v-1)+to+t1+6368*(alfa-1))/alfa;
u:=entier((u1-tmin)*10)+1;
if u>=t then goto L2;
del:=u1*10-entier(u1*10);
u0:=u;
j:=u-a*128;
if j>128 then
begin a:=a+1;
inrec(sp2,128);
j:=1;
end;
if j<1 then goto B2;
if j=128 then
spo(i):=sp2(j)
else
spo(i):=sp2(j)+(sp2(j+1)-sp2(j))*del;
if spo(i)>max then begin max:=spo(i); umax:=v; end else
if spo(i)<min then begin min:=spo(i); umin:=v; end;
B2: end i;
end k;
L2:
monitor(44,spo,15,tspo); close(sp2,true);
setposition(spo,0,0);
outrec(spo,128); for j:=1 step 1 until 128 do spo(j):=-1;
outrec(spo,128); for j:=1 step 1 until 128 do spo(j):=-1;
setposition(spo,0,0); swoprec(spo,128);
spo(1):= tspo(1); spo(2):= v; spo(3):= (tmax-tmin)*8.4;
spo(4):=min; spo(5):=umin;
spo(6):=max; spo(7):=umax;
spo(8):=tmin; spo(9):=tmax; spo(10):=nr;
spo(11):=bmin; spo(12):=bmax;
for j:=1 step 1 until 12 do spo(99+j):=head(j);
close(spo,true); slut: end; end
\f
▶EOF◀