DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »nsresortpr«

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

<*     nsresort   resorts states after nstar and in emisson*>

procedure nsresort(bsname,parterm);
array bsname;
integer array parterm;
if chargesegdes(15)<0 and chargesegdes(16)<0  and
   chargesegdes(17)=0 then
begin comment local block for resortns;
integer i,j,k,kmax,max,trans,tottrans,sta,okdip,maxinsort,
  totaltransitions;
real lambda,oldseq,seq,cut,tau,tau2,A,osc,Sl,c,b;
boolean exchange;
own boolean first;
array bsdipname,bsdatn1,bsdipn1(1:2);
algol list.off copy.statevar;
algol list.off copy.statevar2;
integer array field dipi;
array field dipf;

procedure check(st,i);
value i; integer i;
integer array st;
begin
integer array field ifi,ifi1;
integer k;
ifi:=i*diprecsize; ifi1:=ifi+diprecsize;
if st.ifi(1)=st.ifi1(1) and st.ifi(2)=st.ifi1(2)  then 
begin
  write(out,"nl",1,"*",2,<:equal on all keys:>);
  for k:=1,2 do write(out,"sp",2,st.ifi(k),st.ifi1(k));
  end;
if st.ifi(1)>st.ifi1(1) then
  begin
  swoprecord(st,i,i+1,diprecsize);
  exchange:=true;
  end;
end check;

initrydfile(bsname(1) shift 24, real <:dip:>,segdes.dipsize,true);
for i:=1,2 do bsdipname(i):=segdes.dipname(i);
oldseq:=bsname(1);
seq:=real( long bsname(1) add 1) shift 24;
if true then write(out,"nl",1,<:sequence :>,string seq);
initrydfile(seq,real <:dat:>,segdes.datasize,false);
for i:=1,2 do bsdatn1(i):=segdes.dataname(i);
initrydfile(seq,real <:dip:>,segdes.dipsize,false);
for i:=1,2 do bsdipn1(i):=segdes.dipname(i);
keystat:=false;

if -,first then
begin
first:=true;
if -,disccopy(string inc(bsname),string inc(bsdatn1)) then 
  write(out,"*",2,<:disccopy error:>);
end first;
for i:=1,2 do bsname(i):=bsdatn1(i);


begin <*sorting of states and A's*>
integer array newindex(-1:chargestate(6)+1),
  dipval(1: if chargestate(7)=0 then 1 else chargestate(7)*diprecsize//2);
  getalldipval(bsdipname,dipval);
for i:=chargestate(6) step -1 until 0 do newindex(i):=i;
totaltransitions:=chargestate(7)-1;
newindex(-1):=0;

if statesort then
begin
algol list.off copy.stateloop;
if state <= (stateno-stateindex)//2 then
  begin
  swoprecord(states,state,(stateno-stateindex)-state,statesize);
  newindex(stateindex+state):=stateno-state;
  newindex(stateno-state):=stateindex+state;
  end swop state records;
  end stateloop;
  putstruct(bsname,states,stateindex,stateno,statesize,chargesegdes(5));
  if resortkey then
  begin
    for state:=0 step 1 until stateno-stateindex do writestaterec(states,state);
  end;
  end end end stateloop;
end statesort;

  keystat:=lookupentry(<:ryresortkey:>)=0;
  resortkey:=resortkey or keystat;
  if resortkey then
  begin
  i:=-1;
  algol list.off copy.allstatel;
  i:=i+1;
  write(out,"nl",if i mod 5=0 then 1 else 0,<< ddd>,newindex(i),"sp",4);
  writestate(out,L,n,l,J);
  write(out,if computed then "*" else "sp",1,<:,:>);
  end end allstatel;
  write(out,"nl",3);
  end resortkey;

if resortkey then
begin
 write(out,"ff",1,<:resorting branching ratios:>,"nl",2);
 writechargerec(out);
end;
okdip:=0;
algol list.off copy.allstatel;
algol list.off copy.allstatel2;
if sta<>state then
begin
  getstate(states,sta,n2,J2,seriesindex2,nstar2,Ecm2,L2,app2);
  ser:=seriesindex2*seriessize;
  l2:=series.ser(1);
  write(out,"sp",3,<:(:>);
  writestate(out,L2,n2,l2,J2);
  write(out,<:):>,okdip);
end else okdip:=okdip+1;
    if lambda>0 then
    begin
      dipval.dipi(1):=newindex(state2);
      dipval.dipi(2):=newindex(sta);
      dipval.dipf(6):=-lambda;
    end
    else
    begin
      dipval.dipi(1):=newindex(sta);
      dipval.dipi(2):=newindex(state2);
    end in emission;
end; tottrans:=tottrans+1; end allstatel2;
end end stateloop;

max:=diprecsize//2;
kmax:=totaltransitions;
maxinsort:=-1;
repeat 
  maxinsort:=maxinsort+1;
  dipi:=maxinsort*diprecsize;
until (dipval.dipi(1)=0 and dipval.dipi(2)=0)
    or maxinsort=totaltransitions;
if resortkey then write (out,"nl",2,<:first zero value in sort :>,maxinsort);
okdip:=0;
kmax:=totaltransitions-1;
k:=maxinsort+1; <*next after first zero record*>
if k<totaltransitions then
begin
repeat
  dipi:=k*diprecsize;
  if dipval.dipi(1)<>0 or dipval.dipi(2)<>0 then
  begin
   swoprecord(dipval,maxinsort,k,diprecsize);
   okdip:=okdip+1;
   maxinsort:=maxinsort+1;
  end;
  k:=k+1;
until k=kmax-1;
maxinsort:=maxinsort-2;
end else maxinsort:=maxinsort-1;
if resortkey then write(out,<:<'nl'>after removal<'nl'>maxinsort :>,
  maxinsort,<: , moved :>,okdip);
outendcur(0);
kmax:=300;
for k:=1, k+1 while exchange and k<kmax do
begin
if k mod 50=0 and resortkey then
begin
  write(out,"nl",1,<:resort k= :>,k);
  outendcur(0);
end;
exchange:=false;
for i:=0 step 1 until maxinsort do check(dipval,i);
end;
if resortkey or k>=kmax then write(out,"nl",1,<:*no of sorts :>,k,
   <: max :>,kmax);;
  putalldipval(bsdipn1,dipval);
  if resortkey then
  begin
    for i:=0 step 1 until maxinsort do
    begin
     exchange:=false; dipi:=i*diprecsize;
     check(dipval,i);
     if exchange then write(out,"nl",1,<:*out order:>,
        dipval.dipi(1),dipval.dipi(2),i);
    end;
  end;
calcdipindex(dipval,newindex);
algol list.off copy.allstatel;
puttransno(states,state,newindex(state)-newindex(state-1));
if resortkey then
  begin
  write(out,"nl",1);
  writestate(out,L,n,l,J);
  write(out,<:(:>,state,<:) trans :>,newindex(state));
  end;
end loop;
putstruct(bsname,states,stateindex,stateno,statesize,chargesegdes(5));
end stateloop;
end block for dipw;
chargesegdes(17):=-1;
i:=2*curchargestate-2;
putstruct(bsname,chargestate,i,i,chargesize,1);
i:=i+1;
putstruct(bsname,chargesegdes,i,i,chargesize,1);
bsname(1):=oldseq;
end resort ns;
▶EOF◀