Attribute VB_Name = "Module2"
Option Explicit

' This module contains physics and relative stellar magnitude related functions
' in a segregated module for updating purposes.  It is dependent on the
' helper functions contained in Module 1.
' K. Fisher 5/2006 fisherka@csolutions.net

Public Function phyAbsMag2logLumSolRatio(ByVal MagAbs1_tmp As Double) As Double
' Receives absolute magnitude of a star and returns its ratio to the luminosity of the Sun
'   Mv1-Mv_sol = -2.5 log (L1/L_sol)
'   (Mv1-Mv_sol)/-2.5 = log (L1/L_sol)
'   log(L1/L_sol) = (Mv1-Mv_sol)/-2.5
'   M_sol = 4.83 Per Garrison (2006), absolute mag-not bolometric
'   Mv2 = -0.4 alf And a B8 star s/b approx. 10000 times more luminous than a
'   log(x) =  (-0.4-4.83)/-2.5
'   log(x) = 2.09

' Source: http://www.physics.auburn.edu/~au_astro/HR.pdf
'          Is a variant on Cox(2000) at p. 382

' Testing
'    Using calibrated Mv's, is consistent with Powell's website data
'       for Class V and Giant Class III, but less so for supergiant class I
'       http://www.anzwers.org/free/universe/startype.html

' Working variables
Dim MagAbs1, M_sol, A As Double

' Luminosity and magnitude of Sol are physical parameter constants
M_sol = 4.83

' Get input
MagAbs1 = MagAbs1_tmp

' Compute result
A = (MagAbs1 - M_sol) / -2.5

' Return result - a log of the luminosity ratio
phyAbsMag2logLumSolRatio = A

End Function


Public Function phyM_bol2Teff(ByVal M_bol_tmp As Double, ByVal StarSolRadiusRatio_tmp As Double) As Double
' From a postulated main sequence zero-age star
' with a known bolometric magnitude and a known star to sol radius
' return the effective temperature of the star

' Source:  Cox(2000).  Allen's Astrophysical Quantities (4th ed) at p. 382-383

' Limits: Not stated

' Testing:
'   The Sun, a G4, star has a Teff of 5777 K
'   A G0 star with a calbrated Mv_bol of 4.2 and a calibrated radius of 1.10,
'   has a modeled Teff of:
' ? phyM_bol2Teff(4.2, 1.1)
' 5866.038514604

' Working variables
Dim M_bol, StarSolRadiusRatio, A, B As Double

' Get input
M_bol = M_bol_tmp
StarSolRadiusRatio = StarSolRadiusRatio_tmp

' Find log(StarSolRadiusRatio)
B = Log(StarSolRadiusRatio)

' Compute the log of the eff Temp
A = (M_bol + 5 * B - 42.36) / -10#
'  and convert the log to the eff Temp
A = 10 ^ A

' Return radius ratio
phyM_bol2Teff = A

End Function

Public Function phyWeinsLaw(ByVal Teff_kel_tmp As Double) As Double
'  Receives a star's temperature (kelvins) and returns in nm, the wavelength of its
'  peak emission

' Source: Inglis 2003. Observer's Guide to Stellar Evolution at 27

' Working variables
Dim Teff As Double

' Get input
Teff = Teff_kel_tmp

' Return result

phyWeinsLaw = 2900000# / Teff

End Function

Public Function phyRadiusTemp2Lum(ByVal RadiusStar2RadiusSol_tmp As Double, ByVal TempStar2TempSol_tmp As Double) As Double
' From a known radius and temperature ratio, what is the luminosity?
' L/Lsol = (R/Rsol)^2 * (Tsol/T)^4

' Source: A variant on:
'  Inglis (2003). Observer's Guide to Stellar Evolution. p. 34.

' Test data
'    Per Inglis at p. 35. Betelguese, an M2 star, has a temperature of 3500K and a radius of 670 Sols.
'      The calibrated radius is 800 R_sol.
'      Sol has a temp of ~ 5800K.  Inglis's answer is luminosity ratio should equal 60000.
'  ? phyRadiusTemp2Lum(672.659877,5800/3500)
'  59999.9999785544

' Initialize variables
Dim RadiusStar2RadiusSol, TempStar2TempSol As Double

' Working variables
RadiusStar2RadiusSol = RadiusStar2RadiusSol_tmp
TempStar2TempSol = TempStar2TempSol_tmp

' Return result
phyRadiusTemp2Lum = (RadiusStar2RadiusSol ^ 2) * ((1# / TempStar2TempSol_tmp) ^ 4)

End Function


Public Function phyLumTemp2Radius(ByVal LuminStar2LuminSol_tmp As Double, ByVal TempStar2TempSol_tmp As Double) As Double
' From a known star luminosity and temperature ratio, what is the luminosity
' (R/Rsol) = SGR((L/Lsol)) * (T/Tsol)^2

' Source: Inglis (2003). Observer's Guide to Stellar Evolution. p. 34.

' Test data
'    Per Inglis at p. 35. Betelguese, an M2 star, has a temperature of 3500K and a luminosity ratio of 60,0000.
'      Sol has a temp of ~ 5800K.  Inglis's answer is the star/solar ratio is 670.  The calibrated M2 value ratio is 800.
' ? phyLumTemp2Radius(60000, 5800 / 3500)
' 672.659877120213

' Initialize variables
Dim LuminStar2LuminSol, TempStar2TempSol As Double

' Working variables
LuminStar2LuminSol = LuminStar2LuminSol_tmp
TempStar2TempSol = TempStar2TempSol_tmp

' Return result
phyLumTemp2Radius = Sqr(LuminStar2LuminSol) * (TempStar2TempSol ^ 2)

End Function

Public Function phyMainSeqLifeTime(ByVal MassStar2MassSolRatio_tmp As Double) As String
' From a postulated main sequence zero-age star to Sol mass ratio
' return the ratio of the star's radius to Sol's radius

' Source: Inglis 2003. Observer's Guide to Stellar Evolution at 27

' Limits: Zero-age-main-sequence stars only

' Working variables
Dim MassStar2MassSolRatio, Sol_lifetimes, Lifetime_Byrs As Double

' Get input
MassStar2MassSolRatio = MassStar2MassSolRatio_tmp

' Evaluate lifetime
Sol_lifetimes = 1# / (MassStar2MassSolRatio ^ 2.5)
Lifetime_Byrs = ((10# ^ 10) * Sol_lifetimes) / (10# ^ 9)

' Return result

phyMainSeqLifeTime = CStr(Sol_lifetimes) & " " & CStr(Lifetime_Byrs)

End Function


Public Function phyBrightnessDelta2Mag(ByVal Mag1_tmp As Double, ByVal BrightnessStar1_tmp As Double, ByVal BrightnessStar2_tmp As Double) As String
'  For a relative change in brightness, what is the change in magnitude?
'  Inglis:  m1 - m2= 2.5 log10(b1/b2)
'  m2 = m1 + 2.5 log10(b1/b2)

' Source: Inglis 2003. Observer's Guide to Stellar Evolution at 15
'         Cox 2000. Allen's Astrophysical Quantities at p. 381

' Input:  Mag1 can be absolute magnitude for two stars at two distances,
'           (returns absolute mag change and abs mag of star2), or
'         Mag1 can be an apparent magnitude of a single variable star
'           (returns change in apparent magnitude of single star).
'         Apparent Brightness is an relative brightness measurement in identical units,
'            typically ADU counts in a CCD image
'         Apparent Brightness is a relative measure of Luminosity, which is the
'            absolute energy emitted by a unit surface area of the star

' Test data
'  Per Inglis at 15:  A variable star changes decreases in brightness by a factor of 4.
'    What is the magnitude change? Answer: 1.5
' ? phyBrightnessDelta2Mag(2, 1, 0.25)
' 1.50514997831991 3.50514997831991


' Working variables
Dim Mag1, BStar1, BStar2, deltaMag, Mag2 As Double

' Get input
Mag1 = Mag1_tmp
BStar1 = BrightnessStar1_tmp
BStar2 = BrightnessStar2_tmp

' Compute result
deltaMag = (2.5 * Log10(BStar1 / BStar2))
Mag2 = Mag1 + deltaMag

' Return result
phyBrightnessDelta2Mag = CStr(deltaMag) & " " & CStr(Mag2)
End Function

Public Function phyMagDelta2Brightness(ByVal Mag1_tmp As Double, ByVal Mag2_tmp As Double) As Double
'  For a relative change in magnitudes, what is the change in brightness?
'  Cox: m1 - m2 = -2.5 log10(b1/b2)
'  deltaMag / -2.5 = log10(b1/b2)
'  10^ (deltaMag/-2.5) = b1/b2

' Source: Inglis 2003. Observer's Guide to Stellar Evolution at 15
'         Cox 2000. Allen's Astrophysical Quantities at p. 381

' Input:  Mag1 and Mag2 can be absolute magnitude for two stars at two distances,
'         Mag1 and Mag2 can be an apparent magnitude of a single variable star

' Test data
'  Per Inglis at 15:  A 4.0 variable star changes decreases in magnitude by 1.5 to mag 5.5.
'    What is the brightness change? Answer: (a factor of 4) or 0.25 for a descrease
' ? phyMagDelta2Brightness(4,5.5)
'  0.251188643150958

' Working variables
Dim Mag1, Mag2, deltaMag As Double

' Get input
Mag1 = Mag1_tmp
Mag2 = Mag2_tmp

' Compute result
deltaMag = Mag2 - Mag1

' Return result
phyMagDelta2Brightness = 10 ^ (deltaMag / -2.5)

End Function


Public Function phyAppMagDist2AbsMag(ByVal MagApp1_tmp As Double, ByVal Distparsecs_tmp As Double, ByVal Extinction_mags_tmp As Double) As Double
'  Find the absolute magnitude of a star where its apparent magnitude and distance are known.
'  Mv = V + 5 + 5*log(parallax) - A
'  Mv = V + 5 - 5 * Log(Parsecs) - A

' Source: Cox2000 at 382.  Inglis. Observer's Guide to Stellar Evolution. At 16.

' Test data
'   Inglis at 16.  A star of apparent mag 16 at a distance of 1000kpc has an
'   absolute mag of 6.0.
' ? phyAppMagDist2AbsMag(16,1000,0)
' 6

'  Working variables
Dim MagApp1, Distparsecs, Extinction_mags As Double

' Get input
MagApp1 = MagApp1_tmp
Distparsecs = Distparsecs_tmp
Extinction_mags = Extinction_mags_tmp

' Return result
phyAppMagDist2AbsMag = MagApp1 + 5 - (5 * Log10(Distparsecs)) - Extinction_mags

End Function

Public Function phyAbsMagDist2AppMag(ByVal MagAbs1_tmp As Double, ByVal Distparsecs_tmp As Double, ByVal Extinction_mags_tmp As Double) As Double
'  Find the absolute magnitude of a star where its apparent magnitude and distance are known.
'  Mv = V + 5 + 5*log(parallax) - A
'  Mv = V + 5 - 5 * Log(Parsecs) - A
'  V = Mv - 5 + 5 * Log(parsecs) + A

' Source: Cox2000 at 382.  Inglis. Observer's Guide to Stellar Evolution. At 16.

' Test data
'   Inglis at 16.  A star of apparent mag 16 at a distance of 1000kpc has an
'   absolute mag of 6.0.
' ? phyAbsMagDist2AppMag(6,1000,0)
' 16
'  alf And has an Mv of -0.4, a distance of 30.1 parsecs and an extinction of 0.21 mags. The
'   catalogue V for alf And is 2.2
'

'  Working variables
Dim MagAbs1, Distparsecs, Extinction_mags As Double

' Get input
MagAbs1 = MagAbs1_tmp
Distparsecs = Distparsecs_tmp
Extinction_mags = Extinction_mags_tmp

' Return result
'  V = Mv - 5 + 5 * Log(parsecs) + A
phyAbsMagDist2AppMag = MagAbs1 - 5 + (5 * Log10(Distparsecs)) + Extinction_mags

End Function

Public Function phyMagDeltaBright2Brightness2(ByVal Mag1_tmp As Double, ByVal Mag2_tmp As Double, ByVal BrightnessStar1_tmp As Double) As Double
'  For a relative change in magnitudes and a known brightness for one of the stars, what is the relative brightness of the second star?
'  Cox: m1 - m2 = -2.5 log10(b1/b2)
'  deltaMag / -2.5 = log10(b1/b2)
'  10^ (deltaMag/-2.5) = b1/b2
'  b2 = b1 / ( 10^ (deltaMag/-2.5) )

' Source: Inglis 2003. Observer's Guide to Stellar Evolution at 15
'         Cox 2000. Allen's Astrophysical Quantities at p. 381

' Input:  Mag1 and Mag2 can be absolute magnitude for two stars at two distances,
'         Mag1 and Mag2 can be an apparent magnitude of a single variable star

' Test data
'  Per Inglis at 15:  A 4.0 variable star decreases in magnitude by 1.5 to mag 5.5.
'    The brightness of the star is 1.0.
'    What is the brightness change? Answer: (a factor of 4) or 0.25 for a decrease
' ? phyMagDeltaBright2Brightness2(4, 5.5, 1)
'  0.251188643150958

' Working variables
Dim Mag1, Mag2, deltaMag, BrightnessStar1 As Double

' Get input
Mag1 = Mag1_tmp
Mag2 = Mag2_tmp
BrightnessStar1 = BrightnessStar1_tmp

' Compute result
deltaMag = Mag1 - Mag2

' Return result
phyMagDeltaBright2Brightness2 = BrightnessStar1 / (10 ^ (deltaMag / -2.5))

End Function


Public Function phyLumLum_Sol2M_bol(ByVal LumLum_sol_tmp As Double) As Double
' Receives luminosity ratio of star to Sol and
' returns an estimate of the star's absolute bolometric magnitude
'  M_bol = 2.5 log(L1/L_sol) + 4.74  where M_bol Sol = 4.74

'  Cox(2000) at p. 382

' Working variables
Dim LumLum_sol As Double

' Get input
LumLum_sol = LumLum_sol_tmp

' Return result - bolometric Magnitude
phyLumLum_Sol2M_bol = (-2.5 * Log10(LumLum_sol)) + 4.74

End Function

Public Function phylogLumLum_Sol2SolMassRatio(ByVal logLumLum_sol_tmp As Double) As Double
'  WARNING: Cox algorithm does not correlate with calibrated mass, luminosity relationships
'  for MK spectral types. Compare Cox (2000) at p. 382, to Cox (2000) at Section 15.3.1 Calibration of MK Spectral Types

' Receives luminosity ratio of star to Sol and
' returns an estimate of the ratio of the star's mass to the Sun's mass
' log L/L_sol = 3.8 log (Mass/Mass_sol) + 0.08
' log(Mass/Mass_sol) = ( ( log L/L_sol - 0.08 ) / 3.8 )

' Limits:  Mass/Mass_sol > 0.2 Mass_sol

'  Cox(2000) at p. 382

' Working variables
Dim LumLum_sol, logLumLum_sol, A As Double

' Get input
logLumLum_sol = logLumLum_sol_tmp

A = (logLumLum_sol - 0.08) / 3.8

' Return result - convert log to base 10 for true mass
phylogLumLum_Sol2SolMassRatio = 10 ^ A

End Function

Public Function phyExtractSpectralType(ByVal MKSpectralType_tmp As String) As String
' Receives a non-atomic spectral type string and parses
' the MK Spectral Class Type, The MK Spectral SubType and MK Luminosity Class

' Working variables
Dim MKSpectralType As String
Dim MKSpecType, MKSpecSubType, MKLuminosityClass As String
Dim bolEvaluated As Boolean
Dim bolEvaluatedStore As Boolean
Dim strMatchTest As String
Dim lngMatchPosition As Long
Dim lngMatchPositionStore As Long

' Get input
MKSpectralType = MKSpectralType_tmp

' Extract MKSpectralType

'   Set initial condition
bolEvaluated = False
lngMatchPosition = 0

' Evaluation order prevents runtime errors

' Special exclusion
' Case "QSO"  Wolf Rayet
strMatchTest = "S..."
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = ""
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Normal cases
' Case "WR"  Wolf Rayet
strMatchTest = "WR"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "WC"  Wolf Rayet
strMatchTest = "WC"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "WN"  Wolf Rayet
strMatchTest = "WN"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DA"  White Dwarf - Hydrogren Balmer Lines Dominant
strMatchTest = "DA"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DB"  White Dwarf - Neutral Helium lines dominant
strMatchTest = "DB"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DO"  White Dwarf - Ionized Helium lines dominant
strMatchTest = "DO"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DZ"  White Dwarf - Metal lines dominant
strMatchTest = "DZ"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DQ"  White Dwarf - Carbon features present
strMatchTest = "DQ"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DX"  White Dwarf - Unidentified features, presumeably due to a strong magnetic field
strMatchTest = "DX"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "DC"  White Dwarf - Featureless, continuous spectrum
strMatchTest = "DC"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Error trap - any other "D" Dwarf class star not already captured,
'   is assigned to "D?" - Dwarf unknown
' Case "D"
strMatchTest = "D"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
' Program note: Special Assignment
    MKSpecType = "D?"
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "0"
strMatchTest = "O"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "B"
strMatchTest = "B"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "A"
strMatchTest = "A"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "F"
strMatchTest = "F"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "G"
strMatchTest = "G"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "K"
strMatchTest = "K"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "M"
strMatchTest = "M"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "C"
strMatchTest = "C"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "N"
strMatchTest = "N"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "R"
strMatchTest = "R"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "S"
strMatchTest = "S"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case "?" - Catalogue is marked "unknown"
strMatchTest = "?"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKSpecType = strMatchTest
    bolEvaluated = True
    lngMatchPositionStore = lngMatchPosition
End If

' Case No match found
If bolEvaluated = False Then
    MKSpecType = ""
    lngMatchPositionStore = 0
End If

bolEvaluatedStore = bolEvaluated

' Extract the MK Spectral Subtype Number
If bolEvaluatedStore Then
   MKSpecSubType = Mid(MKSpectralType, lngMatchPositionStore + 1, 1)
Else
   MKSpecSubType = ""
End If

' Check error condition - Omitted MK Spectral Subtype Number must be a number
 If IsNumeric(MKSpecSubType) Then
   MKSpecSubType = MKSpecSubType
 Else
'  Error condition
    MKSpecSubType = ""
 End If

' Extract the MK Luminosity Class
' Re-initialize variables
lngMatchPosition = 0
bolEvaluated = False

' Evaluation order prevents runtime errors

' Case "VI"  SubDwarfs
strMatchTest = "VI"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If


' Case "IV" Subgiants
strMatchTest = "IV"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case "V" Dwarfs Main Sequence
strMatchTest = "V"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case "III" Giants
strMatchTest = "III"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case "II" Bright Giants
strMatchTest = "II"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case "Ia"  More luminous supergiants
strMatchTest = "Ia"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case "Ib"  Less luminous supergiants
strMatchTest = "Ib"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case "I" Supergiants
strMatchTest = "I"
lngMatchPosition = 0
lngMatchPosition = InStr(1, MKSpectralType, strMatchTest)
If lngMatchPosition > 0 And (bolEvaluated = False) Then
    MKLuminosityClass = strMatchTest
    bolEvaluated = True
End If

' Case No match found
If bolEvaluated = False Then
    MKLuminosityClass = ""
    lngMatchPositionStore = 0
End If

' Return result
phyExtractSpectralType = Trim(MKSpecType & " " & MKSpecSubType & " " & MKLuminosityClass)

End Function


Public Function phyIntegratedMag2Stars(ByVal Mag1_tmp As Double, ByVal Mag2_tmp As Double) As Double
'  Receives magnitudes of two close stars and returns their combined magnitude

' Source: Sidqwick at 34

' Test and usage
'  Sidgwick: What is the integrated magnitude of a close double whose
'  individual magnitudes at 2.7 and 3.0? Ans: ~ 2.1
' ? phyIntegratedMag2Stars(2.7,3.0)
' 2.08710252520251

' Define variables
Dim Mag1, Mag2 As Double
Dim A, B, C, D, E As Double ' Working variables
                                  
' Get input
Mag1 = Mag1_tmp
Mag2 = Mag2_tmp

' Find the integrated magnitude
A = 2.512 ^ (Mag2 - Mag1)
A = 1# + (1# / A)
A = Log10(A)
A = A / 0.4

' Return result
phyIntegratedMag2Stars = Mag1 - A

End Function

Public Function phyAitkenDoubleStarCriteria(ByVal Mag1_tmp As Double, ByVal Mag2_tmp As Double) As Double
'  Receives magnitudes of two close stars and returns the maximum separation at which they might be
'  considered a double star

' Source: Sinachopoulos, D.; Mouzourakis, P. 1991. Statistically physical pairs in Aitken's Double Star Catalogue. 1991AGAb....6...84S
'   Romero, F.R. 2006. Aitken's Double Star Criteria. Journal of Double Stars Observations. 2(1):36-41
'   www.jdso.org

' Uses phyIntegratedMag2Stars

' Test and usage
' Romero 2006 computation for GRB 34 AB at mag 8.07, 11.04 is Rho(max)=15.8"
' ? phyAitkenDoubleStarCriteria(8.07,11.04)
' 15.8359886943105

' Define variables
Dim Mag1, Mag2 As Double
Dim A, B, C, D, E As Double ' Working variables
                                  
' Get input
Mag1 = Mag1_tmp
Mag2 = Mag2_tmp

' Find the integrated magnitude
B = phyIntegratedMag2Stars(Mag1, Mag2)

' Find Aitken's criteria
C = 2.8 - (0.2 * B)
D = 10 ^ C

' Return result
phyAitkenDoubleStarCriteria = D

End Function