DataMuseum.dk

top - metrics - download

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

└─⟦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

<*                  ryortpr   calculation of orthogonal matrixelements      *>
<*79-12-08*>

procedure ryort(bsname,parterm);
integer array parterm;
array bsname;
if orto then
begin
integer i,dl,ii,k,ngr,em,sq,n1c,sgc,Jc,trans,l22;
real cut,dele,del,x,h,hp,r2,w,
      rm1,ov,ovl,
      rmax,ymax,r1me,re,r2e,layr,layr1m,layovl,layr2;
boolean page1,plb;
array ry1,ry2(1:(segm-1)*128),bsoname(1:3);
algol list.off copy.statevar;
algol list.off copy.statevar2;

keystat:=survey:=false;

prno:=5;
dl:=0;
plb:=false;
page1:=true;
page:=1;
algol list.off copy.stateloop;
  computed:=getcomputed(states,state,cutcase,cut);
  ncur:=n; lcur:=l; jcur:=J;
  if offkey then write(out,"nl",1,<<dd>,n,false add ryalf(l),1,
    <:  n*  :>,nstar);
  henta(ryf,(state+stateindex)*segm+1,ry1,segm-1);
  algol list.off copy.stateloop2;
  if computed2 and J=J2 and l=l2 and (state2+stateindex2)>=(state+stateindex) then 
  begin
  setrydwhere(<:ryort:>,n,l,n2,l2);
  operator(false);
  cpu:=systime(1,0,time);
  henta(ryf,(state2+stateindex2)*segm+1,ry2,segm-1);
  if offkey then write(out,"nl",1,"*",1,<<dd>,n,false add ryalf(l),1,
    "sp",2,n2,false add ryalf(l2),1,<: cut :>,<<  dd.d0>,cut);
  dele:=E2-E;
  rm1:=r2:=h:=ovl:=ymax:=0;
NE(-1):=0;
for sq:=q-1 step -1 until 0 do
  begin
  del:=DE(sq);
  x:=B(sq+1);
  ngr:=NE(sq-1)+1;
  if ngr<1 then ngr:=1;
  for k:=NE(sq) step -1 until ngr do
    begin
      if abs ry1(k)>ymax then begin ymax:=abs ry1(k); rmax:=x end;
      ov:=ry1(k)*ry2(k)*del;
      ovl:=ovl+ov;
      hp:=ov*x;
      h:=h+hp;
      rm1:=rm1+ov/x;
      r2:=r2+hp*x;
      x:=x-del;
    end;
end;
if (lin>=maxlines-1-(n2+1) or page1) then begin
  writepage(page,cores,parterm);
  if page1 then
  begin
    head(r); writeparam;
    lin:=10;
  write(out,"nl",2,<:orthogonality of wawefunctions:>);
  page1:=false;
end;
n1c:=n; Jc:=J;
write(out,"nl",2,<:state:>,"sp",if finestruct then 7 else 2,
  <:overlap:>,<:<1/r>:>,"sp",2,
  <:<1/r>e:>,"sp",2,<:<r>:>,"sp",2,<:<r>e:>,"sp",2,<:<r**2>:>,"sp",1,
  <:<r**2>e:>,"sp",2,<:cut:>);
end;
r1me:=1/nstar**2;
l22:=(l*(l+2))//4;
re:=(3*nstar**2-l22)/2;
r2e:=nstar**2/2*(5*nstar**2+1-3*l22);
layovl:=real <<-d.dddd>;
layr1m:=real << d.dddd>;
layr:= real << d.ddd>;
layr2:= real << dd.ddd>;
if abs h>=10 or (n=n2 and re>= 10) then layr:=real << ddd.d>;
if abs r2>=100 or (n=n2 and r2e>=100) then layr2:=real << dddddd>;
write(out,"nl",if n1c<>n or J<>Jc then 2 else 1);
writestate(out,L,n,l,J);
write(out,"sp",1);
writestate(out,L2,n2,l2,J2);
write(out,string layovl,ovl);
if n<>n2 then write(out,"sp",14) else
write(out,string layr1m,rm1,r1me);
write(out,string layr,abs h);
if n<>n2 then write(out,"sp",6) else
  write(out,string layr,re);
write(out,string layr2,abs r2);
if n=n2 then write(out,string layr2,r2e,<< dd.ddd>,cut);
if n=n2 and autcut then write(out,"sp",2,case cutcase+1 of(
      <:no:>,<:min:>,<:max:>,<:div:>,<:zero:>,<:n*< :>,
      <:err:>,<:<r>HF:>,<:exact:>));
lin:=lin+(if n1c<>n then 2 else 1); 
n1c:=n; Jc:=J;
end computed2 and l=l2;
end end end stateloop2;
end end end end stateloop;
ncur:=0;
end ryort;
▶EOF◀