⟦488067103⟧

TextFile

;klab3 6  lines.500

clear plotryseq
plotryseq=set 180
permanent plotryseq.13
lookup rydgtest
if ok.yes
mode 10.yes
lookup rydlist
if ok.yes
mode list.yes
clear rydlist rydgtest
if list.yes
plotryseq=algol list.yes
plotryseq=algol
plotryseq
20 8 77
begin
integer i,k,na,la,n,l,nmax,lmax,nmin,lmin,
  mulsel,n2a,minmul,maxmul,mul,Znetmin,
  Z,Zeff,,c,Zmin,Zmax,n2,n2m,l2,n2s,brsegm,diagsegm,
  index,jindex,n2max;
array pname,output,saven,bs(1:3);
integer array tail(1:10);
real s,j,j2;
boolean test,frame,plotprob,plotbranch,
  any,lsline,list,pldate,plotosc,first,
  plotted,plottrue,plotline,plotlambda;

procedure plotseq(n,l,A,Zmax,n2);
value n,l,Zmax,n2; integer n,l,Zmax,n2;
array A;
begin
integer index,jindex;
real ymin,ymax,An,xsi,xlay,j,j2;
xsi:=1/Zmin;
for xsi:=10*xsi while xsi<2.5 do;
if xsi<5   then xsi:=xsi*5  else
if xsi<12.5 then xsi:=xsi*2;
plotform(0,xsi+3,10);
pendown; plotmove(plotxform,0); penup;
 setmargin(1,plotyform-.8);
 writeplot(<:<12>:>);
 plotatsym(Zmin-Znetmin+1,1,mul);
   writeplot(<: sequence  :>);
 if pldate and plottertype=0 then begin
  writedate(plotz,6,0.0);
  setposition(plotz,0,0);
  end;
   writeplot(nl,1);
   if plotlambda then begin
     writeplot(<:<14>l<15>:>);
     end else
   writeplot(case c-4 of(<:A:>,<:b<38>:>,<:f:>,<:S:>,<:lambda:>));
    writeplot(<:(1/Z):>);
   if plotlambda then writeplot(<:*Z**2:>);
   writeplot(sp,2);
  writels(plotz,n,l,-1);
  setposition(plotz,0,0);
  writeplot(<: -:>);
  writels(plotz,n2,l+1,-1);
  setposition(plotz,0,0);
  plotsubform(0,plotxform,0,plotyform-2,false);
  ymin:=maxreal;
  ymax:=0;
  for j:=l+s,j-1 while j>=abs(l-s)-'-7 do
  begin
  index:=j-abs(l-s)+1;
  for j2:=j+1,j2-1 while round(j-j2)<=1 and
    j2>=abs(l+1-s)-'-7 do
  begin
  jindex:=j2-abs(l+1-s)+1;
  for Z:=Zmin step 1 until Zmax do begin
  An:=A(n2s,Z,index,jindex);
  if An<>0 then begin
  if An<ymin then ymin:=An;
  if An>ymax then ymax:=An;
  end An<>0;
  end find min and max for Z;
  end for j2;
  end for j;
    if test then write(out,<:<10>ymin,ymax plotadm:>,ymin,ymax,
      nl,1,n,n2);
    if ymin<ymax/10 then ymin:=0;
    xlay:=real (if Zmin<10 then  <<d.dd> else
    if Zmin<100 then <<d.ddd> else
     <<d.dddd>);
    if -,frame then plotadmini(1/(Zmax+5)*0.9,1/Zmin*1.1,ymin,ymax,0) else
      begin
      plotscale(1/(Zmax+5)-0.2/Zmin,1/Zmin*1.0,ymin-.2*ymax,ymax*1.2);
      plotframe(xlay,
        minlay(-ymax*0.75,-10**entier(-ln(ymax)/ln(10)),0));
      end;
    plotted:=false;
    for j:=l+s,j-1 while j>=abs(l-s)-'-7 do
    begin
    index:=j-abs(l-s)+1;
    for j2:=j+1,j2-1 while round(j-j2)<=1 and
      j2>=abs(l+1-s)-'-7 do
      begin
      jindex:=j2-abs(l+1-s)+1;
      first:=true;
      for Z:=Zmax step -1 until Zmin do
        begin
        An:=A(n2s,Z,index,jindex);
        if An<>0 then begin
         if test then write(out,<:<10>:>,Z,An);
         plotmove(1/Z,An);
         if first then begin
          first:=false;
          pendown;
          plotted:=true;
          end;
          end An<>0;
       end Z;
    penup;
    for Z:=Zmin step 1 until Zmax do begin
      An:=A(n2s,Z,index,jindex);
      if An<>0 then plotpoint(1/Z,An,j+j2-l);
      end plotpoint;
    if plotted and lsline then
    begin
      plotmove(plotxpos-plotsize/deltax*10,plotypos);
      writeplot(<<d>,2*j,<:/2-:>,2*j2,<:/2:>);
    end plot j;
  plotted:=false;
    end j2;
    end j;
  end plotseq;

frame:=plottrue:=true;
plotlambda:=plotline:=
pldate:=list:=plotprob:=plotosc:=plotbranch:=test:=false;
Z:=1;
mulsel:=0;
readifp(<:multiplicity:>,mulsel);
readbfp(<:pldate:>,pldate);
readbfp(<:frame:>,frame);
readbfp(<:test:>,test);
readbfp(<:list:>,list);
readbfp(<:osc:>,plotosc);
readbfp(<:probabilities:>,plotprob);
readbfp(<:branch:>,plotbranch);
readbfp(<:linestrength:>,plotline);
readbfp(<:lambda:>,plotlambda);
readbfp(<:wawelength:>,plotlambda);
readbfp(<:test:>,test);
packtext(pname,<:tek4006a:>);
readsfp(<:plotname:>,pname);
plotosc:=plotosc or -,(plotprob or plotbranch or
  plotlambda or plotline or false);
i:=1;
setplotname(string pname(increase(i),0));
cleararray(saven);
readsfp(<:savename:>,saven);
i:=lookuptail(saven,tail);
if -,(i=0 or i=6) then begin
  cleararray(tail);
  tail(1):=100;
  i:=createentry(saven,tail);
  if i<>0 then alarm(<:***create entry save :>,string inc(saven),i);
  permentry(saven,13);
  end;
readbfp(<:plot:>,plottrue);
saveplot(if plottrue then 1 else 0,string inc(saven),0);
packtext(bs,<: unknown:>);
 readinfp(bs,1);
 if fpinareas>0 then bs(2):=real <:ofz:>;
 i:=lookuptail(bs,tail);
 if i>0 or tail(1)<0 or fpinareas=0 then alarm(<:***inputarea  :>,
  string inc(bs),<: :>,i);
 stackcuri;
 i:=connectcuri(bs);
 if i<>0 then alarm(<:***connect  :>,string inc(bs),i);
setposition(in,0,0);
inrec(in,128);
nmax:=in(1); lmax:=in(2);
n:=nmin:=in(3); l:=lmin:=in(4);
Zmin:=in(5); Zmax:=in(6);
brsegm:=in(7);
mul:=in(9);
maxmul:=in(10);
if maxmul mod 2=1 and mul mod 2 =0 then maxmul:=maxmul-1;
minmul:=maxmul mod 2 +(if maxmul mod 2=0 then 2 else 0);
Znetmin:=in(19);
diagsegm:=in(17);
lsline:=abs(in(128)-1)<'-7;
if mulsel<>0 then mul:=mulsel;
s:=if lsline then (mul-1)/2 else 0;
readifp(<:n:>,n);
readifp(<:l:>,l);
n2:=n2max:=n+1; l2:=lmax;
readifp(<:nmax:>,n2max);
if list then begin
if fpout then begin
  readlsfp(output);
  stackcuro;
  i:=connectcuro(output);
  if i<>0 then begin
    unstackcuro;
     j:=1; alarm(<:***connect output :>,string inc(output),i);
    end;
  end;
  write(out,<:<12>:>);
end;
if Zmin>=Zmax then alarm(<:***Zvalues :>,Zmin,Zmax);
if test then write(out,<:<10>mul,maxmul :>,mul,maxmul);
begin
  array A(nmin:n2max,Zmin:Zmax,1:mul,1:mul);
  boolean array found(nmin:n2max,1:mul,1:mul);
  setposition(in,0,diagsegm*(Zmax-Zmin+1)+2);
  for n2s:=nmin step 1 until n2max do
  for i:=1 step 1 until mul do
  for k:=1 step 1 until mul do
  for Z:=Zmin step 1  until Zmax do A(n2s,Z,k,i):=0;
  na:=la:=-1;
  i:=0;
  for i:=i+1 while true do
  for Z:=Zmin step 1 until Zmax do
    begin
    inrec(in,16);
    na:=in(1); la:=in(2);
    if na=n and la=l then goto ES;
    end;
  ES: n2m:=in(3);
  if plotprob then c:=5 else
  if plotbranch then c:=6 else
  if plotosc then c:=7 else
  if plotline then c:=8 else
  if plotlambda then c:=9;
  if list then
  write(out,<:<10>:>,<<d>,Zmin,<:<=Z<=:>,Zmax,
    <:<10>from :>,n,false add ryalf(l),1,<: to :>,
    nmin,false add ryalf(l+1),1,
    <:-:>,n2max,false add ryalf(l+1),1,
    <:<10> Z   state     value:>);
  cleararray(found);
 for j:=l+s,j-1 while j>=abs(l-s)-'-7 do
  begin
  index:=j-abs(l-s)+1;
  for n2s:=if nmin<=l+2 then l+2 else nmin step 1 until nmax do
  for j2:=j+1,j2-1 while round(j-j2)<=1 and
    j2>=abs(l+1-s)-'-7 do
  begin
  jindex:=j2-abs(l+1-s)+1;
  na:=in(3); la:=in(4);
  if list then write(out,<:<10>:>);
  for Z:=Zmin step 1 until Zmax do
   begin
   Zeff:=Z-Zmin+1;
   if in(16)>0 and na<=n2max then begin
   if Z-Zmin+1<>in(16) then write(out,<:<10>**Zerror :>,Z-Zmin,in(16),na);
   if n<>in(1) or l<>in(2) or in(3)>nmax or in(4)<>l+1 or
     na<>n2s or la<>l+1 or j<>in(14) or j2<>in(15) then
      begin
      write(out,nl,1,star,2);
      writels(out,n,l,j); write(out,sp,1);
      writels(out,n2s,l+1,j2); write(out,sp,3);
      writels(out,in(1),in(2),in(14)); write(out,sp,1);
      writels(out,na,in(4),in(15));
      end else
   if in(9)=0 then A(na,Z,index,jindex):=0 else begin
    found(na,index,jindex):=true;
    if plotlambda then in(c):=in(c)*Zeff*Zeff;
    A(na,Z,index,jindex):=abs in(c);
    end calculated;
   if list then write(out,<:<10>:>,<<dd>,Z,<:  :>,n,false add ryalf(l),1,
         <: :>,na,false add ryalf(la),1,<<  -d.dddd>,A(na,Z,index,jindex));
   end A<>0;
   inrec(in,16);
    end get values;
    end j2;
  end j;
if list then outend(12);
for n2s:=if nmin<l+1 then l+1 else nmin step 1 until n2max do
  begin
  any:=false;
  for j:=l+s,j-1 while j>=abs(l-s)-'-7 do
  for j2:=j+1,j2-1 while round(j-j2)<=1 and
    j2>=abs(l+1-s)-'-7 do
  begin
  index:=j-abs(l-s)+1;
  jindex:=j2-abs(l+1-s)+1;
  any:=any or found(n2s,index,jindex);
  end search;
  if operatorkey(false) then goto END;
  if any then plotseq (n,l,A,Zmax,n2s);
  end end n2s;
END:
if fpout then closeout;
end;
mode list.no 10.no
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦488067103⟧ TextFile

Derivation

TextFile
