Residue Curve Map for Ternary Systems
Case of Acetone - Chloroform - Methanol System
Author's Data: Housam BINOUS
Department of Chemical Engineering
National Institute of Applied Sciences and Technology
Tunis, TUNISIA
Email: binoushousam@yahoo.com

Acetone = component 1
Chloroform = component 2
Methanol = component 3

Gas Constant and Total Pressure

R = 1.987; P = 760;

Vapor Pressure Using Antoine Equation

A1 = 7.11714; B1 = 1210.595; C1 = 229.664;
A2 = 6.95465; B2 = 1170.966; C2 = 226.232;
A3 = 8.08097; B3 = 1582.271; C3 = 239.726;

PS1[i_] := 
        10^(A1 - B1/(C1 + T));
PS2[i_] := 
        10^(A2 - B2/(C2 + T));
PS3[i_] := 10^(A3 - B3/(C3 + T));

Binary inetraction Parameters and Activities for Wilson Model

l12 = 116.1171; l21 = -506.8519; 
    l13 = -114.4047;
l31 = 545.2942; l23 = -361.7944; 
    l32 = 1694.0241;
V1 = 74.05; V2 = 80.67; V3 = 40.73;

A12 = 
        V2/V1 Exp[-l12/(R*(273.15 + 
                      T))];
A13 = 
        V3/V1 Exp[-l13/(R*(273.15 + 
                      T))];
A32 = 
        V2/V3 Exp[-l32/(R*(273.15 + 
                      T))];
A21 = 
        V1/V2 Exp[-l21/(R*(273.15 + 
                      T))];
A31 = 
        V1/V3 Exp[-l31/(R*(273.15 + 
                      T))];
A23 = V3/V2 Exp[-l23/(R*(273.15 + T))];

GAM1[i_] := 
        Exp[-Log[x1[i] + x2[i]*A12 + x3[i]*A13] + 
            1 - (x1[i]/(x1[i] + x2[i]*A12 + x3[i]*A13) + 
                x2[i]*A21/(x1[i]*A21 + x2[i] + x3[i]*A23) + 
                x3[i]*A31/(x1[i]*A31 + x2[i]*A32 + 
                        x3[i]))];
GAM2[i_] := 
        Exp[-Log[x1[i]*A21 + x2[i] + x3[i]*A23] + 
            1 - (x1[i]*A12/(x1[i] + x2[i]*A12 + x3[i]*A13) + 
                x2[i]/(x1[i]*A21 + x2[i] + x3[i]*A23) + 
                x3[i]*A32/(x1[i]*A31 + x2[i]*A32 + 
                        x3[i]))];
GAM3[i_] := 
        Exp[-Log[x1[i]*A31 + x2[i]*A32 + x3[i]] + 
            1 - (x1[i]*A13/(x1[i] + x2[i]*A12 + x3[i]*A13) + 
                x2[i]*A23/(x1[i]*A21 + x2[i] + x3[i]*A23) + 
                x3[i]/(x1[i]*A31 + x2[i]*A32 + x3[i]))];

Calculation of Residue Curve Map for different initial conditions

h = 0.1; x1[0] = 0.2; x2[0] = 0.2; x3[0] = 0.6; i = 0;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] - h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] - h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] - h (x3[i] - y3[i]), i++}];

t1 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt1 = ListPlot[t1, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.2; x2[0] = 0.2; x3[0] = 0.6;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] + h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] + h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] + h (x3[i] - y3[i]), i++}];

t2 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt2 = ListPlot[t2, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.8; x2[0] = 0.1; x3[0] = 0.1;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] + h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] + h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] + h (x3[i] - y3[i]), i++}];

t3 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt3 = ListPlot[t3, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.8; x2[0] = 0.1; x3[0] = 0.1;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] - h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] - h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] - h (x3[i] - y3[i]), i++}];

t4 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt4 = ListPlot[t4, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.4; x2[0] = 0.1; x3[0] = 0.5;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] + h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] + h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] + h (x3[i] - y3[i]), i++}];

t5 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt5 = ListPlot[t5, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.4; x2[0] = 0.1; x3[0] = 0.5;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] - h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] - h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] - h (x3[i] - y3[i]), i++}];

t6 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt6 = ListPlot[t6, PlotRange -> {{0, 1}, {0, 1}}]

i = 0; x1[0] = 0.3; x2[0] = 0.4; x3[0] = 0.3;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] + h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] + h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] + h (x3[i] - y3[i]), i++}];

t7 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt7 = ListPlot[t7, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.3; x2[0] = 0.4; x3[0] = 0.3;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] - h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] - h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] - h (x3[i] - y3[i]), i++}];

t8 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt8 = ListPlot[t8, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.38; x2[0] = 0.22; x3[0] = 0.4;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] + h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] + h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] + h (x3[i] - y3[i]), i++}];

t9 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt9 = ListPlot[t9, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.38; x2[0] = 0.22; x3[0] = 0.4;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] - h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] - h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] - h (x3[i] - y3[i]), i++}];

t10 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt10 = 
        ListPlot[t10, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.1; x2[0] = 0.8; x3[0] = 0.1;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] + h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] + h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] + h (x3[i] - y3[i]), i++}];

t11 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt11 = 
        ListPlot[t11, PlotRange -> {{0, 1}, {0, 1}}];

i = 0; x1[0] = 0.1; x2[0] = 0.8; x3[0] = 0.1;

While[
        i < 200, {T = FindRoot[
                P == 
                  Evaluate[
                    x1[i] PS1[i] GAM1[i] + x2[i] PS2[i] GAM2[i] + 
                      x3[i] PS3[i] GAM3[i]], {T, 100}][[1, 2]], 
          y1[i] = x1[i] PS1[i] GAM1[i]/P, 
y2[i] = 
            x2[i] PS2[i] GAM2[i]/P, 
y3[i] = 
            x3[i] PS3[i] GAM3[i]/P, 
          x1[i + 1] = x1[i] - h (x1[i] - y1[i]), 
          x2[i + 1] = x2[i] - h (x2[i] - y2[i]), 
          x3[i + 1] = x3[i] - h (x3[i] - y3[i]), i++}];

t12 = Table[{x1[i], x2[i]}, {i, 1, 200}];

plt12 = 
        ListPlot[t12, PlotRange -> {{0, 1}, {0, 1}}];

Plot of Residue Curves 
Azeotropes are show as green dots

Show[plt1, plt2, plt3, plt4, plt5, plt6, plt7, plt8, plt9, plt10, 
      plt11, plt12, 
      Graphics[{PointSize[0.04], RGBColor[0, 0, 1], Point[{0, 1}], 
          Point[{1, 0}], Point[{0, 0}]}], 
      Graphics[{{PointSize[0.04], RGBColor[0, 1, 0], 
            Point[{0.3372709051595132, 0.6627290948414463}], 
            Point[{0.7895499074011543, 0}], Point[{0, 0.6547858067112002`}], 
            Point[{0.32931289030731187, 0.23036949344554894}]}, {Text[
              Methanol, {0, -0.1}], Text[Acetone, {1.0, -0.1}], 
            Text[Chloroform, {0, 1.1}], RGBColor[0, 0, 1]}}], 
      AspectRatio -> 1, 
      PlotRange -> {{-0.2, 1.2}, {-0.2, 1.2}}, 
      Epilog -> {RGBColor[1, 0, 0], Line[{{1, 0}, {0, 1}}]}]