⟦b9f3ee81a⟧

TextFile


<*                             rydseg
segment and file descriptions of rydberg datastructure
1981-02-16 reduction of diprec
It is a connected file system having the following
naming structure:
ryf<seq><des>
where:
<seq> is a 3 letter code for this sequence
<des> is a 3 letter code describing the content
At present:
<des>::=dat/ref/dia/dip/qua
where:
 ryf<seq>dat describes the global structure and the
             states,series,parent,chargestates
 ryf<seq>ref gives the references if any
 ryf<seq>dia has the computed diagonal matrixelements
 ryf<seq>dip has the computed allowed dipole offdiagonal
             matrixelements
 ryf<seq>qua has the computed quadropole offdiagonal
             matrixelements
*>
own integer chargerecsize,segdesrecsize,
    diarecsize,diprecsize,quadrecsize;
integer array chargesegdes(1:50),segdes(1:50);
integer field datasize,refsize,diasize,dipsize,quadsize;
array field dataname, refname,dianame,dipname,quadname;
integer field datasegm, refsegm,diasegm,dipsegm,quadsegm;

<*
ryf<seq>dat

segment description:

segment 0
  +  0 atomic number of neutral atom (first series member)
  +  2 number of chargestates
  +  4 first chargestate segment description segment
  +  6 number of chargestate segment descriptions
  +  8 record size chargestate segment description
  + 10 name of datafile
  + 18 number of segments data file
  + 20 name of ref file
  + 28 number of segments ref file
  + 30 name of dia file
  + 38 number of segments dia file
  + 40 name of dip file
  + 48 number of segments dip file
  + 50 name of quad file
  + 58 number of seqments quad file


charge state segment description (1..number of chargestates)
  +  0    CHARGESTATE
  + 16 (1) first segment parentdescriptions
  + 18 (2) last  segemnt parentdescriptions
  + 20 (3) first segment series descriptions
  + 22 (4) last  segment series descriptions
  + 24 (5) first segment state descriptions 
  + 26 (6) last  segment state descriptions
  + 28 (7) first segment ref descriptions
  + 30 (8) last  segment ref descriptions
  + 32 (9) first segment diagonal matrixelements
  + 34(10) last  segment diagonal matrixelements
  + 36(11) first segment dipole matrixelements
  + 40(12) last  segment dipole matrixelements
  + 42(13) wawefunction computed
  + 44(14) diagonal matrixelements computed
  + 46(15) dipole   matrixelements computed
  + 48(16) tau and b computed
  + 50(17) sorted in emission
  + 52(18) first segment quadropole matrixelements
  + 54(19) last  segment quadropole matrixelements
  + 56(20) quadropole matrixelements computed


segment 4
(segment 0 first chargestate)
segment
  +  0 CHARGESTATE
  +  1 PARENT
  + .. SERIES
  + .. STATES

*>
<*
ryf<seq>dia

segment description:

record:
  +  3  <1/r>
  +  7  <df/dr>
  + 11  <r>
  + 15  <r2>
  + 19  Ek
  + 23  Ep
  + 27  tau
  + 31  spinorbit
*>

<*
ryf<seq>dip

segment description:

record:

  +  0  state1
  +  2  state2
  +  7  (2) <r>
  + 11  (3) <c>
  + 15  (4) f
  + 19  (5) A
  + 23  (6) lambda
  + 27  (7) b
*>

<*
ryf<seq>qua

segment description

record:

  +  0  state1
  +  2  state2
  + 15  <r2>
*>

procedure initrydseg;
begin
chargerecsize:=100;
segdesrecsize:=100;
dataname:=10; datasize:=dataname+10;
ref_name:=20; ref_size:=ref_name+10;
dia_name:=30; dia_size:=dia_name+10;
dip_name:=40; dip_size:=dip_name+10;
quad_name:=50; quadsize:=quadname+10;
cleararray(chargesegdes); cleararray(segdes);
segdes(3):=2+chargerecsize*50//512;
segdes(5):=chargerecsize;
diarecsize:=32;
diprecsize:=28;
quadrecsize:=40;
end initrydseg;

procedure write_diarec(dia,diano);
value diano; integer diano;
integer array dia;
begin
real array field diaf;
integer i;
diaf:=diano*diarecsize;
write(out,"nl",2,<:diagonal record description:>);
for i:=diarecsize//4 step -1 until 1 do
begin
  write(out,"nl",1,case i of(<:<1/r>  :>,
    <:<df/dr>:>,<:<r>    :>,<:<r**2> :>,
    <:Ek     :>,<:Ep     :>,<:tau    :>,
    <:SO     :>),<: = :>,dia.diaf(i));
end;
end writediarec;

procedure writediprec(dip,dipno);
value dipno; integer dipno;
integer array dip;
begin
integer i;
array field dipr;
integer array field dipi;
dipr:=dipi:=dipno*diprecsize;
write(out,"nl",2,<:dipole record description:>,
    "sp",3,<:from state :>,dip.dipi(1),
  <:  to :>,dip.dipi(2));
for i:=diprecsize//4 step -1 until 2 do
  write(out,"nl",(i+1) mod 2,"sp",((i) mod 2 )*4,case i of (<::>,
    <:<r>    :>,
    <:c      :>,<:f      :>,<:A      :>,
    <:lambda :>,<:b      :>),
    << -dddddddd.dd'+d>,dip.dipr(i));
end write dip rec;



boolean procedure initrydfile(seq,des,segm,exist);
value seq,des,segm,exist;
real seq,des; integer segm; boolean exist;
begin
integer res,i,j;
boolean new;
array field nf;
integer field size;
array name,n1(1:3);
integer array tail(1:10);
cleararray(name); cleararray(tail);
res:=lookuptail(<:alname:>,tail);
nf:=2;
name(1):=if res=0 then tail.nf(1) else real <:ryf:>;
name(1):=name(1) add (seq shift (-24) extract 24);
name(2):=des;

j:=0;
new:=false;
for i:=1,2,3,4,5 do
begin
  if des=(real (case i of (<:dat:>,<:ref:>,<:dia:>,<:dip:>,<:qua:>)))
    then j:=i;
end;
if j=0 then alarm("*",3,<:description :>,string des,<: is not allowed:>);
nf:=10*j; size:=nf+10;
for i:=1,2 do segdes.nf(i):=name(i);
segdes.size:=segm;

res:=lookuptail(name,tail);
if res=0 and -,exist and tail(1)<segm then res:=removeentry(name);
if res=3 and -,exist then
begin
  tail(1):=segm;
  res:=createentry(name,tail);
  new:=res=0;
  j:=1;
  if new then cleararea(string name(increase(j)));
end new area;
j:=1;
if res<>0 then
  alarm("*",3,<:initrydfile :>,string name(increase(j)),
    <:  res :>,res);
if tail(1)<segm then
  alarm("*",3,<:initrydfile :>,string name(increase(j)),
    <:size error :>,tail(1),<:  requested :>,segm);
if new then permentry(name,2);
end initrydfile;



boolean procedure lookrydfile(seq,des,segm);
value seq,des,segm;
real seq,des; integer segm; 
begin
integer res,i,j;
array name(1:3);
integer array tail(1:10);
cleararray(name); cleararray(tail);
name(1):=real <:ryf:> add (seq shift (-24));
name(2):=des;

j:=0;
for i:=1,2,3,4 do
begin
  if des=(real (case i of (<:dat:>,<:ref:>,<:dia:>,<:dip:>)))
    then j:=i;
end;
if j=0 then alarm("*",3,<:description :>,string des,<: is not allowed:>);

res:=lookuptail(name,tail);
lookrydfile:=res=0 and tail(1)>=segm;
end lookrydfile;

procedure putalldipval(bs,dipval);
array bs;
integer array dipval;
putstruct(bs,dipval,0,chargestate(7)-1,diprecsize,chargesegdes(11));

procedure getalldipval(bs,dipval);
array bs;
integer array dipval;
begin
  maxtrans:=chargestate(7);
  getstruct(bs,dipval,0,chargestate(7)-1,diprecsize,chargesegdes(11));
end getalldipval;
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦b9f3ee81a⟧ TextFile

Derivation

TextFile
