|
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: 6912 (0x1b00)
Types: TextFile
Names: »elis«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »elis«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »elis«
begin
real array field raf;
real procedure simp1(f) ;
array f ;
begin
integer i2 ; real res ;
res:=0 ;
for i2:=0 step 6 until 1146 do
begin
res:=res+216*(f(i2+1)+f(i2+5))+27*(f(i2+2)+f(i2+4))+
272*f(i2+3)+82*f(i2+6) ;
end ;
simp1:=(50/(1152*140))*(res+41*(f(0)-f(1152))) ;
end ;
real procedure h1(z) ;
value z ; real z ;
begin
if z=-2.15 then h1:=0.8496786712 else
if z=-6.65 then h1:=-0.8496786712 else
h1:=0.6377458471*(1/(0.5625+(4.4+z)**2)-0.177777778)*
ln(abs((6.65+z)/(2.15+z)))+
2.124196678*(4.4+z)/(0.5625+(4.4+z)**2) ;
end ;
real procedure h2(z) ;
value z ; real z ;
begin
if z=-7 then h2:=1.274518007 else
if z=-10 then h2:=-1.274518007 else
h2:=0.4251639*(1/(0.25+(8.5+z)**2)-0.4)*ln(abs((10+z)/(7+z)))+
2.124196678*(8.5+z)/(0.25+(8.5+z)**2) ;
end ;
real procedure rez(x,d1,d2,z1,z2) ;
value x,d1,d2,z1,z2 ; real x,d1,d2,z1,z2 ;
begin
real h1,h2,theta,h3 ;
h1:=((z1*z1-z2*z2)*x*x-d1**2+d2**2) ;
h2:=2*(z1*z2*x*x-d1*d2) ;
h3:=h1*h1+h2*h2 ;
theta:=arg(h1,h2) ;
if theta<0 then theta:=(theta+2*pi)/2 else theta:=theta/2 ;
rez:=x*(z1*cos(theta)+z2*sin(theta))/sqrt(sqrt(h3)) ;
slut1:
end ;
real procedure red(x,d1,d2,z1,z2) ;
value x,d1,d2,z1,z2 ; real x,d1,d2,z1,z2 ;
begin
real h1,h2,theta,h3 ;
h1:=((z1*z1-z2*z2)*x*x-d1**2+d2**2) ;
h2:=2*(z1*z2*x*x-d1*d2) ;
h3:=h1*h1+h2*h2 ;
theta:=arg(h1,h2) ;
if theta<0 then theta:=(theta+2*pi)/2 else theta:=theta/2 ;
red:=(d1*cos(theta)+d2*sin(theta))/(sqrt(sqrt(h3))) ;
slut2:
end ;
real procedure alfa(x) ;
value x ; real x ;
begin
real z ; z:=abs(x) ;
if z<=2.15 or z>=10 then alfa:=0
else
if z<6.65 then alfa:=sign(x)*0.63774595*
(1/((z-4.4)*(z-4.4)+0.5625)-0.177777778)
else
if z<=7 then alfa:=0
else
alfa:=sign(x)*0.42516392*
(1/((z-8.5)*(z-8.5)+0.25)-0.4) ;
end ;
integer i,j,k ; real t,a,hj,d1hj,d2hj ;
array int(-1152:2304),d1(0:1152),d2(0:1152),z1(0:1152),z2(0:1152)
,hj1(0:2304),ada(0:1152) ;
zone zo(1152,1,stderror) ;
t:=0.5759 ; a:=50/1152 ;
k:=1 ;
for j:=0 step 1 until 1152 do ada(j):=adapint(50,70,h1(a*j+hj)-h1(hj-a*j)
+h2(a*j+hj)-h2(hj-a*j),
hj,1.0'-3)+adapint(70,90,h1(a*j+hj)+h2(a*j+hj)-h1(hj-a*j)-h2(hj-a*j),hj,1.0'-3) ;
raf:= -4;
for i:=-1152 step 1 until 2304 do
int(i):=h1(i*a)+h2(i*a) ;
for j:=0 step 1 until 2304 do hj1(j):=exp(j*a/t)+1 ;
if k=1 then
begin
open(zo,4,<:gs5800:>,0) ;
inrec(zo,1152) ;
for j:=1 step 1 until 1152 do d1(j):=zo(j) ;
inrec(zo,1152) ;
for j:=1 step 1 until 1152 do d2(j):=zo(j) ;
inrec(zo,1152) ;
for j:=1 step 1 until 1152 do z1(j):=zo(j) ;
inrec(zo,1152) ;
for j:=1 step 1 until 1152 do z2(j):=zo(j) ;
close(zo,true) ;
d1(0):=d1(1) ; z1(0):=z1(1) ; d2(0):=d2(1) ; z2(0):=z2(1) ;
end
else
begin
d1(0):= d2(0):= z2(0):= 0;
tofrom(d2,d2.raf,4*1152);
tofrom(z2,z2.raf,4*1152);
for i:=0 step 1 until 1152 do
begin
if i<300 then
begin
d1(i):=2.68 ; z1(i):=2 ;
end
else
z1(i):=1 ; d1(i):=0 ;
end ;
end ;
for i:=1 step 1 until 3 do
begin
for j:=0 step 1 until 1152 do
begin
if j>0 then
zo(j):=rez(a*j,d1(j),d2(j),z1(j),z2(j))
else hj:=rez(0,d1(0),d2(0),z1(0),z2(0)) ;
z1(j):=red(a*j,d1(j),d2(j),z1(j),z2(j)) ;
end ;
for j:=0 step 1 until 1152 do
begin
for k:=0 step 1 until 1152 do
begin
real a3,a2 ; a2:=int(k+j)+int(k-j) ;
if k+j>1152 then a3:=int(-1152) else a3:=int(-(k+j)) ;
z2(k):=(a2-0.11*((hj1(k)-2)/(hj1(k)))-
(int(j-k)+a3+a2)/(hj1(k)))*z1(k) ;
end ;
d1(j):=simp1(z2) ;
z2(0):= 0;
tofrom(z2,z2.raf,4*1152);
for k:=49 step 1 until 231 do
begin
real a1,a2,a3 ;
if j+k>1152 then a1:=z1(1152) else a1:=z1(j+k) ;
if k-j>=0 then
a2:=hj1(k-j) else a2:=(1/(hj1(j-k)-1))+1 ;
if j-k<0 then a3:=-z1(k-j) else a3:=z1(j-k) ;
z2(k):=((a1+a3)/(hj1(k)-2)+a1/(hj1(k+j))+a3/(a2))*alfa(a*k) ;
end ;
d2(j):=simp1(z2) ;
end ;
z2(0):=hj ; d1hj:=d1(0) ; d2hj:=d2(0) ;
for j:=1 step 1 until 1152 do z2(j):=zo(j) ;
open(zo,4,<:elisdata:>,0) ;
outrec(zo,1152) ;
for j:=1 step 1 until 1152 do zo(j):=d1(j) ;
outrec(zo,1152) ;
for j:=1 step 1 until 1152 do zo(j):=pi*d2(j) ;
close(zo,true) ;
for j:=0 step 1 until 1152 do d1(j):=z2(j) ;
for j:=49 step 1 until 231 do zo(j):=alfa(j*a) ;
for j:=1 step 1 until 1152 do
begin
for k:=0 step 1 until 1152 do
begin
real a4,a3 ; a3:=int(j+k)-int(k-j) ;
if k+j>1152 then a4:=int(-1152) else a4:=int(-j-k) ;
d2(k):=(a3-
(a4-int(j-k)+a3)/(hj1(k)))*d1(k) ;
end ;
z1(j):=1-((simp1(d2)+ada(j))/(j*a)) ;
d2(0):= 0;
tofrom(d2,d2.raf,4*1152);
for k:=49 step 1 until 231 do
begin
real a2,a1 ;
if k-j>=0 then a1:=hj1(k-j) else a1:=(1/(hj1(j-k)-1))+1 ;
if k+j>1152 then a2:=d1(1152) else a2:=d1(k+j) ;
d2(k):=((
d1(abs(j-k))+a2)/(hj1(k)-2)
+d1(abs(j-k))/(a1)+a2/(hj1(k+j)))*zo(k) ;
end ;
z2(j):=(pi/(j*a))*simp1(d2) ;
end ;
z1(0):=z1(1) ; z2(0):=z2(1) ;
open(zo,4,<:elisdata:>,0) ;
inrec(zo,1152) ;
for j:=1 step 1 until 1152 do d1(j):=zo(j) ;
d1(0):=d1hj ;
inrec(zo,1152) ;
for j:=1 step 1 until 1152 do d2(j):=zo(j) ;
d2(0):=d2hj ;
close(zo,true) ;
for j:=0 step 1 until 1152 do
begin
if j<250 or j>1145 then
begin
hj:=z1(j)**2+z2(j)**2 ;
write(out,<:<10>:>,a*j,z1(j),z2(j),
(d1(j)*z1(j)+d2(j)*z2(j))/hj,
(d2(j)*z1(j)-d1(j)*z2(j))/hj) ;
end ;
end ;
end ;
begin
open(zo,4,<:elisdata:>,0) ;
outrec(zo,1152) ;
for i:=1 step 1 until 1152 do zo(i):=d1(i) ;
outrec(zo,1152) ;
for i:=1 step 1 until 1152 do zo(i):=d2(i) ;
outrec(zo,1152) ;
for i:=1 step 1 until 1152 do zo(i):=z1(i) ;
outrec(zo,1152) ;
for i:=1 step 1 until 1152 do zo(i):=z2(i) ;
close(zo,true) ;
end ;
end ;
end ;
end ;
▶EOF◀