VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "ProgramNonBorn"
   ClientHeight    =   5910
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6960
   LinkTopic       =   "Form1"
   ScaleHeight     =   5910
   ScaleWidth      =   6960
   StartUpPosition =   3  'Windows の既定値
   Begin VB.TextBox Text4 
      Alignment       =   1  '右揃え
      Height          =   270
      Left            =   4320
      TabIndex        =   21
      Text            =   "0"
      Top             =   4320
      Width           =   1455
   End
   Begin VB.TextBox Text3 
      Height          =   270
      Index           =   1
      Left            =   4080
      TabIndex        =   20
      Text            =   "Charges from ESP fit"
      Top             =   5040
      Width           =   2535
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Option1"
      Height          =   225
      Index           =   1
      Left            =   3720
      TabIndex        =   19
      Top             =   5040
      Value           =   -1  'True
      Width           =   255
   End
   Begin VB.TextBox Text3 
      Height          =   270
      Index           =   0
      Left            =   4080
      TabIndex        =   17
      Text            =   "Mulliken atomic charges"
      Top             =   5400
      Width           =   2535
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Option1"
      Height          =   225
      Index           =   0
      Left            =   3720
      TabIndex        =   16
      Top             =   5400
      Width           =   255
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   120
      TabIndex        =   14
      Top             =   4200
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   975
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   13
      Top             =   4680
      Width           =   3135
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Execution"
      Height          =   375
      Index           =   1
      Left            =   5160
      TabIndex        =   12
      Top             =   3000
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   3480
      TabIndex        =   11
      Text            =   """(LOG)|*.LOG;*.log"""
      Top             =   2520
      Width           =   3255
   End
   Begin VB.TextBox txtName1 
      Height          =   270
      Index           =   0
      Left            =   120
      TabIndex        =   9
      Top             =   360
      Width           =   3135
   End
   Begin VB.FileListBox File1 
      Height          =   1710
      Left            =   3480
      TabIndex        =   3
      Top             =   360
      Width           =   3255
   End
   Begin VB.CommandButton Command1 
      Caption         =   "File Load"
      Height          =   375
      Index           =   0
      Left            =   3480
      TabIndex        =   2
      Top             =   3000
      Width           =   1575
   End
   Begin VB.DirListBox Dir1 
      Height          =   2190
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   3135
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   120
      TabIndex        =   0
      Top             =   3480
      Width           =   3135
   End
   Begin VB.Label Label7 
      Caption         =   "Angstrom"
      Height          =   255
      Left            =   5880
      TabIndex        =   23
      Top             =   4320
      Width           =   855
   End
   Begin VB.Label Label5 
      Caption         =   "Surface modification :"
      Height          =   255
      Left            =   3600
      TabIndex        =   22
      Top             =   4080
      Width           =   1695
   End
   Begin VB.Label Label4 
      Caption         =   "Charge Type :"
      Height          =   255
      Left            =   3600
      TabIndex        =   18
      Top             =   4680
      Width           =   1455
   End
   Begin VB.Label Label6 
      Caption         =   "Data Name"
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   3960
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Filename extension"
      Height          =   165
      Index           =   2
      Left            =   3480
      TabIndex        =   10
      Top             =   2280
      Width           =   1695
   End
   Begin VB.Label Label1 
      Caption         =   "File List"
      Height          =   165
      Index           =   1
      Left            =   3480
      TabIndex        =   8
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "Drive"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   7
      Top             =   3240
      Width           =   1575
   End
   Begin VB.Label Label3 
      Caption         =   "Directory"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   6
      Top             =   720
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   15
      Left            =   360
      TabIndex        =   5
      Top             =   360
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "Filename"
      Height          =   165
      Index           =   0
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x  As Double:  '  Cartesian coordinate x of surface point, based on individual atomic coorinates
Dim y  As Double:  '  Cartesian coordinate y of surface point, based on individual atomic coorinates
Dim z  As Double:  '  Cartesian coordinate z of surface point, based on individual atomic coorinates
Dim o  As Double: '  absolute Cartesian coordinate x of surface point
Dim p  As Double:  '  absolute Cartesian coordinate y of surface point
Dim q  As Double:  '  absolute Cartesian coordinate z of surface point
Dim Ei   As Double:  ' effective electric field, perpendicular to surface
Dim Si  As Double: ' minute surface area
Dim sumS As Double:  ' total E^0 component
Dim sumSEp As Double:  ' total E(positive)^1 component
Dim sumSE2p As Double:  ' total E(positive)^2 component
Dim sumSEn As Double:  ' total E(negative)^1 component
Dim sumSE2n As Double:  ' total E(negative)^2 component
Dim TsumS As Double:  ' Program Variables, concerning total E^0 component
Dim TsumSEp As Double:  ' Program Variables, concerning total E(positive)^1 component
Dim TsumSE2p As Double:  ' Program Variables, concerning total E(positive)^2 component
Dim TsumSEn As Double:  ' Program Variables, concerning total E(negative)^1 component
Dim TsumSE2n As Double:  ' Program Variables, concerning total E(negative)^2 component
'
Dim Coor(6) As String ' orientation of molecule
Dim DataName As String ' Data filename
Dim AtomNum As Integer ' the number of atoms
Dim K(100) As Double ' atomic number of atoms
Dim t0(100) As Double ' original Cartesian coordinate x of atoms
Dim u0(100) As Double ' original Cartesian coordinate y of atoms
Dim v0(100) As Double ' original Cartesian coordinate z of atoms
Dim r(100) As Double ' radii of atoms
Dim rmod(100) As Double ' radii of atoms
Dim t(100) As Double ' Cartesian coordinate x of atoms
Dim u(100) As Double '  Cartesian coordinate y of atoms
Dim v(100) As Double '  Cartesian coordinate z of atoms
Dim Species(100) As String ' the kind of atoms
Dim ChargeType(1) As String: ' charge type
Dim ChargeSelect As Integer: ' charge type selection number
Dim Charge(1, 100) As Double: ' charge of atoms
Dim CCharge(1, 100) As Double: ' charge of atoms in C
Dim TCharge(1) As Double: ' total charge of molecule
Dim Ex As Double:  ' x component of surface electric field
Dim Ey   As Double:  ' y component of surface electric field
Dim Ez   As Double:  ' z component of surface electric field
Dim Theta  As Double:  '  polar coordinate Theta of surface point
Dim ThStepWidth  As Double:  '  polar coordinate Theta of surface point
Dim Phi  As Double:  '  polar coordinate Phi of surface point
Dim PhiContr(90) As Integer:  ' Program Variables, concerning step number of Phi
Dim PhiStep(90) As Double:  ' Program Variables, concerning step width of Phi
Dim eS(90)  As Double: ' elementary surface area
Dim SurfModif  As Double: ' surface Modification
Dim ee As Double: ' elementary charge
Dim eps0 As Double:   ' electric constant
Dim pi As Double:   ' constant pi
Dim DPath As String:  ' file directory
Dim FlagOPComp As String:  ' control Variables for program, Optimization completeness flag
Dim FlagAlfaBeta As String
Private Sub Command2_Click(Index As Integer): ' Calculation execution
Dim m(100) As Double
Dim w(100) As Double
Dim Nameadd As String
Dim Nameadd2 As String

    B = pi / 180
    
    TsumS = 0
    TsumSEp = 0
    TsumSE2p = 0
    TsumSEn = 0
    TsumSE2n = 0
    
Text1.Text = "　　                     　　"
    
Nameadd2 = ""
If SurfModif <> 0 Then
    Nameadd2 = "-" + CStr(SurfModif)
End If

A$ = ChargeType(ChargeSelect)
Select Case A$
    Case ""
        Nameadd = ""
    Case "Charges from ESP fit"
        Nameadd = " ESP"
    Case "Mulliken atomic charges"
        Nameadd = " MUL"
    Case "Natural Population"
        Nameadd = " NP"
    Case "Hirshfeld charge"
        Nameadd = "HIR"
    Case "AIM charge"
        Nameadd = "AIM"
End Select

Select Case FlagOPComp
    Case "Y"
        Open DPath + "\" + Left$(DataName, Len(DataName) - 4) + Nameadd + Nameadd2 + ".RES" For Output As #3
        Open DPath + "\" + Left$(DataName, Len(DataName) - 4) + Nameadd + Nameadd2 + ".txt" For Output As #4
    Case "?"
        Open DPath + "\" + Left$(DataName, Len(DataName) - 4) + Nameadd + Nameadd2 + "un.RES" For Output As #3
        Open DPath + "\" + Left$(DataName, Len(DataName) - 4) + Nameadd + Nameadd2 + "un.txt" For Output As #4
    Case Else
' erasing calculation execution button
        Command2(1).Visible = False
        Text1.Text = "Optimization not completed!!"
' erasing progress situation
        CurrentX = 3800
        ForeColor = &H8000000F
        CurrentY = 3450: Print "Progress Situation"
        CurrentX = 3550
        For i = 1 To 6
            CurrentX = CurrentX + 450
            ResX = CurrentX
            CurrentY = 3650: Print i
            CurrentX = ResX + 40
            CurrentY = 3800: Print "X"
            CurrentX = ResX
        Next i
        Exit Sub
End Select


' presenting progress situation
ForeColor = vbWindowText
CurrentX = 3800
CurrentY = 3450: Print "Progress Situation"
CurrentX = 3550

For i = 1 To 6
    CurrentX = CurrentX + 450
    ResX = CurrentX
    CurrentY = 3650: Print i
    CurrentX = ResX
Next i
CurrentX = 3590

For i0 = 1 To 6
    Select Case i0: ' orientational selection
        Case 1
            Coor(1) = "xyz"
            For i = 1 To AtomNum
                t(i) = t0(i): u(i) = u0(i): v(i) = v0(i)
            Next i
        Case 2
            Coor(2) = "yzx"
            For i = 1 To AtomNum
                t(i) = u0(i): u(i) = v0(i): v(i) = t0(i)
            Next i
        Case 3
            Coor(3) = "zxy"
            For i = 1 To AtomNum
                t(i) = v0(i): u(i) = t0(i): v(i) = u0(i)
            Next i
        Case 4
            Coor(4) = "xzy"
            For i = 1 To AtomNum
                t(i) = t0(i): u(i) = v0(i): v(i) = u0(i)
            Next i
        Case 5
            Coor(5) = "yxz"
            For i = 1 To AtomNum
                t(i) = u0(i): u(i) = t0(i): v(i) = v0(i)
            Next i
        Case 6
            Coor(6) = "zyx"
            For i = 1 To AtomNum
                t(i) = v0(i): u(i) = u0(i): v(i) = t0(i)
            Next i
    End Select
        
    sumS = 0
    sumSEp = 0
    sumSE2p = 0
    sumSEn = 0
    sumSE2n = 0

' Determination of Phi control parameters
    PhiContr(0) = 1: PhiStep(0) = 360
    eS(0) = 2 * pi * (Cos(B * 0) - Cos(B * 1))
    PhiContr(90) = 1: PhiStep(90) = 360
    eS(90) = 2 * pi * (Cos(B * 0) - Cos(B * 1))
    For i = 1 To 89
        Theta = ThStepWidth * i
        PhiContr(i) = -Int(-Sin(B * Theta) * 180 / 2) * 2
        PhiStep(i) = 360 / PhiContr(i)
        eS(i) = 2 * pi * Abs((Cos(B * (Theta + 1)) - Cos(B * (Theta - 1)))) / PhiContr(i)
    Next i
    
' Output of input data
If i0 = 1 Then
    Print #3, AtomNum
    For i = 1 To AtomNum
        Print #3, i, K(i), t(i), u(i), v(i)
    Next i
    Print #3, TCharge(ChargeSelect)
    For i = 1 To AtomNum
        Print #3, i, Species(i), Charge(ChargeSelect, i)
    Next i
    Print #3, ""
    Print #3, "ChargeType : "; ChargeType(ChargeSelect)
    Print #3, "Surface modification= "; SurfModif; " Angstrom"
    Print #3, ""
    Print #3, "     ----------------------------------------------------------  "
    Print #3, ""
    Print #4, "ChargeType : "; ChargeType(ChargeSelect)
    Print #4, "Surface modification= "; SurfModif; " Angstrom"
    Print #4, "I", "Si", "o", "p", "q", "Ei "
End If
    
' Calculation of sumS, sumSEp, sumSE2p, sumSEn, sumSE2n
    For i = 1 To AtomNum
        For II = 0 To 90
            Theta = ThStepWidth * II
            For iii = 0 To PhiContr(II) - 1
                Phi = PhiStep(II) * iii
    Text1.Text = Phi
                FlagOuterS = "Y"
                A = B * Phi
                D = B * Theta
                x = rmod(i) * Sin(D) * Cos(A)
                y = rmod(i) * Sin(D) * Sin(A)
                z = rmod(i) * Cos(D)
                o = x + t(i)
                p = y + u(i)
                q = z + v(i)
          
                For n = 1 To AtomNum
                    m(n) = (o - t(n)) ^ 2 + (p - u(n)) ^ 2 + (q - v(n)) ^ 2
                    w(n) = rmod(n) ^ 2
                    If n <> i Then
                        If m(n) <= w(n) Then
                            FlagOuterS = "N"
                            n = AtomNum
                        End If
                    End If
                Next n
                If FlagOuterS = "N" Then GoTo com1
          
                Ex = 0#
                Ey = 0#
                Ez = 0#
                         
                For n = 1 To AtomNum
                    Ex = Ex + CCharge(ChargeSelect, n) / 4 / pi / eps0 / m(n) * (o - t(n)) / Sqr(m(n))
                    Ey = Ey + CCharge(ChargeSelect, n) / 4 / pi / eps0 / m(n) * (p - u(n)) / Sqr(m(n))
                    Ez = Ez + CCharge(ChargeSelect, n) / 4 / pi / eps0 / m(n) * (q - v(n)) / Sqr(m(n))
                Next n


                Ex = Ex * 100000000000#: 'Angstrom to   V nm-1
                Ey = Ey * 100000000000#: 'Angstrom to   V nm-1
                Ez = Ez * 100000000000#: 'Angstrom to   V nm-1

                Ei = (Ex * (o - t(i)) + Ey * (p - u(i)) + Ez * (q - v(i))) / Sqr(m(i))
        
                Si = (rmod(i) / 10) ^ 2 * eS(II): ' r/10: radii in nm
                sumS = sumS + Si
                If i0 = 1 Then Print #4, i; " "; Si; " "; o; " "; p; " "; q; " "; Ei
          
                If Ei > 0 Then
                    sumSEp = sumSEp + Si * Ei
                    sumSE2p = sumSE2p + Si * (Ei ^ 2)
                Else
                    If Ei < 0 Then
                        sumSEn = sumSEn + Si * Ei
                        sumSE2n = sumSE2n + Si * (Ei ^ 2)
                    End If
                End If
com1:
            Next iii
        Next II
      Next i
      
    TsumS = TsumS + sumS
    TsumSEp = TsumSEp + sumSEp
    TsumSE2p = TsumSE2p + sumSE2p
    TsumSEn = TsumSEn + sumSEn
    TsumSE2n = TsumSE2n + sumSE2n

    If i0 = 1 Then Print #3, " sumS"; "                        sumSEp"; "                    sumSE^2p"; "              sumSEn"; "                   sumSE^2n"
    Print #3, sumS; " "; sumSEp; " "; sumSE2p; " "; sumSEn; " "; sumSE2n; " "; Coor(i0)
    CurrentX = CurrentX + 450
    ResX = CurrentX
    CurrentY = 3800: Print "X"
    CurrentX = ResX
    
Next i0

Print #3, "       "
Print #3, TsumS / 6; " "; TsumSEp / 6; " "; TsumSE2p / 6; " "; TsumSEn / 6; " "; TsumSE2n / 6; " "; "Mean"

Close #3
Close #4

Text1.Text = "　　Calculation completed　　"

End Sub

Private Sub Drive1_Change()

    Dim objFSO As FileSystemObject
    Dim objDrive As Drive

    Set objFSO = CreateObject("Scripting.FileSystemobject")
    Set objDrive = objFSO.GetDrive(Drive1)
    
    If Not objDrive.IsReady Then Exit Sub
    
    Dir1.Path = Drive1

    Set objFSO = Nothing
    Set objDrive = Nothing

End Sub

Private Sub Dir1_Change()

    ' ﾌｧｲﾙ ﾘｽﾄ ﾎﾞｯｸｽを、ﾃﾞｨﾚｸﾄﾘ ﾘｽﾄ ﾎﾞｯｸｽと連動して更新します。
    File1.Path = Dir1.Path
    
End Sub
Private Sub Setradii(Aspec As String, avdW As Double): ' van der Waals (vdW ) radii in Angstrom
    
    Select Case Aspec
        Case "H"
            avdW = 1.2
        Case "He"
            avdW = 1.4
        Case "Li"
            avdW = 1.82
        Case "Be": '  Bastsanov table4
            avdW = 1.38
        Case "B": '   Bastsanov table4
            avdW = 1.2
        Case "C"
            avdW = 1.7
        Case "N"
            avdW = 1.55
        Case "O"
            avdW = 1.52
        Case "F"
            avdW = 1.47
        Case "Ne"
            avdW = 1.54
        Case "Na"
            avdW = 2.27
        Case "Mg"
            avdW = 1.73
        Case "Al": '   Bastsanov table4
            avdW = 1.75
        Case "Si"
            avdW = 2.1
        Case "P"
            avdW = 1.8
        Case "S"
            avdW = 1.8
        Case "Cl"
            avdW = 1.75
        Case "Ar"
            avdW = 1.88
        Case "K"
            avdW = 2.75
        Case "Ca": '   Bastsanov table4
            avdW = 2.41
        Case "Sc": '   Bastsanov table4
            avdW = 1.98
        Case "Ti": '   Bastsanov table4
            avdW = 1.8
        Case "V": '    Bastsanov table4
            avdW = 1.72
        Case "Cr": '   Bastsanov table4
            avdW = 1.67
        Case "Mn": '   Bastsanov table4
            avdW = 1.66
        Case "Fe": '   Bastsanov table4
            avdW = 1.65
        Case "Co": '   Bastsanov table4
            avdW = 1.64
        Case "Ni"
            avdW = 1.63
        Case "Cu"
            avdW = 1.4
        Case "Zn"
            avdW = 1.39
        Case "Ga"
            avdW = 1.87
        Case "Ge": '   Bastsanov table4
            avdW = 1.77
        Case "As"
            avdW = 1.85
        Case "Se"
            avdW = 1.9
        Case "Br"
            avdW = 1.85
        Case "Kr"
            avdW = 2.02
        Case "Rb": '   Bastsanov table4"
            avdW = 3.04
        Case "Sr": '   Bastsanov table4"
            avdW = 2.63
        Case "Y": '    Bastsanov table4
            avdW = 2.2
        Case "Zr": '   Bastsanov table4
            avdW = 1.96
        Case "Nb": '   Bastsanov table4
            avdW = 1.86
        Case "Mo": '   Bastsanov table4
            avdW = 1.76
        Case "Tc": '   Bastsanov table4
            avdW = 1.73
        Case "Ru": '   Bastsanov table4
            avdW = 1.81
        Case "Rh": '   Bastsanov table4
            avdW = 1.75
        Case "Pd"
            avdW = 1.63
        Case "Ag":
            avdW = 1.77
        Case "Cd"
            avdW = 1.58
        Case "In"
            avdW = 1.93
        Case "Sn"
            avdW = 2.17
        Case "Sb": '   Bastsanov table4
            avdW = 2.03
        Case "Te"
            avdW = 2.06
        Case "I"
            avdW = 1.98
        Case "Xe"
            avdW = 2.16
        Case "Cs": '   Bastsanov table4
            avdW = 3.27
        Case "Ba": '   Bastsanov table4
            avdW = 2.71
        Case "La": '   Bastsanov table4
            avdW = 2.29
        Case "Hf": '   Bastsanov table4
            avdW = 1.94
        Case "Ta": '   Bastsanov table4
            avdW = 1.87
        Case "W": '    Bastsanov table4
            avdW = 1.77
        Case "Re": '   Bastsanov table4
            avdW = 1.75
        Case "Os": '   Bastsanov table4
            avdW = 1.83
        Case "Ir"": '  Bastsanov table4"
            avdW = 1.77
        Case "Pt"
            avdW = 1.72
        Case "Au": '   Bastsanov table4
            avdW = 1.86
        Case "Hg"
            avdW = 1.55
        Case "Tl"
            avdW = 1.96
        Case "Pb"
            avdW = 2.02
        Case "Bi": '   Bastsanov table4
            avdW = 2.17
        Case "Th": '   Bastsanov table4
            avdW = 2.2
        Case "U": '    Bastsanov table4
            avdW = 1.86
    End Select

End Sub
Private Sub LoadChargeData0(I1 As Integer): '

    Line Input #1, A$

    For i = 1 To AtomNum
        Input #1, j, A$
        Istart = 1: Iend = 1
        For II = 1 To Len(A$)
            If Mid$(A$, II, 1) = " " Then
                Iend = II
                Exit For
            End If
        Next II
        Species(i) = Mid$(A$, Istart, Iend - Istart)
        Charge(I1, i) = CVar(Mid$(A$, Iend, Len(A$) - Iend + 1))
        CCharge(I1, i) = Charge(I1, i) * ee

        Call Setradii(Species(i), r(i)): ' Setting radii-data

    Next i
    Input #1, A$
'Text1.Text = A$
    For i = 35 To Len(A$)
        If Mid$(A$, i, 1) <> " " Then
            Istart = i
            Exit For
        End If
    Next i
    For i = Istart + 1 To Len(A$)
        If Mid$(A$, i, 1) = " " Then
            Iend = i
            Exit For
        End If
    Next i

    TCharge(I1) = CVar(Right$(A$, Len(A$) - Istart + 1))
'Text1.Text = TCharge(I1)
    ChargeType(I1) = "Mulliken atomic charges"

End Sub

Private Sub LoadChargeData1(I1 As Integer): '

    Line Input #1, A$
    Input #1, A$

    For i = 10 To Len(A$)
        If Mid$(A$, i, 1) <> " " Then
            Istart = i
            Exit For
        End If
    Next i
    For i = Istart + 1 To Len(A$)
        If Mid$(A$, i, 1) = " " Then
            Iend = i
            Exit For
        End If
    Next i

    TCharge(I1) = CVar(Mid$(A$, Istart, Iend - Istart))
'Text1.Text = TCharge(I1)
    Line Input #1, A$
    For i = 1 To AtomNum
        Input #1, j, A$
        Istart = 1: Iend = 1
        For II = 1 To Len(A$)
            If Mid$(A$, II, 1) = " " Then
                Iend = II
                Exit For
            End If
        Next II
        Species(i) = Mid$(A$, Istart, Iend - Istart)
        Charge(I1, i) = CVar(Mid$(A$, Iend, Len(A$) - Iend + 1))
        CCharge(I1, i) = Charge(I1, i) * ee
'Text1.Text = Species(I)
'Text1.Text = Charge(I1, I)
        Call Setradii(Species(i), r(i)): ' Setting radii-data

    Next i
    ChargeType(I1) = "Charges from ESP fit"
    Text3(1).Text = ChargeType(I1)

End Sub
Private Sub LoadChargeData2(I1 As Integer): '

    Line Input #1, A$
    Line Input #1, A$
    Line Input #1, A$
'Text1.Text = AtomNum
    For i = 1 To AtomNum
        Input #1, A$
        For II = 1 To Len(A$)
            If Mid$(A$, II, 1) <> " " Then
                Istart = II
                Exit For
            End If
        Next II
        For II = Istart + 1 To Len(A$)
            If Mid$(A$, II, 1) = " " Then
                Iend = II
                Exit For
            End If
        Next II
        Species(i) = Mid$(A$, Istart, Iend - Istart)
'Text1.Text = Species(I)
        For II = Iend + 1 To Len(A$)
            If Mid$(A$, II, 1) <> " " Then
                Istart = II
                Exit For
            End If
        Next II
        For II = Istart + 1 To Len(A$)
            If Mid$(A$, II, 1) = " " Then
                Iend = II
                Exit For
            End If
        Next II
        For II = Iend + 1 To Len(A$)
            If Mid$(A$, II, 1) <> " " Then
                Istart = II
                Exit For
            End If
        Next II
        For II = Istart + 1 To Len(A$)
            If Mid$(A$, II, 1) = " " Then
                Iend = II
                Exit For
            End If
        Next II
'Text1.Text = Mid$(A$, Istart, Iend - Istart)
        Charge(I1, i) = CVar(Mid$(A$, Istart, Iend - Istart))
        CCharge(I1, i) = Charge(I1, i) * ee

'Text1.Text = Charge(I1, I)
    
        Call Setradii(Species(i), r(i)): ' Setting radii-data

    Next i
    Line Input #1, A$
    Input #1, A$

    For i = 13 To Len(A$)
        If Mid$(A$, i, 1) <> " " Then
            Istart = i
            Exit For
        End If
    Next i
    For i = Istart + 1 To Len(A$)
        If Mid$(A$, i, 1) = " " Then
            Iend = i
            Exit For
        End If
    Next i

    TCharge(I1) = CVar(Mid$(A$, Istart, Iend - Istart))
'Text1.Text = TCharge(I1)
    ChargeType(I1) = "Natural Population"
    Text3(1).Text = ChargeType(I1)
'Text1.Text = FlagAlfaBeta
    FlagAlfaBeta = ""

End Sub
Private Sub LoadChargeData3(I1 As Integer): '

    Line Input #1, A$

    For II = 1 To AtomNum
        Input #1, A$
        For i = 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        Species(II) = Mid$(A$, Istart, Iend - Istart)
'Text1.Text = Species(II)
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
'Text1.Text = Mid$(A$, Istart, Iend - Istart)
        Charge(I1, II) = CVar(Mid$(A$, Istart, Iend - Istart))
        CCharge(I1, II) = Charge(I1, II) * ee
'Text1.Text = Charge(I1, II)
    Next II
    
    Input #1, A$
    For i = 1 To Len(A$)
        If Mid$(A$, i, 1) <> " " Then
            Istart = i
            Exit For
        End If
    Next i
    For i = Istart + 1 To Len(A$)
        If Mid$(A$, i, 1) = " " Then
            Iend = i
            Exit For
        End If
    Next i
    For i = Iend + 1 To Len(A$)
        If Mid$(A$, i, 1) <> " " Then
            Istart = i
            Exit For
        End If
    Next i
    For i = Istart + 1 To Len(A$)
        If Mid$(A$, i, 1) = " " Then
            Iend = i
            Exit For
        End If
    Next i
    For i = Iend + 1 To Len(A$)
        If Mid$(A$, i, 1) <> " " Then
            Istart = i
            Exit For
        End If
    Next i
    For i = Istart + 1 To Len(A$)
        If Mid$(A$, i, 1) = " " Then
            Iend = i
            Exit For
        End If
    Next i
'Text1.Text = Mid$(A$, Istart, Iend - Istart)
    TCharge(I1) = CVar(Mid$(A$, Istart, Iend - Istart))
'Text1.Text = TCharge(I1)
    Call Setradii(Species(i), r(i)): ' Setting radii-data

    ChargeType(I1) = "Hirshfeld charge"
    Text3(1).Text = ChargeType(I1)

End Sub
Private Sub LoadChargeData4(I1 As Integer): '

    For i = 1 To 5
     Line Input #1, A$
    Next i

    For II = 1 To AtomNum
        Input #1, A$
        For i = 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
            If i = Len(A$) Then
                Iend = i
            End If
        Next i
Text1.Text = Mid$(A$, Istart, Iend - Istart)
        Charge(I1, II) = CVar(Mid$(A$, Istart, Iend - Istart))
        CCharge(I1, II) = Charge(I1, II) * ee
Text1.Text = Charge(I1, II)
    Next II
    
    Input #1, A$
    Input #1, A$
        For i = 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
        Next i
        For i = Iend + 1 To Len(A$)
            If Mid$(A$, i, 1) <> " " Then
                Istart = i
                Exit For
            End If
        Next i
        For i = Istart + 1 To Len(A$)
            If Mid$(A$, i, 1) = " " Then
                Iend = i
                Exit For
            End If
            If i = Len(A$) Then
                Iend = i
            End If
        Next i
Text1.Text = Mid$(A$, Istart, Iend - Istart)
    TCharge(I1) = CVar(Mid$(A$, Istart, Iend - Istart))
Text1.Text = TCharge(I1)
    Call Setradii(Species(i), r(i)): ' Setting radii-data

    ChargeType(I1) = "AIM charge"
    Text3(1).Text = ChargeType(I1)

End Sub
Private Sub Command1_Click(Index As Integer): '  Loading Input Data obtained by Gaussian09
Dim ChargeSelect1 As Integer

FlagOPComp = "N"
If txtName1(0).Text = "" Then
    Text1.Text = "　　no filename　　"
    Exit Sub
End If

If Right$(Dir1.Path, 1) = "\" Then
    DPath = Left$(Dir1.Path, Len(Dir1.Path) - 1)
Else
    DPath = Dir1.Path
End If


Text1.Text = "　　On Loading　　"

Open DPath + "\" + txtName1(0).Text For Input As #1

A$ = Right$(txtName1(0).Text, 3)
If A$ = "LOG" Or A$ = "log" Then
    Fnum = 0
    Do Until EOF(1)
        Line Input #1, A$
        If A$ = "                          Input orientation:                          " Then Exit Do
    Loop
    For i = 1 To 4
        Line Input #1, A$
    Next i
    AtomNum = 0
    Do Until EOF(1)
        Line Input #1, A$
        If A$ = " ---------------------------------------------------------------------" Then Exit Do
        AtomNum = AtomNum + 1
    Loop

    FlagAlfaBeta = ""
    Do Until EOF(1)
        Line Input #1, A$
        If A$ = " *******         Beta  spin orbitals         *******" Then
            FlagAlfaBeta = "B"
        End If
        If A$ = " *******         Alpha spin orbitals         *******" Then
            FlagAlfaBeta = "A"
        End If
        If A$ = " Mulliken atomic charges:" Then
            ChargeSelect1 = 0
            Call LoadChargeData0(ChargeSelect1)
        End If
        If A$ = " Fitting point charges to electrostatic potential" Then
            ChargeSelect1 = 1
            Call LoadChargeData1(ChargeSelect1)
        End If
        If A$ = "                                       Natural Population " Then
            If FlagAlfaBeta = "A" Or FlagAlfaBeta = "" Then
                ChargeSelect1 = 1
                Call LoadChargeData2(ChargeSelect1)
            End If
        End If
        If Left$(A$, 34) = " Hirshfeld spin densities, charges" Then
            ChargeSelect1 = 1
            Call LoadChargeData3(ChargeSelect1)
        End If
        If A$ = " III. PROPERTIES OF ATTRACTORS" Then
            ChargeSelect1 = 1
            Call LoadChargeData4(ChargeSelect1)
        End If
        If A$ = " Optimization completed." Then
            FlagOPComp = "Y"
        Else
            If Mid$(A$, 1, 24) = " Optimization completed " Then
                FlagOPComp = "?"
            End If
        End If
        If A$ = "                         Standard orientation:                         " Then
            If FlagOPComp = "Y" Or FlagOPComp = "?" Then
                For i = 1 To 4
                    Line Input #1, A$
                Next i
                For i = 1 To AtomNum
                    Input #1, j, K(i), lk, t0(i), u0(i), v0(i)
                    t(i) = t0(i): u(i) = u0(i): v(i) = v0(i)
                Next i
            End If
        End If
    Loop
    Close #1

Text1.Text = ChargeSelect1
    If ChargeSelect1 = 1 Then
        Select Case FlagOPComp
            Case "Y"
            Case "?"
            Case Else
                Command2(1).Visible = False
                Text1.Text = "Optimization not completed!!"
                CurrentX = 3800
                ForeColor = &H8000000F
                CurrentY = 3450: Print "Progress Situation"
                CurrentX = 3550
                For i = 1 To 6
                    CurrentX = CurrentX + 450
                    ResX = CurrentX
                    CurrentY = 3650: Print i
                    CurrentX = ResX + 40
                    CurrentY = 3800: Print "X"
                    CurrentX = ResX
                Next i
                Exit Sub
        End Select
        Option1(0).Visible = True
        Option1(1).Visible = True
        Option1(1) = True
        Text3(0).Visible = True
        Text3(1).Visible = True
    Else
        Option1(0).Visible = True
        Option1(1).Visible = False
        Option1(0) = True
        Text3(0).Visible = True
        Text3(1).Visible = False
    End If
Else
    If A$ = "DAT" Or A$ = "dat" Then
        ChargeSelect = 1
        ChargeType(ChargeSelect) = ""
        Option1(1) = True
        Option1(0).Visible = False
        Option1(1).Visible = False
        Text3(0).Visible = False
        Text3(1).Visible = False
        Input #1, AtomNum
        For i = 1 To AtomNum
            Input #1, j, K(i), lk, t0(i), u0(i), v0(i), jj
            t(i) = t0(i): u(i) = u0(i): v(i) = v0(i)
        Next i
        TCharge(ChargeSelect) = jj
        For i = 1 To AtomNum - 1
            Input #1, j, A$, jj
            Istart = 1: Iend = 1
            For II = 1 To Len(A$)
                If Mid$(A$, II, 1) = " " Then
                    Iend = II
                    Exit For
                End If
            Next II
            Species(i) = Mid$(A$, Istart, Iend - Istart)
            Charge(ChargeSelect, i) = CVar(Mid$(A$, Iend + 1, Len(A$) - Iend))
            CCharge(ChargeSelect, i) = Charge(ChargeSelect, i) * ee
    
            Call Setradii(Species(i), r(i)): ' Setting radii-data

        Next i
        For i = AtomNum To AtomNum
            Input #1, j, A$
            Istart = 1: Iend = 1
            For II = 1 To Len(A$)
                If Mid$(A$, II, 1) = " " Then
                    Iend = II
                    Exit For
                End If
            Next II
            Species(i) = Mid$(A$, Istart, Iend - Istart)
            Charge(ChargeSelect, i) = CVar(Mid$(A$, Iend + 1, Len(A$) - Iend))
            CCharge(ChargeSelect, i) = Charge(ChargeSelect, i) * ee
    
            Call Setradii(Species(i), r(i)): ' Setting radii-data

        Next i
        Close #1
        FlagOPComp = "Y"
    Else
        Close #1
        Text1.Text = "　　File format mismatch　　"
        Exit Sub
    End If
End If
    DataName = txtName1(0).Text
    Text2.Text = DataName
    Text1.Text = "　　DATA Loading completed　　"

' erasing progress situation
    CurrentX = 3800
    ForeColor = &H8000000F
    CurrentY = 3450: Print "Progress Situation"
    CurrentX = 3550

    For i = 1 To 6
        CurrentX = CurrentX + 450
        ResX = CurrentX
        CurrentY = 3650: Print i
        CurrentX = ResX + 40
        CurrentY = 3800: Print "X"
        CurrentX = ResX
    Next i

' visualizing calculation execution button
    For i = 1 To AtomNum
        rmod(i) = r(i) + SurfModif
    Next i
    
    Command2(1).Visible = True

End Sub

Private Sub File1_Click()
    
    txtName1(0).Text = File1.FileName
    If Right$(Dir1.Path, 1) = "\" Then
        Text1.Text = Left$(Dir1.Path, Len(Dir1.Path) - 1) + "\" + txtName1(0)
    Else
        Text1.Text = Dir1.Path + "\" + txtName1(0).Text
    End If
    
End Sub

Private Sub Form_Load()
        
    ee = 1.602176565E-19
    eps0 = 8.854187817E-12
    pi = 3.14159265359
    ThStepWidth = 2#
    SurfModif = CVar(Text4.Text)
    ChargeSelect = 1
    Option1(0).Visible = False
    Option1(1).Visible = False
    Text3(0).Visible = False
    Text3(1).Visible = False
    
    With Combo1
        .AddItem "(LOG)|*.LOG;*.log"
        .AddItem "(DAT)|*.DAT;*.dat"
    End With
    
    With File1
        .Pattern = Combo1.Text
    End With
    
End Sub

Private Sub Combo1_Click()

    File1.Pattern = Combo1.Text
    If Combo1.Text = "(DAT)|*.DAT;*.dat" Then
        Text1.Text = "Caution!!" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "EPS or Mulliken Type Data Input is needed."
    End If
    
End Sub

Private Sub Option1_Click(Index As Integer)

    If Option1(0) = True Then
        ChargeSelect = 0
    Else
        ChargeSelect = 1
    End If
    
' erasing progress situation
    CurrentX = 3800
    ForeColor = &H8000000F
    CurrentY = 3450: Print "Progress Situation"
    CurrentX = 3550
    For i = 1 To 6
        CurrentX = CurrentX + 450
        ResX = CurrentX
        CurrentY = 3650: Print i
        CurrentX = ResX + 40
        CurrentY = 3800: Print "X"
        CurrentX = ResX
    Next i

'Text1.Text = ChargeSelect

End Sub

Private Sub Text4_Change()

    SurfModif = CVar(Text4.Text)
    For i = 1 To AtomNum
        rmod(i) = r(i) + SurfModif
    Next i

'Text1.Text = SurfModif

End Sub