DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦ff4154407⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »epb«

Derivation

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »epb« 
        └─⟦this⟧ »epb« 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »epb« 
        └─⟦this⟧ »epb« 

TextFile

;pal
slet c416.procb
clear procb
beskyt c416.procb.7
procb=algol list.no

Subtraktion af konstant baggrund
external procedure b;
begin
integer i,k,j,t1,t2,t,u,s,s1,s2,ver,m,p;
real bmin,umax,konstant,max,A,B;
integer array sptail(1:10);
array spname(1:2);
zone sp(128,1,stderror);
for i:=1 step 1 until 10 do sptail(i):=0;
write(out,nl,1,<:NAME=:>); writeend; readstring(in,spname,1);
write(out,<:VER=  :>); outend(0); read(in,ver);


m:=case ver of(1,5,5,1,1,2,4,5,1);
case m of begin
begin write(out,<:KONSTANT=:>); setposition(out,0,0); read(in,konstant);
end;
begin write(out,<:s1 s2=:>); setposition(out,0,0); read(in,s1,s2);
end;
begin write(out,<:KONSTANT s1 s2=:>); setposition(out,0,0);
      read(in,konstant,s1,s2);
end;
begin write(out,<:A B=:>); setposition(out,0,0); read(in,A,B);
      B:=exp(B);
end;
begin write(out,<:KONSTANT s=:>); setposition(out,0,0);
      read(in,konstant,s);
end;
end;
open(sp,4,string inc(spname),0);
if monitor(42,sp,0,sptail) <> 0 then begin
  write(out,<:*** :>,string inc(spname),<: unknown:>);
  goto slut;
end;
inrec(sp,128); sptail(1):=sp(1); t:=sp(2);
max:=sp(6); if ver=6 then max:=0;
bmin:=sp(11);
p:=sp(40); if p<0 then p:=10;
s1:=(s1-bmin)*p; s2:=(s2-bmin)*p;
setposition(sp,0,2);
for k:=0 step 1 until sptail(1)-3 do
begin swoprec(sp,128);
      for j:=1 step 1 until 128 do
      begin u:=k*128+j;
            if u<t then begin
            case ver of begin
            begin sp(j):=sp(j)-konstant;
            end;
            begin if u<s then sp(j):=konstant;
            end ver=2;
            begin if u>s then sp(j):=konstant;
            end ver =3;
            begin sp(j):=sp(j)*konstant;
            end ver=4;
            begin sp(j):=sp(j)/konstant;
            end ver=5;
            begin if u>s2 then goto L;
                  if u>s1 then
                  begin if sp(j)>max then
                        begin max:=sp(j);
                              umax:=u/p+bmin;
                        end;
                  end;
            end ver=6;
            begin sp(j):=sp(j)-((u+bmin)/10)**(12/7)*B*exp(A*(u+bmin)/10);
            end ver=7;
            begin u:=u/10;
                  sp(j):=sp(j)*((u+bmin+19436)/(bmin+19436))**4;
            end ver=8;
            begin u:=u/10;
                  sp(j):=sp(j)-152.36+0.97*u;
            end ver=9;
            end case;
            end;
      end j;
end k;
L:
setposition(sp,0,0); swoprec(sp,128); sp(30):=1;
if ver=4 then sp(6):=sp(6)*konstant;
if ver=5 then sp(6):=sp(6)/konstant;
if ver=6 then
begin sp(6):=100; write(out,<:MAX=:>,<< dddd.ddd>,max,100/max,
      nl,1,<:MAX FREQ=:>,<<  ddd.dd>,umax);
      setposition(sp,0,2);
      for k:=0 step 1 until sptail(1)-3 do
      begin swoprec(sp,128);
            for j:=1 step 1 until 128 do
            begin u:=k*128+j;
                  if u<t then sp(j):=sp(j)*100/max;
            end j;
      end k;
 
end;

close(sp,true); slut: end; end
▶EOF◀