⟦d6c3206c5⟧

TextFile

;ali time.200 lines.7000

mode list.yes
lookup exactosctxt
clear exactosc
exactosc=set 280
permanent exactosc.13
lookup rydlist
if ok.yes
mode 15.yes
exactosc=hcalg spill.yes
exactosc
1979-11-01
begin
boolean hyp,exc;
integer n,l,nm;
real dele,val,Sl,osc,A;
algol list.off copy.rydstruct;
algol list.off copy.rydseg;
algol list.off copy.alutproc;
algol list.off copy.ryproc;

real procedure F(a,b,c,z);
value a,b,c,z; integer a,b,c; real z;
begin
integer n,m;
real term,f;
term:=1;
f:=1;
b:=abs b;
m:=abs a;
for n:=1 step 1 until m do
begin
  begin
    term:=term*(m+n-1)*(b-n+1)/(c+n-1)/n*z;
    f:=f+term;
  end;
end;
F:=f;
if test then
  write(out,nl,1,sp,6,<:F(:>,<<d>,a,<:,:>,b,<:,:>,c,<:;:>,<<-d.dddd>,z,
       <:) = :>,f);
end F;

real procedure r_2_h(n,nm,l);
value n,nm,l; integer n,nm,l;
begin
integer i,j,k,npn,nmn,nr,nrm;
real norm,fa,a1,a2,na;
nmn:=n-nm;
npn:=n+nm;
nr:=n-l-1;
nrm:=nm-l;
fa:=4*n*nm;
a2:=-fa/nmn/nmn;
a1:=-(nmn/npn)**2;
k:=l+1;
norm:=.25;
for j:=2*l-1 step -1 until 2 do norm:=norm/j;
for j:=1 step 1 until k do norm:=norm*fa;
k:=npn-2*l-2;
for j:=1 step 1 until k do norm:=norm*nmn;
for j:=1 step 1 until npn do norm:=norm/npn;
na:=1; k:=n+l;
for j:=n-l step 1 until k do na:=na*j;
k:=nm+l-1;
for j:=nm-l+1 step 1 until k do na:=na*j;
norm:=norm**2*na;
if test then
  write(out,nl,1,<:nr:>,nr,<: nr':>,nrm,<: na:>,na,<: norm:>,norm,
     <: a1:>,a1,<: a2:>,a2);
r_2_h:=norm*(F(-nr,-nrm,2*l,a2)+a1*F(-nr-2,-nrm,2*l,a2))**2;
end r2h;


real procedure bin(a,b);
value a,b; integer a,b;
if abs a<abs b then bin:=0 else
if b<=0 then bin:=1 else
begin
integer j,k,nom;
real c;
comment calculates binomial coefficients ;
nom:=a-b+1;
c:=1;
for k:=1 step 1 until b do
begin
  c:=c*nom/k;
  nom:=nom+1;
end;
bin:=c;
end bin;

real procedure r_2(n,nm,l);
value n,nm,l; integer n,nm,l;
begin
integer npn,nmn,l22,i,j,k,la,lam,s2,si,lp,lq,ca,cb,c,t;
real norm,sum1,sum2,ds2,isum,fa2;
comment calculates the exact transition matrixelements for H.
r_2 gives the square of the elements.;
norm:=l;
npn:=n+nm;
nmn:=n-nm;
comment n>nm;
l22:=2*l+2;
for i:=1 step 1 until l22 do norm:=norm*n*nm/npn/npn;
for i:=1,2 do norm:=norm*nm/npn;
k:=n+l;
for i:=if n-l>0 then n-l else 1 step 1 until k do
     norm:=norm/i;
k:=nm+l-1;
for i:=nm-l+1 step 1 until k do norm:=norm/i;
k:=4*l+2;
for i:=1 step 1 until k do norm:=norm*2;

if test then write(out,nl,1,star,2,<:norm :>,<<-d.dddd'd>,norm);

comment outer loop, loop1;
sum1:=0;
la:=if n-l-1>0 then n-l-1 else 0;
for la:=la step -1 until 0 do
begin
  comment loop2;
  sum2:=0;
  s2:=if (nm-l) mod 2 =1 then -1 else 1;
  for lam:=nm-l step -1 until 0 do
  begin
   comment inner loop;
    isum:=0;
    ca:=n-l-1-la; cb:=nm-l-lam;
    c:=if ca>cb then cb else ca;
    if c<0 then c:=0;
    si:=if c mod 2=1 then -1 else 1;
    for t:=c step -1 until 0 do
    begin
      isum:=isum+si*bin(1+lam,ca-t)*
            bin(3+lam,cb-t)*
            bin(-(2*l+3+la+lam),t);
      si:=-si;
    end inner sum;
    lp:=la+lam;
    fa2:=nmn/npn;
    lq:=if la>lam then lam else la;
    ds2:=1;
    for i:=1 step 1 until lq do
      ds2:=ds2*fa2/i/i;
    j:=if la>lam then la else lam;
    for i:=lq+1 step 1 until j do ds2:=ds2*fa2/i;
    for i:=j+1 step 1 until lp do ds2:=ds2*fa2;
    k:=(2*l+2+la+lam);
    for i:=1 step 1 until k do ds2:=ds2*i;
    sum2:=sum2+isum*s2*ds2;
    s2:=-s2;
    if test then write(out,nl,1,sp,8,
       <:  lam:>,lam,<: c:>,c,<: isum:>,isum,
          <: ds2:>,ds2,<: sum2:>,sum2);;
  end sum2;
  sum1:=sum1+sum2;
  if test then write(out,nl,1,sp,6,<:la:>,la,<: sum1:>,sum1);
end sum1;
r_2:=sum1*sum1*norm;
end r_2;

algol list.off copy.ryglobal;
if -,readbfp(<:gordon:>,hyp) then hyp:=false;
write(out,ff,1,<:exact transition integrals for H I:>,
    nl,1,if hyp then <:Gordon:> else <:Kupper:>,<: formula:>,
    nl,1,<:trans:>,sp,3,sp,4,<:<r>**2:>,sp,6,<:S:>,sp,4,
     sp,6,<:f:>,sp,6,sp,4,<:A:>);
if -,readbfp(<:test:>,test) then test:=true;
if -,readbfp(<:exc:>,exc) then exc:=true;
for l:=lmin step 1 until lmax do
begin
  if l<>lmin then write(out,nl,2);
  for n:=if nmin>l then nmin else l+1 step 1 until nmax do
  begin
  write(out,nl,1);
  for nm:=if nmin>l+1 then nmin else l+2 step 1 until nmax do
  begin
    write(out,nl,1); writenl(out,n,2*l);
    write(out,sp,2); writenl(out,nm,2*l+2);
    val:=if n=nm then 9/4*n*n*(n*n-(l+1)**2) else
      if hyp and exc then r_2_h(nm,n,l+1) else
      if hyp then r_2_h(n,nm,l+1) else
      if exc then r_2(nm,n,l+1) else
      r2(n,nm,l+1);
    dele:=(1/n/n-1/nm/nm)/2;
    Sl:=val*(l+1);
    osc:=2/3*val*dele*(l+1)/(2*l+1);
    A:=2/cau**3*dele**2*(2*l+1)/(2*l-1)*osc/t0sec*'-8;
    write(out,sp,2,<< -d.dddd'-d>,val,Sl,osc,A);
  end nm;
  end n;
end l;
write(out,ff,1);
end;
exactosc nmax.7 gordon.false test.no
exactosc nmax.7 gordon.false
mode list.no 15.no
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦d6c3206c5⟧ TextFile

Derivation

TextFile
