⟦657042808⟧

TextFile

<*          plotosc  plotting of lifetimes           *>

boolean procedure plottauosc(bsname,parterm,chargestates);
value chargestates; integer chargestates;
array bsname;
integer array parterm;
if  chargesegdes(15)<0 and chargesegdes(16)<0  then
begin comment local block for plotosc;
integer i,trans,tottrans,sta,lpos,st,avc,c1,torder,sig,nm,
  newstate,n2a,seriesindex2a,L2a,J2a,state2a;
real tau,tau2,osc,A,Sl,lambda,c,
      cut,b;
array xmin,xmax,ymin,ymax,taumin,taumax(0:7);
real tfak,pls,plh,he,le,les,plxdis,plydis,
      xsize,ysize,bmax,nsmean,rectsize1,rectsize2,rectx1,rectx2,
      dlm,nv,n2v,layt;
array bsdipname(1:2),nsav(0:maxstates-1);
algol list.off copy.statevar;
algol list.off copy.statevar2;
integer array field dipi;
array field dipf;
if taukey then begin
write(out,"nl",2,<:lifetime plotting:>,"nl",1);
end;

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

begin
integer array dipval(1:chargestate(7)*diprecsize//2);
getalldipval(bsdipname,dipval);
for i:=0 step 1 until 7 do 
begin
  xmax(i):=ymax(i):=taumax(i):=0;
  xmin(i):=ymin(i):=taumin(i):=maxreal;
end;
for i:=0 step 1 until maxstates-1 do nsav(i):=0;


algol list.off copy.allstatel;  <*calculate max and min*>
if nstar<nsmax and l<=lmax then
begin
if taukey then 
  begin
  write(out,"nl",1,"*",1);
  writestate(out,L,n,l,J);
  write(out,<:  t = :>,tau);
  end;
if l//2>xmax(cores) then xmax(cores):=l//2;
if l//2<xmin(cores) then xmin(cores):=l//2;
if nstar>ymax(cores) then ymax(cores):=nstar;
if nstar<ymin(cores) then ymin(cores):=nstar;
if tau>taumax(cores) then taumax(cores):=tau;
if tau<taumin(cores) then taumin(cores):=tau;
if false then 
  write(out,"nl",1,<:xmin :>,xmin(cores),<: xmax:>,xmax(cores),
     <: ymin:>,ymin(cores),<: ymax:>,ymax(cores),
     <: cores:>,cores);
nsmean:=nstar;
newstate:=state;
if finestruct and l>0 then
begin
  st:=0; avc:=1;
  for i:=abs(l-S)+2 step 2 until l+S do
  begin
  st:=st+1;
  if state+st<maxstates then
  begin
  getstate(states,state+st,n2,J2,seriesindex2,nstar2,Ecm2,L2,app2);
  ser2:=seriesindex2*seriessize;
  l2:=series.ser(1);
  if n=n2 and l=l2 and L=L2  and computed then
  begin
    avc:=avc+1;
    nsmean:=nsmean+nstar2;
    newstate:=state+st;
  end;
  end state<maxstates;
  end i;
  nsmean:=nsmean/avc;
end finestruct;
for st:=state step 1 until newstate do nsav(state):=nsmean;
state:=newstate;
end n*<n*max;
end end stateloop;
keystat:=true;

algol list.off copy.allstatel;
end for state;
keystat:=false;
for cores:=0 step 1 until chargestate(4) do
begin
pardes:=parentsize*cores;
S:=parterm.pardes(6);
xmin(cores):=xmin(cores)/2;

tfak:='3;
lpos:=5;
if taumax(cores)>1 then tfak:=1;
if taumin(cores)>='-5 and taumax(cores)<9.99 then tfak:='3 else
if taumin(cores)<0.1 and tfak=1 then lpos:=6;
if taumax(cores)>'5 then lpos:=6;
if list then write(out,false add 10,4,<:   trans   f      b<37>:>);

xfactor:=size*xfactor;
yfactor:=size*yfactor;

pls:=.2*charfactor;
plh:=sqrt2*pls;

les:=le:=pls*(lpos+1);
if finestruct then les:=2*les;
plxdis:=le-pls;
xsize:=le+(xmax(cores)-xmin(cores))*les+(xmax(cores)-xmin(cores)+2)*plxdis;

he:=plh*2;
plydis:=6*plh;
ysize:=plydis*(ymax(cores) - ymin(cores));

plotxform:=entier (xsize*xfactor);
plotyform:=entier (ysize*yfactor+4*he*size);
if plotxform<0 or plotyform<0 or plotxform>50 or plotyform>50 then
write(out,"nl",1,"*",2,<:format trouble , cores :>,cores,"nl",1,
 <:xfactor :>,xfactor,<: yfactor:>,yfactor,<: size:>,size,"nl",1,
 <:xmin:>,xmin(cores),<: max :>,xmax(cores),<: ymin:>,ymin(cores),<: ymax:>,ymax(cores),"nl",1,
 <:plxdis:>,plxdis,<: plydis:>,plydis);
if plottest then write(out,"nl",1,"*",1,<:format :>,plotxform+1,plotyform+1);
if plotno then else
if -,plotform(0,plotxform+1,plotyform+1) then alarm(<:***format:>);
plotsettext(pls*size,plh*size,0,0,0);
he:=he*size;
dlm:=if finestruct then .25 else .1;
plotspline:=true;
if mode2 then begin
  if xmax(cores)<4 then setmargin(plotxform-22*plotsize,2*plotheight) else
  if xmax(cores)>8 then setmargin(plotxform-5*size-22*plotsize,20*plotheight) else
    setmargin(plotxform-2.5*size-22*plotsize,3*plotheight);
    end else setmargin(2*plotsize,plotyform-3*plotheight);
if xmax(cores)>4 then plotsettext(plotsize*1.25,plotheight*1.25,0,0,0);
if xmax(cores)>8 then plotsettext(plotsize*1.5,plotheight*1.5,0,0,0);
if plotno then else
begin
writeplot(<:<12>:>);
plotatsym(S,atno,Z);
writeplot(<:(:>);
plotatsym(S,segdes(1),1);
if -,mode2 then begin
writeplot(<: sequence):>);
if pname(2)<>real <:06a:> then 
  begin
if pldate then begin
  writedate(plotz,6);
  setposition(plotz,0,0);
  end;
writeplot(<:<10>lifetimes:>,
  if tfak>1 then <:(ps):> else <:(ns):>,
  <:<10>relative transition strengths:>);
writeplot(<:<10>:>);
pendown;
plotmove(plotxpos+1.2*xfactor,plotypos);
penup;
writeplot(<: b>=:>,if brsmin<10 then <<d.d> else <<dd>,brsmin,<:<37>:>);
writeplot(<:<10>:>);
setmask(.2,.15,.2);
pendown; plotmove(plotxpos+1.2*xfactor,plotypos); penup;
setmask(0,0,0);
writeplot(<< dd>,brsmin,<:<37>>b>=:>,<<dd>,brmin,<:<37>:>);
end not display;
end mode1 else begin
  writeplot(<:):>);
  plotmove(plotxpos-5*plotsize,plotypos+2*plotheight);
  writeplot(<:<14>t<15>:>,if tfak>1 then <:(ps):> else <:(ns):>);
  end mode2;
end plotted;
if xmax(cores)>8 then plotsettext(plotsize*2/3,plotheight*2/3,0,0,0);
if xmax(cores)>4 then plotsettext(.8*plotsize,.8*plotheight,0,0,0);
stateno:=parterm.pardes(10);
if plottest or taukey then 
  write(out,"nl",2,<:cores :>,cores,<:first state :>,parterm.pardes(9),
     <: last state :>,stateno);
for state:=parterm.pardes(9) step 1 until stateno do
begin
  getstate(states,state,n,J,seriesindex,nstar,Ecm,L,app);
  ser:=seriesindex*seriessize;
  l:=series.ser(1);
  computed:=getcomputed(states,state,cutcase,cut);
  tau:=gettau(states,state);
  if L<0 then L:=l;
  trans:=gettransno(states,state);
rectsize2:=les;
rectsize1:=if l>0 then rectsize2 else le;
rectx1:=(if l=0 then plxdis+le/2 else
 le+(l//2+1)*plxdis+(l//2-1/2)*les)*xfactor;
rectx2:=(le+(l//2+2)*plxdis+(l//2+1/2)*les)*xfactor;
nsmean:=nsav(state);
newstate:=state;
if plottest then
  begin
  write(out,"nl",1,"*",1);
  writestate(out,L,n,l,J);
  write(out,nsmean,tau,state);
  end;
if  computed then
begin
  nv:=(nsmean-ymin(cores))*plydis*yfactor+2*he;
  if plotno or nsmean<='-7 then else
  begin
  if mode2  then begin
    plotmove(rectx1-2*plotsize,nv+(.50*he+plotheight*.4));
    writeplot(<<dd>,n,false add ryalf(l),1);
  end mode2;
  plotrect(rectx1,nv,rectsize1*size,he);
  plotmove(plotxpos+plotsize/4,nv-plotheight/2);
  if -,mode2 then
  begin
  plotmove(plotxpos-4*plotsize,plotypos);
  writeplot(<<dd>,n,false add ryalf(l),1,<: :>);
  end mode2;
  end plotting;
  st:=-1;
  for J2:=abs(l-S),J2+2 while J2<=l+S do
  begin
  st:=st+1;
  tau:=0;
  if state+st<=stateno then
  begin
  getstate(states,state+st,n2,J2,seriesindex2,nstar2,Ecm2,L2,app2);
  ser2:=seriesindex2*seriessize;
  l2:=series.ser2(1);
  if L2<0 then L2:=l2;
  if n=n2 and L=L2 and l=l2 then
  begin
    newstate:=state+st;
    tau:=gettau(states,newstate);
  end found;
  end state<max;
  if tau>0 then
  begin
    tau:=tau*tfak;
    torder:=entier(ln(tau)/ln(10)+1);
    if finestruct and J2>abs(l-S) and (torder=3 or torder=4) then
      write(out,"sp",1);
    if torder<0 and lpos=6 then layt:=real <<d.dddd> else
    if torder<0 then layt:= real <<d.ddd> else
    if torder>5 then layt:=real <<d.dd'd> else
    layt:=real (case torder+1 of(
    <<d.ddd>,
    << d.dd>,
    << dd.d>,
    << ddd>,
    <<dddd>,
    <<ddddd>));
    if -,plotno and nsmean>'-7 then
      writeplot(string layt,tau,"sp",if torder=3 or torder=4 then 2 else 1);
  end tau>0 else
  if l>0 and finestruct and J2<l+S and -,plotno  and nsmean>'-7 then
    writeplot("sp",lpos);
  end J2;
  if l//2<round(2*xmax(cores)) then
  c1:=0;
  algol list.on copy.allstatel2;
    bmax:=b;
    n2v:=(nsav(state2)-ymin(cores))*plydis*yfactor+2*he;
  state2a:=state2;
  J2a:=l2-S;
  for J2a:=J2a+2 while J2a<=l2+S and state2a<stateno-1 do
  begin
    state2a:=state2a+1;
    if plottest then write(out,"sp",2,<:2a:>,state2a);
    getstate(states,state2a,n2a,0,seriesindex2a,0.0,0.0,L2a,0);
    if L2a<0 then L2a:=l2;
    if seriesindex2a=seriesindex2 and n2a=n2
      and L2a=L2 and trans>1 and tottrans<maxtrans then
    begin
      message j2a loop;
      dipi:=dipf:=diprecsize*(tottrans+1);
      if state=dipval.dipi(1) and state2a=dipval.dipi(2) then
      begin
        if bmax<dipval.dipf(7) then bmax:=dipval.dipf(7);
        tottrans:=tottrans+1;
        trans:=trans-1;
      end;
    end;
  end;
    b:=bmax;
    n2v:=(nsav(state2)-ymin(cores))*plydis*yfactor+2*he;
      if plottest then
      begin
       write(out,"nl",1);
       writestate(out,L2,n2,l2,J2);
       write(out,<: b<37> =:>,b,state2);
      end test;
      if n2v>'-8 and abs b>=brmin then begin
      sig:=sign(nv-n2v);
      nm:=n mod 2+2;
      if plotosc and -,plotno and nsmean>'-7 then begin
      plotmove(l//2+.5+1/(nm+1),(nm*nv+n2v)/(nm+1)+sig*plotheight/2/deltay);
      writeplot(<<d.ddd>,osc);
      end plotosc;
     if b<brsmin then setmask(.2,.15,.2);
    if plotno or nsmean<='-7 then else
    begin
    if c1 mod 2=0 then
      plottr(rectx1,nv,rectx2,n2v,rectsize1,rectsize2,he,dlm) else
      plottr(rectx2,n2v,rectx1,nv,rectsize2,rectsize1,he,-dlm);
    end plotting;
      setmask(0,0,0);
    c1:=c1+1;
    end b>brmin;
  end; tottrans:=tottrans+1; end allstatel2;
  end nsmean>0;
  for st:=state+1 step 1 until newstate do
  begin
  trans:=gettransno(states,st);
  tottrans:=tottrans+trans;
  end;
  state:=newstate;
end for cores;
end end allstatel;
end dipval;
plotclose;
if test then outendcur(10);
end plottrans;
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦657042808⟧ TextFile

Derivation

TextFile
