-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathconvert6.bas
331 lines (273 loc) · 13.4 KB
/
convert6.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
Attribute VB_Name = "CodeCONVERT6"
' (c) Copyright 1995-2025 by John J. Donovan
Option Explicit
Sub ConvertHalog(tfilenumber As Integer, percents() As Single, sample() As TypeSample)
' v. 1.0; WRITTEN BY G. BRIMHALL
'
' v. 1.1; MODIFIED BY JAY AGUE (8-1-84) TO COMPUTE BIOTITE
' COMPONENT ACTIVITIES. RECALCULATION PROCEDURE ALSO MODIFIED.
'
' v. 1.2; Further modifications to calculation procedure and
' output formats by Jay J. Ague 4/89. One of the more
' important changes has been the incorporation of code
' which rounds the values in the structural formula to
' 4 decimal places before any computations of mole fractions
' etc. takes place. This is to insure consistency between
' the printed (rounded) structural formula and computed
' quantities.
'
' v.1.3, 19 May 98; Jay J. Ague. Updated with atomic and
' molecular weights from DHZ `92. Output format also modified.
'
' COMPUTES BIOTITE FORMULAS AND SITE OCCUPANCIES AND MOLE FRACTION RATIOS FOR USE IN HALOGEN
' CHEMISTRY AND CHARACTERIZATION OF MINERALIZATION ENVIRONMENTS
ierror = False
On Error GoTo ConvertHalogError
Const MAXBIOT% = 12
Const SSTRING1$ = "-----------------------------------------------------------"
Const SSTRING2$ = " ------ "
Dim IDEBUG As Integer, IBIG As Integer
Dim i As Integer, ip As Integer
Dim MNX As Single, MGMFT As Single, MGB As Single, YM32X As Single
Dim SIDER As Single, ANNIT As Single, PHLOG As Single, WTPCT As Single, WTT As Single
Dim sum1 As Single, sum2 As Single, sum3 As Single, sum4 As Single
Dim WTPCF As Single, WTPCCL As Single, ATOPT As Single, TETAL As Single, OCTAL As Single
Dim XALVI As Single, ALKM As Single, FEX As Single, tix As Single
Dim HALMF As Single, HALMC As Single, HALMO As Single, XFOXOH As Single, HALOG1 As Single, SI As Single
Dim AFEF As Single, AMGF As Single, AFEOH As Single, AMGOH As Single, RAMGFE As Single
Dim XMG As Single, XSID As Single, XAN As Single
Dim d As Double
Dim astring As String, bstring As String
Dim WTPC(1 To MAXBIOT%) As Single, ATOP(1 To MAXBIOT%) As Single, ANSFO(1 To MAXBIOT%) As Single
Dim PMOL(1 To MAXBIOT%) As Single, ANIO(1 To MAXBIOT%) As Single
Dim esym(1 To MAXBIOT%) As String
' Print calculation
Call IOWriteLog(vbCrLf & "Biotite Formula Calculations (from Brimhall and Ague, v. 1.3, HALOG.F code)...")
' Load oxide percents
For i% = 1 To sample(1).LastChan%
ip% = IPOS1%(MAXELM%, sample(1).Elsyms$(i%), Symlo$())
If ip% <> 0 Then
If ip% = 14 Then WTPC!(1) = percents!(i%) ' SiO2
If ip% = 22 Then WTPC!(2) = percents!(i%) ' TiO2
If ip% = 13 Then WTPC!(3) = percents!(i%) ' Al2O3
If ip% = 26 Then WTPC!(4) = percents!(i%) ' FeO
If ip% = 12 Then WTPC!(5) = percents!(i%) ' MgO
If ip% = 20 Then WTPC!(6) = percents!(i%) ' CaO
If ip% = 11 Then WTPC!(7) = percents!(i%) ' Na2O
If ip% = 56 Then WTPC!(8) = percents!(i%) ' BaO
If ip% = 19 Then WTPC!(9) = percents!(i%) ' K2O
If ip% = 9 Then WTPC!(10) = percents!(i%) ' F
If ip% = 17 Then WTPC!(11) = percents!(i%) ' Cl
If ip% = 25 Then WTPC!(12) = percents!(i%) ' MnO
End If
Next i%
IDEBUG = 0
IBIG = 0
WTPCT = 0#
WTT = 0#
For i% = 1 To MAXBIOT%
WTT = WTT + WTPC(i%)
Next i%
If DebugMode Then
Call IOWriteLog(vbCrLf & "Entered Biotite Analysis:")
For i% = 1 To MAXBIOT%
If i% = 1 Then astring$ = Format$("SiO2", a80$)
If i% = 2 Then astring$ = Format$("TiO2", a80$)
If i% = 3 Then astring$ = Format$("Al2O3", a80$)
If i% = 4 Then astring$ = Format$("FeO", a80$)
If i% = 5 Then astring$ = Format$("MgO", a80$)
If i% = 6 Then astring$ = Format$("MnO", a80$)
If i% = 7 Then astring$ = Format$("CaO", a80$)
If i% = 8 Then astring$ = Format$("Na2O", a80$)
If i% = 9 Then astring$ = Format$("BaO", a80$)
If i% = 10 Then astring$ = Format$("K2O", a80$)
If i% = 11 Then astring$ = Format$("F", a80$)
If i% = 12 Then astring$ = Format$("Cl", a80$)
bstring$ = Format$(Format$(WTPC!(i%), f83$), a80)
Call IOWriteLog(bstring$ & a4x$ & astring$)
Next i%
Call IOWriteLog(SSTRING2$)
astring$ = Format$("TOTAL", a80$)
bstring$ = Format$(Format$(WTT!, f83$), a80)
Call IOWriteLog(bstring$ & a4x$ & astring$)
Call IOWriteLog(SSTRING1$)
End If
' Updated using DHZ '92
For i% = 1 To MAXBIOT%
PMOL(1) = WTPC(1) / 60.08: esym$(1) = "Si"
PMOL(2) = WTPC(2) / 79.88: esym$(2) = "Ti"
PMOL(3) = WTPC(3) / 101.96: esym$(3) = "Al"
PMOL(4) = WTPC(4) / 71.85: esym$(4) = "Fe+2"
PMOL(5) = WTPC(5) / 40.3: esym$(5) = "Mg"
PMOL(6) = WTPC(6) / 56.08: esym$(6) = "Ca"
PMOL(7) = WTPC(7) / 61.98: esym$(7) = "Na"
PMOL(8) = WTPC(8) / 153.33: esym$(8) = "Ba"
PMOL(9) = WTPC(9) / 94.2: esym$(9) = "K"
PMOL(10) = WTPC(10) / 19#: esym$(10) = "F"
PMOL(11) = WTPC(11) / 35.45: esym$(11) = "Cl"
PMOL(12) = WTPC(12) / 70.94: esym$(12) = "Mn"
If i% <= 2 Then GoTo 102
If i% = 3 Then GoTo 103
If i% > 3 Then GoTo 104
' 2 OXYGENS
102: ATOP(i%) = PMOL(i%) * 2#
GoTo 105
' 3 OXYGENS
103: ATOP(i%) = PMOL(i%) * 3#
GoTo 105
' 1 OXYGENS
104: ATOP(i%) = PMOL(i%) * 1#
' Total wt percents
105: WTPCT = WTPCT + WTPC(i%)
Next i%
WTPCF = WTPC(10) * 0.4211
WTPCCL = WTPC(11) * 0.2256
WTPCT = WTPCT - 1# * WTPCF - 1# * WTPCCL
ATOPT = 0#
For i% = 1 To MAXBIOT%
ATOPT = ATOPT + ATOP(i%)
Next i%
ATOPT = ATOPT - 1# * ATOP(10) - 1# * ATOP(11)
' SPECIFY NUMBER OF OXYGENS, USE A TOTAL OF 22 NEGATIVE CHARGES
d# = 11# / ATOPT
For i% = 1 To MAXBIOT%
ANIO(i%) = d# * ATOP(i%)
Next i%
For i% = 1 To MAXBIOT%
If i% <= 2 Then ANSFO(i%) = ANIO(i%) / 2#
If i% = 3 Then ANSFO(i%) = ANIO(i%) * (2# / 3#)
If i% > 3 And i% <= 6 Then ANSFO(i%) = ANIO(i%)
If i% = 7 Or i% = 9 Then ANSFO(i%) = ANIO(i%) * 2#
If i% = 8 Then ANSFO(i%) = ANIO(i%)
If i% > 9 Then ANSFO(i%) = ANIO(i%)
Next i%
' Round values in the structural formula (array ANSFO) to four decimal places
For i% = 1 To MAXBIOT%
ANSFO!(i%) = MiscSetRounding2!(ANSFO!(i%), Int(4))
Next i%
' TETRAHEDRAL AL
TETAL = 4# - ANSFO(1)
' OCTAHEDRAL AL
OCTAL = ANSFO(3) - TETAL
If OCTAL < 0# Then TETAL = ANSFO(3)
If OCTAL < 0# Then OCTAL = 0#
XALVI = OCTAL / (ANSFO(5) + ANSFO(2) + OCTAL + ANSFO(4) + ANSFO(12))
' K20 + NA20 + BA0 + CA0
ALKM = ANSFO(9) + ANSFO(7) + ANSFO(8) + ANSFO(6)
' X MG (FULL OCTAHEDRAL)
MGMFT = ANSFO(5) / (ANSFO(5) + ANSFO(2) + OCTAL + ANSFO(4) + ANSFO(12))
' Mg / (Mg + FE)
MGB = ANSFO(5) / (ANSFO(5) + ANSFO(4))
' X FE++ (FULL OCTAHEDRAL ANNITE)
FEX = ANSFO(4) / (ANSFO(5) + ANSFO(2) + OCTAL + ANSFO(4) + ANSFO(12))
' X TI-BIOTITE (FULL OCTAHEDRAL)
tix = ANSFO(2) / (ANSFO(5) + ANSFO(2) + OCTAL + ANSFO(4) + ANSFO(12))
' X MN- BIOTITE (FULL OCTAHEDRAL)
MNX = ANSFO(12) / (ANSFO(5) + ANSFO(2) + OCTAL + ANSFO(4) + ANSFO(12))
' X F
HALMF = ANSFO(10) / 2#
' X CL
HALMC = ANSFO(11) / 2#
' COMPUTE X-OH
HALMO = 1# - HALMF - HALMC
If HALMF = 0# Then HALMF = 0.00001
If HALMC = 0# Then HALMC = 0.00001
If HALMO <= 0# Then HALMO = 0.00001
' COMPUTE LOG X-F/X-OH
If HALMF / HALMO > 0# Then XFOXOH = MiscConvertLog10#(CDbl(HALMF / HALMO))
If HALMF / HALMC > 0# Then HALOG1 = MiscConvertLog10#(CDbl(HALMF / HALMC))
sum1 = ANSFO(9) + ANSFO(7) + ANSFO(6) + ANSFO(8)
sum2 = ANSFO(2) + OCTAL + ANSFO(4) + ANSFO(5) + ANSFO(12)
sum3 = TETAL + ANSFO(1)
sum4 = ANSFO(10) + ANSFO(11)
' BIOTITE COMPONENT ACTIVITIES
SI = ANSFO(1)
AFEF = MiscConvertLog10#(CDbl(ANSFO(9) * ((ANSFO(4) / 3#) ^ 3) * TETAL * ((SI / 3#) ^ 3) * (HALMF ^ 2)))
AMGF = MiscConvertLog10#(CDbl(ANSFO(9) * ((ANSFO(5) / 3#) ^ 3) * TETAL * ((SI / 3#) ^ 3) * (HALMF ^ 2)))
AFEOH = MiscConvertLog10#(CDbl(ANSFO(9) * ((ANSFO(4) / 3#) ^ 3) * TETAL * ((SI / 3#) ^ 3) * (HALMO ^ 2)))
AMGOH = MiscConvertLog10#(CDbl(ANSFO(9) * ((ANSFO(5) / 3#) ^ 3) * TETAL * ((SI / 3#) ^ 3) * (HALMO ^ 2)))
XMG = (ANSFO(5) / 3#)
XSID = (((3# - ANSFO(1) / ANSFO(3)) / 1.75) * (1# - XMG))
XAN = 1# - (XMG + XSID)
PHLOG = XMG * 100#
SIDER = XSID * 100#
ANNIT = XAN * 100#
' COMPUTE Y-INTERCEPT
RAMGFE = MiscConvertLog10#(CDbl(MGMFT / FEX))
YM32X = XFOXOH - 1.5 * RAMGFE
Call IOWriteLog(SSTRING2$)
Call IOWriteLog("NUMBER OF ATOMS:")
Call IOWriteLog(a8x$ & "SI " & Format$(Format$(ANSFO!(1), f84$), a80$))
Call IOWriteLog(a8x$ & "ALIV " & Format$(Format$(TETAL!, f84$), a80$) & a8x$ & "ALVI" & Format$(Format$(OCTAL!, f84$), a80$))
Call IOWriteLog(a8x$ & "TI " & Format$(Format$(ANSFO!(2), f84$), a80$))
Call IOWriteLog(a8x$ & "FE " & Format$(Format$(ANSFO!(4), f84$), a80$))
Call IOWriteLog(a8x$ & "MG " & Format$(Format$(ANSFO!(5), f84$), a80$))
Call IOWriteLog(a8x$ & "MN " & Format$(Format$(ANSFO!(12), f84$), a80$))
Call IOWriteLog(a8x$ & "CA " & Format$(Format$(ANSFO!(6), f84$), a80$))
Call IOWriteLog(a8x$ & "NA " & Format$(Format$(ANSFO!(7), f84$), a80$))
Call IOWriteLog(a8x$ & "BA " & Format$(Format$(ANSFO!(8), f84$), a80$))
Call IOWriteLog(a8x$ & "K " & Format$(Format$(ANSFO!(9), f84$), a80$))
Call IOWriteLog(a8x$ & "F " & Format$(Format$(ANSFO!(10), f84$), a80$))
Call IOWriteLog(a8x$ & "CL " & Format$(Format$(ANSFO!(11), f84$), a80$))
Call IOWriteLog(a8x$ & "OH " & Format$(Format$(2# - (ANSFO(11) + ANSFO(10)), f84$), a80$) & " CALCULATED")
Call IOWriteLog(vbCrLf & "SUMMARY OF BIOTITE GEOCHEMISTRY:")
' PRINT OUT BRIMHALL CALCULATIONS
astring$ = vbCrLf
astring$ = astring$ & Format$("LOG(XF/XCL) = ", a18$) & Format$(Format$(HALOG1!, f84$), a10$)
astring$ = astring$ & Format$("LOG(X-F/X-OH) = ", a18$) & Format$(Format$(XFOXOH!, f84$), a10$)
astring$ = astring$ & Format$("LOG(X-MG/X-FE) = ", a18$) & Format$(Format$(RAMGFE!, f84$), a10$)
Call IOWriteLog(astring$)
astring$ = vbNullString
astring$ = astring$ & Format$("X-MG = ", a18$) & Format$(Format$(MGMFT!, f84$), a10$)
astring$ = astring$ & Format$("X-FE = ", a18$) & Format$(Format$(FEX!, f84$), a10$)
astring$ = astring$ & Format$("X-TI = ", a18$) & Format$(Format$(tix!, f84$), a10$)
Call IOWriteLog(astring$)
astring$ = vbNullString
astring$ = astring$ & Format$("X-MN = ", a18$) & Format$(Format$(MNX!, f84$), a10$)
astring$ = astring$ & Format$("X-AL VI = ", a18$) & Format$(Format$(XALVI!, f84$), a10$)
astring$ = astring$ & Format$("MG/(MG+FE) = ", a18$) & Format$(Format$(MGB!, f84$), a10$)
Call IOWriteLog(astring$)
astring$ = vbCrLf
astring$ = astring$ & Format$("X-OH = ", a18$) & Format$(Format$(HALMO!, f84$), a10$)
astring$ = astring$ & Format$("X-F = ", a18$) & Format$(Format$(HALMF!, f84$), a10$)
astring$ = astring$ & Format$("X-CL = ", a18$) & Format$(Format$(HALMC!, f84$), a10$)
astring$ = astring$ & Format$("LOG (X-F/X-OH) = ", a18$) & Format$(Format$(XFOXOH!, f84$), a10$)
Call IOWriteLog(astring$)
astring$ = vbCrLf
astring$ = astring$ & Format$("TRIANGULAR PLOT LOG X-F/X-OH -1.5 * LOG X-MG/X-FE = ") & Format$(Format$(YM32X!, f84$), a10$)
Call IOWriteLog(astring$)
astring$ = vbCrLf
astring$ = astring$ & Format$("X-SID: = ", a18$) & Format$(Format$(SIDER!, f84$), a10$)
astring$ = astring$ & Format$("X-ANN: = ", a18$) & Format$(Format$(ANNIT!, f84$), a10$)
astring$ = astring$ & Format$("X-PHLOG: = ", a18$) & Format$(Format$(PHLOG!, f84$), a10$)
Call IOWriteLog(astring$)
astring$ = vbCrLf
astring$ = astring$ & Format$("(K+Na+Ca+Ba)", a22$) & Format$("(Ti+Al(VI)+Fe+Mg+Mn)", a22$) & Format$("(Al(IV)+Si)", a22$) & Format$("(F+CL)", a22$) & vbCrLf
astring$ = astring$ & Format$(Format$(sum1!, f84$), a22$) & Format$(Format$(sum2!, f84$), a22$) & Format$(Format$(sum3!, f84$), a22$) & Format$(Format$(sum4!, f84$), a22$)
Call IOWriteLog(astring$)
' WRITE OUTPUT FILE FOR HALOG.OUT (COMPOSITONAL FRAMES)
astring$ = "Sample " & vbTab & VbDquote$ & sample(1).number% & VbDquote$ & vbTab & VbDquote$ & sample(1).Name$ & VbDquote$
Print #tfilenumber%, astring$
astring$ = vbNullString
For i% = 1 To MAXBIOT%
If i% = 3 Then
astring$ = astring$ + MiscAutoFormat$(WTPC!(i%)) & vbTab$ & MiscAutoFormat$(ANSFO!(i%)) & vbTab$ & MiscAutoFormat$(TETAL!) & vbTab$ & MiscAutoFormat$(OCTAL!) & vbTab & esym$(i%) & vbCrLf
ElseIf i% = 11 Then
astring$ = astring$ + MiscAutoFormat$(WTPC!(i%)) & vbTab$ & MiscAutoFormat$(ANSFO!(i%)) & vbTab$ & MiscAutoFormat$(2# - (ANSFO!(10) + ANSFO!(11))) & vbTab$ & esym$(i%) & vbCrLf
Else
astring$ = astring$ + MiscAutoFormat$(WTPC!(i%)) & vbTab$ & MiscAutoFormat$(ANSFO!(i%)) & vbTab$ & esym$(i%) & vbCrLf
End If
Next i%
Print #tfilenumber%, astring$
astring$ = vbNullString
astring$ = astring$ & MiscAutoFormat$(WTT!) & vbTab$ & MiscAutoFormat$(HALOG1!) & vbTab$ & MiscAutoFormat$(RAMGFE!) & vbTab$ & MiscAutoFormat$(MGMFT!) & vbTab$ & MiscAutoFormat$(FEX!) & vbTab$ & MiscAutoFormat$(tix!) & vbTab$ & MiscAutoFormat$(XALVI!) & vbTab$ & MiscAutoFormat$(MNX!) & vbTab$ & MiscAutoFormat$(XFOXOH!) & vbTab$
astring$ = astring$ & MiscAutoFormat$(SIDER!) & vbTab$ & MiscAutoFormat$(ANNIT!) & vbTab$ & MiscAutoFormat$(PHLOG!) & vbTab$ & MiscAutoFormat$(sum1!) & vbTab$ & MiscAutoFormat$(sum2!)
Print #tfilenumber%, astring$
Exit Sub
' Errors
ConvertHalogError:
MsgBox Error$, vbOKOnly + vbCritical, "ConvertHalog"
Close #tfilenumber%
ierror = True
Exit Sub
End Sub