DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦bcc466482⟧ TextFile

    Length: 20736 (0x5100)
    Types: TextFile
    Names: »rydgen1txt«

Derivation

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

;ali time.200 lines.2500

(mode list.yes 
o allist
lookup rydgen1txt
rydgen1=set 200 disc3
scope day rydgen1
kjh=lookup alutproc ryproc rydseg rydstruct ryglobal,
statevar stateloop ionloop coreproc
if ok.no
extract from.crypr alutproc ryproc rydseg rydstruct ryglobal  ,
statevar stateloop ionloop coreproc
lkj=lookup allstatel
if ok.no
extract from.crypr allstatel
lkj=lookup rydritz
if ok.no
extract from.cryprog rydritz
clear temp lkj
lookup rydterm
if ok.yes
mode 11.yes
lookup rydlist
if ok.yes
mode 15.yes
if 11.yes 15.no
o rydterm
rydgen1=algol blocks.yes
o c
finisb
mode 10.no 15.no list.no)
rydgen1
1980-11-10
begin
integer i,j,k,inpi,maxseries,maxparents;
boolean plus,extendl,linelist,inch,
  pass1,pass2,pass3,sortlines,fit;
array output,FP(1:3),BSi(1:10,1:3);
zone out1(128,1,stderror);

procedure writeinch(out,l);
value l; real l;
zone out;
if inch and abs l<1200 then
begin
real k,m,a,sina,d;
l:=abs l;
k:=87.282;
a:=82/180*pi;
d:='7/600;
m:=1;
write(out,"sp",2,<<dd.dd>,k*sqrt(1-((d*sin(a)-m*l)/d)**2));
end writeinch;

procedure liststates(bsname,parterm);
array bsname;
integer array parterm;
begin
algol list.off copy.statevar;
integer lg,trans;
boolean first;
first:=true;
lg:=0;
algol list.off copy.stateloop;
if first then
begin
  write(out,"nl",2,<:state:>,"sp",10,<:cm-1:>,"sp",8,<:n*:>);
  if pass2 and -,pass1 then write(out,"sp",8,<:trans:>);
  first:=false
end first;
      write(out,"nl",if l<>lg and -,first then 2 else 1);
      lg:=l;
      writestate(out,L,n,l,J);
      write(out,<<-dd ddd ddd.ddd>,Ecm,<< dddd.dddddd>,nstar);
      if pass2 and -,pass1 then
        begin
        trans:=gettransno(states,state);
        write(out,"sp",4,<< ddd>,trans);
        end;
end end end end stateloop;
end list states;

procedure write_line_list(out,S,series,first,last,state,parterm,inch);
value S,first,last,inch;
integer S,first,last;
boolean inch;
integer array series,state,parterm;
zone out;
begin
integer serno,state1,state2,n1,n2,l1,l2,J1,J2,L1,L2,
  app1,app2,i1,i2,lines,maxlines,z2,lcount;
real Ecm,lambda,e1,e2,nstar1,nstar2,Ecm1,Ecm2;
boolean test;
integer array field ser2;
real field lam;
integer field s1,s2;
integer array field ia;
array linelist(1:(if sortlines then chargestate(7)*2 else
       0)+1);

procedure linesort(lin,no);
value no; integer no;
array lin;
begin
array field a1,a2;
boolean exchange;
integer i,j,k,max;
real w;

max:=5000;
no:=no-1;

for k:=1,k+1 while exchange and k<max do
begin
  exchange:=false;
  for i:=1 step 1 until no do
  begin
    a2:=i*8;
    a1:=a2-8;
    if lin.a1(2)>lin.a2(2) then
    begin
      for j:=1,2 do
      begin
        w:=lin.a1(j); lin.a1(j):=lin.a2(j);
        lin.a2(j):=w;
      end move;
    exchange:=true;
   end -,inorder;
  end loop states;
end k loop
if k>=max then write(out,"nl",1,"*",2,<:sorting error k =:>,
     k,<: records =:>,no+1);
end linesort;

procedure writeNL;
begin
if lines mod maxlines<>0 then write(out,"nl",1) else
begin
  if lines>=maxlines then write(out,"ff",1);
  write(out,"nl",1,"sp",21,<:lambda Å:>,"sp",2);
  if inch then write(out,"sp",2,<:inch:>);
  write(out,"nl",1);
  lines:=lines+2;
end;
lines:=lines+1;
end writeNL;

test:=false;
lcount:=0;
s1:=2; s2:=4; lam:=8;
ia:=0;
lines:=0; maxlines:=60;
ser:=first*seriessize;
z2:=chargestate(1)**2;
Ip:=getIp(series.ser(4),parterm);
write(out,"ff",1,"nl",2,<:Linelist for :>);
writeatsym(out,chargestate(2),chargestate(3),chargestate(1));
write(out,"nl",1,<:Ionisation potential :>,<< dddddddddd.dd>,Ip);
write(out,"nl",2);
writeNL;
lines:=lines+4;
if test then write(out,"nl",3,<:first :>,first,<: last :>,last);
for serno:=first step 1 until last-1 do
begin
  ser:=serno*seriessize;
  ser2:=ser+seriessize;
  l1:=series.ser(1); l2:=series.ser2(1);
  writeNL;
  if test then write(out,"nl",2,false add ryalf(l1),1,
    <:-1.state :>,series.ser(2),
    false add ryalf(l2),1,<:-2. state :>,series.ser(3));
  for state1:=series.ser(2) step 1 until series.ser(3) do
  begin
    getstate(state,state1,n1,J1,i1,nstar1,Ecm1,L1,app1);
    e1:=-1/2/nstar1/nstar1;
    for state2:=series.ser2(2) step 1 until series.ser2(3) do
    begin
    getstate(state,state2,n2,J2,i2,nstar2,Ecm2,L2,app2);
    e2:=-1/2/nstar2/nstar2;
    lambda:=if abs(e2-e1)>'-11 then '8/(Econv*(e2-e1)*z2) else maxreal;
    if Jtest(J1,J2,l1,l2,S,nstar2-nstar1)  and abs(L2-L1)<=2 and
      i1+1=i2 and lambda<maxreal then
    begin
    if -,sortlines then
    begin
      writeNL;
      writestate(out,L1,n1,l1,J1); write(out,"sp",2);
      writestate(out,L2,n2,l2,J2);
      write(out,<< -dddddddddd.dd>,lambda);
      writeinch(out,lambda);
    end else
    begin
      linelist.ia.s1:=state1;
      linelist.ia.s2:=state2;
      linelist.ia.lam:=abs lambda;
      lcount:=lcount+1;
      ia:=ia+8;
    end sortlines;
    end allowed;
    end state2;
  end state1;
end series;
if sortlines then
begin
  linesort(linelist,lcount);
  for i:=1 step 1 until lcount do
  begin
    ia:=(i-1)*8;
    state1:=linelist.ia.s1;
    state2:=linelist.ia.s2;
    getstate(state,state1,n1,J1,i1,nstar1,Ecm1,L1,app1);
    ser:=i1*seriessize;
    l1:=series.ser(1);
    getstate(state,state2,n2,J2,i2,nstar2,Ecm2,L2,app2);
    ser2:=i2*seriessize;
    l2:=series.ser2(1);
    writeNL;
    writestate(out,L1,n1,l1,J1); write(out,"sp",2);
    writestate(out,L2,n2,l2,J2);
    write(out,<< -ddddddddd.ddd>,linelist.ia.lam);
  end lcount;
end sortlines;
end write_line_list;


procedure rydgen_pass_1(name);
array name;
if pass1 then
begin
integer res,c,char,L,n,l,J,cor,cores,state,
 charge_states,series_index,stateno,app,
 stateindex,diptrans,charge_seg_no,diasegm,dipsegm;
real Eau,Ecm,nstar;
boolean endcond,endion,endstate,b,keystat,segstat,cm1;
array bsrefname,bsname(1:3),txt(1:10);
integer array tail(1:10);
zone ref(128,1,stderror);

initrydproc(1,1,1,1);
initrydseg;
initrydfile(name(1),real <:ref:>,2*Zmax+2,false);
for c:=1,2 do bsrefname(c):=segdes.refname(c);
cm1:=false;
c:=1;
open(ref,4,string bsrefname(increase(c)),0);
setposition(ref,0,0);

connectin(name);
for c:=readchar(in,char) while c>6 and char<>59 and char<>25 do;
if char= 59 <*;*> then begin
  if survey then outchar(out,10);
  outchar(ref,10);
  for c:=readchar(in,char) while char<>59 and char<>25 do
  begin
  if survey then outchar(out,char);
  outchar(ref,char);
  end;
if survey then outchar(out,10);
outchar(ref,10);
end;
repeatchar(in);
for c:=readchar(in,char) while c>6 and char<>25 do;
electrons:=1;
if char=101 <*electrons*> then read(in,electrons);
if electrons<1 or electrons>3 then alarm("nl",1,"*",3,<:electrons:>,electrons);
if survey then write(out,"nl",1,<:electrons = :>,electrons);
finestruct:=true;
repeatchar(in);
for c:=readchar(in,char) while c>6 and char<>25 do;
if char=102<*finestruct*> then
begin
  for c:=readchar(in,char) while c=6 do;
  finestruct:=readb(<:finestructure:>);
end;
initrydproc(electrons,maxstates,maxseries,maxparents);
initrydseg;
cleararray(chargestate);
keystat:=lookupentry(<:keystat:>)=0;
segstat:=lookupentry(<:segstat:>)=0;

begin
integer array series(1:seriesul),parterm(1:parentul),
  states(1:stateul);
cleararray(series);
endcond:=endstate:=false;
initrydfile(name(1),real <:dat:>,250,false);
for c:=1,2 do bsname(c):=segdes.dataname(c);
charge_seg_no:=chargesegdes(1):=segdes(3);
diasegm:=dipsegm:=0;
Z:=0;
for chargestates:=1,chargestates+1 while -,endcond and Z<=Zmax do
begin
  diptrans:=0;
  cleararray(parterm);
  S:=atno:=Z:=0;
  repeatchar(in);
repion:
  if -,readatsym(in,S,atno,Z) then
  write(out,"nl",1,"*",2,<:atom S,atno,Z :>,S,atno,Z);
  chargestate(1):=Z;
  chargestate(2):=S;
  chargestate(3):=atno;
  if Z<Zmin then
  begin
    repeat
    readstring(in,txt,1);
    until txt(1)=real <:ion:>;
    goto repion;
  end;
  if Z>=Zmin and Z<=Zmax then
  begin
  if chargestates=1 then
  begin
    segdes(1):=atno-Z+1;
  end;
  segdes(2):=chargestates;
  if survey then 
  begin
    write(out,"nl",2);
    writeatsym(out,S,atno,Z);
    write(out,"sp",2);
  end;
  endion:=false;
  seriesindex:=stateindex:=0;
  stateno:=-1;
  cleararray(states);
  for cor:=0,cor+1 while -,endion do
  begin
  integer array statesinseries(0:maxseries);

  cores:=cor;
  cleararray(statesinseries);
  readcore(in,cores,parterm); Ip:=getIp(cores,parterm);
  repeatchar(in);
  if survey then
  begin
    write(out,"nl",1);
    writecore(out,cores,parterm); write(out,<< dd ddd ddd.dd>,Ip); end;
  for c:=readchar(in,char) while c>6 and char<>59 and char<>25 do;
  if char=59 <*;*> then
  begin
  setposition(ref,0,1+2*Z);
  outchar(ref,10);
    if survey then outchar(out,10);
    for c:=readchar(in,char) while char<>59 and char<>25 do
    begin
      if survey then outchar(out,char);
      outchar(ref,char);
    end;
  if survey then outchar(out,10);
  outchar(ref,10);
  setposition(ref,0,0);
  for c:=readchar(in,char) while c>6 and char<>25 do;
  repeatchar(in);
  end ;
  lmax:=0;
  endstate:=false;
  for state:=1,state+1 while -, end_state do
  begin
  b:=readstate(in,L,n,l,J) and n>0 and n<128 and l<128-1 and l>=0;
  if list and b then
  begin
    write(out,"nl",1);
    writestate(out,L,n,l,J);
  end else if -,b then write(out,"nl",1,"*",2,<: state error:>,L,n,l,J);
  read(in,Ecm);
  cm1:=cm1 or Ecm=0 or Ecm>100;
  repeatchar(in);
  readchar(in,char);
  if char='n' <*nstar values*> then cm1:=false;
  if -,cm1 then Ecm:=Ip-Econv/2*Z*Z/Ecm/Ecm;
  app:=
  if char= 'f' <*fitted   *> then 1 else
  if char= 'e' <*extended *> then 2 else
  if char= '*' or char = 'n' <*interpol *> then 3 else
  if char= '!' <*extrapol *> then 4 else 0;
  Eau:=(-Ip+Ecm)/Econv;
  if Eau>0 then
  begin
    write(out,"nl",1);
    if -,list then writestate(out,L,n,l,J);
    write(out,<< ddddddddd.dd>,Ecm,<: Ecm>Ip :>);
  end else 
  begin
    nstar:=Z*sqrt(-1/2/Eau);
    if nstar<=nsmax and n<=nmax and l//2<=nmax-1 then
    begin
      if l>lmax then lmax:=l;
      states_in_series(l//2):=states_in_series(l//2)+1;
      stateno:=stateno+1;
      if stateno> maxstates then alarm("nl",1,"*",3,<:statenumber :>,stateno);
      putstate(states,stateno,n,J,seriesindex+l//2,nstar,Ecm,L,app);
    end nstar<nstar max;
    if list then
    begin
      write(out,<< dddddddddd.ddd>,Ecm,"sp",4,
        <<ddd.dddd>,nstar);
      if nstar<=nsmax then write(out,"sp",2,"*",1);
    end listing;
   end;
  for c:=readchar(in,char) while char=32 or char=10 do;
  repeatchar(in);
  if char>96 then
  begin
    <*test some end condition*>
    readstring(in,txt,1);
    end_cond:=txt(1)=real <:end:>;
    endion:=end_cond or txt(1)=real <:ion:>;
    if -,endion then write(out,"*",2,<: syntax end :>,
      string inc(txt));
  end test end_states else
  if char= 60 <* < *> then end_state:=true;
  endstate:=endstate or endion or endcond;
  end read states;

  pardes:=cores*parentsize;
  parterm.pardes(4):=seriesindex;
  parterm.pardes(5):=seriesindex+lmax//2;
  parterm.pardes(6):=S;
  parterm.pardes(9):=stateindex;
  parterm.pardes(10):=stateno;

  k:=stateindex-1;
  for l:=0 step 2 until lmax do
  begin
    ser:=(seriesindex+l//2)*seriessize;
    series.ser(1):=l;
    series.ser(2):=k+1;
    series.ser(3):=k+states_in_series(l//2);
    series.ser(4):=cores;
    k:=k+states_in_series(l//2);
    if keystat then
      write(out,"nl",1,false add ryalf(l),1,<:-from :>,<<d>,series.ser(2),
        <: to :>,series.ser(3),<: coreno = :>,cores);
end l;
for l:=0 step 2 until lmax do
begin
  if fit then
  begin <*rydberg ritz fit*>
  integer jta,jtno,i,st,l2,serno;
  boolean found;
  integer array jtab(1:5);
  boolean array nofit(1:nmax,1:5);
  array E,ns(1:nmax,1:5),Ef,nsf(1:nmax);
    jtno:=0;
    for jta:=1 step 1 until 5 do
    for i:=1 step 1 until nmax do
    begin
      nofit(i,jta):=false;
      E(i,jta):=ns(i,jta):=0;
    end init E,ns;
    for i:=1 step 1 until 5 do jtab(i):=-128;
    
    for st:=stateindex step 1 until stateno do
    begin
      getstate(states,st,n,J,serno,nstar,Ecm,L,app);
      ser:=serno*seriessize;
      l2:=series.ser(1);
      if l=l2 then 
      begin
        jta:=0; found:=false;
        repeat jta:=jta+1;
          if jtab(jta)=J or jta>jtno then
          begin
            nofit(n,jta):=true;
            E(n,jta):=(-Ip+Ecm)/Econv;
            ns(n,jta):=nstar;
            found:=true;
            if jta>jtno then
            begin
              jtno:=jta;
              jtab(jta):=J;
            end;
          end;
        until found;
      end l=l2;
    end state;

    for jta:=1 step 1 until jtno do
    begin
      J:=jtab(jta);
      for i:=1 step 1 until nmax do
      begin
        Ef(i):=E(i,jta); nsf(i):=ns(i,jta);
      end move;
      rydritz(Ef,nsf,nmin,nmax,L,l,jtab(jta),Z);
      for i:=1 step 1 until nmax do
      begin
        if nsf(i)>0 and -,nofit(i,jta) then
        begin
          app:=1 <*fitted*>;
          Ecm:=Ef(i)*Econv+Ip;
          stateno:=stateno+1;
          statesinseries(l//2):=statesinseries(l//2)+1;
          if stateno>maxstates then alarm("nl",1,"*",3,
             <:statenumber :>,stateno);
          putstate(states,stateno,i,J,seriesindex+l//2,nsf(i),Ecm,L,app);
          if list then
          begin
            write(out,"nl",1);
            writestate(out,L,i,l,jtab(jta));
            write(out,<< dddddddddd.ddd>,Ecm,"sp",4,
              <<ddd.ddd>,nsf(i));
            if nstar<nmax then write(out,"sp",2,"*",1);
          end list;
        end inserted;
      end nmax loop;
    end jta;
  end fit;
  end;

  k:=stateindex-1;
  for l:=0 step 2 until lmax do
  begin
    ser:=(seriesindex+l//2)*seriessize;
    series.ser(2):=k+1;
    k:=k+states_in_series(l//2);
    series.ser(3):=k;
  end update;

  sortstates(states,stateindex,stateno);
  diptrans:=diptrans+
    dip_trans_parent(S,series,seriesindex,seriesindex+lmax//2,states,parterm);
  parterm.pardes(11):=diptrans;
  parterm.pardes(12):=0;

stateindex:=stateno+1;
seriesindex:=seriesindex+lmax//2+1;

end parent;

chargestate(4):=cores;
chargestate(5):=seriesindex;
chargestate(6):=stateno;
chargestate(7):=diptrans;
chargestate(8):=chargestate(8)+cores+1;
chargestate(9):=chargestate(9)+seriesindex+1;
chargestate(10):=chargestate(10)+stateno+1;
chargestate(11):=chargestate(11)+diptrans;
chargestate(12):=if finestruct then -1 else 0;
chargestate(18):=chargestates;
chargestate(19):=electrons;
chargesegdes(9):=diasegm;
chargesegdes(11):=dipsegm;
diasegm:=diasegm+(stateno+1)/(512//diarecsize)+1;
dipsegm:=dipsegm+diptrans/(512//diprecsize)+1;
chargesegdes(10):=diasegm-1;
chargesegdes(12):=dipsegm-1;
if keystat then write(out,"nl",2,<:no of states :>,stateno+1);

charge_segno:=chargesegdes(1);
if segstat then write(out,"nl",1,<:first segment parent :>,charge_seg_no,
  "nl",1,<:parents :>,cores+1,"nl",1,<:size :>,parentsize);
if survey then 
begin
  write(out,"sp",6);
  for i:=0 step 1 until cores do writecore(out,i,parterm);
end survey;
charge_segno:=chargesegdes(2):=
  putstruct(bsname,parterm,0,cores,
    parentsize,chargesegdes(1));
chargesegdes(3):=chargesegdes(2)+1;
charge_seg_no:=chargesegdes(3);
if segstat then write(out,"nl",1,<:first segment series :>,charge_seg_no,
  "nl",1,<:series :>,seriesindex+1,"nl",1,<:size :>,seriessize);
chargesegdes(4):=
  putstruct(bsname,series,0,seriesindex,seriessize,chargesegdes(3));
chargesegdes(5):=chargesegdes(4)+1;
charge_seg_no:=chargesegdes(5);
if segstat then write(out,"nl",1,<:first segment states :>,charge_seg_no,
  "nl",1,<:states :>,stateno+1,"nl",1,<:size :>,statesize);
chargesegdes(6):=
  putstruct(bsname,states,0,stateno,statesize,chargesegdes(5));
charge_seg_no:=chargesegdes(6)+1;
putstruct(bsname,chargestate,2*chargestates-2,2*chargestates-2,chargesize,1);
putstruct(bsname,chargesegdes,2*chargestates-1,2*chargestates-1,chargerecsize,1);
chargesegdes(1):=chargesegno;
segdes(2):=segdes(4):=chargestates;
putstruct(bsname,segdes,0,0,segdesrecsize,0);
if segstat then begin
  write(out,"nl",2,<:segment description:>);
  writerec(out,segdes,0,0,segdesrecsize);
  write(out,"nl",2,<:charge segment description:>);
  writerec(out,chargesegdes,0,0,chargerecsize);
  end segstat;
if keystat then writechargerec(out);
end Z>=Zmin and Z<=Zmax;

end chargestate;
end array block;
segdes.datasize:=chargesegno+1;
segdes.diasize:=diasegm;
segdes.dipsize:=dipsegm;
cleararray(tail);
tail(1):=chargesegno+1;
res:=changetail(bsname,tail);
if res<>0 then alarm("nl",1,"*",3,<:cut of :>,string inc(bsname),res);
if true then write(out,"nl",3,<:dat segments :>,chargesegno+1,
  "nl",1,<:dia segments :>,diasegm,
  "nl",1,<:dip segments :>,dipsegm);
putstruct(bsname,segdes,0,0,segdesrecsize,0);
disconnectin;
end rydgen pass 1;

integer procedure dip_trans_parent(S,series,first,last,state,parterm);
value S,first,last;
integer S,first,last;
integer array series,state,parterm;
begin
integer serno,state1,state2,n1,n2,l1,l2,J1,J2,L1,L2,
  app1,app2,i1,i2,trans,trans_s,seriestrans;
real e1,e2,nstar1,nstar2,Ecm1,Ecm2;
boolean test;
integer array field ser2;

test:=false;
if test then write(out,"nl",3,<:calculation of dipole transitions:>,
    "nl",1,<:first :>,first,<: last :>,last);
trans:=0;
for serno:=first step 1 until last-1 do
begin
  seriestrans:=0;
  ser:=serno*seriessize;
  l1:=series.ser(1);
  if test then write(out,"nl",2,
    <:1.state :>,series.ser(2),<: 2. state :>,series.ser(3));
  for state1:=series.ser(2) step 1 until series.ser(3) do
  begin
    getstate(state,state1,n1,J1,i1,nstar1,Ecm1,L1,app1);
    if serno<>i1 then write(out,"nl",1,"*",2,<:wrong seriesindex :>,
       serno,i1);
    trans_s:=0;
    if test then
      begin
      write(out,"nl",1); writestate(out,L1,n1,l1,J1);
      end;
    ser2:=(i1+1)*seriessize;
    for state2:=series.ser2(2) step 1 until series.ser2(3) do
    begin
    getstate(state,state2,n2,J2,i2,nstar2,Ecm2,L2,app2);
    if i2<>i1+1 then write(out,"nl",1,<:wrong 2. seriesindex:>,
      i1+1,i2);
    l2:=series.ser2(1);
    if Jtest(J1,J2,l1,l2,S,nstar2-nstar1)  and abs(L2-L1)<=2 and
      i1+1=i2 then
    begin
      trans_s:=trans_s+1;
      trans:=trans+1;
    end allowed;
    end state2;
  if test then write(out,"sp",3,<:trans:>,trans,transs);
  put_trans_no(state,state1,trans_s);
  seriestrans:=seriestrans+transs;
  end state1;
  series.ser(5):=seriestrans;
  if test then write(out,"nl",1,<:transitions from :>,
    false add ryalf(series.ser(1)),1,seriestrans);
end series;
dip_trans_parent:=trans;
if test then write(out,"nl",1,<:transitions :>,trans);
end dip_transparent;


procedure rydgen_pass_2(name);
array name;
if pass2 then
begin
algol list.off copy.statevar;
algol list.off copy.ionloop;
if list then liststates(bsname,parterm);
if linelist then 
begin
  integer array series(1:seriesul),states(1:stateul);
  getstruct(bsname,series,0,chargestate(5),seriessize,chargesegdes(3));
  getstruct(bsname,states,0,chargestate(6),statesize,chargesegdes(5));
  pardes:=0;
  writelinelist(out,S,
  series,parterm.pardes(4),parterm.pardes(5),states,parterm,inch);
end linelist;
end end end ionloop;
end rydgen pass 2;

procedure rydgen_pass_3(name);
array name;
if pass3 then
begin
integer cut;
algol list.off copy.statevar;
algol list.off copy.ionloop;
algol list.off copy.stateloop;
end state;
end state array;
end series;
end parent;
end parent and series array;
end Z;
end declarations;
end rydgen_pass_3;
algol copy.rydritz;
algol list.off copy.alutproc;
algol list.off copy.rydstruct;
algol list.off copy.rydseg;
algol list.off copy.coreproc;
algol list.off copy.ryproc <*lsproc*>;
algol list.off copy.ryglobal;
plus:=false add 43;
readifp(<:maxstates:>,maxstates ,250);
readifp(<:maxseries:>,maxseries,25);
readifp(<:maxparents:>,maxparents,3);
packtext(output,<: unknown:>);
cleararray(BSi);
if readlsfp(output) then begin
i:=lookupentry(output);
if i<>0 then alarm(<:***left side area :>,string inc(output),i);
open(out1,4,string inc(output),0);
end;
readbfp(<:fit:>,fit,false);
readbfp(<:extendl:>,extendl,extendl);
readbfp(<:linelist:>,linelist,false);
readbfp(<:sort:>,sortlines,false);
readbfp(<:inch:>,inch,false);
linelist:=linelist or inch or sortlines;
readbfp(<:pass1:>,pass1,true);
readbfp(<:pass2:>,pass2,-,pass1);
readbfp(<:pass3:>,pass3,false);
for i:=1 step 1 until fpinareas do begin
  readinfp(FP,i);
  for k:=1,2 do BSi(i,k):=FP(k);
  end;
connectlso;
for inpi:=1 step 1 until fpinareas do begin
  for i:=1,2 do FP(i):=BSi(inpi,i);
rydgen_pass_1(FP);
rydgen_pass_2(FP);
rydgen_pass_3(FP);
end for inputarea;
if fpout then closeout;
end
▶EOF◀