DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »rydritztxt«

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

TextFile

;klab3 6 time.1800 lines.20000
slet ryd.rydritz
beskyt ryd.rydritz.7
lookup rydlist
if ok.yes
mode list.yes
if list.yes
rydritz=algol list.yes
rydritz=algol index.no
external
procedure rydritz(E,ns,nmin,nmax,lmin,lmax,z);
value nmin,nmax,lmin,lmax,z; integer nmin,nmax,lmin,lmax,z;
array E,ns;
begin
  integer n,l,i,j,grad,points,iter,ndiff;
  real nstar,Eau,d,defect;
  boolean allfit,first,list;
  integer array lfit(0:lmax);
  list:=z>0;
  z:=abs z;
  allfit:=false;
  cleararray(lfit);
  grad:=2;
  for l:=lmin step 1 until lmax do
  for n:=if nmin<l+1 then l+1 else nmin step 1 until nmax do
   begin
   if E(lexi(n,l))<0 then lfit(l):=lfit(l)+1;
   end;
  begin
  array W,X,Y(1:nmax),c,s(0:grad);
  comment fits then quantumdefects to the Rydberg-Ritz formulae.
    See H.G. Kuhn: Atomic Spectra (2.ed), Longman, London 1969
    p. 133;
  overflows:=0;
  for l:=lmin step 1 until lmax do
    begin
    if grad>=lfit(l)-1 then grad:=lfit(l)-2;
    if grad<0 then grad:=0;
    j:=1;
    for i:=1 step 1 until nmax do W(i):=X(i):=Y(i):=0.0;
    ndiff:=0;
    for n:=if l+1<nmin then nmin else l+1 step 1 until nmax do 
      begin
      Eau:=E(lexi(n,l));
      nstar:=ns(lexi(n,l));
      if Eau<0 then begin
        X(j):=1/nstar/nstar; Y(j):=n-nstar;
        W(j):=nstar;
        if abs(n-nstar-.6)>ndiff then ndiff:=abs(n-nstar-.6);
        j:=j+1;
        end;
      end;
    points:=j:=j-1;
    W(points):=1;
    TRYAGAIN:
    polfit(j,W(j),X(j),Y(j),c,s,grad);
    if (abs c(0)>ndiff+2 or overflows>0) and list then begin
      for i:=1 step 1 until points do write(out,<:<10>,j,x,y:>,
      i,X(i),Y(i));
    end;
    if grad>1 and abs c(1)>abs c(0) then begin
      grad:=grad-1;
      goto TRYAGAIN;
      end;
    overflows:=-1;
    if list then begin
    write(out,<:<10><10>:>,false add ryalf(l),1,<:-states:>);
    for i:=0 step 1 until grad do
    write(out,<:<10>:>,<<d>,i,<:. degree = :>,<< -d.ddddd>,c(i),
      <:  +-  :>,s(i));
    end list;
    first:=true;
    for n:=if l+1<nmin then nmin else l+1 step 1 until nmax do
      begin
      Eau:=E(lexi(n,l));
      if (Eau>=0 or allfit) and n>4 then begin
      if first and list then begin
        first:=false;
        write(out,<:<10>state E(a.u.)        n*     :>);
        if allfit then write(out,<:     dn*    :>);
        write(out,<:    defect:>);
        end;
        nstar:=n;
        defect:='6;
        iter:=0;
    nextiter:
        iter:=iter+1;
        d:=defect;
        defect:=c(grad);
        for i:=grad step -1 until 1 do defect:=defect/nstar/nstar+c(i-1);
        nstar:=n-defect;
        if abs(d-defect)>'-5 and iter<101 then goto nextiter;
        if iter>20 then write(out,<:<10>iterations =:>,iter);
       if Eau>=0 then ns(lexi(n,l)):=nstar;
        Eau:=-z**2/2/nstar**2;
        if list then begin
        write(out,<:<10>:>,<<dd>,n,false add ryalf(l),1,
           <<  -dd.dddddd>,Eau,nstar);
       if allfit then write(out,<<  -dd.dddddd>,(nstar-ns(lexi(n,l)))/nstar);
       write(out,<<  -dd.dddddd>,defect);
       end list;
        E(lexi(n,l)):=Eau;
        e▶01◀▶a0◀▶1a◀▶c0◀"▶c0◀▶14◀▶c0◀▶14◀▶c0◀▶14◀▶c0◀▶16◀▶c0◀▶16◀«bs»▶9c◀▶06◀=▶c0◀J▶c0◀ ▶c0◀,▶c0◀▶1a◀▶c0◀J@▶02◀▶11◀0A▶9b◀▶03◀▶81◀i@▶16◀@▶80◀S3330▶02◀@æÅ/▶7f◀▶d9◀/▶d1◀▶c9◀▶8f◀▶f9◀▶dd◀/å-▶01◀▶1d◀/▶81◀Å/▶81◀Q/▶81◀-▶EOF◀