DataMuseum.dk

top - metrics - download

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

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

<*          calctau  calculation of lifetimes           *>

boolean procedure calctau(bsname,parterm,chargestates);
value chargestates; integer chargestates;
array bsname;
integer array parterm;
if (lifetimes and chargesegdes(15)<0 and chargesegdes(16)=0) or
  lookupentry(<:rytaukey:>)=0 then
begin comment local block for calctau;
integer i,trans,tottrans,sta;
real tau,tau2,osc,A,Sl,lambda,c,
      cut,b;
array bsdipname(1:2);
boolean taucomputed;
algol list.off copy.statevar;
algol list.off copy.statevar2;
integer array field dipi;
array field dipf;

taucomputed:=false;
if true then begin
write(out,"nl",2,<:lifetime calculation:>,"nl",1);
writeatsym(out,S,atno,Z); write(out,"nl",2);
end;
if chargesegdes(15)<>-1 then write(out,"nl",1,"*",2,<:dipole values not computed:>);
if chargesegdes(16)<>0 then write(out,"nl",1,"*",2,<:tau allready computed:>);

initrydfile(bsname(1) shift 24, real <:dip:>,segdes.dipsize,true);
for i:=1,2 do bsdipname(i):=segdes.dipname(i);
keystat:=lookupentry(<:taukeystat:>)=0;
taukey:=lookupentry(<:rytaukey:>)=0;
taukey:=taukey or keystat;

begin
integer array dipval(1:
         if chargestate(7)=0 then 1 else chargestate(7)*diprecsize//2);
getalldipval(bsdipname,dipval);

if chargesegdes(16)<>0 then
begin
  algol list.off copy.allstatel;
  puttau(states,state,0.0);
  end end allstatel
end;

algol list.off copy.allstatel;
  if taukey then write(out,"nl",1,<:trans :>,trans);
  if computed and trans>0 then
  begin
if keystat then
  begin
    write(out,"nl",2,<:dipole record for :>);
    writestate(out,L,n,l,J);
    write(out,"sp",4,<:trans :>,trans);
    for i:=0 step 1 until trans-1 do writediprec(dipval,tottrans+i);
  end taukey;
  if taukey then write(out,"sp",2,tau);
algol list.off copy.allstatel2;
  if taukey then
  begin
  write(out,"nl",1,"*",1);
  writestate(out,L,n,l,J);
  write(out,"sp",1);
  writestate(out,L,n2,l2,J2);
  end;
    if taukey then write(out,"sp",2,sta,state2,lambda,A);
    if lambda>0 then
    begin
     tau2:=tau2+A;
     puttau(states,state2,tau2);
    end else
    tau:=tau+A;
  taucomputed:=true;
  if taukey then
  begin
     write(out,"nl",1);
     writestate(out,L2,n2,l2,J2);
     write(out,<: A =:>,<< d.ddddd>,A,<:  tau :>,tau2);
   end taukey;
   end; tottrans:=tottrans+1; end allstateloop2;
    if taukey then write(out,"nl",1,<<dd>,n,false add ryalf(l),1,
         <: t  =:>,<< -d.ddd'+ddd>,tau);
    puttau(states,state,tau);
end computed;
end state;
putstruct(bsname,states,stateindex,stateno,statesize,chargesegdes(5));
end stateloop;


algol list.off copy.allstatel;  <*invert lifetimes*>
if tau>0 then tau:=10/tau;
puttau(states,state,tau);
if taukey then 
  begin
  write(out,"nl",1,"*",1);
  writestate(out,L,n,l,J);
  write(out,<:  t = :>,tau);
  end;
end state;
putstruct(bsname,states,stateindex,stateno,statesize,chargesegdes(5));
end stateloop;

if brkey then write(out,"ff",1,<:calculation of branching ratios:>,"nl",2);

algol list.off copy.allstatel;
  if brkey then write(out,"nl",1,<:trans :>,trans);
  if computed and trans>0 then
  begin

algol list.off copy.allstatel2;
   b:=if lambda>0 and tau2>0 then A*tau2*10 else
     if tau>0 then A*tau*10 else 0.0;
   dipval.dipf(7):=b;
   if brkey then write(out,<:  b = :>,b);
   end; tottrans:=tottrans+1; end allstateloop2;
    if brkey then write(out,"nl",1,<<dd>,n,false add ryalf(l),1,
         <: t  =:>,<< -d.ddd'+ddd>,tau);
end computed;
end end stateloop;
putalldipval(bsdipname,dipval);
end dipval;
chargesegdes(16):=if taucomputed then -1 else 0;
calctau:=taucomputed;
i:=2*chargestates-1;
putstruct(bsname,chargesegdes,i,i,chargesize,1);
if taukey then write(out,"ff",1);
end calctau else
calctau:=chargesegdes(16)=-1;
▶EOF◀