|
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: 6144 (0x1800) Types: TextFile Names: »hygentxt«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ. └─⟦4334b4c0b⟧ └─⟦af373cc6d⟧ »rydiv« └─⟦this⟧
; 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◀