DataMuseum.dk

top - metrics - download

    Length: 1536 (0x600)
    Types: TextFile
    Names: »tw6j«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦09b4e9619⟧ »thcømat« 
            └─⟦this⟧ 

TextFile

w6j=algol
external
real procedure sehx6j(j1,j2,j3,j4,j5,j6,g);
value j1,j2,j3,j4,j5,j6;
integer j1,j2,j3,j4,j5,j6;
real array g;
begin comment:  S.E.Harnung.  Calcd. of 6-j symbols;
 integer a,b,c,d,e,f,r,ri,ra,i,abc,aef,dbf,dec,s1,s2,s3;
 real s,t;
 boolean x;
 abc:=(a+b+c) shift (-1); aef:=(a+e+f) shift (-1);
 dbf:=(d+b+f) shift (-1); dec:=(d+e+c) shift (-1);
 s:=abc; t:=aef;
 x:=j1+j2+j3<>s or j1+j5+j6<>t;
 s:=dbf; t:=dec;
 x:=x or j4+j2+j6<>s or j4+j5+j3<>t;
 if x then system(9,6,<:<10>6j-input:>);
 s:=0;
 x:=a>b+c or b>a+c or c>a+b;
 x:=x or a>e+f or e>a+f or f>a+e;
 x:=x or d>b+f or b>d+f or f>d+b;
 x:=x or d>e+c or e>d+c or c>d+e;
 if x then goto ASS;
 s1:=abc+dbf-b-c-f;
 s2:=dbf+dec-d-c-f;
 s3:=abc+dec-c+1;
 ri:=0;
 ra:=abc-c;
 for i:=1,2 do
 begin
  r:=case i of (s1,s2);
  if r>ri then ri:=r;
  r:=case i of (s3,dec-c);
  if r<ra then ra:=r;
  r:=case i of (aef-f,dbf-f);
  if r<ra then ra:=r
 end;
 if ra<ri then goto ASS;
 t:=sqrt(g(abc-a)*g(abc-b)*g(abc-c)/g(abc+1)
        *g(aef-a)*g(aef-e)*g(aef-f)/g(aef+1)
        *g(dbf-d)*g(dbf-b)*g(dbf-f)/g(dbf+1)
        *g(dec-d)*g(dec-e)*g(dec-c)/g(dec+1));
 for r:=ri step 1 until ra do
  s:=s+(if false add r then -1 else 1)/g(r)
   /g(abc-c-r)/g(aef-f-r)/g(dbf-f-r)/g(dec-c-r)
   *g(s3-r)/g(r-s2)/g(r-s1);
 ASS:
 sehx6j:=(if false add (s3-1) then -1 else 1)*s*t
end sehx6j;
end\f


▶EOF◀