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 [...]... - 1 If (Right$(Dir1.Path, 1) "\") Then filespec = Dir1.Path & "\" & List1.List(Index) filespeckq = Dir1.Path & "\" Else filespec = Dir1.Path & List1.List(Index) filespeckq = Dir1.Path End If 16 FrmKetqua.List1.AddItem Left$(List1.List(Index), (Len(List1.List(Index)) - 3)) & "cvg" Call catvong_f(filespec, filespeckq) ProBar1.Value = Index + 1 Next Screen.MousePointer = vbDefault FrmKetqua.Label1.Caption... Double Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double Dim xt1 As Double, yt1 As Double, xt2 As Double, yt2 As Double Dim tam As String L1 = 0 For i = 1 To Sodd_tua If Abs(giaodiemX - X_tua(i)) < 2000 And Abs(giaodiemY Y_tua(i)) < 2000 Then L1 = L1 + 1 33 Tam_tg_tua(L1) = Tg_tua(i) Tam_TU_tua(L1) = TU_tua(i) Tam_X_tua(L1) = X_tua(i) Tam_Y_tua(L1) = Y_tua(i) End If Next L2 = 0 For i = 1 To sodd_thg... = L2 + 1 Tam_tg_thg(L2) = Tg_thg(i) Tam_TU_thg(L2) = Tu_thg(i) Tam_X_thg(L2) = X_thg(i) Tam_Y_thg(L2) = Y_thg(i) End If Next Dim GD_X As Double, GD_Y As Double For i = 2 To L1 xt1 = Tam_X_tua(i - 1) yt1 = Tam_Y_tua(i - 1) xt2 = Tam_X_tua(i) yt2 = Tam_Y_tua(i) For j = 2 To L2 x1 = Tam_X_thg(j - 1) y1 = Tam_Y_thg(j - 1) x2 = Tam_X_thg(j) y2 = Tam_Y_thg(j) Call giaodiem(x1, y1, x2, y2, xt1, yt1, xt2,... To ListCount - 1 15 If (Right$(Dir1.Path, 1) "\") Then filespec = Dir1.Path & "\" & List1.List(Index) filespeckq = Dir1.Path & "\" Else filespec = Dir1.Path & List1.List(Index) filespeckq = Dir1.Path End If ProBar1.Value = Index + 1 Next Else MsgBox ("Khong tim thay Tuxakt.mdb") Exit Sub End If End If Screen.MousePointer = vbDefault MsgBox "Da xu ly song ! Ket qua chua trong : " & Dir1.Path, vbInformation... fso_G.CreateTextFile(Dich_file) 30 Dim Sofile_tua As Integer, Sofile_thg As Integer So_GD = 0 So_SP = 0 With List1 For index1 = 0 To ListCount - 1 If (LCase(Left$(List1.List(index1), 1) ) = LCase("t")) Then List3.AddItem List1.List(index1) Else If LCase(Left$(List1.List(index1), 1) ) LCase("c") Then List2.AddItem List1.List(index1) End If End If Next End With Dim Num_tua As Integer, num_thg As Integer, Sodd_tua As Integer,... CLng(myvar(6)) Ten_tua(j) = CStr(myvar (13 )) Next Dim X_tua1 As Double, Y_tua1 As Double, X_tua2 As Double, Y_tua2 As Double X_tua1 = X_tua (1) Y_tua1 = Y_tua (1) X_tua2 = X_tua(Sodd_tua) Y_tua2 = Y_tua(Sodd_tua) Dim STRline_thg(3000) As String For index2 = 0 To count_thg - 1 If (Right$(Dir1.Path, 1) "\") Then filestg = Dir1.Path & "\" & List2.List(index2) Else filestg = Dir1.Path & List2.List(index2) End... CDbl(myvar(4)) Tu_thg(j) = CLng(myvar(6)) Ten_thg(j) = CStr(myvar (13 )) Next Dim X_thg1 As Double, Y_thg1 As Double, X_thg2 As Double, Y_thg2 As Double X_thg1 = X_thg (1) Y_thg1 = Y_thg (1) X_thg2 = X_thg(sodd_thg) Y_thg2 = Y_thg(sodd_thg) Call giaodiem(X_tua1, Y_tua1, X_tua2, Y_tua2, X_thg1, Y_thg1, X_thg2, Y_thg2) If Modegiaodiem = True Then Dim L1, L2 As Integer Dim Tam_tg_tua(500) As Long, Tam_tg_thg(500)... phuongvi(X (1) , Y (1) , X(sodd), Y(sodd)) na = Right$(ngay (10 ), 2) ngaygoc = "07 / 02 /" & na 'MsgBox (PVi) If PVi >= 0 And PVi = 45 And PVi = 90 And PVi = 13 5 And PVi = 18 0 And PVi . 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. 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. 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. 10 1 13 Chuyên đề 16 : Mã hoá và phân loại dị thờng 11 2 2 I. Chuyên đề 1 : Gắn toạ độ I .1 Chuyển format