DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »coreproc«

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

comment core input/output procedures
1980-03-14
;
<*
a core description may look like this
  <number>                                     electrons=1 , no shells
  <nl> S <number>                              electrons=2 , one shell
  <(nlN S L)> S <number>                         electrons>2 , one shell
  <(n1l1N1 S1 L1)(n2l2N2 S2 L2) S L> S <number>  electrons>2 , two shells
*>

real procedure getIp(parentno,parterm);
value parentno; integer parentno;
integer array parterm;
begin
real field Ipf;
Ipf:=6;
pardes:=parentno*parentsize;
getIp:=parterm.pardes.Ipf;
end getIp;

procedure readcore(z,parentno,parterm);
integer parentno;
zone z;
integer array parterm;
begin
integer c,char,n,l,N,V,L,S,mul,J,shellno;
boolean test;
real Ip;
real field Ipf;
pardes:=parentno*parentsize;
Ipf:=6;
test:=lookupentry(<:coretest:>)=0;
shellno:=0;
L:=0; S:=mul:=2;
repeatchar(in);
for c:=readchar(in,char) while char<>60 and char<>25 and
  (char<48 or char>58) and (char<64 or char>125) do;
if char=60 then
begin
<* < *>
parentterm:=true;
for c:=readchar(in,char) while char<>40 and char<>25 and
  (char<48 or char>57) do;
repeatchar(in);
if char=40 then
begin
for c:=readchar(in,char) while char=40 and char<>25 do
begin
<*read shells*>

<*  (nl N V S L) *>

shelldes:=pardes+parenthead+shellno*shellsize;
shellno:=shellno+1;
readnl(in,n,l);
parterm.shelldes(1):=n;
parterm.shelldes(2):=l;
read(in,N);
parterm.shelldes(3):=N;
if l=4 and N>=3 and N<=8 then read(in,V) else
  V:=0;
read(in,mul); L:=readl(in);
J:=readJ(in);
parterm.shelldes(4):=V;
parterm.shelldes(5):=mul-1;
parterm.shelldes(6):=L;
parterm.shelldes(7):=J;
repeatchar(in);
for c:=readchar(in,char) while char<>25 and char<>41 do;
if test then
begin
  write(out,"nl",1,<:shell :>,shellno,<:(:>);
  writenl(out,n,l);
  write(out,N);
  writeSL(out,mul-1,L);
  write(out,<:):>);
end test shell;
end shells;
if shellno>1 then
begin
repeatchar(in);
read(in,mul); L:=readl(in);
if test then
begin
  write(out,<:total SL :>);
  writeSL(out,mul-1,L);
end;
end total S L;
<*read in S for this set of states*>
read(in,S);
S:=S-1;
end else
begin
<*two-electron*>
<*<nl> S Ip*>
shelldes:=pardes+parenthead;
readnl(in,n,l);
L:=l; 
read(in,S);
if -,(S=1 or S=3) then write(out,"*",2,<:multiplicity error :>,S);
mul:=1;
S:=S-1;
shellno:=1;
parterm.pardes(6):=S;
parterm.shelldes(1):=n;
parterm.shelldes(2):=l;
parterm.shelldes(3):=1; <*degeneracy=2*>
parterm.shelldes(5):=1; <*dublet core*>
if test then
begin
  write(out,<:two electron case :>);
  writenl(out,n,l);
end;
end two electrons;
end not singlet S core;
repeatchar(in);
for c:=readchar(in,char) while char<>25 and c<>2 do;
repeatchar(in);
read(in,Ip);
parterm.pardes(1):=shellno;
parterm.pardes.Ipf:=Ip;
parterm.pardes(4):=0;
parterm.pardes(6):=S;
parterm.pardes(7):=mul-1;
parterm.pardes(8):=L;
if test then begin
write(out,<:Ionisation potential:>,Ip);
outendcur(10);
end;
end readcore;

integer procedure writecore(out,parentno,parterm);
value parentno; integer parentno;
integer array parterm;
zone out;
if electrons>0 then
begin
boolean test;
integer i,char,shellnomax,shellno;
real field Ipf;
test:=lookupentry(<:coretest:>)=0;
Ipf:=6;
pardes:=parentno*parentsize;
shellnomax:=parterm.pardes(1);
if test then write(out,"nl",1,<:pardes :>,pardes,
    "sp",4,<:shellnomax :>,shellnomax);
if test then writeparentrec(parterm,parentno);
char:=0;
if shellnomax>0 then
begin
char:=write(out,false add 60,1);
for shellno:=1 step 1 until shellnomax do
begin
  shelldes:=pardes+parenthead+(shellno-1)*shellsize;
  if test then write(out,"nl",1,<:shelldes :>,shelldes);
  if parterm.shelldes(3)>1 or shellnomax>1 then 
    char:=char+write(out,<:(:>);
  char:=char+writenl(out,parterm.shelldes(1),parterm.shelldes(2));
  if parterm.shelldes(3)>1 or shellnomax>1 then
  begin
  char:=char+write(out,<<d>,parterm.shelldes(3));
  if parterm.shelldes(4)>0 then char:=char+write(out,<< d>,parterm.shelldes(4));
  char:=char+writeSL(out,parterm.shelldes(5),parterm.shelldes(6));
  char:=char+write(out,<:):>);
  end more than one shell;
end shells;
if shellnomax>1 then char:=char+writeSL(out,parterm.pardes(7),parterm.pardes(8));
char:=char+write(out,false add 62,1);
  char:=char+write(out,<<d>,parterm.pardes(6)+1);
end parentterm;
if test then char:=char+write(out,<<  ddddddddddd.ddd>,parterm.pardes.Ipf);
writecore:=char;
end writecore else writecore:=0;

integer procedure degenerate(parentno,parterm,n,l);
value parentno,n,l;
integer parentno,n,l;
integer array parterm;
begin
integer deg,sh;
pardes:=parentno*parentsize;
deg:=1;
for sh:=parterm.pardes(1) step -1 until 1 do
  begin
  shelldes:=pardes+parenthead+(sh-1)*shellsize;
  if n=parterm.shelldes(1) and l=parterm.shelldes(2) then
    deg:=parterm.shelldes(3)+1;
  end;
degenerate:=deg;
end degenerate;
▶EOF◀