DataMuseum.dk

top - metrics - download

    Length: 14592 (0x3900)
    Types: TextFile
    Names: »rydstruct«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦7b6e66aaa⟧ »crypr« 
            └─⟦this⟧ 
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦84e44a383⟧ »crypr« 
            └─⟦this⟧ 

TextFile

<*                         rydstruct                         *>
<*core variables*>
<*global parameter description:
  electrons::=no of active electrons
  (no of shells <electrons )
*>
own integer parenthead,shellsize,statesize,seriessize,
  parentsize,chargesize,stateul,seriesul,parentul,
  curchargestate,maxstates,maxtrans;
own real Econv,cau,a0,t0sec,cmmns,amu,amuc2;
integer array chargestate(1:50),curstate(1:17);
integer array field pardes,shelldes,st,ser;
<*
The rydberg program data structures:
a) records
   state
   term series
   parent
   chargestate


STATE:
 +0 ( 1)  n
 +2 ( 2)  J
 +4 ( 3)  series number
 +6 *10*  n*  (real)
+10 *14*  Ecm-1 (real)
+14 ( 8)  L
+16 ( 9)  approximation 
          (fitted=1, extended=2, interpolated=3, extrapolated=4)
+18 (10)  transitions to other states within parent
+20 *22*  computed (boolean)
+22 (12)  cuttype
+26 *28*  cut (real)
+30 *32*  tau (real)

SERIES:
 +0  l
 +2  first state number
 +4  last state number
 +6  parent number
 +8  transitions to next series number

PARENT:
 +0     record description
 +16+ 0 1. shell
 +16+14 2. shell
 +16+28 3. shell
  
  RECORD DESCRIPTION:
    +0  number of shells
    +2  Ip (ionization potential)
    +6  first series number
    +8  last series number
   +10  S (for all states belonging to this parent)
   +12  S parent
   +14  L parent
   +16  first state number
   +18  last state number
   +20  number of dipole transitions within parent
   +22  number of dipole transitions to other parents
   +24  reduction number (0 or 1 (outer electron eqvivalent))

  SHELL:
    +0  n
    +2  l
    +4  N (electrons eqvivalent)
    +6  V (seniority)
    +8  S
   +10  L
   +12  J

CHARGESTATE:
  +0 Z (effective charge)
  +2 S
  +4 atno
  +6 number of parents
  +8 number of series
  +10 number of states
  +12 number of dipole transitions
  +14 number of parents in sequence
  +16 number of series  in sequence
  +18 number of states  in sequence
  +20 number of trans   in sequence
  +22 finestruct used in calculation
  +26 time of calculation of wawefunction
  +28 numerical coulomb approximation
  +30 delta l 
  +32 njump
  +34 chargestate
 + 36 electrons (active)
*>
procedure initrydproc(electrons_active,maxstates,maxseries,maxparents);
value electrons_active,maxstates,maxseries,maxparents;
integer electrons_active,maxstates,maxseries,maxparents;
begin
electrons:=if electronsactive>0 then electronsactive else 1;
statesize:=32;
seriessize:=10;
parenthead:=26;
shellsize:=14;
parentsize:=(parenthead+(electrons-1)*shellsize);
chargesize:=100;
stateul:=(statesize*(maxstates+1))//2;
seriesul:=(seriessize*(maxseries+1))//2;
parentul:=(parentsize*(maxparents+1))//2;
comment constants taken from C. W. Allen, Astrophysical Quantities
Third edition, Athlone Press, London 1973. p. 13-15. These are the
1965 constants.;
Econv:=219474.618 <*cm-1/au*>;
cau:=137.0372 <*speed of light in au*>;
a0:=5.29172'-9 <* cm *>;
t0sec:=2.4189'-17 <* aut/sec *>;
cmmns:=299.7925 <* mm/ns*>;
amu:=1.66043'-24 <* g *>;
amuc2:=938.256 <*MeV*>;
end;

procedure put_tau(states,stateno,tau);
value stateno,tau;
integer stateno; real tau;
integer array states;
begin
integer array field state;
real field tauf;
tauf:=32;
state:=stateno*statesize;
states.state.tauf:=tau;
end puttau;

real procedure get_tau(states,stateno);
value stateno; integer stateno;
integer array states;
begin
integer array field state;
real field tauf;
tauf:=32;
state:=stateno*statesize;
gettau:=states.state.tauf;
end gettau;

procedure put_trans_no(states,stateno,trans);
value stateno,trans; integer stateno,trans;
integer array states;
begin
integer array field state;
state:=stateno*statesize;
states.state(10):=trans;
end put_trans_no;

integer procedure get_trans_no(states,stateno);
value stateno; integer stateno;
integer array states;
begin
integer array field state;
state:=stateno*statesize;
get_trans_no:=states.state(10);
end get_trans_no;

procedure put_computed(states,stateno,computed,cuttype,cut);
value stateno,computed,cuttype,cut;
integer stateno,cuttype; boolean computed; real cut;
integer array states;
begin
integer array field state;
real field cutf;
boolean field comput;
cutf:=28;
comput:=22;
state:=statesize*stateno;
states.state.comput:=computed;
states.state(12):=cuttype;
states.state.cutf:=cut;
end putcomputed;

boolean procedure get_computed(states,stateno,cuttype,cut);
integer stateno,cuttype; real cut;
integer array states;
begin
integer array field state;
real field cutf;
boolean field comp;
comp:=22;
cutf:=28;
state:=stateno*statesize;
getcomputed:=states.state.comp;
cuttype:=states.state(12);
cut:=states.state.cutf;
end getcomputed;

procedure putstate(states,stateno,n,J,serno,ns,Ecm,L,app);
value stateno,n,J,serno,ns,Ecm,L,app;
integer stateno,n,J,serno,L,app;
real ns,Ecm;
integer array states;
begin
integer i;
integer array field state;
real field nstar,E;
state:=stateno*statesize;
nstar:=10;
E:=14;
for i:=9 step -1 until 1 do
begin
  states.state(i):=case i of
    (n,J,serno,0,0,0,0,L,app);
end;
states.state.nstar:=ns;
states.state.E:=Ecm;
for i:=statesize//2 step -1 until 10 do states.state(i):=0;
end putstate;

procedure getstate(states,stateno,n,J,serno,ns,Ecm,L,app);
value stateno;
integer stateno,n,J,serno,L,app;
real ns,Ecm;
integer array states;
begin
integer i;
integer array field state;
real field nstar,E;
state:=stateno*statesize;
nstar:=10;
E:=14;
n:=states.state(1);
J:=states.state(2);
serno:=states.state(3);
ns:=states.state.nstar;
Ecm:=states.state.E;
L:=states.state(8);
app:=states.state(9);
for i:=statesize//2 step -1 until 1 do
  curstate(i):=states.state(i);
end getstate;

procedure writestaterec(states,stateno);
value stateno;
integer stateno;
integer array states;
begin
integer i;
integer array field state;
real field nstar,E,cut,tau;
boolean field computed;
state:=stateno*statesize;
nstar:=10;
E:=14;
computed:=22;
cut:=28;
tau:=32;
write(out,"nl",2,<:state record :>,stateno);
for i:=1,2,3,8,9,10,12 do
write(out,"nl",1,case i of (<:n      :>,<:J      :>,
    <:series :>,
    <: :>,<: :>,<: :>,<: :>,<:L      :>,
    <:app    :>,<:trans  :>,<: :>,
    <:cuttype:>),<: = :>,states.state(i));
write(out,"nl",1,<:n*    :>,states.state.nstar,
          "nl",1,<:E cm-1:>,states.state.E,
          "nl",1,<:cut   :>,states.state.cut,
          "nl",1,<:tau   :>,states.state.tau,
          "nl",1,if states.state.computed then <::> else <:not :>,
            <:computed:>);
end writestaterec;

procedure writeseriesrec(series,serno);
value serno; integer serno;
integer array series;
begin
integer i;
integer array field ser;
ser:=serno*seriessize;
write(out,"nl",2,<:series record :>,serno);
for i:=1,2,3,4,5 do
  write(out,"nl",1,case i of(<:l      :>,
    <:state 1:>,<:state 2:>,<:parent :>,<:trans  :>),
    <: = :>,series.ser(i));
end write seriesrecord;

procedure writeparentrec(parent,parentno);
value parentno; integer parentno;
integer array parent;
begin
integer i;
integer array field par;
real field Ip;
par:=parentno*parentsize;
write(out,"nl",2,<:parent record :>,parentno,
     <:  parentsize :>,parentsize,<: base :>,par);
for i:=1,4 step 1 until 13 do
  write(out,"nl",1,case i of (<:shells :>,
    <::>,<::>,<:ser 1  :>,<:ser 2  :>,
    <:S all  :>,<:S par  :>,<:L par :>,
    <:state 1:>,<:state 2:>,<:dip par:>,
    <:dip oth:>,<:reduc  :>),
    <: = :>,parent.par(i));
Ip:=6;
write(out,"nl",1,<:Ip     :>,<: = :>,parent.par.Ip);
end writeparentrec;

procedure write_chargerec(out);
zone out;
begin
integer i;
write(out,"ff",1,"nl",1,<:charge record:>);
for i:=1 step 1 until 11 do
  write(out,"nl",1,case i of(<:Z      :>,
    <:S      :>,<:atno   :>,<:parents:>,
    <:series :>,<:states :>,<:diptran:>,
    <:seqpar :>,<:seqser :>,<:seqstat:>,
    <:seqdip :>),<:     = :>,chargestate(i));
write(out,"nl",1,<:chargestate = :>,chargestate(18),
          "nl",1,<:electrons   = :>,chargestate(19));
end write_chargestate;

procedure swoprecord(st,s1,s2,recs);
value s1,s2,recs; integer s1,s2,recs;
integer array st;
begin
integer w,k;
integer array field if1,if2;
if1:=s1*recs; if2:=s2*recs;
for k:=recs//2 step -1 until 1 do
begin
  w:=st.if1(k); st.if1(k):=st.if2(k);
  st.if2(k):=w;
end;
end swoprecords;


procedure sort_states(st,f,l);
value f,l;
integer f,l;
integer array st;
if f<l then
begin
integer array key(1:4);
boolean exchange;
integer k,j,i,max;

procedure swop(st,i);
value i; integer i;
integer array st;
begin
integer k,w;
integer array field ifi,ifi1;
ifi:=i*statesize; ifi1:=ifi+statesize;
for k:=1 step 1 until max do
  begin
  w:=st.ifi(k); st.ifi(k):=st.ifi1(k);
  st.ifi1(k):=w;
  end;
exchange:=true;
end swop;

procedure check(st,i);
value i; integer i;
integer array st;
begin
boolean equal,in_order;
integer array field ifi,ifi1;
integer j,k;
ifi:=i*statesize; ifi1:=ifi+statesize;
for j:=1,j+1 while equal and j<5 do
begin
  equal:=st.ifi(key(j))=st.ifi1(key(j));
end;
if equal then 
begin
  write(out,"nl",1,"*",2,<:equal on all keys:>);
  for k:=1,2,3,4 do write(out,"sp",2,st.ifi(key(k)),st.ifi1(key(k)));
  end;
in_order:=st.ifi(key(j-1))<=st.ifi1(key(j-1));
if -,inorder then swop(st,i);
end;

for j:=1,2,3,4 do key(j):=case j of(3,8,1,2);
comment the sorting keys are l, L, n, J;
max:=statesize//2;
for k:=1, k+1 while exchange and k<200 do
begin
exchange:=false;
for i:=f step 1 until l-1 do check(st,i);
end;
end sort_states;

integer procedure findchargestate(bsname,S,atno,Z);
value S,atno,Z;
integer S,atno,Z;
array bsname;
begin
integer charge,curcharge;
boolean found,test;
charge:=0;
test:=lookupentry(<:testfind:>)=0;

initrydproc(1,1,1,1);
initrydseg;
initrydfile(bsname(1),real <:dat:>,1,true);
for i:=1,2 do bsname(i):=segdes.dataname(i);
getstruct(bsname,segdes,0,0,segdesrecsize,0);
found:=false;
curcharge:=0;
for curcharge:=curcharge+1 while -,found and
  curcharge<=segdes(2) do
begin
  i:=2*curcharge-2;
  getstruct(bsname,chargestate,i,i,chargesize,1);
  found:=Z=chargestate(1) and S=chargestate(2) and atno=chargestate(3);
  if found then charge:=curcharge;
  end;
initrydproc(1,chargestate(6),chargestate(5),chargestate(4));
if found then
begin
  i:=2*charge-1;
  getstruct(bsname,chargesegdes,i,i,chargerecsize,1);
  findchargestate:=charge;
  if test then
  begin
    write(out,"nl",1,<:chargestate found :>,charge);
    writechargerec(out);
  end test;
  end else findchargestate:=-1;
end findchargestate;

integer procedure findstate(bsname,parterm,La,na,la,Ja);
value La,na,la,Ja;
integer La,na,la,Ja;
array bsname;
integer array parterm;
if na<=0 or la<0 then findstate:=-1 else
begin
boolean found,test;
integer fstate;
integer array series(1:seriesul);
algol copy.statevar;
test:=lookupentry(<:testfind:>)=0;
  found:=false;
  fstate:=-1;
  getstruct(bsname,series,0,chargestate(5),seriessize,chargesegdes(3));
  seriesindex:=parterm.pardes(4) +la//2;
  ser:=seriesindex*seriessize;
  if test then
  begin
    write(out,"nl",1,<:seriesindex :>,seriesindex);
  end test;
  if seriesindex<=parterm.pardes(5) then
    begin
    stateindex:=series.ser(2);
    stateno:=series.ser(3);
    l:=series.ser(1);
    if test then
    begin
      write(out,"nl",1);
      writeatsym(out,chargestate(2),chargestate(3),chargestate(1));
      write(out,"nl",1,"*",1,false add ryalf(l),1,"sp",3,
      <:state first :>,stateindex,<: state last :>,stateno);
    end test;
    initrydproc(1,stateno-stateindex,chargestate(5),chargestate(4));
    if l=la then
    begin
    integer array states(1:stateul);
    getstruct(bsname,states,stateindex,stateno,statesize,chargesegdes(5));
    state:=-1;
    for state:=state+1 while state<=stateno-stateindex and
      -,found do
    begin
      getstate(states,state,n,J,0,nstar,Ecm,L,app);
      if test then
      begin
        write(out,"nl",1,"*",1,<:findstate :>,state+stateindex,"sp",2);
        writestate(out,L,n,l,J);
      end test;
      if n=na then
        begin
        found:=L=La and J=Ja;
        if found then fstate:=state+stateindex;
        end search;
      end forstate;
    end l=la;
    end l allowed;
  findstate:=fstate;
end local block for findstate;

procedure readstateaux(bsname,parterm,stateaux);
integer array parterm;
array bsname,stateaux;
begin
boolean endcond,test;
integer c,char;
real val;
algol copy.statevar;
test:=lookupentry(<:testaux:>)=0;
endcond:=false;
cleararray(stateaux);
for c:=c while -,endcond do
begin
  readstate(in,L,n,l,J);
  state:=findstate(bsname,parterm,L,n,l,J);
  comment repeatchar(in);
  if state>=0 then
  begin
    c:=read(in,val);
    if c>0 then stateaux(state):=val;
    if test then
    begin
      write(out,"nl",1);
      writestate(out,L,n,l,J);
      write(out,<<  ddddddd.ddd>,val);
    end test;
    repeatchar(in);
  end
  else
  begin
    write(out,"nl",1);
    writestate(out,L,n,l,J);
    write(out,"sp",4,<:**illegal:>);
  end;
  for c:=readchar(in,char) while c=8 and char<>25 do;
  repeatchar(in);
  endcond:=char>96 or char=25;
  end read loop;
end readstateaux;

procedure calcdipindex(dipval,dipindex);
integer array dipval,dipindex;
begin
integer trans,cur,size,max;
integer array field dipi;
max:=chargestate(7)-1;
cleararray(dipindex);
size:=diprecsize//2;
dipi:=0;
trans:=0;
while (dipval.dipi(1)<>0 or dipval.dipi(2)<>0) and trans<max do
begin
  trans:=trans+1;
  cur:=dipval.dipi(1);
  dipindex(cur):=dipindex(cur)+1;;
  dipi:=dipi+diprecsize;
end for trans;
for cur:=1 step 1 until maxstates-1 do
dipindex(cur):=dipindex(cur-1)+dipindex(cur);
end calcdipindex;

real procedure atomic_mass(atno);
value atno; integer atno;
if atno<1 or atno>96 then atomicmass:=-1 else
atomicmass:=case atno of(
1,4,7,9,11,12,14,16,19,20,
23,24,27,28,31,32,35,40,
39,40,45,48,51,52,55,56,59,59,
64,65,70,73,75,79,80,84,
85,88,89,91,93,96,0,102,103,107,
108,112,115,119,122,128,127,131,
133,137,139,140,141,144,0,150,152,157,159,162,165,167,169,173,175,179,181,184,186,190,193,195,
197,201,204,207,209,210,0,222,
0,226,227,232,231,238,0,0,0,0);
▶EOF◀