DataMuseum.dk

top - metrics - download

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

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

TextFile

;klab3 6 lines.2000 time.300
head 1
lookup banddlist
if ok.yes
mode list.yes
slet ryd.bandd
beskyt ryd.bandd.4
if ok.no
(bandd=set 4
permanent bandd.13)
if list.yes
bandd=algol list.yes
bandd=algol
bandd
30 10 76
external
real procedure bandd(ns1,ns2,l1,l2,n,Z);
value ns1,ns2,l1,l2,n,Z;
integer l1,l2,n,Z; real ns1,ns2;
if n>=0 and n<=2 and Z>0 and l2-l1=n and ns1>=l1 and ns2>=l2 then
  begin
  integer m1,m2,max,k,j,jmin,jmax;
  real d1,d2,w1,w2,R,Q1,Q2,sum,g,A,sj,eps;
  eps:='-4;
  d1:=ns1-l1; d2:=ns2-l2;
  w1:=ns1+l1+1; w2:=ns2+l2+1;
  A:=ns1+ns2+n+2;
  Q1:=2*ns2/(ns1+ns2); Q2:=2*ns1/(ns1+ns2);
  m1:=m2:=max:=entier(ns1+ns2+n+eps);
  if abs (round ns1-ns1)<eps then m1:=ns1;
  if abs (round ns2-ns2)<eps then m2:=ns2;
  begin
  array E1(1:m1),E2(1:m2);
  E1(1):=E2(1):=1;
  for j:=2 step 1 until max do begin
    k:=j-1;
    if j<=m1 then E1(j):=-E1(k)+(d1-k)*(w1-k)/(Q1*k);
    if j<=m2 then E2(j):=-E2(k)+(d2-k)*(w2-k)/(Q2*k);
    end;
  max:=if max+1 < m1+m2 then max+1 else m1+m2;
  R:=Q1*ns1*Q2*ns2*(ns1*ns2/(Z*(ns1+ns2)))**n*exp(ln(gamma(A-1))+
    .5*(ln(gamma(d1))+ln(gamma(d2))+ln(gamma(w1))+ln(gamma(w2))))/(ns1+ns2);
  sum:=0; g:=1;
  for k:=2 step 1 until max do begin
    jmin:=if k-m2<1 then 1 else k-m2;
    jmax:=if k-1<=m1 then k-1 else m1;
    sj:=0;
    for j:=jmin step 1 until jmax do sj:=sj+E1(j)*E2(k-j);
    sum:=sum+sj*g;
    g:=g/(A-k);
    end;
  if n<-1 then bandd:=R*sum/sqrt(bandd(ns1,ns1,l1,l1,0,Z))/
   sqrt(bandd(ns2,ns2,l2,l2,0,Z)) else bandd:=R*sum;
  end  block for arrays;
  end calculate else bandd:=0;
end
testbd=set 150
if ok.yes
testbd=algol list.yes
testbd
begin
integer nmax,n,l,n2s,l2s,gi,gf;
real r,f,dele,A,cau,t0sec,fak;
cau:=137.0372;
t0sec:=2.4189*'-11;
fak:=1/t0sec/cau**3;
nmax:=3;
readifp(<:nmax:>,nmax);
write(out,<:<12><10>Bates and Damgaard program
trans    <r>**2   E2-E1  f(abs)  A(decay):>);
for l:=0 step 1 until nmax-1 do
for n:=l+1 step 1 until nmax do
for n2s:=l+2 step 1 until nmax do
  begin
  r:=if n2s>n then bandd(n,n2s,l,l+1,1,1) else
      bandd(n2s,n,l+1,l,1,1);
  dele:=.5*(1/n2s/n2s-1/n/n);
  if dele>0 then begin gi:=2*l+1; gf:=2*l+3; end else
                 begin gf:=2*l+1; gi:=2*l+3; end;
  f:=2/3*r*r*(l+1)/gi;
  A:=4/3*dele**3*r*r*(l+1)/gf*fak;
  write(out,false add 10,if n=n2s then 2 else 1,<<dd>,n,false add ryalf(l),1,
  <: :>,n2s,false add ryalf(l+1),1,
  << -d.dddd>,r*r,dele,f,A);
  end;
end
testbd
lookup banddlist
if ok.yes
mode list.no
▶EOF◀