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

⟦d88954862⟧ TextFile

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »hygentxt«

Derivation

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦af373cc6d⟧ »rydiv« 
            └─⟦this⟧ 

TextFile

; ali time 20 0 lines.10000
;hygentxt
hygen=set 60
hywftxt=set 50
permanent hywftxt.13 hygen.13
lookup hygenlist
if ok.yes
mode list.yes
if list.yes
hygen=algol list.yes
hygen=algol
hygen
22 3 76
begin
integer i,j,n,l,sg,res,nl,ma,mb,gcd,
     t,ch,nmin,nmax,lmin,lmax,Z,dn;
long array co(0:100);
long a,b,næv,c,ft,nf,cnf,gcdp,n2,l2,ex1,
     nw;
boolean vpar,sp,plot;
array output(1:2);

long procedure reduce(a,b);
long a,b;
begin
long c;
c:=gcdl(a,b);
if c>ex1 then begin
  a:=a//c;
  b:=b//c;
  end;
reduce:=c;
end;

long procedure removesq(a);
long a;
begin
long sq,c,i;
c:=ex1;

rep:
sq:=sqrt(1.0*a)+1;
for i:=ex1+1 step 1 until sq do begin
  if a mod i=0 and (a//i)mod i=0 then
    begin
    a:=a//i//i;
    c:=c*i;
    goto rep;
    end;
  end;
removesq:=c;
end;

long procedure redpol(A,g);
value g; integer g;
long array A;
begin
integer i,f;
boolean b;
b:=true;
f:=1;
l:
for i:=0 step 1 until g do
  if A(i) mod 2<>0 then b:=false;
if b then
  begin
  for i:=0 step 1 until g do A(i):=A(i)//2;
  f:=2*f;
  goto l;
  end;
redpol:=f;
end;

vpar:=false add 40;
sp:=false add 32;
ex1:=extend 1;
plot:=false;
lmin:=0; lmax:=10;
nmax:=11; nmin:=1;
dn:=maxinteger//2;
Z:=1;
initfp;
if fpints>0 then begin
  readifp(<:nmin:>,nmin);
  readifp(<:nmax:>,nmax);
  readifp(<:lmin:>,lmin);
  readifp(<:lmax:>,lmax);
  readifp(<:z:>,Z);
  readifp(<:dn:>,dn);
  end;
if fpbooleans>0 then readbfp(<:plot:>,plot);
if readlsfp(output) then begin
  stackcuro;
  res:=connectcuro(output);
  if res<>0 then begin
  unstackcuro;
  i:=1;
  alarm(<:***connect output :>,string output(increase(i)));
  end;
  end;
if nmin<=lmin then nmin:=lmin+1;
if lmax>nmax-1 then lmax:=nmax-1;
write(out,false add 12,1);
if plot then write(out,<:; ali time.1800
clear hyplot
hyplot=set 200
permanent hyplot.13
hyplot=algol
begin
integer i,n,l,nmax,nc,pf;
real r,rmax,dr,rm;
boolean sp;
array pname(1:3);

:>) else write(out,<:;ali time.1800
slet al3.hywf
lookup hygenlist
if ok.yes
mode list.yes
hywf=set 50
permanent hywf.13
if list.yes
hywf=algol list.yes details.8.8
hywf=algol
hywf
external:>);
write(out,<:<10>real procedure hywf(n,l,rho);
value n,l,rho; integer n,l; real rho;
if n<60>:>,<<d>,nmin,<: or l<60>:>,lmin,<: or n>:>,nmax,
<: or l>:>,lmax,<: then hywf:=0 else
begin
comment version :>); writedate(out,5,0.0); write(out,<:;
real x;
x:=rho/n;
hywf:=case :>);
if dn=1 then write(out,<:l:>) else
if nmax-dn<=0 then write(out,<:n*(n-1)//2+l:>) else
write(out,<:(if n-dn-1>=0 then dn*(dn-1)//2+l-dn else n*(n-1)//2+l):>);
write(out,<<+d>,1-lmin-nmin*(nmin-1)//2,<: of (:>);
for n:=nmin step 1 until nmax do
begin
if n-dn-0>lmin then lmin:=n-dn-0;
for l:=lmin step 1 until if lmax<n then lmax else n-1 do
  begin
  a:=b:=ex1;
  nl:=n-l-1;
  l2:=n2:=2**(l+1);
  for i:=nl step -1 until 1 do a:=a*i;
  for i:=n+l step -1 until n-l do 
    begin
    if i<>n then b:=b*i;
    if l2>1 and b mod 4=0 then
      begin
      b:=b//4;
      l2:=l2//2;
      for j:=j,j do
      for j:=2,3 step 2 until n-1 do
        if b mod (j*j)=0 then begin
        b:=b//(j*j);
        a:=a*j;
        end;
      end;
    end;
  c:=2**nl;
  for i:=nl step -1 until 1 do
  begin
  co(i):=c;
  nf:=(n-l-i)*2;
  cnf:=i*(i+1+2*l);
  gcdp:=reduce(nf,cnf);
  if c mod nf <>0 then begin
    write(out,<:));
end;
:>);
if -,plot then write(out,<:end;
:>);
    outend(25);
    if fpout then closeout;
    alarm(<:<10>***constant :>,c,nf,n,false add ryalf(l),1);
    end;
  c:=c//nf;
  c:=c*cnf;
  end;
  co(0):=c;
  nf:=redpol(co,nl);
  ft:=nf*l2;
  gcdp:=reduce(ft,a);
  if n<>nmin or l<>lmin then write(out,<:,:>);
  if l=lmin then write(out,<:<10>:>);
  ch:=write(out,<:<10>  sqrt(:>,<<d>,Z,<:/:>,n);
  if l>0 then ch:=ch+write(out,<:/:>,<<d>,b);
    ch:=ch+write(out,<:):>);
    nw:=n;
    reduce(ft,nw);
    if ft>1 then ch:=ch+write(out,<:*:>,<<d>,ft);
  if a>1 then ch:=ch+write(out,<:/:>,<<d>,a);
  if nw>ex1 then ch:=ch+write(out,<:/:>,<<d>,nw);
  ch:=ch+write(out,<:*x:>);
  if l>0 then ch:=ch+write(out,<:**:>,<<d>,l+1);
  ch:=ch+write(out,<:*exp(-x):>);
  sg:=-1;
  if n<>l+1 then
  begin
  ch:=ch+write(out,<:*(:>,<<d>,co(0));
  for i:=1 step 1 until nl do
  begin
  if ch>70-4-7-entier(ln(co(i))/ln(10)) then
    ch:=write(out,<:<10>        :>);
  ch:=ch+write(out,<:-x:>);
  if nl>i then ch:=ch+write(out,<:*(:>) else
  if i=nl and co(i)>ex1 then ch:=ch+write(out,<:*:>);
  if co(i)>ex1 then ch:=ch+write(out,<<d>,co(i));
  sg:=-sg;
  end;
  if 70-5<ch+nl then ch:=write(out,<:<10>         :>);
  for i:=1 step 1 until nl do write(out,<:):>);
  end polynomilal;
  end l;
  end n;
write(out,<:);
end;
:>);
if -,plot then write(out,<:
end;
:>) else begin
  write(out,<:
sp:=false add 32;
if readsfp(<60>:plotter:<62>,pname) then setplotname(string inc(pname));
pf:=:>,2,<:;
nmax:=:>,nmax,<:;
rmax:=nmax*nmax*2;
readrfp(<60>:rmax:<62>,rmax);
rmax:=rmax*:>,<<d>,Z,<:;
for l:=0 step 1 until :>,lmax,<: do
begin
plotform(0,7*pf,7*pf);
plotheight:=pf/2*plotheight;
plotsize:=pf/2*plotsize;
setmargin(1.5,plotyform-1);
writeplot(<60>:<60>12>hydrogen  :<62>);:>);
if Z<>1 then write(out,<:
writeplot(<60>:Z = :<62>,<<d>,:>,Z,<:);:>);
write(out,<:
nc:=0;
for n:=l+1 step 1 until nmax do begin
  setmargin(1+nc*1.5,plotyform-2.5-((n-l-1)//2+1)*linediff);
  nc:=(nc+1) mod 2;
  writeplot(<60>:<12>:<62>,sp,4,<<dd>,n,false add alf(l),1);
  setmask((n-l-1)/20,(n-l-1)/40,(n-l-1)/20);
  pendown;
  plotmove(plotxpos+.1,plotypos);
  penup;
  end;
setmask(0,0,0);
plotsubform(0,plotxform,0,plotyform-4,false);
plotadmini(0,rmax,-.6,.8,0);
rmax:=plotxmax-1/deltax;
dr:=rmax/500;
for n:=l+1 step 1 until nmax do
begin
for r:=rmax step -dr until n*n do begin
  if abs hywf(n,l,r)<10*smallreal then rm:=r;
  end;
setmask((n-l-1)/20,(n-l-1)/40,(n-l-1)/20);
if (n-l-1)mod 2=0 then plotgraph(r,hywf(n,l,r),rm,0,-dr) else
  plotgraph(r,hywf(n,l,r),0,rm,dr);
end;
end;
setmask(0,0,0);
end;
if warning.no
hyplot
:>);
end plot;
write(out,<:<10>mode list.no <10>:>);
write(out,false add 12,1);
outend(25);
if fpout then closeout;
end;
if warning.yes
end
hywftxt=hygen  lmax.13 nmax.14
i hywftxt
lookup hygenlist
if ok.yes
mode list.no
mode list.no
▶EOF◀