DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »rydritz«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦e6c2bcfa6⟧ »cryprog« 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦e6c2bcfa6⟧ »cryprog« 
            └─⟦this⟧ 

TextFile

<*rydberg ritz fit        1980-11-21 *>
procedure rydritz(E,ns,nmin,nmax,L,l,J,z);
value nmin,nmax,L,l,J,z; integer nmin,nmax,L,l,J,z;
array E,ns;
begin
  integer n,i,j,grad,points,iter,ndiff;
  real nstar,Eau,d,defect,stddev;
  boolean allfit,first,list;
  integer lfit;
  list:=z>0;
  z:=abs z;
  allfit:=false;
  grad:=2;
  l:=l//2;
  for n:=if nmin<l+1 then l+1 else nmin step 1 until nmax do
   begin
   if E(n)<0 then lfit:=lfit+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;
    if grad>=lfit-1 then grad:=lfit-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;
    if list then write(out,"nl",1,"+",15,<:ryd ritz fit:>,"+",15);
    for n:=if l+1<nmin then nmin else l+1 step 1 until nmax do 
      begin
      Eau:=E(n);
      nstar:=ns(n);
      if Eau<0 then begin
        X(j):=1/nstar/nstar; Y(j):=n-nstar;
        W(j):=nstar;
        Y(j):=Y(j)*W(j);
        if list then write(out,"nl",1,<<d>,n,<< -d.dddd>,X(j),Y(j),W(j),j);
        if abs(n-nstar-.6)>ndiff then ndiff:=abs(n-nstar-.6);
        j:=j+1;
        end;
      end;
    points:=j:=j-1;
    TRYAGAIN:
    stddev:=polfitw(X,Y,W,j,c,s,grad);
    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*2),1);
    if J>-1 then write(out,<:_:>,if J mod 2 = 1 then J else J//2,
       if J mod 2 =1 then <:/2:> else <::>);
    write(out,<:-states:>);
    write(out,"nl",1,<:s = :>,sqrt(stddev));
    write(out,"nl",1,<:points = :>,points);
    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(n);
      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(n):=nstar;
        Eau:=-z**2/2/nstar**2;
        if list then begin
        write(out,<:<10>:>);
       writestate(out,L,n,l*2,J);
       write(out,<<  -dd.dddddd>,Eau,nstar);
       if allfit then write(out,<<  -dd.dddddd>,(nstar-ns(n))/nstar);
       write(out,<<  -dd.dddddd>,defect);
       end list;
        E(n):=Eau;
     end;
end;
end;
if list then write(out,"nl",1,"+",15,<:end fit:>,"+",15);
end rydritz;
▶EOF◀