global.bas

一个较好的自适应遗传算法

      For k = 1 To linex1 - 1
       xr = xr + griddx(k)
      Next k
      x1 = draw_plotx(xr)
      For k = linex1 To i - 1
       xr = xr + griddx(k)
      Next k
      x2 = draw_plotx(xr)
      jmq_zone_num = jmq_zone_num + 1
      jmq_zone(jmq_zone_num, 1) = x1
      jmq_zone(jmq_zone_num, 2) = y1
      jmq_zone(jmq_zone_num, 3) = x2
      jmq_zone(jmq_zone_num, 4) = y2
      linebz = 0
     End If
    Next i
    If linebz = 1 Then
     xr = 0#
     For k = 1 To linex1 - 1
      xr = xr + griddx(k)
     Next k
     x1 = draw_plotx(xr)
     jmq_zone_num = jmq_zone_num + 1
     jmq_zone(jmq_zone_num, 1) = x1
     jmq_zone(jmq_zone_num, 2) = y1
     jmq_zone(jmq_zone_num, 3) = draw_plotx(gridx)
     jmq_zone(jmq_zone_num, 4) = y2
    End If
   Next j
  End If
End Sub

Public Function static_lsdim(a_layer, a_static)
 If a_static = 1 Then
  static_lsdim = 4
 Else
  static_lsdim = 4 + (a_static - 2) * layernum + a_layer
 End If
End Function

'----------------------------------open-save mod -------------------------------------
Public Sub openfile_mod(filename$)
  Open filename$ For Input As #1
  Input #1, A$
  Input #1, FRAC_mod
  If FRAC_mod = -1 Then static_num = 20 Else static_num = 10
  Input #1, A$
  Input #1, qkname$
  Input #1, A$
  Input #1, oilfield_bz$
  Input #1, A$
  Input #1, rem1$
  Input #1, A$
  Input #1, rem2$
  Input #1, A$
  Input #1, rem3$
  Input #1, A$
  Input #1, bb$
  start_time$ = Left$(bb$, 6)
  end_time$ = Right$(bb$, 6)
  Input #1, A$
  Input #1, caldays, interval_time
  Input #1, A$
  Input #1, gridx, gridy, layernum, reserves, vpor
  Input #1, A$
  Input #1, griddxnum, griddynum
  For i = 1 To griddxnum
   Input #1, griddx(i)
  Next i
  For i = 1 To griddynum
   Input #1, griddy(i)
  Next i
  '
  Input #1, A$
  Input #1, wellnum
  For i = 1 To wellnum
   Input #1, wellx(i), welly(i), wellname_in$
   If Len(wellname_in$) <= wellname_max Then wellname$(i) = Trim$(wellname_in$): wellname_other$(i, 1) = "": wellname_other$(i, 2) = "": GoTo 2
   If Len(wellname_in$) > wellelsename_max + wellname_max + 4 Then
    wellname$(i) = Trim$(Left$(wellname_in$, wellname_max))
    wellname_other$(i, 1) = Trim$(Mid$(wellname_in$, wellname_max + 3, wellelsename_max))
    wellname_other$(i, 2) = Trim$(Mid$(wellname_in$, wellelsename_max + wellname_max + 4 + 1, Len(wellname_in$) - wellelsename_max + wellname_max + 4))
    GoTo 2
   End If
   wellname$(i) = Trim$(Left$(wellname_in$, wellname_max))
   wellname_other$(i, 1) = Trim$(Mid$(wellname_in$, wellname_max + 3, Len(wellname_in$) - wellname_max - 2))
   wellname_other$(i, 2) = ""
2 Next i
'
  Input #1, A$
  Input #1, duannum
  For i = 1 To duannum
   Input #1, duanpointnum(i), duancor(i)
   For j = 1 To duanpointnum(i)
    Input #1, duanx(i, j), duany(i, j)
   Next j
   For j = 1 To layer_max
    duanlayer(i, j) = 0
   Next j
   For j = 1 To layernum
    Input #1, duanlayer(i, j)
   Next j
  Next i
  
  ReDim uselessgridx(useless_layernum, layernum), uselessgridy(useless_layernum, layernum), uselessgridnum(layernum)
  Input #1, A$
  Input #1, equbz
  If equbz = -1 Then
   Input #1, uselessgridnum(1)
   For i = 1 To uselessgridnum(1)
    Input #1, uselessgridx(i, 1), uselessgridy(i, 1)
   Next i
   If layernum > 1 Then
    For j = 2 To layernum
     uselessgridnum(j) = uselessgridnum(1)
     For i = 1 To uselessgridnum(1)
      uselessgridx(i, j) = uselessgridx(i, 1)
      uselessgridy(i, j) = uselessgridy(i, 1)
     Next i
    Next j
   End If
  Else
   For j = 1 To layernum
    Input #1, ii, uselessgridnum(j)
    For i = 1 To uselessgridnum(j)
     Input #1, uselessgridx(i, j), uselessgridy(i, j)
    Next i
   Next j
  End If
  Close #1
End Sub

Public Sub savefile_mod(filename$)
  Static printuse()
  ReDim printuse(layer_max)
  Open filename$ For Output As #1
  '
  Print #1, "双重介质标志"
  Print #1, FRAC_mod
  '
  Print #1, "区块名"
  Print #1, qkname$
  '
  Print #1, "油田代码"
  Print #1, oilfield_bz$
  '
  Print #1, "注释一"
  Print #1, rem1$
  Print #1, "注释二"
  Print #1, rem2$
  Print #1, "注释三"
  Print #1, rem3$
  '
  Print #1, "起止时间"
  Print #1, start_time$ + " " + end_time$
  '
  Print #1, "每月计算天数，时间间隔"
  Print #1, caldays, interval_time
  '
  Print #1, "油藏长度，宽度，层数，地质储量，孔隙体积"
  Print #1, gridx, gridy, layernum, reserves, vpor
  '
  Print #1, "网格划分数据"
  Print #1, griddxnum, griddynum
  If griddxnum >= 1 Then Call printgrid(griddxnum, griddx(), "####0.00")
  If griddynum >= 1 Then Call printgrid(griddynum, griddy(), "####0.00")
  '
  Print #1, "井位数据"
  Print #1, wellnum
  If wellnum >= 1 Then
   For i = 1 To wellnum
    Print #1, outc$(wellx(i), "####0.00"); outc$(welly(i), "####0.00"); "  "; outc2$(UCase$(Trim$(wellname$(i))), wellname_max);
    Print #1, "  "; outc2$(UCase$(Trim$(wellname_other$(i, 1))), wellelsename_max); "  "; outc2$(UCase$(Trim$(wellname_other$(i, 2))), wellelsename_max)
   Next i
  End If
  '
  Print #1, "断层线数据"
  Print #1, duannum
  If duannum >= 1 Then
   For i = 1 To duannum
    Print #1, duanpointnum(i), duancor(i)
    For j = 1 To duanpointnum(i)
     Print #1, outc$(duanx(i, j), "####0.00"); outc$(duany(i, j), "####0.00")
    Next j
    For j = 1 To layernum
     printuse(j) = duanlayer(i, j)
    Next j
    Call printgrid(layernum, printuse(), "###")
   Next i
  End If
  '
  Print #1, "无效网格数据"
  If well.SSCheck1.Value = True Then
   Print #1, -1
   Print #1, uselessgridnum(1)
   If uselessgridnum(1) >= 1 Then
    For i = 1 To uselessgridnum(1)
     Print #1, outc$(uselessgridx(i, 1), "#####"); outc$(uselessgridy(i, 1), "#####")
    Next i
   End If
  Else
   Print #1, 0
   For j = 1 To layernum
    Print #1, j, uselessgridnum(j)
    If uselessgridnum(j) >= 1 Then
     For i = 1 To uselessgridnum(j)
      Print #1, outc$(uselessgridx(i, j), "#####"); outc$(uselessgridy(i, j), "#####")
     Next i
    End If
   Next j
  End If
  Close #1
  'save surf files
  'bbb = -1
  bbb = 0
  If bbb = 0 Then Exit Sub
  pathsurf$ = "d:\hj\纯梁\surf\"
  Open pathsurf$ + "grid.bln" For Output As #1
  Print #1, "1"
  Print #1, "0,0"
  Print #1, "1"
  Print #1, Trim$(Str$(gridx)) + "," + Trim$(Str$(gridy))
  dxjs = 0
  For i = 1 To griddxnum - 1
   dxjs = dxjs + griddx(i)
   Print #1, "2"
   Print #1, Trim$(Str$(dxjs)) + ",0"
   Print #1, Trim$(Str$(dxjs)) + "," + Trim$(Str$(gridy))
  Next i
  dyjs = 0
  For i = griddynum To 2 Step -1
   dyjs = dyjs + griddy(i)
   Print #1, "2"
   Print #1, "0," + Trim$(Str$(dyjs))
   Print #1, Trim$(Str$(gridx)) + "," + Trim$(Str$(dyjs))
  Next i
  Close #1
  
  If Dir(pathsurf$ + "wname.dat") = "" Then
   Open pathsurf$ + "wname.dat" For Output As #1
   Print #1, "0,0"
   Print #1, "0," + Trim$(Str$(gridy))
   Print #1, Trim$(Str$(gridx)) + "," + Trim$(Str$(gridy))
   For i = 1 To wellnum
    wellbz = 3
    Print #1, Trim$(Str$(wellx(i))) + ",";
    Print #1, Trim$(Str$(gridy - welly(i))) + ",";
    Print #1, Chr$(34) + Trim$(wellname$(i)) + Chr$(34) + ",";
    Print #1, Trim$(Str$(wellbz))
   Next i
   Close #1
  End If
  
  For i = 1 To layernum
   If Dir(pathsurf$ + "base" + Trim$(Str$(i)) + ".bln") = "" Then
    If duannum >= 1 Then
     Open pathsurf$ + "base" + Trim$(Str$(i)) + ".bln" For Output As #1
     Open pathsurf$ + "blank" + Trim$(Str$(i)) + ".bln" For Output As #2
     bz1 = 0: bz2 = 0
     Print #1, "1"
     Print #1, "0,0"
     Print #1, "1"
     Print #1, Trim$(Str$(gridx)) + "," + Trim$(Str$(gridy))
     For j = 1 To duannum
      If duanlayer(j, i) = -1 Then
       if1 = Abs(duanx(j, 1) - duanx(j, duanpointnum(j))) <= 0.001 And Abs(duany(j, 1) - duany(j, duanpointnum(j))) <= 0.001
       If if1 Then
        bz2 = bz2 + 1
        Print #2, Trim$(Str$(duanpointnum(j))) + ",1"
        For k = 1 To duanpointnum(j)
         Print #2, Trim$(Str$(duanx(j, k))) + "," + Trim$(Str$(gridy - duany(j, k)))
        Next k
       Else
        bz1 = bz1 + 1
        Print #1, Trim$(Str$(duanpointnum(j)))
        For k = 1 To duanpointnum(j)
         Print #1, Trim$(Str$(duanx(j, k))) + "," + Trim$(Str$(gridy - duany(j, k)))
        Next k
       End If
      End If
     Next j
     Close #1: Close #2
     If bz1 = 0 Then Kill pathsurf$ + "base" + Trim$(Str$(i)) + ".bln"
     If bz2 = 0 Then Kill pathsurf$ + "blank" + Trim$(Str$(i)) + ".bln"
    End If
   End If
  Next i
  
End Sub

Public Sub openfile_scn(filename$, BZ)
  Open filename$ For Input As #1
  Input #1, A$
  Input #1, picture_name$
  Input #1, A$
  Input #1, image_xa, image_xb, image_ya, image_yb
  image_xa = image_xa * formbl_x: image_xb = image_xb * formbl_x
  image_ya = image_ya * formbl_y: image_yb = image_yb * formbl_y
  Input #1, A$
  Input #1, blc_setbz
  If blc_setbz = 0 Then
   For i = 1 To 2
    Input #1, blc_zbx(i), blc_zby(i)
    blc_zbx(i) = blc_zbx(i) * formbl_x
    blc_zby(i) = blc_zby(i) * formbl_y
   Next i
   If BZ = 2 Then blc_lenth = Sqr((blc_zbx(2) - blc_zbx(1)) ^ 2 + (blc_zby(2) - blc_zby(1)) ^ 2)
   Input #1, blc_bl
  End If
  Input #1, A$
  Input #1, ml_setbz
  If ml_setbz = 0 Then
   For i = 1 To 4
    Input #1, ml_zbx(i), ml_zby(i)
    ml_zbx(i) = ml_zbx(i) * formbl_x
    ml_zby(i) = ml_zby(i) * formbl_y
   Next i
   If BZ = 2 And blc_setbz = 0 Then
    gridx = Sqr((ml_zbx(2) - ml_zbx(1)) ^ 2 + (ml_zby(2) - ml_zby(1)) ^ 2) / blc_lenth * blc_bl
    gridy = Sqr((ml_zbx(3) - ml_zbx(2)) ^ 2 + (ml_zby(3) - ml_zby(2)) ^ 2) / blc_lenth * blc_bl
   End If
  End If
  '
  Input #1, A$
  Input #1, wellnum
  wellnum_jsq = 0
  For i = 1 To wellnum
   Input #1, wellx(i), welly(i), wellname_in$
   wellx(i) = wellx(i) * formbl_x: welly(i) = welly(i) * formbl_y
   wellname$(i) = Trim$(wellname_in$)
   If BZ = 2 And blc_setbz = 0 And ml_setbz = 0 Then
    Call change_xy(wellx(i), welly(i), blc_lenth, jsz_bz)
    If jsz_bz = -1 Then
     wellnum_jsq = wellnum_jsq + 1
     wellx(wellnum_jsq) = wellx(i): welly(wellnum_jsq) = welly(i)
     wellname_other$(wellnum_jsq, 1) = "": wellname_other$(wellnum_jsq, 2) = ""
    End If
   End If
  Next i
  If BZ = 2 And blc_setbz = 0 And ml_setbz = 0 Then wellnum = wellnum_jsq
 '
  Input #1, A$
  Input #1, duannum
  duannum_jsq = 0
  For i = 1 To duannum
   Input #1, duanpointnum(i), duancor(i)
   duanpointnum_jsq = 0
   For j = 1 To duanpointnum(i)
    Input #1, duanx(i, j), duany(i, j)
    duanx(i, j) = duanx(i, j) * formbl_x: duany(i, j) = duany(i, j) * formbl_y
    If BZ = 2 And blc_setbz = 0 And ml_setbz = 0 Then
     Call change_xy(duanx(i, j), duany(i, j), blc_lenth, jsz_bz)
     If jsz_bz = -1 Then
      If Abs(duanx(i, j) - 0) <= gridx / 150 Then duanx(i, j) = 0
      If Abs(duanx(i, j) - gridx) <= gridx / 150 Then duanx(i, j) = gridx
      If Abs(duany(i, j) - 0) <= gridy / 150 Then duany(i, j) = 0
      If Abs(duany(i, j) - gridy) <= gridy / 150 Then duany(i, j) = gridy
      If duanpointnum_jsq = 0 Then duannum_jsq = duannum_jsq + 1
      duanpointnum_jsq = duanpointnum_jsq + 1
      duanx(duannum_jsq, duanpointnum_jsq) = duanx(i, j): duany(duannum_jsq, duanpointnum_jsq) = duany(i, j)
     End If
    End If
   Next j
   If BZ = 2 And blc_setbz = 0 And ml_setbz = 0 And duanpointnum_jsq <> 0 Then duanpointnum(duannum_jsq) = duanpointnum_jsq: duancor(duannum_jsq) = duancor(i)
  Next i
  If BZ = 2 And blc_setbz = 0 And ml_setbz = 0 Then duannum = duannum_jsq
  Close #1
End Sub

Public Sub savefile_scn(filename$)
  Open filename$ For Output As #1
  '
  Print #1, "图片名"
  Print #1, picture_name$
  '
  Print #1, "image1坐标"
  Print #1, image_xa / formbl_x, image_xb / formbl_x, image_ya / formbl_y, image_yb / formbl_y
  '
  Print #1, "比例尺"
  Print #1, blc_setbz
  If blc_setbz = 0 Then
   For i = 1 To 2
    Print #1, blc_zbx(i) / formbl_x, blc_zby(i) / formbl_y
   Next i
   Print #1, blc_bl
  End If
  '
  Print #1, "模拟区域"
  Print #1, ml_setbz
  If ml_setbz = 0 Then
   For i = 1 To 4
    Print #1, ml_zbx(i) / formbl_x, ml_zby(i) / formbl_y