# This file is part of TrimSPGUI.
#
#   TrimSPGUI is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#
#   TrimSPGUI is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with Foobar.  If not, see <http://www.gnu.org/licenses/>.
#
# Copyright 2009 by Zaher Salman and the LEM Group.

package Chem;

sub parse_formula {
    my ($formula) = @_;
#    print STDOUT "formula=$formula\n";
    my (%elements);

    #check balancing
    return %elements if (!ParensBalanced($formula));

    # replace other grouping with normal parens
    $formula =~ tr/<>{}[]/()()()/;

    # get rid of any spaces
    $formula =~ s/\s+//g;

    # perform macro expansion
    foreach (keys(%macros)) {
        $formula =~ s/$_/$macros{$_}/g;
    }

    # determine initial compound coeficent
    my $coef = ($formula =~ s/^(\d+\.?\d*)//) ? $1 : 1.0;

    # recursively process rest of formula
    return internal_formula_parser($formula, $coef, %elements);
}


sub internal_formula_parser {
    use Text::Balanced qw(extract_bracketed);

    my ($formula, $coef, %form) = @_;
    my $tmp_coef;

    my ($extract, $remainder, $prefix) =
      extract_bracketed($formula, '()', '[^(]*');

    if (defined($extract) and $extract ne '') {
        $extract =~ s/^\((.*)\)$/$1/;
        if ($remainder =~ s/^(\d+\.?\d*)(.*)$/$2/) {
            $tmp_coef = $1 * $coef;
        } else {
            $tmp_coef = $coef;
        }

        # get formula of prefix ( it has no parens)
        %form = add_formula_strings($prefix, $coef, %form) if ($prefix ne '');

        # check remainder for more parens
        %form = internal_formula_parser($remainder, $coef, %form)
          if ($remainder ne '');

        # check extract for more parens
        %form =
          internal_formula_parser($extract, $tmp_coef, %form);    
          ## we already know this is ne ''
    } else { # get formula of complete string
        %form = add_formula_strings($remainder, $coef, %form)
          if ($remainder ne '');
    }
    return %form;
}


sub add_formula_strings {
    my ($formula, $coef, %elements) = @_;

#  print "Getting Formula of $formula\n";
    $formula =~ /^(?:([A-Z][a-z]*)(\d+\.?\d*)?)+$/o # XXX new
        or die "Invalid Portion of Formula $formula";
    while ($formula =~ m/([A-Z][a-z]*)(\d+\.?\d*)?/go) { # XXX new
        my ($elm, $count) = ($1, $2);
        $count = 1 unless defined $count;
        if (defined $elements{$elm}) {
            $elements{$elm} += $count * $coef;
        } else {
            $elements{$elm} = $count * $coef;
        }
    }
    return %elements;
}

sub ParensBalanced {
    my ($form) = @_;
    my @stack  = ();
    my %pairs  = (
        '<' => '>',
        '{' => '}',
        '[' => ']',
        '(' => ')'
    );

    while ($form =~ m/([<>(){}\]\[])/go) { 
        my $current = $1;
        if ($current =~ /[<({\[]/) {
            push(@stack, $current);
            next;
        }
        return 0 if (scalar(@stack) == 0);
        return 0 if ($current ne $pairs{ pop @stack});
    }
    return @stack ? 0 : 1;
}

sub Zof {
    my ($El) = @_;
    
    my %ElementsZ = (
	"Muon",1,
	"Li8",	3,
	"B12",	5,
	"H",1,
	"He",	2,
	"Li",	3,
	"Be",	4,
	"B",	5,
	"C",	6,
	"N",	7,
	"O",	8,
	"F",	9,
	"Ne",	10,
	"Na",	11,
	"Mg",	12,
	"Al",	13,
	"Si",	14,
	"P",	15,
	"S",	16,
	"Cl",	17,
	"Ar",	18,
	"K",	19,
	"Ca",	20,
	"Sc",	21,
	"Ti",	22,
	"V",	23,
	"Cr",	24,
	"Mn",	25,
	"Fe",	26,
	"Co",	27,
	"Ni",	28,
	"Cu",	29,
	"Zn",	30,
	"Ga",	31,
	"Ge",	32,
	"As",	33,
	"Se",	34,
	"Br",	35,
	"Kr",	36,
	"Rb",	37,
	"Sr",	38,
	"Y",	39,
	"Zr",	40,
	"Nb",	41,
	"Mo",	42,
	"Tc",	43,
	"Ru",	44,
	"Rh",	45,
	"Pd",	46,
	"Ag",	47,
	"Cd",	48,
	"In",	49,
	"Sn",	50,
	"Sb",	51,
	"Te",	52,
	"I",	53,
	"Xe",	54,
	"Cs",	55,
	"Ba",	56,
	"La",	57,
	"Ce",	58,
	"Pr",	59,
	"Nd",	60,
	"Pm",	61,
	"Sm",	62,
	"Eu",	63,
	"Gd",	64,
	"Tb",	65,
	"Dy",	66,
	"Ho",	67,
	"Er",	68,
	"Tm",	69,
	"Yb",	70,
	"Lu",	71,
	"Hf",	72,
	"Ta",	73,
	"W",	74,
	"Re",	75,
	"Os",	76,
	"Ir",	77,
	"Pt",	78,
	"Au",	79,
	"Hg",	80,
	"Tl",	81,
	"Pb",	82,
	"Bi",	83,
	"Po",	84,
	"At",	85,
	"Rn",	86,
	"Fr",	87,
	"Ra",	88,
	"Ac",	89,
	"Th",	90,
	"Pa",	91,
	"U",	92,
	"",	0.0000
	);
    return $ElementsZ{$El};
}

sub Massof {
    my ($El) = @_;

    my %ElementsA = (
	"Muon",0.113,
	"Li8",  8.0,
	"B12",  12.0,
	"H",	1.00800,
	"He",	4.00300,
	"Li",	6.93900,
	"Be",	9.01200,
	"B",	10.81100,
	"C",	12.01100,
	"N",	14.00700,
	"O",	15.99900,
	"F",	18.99800,
	"Ne",	20.18300,
	"Na",	22.99000,
	"Mg",	24.31200,
	"Al",	26.98200,
	"Si",	28.08600,
	"P",	30.97400,
	"S",	32.06400,
	"Cl",	35.45300,
	"Ar",	39.94800,
	"K",	39.10200,
	"Ca",	40.08000,
	"Sc",	44.95600,
	"Ti",	47.90000,
	"V",	50.94200,
	"Cr",	51.99600,
	"Mn",	54.93800,
	"Fe",	55.84700,
	"Co",	58.93300,
	"Ni",	58.71000,
	"Cu",	63.54000,
	"Zn",	65.37000,
	"Ga",	69.72000,
	"Ge",	72.59000,
	"As",	74.92200,
	"Se",	78.96000,
	"Br",	79.90900,
	"Kr",	83.80000,
	"Rb",	85.47000,
	"Sr",	87.62000,
	"Y",	88.90500,
	"Zr",	91.22000,
	"Nb",	92.90600,
	"Mo",	95.94000,
	"Tc",	98.00000,
	"Ru",	101.07000,
	"Rh",	102.90500,
	"Pd",	106.40000,
	"Ag",	107.87000,
	"Cd",	112.40000,
	"In",	114.82000,
	"Sn",	118.69000,
	"Sb",	121.75000,
	"Te",	127.60000,
	"I",	126.90400,
	"Xe",	131.30000,
	"Cs",	132.90500,
	"Ba",	137.34000,
	"La",	138.91000,
	"Ce",	140.12000,
	"Pr",	140.90700,
	"Nd",	144.24001,
	"Pm",	147.00000,
	"Sm",	150.35001,
	"Eu",	151.96001,
	"Gd",	157.25000,
	"Tb",	158.92400,
	"Dy",	162.50000,
	"Ho",	164.92999,
	"Er",	167.25999,
	"Tm",	168.93401,
	"Yb",	173.03999,
	"Lu",	174.97000,
	"Hf",	178.49001,
	"Ta",	180.94800,
	"W",	183.85001,
	"Re",	186.20000,
	"Os",	190.20000,
	"Ir",	192.20000,
	"Pt",	195.09000,
	"Au",	196.96700,
	"Hg",	200.59000,
	"Tl",	204.37000,
	"Pb",	207.19000,
	"Bi",	208.98000,
	"Po",	210.00000,
	"At",	210.00000,
	"Rn",	222.00000,
	"Fr",	223.00000,
	"Ra",	226.00000,
	"Ac",	227.00000,
	"Th",	232.03799,
	"Pa",	231.00000,
	"U",	238.03000,
	"",	0.0000     
	);
    return $ElementsA{$El};
    
}

sub Dichteof {
    my ($El) = @_;
    
    my %Dichte = (
	"H",	0.08,
	"He",	0.12,
	"Li",	0.53,
	"Be",	1.85,
	"B",	2.35,
	"C",	3.51,
	"N",	1.03,
	"O",	2.00,
	"F",	1.11,
	"Ne",	1.50,
	"Na",	0.97,
	"Mg",	1.74,
	"Al",	2.70,
	"Si",	2.33,
	"P",	1.00,
	"S",	2.07,
	"Cl",	2.03,
	"Ar",	1.77,
	"K",	0.86,
	"Ca",	1.54,
	"Sc",	2.99,
	"Ti",	4.51,
	"V",	6.09,
	"Cr",	7.14,
	"Mn",	7.44,
	"Fe",	7.87,
	"Co",	8.89,
	"Ni",	8.91,
	"Cu",	8.92,
	"Zn",	7.14,
	"Ga",	5.91,
	"Ge",	5.32,
	"As",	5.72,
	"Se",	4.19,
	"Br",	3.14,
	"Kr",	3.10,
	"Rb",	1.53,
	"Sr",	2.63,
	"Y",	4.47,
	"Zr",	6.51,
	"Nb",	8.58,
	"Mo",	10.28,
	"Tc",	11.49,
	"Ru",	12.45,
	"Rh",	12.41,
	"Pd",	12.02,
	"Ag",	10.49,
	"Cd",	8.64,
	"In",	7.31,
	"Sn",	7.29,
	"Sb",	6.69,
	"Te",	6.25,
	"I",	4.94,
	"Xe",	3.80,
	"Cs",	1.90,
	"Ba",	3.65,
	"La",	6.16,
	"Ce",	6.77,
	"Pr",	6.48,
	"Nd",	7.00,
	"Pm",	7.22,
	"Sm",	7.54,
	"Eu",	5.25,
	"Gd",	7.89,
	"Tb",	8.25,
	"Dy",	8.56,
	"Ho",	8.78,
	"Er",	9.05,
	"Tm",	9.32,
	"Yb",	6.97,
	"Lu",	9.84,
	"Hf",	13.31,
	"Ta",	16.68,
	"W",	19.26,
	"Re",	21.03,
	"Os",	22.61,
	"Ir",	22.65,
	"Pt",	21.45,
	"Au",	19.32,
	"Hg",	13.55,
	"Tl",	11.85,
	"Pb",	11.34,
	"Bi",	9.80,
	"Po",	9.20,
	"At",	0.10,
	"Rn",	0.10,
	"Fr",	0.10,
	"Ra",	5.50,
	"Ac",	10.07,
	"Th",	11.72,
	"Pa",	15.37,
	"U",	18.97,
	"",	0.0000
	);
    return $Dichte{$El};
}


sub Elastof {
    my ($El) = @_;
    
    my %Elast = (
	"H",	0.10000,
	"He",	0.10000,
	"Li",	1.63000,
	"Be",	3.32000,
	"B",	5.77000,
	"C",	7.37000,
	"N",	4.92000,
	"O",	2.60000,
	"F",	0.84000,
	"Ne",	0.02000,
	"Na",	1.11000,
	"Mg",	1.51000,
	"Al",	3.39000,
	"Si",	4.63000,
	"P",	3.43000,
	"S",	2.85000,
	"Cl",	1.40000,
	"Ar",	0.08000,
	"K",	0.93000,
	"Ca",	1.84000,
	"Sc",	3.90000,
	"Ti",	4.85000,
	"V",	5.31000,
	"Cr",	4.10000,
	"Mn",	2.92000,
	"Fe",	4.28000,
	"Co",	4.39000,
	"Ni",	4.44000,
	"Cu",	3.49000,
	"Zn",	1.35000,
	"Ga",	2.81000,
	"Ge",	3.85000,
	"As",	2.96000,
	"Se",	2.25000,
	"Br",	1.22000,
	"Kr",	0.12000,
	"Rb",	0.85000,
	"Sr",	1.72000,
	"Y",	4.37000,
	"Zr",	6.25000,
	"Nb",	7.57000,
	"Mo",	6.82000,
	"Tc",	6.85000,
	"Ru",	6.74000,
	"Rh",	5.75000,
	"Pd",	3.89000,
	"Ag",	2.95000,
	"Cd",	1.16000,
	"In",	2.52000,
	"Sn",	3.14000,
	"Sb",	2.75000,
	"Te",	2.23000,
	"I",	1.11000,
	"Xe",	0.16000,
	"Cs",	0.80000,
	"Ba",	1.90000,
	"La",	4.47000,
	"Ce",	4.32000,
	"Pr",	3.70000,
	"Nd",	3.40000,
	"Pm",	0.10000,
	"Sm",	2.14000,
	"Eu",	1.86000,
	"Gd",	4.14000,
	"Tb",	4.05000,
	"Dy",	3.04000,
	"Ho",	3.14000,
	"Er",	3.29000,
	"Tm",	2.42000,
	"Yb",	1.60000,
	"Lu",	4.43000,
	"Hf",	6.44000,
	"Ta",	8.10000,
	"W",	8.90000,
	"Re",	8.03000,
	"Os",	8.17000,
	"Ir",	6.94000,
	"Pt",	5.84000,
	"Au",	3.81000,
	"Hg",	0.67000,
	"Tl",	1.88000,
	"Pb",	2.03000,
	"Bi",	2.18000,
	"Po",	1.50000,
	"At",	0.10000,
	"Rn",	0.20000,
	"Fr",	0.10000,
	"Ra",	1.66000,
	"Ac",	4.25000,
	"Th",	6.20000,
	"Pa",	0.10000,
	"U",	5.55000,
	"",	0.00000
	);
    return $Elast{$El}; 
}

sub Stopicru {
    my ($El) = @_;
    
    my %Stopicru = (
	"H",	"1.25400,1.44000,242.60001,12000.00000,0.11590",
	"He",	"1.22900,1.39700,484.50000,5873.00000,0.05225",
	"Li",	"1.41100,1.60000,725.59998,3013.00000,0.04578",
	"Be",	"2.24800,2.59000,966.00000,153.80000,0.03475",
	"B",	"2.47400,2.81500,1206.00000,1060.00000,0.02855",
	"C",	"2.60100,2.60100,1701.00000,1279.00000,0.01638",
	"N",	"2.95400,3.35000,1683.00000,1900.00000,0.02513",
	"O",	"2.65200,3.00000,1920.00000,2000.00000,0.02230",
	"F",	"2.08500,2.35200,2157.00000,2634.00000,0.01816",
	"Ne",	"1.95100,2.19900,2393.00000,2699.00000,0.01568",
	"Na",	"2.54200,2.86900,2628.00000,1854.00000,0.01472",
	"Mg",	"3.79100,4.29300,2862.00000,1009.00000,0.01397",
	"Al",	"4.15400,4.73900,2766.00000,164.50000,0.02023",
	"Si",	"4.91400,5.59800,3193.00000,232.70000,0.01419",
	"P",	"3.23200,3.64700,3561.00000,1560.00000,0.01267",
	"S",	"3.44700,3.89100,3792.00000,1219.00000,0.01211",
	"Cl",	"5.30100,6.00800,3969.00000,645.09998,0.01183",
	"Ar",	"5.73100,6.50000,4253.00000,530.00000,0.01123",
	"K",	"5.15200,5.83300,4482.00000,545.70001,0.01129",
	"Ca",	"5.52100,6.25200,4710.00000,553.29999,0.01120",
	"Sc",	"5.20100,5.88400,4938.00000,560.90002,0.01000",
	"Ti",	"4.85800,5.48900,5260.00000,651.09998,0.00893",
	"V",	"4.47900,5.05500,5391.00000,952.29999,0.00912",
	"Cr",	"3.98300,4.48900,5616.00000,1336.00000,0.00841",
	"Mn",	"3.46900,3.90700,5725.00000,1461.00000,0.00883",
	"Fe",	"3.51900,3.96300,6065.00000,1243.00000,0.00778",
	"Co",	"3.14000,3.53500,6288.00000,1372.00000,0.00736",
	"Ni",	"3.55300,4.00400,6205.00000,555.09998,0.00876",
	"Cu",	"3.69600,4.19400,4649.00000,81.13000,0.02242",
	"Zn",	"4.21000,4.75000,6953.00000,295.20001,0.00681",
	"Ga",	"5.04100,5.69700,7137.00000,202.60001,0.00673",
	"Ge",	"5.55400,6.30000,6496.00000,110.00000,0.00969",
	"As",	"5.32300,6.01200,7611.00000,292.50000,0.00645",
	"Se",	"5.87400,6.65600,7395.00000,117.50000,0.00768",
	"Br",	"6.65800,7.53600,7694.00000,222.30000,0.00651",
	"Kr",	"6.41300,7.24000,11850.00000,153.70000,0.00288",
	"Rb",	"5.69400,6.42900,8478.00000,292.89999,0.00609",
	"Sr",	"6.33900,7.15900,8693.00000,330.29999,0.00600",
	"Y",	"6.40700,7.23400,8907.00000,367.79999,0.00589",
	"Zr",	"6.73400,7.60300,9120.00000,405.20001,0.00576",
	"Nb",	"6.90100,7.79100,9333.00000,442.70001,0.00559",
	"Mo",	"6.42400,7.24800,9545.00000,480.20001,0.00538",
	"Tc",	"6.79900,7.67100,9756.00000,517.59998,0.00532",
	"Ru",	"6.10900,6.88700,9966.00000,555.09998,0.00515",
	"Rh",	"5.92400,6.67700,10180.00000,592.50000,0.00492",
	"Pd",	"5.23800,5.90000,10380.00000,630.00000,0.00476",
	"Ag",	"5.34500,6.03800,6790.00000,397.79999,0.01676",
	"Cd",	"5.81400,6.55400,10800.00000,355.50000,0.00463",
	"In",	"6.22900,7.02400,11010.00000,370.89999,0.00454",
	"Sn",	"6.40900,7.22700,11210.00000,386.39999,0.00447",
	"Sb",	"7.50000,8.48000,8608.00000,348.00000,0.00907",
	"Te",	"6.97900,7.87100,11620.00000,392.39999,0.00440",
	"I",	"7.72500,8.71600,11830.00000,394.79999,0.00438",
	"Xe",	"8.33700,9.42500,10510.00000,269.60001,0.00621",
	"Cs",	"7.28700,8.21800,12230.00000,399.70001,0.00445",
	"Ba",	"7.89900,8.91100,12430.00000,402.10001,0.00451",
	"La",	"8.04100,9.07100,12630.00000,404.50000,0.00454",
	"Ce",	"7.48800,8.44400,12830.00000,406.89999,0.00442",
	"Pr",	"7.29100,8.21900,13030.00000,409.29999,0.00430",
	"Nd",	"7.09800,8.00000,13230.00000,411.79999,0.00418",
	"Pm",	"6.90900,7.78600,13430.00000,414.20001,0.00406",
	"Sm",	"6.72800,7.58000,13620.00000,416.60001,0.00398",
	"Eu",	"6.55100,7.38000,13820.00000,419.00000,0.00388",
	"Gd",	"6.73900,7.59200,14020.00000,421.39999,0.00386",
	"Tb",	"6.21200,6.99600,14210.00000,423.89999,0.00372",
	"Dy",	"5.51700,6.21000,14400.00000,426.29999,0.00363",
	"Ho",	"5.22000,5.87400,14600.00000,428.70001,0.00350",
	"Er",	"5.07100,5.70600,14790.00000,433.00000,0.00341",
	"Tm",	"4.92600,5.54200,14980.00000,433.50000,0.00334",
	"Yb",	"4.78800,5.38600,15170.00000,435.89999,0.00329",
	"Lu",	"4.89300,5.50500,15360.00000,438.29999,0.00324",
	"Hf",	"5.02800,5.65700,15550.00000,440.79999,0.00320",
	"Ta",	"4.73800,5.32900,15740.00000,443.20001,0.00319",
	"W",	"4.58700,5.16000,15410.00000,415.29999,0.00341",
	"Re",	"5.20100,5.85100,16120.00000,441.60001,0.00312",
	"Os",	"5.07100,5.70400,16300.00000,440.89999,0.00308",
	"Ir",	"4.94600,5.56300,16490.00000,440.10001,0.00296",
	"Pt",	"4.47700,5.03400,16670.00000,439.29999,0.00287",
	"Au",	"4.84400,5.45800,7852.00000,975.79999,0.02077",
	"Hg",	"4.30700,4.84300,17040.00000,487.79999,0.00288",
	"Tl",	"4.72300,5.31100,17220.00000,537.00000,0.00291",
	"Pb",	"5.31900,5.98200,17400.00000,586.29999,0.00287",
	"Bi",	"5.95600,6.70000,17800.00000,677.00000,0.00266",
	"Po",	"6.15800,6.92800,17770.00000,586.29999,0.00281",
	"At",	"6.20300,6.97900,17950.00000,586.29999,0.00278",
	"Rn",	"6.18100,6.95400,18120.00000,586.29999,0.00275",
	"Fr",	"6.94900,7.82000,18300.00000,586.29999,0.00274",
	"Ra",	"7.50600,8.44800,18480.00000,586.29999,0.00273",
	"Ac",	"7.64800,8.60900,18660.00000,586.29999,0.00270",
	"Th",	"7.71100,8.67900,18830.00000,586.29999,0.00264",
	"Pa",	"7.40700,8.33600,19010.00000,586.29999,0.00260",
	"U",	"7.29000,8.20400,19180.00000,586.29999,0.00267",
	"",	"0.00000,0.00000,0.00000,0.00000,0.00000"
	);
    return $Stopicru{$El};
}

1;