DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »epm«

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

TextFile

;pal
slet c411.procm
clear procm
beskyt c411.procm.11
procm=algol list.no

Multiplication
external procedure m;
begin
  integer i,j,k,t,tmin,u,q,umax,b,tm,ver,l;
  real max,npf,gsnit,sum,a,c,T,p,bmin,A,B,n;
  array spname(1:2), spr(1:2);
  integer array sptail(1:10), tail(1:10);
  zone r, sp(128,1,stderror);
  T:=1;

  for i:=1 step 1 until 10 do sptail(i):=tail(i):=0;
  umax:=-100000;
  T:=1;
  write(out,nl,1,<: NAME=:>); writeend; readstring(in,spname,1);
  write(out,<:mNAME=:>); writeend; readstring(in,spr,1);
  write(out,<:NORM VER= :>); outend(0); read(in,l,ver);
  T:=1;
  
  case ver of begin
  begin write(out,<:T=:>); setposition(out,0,0); read(in,T);
  end 1;
  begin write(out,<:T=:>); setposition(out,0,0); read(in,T);
  end 2;
  begin write(out,<:T=:>); setposition(out,0,0); read(in,T); 
  end 3;
  begin
  end 4;
  begin
  end 5;
  begin write(out,<:T=:>); setposition(out,0,0); read(in,T);
  end 6;
  begin write(out,<:T=:>); setposition(out,0,0); read(in,T);
  end 7;
  begin
  end 8;
  begin
  end 9;
  begin
  end 10;
  begin
  end 11;
  begin write(out,<:EXPONENT=:>); setposition(out,0,0); read(in,n);
  end 12;
  end case;

  c:=1.4387987/T;




  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;


  tail(1):=400;
  open(r,4,string inc(spr),0);
  if monitor(42,r,0,tail)=0 then monitor(48,r,0,tail);
  monitor(40,r,0,tail); monitor(50,r,15,tail);
  inrec(sp,128); tail(1):=1; outrec(r,128);

  sptail(1):=sp(1); t:=sp(2); bmin:=sp(11); b:=sp(30);
  p:=sp(40); if p<0 then p:=10;
  for j:=1 step 1 until 128 do r(j):=sp(j);
  if b=-1 then begin
  write(out,<:
***baggrundskorrektion mangler

benyt proc b for konstant baggrund
benyt proc c for variabel baggrund
:>); goto slut;
end;

  setposition(sp,0,2);
  tail(1):=2; outrec(r,128); tail(1):=3;

  max:=0;
  for k:=0 step 1 until sptail(1)-3 do
  begin
    inrec(sp,128); outrec(r,128);
    for j:=1 step 1 until 128 do
    begin
      u:=k*128+j;
      if u<t then 
      begin
        if ver=1 then r(j):=sp(j)*(bmin+u/p)*(1-exp(-c*(bmin+u/p)));
        if ver=2 then r(j):=sp(j)/(bmin+u/p)/(1-exp(-c*(bmin+u/p)));
        if ver=3 then r(j):=sp(j)*(1-exp(-c*(bmin+u/p)));
        if ver=4 then r(j):=sp(j)*(bmin+u/p)**2;
        if ver=5 then r(j):=sp(j)*(bmin+u/p)**(-2);
        if ver=6 then r(j):=sp(j)*(1/2)*(1+exp(-c*(bmin+u/p)));
        if ver=7 then r(j):=sp(j)*2/(1+exp(-c*(bmin+u/p)));
        if ver=8 then r(j):=sp(j);
        if ver=9 then r(j):=ln(
        if sp(j)<0.00000001 and sp(j)>-0.00000001 then 0.000001 else abs(sp(j)));
        if ver=10 then r(j):=exp(sp(j));
        if ver=11 then r(j):=sp(j)-B*exp(A*(u/p+bmin));
        if ver=12 then r(j):=sp(j)*(bmin+u/p)**n;

        if r(j)>max then begin max:=r(j); umax:=u; end;
    
      end;
    end j;
  tail(1):=tail(1)+1;
  end k;
  close(sp,true);
  monitor(44,r,15,tail);

  setposition(r,0,2);
  for k:=0 step 1 until sptail(1)-3 do
  begin
    swoprec(r,128);
    for j:=1 step 1 until 128 do
    begin
      u:=k*128+j;
      if u<t then r(j):=r(j)*100/(if l=1 then max else 100);
    end j;
  end k;
  setposition(r,0,0); swoprec(r,128);
  r(6):=if l=1 then 100 else max; r(7):=umax;
  if ver=1 then r(50):=1;
  close(r,true);
  write(out,<:MAX=:>,<<  ddd ddd ddd.dd>,max,
  nl,1,<:MAX FREQ=  :>,<< dddd.dd>,bmin+umax/p,<: CM-1:>);
slut: end; end
▶EOF◀