MTP Module Documentation
MJ Mahoney
Last Revision: June 9, 2008
In Visual Basic modules serve the function of program libraries in
other programming languages. They contain procedures (functions and
subroutines) that are used by a main program, and can also be used to
define data structures and program constants. If a procedure needs to
be updated, this can be done in one location and all programs using the
procedure will "see" the change.
Function ThermistorDC!
Function ThermistorDC!(ch%, iv%)
Dim a0!, a1!, a2!, a3!, RR!, LOGrr!, V!, xden!, Rlo!, Rhi!, c#(0 To 3), X#
' ch% is A/D channel number defined below
' iv% is decimal value of MUX channel (ie Hex value has already been converted
' using the function: fHexToDec(HexNumber)
' Channel Numbers are:
' 1 tND, 2 tLO1, 3 tLO2, 4 tIFA, 5 tTGTl, 6 tTGTh, 7 ACCp
' 8 tWIN, 9 tMTR, 10 asterick, 11 ref, 12 tDC1, 13 tDC2
' 14 tPS5, 15 tPS12, 16 ACCm
If iv = 0 Then V = 1# Else V = iv / 16# '981008 mjm Make real to avoid loosing 4 bits of precision
Select Case ch%
Case 1, 2, 3, 4, 9, 10, 11, 12, 13 'Tnd, Tlo1,Tlo2 Tifa, Motor,spare,Vref, DC1, DC2
' following algorithm comes from RFD's eval'n of thermister tables 91.08.13 'f44032 (new data system)
a1 = 0.0009336018: a2 = 0.0002213609: a3 = 0.000000126198
RR = (1 / ((256 - V) / 256)) - 1
If RR > 0 Then xden = (a1 + a2 * Log(34800 * RR) + a3 * Log(34800 * RR) ^ 3)
ThermistorDC = 1 / xden - cTo
' Target thermistor was re-calibrated at JPL on 20000420 because there was
' a 0.9 K difference between them in the SOLVE data, with Thi>Tlo.
' Calibration removed this difference, with the Thi=Tlo 0.5 K < previous Tlo
'
Case 5 'Ttgt Lo
Select Case yyyymmdd$
Case Is < "20041201"
a0 = -241.0423: a1 = 0.4614729: a2 = 0.00004114943
'v = 5 * (v / 255) ' start target low calc, commented out 20000420
Rlo = 0.0404 * 16 * V + 287.49 'mjm 20000420, was ((v + 8.6308) / 28.727) / 0.0010464
ThermistorDC = a0 + a1 * Rlo + a2 * Rlo ^ 2 ' tgt_lo is set
Case Else
'Based on JPL measurements and fit 20041206
'c(0) = -103.8402
'c(1) = 0.037535
'c(2) = 0.0000003007
'c(3) = -0.000000000009157
'Based on Post mission measurements
c(0) = -103.1573
c(1) = 0.037426
c(2) = 0.0000002983
c(3) = -0.00000000000907
ThermistorDC = c(0) + c(1) * iv + c(2) * iv ^ 2 + c(3) * iv ^ 3
End Select
Case 6 'TtgtHi
Select Case yyyymmdd$
Case Is < "20041201"
a0 = -241.0423: a1 = 0.4614729: a2 = 0.00004114943
'v = 5 * (v / 255) ' start tgt hi calc, commented out 20000420
Rhi = 0.0406 * 16 * V + 418.65 'mjm 20000420, was ((v + 12.66724) / 28.727) / 0.0010464
ThermistorDC = a0 + a1 * Rhi + a2 * Rhi ^ 2 ' tgt_hi is set
Case Else
' Based on JPL measurements Post PAVE
c(0) = -105.3481
c(1) = 0.038164
c(2) = 0.0000003124
c(3) = -0.000000000009644
ThermistorDC = c(0) + c(1) * iv + c(2) * iv ^ 2 + c(3) * iv ^ 3
End Select
Case 8 'Twin
Select Case yyyymmdd$
Case Is < "20041201"
' ER2: Thermistor = -132.81 + 0.689408 * v ' based on NZ lab cal 941012
' DC8 QB pgm: n = MUX(8) / 16: v = -122.9 + .61803 * n '
V = -122.9 + 0.61803 * V
If V < -80 Or V > 45 Then V = 99
ThermistorDC = V
Case Else
' Based on JPL measurements and fit 20041206
' c(0) = -103.314
' c(1) = 0.037633
' c(2) = 0.0000003018
' c(3) = -0.000000000009223
'Post mission calibration
c(0) = -103.5184
c(1) = 0.038224
c(2) = 0.0000003115
c(3) = -0.000000000009666
ThermistorDC = c(0) + c(1) * iv + c(2) * iv ^ 2 + c(3) * iv ^ 3
End Select
Case 14
ThermistorDC = iv * 2 / 1000 'answer should be 5.00 (volts)
Case 15
ThermistorDC = iv * 0.0079114 'answer should be 15.00 (volts)
Case 7 'ACC+
' DC8 QB Code for converting accelerometer measurements to gees.
' i = 16: j = 7: tBase = Ttgt
' acc1 = Mux(i): acc2 = Mux(j)
' dACC = acc2 - acc1: dACC = Int(dACC / 5.2) 'dACC is in units of 0.01 g
ThermistorDC = (iv - 2048#) / 1024# + 1 'Gees 20041130 mjm/rfd
' Accelerometer has 2048 as 1g and goes +/- 2 gs wrt to this.
Case 16
Select Case yyyymmdd$
Case Is < "20041201" 'ACC+
ThermistorDC = (iv - 2048#) / 1024# + 1 'Gees 20041130 mjm/rfd
Case Else 'Tplate
a1 = 0.0009336018: a2 = 0.0002213609: a3 = 0.000000126198
RR = (1 / ((256 - V) / 256)) - 1
If RR > 0 Then xden = (a1 + a2 * Log(34800 * RR) + a3 * Log(34800 * RR) ^ 3)
ThermistorDC = 1 / xden - cTo
End Select
Case 17 'ACC-
ThermistorDC = (iv - 2048#) / 1024# + 1 'Gees 20041130 mjm/rfd
Case Else
ThermistorDC = 0
End Select
End Function
Function Thermistor!
Function Thermistor!(ch%, iv%)
Dim x1!, x2!, x3!, RR!, LOGrr!, V!, xden!
' Gunn Diode receiver thermistor calibration
V = iv / 16# '981008 mjm Make real to avoid loosing 4 bits of precision
If V = 0 Then V = 1
' Old%=1: XT(1) = 12100 * rr: XT(2) = 34800 * rr ' Old data unit calibration prior to 931015
Select Case ch%
Case 1, 2, 3, 4, 9 ' ND, LO1, LO2, IFA, MTR
' following algorithm comes from RFD's eval'n of thermister tables 91.08.13+-
x1 = 0.001028792 ' 44031 thermistors (sensor unit)
x2 = 0.0002391957
x3 = 0.000000156301
RR = (1 / (1 - V / 256)) - 1 ' Resistance Ratio (rr) for thermistors only
LOGrr = Log(RR * 34800)
xden = (x1 + x2 * LOGrr + x3 * LOGrr ^ 3)
Thermistor = 1 / xden - 273.16
Case 5 ' target low (Platinum)
'Tlo = -108.54 + .306483 * v ' based on re-calibration of 90.10.12
'Tlo = -108.22 + 0.296 * v ' based on re-calibration of 94.01.31
Thermistor = -107.35 + 0.31264 * V ' based on NZ lab cal 941012
Case 6 ' target hi (Platinum)
' Thi = -40.26 + .308206 * v ' based on re-calibration of 90.10.12
' thi = -42.45 + .30835 * v ' based on re-calibration of 94.01.31
Thermistor = -40.5 + 0.31459 * V ' based on NZ lab cal 941012
Case 8 ' Window (Platinum)
' tWIN = -122.9 + .61803# * v ' used < 94.01.31
' tWIN = -122.9 + .61803# * v ' used > 94.01.31
Thermistor = -132.81 + 0.689408 * V ' based on NZ lab cal 941012
Case 12, 13 ' Data unit rovers 'PWR Supplies '931015, per RFD (MTP Lite)
' following algorithm comes from RFD's eval'n of thermister tables 91.08.13+-
x1 = 0.0009336018 ' 44032 (new data system)
x2 = 0.0002213609
x3 = 0.000000126198
RR = (1 / (1 - V / 256)) - 1 ' Resistance Ratio (rr) for thermistors only
LOGrr = Log(RR * 34800)
xden = (x1 + x2 * LOGrr + x3 * LOGrr ^ 3)
Thermistor = 1 / xden - 273.16
Case 14 ' 5 volt PS
Thermistor = 5 * V / 128
Case 15 ' 12 volt PS
Thermistor = 12 * V / 128
Case Else
Thermistor = 0
End Select
End Function
Function ThermistorER_1!
Function ThermistorER_1!(ch%, iv%)
'This routine was ThermistorERX, renamed 20020609 to reflect SU1 and SU2
' The three coefficients needed for platinum thermistors can be calculated using the
' function fTptC, and using Excel to do a linear fit for R vs counts from data taken in
' the lab by substituting precision thermistors for the target and window themistors
' noting the hexidecimal counts in the D-line for Mux data.
Dim x1!, x2!, x3!, RR!, LOGrr!, V!, xden!
V = iv / 16# '981008 mjm Make real to avoid loosing 4 bits of precision
If V = 0 Then V = 1
' Old%=1: XT(1) = 12100 * rr: XT(2) = 34800 * rr ' Old data unit calibration prior to 931015
Select Case ch%
Case 1, 2, 3, 4, 9, 12, 13 ' ND, AMP, PLO, IFA, MTR, DU1, DU2
' following algorithm comes from RFD's eval'n of thermister tables 91.08.13+-
x1 = 0.0009336018 ' 44032 (new data system)
x2 = 0.0002213609
x3 = 0.000000126198
RR = (1 / (1 - V / 256)) - 1 ' Resistance Ratio (rr) for thermistors only
LOGrr = Log(RR * 34800)
xden = (x1 + x2 * LOGrr + x3 * LOGrr ^ 3)
ThermistorER_1 = 1 / xden - 273.16
Case 5 ' target low (Platinum)
' Tlo = -108.54 + .306483 * v ' based on re-calibration of 90.10.12
' Tlo = -108.22 + 0.296 * v ' based on re-calibration of 94.01.31
' Tlo = -107.35 + 0.31264 * v ' based on NZ lab cal 941012
Select Case yyyymmdd$
Case Is < "20000602"
ThermistorER_1 = -107.35 + 0.31264 * V
Case Is < "20020610"
ThermistorER_1 = -107.2710409 + 0.305581926 * V + 0.000016353 * V ^ 2 ' based of JPL test 20000602
Case Is < "20040101" 'Before pre-AVE
ThermistorER_1 = -104.103246875 + 0.0194094875 * iv + 8.12045 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20000602
Case Is < "20050513" 'C:\MTP\Pt\PtERlow.txt -104.306 1.936339E-02 8.083334E-08
ThermistorER_1 = -104.305520555 + 0.0193596366 * iv + 8.0802 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20000602
Case Is < "20051021" 'C:\MTP\Data\WB57\HAVE2\Setup\Pt_ER_low_B.txt c(0) = -104.6552 c(1) = 0.019499 c(2) = 0.00000008138 c(3) = -0.000000000001285
ThermistorER_1 = -104.6552 + 0.019499 * iv + 0.00000008138 * iv ^ 2 - 0.000000000001285 * iv ^ 3 ' based of JPL test 20050513
Case Is < "20070614"
ThermistorER_1 = -97.2043 + 0.020652 * iv + 8.907 * 10 ^ -8 * iv ^ 2 - 1.512 * 10 ^ -12 * iv ^ 3 ' based of JPL test 20051021
Case Else
ThermistorER_1 = -97.369 + 0.02062 * iv + 8.884 * 10 ^ -8 * iv ^ 2 - 1.506 * 10 ^ -12 * iv ^ 3 ' based of JPL test 20070614
End Select
Case 6 ' target hi (Platinum)
' Thi = -40.26 + .308206 * v ' based on re-calibration of 90.10.12
' thi = -42.45 + .30835 * v ' based on re-calibration of 94.01.31
' Thi = -40.5 + 0.31459 * v ' based on NZ lab cal 941012
Select Case yyyymmdd$
Case Is < "20000602"
ThermistorER_1 = -40.5 + 0.31459 * V ' based on NZ lab cal 941012
Case Is < "20020610"
ThermistorER_1 = -42.62746225 + 0.321146517 * V + 0.0000172788 * V ^ 2 ' based of JPL test 20000602
Case Is < "20040101" 'Before pre-AVE
ThermistorER_1 = -38.35581128 + 0.0199520464 * iv + 8.12045 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20020607
Case Is < "20050513" 'C:\MTP\Pt\PtERhigh.txt -38.51244 1.991832E-02 8.094053E-08
ThermistorER_1 = -38.51423432 + 0.0199012512 * iv + 8.0802 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20020607
Case Is < "20051021" 'C:\MTP\Data\WB57\HAVE2\Setup\Pt_ER_high_B.txt c(0) = -38.8199 c(1) = 0.020027 c(2) = 0.00000006873 c(3) = -0.000000000001291
ThermistorER_1 = -38.8199 + 0.020027 * iv + 0.00000006873 * iv ^ 2 - 0.000000000001291 * iv ^ 3 ' based of JPL test 20050513
Case Is < "20070614" 'C:\MTP\Data\WB57\CRAVE\Setup\Pt_ER_high_B.txt
ThermistorER_1 = -27.5029 + 0.021172 * iv + 7.38 * 10 ^ -8 * iv ^ 2 - 1.508 * 10 ^ -12 * iv ^ 3 ' based of JPL test 20051021
Case Else
ThermistorER_1 = -27.8715 + 0.021256 * iv + 7.449 * 10 ^ -8 * iv ^ 2 - 1.526 * 10 ^ -12 * iv ^ 3 ' based of JPL test 20070614
End Select
Case 8 ' Window (Platinum)
' tWIN = -122.9 + .61803# * v ' used < 94.01.31
' tWIN = -122.9 + .61803# * v ' used > 94.01.31
Select Case yyyymmdd$
Case Is < "20020610"
ThermistorER_1 = -132.81 + 0.689408 * V ' based on NZ lab cal 941012
Case Is < "20040101" 'Before Pre-AVE
ThermistorER_1 = -128.15005382 + 0.0412740796 * iv + 3.74978 * 10 ^ -7 * iv ^ 2 ' based on JPL Lab Cal 20020607
Case Is < "20050513" 'C:\MTP\Pt\PtERwin.txt -130.1722 4.117574E-02 3.738589E-07
ThermistorER_1 = -130.1722 + 0.04117574 * iv + 0.0000003738589 * iv ^ 2 ' based on JPL Lab Cal 20040304
Case Is < "20050513" 'C:\MTP\Data\WB57\HAVE2\Setup\Pt_ER_high_B.txt c(0) = -104.6552 c(1) = 0.019499 c(2) = 0.00000008138 c(3) = -0.000000000001285
ThermistorER_1 = -104.6552 + 0.019499 * iv + 0.00000008138 * iv ^ 2 - 0.000000000001285 * iv ^ 3 ' based of JPL test 20050513
Case Is < "20051021" 'C:\MTP\Data\WB57\HAVE2\Setup\Pt_ER_win_B.txt c(0) = -129.3676 c(1) = 0.041538 c(2) = 0.0000004003 c(3) = -0.00000000001284
ThermistorER_1 = -129.3676 + 0.041538 * iv + 0.0000004003 * iv ^ 2 - 0.00000000001284 * iv ^ 3 ' based of JPL test 20050513
Case Else
ThermistorER_1 = -122.805 + 0.043982 * iv + 4.393 * 10 ^ -7 * iv ^ 2 - 1.511 * 10 ^ -11 * iv ^ 3 ' based of JPL test 20051021
End Select
Case 14 ' 5 volt PS
ThermistorER_1 = 5 * V / 128
Case 15 ' 12 volt PS
ThermistorER_1 = 12 * V / 128
Case 7, 16 ' ACC+ and ACC-
' ThermistorER_1 = iv
ThermistorER_1 = (iv - 2048#) / 1024# + 1 'Gees 20041130 mjm/rfd
Case 11 ' Vref
ThermistorER_1 = 2.5 * V / 128 'Voltage is scaled so 2.5 V = 128 *16 or midscale
Case Else
ThermistorER_1 = 0
End Select
End Function
Function ThermistorER_2
Function ThermistorER_2(ch%, iv%)
Dim x1!, x2!, x3!, RR!, LOGrr!, V!, xden!
' Thermistor calibration for new WB57 sensor unit (SU #2)
V = iv / 16# '981008 mjm Make real to avoid loosing 4 bits of precision
If V = 0 Then V = 1
' Old%=1: XT(1) = 12100 * rr: XT(2) = 34800 * rr ' Old data unit calibration prior to 931015
Select Case ch%
Case 1, 2, 3, 4, 9, 12, 13 ' ND, AMP, PLO, IFA, MTR, DU1, DU2
' following algorithm comes from RFD's eval'n of thermister tables 91.08.13+-
x1 = 0.0009336018 ' 44032 (new data system)
x2 = 0.0002213609
x3 = 0.000000126198
RR = (1 / (1 - V / 256)) - 1 ' Resistance Ratio (rr) for thermistors only
LOGrr = Log(RR * 34800)
xden = (x1 + x2 * LOGrr + x3 * LOGrr ^ 3)
ThermistorER_2 = 1 / xden - 273.16
' Thi, Tlo and Twin on MTP#2 use PT-539AW resistors
' Post AVE calibration for SU#2 on 2004.03.11
'C:\MTP\Pt\PtWBlow.txt -105.10930 1.927487E-02 8.015152E-08
'C:\MTP\Pt\PtWBhigh.txt -39.23671 1.988515E-02 8.071891E-08
'C:\MTP\Pt\PtWBwin.txt -130.95630 4.085367E-02 3.682880E-07
Case 5 ' target low (Platinum) Lab Cal 2002.04.26
Select Case yyyymmdd$
Case Is < "20040101"
ThermistorER_2 = -104.44517542 + 0.0191176938 * iv + 7.88045 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20000610
Case Is < "20070702"
ThermistorER_2 = -105.1093 + 0.01927487 * iv + 0.00000008071891 * iv ^ 2 ' based of JPL test 20040311
Case Else
ThermistorER_2 = -77.5976 + 0.020898 * iv + 0.00000008544 * iv ^ 2 - 0.00000000000153 * iv ^ 3 ' based of JPL test 20070530
End Select
Case 6 ' target hi (Platinum) Lab Cal 2002.04.26
Select Case yyyymmdd$
Case Is < "20040101"
ThermistorER_2 = -39.06863432 + 1.98967488 * 10 ^ -2 * iv + 8.0802 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20000610
Case Is < "20070702" 'Use this date so made up test data from CRAVE will process ok
ThermistorER_2 = -39.23671 + 0.01988515 * iv + 7.88045 * 10 ^ -8 * iv ^ 2 ' based of JPL test 20040311
Case Else
ThermistorER_2 = -4.686 + 0.021516 * iv + 7.019 * 10 ^ -8 * iv ^ 2 - 1.548 * 10 ^ (-12) * iv ^ 3 ' based of JPL test 20040311
End Select
Case 8 ' Window (Platinum)
Select Case yyyymmdd$
Case Is < "20040101"
ThermistorER_2 = -131.850263795 + 0.0406357966 * iv + 3.64658 * 10 ^ -7 * iv ^ 2 ' based of JPL test 20000610
Case Else
ThermistorER_2 = -130.9563 + 0.04085367 * iv + 0.000000368288 * iv ^ 2 ' based of JPL test 20040311
End Select
Case 14 ' 5 volt PS
ThermistorER_2 = 5 * V / 128
Case 15 ' 12 volt PS
ThermistorER_2 = 12 * V / 128
Case 7, 16 ' ACC+ and ACC-
' ThermistorER_2 = iv
ThermistorER_2 = (iv - 2048#) / 1024# + 1 'Gees 20041130 mjm/rfd
Case 11
ThermistorER_2 = 2.5 * V / 128 'Voltage is scaled so 2.5 V = 128 *16 or midscale
Case Else
ThermistorER_2 = 0
End Select
End Function
ER2_UCSE.bas
- Sub Decode2Bh
Sub Decode2Bh(Packet2Bh As String, n%, Status2Bh)
Dim i%, High!, Low!
' All 2Bh parameters are 2 bytes long and scaled
' T, P, TAS, pALT, DA, Roll, TH, B, Pitch,AA, SA, B, Wsd, Wdir, B, CC2
' 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
' Status Word 2 (deg)
High = Asc(Mid$(Packet2Bh, 32, 1)) ' Get High Byte
Low = Asc(Mid$(Packet2Bh, 33, 1)) ' Get Low Byte
CC2(n) = 256 * High + Low
' Check for valid status
Status2Bh = 1 'Good status word
Mask = 12392 '8 + 32 + 64 + 4096 + 8192
If Mask And CC2(n) < Mask Then Status2Bh = 0
' 1 T, 2 P, 3 TAS, 4 pALT, 5 DA, 6 Roll, 7 TH, 8 080-1
' 9 Pitch, 10 AA, 11 SA, 12 ADC, 13 Wind, 14 LSS, 15 DS, 16 080-1
' Outside air temperature (C)
OAT = fGetNo(Packet2Bh, 2) * 1024# / 32768#
' Pressure Altitude (meters)
pALT = fGetNo(Packet2Bh, 8)
' True Roll(deg)
Roll = fGetNo(Packet2Bh, 12) * 180# / 32768#
' True Heading (deg)
Heading = fGetNo(Packet2Bh, 14) * 180# / 32768#
' True Pitch (deg)
Pitch = fGetNo(Packet2Bh, 18) * 180# / 32768#
' Wind Speed (deg)
WindSpeed = fGetNo(Packet2Bh, 26) * 128# / 32768#
' Wind Direction (deg)
WindDir = fGetNo(Packet2Bh, 28) * 180# / 32768#
End Sub
Function fGetNo
Function fGetNo(Packet$, Index%)
Dim High%, Low%, Minus As Boolean
Minus = False
High = Asc(Mid$(Packet$, Index, 1)) ' Get High Byte
Low = Asc(Mid$(Packet$, Index + 1, 1)) ' Get Low Byte
' Take twos-complement of negative number if necessary
If (High And 128) Then
Minus = True
High = High - 128
End If
If Minus Then fGetNo = -1 * (High * 256 + Low) Else fGetNo = High * 256 + Low
End Function
Sub ReadNextFrame
Sub ReadNextFrame(NoData%)
Dim i%, j%
NoData = 0 '1 if not enough data in buffer
' Find 2Ah Packet
Call FindCode("&H2A")
' And read it
If MSComm1.InBufferCount > 46 Then
For j = 1 To 46
Packet2Ah = Packet2Ah + MSComm1.Input
Next j
Else
NoData = 1
Exit Sub
End If
' Find 2Bh Packet
EOFflag = False
For i = 1 To 5
FindCode ("&H2B")
If EOF(INPlu) Then EOFflag = True: Exit Sub
If MSComm1.InBufferCount > 32 Then
For j = 1 To 32
Packet2Bh(i) = Packet2Bh(i) + MSComm1.Input
Next j
Else
NoData = 1
Exit Sub
End If
Next i
End Sub
Sub Decode2Ah
Sub Decode2Ah(Packet2Ah$, Status2Ah%)
Dim char1 As String, char2 As String, High!, Low!
Dim Lat$, Lon$, Deg$, Min$, Mask%
' Read CpK(2),GMT(9),LAT(10),AA(2),LON(11),GS(5),TA(3),Zgps(2),CC1(2)
' 1-2 3-11 12-21 22-23 24-34 35-39 40-42 43-44 45-46
' Read Status Byte CC1
High = Asc(Mid$(Packet2Ah, 46, 1)) ' Get High Byte
Low = Asc(Mid$(Packet2Ah, 47, 1)) ' Get Low Byte
CC1 = 256 * High + Low
Mask = 294 ' 2 + 4 + 32 + 256
' Check status
Status2Ah = 1
If CC1 And Mask < Mask Then Status2Ah = 0
' Decode GMT
' HHMMSS$ = Mid$(Packet2Ah, 3, 9)
HHMMSS$ = Mid$(Packet2Ah, 3, 2) & ":" & Mid$(Packet2Ah, 5, 2) & ":" & Mid$(Packet2Ah, 7, 5)
UTks = 3.6 * Val(Mid$(Packet2Ah, 3, 2)) + 0.06 * Val(Mid$(Packet2Ah, 5, 2)) + Val(Mid$(Packet2Ah, 7, 5)) / 1000#
' Decode Latitude
Deg$ = Mid$(Packet2Ah, 13, 2)
Min$ = Mid$(Packet2Ah, 15, 7)
Latitude = Val(Deg$) + Val(Min$) / 60#
If Mid$(Packet2Ah, 12, 1) = "S" Then Latitude = -Latitude
' Skip reserved word AAh
' Read Longitude
Deg$ = Mid$(Packet2Ah, 25, 3)
Min$ = Mid$(Packet2Ah, 28, 7)
Longitude = Val(Deg$) + Val(Min$) / 60#
If Mid$(Packet2Ah, 24, 1) = "E" Then Longitude = -Longitude
' Read GPS Altitude
Zgps = fGetNo(Packet2Ah, 43)
txtZgps = Zgps
End Sub
Sub FindCode
Sub FindCode(Code%)
Dim Char$, CharCode%, LastCode%
EOFflag = False
If MSComm1.InBufferCount > 0 Then
CharCode = Asc(MSComm1.Input)
Else
NoComPortData = True
Exit Sub
End If
Do ' Loop until end of file.
LastCode = CharCode
If MSComm1.InBufferCount > 0 Then
CharCode = Asc(MSComm1.Input)
Else
MsgBox "There is no data on COM Port " + Str(COMport) + "!", vbOKOnly
NoComPortData = True
Exit Sub
End If
Loop Until EOF(INPlu) Or (CharCode = Code) 'LastCode = "&H10" And
End Sub
ER2_UCSE1.bas
- Sub Decode2Bh
Sub Decode2Bh(Packet2Bh As String, n%, Status2Bh)
Dim i%, High!, Low!
' All 2Bh parameters are 2 bytes long and scaled
' T, P, TAS, pALT, DA, Roll, TH, B, Pitch,AA, SA, B, Wsd, Wdir, B, CC2
' 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
' Status Word 2 (deg)
High = Asc(Mid$(Packet2Bh, 32, 1)) ' Get High Byte
Low = Asc(Mid$(Packet2Bh, 33, 1)) ' Get Low Byte
CC2(n) = 256 * High + Low
' Check for valid status
Status2Bh = 1 'Good status word
Mask = 12392 '8 + 32 + 64 + 4096 + 8192
If Mask And CC2(n) < Mask Then Status2Bh = 0
' 1 T, 2 P, 3 TAS, 4 pALT, 5 DA, 6 Roll, 7 TH, 8 080-1
' 9 Pitch, 10 AA, 11 SA, 12 ADC, 13 Wind, 14 LSS, 15 DS, 16 080-1
' Outside air temperature (C)
OAT = fGetNo(Packet2Bh, 2) * 1024# / 32768#
' Pressure Altitude (meters)
pALT = fGetNo(Packet2Bh, 8)
' True Roll(deg)
Roll = fGetNo(Packet2Bh, 12) * 180# / 32768#
' True Heading (deg)
Heading = fGetNo(Packet2Bh, 14) * 180# / 32768#
' True Pitch (deg)
Pitch = fGetNo(Packet2Bh, 18) * 180# / 32768#
' Wind Speed (deg)
WindSpeed = fGetNo(Packet2Bh, 26) * 128# / 32768#
' Wind Direction (deg)
WindDir = fGetNo(Packet2Bh, 28) * 180# / 32768#
End Sub
Function fGetNo
Function fGetNo(Packet$, Index%)
Dim High%, Low%, Minus As Boolean
Minus = False
High = Asc(Mid$(Packet$, Index, 1)) ' Get High Byte
Low = Asc(Mid$(Packet$, Index + 1, 1)) ' Get Low Byte
' Take twos-complement of negative number if necessary
If (High And 128) Then
Minus = True
High = High - 128
End If
If Minus Then fGetNo = -1 * (High * 256 + Low) Else fGetNo = High * 256 + Low
End Function
Sub ReadNextFrame
Sub ReadNextFrame(NoData%)
Dim i%, j%
NoData = 0 '1 if not enough data in buffer
' Find 2Ah Packet
Call FindCode("&H2A")
' And read it
If MSComm1.InBufferCount > 46 Then
For j = 1 To 46
Packet2Ah = Packet2Ah + MSComm1.Input
Next j
Else
NoData = 1
Exit Sub
End If
' Find 2Bh Packet
EOFflag = False
For i = 1 To 5
FindCode ("&H2B")
If EOF(INPlu) Then EOFflag = True: Exit Sub
If MSComm1.InBufferCount > 32 Then
For j = 1 To 32
Packet2Bh(i) = Packet2Bh(i) + MSComm1.Input
Next j
Else
NoData = 1
Exit Sub
End If
Next i
End Sub
Sub Decode2Ah
Sub Decode2Ah(Packet2Ah$, Status2Ah%)
Dim char1 As String, char2 As String, High!, Low!
Dim Lat$, Lon$, Deg$, Min$, Mask%
' Read CpK(2),GMT(9),LAT(10),AA(2),LON(11),GS(5),TA(3),Zgps(2),CC1(2)
' 1-2 3-11 12-21 22-23 24-34 35-39 40-42 43-44 45-46
' Read Status Byte CC1
High = Asc(Mid$(Packet2Ah, 46, 1)) ' Get High Byte
Low = Asc(Mid$(Packet2Ah, 47, 1)) ' Get Low Byte
CC1 = 256 * High + Low
Mask = 294 ' 2 + 4 + 32 + 256
' Check status
Status2Ah = 1
If CC1 And Mask < Mask Then Status2Ah = 0
' Decode GMT
' HHMMSS$ = Mid$(Packet2Ah, 3, 9)
HHMMSS$ = Mid$(Packet2Ah, 3, 2) & ":" & Mid$(Packet2Ah, 5, 2) & ":" & Mid$(Packet2Ah, 7, 5)
UTks = 3.6 * Val(Mid$(Packet2Ah, 3, 2)) + 0.06 * Val(Mid$(Packet2Ah, 5, 2)) + Val(Mid$(Packet2Ah, 7, 5)) / 1000#
' Decode Latitude
Deg$ = Mid$(Packet2Ah, 13, 2)
Min$ = Mid$(Packet2Ah, 15, 7)
Latitude = Val(Deg$) + Val(Min$) / 60#
If Mid$(Packet2Ah, 12, 1) = "S" Then Latitude = -Latitude
' Skip reserved word AAh
' Read Longitude
Deg$ = Mid$(Packet2Ah, 25, 3)
Min$ = Mid$(Packet2Ah, 28, 7)
Longitude = Val(Deg$) + Val(Min$) / 60#
If Mid$(Packet2Ah, 24, 1) = "E" Then Longitude = -Longitude
' Read GPS Altitude
Zgps = fGetNo(Packet2Ah, 43)
txtZgps = Zgps
End Sub
Sub FindCode
Sub FindCode(Code%)
Dim Char$, CharCode%, LastCode%
EOFflag = False
If MSComm1.InBufferCount > 0 Then
CharCode = Asc(MSComm1.Input)
Else
NoComPortData = True
Exit Sub
End If
Do ' Loop until end of file.
LastCode = CharCode
If MSComm1.InBufferCount > 0 Then
CharCode = Asc(MSComm1.Input)
Else
MsgBox "There is no data on COM Port " + Str(COMport) + "!", vbOKOnly
NoComPortData = True
Exit Sub
End If
Loop Until EOF(INPlu) Or (CharCode = Code) 'LastCode = "&H10" And
End Sub
FLTINFO.bas
Sub InitializeGainLimits
Sub InitializeGainLimits()
Select Case AC$
Case "ER", "WB"
Select Case Mission$
Case "ACCENT2", "ACCENT"
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
GeqnMax(1) = 45: GeqnMax(2) = 45: GeqnMax(3) = 45 'xxx mjm was 25 for SOLVE
GeqnMin(1) = 10: GeqnMin(2) = 10: GeqnMin(3) = 10
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
GnavMax(1) = 45: GnavMax(2) = 45: GnavMax(3) = 45 'was 25 for SOLVE
GnavMin(1) = 10: GnavMin(2) = 10: GnavMin(3) = 10
' Noise Diode MINs were: MAXs were:
GndMax(1) = 26: GndMax(2) = 16: GndMax(3) = 26
GndMin(1) = 5: GndMin(2) = 7: GndMin(3) = 7
' Default for gain picture box
' txtGain1.Text = 30: txtGain2.Text = 40
Case Else
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
GeqnMax(1) = 40: GeqnMax(2) = 40: GeqnMax(3) = 40 'xxx mjm was 25 for SOLVE
GeqnMin(1) = 10: GeqnMin(2) = 10: GeqnMin(3) = 10
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
GnavMax(1) = 40: GnavMax(2) = 40: GnavMax(3) = 40 'was 25 for SOLVE
GnavMin(1) = 10: GnavMin(2) = 10: GnavMin(3) = 10
' Noise Diode MINs were: MAXs were:
GndMax(1) = 26: GndMax(2) = 26: GndMax(3) = 26
GndMin(1) = 5: GndMin(2) = 7: GndMin(3) = 7
' Default for gain picture box
' txtGain1.Text = 10: txtGain2.Text = 20
End Select
Case "DC"
Select Case Mission$
Case "SOLVE", "TexAQS", "CAMEX4"
' Default scale for Gain picture window
' txtGain1.Text = 12
' txtGain2.Text = 17
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
GeqnMax(1) = 14: GeqnMax(2) = 16: GeqnMax(3) = 17
GeqnMin(1) = 9: GeqnMin(2) = 11: GeqnMin(3) = 12#
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
GnavMax(1) = 14: GnavMax(2) = 16: GnavMax(3) = 17
GnavMin(1) = 9: GnavMin(2) = 11: GnavMin(3) = 12
' Noise Diode MINs were: MAXs were:
GndMax(1) = 24: GndMax(2) = 26: GndMax(3) = 27
GndMin(1) = 9: GndMin(2) = 11: GndMin(3) = 12
Case "PEMTB"
' If chkCh2Only.value = 1 Then mjmmjm
' Default scale for Gain picture window
' txtGain1.Text = 5
' txtGain2.Text = 15
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
' GeqnMax(1) = 7.5: GeqnMax(2) = 11: GeqnMax(3) = 11
' GeqnMin(1) = 5: GeqnMin(2) = 6: GeqnMin(3) = 6
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
' GnavMax(1) = 7.5: GnavMax(2) = 11: GnavMax(3) = 11
' GnavMin(1) = 5: GnavMin(2) = 6: GnavMin(3) = 6
' Noise Diode MINs were: MAXs were:
' GndMax(1) = 26: GndMax(2) = 26: GndMax(3) = 26
' GndMin(1) = 5: GndMin(2) = 7: GndMin(3) = 9
' Else
' Default scale for Gain picture window
'txtGain1.Text = 5
'txtGain2.Text = 9
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
GeqnMax(1) = 7.5: GeqnMax(2) = 8.5: GeqnMax(3) = 8.5
GeqnMin(1) = 5: GeqnMin(2) = 6: GeqnMin(3) = 6
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
GnavMax(1) = 7.5: GnavMax(2) = 8.5: GnavMax(3) = 8.5
GnavMin(1) = 5: GnavMin(2) = 6: GnavMin(3) = 6
' Noise Diode MINs were: MAXs were:
GndMax(1) = 26: GndMax(2) = 26: GndMax(3) = 26
GndMin(1) = 5: GndMin(2) = 7: GndMin(3) = 9
' End If
Case "TOTE_VOTE"
' Default scale for Gain picture window
'txtGain1.Text = 5
'txtGain2.Text = 11
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
GeqnMax(1) = 9: GeqnMax(2) = 10: GeqnMax(3) = 11
GeqnMin(1) = 5: GeqnMin(2) = 8: GeqnMin(3) = 9
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
GnavMax(1) = 9: GnavMax(2) = 10: GnavMax(3) = 11
GnavMin(1) = 5: GnavMin(2) = 8: GnavMin(3) = 9
' Noise Diode MINs were: MAXs were:
GndMax(1) = 26: GndMax(2) = 26: GndMax(3) = 26
GndMin(1) = 5: GndMin(2) = 7: GndMin(3) = 9
Case Else
' Default scale for Gain picture window
' txtGain1.Text = 12
' txtGain2.Text = 17
' Gain Equation MINs were 6.0/7.5/8.5 MAXs were 9.0/10.5/12.0
GeqnMax(1) = 16: GeqnMax(2) = 18: GeqnMax(3) = 20
GeqnMin(1) = 9: GeqnMin(2) = 11: GeqnMin(3) = 12#
' Nav/DADS MINs were: 5/7/7 MAXs were: 9/12/12
GnavMax(1) = 16: GnavMax(2) = 18: GnavMax(3) = 20
GnavMin(1) = 9: GnavMin(2) = 11: GnavMin(3) = 12
' Noise Diode MINs were: MAXs were:
GndMax(1) = 24: GndMax(2) = 26: GndMax(3) = 27
GndMin(1) = 9: GndMin(2) = 11: GndMin(3) = 12
End Select
End Select
'Gain limits
''For i = 1 To Channels
'' GeqnMin(i) = Val(frmFLTINFO.txtGE1(i - 1).Text): GeqnMax(i) = Val(frmFLTINFO.txtGE2(i - 1).Text)
'' GnavMin(i) = Val(frmFLTINFO.txtNV1(i - 1).Text): GnavMax(i) = Val(frmFLTINFO.txtNV2(i - 1).Text)
'' GndMin(i) = Val(frmFLTINFO.txtND1(i - 1).Text): GndMax(i) = Val(frmFLTINFO.txtND2(i - 1).Text)
''Next i
End Sub
Function fCurrentFormNumber
Function fCurrentFormNumber(Form$)
Dim i%
For i = 0 To Forms.Count - 1
If Forms(i).Name = Form$ Then fCurrentFormNumber = i
Next i
End Function
Sub LoadListBox
Sub LoadListBox(C As Control, Name$, DecimalPts%, UnitScale!)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, INIfile$, fmt$
Select Case Name$
Case "DC8", "ER2", "WB57", "M55", "NGV": INIfile$ = "C:\MTP\Setup\Missions.INI"
Case Else: INIfile$ = "C:\MTP\Setup\Hardware.INI"
End Select
If Len(Dir(INIfile$)) = 0 Then
MsgBox "Could not find hardware configuration file " + INIfile$, vbOKOnly
Exit Sub
End If
Select Case DecimalPts
Case 0:: fmt$ = "#0"
Case 1: fmt$ = "#0.0"
Case 2: fmt$ = "#0.00"
Case 3: fmt$ = "#0.000"
End Select
lu% = FreeFile
Open INIfile$ For Input As lu%
FIsize% = 0
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Name$ Then
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Cmd$ = "" Then GoTo Exit_Sub
FIsize% = FIsize% + 1
C.AddItem Format$(Val(Cmd$) * UnitScale, fmt$)
Loop
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub LoadListBoxH
Sub LoadListBoxH(C As Control, Name$, DecimalPts%, UnitScale!)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, INIfile$, fmt$
INIfile$ = "C:\MTP\Setup\Hardware.INI"
If Len(Dir(INIfile$)) = 0 Then
MsgBox "Could not find hardware configuration file " + INIfile$, vbOKOnly
Exit Sub
End If
Select Case DecimalPts
Case 0:: fmt$ = "#0"
Case 1: fmt$ = "#0.0"
Case 2: fmt$ = "#0.00"
Case 3: fmt$ = "#0.000"
End Select
lu% = FreeFile
Open INIfile$ For Input As lu%
FIsize% = 0
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Name$ Then
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Cmd$ = "" Then GoTo Exit_Sub
FIsize% = FIsize% + 1
C.AddItem Format$(Val(Cmd$) * UnitScale, fmt$)
Loop
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub LoadListBoxM
Sub LoadListBoxM(C As Control, Name$, DecimalPts%, UnitScale!)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, INIfile$, fmt$
INIfile$ = "C:\MTP\Setup\Missions.INI"
If Len(Dir(INIfile$)) = 0 Then
MsgBox "Could not find hardware configuration file " + INIfile$, vbOKOnly
Exit Sub
End If
Select Case DecimalPts
Case 0:: fmt$ = "#0"
Case 1: fmt$ = "#0.0"
Case 2: fmt$ = "#0.00"
Case 3: fmt$ = "#0.000"
End Select
lu% = FreeFile
Open INIfile$ For Input As lu%
FIsize% = 0
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Name$ Then
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Cmd$ = "" Then GoTo Exit_Sub
FIsize% = FIsize% + 1
C.AddItem Format$(Val(Cmd$) * UnitScale, fmt$)
Loop
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub MapTArmsToOBrms
Sub MapTArmsToOBrms(TArms!(), OBrms!(), Channels%, Nel%, LocHor%, ChInfo!())
Dim j%
' Prepare Observable Error (OBrms) vector
Select Case LocHor
Case 6
' This is final ob order: CH1:1-5, 7-10, CH2:1-5, 7-10, CH3:1-5, 7-10, OAT
For j = 1 To 5: OBrms(j) = TArms(1, j): Next j
For j = 7 To 10: OBrms(j - 1) = TArms(1, j): Next j
If Channels > 1 Then
For j = 11 To 15: OBrms(j - 1) = TArms(2, j - 10): Next j
For j = 17 To 20: OBrms(j - 2) = TArms(2, j - 10): Next j
End If
If Channels > 2 Then
For j = 21 To 25: OBrms(j - 2) = TArms(3, j - 20): Next j
For j = 27 To 30: OBrms(j - 3) = TArms(3, j - 20): Next j
End If
Case 5
' This is final ob order: CH1:1-4, 6-10, CH2:1-4, 6-10, CH3:1-4, 6-10, OAT
For j = 1 To 4: OBrms(j) = TArms(1, j): Next j
For j = 6 To 10: OBrms(j - 1) = TArms(1, j): Next j
If Channels > 1 Then
For j = 11 To 14: OBrms(j - 1) = TArms(2, j - 10): Next j
For j = 16 To 20: OBrms(j - 2) = TArms(2, j - 10): Next j
End If
If Channels > 2 Then
For j = 21 To 24: OBrms(j - 2) = TArms(3, j - 20): Next j
For j = 26 To 30: OBrms(j - 3) = TArms(3, j - 20): Next j
End If
Case Else
MsgBox "Only valid LocHor values are 5 and 6", vbOKOnly
Stop
End Select
' Calculate horizon observable (normally =, might want to wt by ChInfo
' Following is not correct if separate horizon TBs!!!!
' But this code is not used anywhere in RCcalc, MTPsim or
Select Case Channels
Case 1: OBrms(10) = TArms(1, LocHor)
Case 2: OBrms(19) = TArms(1, LocHor)
Case 3: OBrms(28) = TArms(1, LocHor)
End Select
End Sub
Sub ReadFLAfile
Sub ReadFLAfile(Platform$, Mission$)
' Read Retrieval Levels in units of 10 m from default .FLA file
Dim i%, lu#, A$
lu = FreeFile
Open MNpath$ + "Setup\" + Mission$ + "_FLA.txt" For Input As lu
i = 0
Do
Input #lu, A$
i = i + 1
FLA(i) = Val(A$) * 100#
Loop Until EOF(lu)
Close lu
NFL = i
End Sub
Sub ReadFLTINFOfromRegistry
Sub ReadFLTINFOfromRegistry()
App.Title = "FLTINFO"
Mission$ = GetSetting(App.Title, "PATH", "Mission", "AVE")
yyyymmdd$ = GetSetting(App.Title, "PATH", "FlightDate", "")
Rdir$ = "/" + GetSetting(App.Title, "PATH", "Platform") + "/"
Drive$ = GetSetting(App.Title, "PATH", "DefaultDataDrive", "C:")
Pgm$ = GetSetting(App.Title, "PATH", "DefaultProgramPath")
Path$ = GetSetting(App.Title, "PATH", "DefaultDataPath")
TotalCycles = GetSetting(App.Title, "PATH", "TotalCycles", 1)
End Sub
Sub ReadFLTINFO
Sub ReadFLTINFO(Filename$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean
Dim M%
'Avoid using this sub
lu% = FreeFile
Open Filename$ For Input As lu%
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If FIsize% = 2 Then 'Extract PI$
Pi$ = Right$(Cmd$, Len(Cmd$) - 7)
'Debug.Print Pi$
End If
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
'Print "Right Bracket not found. Fix line number ", FIsize%
Stop
End If
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "CALIBRATION"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'Debug.Print cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
Select Case Left$(Cmd$, i1% - 1)
Case "RegNr": RegNr = Int(Val(V$))
Case "Reg0$": Reg0$ = V$
Case "Reg1$": Reg1$ = V$
Case "Reg2$": Reg2$ = V$
Case "Reg3$" 'This corrects old INI files which used 1,2,3 not 0,1,2
Reg0$ = Reg1$
Reg1$ = Reg2$
Reg2$ = V$
Case "USE5$": USE5$ = V$
Case "Algorithm": Algorithm = V$
Case "utMTPcor": utMTPcor = Val(V$)
Case "DTavg": DTavg = Val(V$)
Case "DTrms": DTrms = Val(V$)
Case "MRIavg": MRIavg = Val(V$)
Case "MRIrms": MRIrms = Val(V$)
Case "ALTfujCONST": ALTfujCONST = Val(V$)
Case "ALTfujSLOPE": ALTfujSLOPE = Val(V$)
Case "OATnavCOR": OATnavCOR = Val(V$)
Case "CalSource$": CalSource$ = V$
Case "useMMSpALT": UseMMSpALT = V$
Case "LAT1": LAT1 = Val(V$)
Case "LAT2": LAT2 = Val(V$)
Case "LAT3": LAT3 = Val(V$)
Case "LAT4": LAT4 = Val(V$)
Case "UserLATn$": UserLATn$ = V$
Case "UserLATs": UserLATs = V$
Case Else
End Select
End If
Loop
Case "PATH"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "Mission$": Mission$ = V$
Case "yymmdd$"
yyyymmdd$ = "19" + V$ 'Fix old format
FixPath = True
Case "yyyymmdd$": yyyymmdd$ = V$
Case "TotalCycles": TotalCycles = Val(V$)
Case "Drive$"
Drive$ = V$
' If Drive$ <> Left$(filename$, 2) Then Drive$ = Left$(filename$, 2)
Case "Path$"
Path$ = V$
If FixPath Then
M = InStr(1, Path$, Mission$)
M = M + 1
M = InStr(M, Path$, "\")
If Mid$(Path$, M + 1, 1) = "9" Then
Path$ = Left$(Path$, M) + yyyymmdd$ + "\"
RAWstamp = Tstamp
MMSstamp = Tstamp
REFstamp = Tstamp
ERFstamp = Tstamp
CTCstamp = Tstamp
End If
End If
Case "Rdir$": Rdir$ = V$
Case "Pgm$": Pgm$ = V$
Case Else
End Select
End If
Loop
Case "LIMITS"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "EditTropAlt": EditTropAlt = V$
Case "TropAltMin": TropAltMin = Val(V$)
Case "TropAltMax": TropAltMax = Val(V$)
Case "TropAltPC": TropAltPC = Val(V$)
Case "EditRetAlt": EditRetAlt = V$
Case "RetAltMin": RetAltMin = Val(V$)
Case "RetAltMax": RetAltMax = Val(V$)
Case "RetAltPC": RetAltPC = Val(V$)
Case "EditTemperature": EditTemperature = V$
Case "TemperatureMin": TemperatureMin = Val(V$)
Case "TemperatureMax": TemperatureMax = Val(V$)
Case "TemperaturePC": TemperaturePC = Val(V$)
Case "EditZtOff": EditZtOff = V$
Case "ZtOffA": ZtOffA = Val(V$)
Case "ZtOffB": ZtOffB = Val(V$)
Case "ZtOffPC": ZtOffPC = Val(V$)
Case "EditPitch": EditPitch = V$
Case "ePitchMin": ePitchMin = Val(V$)
Case "ePitchMax": ePitchMax = Val(V$)
Case "PitchPC": PitchPC = Val(V$)
Case "EditRoll": EditRoll = V$
Case "eRollMin": eRollMin = Val(V$)
Case "eRollMax": eRollMax = Val(V$)
Case "RollPC": RollPC = Val(V$)
Case "RAWbadPC": RAWbadPC = V$
Case "NlevPC": NlevPC = V$
Case Else
End Select
End If
Loop
Case "OATtrop"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'Debug.Print cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "EditOATtrop": EditOATtrop = V$
Case "OATtropPC": OATtropPC = V$
Case "OATzt10": OATzt10 = V$
Case "Tzt10": Tzt10 = V$
Case "OATzt11": OATzt11 = V$
Case "Tzt11": Tzt11 = V$
Case "OATzt12": OATzt12 = V$
Case "Tzt12": Tzt12 = V$
Case "OATzt13": OATzt13 = V$
Case "Tzt13": Tzt13 = V$
Case "OATzt20": OATzt20 = V$
Case "Tzt20": Tzt20 = V$
Case "OATzt21": OATzt21 = V$
Case "Tzt21": Tzt21 = V$
Case "OATzt22": OATzt22 = V$
Case "Tzt22": Tzt22 = V$
Case "OATzt23": OATzt23 = V$
Case "Tzt23": Tzt23 = V$
Case "OATks10": OATks10 = V$
Case "OATks11": OATks11 = V$
Case "OATks12": OATks12 = V$
Case "OATks13": OATks13 = V$
Case "OATks20": OATks20 = V$
Case "OATks21": OATks21 = V$
Case "OATks22": OATks22 = V$
Case "OATks23": OATks23 = V$
Case Else
End Select
End If
Loop
Case "VERSION"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
Select Case Left$(Cmd$, i1% - 1)
Case "vCF$": vCF$ = V$
Case "vD1$": vD1$ = V$
Case "vD2$": vD2$ = V$
Case "vMP$": vMP$ = V$
Case "vFR$": vFR$ = V$
Case "vFW$": vFW$ = V$
Case "vDT$": vDT$ = V$
Case Else
End Select
End If
Loop
Case "HISTORY"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
Select Case Left$(Cmd$, i1% - 1)
Case "Tstamp": Tstamp = V$
Case "RAWstamp": RAWstamp = V$
Case "REFstamp": REFstamp = V$
Case "ERFstamp": ERFstamp = V$
Case "CTCstamp": CTCstamp = V$
Case Else
End Select
End If
Loop
Case Else
End Select
End If
Loop
Exit_Sub:
Close (lu%)
AC$ = Mid$(Rdir$, 2, 2)
Root$ = Drive$ + Rdir$
Path$ = Root$ + Mission$ + "\" + yyyymmdd$ + "\" 'Just in case!
yymmdd$ = Right$(yyyymmdd$, 6)
End Sub
Sub LoadComboBox
Sub LoadComboBox(C As Control, Name$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, INIfile$
Select Case Name$
Case "DC8", "ER2", "WB57", "M55", "NGV": INIfile$ = "C:\MTP\Setup\Missions.INI"
Case Else: INIfile$ = "C:\MTP\Setup\Hardware.INI"
End Select
If Len(Dir(INIfile$)) = 0 Then
MsgBox "Could not find hardware configuration file " + INIfile$, vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open INIfile$ For Input As lu%
FIsize% = 0
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Name$ Then
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Cmd$ = "" Then GoTo Exit_Sub
FIsize% = FIsize% + 1
C.AddItem Cmd$
Loop
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub LoadComboBoxH
Sub LoadComboBoxH(C As Control, Name$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, INIfile$
INIfile$ = "C:\MTP\Setup\Hardware.INI"
If Len(Dir(INIfile$)) = 0 Then
MsgBox "Could not find hardware configuration file " + INIfile$, vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open INIfile$ For Input As lu%
FIsize% = 0
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Name$ Then
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Cmd$ = "" Then GoTo Exit_Sub
FIsize% = FIsize% + 1
C.AddItem Cmd$
Loop
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub LoadComboBoxM
Sub LoadComboBoxM(C As Control, Name$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, INIfile$
INIfile$ = "C:\MTP\Setup\Missions.INI"
If Len(Dir(INIfile$)) = 0 Then
MsgBox "Could not find hardware configuration file " + INIfile$, vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open INIfile$ For Input As lu%
FIsize% = 0
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Name$ Then
C.Clear
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Cmd$ = "" Then GoTo Exit_Sub
FIsize% = FIsize% + 1
C.AddItem Cmd$
Loop
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub MapOBtoTA
Sub MapOBtoTA(iRC%, TA!(), ob!(), Channels%, Nel%)
Dim i%, j%
If (Nobs Mod 10) <> 0 Then
For i = 1 To Channels
For j = 1 To Nel
Select Case j + 10 * (i - 1)
Case Is < 6: TA(i, j) = ob(j)
Case Is = 6: TA(i, j) = ob(28)
Case Is < 11: TA(i, j) = ob(j - 1)
Case Is < 16: TA(i, j) = ob(j + 9 * (i - 1))
Case Is = 16: TA(i, j) = ob(28)
Case Is < 21: TA(i, j) = ob(j - 1 + 9 * (i - 1))
Case Is < 26: TA(i, j) = ob(j + 9 * (i - 1))
Case Is = 26: TA(i, j) = ob(28)
Case Is < 31: TA(i, j) = ob(j - 1 + 9 * (i - 1))
End Select
Next j
Next i
Else
For i = 1 To Channels
For j = 1 To 10
TA(i, j) = ob(j + (i - 1) * 10)
Next j
Next i
End If
End Sub
Sub MapTAtoOB
Sub MapTAtoOB(TA!(), ob!(), Channels%, Nel%, LocHor%, ChInfo!())
Dim j%
If (Nobs Mod 10) <> 0 Then 'Assume all RCs are same format
' Prepare Observable Vector:
Select Case LocHor
Case 6
' This is final ob order: CH1:1-5, 7-10, CH2:1-5, 7-10, CH3:1-5, 7-10, OAT
For j = 1 To 5: ob(j) = TA(1, j): Next j
For j = 7 To 10: ob(j - 1) = TA(1, j): Next j
If Channels > 1 Then
For j = 11 To 15: ob(j - 1) = TA(2, j - 10): Next j
For j = 17 To 20: ob(j - 2) = TA(2, j - 10): Next j
End If
If Channels > 2 Then
For j = 21 To 25: ob(j - 2) = TA(3, j - 20): Next j
For j = 27 To 30: ob(j - 3) = TA(3, j - 20): Next j
End If
Case 5
' This is final ob order: CH1:1-4, 6-10, CH2:1-4, 6-10, CH3:1-4, 6-10, OAT
For j = 1 To 4: ob(j) = TA(1, j): Next j
For j = 6 To 10: ob(j - 1) = TA(1, j): Next j
If Channels > 1 Then
For j = 11 To 14: ob(j - 1) = TA(2, j - 10): Next j
For j = 16 To 20: ob(j - 2) = TA(2, j - 10): Next j
End If
If Channels > 2 Then
For j = 21 To 24: ob(j - 2) = TA(3, j - 20): Next j
For j = 26 To 30: ob(j - 3) = TA(3, j - 20): Next j
End If
Case Else
MsgBox "Only valid LocHor values are 5 and 6", vbOKOnly
Stop
End Select
' Calculate horizon observable
Select Case Channels
Case 1: ob(10) = TA(1, LocHor)
Case 2
ob(19) = (ChInfo(1) * TA(1, LocHor) + ChInfo(2) * TA(2, LocHor)) / (ChInfo(1) + ChInfo(2))
Case 3
ob(28) = (ChInfo(1) * TA(1, LocHor) + ChInfo(2) * TA(2, LocHor) + ChInfo(3) * TA(3, LocHor)) / (ChInfo(1) + ChInfo(2) + ChInfo(3))
End Select
Else 'Separate horizon observables for each channel
For j = 1 To 10: ob(j) = TA(1, j): Next j
For j = 1 To 10: ob(10 + j) = TA(2, j): Next j
For j = 1 To 10: ob(20 + j) = TA(3, j): Next j
End If
End Sub
Sub UpdateMissionsINI
Sub UpdateMissionsINI(Platform$, Mission$)
Dim INPlu%, OUTlu%, MissionsINI$, NewMissionsINI$
Dim i0%, Cmd$
INPlu% = FreeFile
MissionsINI$ = "C:\MTP\Setup\Missions.INI"
Open MissionsINI$ For Input As INPlu%
OUTlu% = FreeFile
NewMissionsINI$ = "C:\MTP\Setup\NewMissions.INI"
Open NewMissionsINI$ For Output As OUTlu%
Do
If EOF(INPlu%) Then GoTo Exit_Sub
Input #INPlu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Platform$ Then 'Found Platform
Print #OUTlu, Cmd$ 'Platform
Input #INPlu, Cmd$ 'First mission for platform
If Cmd$ <> Mission$ Then Print #OUTlu, Mission$ 'Don't add if already there
Print #OUTlu, Cmd$
Do
Input #INPlu%, Cmd$ 'Copy rest of file
Print #OUTlu, Cmd$
Loop Until Cmd$ = "[EOF]"
Else
Print #OUTlu, Cmd$
Do
Input #INPlu%, Cmd$ 'Copy rest of file
Print #OUTlu, Cmd$
Loop Until Cmd$ = ""
End If
End If
Loop Until Cmd$ = "[EOF]"
Exit_Sub:
Close OUTlu, INPlu
If Len(Dir("C:\MTP\Setup\Missions.SAV")) > 0 Then Kill "C:\MTP\Setup\Missions.SAV"
Name MissionsINI$ As "C:\MTP\Setup\Missions.SAV"
If Len(Dir("C:\MTP\Setup\Missions.INI")) > 0 Then Kill MissionsINI$
Name NewMissionsINI$ As MissionsINI$
End Sub
Sub WriteFLTINFO
Sub WriteFLTINFO(Filename$)
Dim i0%, i1%, i2%, lu%, FI$
lu% = FreeFile
Open Filename$ For Output As lu%
FIsize% = 0
AC$ = Mid$(Rdir$, 2, 2)
Path$ = Drive$ + Rdir2$ + Mission$ + "\" + yyyymmdd$ + "\"
FI$ = Path$ + AC$ + yyyymmdd$ + ".INI"
Call PrintStr(lu%, "' " + FI$ + " was last written on " + Date$ + " at " + Time$, "", "")
If Asc(Left$(Pi$, 1)) <> 32 Then
Call PrintStr(lu%, "' PI$: " + Pi$, "", "")
Else
Call PrintStr(lu%, "' PI$: MJ MAHONEY (m.j.mahoney@jpl.nasa.gov) & Bruce GARY (bgary@jpl.nasa.gov)", "", "")
End If
Call PrintStr(lu%, "' This INI-file follows a few simple but mandatory format requirements.", "", "")
Call PrintStr(lu%, "' Settings are entered into categories which occupy a single line and", "", "")
Call PrintStr(lu%, "' must be bracketed by square brackets (e.g. [PATH]). Variables for which", "", "")
Call PrintStr(lu%, "' settings are assigned must have exactly the same name in the program in", "", "")
Call PrintStr(lu%, "' which they are used and be followed by an equal sign (=). Spaces are", "", "")
Call PrintStr(lu%, "' not allowed. Anything beyond the first space in a line is ignored.", "", "")
Call PrintStr(lu%, "' Blank lines are also ignored, but are required betweeen categories.", "", "")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[PATH]", "", "")
Call PrintStr(lu%, "Mission$", Mission$, "Mission Name")
Call PrintStr(lu%, "yyyymmdd$", yyyymmdd$, "Flight Date")
Call PrintVal(lu%, "TotalCycles", TotalCycles, "Number of scans in REF file")
Call PrintStr(lu%, "Drive$", Drive$, "Default system hard drive")
Call PrintStr(lu%, "Rdir$", Rdir$, "Default path from root directory")
Call PrintStr(lu%, "Path$", Path$, Drive$ + Rdir2$ + Mission$ + "\yyyyddmm\")
Call PrintStr(lu%, "Pgm$", Pgm$, "Program file directory path")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[CALIBRATION]", "", "")
Call PrintStr(lu%, "Reg0$", Reg$(0), "Tropical RC")
Call PrintStr(lu%, "Reg1$", Reg$(1), "Mid-Latitude RC")
Call PrintStr(lu%, "Reg2$", Reg$(2), "Polar Rc")
Call PrintVal(lu%, "RegNr", RegNr, "RC coefficient index")
Call PrintStr(lu%, "USE5$", USE5$, "USE file for Standard Errors")
Call PrintVal(lu%, "Algorithm", Algorithm, "Retrieval Algorithm Index")
Call PrintVal(lu%, "MRIavg", MRIavg, "Average Meridional Region Index")
Call PrintVal(lu%, "MRIrms", MRIrms, "RMS Meridional Region Index")
Call PrintVal(lu%, "utMTPcor", utMTPcor, "Correction to be ADDED to MTP clock [sec]")
Call PrintVal(lu%, "DTavg", DTavg, "Average D1.BAS NAV-MTP error [sec]")
Call PrintVal(lu%, "DTrms", DTrms, "Variance of NAV-MPT error [sec]")
Call PrintVal(lu%, "ALTfujCONST", ALTfujCONST, "Offset and")
Call PrintVal(lu%, "ALTfujSLOPE", ALTfujSLOPE, "Slope of fit to Nav altitude")
Call PrintVal(lu%, "OATnavCOR", OATnavCOR, "Correction to be ADDED to Nav OAT if no MMS data [K]")
Call PrintStr(lu%, "CalSource$", CalSource$, "T-Calibration Source")
Call PrintBol(lu%, "useMMSpALT", UseMMSpALT, "IF CalSource=MMS, use MMS pALT is True")
Call PrintVal(lu%, "LAT1", LAT1, "Beginning and")
Call PrintVal(lu%, "LAT2", LAT2, "End of tropical/mid-latitude transition region [deg]")
Call PrintVal(lu%, "LAT3", LAT3, "Beginning and")
Call PrintVal(lu%, "LAT4", LAT4, "End of mid-latitude/polar transition region [deg]")
Call PrintStr(lu%, "UserLATn$", UserLATn$, "N=Default, Y=User transition regions")
Call PrintBol(lu%, "UserLATs", UserLATs, "False=Default, True=User transition regions")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[LIMITS]", "", "")
Call PrintBol(lu%, "EditTropAlt", EditTropAlt, "Limit tropopause range [km]?")
Call PrintVal(lu%, "TropAltMin", TropAltMin, "Minimum acceptable tropopause solution [km]")
Call PrintVal(lu%, "TropAltMax", TropAltMax, "Maximum acceptable tropopause solution [km]")
Call PrintVal(lu%, "TropAltPC", TropAltPC, "Percent of scans edited for this reason")
Call PrintBol(lu%, "EditRetAlt", EditRetAlt, "Limit allowed retrieved altitude [km]?")
Call PrintVal(lu%, "RetAltMin", RetAltMin, "Minimum allowed retrieved altitude [km]")
Call PrintVal(lu%, "RetAltMax", RetAltMax, "Maximum allowed retrieved altitude [km]")
Call PrintVal(lu%, "RetAltPC", RetAltPC, "Percent of scans edited for this reason")
Call PrintBol(lu%, "EditZtOff", EditZtOff, "Limit A/C offset from Trop [km]?")
Call PrintVal(lu%, "ZtOffA", ZtOffA, "Minimum (Trop-pALT) a/c is Above trop [km]")
Call PrintVal(lu%, "ZtOffB", ZtOffB, "Maximum (Trop-pALT) if a/c is Below trop [km]")
Call PrintVal(lu%, "ZtOffPC", ZtOffPC, "Percent of scans edited for this reason")
Call PrintBol(lu%, "EditTemperature", EditTemperature, "Limit allowed Temperature range [K]?")
Call PrintVal(lu%, "TemperatureMin", TemperatureMin, "Minumum allowed Temperature [K]")
Call PrintVal(lu%, "TemperatureMax", TemperatureMax, "Maximum allowed Temperature [K]")
Call PrintVal(lu%, "TemperaturePC", TemperaturePC, "Percent of scans edited for this reason")
Call PrintBol(lu%, "EditPitch", EditPitch, "Limit allowed A/C Pitch [K]?")
Call PrintVal(lu%, "ePitchMin", ePitchMin, "Minimum allowed A/C Pitch [K]")
Call PrintVal(lu%, "ePitchMax", ePitchMax, "Maximum allowed A/C Pitch [K]")
Call PrintVal(lu%, "PitchPC", PitchPC, "Percent of scans edited for this reason")
Call PrintBol(lu%, "EditRoll", EditRoll, "Limit allowed A/C Roll [K]?")
Call PrintVal(lu%, "eRollMin", eRollMin, "Minimum allowed A/C Roll [K]")
Call PrintVal(lu%, "eRollMax", eRollMax, "Maximum allowed A/C Roll [K]")
Call PrintVal(lu%, "RollPC", RollPC, "Percent of scans edited for this reason")
Call PrintVal(lu%, "RAWbadPC", RAWbadPC, "Percent of scans edited for this reason")
Call PrintVal(lu%, "NlevPC", NlevPC, "Percent of scans edited for this reason")
Call PrintStr(lu%, " ", "", "")
Call PrintStr(lu%, "[OATtrop]", "", "")
Call PrintBol(lu%, "EditOATtrop", EditOATtrop, "Use OAT tropopauses on ascent/descent/dips?")
Call PrintVal(lu%, "OATtropPC", OATtropPC, "Percent of scans with OAT tropopauses")
Call PrintVal(lu%, "OATzt10", OATzt10, "OAT tropopause 1 on ascent [km]")
Call PrintVal(lu%, "Tzt10", Tzt10, "Temperature at tropopause 1 on ascent [km]")
Call PrintVal(lu%, "OATzt20", OATzt20, "OAT tropopause 2 on ascent [km]")
Call PrintVal(lu%, "Tzt20", Tzt20, "Temperature at tropopause 2 on ascent [km]")
Call PrintVal(lu%, "OATks10", OATks10, "UT at beginning of ascent [ks]")
Call PrintVal(lu%, "OATks20", OATks20, "UT at end of ascent [ks]")
Call PrintVal(lu%, "OATzt11", OATzt11, "OAT tropopause 1 on descent [km]")
Call PrintVal(lu%, "Tzt11", Tzt11, "Temperature at tropopause 1 on descent [km]")
Call PrintVal(lu%, "OATzt21", OATzt21, "OAT tropopause 2 on descent [km]")
Call PrintVal(lu%, "Tzt21", Tzt21, "Temperature at tropopause 2 on descent [km]")
Call PrintVal(lu%, "OATks11", OATks11, "UT as beginning of descent [ks]")
Call PrintVal(lu%, "OATks21", OATks21, "UT as end of descent [ks]")
Call PrintVal(lu%, "OATzt12", OATzt12, "OAT tropopause 1 on dip1 [km]")
Call PrintVal(lu%, "Tzt12", Tzt12, "Temperature at tropopause 1 on dip1 [km]")
Call PrintVal(lu%, "OATzt22", OATzt22, "OAT tropopause 2 on dip1 [km]")
Call PrintVal(lu%, "Tzt22", Tzt22, "Temperature at tropopause 2 on dip1 [km]")
Call PrintVal(lu%, "OATks12", OATks12, "UT as beginning of dip1 [ks]")
Call PrintVal(lu%, "OATks22", OATks22, "UT as end of dip1 [ks]")
Call PrintVal(lu%, "OATzt13", OATzt13, "OAT tropopause 1 on dip2 [km]")
Call PrintVal(lu%, "Tzt13", Tzt13, "Temperature at tropopause 1 on dip2 [km]")
Call PrintVal(lu%, "OATzt23", OATzt23, "OAT tropopause 2 on dip2 [km]")
Call PrintVal(lu%, "Tzt23", Tzt23, "Temperatrue at tropopause 2 on dip2 [km]")
Call PrintVal(lu%, "OATks13", OATks13, "UT as beginning of dip2 [ks]")
Call PrintVal(lu%, "OATks23", OATks23, "UT as end of dip2 [ks]")
Call PrintStr(lu%, " ", "", "")
Call PrintStr(lu%, "[VERSION]", "", "")
Call PrintStr(lu%, "vCF$", vCF$, "CALFILE date")
Call PrintStr(lu%, "vD1$", vD1$, "D1.BAS program version")
Call PrintStr(lu%, "vD2$", vD2$, "D2.BAS program version")
Call PrintStr(lu%, "vMP$", vMP$, "RET_MP.BAS program version")
Call PrintStr(lu%, " ", "", "")
Call PrintStr(lu%, "[HISTORY]", "", "")
Call PrintDate(lu%, "Tstamp", Tstamp, "Time tag for FLTINFO")
Call PrintDate(lu%, "RAWstamp", RAWstamp, "Time tag for writing RAW file")
Call PrintDate(lu%, "REFstamp", REFstamp, "Time tag for retrieval to REF file")
Call PrintDate(lu%, "ERFstamp", ERFstamp, "Time tag for editing REF file to ERF file")
Call PrintDate(lu%, "CTCstamp", CTCstamp, "Time tag for plotting CTC")
Call PrintStr(lu%, " ", "", "")
Close (lu%)
End Sub
Sub PrintDate
Sub PrintDate(lu%, x1$, X As Date, x2$)
Dim fmt$, L%
If X = 0 Then
If lu% = 0 Then Debug.Print x1$ Else Print #lu%, x1$
Else
fmt$ = x1$ + "=" + Format$(X, "yyyy mm dd hh:mm:ss")
L% = 30 - Len(fmt$)
If L% < 0 Then L% = 0
fmt$ = fmt$ + Space$(L%) + "'" + x2$
If lu% = 0 Then Debug.Print fmt$ Else Print #lu%, fmt$
End If
End Sub
Sub PrintStr
Sub PrintStr(lu%, x1$, X$, x2$)
' Print to lu%, x1$=x$ 'x2$
' eg PgmDrive$=c: 'Program Drive
Dim fmt$, L%
If X$ = "" Then
If lu% = 0 Then Debug.Print x1$ Else Print #lu%, x1$
Else
fmt$ = x1$ + "=" + X$
L% = 30 - Len(fmt$)
If L% < 0 Then L% = 0
fmt$ = fmt$ + Space$(L%) + "'" + x2$
If lu% = 0 Then Debug.Print fmt$ Else Print #lu%, fmt$
End If
End Sub
Sub PrintVal
Sub PrintVal(lu%, x1$, X, x2$)
Dim fmt$, xx$, L%
x1$ = x1$ + "="
X = Int(1000 * X) / 1000
xx$ = Str$(X)
Select Case X
Case Is < -1
Case Is < 0: xx$ = "-0" + Right$(X, Len(xx$) - 1)
Case Is = 0: xx$ = "+0"
Case Is < 1: xx$ = "+0" + Right$(X, Len(xx$) - 1)
Case Else: xx$ = "+" + Right$(X, Len(xx$) - 1)
End Select
fmt$ = x1$ + xx$
L% = 30 - Len(fmt$)
fmt$ = fmt$ + Space$(L%) + "'" + x2$
If lu% = 0 Then Debug.Print fmt$ Else Print #lu%, fmt$
End Sub
Sub PrintBol
Sub PrintBol(lu%, x1$, X As Boolean, x2$)
Dim fmt$, L%
If X Then
fmt$ = x1$ + "=" + "True"
Else
fmt$ = x1$ + "=" + "False"
End If
L% = 30 - Len(fmt$)
fmt$ = fmt$ + Space$(L%) + "'" + x2$
If lu% = 0 Then Debug.Print fmt$ Else Print #lu%, fmt$
End Sub
Sub WriteFLTINFOtoRegistry
Sub WriteFLTINFOtoRegistry()
App.Title = "FLTINFO"
SaveSetting App.Title, "PATH", "Mission", Mission$
SaveSetting App.Title, "PATH", "FlightDate", yyyymmdd$
SaveSetting App.Title, "PATH", "Platform", Mid$(Rdir$, 2, Len(Rdir$) - 1)
SaveSetting App.Title, "PATH", "DefaultDataDrive", Drive$
SaveSetting App.Title, "PATH", "DefaultProgramPath", Pgm$
SaveSetting App.Title, "PATH", "DefaultDataPath", Drive$ + Rdir2$ + Mission$ + "\yyyyddmm\"
SaveSetting App.Title, "PATH", "TotalCycles", TotalCycles
End Sub
Sub UpdateFltDates
Sub UpdateFltDates(f As Form)
Dim lu%, A$, FltDateFile$, FltDate&, FlightNo&, i%, LI%, n%, M%, FlightDate$
Dim FltDateFileOld$
With f
.cboFltDates.Clear
.cboFltNos.Clear
.cboObjectives.Clear
FltDateFile$ = fSetupFileName("NUM")
lu = FreeFile
Open FltDateFile$ For Input As lu
i = -1
Do: Line Input #lu, A$ 'FlightNo, FlightDate, Objective$
A$ = LTrim(A$)
n = InStr(1, A$, " ")
FlightNo = Val(Left$(A$, n))
A$ = Trim(Right$(A$, Len(A$) - n + 1))
n = InStr(1, A$, " ")
If n = 0 Then
FlightDate = Val(A$)
Objective$ = "Unknown"
Else
FlightDate = Val(Left$(A$, n))
Objective$ = Trim(Mid$(A$, n, Len(A$) - n + 1))
End If
.cboFltDates.AddItem Str(FlightDate)
.cboFltNos.AddItem Format(FlightNo, "000000")
.cboObjectives.AddItem Objective$
i = i + 1
If yyyymmdd$ = Trim(Str(FlightDate)) Then LI = i
Loop Until EOF(lu)
.cboFltDates.ListIndex = LI
.cboFltNos.ListIndex = LI
.cboObjectives.ListIndex = LI
End With
Close lu
End Sub
Function fSetupFileName
Function fSetupFileName(Ext$) As String
' Ext$ is extension without a dot
' If new setup filename doesn't exist, check for the old name
Dim FileOld$, File$
FileOld$ = DataDrive$ + "\MTP\Data\" + frmFLTINFO.cboPlatforms.Text + "\" + frmFLTINFO.cboMissions.Text _
+ "\" + frmFLTINFO.cboMissions.Text + "." + Ext$
File$ = DataDrive$ + "\MTP\Data\" + frmFLTINFO.cboPlatforms.Text + "\" + _
frmFLTINFO.cboMissions.Text + "\Setup\" + frmFLTINFO.cboMissions.Text + "_" + Ext$ + ".txt"
' See if Mission_Ext.txt file exists. If not, check to see if Mission.Ext file exists.
If Len(Dir(File$)) = 0 Then
' Check if original Mission.Ext file exits
If Len(Dir(FileOld$)) = 0 Then
MsgBox "Neither" + File$ + " or " + vbCrLf + FileOld$ + " exist!", vbOKOnly
Exit Function
Else
File$ = FileOld$
End If
End If
fSetupFileName = File$
End Function
Format.bas
Sub Parse
Sub Parse(ByRef StrgIn$, ByRef Par$, ByRef s$(), ByRef n%)
'*************************************************************************
' MAY 1993, R. F. Denning
' PARSES THE INPUT STRGIN$ INTO N SUBSTRINGS(S$()), CONTAINING CONSECUTIVE
' CHARS BOUNDED BY ANY DELIMITING CHARS FROM PAR$. CONSECUTIVE DELIMITERS
' (FOR EXAMPLE TWO SPACES IN A ROW) ARE TREATED AS ONE, EXCEPT THAT ADJACENT
' COMMAS ARE DETECTED AND WILL PRODUCE NULL STRINGS. COMMAS FOLLOWING OTHER
' DELIMITERS ARE SKIPPED.
'
' AN EXAMPLE MIGHT BE:
' STRGIN$ = "A 12345%54321, 66666,,, 93/05/10,09:11:32 RANDOM TEXT"
' PAR$="% /,:" 'I.E. PERCENT, SPACE, SLASH, COMMA, COLON (IN ANY ORDER)
' PARSE STRGIN$, PAR$, S$(), N
' FOR I=1 TO N
' PRINT S$(I)
' NEXT I
'
' THIS WILL PRODUCE THE FOLLOWING OUTPUT:
' A
' 12345
' 54321
' 66666
' [NULL$]
' [NULL$]
' 93
' 05
' 10
' 09
' 11
' 32
' RANDOM
' TEXT
'
' RETURNING WITH N=0 MEANS NO SUBSTRINGS COULD BE FOUND. N=1 means strgin$ was
' all one string without delimiters.
' strgin$, par$ are not modified, s$() is cleared on entry.
'
'*************************************************************************
Dim Delim%, CharsFound%, C$, LastC$, i%
For i = 0 To 40: s$(i) = "": Next 'CLEAR OUT OLD MATRIX
n = 1
Delim = 1
CharsFound = 0
For i = 1 To Len(StrgIn$)
C$ = Mid$(StrgIn$, i, 1)
If InStr(Par$, C$) > 0 Then 'Is this character a delimiter?
If (C$ = ",") And (LastC$ = ",") Then Delim = 0: n = n + 1 'Yes
Delim = 1
LastC$ = C$
n = n + 1
Else 'No
Delim = 0
s$(n) = s$(n) + C$ 'Add character to S$
CharsFound = CharsFound + 1
End If
Next i
If CharsFound = 0 Then n = 0
' TEST CODE:
'StrgIn$ = "Now:Is%The/Time,( 00:00:00, 5/29/1993 ), For All Good Men To Come To The Aid Of Their Country"
'par$ = "% /,:()"'I.E. SPACE,SLASH, COMMA, COLON, PARENS (IN ANY ORDER)
'parse strgin$, par$, s$(), n
'CLS
'PRINT "Input String:"
'PRINT strgin$
'FOR i = 1 TO n
'PRINT s$(i),
'NEXT i
'PRINT
'PRINT
'PRINT "Parsing TIME$, DATE$:"
'PRINT "Hours, Minutes Seconds now:"
'parse TIME$, ":", s$(), n
'FOR i = 1 TO n: PRINT USING "####.# "; VAL(s$(i)); : NEXT i: PRINT
'PRINT "Month, Date, Year now:"
'parse DATE$, "-", s$(), n
'FOR i = 1 TO n: PRINT USING "####.# "; VAL(s$(i)); : NEXT i: PRINT
'PRINT "Parsing DATE$+TIME$"
'parse DATE$ + "/" + TIME$, ":-/", s$(), n
'FOR i = 1 TO n: PRINT USING "####.# "; VAL(s$(i)); : NEXT i: PRINT
End Sub
Sub CopyFolder
Sub CopyFolder(FromPath$, ToPath$)
Dim Filename$
If Len(Dir(FromPath$, vbDirectory)) = 0 Then
MsgBox FromPath$ + " does not exist!", vbOKOnly
Exit Sub
End If
' Make sure ToPath exist
CreateDirectoryTree ToPath$, False
Filename = Dir(FromPath) ' Retrieve the first entry.
Do While Filename <> "" ' Start the loop.
FileCopy FromPath$ + Filename, ToPath$ + Filename
Filename = Dir
Loop
End Sub
Sub DirCheck
Sub DirCheck(DirPath$, Folder$)
Dim ans As Variant
If Not fDirExists(DirPath$, Folder$) Then
ans = MsgBox("Path: " + DirPath$ + Folder$ + "\" + " does not exist!" + vbLf + vbCrLf + "Do you wish to create it?", vbYesNo)
If ans = vbYes Then
CreateDirectoryTree DirPath$ + Folder$, False
Else
Exit Sub
End If
End If
End Sub
Function fGetPathToDot
Function fGetPathToDot(ByVal File$) As String
Dim L%, Char$
' Get filename up to last ., excluding it
L = Len(File$)
Do
Char$ = Mid$(File$, L, 1)
If Char$ = "." Then Exit Do
L = L - 1
Loop Until L = 0
If L > 0 Then
fGetPathToDot = Left$(File$, L - 1)
Else
fGetPathToDot = ""
End If
End Function
Sub FindDifference
Sub FindDifference(A$, b$, C$, i%)
Dim nA%, nb%, nC%
If b$ = "" Then b$ = A$ 'Handle first pass
Select Case i
Case 1
'AD106:22:32:55 +34.480 -136.900 013 +00.0 +00.0 01100 01100 +17.1 0110 0270 +180.0 1 000 041129 223255
C$ = b$
Case 2, 3
'B 07317 06788 06536 07334 06805 06559 07320 06788 06545 07323 06787 06538 07316 06767 06528
'C 07318 06774 06531 07318 06775 06541 07323 06773 06541 07315 06777 06520 07306 06766 06523
' 123456123456
If i = 2 Then C$ = "B" Else C$ = "C"
For i = 1 To 15
nA = Val(Mid$(A$, (i - 1) * 6 + 2, 6))
nb = Val(Mid$(b$, (i - 1) * 6 + 2, 6))
nC = nA - nb
C$ = C$ + fInteger(nC, 6)
Next i
Case 4
' Tnd Tamp Tsyn Tmix Ttgt1 Ttgt2 Acc+ Twin Tmot Spare Vref Tdat1 Tdat2 Vcc/2 15V/n Tplate Acc-
'd +40.58 +46.92 +32.80 +41.23 +26.24 +26.58 +01.02 +07.19 +36.48 +01.96 +02.04 +34.33 +40.81 +02.48 +01.90 +41.67 +01.02
' 12345671234567
C$ = "D"
For i = 1 To 17
nA = Val(Mid$(A$, (i - 1) * 7 + 2, 6))
nb = Val(Mid$(b$, (i - 1) * 7 + 2, 6))
nC = nA - nb
If nC < 0 Then
C$ = C$ + " " + Format(nC, "-00.00")
Else
C$ = C$ + " " + Format(nC, "+00.00")
End If
Next i
Case 6
'E 13825 12345 09650 07339 06812 06567
C$ = "E"
For i = 1 To 6
nA = Val(Mid$(A$, (i - 1) * 6 + 2, 6))
nb = Val(Mid$(b$, (i - 1) * 6 + 2, 6))
nC = nA - nb
C$ = C$ + fInteger(nC, 6)
Next i
End Select
End Sub
Function fInteger$
Function fInteger$(n%, Count%)
Dim AbsN$, StrN$, Nspace%
AbsN$ = Trim(Abs(n))
StrN$ = Trim(Str(AbsN))
Nspace = Count - Len(AbsN)
If n < 0 Then
fInteger$ = Space(Nspace - 1) + "-" + StrN$
Else
fInteger$ = Space(Nspace - 1) + "+" + StrN$
End If
End Function
Function fDirExists
Function fDirExists(DirPath$, SearchName$) As Boolean
Dim DirName$
DirName = Dir(DirPath, vbDirectory) ' Retrieve the first entry.
Do While DirName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If DirName = SearchName$ Then
fDirExists = True
Exit Function ' SearchName$ already exists
End If
DirName = Dir ' Get next entry.
Loop
fDirExists = False ' Failed to find SearchName$
End Function
Function fAC
Function fAC(ByVal AC$) As String
' Get default mission directory name for a given platform
Select Case AC$
Case "DC": fAC = AC$ + "8"
Case "ER": fAC = AC$ + "2"
Case "WB": fAC = AC$ + "57"
Case "EL": fAC = AC$ + "EC"
Case "M5": fAC = AC$ + "5"
Case "NG": fAC = AC$ + "V"
End Select
End Function
Function fDate
Function fDate(ByVal yyyymmdd$) As Date
' Convert yyyymmdd$ to a Date data type
fDate = DateValue(Mid$(yyyymmdd$, 5, 2) + "/" + Right$(yyyymmdd$, 2) + "/" + Left$(yyyymmdd$, 4))
End Function
Function fDelimiterCharacter
Function fDelimiterCharacter(ByVal Char$) As Boolean
' Set TRUE is Char is Tab, Carriage Return, Linefeed, Comma, Space or Colon
Select Case Char$
Case vbTab, vbCr, vbLf, ",", " ", ":": fDelimiterCharacter = True
Case Else: fDelimiterCharacter = False
End Select
End Function
Function fIsNumber
Function fIsNumber(ByVal X$) As Boolean
' Check if x$ contains only 0-9, +, - or .
' +=43 -=45 .=46 0=48 9=57
Dim i%, n%
For i = 1 To Len(X$)
n = Asc(Mid$(X$, i, 1))
If n < 43 Or n > 57 Or n = 44 Or n = 47 Then '0 thru 9
fIsNumber = False
Exit Function
End If
Next i
fIsNumber = True
End Function
Function fMMMtoNUM
Function fMMMtoNUM(MMM$)
' Convert 3-letter month to number
Select Case MMM$
Case "JAN": fMMMtoNUM = 1
Case "FEB": fMMMtoNUM = 2
Case "MAR": fMMMtoNUM = 3
Case "APR": fMMMtoNUM = 4
Case "MAY": fMMMtoNUM = 5
Case "JUN": fMMMtoNUM = 6
Case "JUL": fMMMtoNUM = 7
Case "AUG": fMMMtoNUM = 8
Case "SEP": fMMMtoNUM = 9
Case "OCT": fMMMtoNUM = 10
Case "NOV": fMMMtoNUM = 11
Case "DEC": fMMMtoNUM = 12
End Select
End Function
Function formats
Function formats(ByVal X!, ByVal f$) As String
' Format a number x using the format f$ so that
' negative numbers have minus sign (they would anyway) and
' positive numbers and zero have a plus sign
If X < 0 Then
formats = "-" + Format(Abs(X), f$)
Else
formats = "+" + Format(X, f$)
End If
End Function
Sub CenterChildForm
Sub CenterChildForm(ParentForm As Form, ChildForm As Form)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Name : CenterChildForm
' Purpose : Used for centering one form on another form
' Parameters : the Parent form and the form you would like to center
' Return val : NA
' Algorithm : moves the form to center of screen after calculating position
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim iLeft As Integer
Dim iTop As Integer
iLeft = ParentForm.Left + (ParentForm.Width - ChildForm.Width) / 2
iTop = ParentForm.Top + (ParentForm.Height - ChildForm.Height) / 2
If (iLeft < 0) Then iLeft = 0
If (iTop < 0) Then iTop = 0
ChildForm.Move iLeft, iTop
End Sub
Function fACext
Function fACext(ByVal AC$) As String
' Get default filename extension for a specified platform
fACext = "." + fAC(AC$)
If Mission$ = "TexAQS" Then fACext = ".ELEC" 'DC8 instrument was on NCAR Electra
End Function
Function fExtension
Function fExtension(ByVal File$) As String
Dim i%, j%
' Get File$ extension without "."
fExtension = ""
j = Len(File$)
i = j
Do
i = i - 1
If Mid$(File$, i, 1) = "." Then
fExtension = Right$(File$, j - i)
Exit Function
End If
Loop
End Function
Function fDegToDMS
Function fDegToDMS(ByVal Deg!) As String
Dim D%, M%, s%, A!, pm%
' Convert decimal degrees to SDDD AM AS
pm = Sgn(Deg)
A = Abs(Deg)
D = Int(A)
s = Int((A - D) * 3600 + 0.5)
M = Int(s / 60)
s = Int(s - 60 * M)
fDegToDMS$ = Format$(pm * D, "####") + Format$(M, " 00") + Format$(s, " 00")
End Function
Function fDeSpace
Function fDeSpace(ByVal X$) As String
' Get rid of trailing spaces
If Asc(Left$(X$, 1)) <> 0 Then
If InStr(1, X$, " ", 1) > 0 Then
fDeSpace$ = Left$(X$, InStr(1, X$, " ", 1) - 1)
End If
Else
fDeSpace$ = ""
End If
End Function
Function fGetPath
Function fGetPath(ByVal File$) As String
' Get path to last "/" or "\"
Dim i%, j%
fGetPath = ""
j = Len(File$)
i = j + 1
Do
i = i - 1
If Mid$(File$, i, 1) = "\" Or Mid$(File$, i, 1) = "/" Then
fGetPath = Left$(File$, i)
Exit Function
End If
Loop Until i = 1
End Function
Function fGetFilename
Function fGetFilename(ByVal File$) As String
' Get Filename from last "/" or "\"
Dim i%, j%
fGetFilename = ""
j = Len(File$)
i = j
Do
i = i - 1
If Mid$(File$, i, 1) = "\" Or Mid$(File$, i, 1) = "/" Then
fGetFilename = Mid$(File$, i + 1, Len(File$))
Exit Function
End If
Loop Until i = 1
End Function
Function fRemoveCharacter
Function fRemoveCharacter(ByVal A$, ByVal character$) As String
Dim i%, b$, C$, Length%, Out$, LastCharacter$
' Remove the character in character$ from A$
Length = Len(A$)
Out$ = ""
LastCharacter = ""
For i = 1 To Length
b$ = Mid$(A$, i, 1)
If b$ <> character$ Then Out$ = Out$ + b$
Next i
fRemoveCharacter = Out$
End Function
Function fRemoveRepeatCharacters
Function fRemoveRepeatCharacters(ByVal A$, ByVal character$) As String
Dim i%, b$, C$, Length%, Out$, LastCharacter$
' Remove any multiple occurances of character$ from A$
Length = Len(A$)
Out$ = ""
LastCharacter = ""
For i = 1 To Length
b$ = Mid$(A$, i, 1)
If b$ = character$ Then
If b$ <> LastCharacter Then Out$ = Out$ + b$
Else
Out$ = Out$ + b$
End If
LastCharacter = b$
Next i
fRemoveRepeatCharacters = Out$
End Function
Function fReplaceExtension
Function fReplaceExtension(ByVal File$, ByVal Ext$) As String
' Replace extension on File$ with Ext$, do not include "."
Dim i%, j%
fReplaceExtension = ""
j = Len(File$)
i = j
Do
i = i - 1
If Mid$(File$, i, 1) = "." Then
fReplaceExtension = Left$(File$, i) + Ext$
Exit Function
End If
Loop Until i = 1
End Function
Function fTstamp
Function fTstamp() As String
' Generate time stamp in format: yyyymmdd_hhmmss
Dim ymd$, hms$
ymd$ = Right$(Date$, 4) + Left$(Date$, 2) + Mid$(Date$, 4, 2)
hms$ = Time$
hms$ = Left$(hms$, 2) + Mid$(hms$, 4, 2) + Right$(hms$, 2)
fTstamp = ymd$ + "_" + hms$
End Function
Function fFullFileName
Function fFullFileName(ByVal Prefix$) As String
' Assumes Drive$, Rdir$, Mission$, AC$, yyyymmdd$ are known
' Generates: "C:\M55\EUPLEX\20030211\TD\TD20030211.M55" type filename
' where Prefix$="TD"
Dim Extension$
fFullFileName = Drive$ + Rdir2$ + Mission$ + "\" + Prefix$ + "\" + Prefix$ + yyyymmdd$ + fACext(AC$)
End Function
Function fUsing2
Function fUsing2(ByVal fmt$, ByRef V!()) As String
Dim L%, M%, i%, j%, k%, f$, Out$, n$
M% = 1
L% = Len(fmt$)
i% = InStr(1, fmt$, "#", 1) ' find first field start =#
Out$ = Space(i% - 1) ' save leading spaces before # if any
Do
j% = InStr(i%, fmt$, ",", 1) 'find next field location (delimited by comma)
If j% = 0 Then j% = L% + 1 'none if end of fmt$
k% = j% - i% 'number of character in current field
f$ = Mid$(fmt$, i%, k%)
n$ = Format$(V(M%), f$) 'format number
M% = M% + 1
Out$ = Out$ + Space(k% - Len(n$)) + "," + n$ ' add spaces so field has correct length
i% = InStr(j%, fmt$, "#", 1) 'Get next field
If i% <> 0 Then Out$ = Out$ + Space(i% - j%)
Loop Until i% = 0
fUsing2$ = Out$
End Function
Function fUsingN
Function fUsingN(ByVal fmt$, ByVal X!, ByVal n%) As String
Dim A$
' Format x using fmt$ and add leading spaces to make total length n
A$ = Format(X!, fmt$)
If Len(A$) < n% Then A$ = Space(n - Len(A$)) + A$
fUsingN = A$
End Function
Function fYMDtoDOY
Function fYMDtoDOY(ByVal Year%, ByVal Month%, ByVal Day%) As Integer
' Given year, month, and day, returns the day of the year (DOY).
Day = Day + (Month - 1) * 30# + Int((Month + 1) * 0.61) - 2
If (Month <= 2) Then
Day = Day + Month
Else
If (Not fLeap_Year(Year)) Then Day = Day - 1
End If
fYMDtoDOY = Day
End Function
Function fYYYYMMDDtoDOY
Function fYYYYMMDDtoDOY(ByVal yyyymmdd$) As Integer
Dim Year%, Month%, Day%
' Convert yyyymmdd$ to DOY
Year = Left$(yyyymmdd$, 4)
Month = Mid$(yyyymmdd$, 5, 2)
Day = Right$(yyyymmdd$, 2)
fYYYYMMDDtoDOY = fYMDtoDOY(Year, Month, Day)
End Function
Function fLeap_Year
Function fLeap_Year(ByVal Year%) As Boolean
' This routine returns TRUE if the year is a leap year.
' Otherwise FALSE is returned.
If (Year Mod 4 = 0 And Year Mod 100 <> 0) Or (Year Mod 400 = 0) Then
fLeap_Year = True
Else
fLeap_Year = False
End If
End Function
Sub ListBoxRemoveItem
Sub ListBoxRemoveItem(L As ListBox, Remove As Boolean)
' Generic routine to remove items from a list box and select next item
Dim i%
Select Case L.SelCount
Case Is < 1 'Empty list
Case 1 'Remove single item
i = L.ListIndex
L.RemoveItem (L.ListIndex)
If i >= 0 And i < L.ListCount - 1 Then
L.Selected(i) = True
Else
If L.ListCount > 0 Then L.Selected(L.ListCount - 1) = True
End If
Case Is > 1 'Keep or Remove multiple items
i = -1
If Remove Then
Do
i = i + 1
If L.Selected(i) Then L.RemoveItem (i): i = i - 1
Loop Until i = L.ListCount - 1
Else
Do
i = i + 1
If Not L.Selected(i) Then L.RemoveItem (i): i = i - 1
Loop Until i = L.ListCount - 1
End If
End Select
End Sub
Sub ParseString
Sub ParseString(ByVal A$, ByRef n%, ByRef b$())
Dim i%, j%, L%, C$, iStart%
' Fill array B$ with n% delimited strings (Tab, CR, LF, " ", ":") in A$
L% = Len(A$)
i% = 0
n% = 0
Do While i <= L
i% = i% + 1
j% = i% - 1
Do
j% = j% + 1
C$ = Mid$(A$, j, 1)
Loop Until fDelimiterCharacter(C$) Or j = L
If j = L Then Exit Sub
C$ = Mid$(A$, i, j - i)
If j > i And IsNumeric(C$) Then
n = n + 1
b$(n) = C$
End If
i = j
Loop
End Sub
Sub ParseString2
Sub ParseString2(ByVal A$, ByVal Delim$, ByRef b$(), ByRef n%)
Dim i%, j%, L%, C$, iStart%
' Fill array B$ with n% delimited numberic only strings, Delim$ in A$
L% = Len(A$)
i% = 0
n% = 0
Do While i < L
i% = i% + 1
j% = i% - 1
Do
j% = j% + 1
C$ = Mid$(A$, j, 1)
Loop Until fDelimiterCharacter2(C$, Delim$) Or j = L
' If j=L need to add last character, which is normally a delimiter
If j = L Then
C$ = Mid$(A$, i, j - i + 1)
Else
C$ = Mid$(A$, i, j - i)
End If
' Only save numeric strings
If j > i And IsNumeric(C$) Then
n = n + 1
b$(n) = C$
End If
i = j
Loop
End Sub
Sub RgbToHsv
Sub RgbToHsv(ByVal r%, ByVal g%, ByVal b%, ByRef H%, ByRef s%, ByRef V%)
' Convert RGB to HSV values
Dim vRed!, vGreen!, vBlue!
Dim Mx!, Mn!, Va!, Sa!, rc!, gc!, bc!
vRed = r / 255
vGreen = g / 255
vBlue = b / 255
Mx = vRed
If vGreen > Mx Then Mx = vGreen
If vBlue > Mx Then Mx = vBlue
Mn = vRed
If vGreen < Mn Then Mn = vGreen
If vBlue < Mn Then Mn = vBlue
Va = Mx
If Mx Then
Sa = (Mx - Mn) / Mx
Else
Sa = 0
End If
If Sa = 0 Then
H = 0
Else
rc = (Mx - vRed) / (Mx - Mn)
gc = (Mx - vGreen) / (Mx - Mn)
bc = (Mx - vBlue) / (Mx - Mn)
Select Case Mx
Case vRed: H = bc - gc
Case vGreen: H = 2 + rc - bc
Case vBlue: H = 4 + gc - rc
End Select
H = H * 60
If H < 0 Then H = H + 360
End If
s = Sa * 100
V = Va * 100
End Sub
Function fSecToTstring
Function fSecToTstring(hms&, ColonFlag As Boolean) As String
Dim hr!, Min!, sec!, D&, T$, C$
' Convert time in seconds to HHMMSS string with colon if colon.flag% is TRUE
hr = Int(hms / 3600)
Min = Int((hms - 3600 * hr) / 60)
sec = Int(hms - 3600 * hr - 60 * Min + 0.5)
If sec = 60 Then sec = 0: Min = Min + 1
If Min = 60 Then Min = 0: hr = hr + 1
If ColonFlag Then C$ = ":" Else C$ = ""
D = 1000000 + 10000 * hr + 100 * Min + sec 'Avoid loosing leading zeros!
T$ = Str$(D): T$ = Right$(T$, 6)
fSecToTstring$ = Left$(T$, 2) + C$ + Mid$(T$, 3, 2) + C$ + Right$(T$, 2)
End Function
Function fUsing
Function fUsing(ByVal fmt$, ByRef V!()) As String
Dim L%, M%, i%, j%, k%, f$, Out$, n$
' Generate a string using the format in fmt$ and the order parameters in V()
M% = 1
L% = Len(fmt$)
i% = InStr(1, fmt$, "#", 1) ' find first field start =#
Out$ = Space(i% - 1) ' save leading spaces before # if any
Do
j% = InStr(i%, fmt$, " ", 1) 'find next field location (delimited by space)
If j% = 0 Then j% = L% + 1 'none if end of fmt$
k% = j% - i% 'number of character in current field
f$ = Mid$(fmt$, i%, k%)
n$ = Format$(V(M%), f$) 'format number
M% = M% + 1
If k - Len(n$) >= 0 Then
Out$ = Out$ + Space(k% - Len(n$)) + n$ ' add spaces so field has correct length
End If
i% = InStr(j%, fmt$, "#", 1) 'Get next field
If i% <> 0 Then Out$ = Out$ + Space(i% - j%)
Loop Until i% = 0
fUsing$ = Out$
End Function
Function fNumeric
Function fNumeric(ByVal X$) As Boolean
Dim i%, n%
' Checks if x$ is an unsigned integer number
For i = 1 To Len(X$)
n = Asc(Mid$(X$, i, 1))
If n < 48 Or n > 57 Then '0 thru 9
fNumeric = False
Exit Function
End If
Next i
fNumeric = True
End Function
Function fTstringToSec
Function fTstringToSec(ByVal T$, ByVal ColonFlag As Boolean) As Long
Dim i%, hr%, Min%, sec%
'Convert a time string (T$) to seconds
'If Colon_Flag is TRUE, T$ format is assumed to be hh:mm:ss; otherwise, hhmmss
If ColonFlag Then i% = 3 Else i% = 2
hr = Val(Mid$(T$, 1, 2))
Min = Val(Mid$(T$, 1 + i%, 2))
sec = Val(Mid$(T$, 1 + 2 * i%, 2))
fTstringToSec& = 3600# * hr + 60# * Min + sec
End Function
Sub SameFormat
Sub SameFormat(ByVal OUTlu%, ByVal fmt$, ByVal Repeat%, ByRef Value!(), ByVal n%)
Dim L%, i%, X$, V!(1 To 20), j%
' Write n% values in Value!() to OUTlu% Repeat%/line using the format fmt$ for each value
j = n% Mod Repeat%
For L = 1 To n% - j Step Repeat%
X$ = ""
For i = 1 To Repeat%
X$ = X$ + fmt$
V(i) = Value(L + i - 1)
'Debug.Print L; i; v(i)
Next i
Print #OUTlu, fUsing(X$, V())
Next L
' Write leftovers
If j > 0 Then
X$ = ""
For i = 1 To j
X$ = X$ + fmt$
V(i) = Value(n% - j + i)
Next i
Print #OUTlu, fUsing(X$, V())
End If
End Sub
Sub SameFormat2
Sub SameFormat2(LB As ListBox, ByVal fmt$, ByVal Repeat%, ByRef Value!(), ByVal n%)
Dim L%, i%, X$, V!(1 To 20), j%
' Write n% values in Value!() to OUTlu% Repeat%/line using the format fmt$ for each value
j = n% Mod Repeat%
For L = 1 To n% - j Step Repeat%
X$ = ""
For i = 1 To Repeat%
X$ = X$ + fmt$
V(i) = Value(L + i - 1)
'Debug.Print L; i; v(i)
Next i
LB.AddItem fUsing(X$, V())
Next L
' Write leftovers
If j > 0 Then
X$ = ""
For i = 1 To j
X$ = X$ + fmt$
V(i) = Value(n% - j + i)
Next i
LB.AddItem fUsing(X$, V())
End If
End Sub
Sub HsvToRgb
Sub HsvToRgb(ByVal H%, ByVal s%, ByVal V%, ByRef r%, ByRef g%, ByRef b%)
' Convert HSV to RGB values
Dim Sa!, Va!, Hue!, i%, f!, P!, q!, T!
Sa = s / 100
Va = V / 100
If s = 0 Then
r = Va
g = Va
b = Va
Else
Hue = H / 60
If Hue = 6 Then Hue = 0
i = Int(Hue)
f = Hue - i
P = Va * (1 - Sa)
q = Va * (1 - (Sa * f))
T = Va * (1 - (Sa * (1 - f)))
Select Case i
Case 0
r = Va
g = T
b = P
Case 1
r = q
g = Va
b = P
Case 2
r = P
g = Va
b = T
Case 3
r = P
g = q
b = Va
Case 4
r = T
g = P
b = Va
Case 5
r = Va
g = P
b = q
End Select
End If
r = Int(255.9999 * r)
g = Int(255.9999 * g)
b = Int(255.9999 * b)
End Sub
Function fDOYtoYMD
Function fDOYtoYMD(Iyear%, Doy%) As String
' SUBROUTINE W3FS26(JLDAYN, Iyear, Month, Iday, IDAYWK, IDAYYR)
'C$$$ SUBPROGRAM DOCUMENTATION BLOCK
'c
'C SUBPROGRAM: W3FS26 YEAR, MONTH, DAY FROM JULIAN DAY NUMBER
'C AUTHOR: JONES,R.E. ORG: W342 DATE: 87-03-29
'c
'C ABSTRACT: COMPUTES YEAR (4 DIGITS), MONTH, DAY, DAY OF WEEK, DAY
'C OF YEAR FROM JULIAN DAY NUMBER. THIS SUBROUTINE WILL WORK
'C FROM 1583 A.D. TO 3300 A.D.
'c
'C PROGRAM HISTORY LOG:
'C 87-03-29 R.E.JONES
'C 88-07-06 R.E.JONES CHANGE TO MICROSOFT FORTRAN 4.10
'C 90-06-11 R.E.JONES CHANGE TO SUN FORTRAN 1.3
'C 91-03-29 R.E.JONES CONVERT TO SiliconGraphics FORTRAN
'c
'c USAGE: Call W3FS26(JLDAYN, Iyear, Month, Iday, IDAYWK, IDAYYR)
'c
'C INPUT VARIABLES:
'C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES
'C ------ --------- -----------------------------------------------
'C JLDAYN ARG LIST INTEGER*4 JULIAN DAY NUMBER
'c
'C OUTPUT VARIABLES:
'C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES
'C ------ --------- -----------------------------------------------
'C IYEAR ARG LIST INTEGER*4 YEAR (4 DIGITS)
'C MONTH ARG LIST INTEGER*4 MONTH
'C IDAY ARG LIST INTEGER*4 DAY
'C IDAYWK ARG LIST INTEGER*4 DAY OF WEEK (1 IS SUNDAY, 7 IS SAT)
'C IDAYYR ARG LIST INTEGER*4 DAY OF YEAR (1 TO 366)
'c
'C REMARKS: A JULIAN DAY NUMBER CAN BE COMPUTED BY USING ONE OF THE
'C FOLLOWING STATEMENT FUNCTIONS. A DAY OF WEEK CAN BE COMPUTED
'C FROM THE JULIAN DAY NUMBER. A DAY OF YEAR CAN BE COMPUTED FROM
'C A JULIAN DAY NUMBER AND YEAR.
'c
'C IYEAR (4 DIGITS)
'c
'c JDN(Iyear, Month, Iday) = Iday - 32075
'c X + 1461 * (Iyear + 4800 + (Month - 14) / 12) / 4
'c y + 367 * (Month - 2 - (Month - 14) / 12 * 12) / 12
'c z - 3 * ((Iyear + 4900 + (Month - 14) / 12) / 100) / 4
'c
'C IYR (4 DIGITS) , IDYR(1-366) DAY OF YEAR
'c
'c JULIAN(IYR, IDYR) = -31739 + 1461 * (IYR + 4799) / 4
'c X - 3 * ((IYR + 4899) / 100) / 4 + IDYR
'c
'C DAY OF WEEK FROM JULIAN DAY NUMBER, 1 IS SUNDAY, 7 IS SATURDAY.
'c
'C JDAYWK(JLDAYN) = MOD((JLDAYN + 1),7) + 1
'c
'C DAY OF YEAR FROM JULIAN DAY NUMBER AND 4 DIGIT YEAR.
'c
'C JDAYYR(JLDAYN,IYEAR) = JLDAYN -
'c X(-31739 + 1461 * (Iyear + 4799) / 4 - 3 * ((Iyear + 4899) / 100) / 4)
'c
'C THE FIRST FUNCTION WAS IN A LETTER TO THE EDITOR COMMUNICATIONS
'C OF THE ACM VOLUME 11 / NUMBER 10 / OCTOBER, 1968. THE 2ND
'C FUNCTION WAS DERIVED FROM THE FIRST. THIS SUBROUTINE WAS ALSO
'C INCLUDED IN THE SAME LETTER. JULIAN DAY NUMBER 1 IS
'C JAN 1,4713 B.C. A JULIAN DAY NUMBER CAN BE USED TO REPLACE A
'C DAY OF CENTURY, THIS WILL TAKE CARE OF THE DATE PROBLEM IN
'C THE YEAR 2000, OR REDUCE PROGRAM CHANGES TO ONE LINE CHANGE
'C OF 1900 TO 2000. JULIAN DAY NUMBERS CAN BE USED FOR FINDING
'C RECORD NUMBERS IN AN ARCHIVE OR DAY OF WEEK, OR DAY OF YEAR.
'c
'c Attributes:
'C LANGUAGE: SiliconGraphics 3.3 FORTRAN 77
'C MACHINE: SiliconGraphics IRIS-4D/25
'c
'C$$$
'c
'c
' Save
'c
Dim JLDAYN&, L&, n&, i&, j&, IDAYWK&, IDAYYR&, Month&
Select Case Iyear
Case 1997: JLDAYN = 2450448.5
Case 1998: JLDAYN = 2450813.5
Case 1999: JLDAYN = 2451178.5
Case Else
Call MsgBox(Str$(Iyear) + " is not supported by this function!", vbOKOnly)
Exit Function
End Select
L = JLDAYN + 68569 + Doy + 1
n = (4 * L) \ 146097
L = L - (146097 * n + 3) \ 4
i = 4000 * (L + 1) \ 1461001
L = L - 1461 * i \ 4 + 31
j = 80 * L \ 2447
Iday = L - 2447 * j \ 80
L = j \ 11
Month = j + 2 - 12 * L
Iyear = 100 * (n - 49) + i + L
IDAYWK = ((JLDAYN + 1) Mod 7) + 1
IDAYYR = JLDAYN - (-31739 + 1461 * (Iyear + 4799) / 4 - 3 * ((Iyear + 4899) / 100) / 4)
fDOYtoYMD = Format(Iyear, "0000") + Format(Month, "00") + Format(Iday, "00")
End Function
Sub Wait
Sub Wait(seconds!)
Dim T As Date
' Wait for seconds in this (lousy) routine (Avoid using!)
T = Time
T = T + TimeSerial(0, 0, seconds)
Do
DoEvents
Loop Until Time > T
End Sub
Sub CreateDirectoryTree
Sub CreateDirectoryTree(Path$, Ask As Boolean)
Dim i%, PathSave$, ans As Variant
' Create the complete directory structure specified by Path$
' Append final slash if necessary
' If Ask = TRUE then user is prompted before creating a new folder
' Replace forward slash with backslash
Path$ = fReplaceChar(Path$, "/", "\")
' Check if last character is "\" and add
If Right$(Path$, 1) <> "\" Then Path$ = Path$ + "\"
PathSave$ = Path$
' Check if path exists
If Len(Dir(Path$)) = 0 Then
i = 0
Do
i = InStr(i + 1, Path$, "\")
If Len(Dir(Left$(Path$, i), vbDirectory)) = 0 Then
If Ask Then
ans = MsgBox("Path: " + Left$(Path$, i) + " does not exist!" + vbLf + vbCrLf + "Do you wish to create it?", vbYesNo)
If ans = vbYes Then
MkDir Left$(Path$, i)
Else
Exit Sub 'Don't go any further if answer is NO
End If
Else
MkDir Left$(Path$, i)
End If
End If
Loop Until i = Len(PathSave$)
End If
End Sub
Function fReplaceChar
Function fReplaceChar(Filename$, char1$, char2$)
' Replace char1 with char2 anywhere in filename$
Dim i&
For i = 1 To Len(Filename$)
If Mid$(Filename$, i, 1) = char1$ Then Mid$(Filename$, i, 1) = char2$
Next i
fReplaceChar = Filename$
End Function
GlobalParms.bas
Math.bas
- Sub BubbleSort
Sub BubbleSort(ByRef A!(), ByRef n%)
Dim T!, i%, j%
For i = 1 To n
For j = i + 1 To n
If A(j) < A(i) Then 'Swap
T = A(i)
A(i) = A(j)
A(j) = T
End If
Next j
Next i
End Sub
Sub BubbleSortL
Sub BubbleSortL(ByRef A&(), ByRef n&)
Dim T&, i&, j&
For i = 1 To n
For j = i + 1 To n
If A(j) < A(i) Then 'Swap
T = A(i)
A(i) = A(j)
A(j) = T
End If
Next j
Next i
End Sub
Sub RollOver
Sub RollOver(iY%, iM%, iD%, UTks!)
' Bump day, month and year if UTks > 86.4
If UTks < 86.4 Then Exit Sub
UTks = UTks - 86.4
iD = iD + 1
Select Case iM
Case 1
If iD > 31 Then iM = 2: iD = 1
Case 2
If iY Mod 4 = 0 Then 'Leap Year
If iD > 29 Then iM = 3: iD = 1
Else
If iD > 28 Then iM = 3: iD = 1
End If
Case 3
If iD > 31 Then iM = 4: iD = 1
Case 4
If iD > 30 Then iM = 5: iD = 1
Case 5
If iD > 31 Then iM = 6: iD = 1
Case 6
If iD > 30 Then iM = 7: iD = 1
Case 7
If iD > 31 Then iM = 8: iD = 1
Case 8
If iD > 31 Then iM = 9: iD = 1
Case 9
If iD > 30 Then iM = 10: iD = 1
Case 10
If iD > 31 Then iM = 11: iD = 1
Case 11
If iD > 30 Then iM = 12: iD = 1
Case 12
If iD > 31 Then iY = iY + 1: iM = 1: iD = 1
End Select
End Sub
Function fSDT
Function fSDT(SDT!) As Single
' Normal noise with standard deviation SDT
fSDT = fNormal() * SDT
End Function
Function ACN
Function ACN(ByVal X!) As Single
' Take arccosine of a number (x!)
' Valid only for +- 90 degrees
Dim Y!
If Abs(X) < 0.00001 Then
Select Case Sgn(X)
Case Is < 0: ACN = -Pi / 2
Case Else: ACN = Pi / 2
End Select
Else
ACN = Atn(Sqr(1 - X ^ 2) / X)
End If
End Function
Function ASN
Function ASN(ByVal X!) As Single
' Take arcsine of a number
' Valid only for +- 90 degrees
If Abs(X) > 0.99999 Then ASN = X * Pi / 2 Else ASN = Atn(X / Sqr(1 - X ^ 2))
End Function
Sub AvgRMSdiff
Sub AvgRMSdiff(z1!(), T1!(), n1%, z2!(), T2!(), n2%, AVG!, RMS!)
Dim Sum1!, Sum2!, X!, i%, nA%, n%
' This code is not yet working. Need to interpolate in Z
'i = 0
'Do: i = i + 1
'Loop Until z1(1) < z2(i)
' Scan to Scan RMS
If n1 = n2 Then
For i = 1 To n1
X = T1(i) - T2(i)
Sum1 = Sum1 + X 'Sum time difference
Sum2 = Sum2 + X ^ 2 'Sum square of time differences
Next i
AVG = Sum1 / n 'Calculate average
If Sum2 - AVG ^ 2 * n > 0 Then RMS = Sqr((Sum2 - AVG ^ 2 * n) / (n - 1)) 'Calculate RMS
Else
End If
End Sub
Sub AvgRMSdiffT
Sub AvgRMSdiffT(T1!(), T2!(), n%, Threshold!, M%, AVG!, RMS!)
Dim i%, j%, X!, Sum1!, Sum2!
j = 0 'Number of samples found
For i = 1 To n
X = T1(i) - T2(i)
If Abs(X) <= Threshold Then
j = j + 1
Sum1 = Sum1 + X 'Sum time difference
Sum2 = Sum2 + X ^ 2 'Sum square of time differences
End If
' Debug.Print i; T1(i); T2(i); X; j
Next i
M = j
If M > 1 Then AVG = Sum1 / M Else Exit Sub 'Calculate average
If Sum2 - AVG ^ 2 * M > 0 Then RMS = Sqr((Sum2 - AVG ^ 2 * M) / (M - 1)) 'Calculate RMS
End Sub
Sub AvgRMSdiffTP
Sub AvgRMSdiffTP(Zac!(), Ztp!(), n%, TPhreshold!, M%, AVG!, RMS!)
Dim i%, j%, X!, Sum1!, Sum2!
j = 0 'Number of samples found
For i = 1 To n
X = Zac(i) - Ztp(i)
If Abs(X) >= TPhreshold Then
j = j + 1
Sum1 = Sum1 + X 'Sum time difference
Sum2 = Sum2 + X ^ 2 'Sum square of time differences
End If
Next i
M = j
If M > 1 Then AVG = Sum1 / M Else Exit Sub 'Calculate average
If Sum2 - AVG ^ 2 * M > 0 Then RMS = Sqr((Sum2 - AVG ^ 2 * M) / (M - 1)) 'Calculate RMS
End Sub
Sub AvgRMSdiffR
Sub AvgRMSdiffR(T1!(), T2!(), Range!(), n%, Threshold!, M%, AVG!, RMS!)
Dim i%, j%, X!, Sum1!, Sum2!
j = 0 'Number of samples found
For i = 1 To n
If Range(i) <= Threshold Then
j = j + 1
X = T1(i) - T2(i)
Sum1 = Sum1 + X 'Sum time difference
Sum2 = Sum2 + X ^ 2 'Sum square of time differences
End If
' Debug.Print i; T1(i); T2(i); X; Range(i); j
Next i
M = j
If M > 1 Then AVG = Sum1 / M Else Exit Sub 'Calculate average
If Sum2 - AVG ^ 2 * M > 0 Then RMS = Sqr((Sum2 - AVG ^ 2 * M) / (M - 1)) 'Calculate RMS
End Sub
Sub AvgRmsMinMax
Sub AvgRmsMinMax(ByRef A!(), ByVal n%, ByRef AVG!, ByRef RMS!, ByRef Min!, ByRef Max!)
Dim Sum1!, Sum2!, X!, i%
' Calculate average,rms, min and max of n numbers in A()
Min = 99999999#
Max = -99999999#
For i = 1 To n
X = A(i)
If X < Min Then Min = X
If X > Max Then Max = X
Sum1 = Sum1 + X 'Sum time difference
Sum2 = Sum2 + X ^ 2 'Sum square of time differences
Next i
AVG = Sum1 / n 'Calculate average
If Sum2 - AVG ^ 2 * n > 0 Then RMS = Sqr((Sum2 - AVG ^ 2 * n) / (n - 1)) Else RMS = 0# 'Calculate RMS
End Sub
Function fVaverage
Function fVaverage(z!(), V!(), n%, z1!, z2!)
Dim V1!, V2!, i%, i1%, i2%, Wt!, Vsum!
V1 = fLinterp(z!(), V!(), n%, z1)
V2 = fLinterp(z!(), V!(), n%, z1)
' Do linear interpolation in z to find value of at zo
i1 = 0
Do
i1 = i1 + 1
Loop Until z(i1) >= z1 Or i = n
i2 = i1
Do
i2 = i2 + 1
Loop Until z(i2) >= z2 Or i = n
' Now calculate weighted sum
Vsum = (V1 + V(i1)) * (z(i1) - z1)
For i = i1 To i2 - 1
Vsum = Vsum + (V(i) + V(i + 1)) * (z(i + 1) - z(i))
Next i
Vsum = Vsum + (V(i2) + V2) * (z2 - z(i2))
fVaverage = Vsum * (z2 - z1) / 2#
End Function
Function fGCD
Function fGCD(LAT1!, LON1!, LAT2!, LON2!) As Single
' Calculate Great Circle Distance between two points in km
Dim D!
D = ACN(Sin(LAT1 * rpd) * Sin(LAT2 * rpd) + Cos(LAT1 * rpd) * Cos(LAT2 * rpd) * Cos((LON1 - LON2) * rpd))
fGCD = 1.852 * 60 * D / rpd 'km (1.852 km / nm, and 1 minute = 1 nm)
End Function
Function fNonNumeric
Function fNonNumeric(A$) As Boolean
Dim i%, n%
For i = 1 To Len(A$)
n = Asc(Mid$(A$, i, 1))
If n < 48 Or n > 57 Then fNonNumeric = True: Exit Function
Next i
fNonNumeric = False
End Function
Function fNormal
Function fNormal() As Single
' Calculate normally distributed random number
' Be sure to call RANDOMIZE before this routine
Dim V1!, V2!, R!, fAC!
Static Iset As Boolean, Gset!
If Not Iset Then
Do
V1 = 2# * Rnd(1) - 1#
V2 = 2# * Rnd(1) - 1#
R = V1 ^ 2 + V2 ^ 2
Loop Until R < 1
fAC = Sqr(-2# * Log(R) / R)
Gset = V1 * fAC
fNormal = V2 * fAC
Iset = True
Else
fNormal = Gset
Iset = False
End If
End Function
Sub FIT
Sub FIT(X!(), Y!(), nData%, sig!(), Mwt As Boolean, A!, B!, SigA!, SigB!, Chi2!, q!)
' Fit Y = A + Bx
' Sig ... SD on Y
' SigA .. SD on A
' SigB .. SD on B
' Chi2 .. Chi Squared
' Q ..... GoodneS of fit probability that would have Chi2 or larger
' If Mwt = 0 then Sig aSumed to be unavailable
Dim Sx!, sY!, Sxx!, Sxy!, S!, Wt!, Delta!, Sxoss!, GammQ!, SigDat!, T!
Dim i%
Sx = 0#
sY = 0#
Sxx = 0#
B = 0#
If Mwt Then
S = 0#
For i = 1 To nData
Wt = 1# / (sig(i) ^ 2)
S = S + Wt
Sx = Sx + X(i) * Wt
sY = sY + Y(i) * Wt
Next i
Else
For i = 1 To nData
Sx = Sx + X(i)
sY = sY + Y(i)
Next i
S = nData
End If
Sxoss = Sx / S 'average x value
If Mwt Then
For i = 1 To nData
T = (X(i) - Sxoss) / sig(i)
Sxx = Sxx + T * T
B = B + T * Y(i) / sig(i)
Next i
Else
For i = 1 To nData
T = X(i) - Sxoss
Sxx = Sxx + X(i) ^ 2
Sxy = Sxy + X(i) * Y(i)
Next i
End If
Delta = S * Sxx - Sx ^ 2
A = (Sxx * sY - Sx * Sxy) / Delta
B = (S * Sxy - Sx * sY) / Delta
' B = B / Sxx
' A = (Sy - Sx * B) / S
SigA = Sqr((1# + Sx * Sx / (S * Sxx)) / S)
SigB = Sqr(1# / Sxx)
Chi2 = 0#
If Not Mwt Then
For i = 1 To nData
Chi2 = Chi2 + (Y(i) - A - B * X(i)) ^ 2
Next i
q = 1#
SigDat = Sqr(Chi2 / (nData - 2))
SigA = SigA * SigDat
SigB = SigB * SigDat
Else
For i = 1 To nData
Chi2 = Chi2 + ((Y(i) - A - B * X(i)) / sig(i)) ^ 2
Next i
q = 0 'GammQ(0.5 * (Ndata - 2), 0.5 * Chi2)
End If
End Sub
Sub AvgRMS
Sub AvgRMS(ByRef A!(), ByVal n%, ByRef AVG!, ByRef RMS!)
Dim Sum1!, Sum2!, X!, i%
' Calculate average and rms of n numbers in A()
If n < 2 Then Exit Sub
For i = 1 To n
X = A(i)
Sum1 = Sum1 + X 'Sum time difference
Sum2 = Sum2 + X ^ 2 'Sum square of time differences
Next i
AVG = Sum1 / n 'Calculate average
If Sum2 - AVG ^ 2 * n > 0 Then RMS = Sqr((Sum2 - AVG ^ 2 * n) / (n - 1)) Else RMS = 0# 'Calculate RMS
End Sub
Sub FIT2
Sub FIT2(X!(), Y!(), nData%, sig!(), Mwt As Boolean, A!, B!, SigA!, SigB!, Chi2!, q!)
' Fit Y = A + Bx
' Sig ... SD on Y
' SigA .. SD on A
' SigB .. SD on B
' Chi2 .. Chi Squared
' Q ..... GoodneS of fit probability that would have Chi2 or larger
' If Mwt = 0 then Sig aSumed to be unavailable
Dim Sx!, sY!, Sxx!, S!, Wt!, Sxoss!, GammQ!, SigDat!, T!
Dim i%
Sx = 0#
sY = 0#
Sxx = 0#
B = 0#
If Mwt Then
S = 0#
For i = 1 To nData
Wt = 1# / (sig(i) ^ 2)
S = S + Wt
Sx = Sx + X(i) * Wt
sY = sY + Y(i) * Wt
Next i
Else
For i = 1 To nData
Sx = Sx + X(i)
sY = sY + Y(i)
Next i
S = nData
End If
Sxoss = Sx / S 'average x value
If Mwt Then
For i = 1 To nData
T = (X(i) - Sxoss) / sig(i)
Sxx = Sxx + T * T
B = B + T * Y(i) / sig(i)
Next i
Else
For i = 1 To nData
T = X(i) - Sxoss
Sxx = Sxx + T * T
B = B + T * Y(i)
Next i
End If
B = B / Sxx
A = (sY - Sx * B) / S
SigA = Sqr((1# + Sx * Sx / (S * Sxx)) / S)
SigB = Sqr(1# / Sxx)
Chi2 = 0#
If Not Mwt Then
For i = 1 To nData
Chi2 = Chi2 + (Y(i) - A - B * X(i)) ^ 2
Next i
q = 1#
SigDat = Sqr(Chi2 / (nData - 2))
SigA = SigA * SigDat
SigB = SigB * SigDat
Else
For i = 1 To nData
Chi2 = Chi2 + ((Y(i) - A - B * X(i)) / sig(i)) ^ 2
Next i
q = 0 'GammQ(0.5 * (Ndata - 2), 0.5 * Chi2)
End If
End Sub
Sub Fpoly
Sub Fpoly(X!, P!(), NP%)
Dim j%
P(1) = 1#
For j = 2 To NP
P(j) = P(j - 1) * X
Next j
End Sub
Sub LFIT
Sub LFIT(X!(), Y!(), sig!(), nData%, A!(), mA%, ListA%(), mFit%, CoVar!(), nCVM%, ChiSq!)
Dim k%, kk%, i%, j%, Afunc!(1 To 6), YM#, SIG2I#, Sum#
Dim beta!(1 To 6, 1), iHit%, Wt#
' Code from Numerical Recipes
kk = mFit + 1
For j = 1 To mA
iHit = 0
For k = 1 To mFit
If ListA(k) = j Then iHit = iHit + 1
Next k
If iHit = 0 Then
ListA(kk) = j
kk = kk + 1
Else
If iHit > 1 Then MsgBox "Improper set in LISTA", vbOKOnly
End If
Next j
If (kk <> (mA + 1)) Then MsgBox "Improper set in LISTA", vbOKOnly
For j = 1 To mFit
For k = 1 To mFit
CoVar(j, k) = 0#
Next k
beta(j, 1) = 0#
Next j
For i = 1 To nData
Call Fpoly(X(i), Afunc, mA)
YM = Y(i)
If (mFit < mA) Then
For j = mFit + 1 To mA
YM = YM - A(ListA(j)) * Afunc(ListA(j))
Next j
End If
SIG2I = 1# / sig(i) ^ 2
For j = 1 To mFit
Wt = Afunc(ListA(j)) * SIG2I
For k = 1 To j
CoVar(j, k) = CoVar(j, k) + Wt * Afunc(ListA(k))
Next k
beta(j, 1) = beta(j, 1) + YM * Wt
Next j
Next i
If (mFit > 1) Then
For j = 2 To mFit
For k = 1 To j - 1
CoVar(k, j) = CoVar(j, k)
Next k
Next j
End If
Call GAUSSJ(CoVar(), mFit, nCVM, beta(), 1, 1)
For j = 1 To mFit
A(ListA(j)) = beta(j, 1)
Next j
ChiSq = 0#
For i = 1 To nData
Call Fpoly(X(i), Afunc, mA)
Sum = 0#
For j = 1 To mA
Sum = Sum + A(j) * Afunc(j)
Next j
ChiSq = ChiSq + ((Y(i) - Sum) / sig(i)) ^ 2
Next i
Call COVSRT(CoVar(), nCVM, mA, ListA(), mFit)
End Sub
Sub GAUSSJ(A!(), n%, NP%, B!(), M%, MP%)
Dim IPIV%(1 To 10), INDXR%(1 To 10), INDXC%(1 To 10)
Dim i%, j%, k%, L%, iRow%, iCol%, BIG!, DUM!, PIVINV!, ll%
' Code from Numberical Recipes
For j = 1 To n: IPIV(j) = 0: Next j
For i = 1 To n
BIG = 0#
For j = 1 To n
If (IPIV(j) <> 1) Then
For k = 1 To n
If (IPIV(k) = 0) Then
If (Abs(A(j, k)) >= BIG) Then
BIG = Abs(A(j, k))
iRow = j
iCol = k
End If
Else
If (IPIV(k) > 1) Then MsgBox "Singular Matrix!", vbOKOnly
End If
Next k
End If
Next j
IPIV(iCol) = IPIV(iCol) + 1
If (iRow <> iCol) Then
For L = 1 To n
DUM = A(iRow, L)
A(iRow, L) = A(iCol, L)
A(iCol, L) = DUM
Next L
For L = 1 To M
DUM = B(iRow, L)
B(iRow, L) = B(iCol, L)
B(iCol, L) = DUM
Next L
End If
INDXR(i) = iRow
INDXC(i) = iCol
If (A(iCol, iCol) = 0#) Then
MsgBox "Singular Matrix!", vbOKOnly
Exit Sub
End If
PIVINV = 1# / A(iCol, iCol)
A(iCol, iCol) = 1#
For L = 1 To n
A(iCol, L) = A(iCol, L) * PIVINV
Next L
For L = 1 To M
B(iCol, L) = B(iCol, L) * PIVINV
Next L
For ll = 1 To n
If (ll <> iCol) Then
DUM = A(ll, iCol)
A(ll, iCol) = 0#
For L = 1 To n
A(ll, L) = A(ll, L) - A(iCol, L) * DUM
Next L
For L = 1 To M
B(ll, L) = B(ll, L) - B(iCol, L) * DUM
Next L
End If
Next ll
Next i
For L = n To 1 Step -1
If (INDXR(L) <> INDXC(L)) Then
For k = 1 To n
DUM = A(k, INDXR(L))
A(k, INDXR(L)) = A(k, INDXC(L))
A(k, INDXC(L)) = DUM
Next k
End If
Next L
End Sub
Sub Qfit
Sub Qfit(X!(), Y!(), n%, Coeff!(), nC%)
Dim nData%, A!(1 To 10), mA%, CoVar!(1 To 10, 1 To 10), ChiSq!
Dim sig!(1 To 100), ListA%(1 To 10), nCVM%, mFit%, i%
' Routine to do quadratic fit to 3 TB errors due to RAOB bias
'x(1) = -25#: x(2) = 0#: x(3) = 25#
'y(1) = 1.59: y(2) = 0: y(3) = -2.11
'A(2)= 0.:A(2)= -0.074:A(3)= -4.159999E-04 agrees will Excel fit
nData = n
mA = nC
nCVM = nC
mFit = nC
For i = 1 To nData: sig(i) = 1#: ListA(i) = i: Next i
Call LFIT(X!(), Y!(), sig!(), nData%, A!(), mA%, ListA%(), mFit%, CoVar!(), nCVM%, ChiSq!)
'Debug.Print x(1); x(2); x(3); y(1); y(2); y(3); A(1); A(2); A(3)
For i = 1 To nC
Coeff(i) = A(i)
Next i
End Sub
Sub COVSRT
Sub COVSRT(CoVar!(), nCVM%, mA%, ListA%(), mFit%)
Dim i%, j%, k%, Swap!
' Numberical Recipes code called by LFIT
For j = 1 To mA - 1
For i = j + 1 To mA
CoVar(i, j) = 0#
Next i
Next j
For i = 1 To mFit - 1
For j = i + 1 To mFit
If (ListA(j) > ListA(i)) Then
CoVar(ListA(j), ListA(i)) = CoVar(i, j)
Else
CoVar(ListA(i), ListA(j)) = CoVar(i, j)
End If
Next j
Next i
Swap = CoVar(1, 1)
For j = 1 To mA
CoVar(1, j) = CoVar(j, j)
CoVar(j, j) = 0#
Next j
CoVar(ListA(1), ListA(1)) = Swap
For j = 2 To mFit
CoVar(ListA(j), ListA(j)) = CoVar(1, j)
Next j
For j = 2 To mA
For i = 1 To j - 1
CoVar(i, j) = CoVar(j, i)
Next i
Next j
End Sub
Sub Cinv
Sub Cinv(x1!, y1!, x2!, y2!)
'
Dim Mag!
Mag = x1 ^ 2 + y1 ^ 2
x2 = x1 / Mag
y2 = -y1 / Mag
End Sub
Sub CpC
Sub CpC(x1!, y1!, x2!, y2!, x3!, y3!)
x3 = x1 + x2
y3 = y1 + y2
End Sub
Sub CmC
Sub CmC(x1!, y1!, x2!, y2!, x3!, y3!)
x3 = x1 - x2
y3 = y1 - y2
End Sub
Sub CxC
Sub CxC(x1!, y1!, x2!, y2!, x3!, y3!)
Dim Mag!
x3 = x1 * x2 - y1 * y2
y3 = x1 * y2 + x2 * y1
End Sub
Function fLinterp
Function fLinterp(z!(), V!(), n%, zo!) As Single
' Do linear interpolation in z to find value of at zo
Dim i%, it%, ib%
i = 0
Do
i = i + 1
Loop Until z(i) >= zo Or i = n
If z(i) = zo Then fLinterp = V(i): Exit Function
If i > n Then fLinterp = V(n): Exit Function
it = i
ib = i - 1
If ib = 0 Then
fLinterp = V(it)
Else
fLinterp = V(ib) + (V(it) - V(ib)) * (zo - z(ib)) / (z(it) - z(ib))
End If
End Function
Function LapseRate
Function LapseRate(z, TZ, z0, T0)
'Lapse rate from (z0,T0) to (z,T)
LapseRate = (TZ - T0) / (z - z0)
End Function
Function Calc_LR_Level
Function Calc_LR_Level(z0!(), T0!(), T2#(), j%, LRt!) As Single
' Enter with j% as index to level BELOW where LR=LRt
' Function returns altitude where LR=LRt
' Z0, T0 is T profile
' T2 are second derivatives from spline fit
Dim dT#, dZ#, AA#, BB#, cC#, Arg#, SolnP#, SolnM#
dT = T0(j% + 1) - T0(j%)
dZ = z0(j% + 1) - z0(j%)
AA = (T2(j% + 1) - T2(j%))
BB = -2 * T2(j% + 1)
If dZ <> 0# Then
cC = T2(j% + 1) - (AA + (6 / dZ) * (LRt - dT / dZ)) / 3
Else
cC = 0#
End If
Arg = BB ^ 2 - 4 * AA * cC
If Arg > 0 Then 'Avoid arithmetic fault
SolnP = z0(j% + 1) - dZ * (-BB + Sqr(Arg)) / (2 * AA)
SolnM = z0(j% + 1) - dZ * (-BB - Sqr(Arg)) / (2 * AA)
If SolnP >= z0(j) And SolnP <= z0(j + 1) Then
Calc_LR_Level = SolnP
Else
Calc_LR_Level = SolnM
End If
'Debug.Print z0(j); z0(j + 1); SolnP; SolnM; Calc_LR_Level
Else
Calc_LR_Level = 99.9: Exit Function
End If
End Function
Function fHexToDec
Function fHexToDec(HexNo$) As Integer
Dim V%
' Convert HexNo$ to Decimal Number
V = Val("&H" + HexNo$)
If V < 0 Then V = 65536 + V 'MSB is not sign, add 2^16
fHexToDec = V
End Function
Sub INC
Sub INC(j%)
j% = j% + 1
End Sub
Sub RBCaverage
Sub RBCaverage(n%, Count%, V!())
' Perform running box car average over N cycles on V() which has Count elements
' Return with V containg running box car average
' Note, N should be an odd number
Dim X!(1 To 10000), i%, j%, n1%, n2%, n3%, Sum!
If Int(n / 2) = n / 2 Then
MsgBox "RBCaverage, N must be an odd integer!", vbOKOnly
Exit Sub
End If
n1 = Int(n / 2)
n2 = n1 + 1
' Save V
For i = 1 To Count
X(i) = V(i)
Next i
' Average first n1 cycles
For i = 1 To n1
Sum = 0#
n3 = 2 * (i - 1) + 1
For j = 1 To n3
Sum = Sum + X(j)
Next j
V(i) = Sum / n3
Next i
' Average from n1+1 to count-n1
For i = n1 + 1 To Count - n1
Sum = 0#
For j = i - n1 To i + n1
Sum = Sum + X(j)
Next j
V(i) = Sum / n
Next i
' Average last n1 cycles
For i = Count - n1 + 1 To Count
Sum = 0#
n3 = -2 * (i - Count) + 1
For j = 1 To n3
Sum = Sum + X(Count - j + 1)
Next j
V(i) = Sum / n3
Next i
End Sub
Function SPLINT
Function SPLINT(z0!(), T0!(), TD2#(), M%, n%, z, R_flag As Boolean)
Dim dZ#, A#, B#, klo%, khi%, k%
'This procedure calculates temperature (T) for a specified altitude (z)
'Routine SPLINE must be run once before using this routine
'Input Parameters:
' z0 .. Measured altitude observables
' T0 .. Measured temperature observables
' TD2 .. Second derivatives of T wrt z (from SPLINE)
' m% ... First non-zero element of z0 if R_flag=TRUE
' Current index if R_flag=FALSE
' n% ... Last non-zero element of z0
' z ... Altitude for which temperature T is needed
' R_flag TRUE for random Splints, FALSE if consecutive
'Output parameters:
' T .... Temperature at specified altitude (z)
'Bound the current fit point by retrieved values
klo% = M%
khi% = n%
If R_flag Then
While (khi% - klo% > 1) 'Perform binary search
k% = (khi% + klo%) / 2
If (z0(k%) > z) Then: khi% = k%: Else: klo% = k%
Wend
Else
While z0(klo%) <= z
klo% = klo% + 1
If klo% > khi% Then Exit Function
Wend
M% = klo%
End If
dZ = z0(khi%) - z0(klo%)
If (dZ = 0) Then dZ = 0.0001 'Stop 'Bad Z0() input.'
A = (z0(khi%) - z) / dZ
B = (z - z0(klo%)) / dZ
If khi <= n Then SPLINT = A * T0(klo%) + B * T0(khi%) + ((A ^ 3 - A) * TD2(klo%) + (B ^ 3 - B) * TD2(khi%)) * (dZ ^ 2) / 6
End Function
Sub DEC
Sub DEC(j%)
j% = j% - 1
End Sub
Sub SPLINE
Sub SPLINE(z0!(), T0!(), TD1#(), TD2#(), M%, n%)
'
' Input Parameters:
' z0 ... Measured altitude observables
' T0 ... Measured temperature observables
' M% ... First non-zero element in z0
' N% ... Last non-zero element in z0
' Output parameters:
' TD1 ... Calculated first derivatives of T wrt Z
' TD2 ... Calculated second derivatives of T wrt Z
Dim dZ#, sig#, i%, P#, dT#, U#(200)
If (n%) < 2 Then Exit Sub
'ReDim U(1 To n%) mjmmjm
' Do one-time Spline fit for input parameters
' Use natural fit; 2nd derivative=0 at end points
TD2(M%) = 0
U(M%) = 0
For i% = M% + 1 To n% - 1
If i > n Then Exit For
If z0(i + 1) <> z0(i - 1) Then
sig = (z0(i%) - z0(i% - 1)) / (z0(i% + 1) - z0(i% - 1))
Else
sig = 0
End If
P = sig * TD2(i% - 1) + 2
TD2(i%) = (sig - 1) / P
If sig <> 0 And z0(i) <> z0(i + 1) Then
U(i%) = (6 * ((T0(i% + 1) - T0(i%)) / (z0(i% + 1) - z0(i%)) - (T0(i%) - T0(i% - 1)) / (z0(i%) - z0(i% - 1))) / (z0(i% + 1) - z0(i% - 1)) - sig * U(i% - 1)) / P
Else
U(i) = 0#
End If
' Debug.Print i%; U(i%); p; SIG
Next
If n < 200 Then TD2(n%) = 0
For i% = n% - 1 To M% Step -1
If i > n Then Exit For
dT = T0(i% + 1) - T0(i%)
dZ = z0(i% + 1) - z0(i%)
If dZ <> 0 Then
TD1(i%) = dT / dZ - (dZ / 6) * (2 * TD2(i%) + TD2(i% + 1))
Else
TD1(i) = 0#
End If
TD2(i%) = TD2(i%) * TD2(i% + 1) + U(i%)
Next
End Sub
Sub trapzd
Sub trapzd(A!, B!, S!, n%)
Dim TNM%, j%, Sum!, X!, DEL!
Static it%
If n = 1 Then
' S = 0.5 * (b - a) * (FUNC(a) + FUNC(b))
it = 1
Else
TNM = it
DEL = (B - A) / TNM
X = A + 0.5 * DEL
Sum = 0#
For j = 1 To it
' Sum = Sum + FUNC(x)
X = X + DEL
Next
S = 0.5 * (S + (B - A) * Sum / TNM)
it = 2 * it
End If
End Sub
Function DCOS
Function DCOS(E)
Dim C!
C = 180 / 3.14159265358979
DCOS = Cos(E / C)
End Function
Function DSExyz
Function DSExyz(Tilt!, Az!, Pitchoff!, P!, R!, E!)
Static T#, C!, sinA!, sinP!, sinR!, sinE!, sinF!, sinT!
Static cosA!, cosP!, cosR!, cosE!, cosT!, cosF!, cosFs!
Static tanF!, tanFs!
Dim S!, g!, f!, sinAlpha!, cosAlphas!, cosAlpha!, tanAlpha!, alpha!
Dim AlphaM!, sinG!, cosGs!, cosG!, tanG!, gamma!, sinGamma!
Dim CosI!, SinIs!, SinI!, TanI!, i!, SinS!, CosS!, CosSs!, CosSm!
Dim TanS!, Delta!, SinDelta!, SinDeltaS!, CosDeltaS!, CosDelta!
Dim TanDelta!, DSE!
T# = Tilt
C = 180 / 3.14159265358979
sinA = Sin(Az / C): cosA = Cos(Az / C)
sinP = Sin(P / C): cosP = Cos(P / C)
sinR = Sin(R / C): cosR = Cos(R / C)
sinE = Sin(E / C): cosE = Cos(E / C)
sinT = Sin(T# / C): cosT = Cos(T# / C)
sinF = sinP * cosA - cosP * sinA * sinR
cosFs = 1 - sinF ^ 2:
If cosFs < 0 Then cosFs = 0.00001 'added 960204 as fix as precaution
If cosFs > 1 Then cosFs = 0.99999 'added 960204 as fix as precaution
cosF = Sqr(cosFs):
If cosFs = 0 Then cosFs = 0.00001 'added 960204 as fix as precaution
tanF = sinF / cosF
f = C * Atn(tanF) 'we have f
sinAlpha = cosR * cosP / cosF
If sinAlpha > 0.99999 Then sinAlpha = 0.99999 'added 960204 as fix to FailLite
cosAlphas = 1 - sinAlpha ^ 2:
If cosAlphas < 0 Then cosAlpha = 0.00001 'added 960204 as fix to FailLite
If cosAlphas > 1 Then cosAlpha = 0.99999 'added 960204 as fix to FailLite
cosAlpha = Sqr(cosAlphas):
If cosAlpha = 0 Then cosAlpha = 0.00001
tanAlpha = sinAlpha / cosAlpha
alpha = C * Atn(tanAlpha): AlphaM = 180 - alpha 'we have Alpha
'code for choosing Alpha vs Alpham
If cosA <= 0 Then cosA = 0.00001 'added 960204 as fix as precaution
sinG = sinP / cosA
cosGs = 1 - sinG ^ 2:
If cosGs <= 0 Then cosGs = 0.00001 'added 960204 as fix as precaution
cosG = Sqr(cosGs):
If cosG = 0 Then cosG = 0.00001 'added 960204 as fix as precaution
tanG = sinG / cosG
g = C * Atn(tanG)
If f > g Then alpha = AlphaM
gamma = alpha + Tilt - 90 'we have Gamma
sinGamma = Sin(gamma / C)
CosI = sinGamma * cosF:
If CosI = 0 Then CosI = 0.00001 'added 960204 as fix as precaution
SinIs = 1 - CosI ^ 2:
If SinIs < 0 Then SinIs = 0.00001 'added 960204 as fix as precaution
If SinIs > 1 Then SinIs = 0.99999 'added 960204 as fix as precaution
SinI = Sqr(SinIs):
If SinI = 0 Then SinI = 0.00001 'added 960204 as fix as precaution
TanI = SinI / CosI
i = C * Atn(TanI) 'we have i
SinS = sinF / SinI
CosSs = 1 - SinS ^ 2:
If CosSs <= 0 Then CosSs = 0.00001 'added 960204 as fix as precaution
If CosSs > 1 Then CosSs = 0.99999 'added 960204 as fix as precaution
CosS = Sqr(CosSs): CosSm = -CosS
TanS = SinS / CosS
S = C * Atn(TanS) 'we have S
If sinE > SinI Then 'chk for "can't get there"
If E >= 0 Then 'go to highest possible
Delta = 90
End If
If E < 0 Then 'go to lowest possible
Delta = -90
End If
End If
If E > 0 And sinE < SinI Then 'there's a solution
SinDelta = sinE / SinI
CosDeltaS = 1 - SinDelta ^ 2:
If CosDeltaS < 0 Then CosDeltaS = 0.00001 'added 960204 as fix as precaution
If CosDeltaS > 1 Then CosDeltaS = 0.99999 'added 960204 as fix as precaution
CosDelta = Sqr(CosDeltaS):
If CosDelta = 0 Then CosDelta = 0.00001 'added 960204 as fix as precaution
TanDelta = SinDelta / CosDelta
Delta = C * Atn(TanDelta)
'IF E < 0 THEN Delta = -Delta '!!!!!!!!!
End If
If E < 0 And -sinE < SinI Then 'there's a solution
SinDelta = sinE / SinI
CosDeltaS = 1 - SinDelta ^ 2:
If CosDeltaS < 0 Then CosDeltaS = 0.00001 'added 960204 as fix as precaution
If CosDeltaS > 1 Then CosDeltaS = 0.99999 'added 960204 as fix as precaution
CosDelta = Sqr(CosDeltaS):
If CosDelta = 0 Then CosDelta = 0.00001 'added 960204 as fix as precaution
TanDelta = SinDelta / CosDelta
Delta = C * Atn(TanDelta)
'IF E < 0 THEN Delta = -Delta '!!!!!!!!!
End If
If E < 0 And -sinE > SinI Then 'no solution; must go to lowest possible
Delta = -90
End If 'we have Delta
DSE = Delta - S
If DSE < -90 Then DSE = -90
If DSE > 90 Then DSE = 90 'we have DSE
LeaveSub0:
'DSExyz = -((180 + 10.3) - DSE) 'refer DSE to RefTarget = 0 degrees
'nmprint "Q, P, R --> " + STR$(navqual) + " " + STR$(P) + " " + STR$(R), 25, 1
' removed above and inserted below mjm 20000831
'ER2: DSExyz = -((180 + 10.3) - DSE) 'refer DSE to RefTarget = 0 degrees
'WAM:
DSExyz = -(180 + Pitchoff - DSE) 'refer DSE to RefTarget = 0 degrees
'nmprint "Q, P, R --> " + Form$(NavQual, 1, 0) + " " + Form$(P, 5, 1) + " " + Form$(R, 5, 1), 25, 1
End Function
Function DSIN
Function DSIN(E)
Dim C!
C = 180 / 3.14159265358979
DSIN = Sin(E / C)
End Function
Function fPTinterp
Function fPTinterp(z!(), V!(), n%, zo!)
' Do linear interpolation in z to find value of at zo
Dim i%, it%, ib%
i = n + 1
Do
i = i - 1
Loop Until z(i) <= zo Or i = 1
If z(i) = zo Then fPTinterp = V(i): Exit Function
If z(1) > zo Then fPTinterp = -1: Exit Function
ib = i
it = i + 1
If it > n Then
fPTinterp = -1 'V(N)
Else
fPTinterp = V(ib) + (V(it) - V(ib)) * (zo - z(ib)) / (z(it) - z(ib))
End If
End Function
modCapture.bas
modGlobalParms.bas
modPNG.bas
- Sub CaptureForm
Sub CaptureForm(f As Form)
Dim i%, Status As Boolean, Filename$, alt_key As Long
#Const WINDOWS_VERSION = "Windows2000"
' Capture an image of the form in the clipboard.
' Press Alt.
alt_key = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, alt_key, 0, 0
DoEvents
' Press Print Screen
#If WINDOWS_VERSION = "Windows2000" Then
keybd_event VK_SNAPSHOT, 0, 0, 0
#Else
keybd_event VK_SNAPSHOT, 1, 0, 0
#End If
DoEvents
' Release Alt.
keybd_event VK_MENU, alt_key, KEYEVENTF_KEYUP, 0
DoEvents
With frmCaptureForm
.ScaleMode = 3
With .picImage
.AutoSize = True
.ScaleMode = 3
.Picture = Clipboard.GetData(vbCFBitmap)
End With
End With
' Construct new filename
i = 0
Do
i = i + 1
Filename$ = "C:\MTP\PNG\" & f.Name & Format(i, "000")
Loop Until Len(Dir(Filename$)) = 0
With f
.Show 'Show image or the size will not be correct
.ScaleMode = 3
End With
' Save image of form that was put in picture box
Status = SavePNGFile(frmCaptureForm.picImage, Filename$)
frmCaptureForm.Hide
If Not Status Then
MsgBox "PNG file of " & f.Name & " was not saved!", vbOKOnly
Else
MsgBox "PNG file of " & f.Name & " was saved in: " & vbCrLf & Filename$, vbOKOnly
End If
End Sub
MScapture.bas
- Sub CaptureFormMJ
Sub CaptureFormMJ(f As Form, PNGfilename$, Mode%, OK As Boolean)
' General form capture routine
' f .............. form
' PNGfilename$ ... fqfn of PNG file saved
' if ="" then a filename f.NameNNN.PNG will be created
' Mode ........... 0 ... capture full screen
' 1 ... capture full form
' 2 ... capture only client area of form
' 3 ... capture active window
' OK ............. if TRUE as MsgBox will verify that capture was made
' This sub uses a form named frmCaptureForm with a picturebox control named picImage
' The image is save to a temporary BMP image which is then converted
' using JG.convertEx routine in the janGraphics.dll library in C:/Windows/system32/
' Also, use Project|References to make sure the janGraphics Library is selected
Dim Filename$, Status As Boolean
Dim i&, DefaultFolder$, TempFolder$, TempFile$
Dim JG As New janGraphics.Compendium, ErrDesc$, iErrNumber As Long
Dim File$
With frmCaptureForm
.AutoRedraw = True
With .picImage
.Left = 0
.Top = 0
.Width = f.Width
.Height = f.Height
Select Case Mode
Case 0
.Picture = CaptureScreen() 'Capture full screen
Case 1
.Picture = CaptureForm(f) 'Capture full form
Case 2
.Picture = CaptureClient(f) 'Capture client area of form
Case 3
.Picture = CaptureActiveWindow() 'Capture active window
End Select
End With
End With
DoEvents
' Construct default filename if one is not provided
If PNGfilename$ = "" Then
i = 0
Do
i = i + 1
Filename$ = "C:\MTP\PNG\" & f.Name & Format(i, "000") & ".png"
Loop Until Len(Dir(Filename$)) = 0
Else
Filename$ = PNGfilename$
End If
On Error GoTo Err_
TempFolder$ = GetTempFolderName
TempFile$ = TempFolder$ & "TempPic.bmp"
SavePicture frmCaptureForm!picImage.Picture, TempFile$
JG.convertEx TempFile$, Filename$, 0, 0, False, 80
i = InStrRev(Filename$, "\")
If i = 0 Then
MsgBox "PNG file of " & f.Name & " was not saved!", vbOKOnly
Exit Sub
Else
DefaultFolder$ = Left$(Filename$, i)
Err_:
If Err.Number <> 0 Then iErrNumber = Err.Number: ErrDesc$ = Err.Description
Set JG = Nothing
If Len(TempFile$) > 0 Then Kill TempFile$: TempFile$ = ""
If Len(TempFolder$) > 0 Then RmDir TempFolder$: TempFolder$ = ""
If iErrNumber <> 0 Then MsgBox ErrDesc$, vbCritical, "Error No " & iErrNumber
' Save image of form that was put in picture box
If OK Then
If PNGfilename$ = "" Then
MsgBox "PNG file of " & f.Name & " was saved in: " & vbCrLf & Filename$, vbOKOnly
Else
MsgBox "PNG file was saved in: " & vbCrLf & Filename$, vbOKOnly
End If
End If
End If
End Sub
MTPio.Bas
- Sub DecodeGVline
Sub DecodeGVline(Line$)
'Instrument on 23:21:18 12-05-2007
'A 23:21:40 12-05-2007
'IWG1,20010920T151645,14.642,-96.4235,4229.12,,4255.74,4235.87,137.172,134.938,209.011,0.162247,0.0558355,185.039,189.068,4.23184,2.98645,0.90837,0.488137,2.95111,5.49085,-7.03531,14.0805,614.777,72.7016,860.533,8.57255,78.2577,0.0569099,0.821413,0.749384,,
'B 009653 013837 014684 009729 013910 014784 010241 014390 015307 010302 014467 015363 010306 014442 015380 010310 014441 015373 010310 014453 015369 010299 014442 015366 010292 014442 015369 009755 013976 014663
'M01: 2943 2109 2884 3097 3086 2954 2479 2936
'M02: 2101 1247 1429 4095 1531 1191 4095 1060
'Pt: 2436 14145 14143 16383 14187 14163 14028 14768
'E 011467 015347 016344 009836 013969 014870
Dim s$(40), n%, i%, j%, T!, Count&, RR!, Rt!, R7M0!, MTPtime$, MTPdate$, X$
Dim Ct!(8), r!(8), Tt(8), Voltage!, Vscale!(1 To 8), Tscale!(1 To 8)
Dim AA As Double, Bb As Double, cC As Double, DD As Double, WriteSMdata As Boolean
Static SMlu%
WriteSMdata = False
Select Case Left$(Line$, 1)
Case "A"
' A 20071205 23:21:40 002.30 00.05 001.11 00.10 01.30 0.01 267.00 0.20 +35.678 +0.045 -120.987 +0.998 75555 75550
' Pitch Pitch Roll Roll Zp Zp OAT OAT LatAvg LatRms LonAvg LonRms SMcmd SMenc
' A YYYYMMDD HH:MM:SS Avg Rms Avg Rms Avg Rms Avg Rms Avg Rms Avg Rms
' 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
' Line$ = "A 20071205 23:21:40 002.30 00.05 001.11 00.10 01.30 0.01 267.00 0.20"
MTPdate$ = Mid$(Line$, 3, 8)
' yyyymmdd$ = Left$(MTPdate$, 4) + Mid$(MTPdate$, 6, 2) + Right$(MTPdate$, 2)
MTPtime$ = Mid$(Line$, 12, 8)
UTsec = fTstringToSec(MTPtime$, True)
Line$ = Right$(Line$, Len(Line$) - 21)
Call ParseString2(Line$, " ", s$(), n%)
For i = 1 To n
T = Val(s$(i)) 'Counts
Select Case i
Case 1: PitchAvg = T
Case 2: PitchRms = T
Case 3: RollAvg = T
Case 4: RollRms = T
Case 5: ZpAvg = T
Case 6: ZpRms = T
Case 7: OatAvg = T
Case 8: OatRms = T
Case 9: LatAvg = T
Case 10: LatRms = T
Case 11: LonAvg = T
Case 12: LonRms = T
Case 13: SMcmd = T
Case 14: SMenc = T
Case Else
MsgBox "A-line parameter " + Str(i) + "not defined!", vbOKOnly
End Select
Next i
Aline = True
Case "B"
' B 009653 013837 014684 009729 013910 014784 010241 014390 015307 010302 014467 015363 010306 014442 015380 010310 014441 015373 010310 014453 015369 010299 014442 015366 010292 014442 015369 009755 013976 014663
Call ParseString2(Line$, " ", s$(), n%)
For j = 1 To Nel
For i = 1 To Channels
C(i, j) = Val(s$(i + Channels * (j - 1)))
Next i
Next j
Bline = True
Case "M"
Select Case Left$(Line$, 3)
Case "M01"
' M01: 2943 2109 2884 3097 3086 2954 2479 2936
Call ParseString2(Line$, " ", s$(), n%)
Vscale(8) = -5.1 '-15V PS Vm15
Vscale(7) = 2# 'VCC PS Vp05
Vscale(6) = 5.1 '+15V PS Vp15
Vscale(5) = 7.79 '+24V Syn Vsyn
Vscale(4) = 7.79 '+24V Step Vmtr
Vscale(3) = 2.78 '+8V PS Vp08
Vscale(2) = 1# 'Video V. Vvid
Vscale(1) = -2.73 '-8V PS Vm08
For i = 1 To n
Mux(i) = Val(s$(i)) 'Counts
Voltage = Vscale(i) * (Mux(i) / 1000#) 'Voltage
Muxs(i) = Voltage
Select Case i
Case 1: Vm08 = Voltage
Case 2: Vvid = Voltage
Case 3: Vp08 = Voltage
Case 4: Vmtr = Voltage
Case 5: Vsyn = Voltage
Case 6: Vp15 = Voltage
Case 7: Vp05 = Voltage
Case 8: Vm15 = Voltage
End Select
Next i
M01line = True
Case "M02"
' M02: 2101 1247 1429 4095 1531 1191 4095 1060
AA = 0.0009376: Bb = 0.0002208: cC = 0.0000001276
Call ParseString2(Line$, " ", s$(), n%)
' "Acceler " 'Acc+
' "T Data " 'Tdat
' "T Motor " 'Tmtr
' "T Pod Air " 'Tair
' "T Scan " 'Tsmp
' "T Pwr Sup " 'Tpsp
' "T N/C " 'Tnc
' "T Synth " 'Tsyn
For i = 1 To n
Select Case i
Case Is = 1
Mux(i + 8) = Val(s$(i))
ACCp = -((Mux(i + 8) * 0.001) - 2.5) / 0.4 ' MMA1250D accellerometer 2.5V +/- .25V @ 0G
Muxs(i + 8) = ACCp
Case Else
Count = Val(s$(i))
Mux(i + 8) = Count
If (Count = 4095) Or (Count = 0) Then
'
Else
Count = 4096# - Count
RR = (1 / (Count / 4096#)) - 1
Rt = 34800# * RR
Muxs(i + 8) = (1# / (AA + Bb * Log(Rt) + cC * Log(Rt) ^ 3) - 273.15)
T = Muxs(i + 8)
Select Case i + 8
Case 10: Tdat = T
Case 11: Tmtr = T
Case 12: Tair = T
Case 13: Tsmp = T
Case 14: Tpsp = T
Case 15: Tnc = T
Case 16: Tsyn = T
End Select
End If
End Select
Next i
End Select
M02line = True
Case "P"
' "Rref 350 " 'R350
' "Target 1 " 'Ttlo
' "Target 2 " 'Tthi
' "Window " 'Twin
' "Mixer " 'Tmix
' "Dblr Amp " 'Tamp
' "Noise D. " 'Tnd
' "Rref 600 " 'R600
' R(0) = 350 'rref low
' R(7) = 600 'rref hi
R7M0 = 250# 'R(7)-R(0)
AA = -244.3364635: Bb = 0.462418: cC = 0.0000588: DD = -0.000000013
' Pt: 2436 14145 14143 16383 14187 14163 14028 14768
Call ParseString2(Line$, " " + vbCrLf, s$(), n%)
For i = 1 To n
Mux(i + 16) = Val(s$(i))
Ct(i - 1) = Mux(i + 16)
Next i
For i = 0 To 7
r(i) = 350# + R7M0 * (Ct(i) - Ct(0)) / (Ct(7) - Ct(0))
T = AA + Bb * r(i) + cC * r(i) ^ 2 + DD * r(i) ^ 3
Muxs(i + 17) = T
Select Case i
Case 0: R350 = T
Case 1: Ttg1 = T
Case 2: Ttg2 = T
Case 3: Twin = T
Case 4: Tmix = T
Case 5: Tamp = T
Case 6: Tnd = T
Case 7: R600 = T
End Select
Next i
Ptline = True
Ttgt = (Ttg1 + Ttg2) / 2#
Muxs(0) = Ttgt
If WriteSMdata Then
If SMlu = 0 Then
SMlu = FreeFile
Open "c:\mtp\data\ngv\start08\20080428\sm.txt" For Output As SMlu
X$ = "UTks" + vbTab + "Zp" + vbTab + "Pitch" + vbTab + "Roll" + vbTab + "SMdif" + vbTab + "Tdat" + vbTab + "Tsynth" + vbTab + "Tmix"
Print #SMlu, X$
End If
Print #SMlu, UTsec / 1000; vbTab; ZpAvg; vbTab; PitchAvg; vbTab; RollAvg; vbTab; SMcmd - SMenc; vbTab; Tdat; vbTab; Tsyn; vbTab; Tmix
End If
Case "E"
' E 011467 015347 016344 009836 013969 014870
Call ParseString2(Line$, " " + vbCrLf, s$(), n%)
For j = Nel + 1 To Ncts
For i = 1 To Channels
C(i, j) = Val(s$(i + Channels * (j - Nel - 1)))
Next i
Next j
Eline = True
Case "I"
Select Case Left$(Line$, 4)
Case "IWG1"
' IWG1,20010920T151645,14.642,-96.4235,4229.12,,4255.74,4235.87,137.172,134.938,209.011,0.162247,0.0558355,185.039,189.068,4.23184,2.98645,0.90837,0.488137,2.95111,5.49085,-7.03531,14.0805,614.777,72.7016,860.533,8.57255,78.2577,0.0569099,0.821413,0.749384,,
Decode_NGV Line$
MapGVtoOther
IWGline = True
Case Else
'Instrument on line
Beep
End Select
End Select
End Sub
Sub GetECMWFvalues
Sub GetECMWFvalues(UTsec&, UT&, P!, T!, PTWfile$)
Dim i%, A$, HeaderCount%, Tf!, Ts!
Static PTWlu%
If PTWlu = 0 Then
PTWlu = FreeFile
Open PTWfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #PTWlu, A$: Next i
Else
If EOF(PTWlu) Then
Close PTWlu
Exit Sub
End If
End If
If UTsec < 0 Then
Line Input #PTWlu, A$
UT = Val(Left$(A$, 10))
Else
Do 'Catch up
Line Input #PTWlu, A$
UT = Val(Left$(A$, 10))
Loop Until (UT >= UTsec Or EOF(PTWlu))
End If
If EOF(PTWlu) Then UT = -1: Exit Sub
' UT(s) T(C)
' 22020.00 -70.0765 11.1022 -5.1630 -8.9322 -0.0000 43.7356 80.6196 -0.1199 0.0000 0.1755 80.2876 380.8031 86.3063 373.2655 82.4692 377.4995 80.6904 380.0693
' 22030.00 -70.2081 10.9010 -5.1943 -8.9611 -0.0004 43.6481 80.5197 -0.1191 0.0000 0.1657 80.2412 380.9119 86.3128 373.2581 82.4692 377.4954 80.6904 380.0667
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
P = -99999#
T = Val(Mid$(A$, 13, 9)) + cTo
'Debug.Print UT; P; fPtoZ(P)
End Sub
Sub GetNGline
Sub GetNGline(NGVlu, UTsec&, P!, T!, mT!, mLatitude!, mLongitude!, mZg!, mZp!, mPitch!, mRoll!)
Dim i%, j%, A$, HeaderCount%, X!, Utime&, TAS!
Static PTWlu%, LastT!, LastP!, LastWspd!, LastWdir!, LastZp!, LastZg!
' UTC ATRL AT_A GGALT GGLAT GGLON PALT PITCH PSFC ROLL TAS_A Time
'22:24:24 -41.8909 -43.3967 9302.98 36.6453 -118.323 9150.33 2.21617 300.439 -0.0850106 241.245 13954
'19:00:04 13.1145 12.9608 1707.68 39.9024 -105.101 1615.38 -1.77342 833.586 0.0328811 0 1694
Line Input #NGVlu, A$
'UTsec , Latitude, Longitude, ALTkm, T1, T2
HHMMSS$ = Left$(A$, 8)
UTsec = fTstringToSec(HHMMSS$, True)
i = InStr(10, A$, " ")
mT = Val(Mid$(A$, 10, i - 10)) + cTo
j = InStr(i + 1, A$, " ")
T = Val(Mid$(A$, i + 1, j - i)) + cTo
i = InStr(j + 1, A$, " ")
mZg = Val(Mid$(A$, j + 1, i - j)) / 1000#
j = InStr(i + 1, A$, " ")
mLatitude = Val(Mid$(A$, i + 1, j - i))
i = InStr(j + 1, A$, " ")
mLongitude = Val(Mid$(A$, j + 1, i - j))
j = InStr(i + 1, A$, " ")
mZp = Val(Mid$(A$, i + 1, j - i)) / 1000#
i = InStr(j + 1, A$, " ")
mPitch = Val(Mid$(A$, j + 1, i - j))
j = InStr(i + 1, A$, " ")
P = Val(Mid$(A$, i + 1, j - i))
i = InStr(j + 1, A$, " ")
mRoll = Val(Mid$(A$, j + 1, i - j))
j = InStr(i + 1, A$, " ")
TAS = Val(Mid$(A$, i + 1, j - i))
i = InStr(j + 1, A$, " ")
Utime = (Mid$(A$, j + 1, Len(A$) - j))
End Sub
Sub MapGVtoOther
Sub MapGVtoOther()
'Public yyyymmddI$, UTsecI&, pALTI!, gALTI!, rALTI!, pALTftI!, gALTfeetI!, OATnI!, OATnavI!, WspdI!, WdirI!
'Public UTsecNavI&, HeadingI!, PitchI!, RollI!, LatitudeI!, LongitudeI!, TASI!
yyyymmdd$ = yyyymmddI$
UTsec = UTsecI
pALT = pALTI
gALT = gALTI
rALT = rALTI
pALTft = pALTftI
' galtfeet = gALTfeetI
OATn = OATnI
OATnav = OATnavI
Wspd = WspdI
Wdir = WdirI
UTsecNav = UTsecNavI
Heading = HeadingI
Pitch = PitchI
Roll = RollI
Latitude = LatitudeI
Longitude = LongitudeI
TAS = TASI
End Sub
Sub Read_HPA
Sub Read_HPA()
Dim lu%, Filename$, A$, i%
Filename$ = MNpath$ + "Setup\" + Mission$ + "_HPA.txt"
' Check if there is a pressure altitude correction file
If Dir$(Filename$) = "" Then
Pcorr = 99#
Else
lu = FreeFile
Open Filename$ For Input As #lu
Do
Line Input #lu, A$
Loop Until Left$(A$, 8) = yyyymmdd$ Or EOF(lu)
If EOF(lu) Then
Pcorr = 99#
Else
Pcorr = Val(Right$(A$, Len(A$) - 9))
End If
Close lu
End If
End Sub
Sub ReadMissionRCSdo
Sub ReadMissionRCSdo(ByVal lu%, ByRef n%, ByRef V!())
Dim i%, j%, k%, A$
' Read l number per line, or several separated by a SINGLE space
' Terminate when a blank line is encountered.
i = 1
Input #lu, A$
k = 1
j = InStr(A$, " ")
If j > 0 Then
Do
V(i) = Mid(A$, k, j - k)
k = j + 1
j = InStr(k, A$, " ")
i = i + 1
If j = 0 Then
V(i) = Mid(A$, k, Len(A$) - k + 1)
Exit Do
End If
Loop
Else
V(i) = Val(A$)
End If
Do
Input #lu, A$
If A$ = "" Then Exit Do
k = 1
j = InStr(A$, " ")
If j > 0 Then
i = i + 1
Do
V(i) = Mid(A$, k, j - k)
k = j + 1
j = InStr(k, A$, " ")
i = i + 1
If j = 0 Then
V(i) = Mid(A$, k, Len(A$) - k + 1)
Exit Do
End If
Loop
Else
i = i + 1
V(i) = Val(A$)
End If
Loop
n = i
End Sub
Sub ReadMissionRCSprocess
Sub ReadMissionRCSprocess(lu%, Category$, EOFflag As Boolean)
Dim i0%, i1%, i2%, Cmd$, V$, i%, j%, response As Variant
Dim A$, rFLA!(1 To 20), n%
Select Case Category$
Case "GENERAL"
Do
If EOF(lu%) Then
EOFflag = True
Exit Sub
End If
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'Debug.Print cmd$
If Len(Cmd$) = 0 Then Exit Sub
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
Select Case Left$(Cmd$, i1% - 1)
Case "GenDate": Gendate$ = V$
Case "Ceiling": Ceiling = Val(V$)
Case "CycleTime": CycleTime = Val(V$)
Case "SU": SU$ = V$
Case "Nif": Nif = Val(V$)
Case "Nel": Nel = Val(V$)
Case "Nlo": Nlo = Val(V$)
Case "Nobs": Nobs = Val(V$)
Case "CH1LSBloss": CHnLSBloss(1) = Val(V$): CH1LSBloss = Val(V$)
Case "CH2LSBloss": CHnLSBloss(2) = Val(V$)
Case "CH3LSBloss": CHnLSBloss(3) = Val(V$)
Case Else
End Select
End If
Loop
Case "RC_ALTITUDES"
ReadMissionRCSdo lu, NFL, rFLA()
For i = 1 To NFL: FLA(i) = Int(rFLA(i) * 100#): Next i
Case "ELEVATION_ANGLES"
ReadMissionRCSdo lu, Nel, El()
Case "LO_FREQUENCIES"
ReadMissionRCSdo lu, Nlo, LO()
Case "OBSERVABLE_ERRORS"
ReadMissionRCSdo lu, Nobs, sOBrms()
Case "IF_BANDPASS"
For i = 1 To Nlo
For j = 1 To Nif
Input #lu, n, IFoff(i, j), IFwt(i, j)
IFoff(i, j) = IFoff(i, j) / 1000#
'Debug.Print n; IFoff(i, j), IFwt(i, j)
Next j
Next i
Case "EOF"
EOFflag = True
Exit Sub
Case Else
End Select
End Sub
Sub RCwrite2
Sub RCwrite2(iRC%, FQFN$)
Dim A As RCconfiguration2, lu%, i%, j%, k%, n%
Dim b As RC_Set_1FL, CreationDateTime As Date
' RC file - This is original RCwrite routine, which is no longer used.
' First record contains configuration information
' It is followed by one record for each flight level with RCs and related info
lu = FreeFile
Open FQFN For Random Access Read Write As lu Len = Len(A)
A.RCformat = RCformat(iRC)
CreationDateTime = Date + Time
A.CreationDateTime = CreationDateTime
A.RAOBfilename = RAOBfilename
A.RCfilename = RCfilename
A.RAOBcount = RAOBcount
A.LR1 = LR1 'LR above top of RAOB
A.zLRb = zLRb 'LR break altitude
A.LR2 = LR2 'LR above break altitude
A.RecordStep = RecordStep 'Record Step through available RAOBs
A.RAOBmin = MinimumRAOBz 'Minimum acceptable RAOB altitude
A.ExcessTamplitude = ExcessTamplitude 'Random Excess Noise Level on Ground
A.SURC = SURC$
A.Nobs = Nobs 'Number of observables
' Retrieval offset levels wrt flight level
A.Nret = Nret 'Number of retrieval levels
For i = 1 To Nret: A.dZ!(i) = dZ(i): Next i
' Flight levels (km)
A.NFL = NFL 'Number of flight levels
For i = 1 To NFL: A.Zr!(i) = Zr(i): Next i
' LO frequencies (GHz)
A.Nlo = Nlo 'Number of LO channels
For i = 1 To Nlo: A.LO!(i) = LO(i): Next i
' Scan mirror elevation angles
A.Nel = Nel 'Number of elevation angles
For i = 1 To Nel: A.El!(i) = El(i): Next i
' IF frequency offsets (GHz) and weights
A.Nif = Nif 'Number of IF frequencies
For j = 1 To Nif
A.IFoff2!(j) = IFoff2(j) 'IFoff2 is original single IF bandpass
A.IFwt2!(j) = IFwt2(j)
Next j
' A.RAOBbias = RAOBbias
' A.CH1LSBloss = CH1LSBloss
' For i = 1 To Channels
' A.CHnLSBloss(i) = CHnLSBloss(i)
' Next i
' Sensitivity matrix: iRC, NFL, Nlo, Nel, bias and slope
For i = 1 To NFL
For j = 1 To Nlo
For k = 1 To Nel
A.SmatrixN1!(i, j, k) = Smatrix(iRC, i, j, k, 1)
A.SmatrixN2!(i, j, k) = Smatrix(iRC, i, j, k, 2)
Next k
Next j
Next i
Put #lu%, 1, A
For n = 2 To NFL + 1
b.sBP = BP(iRC, n - 1, 16) 'Flight level pressure altitude (hPa)
For i = 1 To Nobs
b.sOBrms!(i) = OBrms(n - 1, i) '1-sigma apriori observable errors
b.sOBav!(i) = OBav(iRC, n - 1, i) 'Archive Average observables
Next i
'Debug.Print n - 1; OBrms(n - 1, 1); OBrms(n - 1, 30); b.sOBrms(30)
For i = 1 To Nret
b.sBPrl!(i) = BP(iRC, n - 1, i) 'Pressure at retrieval levels
b.sRTav!(i) = RTav(iRC, n - 1, i) 'Average T at retrieval levels
b.sRMSa!(i) = RMSa(iRC, n - 1, i) 'Variance in T at retrieval levels
b.sRMSe!(i) = RMSe(iRC, n - 1, i) 'Formal error in T at retrieval levels
For j = 1 To Nobs
b.Src!(i, j) = rc(iRC, n - 1, i, j) '33 retrieval levels, 30 observables
Next j
Next i
Put #lu%, n, b
DoEvents
Next n
Close lu
End Sub
Sub ReadMissionRCS
Sub ReadMissionRCS(Mission$, Category$, All As Boolean)
' Read Mission initialization parameters
' If ALL is TRUE, read all parameters
' If ALL is FALSE, read only the requested CATEGORY
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean, i%, j%, response As Variant
Dim A$, Cat$, EOFflag As Boolean
' Read MISSION_RCS.txt file
lu = FreeFile
Open SUpath$ + Mission$ + "_RCS.txt" For Input As lu
FIsize% = 0
FixPath = False
If All Then
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Right Bracket not found. Fix line number " + Str(FIsize%), vbOK
Exit Sub
End If
Cat$ = Mid$(Cmd$, 2, i0% - 2) 'Remove square brackets
Call ReadMissionRCSprocess(lu, Cat$, EOFflag)
If EOFflag Then GoTo Exit_Sub Else GoTo NextCategory
End If
Loop
Else
NextCategory2:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Right Bracket not found. Fix line number " + Str(FIsize%), vbOK
Exit Sub
End If
Cat$ = Mid$(Cmd$, 2, i0% - 2) 'Remove square brackets
If Cat$ = Category$ Then
Call ReadMissionRCSprocess(lu, Cat$, EOFflag)
'For i = 1 To Nobs: OBrms(i) = sOBrms(i): Next i
GoTo Exit_Sub
End If
GoTo NextCategory2
Else
GoTo NextCategory2
End If
End If
Exit_Sub:
Close (lu%)
Check_Category:
End Sub
Sub ReadMTPsetupINI
Sub ReadMTPsetupINI(Category$, AddItem$())
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean
If Len(Dir("C:\MTP\Setup\MTPsetup.INI")) = 0 Then
MsgBox "Unable to open C:\MTP\Setup\MTPsetup.INI", vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open "C:\MTP\Setup\MTPsetup.INI" For Input As lu%
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Right Bracket not found. Fix line number " + Str(FIsize%), vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Category$ Then 'Read setup info for only the requested program
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "SYSTEM"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "ProgramDrive$": ProgramDrive$ = V$
Case "DataDrive$": DataDrive$ = V$
Case "UID$": UID$ = V$
Case "DefaultRTmode"
DefaultRTmode = Val(V$)
If DefaultRTmode = 0 Then RealTime = False Else RealTime = True
Case "DataSourceMode"
DataSourceMode = Val(V$)
' cboSource.ListIndex = DataSourceMode
Case "DataDestinationMode"
DataDestinationMode = Val(V$)
' cboDestination.ListIndex = DataDestinationMode
Case "AlternateRoot"
If V$ = """""" Then Rdir1$ = "" Else Rdir1$ = Val(V$)
Case Else
End Select
End If
Loop
Case "cboDestination"
Case Else
End Select
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub ReadProgramSetup
Sub ReadProgramSetup(Program$, Category$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean
If Len(Dir("C:\MTP\Setup\ProgramSetup.INI")) = 0 Then
MsgBox "Unable to open C:\MTP\Setup\ProgramSetup.INI", vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open "C:\MTP\Setup\ProgramSetup.INI" For Input As lu%
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Right Bracket not found. Fix line number " + Str(FIsize%), vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Program$ Then 'Read setup info for only the requested program
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "CTC"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "LastY1": 'LastY1 = Val(V$)
Case "LastY2": 'LastY2 = Val(V$)
Case "LastZ1": 'LastZ1 = Val(V$)
Case "LastZ2": 'LastZ1 = Val(V$)
Case Else
End Select
End If
Loop
Case Else
End Select
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub ReadPlatform
Sub ReadPlatform(Platform$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean, i%, j%, response As Variant
Dim Filename$
' Read new mjm .INI Platform Format
'Exit Sub
On Error GoTo CopyCal
lu% = FreeFile
Carryon:
Open Filename$ For Input As lu%
CalFileFormat = CInt(fReadFirstNumber(lu))
'MsgBox "ReadCAL Entry!", vbOKOnly
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If FIsize% = 2 Then 'Extract PI$
Pi$ = Right$(Cmd$, Len(Cmd$) - 7)
'Debug.Print Pi$
End If
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
'Print "Right Bracket not found. Fix line number ", FIsize%
Stop
End If
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "GENERAL"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'Debug.Print cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
Select Case Left$(Cmd$, i1% - 1)
Case "GenDate": Gendate$ = V$
Case "FltDate": FltDate$ = V$
Case "UTstart"
Case "UTend"
Case "Channels": Channels = Val(V$)
Case "Nel": Nel = Val(V$)
Case "Emissivity": Emissivity = Val(V$)
Case "Reflectivity": Reflectivity = Val(V$)
Case "DeltaTmin": DeltaTmin = Val(V$)
Case Else
End Select
End If
Loop
Case "FIT_INFO"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "Nfit": Nfit = Val(V$)
Case "Offset": NP$(1) = V$: GOF(1) = 0#
Case "FitVar1": NP$(2) = V$
Case "FitVar2": NP$(3) = V$
Case "FitVar3": NP$(4) = V$
Case "FitVar4": NP$(5) = V$
Case "GEC11": GEC(1, 1) = Val(V$)
Case "GEC12": GEC(1, 2) = Val(V$)
Case "GEC13": GEC(1, 3) = Val(V$)
Case "GEC14": GEC(1, 4) = Val(V$)
Case "GEC15": GEC(1, 5) = Val(V$)
Case "GEC21": GEC(2, 1) = Val(V$)
Case "GEC22": GEC(2, 2) = Val(V$)
Case "GEC23": GEC(2, 3) = Val(V$)
Case "GEC24": GEC(2, 4) = Val(V$)
Case "GEC25": GEC(2, 5) = Val(V$)
Case "GEC31": GEC(3, 1) = Val(V$)
Case "GEC32": GEC(3, 2) = Val(V$)
Case "GEC33": GEC(3, 3) = Val(V$)
Case "GEC34": GEC(3, 4) = Val(V$)
Case "GEC35": GEC(3, 5) = Val(V$)
Case "GOF1": GOF(2) = Val(V$)
Case "GOF2": GOF(3) = Val(V$)
Case "GOF3": GOF(4) = Val(V$)
Case "GOF4": GOF(5) = Val(V$)
Case "TARGET":
TGToffset = Val(V$)
' MsgBox "ReadCAL:" + Str(TGToffset), vbOKOnly
Case "MIXER": MXRoffset = Val(V$)
Case Else
End Select
End If
Loop
Case "WINDOW_CORRECTIONS"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, 3)
Case "WCT"
i = Val(Mid$(Cmd$, 4, 1))
j = Val(Mid$(Cmd$, 5, 2))
WINcor(i, j) = Val(V$)
Case Else
End Select
End If
Loop
Case "EOF"
Exit Sub
Case Else
End Select
End If
Loop
Exit_Sub:
Close (lu%)
AC$ = Mid$(Rdir$, 2, 2)
Root$ = Drive$ + Rdir$
Path$ = Root$ + Mission$ + "\" + yyyymmdd$ + "\" 'Just in case!
yymmdd$ = Right$(yyyymmdd$, 6)
Exit Sub
CopyCal:
response = MsgBox("Calfile has not been copied to flight directory!" + vbCrLf + " Do you wish to copy the default Calfile?", vbYesNo)
If response = vbYes Then
'frmMTPbin.cmdCopyCal_Click
GoTo Carryon
Else
Stop
Exit Sub
End If
End Sub
Sub ReadPTZtoArray
Sub ReadPTZtoArray(ZpMin!)
Dim Prefix$, PTWfile$, Pr!, Tr!, i&, Quit As Boolean, UT&, param!(1 To 16)
' Read 1 Hz Nav data into P, T and Z arrays
' iMax
Prefix$ = Right$(RAWextension$, 2)
PTWfile$ = MNpath$ + Prefix$ + "\" + Prefix$ + yyyymmdd$ + fACext(AC$)
UTsec = -1
Quit = True 'Set TRUE to force STATIC logical unit to be set to 0
Do
Call GetNAVvalues(Prefix$, UTsec&, UT&, Pr!, Tr!, param!(), PTWfile$, Quit)
Loop Until Tr < 999# And fPtoZ(Pr) > ZpMin
Tptz!(1) = Tr
Pptz!(1) = Pr
Zptz!(1) = fPtoZ(Pr)
UTptz = UT - 1 'So UT = UTptz + i
i = 1
Do 'Read nav PT values into memory
i = i + 1
Call GetNAVvalues(Prefix$, UTsec&, UT&, Pr!, Tr!, param!(), PTWfile$, Quit)
If Tr > 999 Then Exit Do
Tptz!(i) = Tr
Pptz!(i) = Pr
Zptz!(i) = fPtoZ(Pr)
Loop Until Quit
iPTZ = i
End Sub
Sub BINread
Sub BINread(lu%, Record%)
Dim A As REFrecord, i%, j%, X!
' Record 1 is FI record
' Record 2 is Limits record
' Record 3, 4 and 5 are spares
Get #lu%, Record% + HiddenRecords, A
GoodScan = A.GoodScan
MakeWord = A.MakeWord
Cycle = A.Cycle
UTsec = A.UTsec
UTsecMTP = A.UTsecMTP
UTsecNav = A.UTsecNav
TTO = A.TTO
pALT = A.pALT
gALT = A.gALT
rALT = A.rALT
mALT = A.mALT
Pitch = A.Pitch
Roll = A.Roll
Latitude = A.Latitude
Longitude = A.Longitude
Heading = A.Heading
TAS = A.TAS
Wspd = A.Wspd
Wdir = A.Wdir
Elcor = A.Elcor
ElCorUsed = A.ElCorUsed
OATnav = A.OATnav
OATmms = A.OATmms
OATmtp = A.OATmtp
TTMA = A.TTMA
TMMA = A.TMMA
TWMA = A.TWMA
For i% = 1 To Channels
RFImask(i) = A.RFImask(i)
For j% = 1 To 12
C(i%, j%) = A.Counts(i%, j%)
CMA(i, j) = A.CMA(i, j)
Next j%
Next i%
Muxs(0) = A.Muxs(0)
For i% = 1 To 16
Muxs(i%) = A.Muxs(i%)
Mux(i%) = A.Mux(i%)
Next i%
' Muxs(i) Parameter
' 00 Ttgt
' 01 Tnd
' 02 Tlo1
' 03 Tlo2
' 04 Tifa
' 05 Tlo
' 06 Thi
' 07 ACC+
' 08 Twin
' 09 Tmtr
' 10
' 11 Vref
' 12 Tdc1
' 13 Tdc2
' 14 PS5
' 15 PS12
' 16 ACC-
Ttgt = A.Muxs(0) 'Either tgt lo or tgt hi
Tnd = A.Muxs(1)
Tlo1 = A.Muxs(2)
Tlo2 = A.Muxs(3)
Tifa = A.Muxs(4)
Ttgtlo = A.Muxs(5)
Ttgthi = A.Muxs(6)
ACCp = A.Muxs(7)
Twin = A.Muxs(8)
Tmtr = A.Muxs(9)
'asterisk = a.Muxs(10)
Vref = A.Muxs(11)
Tdc1 = A.Muxs(12) '11 on DC8
Tdc2 = A.Muxs(13) '12 on DC8
Vps5 = A.Muxs(14)
Vps12 = A.Muxs(15)
ACCm = A.Muxs(16)
dACC = ACCp - ACCm 'Peak positive acceleration minus peak negative acceleration
For i = 1 To Channels
dND(i) = C(i, 11) - C(i, 12)
CN(i) = dND(i)
CB(i) = C(i, 12) 'Channel i base counts
CS(i, LocHor) = C(i, LocHor)
Next i
dACC = ACCp - ACCm 'Peak positive acceleration minus peak negative acceleration
Tac = OATmtp
End Sub
Sub ERFopen
Sub ERFopen(ERFfile$)
' Open the default ERF file
ERFlu = FreeFile
FileFormatIn = fREFreadFileFormat(ERFfile$)
Select Case FileFormatIn
Case 32
Open ERFfile$ For Random Access Read Write As ERFlu Len = Len(REF)
Case 33, 0
Open ERFfile$ For Random Access Read Write As ERFlu Len = Len(REF2)
End Select
End Sub
Sub GetPTWvalues_All
Sub GetPTWvalues_All(UTsec&, UT&, Ps!, pt!, Ts!, PTWfile$)
' UTsec is requested UT
' UT is returned UT
Dim i%, A$, HeaderCount%, Tport!, Tstar!, Tf!
Static PTWlu%
If PTWlu = 0 Then
PTWlu = FreeFile
Open PTWfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #PTWlu, A$: Next i
Else
If EOF(PTWlu) Then
Close PTWlu
Exit Sub
End If
End If
Do 'Catch up
Line Input #PTWlu, A$
If 1 = 0 Then UT = Val(Left$(A$, 7)) Else UT = Val(Left$(A$, 6))
Loop Until (UT >= UTsec And Mid$(A$, 7, 6) <> "999.99") Or EOF(PTWlu)
' Loop Until UT >= UTsec Or EOF(PTWlu)
If EOF(PTWlu) Then UT = -1: Exit Sub
'Changing PTW formats!
'19990409
'UtSec BoxTemp RamPres VertDifPres HorzDifPres AirTemp AnaPxdTemp TAS StatPres DigPxdTemp
' 47385 23.02 0.77 -0.19 -1.40 296.55 35.73 11.41 1009.78 36.00
'
'19990912
'UtSec BoxTemp RamPres VertDifPres HorzDifPres AirTemp AnaPxdTemp System28 TAS StatPres DigPxdTemp
' 48801 36.20 1.08 0.45 -0.43 303.48 33.61 26.10 13.60 1011.89 28.00
'
'20020601
'CRYSTAL-FACE Format (NB Fast Air Temp <1 sec, but sampled at 1 sec, Slow Air Temp = 4 sec)
' UT FastTmp SlowTmp StatP PitotP RamP TAS
'60992 302.92 303.13 1017.47 1017.65 0.18 5.54
'60993 302.64 303.08 1017.45 1017.67 0.22 6.13
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
Select Case Val(yyyymmdd$)
Case Is < 19990912 'Format changed (see above)
Ps = Val(Mid$(A$, 64, 8))
Ts = Val(Mid$(A$, 40, 8)) + cTo
Case Is < 20020601
Ps = Val(Mid$(A$, 72, 8))
Ts = Val(Mid$(A$, 40, 8)) + cTo
Case Is < 20050800
'HAVE2 - Starboard and Port T probes
'UtSec BoxTemp StarAirTemp PortAirTemp PlateTemp System28 TAS PitotPres PPTemp StatPres SPTemp RamPres STatd PTatd
' 65378 46.18 304.23 304.38 35.18 26.66 67.31 1039.41 34.00 1012.84 34.00 26.57 2290.71 2286.16
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
If 1 = 0 Then 'Raw files from Tom are different from archived files!!
Ps = Val(Mid$(A$, 80, 9))
Tport = Val(Mid$(A$, 17, 9)) 'Kelvin
Tstar = Val(Mid$(A$, 26, 9)) 'Kelvin
Ts = Tport
Else 'Same as C-F, pre-AVE
' UT PortTmp StarTmp StatP PitotP RamP TAS
'67620 304.71 304.91 1012.83 1022.85 10.02 41.50
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
Ps = Val(Mid$(A$, 21, 7))
pt = Val(Mid$(A$, 29, 7))
Tport = Val(Mid$(A$, 7, 6)) 'Kelvin
Tstar = Val(Mid$(A$, 14, 6)) 'Kelvin
Ts = (Tport + Tstar) / 2# 'Average
End If
Case Else
Ps = Val(Mid$(A$, 21, 7))
Tport = Val(Mid$(A$, 7, 6)) 'Kelvin
Tstar = Val(Mid$(A$, 14, 6)) 'Kelvin
Ts = Tport
End Select
If Ps < 0 Then Ps = 0#
'Debug.Print UT; P; fPtoZ(P)
End Sub
Sub RCread2
Sub RCread2(iRC%, FQFN$)
Dim A As RCconfiguration2, lu%, i%, j%, k%, n%
Dim b As RC_Set_1FL, CreationDateTime As Date
' RC file -- This is original RCread routine which is no longer used. Kept so
' old RC files can be read or converted to new data structure
' Separate IF bandpasses are now used for each frequency. Originally only 1 was used
' First record contains configuration information
' It is followed by one record for each flight level with RCs and related info
lu = FreeFile
Open FQFN For Random Access Read Write As lu Len = Len(A)
Get #lu%, 1, A
RCformat(iRC) = A.RCformat
CreationDateTime = A.CreationDateTime
RAOBfilename = Trim(A.RAOBfilename)
RCfilename = Trim(A.RCfilename)
RCtemplate$(iRC) = RAOBfilename 'RC RAOB Template (eg BGDH__2003010912.RAOB2)
If Mid$(fGetFilename(RCtemplate$(iRC)), 6, 1) = "_" Then RAOBreanalysis = True
RAOBcount = A.RAOBcount
LR1 = A.LR1 'LR above top of RAOB
zLRb = A.zLRb 'LR break altitude
LR2 = A.LR2 'LR above break altitude
RecordStep = A.RecordStep 'Record Step through available RAOBs
MinimumRAOBz = A.RAOBmin 'Minimum acceptable RAOB altitude
ExcessTamplitude = A.ExcessTamplitude 'Random Excess Noise Level on Ground
SURC$ = A.SURC
Nobs = A.Nobs 'Number of observables
' Retrieval offset levels wrt flight level
Nret = A.Nret 'Number of retrieval levels
For i = 1 To Nret: dZ!(i) = A.dZ(i): Next i
' Flight levels (km)
NFL = A.NFL 'Number of flight levels
For i = 1 To NFL: Zr!(i) = A.Zr(i): Next i
' LO frequencies (GHz)
Nlo = A.Nlo 'Number of LO channels
For i = 1 To Nlo: LO!(i) = A.LO(i): Next i
' Scan mirror elevation angles
Nel = A.Nel 'Number of elevation angles
For i = 1 To Nel: El!(i) = A.El(i): Next i
' IF frequency offsets (GHz) and weights
Nif = A.Nif 'Number of IF frequencies
For j = 1 To Nif
IFoff!(1, j) = A.IFoff2(j)
IFwt!(1, j) = A.IFwt2(j)
Next j
For i = 2 To Nlo
For j = 1 To Nif
IFoff!(i, j) = IFoff(1, j)
IFwt!(i, j) = IFwt(1, j)
Next j
Next i
' Sensitivity matrix: iRC, NFL, Nlo, Nel, bias and slope
For i = 1 To NFL
For j = 1 To Nlo
For k = 1 To Nel
Smatrix(iRC, i, j, k, 1) = A.SmatrixN1!(i, j, k)
Smatrix(iRC, i, j, k, 2) = A.SmatrixN2!(i, j, k)
Next k
Next j
Next i
FoundSmatrix = True
For n = 2 To NFL + 1
Get #lu%, n, b
BP(iRC, n - 1, 16) = b.sBP 'Flight level pressure altitude (hPa)
For i = 1 To Nobs
OBrms!(n - 1, i) = b.sOBrms(i) '1-sigma apriori observable errors
OBav!(iRC, n - 1, i) = b.sOBav(i) 'Archive Average observables
Next i
'Debug.Print n - 1; OBrms(n - 1, 1); OBrms(n - 1, 30)
For i = 1 To Nret
BP!(iRC, n - 1, i) = b.sBPrl(i) 'Pressure at retrieval levels
RAav!(iRC, n - 1, i) = fPtoZ(b.sBPrl(i))
RTav!(iRC, n - 1, i) = b.sRTav(i) 'Average T at retrieval levels
RMSa!(iRC, n - 1, i) = b.sRMSa(i) 'Variance in T at retrieval levels
RMSe!(iRC, n - 1, i) = b.sRMSe(i) 'Formal error in T at retrieval levels
For j = 1 To Nobs
rc!(iRC, n - 1, i, j) = b.Src(i, j) '33 retrieval levels, 30 observables
Next j
Next i
DoEvents
Next n
Close lu
End Sub
Sub RCwrite
Sub RCwrite(iRC%, FQFN$)
Dim A As RCconfiguration, lu%, i%, j%, k%, n%
Dim b As RC_Set_1FL, CreationDateTime As Date
' RC file
' First record contains configuration information
' It is followed by one record for each flight level with RCs and related info
lu = FreeFile
Open FQFN For Random Access Read Write As lu Len = Len(A)
A.RCformat = RCformat(iRC)
CreationDateTime = Date + Time
A.CreationDateTime = CreationDateTime
A.RAOBfilename = RAOBfilename
A.RCfilename = RCfilename
A.RAOBcount = RAOBcount
A.LR1 = LR1 'LR above top of RAOB
A.zLRb = zLRb 'LR break altitude
A.LR2 = LR2 'LR above break altitude
A.RecordStep = RecordStep 'Record Step through available RAOBs
A.RAOBmin = MinimumRAOBz 'Minimum acceptable RAOB altitude
A.ExcessTamplitude = ExcessTamplitude 'Random Excess Noise Level on Ground
A.SURC = SURC 'SU (IFB) used to calculate RC set
A.Nobs = Nobs 'Number of observables
' Retrieval offset levels wrt flight level
A.Nret = Nret 'Number of retrieval levels
For i = 1 To Nret: A.dZ!(i) = dZ(i): Next i
' Flight levels (km)
A.NFL = NFL 'Number of flight levels
For i = 1 To NFL: A.Zr!(i) = Zr(i): Next i
' LO frequencies (GHz)
A.Nlo = Nlo 'Number of LO channels
For i = 1 To Nlo: A.LO!(i) = LO(i): Next i
' Scan mirror elevation angles
A.Nel = Nel 'Number of elevation angles
For i = 1 To Nel: A.El!(i) = El(i): Next i
' IF frequency offsets (GHz) and weights
A.Nif = Nif 'Number of IF frequencies
For i = 1 To Nlo
For j = 1 To Nif
A.IFoff!(i, j) = IFoff(i, j)
A.IFwt!(i, j) = IFwt(i, j)
Next j
Next i
A.RAOBbias = RAOBbias
A.CH1LSBloss = CH1LSBloss
For i = 1 To Channels
A.CHnLSBloss(i) = CHnLSBloss(i)
Next i
' Sensitivity matrix: iRC, NFL, Nlo, Nel, bias and slope
For i = 1 To NFL
For j = 1 To Nlo
For k = 1 To Nel
A.SmatrixN1!(i, j, k) = Smatrix(iRC, i, j, k, 1)
A.SmatrixN2!(i, j, k) = Smatrix(iRC, i, j, k, 2)
Next k
Next j
Next i
Put #lu%, 1, A
For n = 2 To NFL + 1
b.sBP = BP(iRC, n - 1, 16) 'Flight level pressure altitude (hPa)
For i = 1 To Nobs
b.sOBrms!(i) = OBrms(n - 1, i) '1-sigma apriori observable errors
b.sOBav!(i) = OBav(iRC, n - 1, i) 'Archive Average observables
Next i
'Debug.Print n - 1; OBrms(n - 1, 1); OBrms(n - 1, 30); b.sOBrms(30)
For i = 1 To Nret
b.sBPrl!(i) = BP(iRC, n - 1, i) 'Pressure at retrieval levels
b.sRTav!(i) = RTav(iRC, n - 1, i) 'Average T at retrieval levels
b.sRMSa!(i) = RMSa(iRC, n - 1, i) 'Variance in T at retrieval levels
b.sRMSe!(i) = RMSe(iRC, n - 1, i) 'Formal error in T at retrieval levels
For j = 1 To Nobs
b.Src!(i, j) = rc(iRC, n - 1, i, j) '33 retrieval levels, 30 observables
Next j
Next i
Put #lu%, n, b
DoEvents
Next n
Close lu
End Sub
Sub RCread
Sub RCread(iRC%, FQFN$)
Dim A As RCconfiguration, lu%, i%, j%, k%, n%
Dim b As RC_Set_1FL, CreationDateTime As Date, File$
' RC file
' First record contains configuration information
' It is followed by one record for each flight level with RCs and related info
lu = FreeFile
Open FQFN For Random Access Read Write As lu Len = Len(A)
Get #lu%, 1, A
RCformat(iRC) = A.RCformat
CreationDateTime = A.CreationDateTime
RAOBfilename = Trim(A.RAOBfilename)
RCfilename = Trim(A.RCfilename)
If Dir(RAOBfilename) = "" Then
File$ = RSpath$ + fGetFilename(RAOBfilename)
If Dir(File$) <> "" Then RAOBfilename = File$
End If
' Template based RAOB2 files used to be stored in for example
' C:\MTP\RAOB\Missions\TC4\ path
' They were moved in Dec 2007 to for example
' C:\MTP\Data\ER2\TC4\RAOB\ path
' This was done to keep all mission related RAOB information in the MTP\Data\ path
' This check is necessary because the RAOB2 file contains the path that the RCs were
' originally calculated in, which includes all RCs before Dec 2007
' If Mid$(RAOBfilename, 2, 20) = ":\MTP\RAOB\Missions\" Then
' RAOBfilename = MNpath$ + "RAOB\" + fGetFilename(RAOBfilename)
' End If
RCtemplate$(iRC) = RAOBfilename 'RC RAOB Template (eg BGDH__2003010912.RAOB2)
If Mid$(fGetFilename(RCtemplate$(iRC)), 6, 1) = "_" Then RAOBreanalysis = True
RAOBcount = A.RAOBcount
LR1 = A.LR1 'LR above top of RAOB
zLRb = A.zLRb 'LR break altitude
LR2 = A.LR2 'LR above break altitude
RecordStep = A.RecordStep 'Record Step through available RAOBs
MinimumRAOBz = A.RAOBmin 'Minimum acceptable RAOB altitude
ExcessTamplitude = A.ExcessTamplitude 'Random Excess Noise Level on Ground
SURC = A.SURC
Select Case Trim(SURC) 'SURC only written after 20060128
Case "DC8", "ER2S", "ER2T"
Case Else
SURC = "" 'Set to null string to avoid crap
End Select
Nobs = A.Nobs 'Number of observables
' Retrieval offset levels wrt flight level
Nret = A.Nret 'Number of retrieval levels
For i = 1 To Nret: dZ!(i) = A.dZ(i): Next i
' Flight levels (km)
NFL = A.NFL 'Number of flight levels
For i = 1 To NFL: Zr!(i) = A.Zr(i): Next i
' LO frequencies (GHz)
Nlo = A.Nlo 'Number of LO channels
For i = 1 To Nlo: LO!(i) = A.LO(i): Next i
' Scan mirror elevation angles
Nel = A.Nel 'Number of elevation angles
For i = 1 To Nel: El!(i) = A.El(i): Next i
' IF frequency offsets (GHz) and weights
Nif = A.Nif 'Number of IF frequencies
' For j = 1 To Nif
' IFoff!(i, j) = A.IFoff(i, j)
' IFwt!(i, j) = A.IFwt(i, j)
' Next j
For i = 1 To Nlo
For j = 1 To Nif
IFoff!(i, j) = A.IFoff(i, j)
IFwt!(i, j) = A.IFwt(i, j)
Next j
Next i
RAOBbias = A.RAOBbias
CH1LSBloss = A.CH1LSBloss
For i = 1 To Channels
CHnLSBloss(i) = CHnLSBloss(i)
Next i
' Sensitivity matrix: iRC, NFL, Nlo, Nel, bias and slope
For i = 1 To NFL
For j = 1 To Nlo
For k = 1 To Nel
Smatrix(iRC, i, j, k, 1) = A.SmatrixN1!(i, j, k)
Smatrix(iRC, i, j, k, 2) = A.SmatrixN2!(i, j, k)
Next k
Next j
Next i
FoundSmatrix = True
For n = 2 To NFL + 1
Get #lu%, n, b
BP(iRC, n - 1, 16) = b.sBP 'Flight level pressure altitude (hPa)
For i = 1 To Nobs
OBrms!(n - 1, i) = b.sOBrms(i) '1-sigma apriori observable errors
OBav!(iRC, n - 1, i) = b.sOBav(i) 'Archive Average observables
Next i
'Debug.Print n - 1; OBrms(n - 1, 1); OBrms(n - 1, 30)
For i = 1 To Nret
BP!(iRC, n - 1, i) = b.sBPrl(i) 'Pressure at retrieval levels
RAav!(iRC, n - 1, i) = fPtoZ(b.sBPrl(i))
RTav!(iRC, n - 1, i) = b.sRTav(i) 'Average T at retrieval levels
RMSa!(iRC, n - 1, i) = b.sRMSa(i) 'Variance in T at retrieval levels
RMSe!(iRC, n - 1, i) = b.sRMSe(i) 'Formal error in T at retrieval levels
For j = 1 To Nobs
rc!(iRC, n - 1, i, j) = b.Src(i, j) '33 retrieval levels, 30 observables
Next j
Next i
DoEvents
Next n
Close lu
End Sub
Sub REF2readFLTINFO
Sub REF2readFLTINFO(FQFN$)
Dim i%, lu%, iNRC%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Get #lu%, 1, FIR2
Close lu
Mission$ = Trim(FIR2.Mission)
FileFormatIn = FIR2.Fileformat
FltNumber$ = Trim(FIR2.FltNumber)
Pi$ = FIR2.Pi
Yeer = FIR2.Yeer
Doy = FIR2.Doy
yyyymmdd = FIR2.yyyymmdd
FlightDate = fDate(yyyymmdd$)
TotalCycles = FIR2.TotalCycles
Channels = FIR2.Channels
Drive$ = UCase$(FIR2.Drive) 'eg C:
Rdir$ = UCase$(Trim(FIR2.Rdir)) 'eg \DC8\
Rdir2$ = Rdir1$ + "\MTP\Data" + Rdir$ 'eg \MTP\Data\DC8\
Platform$ = Mid$(Rdir$, 2, Len(Rdir$) - 2) 'eg DC8
AC$ = Mid$(Rdir$, 2, 2) 'eg DC
Root$ = Drive$ + Rdir2$ 'eg C:\MTP\Data\DC8\
MNpath$ = Root$ + Mission$ + "\" 'eg C:\MTP\Data\DC8\SOLVE\
Call DirCheck(Root$, Mission$)
RCpath$ = MNpath$ + "RC\" 'eg C:\MTP\Data\DC8\SOLVE\RC\
Call DirCheck(MNpath, "RC")
RSpath$ = MNpath$ + "RAOB\" 'eg C:\MTP\Data\DC8\SOLVE\RAOB\
Call DirCheck(MNpath, "RAOB")
MPpath$ = MNpath$ + "MP\" 'eg C:\MTP\Data\DC8\SOLVE\MP\
Call DirCheck(MNpath, "MP")
SUpath$ = MNpath$ + "Setup\" 'eg C:\MTP\Data\DC8\SOLVE\Setup\
Call DirCheck(MNpath, "Setup")
Path$ = MNpath$ + yyyymmdd$ + "\" 'eg C:\MTP\Data\DC8\SOLVE\20000120\
Call DirCheck(MNpath, yyyymmdd$)
PathDot$ = Path$ + AC$ + yyyymmdd$ + "." 'eg C:\MTP\Data\DC8\SOLVE\20000120\DC20000120.
yymmdd$ = Right$(yyyymmdd$, 6)
RCs$ = Left$(AC$, 1) + "RC"
' Default Fully-Qualified File Names
BINfile$ = PathDot$ + "BIN"
CALfile$ = PathDot$ + "CAL"
ERFfile$ = PathDot$ + "ERF"
INPfile$ = PathDot$ + "INP"
LOGfile$ = PathDot$ + "LOG"
MMSfile$ = MNpath$ + "MMS\MM" + yyyymmdd$ + "." + Platform$
RAOBfile$ = RSpath$ + Mission$ + ".RAOB2"
RAWfile$ = PathDot$ + "RAW"
REFfile$ = PathDot$ + "REF"
RTSfile$ = PathDot$ + "RTS"
OUTfile$ = PathDot$ + "OUT"
MPfile$ = MPpath$ + "MP" + yyyymmdd$ + "." + Platform$
' USEfile$ = RCpath$ + USE5$ + ".USE"
Pgm$ = Trim(FIR2.Pgm)
USE5$ = FIR2.USE5
SU$ = RTrim(FIR2.SU)
NFL = FIR2.NFL
For i = 1 To NFL: FLA(i) = FIR2.FLA(i): Next i
PgmDrive$ = FIR2.PgmDrive
Algorithm = FIR2.Algorithm
MRIavg = FIR2.MRIavg
MRIrms = FIR2.MRIrms
utMTPcor = FIR2.utMTPcor
DTavg = FIR2.DTavg
DTrms = FIR2.DTrms
ALTfujCONST = FIR2.ALTfujCONST
ALTfujSLOPE = FIR2.ALTfujSLOPE
OATnavCOR = FIR2.OATnavCOR
CalSource = Trim(FIR2.CalSource)
GainScale = FIR2.GainScale
REFsource = FIR2.REFsource
OATsource = FIR2.OATsource
' OATsource: 1=MTP, 2=A/C, 3=MMS
' GainScale: 1=EQN, 2=ND, 3=OAT
' REFsource: 1=TGT, 2=OAT
If GainScale = 0 Then 'Undefined, generate new definition
Select Case CalSource$
Case "DADStgt": GainScale = 3: REFsource = 2: OATsource = 2
Case "GAIN_EQN": GainScale = 1: REFsource = 1: OATsource = 2
Case "OATnav": GainScale = 3: REFsource = 1: OATsource = 2
Case "MMS": GainScale = 3: REFsource = 1: OATsource = 3
Case "DADS": GainScale = 3: REFsource = 1: OATsource = 2
Case "ND": GainScale = 2: REFsource = 1: OATsource = 2
End Select
End If
UseMMSpALT = FIR2.UseMMSpALT
LAT1 = FIR2.LAT1
LAT2 = FIR2.LAT2
LAT3 = FIR2.LAT3
LAT4 = FIR2.LAT4
UserLATs = FIR2.UserLATs
EnableCalfile = FIR2.EnableCalfile
DoAll = FIR2.DoAll
DoAllMask = FIR2.DoAllMask
EditTropAlt = FIR2.EditTropAlt
TropAltMin = FIR2.TropAltMin
TropAltMax = FIR2.TropAltMax
TropAltPC = FIR2.TropAltPC
EditRetAlt = FIR2.EditRetAlt
RetAltMin = FIR2.RetAltMin
RetAltMax = FIR2.RetAltMax
RetAltPC = FIR2.RetAltPC
EditZtOff = FIR2.EditZtOff
ZtOffA = FIR2.ZtOffA
ZtOffB = FIR2.ZtOffB
ZtOffPC = FIR2.ZtOffPC
EditTemperature = FIR2.EditTemperature
TemperatureMin = FIR2.TemperatureMin
TemperatureMax = FIR2.TemperatureMax
TemperaturePC = FIR2.TemperaturePC
EditPitch = FIR2.EditPitch
ePitchMin = FIR2.ePitchMin
ePitchMax = FIR2.ePitchMax
PitchPC = FIR2.PitchPC
EditRoll = FIR2.EditRoll
eRollMin = FIR2.eRollMin
eRollMax = FIR2.eRollMax
RollPC = FIR2.RollPC
EditNav = FIR2.EditNav
NavMin = FIR2.NavMin
NavMax = FIR2.NavMax
NavQualPC = FIR2.NavQualPC
EditTA = FIR2.EditTA
TAmin = FIR2.TAmin
TAmax = FIR2.TAmax
TAqualPC = FIR2.TAqualPC
EditCts = FIR2.EditCts
CtsMin = FIR2.CtsMin
CtsMax = FIR2.CtsMax
CtsQualPC = FIR2.CtsQualPC
EditCycle = FIR2.EditCycle
CycleQualPC = FIR2.CycleQualPC
EditTtgt = FIR2.EditTtgt
TtgtMin = FIR2.TtgtMin
TtgtMax = FIR2.TtgtMax
TtgtPC = FIR2.TtgtPC
EditNlev = FIR2.EditNlev
NlevMin = FIR2.NlevMin
NlevMax = FIR2.NlevMax
NlevPC = FIR2.NlevPC
EditRAWbad = FIR2.EditRAWbad
RAWbadmin = FIR2.RAWbadmin
RAWbadmax = FIR2.RAWbadmax
RAWbadPC = FIR2.RAWbadPC
EditRate = FIR2.EditRate
RateMin = FIR2.RateMin
RateMax = FIR2.RateMax
RatePC = FIR2.RatePC
EditOATtrop = FIR2.EditOATtrop
OATtropPC = FIR2.OATtropPC
OATzt10 = FIR2.OATzt10
Tzt10 = FIR2.Tzt10
OATzt20 = FIR2.OATzt20
Tzt20 = FIR2.Tzt20
OATks10 = FIR2.OATks10
OATks20 = FIR2.OATks20
OATzt11 = FIR2.OATzt11
Tzt11 = FIR2.Tzt11
OATzt21 = FIR2.OATzt21
Tzt21 = FIR2.Tzt21
OATks11 = FIR2.OATks11
OATks21 = FIR2.OATks21
OATzt12 = FIR2.OATzt12
Tzt12 = FIR2.Tzt12
OATzt22 = FIR2.OATzt22
Tzt22 = FIR2.Tzt22
OATks12 = FIR2.OATks12
OATks22 = FIR2.OATks22
OATzt13 = FIR2.OATzt13
Tzt13 = FIR2.Tzt13
OATzt23 = FIR2.OATzt23
Tzt23 = FIR2.Tzt23
OATks13 = FIR2.OATks13
OATks23 = FIR2.OATks23
'
OATzt14 = FIR2.OATzt14
Tzt14 = FIR2.Tzt14
OATzt24 = FIR2.OATzt24
Tzt24 = FIR2.Tzt24
' HISTORY information
CALversion = FIR2.CALversion
MAKEversion = FIR2.MAKEversion
EDITversion = FIR2.EDITversion
FLTINFOversion = FIR2.FLTINFOversion
Tstamp = FIR2.Tstamp
RAWstamp = FIR2.RAWstamp
MMSstamp = FIR2.MMSstamp
REFstamp = FIR2.REFstamp
ERFstamp = REFstamp
ERFstamp = FIR2.ERFstamp
CTCstamp = FIR2.CTCstamp
Ncts = FIR2.Ncts
If Ncts = 0 Then Ncts = 12
ATPrange = FIR2.ATPrange
If ATPrange = 0 Then ATPrange = 20
End Sub
Function fREFreadFileFormat
Function fREFreadFileFormat(FQFN$)
Dim lu%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Get #lu%, 1, FIR
Close lu
fREFreadFileFormat = FIR.Fileformat
End Function
Sub REF2writeCALFILE
Sub REF2writeCALFILE(FQFN$)
Dim i%, j%, lu%, iNRC%
CFR2.Gendate = Gendate$
For i = 1 To 10
CFR2.WCTdates(i) = WCTdates$(i)
Next i
CFR2.UTstart = UTstart
CFR2.UTend = UTend
CFR2.Channels = Channels
CFR2.Nel = Nel
CFR2.Emissivity = Emissivity
CFR2.Reflectivity = Reflectivity
CFR2.DeltaTmin = DeltaTmin
CFR2.RHS = RHS
CFR2.LocHor = LocHor
CFR2.Targets = Targets
' "FIT_INFO"
CFR2.Nfit = Nfit
For i = 1 To Nfit
CFR2.NP(i) = NP$(i)
Next i
For i = 1 To Channels
CFR2.GOF(i) = GOF(i)
For j = 1 To Nfit
CFR2.GEC(i, j) = GEC(i, j)
Next j
Next i
aTGToffset(0) = TGToffset
aMXRoffset(0) = MXRoffset
aNAVoffset(0) = NAVoffset
aNDoffset(0) = NDoffset
CFR2.aTGToffset(0) = aTGToffset(0)
CFR2.aMXRoffset(0) = aMXRoffset(0)
CFR2.aNAVoffset(0) = aNAVoffset(0)
CFR2.aNDoffset(0) = aNDoffset(0)
CFR2.aTGToffset(1) = aTGToffset(1)
CFR2.aMXRoffset(1) = aMXRoffset(1)
CFR2.aNAVoffset(1) = aNAVoffset(1)
CFR2.aNDoffset(1) = aNDoffset(1)
CFR2.aTGToffset(2) = aTGToffset(2)
CFR2.aMXRoffset(2) = aMXRoffset(2)
CFR2.aNAVoffset(2) = aNAVoffset(2)
CFR2.aNDoffset(2) = aNDoffset(2)
CFR2.aTGToffset(3) = aTGToffset(3)
CFR2.aMXRoffset(3) = aMXRoffset(3)
CFR2.aNAVoffset(3) = aNAVoffset(3)
CFR2.aNDoffset(3) = aNDoffset(3)
' "WINDOW_CORRECTIONS"
CFR2.EnableWCT = EnableWCT
For i = 1 To Channels
For j = 1 To Nel
CFR2.WINcor(i, j) = WINcor(i, j)
Next j
Next i
' RAW counts editting criteria
CFR2.CMAcycles = CMAcycles
CFR2.CMAcycles2 = CMAcycles2
CFR2.RFIthreshold = RFIthreshold
CFR2.RFIiterations = RFIiterations
CFR2.RFIiterations2 = RFIiterations2
CFR2.MUXthreshold = MUXthreshold
CFR2.BadCycles = BadCycles
CFR2.Badcycles2 = Badcycles2
CFR2.UseMAforCB = UseMAforCB
CFR2.UseMAforCS = UseMAforCS
CFR2.UseMAforCSgain = UseMAforCSgain
CFR2.UseMAforCN = UseMAforCN
CFR2.UseMAforTtgt = UseMAforTtgt
CFR2.UseMAforTifa = UseMAforTifa
CFR2.RAWextension = RAWextension
' Gain Limits
For i = 1 To Channels
CFR2.GeqnMin(i) = GeqnMin(i)
CFR2.GeqnMax(i) = GeqnMax(i)
CFR2.GnavMin(i) = GnavMin(i)
CFR2.GnavMax(i) = GnavMax(i)
CFR2.GndMin(i) = GndMin(i)
CFR2.GndMax(i) = GndMax(i)
Next i
' Channel Weights
For i = 1 To 3: CFR2.ChInfo(i) = ChInfo(i): Next i
' Fit Region
CFR2.TBfitX1 = TBfitX1
CFR2.TBfitX2 = TBfitX2
CFR2.TBfitY1 = TBfitY1
CFR2.TBfitY2 = TBfitY2
' Noise Diode Noise Temperatures
For i = 1 To Channels
CFR2.Cnd0(i) = Cnd0(i)
CFR2.Cnd1(i) = Cnd1(i)
CFR2.Cnd2(i) = Cnd2(i)
Next i
CFR2.TrefND = TrefND
CFR2.MTPyaw = MTPyaw
CFR2.MTPpitch = MTPpitch
CFR2.MTProll = MTProll
CFR2.MTPfiduciary = MTPfiduciary
CFR2.fEcCount = fEcCount
For i = 1 To 10
CFR2.ElSUI(i) = ElSUI(i)
Next i
CFR2.NRC = NRC
For i = 0 To NRC - 1
CFR2.Reg(i) = Reg(i)
CFR2.RCformat(i) = RCformat(i)
CFR2.RCuse(i) = RCuse(i)
Next i
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Put #lu%, 3, CFR2
Close lu
DoEvents
End Sub
Sub REF2writeFLTINFO
Sub REF2writeFLTINFO(FQFN$)
Dim i%, lu%, iNRC%
' Only allow DoAll flag to be set in default FLTINFO file!!!
'If FQFN$ <> "C:\MTP\Setup\FLTINFO.REF" Then DoAll = False
ReadSETUP ("SYSTEM")
Drive$ = DataDrive$
PgmDrive$ = ProgramDrive$
FIR2.Tstamp = Date + Time
FIR2.RAWstamp = RAWstamp
FIR2.REFstamp = REFstamp
FIR2.ERFstamp = ERFstamp
FIR2.CTCstamp = CTCstamp
FIR2.Mission = Mission$
FIR2.Fileformat = FileFormatOut
FIR2.FltNumber = FltNumber$
FIR2.Pi = Pi$
FIR2.Yeer = Yeer
FIR2.Doy = Doy
FIR2.yyyymmdd = yyyymmdd
FIR2.TotalCycles = TotalCycles
FIR2.Channels = Channels
FIR2.Drive = Drive$
FIR2.Rdir = Rdir$
FIR2.Path = Path$
FIR2.Pgm = Pgm$
FIR2.USE5 = USE5$
FIR2.SU = SU$
FIR2.NFL = NFL
For i = 1 To NFL: FIR2.FLA(i) = FLA(i): Next i
FIR2.PgmDrive = PgmDrive$
FIR2.Algorithm = Algorithm
FIR2.MRIavg = MRIavg
FIR2.MRIrms = MRIrms
FIR2.utMTPcor = utMTPcor
FIR2.DTavg = DTavg
FIR2.DTrms = DTrms
FIR2.ALTfujCONST = ALTfujCONST
FIR2.ALTfujSLOPE = ALTfujSLOPE
FIR2.OATnavCOR = OATnavCOR
FIR2.CalSource = CalSource
FIR2.GainScale = GainScale
FIR2.REFsource = REFsource
FIR2.OATsource = OATsource
FIR2.UseMMSpALT = UseMMSpALT
FIR2.LAT1 = LAT1
FIR2.LAT2 = LAT2
FIR2.LAT3 = LAT3
FIR2.LAT4 = LAT4
FIR2.UserLATs = UserLATs
FIR2.EnableCalfile = EnableCalfile
FIR2.DoAll = DoAll
FIR2.DoAllMask = DoAllMask
FIR2.EditTropAlt = EditTropAlt
FIR2.TropAltMin = TropAltMin
FIR2.TropAltMax = TropAltMax
FIR2.TropAltPC = TropAltPC
FIR2.EditRetAlt = EditRetAlt
FIR2.RetAltMin = RetAltMin
FIR2.RetAltMax = RetAltMax
FIR2.RetAltPC = RetAltPC
FIR2.EditZtOff = EditZtOff
FIR2.ZtOffA = ZtOffA
FIR2.ZtOffB = ZtOffB
FIR2.ZtOffPC = ZtOffPC
FIR2.EditTemperature = EditTemperature
FIR2.TemperatureMin = TemperatureMin
FIR2.TemperatureMax = TemperatureMax
FIR2.TemperaturePC = TemperaturePC
FIR2.EditPitch = EditPitch
FIR2.ePitchMin = ePitchMin
FIR2.ePitchMax = ePitchMax
FIR2.PitchPC = PitchPC
FIR2.EditRoll = EditRoll
FIR2.eRollMin = eRollMin
FIR2.eRollMax = eRollMax
FIR2.RollPC = RollPC
FIR2.EditNav = EditNav
FIR2.NavMin = NavMin
FIR2.NavMax = NavMax
FIR2.NavQualPC = NavQualPC
FIR2.EditTA = EditTA
FIR2.TAmin = TAmin
FIR2.TAmax = TAmax
FIR2.TAqualPC = TAqualPC
FIR2.EditCts = EditCts
FIR2.CtsMin = CtsMin
FIR2.CtsMax = CtsMax
FIR2.CtsQualPC = CtsQualPC
FIR2.EditCycle = EditCycle
FIR2.CycleQualPC = CycleQualPC
FIR2.EditTtgt = EditTtgt
FIR2.TtgtMin = TtgtMin
FIR2.TtgtMax = TtgtMax
FIR2.TtgtPC = TtgtPC
FIR2.EditNlev = EditNlev
FIR2.NlevMin = NlevMin
FIR2.NlevMax = NlevMax
FIR2.NlevPC = NlevPC
FIR2.EditRAWbad = EditRAWbad
FIR2.RAWbadmin = RAWbadmin
FIR2.RAWbadmax = RAWbadmax
FIR2.RAWbadPC = RAWbadPC
FIR2.EditRate = EditRate
FIR2.RateMin = RateMin
FIR2.RateMax = RateMax
FIR2.RatePC = RatePC
FIR2.EditOATtrop = EditOATtrop
FIR2.OATtropPC = OATtropPC
FIR2.OATzt10 = OATzt10
FIR2.Tzt10 = Tzt10
FIR2.OATzt20 = OATzt20
FIR2.Tzt20 = Tzt20
FIR2.OATks10 = OATks10
FIR2.OATks20 = OATks20
FIR2.OATzt11 = OATzt11
FIR2.Tzt11 = Tzt11
FIR2.OATzt21 = OATzt21
FIR2.Tzt21 = Tzt21
FIR2.OATks11 = OATks11
FIR2.OATks21 = OATks21
FIR2.OATzt12 = OATzt12
FIR2.Tzt12 = Tzt12
FIR2.OATzt22 = OATzt22
FIR2.Tzt22 = Tzt22
FIR2.OATks12 = OATks12
FIR2.OATks22 = OATks22
FIR2.OATzt13 = OATzt13
FIR2.Tzt13 = Tzt13
FIR2.OATzt23 = OATzt23
FIR2.Tzt23 = Tzt23
FIR2.OATks13 = OATks13
FIR2.OATks23 = OATks23
'
FIR2.OATzt14 = OATzt14
FIR2.Tzt14 = Tzt14
FIR2.OATzt24 = OATzt24
FIR2.Tzt24 = Tzt24
' HISTORY information
FIR2.CALversion = CALversion
FIR2.MAKEversion = MAKEversion
FIR2.EDITversion = EDITversion
FLTINFOversion = FileDateTime(ProgramDrive$ + "\MTP\VB6\BAS\FLTINFO.bas") 'FLTINFO version
FIR2.FLTINFOversion = FLTINFOversion
FIR2.Tstamp = Tstamp
FIR2.RAWstamp = RAWstamp
FIR2.MMSstamp = MMSstamp
FIR2.REFstamp = REFstamp
FIR2.ERFstamp = ERFstamp
FIR2.CTCstamp = CTCstamp
FIR2.Ncts = Ncts
FIR2.ATPrange = ATPrange
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Put #lu%, 1, FIR2
Close lu
End Sub
Sub REFopen
Sub REFopen(REFfile$)
FileFormatIn = fREFreadFileFormat(REFfile$)
If FileFormatIn = 0 Then FileFormatIn = 33
REFlu = FreeFile
Select Case FileFormatIn
Case 32
Open REFfile$ For Random Access Read Write As REFlu Len = Len(REF)
Case 33
Open REFfile$ For Random Access Read Write As REFlu Len = Len(REF2)
End Select
End Sub
Sub BINopen
Sub BINopen(BINfile$)
BINlu = FreeFile
FileFormatIn = fREFreadFileFormat(BINfile$)
Select Case FileFormatIn
Case 32
Open BINfile$ For Random Access Read Write As BINlu Len = Len(REF)
Case 33
Open BINfile$ For Random Access Read Write As BINlu Len = Len(REF2)
End Select
End Sub
Sub REFread
Sub REFread(lu%, Record%)
Select Case FileFormatIn
Case 32: Call REFread32(lu%, Record%)
Case 33: Call REFread33(lu%, Record%)
End Select
End Sub
Sub CheckRCconfig
Sub CheckRCconfig(f As Form)
' Print #CFGlu, Format(IFwt(Nif), "#0.0000")
End Sub
Function fGetLRextension
Function fGetLRextension(RMSfilename$, LR1!, LR2!, zLRb!) As Boolean
Dim lu%, nRAOBtemplates%, iY, iM, iD, UT0, LR11, LR12, zLRb1, LR21, LR22, zLRb2, A$, i%, ii%
Dim RAOBfilename$, RAOBfilename1$, RAOBfilename2$, RAOB1$, RAOB2$, RAOB1x$, RAOB2x$
Dim RAOBrangeUsedFile$, iNum%
RAOBrangeUsedFile$ = MNpath$ + "RAOB\" + Mission$ + "_RAOBrangeUsed.txt"
If Dir$(RAOBrangeUsedFile$, vbNormal) = "" Then
MsgBox "Warning: " + RAOBrangeUsedFile$ + " does not exist!", vbOKOnly
fGetLRextension = False
Exit Function
End If
' Open MissionRAOBrange.txt file and set LR extension parameters
lu = FreeFile
Open RAOBrangeUsedFile$ For Input As lu 'eg SOLVE2_RAOBrangeAll.txt
Input #lu, A$ 'skip header line
nRAOBtemplates = 0
Do 'Read list of RAOBs within 200 km of Flight Track
Input #lu, iNum, iY, iM, iD, UT0, LR11, LR12, zLRb1, LR21, LR22, zLRb2, A$
i = InStr(1, A$, vbTab)
RAOB1$ = Left$(A$, i - 1)
' Generate default filename for RAOB template file of soundings in case RMS command is used
Select Case Len(RAOB1$)
Case 5: RAOBfilename$ = RAOB1$ + "_"
Case 4: RAOBfilename$ = RAOB1$ + "__"
Case 3: RAOBfilename$ = RAOB1$ + "___"
End Select
RAOBfilename1$ = RAOBfilename$ + Format(iY, "0000") + Format(iM, "00") + Format(iD, "00")
If UT0 > 42.3 Then ' Allow for day change if after 1200UT
RAOBfilename2$ = RAOBfilename$ + Format(iY, "0000") + Format(iM, "00") + Format(iD + 1, "00")
Else
RAOBfilename2$ = ""
End If
ii = InStr(i + 1, A$, vbTab)
RAOB2x$ = Mid$(A$, i + 1, ii - i - 1)
'Debug.Print RMSfilename$; " "; RAOBfilename1; " "; RAOBfilename2
Loop Until Left$(RMSfilename, 14) = RAOBfilename1 Or Left$(RMSfilename, 14) = RAOBfilename2 Or EOF(lu)
If EOF(lu) Then
fGetLRextension = False
Else
fGetLRextension = True
LR1 = LR11
LR2 = LR12
zLRb = zLRb1
End If
Close lu
End Function
Function fRMSfilename
Function fRMSfilename(WMO4l$, WMOnumber&, iY, iM%, iD%, iH%) As String
Dim RMSfilename$, Status As Boolean, Record&
' Generate default filename for RAOB template file of soundings in case RMS command is used
If WMO4l = "XXXX" Then 'First make sure ICAO name does not exist as MTP default is ICAO
Status = fGetUAsite(Str(WMOnumber), Record)
If Status Then WMO4l = Left$(GPicao, 4)
End If
If WMO4l = "XXXX" Then
RMSfilename$ = Format(WMOnumber, "00000") + "_"
Else
If InStr(WMO4l, " ") = 0 Then
RMSfilename$ = WMO4l + "__"
Else
RMSfilename$ = Left$(WMO4l, InStr(WMO4l, " ") - 1) + "___"
End If
End If
fRMSfilename = RMSfilename$ + Format(Iyear, "0000") + Format(Imonth, "00") + Format(Iday, "00") + Format(Ihour, "00") + ".RAOB2"
End Function
Sub Read_Gaines_Hipskind_Format
Sub Read_Gaines_Hipskind_Format(lu%, Record%, Prefix$)
Dim Org$, Sname$, Mname$, Ivol%, Nvol%, dX(1 To 2), ReduxDate$, n%
Dim Xname$(1 To 2), NSCOML%, NNCOML%
Static VSCAL!(1 To 100), Vmiss!(1 To 100), Vname$(1 To 100)
Static ASCAL!(1 To 100), Amiss!(1 To 100), Aname$(1 To 100)
' If Record=0, read header, otherwise read data
Dim A$, i%, x2!, x1!(1 To 100), NXm1%, V!(1 To 100, 1 To 100), AuxV!(1 To 100), num!(1 To 100)
Dim PV!(1 To 100)
Static nHeader%, FFI%, NV%, NauxV%, NX%(1 To 100), NXDEF%(1 To 100), ZZp!(1 To 100)
If Record = 0 Then
Input #lu, nHeader%, FFI '1 Number of header records and File Format
Select Case FFI
Case 1001 ' XS File Format
Line Input #lu, Pi$ '2 PI
Line Input #lu, Org$ '3 Organization
Line Input #lu, Sname$ '4 Instrument
Line Input #lu, Mname$ '5 Mission
Mission$ = Mname$
Call Read_N_Numbers(lu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #lu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(lu, 1, num())
dX(1) = num(1)
Line Input #lu, Xname$(1) '7 Flight date and Reduction Date
Call Read_N_Numbers(lu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(lu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(lu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #lu, Vname(n): Next n
Call Read_N_Numbers(lu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML: Line Input #lu, A$: Next n
Call Read_N_Numbers(lu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #lu, A$: Next n
Record = 0
Case 2010 ' XS File Format
Line Input #lu, Pi$ '2 PI
Line Input #lu, Org$ '3 Organization
Line Input #lu, Sname$ '4 Instrument
Line Input #lu, Mname$ '5 Mission
Mission$ = Mname$
If Mission$ = "TOTE/VOTE" Then Mission$ = "TOTE_VOTE"
Call Read_N_Numbers(lu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #lu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(lu, 2, num())
dX(1) = num(1)
dX(2) = num(2) '8 Interval between primary variables, 0.0 is non-uniform
Call Read_N_Numbers(lu, 1, num())
NX(1) = num(1)
Call Read_N_Numbers(lu, 1, num())
NXDEF(1) = num(1)
For i = 1 To NXDEF(1): Input #lu, x1(i): Next i
For i = 1 To NXDEF(1): ZZp(i) = fPtoZ(x1(i)): Next i 'convert p to Zp
Line Input #lu, Xname$(1) '9 Mission
Line Input #lu, Xname$(2) '10 Mission
Call Read_N_Numbers(lu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(lu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(lu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #lu, Vname(n): Next n
Call Read_N_Numbers(lu, 1, num())
NauxV = num(1) ' Number of Auxiliary Variables
Call Read_N_Numbers(lu, NauxV, num())
For n = 1 To NauxV: ASCAL(n) = num(n): Next n
Call Read_N_Numbers(lu, NauxV, num())
For n = 1 To NauxV: Amiss(n) = num(n): Next n
For n = 1 To NauxV: Line Input #lu, Aname(n): Next n
Call Read_N_Numbers(lu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML: Line Input #lu, A$: Next n
Call Read_N_Numbers(lu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #lu, A$: Next n
Record = 0
Case 2110
Line Input #lu, Pi$ '2 PI
Line Input #lu, Org$ '3 Organization
Line Input #lu, Sname$ '4 Instrument
Line Input #lu, Mname$ '5 Mission
Mission$ = Mname$
If Mission$ = "TOTE/VOTE" Then Mission$ = "TOTE_VOTE"
Call Read_N_Numbers(lu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #lu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(lu, 2, num())
dX(1) = num(1)
dX(2) = num(2) '8 Interval between primary variables, 0.0 is non-uniform
Line Input #lu, Xname$(1) '9 Mission
Line Input #lu, Xname$(2) '10 Mission
Call Read_N_Numbers(lu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(lu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(lu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #lu, Vname(n): Next n
Call Read_N_Numbers(lu, 1, num())
NauxV = num(1) ' Number of Auxiliary Variables
Call Read_N_Numbers(lu, NauxV, num())
For n = 1 To NauxV: ASCAL(n) = num(n): Next n
Call Read_N_Numbers(lu, NauxV, num())
For n = 1 To NauxV: Amiss(n) = num(n): Next n
For n = 1 To NauxV: Line Input #lu, Aname(n): Next n
Call Read_N_Numbers(lu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML
Line Input #lu, A$
Select Case n
Case 1
Case 2
i = InStr(A$, ":")
Longitude = Val(Right$(A$, Len(A$) - i - 1))
Case 3
i = InStr(A$, ":")
Latitude = Val(Right$(A$, Len(A$) - i - 1))
Case 4
End Select
Next n
Call Read_N_Numbers(lu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #lu, A$: Next n
Record = 0
End Select
Else
Select Case FFI
Case 1001
Case 2010
Input #lu, x2 ' Read Second Primary Variable
For n = 1 To NauxV: Input #lu, AuxV(n): Next n 'Read Auxiliary Variables
For n = 1 To NV
For i = 1 To NX(1): Input #lu, V(i, n): Next i 'Read Primary Variables
Next n 'Read Secondary Variables
Select Case Prefix$
Case "XS" ' GMAO Assimilation Data
UTsec = x2
Latitude = AuxV(2) * ASCAL(2)
Longitude = AuxV(1) * ASCAL(1)
For n = 1 To NV
For i = 1 To NX(1): PV(i) = V(i, 1) * VSCAL(1): Next i
For i = 1 To NX(1): TTT(i) = V(i, 2) * VSCAL(2): Next i
For i = 1 To NX(1): Zgeo(i) = V(i, 3) * VSCAL(3) / 1000#: Next i
For i = 1 To NX(1): zzz(i) = ZZp(i): Next i
' Ignore winds for now
Next n 'Read Secondary Variables
For i = 1 To NX(1)
sZZZ(i) = zzz(i) / 100#
sTTT(i) = TTT(i) / 10#
sZg(i) = Zgeo(i) / 100#
Next i
End Select
Case 2110
Input #lu, x2, NXm1 ' Read Second Primary Variable and number of First Primary Variables
For n = 2 To NauxV: Input #lu, AuxV(n): Next n 'Read Auxiliary Variables
For i = 1 To NXm1
Input #lu, x1(i) ' Read First Primary Variable
For n = 1 To NV: Input #lu, V(i, n): Next n 'Read Secondary Variables
Next i
Select Case Prefix$
Case "MP" ' MTP Data
UTsec = x2
AuxV(1) = NXm1
Nlev = AuxV(1) * ASCAL(1)
Nlev1 = 33 - Nlev + 1
Nlev2 = 33
pALT = AuxV(2) * ASCAL(2)
Pitch = AuxV(3) * ASCAL(3)
Roll = AuxV(4) * ASCAL(4)
OATmtp = AuxV(5) * ASCAL(5)
Zt1 = AuxV(6) * ASCAL(6)
Zt2 = AuxV(7) * ASCAL(7)
Th1 = AuxV(8) * ASCAL(8)
Th2 = AuxV(9) * ASCAL(9)
Latitude = AuxV(10) * ASCAL(10)
Longitude = AuxV(11) * ASCAL(11)
LRac = AuxV(12) * ASCAL(12)
MRI = AuxV(13) * ASCAL(13)
GoodScan = True
GoodTrop = True
For i = 1 To Nlev
zzz(33 - i + 1) = V(i, 1) * VSCAL(1)
TTT(33 - i + 1) = V(i, 2) * VSCAL(2)
Next i
For i = 1 To Nlev
sZZZ(i) = zzz(i) / 100#
sTTT(i) = TTT(i) / 10#
Next i
End Select
End Select
End If
End Sub
Sub Read_N_Numbers
Sub Read_N_Numbers(lu%, n%, V!())
Dim A$, i%, j%, iStart%
Line Input #lu, A$
i = 0
For j = 1 To n
Do
iStart = i + 1
i = InStr(iStart, A$, " ", vbTextCompare)
Loop Until i > iStart Or i = 0
If i = 0 Then
V(j) = Val(Mid$(A$, iStart, Len(A$) - iStart + 1))
Else
V(j) = Val(Mid$(A$, iStart, i - iStart))
End If
Next j
End Sub
Function fReadFile_XXX
Function fReadFile_XXX(Ext$, SUname$) As Boolean
Dim i%, j%, lu%, XXXfile$, IC%, ir%, n%
If Val(yyyymmdd$) > 20050601 And Ext$ = "IFB" Then
XXXfile$ = MNpath$ + "Setup\" + Mission$ + "_" + SU$ + "_" + Ext$ + ".txt"
Else
XXXfile$ = MNpath$ + "Setup\" + Mission$ + "_" + Ext$ + ".txt"
End If
If Len(Dir$(XXXfile$)) = 0 Then
MsgBox "The file: " & XXXfile$ & "does not exist!" & vbCrLf & "Create it before proceeding!", vbOKOnly
fReadFile_XXX = False
End If
lu = FreeFile
Open XXXfile$ For Input As lu
Select Case Ext$
Case "IFB"
Input #lu, Nlo 'Number of channels
Input #lu, Nif 'Number of response segments in IF
For i = 1 To Nlo
Input #lu, CHnLSBloss(i) 'CHn LSB RF loss percentage
Next i
CH1LSBloss = CHnLSBloss(1)
For i = 1 To Nlo
For j = 1 To Nif
Input #lu, n, IFoff(i, j), IFwt(i, j)
IFoff(i, j) = IFoff(i, j) / 1000#
'Debug.Print n; IFoff(i, j), IFwt(i, j)
Next j
Next i
Close lu
fReadFile_XXX = True
End Select
End Function
Sub ReadInRC
Sub ReadInRC(RCpathToDot$, iRC%)
Dim A$, FI$, lu%, i%, j%, k%, L%, V!, Filename$, bpv!, Gendate$
' Routine to read in retrieval coefficients
' Check first if .RCF file exists, and if not check for older .CFG file
' .RCF files are binary, have 30 observables and include .cfg info and all flight levels
' .CFG files are ascii, have 28 observables, and have separate files for each FL, and .CFG
Static MissingRCflag As Boolean
If Dir(RCpathToDot$ + ".RCF") = "" Then
If Dir(RCpathToDot$ + ".CFG") = "" Then
If Not MissingRCflag Then MsgBox "The RC files: " + RCpathToDot$ + ".cfg or .rcf" + vbCrLf + "Could not be found!", vbOKOnly
MissingRCflag = True
Exit Sub
Else
Call ReadRCconfig(iRC, RCpathToDot$ + ".cfg")
For i = 1 To NFL
If Dir(RCpathToDot$ + "." + Format$(FLA(i), "0000")) = "" Then
If Not MissingRCflag Then MsgBox "The RC file: " + RCpathToDot$ + "." + Format$(FLA(i), "0000") + vbCrLf + "Could not be found!", vbOKOnly
MissingRCflag = True
Exit Sub
End If
lu% = FreeFile
Open RCpathToDot$ + "." + Format$(FLA(i), "0000") For Input As #lu%
'123456789012345678901234567890123456789012345678901234567890
'DRCNA012.0850 330.99 089 Generated: 07-23-2003 19:33:19
Input #lu%, A$
Filename = Left$(A$, 13) 'RC Filename
bpv = Mid$(A$, 14, 9) 'FL Barometric pressure
RAOBcount% = Mid$(A$, 22, 5) 'Number of soundings used to calculate RC set
Gendate$ = Mid$(A$, 28, 30) 'Date RCs were calculate
' Blank line
Input #lu%, A$
' A Priori Observable Errors
For j = 1 To Nobs: Input #lu%, OBrms(i, j): Next j
' Average observable values for soundings used
For j = 1 To Nobs: Input #lu%, OBav(iRC, i, j): Next j
' For each retrieval set (iRC), and
' For each flight altitude (i = 1 to NFL), and
' For each retrieval level (k = 1 to Nret), read:
' bp(iRC, i, k) Pressure at retrieval level, use to calculate pressure altitude (RAav(iRC, i, k)
' RTav(iRC, i, k) Average temperature at retrieval level
' RMSa(iRC, i, k) Temperature variance at retrieval level
' RMSe(iRC, i, k) Expected retrieval accuracy at retrieval level
' rc(iRC, i, k, L) RC values for this retrieval level (L= 1 to Nobs)
For k = 1 To Nret
Input #lu%, BP(iRC, i, k), RTav(iRC, i, k), RMSa(iRC, i, k), RMSe(iRC, i, k)
RAav(iRC, i, k) = fPtoZ(BP(iRC, i, k))
For L = 1 To Nobs: Input #lu%, rc(iRC, i, k, L): Next L
Next k
Close #lu%
Next i
End If
Else
RCread iRC, RCpathToDot$ + ".RCF"
' RCwrite iRC, RCpathToDot$ + ".RCF2"
End If
End Sub
Sub ReadMissionWCT
Sub ReadMissionWCT()
Dim Filename$, A$, lu%, i%, j%, Elev!
Filename$ = DataDrive$ + Rdir2$ + Mission$ + "\Setup\" + Mission$ + "_WCT.TXT"
lu = FreeFile
Open Filename$ For Input As lu
Line Input #lu, A$
For j = 1 To Nel
Select Case Channels
Case 2
Input #lu, Elev, WINcor(1, j), WINcor(2, j)
Case 3
Input #lu, Elev, WINcor(1, j), WINcor(2, j), WINcor(3, j)
End Select
Next j
Close lu
End Sub
Sub TSwrite
Sub TSwrite(REFlu%, GoodScansOnly As Boolean, WriteBadHeaders As Boolean, f As Form)
Dim Ext$, MPheader$, V!(1 To 4), LocalOpen As Boolean
Dim Filename$, MPfile$, TSfile$, MPlu%, TSlu%, HDRfile$, L%, X!, A$, dZp!, dZg!, Discard As Boolean, dALT!
If CallingForm.chkUTseconds.Value = 0 Then
MPheader$ = " ##0.000 ##0.0 ##0.0 #0.00"
Else
MPheader$ = " ##0000 ##0.0"
End If
If f.chkDiscard.Value = 1 Then Discard = True Else Discard = False
dALT = Val(f.txtDiscard.Text)
Ext$ = fACext(AC$)
TSfile$ = "TS" + yyyymmdd$ + Ext$
MPfile$ = "MP" + yyyymmdd$ + Ext$
' Will read & modify header after first assigning MP output file
TSlu% = FreeFile
Open Drive$ + Rdir2$ + Mission$ + "\TS\" + TSfile$ For Output As #TSlu%
HDRfile$ = Drive$ + Rdir2$ + Mission$ + "\" + Mission$ + "_TS.HDR"
Call UpdateTSheader(HDRfile$, TSlu%)
MPlu% = FreeFile
Open MPpath$ + MPfile$ For Input As #MPlu%
' Write Limits Record
Record% = 0
Call MPread(MPlu, 0) 'skip header record
Do
Record% = Record% + 1
If Record > f.ProgressBar1.Max Then Exit Do
f.txtRecord.Text = Str(Record)
f.ProgressBar1.Value = Record
Call MPread(MPlu%, Record%)
If Not EOF(MPlu) Then
If Nlev > 0 Then GoSub WriteCycle
End If
DoEvents
Loop Until EOF(MPlu%)
Close TSlu%, MPlu
' If LocalOpen Then Close (REFlu%)
Exit Sub
WriteCycle:
' NB only come here on GoodScan = True (get rid of checks for goodscan)
' If EditNlev And (Nlev < NlevMin Or Nlev > NlevMax) Then
' EditWord = EditWord Or 128: GoodScan = False ' Determine total # of acceptable levels; throw out if <7 levels
' NlevPC = NlevPC + 1
' End If
' If Nlev1 = 0 Then Nlev1 = 1
' If pALT < zzz(Nlev1) / 100 Then EditWord = EditWord Or 1: RetAltPC = RetAltPC + 1: GoodScan = False
' Update the number of valid levels
If CallingForm.chkUTseconds.Value = 1 Then
V(1) = UTsec: V(2) = OATmtp: V(3) = 0#
Else
V(1) = UTsec / 1000#: V(2) = OATmtp: V(3) = OATnav: V(4) = OATmtp - OATnav
End If
' If GoodScan Or WriteBadHeaders Or (Discard And pALT < dALT) Then
Print #TSlu%, fUsing$(MPheader$, V!())
Return
End Sub
Sub UpdateTSheader
Sub UpdateTSheader(HDRfile$, MPlu%)
Dim lu%, i%, j%, L%, n%, A$, b$, Nhdr%, yr$, dy$, mo$, fln&, fltnr&, FltDate&
Dim X$, lux%
Dim FlightNo&, Objective$, FlightDate$
lu% = FreeFile
Open HDRfile$ For Input As lu%
Input #lu%, Nhdr 'Get number of header lines
Close (lu%)
lu% = FreeFile
Open HDRfile$ For Input As lu% 'Start over
For j = 1 To Nhdr 'Update dates in MP file header
Line Input #lu%, A$
Select Case j
Case 7
Mid$(A$, 1, 4) = Mid$(yyyymmdd$, 1, 4) 'set YR
Mid$(A$, 6, 2) = Mid$(yyyymmdd$, 5, 2) 'set MO
Mid$(A$, 9, 2) = Mid$(yyyymmdd$, 7, 2) 'set DY
b$ = Date$: L = Len(b$)
yr$ = Right$(b$, 4): dy$ = Mid$(b$, L - 6, 2): mo$ = Mid$(b$, L - 9, 2)
Mid$(A$, 13) = yr$ + " " + mo$ + " " + dy$
If Mission$ = "SONEX" Then
lux% = FreeFile
Open "\DC8\SONEX\FLTNR.PRN" For Input As lux%
Do
Input #lux%, fln, FltDate
If FltDate = Val(Right$(yyyymmdd$, 6)) Then FlightNo = fln
Loop Until EOF(lux%)
Else
lux% = FreeFile
Open Drive$ + Rdir2$ + Mission$ + "\" + Mission$ + ".NUM" For Input As lux%
i = -1
Do: Line Input #lux, b$ 'FlightNo, FlightDate, Objective$
b$ = LTrim(b$)
n = InStr(1, b$, " ")
FlightNo = Val(Left$(b$, n - 1))
b$ = Trim(Right$(b$, Len(b$) - n + 1))
n = InStr(1, b$, " ")
If n = 0 Then
FlightDate = Val(b$)
Objective$ = "Unknown"
Else
FlightDate = Val(Left$(b$, n - 1))
Objective$ = Trim(Mid$(b$, n, Len(A$) - n + 1))
End If
i = i + 1
If yyyymmdd$ = Trim(Str(FlightDate)) Then Exit Do
Loop Until EOF(lux)
End If
Close #lux%
Mid$(A$, 25) = Format$(FlightNo, "00000000")
Case Else
End Select
Print #MPlu%, A$
Next j
Close (lu%)
End Sub
Sub WriteCAL
Sub WriteCAL(Filename$)
Dim i0%, i1%, i2%, lu%, i%, j%, X$, MyDate
lu% = FreeFile
Open Filename$ For Output As lu%
FIsize% = 0
'AC$ = Mid$(Rdir$, 2, 2)
'Path$ = Drive$ + Rdir2$ + Mission$ + "\" + yyyymmdd$ + "\"
Print #lu, "1 ' Cal File Format"
Call PrintStr(lu%, "' " + Filename$ + " was last written on " + Date$ + " at " + Time$, "", "")
Call PrintStr(lu%, "' This CAL-file follows a few simple but mandatory format requirements.", "", "")
Call PrintStr(lu%, "' Settings are entered into categories which occupy a single line and", "", "")
Call PrintStr(lu%, "' must be bracketed by square brackets (e.g. [PATH]). Variables for which", "", "")
Call PrintStr(lu%, "' settings are assigned must have exactly the same name in the program in", "", "")
Call PrintStr(lu%, "' which they are used and be followed by an equal sign (=). Spaces are", "", "")
Call PrintStr(lu%, "' not allowed. Anything beyond the first space in a line is ignored.", "", "")
Call PrintStr(lu%, "' Blank lines are also ignored, but are required betweeen categories.", "", "")
Call PrintStr(lu%, "", "", "")
Gendate$ = fTstamp$ 'Right$(Date$, 4) + Left$(Date$, 2) + Mid$(Date$, 4, 2)
Call PrintStr(lu%, "[GENERAL]", "", "")
Call PrintStr(lu%, "GenDate", Gendate$, "Analysis Date")
Call PrintStr(lu%, "yyyymmdd$", yyyymmdd$, "Flight Date")
Call PrintVal(lu%, "UTstart", UTstart, "Start UT")
Call PrintVal(lu%, "UTend", UTend, "End UT")
Call PrintVal(lu%, "Channels", Channels, "Number of frequency channels")
Call PrintVal(lu%, "Nel", Nel, "Number of elevation angles")
Call PrintVal(lu%, "LocHor", LocHor, "Scan Position when viewing the Horizon")
Call PrintBol(lu%, "RHS", RHS, "True if MTP is on Right Hand Side of Aircraft")
Call PrintVal(lu%, "Emissivity", Emissivity, "Emissivity of window")
Call PrintVal(lu%, "Reflectivity", Reflectivity, "Reflectivity of window")
Call PrintVal(lu%, "DeltaTmin", DeltaTmin, "Minimum OAT-TGT Temperature Difference")
Call PrintVal(lu%, "Pitchmin", ePitchMin, "Minimum allowable Pitch")
Call PrintVal(lu%, "Pitchmax", ePitchMax, "Maximum allowable Pitch")
Call PrintVal(lu%, "RollLimit", eRollMin, "Maximum allowable Roll (+ or -)")
Call PrintVal(lu%, "Nsamples", TotalCycles, "Total Number of Samples")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[FIT_INFO]", "", "")
Call PrintVal(lu%, "Nfit", Nfit, "Number of Fit coefficients")
Call PrintVal(lu%, "Offset", GOF(1), "Fit Offset")
For i = 1 To Nfit
Call PrintStr(lu%, "FitVar" + Format(i, "0"), NP$(i), "Fit Variable" + Format(i, "0"))
For j = 1 To Channels
X$ = Format(j, "0") + Format(i, "0")
Call PrintVal(lu%, "GEC" + X$, GEC(j, i), "Fit coefficient" + X$)
Next j
If i < Nfit Then Call PrintVal(lu%, "GOF" + Format(i, "0"), GOF(i + 1), "Fit Parameter Offset")
Next i
Call PrintVal(lu%, "Target", TGToffset, "Target temperature offset in cycles")
Call PrintVal(lu%, "Mixer", MXRoffset, "Mixer temperature offset in cycles")
Call PrintVal(lu%, "Nav", NAVoffset, "Nav temperature offset in cycles")
Call PrintVal(lu%, "Noise", NDoffset, "Noise Diode temperature offset in cycles")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[ND_INFO]", "", "")
Call PrintVal(lu%, "TrefND", TrefND, "Noise Diode reference temperature")
For i = 1 To Channels
Call PrintVal(lu%, "Cnd0" + Format(i, "0"), Cnd0(i), "Noise Diode fit parameter" + Format(i, "0") + "0")
Call PrintVal(lu%, "Cnd1" + Format(i, "0"), Cnd1(i), "Noise Diode fit parameter" + Format(i, "0") + "1")
Call PrintVal(lu%, "Cnd2" + Format(i, "0"), Cnd2(i), "Noise Diode fit parameter" + Format(i, "0") + "2")
Next i
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[GAIN_INFO]", "", "")
Call PrintVal(lu%, "GainScale", GainScale, "Gain scale used (1=GE, 2=ND, 3=OAT)")
Call PrintVal(lu%, "OATsource", OATsource, "OAT source used (1=MTP, 2=A/C, 3=MMS)")
Call PrintVal(lu%, "REFsource", REFsource, "Reference Temperature (1=Target, 2=OAT)")
Call PrintVal(lu%, "OATnavCOR", OATnavCOR, "OAT temperature correction (added)")
Call PrintStr(lu%, "RAWextension", RAWextension$, "Extension of RAW data file")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[MA_INFO]", "", "") 'Moving Average Info
Call PrintBol(lu%, "UseMAforCB", UseMAforCB, "Use Moving Average for Base Counts")
Call PrintBol(lu%, "UseMAforCS", UseMAforCS, "Use Moving Average for Sky Counts")
Call PrintBol(lu%, "UseMAforCN", UseMAforCN, "Use Moving Average for Noise Diode Counts")
Call PrintBol(lu%, "UseMAforTtgt", UseMAforTtgt, "Use Moving Average for Target Temperature")
Call PrintBol(lu%, "UseMAforTifa", UseMAforTifa, "Use Moving Average for IF Amp Temperature")
Call PrintVal(lu%, "CMAcycles", CMAcycles, "Slow Cycle Moving Average count")
Call PrintVal(lu%, "CMAcycles2", CMAcycles2, "Fast Cycle Moving Average count")
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[CHANNEL_INFO]", "", "")
For i = 1 To Channels
Call PrintVal(lu%, "ChInfo" + Format(i, "0"), ChInfo(i), "Channel " + Format(i, "0") + " Information Content")
Next i
Call PrintStr(lu%, "", "", "")
Call PrintStr(lu%, "[WINDOW_CORRECTIONS]", "", "")
For i = 1 To Channels
For j = 1 To Nel
X$ = "WCT" + Format(i, "0") + Format(j, "00")
Call PrintVal(lu%, X$, WINcor(i, j), "Window Correction Table Entry, " + X$)
Next j
Next i
Call PrintStr(lu%, " ", "", "")
Close (lu%)
End Sub
Sub BINwrite32
Sub BINwrite32(lu%, Record%)
Dim A As REFrecord, i%, j%, X%
A.Cycle = Record
A.GoodScan = GoodScan
A.MakeWord = MakeWord
A.UTsec = UTsec
A.UTsecMTP = UTsecMTP
A.UTsecNav = UTsecNav
A.TTO = TTO
A.pALT = pALT
A.gALT = gALT 'gALT
A.rALT = 99.9 'rALT
A.mALT = mALT
A.Pitch = Pitch
A.Roll = Roll
A.Latitude = Latitude
A.Longitude = Longitude
A.Heading = Heading
A.TAS = 999.9 'TAS
A.Wspd = Wspd
A.Wdir = Wdir
A.Elcor = Elcor
A.ElCorUsed = ElCorUsed
A.OATnav = OATnav
A.OATmms = OATmms
A.OATmtp = OATmtp
A.TTMA = TTMA
A.TMMA = TMMA
A.TWMA = TWMA
For i% = 1 To Channels
A.RFImask(i) = RFImask(i)
' For j% = 1 To 10: a.TA(i%, j%) = TA(i%, j%): Next j%
For j% = 1 To Ncts
A.Counts(i%, j%) = C(i%, j%)
A.CMA(i, j) = CMA(i, j)
Next j%
Next i%
A.Muxs(0) = Muxs(0)
For i% = 1 To 16
A.Muxs(i%) = Muxs(i%)
A.Mux(i%) = Mux(i%)
Next i%
Put #lu%, Record% + HiddenRecords, A
End Sub
Sub BINwrite33
Sub BINwrite33(ByVal lu%, ByVal Record%)
Dim A As REF2record, i%, j%, X%
A.Cycle = Record
A.GoodScan = GoodScan
A.MakeWord = MakeWord
A.UTsec = UTsec
A.UTsecMTP = UTsecMTP
A.UTsecNav = UTsecNav
A.TTO = TTO
A.pALT = pALT
A.gALT = gALT 'gALT
A.rALT = 99.9 'rALT
A.mALT = mALT
A.Pitch = Pitch
A.Roll = Roll
A.Latitude = Latitude
A.Longitude = Longitude
A.Heading = Heading
A.TAS = 999.9 'TAS
A.Wspd = Wspd
A.Wdir = Wdir
A.Elcor = Elcor
A.ElCorUsed = ElCorUsed
A.OATnav = OATnav
A.OATmms = OATmms
A.OATmtp = OATmtp
A.TTMA = TTMA
A.TMMA = TMMA
A.TWMA = TWMA
For i% = 1 To Channels
A.RFImask(i) = RFImask(i)
' For j% = 1 To 10: a.TA(i%, j%) = TA(i%, j%): Next j%
For j% = 1 To Ncts
A.Counts(i%, j%) = C(i%, j%)
A.CMA(i, j) = CMA(i, j)
Next j%
Next i%
A.Muxs(0) = Muxs(0)
For i% = 1 To 32
A.Muxs(i%) = Muxs(i%)
A.Mux(i%) = Mux(i%)
Next i%
Put #2, Record% + HiddenRecords, A
End Sub
Sub BINwrite
Sub BINwrite(lu%, Record%)
Select Case FileFormatOut
Case 32: Call BINwrite32(lu%, Record%)
Case 33: Call BINwrite33(lu%, Record%)
End Select
End Sub
Function fRAWscans
Function fRAWscans(RAWfile$)
Dim lu%, RecordBytes&, ByteCount&, LOFraw%, A$, Count%
' Return number of RAW file cycles. Should be
' greater than actual number by one or two because
' of 99:99 cycles and incomplete cycles
lu = FreeFile
Open RAWfile$ For Input As lu
Count = 0
Do
Do 'Go to next A-line
Line Input #lu, A$
Loop Until Left$(A$, 1) = "A" Or EOF(lu)
Count = Count + 1
Loop Until EOF(lu)
Close lu
fRAWscans = Count - 1
End Function
Sub GetABLEvalues
Sub GetABLEvalues(UTsec&, UT&, mZg!, mZp!, PTWfile$, Quit)
Dim i%, A$, HeaderCount%, Tf!, Ts!
Static PTWlu%
If PTWlu = 0 Then
PTWlu = FreeFile
Open PTWfile$ For Input As PTWlu
Input #PTWlu, A$ 'HeaderCount, a$ 'Skip Header Line
'For i = 2 To HeaderCount: Line Input #PTWlu, a$: Next i
Else
If EOF(PTWlu) Then
Close PTWlu
Exit Sub
End If
End If
Do 'Catch up
Line Input #PTWlu, A$
UT = Val(Left$(A$, 5))
Loop Until (UT >= UTsec) Or EOF(PTWlu)
If EOF(PTWlu) Then UT = -1: Exit Sub
'time gps baro
'22949 442 583
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
mZg = Val(Mid$(A$, 7, 6))
mZp = Val(Mid$(A$, 16, 6))
'Debug.Print UT; P; fPtoZ(P)
End Sub
Sub GetICATSvalues
Sub GetICATSvalues(UTsec&, UT&, P!, T!, GA!, MMfile$, Quit As Boolean)
Dim i%, A$, HeaderCount%
Static MMlu%
If MMlu = 0 Then
MMlu = FreeFile
Open MMfile$ For Input As MMlu
Input #MMlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #MMlu, A$: Next i
Else
If EOF(MMlu) Then
Close MMlu
MMfile$ = ""
Exit Sub
End If
End If
Do 'Catch up
Do
Line Input #MMlu, A$
Loop Until Left$(A$, 1) = "C"
UT = fTstringToSec(Mid$(A$, 7, 8), True)
Loop Until UT >= UTsec Or EOF(MMlu)
If EOF(MMlu) Then
Close MMlu
MMlu = 0
Quit = True
Exit Sub
End If
'12345678901234567890
'C 227 15:29:59.000 +34 55.6 -117 53.2 -1.4 0.1 0
'D 0 0 0 57.1 0.0 2209 0 2000.0 3000.0
'E 31.2 31.2 32.6 33.4 0 -16 19.7 0.0
'F 47 934.9 0.000 0.7 208.4 16.6 225.0 4.126
'G 6.2 10.0 13.4 46.03 62.10 28.2 29.4 91.3 34.5
'H 58.9 44.9 -0 -0 0 -0 -0 32
'I 31.2 33.4 312.5 2299 -142.4 28.1 29.3 91.3
'C 227 15:30:00.000 +34 55.6 -117 53.2 -1.4 0.1 0
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
Line Input #MMlu, A$ 'D
P = fZtoP(Val(Mid$(A$, 27, 6)) / (1000 * kft_km)) 'P (mb)
Line Input #MMlu, A$ 'E
T = Mid$(A$, 2, 6) 'T(C)
Line Input #MMlu, A$ 'F
Line Input #MMlu, A$ 'G
Line Input #MMlu, A$ 'H
Line Input #MMlu, A$ 'I
GA = Mid$(A$, 21, 6) 'gALT
OATmms = T + cTo
End Sub
Sub GetNCvalues
Sub GetNCvalues(UTsec&, UT&, P!, T!, NCfile$, Quit As Boolean)
Dim i%, A$, HeaderCount%
Static MMlu%
If MMlu = 0 Then
MMlu = FreeFile
Open NCfile$ For Input As MMlu
For i = 1 To 3: Line Input #MMlu, A$: Next i
Else
If EOF(MMlu) Then
Close MMlu
NCfile$ = ""
Exit Sub
End If
End If
'timewave , ambient_temperature, sTatic_pressure
'date_time,deg C,deg C
'8/11/00 18:19:02,14.18,676.68
'8/11/00 18:19:03,14.23,676.67
'12345678901234567890123456789
Do 'Catch up
Line Input #MMlu, A$
UT = fTstringToSec&(Mid$(A$, 9, 8), True)
Loop Until UT >= UTsec Or EOF(MMlu)
If EOF(MMlu) Then
Close MMlu
MMlu = 0
Quit = True
Exit Sub
End If
i = InStr(19, A$, ",")
P = Val(Mid$(A$, i + 1, Len(A$) - i))
T = Val(Mid$(A$, 18, i - 18 + 1)) + cTo
OATmms = T + cTo
End Sub
Sub GetNextXS
Sub GetNextXS(Mode%, UTsec&, UT&, Latitude!, Longitude!, PV!(), T!(), Zg!(), Zp!(), Wz!(), Wm!(), Levels%, XSfile$, Quit As Boolean)
Dim i%, A$, HeaderCount%, V!, Txs!, nMax%
Static PTWlu%, ZZp!(1 To 50), X$, ii%, jj%, j%, nVar%, Vscale!(1 To 10), PV1&
Static PVs!, Ts!, zgs!, Zps!, Wzs!, Wms!
'32 2010
'Atlas , Lamich, Strahan, Lucchesi, Steenrod, Ledvina, Conaty, Pawson, Newman, Lait
'NASA Goddard Space Flight Center Codes 910.3 and 916
'GSFC Assimilation GG1X1 grid data interpolated to the DC8 flight curtain
'SOLVE
'1 1
'2000 03 08 2000 07 26
'0.00000 0.00000
'17
'17 'line10
'1000 850 700 500 400 300 250 200 150 100 70 50 30 10 5 2 1
'Pressure Levels(mb)
'seconds from 0 GMT on flight date
'5
'1.00000E-07 0.100000 1.00000 0.0100000 0.100000 line15
'999999 9999 99999 9999 999 line16
'Ertel 's Potential Vorticity (K m^2/kg s)
'Temperature (k)
'Geopotential Height(M)
'Zonal wind(M / s)
'Meridional wind(M / s)
'2
'0.0100000 0.100000
'9999 999
'Longitude (degrees East)
'Latitude (degrees North)
'0
'4
'Aircraft position is taken from the DFexchange file
'Assimilation analyses are interpolated to the flight curtain
'linearly in latitude and longitude.
'Data are valid for 12 UTC on 8 March, 2000.
' Mode =1 Get a single profile and close file
' Mode =0 Get next profile
nMax = 50 'Max levels that program can handle
If PTWlu = 0 Then
PTWlu = FreeFile
Open XSfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount
Line Input #PTWlu, A$
Select Case i
Case 10
nMax = Val(A$)
Case 11
jj = 1
For j = 1 To nMax
ii = InStr(jj, A$, " ")
If ii = 0 Then ii = Len(A$) + 1
ZZp(j) = fPtoZ(Val(Mid$(A$, jj, ii - jj)))
jj = ii + 1
Next j
Case 14
nVar = Val(A$)
Case 15
jj = 1
For j = 1 To nVar
ii = InStr(jj, A$, " ")
If ii = 0 Then ii = Len(A$) + 1
Vscale(j) = Val(Mid$(A$, jj, ii - jj))
jj = ii + 1
Next j
Case 16
ii = InStr(1, A$, " ")
PV1 = Val(Left$(A$, ii - 1))
Case Else
End Select
Next i
' ZZp(1) = fPtoZ(1000): ZZp(2) = fPtoZ(850): ZZp(3) = fPtoZ(700): ZZp(4) = fPtoZ(500)
' ZZp(5) = fPtoZ(400): ZZp(6) = fPtoZ(300): ZZp(7) = fPtoZ(250): ZZp(8) = fPtoZ(200)
' ZZp(9) = fPtoZ(150): ZZp(10) = fPtoZ(100): ZZp(11) = fPtoZ(70): ZZp(12) = fPtoZ(50)
' ZZp(13) = fPtoZ(30): ZZp(14) = fPtoZ(10): ZZp(15) = fPtoZ(5): ZZp(16) = fPtoZ(2)
' ZZp!(17) = fPtoZ(1):
X$ = " "
Else
If EOF(PTWlu) Then GoTo CloseCode
End If
If EOF(PTWlu) Then GoTo CloseCode
Line Input #PTWlu, A$
i = InStr(1, A$, " ")
UT = Val(Left$(A$, i - 1))
'UTsec Lon Lat
'55110 603 758
' -4 38 19 39 42 125 375 681 912 1703
'2949 4920 12817 50960 103319 291838 968698
' 2681 2604 2488 2333 2232 2099 2055 2058 2048 2022
'2002 2002 2045 2211 2380 2504 2488
' 133 1386 2836 5208 6699 8520 9623 10963 12695 15107
'17202 19171 22174 28986 33630 40181 45343
' -45 -37 -36 -40 -17 16 27 33 25 -4
'-19 -25 -35 -13 70 17 141
' -24 -53 -63 27 66 94 61 -18 -76 -120
'-158 -204 -267 -263 -172 -119 34
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
A$ = Right$(A$, Len(A$) - 6)
Longitude = Val(Left$(A$, InStr(1, A$, " ", 1) - 1)) / 100#
Latitude = Val(Right$(A$, Len(A$) - InStr(1, A$, " ", 1) + 1)) / 10#
For i = 1 To nMax: Input #PTWlu, PV(i): Next i
For i = 1 To nMax: Input #PTWlu, T(i): Next i
For i = 1 To nMax: Input #PTWlu, Zg(i): Next i
For i = 1 To nMax: Input #PTWlu, Wz(i): Next i
For i = 1 To nMax: Input #PTWlu, Wm(i): Next i
For i = 1 To nMax: Zp(i) = ZZp(i): Next i
If T(1) = 9999 Then
nMax = nMax - 1
For i = 1 To nMax
PV(i) = PV(i + 1) * Vscale(1)
T(i) = T(i + 1) * Vscale(2)
Zg(i) = Zg(i + 1) * Vscale(3)
Wz(i) = Wz(i + 1) * Vscale(4)
Wm(i) = Wm(i + 1) * Vscale(5)
Zp(i) = Zp(i + 1)
'Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
Else
For i = 1 To nMax
PV(i) = PV(i) * Vscale(1)
T(i) = T(i) * Vscale(2)
Zg(i) = Zg(i) * Vscale(3)
Wz(i) = Wz(i) * Vscale(4)
Wm(i) = Wm(i) * Vscale(5)
'Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
End If
Levels = nMax
If Mode = 1 Then Close PTWlu: PTWlu = 0
Exit Sub
CloseCode:
Close PTWlu
PTWlu = 0
Quit = True
End Sub
Sub GetNextXS1
Sub GetNextXS1(Mode%, UTsec&, UT&, Latitude!, Longitude!, PV!(), T!(), Zg!(), Zp!(), Wz!(), Wm!(), Levels%, XSfile$, Quit As Boolean)
Static PTWlu%, ZZp!(1 To 50), X$, ii%, jj%, j%, nVar%, Vscale!(1 To 10), PV1&
Static PVs!, Ts!, zgs!, Zps!, Wzs!, Wms!
Dim Org$, Sname$, Mname$, Ivol%, Nvol%, dX(1 To 2), ReduxDate$, n%
Dim Xname$(1 To 2), NSCOML%, NNCOML%
Static VSCAL!(1 To 100), Vmiss!(1 To 100), Vname$(1 To 100)
Static ASCAL!(1 To 100), Amiss!(1 To 100), Aname$(1 To 100)
' If Record=0, read header, otherwise read data
' Mode = 0, don't close file, Mode = 1, close file, Mod = 3, Close file
Dim A$, i%, x2!, x1!(1 To 100), NXm1%, V!(1 To 100, 1 To 100), AuxV!(1 To 100), num!(1 To 100)
Static nHeader%, FFI%, NV%, NauxV%, NX%(1 To 100), NXDEF%(1 To 100)
If Mode = 3 And PTWlu > 0 Then Close (PTWlu): PTWlu = 0: Exit Sub
If PTWlu = 0 And Not (Mode = 3) Then
PTWlu = FreeFile
Open XSfile$ For Input As PTWlu
Input #PTWlu, nHeader%, FFI '1 Number of header records and File Format
Line Input #PTWlu, Pi$ '2 PI
Line Input #PTWlu, Org$ '3 Organization
Line Input #PTWlu, Sname$ '4 Instrument
Line Input #PTWlu, Mname$ '5 Mission
'Mission$ = Mname$
If Mission$ = "TOTE/VOTE" Then Mission$ = "TOTE_VOTE"
Call Read_N_Numbers(PTWlu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #PTWlu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(PTWlu, 2, num())
dX(1) = num(1)
dX(2) = num(2) '8 Interval between primary variables, 0.0 is non-uniform
Call Read_N_Numbers(PTWlu, 1, num())
NX(1) = num(1)
Call Read_N_Numbers(PTWlu, 1, num())
NXDEF(1) = num(1)
For i = 1 To NXDEF(1): Input #PTWlu, x1(i): Next i
For i = 1 To NXDEF(1): ZZp(i) = fPtoZ(x1(i)): Next i 'convert p to Zp
Line Input #PTWlu, Xname$(1) '9 Mission
Line Input #PTWlu, Xname$(2) '10 Mission
Call Read_N_Numbers(PTWlu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #PTWlu, Vname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NauxV = num(1) ' Number of Auxiliary Variables
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: ASCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: Amiss(n) = num(n): Next n
For n = 1 To NauxV: Line Input #PTWlu, Aname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML: Line Input #PTWlu, A$: Next n
Call Read_N_Numbers(PTWlu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #PTWlu, A$: Next n
Record = 0
Else
If Mode = 3 Then Exit Sub
End If
If EOF(PTWlu) Then GoTo CloseCode
Input #PTWlu, x2 ' Read Second Primary Variable
For n = 1 To NauxV: Input #PTWlu, AuxV(n): Next n 'Read Auxiliary Variables
For n = 1 To NV
For i = 1 To NX(1): Input #PTWlu, V(i, n): Next i 'Read Primary Variables
Next n 'Read Secondary Variables
UT = x2
Latitude = AuxV(2) * ASCAL(2)
Longitude = AuxV(1) * ASCAL(1)
For n = 1 To NV
For i = 1 To NX(1): PV(i) = V(i, 1) * VSCAL(1): Next i
For i = 1 To NX(1): T(i) = V(i, 2) * VSCAL(2): Next i
For i = 1 To NX(1): Zg(i) = V(i, 3) * VSCAL(3) / 1000#: Next i
For i = 1 To NX(1): Zp(i) = ZZp(i): Next i
' Ignore winds for now
Next n 'Read Secondary Variables
Levels = NX(1)
For n = 1 To NX(1)
If T(1) > 900 Then
Levels = Levels - 1
For i = 1 To Levels
PV(i) = PV(i + 1)
T(i) = T(i + 1)
Zg(i) = Zg(i + 1)
Wz(i) = Wz(i + 1)
Wm(i) = Wm(i + 1)
Zp(i) = Zp(i + 1)
'Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
Else
Exit For
End If
Next n
If Mode = 1 Then Close PTWlu: PTWlu = 0
Exit Sub
CloseCode:
Close PTWlu
PTWlu = 0
Quit = True
End Sub
Sub GetNextXS2
Sub GetNextXS2(Mode%, UTsec&, UT&, Latitude!, Longitude!, PV!(), T!(), Zg!(), Zp!(), Wz!(), Wm!(), Levels%, XSfile$, Quit As Boolean)
Static PTWlu%, ZZp!(1 To 50), X$, ii%, jj%, j%, nVar%, Vscale!(1 To 10), PV1&
Static PVs!, Ts!, zgs!, Zps!, Wzs!, Wms!
Dim Org$, Sname$, Mname$, Ivol%, Nvol%, dX(1 To 2), ReduxDate$, n%
Dim Xname$(1 To 2), NSCOML%, NNCOML%
Static VSCAL!(1 To 100), Vmiss!(1 To 100), Vname$(1 To 100)
Static ASCAL!(1 To 100), Amiss!(1 To 100), Aname$(1 To 100)
' If Record=0, read header, otherwise read data
' Mode = 0, don't close file, Mode = 1, close file, Mod = 3, Close file
Dim A$, i%, x2!, x1!(1 To 100), NXm1%, V!(1 To 100, 1 To 100), AuxV!(1 To 100), num!(1 To 100)
Static nHeader%, FFI%, NV%, NauxV%, NX%(1 To 100), NXDEF%(1 To 100)
If Mode = 3 And PTWlu > 0 Then Close (PTWlu): PTWlu = 0: Exit Sub
If PTWlu = 0 And Not (Mode = 3) Then
PTWlu = FreeFile
Open XSfile$ For Input As PTWlu
Input #PTWlu, nHeader%, FFI '1 Number of header records and File Format
Line Input #PTWlu, Pi$ '2 PI
Line Input #PTWlu, Org$ '3 Organization
Line Input #PTWlu, Sname$ '4 Instrument
Line Input #PTWlu, Mname$ '5 Mission
'Mission$ = Mname$
If Mission$ = "TOTE/VOTE" Then Mission$ = "TOTE_VOTE"
Call Read_N_Numbers(PTWlu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #PTWlu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(PTWlu, 2, num())
dX(1) = num(1)
dX(2) = num(2) '8 Interval between primary variables, 0.0 is non-uniform
Call Read_N_Numbers(PTWlu, 1, num())
NX(1) = num(1)
Call Read_N_Numbers(PTWlu, 1, num())
NXDEF(1) = num(1)
For i = 1 To NXDEF(1): Input #PTWlu, x1(i): Next i
For i = 1 To NXDEF(1): ZZp(i) = fPtoZ(x1(i)): Next i 'convert p to Zp
Line Input #PTWlu, Xname$(1) '9 Mission
Line Input #PTWlu, Xname$(2) '10 Mission
Call Read_N_Numbers(PTWlu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #PTWlu, Vname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NauxV = num(1) ' Number of Auxiliary Variables
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: ASCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: Amiss(n) = num(n): Next n
For n = 1 To NauxV: Line Input #PTWlu, Aname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML: Line Input #PTWlu, A$: Next n
Call Read_N_Numbers(PTWlu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #PTWlu, A$: Next n
Record = 0
Else
If Mode = 3 Then Exit Sub
End If
If EOF(PTWlu) Then GoTo CloseCode
Input #PTWlu, x2 ' Read Second Primary Variable
For n = 1 To NauxV: Input #PTWlu, AuxV(n): Next n 'Read Auxiliary Variables
For n = 1 To NV
For i = 1 To NX(1): Input #PTWlu, V(i, n): Next i 'Read Primary Variables
Next n 'Read Secondary Variables
UT = x2
Latitude = AuxV(2) * ASCAL(2)
Longitude = AuxV(1) * ASCAL(1)
For n = 1 To NV
For i = 1 To NX(1): PV(i) = V(i, 1) * VSCAL(1): Next i
For i = 1 To NX(1): T(i) = V(i, 2) * VSCAL(2): Next i
For i = 1 To NX(1): Zg(i) = V(i, 3) * VSCAL(3) / 1000#: Next i
For i = 1 To NX(1): Zp(i) = ZZp(i): Next i
' Ignore winds for now
Next n 'Read Secondary Variables
Levels = NX(1)
For n = 1 To NX(1)
If T(1) > 900 Then
Levels = Levels - 1
For i = 1 To Levels
PV(i) = PV(i + 1)
T(i) = T(i + 1)
Zg(i) = Zg(i + 1)
Wz(i) = Wz(i + 1)
Wm(i) = Wm(i + 1)
Zp(i) = Zp(i + 1)
' Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
Else
Exit For
End If
Next n
If Mode = 1 Then Close PTWlu: PTWlu = 0
Exit Sub
CloseCode:
Close PTWlu
PTWlu = 0
Quit = True
End Sub
Sub GetNextXS3
Sub GetNextXS3(Mode%, UTsec&, UT&, Latitude!, Longitude!, PV!(), T!(), Zg!(), Zp!(), Wz!(), Wm!(), Levels%, XSfile$, Quit As Boolean)
Static PTWlu%, ZZp!(1 To 50), X$, ii%, jj%, j%, nVar%, Vscale!(1 To 10), PV1&
Static PVs!, Ts!, zgs!, Zps!, Wzs!, Wms!
Dim Org$, Sname$, Mname$, Ivol%, Nvol%, dX(1 To 2), ReduxDate$, n%
Dim Xname$(1 To 2), NSCOML%, NNCOML%
Static VSCAL!(1 To 100), Vmiss!(1 To 100), Vname$(1 To 100)
Static ASCAL!(1 To 100), Amiss!(1 To 100), Aname$(1 To 100)
' If Record=0, read header, otherwise read data
' Mode = 0, don't close file, Mode = 1, close file, Mod = 3, Close file
Dim A$, i%, x2!, x1!(1 To 100), NXm1%, V!(1 To 100, 1 To 100), AuxV!(1 To 100), num!(1 To 100)
Static nHeader%, FFI%, NV%, NauxV%, NX%(1 To 100), NXDEF%(1 To 100)
If Mode = 3 And PTWlu > 0 Then Close (PTWlu): PTWlu = 0: Exit Sub
If PTWlu = 0 And Not (Mode = 3) Then
PTWlu = FreeFile
Open XSfile$ For Input As PTWlu
Input #PTWlu, nHeader%, FFI '1 Number of header records and File Format
Line Input #PTWlu, Pi$ '2 PI
Line Input #PTWlu, Org$ '3 Organization
Line Input #PTWlu, Sname$ '4 Instrument
Line Input #PTWlu, Mname$ '5 Mission
'Mission$ = Mname$
If Mission$ = "TOTE/VOTE" Then Mission$ = "TOTE_VOTE"
Call Read_N_Numbers(PTWlu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #PTWlu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(PTWlu, 2, num())
dX(1) = num(1)
dX(2) = num(2) '8 Interval between primary variables, 0.0 is non-uniform
Call Read_N_Numbers(PTWlu, 1, num())
NX(1) = num(1)
Call Read_N_Numbers(PTWlu, 1, num())
NXDEF(1) = num(1)
For i = 1 To NXDEF(1): Input #PTWlu, x1(i): Next i
For i = 1 To NXDEF(1): ZZp(i) = fPtoZ(x1(i)): Next i 'convert p to Zp
Line Input #PTWlu, Xname$(1) '9 Mission
Line Input #PTWlu, Xname$(2) '10 Mission
Call Read_N_Numbers(PTWlu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #PTWlu, Vname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NauxV = num(1) ' Number of Auxiliary Variables
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: ASCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: Amiss(n) = num(n): Next n
For n = 1 To NauxV: Line Input #PTWlu, Aname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML: Line Input #PTWlu, A$: Next n
Call Read_N_Numbers(PTWlu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #PTWlu, A$: Next n
Record = 0
Else
If Mode = 3 Then Exit Sub
End If
If EOF(PTWlu) Then GoTo CloseCode
Input #PTWlu, x2 ' Read Second Primary Variable
For n = 1 To NauxV: Input #PTWlu, AuxV(n): Next n 'Read Auxiliary Variables
For n = 1 To NV
For i = 1 To NX(1): Input #PTWlu, V(i, n): Next i 'Read Primary Variables
Next n 'Read Secondary Variables
UT = x2
Latitude = AuxV(2) * ASCAL(2)
Longitude = AuxV(1) * ASCAL(1)
For n = 1 To NV
For i = 1 To NX(1): PV(i) = V(i, 1) * VSCAL(1): Next i
For i = 1 To NX(1): T(i) = V(i, 2) * VSCAL(2): Next i
For i = 1 To NX(1): Zg(i) = V(i, 3) * VSCAL(3) / 1000#: Next i
For i = 1 To NX(1): Zp(i) = ZZp(i): Next i
' Ignore winds for now
Next n 'Read Secondary Variables
Levels = NX(1)
For n = 1 To NX(1)
If T(1) > 900 Then
Levels = Levels - 1
For i = 1 To Levels
PV(i) = PV(i + 1)
T(i) = T(i + 1)
Zg(i) = Zg(i + 1)
Wz(i) = Wz(i + 1)
Wm(i) = Wm(i + 1)
Zp(i) = Zp(i + 1)
' Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
Else
Exit For
End If
Next n
If Mode = 1 Then Close PTWlu: PTWlu = 0
Exit Sub
CloseCode:
Close PTWlu
PTWlu = 0
Quit = True
End Sub
Sub GetNextXS4
Sub GetNextXS4(Mode%, UTsec&, UT&, Latitude!, Longitude!, PV!(), T!(), Zg!(), Zp!(), Wz!(), Wm!(), Levels%, XSfile$, Quit As Boolean)
Static PTWlu%, ZZp!(1 To 50), X$, ii%, jj%, j%, nVar%, Vscale!(1 To 10), PV1&
Static PVs!, Ts!, zgs!, Zps!, Wzs!, Wms!
Dim Org$, Sname$, Mname$, Ivol%, Nvol%, dX(1 To 2), ReduxDate$, n%
Dim Xname$(1 To 2), NSCOML%, NNCOML%
Static VSCAL!(1 To 100), Vmiss!(1 To 100), Vname$(1 To 100)
Static ASCAL!(1 To 100), Amiss!(1 To 100), Aname$(1 To 100)
' If Record=0, read header, otherwise read data
' Mode = 0, don't close file, Mode = 1, close file, Mod = 3, Close file
Dim A$, i%, x2!, x1!(1 To 100), NXm1%, V!(1 To 100, 1 To 100), AuxV!(1 To 100), num!(1 To 100)
Static nHeader%, FFI%, NV%, NauxV%, NX%(1 To 100), NXDEF%(1 To 100)
If Mode = 3 And PTWlu > 0 Then Close (PTWlu): PTWlu = 0: Exit Sub
If PTWlu = 0 And Not (Mode = 3) Then
PTWlu = FreeFile
Open XSfile$ For Input As PTWlu
Input #PTWlu, nHeader%, FFI '1 Number of header records and File Format
Line Input #PTWlu, Pi$ '2 PI
Line Input #PTWlu, Org$ '3 Organization
Line Input #PTWlu, Sname$ '4 Instrument
Line Input #PTWlu, Mname$ '5 Mission
'Mission$ = Mname$
If Mission$ = "TOTE/VOTE" Then Mission$ = "TOTE_VOTE"
Call Read_N_Numbers(PTWlu, 2, num())
Ivol = num(1)
Nvol = num(2) '6
Line Input #PTWlu, A$ '7 Flight date and Reduction Date
' 1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
' 12345678901234567890123
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
ReduxDate$ = Mid$(A$, 13, 4) + Mid$(A$, 18, 2) + Mid$(A$, 21, 2)
Call Read_N_Numbers(PTWlu, 2, num())
dX(1) = num(1)
dX(2) = num(2) '8 Interval between primary variables, 0.0 is non-uniform
Call Read_N_Numbers(PTWlu, 1, num())
NX(1) = num(1)
Call Read_N_Numbers(PTWlu, 1, num())
NXDEF(1) = num(1)
For i = 1 To NXDEF(1): Input #PTWlu, x1(i): Next i
For i = 1 To NXDEF(1): ZZp(i) = fPtoZ(x1(i)): Next i 'convert p to Zp
Line Input #PTWlu, Xname$(1) '9 Mission
Line Input #PTWlu, Xname$(2) '10 Mission
Call Read_N_Numbers(PTWlu, 1, num())
NV = num(1) '11 Number of Primary variables
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: VSCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NV, num())
For n = 1 To NV: Vmiss(n) = num(n): Next n
For n = 1 To NV: Line Input #PTWlu, Vname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NauxV = num(1) ' Number of Auxiliary Variables
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: ASCAL(n) = num(n): Next n
Call Read_N_Numbers(PTWlu, NauxV, num())
For n = 1 To NauxV: Amiss(n) = num(n): Next n
For n = 1 To NauxV: Line Input #PTWlu, Aname(n): Next n
Call Read_N_Numbers(PTWlu, 1, num())
NSCOML = num(1) ' Number of special comment lines
For n = 1 To NSCOML: Line Input #PTWlu, A$: Next n
Call Read_N_Numbers(PTWlu, 1, num())
NNCOML = num(1) ' Number of normal comment lines
For n = 1 To NNCOML: Line Input #PTWlu, A$: Next n
Record = 0
Else
If Mode = 3 Then Exit Sub
End If
If EOF(PTWlu) Then GoTo CloseCode
Input #PTWlu, x2 ' Read Second Primary Variable
For n = 1 To NauxV: Input #PTWlu, AuxV(n): Next n 'Read Auxiliary Variables
For n = 1 To NV
For i = 1 To NX(1): Input #PTWlu, V(i, n): Next i 'Read Primary Variables
Next n 'Read Secondary Variables
UT = x2
Latitude = AuxV(2) * ASCAL(2)
Longitude = AuxV(1) * ASCAL(1)
For n = 1 To NV
For i = 1 To NX(1): PV(i) = V(i, 1) * VSCAL(1): Next i
For i = 1 To NX(1): T(i) = V(i, 2) * VSCAL(2): Next i
For i = 1 To NX(1): Zg(i) = V(i, 3) * VSCAL(3) / 1000#: Next i
For i = 1 To NX(1): Zp(i) = ZZp(i): Next i
' Ignore winds for now
Next n 'Read Secondary Variables
Levels = NX(1)
For n = 1 To NX(1)
If T(1) > 900 Then
Levels = Levels - 1
For i = 1 To Levels
PV(i) = PV(i + 1)
T(i) = T(i + 1)
Zg(i) = Zg(i + 1)
Wz(i) = Wz(i + 1)
Wm(i) = Wm(i + 1)
Zp(i) = Zp(i + 1)
' Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
Else
Exit For
End If
Next n
If Mode = 1 Then Close PTWlu: PTWlu = 0
Exit Sub
CloseCode:
Close PTWlu
PTWlu = 0
Quit = True
End Sub
Sub GetTDCvalues
Sub GetTDCvalues(UTsec&, UT&, P!, T!, Th!, U!, V!, W!, MMfile$, Quit As Boolean)
Dim i%, i2%, A$, HeaderCount%
Static MMlu%, Tcorrection%
If 1 = 1 Then 'EUPLEX and SCOUT-O3 final data
If Quit Then
If MMlu <> 0 Then Close MMlu
MMlu = 0
Quit = False
End If
If MMlu = 0 Then
MMlu = FreeFile
Open MMfile$ For Input As MMlu
Input #MMlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount + 1: Line Input #MMlu, A$: Next i
Else
If EOF(MMlu) Then
Close MMlu
MMfile$ = ""
Exit Sub
End If
End If
Do 'Catch up 'ER2 MMS 1940 sec slow on 20020728 and 1550 sec slow on 20020726
Line Input #MMlu, A$
UT = Int(Val(Left$(A$, 8)) + 0.5)
Loop Until (UT >= UTsec) Or EOF(MMlu)
If EOF(MMlu) Then
Close MMlu
MMlu = 0
Quit = True
Exit Sub
End If
' Time Pst* H* Tst* Vtrue* U* Ud*
' 22821 945.7 578 -3.06 13.1 3.9 30
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' 13450 986.1 228 245.2 29.50 9.3 281 303.7
P = (Val(Mid$(A$, 10, 7)))
T = Val(Mid$(A$, 33, 8)) + cTo 'Kelvin
OATmms = T
' Th = Val(Mid$(a$, 20, 5) / 10#)
' U = Val(Mid$(a$, 25, 5) / 10#)
' v = Val(Mid$(a$, 30, 5) / 10#)
' W = Val(Mid$(a$, 35, 5) / 10#)
Else 'SCOUT-O3 tab delimited and no header, prelim data
If MMlu = 0 Then
MMlu = FreeFile
Open MMfile$ For Input As MMlu
Input #MMlu, HeaderCount, A$ 'Skip Header Info
Else
If EOF(MMlu) Then
Close MMlu
MMfile$ = ""
Exit Sub
End If
End If
Do 'Catch up
Line Input #MMlu, A$
i = InStr(1, A$, vbTab)
UT = Int(Val(Left$(A$, i - 1)) + 0.5)
Loop Until (UT >= UTsec) Or EOF(MMlu)
If EOF(MMlu) Then
Close MMlu
MMlu = 0
Quit = True
Exit Sub
End If
'Time Pst* H* Vtrue* Tst* Uwind* W_dir* Q*
'18000 1003.2 84 22.8 33.75 6.3 27 306.5
'18001 1003.2 84 22.9 33.75 6.4 27 306.5
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
i2 = InStr(i + 1, A$, vbTab)
P = (Val(Mid$(A$, i + 1, i2 - i - 1)))
i = InStr(i2 + 1, A$, vbTab)
i2 = InStr(i + 1, A$, vbTab)
i = InStr(i2 + 1, A$, vbTab)
T = Val(Mid$(A$, i2 + 1, i - i2 - 1)) + cTo 'Kelvin
OATmms = T
End If
End Sub
Sub GetUCSEvalues
Sub GetUCSEvalues(UTsec&, UT&, P!, T!, mPitch!, mRoll!, mLatitude!, mLongitude!, mHeading!, mZg!, mZp!, mWspd!, mWdir!, UCSEfile$, Quit As Boolean)
Dim i%, A$, HeaderCount%, Char As Byte
Static UCSElu%
If UCSElu = 0 Then
UCSElu = FreeFile
Open UCSEfile$ For Input As UCSElu
Input #UCSElu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #UCSElu, A$: Next i
' Char = Input(1, UCSElu)
' Debug.Print Hex$(Asc(Char))
Else
If EOF(UCSElu) Then
Close UCSElu
UCSEfile$ = ""
Exit Sub
End If
End If
Do 'Catch up
Line Input #UCSElu, A$
UT = Int(Val(Left$(A$, 6)) + 0.5)
Loop Until (UT >= UTsec And Mid$(A$, 18, 4) <> "9999") Or EOF(UCSElu)
If EOF(UCSElu) Then
Close UCSElu
UCSElu = 0
Quit = True
Exit Sub
End If
'TIME Tout Pstat Vtrue Halt Dr_ang Head Pitch Attac Sl_ang Uwind W_dir Roll Lat Long Gr_sp Tr_ang Alt SS1 SS2 SRK SYS_TIME
'18660 34.98 1001.5 68.01 81 -0.88 288.74 3.08 6.07 15.05 6.05 288.75 0.59 -12.4188 130.8933 0.0 213 34 111111111 1110111111101111 11110 51632526
'18661 34.94 1001.5 65.13 81 -0.88 288.74 3.08 6.10 15.02 5.81 288.75 0.60 -12.4188 130.8933 0.0 192 34 111111111 1110111111101111 11110 51632527
' TIME Tout Pstat Vtrue Halt Dr_ang Head Pitch Attac Sl_ang Uwind W_dir Roll Lat Long Gr_sp Tr_ang Alt SS1 SS2 SRK SYS_TIME
' 28207 -12.75 947.37 49.37 563 0 57.94 3.05 0 0 13.71 58.33 0.45 67.8215 20.3273 0 177 441 1111111111111111 1011111111111111 110 1
' 36807 -63.16 74.83 699.22 18006 7.16 3.55 4.84 5.93 0.58 27.93 -52.89 1.03 75.3677 24.4817 659.4 12 16978 1111111111111111 111111111111111 110 8601
' 34085 -0.3 962.3 56.5 433 0 58.15 2.75 0 0 999 9999 0.65 67.82 20.33 999 999999 99999 9999999999999999 9999999999999999 9999 5
' 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
' 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
T = Val(Mid$(A$, 7, 6)) + cTo 'Kelvin
P = Val(Mid$(A$, 14, 6))
'Th = fTheta(T, P)
mHeading = Val(Mid$(A$, 41, 7))
mZp = Val(Mid$(A$, 28, 5))
mZg = Val(Mid$(A$, 124, 5))
mPitch = Val(Mid$(A$, 49, 5))
mRoll = Val(Mid$(A$, 83, 7))
mLatitude = Val(Mid$(A$, 91, 9))
mLongitude = Val(Mid$(A$, 101, 9))
mWspd = Val(Mid$(A$, 68, 6))
If Val(Mid$(A$, 75, 6)) = 9999 Then mWdir = 999 Else mWdir = Val(Mid$(A$, 75, 6))
End Sub
Sub GetNAVvalues
Sub GetNAVvalues(Prefix$, UTsec&, UT&, P!, T!, param!(), PTWfile$, Quit As Boolean)
' Prefix$ . Nav file 2 letter prefix
' UTsec ... current time, if <0 then just get next record, if >= 0 go to that time
' UT ... time read from Nav file corresponding to UTsec
' P, T, Th, U, V, W ... pressure, temperature, theta, and winds at UT
' PTWfile$ Nav file to read.
' Quit .... TRUE if EOF
Dim i%, mTh!, mT!, mPitch!, mRoll!, mLatitude!, mLongitude!, mZg!, mZp!, mWspd!, mWdir!, mHeading!, Wu!, Wv!, Ww!
Dim X!
' param(1) = P hPa
' param(2) = T K
' param(3) = mPitch deg
' param(4) = mRoll deg
' param(5) = mLatitude deg
' param(6) = mLongitude deg
' param(7) = mHeading deg
' param(8) = mZg km
' param(9) = mZp km
' param(10) = mWspd kts
' param(11) = mWdir deg
' param(12) = mU m/s
' param(13) = mV m/s
' param(14) = mW m/s
' param(15) = mTheta K
' param(16) = T2 K 'Research T for NGV
For i = 1 To 16
param(i) = 99999#
Next i
Select Case Prefix$
Case "NG"
Call GetNGvalues(UTsec&, UT, P!, T!, mT!, mLatitude!, mLongitude!, mZg!, mZp!, mPitch!, mRoll!, PTWfile$, Quit)
If Quit Then
X = X
End If
param(3) = mPitch
param(4) = mRoll
param(5) = mLatitude
param(6) = mLongitude
param(8) = mZg
param(9) = mZp
param(16) = mT
Case "MM"
Call GetMMSvalues(UTsec, UT, P, T, mTh, Wu, Wv, Ww, PTWfile$, Quit)
param(12) = Wu
param(13) = Wv
param(14) = Ww
Case "PT": Call GetPTWvalues(UTsec&, UT, P!, T!, PTWfile$)
Case "FT": Call GetFTvalues(UTsec&, UT, P!, T!, mLatitude!, mLongitude!, mZg!, mZp!, mWspd!, mWdir!, PTWfile$)
param(5) = mLatitude
param(6) = mLongitude
param(8) = mZg
param(9) = mZp
param(10) = mWspd
param(11) = mWdir
Case "NC": Call GetNCvalues(UTsec&, UT, P!, T!, PTWfile$, Quit)
Case "IC"
Call GetICATSvalues(UTsec&, UT&, P!, T!, mZg, PTWfile$, Quit)
param(8) = mZg
Case "UC":
'UTsec = fTstringToSec(Right$(AA$, 6), False) + 27 'MTP is 27 seconds slow
Call GetUCSEvalues(UTsec&, UT&, P!, T!, mPitch!, mRoll!, mLatitude!, mLongitude!, mHeading!, mZg!, mZp!, mWspd!, mWdir!, PTWfile$, Quit)
param(3) = mPitch
param(4) = mRoll
param(5) = mLatitude
param(6) = mLongitude
param(7) = mHeading
param(8) = mZg
param(9) = mZp
param(10) = mWspd
param(11) = mWdir
Case "TD"
'Call GetABLEvalues(UTsec&, UT&, mZg!, mZp!, PTWfile$, Quit)
Call GetTDCvalues(UTsec&, UT&, P!, T!, mTh!, Wu!, Wv!, Ww!, PTWfile$, Quit)
End Select
param(1) = P 'hPa
param(2) = T 'K
param(15) = fTheta(T, P) 'K
End Sub
Sub GetXSvalues
Sub GetXSvalues(Mode%, UTsec&, UT&, Latitude!, Longitude!, PV!(), T!(), Zg!(), Zp!(), Wz!(), Wm!(), Levels%, XSfile$, Quit As Boolean)
Dim i%, A$, HeaderCount%, V!, Txs!
Static PTWlu%, ZZp!(1 To 17), X$, ii%, jj%, j%, nMax%, nVar%, Vscale!(1 To 10), PV1&
Static PVs!, Ts!, zgs!, Zps!, Wzs!, Wms!
'32 2010
'Atlas , Lamich, Strahan, Lucchesi, Steenrod, Ledvina, Conaty, Pawson, Newman, Lait
'NASA Goddard Space Flight Center Codes 910.3 and 916
'GSFC Assimilation GG1X1 grid data interpolated to the DC8 flight curtain
'SOLVE
'1 1
'2000 03 08 2000 07 26
'0.00000 0.00000
'17
'17 'line10
'1000 850 700 500 400 300 250 200 150 100 70 50 30 10 5 2 1
'Pressure Levels(mb)
'seconds from 0 GMT on flight date
'5
'1.00000E-07 0.100000 1.00000 0.0100000 0.100000 line15
'999999 9999 99999 9999 999 line16
'Ertel 's Potential Vorticity (K m^2/kg s)
'Temperature (k)
'Geopotential Height(M)
'Zonal wind(M / s)
'Meridional wind(M / s)
'2
'0.0100000 0.100000
'9999 999
'Longitude (degrees East)
'Latitude (degrees North)
'0
'4
'Aircraft position is taken from the DFexchange file
'Assimilation analyses are interpolated to the flight curtain
'linearly in latitude and longitude.
'Data are valid for 12 UTC on 8 March, 2000.
' Mode =1 Get a single profile and close file
' Mode =0 Get next profile
If PTWlu = 0 Then
PTWlu = FreeFile
Open XSfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount
Line Input #PTWlu, A$
Select Case i
Case 10
nMax = Val(A$)
Case 11
jj = 1
For j = 1 To nMax
ii = InStr(jj, A$, " ")
If ii = 0 Then ii = Len(A$) + 1
ZZp(j) = fPtoZ(Val(Mid$(A$, jj, ii - jj)))
jj = ii + 1
Next j
Case 14
nVar = Val(A$)
Case 15
jj = 1
For j = 1 To nVar
ii = InStr(jj, A$, " ")
If ii = 0 Then ii = Len(A$) + 1
Vscale(j) = Val(Mid$(A$, jj, ii - jj))
jj = ii + 1
Next j
Case 16
ii = InStr(1, A$, " ")
PV1 = Val(Left$(A$, ii - 1))
Case Else
End Select
Next i
' ZZp(1) = fPtoZ(1000): ZZp(2) = fPtoZ(850): ZZp(3) = fPtoZ(700): ZZp(4) = fPtoZ(500)
' ZZp(5) = fPtoZ(400): ZZp(6) = fPtoZ(300): ZZp(7) = fPtoZ(250): ZZp(8) = fPtoZ(200)
' ZZp(9) = fPtoZ(150): ZZp(10) = fPtoZ(100): ZZp(11) = fPtoZ(70): ZZp(12) = fPtoZ(50)
' ZZp(13) = fPtoZ(30): ZZp(14) = fPtoZ(10): ZZp(15) = fPtoZ(5): ZZp(16) = fPtoZ(2)
' ZZp!(17) = fPtoZ(1):
X$ = " "
Else
If EOF(PTWlu) Then GoTo CloseCode
End If
Do 'Catch up
If EOF(PTWlu) Then GoTo CloseCode
Line Input #PTWlu, A$
i = InStr(1, A$, " ")
UT = Val(Left$(A$, i - 1))
If UT < UTsec Then
For i = 1 To 10
If EOF(PTWlu) Then GoTo CloseCode
Line Input #PTWlu, A$
Next i 'skip data
End If
Loop Until UT >= UTsec
'UTsec Lon Lat
'55110 603 758
' -4 38 19 39 42 125 375 681 912 1703
'2949 4920 12817 50960 103319 291838 968698
' 2681 2604 2488 2333 2232 2099 2055 2058 2048 2022
'2002 2002 2045 2211 2380 2504 2488
' 133 1386 2836 5208 6699 8520 9623 10963 12695 15107
'17202 19171 22174 28986 33630 40181 45343
' -45 -37 -36 -40 -17 16 27 33 25 -4
'-19 -25 -35 -13 70 17 141
' -24 -53 -63 27 66 94 61 -18 -76 -120
'-158 -204 -267 -263 -172 -119 34
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
A$ = Right$(A$, Len(A$) - 6)
Longitude = Val(Left$(A$, InStr(1, A$, " ", 1) - 1)) / 100#
Latitude = Val(Right$(A$, Len(A$) - InStr(1, A$, " ", 1) + 1)) / 10#
For i = 1 To nMax: Input #PTWlu, PV(i): Next i
For i = 1 To nMax: Input #PTWlu, T(i): Next i
For i = 1 To nMax: Input #PTWlu, Zg(i): Next i
For i = 1 To nMax: Input #PTWlu, Wz(i): Next i
For i = 1 To nMax: Input #PTWlu, Wm(i): Next i
For i = 1 To nMax: Zp(i) = ZZp(i): Next i
' Do
' If PV(1) = PV1 Then 'Substitute for missing data
' PV(1) = PVs
' T(1) = Ts
' Zg(1) = zgs
' Wz(1) = Wzs
' Wm(1) = Wms
' Zp(1) = Zps
' Else 'Save last good cycle
' PVs = PV(1)
' Ts = T(1)
' zgs = Zg(1)
' Wzs = Wz(1)
' Wms = Wm(1)
' Zps = Zp(1)
' End If
' Loop Until PV(1) <> PV1
If T(1) = 9999 Then
nMax = nMax - 1
For i = 1 To nMax
PV(i) = PV(i + 1) * Vscale(1)
T(i) = T(i + 1) * Vscale(2)
Zg(i) = Zg(i + 1) * Vscale(3)
Wz(i) = Wz(i + 1) * Vscale(4)
Wm(i) = Wm(i + 1) * Vscale(5)
Zp(i) = Zp(i + 1)
' Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
Else
For i = 1 To nMax
PV(i) = PV(i) * Vscale(1)
T(i) = T(i) * Vscale(2)
Zg(i) = Zg(i) * Vscale(3)
Wz(i) = Wz(i) * Vscale(4)
Wm(i) = Wm(i) * Vscale(5)
' Debug.Print i; PV(i); T(i); Zg(i); Zp(i); Wz(i); Wm(i)
Next i
End If
Levels = nMax
If Mode = 1 Then Close PTWlu: PTWlu = 0
Exit Sub
CloseCode:
Close PTWlu
PTWlu = 0
Quit = True
End Sub
Sub ReadRCconfig
Sub ReadRCconfig(iRC%, RCname$)
Dim i%, j%, k%, L%, i0%, i1%, i2%, lu%, Cmd$, V$, z!, TA1!(1 To 3, 1 To 10), TA2!(1 To 3, 1 To 10)
Dim OB1!(1 To 30), OB2!(1 To 30), r$(1 To 8)
If Len(Dir(RCname$)) = 0 Then
MsgBox "Could not find RC configuration file " + RCname$, vbOKOnly
Exit Sub
End If
FoundSmatrix = False
lu% = FreeFile
Open RCname$ For Input As lu%
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "RCformat"
Input #lu, RCformat(iRC)
Case "RAOB"
Input #lu, RCtemplate$(iRC) 'RC RAOB Template (eg BGDH__2003010912.RAOB2)
If Mid$(fGetFilename(RCtemplate$(iRC)), 6, 1) = "_" Then RAOBreanalysis = True
Input #lu, RAOBcount 'Number of available RAOBs
' Need to take into account that older RC files only had 6 [RAOB] entries
i = 0
Do
i = i + 1
Line Input #lu, r$(i)
Loop Until Len(r$(i)) = 0
If i = 7 Then
LR1 = Val(r$(1)) 'LR above top of RAOB
zLRb = Val(r$(2)) 'LR break altitude
LR2 = Val(r$(3)) 'LR above break altitude
RecordStep = Val(r$(4)) 'Record Step through available RAOBs
MinimumRAOBz = Val(r$(5)) 'Minimum acceptable RAOB altitude
ExcessTamplitude = Val(r$(6)) 'Random Excess Noise Level on Ground
Else
LR1 = Val(r$(1)) 'LR above top of RAOB
RecordStep = Val(r$(2)) 'Record Step through available RAOBs
MinimumRAOBz = Val(r$(3)) 'Minimum acceptable RAOB altitude
ExcessTamplitude = Val(r$(4)) 'Random Excess Noise Level on Ground
End If
Case "Nret"
Input #lu, Nret
For i = 1 To Nret 'Read pressure altitude offsets
Input #lu, dZ(i)
Next i
Case "Nobs"
Input #lu, Nobs
For i = 1 To Nobs 'Read observable errors
Input #lu, OBrms(1, i) 'These should not be used as there is only one cfg file, but NFL OBrms values
Next i
Case "NFL"
Input #lu, NFL 'Read Flight levels
For i = 1 To NFL
Input #lu, z
FLA(i) = Int(z * 100 + 0.5)
Next i
Case "Nlo"
Input #lu, Nlo 'Read Flight levels
For i = 1 To Nlo
Input #lu, LO(i)
Next i
Case "Nel"
Input #lu, Nel 'Read Flight levels
For i = 1 To Nel
Input #lu, El(i)
Next i
Case "Smatrix"
FoundSmatrix = True
For i = 1 To NFL
For j = 1 To Nlo
For k = 1 To Nel
For L = 1 To 2 'linear and quadratic term, there is no bias term
Input #lu, Smatrix(iRC, i, j, k, L)
Next L
TA1(j, k) = Smatrix(iRC, i, j, k, 1)
TA2(j, k) = Smatrix(iRC, i, j, k, 2)
Next k
Next j
Call MapTAtoOB(TA1(), OB1(), Channels, Nel, LocHor, ChInfo())
Call MapTAtoOB(TA2(), OB2(), Channels, Nel, LocHor, ChInfo())
For j = 1 To Nobs
SmatrixOB(iRC, i, j, 1) = OB1(j)
SmatrixOB(iRC, i, j, 2) = OB2(j)
Next j
Next i
Case Else
End Select
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub ReadMTPH
Sub ReadMTPH(MTPHname$)
Dim i%, j%, k%, L%, i0%, i1%, i2%, lu%, Cmd$, V$, z!, TA1!(1 To 3, 1 To 10), TA2!(1 To 3, 1 To 10)
Dim IntegrationTime!, X$, Nel%, Nlo%
If Len(Dir(MTPHname$)) = 0 Then
MsgBox "Could not find MTPH configuration file " + MTPHname$, vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open MTPHname$ For Input As lu%
Do
If EOF(lu%) Then GoTo Exit_Sub
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Missing right bracket not found!", vbOKOnly
Exit Sub
End If
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "Aircraft"
Input #lu, X$
Case "NominalPitch"
Input #lu, X$
Case "Offsets"
Line Input #lu, X$
MTPyaw = Val(Left$(X$, 7))
Line Input #lu, X$
MTPpitch = Val(Left$(X$, 7))
Line Input #lu, X$
MTProll = Val(Left$(X$, 7))
Case "Integ. Time"
Input #lu, X$
Case "Frequencies" 'Read Frequencies
Input #lu, Nlo
For i = 1 To Nlo
Line Input #lu, X$
LOSUI(i) = Val(X$)
Next i
Case "El. Angles" 'Read Elevation Angles
Line Input #lu, X$
Nel = Left$(X$, 3)
Line Input #lu, X$ 'Fiduciary
For i = 1 To Nel
Line Input #lu, X$
j = InStr(1, X$, "'")
ElSUI(i) = Val(Left$(X$, j))
If Abs(ElSUI(i)) > EmaxDegrees Then EmaxDegrees = ElSUI(i)
Next i
End Select
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub ReadWCT
Sub ReadWCT(Filename$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean, i%, j%, response As Variant
On Error GoTo CopyCal
lu% = FreeFile
Carryon:
Open Filename$ For Input As lu%
CalFileFormat = CInt(fReadFirstNumber(lu))
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
' Extract PI$
If FIsize% = 2 Then Pi$ = Right$(Cmd$, Len(Cmd$) - 7)
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
Stop
End If
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "WINDOW_CORRECTIONS"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, 3)
Case "WCT"
i = Val(Mid$(Cmd$, 4, 1))
j = Val(Mid$(Cmd$, 5, 2))
WINcor(i, j) = Val(V$)
Case Else
End Select
End If
Loop
Case "EOF"
Exit Sub
Case Else
End Select
End If
Loop
Exit_Sub:
Close (lu%)
AC$ = Mid$(Rdir$, 2, 2)
Root$ = Drive$ + Rdir$
Path$ = Root$ + Mission$ + "\" + yyyymmdd$ + "\" 'Just in case!
yymmdd$ = Right$(yyyymmdd$, 6)
Exit Sub
CopyCal:
response = MsgBox("Calfile has not been copied to flight directory!" + vbCrLf + " Do you wish to copy the default Calfile?", vbYesNo)
If response = vbYes Then
'frmMTPbin.cmdCopyCal_Click
GoTo Carryon
Else
Stop
Exit Sub
End If
End Sub
Sub WriteRCconfig
Sub WriteRCconfig(f As Form)
Dim CFGlu%, i%, j%, k%, L%, CFGfile$, mm$, MyDate As Variant
' Open I/O files
CFGlu = FreeFile
CFGfile$ = f.txtRAOBpath.Text + "RC\" + fReplaceExtension(f.txtRCfile.Text, "CFG")
Open CFGfile$ For Output As CFGlu
Print #CFGlu, "' RC Configuration file: Created- " + Date$ + " " + Time$
Print #CFGlu, ""
Print #CFGlu, "[RCformat]"
Print #CFGlu, Str(Val(f.txtRCformat.Text))
Print #CFGlu, ""
Print #CFGlu, "[RAOB]"
Print #CFGlu, Trim(f.cboRAOBfiles.Text)
Print #CFGlu, Str(RAOBcount) 'Number of available RAOBs
Print #CFGlu, Str(Val(f.txtLR1.Text)) 'LR above top of RAOB
Print #CFGlu, Str(Val(f.txtZb.Text)) 'LR break altitude
Print #CFGlu, Str(Val(f.txtLR2.Text)) 'LR above break altitude
Print #CFGlu, Str(Val(f.txtRecordStep.Text)) 'Record Step through available RAOBs
Print #CFGlu, Str(Val(f.txtRAOBmin.Text)) 'Minimum acceptable RAOB altitude
If f.chkExcessGndT.Value = True Then
Print #CFGlu, Str(Val(f.txtExcessTamplitude)) 'Random Excess Noise Level on Ground
Else
Print #CFGlu, "0" 'Random Excess Noise Level on Ground
End If
Print #CFGlu, SURC$ 'SU IF bandpass
Print #CFGlu, ""
Print #CFGlu, "[Nobs]"
Print #CFGlu, Str(Nobs)
For i = 1 To Nobs - 1 'Read observable errors
Print #CFGlu, Format(OBrms(1, i), "0.00") + " "; 'Assume all RCs have same FLs
Next i
Print #CFGlu, Format(OBrms(1, Nobs), "0.00")
Print #CFGlu, ""
Print #CFGlu, "[Nret]"
Print #CFGlu, Str(Nret)
For i = 1 To Nret - 1 'Write retrieval offset levels
Print #CFGlu, Format(dZ(i), "##0.0") + " ";
Next i
Print #CFGlu, Format(dZ(Nret), "##0.0")
Print #CFGlu, ""
Print #CFGlu, "[NFL]"
Print #CFGlu, Str(NFL)
For i = 1 To NFL - 1 'Write flight levels
Print #CFGlu, Format(Zr(i), "#0.00") + " ";
Next i
Print #CFGlu, Format(Zr(NFL), "#0.00")
Print #CFGlu, ""
Print #CFGlu, "[Nlo]"
Print #CFGlu, Str(Nlo)
For i = 1 To Nlo - 1 'Write LO Frequencies
Print #CFGlu, Format(LO(i), "#00.000") + " ";
Next i
Print #CFGlu, Format(LO(Nlo), "#00.000")
Print #CFGlu, ""
Print #CFGlu, "[Nel]"
Print #CFGlu, Str(Nel)
For i = 1 To Nel - 1 'Write LO Frequencies
Print #CFGlu, Format(El(i), "#00.0") + " ";
Next i
Print #CFGlu, Format(El(Nel), "#00.0")
Print #CFGlu, ""
Print #CFGlu, "[Nif]"
Print #CFGlu, Str(Nif)
For i = 1 To Nif 'Write IF offset frequencies (GHz)
Print #CFGlu, formats(IFoff(1, i), "#0.0000") + " ";
Next i
Print #CFGlu, formats(IFwt(1, Nif), "#0.0000")
For i = 1 To Nif 'Write IF weights
Print #CFGlu, formats(IFwt(1, i), "#0.0000") + " ";
Next i
Print #CFGlu, ""
Print #CFGlu, ""
' Print #CFGlu, Format(IFwt(Nif), "#0.0000")
' Write sensitivity matrix
Print #CFGlu, "[Smatrix]"
For i = 1 To NFL
For j = 1 To Nlo
For k = 1 To Nel 'linear and quadratic term, there is no bias term
Print #CFGlu, formats(Smatrix(0, i, j, k, 1), "#0.000") + " "; formats(Smatrix(0, i, j, k, 2), "#0.00000") + " ";
Next k
Next j
Print #CFGlu, ""
Next i
Print #CFGlu, ""
Close CFGlu
End Sub
Sub ReadCAL
Sub ReadCAL(Filename$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean, i%, j%, response As Variant
' Read new mjm .INI Calfile Format
'Exit Sub
On Error GoTo CopyCal
lu% = FreeFile
Carryon:
Open Filename$ For Input As lu%
CalFileFormat = CInt(fReadFirstNumber(lu))
'MsgBox "ReadCAL Entry!", vbOKOnly
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If FIsize% = 2 Then 'Extract PI$
Pi$ = Right$(Cmd$, Len(Cmd$) - 7)
'Debug.Print Pi$
End If
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
'Print "Right Bracket not found. Fix line number ", FIsize%
Stop
End If
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "GENERAL"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'Debug.Print cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
Select Case Left$(Cmd$, i1% - 1)
Case "GenDate": Gendate$ = V$
Case "FltDate": FltDate$ = V$
Case "UTstart"
Case "UTend"
Case "Channels": Channels = Val(V$)
Case "Nel": Nel = Val(V$)
Case "Emissivity": Emissivity = Val(V$)
Case "Reflectivity": Reflectivity = Val(V$)
Case "DeltaTmin": DeltaTmin = Val(V$)
Case Else
End Select
End If
Loop
Case "FIT_INFO"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "Nfit": Nfit = Val(V$)
Case "Offset": NP$(1) = V$: GOF(1) = 0#
Case "FitVar1": NP$(2) = V$
Case "FitVar2": NP$(3) = V$
Case "FitVar3": NP$(4) = V$
Case "FitVar4": NP$(5) = V$
Case "GEC11": GEC(1, 1) = Val(V$)
Case "GEC12": GEC(1, 2) = Val(V$)
Case "GEC13": GEC(1, 3) = Val(V$)
Case "GEC14": GEC(1, 4) = Val(V$)
Case "GEC15": GEC(1, 5) = Val(V$)
Case "GEC21": GEC(2, 1) = Val(V$)
Case "GEC22": GEC(2, 2) = Val(V$)
Case "GEC23": GEC(2, 3) = Val(V$)
Case "GEC24": GEC(2, 4) = Val(V$)
Case "GEC25": GEC(2, 5) = Val(V$)
Case "GEC31": GEC(3, 1) = Val(V$)
Case "GEC32": GEC(3, 2) = Val(V$)
Case "GEC33": GEC(3, 3) = Val(V$)
Case "GEC34": GEC(3, 4) = Val(V$)
Case "GEC35": GEC(3, 5) = Val(V$)
Case "GOF1": GOF(2) = Val(V$)
Case "GOF2": GOF(3) = Val(V$)
Case "GOF3": GOF(4) = Val(V$)
Case "GOF4": GOF(5) = Val(V$)
Case "TARGET":
TGToffset = Val(V$)
' MsgBox "ReadCAL:" + Str(TGToffset), vbOKOnly
Case "MIXER": MXRoffset = Val(V$)
Case Else
End Select
End If
Loop
Case "WINDOW_CORRECTIONS"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, 3)
Case "WCT"
i = Val(Mid$(Cmd$, 4, 1))
j = Val(Mid$(Cmd$, 5, 2))
WINcor(i, j) = Val(V$)
Case Else
End Select
End If
Loop
Case "EOF"
Exit Sub
Case Else
End Select
End If
Loop
Exit_Sub:
Close (lu%)
AC$ = Mid$(Rdir$, 2, 2)
Root$ = Drive$ + Rdir$
Path$ = Root$ + Mission$ + "\" + yyyymmdd$ + "\" 'Just in case!
yymmdd$ = Right$(yyyymmdd$, 6)
Exit Sub
CopyCal:
response = MsgBox("Calfile has not been copied to flight directory!" + vbCrLf + " Do you wish to copy the default Calfile?", vbYesNo)
If response = vbYes Then
'frmMTPbin.cmdCopyCal_Click
GoTo Carryon
Else
Stop
Exit Sub
End If
End Sub
Sub DecodeAline
Sub DecodeAline(A$, GoToNext As Boolean)
' This sub decodes the raw A-line data from the MTP Data Unit
' Parameters include:
' AlineFormat Single character identifying the A-line format
' DOY Day of Year
' HH:MM:SS UT time
' Latitude Latitude (degrees)
' Longitude Longitude (degrees)
' Heading Heading (degrees)
' Pitch Aircraft Pitch (degrees)
' Roll Aircraft Roll (degrees)
' gALT Geometric Altitude (km)
' pALT Pressure Altitude (km)
' OATn Aircraft Outside Air Temperature (Celcius)
' Wind Speed Aircraft Wind Speed (knots)
' Wind Direction Aircraft Wind Direction (degrees)
' ElCorr Sensor Unit Elevation Angle Correction (degrees)
' ElCorrUsed 0/1 depending on whether Elcorr was used
' MTP Clock yymmdd Ditto
' MTP Cloci hhmmss Ditto
' Status Receiver Hardware Information
' StatusBit(7) 128 Acceleration >60 counts
' StatusBit(6) 64 DU: 0=#1 (old) 1=#2 (new)
' StatusBit(5) 32 SU: 0=#1 (old) 1=#2 (new)
' StatusBit(4) 16 Spare
' StatusBit(3) 8 Spare
' StatusBit(2) 4 Spare
' StatusBit(0) 1 Timeout on Phase Lock 0=OK, 1=Fail
'
' Other parameters calculated here are:
' pALTft Pressure Altitude (ft)
' gALTft Geometric Altitude (ft)
' OATnav Aircraft Outside Air Temperature (Kelvin)
Dim AlineFormat$, X$, ALTkmu!, ALTcor!, dALT!
Static dtMTP!
Static LatitudeLast!, LongitudeLast!, gALTlast!, gALTftLast!, pALTftLast!
GoToNext = False
AlineFormat = Mid$(A$, 2, 1)
If AlineFormat = "W" And Val(yyyymmdd$) < 19990000 Then AlineFormat = "Y" 'WAM has different format
Select Case AlineFormat
Case " ", "G", "N", "X", "W", "!" 'WB57 after WAM (ie ACCENT) is "W", for WAM is "Y"
' ER2 Format
' 1 2 3 4 5 6 7 8 9 10
' 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
' doy hh mm ss snn.lat snnn.lon hdg ppp.p rr.rr .zgeo pALT OAT Wspd Wdir Scndispc yymmdd hhmmss
' doy hh mm ss snn.lat snnn.lon hdg ppp.p rr.rr .zgeo pALT OAT Wspd Wdir Scndispc Sta yymmdd hhmmss
' AG266:22:02:32 -3.051 -159.368 64.2 .6 3.7 20479 20178 -65.9 .9 3.2 -188.9 1 255 970923 220222
' Geophysica
' AG...12:46:23 67.821 20.327 36.4 3.0 .6 451 552 -10.3 15.9 36.6 -191.8 1 0 030123
' Put in colon (:) 20030125
' AG...:00:15:16 67.821 20.327 149.5 3.5 -.4 99999 494 18.1 15.4 149.9 -192.4 1 0 030125 143357
' AG173:19:36:50 +35.184 -98.3247 346.0 .2 -.2 13980 13170 -62.8 12.6 170.5 -192.5 1 0 050622 193607
Latitude = Val(Mid$(A$, 15, 8))
Longitude = Val(Mid$(A$, 23, 9))
Heading = Val(Mid$(A$, 32, 6))
Pitch = Val(Mid$(A$, 38, 6))
Roll = Val(Mid$(A$, 44, 6))
gALT = Val(Mid$(A$, 50, 6)) / 1000# 'gALT in km
If gALT = 99.999 Then gALT = gALTlast 'GPS/geometric alt [km]
gALTft = gALT * cft_km
pALT = Val(Mid$(A$, 56, 6)) / 1000# 'pALT in km
pALTft = pALT * cft_km
If pALT > 23# Then pALT = 99.9
OATn = Val(Mid$(A$, 62, 6)) 'Default OAT is OATnav
OATnav = OATn + cTo 'Convert to K
Wspd = Val(Mid$(A$, 68, 6))
Wdir = Val(Mid$(A$, 74, 6))
If AlineFormat = "W" Then Wdir = 0: Wspd = 0 'xxx mjm 990422
Elcor = Val(Mid$(A$, 80, 7))
ElCorUsed = Val(Mid$(A$, 87, 2))
If ElCorUsed Then StatusBit(1) = 0 Else StatusBit(1) = 2 '0 if ElCorUsed, 2 if not used
If Len(A$) > 102 Then
StatusBits = Val(Mid$(A$, 89, 4))
StatusBit(7) = StatusBits And 128 ' Acceleration >60 counts
StatusBit(6) = StatusBits And 64 ' DU: 0=#1 (old) 1=#2 (new)
StatusBit(5) = StatusBits And 32 ' SU: 0=#1 (old) 1=#2 (new)
StatusBit(4) = StatusBits And 16 ' Spare
StatusBit(3) = StatusBits And 8 ' Spare
StatusBit(2) = StatusBits And 4 ' Spare
StatusBit(0) = StatusBits And 1 ' Timeout on Phase Lock 0=OK, 1=Fail
Else
StatusBits = 0
StatusBit(7) = 0
StatusBit(6) = 0
StatusBit(5) = 0
StatusBit(4) = 0
StatusBit(3) = 0
StatusBit(2) = 0
StatusBit(0) = 0
End If
Case "Y", "!"
' WB57 Format for WAM
' 1 2 3 4 5 6 7 8 9" 10 11
' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123"
' DOY:HH:MM:SS Latitude Longitud Heading Pitch Roll Z_GEO pALT Temper ..Wspd ..Wdir sddd.d n yymmdd hhmmss"
' ###:##:##:## S###.### S###.### S###.### S###.# S###.# S###### S###### S###.# S###.# S###.# "
'Final version:
' AW054:14:00:20 +027.681 +065.230 -128.200 +035.4 -023.8 +045323 +045323 +028.6 +158.6 +042.1
'Original version:
' AW054:17:42:53 +043.432 +122.321 +004.2 -038.2 +035.4 05941 05941 -008.6 128.4 085.5
Latitude = Val(Mid$(A$, 16, 8))
Longitude = Val(Mid$(A$, 25, 8))
Heading = Val(Mid$(A$, 34, 8))
Pitch = Val(Mid$(A$, 43, 6))
Roll = Val(Mid$(A$, 50, 6))
gALTft = Val(Mid$(A$, 57, 7))
gALT = gALTft / cft_km 'gALT km
pALTft = Val(Mid$(A$, 65, 7))
pALT = pALTft / cft_km 'pALT km
OATn = Val(Mid$(A$, 73, 6))
OATnav = OATn + cTo
Wspd = Val(Mid$(A$, 80, 5))
Wdir = Val(Mid$(A$, 87, 5))
Wdir = Wdir + 180
Elcor = Val(Mid$(A$, 80, 7))
ElCorUsed = Val(Mid$(A$, 87, 2))
If ElCorUsed Then StatusBit(1) = 0 Else StatusBit(1) = 2
If Len(A$) > 102 Then
StatusBits = Val(Mid$(A$, 89, 4))
StatusBit(7) = StatusBits And 128 ' Acceleration >60 counts
StatusBit(6) = StatusBits And 64 ' DU: 0=#1 (old) 1=#2 (new)
StatusBit(5) = StatusBits And 32 ' SU: 0=#1 (old) 1=#2 (new)
StatusBit(4) = StatusBits And 16 ' Spare
StatusBit(3) = StatusBits And 8 ' Spare
StatusBit(2) = StatusBits And 4 ' Spare
StatusBit(0) = StatusBits And 1 ' Timeout on Phase Lock 0=OK, 1=Fail
Else
StatusBits = 0
StatusBit(7) = 0
StatusBit(6) = 0
StatusBit(5) = 0
StatusBit(4) = 0
StatusBit(3) = 0
StatusBit(2) = 0
StatusBit(0) = 0
End If
Case "D", "E", "!"
' DC8 Format
' 1 2 3 4 5 6 7 8 9"
' 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"
' AD999 99999999 9999999 99999999 9999 99999 99999 99999 99999 99999 9999 9999 999999 1 999999 999999
' AD250 16:12:31 30.230 -081.668 074 -01.1 -0.6 00034 -0079 27.8 0000 0000 13.0 1 010907 161115
' AD250 16:51:37 26.343 -083.030 194 1.0 10.5 29688 27998 -26.3 0002 0041 11.4 1 010907 165022
' doy hh:mm:ss snn.lat snnn.lon hdg ppp.p rr.r radar pALTft.OATn Wspd Wdir ScnDis P yymmdd hhmmss'
' TexAQS
' AE224 17:38:05 39.913 -105.117 x999 - 0.2 - 0.7 95960 05436 35.6 0007 0204 12.3 1 000811 173802
' ^fix
' SOLVE
' AD 75 05:40:40 67.821 20.335 207 .3 .6 01589 02055 -13.4 0000 0000 11.9 1 000315 053809
' CAMEX-4
' AD250 16:12:31 30.230 -081.668 074 -01.1 -0.6 00034 -0079 27.8 0000 0000 13.0 1 010907 161115
' SOLVE2
' AD309:15:41:12 +34.480 -136.900 013 +00.0 +00.0 34000 34000 -10.10 1 021106 154112
' PAVE
' AD999:99:99:99 +99.999 -999.999 999 +99.9 +99.9 99999 99999 -99.9 9999 9999 +999.9 0 000 041209 193917
' AD107:19:39:49 +34.480 -136.900 013 +00.0 +00.0 01100 01100 +17.1 0110 0270 +180.0 1 000 041209 193949
' 1 2 3 4 5 6 7 8 9"
' 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"
Latitude = Val(Mid$(A$, 15, 8))
Longitude = Val(Mid$(A$, 23, 9))
Heading = Val(Mid$(A$, 32, 5))
Pitch = Val(Mid$(A$, 37, 6))
Roll = Val(Mid$(A$, 43, 6))
gALTft = Val(Mid$(A$, 49, 6))
If gALTft <> 99999 Then gALT = gALTft / cft_km Else gALT = gALTlast 'GPS/geometric alt [km]
pALTft = Val(Mid$(A$, 55, 6)) 'pressure altitude
If pALTft <> 99999 Then pALT = pALTft / cft_km
OATn = Val(Mid$(A$, 61, 6))
OATnav = OATn + cTo
Wspd = Val(Mid$(A$, 68, 4))
Wdir = Val(Mid$(A$, 74, 5))
Elcor = Val(Mid$(A$, 79, 7))
ElCorUsed = Val(Mid$(A$, 86, 2))
Case Else
Call MsgBox("You are not using a valid A-line format!", vbOK)
Exit Sub
End Select
' DU date and time should always be present at end of A-line, decode from right side
X$ = Right$(A$, 13)
yymmddMTP$ = Left$(X$, 6)
hhmmssMTP$ = Right$(X$, 6) 'use Right$ in case formatting error
' Check to make sure all data are valid and set flags if not
If Abs(Latitude) > 90 Then Latitude = 99.999
If Abs(Longitude) > 180 Then Longitude = 999.999
If Heading < 0 Then Heading = Heading + 360
If Heading > 360 Then Heading = 999
If Abs(Pitch) > 90 Then Pitch = 999.9
If Abs(Roll) > 90 Then Roll = 999.9
If Wspd > 999 Then Wspd = 999
If Wdir > 999 Then Wdir = 999
If gALT > Ceiling Then
gALT = 99.9
Call MsgBox("Geometric Altitude (gALT) exceeded aircraft Ceiling= " & Str(Ceiling) & "!", vbOKOnly)
End If
If gALT = 0 Then gALT = gALTlast Else gALTlast = gALT 'ER2 drops gALT occassionally
If pALT > Ceiling Then
pALT = 99.9
'Call MsgBox("Pressure Altitude (pALT) exceeded aircraft Ceiling= " & Str(Ceiling) & "!", vbOKOnly)
End If
If pALT < 0# Then pALT = 0#: pALTft = 0#
' Fix pALT if necessary
If pALT = 99.9 Then
pALTft = pALTlast * cft_km
ALTkm = pALTlast
Else 'code below needs to be cleaned up
pALTlast = pALT
If pALT < 0 Then pALT = 0
' ALTkmu = ALTkm
' 'ALTcor = .046 - .000437 * ALTkmu ^ 2 + 3.315E-05 * (ALTkmu ^ 3)
' ALTkm = ALTkmu + ALTfujCONST * ALTcor
End If
' The following line not used, but might want to set up a idiot light or beep
If Abs(Roll) > RollThreshold Then RollThresholdFlag = True Else RollThresholdFlag = False
UTsecMTPlast = UTsecMTP
UTsecMTP = fTstringToSec(hhmmssMTP$, False)
If Mid$(A$, 7, 8) <> "99:99:99" Then 'Use NAV UT if it's present
Doy = Val(Mid$(A$, 3, 3))
If Doy = 0 Or Doy = 999 Then Doy = fYYYYMMDDtoDOY(yyyymmdd$)
UTsecNav = fTstringToSec(Mid$(A$, 7, 8), True) 'Nav has colons 'xxx mjm was 7,8!!! 03/01/22
UTsec = UTsecNav
dtMTP = UTsecMTP - UTsec
Else
Doy = 999
UTsec = UTsecMTPlast - dtMTP + (UTsecMTP - UTsecMTPlast) 'UTsecMTP - (Diff of MTP-NAV) + Scan Length
UTsecNav = UTsec
If Latitude > 99 Then
Latitude = LatitudeLast
Longitude = LongitudeLast
gALT = gALTlast
gALTft = gALTftLast
End If
End If
UTsecNAVlast = UTsec
LatitudeLast = Latitude
LongitudeLast = Longitude
gALTlast = gALT
gALTftLast = gALTft
' If UTtakeoff > 0 And AC$ = "ER" And Mission$ = "CAMEX4" Then
' ALTkm = fZnavCorr(ALTkm, (UTsec - UTtakeoff) / 1000)
' End If
' pALT = ALTkm 'Have some sort of valid altitude at this point
' pALTft = pALT * cft_km
If pALTftLast = 0 Then pALTftLast = pALTft
dALT = pALTft - pALTftLast
hhmmssNAV$ = fSecToTstring(UTsecNav, False) 'Get rid of colons
End Sub
Sub DecodeBCDElines
Sub DecodeBCDElines(A$, SU$, Lt$, GoToNext As Boolean)
Dim i%, j%, Jindex%, X!, iChannels%, Target1 As Boolean
' Allow a channel to be dropped in retrieval
iChannels = Channels 'Default is to use all channels
' Select Case Mission$
' Case "EUPLEX"
' Select Case yyyymmdd$
' Case "20030115", "20030119": iChannels = 3 'Read 3 Channels, but retrieve only 2
' End Select
' End Select
Lt$ = Left$(A$, 1)
Select Case Lt$
Case "B" ' C(i,j)
For j = 1 To 5
If RHS Then Jindex = j Else Jindex = 11 - j
For i = 1 To iChannels
X = Val(Mid$(A$, 2 + 6 * (i - 1) + 6 * iChannels * (j - 1), 6))
If X > 30000 Or X < 0 Then C(i, Jindex) = 30000 Else C(i, Jindex) = X
Next i
Next j
Bline% = True
Case "C" ' C(i,j)
For j = 6 To 10
If RHS Then Jindex = j Else Jindex = 11 - j
For i = 1 To iChannels
X = Val(Mid$(A$, 2 + 6 * (i - 1) + 6 * iChannels * (j - 6), 6))
If X > 30000 Or X < 0 Then C(i, Jindex) = 30000 Else C(i, Jindex) = X
Next i
Next j
Cline% = True
Case "D" ' MUX()
Select Case SU$
Case "DC8"
If Mission$ = "SOLVE2" Or (Mission$ = "PAVE" And yyyymmdd$ = "20050109") Then
' Before 20041120 was 'If yyyymmdd$ > 20021100 Then'
' D line now contains raw counts again, and
' d line contains converted numbers which are ignored as they are converted
'
' 0 1 2 3 4 5 6 7 8 9 10 11
' 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
' Tnd Tamp Tsyn Tmix Tt1 Tt2 ACC+ Twin Tmot XXX Vref Tdat1 Tdat2 VCC/2 15V/n Trad ACCm"
' D +39.30 +44.49 -89.57 +39.55 +03.40 +04.10 +01.05 +02.84 +35.01 +01.98 +02.05 -104.42 -104.42 +02.49 +01.91 +42.00 ACCm not added until after SOLVE2
' Channel Numbers are:
' 1 tND, 2 tLO1, 3 tLO2, 4 tIFA,5 TGTl,6 TGTh,7 ACCp 8 tWIN,9 tMTR,10 xxx,11 ref,12 tDC1,13 tDC2,14 tPS5,15 tPS12,16 Trad, 17 ACCm
For i = 1 To 16: Muxs(i) = Mid$(A$, 2 + (i - 1) * 7, 7): Next i
Else
For j = 1 To 17: Mux(j) = fHexToDec(Mid$(A$, 3 + 4 * (j - 1), 3)): Next j
' First 4 channels (different assignments in Old vs New format)
For j = 1 To 17: Muxs(j) = ThermistorDC(j, Mux(j)): Next j
End If
Muxs(13) = Muxs(12) 'DC2 Make DC8 DC1 and DC2 same as ER2
Muxs(12) = Muxs(11) 'DC1
Tifa = Muxs(4)
Tlo = Muxs(5)
Thi = Muxs(6)
If yyyymmdd$ > 20021100 Then
Ttgt = Tlo
Else
If Thi < -37.5 Then Ttgt = Tlo Else Ttgt = Thi 'DC8 used -33C xxx
End If
Case "ER2G"
For j = 1 To 16
Mux(j) = fHexToDec(Mid$(A$, 3 + 4 * (j - 1), 3))
Next j
For j = 1 To 16: Muxs(j) = Thermistor(j, Mux(j)): Next j
Case "ER2S"
For j = 1 To 16
Mux(j) = fHexToDec(Mid$(A$, 3 + 4 * (j - 1), 3))
Next j
For j = 1 To 16: Muxs(j) = ThermistorER_1(j, Mux(j)): Next j
Tifa = Muxs(4)
Tlo = Muxs(5)
Thi = Muxs(6)
If yyyymmdd$ > "20051100" Then
If Tlo < -26 Then Ttgt = Tlo Else Ttgt = Thi 'New RTD circuit has new overlap region
Else
If Thi < -37.5 Then Ttgt = Tlo Else Ttgt = Thi 'DC8 used -33C xxx
End If
Twin = ThermistorER_1(8, Mux(8))
'Debug.Print UTks; Tifa; Tlo; Thi; Ttgt
Case "ER2T"
For j = 1 To 16
Mux(j) = fHexToDec(Mid$(A$, 3 + 4 * (j - 1), 3))
Next j
For j = 1 To 16: Muxs(j) = ThermistorER_2(j, Mux(j)): Next j
Tifa = Muxs(4)
Tlo = Muxs(5)
Thi = Muxs(6)
If yyyymmdd$ > "20070701" Then
If Thi < 0# Then Ttgt = Tlo Else Ttgt = Thi 'range changed to +/-80 C for hot target
Else
If Thi < -37.5 Then Ttgt = Tlo Else Ttgt = Thi
End If
Twin = ThermistorER_2(8, Mux(8))
Case Else
Stop
End Select
Muxs(0) = Ttgt
If Muxs(9) < -99 Then Muxs(9) = -99.9
If Muxs(12) < -99 Then Muxs(12) = -99.9
If Muxs(13) < -99 Then Muxs(13) = -99.9
' Muxs(i) Parameter
' 00 Ttgt ' 01 Tnd ' 02 Tlo1 ' 03 Tlo2
' 04 Tifa ' 05 Tlo ' 06 Thi ' 07 ACC+
' 08 Twin ' 09 Tmtr ' 10 ' 11 Vref
' 12 Tdc1 ' 13 Tdc2 ' 14 PS5 ' 15 PS12 ' 16 ACC-
Tnd = Muxs(1)
Tlo1 = Muxs(2) 'VCO=LO equivalences
Tlo2 = Muxs(3)
Tmxr = Muxs(4) 'IFA=MXR
Tifa = Muxs(4)
Tlo = Muxs(5) 'target low
Thi = Muxs(6) 'target hi
'If SU$ <> "DC8" Then
' If Thi < -37.5 Then Ttgt = Tlo Else Ttgt = Thi 'DC8 used -33C xxx
'End If
Muxs(0) = Ttgt
Twin = Muxs(8) 'Window
If Twin < -80 Or Twin > 45 Then Muxs(8) = Twin '99
Tmtr = Muxs(9)
Vref = Muxs(11) 'Voltage reference for a/d to correct thermistors (=2.51 V)
Tdc1 = Muxs(12)
Tdc2 = Muxs(13)
Vps5 = Muxs(14)
Vps12 = Muxs(15)
' dACC = (Muxs(7) - Muxs(16)) / 5.2 'dACC is in units of 0.01 g
dACC = (Muxs(7) - Muxs(16)) / 52 'dACC is in units of 0.1 g
' Muxs(17) = OATn
' Muxs(18) = ALTkm * 3 Dline = True
Dline = True
Case "E"
' 1234567890123456789012345678901234567890
' E 20021 17719 15062 12060 10726 10930
If Mid$(A$, 2, 1) = " " Then Target1 = True Else Target1 = False
For j = 11 To 12
For i = 1 To iChannels
X = Val(Mid$(A$, 2 + 6 * (i - 1) + 6 * iChannels * (j - 11), 6))
If X > 30000 Or X < 0 Then X = 30000
' Check to see if there are two targets
If Target1 Then C(i, j) = X Else C(i, j + 2) = X
Next i
Next j
' Define Base, Sky and Noise Diode counts (Used in a number of places)
For i = 1 To iChannels
CS(i, LocHor) = C(i, LocHor)
If Target1 Then
CB(i) = C(i, 12): dND(i) = C(i, 11) - CB(i)
Else
CB2(i) = C(i, 14): dND2(i) = C(i, 13) - CB2(i)
End If
Next i
' dND(i) = c(i, 11) - CB(i) was dND(i) = c(1, 11) - CB(i) until 20030924!
Eline% = True
Case "F": 'Print "Instrument Failure!" + Space$(61);
Case "I": 'Beep: Print "Instrument on!" + Space$(66);
Case Else
End Select
End Sub
Function fZnavCorr
Function fZnavCorr(z!, dUT!)
' z is NAV pressure altitude (km)
' dUT are UT ks since takeoff
' Return with corrected NAV pressure altitude (km)
Select Case AC$
Case "ER"
Select Case Mission$
Case "CAMEX4"
'ZPnavCOR [meters] = 0 + 85 * (utsec - utsec_takeoff)/14400 + 162 * (ZPnav/20 km)2 + 105 * (ZPnav/20 km)10
fZnavCorr = z + (85 * dUT / 14.4 + 162 * (z / 20) ^ 2 + 105 * (z / 20) ^ 10) / 1000
Case Else
fZnavCorr = z
End Select
Case Else
fZnavCorr = z
End Select
End Function
Sub GetINUvalues
Sub GetINUvalues(UTsec&, UT&, Pinu!, PA1!, Pim!, PA2!, INUfile$)
Dim i%, A$, HeaderCount%
Static INUlu%
If INUlu = 0 Then
INUlu = FreeFile
Open INUfile$ For Input As INUlu
For i = 2 To 6: Line Input #INUlu, A$: Next i
Else
If EOF(INUlu) Then
Close INUlu
Exit Sub
End If
End If
Do 'Catch up
Line Input #INUlu, A$
UT = 3600# * Val(Mid$(A$, 5, 2)) + 60# * Val(Mid$(A$, 8, 2)) + Val(Mid$(A$, 11, 2))
Loop Until UT >= UTsec
'NASA 809 Flight #00-036 01/11/00/011 (GMT) RECORDER 4 HARD DISK 11
' INS INS . . . . . based on MMS pressure sensors . . . . .
'DAY TIME T INU INU INU PRESS SAT PITCH ROLL TRUE AIR N/S E/W GND Wind Wind mach static SAT wind wind
'DDD HH:MM:SS S LATITUDE LONGITUDE ALT HEAD SPD VEL VEL SPD Dir Speed number TAS altitude press temp dir speed TIME
' deg deg ft mbar degC deg deg deg knts knts knts knts deg knots knots feet mb deg C deg knots HH:MM:SS
'148 13:13:13 N42.203 W 72.525 602 991.4 0.0 + 4.2 - 0.1 215.5 N 0 E 0 0 213.1 20.1 0 354 1000.34 0.0 180.0 0.0 13:13:13
'148 13:13:14 N42.203 W 72.525 602 991.4 0.0 + 4.2 - 0.1 215.5 N 0 E 0 0 213.1 20.1
'1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345
' 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
'NASA 809 Flight #01-136 09/09/01/252 (GMT) RECORDER 5 HARD DISK 5
' INS INS . . . . . based on MMS pressure sensors . . . . .
'DAY TIME T INU INU INU PRESS SAT PITCH ROLL TRUE AIR N/S E/W GND Wind Wind mach static SAT wind wind
'DDD HH:MM:SS S LATITUDE LONGITUDE ALT HEAD SPD VEL VEL SPD Dir Speed number TAS altitude press temp dir speed TIME
' deg deg ft mbar degC deg deg deg knts knts knts knts deg knots knots feet mb deg C deg knots HH:MM:SS
'252 16:00:00 N30.233 W 81.768 9537 709.4 -3.8 +17.7 - 5.3 255.6 S 37 W165 169 183.0 6.4 0.264 169 9456 711.65 -3.8 166.7 5.4 16:00:00
'252 16:00:01 N30.233 W 81.769 9619 707.2 -3.8 +17.0 - 5.0 255.2 S 39 W165 170 178.9 5.1 0.264 169 9491 710.68 -3.8 154.0 5.1 16:00:01
Pinu = Val(Mid$(A$, 34, 7)) / 3280.8
If Pinu < 0 Then Pinu = 0#
Pim = Val(Mid$(A$, 129, 8) / 3280.8)
PA1 = fPtoZ(Val(Mid$(A$, 41, 7)) / 3280.8)
PA2 = fPtoZ(Val(Mid$(A$, 137, 8)) / 3280.8)
End Sub
Sub GetFTvalues
Sub GetFTvalues(UTsec&, UT&, P!, T!, mLatitude!, mLongitude!, mZg!, mZp!, mWspd!, mWdir!, FTfile$)
Dim i%, A$, HeaderCount%, X!
Static PTWlu%, LastT!, LastP!, LastWspd!, LastWdir!, LastZp!, LastZg!
If PTWlu = 0 Then
PTWlu = FreeFile
Open FTfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #PTWlu, A$: Next i
Else
If EOF(PTWlu) Then
Close PTWlu
Exit Sub
End If
End If
Do 'Catch up
If P <> 9999.99 Then LastP = P
If T <> 999.99 Then LastT = T
Line Input #PTWlu, A$
UT = Val(Left$(A$, 5))
P = Val(Mid$(A$, 21, 8))
T = Val(Mid$(A$, 29, 7))
Loop Until UT >= UTsec Or EOF(PTWlu)
If EOF(PTWlu) Then UT = -1: Exit Sub
' UT Lat Lon Pres Temp Theta TAS GPS_Alt WindSpd WindDir
'66978 34.64 -118.08 930.66 306.40 312.76 0.00 724.00 2.40 359.80
'60681 32.16 -107.58 76.56 212.71 443.41 208.01 18087.20 999.99 999.99
'60682 32.16 -107.58 76.53 999.99 999.99 999.99 18088.60 999.99 999.99
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
If UTsec > 40508 Then
X = X
End If
If P = 9999.99 Then P = LastP
If P < 0 Then P = 0#
If T = 999.99 Then T = LastT
mLatitude = Mid$(A$, 6, 7)
mLongitude = Mid$(A$, 13, 8)
If mZg < 0 Then mZg = 0
mZg = Val(Mid$(A$, 50, 9)) / 1000#
mZp = fPtoZ(Val(Mid$(A$, 21, 8)))
mWspd = Mid$(A$, 59, 8)
If mWspd = "9999.99" Then mWspd = 0
mWdir = Mid$(A$, 67, 8)
If mWdir = "9999.99" Then mWdir = 0
If mZg <> 9999.99 Then LastZg = mZg
If mWspd <> 9999.99 Then LastWspd = mWspd
If mWdir <> 9999.99 Then LastWdir = mWdir
'Debug.Print UT; P; fPtoZ(P)
End Sub
Sub GetNGvalues
Sub GetNGvalues(UTsec&, UT&, P!, T!, mT!, mLatitude!, mLongitude!, mZg!, mZp!, mPitch!, mRoll!, FTfile$, Quit As Boolean)
Dim i%, j%, A$, HeaderCount%, X!, Utime&, TAS!
Static PTWlu%, LastT!, LastP!, LastWspd!, LastWdir!, LastZp!, LastZg!, LastUTsec!
If PTWlu = 0 Then
PTWlu = FreeFile
Open FTfile$ For Input As PTWlu
Input #PTWlu, A$ 'Skip Header Info
'For i = 2 To HeaderCount: Line Input #PTWlu, a$: Next i
LastUTsec = 0
Else
If EOF(PTWlu) Then
Close PTWlu
PTWlu = 0
Quit = True
Exit Sub
End If
End If
' UTC ATRL AT_A GGALT GGLAT GGLON PALT PITCH PSFC ROLL TAS_A Time
'22:24:24 -41.8909 -43.3967 9302.98 36.6453 -118.323 9150.33 2.21617 300.439 -0.0850106 241.245 13954
'19:00:04 13.1145 12.9608 1707.68 39.9024 -105.101 1615.38 -1.77342 833.586 0.0328811 0 1694
Line Input #PTWlu, A$
'UTsec , Latitude, Longitude, ALTkm, T1, T2
HHMMSS$ = Left$(A$, 8)
UT = fTstringToSec(HHMMSS$, True)
If UT < LastUTsec Then UT = UT + 86400#
i = InStr(10, A$, " ")
mT = Val(Mid$(A$, 10, i - 10)) + cTo
j = InStr(i + 1, A$, " ")
T = Val(Mid$(A$, i + 1, j - i)) + cTo
i = InStr(j + 1, A$, " ")
mZg = Val(Mid$(A$, j + 1, i - j)) / 1000#
j = InStr(i + 1, A$, " ")
mLatitude = Val(Mid$(A$, i + 1, j - i))
i = InStr(j + 1, A$, " ")
mLongitude = Val(Mid$(A$, j + 1, i - j))
j = InStr(i + 1, A$, " ")
mZp = Val(Mid$(A$, i + 1, j - i)) / 1000#
i = InStr(j + 1, A$, " ")
mPitch = Val(Mid$(A$, j + 1, i - j))
j = InStr(i + 1, A$, " ")
P = Val(Mid$(A$, i + 1, j - i))
i = InStr(j + 1, A$, " ")
mRoll = Val(Mid$(A$, j + 1, i - j))
j = InStr(i + 1, A$, " ")
TAS = Val(Mid$(A$, i + 1, j - i))
i = InStr(j + 1, A$, " ")
Utime = (Mid$(A$, j + 1, Len(A$) - j))
LastUTsec = UT
End Sub
Sub GetPTWvalues
Sub GetPTWvalues(UTsec&, UT&, P!, T!, PTWfile$)
Dim i%, A$, HeaderCount%, Tf!, Ts!
Static PTWlu%
If PTWlu = 0 Then
PTWlu = FreeFile
Open PTWfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #PTWlu, A$: Next i
Else
If EOF(PTWlu) Then
Close PTWlu
Exit Sub
End If
End If
If UTsec < 0 Then
Line Input #PTWlu, A$
If 1 = 0 Then UT = Val(Left$(A$, 7)) Else UT = Val(Left$(A$, 6))
Else
Do 'Catch up
Line Input #PTWlu, A$
If 1 = 0 Then UT = Val(Left$(A$, 7)) Else UT = Val(Left$(A$, 6))
Loop Until (UT >= UTsec And Mid$(A$, 7, 6) <> "999.99") Or EOF(PTWlu)
End If
If UT <> UTsec Then
i = i
End If
' Loop Until UT >= UTsec Or EOF(PTWlu)
If EOF(PTWlu) Then UT = -1: Exit Sub
'Changing PTW formats!
'19990409
'UtSec BoxTemp RamPres VertDifPres HorzDifPres AirTemp AnaPxdTemp TAS StatPres DigPxdTemp
' 47385 23.02 0.77 -0.19 -1.40 296.55 35.73 11.41 1009.78 36.00
'
'19990912
'UtSec BoxTemp RamPres VertDifPres HorzDifPres AirTemp AnaPxdTemp System28 TAS StatPres DigPxdTemp
' 48801 36.20 1.08 0.45 -0.43 303.48 33.61 26.10 13.60 1011.89 28.00
'
'20020601
'CRYSTAL-FACE Format (NB Fast Air Temp <1 sec, but sampled at 1 sec, Slow Air Temp = 4 sec)
' UT FastTmp SlowTmp StatP PitotP RamP TAS
'60992 302.92 303.13 1017.47 1017.65 0.18 5.54
'60993 302.64 303.08 1017.45 1017.67 0.22 6.13
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
' Line Input #PTWlu, a$
Select Case Val(yyyymmdd$)
Case Is < 19990912 'Format changed (see above)
P = Val(Mid$(A$, 64, 8))
T = Val(Mid$(A$, 40, 8)) + cTo
Case Is < 20020601
P = Val(Mid$(A$, 72, 8))
T = Val(Mid$(A$, 40, 8)) + cTo
Case Is < 20050800
'HAVE2 - Starboard and Port T probes
'UtSec BoxTemp StarAirTemp PortAirTemp PlateTemp System28 TAS PitotPres PPTemp StatPres SPTemp RamPres STatd PTatd
' 65378 46.18 304.23 304.38 35.18 26.66 67.31 1039.41 34.00 1012.84 34.00 26.57 2290.71 2286.16
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
If 1 = 0 Then 'Raw files from Tom are different from archived files!!
P = Val(Mid$(A$, 80, 9))
Tf = Val(Mid$(A$, 17, 9)) 'Kelvin
Ts = Val(Mid$(A$, 26, 9)) 'Kelvin
T = Tf
Else 'Same as C-F, pre-AVE
' UT FastTmp SlowTmp StatP PitotP RamP TAS
'65378 304.00 304.14 1009.92 1039.41 29.49 70.96
P = Val(Mid$(A$, 21, 7))
Tf = Val(Mid$(A$, 7, 6)) 'Kelvin
Ts = Val(Mid$(A$, 14, 6)) 'Kelvin
T = Tf 'Tfast=Tstarboard
End If
Case Else
P = Val(Mid$(A$, 21, 7))
Tf = Val(Mid$(A$, 7, 6)) 'Kelvin
Ts = Val(Mid$(A$, 14, 6)) 'Kelvin
T = Tf
End Select
If P < 0 Then P = 0#
'Debug.Print UT; P; fPtoZ(P)
End Sub
Sub GetMGvalues
Sub GetMGvalues(UTsec&, UT&, dALT!, dLAT!, dLON!, q%, Turb!, re!, MGfile$)
Dim i%, A$, HeaderCount%
Static MGlu%
If MGlu = 0 Then
MGlu = FreeFile
Open MGfile$ For Input As MGlu
Input #MGlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #MGlu, A$: Next i
Else
If EOF(MGlu) Then
Close MGlu
Exit Sub
End If
End If
Do 'Catch up
Line Input #MGlu, A$
UT = Val(Left$(A$, 8)) + 0.5
Loop Until UT >= UTsec
' UT DALT DLAT DLONG Q TEDR REYN
' 47640.6 210 4219573 -7253231 1 99999 9999
'123456789012345678901234567890123456789012345678901234567890
' 1 2 3 4 5 6 7 8
dALT = Val(Mid$(A$, 9, 6) / 1000#) 'Celcius
dLAT = Val(Mid$(A$, 15, 9) / 100000#)
dLON = Val(Mid$(A$, 24, 10) / 100000#)
q = Val(Mid$(A$, 25, 1))
Turb = Val(Mid$(A$, 36, 6) / 100#)
re = Val(Mid$(A$, 42, 5) / 100#)
End Sub
Sub GetMMSvalues
Sub GetMMSvalues(UTsec&, UT&, P!, T!, Th!, U!, V!, W!, MMfile$, Quit As Boolean)
' UTsec ... current time, if <0 then just read next record
' UT ... time read from MMS file
' P, T, Th, U, V, W ... pressure, temperature, theta, and winds at UT
' MMSfile$ Nav file to read.
Dim i%, A$, HeaderCount%
Static MMlu%, Tcorrection%
If Quit Then
If MMlu <> 0 Then Close MMlu
MMlu = 0
Quit = False
End If
If MMlu = 0 Then
MMlu = FreeFile
Open MMfile$ For Input As MMlu
Input #MMlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #MMlu, A$: Next i
Select Case MMfile$
Case "c:\ER2\CRYSTAL\MM\MM20020726.ER2": Tcorrection = 1550.84
Case "c:\ER2\CRYSTAL\MM\MM20020728.ER2": Tcorrection = 1941.93
Case Else: Tcorrection = 0
End Select
Else
If EOF(MMlu) Then
Close MMlu
MMfile$ = ""
Exit Sub
End If
End If
If UTsec < 0 Then
Line Input #MMlu, A$
UT = Int(Val(Left$(A$, 8)) + 0.5) + Tcorrection
Else
Do 'Catch up 'ER2 MMS 1940 sec slow on 20020728 and 1550 sec slow on 20020726
Line Input #MMlu, A$
UT = Int(Val(Left$(A$, 8)) + 0.5) + Tcorrection
Loop Until (UT >= UTsec And Mid$(A$, 18, 4) <> "9999") Or EOF(MMlu)
End If
If EOF(MMlu) Then
Close MMlu
MMlu = 0
Quit = True
Exit Sub
End If
Select Case Val(yyyymmdd$)
Case Is < 20010801
'GMT Psta Tsta Thta U V W
' 24518.8 9237 2559 2618 11 -8 -14
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
P = (Val(Mid$(A$, 9, 6)) / 10#)
T = Val(Mid$(A$, 15, 5) / 10#) 'Kelvin
OATmms = T + cTo
Th = Val(Mid$(A$, 20, 5) / 10#)
U = Val(Mid$(A$, 25, 5) / 10#)
V = Val(Mid$(A$, 30, 5) / 10#)
W = Val(Mid$(A$, 35, 5) / 10#)
Case Else
'CAMEX-4, CRYSTAL
' GMT Psta Tsta Thta U V W
' GMT Psta Tsta Thta U V W
' 65314.726 10158 3053 3039 -77 7 5
' 71931.1 566 21124 47970 -100 21 -1 'Final CRYSTAL data
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
P = (Val(Mid$(A$, 10, 5)) / 10#)
T = Val(Mid$(A$, 16, 5) / 100#) 'Kelvin
OATmms = T '+ cTo
Th = Val(Mid$(A$, 22, 5) / 100#)
U = Val(Mid$(A$, 27, 5) / 10#)
V = Val(Mid$(A$, 32, 5) / 10#)
W = Val(Mid$(A$, 37, 5) / 10#)
End Select
End Sub
Sub GetMMSvalues_n
Sub GetMMSvalues_n(UTsec&, UT&, P!, T!, Th!, U!, V!, W!, MMfile$, Quit As Boolean)
Dim i%, A$, HeaderCount%
Static MMlu%
If MMlu = 0 Then
MMlu = FreeFile
Open MMfile$ For Input As MMlu
Input #MMlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #MMlu, A$: Next i
Else
If EOF(MMlu) Then
Close MMlu
MMfile$ = ""
Exit Sub
End If
End If
Do 'Catch up
Line Input #MMlu, A$
UT = Int(Val(Left$(A$, 8)) + 0.5)
Loop Until UT >= UTsec Or EOF(MMlu)
If EOF(MMlu) Then
Close MMlu
MMlu = 0
Quit = True
Exit Sub
End If
'GMT Psta Tsta Thta U V W
' 24518.8 9237 2559 2618 11 -8 -14
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
If Mission$ = "CAMEX4" Then
P = (Val(Mid$(A$, 11, 6)) / 10#)
T = Val(Mid$(A$, 17, 5) / 10#) - cTo 'Celcius
OATmms = T + cTo
Th = Val(Mid$(A$, 22, 5) / 10#)
U = Val(Mid$(A$, 27, 5) / 10#)
V = Val(Mid$(A$, 32, 5) / 10#)
W = Val(Mid$(A$, 37, 5) / 10#)
Else
P = (Val(Mid$(A$, 9, 6)) / 10#)
T = Val(Mid$(A$, 15, 5) / 10#) - cTo 'Celcius
OATmms = T + cTo
Th = Val(Mid$(A$, 20, 5) / 10#)
U = Val(Mid$(A$, 25, 5) / 10#)
V = Val(Mid$(A$, 30, 5) / 10#)
W = Val(Mid$(A$, 35, 5) / 10#)
End If
P = fPtoZ(P)
End Sub
Sub GetPTWvalues_n
Sub GetPTWvalues_n(UTsec&, UT&, P!, T!, PTWfile$)
Dim i%, A$, HeaderCount%, Tf!, Ts!
Static PTWlu%
If PTWlu = 0 Then
PTWlu = FreeFile
Open PTWfile$ For Input As PTWlu
Input #PTWlu, HeaderCount, A$ 'Skip Header Info
For i = 2 To HeaderCount: Line Input #PTWlu, A$: Next i
Else
If EOF(PTWlu) Then
Close PTWlu
Exit Sub
End If
End If
Do 'Catch up
Line Input #PTWlu, A$
UT = Val(Left$(A$, 7))
Loop Until UT >= UTsec Or EOF(PTWlu)
If EOF(PTWlu) Then UT = -1: Exit Sub
'Changing PTW formats!
'19990409
'UtSec BoxTemp RamPres VertDifPres HorzDifPres AirTemp AnaPxdTemp TAS StatPres DigPxdTemp
' 47385 23.02 0.77 -0.19 -1.40 296.55 35.73 11.41 1009.78 36.00
'
'19990912
'UtSec BoxTemp RamPres VertDifPres HorzDifPres AirTemp AnaPxdTemp System28 TAS StatPres DigPxdTemp
' 48801 36.20 1.08 0.45 -0.43 303.48 33.61 26.10 13.60 1011.89 28.00
'
'20020601
'CRYSTAL-FACE Format (NB Fast Air Temp <1 sec, but sampled at 1 sec, Slow Air Temp = 4 sec)
'UtSec BoxTemp FastAirT SlowAirT PlateT System28 TAS StatPres SPTemp PitotPres PPTemp RamPres FTatd STatd
' 52368 29.96 300.44 301.02 27.54 26.58 3.45 1012.13 26.00 1012.20 26.00 0.07 2377.34 2366.47
' 62372 27.97 9999.00 9999.00 50.21 26.90 9999.00 981.43 50.00 1002.72 50.00 21.29 2070.64 2063.57
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 1 2 3 4 5 6 7 8
Line Input #PTWlu, A$
Select Case Val(yyyymmdd$)
Case Is < 19990912 'Format changed (see above)
P = Val(Mid$(A$, 64, 8)) 'Celcius
T = Val(Mid$(A$, 40, 8))
Case Is < 20020601
P = Val(Mid$(A$, 72, 8)) 'Celcius
T = Val(Mid$(A$, 40, 8))
Case Else
P = Val(Mid$(A$, 81, 8))
Tf = Val(Mid$(A$, 18, 8)) 'Kelvin
Ts = Val(Mid$(A$, 27, 8)) 'Kelvin
T = Tf
End Select
If P < 0 Then P = 0#
'Debug.Print UT; P; fPtoZ(P)
End Sub
Sub ExportTXTfile
Sub ExportTXTfile(INPfile$, OUTfile$)
Dim i%, j%, V(0 To 30) As String, H(0 To 30) As String, Free!, Out$, Gain1!, Gain2!, Gain3!
Dim INPlu%, OUTlu%, Hcount%
' INPfile$ is a REF file
' OUTfile$ is a TXT file
'
INPlu = FreeFile
Open INPfile$ For Random Access Read Write As INPlu Len = Len(REF)
'FileRecords = LOF(INPlu) / Len(REF) - HiddenRecords
OUTlu% = FreeFile
Open OUTfile$ For Output As OUTlu
Free = 0#
' Print Formatting information
Print #OUTlu, "Flight" + vbTab + yyyymmdd$
Print #OUTlu, "UT Range" + vbTab + Format$(UTmin / 1000#, "#00.000") + vbTab + Format$(UTmax / 1000#, "#00.000")
Print #OUTlu, "LAT Range" + vbTab + Format$(LATmin, "#00.000") + vbTab + Format$(LATmax, "#00.000")
Print #OUTlu, "LON Range" + vbTab + Format$(LONmin, "#000.000") + vbTab + Format$(LONmax, "#000.000")
Print #OUTlu, "ALT Range" + vbTab + Format$(pALTmin, "#00.000") + vbTab + Format$(pALTmax, "#00.000")
Print #OUTlu, "T Range" + vbTab + Format$(Tacmin, "#00.000") + vbTab + Format$(Tacmax, "#00.000")
H$(0) = "UTks": H$(1) = "pALT": H$(2) = "OATmtp": H$(3) = "Lat"
H$(4) = "Long": H$(5) = "Pitch": H$(6) = "Roll": H$(7) = "Hdg"
H$(8) = "LRac": H$(9) = "Zt1": H$(10) = "Zt2": H$(11) = "OATnav"
H$(12) = "Gain1": H$(13) = "Gain2": H$(14) = "Gain3": H$(15) = "CB1"
H$(16) = "CB2": H$(17) = "CB3": H$(18) = "dND1": H$(19) = "dND2"
H$(20) = "dND3": H$(21) = "C15": H$(22) = "C25": H$(23) = "C35"
H$(24) = "C16": H$(25) = "C26": H$(26) = "C36"
' H$(27) = "C101" + vbTab + "C102" + vbTab + "C103" + vbTab + "C104" + vbTab + "C105" + vbTab + "C106" + vbTab + "C107" + vbTab + "C108" + vbTab + "C109" + vbTab + "C110" + vbTab + "C111" + vbTab + "C112"
' H$(28) = "C201" + vbTab + "C202" + vbTab + "C203" + vbTab + "C204" + vbTab + "C205" + vbTab + "C206" + vbTab + "C207" + vbTab + "C208" + vbTab + "C209" + vbTab + "C210" + vbTab + "C211" + vbTab + "C212"
' H$(29) = "C301" + vbTab + "C302" + vbTab + "C303" + vbTab + "C304" + vbTab + "C305" + vbTab + "C306" + vbTab + "C307" + vbTab + "C308" + vbTab + "C309" + vbTab + "C310" + vbTab + "C311" + vbTab + "C312"
H$(27) = "Ttgt" + vbTab + "Tnd" + vbTab + "Tlo1" + vbTab + "Tlo2" + vbTab + "Tifa" + vbTab + "Tlo" + vbTab + "Thi" + vbTab + "Acc+" + vbTab + "Twin" + vbTab
H$(27) = H$(27) + "Tmtr" + vbTab + "Spare" + vbTab + "Vref" + vbTab + "DC1" + vbTab + "DC2" + vbTab + "PS5" + vbTab + "PS12" + vbTab + "Acc-"
Hcount = 27
Out$ = H$(0)
For j = 1 To Hcount
Out$ = Out$ + vbTab + H$(j)
Next j
Print #OUTlu%, Out$ 'Write header string
For i = 1 To TotalCycles
Call REFread(INPlu, i)
' Map parameters to an array to facilitate formatting
V(0) = Format$(UTsec / 1000#, "##0.000"): V(1) = Format$(pALT, "#0.000")
V(2) = Format$(OATmtp, "##0.0"): V(3) = Format$(Latitude, "##0.000")
V(4) = Format$(Longitude, "###0.000"): V(5) = Format$(Pitch, "##0.0")
V(6) = Format$(Roll, "#00.0"): V(7) = Format$(Heading, "#000.0")
V(8) = Format$(LRac, "##0.0"): V(9) = Format$(Zt1, "#0.00")
V(10) = Format$(Zt2, "#0.00"): V(11) = Format$(OATnav, "#00.00")
' Gain1 = G1 '(c(1, 6) - CB1) / (90 - Ttgt) 'Lab Hot Target Gains
' Gain2 = G2 '(c(2, 6) - CB2) / (90 - Ttgt)
' Gain3 = G3 '(c(3, 6) - CB3) / (90 - Ttgt)
V(12) = Format$(g(1), "##0.00"): V(13) = Format$(g(2), "##0.00")
V(14) = Format$(g(3), "##0.00"): V(15) = Format$(CB(1), "##0.00")
V(16) = Format$(CB(2), "##0.00"): V(17) = Format$(CB(3), "##0.00")
V(18) = Format$(dND(1), "##0.00"): V(19) = Format$(dND(2), "##0.00")
V(20) = Format$(dND(3), "##0.00"): V(21) = Format$(C(1, 5), "##0.00")
V(22) = Format$(C(2, 5), "##0.00"): V(23) = Format$(C(3, 5), "##0.00")
V(24) = Format$(C(1, 6), "##0.00"): V(25) = Format$(C(2, 6), "##0.00")
V(26) = Format$(C(3, 6), "##0.00")
' v(27) = Format$(c(1, 1), "####0")
' For j = 2 To 12
' v(27) = v(27) + vbTab + Format$(c(1, j), "###0")
' Next j
'
' v(28) = Format$(c(2, 1), "####0")
' For j = 2 To 12
' v(28) = v(28) + vbTab + Format$(c(2, j), "###0")
' Next j
'
' v(29) = Format$(c(3, 1), "####0")
' For j = 2 To 12
' v(29) = v(29) + vbTab + Format$(c(3, j), "###0")
' Next j
V(Hcount) = Format$(Muxs(0), "##0.00")
For j = 1 To 16
V(Hcount) = V(Hcount) + vbTab + Format$(Muxs(j), "##0.00")
Next j
'
Out$ = V(0)
For j = 1 To Hcount
Out$ = Out$ + vbTab + V(j)
Next j
If Latitude < 90 Then Print #OUTlu, Out$
DoEvents
Next i
Close INPlu, OUTlu
End Sub
Sub MPread
Sub MPread(lu%, Record%)
Dim A$, i%
Static nHeader%
If Record = 0 Then
Input #lu, nHeader%, A$
Record = 1
Do 'Read all header lines
Record = Record + 1
Line Input #lu, A$
Select Case Record%
Case 2
Pi$ = "MJ Mahoney"
Case 5
Mission$ = A$
Select Case Mission$
Case "TOTE/VOTE": Mission$ = "TOTE_VOTE"
Case "CRYSTAL-FACE": Mission$ = "CRYSTAL"
End Select
Case 7
yyyymmdd$ = Left$(A$, 4) + Mid$(A$, 6, 2) + Mid$(A$, 9, 2)
Case Is < nHeader
End Select
Loop Until Record = nHeader
Record = 0
Else
' 1 2 3 4 5 6 7 8
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123
' 34710 16 0.327 12.6 1.4 252.6 99.9 99.9 999.9 999.9 64.666 -147.101 999.9
Line Input #lu, A$
UTsec = Left$(A$, 7)
Nlev = Mid$(A$, 8, 3)
Nlev1 = 33 - Nlev + 1
Nlev2 = 33
pALT = Mid$(A$, 11, 8) 'km
Pitch = Mid$(A$, 19, 6)
Roll = Mid$(A$, 25, 6)
OATmtp = Mid$(A$, 31, 6)
Zt1 = Mid$(A$, 37, 6)
Zt2 = Mid$(A$, 43, 6)
Th1 = Mid$(A$, 49, 6)
Th2 = Mid$(A$, 55, 6)
Latitude = Mid$(A$, 61, 8)
Longitude = Mid$(A$, 69, 9)
LRac = Mid$(A$, 78, 6)
If Nlev > 0 Then GoodScan = True Else GoodScan = False
GoodTrop = True
For i = 1 To Nlev
'1234567890
' 723 2277
Line Input #lu, A$
zzz(33 - i + 1) = Left$(A$, 6)
TTT(33 - i + 1) = Mid$(A$, 7, 6)
'Debug.Print zzz(Nlev - i + 1); TTT(Nlev - 1 + 1)
Next i
For i = 1 To Nlev
sZZZ(i) = zzz(i) / 100#
sTTT(i) = TTT(i) / 10#
Next i
End If
'57 2110
'GARY, Bruce (bgary@jpl.nasa.gov) and MAHONEY, MJ
'M/S 246-101; Jet Propulsion Laboratory; Pasadena, CA 91109
'DC-8 Microwave Temperature Profiler (MTP/DC8)
'TOTE/VOTE
'1 1
'1995 12 11 1996 06 26 {FLT DATE & REDUCTION DATE}
'0.0 0.0
'Remote sensing altitude (units of 10 meters)
'Elapsed UT seconds from 0 hours on day given by DATE
'1 {NV = number of primary variables temp/mtp}
'0.1 {scale factors for primary variables temp/mtp}
'9999 {missing values for primary variables temp/mtp}
'Retrieved air temperature (K)
'12 {number of auxiliary variables}
'1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0
'99 99.999 99.9 99.9 999.9 999.9 999.9 999.9 999.9 99.999 999.999 999.9
'NX(1) is the number of altitudes in subsequent data records
'Pressure altitude of DC-8 (km)
'aircraft Pitch(Deg)
'aircraft Roll(Deg)
'Horizon brightness temperature (ie, OAT, similar to SAT); avg ch1, ch2 & ch3 (C)
'Tropopause #1 (km).
'Tropopause #2 (km).
'Potential temperature of tropopause #1 (K).
'Potential temperature of tropopause #2 (K).
'Latitude (Deg)
'Longitude (Deg)
'dT/dz (K/km) for 1.0 km layer centered on aircraft flight altitude.
'3 {number of special comment lines}
'The following data appear to be normal.
'This data has undergone FINAL CALIBRATION. RMS performance given below is
' based on 30 intercomparisons with radiosondes.
'23 {number of normally included comment lines}
'All altitudes are pressure altitudes. PALT = A/C 's pressure altitude.
'Here 's a brief free-form tutorial on how to decipher the MTP data: Data groups
' consist of the following group of lines per 17-second observing cycle.
'First line is: UTSEC, # alt's in following table, Pressure Altitude, Pitch,
' Roll, Outside air temp (K), tropopause altitude #1 (km), tropopause altitude
' #2 (km) [if present], potential temperatures of tropopause #1 and #2
' (4-cycle average), latitude, longitude, & lapse rate near flight level.
' The 1-liners (for each cycle) can be stripped & imported into a spreadsheet
' for convenient plotting of trop altitude, lapse rate, etc. The tropopause
' altitudes are calculated by cubic spline interpolation of the retrieved
' altitudes using the WMO definition (that is, trop #1 is lowest altitude
' where average lapse rate > -2 K/km from initial -2 K/km point to any point
' within 2 km; trop #2 occurs above first trop after lapse rate is < -3K/km
' for >1 km, and then first trop definition applies, possibly from within
' the 1 km region.)
'Remaining set of lines for each cycle consist of 2 columns: col#1 is pressure
' altitude (units of 10 m), & col#2 is temperature from MTP (units of 0.1 K).
'Note: Temperature accuracy varies with altitude distance from flight level,
' latitude and season. Within 2 km of aircraft RMS < 1.0 K, within 5 km of
' aircraft RMS < 2.0 K, within 10 km of aircraft RMS < 3.0 K. These
' values are for aircraft flight altitude of 9.5 to 12.5 km. For additional
' clarification ask bgary@jpl.nasa.gov.
'
' 34710 16 0.327 12.6 1.4 252.6 99.9 99.9 999.9 999.9 64.666 -147.101 999.9
' 723 2277
' 553 2379
' 433 2447
' 353 2485
' 283 2522
' 233 2551
' 193 2571
' 163 2586
' 133 2598
' 103 2617
' 83 2631
' 63 2634
' 48 2600
' 33 2518
' 18 2476
' 3 2458
' 34727 16 0.490 12.8 -1.2 260.0 99.9 99.9 999.9 999.9 64.655 -147.093 999.9
' 739 2261
' 569 2369
'
End Sub
Sub MPwrite
Sub MPwrite(REFlu%, GoodScansOnly As Boolean, WriteBadHeaders As Boolean, f As Form)
Dim Ext$, MPheader$, MPdata3$, MPdata5$, V!(1 To 20), LocalOpen As Boolean
Dim Filename$, MPlu%, HDRfile$, HDRfileOld$, L%, X!, A$, dZp!, dZg!, Discard As Boolean, dALT!
Dim UTsecLast&
If REFlu% = 0 Then
Filename$ = Path$ + AC$ + yyyymmdd$ + ".ERF"
REFopen Filename$
LocalOpen = True
End If
MPheader$ = " #####0 #0 ##0.000 ##0.0 ##0.0 ##0.0 ##0.0 ##0.0 ##0.0 ##0.0 ##0.000 ###0.000 ##0.0 #0.00 #00.00 #0.00"
' Rexample$ = " 52900 33 0.064 -0.8 0.2 298.3 11.2 99.9 303.4 325.8 29.612 -95.166 999.9 2.00 200.05 15.67"
MPdata3$ = " ###0 ###0 #0"
MPdata5$ = " ###0 ###0 #0 ####0 ####0"
If Mission$ = "TexAQS" Then MPdata5$ = " ####0 ###0.0 000.0 0.0 ####0 000.0"
If f.chkDiscard.Value = 1 Then Discard = True Else Discard = False
dALT = Val(f.txtDiscard.Text)
' Will read & modify header after first assigning MP output file
MPlu% = FreeFile
If Mission$ = "TCSP" Or Mission$ = "CAMEX4" Then
MPfile$ = MPpath$ + Mission$ + "_MTP_" + yyyymmdd$ + "_MP.txt"
End If
Open MPfile$ For Output As #MPlu%
HDRfile$ = fSetupFileName("HDR")
Call UpdateMPheader(HDRfile$, MPlu%)
' Write Limits Record
Record% = 0
Do
Record% = Record% + 1
If Record > f.ProgressBar1.Max Then Exit Do
f.txtRecord.Text = Str(Record)
f.ProgressBar1.Value = Record
Call REFread(REFlu%, Record%)
If Not EOF(REFlu) Then
If Not GoodScansOnly Or GoodScan Or WriteBadHeaders Then GoSub WriteCycle
End If
DoEvents
Loop Until EOF(REFlu%)
Close (MPlu%)
If LocalOpen Then Close (REFlu%)
Exit Sub
WriteCycle:
' NB only come here on GoodScan = True (get rid of checks for goodscan)
If EditNlev And (Nlev < NlevMin Or Nlev > NlevMax) Then
EditWord = EditWord Or 128: GoodScan = False ' Determine total # of acceptable levels; throw out if <7 levels
NlevPC = NlevPC + 1
End If
If Nlev1 = 0 Then Nlev1 = 1
If pALT < zzz(Nlev1) / 100 Then EditWord = EditWord Or 1: RetAltPC = RetAltPC + 1: GoodScan = False
' Update the number of valid levels
V(1) = UTsec: V(2) = Nlev: V(3) = pALT: V(4) = Pitch: V(5) = Roll: V(6) = OATmtp
V(7) = Zt1: V(8) = Zt2: V(9) = Th1: V(10) = Th2: V(11) = Latitude: V(12) = Longitude
V(13) = LRac: V(14) = MRI: V(15) = Tcp: V(16) = Zcp
If WriteBadHeaders And Not GoodScan Then V(2) = 0
If Discard And pALT < dALT Then V(2) = 0
If (MakeWord And 32) Or Not GoodTrop Then 'RAWbad cycles formatted for MP files
V(7) = 99.9: V(8) = 99.9: V(9) = 999.9: V(10) = 999.9
End If
If GoodScan Or WriteBadHeaders Or (Discard And pALT < dALT) Then
' Check to make sure time series is monotonic
If UTsec > UTsecLast Then
Print #MPlu%, fUsing$(MPheader$, V!())
Else
MsgBox "UTsec 0.1 And dZg(L) <> 9999 Then
If sTSE(L) > 9.9 Then sTSE(L) = 9.9 'Avoid formats running together
If Mission$ = "TexAQS" Then
V(1) = sZZZ(L) 'meters, pressure altitude
A$ = fUsingN("####0", V(1), 6)
V(2) = fZtoP(V(1)) 'hPa, pressure altitude
A$ = A$ + fUsingN("###0.0", V(2), 7)
V(3) = sTTT(L) 'K, temperature
A$ = A$ + fUsingN("000.0", V(3), 6)
V(4) = sTSE(L) 'K, temperature error
A$ = A$ + fUsingN("0.0", V(4), 4)
V(5) = sZg(L) 'meters, geometric altitude
A$ = A$ + fUsingN("####0", V(5), 6)
V(6) = fTheta(sTTT(L), fZtoP(sZZZ(L))) 'K, Theta
A$ = A$ + fUsingN("000.0", V(6), 6)
Print #MPlu, A$
Else
' v(1) = zzz(L): v(2) = TTT(L): v(3) = TSE(L): v(4) = Zgeo(L): v(5) = ND(L)
' Print #MPlu%, fUsing$(MPdata5$, v())
V(1) = sZZZ(L) * 1000# 'meters, pressure altitude
A$ = fUsingN("####0", V(1), 6)
V(2) = sTTT(L) 'K, temperature
A$ = A$ + fUsingN("000.0", V(2), 6)
V(3) = sTSE(L) 'K, temperature error
A$ = A$ + fUsingN("0.0", V(3), 4)
V(4) = sZg(L) * 1000# 'meters, geometric altitude
A$ = A$ + fUsingN("####0", V(4), 6)
V(5) = sND(L)
A$ = A$ + fUsingN("####0", V(5), 6)
Print #MPlu, A$
End If
'End If
End Select
'End If
Next L
End If
End If
End If
UTsecLast = UTsec
Return
End Sub
Sub CheckLimits
Sub CheckLimits(Record%)
Dim i%, X!, y!
' Collect statistics for LIMITS record
If Nlev < 99 And Nlev > NretMax Then NretMax = Nlev 'Added for GTE
If Nlev < 99 And Nlev < NretMin Then NretMin = Nlev
If OK Then GoodRecords = GoodRecords + 1 Else Badrecords = Badrecords + 1
If UTsec < UTmin Then UTmin = UTsec
If UTsec > UTmax Then UTmax = UTsec
If pALT < 99.9 And pALT > pALTmax Then pALTmax = pALT
If pALT < 99.9 And pALT < pALTmin Then pALTmin = pALT
If gALT < 99.9 And gALT > gALTmax Then gALTmax = gALT
If gALT < 99.9 And gALT < gALTmin Then gALTmin = gALT
If Pitch < 99.9 And Pitch < Pitchmin Then Pitchmin = Pitch
If Pitch < 99.9 And Pitch > PitchMax Then PitchMax = Pitch
If Roll < 99.9 And Roll < Rollmin Then Rollmin = Roll
If Roll < 99.9 And Roll > RollMax Then RollMax = Roll
If Tac < 999.9 And Tac < Tacmin Then Tacmin = Tac
If Tac < 999.9 And Tac > Tacmax Then Tacmax = Tac
If Zt1 < 99.9 And Zt1 < Zt1min Then Zt1min = Zt1
If Zt1 < 99.9 And Zt1 > Zt1max Then Zt1max = Zt1
If Zt2 < 99.9 And Zt2 < Zt2min Then Zt2min = Zt2
If Zt2 < 99.9 And Zt2 > Zt2max Then Zt2max = Zt2
If Th1 < 999.9 And Th1 > PT1max Then PT1max = Th1
If Th1 < 999.9 And Th1 < PT1min Then PT1min = Th1
If Th2 < 999.9 And Th2 > PT2max Then PT2max = Th2
If Th2 < 999.9 And Th2 < PT2min Then PT2min = Th2
If Th1 < 900 Then TT1 = fKelvin(Th1, fZtoP(Zt1)) Else TT1 = 999.9
If TT1 < 900 And TT1 < T1min Then T1min = TT1
If TT1 < 900 And TT1 > T1max Then T1max = TT1
If Th2 < 900 Then TT2 = fKelvin(Th2, fZtoP(Zt2)) Else TT2 = 999.9
If TT2 < 900 And TT2 < T2min Then T2min = TT2
If TT2 < 900 And TT2 > T2max Then T2max = TT2
If Latitude < 999.9 And Latitude < LATmin Then LATmin = Latitude
If Latitude < 999.9 And Latitude > LATmax Then LATmax = Latitude
If Longitude < 999.9 And Longitude < LONmin Then LONmin = Longitude
If Longitude < 999.9 And Longitude > LONmax Then LONmax = Longitude
If LRac < 99.9 And LRac < LRmin Then LRmin = LRac
If LRac < 99.9 And LRac > LRmax Then LRmax = LRac
If MRI < 99.9 And MRI < MRImin Then MRImin = MRI
If MRI < 99.9 And MRI > MRImax Then MRImax = MRI
' If Record% Mod 10 = 0 Then
If Nlev1 > 0 Then
For i = Nlev1 To Nlev2
X = sZZZ(i) '* VSCAL0
If X < Zmin Then Zmin = X
If X > Zmax Then Zmax = X
y = sTTT(i) '* VSCAL1
If y < Tmin Then Tmin = y: zTmin = X
If y > Tmax Then Tmax = y: ZtMax = X
X = sTSE(i) '* VSCAL2
If X < 9.9 And X < TSEmin Then TSEmin = X
If X < 9.9 And X > TSEmax Then TSEmax = X
X = sZg(i) '* VSCAL3
If X < 99.9 And X < zgeomin Then zgeomin = X
If X < 99.9 And X > zgeomax Then zgeomax = X
X = sND(i) '* VSCAL4
If X < 99999 And X < NDmin Then NDmin = X
If X > -99999 And X > NDmax Then NDmax = X
Next i
'Debug.Print Tmin; Tmax; Zmin; Zmax; Record%
PTmin = fTheta(Tmin, fZtoP(zTmin))
PTmax = fTheta(Tmax, fZtoP(ZtMax))
End If
End Sub
Sub CheckLimitsInit
Sub CheckLimitsInit()
' Initialize LIMITS variables
NV = 4
VSCAL(0) = VSCAL0: VSCAL(1) = VSCAL1: VSCAL(2) = VSCAL2
VSCAL(3) = VSCAL3: VSCAL(4) = VSCAL4
NretMin = 99: NretMax = 0
GoodRecords = 0: Badrecords = 0
UTmin = 100000: UTmax = 0
pALTmin = 999.9: pALTmax = -10
Pitchmin = 90: PitchMax = -90
Rollmin = 90: RollMax = -90
Tacmin = 400: Tacmax = 0
Zt1min = 99.9: Zt1max = 0
Zt2min = 99.9: Zt2max = 0
PT1min = 600: PT1max = 0
PT2min = 600: PT2max = 0
T1min = 400: T1max = 0
T2min = 400: T2max = 0
LATmin = 90: LATmax = -90
LONmin = 180: LONmax = -180
LRmin = 99: LRmax = -99
Zmin = 99: Zmax = 0
Tmin = 999: Tmax = 0
zTmin = 99: ZtMax = 0
TSEmin = 99: TSEmax = 0
zgeomin = 9999: zgeomax = 0
NDmin = 99999: NDmax = 0
MRImin = 99: MRImax = 0
gALTmin = 999.9: gALTmax = -10
End Sub
Function fReadFirstNumber
Function fReadFirstNumber(lu%) As Long
Dim A$, i%
Line Input #lu, A$
i = InStr(1, A$, " ", vbTextCompare)
If i = 0 Then
fReadFirstNumber = Val(A$)
Else
fReadFirstNumber = Val(Left$(A$, i - 1))
End If
End Function
Sub REFread32
Sub REFread32(lu%, Record%)
Dim A As REFrecord, i%, j%, X!
' Record 1 is FI record
' Record 2 is Limits record
' Record 3, 4 and 5 are spares
Get #lu%, Record% + HiddenRecords, A
GoodScan = A.GoodScan
GoodTrop = A.GoodTrop
Cycle = A.Cycle
'Debug.Print Cycle; GoodScan; GoodTrop
Nlev = A.Nlev
Nlev1 = A.Nlev1
Nlev2 = A.Nlev2
MakeWord = A.MakeWord
EditWord = A.EditWord
UTsec = A.UTsec
UTsecMTP = A.UTsecMTP
UTsecNav = A.UTsecNav
pALT = A.pALT
gALT = A.gALT
rALT = A.rALT
Pitch = A.Pitch
Roll = A.Roll
Latitude = A.Latitude
Longitude = A.Longitude
Heading = A.Heading
TAS = A.TAS
Wspd = A.Wspd
Wdir = A.Wdir
Zt1 = A.Zt1
TT1 = A.TT1
Th1 = A.Th1
SEp1 = A.SEp1
SEm1 = A.SEm1
Zt2 = A.Zt2
TT2 = A.TT2
Th2 = A.Th2
SEp2 = A.SEp2
SEm2 = A.SEm2
OATmtp = A.OATmtp
OATnav = A.OATnav
OATmms = A.OATmms
LRac = A.LRac
LRac2 = A.LRac2
LRac3 = A.LRac3
Zice = A.Zice
dTice = A.dTice
Elcor = A.Elcor
ElCorUsed = A.ElCorUsed
MRI = A.MRI
ZtIPV = A.ZtIPV
IPVt = A.IPVt
StatusBits = A.StatusBits
Tmin5 = A.Tmin5
Zmin5 = A.Zmin5
RCindex1 = A.RCindex1
RCindex2 = A.RCindex2
g(1) = A.g1
g(2) = A.g2
g(3) = A.g3
Geqn(1) = A.G1eqn
Geqn(2) = A.G2eqn
Geqn(3) = A.G3eqn
Gnd(1) = A.G1nd
Gnd(2) = A.G2nd
Gnd(3) = A.G3nd
Goat(1) = A.G1oat
Goat(2) = A.G2oat
Goat(3) = A.G3oat
'Debug.Print Record; Goat(1); Goat(2); Goat(3)
For i% = 1 To Channels
RFImask(i) = A.RFImask(i)
For j% = 1 To 10: TA(i%, j%) = A.TA(i%, j%): Next j%
Next i%
For i% = 1 To 33
zzz(i%) = A.zzz(i%)
TTTT(i%) = A.TTTT(i%)
'2003.09.10 mjm increased accuracy of T to 0.01 K
'Replace TTT by TTTT in data structure so TTT could be made real so that
'TTT could be /10 here if necessary and also /10 everywhere that it is used
If TTTT(i) > 3200 Then TTT(i) = TTTT(i) / 10# Else TTT(i) = TTTT(i)
'Debug.Print i%; zzz(i%); TTT(i%)
TSE(i%) = A.TSE(i%)
Zgeo(i%) = A.Zgeo(i%)
ND(i%) = A.ND(i%)
sZZZ(i%) = zzz(i%) / 100# 'new real numbers
sTTT(i%) = TTT(i%) / 10#
sZg(i%) = Zgeo(i) / 100#
sTSE(i%) = TSE(i) / 10#
sND(i%) = ND(i)
Next i%
For i% = 1 To Channels
For j% = 1 To 12
C(i%, j%) = A.Counts(i%, j%)
CMA(i, j) = A.CMA(i, j)
Next j%
Next i%
Muxs(0) = A.Muxs(0)
For i% = 1 To 16
Muxs(i%) = A.Muxs(i%)
Mux(i%) = A.Mux(i%)
Next i%
' Muxs(i) Parameter
' 00 Ttgt
' 01 Tnd
' 02 Tlo1
' 03 Tlo2
' 04 Tifa
' 05 Tlo
' 06 Thi
' 07 ACC+
' 08 Twin
' 09 Tmtr
' 10
' 11 Vref
' 12 Tdc1
' 13 Tdc2
' 14 PS5
' 15 PS12
' 16 ACC-
Ttgt = A.Muxs(0) 'Either tgt lo or tgt hi
Tnd = A.Muxs(1)
Tlo1 = A.Muxs(2)
Tlo2 = A.Muxs(3)
Tifa = A.Muxs(4)
Ttgtlo = A.Muxs(5)
Ttgthi = A.Muxs(6)
ACCp = A.Muxs(7)
Twin = A.Muxs(8)
Tmtr = A.Muxs(9)
'asterisk = a.Muxs(10)
Vref = A.Muxs(11)
Tdc1 = A.Muxs(12) '11 on DC8
Tdc2 = A.Muxs(13) '12 on DC8
Vps5 = A.Muxs(14)
Vps12 = A.Muxs(15)
ACCm = A.Muxs(16)
dACC = ACCp - ACCm 'Peak positive acceleration minus peak negative acceleration
For i = 1 To Channels
dND(i) = C(i, 11) - C(i, 12)
CN(i) = dND(i)
CB(i) = C(i, 12) 'Channel i base counts
CS(i, LocHor) = C(i, LocHor)
Next i
dACC = ACCp - ACCm 'Peak positive acceleration minus peak negative acceleration
Tac = OATmtp
ALTkm = pALT
End Sub
Sub REFread33
Sub REFread33(lu%, Record%)
Dim A As REF2record, i%, j%, X!
' Record 1 is FI record
' Record 2 is Limits record
' Record 3, 4 and 5 are spares
Get #lu%, Record% + HiddenRecords, A
GoodScan = A.GoodScan
GoodTrop = A.GoodTrop
Cycle = A.Cycle
'Debug.Print Cycle; GoodScan; GoodTrop
Nlev = A.Nlev
Nlev1 = A.Nlev1
Nlev2 = A.Nlev2
TTO = A.TTO
TTO2 = A.TTO2
TTO3 = A.TTO3
MakeWord = A.MakeWord
EditWord = A.EditWord
UTsec = A.UTsec
UTsecMTP = A.UTsecMTP
UTsecNav = A.UTsecNav
pALT = A.pALT
gALT = A.gALT
rALT = A.rALT
mALT = A.mALT
Pitch = A.Pitch
Roll = A.Roll
Latitude = A.Latitude
Longitude = A.Longitude
Heading = A.Heading
TAS = A.TAS
Wspd = A.Wspd
Wdir = A.Wdir
Zt1 = A.Zt1
TT1 = A.TT1
Th1 = A.Th1
SEp1 = A.SEp1
SEm1 = A.SEm1
Zt2 = A.Zt2
TT2 = A.TT2
Th2 = A.Th2
SEp2 = A.SEp2
SEm2 = A.SEm2
Tcp = A.Tcp
Zcp = A.Zcp
OATmtp = A.OATmtp
OATnav = A.OATnav
OATmms = A.OATmms
LRac = A.LRac
LRac2 = A.LRac2
LRac3 = A.LRac3
Zice = A.Zice
dTice = A.dTice
Elcor = A.Elcor
ElCorUsed = A.ElCorUsed
MRI = A.MRI
ZtIPV = A.ZtIPV
IPVt = A.IPVt
StatusBits = A.StatusBits
Tmin5 = A.Tmin5
Zmin5 = A.Zmin5
RCindex1 = A.RCindex1
RCindex2 = A.RCindex2
g(1) = A.g1
g(2) = A.g2
g(3) = A.g3
Geqn(1) = A.G1eqn
Geqn(2) = A.G2eqn
Geqn(3) = A.G3eqn
Gnd(1) = A.G1nd
Gnd(2) = A.G2nd
Gnd(3) = A.G3nd
Goat(1) = A.G1oat
Goat(2) = A.G2oat
Goat(3) = A.G3oat
'Debug.Print Record; Goat(1); Goat(2); Goat(3)
For i% = 1 To Channels
RFImask(i) = A.RFImask(i)
For j% = 1 To 10: TA(i%, j%) = A.TA(i%, j%): Next j%
Next i%
For i% = 1 To 33
sZZZ(i%) = A.sZZZ(i%)
sTTT(i%) = A.sTTT(i%)
sTSE(i%) = A.sTSE(i%)
sZg(i%) = A.sZg(i%)
sND(i%) = A.sND(i%)
Next i%
For i% = 1 To Channels
For j% = 1 To Ncts
C(i%, j%) = A.Counts(i%, j%)
CMA(i, j) = A.CMA(i, j)
Next j%
Next i%
Muxs(0) = A.Muxs(0)
For i% = 1 To 32
Muxs(i%) = A.Muxs(i%)
Mux(i%) = A.Mux(i%)
Next i%
' Mapping between old mux parameters and new NGV parameters
' New Old
' Vps12
' ACCm
' 00 Ttgt = Ttgt
' 01 Vm15 = = Analog circuits on controller board and in receiver
' 02 Vp05 = Vps5 = +5V logic (there is a second +5V to T control boards)
' 03 Vp15 = = Controller board (IF and LO amplifiers)
' 04 Vsyn = = 24V for LO Synthesizer
' 05 Vmtr = = 24V for Stepper Motor
' 06 Vp08 = = Regulated +15 V for MUX
' 07 Vvid = = Video signal
' 08 Vm08 = = Regulated -15 V for MUX
' 09 Tdat = = T data controller board
' 10 Tair = = T fairing air
' 11 Tsmp = = T scan motor plate
' 12 Tpsp = Tdc1 = T power supplies
' 13 Tnc = Tdc2 = Tcpu
' 14 Tsyn = Tlo2
' 15 Tmtr = Tmtr
' 16 ACCp = ACCp = for now. Later will add firmware to calculate max and min
' 17 R350 =
' 18 Ttg1 = Ttgtlo
' 19 Ttg2 = Ttgthi
' 20 Twin = Twin
' 21 Tmix = Tifa
' 22 Tamp = Tlo1
' 23 Tnd = Tnd
' 24 R600 =
' Muxs(i) Parameter
' 00 Ttgt
' 01 Tnd
' 02 Tlo1
' 03 Tlo2
' 04 Tifa
' 05 Tlo
' 06 Thi
' 07 ACC+
' 08 Twin
' 09 Tmtr
' 10
' 11 Vref
' 12 Tdc1 Power Supplies
' 13 Tdc2 CPU
' 14 PS5
' 15 PS12
' 16 ACC-
If AC$ <> "NG" Then
Ttgt = A.Muxs(0) 'Either tgt lo or tgt hi
Tnd = A.Muxs(1)
Tlo1 = A.Muxs(2)
Tlo2 = A.Muxs(3)
Tifa = A.Muxs(4)
Ttgtlo = A.Muxs(5)
Ttgthi = A.Muxs(6)
ACCp = A.Muxs(7)
Twin = A.Muxs(8)
Tmtr = A.Muxs(9)
'asterisk = a.Muxs(10)
Vref = A.Muxs(11)
Tdc1 = A.Muxs(12) '11 on DC8
Tdc2 = A.Muxs(13) '12 on DC8
Vps5 = A.Muxs(14)
Vps12 = A.Muxs(15)
ACCm = A.Muxs(16)
dACC = ACCp - ACCm 'Peak positive acceleration minus peak negative acceleration
Else
Ttgt = A.Muxs(0) 'Either tgt lo or tgt hi
Vm08 = A.Muxs(1)
Vvid = A.Muxs(2)
Vp08 = A.Muxs(3)
Vmtr = A.Muxs(4)
Vsyn = A.Muxs(5)
Vp15 = A.Muxs(6)
Vp05 = A.Muxs(7)
Vm15 = A.Muxs(8)
ACCp = A.Muxs(9)
Tdat = A.Muxs(10)
Tmtr = A.Muxs(11)
Tair = A.Muxs(12)
Tsmp = A.Muxs(13)
Tpsp = A.Muxs(14)
Tnc = A.Muxs(15)
R350 = A.Muxs(16)
Tsyn = A.Muxs(17)
Ttg1 = A.Muxs(18)
Ttg2 = A.Muxs(19)
Twin = A.Muxs(20)
Tmix = A.Muxs(21)
Tamp = A.Muxs(22)
Tnd = A.Muxs(23)
R600 = A.Muxs(24)
dACC = ACCp
End If
For i = 1 To Channels
dND(i) = C(i, 11) - C(i, 12)
CN(i) = dND(i)
CB(i) = C(i, 12) 'Channel i base counts
CS(i, LocHor) = C(i, LocHor)
Next i
dACC = ACCp - ACCm 'Peak positive acceleration minus peak negative acceleration
Tac = OATmtp
ALTkm = pALT
End Sub
Sub REFreadLIMITS
Sub REFreadLIMITS(FQFN$)
Dim i%, lu%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF)
Get #lu%, 2, RLR
Close lu
NV% = RLR.NV
For i% = 0 To NV%: VSCAL(i%) = RLR.VSCAL(i%): Next i%
UTmin = RLR.UTmin: UTmax = RLR.UTmax
UTtakeoff = RLR.UTtakeoff: UTlanding = RLR.UTlanding
GoodRecords = RLR.Mins(1): Badrecords = RLR.Maxs(1)
NretMin = RLR.Mins(2): NretMax = RLR.Maxs(2)
pALTmin = RLR.Mins(3): pALTmax = RLR.Maxs(3)
Pitchmin = RLR.Mins(4): PitchMax = RLR.Maxs(4)
Rollmin = RLR.Mins(5): RollMax = RLR.Maxs(5)
Tacmin = RLR.Mins(6): Tacmax = RLR.Maxs(6)
Zt1min = RLR.Mins(7): Zt1max = RLR.Maxs(7)
Zt2min = RLR.Mins(8): Zt2max = RLR.Maxs(8)
T1min = RLR.Mins(9): T1max = RLR.Maxs(9)
T2min = RLR.Mins(10): T2max = RLR.Maxs(10)
PT1min = RLR.Mins(11): PT1max = RLR.Maxs(11)
PT2min = RLR.Mins(12): PT2max = RLR.Maxs(12)
LATmin = RLR.Mins(13): LATmax = RLR.Maxs(13)
LONmin = RLR.Mins(14): LONmax = RLR.Maxs(14)
LRmin = RLR.Mins(15): LRmax = RLR.Maxs(15)
Zmin = RLR.Mins(16): Zmax = RLR.Maxs(16)
Tmin = RLR.Mins(17): Tmax = RLR.Maxs(17)
zTmin = RLR.Mins(18): ZtMax = RLR.Maxs(18)
PTmin = RLR.Mins(19): PTmax = RLR.Maxs(19)
TSEmin = RLR.Mins(20): TSEmax = RLR.Maxs(20)
zgeomin = RLR.Mins(21): zgeomax = RLR.Maxs(21)
NDmin = RLR.Mins(22): NDmax = RLR.Maxs(22)
MRImin = RLR.Mins(23): MRImax = RLR.Maxs(23)
gALTmin = RLR.Mins(24): gALTmax = RLR.Maxs(24)
UTksmin = RLR.Mins(25): UTksmax = RLR.Maxs(25)
Ztgm = RLR.Ztgm 'Altitude of global minimum T
Tzgm = RLR.Tzgm 'Global minimum T for flight above 5 km
Thgm = RLR.Thgm 'Theta at global minimym T
UTgm = RLR.UTgm 'UT at time of global minimum T
'
' Summary of Limits Information in Record 3 of every REF file
'
' UTmin and UTmax 'UT range [sec]
' GoodRecords and Badrecords 'Number of good and bad records
' NretMin and NretMax 'Range of retrieved levels
' pALTmin and pALTmax 'Range of aircraft pressure altitudes [km]
' Pitchmin and Pitchmax 'Range of aircraft pitch [deg]
' Rollmin and Rollmax 'Range of aircraft roll [deg]
' Tacmin and Tacmax 'Range of aircraft outside air temperatures [K]
' Zt1min and Zt1max 'Range of tropopause 1 altitudes [km]
' Zt2min and Zt2max 'Range of tropopause 2 altitudes [km]
' T1min and T1max 'Range of tropopause 1 temperatures [K]
' T2min and T2max 'Range of tropopause 1 temperatures [K]
' PT1min and PT1max 'Range of tropopause 1 potential temperatures [K]
' PT2min and PT2max 'Range of tropopause 2 potential temperatures [K]
' LATmin and LATmax 'Latitude range covered during flight
' LONmin and LONmax 'Longitude range covered during flight
' LRmin and LRmax 'Range of lapse rates measured at aircraft during flight [K/km]
' Zmin and Zmax 'Range of retrieved altitudes during flight [km]
' Tmin and Tmax 'Range of retrieved temperatures during flight [km]
' zTmin and zTmax 'Altitudes at Tmin and Tmax [km]
' PTmin and PTmax 'Potential temperatures at Tmin and Tmax [K]
' TSEmin and TSEmax 'Range of errors on tropopause altitudes [km]
' zgeomin and zgeomax 'Range of geometric altitudes corresponding to Zmin and Zmax [km]
' NDmin and NDmax 'Range of number density
' MRImin and MRImax
' gALTmin and gALTmax
' UTksmin and UTksmax 'UT Used min and max (ie no ascent/descent)
End Sub
Sub REF2readLIMITS
Sub REF2readLIMITS(FQFN$)
Dim i%, lu%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Get #lu%, 2, RLR
Close lu
NV% = RLR.NV
For i% = 0 To NV%: VSCAL(i%) = RLR.VSCAL(i%): Next i%
UTmin = RLR.UTmin: UTmax = RLR.UTmax
UTtakeoff = RLR.UTtakeoff: UTlanding = RLR.UTlanding
GoodRecords = RLR.Mins(1): Badrecords = RLR.Maxs(1)
NretMin = RLR.Mins(2): NretMax = RLR.Maxs(2)
pALTmin = RLR.Mins(3): pALTmax = RLR.Maxs(3)
Pitchmin = RLR.Mins(4): PitchMax = RLR.Maxs(4)
Rollmin = RLR.Mins(5): RollMax = RLR.Maxs(5)
Tacmin = RLR.Mins(6): Tacmax = RLR.Maxs(6)
Zt1min = RLR.Mins(7): Zt1max = RLR.Maxs(7)
Zt2min = RLR.Mins(8): Zt2max = RLR.Maxs(8)
T1min = RLR.Mins(9): T1max = RLR.Maxs(9)
T2min = RLR.Mins(10): T2max = RLR.Maxs(10)
PT1min = RLR.Mins(11): PT1max = RLR.Maxs(11)
PT2min = RLR.Mins(12): PT2max = RLR.Maxs(12)
LATmin = RLR.Mins(13): LATmax = RLR.Maxs(13)
LONmin = RLR.Mins(14): LONmax = RLR.Maxs(14)
LRmin = RLR.Mins(15): LRmax = RLR.Maxs(15)
Zmin = RLR.Mins(16): Zmax = RLR.Maxs(16)
Tmin = RLR.Mins(17): Tmax = RLR.Maxs(17)
zTmin = RLR.Mins(18): ZtMax = RLR.Maxs(18)
PTmin = RLR.Mins(19): PTmax = RLR.Maxs(19)
TSEmin = RLR.Mins(20): TSEmax = RLR.Maxs(20)
zgeomin = RLR.Mins(21): zgeomax = RLR.Maxs(21)
NDmin = RLR.Mins(22): NDmax = RLR.Maxs(22)
MRImin = RLR.Mins(23): MRImax = RLR.Maxs(23)
gALTmin = RLR.Mins(24): gALTmax = RLR.Maxs(24)
UTksmin = RLR.Mins(25): UTksmax = RLR.Maxs(25)
Ztgm = RLR.Ztgm 'Altitude of global minimum T
Tzgm = RLR.Tzgm 'Global minimum T for flight above 5 km
Thgm = RLR.Thgm 'Theta at global minimym T
UTgm = RLR.UTgm 'UT at time of global minimum T
'
' Summary of Limits Information in Record 3 of every REF file
'
' UTmin and UTmax 'UT range [sec]
' GoodRecords and Badrecords 'Number of good and bad records
' NretMin and NretMax 'Range of retrieved levels
' pALTmin and pALTmax 'Range of aircraft pressure altitudes [km]
' Pitchmin and Pitchmax 'Range of aircraft pitch [deg]
' Rollmin and Rollmax 'Range of aircraft roll [deg]
' Tacmin and Tacmax 'Range of aircraft outside air temperatures [K]
' Zt1min and Zt1max 'Range of tropopause 1 altitudes [km]
' Zt2min and Zt2max 'Range of tropopause 2 altitudes [km]
' T1min and T1max 'Range of tropopause 1 temperatures [K]
' T2min and T2max 'Range of tropopause 1 temperatures [K]
' PT1min and PT1max 'Range of tropopause 1 potential temperatures [K]
' PT2min and PT2max 'Range of tropopause 2 potential temperatures [K]
' LATmin and LATmax 'Latitude range covered during flight
' LONmin and LONmax 'Longitude range covered during flight
' LRmin and LRmax 'Range of lapse rates measured at aircraft during flight [K/km]
' Zmin and Zmax 'Range of retrieved altitudes during flight [km]
' Tmin and Tmax 'Range of retrieved temperatures during flight [km]
' zTmin and zTmax 'Altitudes at Tmin and Tmax [km]
' PTmin and PTmax 'Potential temperatures at Tmin and Tmax [K]
' TSEmin and TSEmax 'Range of errors on tropopause altitudes [km]
' zgeomin and zgeomax 'Range of geometric altitudes corresponding to Zmin and Zmax [km]
' NDmin and NDmax 'Range of number density
' MRImin and MRImax
' gALTmin and gALTmax
' UTksmin and UTksmax 'UT Used min and max (ie no ascent/descent)
End Sub
Sub REF2readCALFILE
Sub REF2readCALFILE(FQFN$)
Dim i%, j%, lu%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Get #lu%, 3, CFR2
Close lu
Gendate$ = Trim(CFR2.Gendate)
For i = 1 To 10
WCTdates$(i) = Trim(CFR2.WCTdates(i))
Next i
UTstart = CFR2.UTstart
UTend = CFR2.UTend
Channels = CFR2.Channels
Nel = CFR2.Nel
Emissivity = CFR2.Emissivity
Reflectivity = CFR2.Reflectivity
DeltaTmin = CFR2.DeltaTmin
' "FIT_INFO"
Nfit = CFR2.Nfit
For i = 1 To Nfit
NP$(i) = Trim(CFR2.NP(i))
Next i
For i = 1 To Channels
GOF(i) = CFR2.GOF(i)
For j = 1 To Nfit
GEC(i, j) = CFR2.GEC(i, j)
Next j
Next i
aTGToffset(0) = CFR2.aTGToffset(0)
aMXRoffset(0) = CFR2.aMXRoffset(0)
aNAVoffset(0) = CFR2.aNAVoffset(0)
aNDoffset(0) = CFR2.aNDoffset(0)
aTGToffset(1) = CFR2.aTGToffset(1)
aMXRoffset(1) = CFR2.aMXRoffset(1)
aNAVoffset(1) = CFR2.aNAVoffset(1)
aNDoffset(1) = CFR2.aNDoffset(1)
aTGToffset(2) = CFR2.aTGToffset(2)
aMXRoffset(2) = CFR2.aMXRoffset(2)
aNAVoffset(2) = CFR2.aNAVoffset(2)
aNDoffset(2) = CFR2.aNDoffset(2)
aTGToffset(3) = CFR2.aTGToffset(3)
aMXRoffset(3) = CFR2.aMXRoffset(3)
aNAVoffset(3) = CFR2.aNAVoffset(3)
aNDoffset(3) = CFR2.aNDoffset(3)
TGToffset = aTGToffset(0)
MXRoffset = aMXRoffset(0)
NAVoffset = aNAVoffset(0)
NDoffset = aNDoffset(0)
UseMAforCB = CFR2.UseMAforCB
UseMAforCS = CFR2.UseMAforCS
UseMAforCSgain = CFR2.UseMAforCSgain
UseMAforCN = CFR2.UseMAforCN
UseMAforTtgt = CFR2.UseMAforTtgt
UseMAforTifa = CFR2.UseMAforTifa
RAWextension = CFR2.RAWextension
' "WINDOW_CORRECTIONS"
EnableWCT = CFR2.EnableWCT
For i = 1 To Channels
For j = 1 To Nel
WINcor(i, j) = CFR2.WINcor(i, j)
Next j
Next i
' RAW counts editting criteria
CMAcycles = CFR2.CMAcycles 'Slow -- Base, Ttgt, etc.
CMAcycles2 = CFR2.CMAcycles2 'Fast -- Sky counts
RFIthreshold = CFR2.RFIthreshold
RFIiterations = CFR2.RFIiterations
RFIiterations2 = CFR2.RFIiterations2
MUXthreshold = CFR2.MUXthreshold
BadCycles = CFR2.BadCycles
Badcycles2 = CFR2.Badcycles2
' Gain Limits
For i = 1 To Channels
GeqnMin(i) = CFR2.GeqnMin(i)
GeqnMax(i) = CFR2.GeqnMax(i)
GnavMin(i) = CFR2.GnavMin(i)
GnavMax(i) = CFR2.GnavMax(i)
GndMin(i) = CFR2.GndMin(i)
GndMax(i) = CFR2.GndMax(i)
Next i
' Channel Weights
For i = 1 To Channels: ChInfo(i) = CFR2.ChInfo(i): Next i
' Fit Region
TBfitX1 = CFR2.TBfitX1
TBfitX2 = CFR2.TBfitX2
TBfitY1 = CFR2.TBfitY1
TBfitY2 = CFR2.TBfitY2
' Noise Diode Noise Temperatures
For i = 1 To Channels
Cnd0(i) = CFR2.Cnd0(i)
Cnd1(i) = CFR2.Cnd1(i)
Cnd2(i) = CFR2.Cnd2(i)
Next i
TrefND = CFR2.TrefND
MTPyaw = CFR2.MTPyaw
MTPpitch = CFR2.MTPpitch
MTProll = CFR2.MTProll
MTPfiduciary = CFR2.MTPfiduciary
fEcCount = CFR2.fEcCount
For i = 1 To 10
ElSUI(i) = CFR2.fEcCount
Next i
RHS = CFR2.RHS
LocHor = CFR2.LocHor
Targets = CFR2.Targets
NRC = CFR2.NRC
For i = 0 To NRC - 1
Reg(i) = CFR2.Reg(i)
RCformat(i) = CFR2.RCformat(i)
RCuse(i) = CFR2.RCuse(i)
Next i
DoEvents
End Sub
Sub REFwriteHEADER
Sub REFwriteHEADER(FQFN$)
' Write header using the current file format
Select Case FileFormatOut
Case 32
REFwriteFLTINFO FQFN$ 'Record 1
REFwriteLIMITS FQFN$ 'Record 2
REFwriteCALFILE FQFN$ 'REcord 3
Case 33
REF2writeFLTINFO FQFN$ 'Record 1
REF2writeLIMITS FQFN$ 'Record 2
REF2writeCALFILE FQFN$ 'REcord 3
Case Else
Call MsgBox("The FileFormat: " & Str(FileFormatOut) & " is not supported!", vbOKOnly)
End Select
End Sub
Sub REFreadHEADER
Sub REFreadHEADER(FQFN$)
FileFormatIn = fREFreadFileFormat(FQFN$)
Select Case FileFormatIn
Case 32
REFreadFLTINFO FQFN$ 'Record 1
REFreadLIMITS FQFN$ 'Record 2
If EnableCalfile Then REFreadCALFILE FQFN$ 'REcord 3
Case 33
REF2readFLTINFO FQFN$ 'Record 1
REF2readLIMITS FQFN$ 'Record 2
REF2readCALFILE FQFN$ 'REcord 3
Case Else
Call MsgBox("The requested FileFormat:" & Str(FileFormatIn) & " is not supported!", vbOKOnly)
End Select
End Sub
Sub REFreadFLTINFO
Sub REFreadFLTINFO(FQFN$)
Dim i%, lu%, iNRC%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF)
Get #lu%, 1, FIR
Close lu
Mission$ = Trim(FIR.Mission)
FileFormatIn = FIR.Fileformat
FltNumber$ = Trim(FIR.FltNumber)
Pi$ = FIR.Pi
Yeer = FIR.Yeer
Doy = FIR.Doy
yyyymmdd = FIR.yyyymmdd
FlightDate = fDate(yyyymmdd$)
TotalCycles = FIR.TotalCycles
Channels = FIR.Channels
Drive$ = FIR.Drive 'eg C:
Drive$ = "C:" 'xxxmjm
Rdir$ = Trim(FIR.Rdir) 'eg \DC8\
Rdir2$ = Rdir1$ + "\MTP\Data" + Rdir$ 'eg \MTP\Data\DC8\
Platform$ = Mid$(Rdir$, 2, Len(Rdir$) - 2) 'eg DC8
AC$ = Mid$(Rdir$, 2, 2) 'eg DC
Root$ = Drive$ + Rdir2$ 'eg C:\MTP\Data\DC8\
MNpath$ = Root$ + Mission$ + "\" 'eg C:\MTP\Data\DC8\SOLVE\
Call DirCheck(Root$, Mission$)
RCpath$ = MNpath$ + "RC\" 'eg C:\MTP\Data\DC8\SOLVE\RC\
Call DirCheck(MNpath, "RC")
MPpath$ = MNpath$ + "MP\"
Call DirCheck(MNpath, "MP")
Path$ = MNpath$ + yyyymmdd$ + "\" 'eg C:\MTP\Data\DC8\SOLVE\20000120\
Call DirCheck(MNpath, yyyymmdd$)
SUpath$ = MNpath$ + "Setup\"
Call DirCheck(MNpath, "Setup")
PathDot$ = Path$ + AC$ + yyyymmdd$ + "." 'eg C:\MTP\Data\DC8\SOLVE\20000120\DC20000120.
yymmdd$ = Right$(yyyymmdd$, 6)
' Default Fully-Qualified File Names
BINfile$ = PathDot$ + "BIN"
CALfile$ = PathDot$ + "CAL"
ERFfile$ = PathDot$ + "ERF"
INPfile$ = PathDot$ + "INP"
LOGfile$ = PathDot$ + "LOG"
MMSfile$ = MNpath$ + "MMS\MM" + yyyymmdd$ + "." + Platform$
RAOBfile$ = RSpath$ + Mission$ + ".RAOB2"
RAWfile$ = PathDot$ + "RAW"
REFfile$ = PathDot$ + "REF"
RTSfile$ = PathDot$ + "RTS"
OUTfile$ = PathDot$ + "OUT"
MPfile$ = MPpath$ + "MP" + yyyymmdd$ + "." + Platform$
' USEfile$ = RCpath$ + USE5$ + ".USE"
RCs$ = Left$(AC$, 1) + "RC"
Pgm$ = Trim(FIR.Pgm)
USE5$ = FIR.USE5
SU$ = Trim(FIR.SU)
NFL = FIR.NFL
For i = 1 To NFL: FLA(i) = FIR.FLA(i): Next i
PgmDrive$ = FIR.PgmDrive
Algorithm = FIR.Algorithm
MRIavg = FIR.MRIavg
MRIrms = FIR.MRIrms
utMTPcor = FIR.utMTPcor
DTavg = FIR.DTavg
DTrms = FIR.DTrms
ALTfujCONST = FIR.ALTfujCONST
ALTfujSLOPE = FIR.ALTfujSLOPE
OATnavCOR = FIR.OATnavCOR
CalSource = Trim(FIR.CalSource)
GainScale = FIR.GainScale
REFsource = FIR.REFsource
OATsource = FIR.OATsource
' OATsource: 1=MTP, 2=A/C, 3=MMS
' GainScale: 1=EQN, 2=ND, 3=OAT
' REFsource: 1=TGT, 2=OAT
If GainScale = 0 Then 'Undefined, generate new definition
Select Case CalSource$
Case "DADStgt": GainScale = 3: REFsource = 2: OATsource = 2
Case "GAIN_EQN": GainScale = 1: REFsource = 1: OATsource = 2
Case "OATnav": GainScale = 3: REFsource = 1: OATsource = 2
Case "MMS": GainScale = 3: REFsource = 1: OATsource = 3
Case "DADS": GainScale = 3: REFsource = 1: OATsource = 2
Case "ND": GainScale = 2: REFsource = 1: OATsource = 2
End Select
End If
UseMMSpALT = FIR.UseMMSpALT
LAT1 = FIR.LAT1
LAT2 = FIR.LAT2
LAT3 = FIR.LAT3
LAT4 = FIR.LAT4
UserLATs = FIR.UserLATs
EnableCalfile = FIR.EnableCalfile
DoAll = FIR.DoAll
DoAllMask = FIR.DoAllMask
MakeEditWord = FIR.MakeEditWord
EditTropAlt = FIR.EditTropAlt
TropAltMin = FIR.TropAltMin
TropAltMax = FIR.TropAltMax
TropAltPC = FIR.TropAltPC
EditRetAlt = FIR.EditRetAlt
RetAltMin = FIR.RetAltMin
RetAltMax = FIR.RetAltMax
RetAltPC = FIR.RetAltPC
EditZtOff = FIR.EditZtOff
ZtOffA = FIR.ZtOffA
ZtOffB = FIR.ZtOffB
ZtOffPC = FIR.ZtOffPC
EditTemperature = FIR.EditTemperature
TemperatureMin = FIR.TemperatureMin
TemperatureMax = FIR.TemperatureMax
TemperaturePC = FIR.TemperaturePC
EditPitch = FIR.EditPitch
ePitchMin = FIR.ePitchMin
ePitchMax = FIR.ePitchMax
PitchPC = FIR.PitchPC
EditRoll = FIR.EditRoll
eRollMin = FIR.eRollMin
eRollMax = FIR.eRollMax
RollPC = FIR.RollPC
EditNav = FIR.EditNav
NavMin = FIR.NavMin
NavMax = FIR.NavMax
NavQualPC = FIR.NavQualPC
EditTA = FIR.EditTA
TAmin = FIR.TAmin
TAmax = FIR.TAmax
TAqualPC = FIR.TAqualPC
EditCts = FIR.EditCts
CtsMin = FIR.CtsMin
CtsMax = FIR.CtsMax
CtsQualPC = FIR.CtsQualPC
EditCycle = FIR.EditCycle
CycleQualPC = FIR.CycleQualPC
EditTtgt = FIR.EditTtgt
TtgtMin = FIR.TtgtMin
TtgtMax = FIR.TtgtMax
TtgtPC = FIR.TtgtPC
EditNlev = FIR.EditNlev
NlevMin = FIR.NlevMin
NlevMax = FIR.NlevMax
NlevPC = FIR.NlevPC
EditRAWbad = FIR.EditRAWbad
RAWbadmin = FIR.RAWbadmin
RAWbadmax = FIR.RAWbadmax
RAWbadPC = FIR.RAWbadPC
EditRate = FIR.EditRate
RateMin = FIR.RateMin
RateMax = FIR.RateMax
RatePC = FIR.RatePC
EditOATtrop = FIR.EditOATtrop
OATtropPC = FIR.OATtropPC
OATzt10 = FIR.OATzt10
Tzt10 = FIR.Tzt10
OATzt20 = FIR.OATzt20
Tzt20 = FIR.Tzt20
OATks10 = FIR.OATks10
OATks20 = FIR.OATks20
OATzt11 = FIR.OATzt11
Tzt11 = FIR.Tzt11
OATzt21 = FIR.OATzt21
Tzt21 = FIR.Tzt21
OATks11 = FIR.OATks11
OATks21 = FIR.OATks21
OATzt12 = FIR.OATzt12
Tzt12 = FIR.Tzt12
OATzt22 = FIR.OATzt22
Tzt22 = FIR.Tzt22
OATks12 = FIR.OATks12
OATks22 = FIR.OATks22
OATzt13 = FIR.OATzt13
Tzt13 = FIR.Tzt13
OATzt23 = FIR.OATzt23
Tzt23 = FIR.Tzt23
OATks13 = FIR.OATks13
OATks23 = FIR.OATks23
'
OATzt14 = FIR.OATzt14
Tzt14 = FIR.Tzt14
OATzt24 = FIR.OATzt24
Tzt24 = FIR.Tzt24
' HISTORY information
CALversion = FIR.CALversion
MAKEversion = FIR.MAKEversion
EDITversion = FIR.EDITversion
FLTINFOversion = FIR.FLTINFOversion
Tstamp = FIR.Tstamp
RAWstamp = FIR.RAWstamp
MMSstamp = FIR.MMSstamp
REFstamp = FIR.REFstamp
ERFstamp = REFstamp
ERFstamp = FIR.ERFstamp
CTCstamp = FIR.CTCstamp
NRC = FIR.NRC
If NRC = 0 Then NRC = 1
If NRC > NRCmax Then NRC = NRCmax
Reg$(0) = Reg0$
Reg$(1) = Reg1$
Reg$(2) = Reg2$
If NRC > 16 Then iNRC = 16 Else iNRC = NRC
For i = 0 To iNRC - 1
If i < 16 Then
If FIR.Reg(i) <> "" Then Reg(i) = FIR.Reg(i) Else Reg(i) = ""
Else
' If FIR.Reg(i) <> "" Then Reg(i) = FIR.RegExt(i - 15) Else Reg(i) = ""
End If
If i <= 10 Then
RCformat(i) = FIR.RCformat(i)
Else
RCformat(i) = FIR.RCfmt(i - 10)
End If
If i < 16 Then
If Abs(FIR.RCuse(i)) > 5000 Then
RCuse(i) = 1000
Else
RCuse(i) = FIR.RCuse(i)
End If
Else
' RCuse(i) = FIR.RCuseExt(i - 15)
End If
Next i
Reg0$ = FIR.Reg(0)
Reg1$ = FIR.Reg(1)
Reg2$ = FIR.Reg(2)
ATPrange = 20
End Sub
Sub REFwriteFLTINFO
Sub REFwriteFLTINFO(FQFN$)
Dim i%, lu%, iNRC%
' Only allow DoAll flag to be set in default FLTINFO file!!!
'If FQFN$ <> "C:\MTP\Setup\FLTINFO.REF" Then DoAll = False
ReadSETUP ("SYSTEM")
Drive$ = DataDrive$
PgmDrive$ = ProgramDrive$
FIR.Tstamp = Date + Time
FIR.RAWstamp = RAWstamp
FIR.REFstamp = REFstamp
FIR.ERFstamp = ERFstamp
FIR.CTCstamp = CTCstamp
FIR.Mission = Mission$
FIR.Fileformat = FileFormatOut
FIR.FltNumber = FltNumber$
FIR.Pi = Pi$
FIR.Yeer = Yeer
FIR.Doy = Doy
FIR.yyyymmdd = yyyymmdd
FIR.TotalCycles = TotalCycles
FIR.Channels = Channels
FIR.Drive = Drive$
FIR.Rdir = Rdir$
FIR.Path = Path$
FIR.Pgm = Pgm$
FIR.Reg0 = Reg$(0)
FIR.Reg1 = Reg$(1)
FIR.Reg2 = Reg$(2)
FIR.USE5 = USE5$
FIR.SU = SU$
FIR.NFL = NFL
For i = 1 To NFL: FIR.FLA(i) = FLA(i): Next i
FIR.PgmDrive = PgmDrive$
FIR.Algorithm = Algorithm
FIR.MRIavg = MRIavg
FIR.MRIrms = MRIrms
FIR.utMTPcor = utMTPcor
FIR.DTavg = DTavg
FIR.DTrms = DTrms
FIR.ALTfujCONST = ALTfujCONST
FIR.ALTfujSLOPE = ALTfujSLOPE
FIR.OATnavCOR = OATnavCOR
FIR.CalSource = CalSource
FIR.GainScale = GainScale
FIR.REFsource = REFsource
FIR.OATsource = OATsource
FIR.UseMMSpALT = UseMMSpALT
FIR.LAT1 = LAT1
FIR.LAT2 = LAT2
FIR.LAT3 = LAT3
FIR.LAT4 = LAT4
FIR.UserLATs = UserLATs
FIR.EnableCalfile = EnableCalfile
FIR.DoAll = DoAll
FIR.DoAllMask = DoAllMask
FIR.MakeEditWord = MakeEditWord
FIR.EditTropAlt = EditTropAlt
FIR.TropAltMin = TropAltMin
FIR.TropAltMax = TropAltMax
FIR.TropAltPC = TropAltPC
FIR.EditRetAlt = EditRetAlt
FIR.RetAltMin = RetAltMin
FIR.RetAltMax = RetAltMax
FIR.RetAltPC = RetAltPC
FIR.EditZtOff = EditZtOff
FIR.ZtOffA = ZtOffA
FIR.ZtOffB = ZtOffB
FIR.ZtOffPC = ZtOffPC
FIR.EditTemperature = EditTemperature
FIR.TemperatureMin = TemperatureMin
FIR.TemperatureMax = TemperatureMax
FIR.TemperaturePC = TemperaturePC
FIR.EditPitch = EditPitch
FIR.ePitchMin = ePitchMin
FIR.ePitchMax = ePitchMax
FIR.PitchPC = PitchPC
FIR.EditRoll = EditRoll
FIR.eRollMin = eRollMin
FIR.eRollMax = eRollMax
FIR.RollPC = RollPC
FIR.EditNav = EditNav
FIR.NavMin = NavMin
FIR.NavMax = NavMax
FIR.NavQualPC = NavQualPC
FIR.EditTA = EditTA
FIR.TAmin = TAmin
FIR.TAmax = TAmax
FIR.TAqualPC = TAqualPC
FIR.EditCts = EditCts
FIR.CtsMin = CtsMin
FIR.CtsMax = CtsMax
FIR.CtsQualPC = CtsQualPC
FIR.EditCycle = EditCycle
FIR.CycleQualPC = CycleQualPC
FIR.EditTtgt = EditTtgt
FIR.TtgtMin = TtgtMin
FIR.TtgtMax = TtgtMax
FIR.TtgtPC = TtgtPC
FIR.EditNlev = EditNlev
FIR.NlevMin = NlevMin
FIR.NlevMax = NlevMax
FIR.NlevPC = NlevPC
FIR.EditRAWbad = EditRAWbad
FIR.RAWbadmin = RAWbadmin
FIR.RAWbadmax = RAWbadmax
FIR.RAWbadPC = RAWbadPC
FIR.EditRate = EditRate
FIR.RateMin = RateMin
FIR.RateMax = RateMax
FIR.RatePC = RatePC
FIR.EditOATtrop = EditOATtrop
FIR.OATtropPC = OATtropPC
FIR.OATzt10 = OATzt10
FIR.Tzt10 = Tzt10
FIR.OATzt20 = OATzt20
FIR.Tzt20 = Tzt20
FIR.OATks10 = OATks10
FIR.OATks20 = OATks20
FIR.OATzt11 = OATzt11
FIR.Tzt11 = Tzt11
FIR.OATzt21 = OATzt21
FIR.Tzt21 = Tzt21
FIR.OATks11 = OATks11
FIR.OATks21 = OATks21
FIR.OATzt12 = OATzt12
FIR.Tzt12 = Tzt12
FIR.OATzt22 = OATzt22
FIR.Tzt22 = Tzt22
FIR.OATks12 = OATks12
FIR.OATks22 = OATks22
FIR.OATzt13 = OATzt13
FIR.Tzt13 = Tzt13
FIR.OATzt23 = OATzt23
FIR.Tzt23 = Tzt23
FIR.OATks13 = OATks13
FIR.OATks23 = OATks23
'
FIR.OATzt14 = OATzt14
FIR.Tzt14 = Tzt14
FIR.OATzt24 = OATzt24
FIR.Tzt24 = Tzt24
' HISTORY information
FIR.CALversion = CALversion
FIR.MAKEversion = MAKEversion
FIR.EDITversion = EDITversion
FLTINFOversion = FileDateTime(ProgramDrive$ + "\MTP\VB6\BAS\FLTINFO.bas") 'FLTINFO version
FIR.FLTINFOversion = FLTINFOversion
FIR.Tstamp = Tstamp
FIR.RAWstamp = RAWstamp
FIR.MMSstamp = MMSstamp
FIR.REFstamp = REFstamp
FIR.ERFstamp = ERFstamp
FIR.CTCstamp = CTCstamp
FIR.NRC = NRC
If NRC > 16 Then iNRC = 16 Else iNRC = NRC
For i = 0 To iNRC - 1
FIR.Reg(i) = Reg(i)
If i <= 10 Then
FIR.RCformat(i) = RCformat(i)
Else
FIR.RCfmt(i - 10) = RCformat(i)
End If
FIR.RCuse(i) = RCuse(i)
Next i
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF)
Put #lu%, 1, FIR
Close lu
End Sub
Sub ReadSETUP
Sub ReadSETUP(Program$)
Dim i0%, i1%, i2%, lu%, Cmd$, V$, FixPath As Boolean
If Len(Dir("C:\MTP\Setup\MTPsetup.INI")) = 0 Then
MsgBox "Unable to open C:\MTP\Setup\MTPsetup.INI", vbOKOnly
Exit Sub
End If
lu% = FreeFile
Open "C:\MTP\Setup\MTPsetup.INI" For Input As lu%
FIsize% = 0
FixPath = False
Do
NextCategory:
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
If Left$(Cmd$, 1) = "[" Then 'Ignore everything until category found
i0% = InStr(2, Cmd$, "]")
If i0% = 0 Then
MsgBox "Right Bracket not found. Fix line number " + Str(FIsize%), vbOKOnly
Exit Sub
End If
If Mid$(Cmd$, 2, i0% - 2) = Program$ Then 'Read setup info for only the requested program
Select Case Mid$(Cmd$, 2, i0% - 2)
Case "SYSTEM"
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, "=")
If i1% > 0 Then 'Look for a command line
i2% = InStr(i1%, Cmd$, " ") 'and end of its value
If i2% = 0 Then i2% = Len(Cmd$) + 1
V$ = Mid$(Cmd$, i1% + 1, i2% - i1% - 1)
'Debug.Print cmd$
Select Case Left$(Cmd$, i1% - 1)
Case "ProgramDrive$": ProgramDrive$ = V$
Case "DataDrive$": DataDrive$ = V$
Case "UID$": UID$ = V$
Case "DefaultRTmode"
DefaultRTmode = Val(V$)
If DefaultRTmode = 0 Then RealTime = False Else RealTime = True
Case "DataSourceMode"
DataSourceMode = Val(V$)
' cboSource.ListIndex = DataSourceMode
Case "DataDestinationMode"
DataDestinationMode = Val(V$)
' cboDestination.ListIndex = DataDestinationMode
Case "AlternateRoot"
If V$ = """""" Then Rdir1$ = "" Else Rdir1$ = Val(V$)
Case Else
End Select
End If
Loop
Case "cboDestination"
cboN = -1
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, " ") 'Look for first space
If i1% > 0 Then 'Look for a command line
cboN = cboN + 1
cDestination$(cboN) = Left$(Cmd$, i1 - 1)
i1% = InStr(i1%, Cmd$, "=") 'USERNAME
If i1% > 0 Then
i2% = InStr(i1 + 1, Cmd$, " ")
cUsername(cboN) = Mid$(Cmd$, i1 + 1, i2 - i1 - 1)
i1% = InStr(i2% + 1, Cmd$, "=") 'PASSWORD
i2% = Len(Cmd$)
cPassword(cboN) = Mid$(Cmd$, i1 + 1, i2 - i1)
End If
End If
Loop
Case "cboDestination2"
cboN2 = -1
Do
If EOF(lu%) Then GoTo Exit_Sub
FIsize% = FIsize% + 1
Input #lu%, Cmd$ 'Read a line
'PRINT cmd$
If Len(Cmd$) = 0 Then GoTo NextCategory
i1% = InStr(1, Cmd$, " ") 'Look for first space
If i1% > 0 Then 'Look for a command line
cboN2 = cboN2 + 1
cDestination2$(cboN2) = Left$(Cmd$, i1 - 1)
i1% = InStr(i1%, Cmd$, "=") 'USERNAME
If i1% > 0 Then
i2% = InStr(i1 + 1, Cmd$, " ")
cUsername2(cboN2) = Mid$(Cmd$, i1 + 1, i2 - i1 - 1)
i1% = InStr(i2% + 1, Cmd$, "=") 'PASSWORD
i2% = Len(Cmd$)
cPassword2(cboN2) = Mid$(Cmd$, i1 + 1, i2 - i1)
End If
End If
Loop
Case Else
End Select
End If
End If
Loop
Exit_Sub:
Close (lu%)
End Sub
Sub REFwriteCALFILE
Sub REFwriteCALFILE(FQFN$)
Dim i%, j%, lu%, iNRC%
CFR.Gendate = Gendate$
For i = 1 To 10
CFR.WCTdates(i) = WCTdates$(i)
Next i
CFR.UTstart = UTstart
CFR.UTend = UTend
CFR.Channels = Channels
CFR.Nel = Nel
CFR.Emissivity = Emissivity
CFR.Reflectivity = Reflectivity
CFR.DeltaTmin = DeltaTmin
CFR.RHS = RHS
CFR.LocHor = LocHor
' "FIT_INFO"
CFR.Nfit = Nfit
For i = 1 To Nfit
CFR.NP(i) = NP$(i)
Next i
For i = 1 To Channels
CFR.GOF(i) = GOF(i)
For j = 1 To Nfit
CFR.GEC(i, j) = GEC(i, j)
Next j
Next i
CFR.TGToffset = TGToffset
CFR.MXRoffset = MXRoffset
CFR.NAVoffset = NAVoffset
CFR.NDoffset = NDoffset
' "WINDOW_CORRECTIONS"
CFR.EnableWCT = EnableWCT
For i = 1 To Channels
For j = 1 To Nel
CFR.WINcor(i, j) = WINcor(i, j)
Next j
Next i
' RAW counts editting criteria
CFR.CMAcycles = CMAcycles
CFR.CMAcycles2 = CMAcycles2
CFR.RFIthreshold = RFIthreshold
CFR.RFIiterations = RFIiterations
CFR.RFIiterations2 = RFIiterations2
CFR.MUXthreshold = MUXthreshold
CFR.BadCycles = BadCycles
CFR.Badcycles2 = Badcycles2
CFR.UseMAforCB = UseMAforCB
CFR.UseMAforCS = UseMAforCS
' CFR.UseMAforCSgain = UseMAforCSgain
CFR.UseMAforCN = UseMAforCN
CFR.UseMAforTtgt = UseMAforTtgt
CFR.UseMAforTifa = UseMAforTifa
CFR.RAWextension = RAWextension
' Gain Limits
For i = 1 To Channels
CFR.GeqnMin(i) = GeqnMin(i)
CFR.GeqnMax(i) = GeqnMax(i)
CFR.GnavMin(i) = GnavMin(i)
CFR.GnavMax(i) = GnavMax(i)
CFR.GndMin(i) = GndMin(i)
CFR.GndMax(i) = GndMax(i)
Next i
' Channel Weights
For i = 1 To 3: CFR.ChInfo(i) = ChInfo(i): Next i
' Fit Region
CFR.TBfitX1 = TBfitX1
CFR.TBfitX2 = TBfitX2
CFR.TBfitY1 = TBfitY1
CFR.TBfitY2 = TBfitY2
' Noise Diode Noise Temperatures
For i = 1 To Channels
CFR.Cnd0(i) = Cnd0(i)
CFR.Cnd1(i) = Cnd1(i)
CFR.Cnd2(i) = Cnd2(i)
Next i
CFR.TrefND = TrefND
CFR.NRC = NRC
If NRC > 16 Then
For i = 16 To NRC - 1
CFR.RegExt(i - 15) = Reg(i)
CFR.RCfmt(i - 10) = RCformat(i)
CFR.RCuseExt(i - 15) = RCuse(i)
Next i
End If
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF)
Put #lu%, 3, CFR
Close lu
End Sub
Sub REFreadCALFILE
Sub REFreadCALFILE(FQFN$)
Dim i%, j%, lu%
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF)
Get #lu%, 3, CFR
Close lu
Gendate$ = Trim(CFR.Gendate)
For i = 1 To 10
WCTdates$(i) = Trim(CFR.WCTdates(i))
Next i
UTstart = CFR.UTstart
UTend = CFR.UTend
Channels = CFR.Channels
Nel = CFR.Nel
Emissivity = CFR.Emissivity
Reflectivity = CFR.Reflectivity
DeltaTmin = CFR.DeltaTmin
' "FIT_INFO"
Nfit = CFR.Nfit
For i = 1 To Nfit
NP$(i) = Trim(CFR.NP(i))
Next i
For i = 1 To Channels
GOF(i) = CFR.GOF(i)
For j = 1 To Nfit
GEC(i, j) = CFR.GEC(i, j)
Next j
Next i
TGToffset = CFR.TGToffset
MXRoffset = CFR.MXRoffset
NAVoffset = CFR.NAVoffset
NDoffset = CFR.NDoffset
UseMAforCB = CFR.UseMAforCB
UseMAforCS = CFR.UseMAforCS
'UseMAforCSgain = CFR.UseMAforCSgain
UseMAforCN = CFR.UseMAforCN
UseMAforTtgt = CFR.UseMAforTtgt
UseMAforTifa = CFR.UseMAforTifa
RAWextension = CFR.RAWextension
' "WINDOW_CORRECTIONS"
EnableWCT = CFR.EnableWCT
For i = 1 To Channels
For j = 1 To Nel
WINcor(i, j) = CFR.WINcor(i, j)
Next j
Next i
' RAW counts editting criteria
CMAcycles = CFR.CMAcycles 'Slow -- Base, Ttgt, etc.
CMAcycles2 = CFR.CMAcycles2 'Fast -- Sky counts
RFIthreshold = CFR.RFIthreshold
RFIiterations = CFR.RFIiterations
RFIiterations2 = CFR.RFIiterations2
MUXthreshold = CFR.MUXthreshold
BadCycles = CFR.BadCycles
Badcycles2 = CFR.Badcycles2
' Gain Limits
For i = 1 To Channels
GeqnMin(i) = CFR.GeqnMin(i)
GeqnMax(i) = CFR.GeqnMax(i)
GnavMin(i) = CFR.GnavMin(i)
GnavMax(i) = CFR.GnavMax(i)
GndMin(i) = CFR.GndMin(i)
GndMax(i) = CFR.GndMax(i)
Next i
' Channel Weights
For i = 1 To Channels: ChInfo(i) = CFR.ChInfo(i): Next i
' Fit Region
TBfitX1 = CFR.TBfitX1
TBfitX2 = CFR.TBfitX2
TBfitY1 = CFR.TBfitY1
TBfitY2 = CFR.TBfitY2
' Noise Diode Noise Temperatures
For i = 1 To Channels
Cnd0(i) = CFR.Cnd0(i)
Cnd1(i) = CFR.Cnd1(i)
Cnd2(i) = CFR.Cnd2(i)
Next i
TrefND = CFR.TrefND
RHS = CFR.RHS
LocHor = CFR.LocHor
' NRC = CFR.NRC 'already read in FIrecord with first part of Reg, RCformat, RCuse
If NRC > 16 Then
For i = 16 To NRC - 1
Reg(i) = CFR.RegExt(i - 15)
RCformat(i) = CFR.RCfmt(i - 10)
RCuse(i) = CFR.RCuseExt(i - 15)
Next i
End If
End Sub
Sub REFwrite32
Sub REFwrite32(lu%, Record%)
Dim A As REFrecord, i%, j%, X%
' Debug.Print Cycle; GoodScan; GoodTrop
A.GoodScan = GoodScan
A.GoodTrop = GoodTrop
A.Cycle = Cycle
A.Nlev = Nlev
A.Nlev1 = Nlev1
A.Nlev2 = Nlev2
A.MakeWord = MakeWord
A.EditWord = EditWord
A.UTsec = UTsec
A.UTsecMTP = UTsecMTP
A.UTsecNav = UTsecNav
A.pALT = pALT
A.gALT = gALT 'gALT
A.rALT = 99.9 'rALT
A.Pitch = Pitch
A.Roll = Roll
A.Latitude = Latitude
A.Longitude = Longitude
A.Heading = Heading
A.TAS = 999.9 'TAS
A.Wspd = Wspd
A.Wdir = Wdir
A.Zt1 = Zt1
A.TT1 = TT1
A.Th1 = Th1
A.SEp1 = SEp1
A.SEm1 = SEm1
A.Zt2 = Zt2
A.TT2 = TT2
A.Th2 = Th2
A.SEp2 = SEp2
A.SEm2 = SEm2
A.OATmtp = OATmtp
A.OATnav = OATnav
A.OATmms = OATmms
A.LRac = LRac
A.LRac2 = LRac2
A.LRac3 = LRac3
A.Zice = Zice
A.dTice = dTice
A.Elcor = Elcor
A.ElCorUsed = ElCorUsed
A.MRI = MRI
A.ZtIPV = ZtIPV
A.IPVt = IPVt
A.StatusBits = StatusBits
A.Tmin5 = Tmin5
A.Zmin5 = Zmin5
A.RCindex1 = RCindex1
A.RCindex2 = RCindex2
A.g1 = g(1)
A.g2 = g(2)
A.g3 = g(3)
A.G1eqn = Geqn(1)
A.G2eqn = Geqn(2)
A.G3eqn = Geqn(3)
A.G1nd = Gnd(1)
A.G2nd = Gnd(2)
A.G3nd = Gnd(3)
A.G1oat = Goat(1)
A.G2oat = Goat(2)
A.G3oat = Goat(3)
'Debug.Print Record; Goat(1); Goat(2); Goat(3)
For i% = 1 To Channels
A.RFImask(i) = RFImask(i)
For j% = 1 To 10: A.TA(i%, j%) = TA(i%, j%): Next j%
Next i%
For i% = 1 To 33
A.zzz(i%) = zzz(i%)
If TTT(i) > 32767 Then TTT(i) = 32767
A.TTTT(i%) = Int(TTT(i%))
A.TSE(i%) = TSE(i%)
A.Zgeo(i%) = Zgeo(i%)
A.ND(i%) = ND(i%)
Next i%
For i% = 1 To Channels
For j% = 1 To 12
A.Counts(i%, j%) = C(i%, j%)
A.CMA(i, j) = CMA(i, j)
Next j%
Next i%
A.Muxs(0) = Muxs(0)
For i% = 1 To 16
A.Muxs(i%) = Muxs(i%)
A.Mux(i%) = Mux(i%)
Next i%
Put #lu%, Record% + HiddenRecords, A
End Sub
Sub REFwrite33
Sub REFwrite33(lu%, Record%)
Dim A As REF2record, i%, j%, X%
' Debug.Print Cycle; GoodScan; GoodTrop
A.GoodScan = GoodScan
A.GoodTrop = GoodTrop
A.Cycle = Cycle
A.Nlev = Nlev
A.Nlev1 = Nlev1
A.Nlev2 = Nlev2
A.MakeWord = MakeWord
A.EditWord = EditWord
A.UTsec = UTsec
A.UTsecMTP = UTsecMTP
A.UTsecNav = UTsecNav
A.pALT = pALT
A.gALT = gALT 'gALT
A.rALT = 99.9 'rALT
A.Pitch = Pitch
A.Roll = Roll
A.Latitude = Latitude
A.Longitude = Longitude
A.Heading = Heading
A.TAS = 999.9 'TAS
A.Wspd = Wspd
A.Wdir = Wdir
A.Zt1 = Zt1
A.TT1 = TT1
A.Th1 = Th1
A.SEp1 = SEp1
A.SEm1 = SEm1
A.Zt2 = Zt2
A.TT2 = TT2
A.Th2 = Th2
A.SEp2 = SEp2
A.SEm2 = SEm2
A.Tcp = Tcp
A.Zcp = Zcp
A.OATmtp = OATmtp
A.OATnav = OATnav
A.OATmms = OATmms
A.LRac = LRac
A.LRac2 = LRac2
A.LRac3 = LRac3
A.Zice = Zice
A.dTice = dTice
A.Elcor = Elcor
A.ElCorUsed = ElCorUsed
A.MRI = MRI
A.ZtIPV = ZtIPV
A.IPVt = IPVt
A.StatusBits = StatusBits
A.Tmin5 = Tmin5
A.Zmin5 = Zmin5
A.RCindex1 = RCindex1
A.RCindex2 = RCindex2
A.g1 = g(1)
A.g2 = g(2)
A.g3 = g(3)
A.G1eqn = Geqn(1)
A.G2eqn = Geqn(2)
A.G3eqn = Geqn(3)
A.G1nd = Gnd(1)
A.G2nd = Gnd(2)
A.G3nd = Gnd(3)
A.G1oat = Goat(1)
A.G2oat = Goat(2)
A.G3oat = Goat(3)
'Debug.Print Record; Goat(1); Goat(2); Goat(3)
For i% = 1 To Channels
A.RFImask(i) = RFImask(i)
For j% = 1 To 10: A.TA(i%, j%) = TA(i%, j%): Next j%
Next i%
For i% = 1 To 33
A.sZZZ(i%) = sZZZ(i%)
A.sTTT(i%) = sTTT(i%)
A.sTSE(i%) = sTSE(i%)
A.sZg(i%) = sZg(i%)
A.sND(i%) = sND(i%)
Next i%
For i% = 1 To Channels
For j% = 1 To Ncts
A.Counts(i%, j%) = C(i%, j%)
A.CMA(i, j) = CMA(i, j)
Next j%
Next i%
A.Muxs(0) = Muxs(0)
For i% = 1 To 32
A.Muxs(i%) = Muxs(i%)
A.Mux(i%) = Mux(i%)
'Debug.Print i; Muxs(i); Mux(i)
Next i%
Put #lu%, Record% + HiddenRecords, A
End Sub
Sub REFwrite
Sub REFwrite(lu%, Record%)
Select Case FileFormatOut
Case 32: Call REFwrite32(lu%, Record%)
Case 33: Call REFwrite33(lu%, Record%)
End Select
'Call REFread33(lu, Record)
End Sub
Sub REFwriteLIMITS
Sub REFwriteLIMITS(FQFN$)
Dim i%, lu%
RLR.NV = NV%
For i% = 0 To NV%: RLR.VSCAL(i%) = VSCAL(i%): Next i%
RLR.UTmin = UTmin: RLR.UTmax = UTmax
RLR.UTtakeoff = UTtakeoff: RLR.UTlanding = UTlanding
RLR.Mins(1) = GoodRecords: RLR.Maxs(1) = Badrecords
RLR.Mins(2) = NretMin: RLR.Maxs(2) = NretMax
RLR.Mins(3) = pALTmin: RLR.Maxs(3) = pALTmax
RLR.Mins(4) = Pitchmin: RLR.Maxs(4) = PitchMax
RLR.Mins(5) = Rollmin: RLR.Maxs(5) = RollMax
RLR.Mins(6) = Tacmin: RLR.Maxs(6) = Tacmax
RLR.Mins(7) = Zt1min: RLR.Maxs(7) = Zt1max
If Zt2min = 99.9 And Zt2max = 0 Then Zt2min = 99.9: Zt2max = 99.9
RLR.Mins(8) = Zt2min: RLR.Maxs(8) = Zt2max
RLR.Mins(9) = T1min: RLR.Maxs(9) = T1max
RLR.Mins(10) = T2min: RLR.Maxs(10) = T2max
RLR.Mins(11) = PT1min: RLR.Maxs(11) = PT1max
If PT2min = 600 And PT2max = 0 Then PT2min = 999.9: PT2max = 999.9
RLR.Mins(12) = PT2min: RLR.Maxs(12) = PT2max
RLR.Mins(13) = LATmin: RLR.Maxs(13) = LATmax
RLR.Mins(14) = LONmin: RLR.Maxs(14) = LONmax
RLR.Mins(15) = LRmin: RLR.Maxs(15) = LRmax
RLR.Mins(16) = Zmin: RLR.Maxs(16) = Zmax
RLR.Mins(17) = Tmin: RLR.Maxs(17) = Tmax
RLR.Mins(18) = zTmin: RLR.Maxs(18) = ZtMax
RLR.Mins(19) = PTmin: RLR.Maxs(19) = PTmax
RLR.Mins(20) = TSEmin: RLR.Maxs(20) = TSEmax
RLR.Mins(21) = zgeomin: RLR.Maxs(21) = zgeomax
RLR.Mins(22) = NDmin: RLR.Maxs(22) = NDmax
RLR.Mins(23) = MRImin: RLR.Maxs(23) = MRImax
RLR.Mins(24) = gALTmin: RLR.Maxs(24) = gALTmax
RLR.Mins(25) = UTksmin: RLR.Maxs(25) = UTksmax
RLR.Ztgm = Ztgm 'Altitude of global minimum T
RLR.Tzgm = Tzgm 'Global minimum T for flight above 5 km
RLR.Thgm = Thgm 'Theta at global minimym T
RLR.UTgm = UTgm 'UT at time of global minimum T
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF)
Put #lu%, 2, RLR
Close lu
End Sub
Sub REF2writeLIMITS
Sub REF2writeLIMITS(FQFN$)
Dim i%, lu%
RLR.NV = NV%
For i% = 0 To NV%: RLR.VSCAL(i%) = VSCAL(i%): Next i%
RLR.UTmin = UTmin: RLR.UTmax = UTmax
RLR.UTtakeoff = UTtakeoff: RLR.UTlanding = UTlanding
RLR.Mins(1) = GoodRecords: RLR.Maxs(1) = Badrecords
RLR.Mins(2) = NretMin: RLR.Maxs(2) = NretMax
RLR.Mins(3) = pALTmin: RLR.Maxs(3) = pALTmax
RLR.Mins(4) = Pitchmin: RLR.Maxs(4) = PitchMax
RLR.Mins(5) = Rollmin: RLR.Maxs(5) = RollMax
RLR.Mins(6) = Tacmin: RLR.Maxs(6) = Tacmax
RLR.Mins(7) = Zt1min: RLR.Maxs(7) = Zt1max
If Zt2min = 99.9 And Zt2max = 0 Then Zt2min = 99.9: Zt2max = 99.9
RLR.Mins(8) = Zt2min: RLR.Maxs(8) = Zt2max
RLR.Mins(9) = T1min: RLR.Maxs(9) = T1max
RLR.Mins(10) = T2min: RLR.Maxs(10) = T2max
RLR.Mins(11) = PT1min: RLR.Maxs(11) = PT1max
If PT2min = 600 And PT2max = 0 Then PT2min = 999.9: PT2max = 999.9
RLR.Mins(12) = PT2min: RLR.Maxs(12) = PT2max
RLR.Mins(13) = LATmin: RLR.Maxs(13) = LATmax
RLR.Mins(14) = LONmin: RLR.Maxs(14) = LONmax
RLR.Mins(15) = LRmin: RLR.Maxs(15) = LRmax
RLR.Mins(16) = Zmin: RLR.Maxs(16) = Zmax
RLR.Mins(17) = Tmin: RLR.Maxs(17) = Tmax
RLR.Mins(18) = zTmin: RLR.Maxs(18) = ZtMax
RLR.Mins(19) = PTmin: RLR.Maxs(19) = PTmax
RLR.Mins(20) = TSEmin: RLR.Maxs(20) = TSEmax
RLR.Mins(21) = zgeomin: RLR.Maxs(21) = zgeomax
RLR.Mins(22) = NDmin: RLR.Maxs(22) = NDmax
RLR.Mins(23) = MRImin: RLR.Maxs(23) = MRImax
RLR.Mins(24) = gALTmin: RLR.Maxs(24) = gALTmax
RLR.Mins(25) = UTksmin: RLR.Maxs(25) = UTksmax
RLR.Ztgm = Ztgm 'Altitude of global minimum T
RLR.Tzgm = Tzgm 'Global minimum T for flight above 5 km
RLR.Thgm = Thgm 'Theta at global minimym T
RLR.UTgm = UTgm 'UT at time of global minimum T
lu = FreeFile
Open FQFN$ For Random Access Read Write As lu Len = Len(REF2)
Put #lu%, 2, RLR
Close lu
End Sub
Sub UpdateMPheader
Sub UpdateMPheader(HDRfile$, MPlu%)
Dim lu%, i%, j%, L%, n%, A$, b$, Nhdr%, yr$, dy$, mo$, fln&, fltnr&, FltDate&
Dim X$, lux%
Dim FlightNo&, Objective$, FlightDate$, NUMfile$
lu% = FreeFile
Open HDRfile$ For Input As lu%
Input #lu%, Nhdr 'Get number of header lines
Close (lu%)
lu% = FreeFile
Open HDRfile$ For Input As lu% 'Start over
For j = 1 To Nhdr 'Update dates in MP file header
Line Input #lu%, A$
Select Case j
Case 7
Mid$(A$, 1, 4) = Mid$(yyyymmdd$, 1, 4) 'set YR
Mid$(A$, 6, 2) = Mid$(yyyymmdd$, 5, 2) 'set MO
Mid$(A$, 9, 2) = Mid$(yyyymmdd$, 7, 2) 'set DY
b$ = Date$: L = Len(b$)
yr$ = Right$(b$, 4): dy$ = Mid$(b$, L - 6, 2): mo$ = Mid$(b$, L - 9, 2)
Mid$(A$, 13) = yr$ + " " + mo$ + " " + dy$
If Mission$ = "SONEX" Then
lux% = FreeFile
Open "\DC8\SONEX\FLTNR.PRN" For Input As lux%
Do
Input #lux%, fln, FltDate
If FltDate = Val(Right$(yyyymmdd$, 6)) Then FlightNo = fln
Loop Until EOF(lux%)
Else
NUMfile$ = fSetupFileName("NUM")
lux% = FreeFile
Open NUMfile$ For Input As lux%
i = -1
Do: Line Input #lux, b$ 'FlightNo, FlightDate, Objective$
b$ = LTrim(b$)
n = InStr(1, b$, " ")
FlightNo = Val(Left$(b$, n - 1))
b$ = Trim(Right$(b$, Len(b$) - n + 1))
n = InStr(1, b$, " ")
If n = 0 Then
FlightDate = Val(b$)
Objective$ = "Unknown"
Else
FlightDate = Val(Left$(b$, n - 1))
Objective$ = Trim(Mid$(b$, n, Len(A$) - n + 1))
End If
i = i + 1
If yyyymmdd$ = Trim(Str(FlightDate)) Then Exit Do
Loop Until EOF(lux)
End If
Close #lux%
Mid$(A$, 25) = Format$(FlightNo, "00000000")
Case Else
End Select
Print #MPlu%, A$
Next j
Close (lu%)
End Sub
Function fReadLF
Function fReadLF(lu%) As String
Dim C$, Out$
Out$ = ""
Do
C$ = Input(1, lu)
Select Case C$
Case vbLf
Case vbCr
Case Else
Out$ = Out$ + C$
End Select
Loop Until C$ = vbLf Or EOF(lu)
fReadLF = Out$
End Function
NGVsim.bas
- Sub DecodeAline
Sub DecodeAline(A$, GoToNext As Boolean)
Dim NavSource$, X$, ALTkmu!, ALTcor!, dALT!
Static UTsecNAVold&, hhmmNavLast$, hhmmssNavLast$, ALTftLast!
GoToNext = False
NavSource$ = Mid$(A$, 2, 1)
If NavSource$ = "W" And Val(yyyymmdd$) < 19990000 Then NavSource$ = "Y" 'WAM has different format
Select Case NavSource$
Case " ", "G", "N", "X", "W", "!" 'WB57 after WAM (ie ACCENT) is "W", for WAM is "Y"
' ER2 Format
' 1 2 3 4 5 6 7 8 9 10
' 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
' doy hh mm ss snn.lat snnn.lon hdg ppp.p rr.rr .zgeo pALT OAT Wspd Wdir Scndispc yymmdd hhmmss
' doy hh mm ss snn.lat snnn.lon hdg ppp.p rr.rr .zgeo pALT OAT Wspd Wdir Scndispc Sta yymmdd hhmmss
' AG266:22:02:32 -3.051 -159.368 64.2 .6 3.7 20479 20178 -65.9 .9 3.2 -188.9 1 255 970923 220222
Latitude = Val(Mid$(A$, 15, 8)): Longitude = Val(Mid$(A$, 23, 9))
Heading = Val(Mid$(A$, 32, 6))
Pitch = Val(Mid$(A$, 38, 6)): Roll = Val(Mid$(A$, 44, 6))
gALT = Val(Mid$(A$, 50, 6)) / 1000# 'gALT in km
If gALT = 99.999 Then gALT = gALTlast 'GPS/geometric alt [km]
gALTft = gALT * cft_km
pALT = Val(Mid$(A$, 56, 6)) / 1000# 'pALT in km
pALTft = pALT * cft_km
If pALT > 23# Then pALT = 99.9
'pALT = gALT
'pALTft = gALTft
OATn = Val(Mid$(A$, 62, 6)) 'Default OAT is OATnav
OATnav = OATn + cto 'Convert K
Wspd = Val(Mid$(A$, 68, 6))
Wdir = Val(Mid$(A$, 74, 6))
If NavSource$ = "W" Then Wdir = 0: Wspd = 0 'xxx mjm 990422
' DU data should always be present at end of A-line, decode from right side
X$ = Right$(A$, 13)
yymmddMTP$ = Left$(X$, 6)
hhmmssMTP$ = Right$(X$, 6) 'use Right$ in case formatting error
Case "Y", "!"
' WB57 Format for WAM
' 1 2 3 4 5 6 7 8 9" 10 11
' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123"
' DOY:HH:MM:SS Latitude Longitud Heading Pitch Roll Z_GEO pALT Temper ..Wspd ..Wdir sddd.d n yymmdd hhmmss"
' ###:##:##:## S###.### S###.### S###.### S###.# S###.# S###### S###### S###.# S###.# S###.# "
'Final version:
' AW054:14:00:20 +027.681 +065.230 -128.200 +035.4 -023.8 +045323 +045323 +028.6 +158.6 +042.1
'Original version:
' AW054:17:42:53 +043.432 +122.321 +004.2 -038.2 +035.4 05941 05941 -008.6 128.4 085.5
Latitude = Val(Mid$(A$, 16, 8)): Longitude = Val(Mid$(A$, 25, 8))
Heading = Val(Mid$(A$, 34, 8))
Pitch = Val(Mid$(A$, 43, 6)): Roll = Val(Mid$(A$, 50, 6))
gALTft = Val(Mid$(A$, 57, 7))
gALT = gALTft / cft_km 'gALT km
pALTft = Val(Mid$(A$, 65, 7))
pALT = pALTft / cft_km 'pALT km
OATn = Val(Mid$(A$, 73, 6))
OATnav = OATn + cto
Wspd = Val(Mid$(A$, 80, 5))
Wdir = Val(Mid$(A$, 87, 5))
Wdir = Wdir + 180
' DU data should always be present at end of A-line, decode from right side
X$ = Right$(A$, 13)
yymmddMTP$ = Left$(X$, 6)
hhmmssMTP$ = Right$(X$, 6) 'use Right$ in case formatting error
Case "D", "E", "!"
' DC8 Format
' 1 2 3 4 5 6 7 8 9"
' 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"
' AD999 99999999 9999999 99999999 99999 99999 9999 99999 99999 99999 99999 99999 999999 1" + MID$(a$, 88, 14) '960219 101112"
' doy hh:mm:ss snn.lat snnn.lon hdg ppp.p rr.r radar ALTft .OATn .Wspd .Wdir ScnDis P yymmdd hhmmss'
' TexAQS
' AE224 17:38:05 39.913 -105.117 x999 - 0.2 - 0.7 95960 05436 35.6 0007 0204 12.3 1 000811 173802
' ^fix
' SOLVE
' AD 75 05:40:40 67.821 20.335 207 .3 .6 01589 02055 -13.4 0000 0000 11.9 1 000315 053809
Latitude = Val(Mid$(A$, 15, 8)): Longitude = Val(Mid$(A$, 23, 9))
Heading = Val(Mid$(A$, 32, 5))
Pitch = Val(Mid$(A$, 37, 6)): Roll = Val(Mid$(A$, 43, 6))
gALTft = Val(Mid$(A$, 49, 6))
If gALTft <> 99999 Then gALT = gALTft / cft_km Else gALT = gALTlast 'GPS/geometric alt [km]
pALTft = Val(Mid$(A$, 55, 6)) 'pressure altitude
If pALTft <> 99999 Then pALT = pALTft / cft_km
OATn = Val(Mid$(A$, 61, 6))
OATnav = OATn + cto
Wspd = Val(Mid$(A$, 68, 4))
Wdir = Val(Mid$(A$, 74, 5))
ElCor = Val(Mid$(A$, 79, 7))
ElCorUsed = Val(Mid$(A$, 86, 2))
yymmddMTP$ = Mid$(A$, 89, 6)
hhmmssMTP$ = Mid$(A$, 96, 6)
Case Else
Call MsgBox("You are not using a valid A-line format!", vbOK)
Exit Sub
End Select
If Abs(Latitude) > 90 Then Latitude = 99.999
If Abs(Longitude) > 180 Then Longitude = 999.999
If Heading < 0 Then Heading = Heading + 360
If Heading > 360 Then Heading = 999
If Abs(Pitch) > 90 Then Pitch = 999.9
If Abs(Roll) > 90 Then Roll = 999.9
'If Abs(Roll) > RollWarnCrit Then RollWarnFlg = True Else RollWarnFlg = False
'xxx mjm 20000204 never used
If Wspd > 999 Then Wspd = 999
If Wdir > 999 Then Wdir = 999
If gALT > Ceiling Then gALT = 99.9
If gALT = 0 Then gALT = gALTlast Else gALTlast = gALT 'ER2 drops gALT occassionally
If pALT > Ceiling Then pALT = 99.9
If pALT < 0# Then pALT = 0#: pALTft = 0#
' Fix pALT if necessary
If pALT = 99.9 Then
pALTft = pALTlast
ALTft = pALTft
ALTkm = pALTft / cft_km
Else
pALTlast = pALTft
If pALTft < 0 Then pALTft = 1
ALTkm = pALTft / cft_km
ALTkmu = ALTkm
'ALTcor = .046 - .000437 * ALTkmu ^ 2 + 3.315E-05 * (ALTkmu ^ 3)
ALTkm = ALTkmu + ALTfujCONST * ALTcor
ALTft = Int(ALTkm * cft_km + 0.5)
End If
UTsecMTP = fTstringToSec(hhmmssMTP$, False)
If Mid$(A$, 6, 8) <> "99:99:99" Then 'Use NAV UT if it's present
Doy = Val(Mid$(A$, 3, 3))
UTsecNav = fTstringToSec(Mid$(A$, 7, 8), True) 'Nav has colons
UTsec = UTsecNav
Else
Doy = 999
UTsec = UTsecMTP
End If
' Now fix time if necessary
If Mid$(A$, 6, 8) <> "99:99:99" Then 'Use NAV UT if it's present
' Doy = Val(Mid$(a$, 3, 3))
' UTsecNAV = fTstringToSec(Mid$(a$, 7, 8), True) 'Nav has colons
If UTsecNav < UTsecNAVold& And UTsecNav > 60 Then
UTsecNav = UTsecNav + 60 'Fix WB57 NAV 60 s problem
End If
UTsecNAVold& = UTsecNav
hhmmssNAV$ = fSecToTstring(UTsecNav, False) 'Get rid of colons
If hhmmNavLast$ = "" Then hhmmssNavLast$ = hhmmssNAV$
' UTsec = UTsecNAV
Else
hhmmssNAV$ = "999999"
' UTsec = UTsecMTP
GoToNext = True ' DADS not present at end of file
Exit Sub
End If
' If UTtakeoff > 0 And AC$ = "ER" And Mission$ = "CAMEX4" Then
' ALTkm = fZnavCorr(ALTkm, (UTsec - UTtakeoff) / 1000)
' End If
pALT = ALTkm 'Have some sort of valid altitude at this point
pALTft = pALT * cft_km
If ALTftLast = 0 Then ALTftLast = pALTft
dALT = pALTft - ALTftLast
ALTftLast = pALTft
hhmmssNAV$ = fSecToTstring(UTsecNav, False) 'Get rid of colons
If Heading > 180 Then Heading = 180 - Heading
If Wdir > 180 Then Wdir = 180 - Wdir
End Sub
Function fZtoP!
Function fZtoP!(Z!)
' Convert US Standard Atmosphere 1976 from Pressure Altitude [km] to Pressure [mb]
' Uses Function fTstd (z) to calculate US standard temperatures
' This approach is taken as it reduces number of calculations
' MJ Mahoney JPL 1990507
' Z T P D
' km K mb kg/m3
' 0 288.15 1013.25 1.22499919057116 1
' 11 216.65 226.3206 0.363917777824827 2
' 20 216.65 54.74888 8.80347996750117E-02 3
' 32 228.65 8.680185 1.32249977610308E-02 4
' 47 270.65 1.109063 1.42753221375531E-03 5
' 51 270.65 0.6693885 8.61604682553416E-04 6
' 71 214.65 3.956419E-02 6.42109635061132E-05 7
' 84.852 186.946 3.733836E-03 6.95787870826203E-06 8
Dim P!, T!
T = fTstd(Z)
Select Case Z
Case Is <= 11
' P = 1013.25 * (T / 288.15) ^ (-1000 * cg / (cRs * -6.5)
P = 1013.25 * (T / 288.15) ^ (5.2558761507598)
Case Is <= 20
' P = 226.3206 * Exp(-1000 * cg * (z - 11.) / (cRs * 216.65))
P = 226.3206 * Exp(-0.157688414400825 * (Z - 11#))
Case Is <= 32
' P = 54.74888 * (T / 216.65) ^ (-1000 * cg / (cRs * 1.)
P = 54.74888 * (T / 216.65) ^ (-34.1631949799387)
Case Is <= 47
' P = 8.680185 * (T / 228.65) ^ (-1000 * cg / (cRs * 2.8)
P = 8.680185 * (T / 228.65) ^ (-12.2011410642638)
Case Is <= 51
' P = 1.109063 * Exp(-1000 * cg * (Zs(i) - Zs(i - 1)) / (cRs * 270.65))
P = 1.109063 * Exp(-0.126226473230884 * (Z - 47))
Case Is <= 71
' P = 0.6693885 * (T / 270.65) ^ (-1000 * cg / (cRs * -2.8)
P = 0.6693885 * (T / 270.65) ^ (12.2011410642638)
Case Is <= 84.852
' P = 0.03956419 * (T / 214.65) ^ (-1000 * cg / (cRs * -2.0)
P = 0.03956419 * (T / 214.65) ^ (17.0815974899694)
Case Else
P = 0#
End Select
fZtoP = P
End Function
Function fTstd!
Function fTstd!(Z!)
' Temperature structure of 1976 US Standard Atmosphere
' z in km, fTstd in K
' MJ Mahoney JPL 19980510
Select Case Z
Case Is <= 11: fTstd = 288.15 - 6.5 * Z
Case Is <= 20: fTstd = 216.65
Case Is <= 32: fTstd = 216.65 + (Z - 20)
Case Is <= 47: fTstd = 228.65 + 2.8 * (Z - 32)
Case Is <= 51: fTstd = 270.65
Case Is <= 71: fTstd = 270.65 - 2.8 * (Z - 51)
Case Is <= 84.852: fTstd = 214.65 - 2# * (Z - 71)
Case Else: fTstd = 184.946
End Select
End Function
Function fSecToTstringx$
Function fSecToTstringx$(hms&, ColonFlag As Boolean)
Dim hr!, Min!, sec!, D&, T$, X$, C$
' Convert time in seconds to HHMMSS string with colon if colon.flag% is TRUE
hr = Int(hms / 3600)
Min = Int((hms - 3600 * hr) / 60)
sec = Int(hms - 3600 * hr - 60 * Min + 0.5)
If sec = 60 Then sec = 0: Min = Min + 1
If Min = 60 Then Min = 0: hr = hr + 1
If ColonFlag Then C$ = ":" Else C$ = ""
D = 1000000 + 10000 * hr + 100 * Min + sec 'Avoid loosing leading zeros!
T$ = Str$(D): T$ = Right$(T$, 6)
X$ = Left$(T$, 2) + C$ + Mid$(T$, 3, 2) + C$ + Right$(T$, 2)
fSecToTstringx$ = Left$(T$, 2) + C$ + Mid$(T$, 3, 2) + C$ + Right$(T$, 2)
' L$ = Left$(T$, 2): LL$ = Left$(T$, 1)
' T$ = T$
End Function
Function fTstringToSecx&
Function fTstringToSecx&(T$, ColonFlag As Boolean)
Dim i%, hr%, Min%, sec%
'Convert a time string to seconds
'If colon_flag is TRUE, format is assumed to be hh:mm:ss; otherwise, hhmmss
If ColonFlag Then i% = 3 Else i% = 2
hr = Val(Mid$(T$, 1, 2))
Min = Val(Mid$(T$, 1 + i%, 2))
sec = Val(Mid$(T$, 1 + 2 * i%, 2))
fTstringToSecx& = 3600# * hr + 60# * Min + sec
End Function
Sub FindIWG1
Sub FindIWG1()
Dim IWG1$
' Look for character string "IWG1," on INPlu
EOFflag = False
Repeat:
IWG1$ = ""
Do 'Look for first "F"
GoSub GetChar 'Get next character
If IWG1$ = "I" Then 'Check for I
GoSub GetChar
If IWG1$ = "IW" Then 'Check for IW
GoSub GetChar
If IWG1$ = "IWG" Then 'Check for IWG
GoSub GetChar
If IWG1$ = "IWG1" Then 'Check for IWG1
GoSub GetChar
If IWG1$ = "IWG1," Then 'Check for IWG1,
Exit Sub
Else
GoSub Repeat
End If
Else
GoSub Repeat
End If
Else
GoSub Repeat
End If
Else
GoSub Repeat
End If
Else
GoSub Repeat
End If
Loop
Exit Sub
GetChar:
If ReadMode = 2 Then 'Read data from serial port
If MSComm1.InBufferCount > 0 Then
IWG1$ = IWG1$ + MSComm1.Input
Else
MsgBox "There is no data on COM Port " + Str(COMport) + "!", vbOKOnly
NoComPortData = True
Exit Sub
End If
Else 'Read data from file
If EOF(INPlu) Then
EOFflag = True
Exit Sub
End If
IWG1$ = IWG1$ + Input(1, INPlu) 'Get one character.
End If
Return
End Sub
Sub ReadNextFrameFile
Sub ReadNextFrameFile()
Dim i%, j%, X$
Static NGVlu%
' Find NGV Packet start string
Call FindIWG1 'Get "IWG1," string
If EOF(INPlu) Then EOFflag = True: Exit Sub 'Skip CPK
' And read it from NGV Data File
Packet_NGV = "IWG1,"
X$ = ""
Do
Packet_NGV = Packet_NGV + Input(1, INPlu) 'get a character
' If WriteHex Then Debug.Print fHex2$(Right$(Packet_NGV, 1));
If Len(Packet_NGV) > 4 Then X$ = Right$(Packet_NGV, 4)
Loop Until X$ = "\r\n" 'vbCR+vbLF
If WriteHex Then Debug.Print ""
' Packet_NGV = Left$(Packet_NGV, Len(Packet_NGV) - 4)
If WriteHex Then Print #OUTlu, Packet_NGV
EOFflag = False
' Frame Number
FrameNumber = FrameNumber + 1
' txtFrame.Text = FrameNumber
' If FrameNumber < Slider3.Max Then Slider3.Value = FrameNumber
Exit Sub
End Sub
Function GetSerialIn$
Function GetSerialIn$()
Static MTPin$
Dim COM1$, Char$, i%, L%
Do
If MSComm1.InBufferCount > 0 Then
COM1$ = MSComm1.Input
L% = Len(COM1$)
Select Case MSComm1.InputLen
Case 0 'Entire buffer read into COM1$
For i% = 1 To L% 'Check for CR in buffer
Char$ = Mid$(COM1$, i%, 1)
Select Case Char$
Case vbCr
GetSerialIn$ = MTPin$
List1.AddItem MTPin$
MTPin$ = Right$(COM1$, L% - i% - 1) 'Save leftovers
Exit Function 'And exit
Case vbLf 'Ignore LF
Case Else
MTPin$ = MTPin$ + Char$ 'No CR, save everything
End Select
Next
Case 1
Select Case COM1$
Case vbCr
GetSerialIn$ = MTPin$
List1.AddItem MTPin$
MTPin$ = ""
Exit Function
Case vbLf
' Ignore linefeeds
Case Else
MTPin$ = MTPin$ + COM1$
End Select
End Select
DoEvents
End If
Loop
End Function
Sub Encode_NGV
Sub Encode_NGV(Packet_NGV As String)
Dim i%, Out$, D1$, D2$
' This routine is only used to encode DC8 data for testing
' Num x Parameter Unit Variable
' 000 Prefix IWG1
' 001 x Date/Time yyyy-mm-ddThh:mm:ss UTsec
' 002 x Latitude deg Latitude
' 003 x Longitude deg Longitude
' 004 x GPS_MSL_Alt m gALT, Zg
' 005 WGS_84_Alt m wALT, Zw
' 006 x Press_Alt ft pALT, Zp
' 007 Radar_Alt ft rALT, Zr
' 008 Grnd_Spd m/s GroundSpeed
' 009 True_Airspeed m/s TAS
' 010 Indicated_Airspeed kts IAS
' 011 Mach_Number --- Mach
' 012 Vert_Velocity m/s Vz
' 013 x True_Hdg degt Heading
' 014 Track degt TrackAngle
' 015 Drift deg DriftAngle
' 016 x Pitch deg Pitch
' 017 x Roll deg Roll
' 018 Side_slip deg SideSlipAngle
' 019 Angle_of_Attack deg AttackAngle
' 020 x Ambient_Temp C OATn (OATnav = OATn + cTo)
' 021 Dew_Point C Tdew
' 022 Total_Temp C Ttotal
' 023 Static_Press mb Ps
' 024 Dynamic_Press mb Pd
' 025 Cabin_Press mb Pc
' 026 x Wind_Speed m/s Wspd
' 027 x Wind_Dir degt Wdir
' 028 Vert_Wind_Spd m/s VWS
' 029 Solar_Zenith_Angle deg SZA
' 030 Sun_Elev_AC deg SEAC
' 031 Sun_Az_Grd degt SAG
' 032 Sun_Az_AC degt SAAC
' Suffix \r\n
Out$ = "IWG1"
For i = 1 To 32
Select Case i
Case 1 'yyyy-mm-ddThh:mm:ss
D1$ = Date
D2$ = Right$(D1$, 4) + "-" + Left$(D1$, 2) + "-" + Mid$(D1$, 4, 2)
Out$ = Out$ + "," + D2$ + "T" + fSecToTstring$(UTsec, True)
Case 2 'Latitude
Out$ = Out$ + "," + Format(Latitude, "##0.000")
Case 3 'Longitude
Out$ = Out$ + "," + Format(Longitude, "###0.000")
Case 4 'gALT
Out$ = Out$ + "," + Format(gALT * 1000#, "####0") 'm
Case 6 'pALT
Out$ = Out$ + "," + Format(pALT * cft_km, "####0") 'feet
Case 13 'Heading
Out$ = Out$ + "," + Format(Heading, "##0.00")
Case 16 'Pitch
Out$ = Out$ + "," + Format(Pitch, "##0.00")
Case 17 'Roll
Out$ = Out$ + "," + Format(Roll, "##0.00")
Case 20 'OATnav
Out$ = Out$ + "," + Format(OATn, "##0.00")
Case 26 'Wspd
Out$ = Out$ + "," + Format(Wspd, "##0.0")
Case 27 'Wdir
Out$ = Out$ + "," + Format(Wdir, "##0.0")
Case Else
Out$ = Out$ + ","
End Select
Next i
Packet_NGV = Out$ + "\r\n"
End Sub
NGVTcal.bas
- Function fUsing
Function fUsing(ByVal fmt$, ByRef V!()) As String
Dim L%, M%, i%, j%, k%, f$, out$, n$
' Generate a string using the format in fmt$ and the order parameters in V()
M% = 1
L% = Len(fmt$)
i% = InStr(1, fmt$, "#", 1) ' find first field start =#
out$ = Space(i% - 1) ' save leading spaces before # if any
Do
j% = InStr(i%, fmt$, " ", 1) 'find next field location (delimited by space)
If j% = 0 Then j% = L% + 1 'none if end of fmt$
k% = j% - i% 'number of character in current field
f$ = Mid$(fmt$, i%, k%)
n$ = Format$(V(M%), f$) 'format number
M% = M% + 1
If k - Len(n$) >= 0 Then
out$ = out$ + Space(k% - Len(n$)) + n$ ' add spaces so field has correct length
End If
i% = InStr(j%, fmt$, "#", 1) 'Get next field
If i% <> 0 Then out$ = out$ + Space(i% - j%)
Loop Until i% = 0
fUsing$ = out$
End Function
Function fDOYtoYMD
Function fDOYtoYMD(Iyear%, Doy%) As String
' SUBROUTINE W3FS26(JLDAYN, Iyear, Month, Iday, IDAYWK, IDAYYR)
'C$$$ SUBPROGRAM DOCUMENTATION BLOCK
'c
'C SUBPROGRAM: W3FS26 YEAR, MONTH, DAY FROM JULIAN DAY NUMBER
'C AUTHOR: JONES,R.E. ORG: W342 DATE: 87-03-29
'c
'C ABSTRACT: COMPUTES YEAR (4 DIGITS), MONTH, DAY, DAY OF WEEK, DAY
'C OF YEAR FROM JULIAN DAY NUMBER. THIS SUBROUTINE WILL WORK
'C FROM 1583 A.D. TO 3300 A.D.
'c
'C PROGRAM HISTORY LOG:
'C 87-03-29 R.E.JONES
'C 88-07-06 R.E.JONES CHANGE TO MICROSOFT FORTRAN 4.10
'C 90-06-11 R.E.JONES CHANGE TO SUN FORTRAN 1.3
'C 91-03-29 R.E.JONES CONVERT TO SiliconGraphics FORTRAN
'c
'c USAGE: Call W3FS26(JLDAYN, Iyear, Month, Iday, IDAYWK, IDAYYR)
'c
'C INPUT VARIABLES:
'C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES
'C ------ --------- -----------------------------------------------
'C JLDAYN ARG LIST INTEGER*4 JULIAN DAY NUMBER
'c
'C OUTPUT VARIABLES:
'C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES
'C ------ --------- -----------------------------------------------
'C IYEAR ARG LIST INTEGER*4 YEAR (4 DIGITS)
'C MONTH ARG LIST INTEGER*4 MONTH
'C IDAY ARG LIST INTEGER*4 DAY
'C IDAYWK ARG LIST INTEGER*4 DAY OF WEEK (1 IS SUNDAY, 7 IS SAT)
'C IDAYYR ARG LIST INTEGER*4 DAY OF YEAR (1 TO 366)
'c
'C REMARKS: A JULIAN DAY NUMBER CAN BE COMPUTED BY USING ONE OF THE
'C FOLLOWING STATEMENT FUNCTIONS. A DAY OF WEEK CAN BE COMPUTED
'C FROM THE JULIAN DAY NUMBER. A DAY OF YEAR CAN BE COMPUTED FROM
'C A JULIAN DAY NUMBER AND YEAR.
'c
'C IYEAR (4 DIGITS)
'c
'c JDN(Iyear, Month, Iday) = Iday - 32075
'c X + 1461 * (Iyear + 4800 + (Month - 14) / 12) / 4
'c y + 367 * (Month - 2 - (Month - 14) / 12 * 12) / 12
'c z - 3 * ((Iyear + 4900 + (Month - 14) / 12) / 100) / 4
'c
'C IYR (4 DIGITS) , IDYR(1-366) DAY OF YEAR
'c
'c JULIAN(IYR, IDYR) = -31739 + 1461 * (IYR + 4799) / 4
'c X - 3 * ((IYR + 4899) / 100) / 4 + IDYR
'c
'C DAY OF WEEK FROM JULIAN DAY NUMBER, 1 IS SUNDAY, 7 IS SATURDAY.
'c
'C JDAYWK(JLDAYN) = MOD((JLDAYN + 1),7) + 1
'c
'C DAY OF YEAR FROM JULIAN DAY NUMBER AND 4 DIGIT YEAR.
'c
'C JDAYYR(JLDAYN,IYEAR) = JLDAYN -
'c X(-31739 + 1461 * (Iyear + 4799) / 4 - 3 * ((Iyear + 4899) / 100) / 4)
'c
'C THE FIRST FUNCTION WAS IN A LETTER TO THE EDITOR COMMUNICATIONS
'C OF THE ACM VOLUME 11 / NUMBER 10 / OCTOBER, 1968. THE 2ND
'C FUNCTION WAS DERIVED FROM THE FIRST. THIS SUBROUTINE WAS ALSO
'C INCLUDED IN THE SAME LETTER. JULIAN DAY NUMBER 1 IS
'C JAN 1,4713 B.C. A JULIAN DAY NUMBER CAN BE USED TO REPLACE A
'C DAY OF CENTURY, THIS WILL TAKE CARE OF THE DATE PROBLEM IN
'C THE YEAR 2000, OR REDUCE PROGRAM CHANGES TO ONE LINE CHANGE
'C OF 1900 TO 2000. JULIAN DAY NUMBERS CAN BE USED FOR FINDING
'C RECORD NUMBERS IN AN ARCHIVE OR DAY OF WEEK, OR DAY OF YEAR.
'c
'c Attributes:
'C LANGUAGE: SiliconGraphics 3.3 FORTRAN 77
'C MACHINE: SiliconGraphics IRIS-4D/25
'c
'C$$$
'c
'c
' Save
'c
Dim JLDAYN&, L&, n&, i&, j&, IDAYWK&, IDAYYR&, Month&
Select Case Iyear
Case 1997: JLDAYN = 2450448.5
Case 1998: JLDAYN = 2450813.5
Case 1999: JLDAYN = 2451178.5
Case Else
Call MsgBox(Str$(Iyear) + " is not supported by this function!", vbOKOnly)
Exit Function
End Select
L = JLDAYN + 68569 + Doy + 1
n = (4 * L) \ 146097
L = L - (146097 * n + 3) \ 4
i = 4000 * (L + 1) \ 1461001
L = L - 1461 * i \ 4 + 31
j = 80 * L \ 2447
Iday = L - 2447 * j \ 80
L = j \ 11
Month = j + 2 - 12 * L
Iyear = 100 * (n - 49) + i + L
IDAYWK = ((JLDAYN + 1) Mod 7) + 1
IDAYYR = JLDAYN - (-31739 + 1461 * (Iyear + 4799) / 4 - 3 * ((Iyear + 4899) / 100) / 4)
fDOYtoYMD = Format(Iyear, "0000") + Format(Month, "00") + Format(Iday, "00")
End Function
Function fTvRH
Function fTvRH(P!, T!, RH!)
' Calculate virtual temperature from p, T, and RH
' Need function fEs to calculate water vapor saturation mixing ratio
fTvRH = T / (1 - (RH / 100) * (fEs(T) / P) * (1 - cEa))
End Function
Function fEs
Function fEs(ByVal Tk!) As Single
Dim dT!, es!, i%
Static a!(0 To 6), Init As Boolean, cTo!
'Water vapor saturation mixing ratio
'Tk in Kelvin, Es in mb
'See Flatau et al., 1992, J. App. Meteorol.,31,1507-1513.
If Not Init Then
a(0) = 6.1117675 'Saturation vapor pressure (hPa)
a(1) = 0.443986062
a(2) = 0.0143053301
a(3) = 0.000265027242
a(4) = 0.00000302246994
a(5) = 2.03886313E-08
a(6) = 6.38780966E-11
cTo = 273.15
Init = True
End If
dT = Tk - cTo
es = a(0)
For i = 1 To 6
es = es + a(i) * dT ^ i
Next i
fEs = es
End Function
Function fEv
Function fEv(ByVal RH!, ByVal T!) As Single
' Vapor pressure (mb) given RH (%) and T (K)
fEv = RH * fEs(T) / 100#
End Function
Function fLinterp
Function fLinterp(z!(), V!(), n%, zo!) As Single
' Do linear interpolation in z to find value of at zo
Dim i%, it%, ib%
i = 0
Do
i = i + 1
Loop Until z(i) >= zo Or i = n
If z(i) = zo Then fLinterp = V(i): Exit Function
If i > n Then fLinterp = V(n): Exit Function
it = i
ib = i - 1
If ib = 0 Then
fLinterp = V(it)
Else
fLinterp = V(ib) + (V(it) - V(ib)) * (zo - z(ib)) / (z(it) - z(ib))
End If
End Function
Sub ReadNGV
Sub ReadNGV(ngvlu%)
Dim a$, i%, j%, HHMMSS$
'UTC ATRL AT_A GGLAT GGLON PALT PSFC Time
'15:35:04 -68.1329 -67.1145 40.0492 -107.456 12191.3 187.418 1504
'15:35:14 -68.1442 -67.1961 40.0502 -107.48 12193.9 187.339 1514
Input #ngvlu, a$
i = InStr(1, a$, " ")
HHMMSS$ = Left$(a$, i - 1)
nUTsec = fTstringToSec(HHMMSS$, True)
j = InStr(i + 1, a$, " ")
nTr = Val(Mid$(a$, i + 1, j - i - 1))
i = InStr(j + 1, a$, " ")
nTa = Val(Mid$(a$, j + 1, i - j - 1))
j = InStr(i + 1, a$, " ")
nLatitude = Val(Mid$(a$, i + 1, j - i - 1))
i = InStr(j + 1, a$, " ")
nLongitude = Val(Mid$(a$, j + 1, i - j - 1))
j = InStr(i + 1, a$, " ")
nZp = Val(Mid$(a$, i + 1, j - i - 1)) / 1000#
i = InStr(j + 1, a$, " ")
nP = Val(Mid$(a$, j + 1, i - j - 1))
End Sub
Function fTstringToSec
Function fTstringToSec(ByVal T$, ByVal ColonFlag As Boolean) As Long
Dim i%, Hr%, Min%, Sec%
'Convert a time string (T$) to seconds
'If Colon_Flag is TRUE, T$ format is assumed to be hh:mm:ss; otherwise, hhmmss
If ColonFlag Then i% = 3 Else i% = 2
Hr = Val(Mid$(T$, 1, 2))
Min = Val(Mid$(T$, 1 + i%, 2))
Sec = Val(Mid$(T$, 1 + 2 * i%, 2))
fTstringToSec& = 3600# * Hr + 60# * Min + Sec
End Function
Sub Zhme
Sub Zhme(P!(), T!(), RH!(), zo!, n%, Zg!())
Dim i%, Tv!(1 To 2000), GammaA!
GammaA = 1000 * 2 * cg / cRd ' 1000* to get km, 2 for average Tv
Zg(1) = zo
Tv(1) = fTvRH(P(1), T(1), RH(1))
For i = 2 To n
Tv(i) = fTvRH(P(i), T(i), RH(i))
Zg(i) = Zg(i - 1) - (Tv(i) + Tv(i - 1)) * Log(P(i) / P(i - 1)) / GammaA
Next i
End Sub
Function fRhoV
Function fRhoV(ByVal RH!, ByVal T!) As Single
' Vapor density (gm/m3) given RH (%) and T (K)
' Using ideal gas law
If T = 0 Then T = 273.15
fRhoV = 100000 * cEa * fEv(RH, T) / (cRd * T)
End Function
Function fHypsometricEqn
Function fHypsometricEqn(ByVal T1!, ByVal p1!, ByVal T2!, ByVal p2!) As Single
' Change in geopotential height (km) between pressure levels P1 and p2 (hPa/mb)
' with corresponding temperatures T1 and T2 (K)
' cRd = 287.05307 'J /kg K Gas Constant (dry air)
' cg = 9.80665 'm /s2 Acceleration of gravity(surface)
'
fHypsometricEqn = cRd * (T1 + T2) * Log(p1 / p2) / cg / 2000 'Delta km
End Function
Function fRhoInt
Function fRhoInt(ByRef z!(), ByRef Rho!(), ByVal Nlev%, ByVal Zmax!, ZmaxFlag As Boolean) As Single
' Integrate liquid or vapor density (g/m3) to get column (cm)
' If ZmaxFlag is TRUE, integrate only to zo (km)
' Else integrate entire profile
Dim Sum!, i%, RhoZmax!
Sum = 0#
If ZmaxFlag Then 'Integrate to Zmax only
i = 1
Do While (z(i + 1) < Zmax) And (i + 1 <= Nlev)
i = i + 1
Sum = Sum + 0.5 * (Rho(i - 1) + Rho(i)) * (z(i) - z(i - 1))
Loop
RhoZmax = fLinterp(z(), Rho(), Nlev, Zmax)
Sum = Sum + 0.5 * (RhoZmax + Rho(i)) * (Zmax - z(i))
Else 'Integrate entire profile
For i = 2 To Nlev
Sum = Sum + 0.5 * (Rho(i - 1) + Rho(i)) * (z(i) - z(i - 1))
Next i
End If
fRhoInt = Sum / 10 'cm, density of water = 1000000 g/m3 and 100000 cm/km
End Function
Function fTdTaToRH
Function fTdTaToRH(TA!, Td!, Celsius As Boolean)
'Ta is ambient temperature [C]
'Td is dew point temperature [C]
'RH is in percent
Dim es!, E!
If Td = 0 Then fTdTaToRH = 0#: Exit Function
If Celsius Then
es = 6.11 * (10# ^ (7.5 * TA / (237.7 + TA)))
E = 6.11 * (10# ^ (7.5 * Td / (237.7 + Td)))
Else 'assume Kelvin
es = 6.11 * (10# ^ (7.5 * (TA - cTo) / (TA - 35.45)))
E = 6.11 * (10# ^ (7.5 * (Td - cTo) / (Td - 35.45)))
End If
fTdTaToRH = (E / es) * 100#
End Function
Function fReadLF
Function fReadLF(lu%) As String
Dim c$, out$
out$ = ""
Do
c$ = Input(1, lu)
Select Case c$
Case vbLf
Case vbCr
Case Else
out$ = out$ + c$
End Select
Loop Until c$ = vbLf Or EOF(lu)
fReadLF = out$
End Function
Function fPtoZ
Function fPtoZ(ByVal P!) As Single
Dim z!
' Convert US Standard Atmosphere 1976 from Pressure [mb] to Pressure Altitude [km]
' MJ Mahoney JPL 1990507
' Z T P D N LR
' km K mb kg/m3 K/km
' 0 288.15 1013.25 1.22499919057116 1 -6.5
' 11 216.65 226.3206 0.363917777824827 2 0.0
' 20 216.65 54.74888 8.80347996750117E-02 3 1.0
' 32 228.65 8.680185 1.32249977610308E-02 4 2.8
' 47 270.65 1.109063 1.42753221375531E-03 5 0.0
' 51 270.65 0.6693885 8.61604682553416E-04 6 -2.8
' 71 214.65 3.956419E-02 6.42109635061132E-05 7 -2.0
' 84.852 186.946 3.733836E-03 6.95787870826203E-06 8 0.0
' 90 186.946 1.45742511874549E-03 9 0.2908
' 95 188.4 5.8654139565495E-04 10 1.34
' 100 195.1 2.40645796828482E-04 11 2.74
' 105 208.8 1.03251578598705E-04 12 6.24
' 110 240.0 4.81695302325482E-05 13 12.0
' 120 360.0 14
Select Case P
Case Is > 226.3206 '<11 km
' z = Zs(1) + (Ts(1) / LRs(1)) * (1.-((P / Ps(1)) ^ (-(cRs * LRs(1))/(1000.*cg))))
z = (44.3307692307692) * (1# - (P / 1013.25) ^ (0.190263235151657))
Case Is > 54.74888 '<20 km
' z = Zs(2) - (cRs * Ts(2) / (cg * 1000)) * ln(P / Ps(2))
z = 11# - 6.34161998393947 * Log(P / 226.3206)
Case Is > 8.680185 '<32 km
' z = Zs(3) - (Ts(3) / LRs(3)) * (1.-((P / Ps(3)) ^ (-(cRs * LRs(3))/(1000.*cg))))
z = 20 - 216.65 * (1# - (P / 54.74888) ^ (-2.92712669464088E-02))
Case Is > 1.109063 '<47 km
' z = Zs(4) - (Ts(4) / LRs(4)) * (1.-((P / Ps(4)) ^ ((cRs * LRs(4))/(1000.*cg))))
z = 32 - 81.6607142857143 * (1# - (P / 8.680185) ^ (-8.19595474499447E-02))
Case Is > 0.6693885 '<51 km
' z = Zs(5) - (cRs * Ts(5) / (cg * 1000)) * ln(P / Ps(5))
z = 47# - 7.92226839904554 * Log(P / 1.109063)
Case Is > 0.03956419 '<71 km
' z = Zs(6) - (Ts(6) / LRs(6)) * (1.-((P / Ps(6)) ^ ((cRs * LRs(6))/(1000.*cg))))
z = 51 + 96.6607142857143 * (1# - (P / 0.6693885) ^ (8.19595474499447E-02))
Case Is > 0.003733834 '<84.852 km
' z = Zs(7) - (Ts(7) / LRs(7)) * (1.-((P / Ps(7)) ^ (-(cRs * LRs(7))/(1000.*cg))))
z = 71 + 107.325 * (1# - (P / 0.03956419) ^ (5.85425338928176E-02))
Case Is > 1.45742511874549E-03 '<90 km
' z = Zs(8) - (cRs * Ts(8) / (cg * 1000)) * ln(P / Ps(8))
z = 84.852 - 5.47214624555127 * Log(P / 0.003733834)
Case Is > 5.8654139565495E-04 '<95 km
' z = Zs(9) - (Ts(9) / LRs(9)) * (1.-((P / Ps(9)) ^ ((cRs * LRs(9))/(1000.*cg))))
z = 90# - 642.8679 * (1# - (P / 1.45742511874549E-03) ^ (-8.51208458015383E-03))
Case Is > 2.40645796828482E-04 '<100 km
' z = Zs(4) - (Ts(10) / LRs(10)) * (1.-((P / Ps(10)) ^ ((cRs * LRs(10))/(1000.*cg))))
z = 95# - 140.597 * (1# - (P / 5.8654139565495E-04) ^ (-3.92234986852218E-02))
Case Is > 1.03251578598705E-04 '<105 km
' z = Zs(4) - (Ts(4) / LRs(4)) * (1.-((P / Ps(4)) ^ ((cRs * LRs(4))/(1000.*cg))))
z = 100# - 71.20438 * (1# - (P / 2.40645796828482E-04) ^ (-8.02032717123127E-02))
Case Is > 4.81695302325482E-05 '<110 km
' z = Zs(12) - (Ts(12) / LRs(12)) * (1.-((P / Ps(12)) ^ ((cRs * LRs(12))/(1000.*cg))))
z = 105# - 33.46154 * (1# - (P / 1.03251578598705E-04) ^ (-0.18265269904593))
Case Else
' z = Zs(4) - (Ts(4) / LRs(4)) * (1.-((P / Ps(4)) ^ ((cRs * LRs(4))/(1000.*cg))))
If P <= 0 Then P = 0.000001
z = 110 - 20# * (1# - (P / 4.81695302325482E-05) ^ (-0.351255203356906))
End Select
fPtoZ = z
End Function
Function fZtoP!
Function fZtoP!(z!)
' Convert US Standard Atmosphere 1976 from Pressure Altitude [km] to Pressure [mb]
' Uses Function fTstd (z) to calculate US standard temperatures
' This approach is taken as it reduces number of calculations
' MJ Mahoney JPL 1990507
' Z T P D
' km K mb kg/m3
' 0 288.15 1013.25 1.22499919057116 1
' 11 216.65 226.3206 0.363917777824827 2
' 20 216.65 54.74888 8.80347996750117E-02 3
' 32 228.65 8.680185 1.32249977610308E-02 4
' 47 270.65 1.109063 1.42753221375531E-03 5
' 51 270.65 0.6693885 8.61604682553416E-04 6
' 71 214.65 3.956419E-02 6.42109635061132E-05 7
' 84.852 186.946 3.733836E-03 6.95787870826203E-06 8
' 90 186.946 9 0.2908
' 95 188.4 10 1.34
' 100 195.1 11 2.74
' 105 208.8 12 6.24
' 110 240.0 13 12.0
' 120 360.0 14
Dim P!, T!
T = fTstd(z)
Select Case z
Case Is <= 11
' P = P(1)*(T/T(1))^(-1000*cg/(cRs*LR(1)))
' P = 1013.25 * (T / 288.15) ^ (-1000 * cg / (cRs * -6.5)
P = 1013.25 * (T / 288.15) ^ (5.2558761507598)
Case Is <= 20
' P = 226.3206 * Exp(-1000 * cg * (z - 11.) / (cRs * 216.65))
P = 226.3206 * Exp(-0.157688414400825 * (z - 11#))
Case Is <= 32
' P = 54.74888 * (T / 216.65) ^ (-1000 * cg / (cRs * 1.)
P = 54.74888 * (T / 216.65) ^ (-34.1631949799387)
Case Is <= 47
' P = 8.680185 * (T / 228.65) ^ (-1000 * cg / (cRs * 2.8)
P = 8.680185 * (T / 228.65) ^ (-12.2011410642638)
Case Is <= 51
' P = 1.109063 * Exp(-1000 * cg * (Zs(i) - Zs(i - 1)) / (cRs * 270.65))
P = 1.109063 * Exp(-0.126226473230884 * (z - 47))
Case Is <= 71
' P = 0.6693885 * (T / 270.65) ^ (-1000 * cg / (cRs * -2.8)
P = 0.6693885 * (T / 270.65) ^ (12.2011410642638)
Case Is <= 84.852
' P = 0.03956419 * (T / 214.65) ^ (-1000 * cg / (cRs * -2.0)
P = 0.039564189818084 * (T / 214.65) ^ (17.0815974899694)
Case Is <= 90
' P = 0.003733834 * Exp(-1000 * cg * (z - 84.852) / (cRs * 186.946))
P = 0.003733834 * Exp(-0.182743653140151 * (z - 84.852))
Case Is <= 95
' P = 0.001457425 * (T / 184.946) ^ (-1000 * cg / (cRs * 0.2908)
P = 1.45742511874549E-03 * (T / 186.946) ^ (-117.480037757699)
Case Is <= 100
' P = P(11)*(T/T(11))^(-1000*cg/(cRs*LR(11)))
' P = 0.0005808211 * (T / 188.4) ^ (-1000 * cg / (cRs * 1.34)
P = 5.8654139565495E-04 * (T / 188.4) ^ (-25.4949216268199)
Case Is <= 105
' P = 0.0001815319 * (T / 195.1) ^ (-1000 * cg / (cRs * 2.74)
P = 2.40645796828482E-04 * (T / 195.1) ^ (-12.4683193357411)
Case Is <= 110
' P = 0.00007788813 * (T / 208.8) ^ (-1000 * cg / (cRs * 6.24)
P = 1.03251578598705E-04 * (T / 208.8) ^ (-5.4748709903748)
Case Else
' P = 0.00003633683 * (T / 240.) ^ (-1000 * cg / (cRs * 12)
P = 4.81695302325482E-05 * (T / 240#) ^ (-2.84693291499489)
End Select
fZtoP = P
End Function
Function fTstd!
Function fTstd!(z!)
' Temperature structure of 1976 US Standard Atmosphere
' z in km, fTstd in K
' MJ Mahoney JPL 19980510
Select Case z
Case Is <= 11: fTstd = 288.15 - 6.5 * z
Case Is <= 20: fTstd = 216.65
Case Is <= 32: fTstd = 216.65 + (z - 20)
Case Is <= 47: fTstd = 228.65 + 2.8 * (z - 32)
Case Is <= 51: fTstd = 270.65
Case Is <= 71: fTstd = 270.65 - 2.8 * (z - 51)
Case Is <= 84.852: fTstd = 214.65 - 2# * (z - 71)
Case Is <= 90: fTstd = 186.946
Case Is <= 95: fTstd = 186.946 + 0.2908 * (z - 90)
Case Is <= 100: fTstd = 188.4 + 1.34 * (z - 95)
Case Is <= 105: fTstd = 195.1 + 2.74 * (z - 100)
Case Is <= 110: fTstd = 208.8 + 6.24 * (z - 105)
Case Is <= 120: fTstd = 240 + 12 * (z - 110)
Case Else: fTstd = 360 + 12 * (z - 120)
End Select
End Function
Function fNumeric
Function fNumeric(ByVal X$) As Boolean
Dim i%, n%
' Checks if x$ is an unsigned integer number
For i = 1 To Len(X$)
n = Asc(Mid$(X$, i, 1))
If n < 48 Or n > 57 Then '0 thru 9
fNumeric = False
Exit Function
End If
Next i
fNumeric = True
End Function
Function fGCD
Function fGCD(LAT1!, LON1!, LAT2!, LON2!) As Single
' Calculate Great Circle Distance between two points in km
Dim D!
D = ACN(Sin(LAT1 * rpd) * Sin(LAT2 * rpd) + Cos(LAT1 * rpd) * Cos(LAT2 * rpd) * Cos((LON1 - LON2) * rpd))
fGCD = 1.852 * 60 * D / rpd 'km (1.852 km / nm, and 1 minute = 1 nm)
End Function
Function ACN
Function ACN(ByVal X!) As Single
' Take arccosine of a number (x!)
' Valid only for +- 90 degrees
Dim y!
If Abs(X) < 0.00001 Then
Select Case Sgn(X)
Case Is < 0: ACN = -Pi / 2
Case Else: ACN = Pi / 2
End Select
Else
ACN = Atn(Sqr(1 - X ^ 2) / X)
End If
End Function
NGV_Nav.bas
- Sub Decode2Bh
Sub Decode2Bh(Packet2Bh As String, n%, Status2Bh)
Dim i%, High!, Low!
' All 2Bh parameters are 2 bytes long and scaled
' T, P, TAS, pALT, DA, Roll, TH, B, Pitch,AA, SA, B, Wsd, Wdir, B, CC2
' 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
' Status Word 2 (deg)
High = Asc(Mid$(Packet2Bh, 32, 1)) ' Get High Byte
Low = Asc(Mid$(Packet2Bh, 33, 1)) ' Get Low Byte
CC2(n) = 256 * High + Low
' Check for valid status
Status2Bh = 1 'Good status word
Mask = 12392 '8 + 32 + 64 + 4096 + 8192
If Mask And CC2(n) < Mask Then Status2Bh = 0
' 1 T, 2 P, 3 TAS, 4 pALT, 5 DA, 6 Roll, 7 TH, 8 080-1
' 9 Pitch, 10 AA, 11 SA, 12 ADC, 13 Wind, 14 LSS, 15 DS, 16 080-1
' Outside air temperature (C)
OAT = fGetNo(Packet2Bh, 2) * 1024# / 32768#
' Pressure Altitude (meters)
pALT = fGetNo(Packet2Bh, 8)
' True Roll(deg)
Roll = fGetNo(Packet2Bh, 12) * 180# / 32768#
' True Heading (deg)
Heading = fGetNo(Packet2Bh, 14) * 180# / 32768#
' True Pitch (deg)
Pitch = fGetNo(Packet2Bh, 18) * 180# / 32768#
' Wind Speed (deg)
WindSpeed = fGetNo(Packet2Bh, 26) * 128# / 32768#
' Wind Direction (deg)
WindDir = fGetNo(Packet2Bh, 28) * 180# / 32768#
End Sub
Function fGetNo
Function fGetNo(Packet$, Index%)
Dim High%, Low%, Minus As Boolean
Minus = False
High = Asc(Mid$(Packet$, Index, 1)) ' Get High Byte
Low = Asc(Mid$(Packet$, Index + 1, 1)) ' Get Low Byte
' Take twos-complement of negative number if necessary
If (High And 128) Then
Minus = True
High = High - 128
End If
If Minus Then fGetNo = -1 * (High * 256 + Low) Else fGetNo = High * 256 + Low
End Function
Sub ReadNextFrame
Sub ReadNextFrame(NoData%)
Dim i%, j%
NoData = 0 '1 if not enough data in buffer
' Find 2Ah Packet
Call FindCode("&H2A")
' And read it
If MSComm1.InBufferCount > 46 Then
For j = 1 To 46
Packet2Ah = Packet2Ah + MSComm1.Input
Next j
Else
NoData = 1
Exit Sub
End If
' Find 2Bh Packet
EOFflag = False
For i = 1 To 5
FindCode ("&H2B")
If EOF(INPlu) Then EOFflag = True: Exit Sub
If MSComm1.InBufferCount > 32 Then
For j = 1 To 32
Packet2Bh(i) = Packet2Bh(i) + MSComm1.Input
Next j
Else
NoData = 1
Exit Sub
End If
Next i
End Sub
Sub Decode2Ah
Sub Decode2Ah(Packet2Ah$, Status2Ah%)
Dim char1 As String, char2 As String, High!, Low!
Dim Lat$, Lon$, Deg$, Min$, Mask%
' Read CpK(2),GMT(9),LAT(10),AA(2),LON(11),GS(5),TA(3),Zgps(2),CC1(2)
' 1-2 3-11 12-21 22-23 24-34 35-39 40-42 43-44 45-46
' Read Status Byte CC1
High = Asc(Mid$(Packet2Ah, 46, 1)) ' Get High Byte
Low = Asc(Mid$(Packet2Ah, 47, 1)) ' Get Low Byte
CC1 = 256 * High + Low
Mask = 294 ' 2 + 4 + 32 + 256
' Check status
Status2Ah = 1
If CC1 And Mask < Mask Then Status2Ah = 0
' Decode GMT
' HHMMSS$ = Mid$(Packet2Ah, 3, 9)
HHMMSS$ = Mid$(Packet2Ah, 3, 2) & ":" & Mid$(Packet2Ah, 5, 2) & ":" & Mid$(Packet2Ah, 7, 5)
UTks = 3.6 * Val(Mid$(Packet2Ah, 3, 2)) + 0.06 * Val(Mid$(Packet2Ah, 5, 2)) + Val(Mid$(Packet2Ah, 7, 5)) / 1000#
' Decode Latitude
Deg$ = Mid$(Packet2Ah, 13, 2)
Min$ = Mid$(Packet2Ah, 15, 7)
Latitude = Val(Deg$) + Val(Min$) / 60#
If Mid$(Packet2Ah, 12, 1) = "S" Then Latitude = -Latitude
' Skip reserved word AAh
' Read Longitude
Deg$ = Mid$(Packet2Ah, 25, 3)
Min$ = Mid$(Packet2Ah, 28, 7)
Longitude = Val(Deg$) + Val(Min$) / 60#
If Mid$(Packet2Ah, 24, 1) = "E" Then Longitude = -Longitude
' Read GPS Altitude
Zgps = fGetNo(Packet2Ah, 43)
txtZgps = Zgps
End Sub
Sub FindCode
Sub FindCode(Code%)
Dim Char$, CharCode%, LastCode%
EOFflag = False
If MSComm1.InBufferCount > 0 Then
CharCode = Asc(MSComm1.Input)
Else
NoComPortData = True
Exit Sub
End If
Do ' Loop until end of file.
LastCode = CharCode
If MSComm1.InBufferCount > 0 Then
CharCode = Asc(MSComm1.Input)
Else
MsgBox "There is no data on COM Port " + Str(COMport) + "!", vbOKOnly
NoComPortData = True
Exit Sub
End If
Loop Until EOF(INPlu) Or (CharCode = Code) 'LastCode = "&H10" And
End Sub
Physics.bas
- Function fAbsVsZp
Function fAbsVsZp(ch%, Zp!)
' Calculate Absorption Vs Zp based on fits in Efold.xls
' Note that USB and LSB used with freq offset of 0.2833 GHz
' And T was for US Standard Atmosphere
' Only valid from 10 to 22 km
' If Zp = 0# Then Exit Function
' Select Case ch
' Case 1 'Power Law fit was best R2=0.9803 from 10 to 22 km
' fAbsVsZp = 16.529 * Zp ^ (-1.3424)
' Case 2 'Power Law fit was best R2=0.9980 from 10 to 22 km
' fAbsVsZp = 27.947 * Zp ^ (-1.1928)
' Case 3 'Exponential fit was best R2=0.9945 from 10 to 22 km
' fAbsVsZp = 13.866 * Exp(-0.1301 * Zp)
' End Select
' New fits 0 to 50 km from O2absVsRH.xls
Select Case ch
Case 1 'Power Law fit was best R2=0.9803 from 10 to 22 km
fAbsVsZp = 1.3158 - 0.1493 * Zp + 0.007 * Zp ^ 2 - 0.0001 * Zp ^ 3 + 0.000001 * Zp ^ 4
Case 2 'Power Law fit was best R2=0.9980 from 10 to 22 km
fAbsVsZp = 2.1981 - 0.2004 * Zp + 0.0086 * Zp ^ 2 - 0.0002 * Zp ^ 3 + 0.000001 * Zp ^ 4
Case 3 'Exponential fit was best R2=0.9945 from 10 to 22 km
If Zp > 11 Then
fAbsVsZp = 1.2325 - 0.0166 * Zp + 0.0002 * Zp ^ 2 - 0.00005 * Zp ^ 3 + 0.0000003 * Zp ^ 4
Else
fAbsVsZp = 3.1476 - 0.1674 * Zp + 0.0032 * Zp ^ 2
End If
End Select
End Function
Sub FindXmin
Sub FindXmin(n1%, n2%, X!(), y!(), y1!, y2!, Xmin!, Ymin!)
' For a profile y vs x find value of y (Ymin) at which x is is minimum (Xmin)
' With the constraint that y must satisfy y1 <= y <= y2
Dim j%
Xmin = 10000000000#
For j = n1 To n2
If y(j) >= y1 And y(j) <= y2 Then 'Check that y is in required range
If X(j) < Xmin Then 'Check for new minimum
Xmin = X(j)
Ymin = y(j)
End If
End If
Next j
End Sub
Function fPtFromPsM
Function fPtFromPsM(Ps!, M!)
'Calculate Pt from Ps and Mach Number
Dim gamma!
gamma = cCp / cCv
fPtFromPsM = Ps * Exp((gamma / (gamma - 1)) * Log(1 + 0.5 * (gamma - 1) * M ^ 2))
End Function
Function fPsFromPtM
Function fPsFromPtM(pt!, M!)
'Calculate Pt from Ps and Mach Number
Dim gamma!
gamma = cCp / cCv
fPsFromPtM = pt / Exp((gamma / (gamma - 1)) * Log(1 + 0.5 * (gamma - 1) * M ^ 2))
End Function
Function fRHv
Function fRHv(ByVal V!, ByVal T!)
' Invert fRhoV (RH,T) to get RH from V and T
' V (g/m3), T (K)
fRHv = (T / fEs(T)) * (cRd / cEa) * V / 1000#
End Function
Function fTfromTheta
Function fTfromTheta(Th!, P!)
If P > 0 Then fTfromTheta = Th * (1000 / P) ^ -0.286 Else fTfromTheta = 999.9
End Function
Function fTsFromTtMR
Function fTsFromTtMR(Tt!, M!, r!)
'Calcuate Tt from Ts, Mach Number, and recovery factor
Dim gamma!
gamma = cCp / cCv
fTsFromTtMR = Tt / (1 + r * ((gamma - 1) / 2#) * M ^ 2)
End Function
Function fTtFromTsMR
Function fTtFromTsMR(Ts!, M!, r!)
'Calcuate Tt from Ts, Mach Number, and recovery factor
Dim gamma!
gamma = cCp / cCv
fTtFromTsMR = Ts * (1 + r * ((gamma - 1) / 2#) * M ^ 2)
End Function
Function fCalculate_Layer_Avg_T
Function fCalculate_Layer_Avg_T(z!(), T!(), Nr%, Zp!, Thickness!)
' Calculate the average temperature in atmospheric layer of Thickness centered on Zp
'
Dim ZpB!, zPT!, ib%, it%, i%, Tbot!, Ttop!, Tsum!, Zsum!
ZpB = Zp - Thickness / 2
zPT = Zp + Thickness / 2
i = 0 'RAOB index
ib% = 0 'RAOB bottom index
Do
ib = ib + 1
Loop Until z(ib) >= ZpB
ib = ib - 1
' Find RAOB top index
it = ib 'RAOB top index
Do
it = it + 1
Loop Until z(it) >= zPT Or it = Nr
Tbot = T(ib) + (T(ib + 1) - T(ib)) * (ZpB - z(ib)) / (z(ib + 1) - z(ib))
Ttop = T(it - 1) + (T(it) - T(it - 1)) * (zPT - z(it - 1)) / (z(it) - z(it - 1))
' Calculate layer average T
If it = ib + 1 Then 'No data points in layer
fCalculate_Layer_Avg_T = 0.5 * (Tbot + Ttop)
Else
Tsum = (T(ib + 1) + Tbot) * (z(ib + 1) - ZpB)
Zsum = (z(ib + 1) - ZpB)
For i = ib + 1 To it - 2
Tsum = Tsum + (T(i) + T(i + 1)) * (z(i + 1) - z(i))
Zsum = Zsum + (z(i + 1) - z(i))
Next i
Tsum = Tsum + (T(it - 1) + Ttop) * (zPT - z(it - 1))
Zsum = Zsum + (zPT - z(it - 1))
fCalculate_Layer_Avg_T = 0.5 * Tsum / Zsum
End If
End Function
Sub Calculate_MLS_Levels
Sub Calculate_MLS_Levels(Zmls!())
' mjm ... 20050214
' Calculate MLS L3 retrieval levels
' Zmls() is indexed from 0 to 48
' Even indices correspond to retrieval levels
' Odd indices correspond to levels between retrieval levels
' These are needed so that layer averaging of MTP profiles can be done
' See: http://auc.dfd.dlr.de/MLS/MLS_dataset.html#9.
' P(i) = 1000 x 10**(-i/6) mb, where i=0,1,2,...24
' P(i) = 1000 x 10**(-i/3) mb, where i=25, 29, ...36
' UARS retrievals 10-85 km (48 levels goes to 0.1 hPa = 65 km)
' Also: MTP_Retrieval_Levels.xls
Dim i%
For i = 0 To 48 'MLS levels 1 to 25 are even numbers
Zmls(i) = fPtoZ(1000# * 10# ^ (-i / 12#))
Next i
For i = 49 To 73
Zmls(i) = fPtoZ(1000# * 10# ^ (-i / 6#)) 'MLS levels 26 to 37 are even numbers
Next i
End Sub
Sub Calculate_TES_Levels
Sub Calculate_TES_Levels(Ztes!())
' mjm ... 20050214
' Calculate TES L3 retrieval levels
' Above 1000 hPa, P(i) = 1000 x 10**(-i/24) mb, where i=0,1,2,...37
' P(i) = 1000 x 10**(-i/3) mb, where i=25, 29, ...36
Dim i%
For i = 0 To 37 'MLS levels 1 to 25 are even numbers
Ztes(i) = fPtoZ(1000# * 10# ^ (-i / 24#))
Next i
End Sub
Sub Calculate_MLS_Profile
Sub Calculate_MLS_Profile(z!(), T!(), Nr%, Zmls!(), Tmls!(), Nmls%)
' Enter with T-profile
' Return with MLS profile, Zmls(), Tmls()
Dim i%, ib%, it%, j%, k%, L%, LB%, Lt%, Ttop!, Tbot!, Tsum!, Zsum!
Static Initialized As Boolean, Zm!(0 To 73)
If Not Initialized Then
Call Calculate_MLS_Levels(Zm()) 'Even numbers are MLS levels, Odd intermediate levels
Initialized = True 'Index 48 is 65 km = 0.0001 hPa
End If
For i = 1 To 37: Zmls(i) = 0#: Next i
' Find MLS inter-layer with RAOB data below it
i = 0 'RAOB index
ib% = 1 'RAOB bottom index
L = 0 'MLS out index
LB = -1 'Bottom inter-layer index
Do
LB = LB + 2
Loop Until Zm(LB) >= z(ib)
Do
ib = ib + 1
Loop Until z(ib) >= Zm(LB)
ib = ib - 1
Lt = LB + 2 'Top inter-layer index
' Find RAOB top index
it = ib 'RAOB top index
Do
it = it + 1
Loop Until z(it) >= Zm(Lt)
Tbot = T(ib) + (T(ib + 1) - T(ib)) * (Zm(LB) - z(ib)) / (z(ib + 1) - z(ib))
Ttop = T(it - 1) + (T(it) - T(it - 1)) * (Zm(Lt) - z(it - 1)) / (z(it) - z(it - 1))
' Calculate layer average T
Tsum = (T(ib + 1) + Tbot) * (z(ib + 1) - Zm(LB))
Zsum = (z(ib + 1) - Zm(LB))
For i = ib + 1 To it - 2
Tsum = Tsum + (T(i) + T(i + 1)) * (z(i + 1) - z(i))
Zsum = Zsum + (z(i + 1) - z(i))
Next i
Tsum = Tsum + (T(it - 1) + Ttop) * (Zm(Lt) - z(it - 1))
Zsum = Zsum + (Zm(Lt) - z(it - 1))
L = L + 1
Tmls(L) = 0.5 * Tsum / Zsum '(Zm(Lt) - Zm(Lb))
Zmls(L) = Zm(LB + 1)
Do
LB = Lt
Lt = LB + 2 'Top inter-layer index
' Find RAOB top index
If z(ib + 1) < Zm(Lt) Then 'Make sure there is a RAOB point in the layer
it = ib
Do
it = it + 1
Loop Until z(it) >= Zm(Lt)
End If
Tbot = T(ib) + (T(ib + 1) - T(ib)) * (Zm(LB) - z(ib)) / (z(ib + 1) - z(ib))
Ttop = T(it - 1) + (T(it) - T(it - 1)) * (Zm(Lt) - z(it - 1)) / (z(it) - z(it - 1))
' Calculate layer average T
If it - ib > 2 Then
Tsum = (T(ib + 1) + Tbot) * (z(ib + 1) - Zm(LB))
For i = ib + 1 To it - 2
Tsum = Tsum + (T(i) + T(i + 1)) * (z(i + 1) - z(i))
Next i
Tsum = Tsum + (T(it - 1) + Ttop) * (Zm(Lt) - z(it - 1))
Else
Tsum = (Tbot + Ttop) * (Zm(Lt) - Zm(LB))
End If
L = L + 1
Tmls(L) = 0.5 * Tsum / (Zm(Lt) - Zm(LB))
Zmls(L) = Zm(LB + 1)
Nmls = L
Debug.Print L; Zmls(L); Tmls(L)
ib = it - 1 'RAOB bottom index
Loop Until Zm(Lt + 2) > z(Nr)
End Sub
Function fET
Function fET(ByVal W!, ByVal T) As Single
Dim X!
' Equivalent Temperature
If T = 0 Then T = 300
X = (cLv * W) / (cCp * T)
If X < 50 Then
fET = T * Exp(X)
Else
fET = T
End If
End Function
Function fgnSMT
Function fgnSMT(Latitude!)
' Gravity vs Latitude from Smithsonian Meteorological Tables (page 488)
Dim Cos2L!
Cos2L = Cos(2 * Latitude * rpd)
fgnSMT = 9.80616 * (1 - 0.0026373 * Cos2L + 0.0000059 * Cos2L ^ 2)
End Function
Function fPypsometricEqn
Function fPypsometricEqn(ByVal T1!, ByVal p1!, ByVal T2!, ByVal dZg!) As Single
' Get pressure corresponding to an increase in geopotential height, dZg, above p1
' 1 is lower level, 2 is upper level
' dZg in km, p1 in hPa, and T in K
fPypsometricEqn = p1 * Exp(-2000# * cg * dZg / (cRd * (T1 + T2)))
End Function
Function fgS
Function fgS(ByVal phi!) As Single
' Somigliana's Equation for Normal Gravity on the surface of
' an ellipsoid of revolution
Dim sP!, cge!, E!, ks!
cge = 9.7803253359
E = 0.081819
ks = 0.001931853
sP = Sin(phi * rpd) ^ 2
fgS = cge * ((1 + ks * sP) / (Sqr(1 - E ^ 2 * sP)))
End Function
Function fHypsometricEqn
Function fHypsometricEqn(ByVal T1!, ByVal p1!, ByVal T2!, ByVal p2!) As Single
' Change in geopotential height (km) between pressure levels P1 and p2 (hPa/mb)
' with corresponding virtual temperatures T1 and T2 (K)
' cRd = 287.05307 'J /kg K Gas Constant (dry air)
' cg = 9.80665 'm /s2 Acceleration of gravity(surface)
'
fHypsometricEqn = cRd * (T1 + T2) * Log(p1 / p2) / cg / 2000 'Delta km
End Function
Function fMachNumber
Function fMachNumber(ByVal Ps!, ByVal pt!) As Single
Dim gamma!, X!
' Mach Number from static and total pressure
gamma = cCp / cCv
X = (2 / (gamma - 1)) * ((pt / Ps) ^ ((gamma - 1) / gamma) - 1)
If X >= 0 Then
fMachNumber = Sqr(X)
Else
fMachNumber = 0#
End If
End Function
Function fW
Function fW(RH!, P!, T!)
' Water Vapor Mixing Ratio, w (note is neither a volume or mass mixing ratio)
' p .... hPa
' T .... K
' RH ... %
Dim E!, q!
' paritial pressure of water vapor (hPa)
E = RH! * fEs(T) / 100#
' specific humidity (gm/gm), mass mixing ratio
q = cEa * E / (P - (1 - cEa) * E)
' Water Vapor Mixing ratio
fW = q / (1 - q)
End Function
Function fRtoT
Function fRtoT(ByVal Ohms!) As Single
Dim a1!, a2!, a3!, a4!
' Convert platinum resistance to temperature
'fRtoT = 5 * 10 ^ (-5) * Ohms ^ 2 + 0.4527 * Ohms - 239.23
' see T_vs_R.xls for fit from -100 C to +45 C
a1 = -239.529603289315
a2 = 0.450385127204133
a3 = 6.71883132179858E-05
a4 = -1.96781369379622E-08
fRtoT = a1 + a2 * Ohms + a3 * Ohms ^ 2 + a4 * Ohms ^ 3
End Function
Function fRphi
Function fRphi(phi!)
' Ad Hoc Radius based on Somigliana's Formula
' Rphi = -2 g(phi)/(d/d(g(phi)))
fRphi = 6378.137 / (1.006803 - 0.006706 * Sin(phi * rpd) ^ 2)
End Function
Function fZgToZghWGS
Function fZgToZghWGS(Zg!, Latitude!)
Dim r!
' Zg in km
' Latitude in deg
' Result in km
r = fRwgs(Latitude)
fZgToZghWGS = r * (fgnWGS(Latitude) / 9.80665) * (Zg / (r + Zg))
End Function
Function fRwgs
Function fRwgs(Latitude!)
' Unlike fRsmt this routine use Somigliana's normal gravity and WGS84
' R(phi)= a / (1 +f +mr -2 f sin(phi)^2)
' fRwgs in km
fRwgs = 6378.137 / (1.0068025972 - 0.0067056213 * Sin(Latitude * rpd) ^ 2)
End Function
Function fZghToZgSMT
Function fZghToZgSMT(Zgh!, Latitude!)
Dim r!
' Convert Zgh to Zg using Smithsonian Meteorological Tables
' See Eqn (13) at http://mtp.jpl.nasa.gov/notes/altitude/altitude.html
' Zgh in km
' Latitude in deg
' Result in km
r = fRsmt(Latitude)
fZghToZgSMT = r * Zgh / (fgnSMT(Latitude) * r / 9.80665 - Zgh)
End Function
Function fRsmt
Function fRsmt(ByVal Latitude!) As Single
' Smithsonian Meteorological Tables p.218 Equation 6
' Ginned up earth radius to compensate for centrifugal force
' variation with latitide
' Note that this is not the earth ellipsoid radius!!!
fRsmt = -2# * fgnSMT(Latitude) / fdgdzSMT(Latitude) / 1000#
End Function
Function fdgdzSMT
Function fdgdzSMT(Latitude!)
Dim Cos2L!, Cos4L!
' Rate of change of gravity with altitude
' From the Smithsonian Meteorological Tables p.218 Equation 7
' rpd = radians per degree = 1.74532925199433E-02
Cos2L = Cos(2 * rpd * Latitude)
Cos4L = Cos(4 * rpd * Latitude)
fdgdzSMT = -(3.085462 * 10 ^ (-6) + 2.27 * 10 ^ (-9) * Cos2L - 2 * 10 ^ (-12) * Cos4L)
End Function
Function fdgdzWGS
Function fdgdzWGS(Latitude!)
' R(phi) = a / (1 + f + mr - 2 f sin(phi)^2
' a = 6378.1370 km
' f = 1/298.257223563
' mr= omega^2 a^2 b / GM = 0.003449787
' GM= 3986004.418 10^8 m^3/s^2
' omega = 7292115.0 10^11 rad/s
fdgdzWGS = (-2# * fgnWGS(Latitude) / 6378137#) * (1.006802597 - 0.006705621 * Sin(Latitude * rpd) ^ 2)
End Function
Function fgnWGS
Function fgnWGS(Latitude!)
Dim SinL!
' Calculate gravity at specified latitude
' Using Somigliana's Equation
' GammaS = GammaE((1 + kS sin(latitude)^2)/(sqrt(1 - e^2 sin(latitude)^2)))
' GammaE = 9.7803253359 m/s2
' kS = 0.00190117
' e = 0.081819
'
SinL = Sin(Latitude * rpd)
fgnWGS = 9.7803253359 * (1 + 0.00193185265241 * SinL ^ 2) / Sqr(1 - (0.081819190842622 * SinL) ^ 2)
End Function
Function fgn
Function fgn(Latitude!)
Dim SinL!
' Same as fgnWGS
' Calculate gravity at specified latitude
' Using Somigliana's Equation
' GammaS = GammaE((1 + kS sin(latitude)^2)/(sqrt(1 - e^2 sin(latitude)^2)))
' GammaE = 9.7803253359 m/s2
' kS = 0.00190117
' e = 0.081819
'
SinL = Sin(Latitude * rpd)
fgn = 9.7803253359 * (1 + 0.00193185265241 * SinL ^ 2) / Sqr(1 - (0.081819190842622 * SinL) ^ 2)
End Function
Function fCs
Function fCs(Tk!) As Single
Dim gamma!
' Speed of sound at temperature Tk in Kelvin
fCs = Sqr((cCp / cCv) * cRd * Tk)
End Function
Function fDALR
Function fDALR() As Single
'cg ... gravity, m/s2
'cCp .. specific heat at constant pressure J/kg K
fDALR = 1000 * cg / cCp 'K/km
End Function
Function fDP
Function fDP(CASk!) As Single
' Pressure difference between pitot tube and static port for
' Indicated Air Speed IAS m/s
fDP = cPs * ((1 + 0.2 * (CASk / cCso) ^ 2) ^ (3.5) - 1)
End Function
Function fEs
Function fEs(ByVal Tk!) As Single
Dim dT!, es!, i%
Static A!(0 To 6), Init As Boolean, cTo!
'Water vapor saturation mixing ratio
'Tk in Kelvin, Es in mb
'See Flatau et al., 1992, J. App. Meteorol.,31,1507-1513.
If Not Init Then
A(0) = 6.1117675 'Saturation vapor pressure (hPa)
A(1) = 0.443986062
A(2) = 0.0143053301
A(3) = 0.000265027242
A(4) = 0.00000302246994
A(5) = 2.03886313E-08
A(6) = 6.38780966E-11
cTo = 273.15
Init = True
End If
dT = Tk - cTo
es = A(0)
For i = 1 To 6
es = es + A(i) * dT ^ i
Next i
fEs = es
End Function
Function fEsi
Function fEsi(ByVal Tk!) As Single
Dim dT!, es!, i%
Static A!(0 To 6), Init As Boolean, cTo!
'Tk in Kelvin, Esi, saturation vapor pressure over ice in mb
'See Flatau et al., 1992, J. App. Meteorol.,31,1507-1513.
If Not Init Then
A(0) = 6.10952665
A(1) = 0.501948366
A(2) = 0.0186288989
A(3) = 0.000403488906
A(4) = 0.00000539797852
A(5) = 4.20713632E-08
A(6) = 1.47271071E-10
cTo = 273.15
Init = True
End If
es = A(0)
dT = Tk - cTo
For i = 1 To 6
es = es + A(i) * dT ^ i
Next i
fEsi = es
End Function
Function fEv
Function fEv(ByVal RH!, ByVal T!) As Single
' Vapor pressure (mb) given RH (%) and T (K)
fEv = RH * fEs(T) / 100#
End Function
Function fEvs1
Function fEvs1(ByVal Tk!) As Single
' From J.M. Richards, J.Phys.D:Appl. Phys., 1971, Vol 4 L15-L18 and correction on p876 for first coefficient
' Evs [mb] = 1013.25 exp(EEW), where EEW= 13.3185 t -1.976 t^2 - 0.6445 t^3 - 0.1299 t^4, with t=1-373.15/T [K]
Dim Ts!, EEW!
Ts = 1 - 373.15 / Tk
EEW = 13.3185 * Ts - 1.976 * Ts ^ 2 - 0.6445 * Ts ^ 3 - 0.1299 * Ts ^ 4
fEvs1 = 1013.25 * Exp(EEW)
End Function
Function fEvsMB
Function fEvsMB(ByVal Tk!) As Single
Dim T!, E!
' From J.M. Richards, J.Phys.D:Appl. Phys., 1971, Vol 4 L15-L18 and correction on p876 for first coefficient
' Evs [mb] = 1013.25 exp(EEW), where EEW= 13.3185 t -1.976 t^2 - 0.6445 t^3 - 0.1299 t^4, with t=1-373.15/T [K]
T = 1 - 373.15 / Tk
E = (((0.1299 * T + 0.6445) * T + 1.976) * (-T) + 13.3185) * T
fEvsMB = 1013.25 * Exp(E)
End Function
Function fEvsGM3
Function fEvsGM3(TA!)
fEvsGM3 = (100000 / cRv) * (fEvsMB(TA) / TA)
End Function
Function fH2Oppmv
Function fH2Oppmv(ByVal TA!, ByVal PA!, ByVal RH!) As Single
' Calculate water vapor mixing ratio in ppmv
' From APCA Journal, 30 (4), April 1980, Gregory J McRae
fH2Oppmv = 10000 * RH * fEvsMB(TA) / PA
End Function
Function fLiv
Function fLiv(Tk!)
Dim T!
' T in Kelvin
T = Tk - cTo
fLiv = 2.8341 - 0.0003 * T - 0.000004 * T ^ 2
End Function
Function fLlv
Function fLlv(Tk!)
Dim T!
' T in Kelvin
T = Tk - cTo
fLlv = 2.502 - 0.0024 * T
End Function
Function fMach
Function fMach(ByVal z!, ByVal IAS!) As Single
' Mach number given z (km) and IAS (m/s)
fMach = Sqr(5 * ((fDP(IAS) / fZtoP(z) + 1#) ^ (2 / 7) - 1#))
End Function
Function fOATk
Function fOATk(ByVal IATk!, ByVal Mach!, ByVal r!) As Single
fOATk = IATk / (1# + 0.2 * r * Mach ^ 2)
End Function
Function fRH_TwTd
Function fRH_TwTd(ByVal Tw!, ByVal Td!) As Single
Dim Ew!, Ed!, Ea!
' Tw, Td in K, RH=%
' Calculate the saturation vapor pressure (E) for both the dry-bulb (Td) and wet-bulb (Tw) temperatures using the following equations:
' Ew = 0.61078 * Exp((17.269 * Tw) / (Tw + 237.3)) * 10 'Tw C
' Ed = 0.61078 * Exp((17.269 * Td) / (Td + 237.3)) * 10 '=Es, Td C
Ew = fEs(Tw)
Ed = fEs(Td)
' In the above equations the temperatures units ar26e Celsius and the saturation vapor pressure units are millibars.
' Then you need to calculate that actual vapor pressure (Ea) using the following equation:
Ea = Ew - 0.63 * (Td - Tw)
' Relative Humidity is then calculated using the following equation:
fRH_TwTd = (Ea / Ed) * 100
' The units of relative humidity are in percent.
' Here is an example of the using the equations:
' Assume that your dry-bulb temperature (Td) = 30 C and your wet-bulb temperature (Tw) = 26 C.
' Ew = 0.61078 * Exp((17.269 * 26) / (26 + 237.3)) * 10
' Ew = 33.61 millibars
' Ed = 0.61078 * Exp((17.269 * 30) / (30 + 237.3)) * 10
' Ed = 42.44 millibars
' Ea = 33.61 - 0.63 * (30 - 26)
' Ea = 31.09 millibars
' RH = (31.09 / 42.44) * 100
' RH = 73.3 %
End Function
Function fRhoV
Function fRhoV(ByVal RH!, ByVal T!) As Single
' Vapor density (gm/m3) given RH (%) and T (K)
' Using ideal gas law
If T = 0 Then T = 273.15
fRhoV = 100000 * cEa * fEv(RH, T) / (cRd * T)
End Function
Function fRhoVvmr
Function fRhoVvmr(P!, T!, VMR!)
' Calculate the vapor density at p and T assuming a volume mixing ratio VMR
' VMR in gm/kg, p in mb and T in K,
fRhoVvmr = (VMR * P * 100000) / (cRv * T) 'gm/m3
End Function
Function fRHw
Function fRHw(P!, T!, W!)
fRHw = (100 / fEs(T)) * W * P / (W + cEa)
End Function
Function fSAT
Function fSAT(ByVal Tt!, ByVal M!) As Single
fSAT = Tt / (1 + ((cCp / cCv - 1) / 2) * M ^ 2)
End Function
Function fTAS
Function fTAS(ByVal Tr!, ByVal M!) As Single
Dim gamma!
gamma = cCp / cCv
fTAS = M * Sqr(gamma * cRd * Tr / (1 + (gamma - 1) * M ^ 2 / 2))
End Function
Function ftest
Function ftest(Zgh!, Latitude!)
Dim CL
CL = Cos(2 * Latitude * 3.14159 / 180)
ftest = (1 + 0.002644 * CL) * Zgh + (1 + 0.0089 * CL) * Zgh ^ 2 / 6245
End Function
Function fTevs
Function fTevs(ByVal evs!) As Single
Dim T1!, TN!, tnp1!
' es in mb
' Find Td
T1 = Log(evs / 1013.25) / 13.3185
tnp1 = T1 + ((0.1299 * T1 + 0.6445) * T1 + 1.976) * T1 ^ 2 / 13.3185
Do
TN = tnp1
tnp1 = T1 + ((0.1299 * TN + 0.6445) * TN + 1.976) * TN ^ 2 / 13.3185
Loop Until tnp1 - TN < 0.00000000001
fTevs = 373.15 / (1 - tnp1)
End Function
Function FTD
Function FTD(W!, P!)
'B = 5420 'K
'A = 253000000# 'kPa
End Function
Function ABS_H2O
Function ABS_H2O(ByVal T!, ByVal P!, ByVal VD!, ByVal f!) As Single
'
' PURPOSE- COMPUTE ABSORPTION COEF IN ATMOSPHERE DUE TO WATER VAPOR
'
' CALLING SEQUENCE PARAMETERS-
' SPECIFICATIONS
' NAME UNITS I/O DESCRIPTON VALID RANGE
' T KELVIN I TEMPERATURE
' P MILLIBAR I PRESSURE .1 TO 1000
' VD G/M**3 I WATER VAPOR DENSITY
' F GHZ I FREQUENCY 0 TO 800
' ABS_H2O NEPERS/KM O ABSORPTION COEFFICIENT
'
' REFERENCES-
' P.W. ROSENKRANZ, RADIO SCIENCE V.33, PP.919-928 (1998).
'
' LINE INTENSITIES SELECTION THRESHOLD = HALF OF CONTINUUM ABSORPTION AT 1000 MB.
' WIDTHS MEASURED AT 22,183,380 GHZ, OTHERS CALCULATED.
' A.BAUER ET AL. ASA WORKSHOP (SEPT. 1989) (380GHz).
'
' REVISION HISTORY-
' DATE- OCT.6, 1988 P.W.ROSENKRANZ - EQS AS PUBL. IN 1993.
' OCT.4, 1995 PWR- USE CLOUGH'S DEFINITION OF LOCAL LINE
' CONTRIBUTION, HITRAN INTENSITIES, ADD 7 LINES.
' OCT. 24, 95 PWR -ADD 1 LINE.
' JULY 7, 97 PWR -SEPARATE COEFF. FOR SELF-BROADENING,
' REVISED CONTINUUM.
' DEC. 11, 98 PWR - ADDED COMMENTS
'
' LOCAL VARIABLES:
Dim NLINES%, i%, j%
NLINES = 15
Dim df!(1 To 2)
Static S1!(1 To 15), b2!(1 To 15), W3!(1 To 15), FL!(1 To 15), X!(1 To 15), WS(1 To 15), XS(1 To 15)
Static Init
Dim Pvap!, Pda!, den!, Ti!, TI2!, Sum!, Width!, WSQ!, s!, BASE!, RES!, CON!
' LINE FREQUENCIES:
If Init = 0 Then
FL(1) = 22.2351: FL(2) = 183.3101: FL(3) = 321.2256: FL(4) = 325.1529: FL(5) = 380.1974
FL(6) = 439.1508: FL(7) = 443.0183: FL(8) = 448.0011: FL(9) = 470.889: FL(10) = 474.6891
FL(11) = 488.4911: FL(12) = 556.936: FL(13) = 620.7008: FL(14) = 752.0332: FL(15) = 916.1712
' LINE INTENSITIES AT 300K:
S1(1) = 1.31E-14: S1(2) = 0.000000000002273: S1(3) = 8.036E-14: S1(4) = 0.000000000002694: S1(5) = 0.00000000002438
S1(6) = 0.000000000002179: S1(7) = 4.624E-13: S1(8) = 0.00000000002562: S1(9) = 8.369E-13: S1(10) = 0.000000000003263
S1(11) = 6.659E-13: S1(12) = 0.000000001531: S1(13) = 0.00000000001707: S1(14) = 0.000000001011: S1(15) = 0.00000000004227
' T COEFF. OF INTENSITIES:
b2(1) = 2.144: b2(2) = 0.668: b2(3) = 6.179: b2(4) = 1.541: b2(5) = 1.048
b2(6) = 3.595: b2(7) = 5.048: b2(8) = 1.405: b2(9) = 3.597: b2(10) = 2.379
b2(11) = 2.852: b2(12) = 0.159: b2(13) = 2.391: b2(14) = 0.396: b2(15) = 1.441
' AIR-BROADENED WIDTH PARAMETERS AT 300K:
W3(1) = 0.00281: W3(2) = 0.00281: W3(3) = 0.0023: W3(4) = 0.00278: W3(5) = 0.00287
W3(6) = 0.0021: W3(7) = 0.00186: W3(8) = 0.00263: W3(9) = 0.00215: W3(10) = 0.00236
W3(11) = 0.0026: W3(12) = 0.00321: W3(13) = 0.00244: W3(14) = 0.00306: W3(15) = 0.00267
' T-EXPONENT OF AIR-BROADENING:
X(1) = 0.69: X(2) = 0.64: X(3) = 0.67: X(4) = 0.68: X(5) = 0.54
X(6) = 0.63: X(7) = 0.6: X(8) = 0.66: X(9) = 0.66: X(10) = 0.65
X(11) = 0.69: X(12) = 0.69: X(13) = 0.71: X(14) = 0.68: X(15) = 0.7
' SELF-BROADENED WIDTH PARAMETERS AT 300K:
WS(1) = 0.01349: WS(2) = 0.01491: WS(3) = 0.0108: WS(4) = 0.0135: WS(5) = 0.01541
WS(6) = 0.009: WS(7) = 0.00788: WS(8) = 0.01275: WS(9) = 0.00983: WS(10) = 0.01095
WS(11) = 0.01313: WS(12) = 0.0132: WS(13) = 0.0114: WS(14) = 0.01253: WS(15) = 0.01275
' T-EXPONENT OF SELF-BROADENING:
XS(1) = 0.61: XS(2) = 0.85: XS(3) = 0.54: XS(4) = 0.74: XS(5) = 0.89
XS(6) = 0.52: XS(7) = 0.5: XS(8) = 0.67: XS(9) = 0.65: XS(10) = 0.64
XS(11) = 0.72: XS(12) = 1#: XS(13) = 0.68: XS(14) = 0.84: XS(15) = 0.78
Init = 1
End If
If VD <= 0# Then ABS_H2O = 0#: Exit Function
Pvap = VD * T / 217#
Pda = P - Pvap
den = 3.335E+16 * VD
Ti = 300# / T
TI2 = Ti ^ 2.5
' CONTINUUM TERMS
CON = (0.000000000543 * Pda * Ti ^ 3 + 0.000000018 * Pvap * Ti ^ 7.5) * Pvap * f * f
' ADD RESONANCES
Sum = 0#
For i = 1 To NLINES
Width = W3(i) * Pda * Ti ^ X(i) + WS(i) * Pvap * Ti ^ XS(i)
WSQ = Width * Width
s = S1(i) * TI2 * Exp(b2(i) * (1# - Ti))
df(1) = f - FL(i)
df(2) = f + FL(i)
' USE CLOUGH'S DEFINITION OF LOCAL LINE CONTRIBUTION
BASE = Width / (562500# + WSQ)
' DO FOR POSITIVE AND NEGATIVE RESONANCES
RES = 0#
For j = 1 To 2
If Abs(df(j)) < 750# Then RES = RES + Width / (df(j) ^ 2 + WSQ) - BASE
Next j
Sum = Sum + s * RES * (f / FL(i)) ^ 2
Next i
ABS_H2O = 0.00003183 * den * Sum + CON
End Function
Function ABS_N2
Function ABS_N2(ByVal T!, ByVal P!, ByVal f!)
'ABSN2 = ABSORPTION COEFFICIENT DUE TO NITROGEN IN AIR (NEPER/KM)
' T = TEMPERATURE (K)
' P = PRESSURE (MB)
' F = FREQUENCY (GHZ)
'
Dim Th!
Th = 300# / T
ABS_N2 = 0.000000000000064 * P * P * f * f * Th ^ 3.55
End Function
Function ABS_LIQ
Function ABS_LIQ(ByVal T!, ByVal VD!, ByVal f!) As Single
' COMPUTES ABSORPTION IN NEPERS/KM BY SUSPENDED WATER DROPLETS
' ARGUMENTS (INPUT):
' VD IN G/M**3
' F IN GHZ (VALID FROM 0 TO 1000 GHZ)
' T IN KELVIN
'
' REFERENCES:
' LIEBE, HUFFORD AND MANABE, INT. J. IR & MM WAVES V.12, pp.659-675
' (1991); Liebe et al, AGARD Conf. Proc. 542, May 1993.
'
' REVISION HISTORY:
' PWR 8/3/92 original version
' PWR 12/14/98 temp. dependence of EPS2 eliminated to agree with MPM93
'
' COMPLEX EPS,RE
Dim EPS0!, EPS1!, EPS2!, c1!, c2!, D1!, D2!, FP!, FS!, Theta1!, A!, b!
If (VD <= 0#) Then ABS_LIQ = 0#: Exit Function
Theta1 = 1# - 300# / T
EPS0 = 77.66 - 103.3 * Theta1
EPS1 = 0.0671 * EPS0
EPS2 = 3.52
FP = (316# * Theta1 + 146.4) * Theta1 + 20.2
FS = 39.8 * FP
c1 = EPS0 - EPS1
c2 = EPS1 - EPS2
D1 = 1 + (f / FP) ^ 2
D2 = 1 + (f / FS) ^ 2
A = c1 / D1 + c2 / D2 + EPS2
b = (c1 / D1) * (f / FP) + (c2 / D2) * (f / FS)
' EPS = (EPS0 - EPS1) / CMPLX(1#, f / FP) + (EPS1 - EPS2) / CMPLX(1#, f / FS) + EPS2
' Re = (EPS - 1#) / (EPS + 2#)
' ABS_LIQ = -0.06286 * AIMAG(RE) * f * VD
' AIMAG = imaginary part of Complex number
ABS_LIQ = 0.06286 * f * VD * 3# * b / ((A + 2) ^ 2 + b ^ 2)
End Function
Function ABS_TOT
Function ABS_TOT(ByVal T!, ByVal P!, ByVal RhoV!, ByVal RhoL!, ByVal f!, ByRef flag() As Boolean) As Single
ABS_TOT = 0#
If flag(1) Then ABS_TOT = ABS_O2(T!, P!, RhoV!, f!)
If flag(2) Then ABS_TOT = ABS_TOT + ABS_N2(T!, P!, f!)
If flag(3) Then ABS_TOT = ABS_TOT + ABS_H2O(T!, P!, RhoV!, f!)
If flag(4) Then ABS_TOT = ABS_TOT + ABS_LIQ(T!, RhoL!, f!)
End Function
Function fDstd
Function fDstd(z!) As Single
' Calculate density of 1976 Standard Atmosphere
' Input z ......... km
' Output Density ... kg/m3
fDstd = 100 * fZtoP(z) / (fTstd(z) * cRs)
End Function
Function fFusb
Function fFusb(ByVal T!, ByVal P!, ByVal VD!, ByVal f!) As Single
Dim Tau1!, Tau2!, df!, Fusb!, i%, dFscale!
' Find USB F which has same absorption as LSB F
Tau1 = ABS_O2(T, P, VD, f)
Fusb = 61 + (61 - f)
df = 0.001
i = 0
If f > 54 Then dFscale = 1 Else dFscale = 10 'Make bigger f steps in low opacity
Do
i = i + 1
Tau2 = ABS_O2(T, P, VD, Fusb)
Select Case Abs(Tau2 - Tau1)
Case Is < 0.001: df = 0.0001 * dFscale
Case Is < 0.01: df = 0.001 * dFscale
Case Is < 0.1: df = 0.01 * dFscale
Case Is < 1: df = 0.1 * dFscale
Case Else: df = 1 * dFscale
End Select
If Tau2 < Tau1 Then Fusb = Fusb - df Else Fusb = Fusb + df
DoEvents
Loop Until Abs(Tau1 - Tau2) < 0.0001
fFusb = Fusb
End Function
Function fGeoidRadius
Function fGeoidRadius(LatDeg!)
' Calculate radius of WGS-84 Geoid in km
Dim rLat!
If LatDeg = 90 Then
fGeoidRadius = cRep / 1000# 'km
Else
rLat = LatDeg * rpd
fGeoidRadius = (cRee * cRep * Sqr((1 + Tan(rLat) ^ 2) / (cRep ^ 2 + cRee ^ 2 * Tan(rLat) ^ 2))) / 1000#
End If
End Function
Function fGeoPot
Function fGeoPot(Z1!, Z2!, Lat!, EPS!)
' Calculate geopotential height form z1 to z2 at latitude (Lat) to precision EPS
' Integral from 0 to Z of g(z) dz / 9.8
' MJ Mahoney 19990517
Dim SinL2!, gn!, jmax%, j%, n%, it%, i%
Dim s!, os!, ost!, st!, DeltaZ!, Sum!, TNM!, z!
' First calculate surface gravity at Lat
' SinL2 = Sin(Lat * RpD) ^ 2
' gn = 9.7803185 * (1 + 0.005278895 * SinL2 - 0.000023462 * SinL2 ^ 2)
gn = fgnSMT(Lat)
' Now implement QSIMP from Numerical Recipes
jmax = 20
ost = -1E+30
os = -1E+30
For j = 1 To jmax
GoSub trapzd
s = (4# * st - ost) / 3#
If (Abs(s - os) < EPS * Abs(os)) Then fGeoPot = s / 9.8: Exit Function
If (s = 0# And os = 0# And j > 6) Then fGeoPot = s / 9.8: Exit Function
os = s
ost = st
Next j
Call MsgBox("Too many steps in qsimp", vbOKOnly)
Exit Function
trapzd:
If j = 1 Then
' s = 0.5 * (Z2 - Z1) * (2# * gn - 0.003086 * (Z1 + Z2))
st = (Z2 - Z1) * gn - 0.001543 * (Z2 * Z2 - Z1 * Z1)
Else
it = 2 ^ (j - 2)
TNM = it
DeltaZ = (Z2 - Z1) / TNM
z = Z1 + 0.5 * DeltaZ
Sum = 0#
For i = 1 To it
Sum = Sum + gn - 0.003086 * z
z = z + DeltaZ
Next i
st = 0.5 * (st + (Z2 - Z1) * Sum / TNM)
End If
Return
End Function
Function fVToR
Function fVToR(Volts!, Src$)
'DC8 Platinum Resistor Calibration
Select Case Src$
Case "Ttgt1": fVToR = 77.301 * Volts + 289.93
Case "Ttgt2": fVToR = 77.453 * Volts + 288.66
Case "Twin": fVToR = 77.434 * Volts + 291.57
End Select
End Function
Function fZghToZgSMT98
Function fZghToZgSMT98(Zgh!, Latitude!)
Dim r!
' Same as SMT with g=9.8
r = fRsmt(Latitude)
fZghToZgSMT98 = r * Zgh / (fgnSMT(Latitude) * r / 9.8 - Zgh)
End Function
Function fZgZpDiffRAOB
Function fZgZpDiffRAOB(P!(), Zh!(), Nlevr%, Latitude!, Zpr!, FirstPass As Boolean)
' Calculate Zg-Zp at a specified pressure altitude Zpr give RAOB P(), Zh() and Latitude
' Enter with:
' P() .... RAOB pressure profile
' Zh() ... RAOB Geopotential Height (km)
' Nlevr .. Number of RAOB levels
' Zp ... Pressure Altitude (km) at which Zg-Zp is needed
' Latitude ... Latitude at which difference is required
' FirstPass .. if TRUE calculate Zp() profile, if FALSE use static Zp() profile
' Return with Zg-Zp at Zp
Dim i%, Zg1!, Zg2!, Zp1!, Zp2!
Static Zp!()
If FirstPass Then 'Convert RAOB pressure profile to Zp() profile
ReDim Zp(1 To Nlevr)
For i = 1 To Nlevr
Zp(i) = fPtoZ(P(i))
Next i
End If
' Find first Zp() level above Zp
i = 0
Do
Loop Until Zp(i) > Zpr 'Zpr is pressure altitude at which Zg in needed
Zp1 = Zp(i - 1) 'Lower Zp
Zp2 = Zp(i) 'Upper Zp
' Geopotential height Zh() and pressure altitude Zp() levels have same index
Zg1 = fZghToZgSMT(Zh(i - 1), Latitude) 'Lower Zh level converted to Zg
Zg2 = fZghToZgSMT(Zh(i), Latitude) 'Upper Zh level converted to Zg
fZgZpDiffRAOB = Zg1 + (Zpr - Zp1) * (Zg2 - Zg1) / (Zp2 - Zp1)
End Function
Function fZhToZg
Function fZhToZg(Zgh!, Latitude!)
Dim r!
' This conversion differs from fZhToZgSMT in two ways:
' Somigliana's Normal Gravity is used instead of the SMT value (differ by parts in 10^6)
' 9.80665 is used for gravity at 45 degress, rather than 9.8
r = fRwgs(Latitude)
fZhToZg = r * Zgh / (fgS(Latitude) * r / 9.80665 - Zgh)
End Function
Function fZgToZgh
Function fZgToZgh(Zg!, Latitude!)
' Convert geometric altitude to geopotential height
' Zg ........ geometric altitude (km)
' Latitude .. degrees
' Return .... geopotential height
Dim r!
r = fRwgs(Latitude)
fZgToZgh = (fgnWGS(Latitude) * r / 9.80665) * (Zg / (Zg + r))
End Function
Function fIntHE
Function fIntHE(ByVal g0!, ByVal T0!, ByVal LR0!, ByVal P0!, ByVal P!) As Single
' Integrate Hydrostatic Equation from a point Z0, T0, P0 to a point P
' Assuming a fixed lapse rate LR0 from the P0 to P
' g0 .... accelertion of gravity at altitude and latitude of integration
' PO ... initial pressure in mb
' T0 ... virtual temperature at initial point
' LRO ... constant lapse rate from PO to P
' P ... end point of integration
' Function returns DeltaZ in km from P0 to P
' Written: MJM 19990507
' cRd the gas constant for dry air = 287.05307 J /kg K
' cg the acceleration of gravity = 9.80665 m /s2
If LR0 = 0 Then
' fIntHE = - (cRd * T0 / (cg * 1000#)) * Log(P / P0)
' fIntHE = - 2.92712669464088E-02 * T0 * Log(P / P0) 'fixed g
fIntHE = -0.28705307 * T0 * Log(P / P0) / g0 'allow g to vary
Else
' fIntHE = + (T0 / LR0) * (1# - (P / P0) ^ (-cRd * LR0 / (cg * 1000#)))
' fIntHE = - (T0 / LR0) * (1# - (P / P0) ^ (-2.92712669464088E-02 * LR0))
fIntHE = -(T0 / LR0) * (1# - (P / P0) ^ (-0.28705307 * LR0 / g0))
End If
End Function
Function fNDmj
Function fNDmj(ByVal RH!, ByVal P!, ByVal T!) As Single
Dim Tv!
' RH %, P [mb], T [K]
Tv = fTv(RH, P, T)
fNDmj = 100 * P * cAo / (cRd * Tv * Cmd)
End Function
Function fPressure
Function fPressure(ByVal pt!, ByVal T!) As Single
' Find pressure given PT and T
fPressure = 1000# * (T / pt) ^ (3.4965035)
End Function
Function fStandardDensity
Function fStandardDensity(ByVal Imonth%, ByVal pALT!, ByVal Latitude!) As Single
Dim lu%, Filename$, iLAT%, Line1$, Line2$, iZ%
Dim Rho1!, Rho2!, x1!, x2!, f!, i%, j%
Static NDPmonth%, Rho!(0 To 25, 0 To 13)
' Only read file if month has changed
If NDPmonth <> Imonth Then
NDPmonth = Imonth
Filename$ = "C:\MTP\Setup\DENSITY\Std_Atm_Den." + Format(Imonth, "000")
lu = FreeFile
Open Filename$ For Input As lu
'Skip two header lines
Input #lu, Line1$
Input #lu, Line1$
' Reference Atmosphere Density (kg/m**3) Month= 4
' -90. -75. -60. -45. -30. -15. 0. 15. 30. 45. 60. 75. 90.
' 0. 1.39810 1.33850 1.27950 1.24740 1.20630 1.18160 1.17160 1.18570 1.21130 1.26780 1.31160 1.38840 1.42970
' 1 2 3 4 5 6 7 8 9 1 7
'12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
' 1234567812345678
' 2. 1.06170 1.04250 1.02400 1.01220 0.98598 0.96775 0.96565 0.97223 0.98903 1.01170 1.03750 1.06350 1.07450
' 4. 0.84294 0.83111 0.81419 0.81810 0.80015 0.79044 0.78992 0.79159 0.80172 0.81340 0.81648 0.84225 0.84831
' 6. 0.66221 0.66134 0.65407 0.65738 0.64897 0.64133 0.64096 0.64388 0.64947 0.65615 0.65709 0.66274 0.66313
' 8. 0.51425 0.51955 0.51931 0.52270 0.52471 0.51764 0.51728 0.52202 0.52446 0.52336 0.52213 0.51557 0.51285
'10. 0.37877 0.38648 0.40696 0.41081 0.41912 0.41790 0.41737 0.41823 0.41832 0.41224 0.39711 0.37924 0.37669
' ...
'50 ....last line
For i = 0 To 25
For j = 0 To 13
Input #lu, Rho(i, j)
Next j
Next i
Close lu
End If
For i = 1 To 13
If -90 + (i - 1) * 15 >= Latitude Then Exit For
Next i
iLAT = i - 1 'Lower latitude
' Bracket altitude [km]
iZ = Int(Abs(pALT) / 2) 'Lower altitude
' Interpolate in Latitude
f = 1 + (Latitude + 90) / 15 - iLAT
Rho1 = (1 - f) * Rho(iZ, iLAT) + f * Rho(iZ, iLAT + 1)
Rho2 = (1 - f) * Rho(iZ + 1, iLAT) + f * Rho(iZ + 1, iLAT + 1)
'Interpolate in altitude
f = (pALT / 2 - iZ)
fStandardDensity = (1# - f) * Rho1 + f * Rho2
End Function
Function fRhoVsjk
Function fRhoVsjk(RH!, Tk!)
Dim Tc!
Tc = Tk - cTo 'Temperature in Celcius
fRhoVsjk = 2.17 * (RH / Tk) * 10 ^ ((26# + Tc) / 33# + ((Tc - 7#) / 90#) ^ 2) ' Vapor density [g/m3]
End Function
Function fTB
Function fTB(El!, T!(), Tau!(), Levels%)
' This routine allows TB calculations for different Elevation angles and fixed Tau(i,j) array
Dim j%, jm1%, Sum#, SinEL!
SinEL = Sin(El * Pi / 180#)
Sum = 0#
For j = 2 To Levels
Sum = Sum + (T(jm1) + T(j)) * (Exp(-Tau(jm1) / SinEL) - Exp(-Tau(j) / SinEL))
Next j
If El >= 0 Then
fTB = 0.5 * Sum + 2.75 * Exp(-Tau(Levels) / SinEL) 'Add CMB
Else
fTB = 0#
End If
End Function
Function fTBraob
Function fTBraob(f!, E!, zo!, z!(), T!(), RhoV!(), RhoL!(), BI!, Nlev%, EnableAbs() As Boolean)
Dim dP!, Pstep!, Zmax!, RsinE!, P!, r!, DeltaTB!, Levels%
Dim i%, j%, jm1%, jm%, Done As Boolean, DeltaZ!, SumZ!, SumP!, RhoVj!, RhoVjm1!
Dim Tjm1!, Tj!, Zjm1!, Zj!, PAjm1!, PAj!, Kjm1!, Kj!, Taujm1!, Tauj!, RhoLj!, RhoLjm1!
Dim Sum!
' Note that z is geometric altitude, but that pressure steps use pressure altitude
' This needs to be fixed!!!!
If E = 0 Then fTBraob = T(1): Exit Function
RsinE = 1 / Sin(E * 3.14159 / 180)
' Create equal steps in Ln(P) to 50 km
Levels = 200
If zo = z(1) Then
Zjm1 = z(1)
Tjm1 = T(1)
P = fZtoP(z(1))
RhoVjm1 = RhoV(1)
RhoLjm1 = RhoL(1)
Else
Zjm1 = zo
Tjm1 = fLinterp(z(), T(), Nlev, zo)
P = fZtoP(zo)
RhoVjm1 = fLinterp(z(), RhoV(), Nlev, zo)
RhoLjm1 = fLinterp(z(), RhoL(), Nlev, zo)
End If
Kjm1 = ABS_TOT(Tjm1, P, RhoVjm1, RhoLjm1, f, EnableAbs())
If Kjm1 = 0 Then Zmax = 30 Else Zmax = 20 / Kjm1 / RsinE 'Integrate to 5 optical depths
dP = P - fZtoP(Zjm1 + Zmax)
Pstep = dP / Levels 'Pressure step in zenith direction
Sum = 0#
Taujm1 = 0#
For j = 2 To Levels
P = P - Pstep
Zj = fPtoZ(P)
Tj = fLinterp(z(), T(), Nlev, Zj)
RhoVj = fLinterp(z(), RhoV(), Nlev, Zj)
RhoLj = fLinterp(z(), RhoL(), Nlev, Zj)
Kj = ABS_TOT(Tj, P, RhoVj, RhoLj, f, EnableAbs())
Tauj = Taujm1 + 0.5 * (Kj + Kjm1) * (Zj - Zjm1) * RsinE
Sum = Sum + (Tjm1 + Tj) * (Exp(-Taujm1) - Exp(-Tauj))
Tjm1 = Tj: Zjm1 = Zj: Kjm1 = Kj: Taujm1 = Tauj
Next j
fTBraob = 0.5 * Sum + 2.75 * Exp(-Tauj) 'Add CMB
End Function
Function fTdTaToRH
Function fTdTaToRH(TA!, Td!, Celsius As Boolean)
'Ta is ambient temperature [C]
'Td is dew point temperature [C]
'RH is in percent
Dim es!, E!
If Td = 0 Then fTdTaToRH = 0#: Exit Function
If Celsius Then
es = 6.11 * (10# ^ (7.5 * TA / (237.7 + TA)))
E = 6.11 * (10# ^ (7.5 * Td / (237.7 + Td)))
Else 'assume Kelvin
es = 6.11 * (10# ^ (7.5 * (TA - cTo) / (TA - 35.45)))
E = 6.11 * (10# ^ (7.5 * (Td - cTo) / (Td - 35.45)))
End If
fTdTaToRH = (E / es) * 100#
End Function
Function fTvirtual50!
Function fTvirtual50!(T!)
If T < 170 Or T > 320 Then
fTvirtual50 = 300
Else
fTvirtual50 = T + 10 ^ (0.0365 * (T - 283)) 'BLG fit at RH=50%
End If
End Function
Function fNumberDensity
Function fNumberDensity(ByVal P!, ByVal T!) As Single
Dim M!
' P [mb], T [K]
If T < 170 Or T > 330 Then T = 300
M = 28.97 * (1 - 10 ^ (0.034 * (T - 355))) 'g at 10 km
fNumberDensity = 348 * (P / T) * 6.023E+23 / M
End Function
Function fND
Function fND(ByVal P!, ByVal T!) As Single
Dim M!
' Number density from pressure and temperature
M = 28.97 * (1 - 10 ^ (0.034 * (T - 355))) 'g at 10 km
fND = 348 * (P / T) * 6.023E+23 / M
End Function
Function fRhoLabs
Function fRhoLabs(ByVal LWC!, ByVal T!, ByVal Nu!) As Single
' Calculate liquid water absorption in Np/km
' LWC [g/m3], T [K], Nu [GHz]
fRhoLabs = 0.075 * LWC * (280 / T) ^ 6.87 * (Nu / 22.2) ^ 1.9
End Function
Function Calc_TB
Function Calc_TB(Elevation!, Zoff!, Tsurface!, LapseRate!, StandardT As Boolean, Ztrop!, RhoVsurface!, CM%, Zbase!, Ztops!, Nu!, EPS!)
Dim OldS!, j%, jmax%, s!, k%, AlphaO2!, AlphaLH2O!
Dim TNM%, Sum!, Wsum!, r!, DEL!, r1!, r2!, Wr!, LWC!
Dim Tr!, Pr!, RhoVr!, z!, Absorption!, dR!, it%, rstep%
' First calculate absorption at zero elevation
Tr = fTatZ(Zoff, Tsurface, LapseRate, Ztrop, StandardT)
Pr = fZtoP(Zoff)
RhoVr = RhoVsurface * Exp(-Zoff / 2#)
Absorption = O2ABS(Tr, Pr, RhoVr, Nu)
r1 = 0: r2 = 5 / Absorption 'Range = 5 optical depths
dR = r2 - r1
jmax = 20
OldS = 1E-30
it = 1
LWC = 0
AlphaO2 = O2ABS(Tr, Pr, RhoVr, Nu)
AlphaLH2O = fRhoLabs(LWC, Tr, Nu)
s = Tr * WtFunction(r1, AlphaO2, AlphaLH2O) * dR
For j = 1 To jmax
' This is Trapezoidal integration routine
TNM = it
rstep = dR / TNM
r = r1 + rstep / 2
Wsum = 0#
Sum = 0#
For k = 1 To it
' Calculate applicable altitude, Z
z = Zoff + r * Sin(Elevation * mPI / 180)
' Calculate T, P, RhoV, and LWC at Z
Tr = fTatZ(z, Tsurface, LapseRate, Ztrop, StandardT)
Pr = fZtoP(z)
RhoVr = RhoVsurface * Exp(-z / 2#)
' Determine Cloud Model to use
Select Case CM
Case 0
LWC = 0
Case 1
If z > Zbase And z < Ztops Then
LWC = 0.5 * (RhoVsurface * Exp(-Zbase / 2#) - RhoVsurface * Exp(-z / 2#)) 'g/m3
Else
LWC = 0
End If
End Select
' Calculate O2 and LH2O absorption at Z, and weighting function
AlphaO2 = O2ABS(Tr, Pr, RhoVr, Nu)
AlphaLH2O = fRhoLabs(LWC, Tr, Nu)
Wr = WtFunction(r, AlphaO2, AlphaLH2O)
' Then do integral over range
Wsum = Wsum + Wr * rstep
Sum = Sum + Tr * Wr * rstep
r = r + rstep
Next
s = (s + Sum) / 2
it = 2 * it
' End of integration
If Abs(s - OldS) < EPS * Abs(OldS) Then Exit For
OldS = s
' Debug.Print j; S / Wsum
Next
If j = jmax Then Stop
Calc_TB = s / Wsum
End Function
Sub CalculateZarray
Sub CalculateZarray(Latitude!, zo!, n1%, n2%, Pz!(), TZ!(), RHZ!(), Mode%, Zx!())
Dim z!, i%, g0!, T0!, P0!, P!, LR0!, Tv!, RH0!, T!, X!, p1!, T1!, RH1!
' Calculate Geopotential Height for arrays of P,T, and RH
' Inputs: Latitude
' Geometric altitude for initial point (Geopotential if mode=2)
' Pressure array
' Dimension of P,T,RH and Z arrays
' Temperature array
' Relative Humidity array
' Mode = 0 no g variation with height (use g at lat and Zo), no useful use!
' 1 geometric height (g varies with height)
' 2 geopotential height (g = 9.8 at all altitudes)
' Output: Z array corresponding to mode
z = zo
Select Case Mode ' Set g for case where it doesn't vary
Case 0: g0 = fg(zo, Latitude)
Case 2: g0 = 9.8
End Select
For i = n1 To n2 - 1
T0 = TZ(i)
P0 = Pz(i)
LR0 = (TZ(i + 1) - TZ(i)) / (fPtoZ(Pz(i + 1)) - fPtoZ(Pz(i)))
RH0 = (RHZ(i) + RHZ(i + 1)) / 2 'averaging doesn't make much difference
Tv = fTv(RH0, P0, T0) 'Average virtual temperature
If Mode = 1 Then g0 = fg(z, Latitude)
P = Pz(i + 1)
z = z + fIntHE!(g0, Tv, LR0, P0, P)
Zx(i + 1) = z
Next i
End Sub
Function fTvRH
Function fTvRH(P!, T!, RH!)
' Calculate virtual temperature from p, T, and RH
' Need function fEs to calculate water vapor saturation mixing ratio
' cEa = 0.622004944 = cMw/cMd
' cMd = 28.9644 kg/kmole - Avg Molecular Weight (dry air)
' cMw = 18.0160 kg/kmole - Molecular Weight (water vapor)
fTvRH = T / (1# - (RH / 100#) * (fEs(T) / P) * (1# - cEa))
End Function
Function fZgmToZgp!
Function fZgmToZgp!(Zgm!, gn!)
' Calculate geopotential height corresponding to geometric height Zgm
' with normal (surface at Lat) gravity of gn
' Note: Specify gn instead of Latitude to avoid repetitive calculation
fZgmToZgp = (gn * Zgm - 0.001543 * Zgm * Zgm) / 9.8
End Function
Function fZghToZgWGS
Function fZghToZgWGS(Zgh!, Latitude!)
Dim r!
' Zgh in km
' Latitude in deg
' Result in km
r = fRwgs(Latitude)
fZghToZgWGS = r * Zgh / (fgnWGS(Latitude) * r / 9.80665 - Zgh)
End Function
Function fZgpToZgm!
Function fZgpToZgm!(Zgp!, gn!)
Dim X!
' Calculate geometric height corresponding to geopotential height Zgp
' with normal (surface at Lat) gravity of gn
' Note: Specify gn instead of Latitude to avoid repetitive calculation
' fZgpToZgm = (gn - Sqr(gn * gn - 2 * 0.003086 * 9.8 * Zgp)) / 0.003086
fZgpToZgm = 324.044069993519 * (gn - Sqr(gn * gn - 0.0604856 * Zgp))
End Function
Function fZhtoZg24
Function fZhtoZg24(Zgh!, Latitude!)
Dim cos2phi#
' Taylor Series expansion of conversion between H and Zg
' See equation (24) on web page:
' http://mtp.jpl.nasa.gov/notes/altitude/altitude.html
' Use exact equation given by: fZhToZg(Zgh, Latitude)
cos2phi = Cos(2# * Latitude * rpd)
fZhtoZg24 = (1# + 0.002644 * cos2phi) * Zgh + (1# + 0.0089 * cos2phi) * Zgh ^ 2 / 6245#
End Function
Function fZhtoZgSMT98
Function fZhtoZgSMT98(Zgh!, Latitude!)
Dim r#
' Convert Geopotential Height (Zgh) to Geometric Height (Zg)
' Verified against Smithsonian Meteorological Tables (page 222-223)
r = fRsmt(Latitude) 'Ad hoc radius
fZhtoZgSMT98 = r * Zgh / (fgnSMT(Latitude) * r / 9.8 - Zgh)
End Function
Function fZhtoZgSMT
Function fZhtoZgSMT(Zgh!, Latitude!)
Dim r#
' Convert Geopotential Height (Zgh) to Geometric Height (Zg)
' Zgh ......... Geopotential height (km)
' Latitude .... degrees
' Return ...... Geometric altitude (km)
'
' Verified against Smithsonian Meteorological Tables (page 222-223)
' if 9.80665 set to 9.8 as in tables
r = fRsmt(Latitude) 'Ad hoc radius
fZhtoZgSMT = r * Zgh / (fgnSMT(Latitude) * r / 9.80665 - Zgh)
End Function
Function fZhtoZg14
Function fZhtoZg14(Zgh!, Latitude!)
Dim cos2phi#
' Taylor Series expansion of conversion between H and Zg
' See equation (12) on web page:
' http://mtp.jpl.nasa.gov/notes/altitude/altitude.html
' Use exact equation given by: fZhToZg(Zgh, Latitude)
cos2phi = Cos(2# * Latitude * rpd)
fZhtoZg14 = (1# + 0.0026373 * cos2phi) * Zgh + (1# + 0.0086476 * cos2phi) * Zgh ^ 2 / 6356.6818
End Function
Function fZgToZghSMT
Function fZgToZghSMT(Zg!, Latitude!)
Dim r!
' Convert geometric altitude to geopotential height
' Zg ........ Geometric altitude (km)
' Latitude .. Degrees
' Return .... Geopotential height
'
' Verified against Smithsonian Meteorological Tables (page 220-221)
' if 9.80665 set to 9.8 as in tables
r = fRsmt(Latitude)
fZgToZghSMT = r * (fgnSMT(Latitude) / 9.80665) * (Zg / (Zg + r))
End Function
Sub IntegrateHE
Sub IntegrateHE(Nlev%, z!(), T!(), dZg!(), NoD!())
Dim L%, dZgi!, z0!, T0!, P0!, Tv0!
Dim Plast!, Tlast!, ZL!, TL!, PL!, TvL!, TvLast!
' Checked against GOSUB version 19990404 mjm with same results
' z() ...... contains pALT [km]
' T() ...... contains Temperatures [K] at pALT
' dZg() .... contains geometric altitude offsets wrt flight level
' NoD() .... contains Number Density profile
' Nret ..... is number of levels with z>0.1
' L=1 is lowest level, L=16 is a/c level, and L=33 is highest level
' Exit when z<0.1, so Nlev may be <33
'
' First integrate up
L = 16: dZgi = 0: z0! = z(L): T0! = T(L): dZg(L) = 0
P0 = fZtoP(z0): Tv0 = fTvirtual50(T0)
NoD(L) = fNumberDensity(P0, T0)
Plast = P0: TvLast = Tv0
Do 'Integrate above a/c
L = L + 1
ZL = z(L): TL = T(L)
PL = fZtoP(ZL): TvL = fTvirtual50(TL)
NoD(L) = fNumberDensity(PL, TL)
If P0 = 0 Or PL = 0 Then Stop
' 0.001*29.38*0.5 = 1.469E-1 NB 29.38 = 1/(R * g)
dZgi = -0.01469 * (TvL + TvLast) * Log(PL / Plast)
dZg(L) = dZg(L - 1) + dZgi
TvLast = TvL: Plast = PL
Loop Until L = 33
' Then integrate down from a/c
L = 16: Plast = P0: TvLast = Tv0
Do
L = L - 1
ZL = z(L): TL = T(L)
PL = fZtoP(ZL): TvL = fTvirtual50(TL)
NoD(L) = fNumberDensity(PL, TL)
If P0! = 0 Or PL! = 0 Then Stop
dZgi = -0.01469 * (TvL + TvLast) * Log(PL / Plast)
dZg(L) = dZg(L + 1) + dZgi
TvLast = TvL: Plast = PL
Loop Until L = 1 Or 34 - L = Nlev
End Sub
Function O2ABS!
Function O2ABS!(T!, P!, V!, f!)
' This is the OXLIEB93 model, same as that function
Dim X!, y!
Static FZ!(1 To 44), a1!(1 To 44), a2!(1 To 44), a3!(1 To 44)
Static a4!(1 To 44), A5!(1 To 44), A6!(1 To 44), Init%
If Init = 0 Then
FZ(1) = 50.474238: FZ(2) = 50.987749: FZ(3) = 51.50335: FZ(4) = 52.02141
FZ(5) = 52.542394: FZ(6) = 53.066907: FZ(7) = 53.595749: FZ(8) = 54.13
FZ(9) = 54.671159: FZ(10) = 55.221367: FZ(11) = 55.783802: FZ(12) = 56.264775
FZ(13) = 56.363389: FZ(14) = 56.968206: FZ(15) = 57.612484: FZ(16) = 58.323877
FZ(17) = 58.44659: FZ(18) = 59.164207: FZ(19) = 59.590983: FZ(20) = 60.306061
FZ(21) = 60.434776: FZ(22) = 61.15056: FZ(23) = 61.800154: FZ(24) = 62.411215
FZ(25) = 62.48626: FZ(26) = 62.997977: FZ(27) = 63.568518: FZ(28) = 64.127767
FZ(29) = 64.678903: FZ(30) = 65.224071: FZ(31) = 65.764772: FZ(32) = 66.302091
FZ(33) = 66.83683: FZ(34) = 67.369598: FZ(35) = 67.900867: FZ(36) = 68.431005
FZ(37) = 68.960311: FZ(38) = 118.750343: FZ(39) = 368.49835: FZ(40) = 424.763124
FZ(41) = 487.24937: FZ(42) = 715.39315: FZ(43) = 773.839675: FZ(44) = 834.14533
a1(1) = 0.000000094: a1(2) = 0.000000246: a1(3) = 0.000000608: a1(4) = 0.00000141
a1(5) = 0.0000031: a1(6) = 0.00000641: a1(7) = 0.0000125: a1(8) = 0.0000228
a1(9) = 0.0000392: a1(10) = 0.0000632: a1(11) = 0.0000954: a1(12) = 0.0000549
a1(13) = 0.000134: a1(14) = 0.000176: a1(15) = 0.000214: a1(16) = 0.000239
a1(17) = 0.000146: a1(18) = 0.00024: a1(19) = 0.000211: a1(20) = 0.000212
a1(21) = 0.000246: a1(22) = 0.00025: a1(23) = 0.00023: a1(24) = 0.000193
a1(25) = 0.000152: a1(26) = 0.00015: a1(27) = 0.000109: a1(28) = 0.0000734
a1(29) = 0.0000464: a1(30) = 0.0000275: a1(31) = 0.0000153: a1(32) = 0.00000801
a1(33) = 0.00000395: a1(34) = 0.00000183: a1(35) = 0.000000801: a1(36) = 0.00000033
a1(37) = 0.000000128: a1(38) = 0.0000945: a1(39) = 0.00000679: a1(40) = 0.0000638
a1(41) = 0.0000235: a1(42) = 0.00000996: a1(43) = 0.0000671: a1(44) = 0.000018
a2(1) = 9.694: a2(2) = 8.694: a2(3) = 7.744: a2(4) = 6.844
a2(5) = 6.004: a2(6) = 5.224: a2(7) = 4.484: a2(8) = 3.814
a2(9) = 3.194: a2(10) = 2.624: a2(11) = 2.119: a2(12) = 0.015
a2(13) = 1.66: a2(14) = 1.26: a2(15) = 0.915: a2(16) = 0.626
a2(17) = 0.084: a2(18) = 0.391: a2(19) = 0.212: a2(20) = 0.212
a2(21) = 0.391: a2(22) = 0.626: a2(23) = 0.915: a2(24) = 1.26
a2(25) = 0.083: a2(26) = 1.665: a2(27) = 2.115: a2(28) = 2.62
a2(29) = 3.195: a2(30) = 3.815: a2(31) = 4.485: a2(32) = 5.225
a2(33) = 6.005: a2(34) = 6.845: a2(35) = 7.745: a2(36) = 8.695
a2(37) = 9.695: a2(38) = 0.009: a2(39) = 0.049: a2(40) = 0.044
a2(41) = 0.049: a2(42) = 0.145: a2(43) = 0.13: a2(44) = 0.147
a3(1) = 0.89: a3(2) = 0.91: a3(3) = 0.94: a3(4) = 0.97
a3(5) = 0.99: a3(6) = 1.02: a3(7) = 1.05: a3(8) = 1.07
a3(9) = 1.1: a3(10) = 1.13: a3(11) = 1.17: a3(12) = 1.73
a3(13) = 1.2: a3(14) = 1.24: a3(15) = 1.28: a3(16) = 1.33
a3(17) = 1.52: a3(18) = 1.39: a3(19) = 1.43: a3(20) = 1.45
a3(21) = 1.36: a3(22) = 1.31: a3(23) = 1.27: a3(24) = 1.23
a3(25) = 1.54: a3(26) = 1.2: a3(27) = 1.17: a3(28) = 1.13
a3(29) = 1.1: a3(30) = 1.07: a3(31) = 1.05: a3(32) = 1.02
a3(33) = 0.99: a3(34) = 0.97: a3(35) = 0.94: a3(36) = 0.92
a3(37) = 0.9: a3(38) = 1.63: a3(39) = 1.92: a3(40) = 1.93
a3(41) = 1.92: a3(42) = 1.81: a3(43) = 1.82: a3(44) = 1.81
a4(1) = 0.8: a4(2) = 0.8: a4(3) = 0.8: a4(4) = 0.8
a4(5) = 0.8: a4(6) = 0.8: a4(7) = 0.8: a4(8) = 0.8
a4(9) = 0.8: a4(10) = 0.8: a4(11) = 0.8: a4(12) = 0.8
a4(13) = 0.8: a4(14) = 0.8: a4(15) = 0.8: a4(16) = 0.8
a4(17) = 0.8: a4(18) = 0.8: a4(19) = 0.8: a4(20) = 0.8
a4(21) = 0.8: a4(22) = 0.8: a4(23) = 0.8: a4(24) = 0.8
a4(25) = 0.8: a4(26) = 0.8: a4(27) = 0.8: a4(28) = 0.8
a4(29) = 0.8: a4(30) = 0.8: a4(31) = 0.8: a4(32) = 0.8
a4(33) = 0.8: a4(34) = 0.8: a4(35) = 0.8: a4(36) = 0.8
a4(37) = 0.8: a4(38) = 0.8: a4(39) = 0.2: a4(40) = 0.2
a4(41) = 0.2: a4(42) = 0.2: a4(43) = 0.2: a4(44) = 0.2
A5(1) = 0.24: A5(2) = 0.22: A5(3) = 0.197: A5(4) = 0.166
A5(5) = 0.136: A5(6) = 0.131: A5(7) = 0.23: A5(8) = 0.335
A5(9) = 0.374: A5(10) = 0.258: A5(11) = -0.166: A5(12) = 0.39
A5(13) = -0.297: A5(14) = -0.416: A5(15) = -0.613: A5(16) = -0.205
A5(17) = 0.748: A5(18) = -0.722: A5(19) = 0.765: A5(20) = -0.705
A5(21) = 0.697: A5(22) = 0.104: A5(23) = 0.57: A5(24) = 0.36
A5(25) = -0.498: A5(26) = 0.239: A5(27) = 0.108: A5(28) = -0.311
A5(29) = -0.421: A5(30) = -0.375: A5(31) = -0.267: A5(32) = -0.168
A5(33) = -0.169: A5(34) = -0.2: A5(35) = -0.228: A5(36) = -0.24
A5(37) = -0.25: A5(38) = -0.036: A5(39) = 0#: A5(40) = 0#
A5(41) = 0#: A5(42) = 0#: A5(43) = 0#: A5(44) = 0#
A6(1) = 0.79: A6(2) = 0.78: A6(3) = 0.774: A6(4) = 0.764
A6(5) = 0.751: A6(6) = 0.714: A6(7) = 0.584: A6(8) = 0.431
A6(9) = 0.305: A6(10) = 0.339: A6(11) = 0.705: A6(12) = -0.113
A6(13) = 0.753: A6(14) = 0.742: A6(15) = 0.697: A6(16) = 0.051
A6(17) = -0.146: A6(18) = 0.266: A6(19) = -0.09: A6(20) = 0.081
A6(21) = -0.324: A6(22) = -0.067: A6(23) = -0.761: A6(24) = -0.777
A6(25) = 0.097: A6(26) = -0.768: A6(27) = -0.706: A6(28) = -0.332
A6(29) = -0.298: A6(30) = -0.423: A6(31) = -0.575: A6(32) = -0.7
A6(33) = -0.735: A6(34) = -0.744: A6(35) = -0.753: A6(36) = -0.76
A6(37) = -0.765: A6(38) = 0.009: A6(39) = 0#: A6(40) = 0#
A6(41) = 0#: A6(42) = 0#: A6(43) = 0#: A6(44) = 0#:
Init = 1
End If
Dim Pvap!, Pdry!, GammaZ!, Sox!, Foxim!, Sni!, FFni!, Cont!
Dim s!, Sum!, gamma!, Delta!, Fpp!, OXres!, i%, Tp!
Tp = 300 / T
Pvap = V / 0.7217 / Tp
Pdry = P - Pvap
GammaZ = 0.00056 * P * Tp ^ 0.8
Sox = 0.0000614 * Pdry * Tp ^ 2
Foxim = f * GammaZ / (f ^ 2 + GammaZ ^ 2)
Sni = 0.0000000000014 * Pdry ^ 2 * Tp ^ 3.5
FFni = f / (1 + 0.000019 * f ^ 1.5)
Cont = 0.182 * f * (Sox * Foxim + Sni * FFni)
Sum = 0
For i = 1 To 44
s = a1(i) * Pdry * Tp ^ 3 * Exp(a2(i) * (1 - Tp))
gamma = 0.001 * a3(i) * (Pdry * Tp ^ a4(i) + 1.1 * Pvap * Tp)
Delta = 0.001 * (A5(i) + A6(i) * Tp) * P * Tp ^ 0.8
X = (FZ(i) - f) ^ 2 + gamma ^ 2
y = (FZ(i) + f) ^ 2 + gamma ^ 2
Fpp = (1 / X + 1 / y) * gamma * f / FZ(i) - Delta * (f / FZ(i)) * ((FZ(i) - f) / X + (FZ(i) + f) / y)
Sum = Sum + s * Fpp
Next i
OXres = 0.182 * f * Sum
O2ABS = (Cont + OXres) / 4.343 '[nepers/km]
End Function
Function ABS_O2
Function ABS_O2(ByVal T!, ByVal P!, ByVal VD!, ByVal f!) As Single
'
' PURPOSE: RETURNS ABSORPTION COEFFICIENT DUE TO OXYGEN IN AIR, IN NEPERS/KM
'
' 5/1/95 P. Rosenkranz
' 11/5/97 P. Rosenkranz - 1- line modification.
' 12/16/98 pwr - updated submm freq's and intensities from HITRAN96
'
' ARGUMENTS:
'
' NAME UNITS DESCRIPTION VALID RANGE
'
' T KELVIN TEMPERATURE UNCERTAIN, but believed to be
' valid for atmosphere
' P MILLIBARS PRESSURE 3 TO 1000
' VD G/M**3 WATER VAPOR DENSITY ENTERS LINEWIDTH CALCULATION DUE TO GREATER BROADENING EFFICIENCY OF H2O
' F GHZ FREQUENCY 0 TO 900
'
' REFERENCES FOR EQUATIONS AND COEFFICIENTS:
' P.W. Rosenkranz, CHAP. 2 and appendix, in ATMOSPHERIC REMOTE SENSING
' BY MICROWAVE RADIOMETRY (M.A. Janssen, ed., 1993).
' H.J. Liebe et al, JQSRT V.48, PP.629-643 (1992).
' M.J. Schwartz, Ph.D. thesis, M.I.T. (1997).
' SUBMILLIMETER LINE INTENSITIES FROM HITRAN96.
' This version differs from Liebe's MPM92 in two significant respects:
' 1. It uses the modification of the 1- line width temperature dependence
' recommended by Schwartz: (1/T).
' 2. It uses the same temperature dependence (X) for submillimeter
' line widths as in the 60 GHz band: (1/T)**0.8
'
Dim y!
Static W300!(1 To 40), fr!(1 To 40), Y300!(1 To 40), S300!(1 To 40) 'X!, WB300!
Static V!(1 To 40), BE!(1 To 40), Init%
'C LINES ARE ARRANGED 1-,1+,3-,3+,ETC. IN SPIN-ROTATION SPECTRUM
If Init = 0 Then
fr(1) = 118.7503: fr(2) = 56.2648: fr(3) = 62.4863: fr(4) = 58.4466: fr(5) = 60.3061: fr(6) = 59.591
fr(7) = 59.1642: fr(8) = 60.4348: fr(9) = 58.3239: fr(10) = 61.1506: fr(11) = 57.6125: fr(12) = 61.8002
fr(13) = 56.9682: fr(14) = 62.4112: fr(15) = 56.3634: fr(16) = 62.998: fr(17) = 55.7838: fr(18) = 63.5685
fr(19) = 55.2214: fr(20) = 64.1278: fr(21) = 54.6712: fr(22) = 64.6789: fr(23) = 54.13: fr(24) = 65.2241
fr(25) = 53.5957: fr(26) = 65.7648: fr(27) = 53.0669: fr(28) = 66.3021: fr(29) = 52.5424: fr(30) = 66.8368
fr(31) = 52.0214: fr(32) = 67.3696: fr(33) = 51.5034: fr(34) = 67.9009: fr(35) = 368.4984: fr(36) = 424.7632
fr(37) = 487.2494: fr(38) = 715.3931: fr(39) = 773.8397: fr(40) = 834.1458
S300(1) = 2.936E-15: S300(2) = 8.079E-16: S300(3) = 2.48E-15: S300(4) = 2.228E-15
S300(5) = 3.351E-15: S300(6) = 3.292E-15: S300(7) = 3.721E-15: S300(8) = 3.891E-15
S300(9) = 3.64E-15: S300(10) = 4.005E-15: S300(11) = 3.227E-15: S300(12) = 3.715E-15
S300(13) = 2.627E-15: S300(14) = 3.156E-15: S300(15) = 1.982E-15: S300(16) = 2.477E-15
S300(17) = 1.391E-15: S300(18) = 1.808E-15: S300(19) = 9.124E-16: S300(20) = 1.23E-15
S300(21) = 5.603E-16: S300(22) = 7.842E-16: S300(23) = 3.228E-16: S300(24) = 4.689E-16
S300(25) = 1.748E-16: S300(26) = 2.632E-16: S300(27) = 8.898E-17: S300(28) = 1.389E-16
S300(29) = 4.264E-17: S300(30) = 6.899E-17: S300(31) = 1.924E-17: S300(32) = 3.229E-17
S300(33) = 8.191E-18: S300(34) = 1.423E-17: S300(35) = 6.494E-16: S300(36) = 7.083E-15
S300(37) = 3.025E-15: S300(38) = 1.835E-15: S300(39) = 1.158E-14: S300(40) = 3.993E-15
' S300(17) = S300(17) * 1.0002
' S300(19) = S300(19) * 1.0002
'Call BubbleSort(S300(), 40)
BE(1) = 0.009: BE(2) = 0.015: BE(3) = 0.083: BE(4) = 0.084: BE(5) = 0.212: BE(6) = 0.212
BE(7) = 0.391: BE(8) = 0.391: BE(9) = 0.626: BE(10) = 0.626: BE(11) = 0.915: BE(12) = 0.915
BE(13) = 1.26: BE(14) = 1.26: BE(15) = 1.66: BE(16) = 1.665: BE(17) = 2.119: BE(18) = 2.115
BE(19) = 2.624: BE(20) = 2.625: BE(21) = 3.194: BE(22) = 3.194: BE(23) = 3.814: BE(24) = 3.814
BE(25) = 4.484: BE(26) = 4.484: BE(27) = 5.224: BE(28) = 5.224: BE(29) = 6.004: BE(30) = 6.004
BE(31) = 6.844: BE(32) = 6.844: BE(33) = 7.744: BE(34) = 7.744: BE(35) = 0.048: BE(36) = 0.044
BE(37) = 0.049: BE(38) = 0.145: BE(39) = 0.141: BE(40) = 0.145
'C WIDTHS IN MHZ/MB'
' WB300 = 0.56: X = 0.8
W300(1) = 1.63: W300(2) = 1.646: W300(3) = 1.468: W300(4) = 1.449: W300(5) = 1.382: W300(6) = 1.36
W300(7) = 1.319: W300(8) = 1.297: W300(9) = 1.266: W300(10) = 1.248: W300(11) = 1.221: W300(12) = 1.207
W300(13) = 1.181: W300(14) = 1.171: W300(15) = 1.144: W300(16) = 1.139: W300(17) = 1.11: W300(18) = 1.108
W300(19) = 1.079: W300(20) = 1.078: W300(21) = 1.05: W300(22) = 1.05: W300(23) = 1.02: W300(24) = 1.02
W300(25) = 1#: W300(26) = 1#: W300(27) = 0.97: W300(28) = 0.97: W300(29) = 0.94: W300(30) = 0.94
W300(31) = 0.92: W300(32) = 0.92: W300(33) = 0.89: W300(34) = 0.89: W300(35) = 1.92: W300(36) = 1.92
W300(37) = 1.92: W300(38) = 1.81: W300(39) = 1.81: W300(40) = 1.81
Y300(1) = -0.0233: Y300(2) = 0.2408: Y300(3) = -0.3486: Y300(4) = 0.5227: Y300(5) = -0.543
Y300(6) = 0.5877: Y300(7) = -0.397: Y300(8) = 0.3237: Y300(9) = -0.1348: Y300(10) = 0.0311
Y300(11) = 0.0725: Y300(12) = -0.1663: Y300(13) = 0.2832: Y300(14) = -0.3629: Y300(15) = 0.397
Y300(16) = -0.4599: Y300(17) = 0.4695: Y300(18) = -0.5199: Y300(19) = 0.5187: Y300(20) = -0.5597
Y300(21) = 0.5903: Y300(22) = -0.6246: Y300(23) = 0.6656: Y300(24) = -0.6942: Y300(25) = 0.7086
Y300(26) = -0.7325: Y300(27) = 0.7348: Y300(28) = -0.7546: Y300(29) = 0.7702: Y300(30) = -0.7864
Y300(31) = 0.8083: Y300(32) = -0.821: Y300(33) = 0.8439: Y300(34) = -0.8529: Y300(35) = 0#
Y300(36) = 0#: Y300(37) = 0#: Y300(38) = 0#: Y300(39) = 0#: Y300(40) = 0#
V(1) = 0.0079: V(2) = -0.0978: V(3) = 0.0844: V(4) = -0.1273: V(5) = 0.0699
V(6) = -0.0776: V(7) = 0.2309: V(8) = -0.2825: V(9) = 0.0436: V(10) = -0.0584
V(11) = 0.6056: V(12) = -0.6619: V(13) = 0.6451: V(14) = -0.6759: V(15) = 0.6547
V(16) = -0.6675: V(17) = 0.6135: V(18) = -0.6139: V(19) = 0.2952: V(20) = -0.2895
V(21) = 0.2654: V(22) = -0.259: V(23) = 0.375: V(24) = -0.368: V(25) = 0.5085
V(26) = -0.5002: V(27) = 0.6206: V(28) = -0.6091: V(29) = 0.6526: V(30) = -0.6393
V(31) = 0.664: V(32) = -0.6475: V(33) = 0.6729: V(34) = -0.6545: V(35) = 0#
V(36) = 0#: V(37) = 0#: V(38) = 0#: V(39) = 0#: V(40) = 0#
Init = 1
End If
Dim Th!, Th1!, b!, PresWV!, PresDA!, den!, Dens!, dFnr!, Sum!, k%, df!, Str!, Sf1!, Sf2!
Th = 300# / T
Th1 = Th - 1#
b = Th ^ 0.8 'X=0.8
PresWV = VD * T / 217#
PresDA = P - PresWV
den = 0.001 * (PresDA * b + 1.1 * PresWV * Th)
Dens = 0.001 * (PresDA + 1.1 * PresWV) * Th
dFnr = 0.56 * den 'WB300=0.56
Sum = 1.6E-17 * f * f * dFnr / (Th * (f * f + dFnr * dFnr))
For k = 1 To 40
If k = 1 Then 'exception for 1- line
df = W300(1) * Dens
Else
df = W300(k) * den
End If
y = 0.001 * P * b * (Y300(k) + V(k) * Th1)
Str = S300(k) * Exp(-BE(k) * Th1)
Sf1 = (df + (f - fr(k)) * y) / ((f - fr(k)) ^ 2 + df * df)
Sf2 = (df - (f + fr(k)) * y) / ((f + fr(k)) ^ 2 + df * df)
Sum = Sum + Str * (Sf1 + Sf2) * (f / fr(k)) ^ 2
Next k
ABS_O2 = 503400000000# * Sum * PresDA * Th ^ 3 / 3.14159
End Function
Function OXLIEB93
Function OXLIEB93(T!, P!, V!, f!)
Static FZ!(1 To 44), a1!(1 To 44), a2!(1 To 44), a3!(1 To 44)
Static a4!(1 To 44), A5!(1 To 44), A6!(1 To 44), Init%
Dim Pvap!, Pdry!, GammaZ!, Sox!, Foxim!, Sni!, FFni!, Cont!
Dim s!, Sum!, gamma!, Delta!, Fpp!, OXres!, i%, Tp!, X!, y!
If Init = 0 Then
FZ(1) = 50.474238: FZ(2) = 50.987749: FZ(3) = 51.50335: FZ(4) = 52.02141
FZ(5) = 52.542394: FZ(6) = 53.066907: FZ(7) = 53.595749: FZ(8) = 54.13
FZ(9) = 54.671159: FZ(10) = 55.221367: FZ(11) = 55.783802: FZ(12) = 56.264775
FZ(13) = 56.363389: FZ(14) = 56.968206: FZ(15) = 57.612484: FZ(16) = 58.323877
FZ(17) = 58.44659: FZ(18) = 59.164207: FZ(19) = 59.590983: FZ(20) = 60.306061
FZ(21) = 60.434776: FZ(22) = 61.15056: FZ(23) = 61.800154: FZ(24) = 62.411215
FZ(25) = 62.48626: FZ(26) = 62.997977: FZ(27) = 63.568518: FZ(28) = 64.127767
FZ(29) = 64.678903: FZ(30) = 65.224071: FZ(31) = 65.764772: FZ(32) = 66.302091
FZ(33) = 66.83683: FZ(34) = 67.369598: FZ(35) = 67.900867: FZ(36) = 68.431005
FZ(37) = 68.960311: FZ(38) = 118.750343: FZ(39) = 368.49835: FZ(40) = 424.763124
FZ(41) = 487.24937: FZ(42) = 715.39315: FZ(43) = 773.839675: FZ(44) = 834.14533
a1(1) = 0.000000094: a1(2) = 0.000000246: a1(3) = 0.000000608: a1(4) = 0.00000141
a1(5) = 0.0000031: a1(6) = 0.00000641: a1(7) = 0.0000125: a1(8) = 0.0000228
a1(9) = 0.0000392: a1(10) = 0.0000632: a1(11) = 0.0000954: a1(12) = 0.0000549
a1(13) = 0.000134: a1(14) = 0.000176: a1(15) = 0.000214: a1(16) = 0.000239
a1(17) = 0.000146: a1(18) = 0.00024: a1(19) = 0.000211: a1(20) = 0.000212
a1(21) = 0.000246: a1(22) = 0.00025: a1(23) = 0.00023: a1(24) = 0.000193
a1(25) = 0.000152: a1(26) = 0.00015: a1(27) = 0.000109: a1(28) = 0.0000734
a1(29) = 0.0000464: a1(30) = 0.0000275: a1(31) = 0.0000153: a1(32) = 0.00000801
a1(33) = 0.00000395: a1(34) = 0.00000183: a1(35) = 0.000000801: a1(36) = 0.00000033
a1(37) = 0.000000128: a1(38) = 0.0000945: a1(39) = 0.00000679: a1(40) = 0.0000638
a1(41) = 0.0000235: a1(42) = 0.00000996: a1(43) = 0.0000671: a1(44) = 0.000018
a2(1) = 9.694: a2(2) = 8.694: a2(3) = 7.744: a2(4) = 6.844
a2(5) = 6.004: a2(6) = 5.224: a2(7) = 4.484: a2(8) = 3.814
a2(9) = 3.194: a2(10) = 2.624: a2(11) = 2.119: a2(12) = 0.015
a2(13) = 1.66: a2(14) = 1.26: a2(15) = 0.915: a2(16) = 0.626
a2(17) = 0.084: a2(18) = 0.391: a2(19) = 0.212: a2(20) = 0.212
a2(21) = 0.391: a2(22) = 0.626: a2(23) = 0.915: a2(24) = 1.26
a2(25) = 0.083: a2(26) = 1.665: a2(27) = 2.115: a2(28) = 2.62
a2(29) = 3.195: a2(30) = 3.815: a2(31) = 4.485: a2(32) = 5.225
a2(33) = 6.005: a2(34) = 6.845: a2(35) = 7.745: a2(36) = 8.695
a2(37) = 9.695: a2(38) = 0.009: a2(39) = 0.049: a2(40) = 0.044
a2(41) = 0.049: a2(42) = 0.145: a2(43) = 0.13: a2(44) = 0.147
a3(1) = 0.89: a3(2) = 0.91: a3(3) = 0.94: a3(4) = 0.97
a3(5) = 0.99: a3(6) = 1.02: a3(7) = 1.05: a3(8) = 1.07
a3(9) = 1.1: a3(10) = 1.13: a3(11) = 1.17: a3(12) = 1.73
a3(13) = 1.2: a3(14) = 1.24: a3(15) = 1.28: a3(16) = 1.33
a3(17) = 1.52: a3(18) = 1.39: a3(19) = 1.43: a3(20) = 1.45
a3(21) = 1.36: a3(22) = 1.31: a3(23) = 1.27: a3(24) = 1.23
a3(25) = 1.54: a3(26) = 1.2: a3(27) = 1.17: a3(28) = 1.13
a3(29) = 1.1: a3(30) = 1.07: a3(31) = 1.05: a3(32) = 1.02
a3(33) = 0.99: a3(34) = 0.97: a3(35) = 0.94: a3(36) = 0.92
a3(37) = 0.9: a3(38) = 1.63: a3(39) = 1.92: a3(40) = 1.93
a3(41) = 1.92: a3(42) = 1.81: a3(43) = 1.82: a3(44) = 1.81
a4(1) = 0.8: a4(2) = 0.8: a4(3) = 0.8: a4(4) = 0.8
a4(5) = 0.8: a4(6) = 0.8: a4(7) = 0.8: a4(8) = 0.8
a4(9) = 0.8: a4(10) = 0.8: a4(11) = 0.8: a4(12) = 0.8
a4(13) = 0.8: a4(14) = 0.8: a4(15) = 0.8: a4(16) = 0.8
a4(17) = 0.8: a4(18) = 0.8: a4(19) = 0.8: a4(20) = 0.8
a4(21) = 0.8: a4(22) = 0.8: a4(23) = 0.8: a4(24) = 0.8
a4(25) = 0.8: a4(26) = 0.8: a4(27) = 0.8: a4(28) = 0.8
a4(29) = 0.8: a4(30) = 0.8: a4(31) = 0.8: a4(32) = 0.8
a4(33) = 0.8: a4(34) = 0.8: a4(35) = 0.8: a4(36) = 0.8
a4(37) = 0.8: a4(38) = 0.8: a4(39) = 0.2: a4(40) = 0.2
a4(41) = 0.2: a4(42) = 0.2: a4(43) = 0.2: a4(44) = 0.2
A5(1) = 0.24: A5(2) = 0.22: A5(3) = 0.197: A5(4) = 0.166
A5(5) = 0.136: A5(6) = 0.131: A5(7) = 0.23: A5(8) = 0.335
A5(9) = 0.374: A5(10) = 0.258: A5(11) = -0.166: A5(12) = 0.39
A5(13) = -0.297: A5(14) = -0.416: A5(15) = -0.613: A5(16) = -0.205
A5(17) = 0.748: A5(18) = -0.722: A5(19) = 0.765: A5(20) = -0.705
A5(21) = 0.697: A5(22) = 0.104: A5(23) = 0.57: A5(24) = 0.36
A5(25) = -0.498: A5(26) = 0.239: A5(27) = 0.108: A5(28) = -0.311
A5(29) = -0.421: A5(30) = -0.375: A5(31) = -0.267: A5(32) = -0.168
A5(33) = -0.169: A5(34) = -0.2: A5(35) = -0.228: A5(36) = -0.24
A5(37) = -0.25: A5(38) = -0.036: A5(39) = 0#: A5(40) = 0#
A5(41) = 0#: A5(42) = 0#: A5(43) = 0#: A5(44) = 0#
A6(1) = 0.79: A6(2) = 0.78: A6(3) = 0.774: A6(4) = 0.764
A6(5) = 0.751: A6(6) = 0.714: A6(7) = 0.584: A6(8) = 0.431
A6(9) = 0.305: A6(10) = 0.339: A6(11) = 0.705: A6(12) = -0.113
A6(13) = 0.753: A6(14) = 0.742: A6(15) = 0.697: A6(16) = 0.051
A6(17) = -0.146: A6(18) = 0.266: A6(19) = -0.09: A6(20) = 0.081
A6(21) = -0.324: A6(22) = -0.067: A6(23) = -0.761: A6(24) = -0.777
A6(25) = 0.097: A6(26) = -0.768: A6(27) = -0.706: A6(28) = -0.332
A6(29) = -0.298: A6(30) = -0.423: A6(31) = -0.575: A6(32) = -0.7
A6(33) = -0.735: A6(34) = -0.744: A6(35) = -0.753: A6(36) = -0.76
A6(37) = -0.765: A6(38) = 0.009: A6(39) = 0#: A6(40) = 0#
A6(41) = 0#: A6(42) = 0#: A6(43) = 0#: A6(44) = 0#:
Init = 1
End If
Tp = 300 / T
Pvap = V / 0.7217 / Tp
Pdry = P - Pvap
GammaZ = 0.00056 * P * Tp ^ 0.8
Sox = 0.0000614 * Pdry * Tp ^ 2
Foxim = f * GammaZ / (f ^ 2 + GammaZ ^ 2)
Sni = 0.0000000000014 * Pdry ^ 2 * Tp ^ 3.5
FFni = f / (1 + 0.000019 * f ^ 1.5)
Cont = 0.182 * f * (Sox * Foxim + Sni * FFni)
Sum = 0
For i = 1 To 44
s = a1(i) * Pdry * Tp ^ 3 * Exp(a2(i) * (1 - Tp))
gamma = 0.001 * a3(i) * (Pdry * Tp ^ a4(i) + 1.1 * Pvap * Tp)
Delta = 0.001 * (A5(i) + A6(i) * Tp) * P * Tp ^ 0.8
X = (FZ(i) - f) ^ 2 + gamma ^ 2
y = (FZ(i) + f) ^ 2 + gamma ^ 2
Fpp = (1 / X + 1 / y) * gamma * f / FZ(i) - Delta * (f / FZ(i)) * ((FZ(i) - f) / X + (FZ(i) + f) / y)
Sum = Sum + s * Fpp
Next i
OXres = 0.182 * f * Sum
OXLIEB93 = (Cont + OXres) / 4.343 '[nepers/km]
End Function
Function fVliebe!
Function fVliebe!(T!, P!, V!, f!)
' COMPUTE VAPOR ABSORPTION AS A FUNCTION OF FREQUENCY (F),
' VAPOR DENSITY (V), PRESSURE (P), TEMPERATURE (T), LINE
' STRENGTH FACTOR (CL), CONTINUUM STRENGTH FACTOR (CC),
' AND LINE WIDTH FACTOR (CW).
' RESULT IN NEPERS
Dim FZ!, CL!, CW!, cC!, Pvap!, Pdry!, W!
Dim Term1!, Term2!, Term3!, Tp!
FZ = 22.235
CL = 1.05 '1. Were Liebe '87 Model SJK corrected
CW = 1# '1. to current values for TOPEX
cC = 1.3 '1.2 Liebe 93 Model agrees w/sjk from 18-40 GHz
' NOMINAL LIEBE '87 MODEL
Tp = 300# / T
Pvap = V / 0.7223 / Tp
Pdry = P - Pvap
W = CW * 0.002784 * (Pdry * Tp ^ 0.6 + 4.8 * Pvap * Tp ^ 1.1)
Term1 = CL * 0.0109 * Pvap * Tp ^ 3.5 * Exp(2.143 * (1# - Tp))
Term2 = (W / FZ) * (1# / ((FZ - f) ^ 2 + W ^ 2) + 1# / ((FZ + f) ^ 2 + W ^ 2))
Term3 = cC * 0.1 * (0.000000113 * Pdry * Tp ^ 0.5 + 0.00000357 * Pvap * Tp ^ 8) * Pvap * Tp ^ 2.5
fVliebe = (1# / 4.34) * 0.182 * f ^ 2 * (Term1 * Term2 + Term3)
End Function
Function fTatZ!
Function fTatZ!(z!, Ts!, LR!, Zt!, StandardT As Boolean)
Dim TZ!
If StandardT Then
TZ = fTstd(z)
Else
If z < Zt Then
TZ = Ts + LR * z
Else
TZ = Ts + LR * Zt
End If
End If
fTat