Thư viện tri thức trực tuyến
Kho tài liệu với 50,000+ tài liệu học thuật
© 2023 Siêu thị PDF - Kho tài liệu học thuật hàng đầu Việt Nam
Nghiên cứu và thành lập bộ chương trình hiệu chỉnh và liên kết tài liệu từ phổ gamma hàng không - Mã các chương trình
Nội dung xem thử
Mô tả chi tiết
bé tµi nguyªn vµ m«i tr−êng
côc ®Þa chÊt vµ kho¸ng s¶n viÖt nam
liªn ®oµn vËt lý ®Þa chÊt
_______________________________________
®Ò tµi
“Nghiªn cøu vµ thµnh lËp bé ch−¬ng tr×nh hiÖu chØnh
vµ liªn kÕt tµi liÖu tõ phæ gamma hµng kh«ng “
Chñ nhiÖm : Ks KiÒu Trung Thuû
Phô lôc 1
M∙ Ch−¬ng tr×nh
6322-1
22/3/2007
Hµ Néi 2006
1
MôC LôC
Trang
1 Chuyªn ®Ò 1: G¾n to¹ ®é 2
2 Chuyªn ®Ò 2: C¾t bay vßng 16
3 Chuyªn ®Ò 3: HiÖu chØnh deviaxia vµ biÕn thiªn
tõ
23
4 Chuyªn ®Ò 4: TÝnh sai ph©n tõ, c©n b»ng m¹ng
l−íi tùa.
30
5 Chuyªn ®Ò 5: Liªn kÕt c¸c tuyÕn th−êng 52
6 Chuyªn ®Ò 6: TÝnh sai sè tµi liÖu tõ 59
7 Chuyªn ®Ò 7: TÝnh dÞ th−êng tõ 65
8 Chuyªn ®Ò 8, 9, 10, 11: Liªn kÕt tµi liÖu phæ
gamma theo tuyÕn kiÓm tra, hiÖu chØnh compton,
hiÖu chØnh ®é cao, tÝnh chuyÓn hµm l−îng.
69
9 Chuyªn ®Ò 12: Läc tµi liÖu phæ gamma 79
10 Chuyªn ®Ò 13: TÝnh sai sè tµi liÖu x¹ phæ gamma 84
11 Chuyªn ®Ò 14: Liªn kÕt tµi liÖu x¹ phæ gamma
dùa vµo tuyÕn tùa,
90
12 Chuyªn ®Ò 15: TÝnh sai sè tµi liÖu x¹ phæ
gamma.
101
13 Chuyªn ®Ò 16: M· ho¸ vµ ph©n lo¹i dÞ th−êng 112
2
I. Chuyên đề 1 : Gắn toạ độ
I.1 Chuyển format WGS84 -> CTranfer
Private Sub Ctranfer_Click()
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String
With List1
Screen.MousePointer = vbHourglass
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
ProBar1.Max = .ListCount
ProBar1.Visible = True
For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\" & Left$(List1.List(Index),
(Len(List1.List(Index)) - 4)) & ".c84"
Else
filespec = Dir1.Path & List1.List(Index)
filespeckq = Dir1.Path & Left$(List1.List(Index), (Len(List1.List(Index)) - 4))
& ".c84"
End If
FrmKetqua.List1.AddItem Left$(List1.List(Index), (Len(List1.List(Index)) - 4))
& ".c84"
Call W84(filespec, filespeckq)
ProBar1.Value = Index + 1
Next
End If
Screen.MousePointer = vbDefault
FrmKetqua.Label1.Caption = " Ket qua chua trong thu muc : " & LCase(Dir1.Path)
FrmKetqua.Show vbModal
ProBar1.Visible = False
End With
Call Dir1_Change
End Sub
Private Function W84(filespec As String, filespeckq As String)
Dim modefile As Boolean
modefile = False
On Error GoTo MsgError
3
Dim strOUT(25000) As String
Dim strin(25000) As String
Dim j As Integer, numvals As Integer, sodd As Integer
Dim myvar As Variant
Dim ngay(), Gio(), VD(), KD(), docao() As String
If LCase(Right$(filespec, 3)) = LCase("W84") Then
'khoi doc file text
numvals = 0
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim fso_G As New FileSystemObject
Dim ts_G As TextStream
Dim tam_STR As String
Set ts = fso.OpenTextFile(filespec)
Do While Not ts.AtEndOfStream
numvals = numvals + 1
strin(numvals) = ts.ReadLine
Loop
ts.Close
sodd = numvals
ReDim ngay(sodd - 1), Gio(sodd - 1), VD(sodd - 1), KD(sodd - 1), docao(sodd - 1)
If sodd <= 20000 Then
Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 22 To sodd - 1
Dim i As Integer
Dim toado As String
myvar = Split(strin(j), ",")
For i = LBound(myvar) To UBound(myvar)
Next
Dim KDdo, KDphut, KDgiay, VDdo, VDphut, VDgiay As String
Dim VDKD, tam1(2), tam2(2) As String
Dim tam As Double
If i = 4 Then
ngay(j) = CStr(myvar(0))
Gio(j) = Left$(Trim$(CStr(myvar(1))), 8)
docao(j) = Trim$(CStr(myvar(3)))
VDKD = Trim$(CStr(myvar(2)))
Dim SPL As Variant
Dim m As Integer
SPL = Split(VDKD, " ")
For m = LBound(SPL) To UBound(SPL)
4
tam1(m) = SPL(m)
Next
'vido
SPL = Split(tam1(0), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
VDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
VDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
VDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
VDgiay = Left$(("0" & CStr(tam)), 7)
Else
VDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = VDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = VDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = VDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = VDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = VDgiay + ".0000"
VD(j) = VDdo + VDphut + VDgiay
SPL = Split(tam1(1), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
KDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
KDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
KDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
KDgiay = Left$(("0" & CStr(tam)), 7)
Else
KDgiay = Left$(tam, 7)
5
End If
If Len(VDgiay) = 6 Then VDgiay = KDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = KDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = KDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = KDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = KDgiay + ".0000"
KD(j) = KDdo + KDphut + KDgiay
If docao(j) <> "" Then
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(docao(j)) 'CStr(100)
Else
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(100)
End If
ts_G.WriteLine (toado)
modefile = True
Else
MsgBox ("Khong dung format !")
End If
Next
Close
Else
Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 22 To 10000
myvar = Split(strin(j), ",")
For i = LBound(myvar) To UBound(myvar)
Next
If i = 4 Then
ngay(j) = CStr(myvar(0))
Gio(j) = Left$(Trim$(CStr(myvar(1))), 8)
docao(j) = Trim$(CStr(myvar(3)))
VDKD = Trim$(CStr(myvar(2)))
SPL = Split(VDKD, " ")
For m = LBound(SPL) To UBound(SPL)
tam1(m) = SPL(m)
Next
SPL = Split(tam1(0), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
VDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
VDphut = Left$(("0" & CStr(tam)), 2)
6
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
VDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
VDgiay = Left$(("0" & CStr(tam)), 7)
Else
VDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = VDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = VDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = VDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = VDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = VDgiay + ".0000"
VD(j) = VDdo + VDphut + VDgiay
SPL = Split(tam1(1), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
KDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
KDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
KDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
KDgiay = Left$(("0" & CStr(tam)), 7)
Else
KDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = KDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = KDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = KDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = KDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = KDgiay + ".0000"
KD(j) = KDdo + KDphut + KDgiay
If docao(j) <> "" Then
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(docao(j)) 'CStr(100)
Else
7
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(100)
End If
ts_G.WriteLine (toado)
modefile = True
Else
MsgBox ("Khong dung format !")
End If
Next
Close
filespeckq = filespeckq + "A"
Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 10001 To sodd - 1
myvar = Split(strin(j), ",")
For i = LBound(myvar) To UBound(myvar)
Next
If i = 4 Then
ngay(j) = CStr(myvar(0))
Gio(j) = Left$(Trim$(CStr(myvar(1))), 8)
docao(j) = Trim$(CStr(myvar(3)))
VDKD = Trim$(CStr(myvar(2)))
SPL = Split(VDKD, " ")
For m = LBound(SPL) To UBound(SPL)
tam1(m) = SPL(m)
Next
SPL = Split(tam1(0), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
VDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
VDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
VDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
VDgiay = Left$(("0" & CStr(tam)), 7)
Else
VDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = VDgiay + "0"
8
If Len(VDgiay) = 5 Then VDgiay = VDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = VDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = VDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = VDgiay + ".0000"
VD(j) = VDdo + VDphut + VDgiay
SPL = Split(tam1(1), ".")
m = 0
For m = LBound(SPL) To UBound(SPL)
tam2(m) = SPL(m)
Next
KDdo = tam2(0)
tam = CDbl("0." & tam2(1)) * 60
If tam < 10 Then
KDphut = Left$(("0" & CStr(tam)), 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 1))) * 60
Else
KDphut = Left$(tam, 2)
tam = (Right$(tam, (Len(Trim$(tam)) - 2))) * 60
End If
If tam < 10 Then
KDgiay = Left$(("0" & CStr(tam)), 7)
Else
KDgiay = Left$(tam, 7)
End If
If Len(VDgiay) = 6 Then VDgiay = KDgiay + "0"
If Len(VDgiay) = 5 Then VDgiay = KDgiay + "00"
If Len(VDgiay) = 4 Then VDgiay = KDgiay + "000"
If Len(VDgiay) = 3 Then VDgiay = KDgiay + "0000"
If Len(VDgiay) = 2 Then VDgiay = KDgiay + ".0000"
KD(j) = KDdo + KDphut + KDgiay
If docao(j) <> "" Then
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(docao(j)) 'CStr(100)
Else
toado = CStr(j) + " " + Gio(j) + " " + VD(j) + " " + KD(j) + " " +
CStr(100)
End If
ts_G.WriteLine (toado)
modefile = True
Else
MsgBox ("Khong dung format !")
End If
Next
Close
End If
MsgError:
9
If modefile = False Then MsgBox ("Loi mo file. File : " & filespec & " Khong dung
format")
Else
MsgBox ("Chi lam viec voi file WGS84 !" & filespec)
Exit Function
End If
End Function
I.2 Chuyển format Ctranfer -> Btranfer
Private Sub Btranfer_Click()
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String
With List1
Screen.MousePointer = vbHourglass
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
ProBar1.Max = .ListCount
ProBar1.Visible = True
For Index = 0 To .ListCount - 1
If (Right$(Dir1.Path, 1) <> "\") Then
filespec = Dir1.Path & "\" & List1.List(Index)
filespeckq = Dir1.Path & "\" & Left$(List1.List(Index),
(Len(List1.List(Index)) - 3)) & ".B84"
Else
filespec = Dir1.Path & List1.List(Index)
filespeckq = Dir1.Path & Left$(List1.List(Index), (Len(List1.List(Index)) - 3))
& ".B84"
End If
FrmKetqua.List1.AddItem Left$(List1.List(Index), (Len(List1.List(Index)) - 3))
& ".B84"
Call CTra_BTra(filespec, filespeckq)
ProBar1.Value = Index + 1
Next
End If
Screen.MousePointer = vbDefault
FrmKetqua.Label1.Caption = " Ket qua chua trong thu muc : " & LCase(Dir1.Path)
FrmKetqua.Show vbModal
10
ProBar1.Visible = False
End With
Call Dir1_Change
End Sub
Private Function CTra_BTra(filespec As String, filespeckq As String)
Dim modefile As Boolean
modefile = False
On Error GoTo MsgError
Dim j As Integer, numvals As Integer, sodd As Integer
Dim ngay() As String, Gio() As String, VD() As String, KD() As String, toado() As
String
Dim STT() As Integer
Dim strin(25000) As String
Dim myvar As Variant
If LCase(Right$(filespec, 3)) = LCase("rpt") Then
numvals = 0
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim fso_G As New FileSystemObject
Dim ts_G As TextStream
Dim tam_STR As String
Set ts = fso.OpenTextFile(filespec)
Do While Not ts.AtEndOfStream
numvals = numvals + 1
strin(numvals) = ts.ReadLine
Loop
ts.Close
sodd = numvals
ReDim ngay(sodd - 1), Gio(sodd - 1), VD(sodd - 1), KD(sodd - 1), toado(sodd - 2)
ReDim STT(sodd - 1)
Set ts_G = fso_G.CreateTextFile(filespeckq)
For j = 10 To sodd - 6
Dim i As Integer
myvar = Split(strin(j), " ")
For i = LBound(myvar) To UBound(myvar)
Next
Gio(j) = Left$(Right$(myvar(0), 11), 8)
VD(j) = Right$(myvar(0), 2) + myvar(1) + Left$(myvar(2), 7)
KD(j) = Right$(myvar(2), 3) + myvar(3) + myvar(4)
KD(j) = Left$(KD(j), 11)
toado(j) = CStr(j - 9) + " " + Gio(j) + " " + VD(j) + " " + KD(j)
11
ts_G.WriteLine (toado(j))
modefile = True
Next
ts_G.Close
MsgError:
If modefile = False Then MsgBox ("Loi mo file. File : " & filespec & " Khong dung
format")
Else
MsgBox ("Chi xu ly file *.rpt !")
End If
End Function
I.3 Gắn toạ độ
Dim Index As Integer
Dim filespec As String
Dim filespeckq As String
Dim modeOK As Integer
Dim sfilename As String
With List1
If .ListCount = 0 Then
MsgBox "Chua co danh sach file ! ", vbInformation + vbOKOnly
Screen.MousePointer = vbDefault
Exit Sub
Else
sfilename = CurDir & "\tuxakt.mdb"
sfilename = Dir(sfilename)
If sfilename <> vbNullString Then
ProBar1.Max = .ListCount
ProBar1.Visible = True
For Index = 0 To .ListCount - 1
If Index > 0 Then
If Right$(List1.List(Index), 3) <> Right$(List1.List(Index - 1), 3) Then
MsgBox ("Chi ghep cac file cung ten tuyen !")
Screen.MousePointer = vbDefault
Exit Sub
End If
End If
Next
Dim thumuc As String
If (Right$(Dir1.Path, 1) <> "\") Then
thumuc = Dir1.Path & "\"
Else
thumuc = Dir1.Path