DataMuseum.dk

top - metrics - download

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

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »ramsubx« 

TextFile

clear user ramsub
ramsub=set 1 disc5
scope user ramsub
ramsub=algol
\f


RAMAN ANALYSE                                                      SUB

external procedure ramsub(ver);
integer ver;

begin
integer i,k,j,t1,t2,t,u,antal,segm;
real factor,s1,s2,max,umax,bmin,bmax,bmin1,bmin2,bmax1,bmax2;
integer array sptail(1:10), sp1tail(1:10), sp2tail(1:10);
array head(1:12), spname(1:2), sp1name(1:2), sp2name(1:2);
boolean nl;
zone sp, sp1, sp2(128,1,stderror);
nl:=false add 10;
write(out,<:<text>=:>); setposition(out,0,0);
readhead(in,head,1);
write(out,nl,1,<:navn navn1 navn2=:>);  
spname(1):=spname(2):=real<::>; setposition(out,0,0); readstring(in,spname,1);
setposition(out,0,0); readstring(in,sp1name,1);
setposition(out,0,0); readstring(in,sp2name,1);
case ver of
begin begin write(out,<:faktor=:>);
            setposition(out,0,0); read(in,factor);
      end 1;
      begin
      end 2;
      begin write(out,<:s1 s2 faktor=:>); 
            setposition(out,0,0); read(in,s1,s2,factor);
      end 3;
end case;
open(sp1,4,string inc(sp1name),0);
open(sp2,4,string inc(sp2name),0);
if monitor(42,sp1,0,sp1tail) <> 0 then begin
  write(out,<:* :>,string inc(sp1name),<: findes ikke:>);
  goto slut;
end;
if monitor(42,sp2,0,sp2tail) <> 0 then begin
  write(out,<:*** :>,string inc(sp2name),<: unknown:>);
  goto slut;
end;
inrec(sp1,128); sp1tail(1):=sp1(1); t1:=sp1(2);
bmin1:=sp1(11); bmax1:=sp1(12);
inrec(sp2,128); sp2tail(1):=sp2(1); t2:=sp2(2);
bmin2:=sp2(11); bmax2:=sp2(12);
bmax:=bmax1; if bmax<bmax2 then bmax:=bmax2;

segm:=sp1tail(1);
if segm>sp2tail(1) then segm:=sp2tail(1);

if lookupentry(spname)=0 then removeentry(spname);
cleararray(sptail);
sptail(1):=segm;
write(out,nl,1,<< ddd>,segm);
reservesegm(spname,sptail(1)); permentry(spname,15);
open(sp,4,string inc(spname),0);

segm:=segm-3;

t:=t1; if t1>t2 then t:=t2;
max:=0;
setposition(sp,0,2); setposition(sp1,0,2); setposition(sp2,0,2);
for k:=0 step 1 until segm do
begin outrec(sp,128);  inrec(sp1,128); inrec(sp2,128);
      for j:=1 step 1 until 128 do
      begin u:=k*128+j;
            case ver of
            begin
            begin if u<t then sp(j):=sp1(j)+sp2(j)*factor;
            end ver 1;
            begin if u<t then sp(j):=sp1(j)/sp2(j);
            end ver 2;
            begin if u<s1 then sp(j):=sp1(j);
                  if u>=s1 and u<=s2 then sp(j):=(sp1(j)+sp2(j)*factor)/2;
                  if u>s2 and u<t then sp(j):=sp2(j)*factor;
            end ver 3;
            end;
            if sp(j)>max then begin max:=sp(j); umax:=u; end;
      end j;
end k;
setposition(sp,0,0); outrec(sp,128);
for j:=1 step 1 until 128 do sp(j):=-1;
sp(1):=sptail(1);
sp(2):=t;
sp(6):=max;  sp(7):=umax;
sp(11):=bmin1;  sp(12):=bmax;
for j:=100 step 1 until 111 do sp(j):=head(j-99);
slut:
close(sp,true); close(sp1,true);close(sp2,true);
end; end
\f


▶EOF◀