Determining Wavefunction of Noncyclic Polyenes

Clear["Globals`*"]

βconstant = 75 kcal/mol;

Equations

c[j_, r_, n_] := ((((2/((n+1)))))^0.5) Sin[(((j r π))/((n + 1)))]

m[j_,n_] := N[2 Cos[(((j π))/((n + 1)))]]

Ethene

Wavefunctions

n =2;

eth = ({{" ", "Atom A (r=1)", "Atom B (r=2)", "Energy(β)"}, {"ψ1", c[1,1,n], c[1,2,n], m[1,n]}, {"ψ2", c[2,1,n], c[2,2,n], m[2,n]}});
Grid[eth,Frame-> All]

equations = ({{ ψ1, eth[[2,2]](Subscript[ψ, A]) +  eth[[2,3]](Subscript[ψ, B]) }, {ψ2, eth[[3,2]](Subscript[ψ, A]) +  eth[[3,3]](Subscript[ψ, B]) }});

Grid[equations,Frame-> All]

localizationenergy = Abs[eth[[2,4]]]+ Abs[eth[[3,4]]]

Delocalization Energies

ψvalues = NSolve[Det[(({{x, 1}, {1, x}}))]==0,x]

ψ1=x/.ψvalues[[1]];
ψ2=x/.ψvalues[[2]];

etheneψTotal = Abs[ψ1] + Abs[ψ2]

energyψ1 = α + ψ1 β
energyψ2 = α + ψ2 β
energyTotal = energyψ2 - energyψ2

totalenergy = energyTotal βconstant /.β-> 1

Check for orthonormality:

∫(Subscript[ψ, 1])(Subscript[ψ, 1])\[DifferentialD]τ= ((eth[[2,2]])^2) + ((eth[[2,3]])^2)

∫(Subscript[ψ, 2])(Subscript[ψ, 2])\[DifferentialD]τ= ((eth[[3,2]])^2) + ((eth[[3,3]])^2)

∫(Subscript[ψ, 1])(Subscript[ψ, 2])\[DifferentialD]τ= (eth[[2,2]] eth[[3,2]]) + (eth[[2,3]] eth[[3,3]])

Allyl

n =3;

allyl = ({{" ", "Atom A (r=1)", "Atom B (r=2)", "Atom C (r=3)", "Energy (β)"}, {"ψ1", c[1,1,n], c[1,2,n], c[1,3,n], m[1,n]}, {"ψ2", c[2,1,n], c[2,2,n], c[2,3,n], m[2,n]}, {"ψ3", c[3,1,n], c[3,2,n], c[3,3,n], m[3,n]}});
Grid[allyl,Frame-> All]

equations = ({{ ψ1, allyl[[2,2]](Subscript[ψ, A]) +  allyl[[2,3]](Subscript[ψ, B]) + allyl[[2,4]](Subscript[ψ, C]) }, {ψ2, allyl[[3,2]](Subscript[ψ, A]) +  allyl[[3,3]](Subscript[ψ, B]) +  allyl[[3,4]](Subscript[ψ, C]) }, {ψ3, allyl[[4,2]](Subscript[ψ, A]) +  allyl[[4,3]](Subscript[ψ, B]) + allyl[[4,4]](Subscript[ψ, C]) }});

Grid[equations,Frame-> All]

delocalizationenergy = Abs[allyl[[2,4]]]+ Abs[allyl[[3,4]]]

ΔE =localizationenergy - delocalizationenergy

Check for orthonormality:

∫(Subscript[ψ, 1])(Subscript[ψ, 1])\[DifferentialD]τ= (0.5^2) + (0.707107^2)+ (0.5^2)

∫(Subscript[ψ, 1])(Subscript[ψ, 2])\[DifferentialD]τ= (0.5) (0.707107) + (0.707107) (0) + (0.5) (-0.707107)

Butadiene

n =4;

but = ({{" ", "Atom A (r=1)", "Atom B (r=2)", "Atom C (r=3)", "Atom D(r=4)", "Energy(β)"}, {"ψ1", c[1,1,n], c[1,2,n], c[1,3,n], c[1,4,n], m[1,n]}, {"ψ2", c[2,1,n], c[2,2,n], c[2,3,n], c[2,4,n], m[2,n]}, {"ψ3", c[3,1,n], c[3,2,n], c[3,3,n], c[3,4,n], m[3,n]}, {"ψ4", c[4,1,n], c[4,2,n], c[4,3,n], c[4,4,n], m[4,n]}});
Grid[but,Frame-> All]

equations = ({{ ψ1, but[[2,2]](Subscript[ψ, A]) +  but[[2,3]](Subscript[ψ, B]) +  but[[2,4]](Subscript[ψ, C]) +  but[[2,5]](Subscript[ψ, D])}, {ψ2, but[[3,2]](Subscript[ψ, A]) +  but[[3,3]](Subscript[ψ, B]) +  but[[3,4]](Subscript[ψ, C]) +  but[[3,5]](Subscript[ψ, D])}, {ψ3, but[[4,2]](Subscript[ψ, A]) +  but[[4,3]](Subscript[ψ, B]) +  but[[4,4]](Subscript[ψ, C]) +  but[[4,5]](Subscript[ψ, D])}, {ψ4, but[[5,2]](Subscript[ψ, A]) +  but[[5,3]](Subscript[ψ, B]) +  but[[5,4]](Subscript[ψ, C]) +  but[[5,5]](Subscript[ψ, D])}});

Grid[equations,Frame-> All]

Check for orthonormality:

∫(Subscript[ψ, 1])(Subscript[ψ, 1])\[DifferentialD]τ= (0.371748^2) +(0.601501^2)+ (0.601501^2)+ (0.371748^2)

∫(Subscript[ψ, 1])(Subscript[ψ, 2])\[DifferentialD]τ= (0.371748) (0.601501) + (0.371748) (0.601501) + (-0.371748) (0.601501)+ (0.371748) (-0.601501)

Hexatriene

n =6;

hex= ({{" ", "Atom A (r=1)", "Atom B (r=2)", "Atom C (r=3)", "Atom D(r=4)", "Atom E(r=5)", "Atom F(r=6)", "Energy(β)"}, {"ψ1", c[1,1,n], c[1,2,n], c[1,3,n], c[1,4,n], c[1,5,n], c[1,6,n], m[1,n]}, {"ψ2", c[2,1,n], c[2,2,n], c[2,3,n], c[2,4,n], c[2,5,n], c[2,6,n], m[2,n]}, {"ψ3", c[3,1,n], c[3,2,n], c[3,3,n], c[3,4,n], c[3,5,n], c[3,6,n], m[3,n]}, {"ψ4", c[4,1,n], c[4,2,n], c[4,3,n], c[4,4,n], c[4,5,n], c[4,6,n], m[4,n]}, {"ψ5", c[5,1,n], c[5,2,n], c[5,3,n], c[5,4,n], c[5,5,n], c[5,6,n], m[5,n]}, {"ψ6", c[6,1,n], c[6,2,n], c[6,3,n], c[6,4,n], c[6,5,n], c[6,6,n], m[6,n]}});
Grid[hex,Frame-> All]

equations = ({{ ψ1, hex[[2,2]](Subscript[ψ, A]) +  hex[[2,3]](Subscript[ψ, B]) +  
hex[[2,4]](Subscript[ψ, C]) +  hex[[2,5]](Subscript[ψ, D]) +  hex[[2,6]](Subscript[ψ, E]) +  hex[[2,7]](Subscript[ψ, F])}, {ψ2, hex[[3,2]](Subscript[ψ, A]) + hex[[3,3]](Subscript[ψ, B]) +  
hex[[3,4]](Subscript[ψ, C]) +  hex[[3,5]](Subscript[ψ, D])+  hex[[3,6]](Subscript[ψ, E]) +  hex[[3,7]](Subscript[ψ, F])}, {ψ3, hex[[4,2]](Subscript[ψ, A]) +  hex[[4,3]](Subscript[ψ, B]) +  
hex[[4,4]](Subscript[ψ, C]) +  hex[[4,5]](Subscript[ψ, D])+  hex[[4,6]](Subscript[ψ, E]) +  hex[[4,7]](Subscript[ψ, F])}, {ψ4, hex[[5,2]](Subscript[ψ, A]) + hex[[5,3]](Subscript[ψ, B]) +  
hex[[5,4]](Subscript[ψ, C]) +  hex[[5,5]](Subscript[ψ, D])+  hex[[5,6]](Subscript[ψ, E]) +  hex[[5,7]](Subscript[ψ, F])}, {ψ5, hex[[6,2]](Subscript[ψ, A]) +  hex[[6,3]](Subscript[ψ, B]) +  
hex[[6,4]](Subscript[ψ, C]) +  hex[[6,5]](Subscript[ψ, D]) +  hex[[6,6]](Subscript[ψ, E]) +  hex[[6,7]](Subscript[ψ, F])}, {ψ6, hex[[7,2]](Subscript[ψ, A]) +  hex[[7,3]](Subscript[ψ, B]) +  
hex[[7,4]](Subscript[ψ, C]) +  hex[[7,5]](Subscript[ψ, D]) +  hex[[7,6]](Subscript[ψ, E]) +  hex[[7,7]](Subscript[ψ, F])}});

Grid[equations,Frame-> All]

delocalizationenergy = Abs[hex[[2,8]]]+ Abs[hex[[3,8]]]+ Abs[hex[[4,8]]]+ Abs[hex[[5,8]]]+ Abs[hex[[6,8]]]+ Abs[hex[[7,8]]]

ΔE = delocalizationenergy -3 localizationenergy