用VB读取GRADS数据源码及要点注释

Forcast

’用FORTRAN读取GRADS数据比较多，因工作需将WRF模式结果放进数据库，所以只能用VB来实现，逼着自己写VB代码。第一部分是读取CTL，从中读取XDEF YDEF TDEF 等得起点和间隔，变量名称，单层还是多层。LINUX里CTL文件只有换行符，没有回车符，先将内容分解为N行HANG（），再将每行分解为N列LIE（），在分解每行之前要将多余的空格去掉用自编的SplitSpace（）函数。行内容遇到“VARS”时开始处理变量设VarStart = True，遇到“ENDVARS”时结束处理变量设VarStart = FALSE，注意语句位置。每个变量的出现位置包括多层（秩序）记录好，以便查找。
'GRADS数据二进制文件读取关键点，文中红字是1步步跟踪试出来的。变量类型定义为SINGLE，巧用定义数组里面含有结构方式实现4维数组： DAT（时次，要素变量）.XY(经度，纬度)，这样方便你输出想要的数据。
'我不知道内容放在此版是否合适，有需要测试数据和讨论的可以留言
Private Type GradsVars
  Ename As String: Znow As Integer: Zall As Integer: CName As String  '要素英文名      垂直当前层       垂直总层数       要素中文名
End Type
Private Type GradsData
   XY() As Single  'GRADS数据要素场
End Type
Private Sub Cmd_雨量_Click()
Dim Hang() As String, Lie() As String, CK() As Single, VarStart As Boolean, VarsMax As Integer, Cell() As String
Dim Ys() As GradsVars, Dat() As GradsData
Dim First As Single
VarStart = False: j = 0
Open "chlf_d01_2010060912_0000.CTL" For Input As #1
Line Input #1, a$: Hang() = Split(a$, vbLf): Close #1
For i = 0 To UBound(Hang()): 'Debug.Print Hang(i)
If Hang(i) <> "" Then  '不处理空行
  Call SplitSpace(Hang(i), Lie())
  If UCase(Lie(0)) = "XDEF" Then Xdef = Val(Lie(1)): X0 = Val(Lie(3)): DTX = Val(Lie(4))
  If UCase(Lie(0)) = "YDEF" Then YDEF = Val(Lie(1)): Y0 = Val(Lie(3)): DTY = Val(Lie(4))
  If UCase(Lie(0)) = "ZDEF" Then zdef = Val(Lie(1))
  If UCase(Lie(0)) = "TDEF" Then tdef = Val(Lie(1)): t0 = Lie(3): dtt = Val(Lie(4)):
  If UCase(Lie(0)) = "ENDVARS" Then VarStart = False:   '这句要放前面，防止读到它还处理！
  If VarStart = True Then            '变量行处理部分要夹在中间
     ZZ = Val(Lie(1))
     If ZZ > 0 Then     '多层变量  中文名称后带_两位数层次编号
          For k = 1 To ZZ: j = j + 1: Ys(j).Ename = Lie(0): Ys(j).Znow = k: Ys(j).Zall = ZZ: Ys(j).CName = Format(j, "000_") & Lie(3) & Format(k, "_00"): Next
     Else              '单层变量
         j = j + 1: Ys(j).Ename = Lie(0): Ys(j).Znow = 0: Ys(j).Zall = 0: Ys(j).CName = Format(j, "000_") & Lie(3)
         '加上出现秩序即位置
     End If
  End If
  If UCase(Lie(0)) = "VARS" Then VarStart = True: vars = Val(Lie(1)): ReDim Ys(vars * zdef) As GradsVars
  '开始读变量,这句要放后面，防止此句也处理！
End If: Next
VarsMax = j:
ReDim CK(1 To Xdef, 1 To YDEF) As Single   '根据格点数大小来定义每次读取的数据个数
ReDim Dat(1 To tdef, 1 To VarsMax)  '根据时次数目、要素场数重新定义数据数组,数据个体本身是一个二维结构
For i = 1 To tdef: For j = 1 To VarsMax
ReDim Dat(i, j).XY(1 To Xdef, 1 To YDEF) As Single   '根据格点数来重新定义个体结构里的数组维数大小
Next: Next
For j = 1 To VarsMax: allvars$ = allvars$ & Ys(j).CName & "|": Next  '将所以变量组成总串方便需要某变量时直接找对位置j

Open "chlf_d01_2010060912_0000.dat" For Binary As #2    '数据文件需要拷贝到当前盘来读才快,本地读完0.07S
For t = 1 To tdef   '时间维循环
   For v = 1 To VarsMax   '要素场循环
       Get #2, , First:   'Debug.Print first  '场开始标志，为一个2.5E-41左右很小的数字，估计是Linux与Win的差别造成
       Get #2, , CK: Dat(t, v).XY = CK '采用格点场-数组读取和赋值的方法，大大加快读取速度
       Get #2, , First:   '场结束标志，为一个2.5E-41左右很小的数字
   Next v
Next t: Close #2
End Sub
Public Sub SplitSpace(a$, Cell() As String)  '将行字串分解短子串返回，分隔标志为空格，可以删除原串中多余一个以上的空格
Dim Temp() As String
  Temp() = Split(a$, " "): ' Debug.Print UBound(Temp()) '通过观察测试，中间若空多格，则会出现较多的子空串，但其长度为0
  b$ = "": For j = 0 To UBound(Temp()): If Len(Temp(j)) > 0 Then b$ = b$ & Temp(j) & " "   '将多余子空串不要，再重组
  Next
  Cell() = Split(Trim(b$), " ")   '因为此时已经没有多余的空格，再分隔即得到正确的短子串
End Sub

冬日情愫+

楼主  顶一个！

mofangbao

虽然我对vb比较菜，但是看到源码还是会相当感动了，过两天我也发点自己的源码，嘿嘿

月流火

谢谢分享！！！

qxtlyf

支持原创！！！！！

liujimin025

楼主  顶一个！

demirouge

THANK YOU VERY MUCH

angel1006

这些都是高难度的

river

相当给力啦

xiaodx

万分感谢强大的楼主
下面这句代码不仅帮我解决了读取数据的速度，而且解决了数组太大而导致内存溢出的问题
----------------
Get #2, , CK: Dat(t, v).XY = CK