Language: Excel/VisualBasic.
Objective: A program to simulate growth of many polymer chains by free radical polymerization and count chains of given degree of polymerization. A graphical output of the results is available.
Notes: Includes data for experiments with the following monomers: acrylonitrile, methyl methacrylate, styrene, vinyl acetate and vinyl chloride. Data about other or additional monomers can easily incorporated to the program. Termination of the polymerization process can be chosen: by dispropornation or by coupling.
Click here to download the Excel file or use the Visual Basic for Applications listing below.
***** Begin of Program Listing *****
'
' POLYMER DISTRIBUTION EXPERIMENTS
'
' A program to simulate growth of many polymer chains by free
' radical polymerization and count chains of given degree of
' polymerization.
'
' Original Basic Program by L. Oliver Smith, Valparaiso University.
' See Journal of Chemical Education, Sept. 1988, 795-796.
'
'
' Excel/Visual Basic version developed by
' Antonio Augusto Gorni
' São Vicente, Brazil
' www.gorni.eng.br
'
' April 18, 2002
'
Option Explicit
'
' Definition of Global Constants.
'
Public Const gintMaxNo As Integer = 5000
Public Const gintArrMax As Integer = 10000
'
' Defining Global Variables.
'
Public intL As Integer
Public intPolOpt As Integer
Public intMaxNum As Integer
Public intMaxWt As Integer
Public intSample As Integer
Public intXAxisTicksnumber As Integer
Public intYAxisTicksnumber As Integer
Public intXAxisTicksWeight As Single
Public intYAxisTicksWeight As Single
Public sngM0 As Single
Public sngInit As Single
Public sngMonMolWt As Single
Public sngKit As Single
Public sngKpt As Single
Public sngSamplSum(200) As Single
Public sngSmplTotl(200) As Single
Public sngXMinNumber As Single
Public sngXMaxNumber As Single
Public sngYMinNumber As Single
Public sngYMaxnumber As Single
Public sngXMinWeight As Single
Public sngXMaxWeight As Single
Public sngYMinWeight As Single
Public sngYMaxWeight As Single
Public strXAxisLegendNumber As String
Public strYAxisLegendNumber As String
Public strXAxisLegendWeight As String
Public strYAxisLegendWeight As String
Public strPolymer As String
Public strTerm As String
Public strBuffer As String
Dim intQ As Integer
Dim intN As Integer
Dim intSize As Integer
Dim intDP(gintArrMax) As Integer
Dim sngR0 As Single
Dim sngRatio As Single
Dim sngIncrement As Single
Dim sngAvMolWt As Single
Dim sngKinChL As Single
Dim sngChnSum As Single
Dim sngMassUm As Single
Dim boolDone As Boolean
Dim boolTerminate As Boolean
'
' sngM0 > Monomer Concentration
' sngInit > Initiator Concentration
' sngr0 > Free Radical Concentration
' sngRatio > Ratio of Polymerization Rate to Termination Rate
' sngMonMolWt > Molecular Weight of Monomer
' sngKit > Square Root(ki/kt)
' sngKpt > kp/kt
' sngChnSum > Total Number of Chains Formed
' sngMassUm > Total Mass of Polymer
' sngSamplSum > Maximum Number Fraction
' sngSamplTotl > Maximum Weight Fraction
' intSample > Number of Degrees of Polymerization per Sample
' intL > Highest Degree of Polymerization
' sngAvMolWt > Number Average Molecular Weight of Polymer
' sngKinChL > Kinetic Chain Length
'
Sub Auto_Open()
Application.ScreenUpdating = False
Clear
Application.ScreenUpdating = True
End Sub
'
' Introduc Macro:
' Display Basic Info about the Program.
'
Sub Introduc()
Load frmIntroduction
frmIntroduction.Show
Set frmIntroduction = Nothing
End Sub
'
' Input_Data Macro:
' Get data about Polymer and Monomer/Initiator Concentration.
'
Sub Input_Data()
Dim intIJ As Integer
frmPolyData.Show
Set frmPolyData = Nothing
'
' Checks Again If User Gave Up.
'
If intPolOpt = 0 Then Exit Sub
'
' User is Turned On: Program Continues.
' Initializes Variables...
'
For intIJ = 1 To gintArrMax
intDP(intIJ) = 0
Next intIJ
sngR0 = sngKit * Sqr(sngInit)
sngRatio = 0.5 * sngM0 * sngKpt / sngR0
sngRatio = sngRatio / (1# + sngRatio)
intQ = Int((1# + 0.0268 * sngM0 * sngKpt / sngR0) + 0.5)
End Sub
'
' PropagaTd Subroutine:
' Procedure to Simulate Degrees of Polymerization of Polymer Chains
' Based on Relative Probabilities of Propagation and Termination by
' Disproportionation
'
Sub PropagaTd(sngR As Single, intU As Integer)
Dim sngA As Single
intU = 1
boolTerminate = False
Do Until boolTerminate Or (intU = gintArrMax)
sngA = Rnd
If sngA < sngR Then
intU = intU + 1 ' Terminate or grow based on probability
' intU = chain length
Else
boolTerminate = True
End If
Loop
If intU < gintArrMax Then intDP(intU) = intDP(intU) + 1 ' Add 1 to deg. of polym. counter
End Sub
'
' PropagTc Subroutine
'
' Procedure to Simulate Degrees of Polymerization of Polymer Chains
' Based on Relative Probabilities of Propagation and Termination by
' Coupling
'
Sub PropagaTc(sngR As Single, intJ As Integer)
Dim intIncr As Integer
Dim intU As Integer
Dim sngA As Single
Dim intPlen(2) As Integer
For intIncr = 1 To 2
intU = 1
boolTerminate = False
Do Until boolTerminate Or (intU = gintArrMax)
sngA = Rnd
If sngA < sngR Then
intU = intU + 1 ' Terminate or Grow Based on Probability
' intU = growing chain length
Else
boolTerminate = True
End If
Loop
intPlen(intIncr) = intU
Next intIncr
intJ = intPlen(1) + intPlen(2) ' intJ = Coupled Chain Length
If intJ < gintArrMax Then intDP(intJ) = intDP(intJ) + 1 ' Add to Coupled Chain Length Counter}
End Sub
'
' CalculNs Subroutine
'
' Calculates Total Number of Chains Formed, "Mass of Polymer", Maximum
' Number Fraction, Maximum Weight Fraction and Numbers of Degrees of
' Polymerization per Sample
'
Sub CalculNs(sngAvMw As Single, sngSum() As Single, sngTotal() As Single, _
intStep As Integer, intMax1 As Integer, intMax2 As Integer)
Dim intJ As Integer
Dim intK As Integer
Dim intNI As Integer
Dim intTerm As Integer
Dim sngW As Single
Dim intW1(gintArrMax) As Integer
Dim intW2(gintArrMax) As Integer
intMax1 = 1
intMax2 = 1
sngChnSum = 0#
sngMassUm = 0#
For intJ = 1 To intL
sngW = intJ * intDP(intJ) ' Calculate Weight of Polymer Chain Length I
intW1(intJ) = Int(sngW / 30000#)
intW2(intJ) = Int(sngW - Int(intW1(intJ) * 30000#))
sngMassUm = sngMassUm + sngW ' Calculate Total Weight of Polymer
sngChnSum = sngChnSum + intDP(intJ) ' Calculate Total Number of Chains
Next
sngAvMw = sngMassUm / sngChnSum
intTerm = Int(sngAvMw * 5# + 0.5)
sngAvMw = sngAvMw * sngMonMolWt
If intTerm > intL Then intTerm = intL
intStep = (intTerm + 199) \ 200
For intJ = 1 To 200
sngSum(intJ) = 0#
sngTotal(intJ) = 0#
For intNI = 1 To intStep
intK = intStep * (intJ - 1) + intNI
sngSum(intJ) = sngSum(intJ) + intDP(intK) ' Sum Number of Chains in Range
sngTotal(intJ) = sngTotal(intJ) + intW1(intK) * 30000# + intW2(intK) ' Sum Chain Weights in range
Next intNI
If sngSum(intJ) > sngSum(intMax1) Then intMax1 = intJ ' Find Largest Sum of Chains
If sngTotal(intJ) > sngTotal(intMax2) Then intMax2 = intJ ' Find Largest Sum of Weights
Next intJ
For intJ = 1 To 200
sngSum(intJ) = sngSum(intJ) / sngChnSum ' Convert to Fractions
sngTotal(intJ) = sngTotal(intJ) / sngMassUm ' Convert to Fractions
Next intJ
End Sub
'
' Clear Macro:
' Prepares Spreadsheet for New Calculation.
'
Sub Clear()
Dim intCounter As Integer
'
' Clear Graphics.
'
Worksheets("Polymer_Distribution").Activate
If [E10] <> "" Then
Worksheets("Polymer_Graphics").Activate
ActiveSheet.ChartObjects("First Graph").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Second Graph").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
End If
'
' Clear Numerical Data.
'
Worksheets("Polymer_Distribution").Activate
For intCounter = 10 To 22
Cells(intCounter, "E") = ""
Next intCounter
Range("E10").Select
End Sub
'
' Start Macro:
' Executes the Numerical Calculations.
'
Sub Start()
Dim intIJ As Integer
Dim intI As Integer
Dim intAux As Integer
'
' Clear the Results of Previous Calculations.
'
Application.ScreenUpdating = False
Clear
Application.ScreenUpdating = True
Application.ScreenUpdating = False
'
' Data Input Using Forms: Type of Polymerization Reaction.
'
frmPolType.Show
'
' Checks if User Gave Up.
'
If intPolOpt = 0 Then Exit Sub
'
' User is Turned On: Program Continues.
' Data Input.
'
Input_Data
'
' Begin Calculations...
'
Worksheets("Polymer_Distribution").Activate
Select Case intPolOpt
Case 1
intL = 1
Randomize
For intN = 1 To gintMaxNo
PropagaTd sngRatio, intSize ' Build ggintMaxNo of "Polymer Chains"
If intSize > intL Then intL = intSize ' Set l at Largest Chain Length
Next intN
CalculNs sngAvMolWt, sngSamplSum, sngSmplTotl, intSample, intMaxNum, intMaxWt
[E11] = "Disproportionation"
strTerm = "D"
sngKinChL = sngAvMolWt / sngMonMolWt
Case 2
intL = 1
Randomize
For intN = 1 To gintMaxNo
PropagaTc sngRatio, intSize ' Build ggintMaxNo of "Polymer Chains"
If intSize > intL Then intL = intSize ' Set l at Largest Chain Length}
Next intN
CalculNs sngAvMolWt, sngSamplSum, sngSmplTotl, intSample, intMaxNum, intMaxWt
[E11] = "Coupling"
strTerm = "C"
sngKinChL = sngAvMolWt / sngMonMolWt / 2
End Select
'
' Output Numerical Data...
'
[E10] = strPolymer
[E12] = sngM0
[E13] = sngInit
[E14] = sngR0
[E15] = sngChnSum
[E16] = sngMassUm
[E17] = sngSamplSum(intMaxNum)
[E18] = sngSmplTotl(intMaxWt)
[E19] = intSample
[E20] = intL
[E21] = sngAvMolWt
[E22] = sngKinChL
'
' Generates Data for Graphics...
'
Sheets("Graphic_Data").Select
Range("A2:E201").Select
Selection.Clear
For intI = 1 To 200
intAux = intI * intSample
Range("A" & intI + 1) = intI * intSample
Range("B" & intI + 1) = sngSamplSum(intI)
Range("C" & intI + 1) = sngSmplTotl(intI)
If strTerm = "D" Then
Range("D" & intI + 1) = CSng(intSample) * Exp(intAux * Log(sngKinChL / (sngKinChL + 1#))) / sngKinChL
Range("E" & intI + 1) = CSng(intSample) * CSng(intAux) * Exp(intAux * Log(sngKinChL / (sngKinChL + 1#))) / (sngKinChL * sngKinChL)
strBuffer = "Disproportionation"
End If
If strTerm = "C" Then
Range("D" & intI + 1) = CSng(intSample) * CSng(intAux - 1) * Exp(intAux * Log(sngKinChL / (sngKinChL + 1#))) / (sngKinChL * sngKinChL)
Range("E" & intI + 1) = CSng(intSample) * CSng(intAux) * CSng(intAux - 1) * Exp(intAux * Log(sngKinChL / (sngKinChL + 1#))) / (2# * sngKinChL * sngKinChL * sngKinChL)
strBuffer = "Coupling"
End If
Next intI
'
' Plots results...
'
Sheets("Polymer_Graphics").Select
ActiveSheet.ChartObjects.Add(0, 0, 420, 202.5).Select
ActiveSheet.ChartObjects(1).Name = "First Graph"
Application.CutCopyMode = False
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets("Graphic_Data").Range( _
"A2:B201,D2:D201"), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = "=""Simulated Polymerization"""
ActiveChart.SeriesCollection(2).Name = "=""Theoretical Curve"""
ActiveChart.Location Where:=xlLocationAsObject, Name:="Polymer_Graphics"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = _
"Number Fraction Distribution of D.P. - " + strBuffer
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _
"Degree of Polymerization - " + strPolymer
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Fraction"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.Deselect
ActiveSheet.ChartObjects.Add(500, 0, 420, 202.5).Select
ActiveSheet.ChartObjects(2).Name = "Second Graph"
ActiveSheet.ChartObjects("Second Graph").Activate
Application.CutCopyMode = False
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets("Graphic_Data").Range( _
"A2:A201,C2:C201,E2:E201"), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = "=""Simulated Polymerization"""
ActiveChart.SeriesCollection(2).Name = "=""Theoretical Curve"""
ActiveChart.Location Where:=xlLocationAsObject, Name:="Polymer_Graphics"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = _
"Weight Fraction Distribution of D.P. - " + strBuffer
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _
"Degree of Polymerization - " + strPolymer
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Fraction"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.Deselect
' ActiveSheet.ChartObjects("First Graph").Select
Range("A1").Select
Worksheets("Polymer_Distribution").Activate
End Sub
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 01 April 2004 | |
| © Antonio Augusto Gorni |