Reading data for Moller - Plesset series

Mathematica program

(* Reading data for Moller - Plesset series *)

removetag[s_String] := Module[{s1, sp1, sp2, p1, p2},
      s1 = s;
      While[
        {sp1, sp2} = {sp1, sp2} = {StringPosition[s1, "<", 1], StringPosition[s1, ">", 1]};
        (sp1 =!= {} && sp2 =!= {}) && ((p1 = sp1[[1, 1]]) < (p2 = sp2[[1, 1]])),
        s1 = StringDrop[s1, {p1, p2}]];
      s1];

ndigitdata = 256;

inpfile = "data.m";
fileid = {FileDate[inpfile], FileByteCount[inpfile]};
altinpfile = "altdata.m";

altfileid = {};
If[FileType[altinpfile] === File, Get[altinpfile]];

If[altfileid =!= fileid,
s = Import[inpfile, "Text"];
mark = "`" <> ToString[ndigitdata];
posdots = StringPosition[s, "."] // Transpose // First;
chars = Characters[s];
mchar = Length[chars];
digs = CharacterRange["0", "9"];
digq[n_] := If[n < 1 || n > mchar, False, MemberQ[digs, chars[[n]]]];
md = Length[posdots];
posmarks = Table[
      pd = posdots[[nd]];
      If[! digq[pd - 1] || ! digq[pd + 1], Null,
        pd++;
        While[digq[pd], pd++];
        pd], {nd, md}];
posmarks = Select[posmarks, IntegerQ];
s = StringInsert[s, mark, posmarks];
Export[altinpfile, s, "Text"];
altfileid = fileid;
PutAppend[Definition[altfileid], altinpfile];
Get[altinpfile];
];

accDigits[x_Real] := Module[{dig, m},
      {dig, m} = RealDigits[x,10,99];
      dig = Split[dig];
      If[Last[Last[dig]] === 0, dig = Drop[dig, -1]];
      Length[Flatten[dig]] - m];

mser = Length[alldata];
names = {};
Do[
   {molec, bas, datf, bdist, en, nm00, mpser} = alldata[[nser]];
    datf = StringReplace[datf, ".dat" -> ""];
    name = "a" <> ToString[nser];
    names = Append[names, name];
    molecule[name] = molec;
    basis[name] = bas;
    structure[name] = datf;
    bdistance[name] = bdist;
    exact[name] = en;
    mpser1 = Drop[Prepend[mpser,0],-1];
    func = mpser - mpser1;
    nm0 = Length[func];
    Do[If[func[[n]]==0,Break[]];
       nm=n,{n,nm0}];
    func = Take[func, nm];
    coeff[name] = func;
    accdig[name] = accDigits/@func;
    , {nser, mser}];

names = Select[names, exact[#] != 0 &];
mser = Length[names];

plist = Table[{nser, name = names[[nser]], molecule[name] // removetag, basis[name],
        structure[name], exact[name] // N, Length[coeff[name]]}, {nser, 
        mser}];
plist = Prepend[
      plist, {"No.", "Name", "Molecule", "Basis", "Structure", "E", "N"}];
Print[plist // TableForm];
printprogr["read"];

Molecule - icon for Allen-dataBlankExamples of MP seriesBlankSource code of Mathematica programBlankMathematica programsBlankWork in UMass DartmouthWork in UMassDBlankWaste iconUnpublished reports

Designed by A. Sergeev.