|
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: »ramplox«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »ramplox«
clear user ramplo
ramplo=set 1 disc5
scope user ramplo
ramplo=algol list.no
\f
RAMAN ANALYSE PLO
external procedure ramplo(navn,ramme,fmin,fmax,format,max);
long array navn; integer ramme,fmin,fmax; real format,max;
begin
integer i,j,k,h,m,t,min,deltaf,nyfmax,del,stpl,
sm,smo,segm,sk,p,s,ver,layout,df,dt;
real f1,u,up,u1p,u0,u1,um,gain,bagr,bgr,sum,maxsum,jmax,
tmin,tmax,bmin,bmax,smin,smax,umax,ymax,si,x,y,
x1,x2,y1,y2,dx,skax,skay,B,mx,my,C,d,wo,w,D,C1;
boolean ir,f,nl; array head,text(1:12);
zone z(128,1,stderror);
nl:=false add 10; p:=10; ir:=false;
if ramme>0 then
begin x:=26; y:=18; si:=1.5;
write(out,<:abs: fmin fmax df dt= :>); setposition(out,0,0);
read(in,fmin,fmax,df,dt);
if ramme<>3 then
begin write(out,<:overskrift= :>); setposition(out,0,0);
readhead(in,head,1);
end;
if ramme=1 then layout:=0;
if ramme=2 then
begin write(out,<:layout= :>); setposition(out,0,0);
ftal(layout);
end;
if ramme=3 then
begin write(out,<:layout= :>); setposition(out,0,0);
ftal(layout);
plotform(10,38,25);
write(out,<:xmin xmax ymin ymax si=:>);
setposition(out,0,0);
read(in,x1,x2,y1,y2,si);
x1:=x1-1; x2:=x2+1;
y1:=y1-1; y2:=y2+2;
plotsubform(x1,x2,y1,y2-1,false);
x:=x2-x1; y:=y2-y1-1;
end
else
begin if cb(1,layout) and ramme<>3 then
begin write(out,<:x y si= :>); setposition(out,0,0);
read(in,x,y,si);
end;
plotform(10,x,y+1);
end;
plotsize:=0.2*si; plotheight:=0.28*si;
if cb(2,layout) then plotspline:=true;
deltaf:=fmax-fmin; skax:=(x-2)/deltaf;
format:=x*100+y; skay:=(y-4)/max;
if ramme <>3 then
begin setmargin(1,y-0.75);
writeplot(<:<12>I(<14>n<15>):>);
setmargin(3,y-0.75);
writeplot(<:<12>:>,string inc(head));
costhetax:=costhetay:=0; sinthetax:=sinthetay:=1;
setmargin(.6,(y-plotsize*17)/2);
writeplot(<:<12>I N T E N S I T Y:>);
costhetax:=costhetay:=1; sinthetax:=sinthetay:=0;
end;
if cb(3,layout) then
begin setmargin(.5,1.9); writeplot(<:<12>:>,<:0:>);
plotmove(1,2); pendown; plotmove(1.4,2); penup;
setmargin(.5 ,y-2.1); writeplot(<:<12>:>,<:1:>);
plotmove(1,y-2); pendown; plotmove(1.4,y-2); penup;
end;
plotmove(1,1); pendown;
for j:=fmin step df until fmax do
begin f1:=(j-fmin)*skax+1;
if j<>fmin then
begin plotmove(f1,1);
plotmove(f1,1+y/(if j mod dt=0 then 25 else 50));
plotmove(f1,1);
end;
if j mod dt = 0 then
begin setmargin(f1-plotsize*0.5*cif(j),0.8-plotheight);
writeplot(<:<12>:>,case cif(j) of(
<<d>,<<dd>,<<ddd>,<<dddd>),j);
plotmove(f1,1); pendown;
end;
end;
plotmove(x-1,1); plotmove(x-1,y-1);
plotmove(x-1,1); plotmove(x-1,y-1);
for j:=fmin step df until fmax do
if j mod df=0 then nyfmax:=j;
for j:=nyfmax step -df until fmin do
begin f1:=(j-fmin)*skax+1;
if j<>fmin then
begin plotmove(f1,y-1);
plotmove(f1,y-1-y/(if j mod dt=0 then 25 else 50));
plotmove(f1,y-1);
end;
end;
plotmove(1,y-1); plotmove(1,1);
plotmove(1,y-1); plotmove(1,1);
if ramme=3 then
plotsubform(x1+1,x2-1,y1+1,y2-1,false)
else
plotsubform(1,x-1,1,y-1,false);
penup; plotend;
end ramme;
x:=entier(format/100); y:=format-x*100;
skay:=(y-4)/max; deltaf:=fmax-fmin; skax:=(x-2)/deltaf;
gain:=1.0; bagr:=1.0; del:=1; dx:=0.0;
ramnc(j,navn,i); if i=6 then goto L;
write(out,<:version= :>); setposition(out,0,0);
ftal(ver);
open(z,4,navn,0); inrec(z,128);
segm:=z(1); t:=z(2); bmin:=z(11); bmax:=z(12);
if z(40)>0 then sk:=10 else sk:=1;
sm:=z(51); if sm>0 then begin smo:=sm; sm:=1; end;
for i:=1 step 1 until 12 do head(i):=z(i+99);
smin:=if fmin<bmin then bmin else fmin;
smax:=if fmax>bmax then bmax else fmax;
if cb(1,ver) then
begin write(out,<:gain bagr delta=:>); setposition(out,0,0);
read(in,gain,bagr,del);
end;
if cb(2,ver) then
begin B1:write(out,<:bmin=:>,<< dddd.dd>,bmin,<:cm-1 smin=:>);
setposition(out,0,0); read(in,smin);
if smin<fmin then goto B1;
B2:write(out,<:bmax=:>,<< dddd.dd>,bmax,<:cm-1 smax=:>);
setposition(out,0,0); read(in,smax);
if smax>fmax then goto B2;
end;
if cb(3,ver) then
begin write(out,<:stipling: stpl=:>); setposition(out,0,0);
read(in,maxsum);
end;
if cb(4,ver) then
begin write(out,<:sk dx=:>); setposition(out,0,0);
read(in,sk,dx);
end;
um:=(bmin-fmin+t/p)*skax;
u0:=(smin-bmin)*10; h:=entier(u0/128); u0:=u0-h*128;
if u0=0 then u0:=1;
setposition(z,0,h+2); inrec(z,128);
u1:=gain*z(u0)*skay+bagr;
u:=(smin-fmin)*skax; ymax:=y-2;
plotmove((if ir then u-um else u)*sk+dx,if u1>ymax then ymax else u1);
pendown; setposition(z,0,2);
sum:=0;
up:=u; u1p:=u1;
for k:=0 step 1 until segm-3 do
begin inrec(z,128);
for j:=1 step 1 until 128 do
begin i:=k*128+j;
if i<t and (k*128+j) mod del = 0 then
begin u:=(bmin-fmin+i/p)*skax;
if u< (smin-fmin)*skax then goto S1;
if u> (smax-fmin)*skax then goto S2;
u1:=gain*z(j)*skay+bagr;
if cb(3,ver) then begin
if sum>maxsum then
begin sum:=0;
if penstatus=0 then
pendown
else
penup;
end;
sum:=sqrt((up-u)*sk*(up-u)*sk+(u1p-u1)*(u1p-u1))+sum;
up:=u; u1p:=u1;
end;
plotmove((if ir then (u-um) else u)*sk+dx,
if u1>ymax then ymax else u1);
end;
S1: end j;
end k;
S2: penup; plotend; close (z,true); goto slut;
L:
write(out,<:s= :>); setposition(out,0,0); read(in,s);
case s of
begin
begin write(out,<:B (cps)=:>); setposition(out,0,0);
read(in,B);
plotmove(0,bagr+gain*skay*B); pendown;
plotmove(x-2,bagr+gain*skay*B); penup;
plotend;
end s=1;
begin write(out,<:x y <text>=:>); setposition(out,0,0);
read(in,mx,my); readhead(in,text,1);
setmargin(mx,my);
writeplot(<:<12>:>,string inc(text));
end s=2;
begin
end s=3;
begin write(out,<:lorentz: bagr c hwhh wo (cm-1)= :>);
setposition(out,0,0);
read(in,bagr,C,d,wo);
plotgraph(w,bagr+100*C*skay*d**2/((w/skax+fmin-wo)**2+d**2),
0,x-2,0.1);
end s=4;
begin write(out,<:lorentz*trekant: bagr hwhh deltau c=:>);
setposition(out,0,0);
read(in,bagr,B,D,C);
C1:=1/((1/B)*2*arctan(D/B)+(1/D)*ln(B**2)-
(1/D)*ln(D**2+B**2));
plotgraph(w,bagr+gain*skay*C*C1*(
(1/B)*(1+(w/skax+fmin)/D)*
arctan((w/skax+fmin+D)/B)-
(1/B)*(1-(w/skax+fmin)/D)*
arctan((w/skax+fmin-D)/B)-
2*(1/B)*(w/skax+fmin)*arctan((w/skax+fmin)/B)/D+
(1/D)*ln(B**2+(w/skax+fmin)**2)-
(1/2/D)*ln((w/skax+fmin)**2+2*(w/skax+fmin)*D+D**2+B**2)-
(1/2/D)*ln((w/skax+fmin)**2-2*(w/skax+fmin)*D+D**2+B**2)),
0,x-2,0.1);
end s=5;
end case;
slut: end; end
▶EOF◀