Option Explicit
 
'***************************************************************************
'Model Variables
'***************************************************************************
Global ng As Integer      ' Nr of internal variables defining agents
Global no As Integer      ' Number of agents
Global GDP As Double      ' Total wealth of the world of agents
Global IndProd As Single  ' Industrial Production
Global iino As Integer    ' idem ino
Global ino As Integer     '1 Initial Nr. of Agents
Global ops As Integer     '2 Optimum Population Size
Global RNR1 As Integer    '3 Richness of Resource 1
Global SNR1 As Single     '4 Size of Resource 1
Global DNR1 As Single     '5 Degradation of Resource 1 due to consumption
Global DPR1 As Integer    '6 Distribution Pattern of Resource 1
Global BRC2 As Single     '8 Basal rate of metabolic consumption Resource 2
Global fch2 As Integer    '9 Frequency of change Resource 2
Global RNR2 As Single     '7 Richness of Resource 2
Global econoT As Integer  '10 Economy (Type of taxation)
Global SNR2 As Integer    '11 Size of Resource 2
Global DNR2 As Single     '12 Degradation of Resource 2 due to consumtion
Global EfC1 As Single     '13 Efficiency of consumption of Resource 1
Global BRC1 As Single     '14 Basal rate of metabolic consumption of Resource 1
Global DPR2 As Integer    '15 Distribution Pattern of Resource 2
Global EfC2 As Integer    '18 Efficiency of consumption of Resource 2
Global fch1 As Single     '20 Frequency of change Resource 1
Global ssconst As Integer '21 Simulation scenario
Global acol As Integer    'Agents color
Global dangers As Single  'selection agents different to starvation

Global foodreserve As Single 'amount of food kept as reserve and never comercialized
Global minreserve As Single  'amount of minerals kept for security
Global mafood As Single   ' minimum amount of food required for initiating reproduction when ssconstant = 1 or 4

'Monetary constants
Global MonBase As Single        'Total Monetary Base
Global foodprice As Single      'Price of food
Global minprice As Single       'price of minerals
Global profit As Single         'Profit in commercial transactions by traders
Global srage As Single          'seniorage
Global MonBank As Single        'Bank Money
Global Interest As Single       'Bank Interest
Global Pridistortion As Single  'NOT IMPLEMENTED Bias for price reduction after failed transaction
Global Inflation As Single      'NOT IMPLEMENTED Rate at which individual agentrs adjust prices

Global maxagents As Integer      'Maximum number of agents
Global findex As Integer         'code for finding excel or notepad

'global/dynamic arrays
Global agent(10000, 23) As Single   'Phenotype of Organisms (individual i, Variable j)
  ' j=0 x (implemented in action)
  ' j=1 y (implemented in action)
  ' j=2 Contact Radius (implemented in action)
  ' j=3 Altruistic strategy: none, dissipative or synergistic (implemented in action)
  ' j=4 Type of Movement
  ' j=5 Distance of Movement (implemented)
  ' j=6 Pro social behaviour (pays tax)
  ' j=7 Age
  ' j=8 Punitive threshold
  ' j=9 Shame: Sensitivity to punishment
  ' j=10 Monetary Wealth
  ' j=11 Wealth-Food (R1)
  ' j=12 Wealth-Commodities (R2)
  ' j=13 Generosity (%)
  ' j=14 Altruistic Threshold (*)
  ' j=15 Altruistic Synergy: Dissipative or synergistic altruism
  ' j=16 Cost of punishment or to punished
  ' j=17 Fertility
  ' j=18 History of interactions
  ' j=19 Specialization in punishment
  ' j=20 Type of Agent
  ' j=21 Food price memory
  ' j=22 Mineral comodity price memory
  ' j=23 Credit outstanding records
 
Global or1(500, 500) As Integer   'Resources 1
Global or2(500, 500) As Integer   'Resources 2
Global oo(100, 5) As Integer      'Resources
Global scmin(24) As Integer    'Min allowed values for variables
Global ps(40, 20) As Integer   'Output matrix - normalized(Population structure)
Global PSS(40, 40) As Integer  'Output matrix - raw data
Global scmax(40) As Single     'Labels for columns in zoom graph
Global scmax0(40) As Single
Global ss(30) As Single
Global ss2(30) As Double
Global mean(30) As Single
Global sd(30) As Single
Global dom(30, 3) As Single    'Defines variables to mutate only i,0 is saved
Global ExtVar(30) As Single    'Values of exernal variables
Global NExtVar(30) As String   'Names of exernal variables
Global aggdp(5) As Single      '% TW for each type of agent as defined by j=20
Global agno(5) As Double       '% of each type of agent as defined by j=20
Global taxpool As Single       'Aggregate tax on resource collected
Global taxpoolT As Single       'Aggregate tax on resource collected
Global TaxType As Integer      'Type of comodity to be taxt (10, 11 or 12)
Global SSTax As Single         'Amount of synergy the pool of social resorces obtained through tax achieves
Global FixedTax As Integer     '0 is for fixed amount of tax, else is % of wealth of taxpayer
Global TaxAmount As Single     'Amount of tax to be payed in ambolute or % terms
Global TaxUse As Integer       'Defines how taxes are distributed
Global Socef As Integer        'Social eficiency in punishing tax evaders
Global CostY As Single         'Cost to punish

'Program support variables
Global Const FileIni = "Sociodynam.ini"
Global iProgAction As Integer   'program state, 0 = start/stop, 1 = running
                                '2 = pause, '3 = end
Global tstep As Integer         'cummulative time step
Global tt As Integer
Global StepSize As Integer      'Step size for simulation
Global GraphRes As Integer      'Graph x-scale resolution
Global GeneSelections(2, 1) As Integer 'previous graph selections
Global iXCount As Integer       'current xposition on axis of main form
Global iLastY(20, 14) As Integer     'Last y coordinates for population graph
Global VarList(40) As String    'Variable descriptions for full labels
Global VarListAbr(40) As String 'Variable descriptions for abbreviated labels
Global Fileparm As String       'parameter file
Global FilePop As String        'population file
Global Colorscale(25)  As Long  'colors used for graphs
Global colcode As Integer        'Colorcodes
Global AlreadyRun As Integer    'for intro about - run first time only
Global gnZoomIndex As Integer   'Index for zoom graph
Global filternr As Integer      'Variable to be filtered
Global filterval As Integer     'Value of Variable to be filtered
Global inspnr1 As Integer       'Val of genes to be associated with species in iniloop
Global inspnr2 As Integer       'Val of genes to be associated with species in iniloop
Global iinspnr1 As Integer      'Val of genes defining species to be associated with species in iniloop
Global allel(10) As Integer     'allelic values of inspnr1 to be excluded
Global plotval  As Integer      'plot average or absolute frequency
Global Mutsim As Integer        '1 Indicates mutation hypersim

'MsgBox Parameters
Global Const MB_OK = 0
Global Const MB_OKCancel = 1
Global Const MB_AbortRetryIgnore = 2
Global Const MB_YesNoCancel = 3
Global Const MB_YesNo = 4
Global Const MB_RetryCancel = 5
Global Const MB_IconStop = 16
Global Const MB_IconQuestion = 32
Global Const MB_IconExclamation = 48
Global Const MB_IconInformation = 64

' Transformations
Global pps(30, 10) As Integer
Global graf(14) As Integer
Global pathword  As String
Global pathnote As String

Global buyer As Integer
Global seller As Integer
Global product As Integer
Global amount As Integer
Global price As Single
Global pritype As Single
Global mutation As Single    'Mutation probability of gens in new offsring

 Sub ACreateInitPop()
  Dim i, j, kk As Integer
  Erase agent
  MonBank = 0
  GDP = 0
  MonBase = 0
  Randomize
  taxpool = 0
  iino = ino
  no = ino

 ' If scmax(0) > scmax(1) Then kk = scmax(1) Else kk = scmax(0)
 ' If SNR1 > kk Then SNR1 = kk
   If scmax(19) = 2 And scmin(19) = 2 Then scmin(8) = 0
  For i = 1 To no
   agent(i, 0) = Int((scmax(0) + 1) * Rnd)
   agent(i, 1) = Int((scmax(1) + 1) * Rnd)
   For j = 2 To ng
    agent(i, j) = Int((scmax(j) - scmin(j) + 1) * Rnd) + scmin(j)
   Next
    agent(i, 23) = 0
    agent(i, 22) = minprice
    agent(i, 21) = foodprice
    agent(i, 18) = 0
    agent(i, 7) = 0
  Next
'  If scmax0(7) = 0 Then scmax0(7) = 1
'  If scmax0(11) = 0 Then scmax0(11) = 1
'  If scmax0(10) = 0 Then scmax0(10) = 1
Resources1
Resources2
End Sub
  
Sub Resources1()
Dim i, j, ii, jj, k, kk, ko, io, jo As Integer
Erase or1
'Resource 1
Select Case DPR1
Case 1  ' Fixed sized, Randomly distributed
  For i = 1 To RNR1  'Natural resources
   ii = Int(Rnd * (scmax(0) + 1))
   jj = Int(Rnd * (scmax(1) + 1))
   ko = SNR1
   oo(i, 0) = ii
   oo(i, 1) = jj
   oo(i, 2) = ko
   For k = 0 To SNR1
   For kk = 0 To ko
     io = ii + k
     jo = jj + kk
     If io > scmax(0) Then io = io - scmax(0)
     If jo > scmax(1) Then jo = jo - scmax(1)
     or1(io, jo) = or1(io, jo) + 1
   Next
   Next
  Next
  
Case 2   ' Fixed size, centered
 For i = 1 To RNR1  'Natural resources
   ii = scmax(0) / 2
   jj = 1 'scmax(1) / 2
   ko = SNR1
   oo(i, 0) = ii
   oo(i, 1) = jj
   oo(i, 2) = ko
   For k = 0 To SNR1
   For kk = 0 To ko
     io = ii + k
     jo = jj + kk
     If io > scmax(0) Then io = io - scmax(0)
     If jo > scmax(1) Then jo = jo - scmax(1)
     or1(io, jo) = or1(io, jo) + 1
   Next
   Next
  Next
  
Case Else   ' Random size, randomly distributed
  For i = 0 To RNR1  'Natural resources
   ii = Int(Rnd * (scmax(0) + 1))
   jj = Int(Rnd * (scmax(1) + 1))
   ko = Int(Rnd * (SNR1 + 1))
   oo(i, 0) = ii
   oo(i, 1) = jj
   oo(i, 2) = ko
   For k = 0 To Int(Rnd * (SNR1 + 1))
   For kk = 0 To ko
     io = ii + k
     jo = jj + kk
     If io > scmax(0) Then io = io - scmax(0)
     If jo > scmax(1) Then jo = jo - scmax(1)
     or1(io, jo) = or1(io, jo) + 1
   Next
   Next
  Next
End Select
End Sub

Sub Resources2()
Dim i, j, ii, jj, k, kk, ko, io, jo As Integer
Erase or2
'Resource 2
Select Case DPR2
Case 1  ' Fixed sized, Randomly distributed
  For i = 1 To RNR2  'Natural resources
   ii = Int(Rnd * (scmax(0) + 1))
   jj = Int(Rnd * (scmax(1) + 1))
   ko = SNR2
   oo(i, 3) = ii
   oo(i, 4) = jj
   oo(i, 5) = ko
   For k = 0 To SNR2
   For kk = 0 To ko
     io = ii + k
     jo = jj + kk
     If io > scmax(0) Then io = io - scmax(0)
     If jo > scmax(1) Then jo = jo - scmax(1)
     or2(io, jo) = or2(io, jo) + 1
   Next
   Next
  Next
  
Case 2   ' Fixed size, centered
 For i = 0 To RNR2  'Natural resources
   ii = 1 'scmax(0) / 2
   jj = 1 'scmax(1) / 2
   ko = SNR2
   oo(i, 3) = ii
   oo(i, 4) = jj
   oo(i, 5) = ko
   For k = 0 To SNR2
   For kk = 0 To ko
     io = ii + k
     jo = jj + kk
     If io > scmax(0) Then io = io - scmax(0)
     If jo > scmax(1) Then jo = jo - scmax(1)
     or2(io, jo) = or2(io, jo) + 1
   Next
   Next
  Next
  
Case Else   ' Random size, randomly distributed
  For i = 1 To RNR2  'Natural resources
   ii = Int(Rnd * (scmax(0) + 1))
   jj = Int(Rnd * (scmax(1) + 1))
   ko = Int(Rnd * (SNR2 + 1))
   oo(i, 3) = ii
   oo(i, 4) = jj
   oo(i, 5) = ko
   For k = 0 To Int(Rnd * SNR2 + 1)
   For kk = 0 To ko
     io = ii + k
     jo = jj + kk
     If io > scmax(0) Then io = io - scmax(0)
     If jo > scmax(1) Then jo = jo - scmax(1)
     or2(io, jo) = or2(io, jo) + 1
   Next
   Next
  Next
End Select
  
End Sub

Sub EBarter()
Dim i, j As Integer   'counters
Dim tmp, temp As Single

  For i = 1 To no
  temp = 0
   For j = 1 To no
    If Abs(agent(i, 0) - agent(j, 0)) < agent(i, 2) And Abs(agent(i, 1) - agent(j, 1)) < agent(i, 2) Then 'Contact radius
 
          
  ' ********** BARTER  **********************************************************
    'commerce of agricultural goods
     If (agent(j, 20) = 1 And agent(i, 20) = 3) Or (agent(i, 20) = 0 And agent(j, 20) = 0) Then 'type of agent
      If agent(j, 11) > foodreserve And agent(i, 12) > minreserve Then
       tmp = 0
       If agent(j, 11) - foodreserve >= (agent(i, 12) - minreserve) Then
        tmp = agent(i, 12) - minreserve
       ElseIf agent(j, 11) - foodreserve < (agent(i, 12) - minreserve) Then
        tmp = agent(j, 11) - foodreserve
       End If
       agent(j, 11) = agent(j, 11) - tmp
       agent(j, 12) = agent(j, 12) + tmp
       agent(i, 11) = agent(i, 11) + tmp
       agent(i, 12) = agent(i, 12) - tmp
       temp = 1
      End If
      
    'commerce of resource 2 and adding value
     ElseIf (agent(j, 20) = 2 And agent(i, 20) = 3) Or (agent(j, 20) = 0 And agent(i, 20) = 0) Then
      If agent(i, 11) > foodreserve And agent(j, 12) > minreserve Then
       tmp = 0
       If agent(j, 12) - minreserve <= agent(i, 11) - foodreserve Then
        tmp = agent(j, 12) - minreserve
       ElseIf agent(j, 12) - minreserve > agent(i, 11) - foodreserve Then
        tmp = agent(i, 11) - foodreserve
       End If
       agent(j, 11) = agent(j, 11) + tmp
       agent(j, 12) = agent(j, 12) - tmp
       agent(i, 11) = agent(i, 11) - tmp
       agent(i, 12) = agent(i, 12) + tmp
       temp = 1
      End If
     End If 'type of agent
      
    ' ********** ALTRUISTIC BEHAVIOR****************************************************
    If agent(i, 3) > 0 And temp = 0 Then Call BAltruist(i, j) 'Altruistic behaviours
    ' **********************************************************************************

    End If 'Contact radius
   Next 'j
  Next  'i
  
  If TaxType > 9 Then ETaxes
  
End Sub

Sub XMatrix()
   Dim i, ii, j, a, a1, a2 As Integer
   Dim temp As Double
   
  '*****************************************************************
 'Rearrangement of matrices: elimination of dead agent
 '*****************************************************************
  ii = 0
  GDP = 0
  IndProd = 0
  MonBase = 0
  Erase aggdp
  Erase agno
 
  'Eliminate variable types previously defined
  If inspnr1 > 1 Or inspnr2 > 1 Then
  For i = 1 To no
   For a = 1 To 9 Step 2
    a1 = allel(a)
    If a1 = 100 Then a1 = 0
    a2 = allel(a + 1)
    If a2 = 100 Then a2 = 0
    If allel(a) > 0 And agent(i, inspnr1) = a1 Then agent(i, 11) = 0
    If allel(a + 1) > 0 And agent(i, inspnr2) = a2 Then agent(i, 11) = 0
   Next
  Next
  End If
  
  'step thru old array
  For i = 1 To no
    
    ' Irreversible processes
    agent(i, 7) = agent(i, 7) + 1              ' increment age
    agent(i, 11) = agent(i, 11) - BRC1 / 10    ' cost of feeding
    agent(i, 12) = agent(i, 12) - BRC2 / 10    ' cost of living
        
    If agent(i, 21) < 1 Then agent(i, 21) = 1
    If agent(i, 22) < 1 Then agent(i, 22) = 1
            
'****************** SELECTION ***************************************************************************
   'Selecting agents surviving starvation and random death
   If ssconst = 3 Then
     If agent(i, 12) < 0 Then agent(i, 12) = 0
     If agent(i, 11) < 0 Then agent(i, 11) = 0
     If agent(i, 10) < 0 Then agent(i, 10) = 0
     GoTo 1001
   End If
   
   If (ssconst = 4 Or ssconst = 5) And agent(i, 7) > 10 Then agent(i, 11) = 0 ' eliminating the old > 10
   
   'Culling...................................................................
   
   If agent(i, 11) > 0 Then
   If 100 * Rnd / (agent(i, 12) / (mean(12) + 0.01) + 0.1) < 1000 * Rnd / (dangers + 0.01) Then
'********************************************************************************************************

1001  ii = ii + 1
    For j = 0 To ng + 3
     agent(ii, j) = agent(i, j)
    Next
       
        'Changing maximum graph limit
    If agent(ii, 7) > scmax0(7) Then scmax0(7) = scmax0(7) * 2
    If agent(ii, 11) > scmax0(11) Then scmax0(11) = scmax0(11) * 2
    If agent(ii, 12) > scmax0(12) Then scmax0(12) = scmax0(12) * 2
    If agent(ii, 10) > scmax0(10) Then scmax0(10) = scmax0(10) * 2
    If agent(ii, 18) > scmax0(18) Then scmax0(18) = scmax0(18) * 2
    If agent(ii, 21) > scmax0(21) Then scmax0(21) = scmax0(21) * 2
    If agent(ii, 22) > scmax0(22) Then scmax0(22) = scmax0(22) * 2
    If agent(ii, 23) > scmax0(23) Then scmax0(23) = scmax0(23) * 2
      
    temp = agent(ii, 10) + agent(ii, 11) * agent(ii, 21) + agent(ii, 12) * agent(ii, 22)
    If temp > 0 Then GDP = GDP + Sqr(temp)
    temp = agent(ii, 11) + agent(ii, 12)
    If temp > 0 Then IndProd = IndProd + Sqr(temp)
    MonBase = MonBase + agent(ii, 10)
    agno(agent(ii, 20)) = agno(agent(ii, 20)) + 1   ' Counting nr of agent types
    temp = agent(ii, 10) + agent(ii, 11) * agent(ii, 21) + agent(ii, 12) * agent(ii, 22)
    If temp > 0 Then aggdp(agent(ii, 20)) = aggdp(agent(ii, 20)) + Sqr(temp)
   
   End If
   End If
  Next
  no = ii
  
  For i = 0 To 5
   If no = 0 Then agno(i) = 0 Else agno(i) = agno(i) / no * 100   'Calculating percentages
   If GDP = 0 Then aggdp(i) = 0 Else aggdp(i) = aggdp(i) / GDP * 100
  Next
   
End Sub

 Sub XOutPut01()
  Dim i, j, jj, k, kk As Integer
  Dim tp, temp, tpp, dbbl, filj As Single
  On Error GoTo errparm

 '*****************************************************************
 'Output
 '*****************************************************************
  If filternr >= 0 Then filj = filternr Else filj = 0
  Erase ps
  Erase PSS
  Erase ss
  Erase ss2
  
  For j = 2 To ng + 3
   If scmax0(j) > 10 Then temp = scmax0(j) Else temp = 10
   For i = 1 To no
      ss(j) = ss(j) + agent(i, j)
      ss2(j) = ss2(j) + agent(i, j) * agent(i, j)
      If filternr < 0 Or (filternr >= 0 And filterval = agent(i, filj)) Then
       k = 10 - Int(agent(i, j) / temp * 10)
       If k < 0 Then k = 0
       PSS(j, k) = PSS(j, k) + 1
      End If
   Next
       PSS(0, 10) = no
      If no < 3 Then
        mean(j) = 0
        sd(j) = 0
      Else
        tp = no
        dbbl = (tp * ss2(j) - (ss(j) ^ 2)) / (tp * (tp - 1))
        If dbbl < 0 Then dbbl = 0
        sd(j) = CSng(dbbl ^ 0.5)
        mean(j) = ss(j) / tp
        mean(j) = Int(mean(j) * 100) / 100
        sd(j) = Int(sd(j) * 100) / 100
      End If
    
    If plotval = 0 Then               'Plot absolute frequencies
     For k = 0 To 10                                      'colors
      If PSS(j, k) > 0 Then
       ps(j, k) = Int(PSS(j, k) / no * 10) + 1     'intensity of red
       If ps(j, k) > 9 Then ps(j, k) = 9
      Else
       ps(j, k) = 0
      End If
     Next
    
    ElseIf plotval = 1 Then          'Plot average frequencies
     If scmax0(j) > 10 Then tpp = CInt(mean(j) / scmax0(j) * 10) Else tpp = mean(j)
     For k = 0 To 10
      ps(j, k) = 0
     Next
     ps(j, 10 - tpp) = 22
    End If
  Next                                                   'j loop
Exit Sub
errparm:
MsgBox "Error:" + Str$(Err) + " Parameter overflow"
'Fileparm = "None Selected"
FilePop = "None Selected"
iProgAction = 0
DoEvents
frmMain.Refresh
Exit Sub
End Sub

Sub ASimloop()
Dim i, j, k, io, jo As Integer   'counters
Dim nbi, nn As Integer           'New births & temp
Dim fpm, tmp, tmp2 As Single     'Temporary variable

Randomize
  
If fch1 > 0 Then
 If (Int(tstep / fch1) * fch1 = tstep) Then Resources1
End If

If fch2 > 0 Then
 If (Int(tstep / fch2) * fch2 = tstep) Then Resources2
End If

 ' *******************************************************************
 '                           Creation of new agents
 ' *******************************************************************

Select Case ssconst
Case 0  'Market scenario
 
 For i = no + 1 To ops
   agent(i, 0) = Int((scmax(0) + 1) * Rnd)
   agent(i, 1) = Int((scmax(1) + 1) * Rnd)
   For j = 2 To ng
    agent(i, j) = Int((scmax(j) - scmin(j) + 1) * Rnd) + scmin(j)
   Next
    agent(i, 23) = 0
    agent(i, 22) = minprice
    agent(i, 21) = foodprice
    agent(i, 18) = 0
    agent(i, 7) = 0
  Next
  no = ops

Case 1, 4      'Biological scenario: only fertile agents reproduce with no cost
nn = no
For i = 1 To no
 nbi = CInt(agent(i, 17))
 If agent(i, 11) > (mafood + foodreserve) And nbi > 0 Then
 If nn + nbi < ops Then
  For k = nn + 1 To nn + nbi                         'Loop Nbi
   agent(k, 0) = agent(i, 0) + Int(20 * Rnd) - 10
   If agent(k, 0) > 500 Or agent(k, 0) < 0 Then agent(k, 0) = 100 * Rnd + 10
   agent(k, 1) = agent(i, 1) + Int(20 * Rnd) - 10
   If agent(k, 1) > 400 Or agent(k, 1) < 0 Then agent(k, 1) = 100 * Rnd + 10
    For j = 2 To ng
     agent(k, j) = agent(i, j)
     If Rnd < mutation Then agent(k, j) = Int((scmax(j) - scmin(j) + 1) * Rnd) + scmin(j)
    Next 'j
    agent(k, 23) = 0
    agent(k, 22) = minprice
    agent(k, 21) = foodprice
    agent(k, 18) = 0
    agent(k, 10) = agent(i, 10) / nbi
    agent(k, 11) = (agent(i, 11) - foodreserve - mafood) / nbi
    agent(k, 12) = agent(i, 12) / nbi
    agent(k, 7) = 0
  Next  'k
  nn = nn + nbi
  agent(i, 11) = foodreserve
 End If
 End If
Next  'i
no = nn

Case 5
nn = no
For i = 1 To no
 nbi = Int(agent(i, 11) / (mafood + foodreserve))
 If nbi > 0 Then
 agent(i, 11) = foodreserve
 If nn + nbi < ops Then
  For k = nn + 1 To nn + nbi                         'Loop Nbi
   agent(k, 0) = agent(i, 0) + Int(20 * Rnd) - 10
   If agent(k, 0) > 500 Or agent(k, 0) < 0 Then agent(k, 0) = 100 * Rnd + 10
   agent(k, 1) = agent(i, 1) + Int(20 * Rnd) - 10
   If agent(k, 1) > 400 Or agent(k, 1) < 0 Then agent(k, 1) = 100 * Rnd + 10
    For j = 2 To ng
     agent(k, j) = agent(i, j)
     If Rnd < mutation Then agent(k, j) = Int((scmax(j) - scmin(j) + 1) * Rnd) + scmin(j)
    Next 'j
    agent(k, 23) = 0
    agent(k, 22) = minprice
    agent(k, 21) = foodprice
    agent(k, 18) = 0
    agent(k, 10) = agent(i, 10) / nbi
    agent(k, 11) = foodreserve
    agent(k, 12) = agent(i, 12) / nbi
    agent(k, 7) = 0
    agent(k, 17) = 0
    agent(i, 17) = nbi
  Next  'k
  nn = nn + nbi
 End If
 End If
Next  'i
no = nn

Case Else
End Select
 
 
 '***************************************************************************
 '                         SPATIAL MOVEMENT
 '***************************************************************************
  For i = 1 To no
  Select Case agent(i, 4)      'Type of movement

   Case 2 'x forward when thin: stand still when thick
    If agent(i, 11) <= scmax0(11) / 2 Then
     agent(i, 0) = agent(i, 0) + Int(Rnd * (agent(i, 5) + 1))
     If agent(i, 0) > scmax(0) Then agent(i, 0) = agent(i, 0) - scmax(0)
    Else
     agent(i, 0) = agent(i, 0) - Int(Rnd * (agent(i, 5) + 1))
     If agent(i, 0) < 0 Then agent(i, 0) = agent(i, 0) + scmax(0)
    End If
    
   Case 3 'Fixed speed random movement
    If scmax(0) > scmax(5) Then
    If Rnd > 0.5 Then
     agent(i, 0) = agent(i, 0) + agent(i, 5)
     If agent(i, 0) > 500 Then agent(i, 0) = agent(i, 0) - 500
    Else
     agent(i, 0) = agent(i, 0) - agent(i, 5)
     If agent(i, 0) < 0 Then agent(i, 0) = 500 + agent(i, 0)
    End If
    End If
    If scmax(1) > scmax(5) Then
    If Rnd > 0.5 Then
     agent(i, 1) = agent(i, 1) + agent(i, 5)
     If agent(i, 1) > 400 Then agent(i, 1) = agent(i, 1) - 400
    Else
     agent(i, 1) = agent(i, 1) - agent(i, 5)
     If agent(i, 1) < 0 Then agent(i, 1) = 400 + agent(i, 1)
    End If
    End If
       
  End Select
  Next         ' Loop 1 "i"



 '**********************************************************************************
 '                            ACTIONS
 '**********************************************************************************
 
 'Consumption of resources..........................................................
 
 For i = 1 To no
 'Consumption of resource 1
  If (agent(i, 20) <= 1 Or agent(i, 20) = 4) And or1(agent(i, 0), agent(i, 1)) > 0 Then
   agent(i, 11) = agent(i, 11) + EfC1
   or1(agent(i, 0), agent(i, 1)) = or1(agent(i, 0), agent(i, 1)) - DNR1
  End If
 'Consumption of resource 2
  If (agent(i, 20) = 0 Or agent(i, 20) = 2 Or agent(i, 20) = 4) And or2(agent(i, 0), agent(i, 1)) > 0 Then
   agent(i, 12) = agent(i, 12) + EfC2
   or2(agent(i, 0), agent(i, 1)) = or2(agent(i, 0), agent(i, 1)) - DNR2
  End If
 Next
 
 ' ********** INTERCHANGE **********************************************************
  
 Select Case econoT
  
 Case 0
   If TaxType > 9 Then ETaxes
   
 Case 1, 10
  EBarter
  
 Case Else
  Economy
 
 End Select
  
 '*************************************************************************************
 XMatrix
End Sub

Sub ETaxes()   'TAXES on comodity defined by TaxType
Dim i As Integer
Dim temp As Single

 If TaxType < 10 And TaxType > 12 Then Exit Sub
  
 'Paying Taxes
 
  If FixedTax = 0 Then   'Taxes are payed as an fixed amount by agents richer than the mean
   For i = 1 To no
    If agent(i, 6) = 1 And agent(i, TaxType) > TaxAmount Then
     taxpool = taxpool + TaxAmount
     agent(i, TaxType) = agent(i, TaxType) - TaxAmount
    End If
   Next
 
  ElseIf FixedTax = 1 Then  'Taxes are payed by all as an percentage of the agents wealth
   For i = 1 To no
    If agent(i, 6) = 1 Then
     taxpool = taxpool + agent(i, TaxType) * TaxAmount / 100
     agent(i, TaxType) = agent(i, TaxType) - agent(i, TaxType) * TaxAmount / 100
    End If
   Next
 
  End If
  taxpoolT = taxpool
 
 
 Select Case TaxUse  'Benefits from taxes
 
 Case 1            'Distributing the collected benefits over all the population
  For i = 1 To no
   agent(i, TaxType) = agent(i, TaxType) + (taxpool / no) * SSTax 'Benefits
  Next
  taxpool = 0
 
 Case 2            'Taxes are used to punish tax evaders
   For i = 1 To no
    If agent(i, 6) = 0 And Rnd * 100 < Socef Then agent(i, TaxType) = agent(i, TaxType) - scmax(16) 'Punishment
   Next
    
 Case 3
  For i = 1 To no  ' Taxes are used to punish AND benefit tax payers
   If agent(i, 6) = 0 And Rnd * 100 < Socef Then agent(i, TaxType) = agent(i, TaxType) - scmax(16) 'Punishment
   taxpool = taxpool - CostY
   If taxpool <= 0 Then Exit For
  Next
  For i = 1 To no
   agent(i, TaxType) = agent(i, TaxType) + (taxpool / no) * SSTax 'Benefits
  Next
   
 End Select
 taxpool = 0
 
End Sub
Sub Transaction()
   If econoT = 5 Or econoT = 6 Then   'Creation of money through credit
    If amount > agent(buyer, 10) / price Then agent(buyer, 10) = amount * price + 1
   
   Else
    If amount > agent(buyer, 10) / price Then amount = Int(agent(buyer, 10) / price)
    If (agent(buyer, 10) / price) < 1# Then amount = 0#
   
   End If
    
    agent(seller, product) = agent(seller, product) - amount
    agent(buyer, product) = agent(buyer, product) + amount
    agent(seller, 10) = agent(seller, 10) + amount * price
    agent(buyer, 10) = agent(buyer, 10) - amount * price
    agent(buyer, 18) = agent(buyer, 18) + 1
    agent(seller, 18) = agent(seller, 18) + 1
    
End Sub

Sub Economy()
Dim i, j  As Integer   'counters
 ' For i = 1 To no
 '  agent(i, 18) = 0
 ' Next

  For i = 1 To no
   For j = 1 To no
    If Abs(agent(i, 0) - agent(j, 0)) < agent(i, 2) And Abs(agent(i, 1) - agent(j, 1)) < agent(i, 2) Then 'Contact radius
      
      'Altruistic behaviours
      If agent(i, 3) > 0 And (agent(j, 10) * agent(i, 14) < agent(i, 10) Or agent(i, 19) = 3) Then seller = i: buyer = j: Call BAltruist(i, j)
      
'************************* MERCANTILE MONEY WITH PRICE ADJUSTMENT **************************
    
Select Case econoT

Case 3, 5  'Fixed prices
  
  If (agent(j, 20) = 1 And agent(i, 20) = 3) Or (agent(i, 20) = 0 And agent(j, 20 = 0)) Then 'type of agent
  'Commerce of agricultural goods: Farmer (j) sells to trader (i)
         amount = agent(j, 11) - foodreserve
         buyer = i
         seller = j
         product = 11
         pritype = 21
       If amount > 0 And agent(j, 21) <= agent(i, 21) Then 'buyer fixes the lower limit of price
         price = agent(j, 21)   'seller fixes the price
         Transaction
       End If
     'Farmer (j) Buying minerals from trader (i)
         amount = agent(i, 12) - minreserve
         buyer = j
         seller = i
         product = 12
         pritype = 22
       If amount > 0 And agent(i, 22) <= agent(j, 22) Then
        price = agent(i, 22)
        Transaction
       End If
       ' End interaction agent 1 & 3
      
     'commerce with miners (j) selling minerals to traders (i)
  ElseIf (agent(j, 20) = 2 And agent(i, 20) = 3) Or (agent(j, 20) = 0 And agent(i, 20) = 0) Then
        amount = agent(j, 12) - minreserve
        buyer = i
        seller = j
        product = 12
        pritype = 22
       If amount > 0 And agent(j, 22) <= agent(i, 22) Then
        price = agent(j, 22)
        Transaction
       End If
      
      'miners(j) buying food from trader (i)
        amount = agent(i, 11) - foodreserve
        buyer = j
        seller = i
        product = 11
        pritype = 21
       If amount > 0 And agent(i, 21) <= agent(j, 21) Then
         price = agent(i, 21)
         Transaction
       End If
    
  End If


Case 4, 6   'Prices determined by demand
  
  If (agent(j, 20) = 1 And agent(i, 20) = 3) Or (agent(i, 20) = 0 And agent(j, 20 = 0)) Then 'type of agent
     'Commerce of agricultural goods: Farmer (j) sells to trader (i)
         amount = agent(j, 11) - foodreserve
         buyer = i
         seller = j
         product = 11
         pritype = 21
       If amount > 0 And agent(j, 21) <= agent(i, 21) Then 'buyer fixes the lower limit of price
         price = agent(j, 21)   'seller fixes the price
         Transaction
       Else
        Priceadjust
       End If
     'Farmer (j) Buying minerals from trader (i)
         amount = agent(i, 12) - minreserve
         buyer = j
         seller = i
         product = 12
         pritype = 22
       If amount > 0 And agent(i, 22) <= agent(j, 22) Then
        price = agent(i, 22)
        Transaction
       Else
        Priceadjust
       End If
       ' End interaction agent 1 & 3
      
     'Commerce with miners (j) selling minerals to traders (i)
  ElseIf (agent(j, 20) = 2 And agent(i, 20) = 3) Or (agent(j, 20) = 0 And agent(i, 20) = 0) Then
        amount = agent(j, 12) - minreserve
        buyer = i
        seller = j
        product = 12
        pritype = 22
       If amount > 0 And agent(j, 22) <= agent(i, 22) Then
        price = agent(j, 22)
        Transaction
       Else
        Priceadjust
       End If
      
     'Miners(j) buying food from trader (i)
        amount = agent(i, 11) - foodreserve
        buyer = j
        seller = i
        product = 11
        pritype = 21
       If amount > 0 And agent(i, 21) <= agent(j, 21) Then
         price = agent(i, 21)
         Transaction
       Else
        Priceadjust
       End If
    
  End If
 
 End Select 'case
End If 'Contact radius
   
   Next 'j
        
        
    If econoT = 7 Then  'Banking
      buyer = i
     If agent(i, 23) > 0 Then
      Bank2
     ElseIf agent(i, 10) < 1 And agent(i, 11) < 1 And agent(i, 12) < 1 Then
      Bank1
     End If
    End If
  
  Next  'i
 
  If TaxType > 9 Then ETaxes
 
End Sub

Sub Priceadjust()

agent(seller, pritype) = agent(seller, pritype) - 0.1
agent(buyer, pritype) = agent(buyer, pritype) + 0.1
If agent(seller, pritype) < 1 Then agent(seller, pritype) = 1

End Sub

Sub BAltruist(i, j) ' ALTRUISTIC BEHAVIOUR
Dim tmp As Single
'i=Altruistic donor
'j=Reciever
     tmp = 0
    If agent(j, 11) * agent(i, 14) < agent(i, 11) And agent(i, 1) > foodreserve Then
      tmp = agent(i, 13) * agent(i, 11) / 10 'Generosity %: wealth transacted
      agent(i, 18) = agent(i, 18) + 1  'Traking the donation history
      agent(i, 11) = agent(i, 11) - tmp
      agent(j, 11) = agent(j, 11) + tmp
      If agent(i, 11) < 0 Then agent(i, 11) = 0
      If agent(i, 3) = 2 And tmp > 0 Then agent(i, 12) = agent(i, 12) + tmp * agent(i, 15) / 5 'Altrustic strategy = 2: Generosity buys security
      If agent(i, 3) = 3 And tmp > 0 Then agent(i, 11) = agent(i, 11) + tmp * agent(i, 15) / 5 'AS=3: Commercial transaction (* Altruistic synergy)
    End If
    
'*********** ALTRUISTIC PUNISHMENT ****************************************************************
      
    'i=Altruistic punisher
    If agent(i, 19) = 1 Then  'Punishment triggered by PThr (8)  i = Punisher, j = Punished
      If agent(j, 13) < agent(i, 8) And agent(i, 11) > foodreserve Then
        If agent(i, 11) > agent(i, 16) Then tmp = agent(i, 16) Else tmp = agent(i, 11)
        agent(j, 11) = agent(j, 11) - tmp
        If agent(j, 11) < 0 Then agent(j, 11) = 0
        If econoT <> 10 Then agent(i, 11) = agent(i, 11) - tmp
        agent(j, 13) = agent(j, 13) + agent(j, 9)
      End If
      
    ElseIf agent(i, 19) = 2 And agent(i, 8) = 0 Then  'Punishment triggered when PThr = 0
       If agent(i, 11) > agent(i, 16) Then tmp = agent(i, 16) Else tmp = agent(i, 11)
       agent(j, 11) = agent(j, 11) - tmp
       If agent(j, 11) < 0 Then agent(j, 11) = 0
       If econoT <> 10 Then agent(i, 11) = agent(i, 11) - tmp
       agent(j, 13) = agent(j, 13) + agent(j, 9)
       
    ElseIf agent(i, 19) = 3 And agent(i, 6) = 1 And agent(j, 6) = 0 Then  'Tax payer punishes tax evader
      If Rnd * 100 < Socef Then
       If FixedTax = 0 Then
        agent(j, TaxType) = agent(j, TaxType) - agent(i, 16)
        agent(i, TaxType) = agent(i, TaxType) - CostY
       Else
        agent(j, TaxType) = agent(j, TaxType) - agent(j, TaxType) * agent(i, 16) / 10
        agent(i, TaxType) = agent(i, TaxType) - TaxAmount * agent(i, TaxType) / 100
       End If
      End If
    
    End If

End Sub

Sub Bank1() 'Getting a loan

    agent(buyer, 10) = agent(buyer, 10) + 10
    agent(buyer, 23) = agent(buyer, 23) + 10 + (10 * Interest / 100)
    MonBank = MonBank - 10
    If MonBank < 1 Then MonBank = 1
    
End Sub

Sub Bank2() 'Paying back a loan
Dim tmp As Single

    agent(buyer, 23) = agent(buyer, 23) + (agent(buyer, 23) * Interest / 100)
    
    If agent(buyer, 10) > agent(buyer, 23) Then
     tmp = agent(buyer, 23)
    ElseIf agent(buyer, 10) > 2 Then
     tmp = 2
    Else
     tmp = 0
    End If
    
     agent(buyer, 10) = agent(buyer, 10) - tmp
     agent(buyer, 23) = agent(buyer, 23) - tmp
     MonBank = MonBank + tmp

End Sub

   ********************************************************

Complementary Code:


Option Explicit

Sub excell()
Dim RetVal
Dim Text1 As String
Dim Text2 As String
  On Error GoTo errex
 Text1 = ParseFName(Fileparm)
 If findex = 0 Then
  If Mutsim = 0 Then
   Text1 = ParseExtOut(Text1) + "1.csv"
  Else
   Text1 = ParseExtOut(Text1) + "3.csv"
  End If
  If pathword = "" Then pathword = "c:\Archivos de Programa\Microsoft Office\office\excel.exe"
  'If pathword = "" Then pathword = "c:\Program Files\Microsoft Office\office\excel.exe"
  Text2 = pathword & " " & Text1
  RetVal = Shell(Text2, 3)
Else
 Text1 = ParseExtOut(Text1) + ".txt"
 If pathnote = "" Then pathnote = "c:\Windows\notepad.exe"
 Text2 = pathnote & " " & Text1
 RetVal = Shell(Text2, 3)
End If
 Exit Sub
errex:
  fpath.Show
  Exit Sub
End Sub

Sub colinit()
  
  Colorscale(23) = &HC0FFC0
  
 Select Case colcode
 Case Is < 2 ' For red color screen
  Colorscale(0) = QBColor(9)
  Colorscale(1) = RGB(0, 0, 0)
  Colorscale(2) = RGB(100, 0, 0)
  Colorscale(3) = RGB(150, 0, 0)
  Colorscale(4) = RGB(200, 0, 0)
  Colorscale(5) = RGB(255, 0, 0)
  Colorscale(6) = RGB(255, 50, 0)
  Colorscale(7) = RGB(255, 100, 0)
  Colorscale(8) = RGB(255, 140, 0)
  Colorscale(9) = RGB(255, 255, 0) ' QBColor(14)
  
  Colorscale(10) = QBColor(5)
  Colorscale(11) = QBColor(6)
  Colorscale(12) = QBColor(12)
  Colorscale(13) = QBColor(8)
  Colorscale(14) = QBColor(2)
  Colorscale(15) = QBColor(10)
  Colorscale(16) = QBColor(3)
  Colorscale(17) = QBColor(1)
  Colorscale(18) = QBColor(9)
  Colorscale(19) = QBColor(4)
  Colorscale(20) = QBColor(0)
  
  Colorscale(21) = QBColor(10)
  Colorscale(22) = &H0&

  Case Is = 2      ' Colors for printing
  Colorscale(0) = QBColor(15)
  Colorscale(9) = &H0&
  Colorscale(8) = &H11&
  Colorscale(7) = &H21&
  Colorscale(6) = &H41&
  Colorscale(5) = &H61&
  Colorscale(4) = &HA1&
  Colorscale(3) = &HC1&
  Colorscale(2) = &HFF1&
  Colorscale(1) = QBColor(14)
  
  Colorscale(10) = QBColor(5)
  Colorscale(11) = QBColor(5)
  Colorscale(12) = QBColor(13)
  Colorscale(13) = QBColor(11)
  Colorscale(14) = QBColor(1)
  Colorscale(15) = QBColor(2)
  Colorscale(16) = QBColor(10)
  Colorscale(17) = QBColor(12)
  Colorscale(18) = QBColor(4)
  Colorscale(19) = QBColor(7)
  Colorscale(20) = QBColor(3)

  Colorscale(21) = QBColor(11)
  Colorscale(22) = &H0&
 
 Case Is = 3     ' Black and white
  Colorscale(9) = QBColor(15)
  Colorscale(8) = QBColor(7)
  Colorscale(7) = QBColor(7)
  Colorscale(6) = QBColor(7)
  Colorscale(5) = QBColor(7)
  Colorscale(4) = QBColor(8)
  Colorscale(3) = QBColor(8)
  Colorscale(2) = QBColor(8)
  Colorscale(1) = QBColor(8)
  Colorscale(0) = QBColor(0)
  
  Colorscale(10) = QBColor(0)
  Colorscale(11) = QBColor(0)
  Colorscale(12) = QBColor(0)
  Colorscale(13) = QBColor(0)
  Colorscale(14) = QBColor(0)
  Colorscale(15) = QBColor(0)
  Colorscale(16) = QBColor(0)
  Colorscale(17) = QBColor(0)
  Colorscale(18) = QBColor(0)
  Colorscale(19) = QBColor(0)
  Colorscale(20) = QBColor(0)

  Colorscale(21) = QBColor(0)
  Colorscale(22) = QBColor(15)
 
 Case Is = 4      ' White and Black
  Colorscale(9) = QBColor(0)
  Colorscale(8) = QBColor(8)
  Colorscale(7) = QBColor(8)
  Colorscale(6) = QBColor(8)
  Colorscale(5) = QBColor(8)
  Colorscale(4) = QBColor(7)
  Colorscale(3) = QBColor(7)
  Colorscale(2) = QBColor(7)
  Colorscale(1) = QBColor(7)
  Colorscale(0) = QBColor(15)
  
  Colorscale(10) = QBColor(0)
  Colorscale(11) = QBColor(0)
  Colorscale(12) = QBColor(0)
  Colorscale(13) = QBColor(0)
  Colorscale(14) = QBColor(0)
  Colorscale(15) = QBColor(0)
  Colorscale(16) = QBColor(0)
  Colorscale(17) = QBColor(0)
  Colorscale(18) = QBColor(0)
  Colorscale(19) = QBColor(0)
  Colorscale(20) = QBColor(0)
 
  Colorscale(21) = QBColor(15)
  Colorscale(22) = QBColor(0)

 Case Is = 5
  Colorscale(9) = QBColor(4)
  Colorscale(8) = QBColor(12)
  Colorscale(7) = QBColor(1)
  Colorscale(6) = QBColor(9)
  Colorscale(5) = QBColor(11)
  Colorscale(4) = QBColor(3)
  Colorscale(3) = QBColor(2)
  Colorscale(2) = QBColor(2)
  Colorscale(1) = QBColor(10)
  Colorscale(0) = QBColor(14)
  
  Colorscale(10) = QBColor(0)
  Colorscale(11) = QBColor(13)
  Colorscale(12) = QBColor(12)
  Colorscale(13) = QBColor(11)
  Colorscale(14) = QBColor(10)
  Colorscale(15) = QBColor(15)
  Colorscale(16) = QBColor(5)
  Colorscale(17) = QBColor(4)
  Colorscale(18) = QBColor(3)
  Colorscale(19) = QBColor(2)
  Colorscale(20) = QBColor(0)
 
  Colorscale(21) = QBColor(15)
  Colorscale(22) = QBColor(4)
 
 Case Is = 6
  Colorscale(9) = QBColor(14)
  Colorscale(8) = QBColor(8)
  Colorscale(7) = QBColor(7)
  Colorscale(6) = QBColor(6)
  Colorscale(5) = QBColor(5)
  Colorscale(4) = QBColor(4)
  Colorscale(3) = QBColor(3)
  Colorscale(2) = QBColor(2)
  Colorscale(1) = QBColor(1)
  Colorscale(0) = QBColor(0)
  
  Colorscale(10) = QBColor(0)
  Colorscale(11) = QBColor(13)
  Colorscale(12) = QBColor(12)
  Colorscale(13) = QBColor(11)
  Colorscale(14) = QBColor(10)
  Colorscale(15) = QBColor(15)
  Colorscale(16) = QBColor(5)
  Colorscale(17) = QBColor(4)
  Colorscale(18) = QBColor(3)
  Colorscale(19) = QBColor(2)
  Colorscale(20) = QBColor(0)

  Colorscale(21) = QBColor(1)
  Colorscale(22) = QBColor(14)

 Case Is > 6
  Colorscale(0) = QBColor(9)
  Colorscale(1) = RGB(0, 0, 0)
  Colorscale(2) = RGB(100, 0, 0)
  'Colorscale(3) = RGB(150, 0, 0)
  Colorscale(3) = RGB(200, 0, 0)
  Colorscale(4) = RGB(255, 0, 0)
  Colorscale(5) = RGB(255, 50, 0)
  Colorscale(6) = RGB(255, 100, 0)
  Colorscale(7) = RGB(255, 140, 0)
  Colorscale(8) = RGB(255, 255, 0) ' QBColor(14)
  Colorscale(9) = RGB(255, 255, 255)
  
  Colorscale(10) = QBColor(12)
  Colorscale(11) = QBColor(2)
  Colorscale(12) = QBColor(4)
  Colorscale(13) = QBColor(14)
  Colorscale(14) = QBColor(0)
  Colorscale(15) = QBColor(11)
  Colorscale(16) = QBColor(3)
  Colorscale(17) = QBColor(7)
  Colorscale(18) = QBColor(5)
  Colorscale(19) = QBColor(8)
  Colorscale(20) = QBColor(9)

  Colorscale(21) = QBColor(1)
  Colorscale(22) = QBColor(14)

 End Select

End Sub

Sub genetrans()
Dim k, kk As Integer
' Transformations of genes
For k = 0 To 10
For kk = 0 To 13
If graf(kk) <= 23 Then pps(kk, k) = ps(graf(kk), k)
 Next
 Next
 
End Sub
Sub Initialization()
  Erase agent   ' Organisms with phenotype x
  Erase ps
  Erase PSS      ' Output matrix - raw data
  Erase ss
  Erase ss2
  Erase mean
  Erase sd
  Erase iLastY
  scmax0(21) = foodprice
  scmax(21) = foodprice
  scmax0(22) = minprice
  scmax(21) = minprice
  scmax(23) = 50
  scmax0(23) = 50

  maxagents = 6000
  tstep = 0
  iXCount = 0
  gnZoomIndex = -1
  VarList(40) = "40. Total population"
  VarList(39) = "39. Total Wealth"
  VarList(38) = "38. %TW Farmers"
  VarList(37) = "37. %TW Miners"
  VarList(36) = "36. %TW Traders"
  VarList(35) = "35. Nr Farmers #1"
  VarList(34) = "34. Nr Miners #2"
  VarList(33) = "33. Nr Traders #3"
  VarList(32) = "32. Monetary Base"
  VarList(31) = "31. Bank Money"
  VarList(30) = "30. Industrial Production"
  VarList(29) = "29. Total Tax Wealth"
  
  VarList(0) = "0. Position x"
  VarList(1) = "1. Position y"
  VarList(2) = "2. Contact Radius"
  VarList(3) = "3. Altruistic Strategy"
  VarList(4) = "4. Type of Movement"
  VarList(5) = "5. Distance of Movement"
  VarList(6) = "6. Pro Social"
  VarList(7) = "7. Age"
  VarList(8) = "8. Punitive Threshold"
  VarList(9) = "9. Shame"
  VarList(10) = "10. Money"
  VarList(11) = "11. Wealth-food"
  VarList(12) = "12. Wealth-commodities"
  VarList(13) = "13. Generosity (%)"
  VarList(14) = "14. Altuistic Threshold"
  VarList(15) = "15. Gain x 5"
  VarList(16) = "16. Cost K to Punished"
  VarList(17) = "17. Fertility"
  VarList(18) = "18. Donation history"
  VarList(19) = "19. Punitive Specialist"
  VarList(20) = "20. Type of Agent" '1 Farmer, 2 Miner, 3 Trader, 0 non-specialized generalist
  VarList(21) = "21. Food Prices"
  VarList(22) = "22. Mineral Prices"
  VarList(23) = "23. Credit"
  
  VarListAbr(40) = "POP"
  VarListAbr(39) = "TW"
  VarListAbr(38) = "%Far"
  VarListAbr(37) = "%Min"
  VarListAbr(36) = "%Tra"
  VarListAbr(35) = "nFar"
  VarListAbr(34) = "nMin"
  VarListAbr(33) = "nTra"
  VarListAbr(32) = "MB"
  VarListAbr(31) = "BM"
  VarListAbr(30) = "InPr"
  VarListAbr(29) = "TTW"
    
  VarListAbr(0) = "x"
  VarListAbr(1) = "y"
  VarListAbr(2) = "CR"
  VarListAbr(3) = "ASt"
  VarListAbr(4) = "TMo"
  VarListAbr(5) = "DMo"
  VarListAbr(6) = "P"
  VarListAbr(7) = "Age"
  VarListAbr(8) = "PTh"
  VarListAbr(9) = "Sha"
  VarListAbr(10) = "Wth"
  VarListAbr(11) = "WFo"
  VarListAbr(12) = "WCo"
  VarListAbr(13) = "Gen"
  VarListAbr(14) = "ATh"
  VarListAbr(15) = "Gain"
  VarListAbr(16) = "K"
  VarListAbr(17) = "Fert"
  VarListAbr(18) = "Don"
  VarListAbr(19) = "Pun"
  VarListAbr(20) = "TAg"
  VarListAbr(21) = "FPr"
  VarListAbr(22) = "MPr"
  VarListAbr(23) = "Crd"
  
  colinit
  
  NExtVar(0) = "ssconst"
  NExtVar(1) = "ino"
  NExtVar(2) = "ops"
  NExtVar(3) = "RNR1"
  NExtVar(4) = "SNR1"
  NExtVar(5) = "DNR1"
  NExtVar(6) = "DPR1"
  NExtVar(7) = "BRC1"
  NExtVar(8) = "EfC1"
  NExtVar(9) = "fch1"
  NExtVar(10) = "RNR2"
  NExtVar(11) = "SNR2"
  NExtVar(12) = "DNR2"
  NExtVar(13) = "DPR2"
  NExtVar(14) = "BRC2"
  NExtVar(15) = "EfC2"
  NExtVar(16) = "fch2"
  NExtVar(17) = "econoT"
  NExtVar(18) = "minFood"
  NExtVar(19) = "minMin"
  NExtVar(20) = "dangers"
  NExtVar(21) = "Mutation"
  NExtVar(22) = "TaxAmount"
  NExtVar(23) = "FixedTax"
  NExtVar(24) = "TaxUse"
  NExtVar(25) = "E"
  NExtVar(26) = "TaxType"
  NExtVar(27) = "SSTax"
  NExtVar(28) = "CostY"
  
 End Sub
Sub OutPut02()
'Plot  frequencies
  genetrans
  Dim i, ii, ji, j As Integer
  Dim temp As Single
    Dim lcol, tp As Long
  
    If iXCount + 1 > GraphRes Or iXCount = 0 Then
    'exceeded xmax position - start over
    For i = 0 To 13
      frmMain!picGene(i).Cls
    Next
    iXCount = 0
    End If
  
  For ji = 0 To 13
  'plot population graph
  Select Case graf(ji)
   
   Case Is = 40         'Or graf(ji) = 0 Then            population
   frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = ((iino / ops) ^ 0.5) * ops
    temp = ((no / ops) ^ 0.5) * ops
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
     
  Case Is = 39    'TW
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = (aggdp(1) + aggdp(2) + aggdp(3)) / 10
    temp = (aggdp(1) + aggdp(2) + aggdp(3)) / 10
    If temp > 100 Then temp = temp / 100
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
  
  Case Is = 38   '% TW Agriculture
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = aggdp(1) / 10
    temp = aggdp(1) / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
  
  Case Is = 37   '% TW Mining
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = aggdp(2) / 10
    temp = aggdp(2) / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
    
  Case Is = 36   '% TW Commerce
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = aggdp(3) / 10
    temp = aggdp(3) / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp

  Case Is = 35   '% Agriculture DM (Demography)
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = agno(1) / 10
    temp = agno(1) / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
  
  Case Is = 34   '% Mining DM
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = agno(2) / 10
    temp = agno(2) / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
    
  Case Is = 33   '% Commerce DM
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = agno(3) / 10
    temp = agno(3) / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp

  Case Is = 32    'Monetary Base
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = ((MonBase / ops) ^ 0.5) * ops / 4
    temp = ((MonBase / ops) ^ 0.5) * ops / 4
    If temp > ops * 3 Then temp = temp / 10: MonBase = MonBase / 10
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp

  Case Is = 31    'Bank Lending BM
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = MonBank / 20
    temp = MonBank / 20
    If temp > 20 Then temp = temp / 20: MonBank = MonBank / 20
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp

  Case Is = 30    'Industrial Production
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    If tstep = 1 Then iLastY(i, ji) = ((iino / ops) ^ 0.5) * ops
    temp = ((IndProd / ops) ^ 0.5) * ops
    If temp > ops / 2 Then temp = temp / 100
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
  'plot  graphs
  
  Case Is = 29    'TW
    frmMain!picGene(ji).DrawWidth = 3
    i = 1
    temp = taxpoolT
    frmMain!picGene(ji).Line (iXCount, iLastY(i, ji))-(iXCount + 1, temp), Colorscale(10)
    iLastY(i, ji) = temp
  
  Case Is < 24     'plot 12 variables
    i = ji
    For j = 1 To 11      'plots 0-11 lines
      lcol = Colorscale(pps(i, j - 1))
      'GoSub ColorSelection
      frmMain!picGene(i).Line (iXCount, j - 1)-(iXCount + 1, j), lcol, BF
    Next
  End Select
  Next
  iXCount = iXCount + 1
 If fplot.Visible = True Then OutPutPlot
End Sub
Sub OutPutPlot()
 Dim i, j, temp, tmp, tp, io, jo, iof, jof, io1, jo1 As Integer
 Dim tem As Double
 
 'Plot the spatial x - y plot
   fplot!Picture1.Cls
    
  If DNR1 = 0 Then
  ' fplot!Picture1.FillStyle = 1
   For i = 1 To RNR1
    temp = 0: tmp = 0
    io = oo(i, 0) + oo(i, 2)
    jo = oo(i, 1) + oo(i, 2)
    iof = oo(i, 0)
    jof = oo(i, 1)
    fplot!Picture1.Line (iof, jof)-(io, jo), QBColor(10), BF
    If io > scmax(0) Then io1 = io - scmax(0): temp = 1
    If temp = 1 Then fplot!Picture1.Line (0, jof)-(io1, jo), QBColor(10), BF
    If jo > scmax(1) Then jo1 = jo - scmax(1): tmp = 1
    If tmp = 1 Then fplot!Picture1.Line (iof, 0)-(io, jo1), QBColor(10), BF
    If temp = 1 And tmp = 1 Then fplot!Picture1.Line (0, 0)-(io1, jo1), QBColor(10), BF
   Next
  End If

  If DNR2 = 0 Then
  ' fplot!Picture1.FillStyle = 1
   For i = 1 To RNR2
    temp = 0: tmp = 0
    io = oo(i, 3) + oo(i, 5)
    jo = oo(i, 4) + oo(i, 5)
    iof = oo(i, 3)
    jof = oo(i, 4)
    fplot!Picture1.Line (iof, jof)-(io, jo), QBColor(2), BF
    If io > scmax(0) Then io1 = io - scmax(0): temp = 1
    If temp = 1 Then fplot!Picture1.Line (0, jof)-(io1, jo), QBColor(6), BF
    If jo > scmax(1) Then jo1 = jo - scmax(1): tmp = 1
    If tmp = 1 Then fplot!Picture1.Line (iof, 0)-(io, jo1), QBColor(6), BF
    If temp = 1 And tmp = 1 Then fplot!Picture1.Line (0, 0)-(io1, jo1), QBColor(6), BF
   Next
  End If
   
  ' plot the agents
   For i = 1 To no
     tem = agent(i, 10) + agent(i, 11) * agent(i, 21) + agent(i, 12) * agent(i, 22)
     If tem > 1 Then temp = CInt(Sqr((Sqr(tem)))) Else temp = 0.5
     If scmax0(acol) > 10 Then tp = 10 * agent(i, acol) / scmax0(acol) Else tp = agent(i, acol)
     If tp < 0 Then tp = 0
     If tp > 9 Then tp = 9
     fplot!Picture1.FillColor = Colorscale(tp + 10)
     fplot!Picture1.Circle (agent(i, 0), agent(i, 1)), temp, Colorscale(tp + 10)
   Next
 
  'Natural Resources 1 and 2
  If DNR1 > 0 Or DNR2 > 0 Then
   For j = 1 To scmax(1)
   For i = 1 To scmax(0)
    DoEvents
    If DNR1 > 0 And or1(i, j) > 0 Then fplot!Picture1.Line (i, j)-(i + 1, j + 1), QBColor(10), BF
    If DNR2 > 0 And or2(i, j) > 0 Then fplot!Picture1.Line (i, j)-(i + 1, j + 1), QBColor(6), BF
    'If DNR1 > 0 And or1(i, j) = 0 Then fplot!Picture1.Line (i, j)-(i + 1, j + 1), Colorscale(23), BF
    'If DNR2 > 0 And or2(i, j) = 0 Then fplot!Picture1.Line (i, j)-(i + 1, j + 1), Colorscale(23), BF
   Next
   Next
  End If
' ColorSelection:
' Select Case pps(i, j - 1)
'  Case 0: lcol = colorscale(0)
'  Case 1: lcol = colorscale(1)
'  Case 2: lcol = colorscale(2)
'  Case 3: lcol = colorscale(3)
'  Case 4: lcol = colorscale(4)
'  Case 5: lcol = colorscale(5)
'  Case 6: lcol = colorscale(6)
'  Case 7: lcol = colorscale(7)
'  Case 8: lcol = colorscale(8)
'  Case 9: lcol = colorscale(9)
'  Case Else: lcol = colorscale(11)
' End Select
' Return
End Sub
Sub Output03()  'Format the Zoom graphs
 Dim i As Integer
  'For i = 0 To 10
  'frmZoom.MSchart1.Column = i + 1
  'frmZoom.MSchart1.ColumnLabel = LTrim$(Str$(2))
  'Next
  For i = 1 To 11
   frmZoom.MSChart1.Row = i
   
   If gnZoomIndex = 39 Then 'Total Wealth
    frmZoom.MSChart1.RowLabel = ""
    If i = 1 Then frmZoom.MSChart1.Data = GDP Else frmZoom.MSChart1.Data = 0
   
   ElseIf gnZoomIndex = 29 Then 'Total Tax Wealth
    frmZoom.MSChart1.RowLabel = ""
    If i = 1 Then frmZoom.MSChart1.Data = taxpoolT Else frmZoom.MSChart1.Data = 0
   
   ElseIf gnZoomIndex = 36 Then 'Commerce
    frmZoom.MSChart1.RowLabel = ""
    If i = 4 Then
     frmZoom.MSChart1.Data = aggdp(3)
    ElseIf i = 3 Then
     frmZoom.MSChart1.Data = aggdp(2)
    ElseIf i = 2 Then
     frmZoom.MSChart1.Data = aggdp(1)
    ElseIf i = 1 Then
     frmZoom.MSChart1.Data = aggdp(0)
    Else
     frmZoom.MSChart1.Data = 0
    End If
     frmZoom.MSChart1.RowLabel = CStr(i - 1)
   
   ElseIf gnZoomIndex = 37 Then 'Mining
    frmZoom.MSChart1.RowLabel = ""
    If i = 4 Then
     frmZoom.MSChart1.Data = aggdp(3)
    ElseIf i = 3 Then
     frmZoom.MSChart1.Data = aggdp(2)
    ElseIf i = 2 Then
     frmZoom.MSChart1.Data = aggdp(1)
    ElseIf i = 1 Then
     frmZoom.MSChart1.Data = aggdp(0)
    Else
     frmZoom.MSChart1.Data = 0
    End If
     frmZoom.MSChart1.RowLabel = CStr(i - 1)
   
   ElseIf gnZoomIndex = 38 Then 'Agriculture
    frmZoom.MSChart1.RowLabel = ""
    If i = 4 Then
     frmZoom.MSChart1.Data = aggdp(3)
    ElseIf i = 3 Then
     frmZoom.MSChart1.Data = aggdp(2)
    ElseIf i = 2 Then
     frmZoom.MSChart1.Data = aggdp(1)
    ElseIf i = 1 Then
     frmZoom.MSChart1.Data = aggdp(0)
    Else
     frmZoom.MSChart1.Data = 0
    End If
     frmZoom.MSChart1.RowLabel = CStr(i - 1)
   
   ElseIf gnZoomIndex = 32 Then 'Money
    frmZoom.MSChart1.RowLabel = ""
    If i = 1 Then frmZoom.MSChart1.Data = MonBase Else frmZoom.MSChart1.Data = 0
   
   ElseIf gnZoomIndex = 31 Then 'Bank Money
    frmZoom.MSChart1.RowLabel = ""
    If i = 1 Then frmZoom.MSChart1.Data = MonBank Else frmZoom.MSChart1.Data = 0
   
   ElseIf gnZoomIndex = 30 Then 'Indistrial Production
    frmZoom.MSChart1.RowLabel = ""
    If i = 1 Then frmZoom.MSChart1.Data = IndProd Else frmZoom.MSChart1.Data = 0
   
   ElseIf gnZoomIndex > 32 And gnZoomIndex < 36 Then 'population of sector
    frmZoom.MSChart1.Data = PSS(20, 11 - i)
    If scmax0(gnZoomIndex) > 10 Then
     frmZoom.MSChart1.RowLabel = CStr((i - 1) * scmax0(gnZoomIndex) / 10)
    Else
     frmZoom.MSChart1.RowLabel = CStr(i - 1)
    End If
   
   Else   ' POPULATION
    frmZoom.MSChart1.Data = PSS(gnZoomIndex, 11 - i)
    If scmax0(gnZoomIndex) > 10 Then
     frmZoom.MSChart1.RowLabel = CStr((i - 1) * scmax0(gnZoomIndex) / 10)
    Else
     frmZoom.MSChart1.RowLabel = CStr(i - 1)
    End If
   End If
  Next
   
  frmZoom.MSChart1.DrawMode = 2
End Sub
Function ParseExtOut(FName As String) As String
'Accepts a string consisting of path and filename.
'Returns 1. the file name and path (without .ext)
'           if an extension is found.  or
'        2. the passed string if no extension is found.
Dim i As Integer
  If InStr(1, FName, ".") Then
    ParseExtOut = Left$(FName, InStr(1, FName, ".") - 1)
  Else
    ParseExtOut = FName
  End If
End Function
Function ParseFName(FilePath As String) As String
'Accepts a string with path and filename
'Returns the filename with extension.
 Dim i As Integer
  For i = Len(FilePath) To 2 Step -1
    If Mid$(FilePath, i, 1) = "\" Then Exit For
  Next
  If i <= 2 Then
    ParseFName = FilePath
  Else
    ParseFName = Right$(FilePath, Len(FilePath) - i)
  End If
End Function

Function ParsePath(FilePath As String) As String
'Accepts a string with path and filename.
'Returns the path - without the final \.
 Dim i As Integer
  For i = Len(FilePath) To 2 Step -1
    If Mid$(FilePath, i, 1) = "\" Then Exit For
  Next
  ParsePath = Left$(FilePath, i - 1)
End Function
Sub PrintFrm(PFrm As Form)
  Dim i As Integer
  'change cursor to hourglass
  PFrm.MousePointer = 11
  'set font size for printer
  Printer.FontSize = 8.5
  'move the (0,0) on the printer object to center form on the page
  Printer.ScaleLeft = -((Printer.Width - PFrm.Width) / 2)
  Printer.ScaleTop = -((Printer.Height - PFrm.Height) / 2)
  Printer.Print " "
End Sub


Sub Readparms(FName As String)
  Dim i As Integer
  On Error GoTo ReadParmsError
  Open FName For Input As #1
    Input #1, GraphRes 'iinspnr1  '0
    Input #1, ino '1
    Input #1, ops '2
    Input #1, RNR1 '3
    Input #1, SNR1 '4
    Input #1, DNR1 '5
    Input #1, DPR1 '6
    Input #1, RNR2 '7
    Input #1, BRC2  '8
    Input #1, fch2  '9
    Input #1, econoT '10
    Input #1, SNR2 '11
    Input #1, DNR2 '12
    Input #1, EfC1 '13
    Input #1, BRC1  '14
    Input #1, DPR2  '15
    Input #1, Mutsim '16
    Input #1, mutation '17
    Input #1, EfC2 '18
    Input #1, dangers '19
    Input #1, fch1 '20
    Input #1, ssconst  '21
    Input #1, inspnr1 '22
    Input #1, inspnr2 '23
    Input #1, mafood
     
    For i = 0 To 20
     Input #1, scmax(i)
     If scmax(i) < 10 Then scmax0(i) = 10 Else scmax0(i) = scmax(i)
    Next

    For i = 0 To 13
    Input #1, graf(i)
    Next
    
   For i = 1 To 10
    Input #1, allel(i)
   Next
   
   Input #1, acol
   
   For i = 0 To 20
    Input #1, dom(i, 0)
   Next
   
   For i = 0 To 20
    Input #1, scmin(i)
   Next
   scmin(0) = scmax(0)
   scmin(1) = scmax(1)
   
  For i = 0 To 20
    Input #1, dom(i, 1), dom(i, 2), dom(i, 3)
   Next
  
   Input #1, foodprice
   Input #1, minprice
   Input #1, profit
   Input #1, foodreserve
   Input #1, minreserve
   Input #1, srage
   Input #1, Interest
   Input #1, TaxType
   Input #1, SSTax
   Input #1, TaxAmount
   Input #1, FixedTax
   Input #1, TaxUse
   Input #1, Socef
  
   For i = 21 To 30
    Input #1, dom(i, 0), dom(i, 1), dom(i, 2), dom(i, 3)
   Next
   
   Input #1, CostY
   Input #1, Pridistortion
   Input #1, Inflation
   
 Close #1
 If Pridistortion = 0 Then Pridistortion = 1
 TransExtVar1

Exit Sub
  
ReadParmsError:
Close
MsgBox "Error" + Str$(Err) + " in file " + FName, MB_OK + MB_IconExclamation, "Read Parameter File"
FName = "None Selected"
Exit Sub

End Sub
Sub TransExtVar1()
  ExtVar(0) = ssconst
  ExtVar(1) = ino
  ExtVar(2) = ops
  ExtVar(3) = RNR1
  ExtVar(4) = SNR1
  ExtVar(5) = DNR1
  ExtVar(6) = DPR1
  ExtVar(7) = BRC1
  ExtVar(8) = EfC1
  ExtVar(9) = fch1
  ExtVar(10) = RNR2
  ExtVar(11) = SNR2
  ExtVar(12) = DNR2
  ExtVar(13) = DPR2
  ExtVar(14) = BRC2
  ExtVar(15) = EfC2
  ExtVar(16) = fch2
  ExtVar(17) = econoT
  ExtVar(18) = foodreserve
  ExtVar(19) = minreserve
  ExtVar(20) = dangers
  ExtVar(21) = mutation
  ExtVar(22) = TaxAmount
  ExtVar(23) = FixedTax
  ExtVar(24) = TaxUse
  ExtVar(25) = Socef
  ExtVar(26) = TaxType
  ExtVar(27) = SSTax
  ExtVar(28) = CostY

  
End Sub
Sub TransExtVar()
  ssconst = ExtVar(0)
  ino = ExtVar(1)
  ops = ExtVar(2)
  RNR1 = ExtVar(3)
  SNR1 = ExtVar(4)
  DNR1 = ExtVar(5)
  DPR1 = ExtVar(6)
  BRC1 = ExtVar(7)
  EfC1 = ExtVar(8)
  fch1 = ExtVar(9)
  RNR2 = ExtVar(10)
  SNR2 = ExtVar(11)
  DNR2 = ExtVar(12)
  DPR2 = ExtVar(13)
  BRC2 = ExtVar(14)
  EfC2 = ExtVar(15)
  fch2 = ExtVar(16)
  econoT = ExtVar(17)
  foodreserve = ExtVar(18)
  minreserve = ExtVar(19)
  dangers = ExtVar(20)
  mutation = ExtVar(21)
  TaxAmount = ExtVar(22)
  FixedTax = ExtVar(23)
  TaxUse = ExtVar(24)
  Socef = ExtVar(25)
  TaxType = ExtVar(26)
  SSTax = ExtVar(27)
  CostY = ExtVar(28)

End Sub

Sub Readpops(FName As String)
  Dim i, ii, j, jj As Integer
  
 ' frmGauge.Show
  On Error GoTo ReadPopsError
  Open FName For Input As #1
    Input #1, no
   ' ino = no
    'read organisms
    For i = 1 To no
    '  frmGauge!hgaUpdate.Value = Int((i / no) * 100)
      For jj = 1 To 3
        For j = 0 To ng
          Input #1, agent(i, j)
        Next
      Next
    Next
    'read phenotypes
    For i = 1 To no
      For j = 0 To ng
        Input #1, agent(i, j)
      Next
    Next
    'read graphics parameters
    For ii = 0 To 13
    For i = 1 To 10
      Input #1, iLastY(i, ii)
    Next
    Next
    Close #1
'  Unload frmGauge
  Exit Sub
ReadPopsError:
Close #1
MsgBox "Error" + Str$(Err) + " in file " + FName, MB_OK + MB_IconExclamation, "Read Population File"
FName = "None Selected"
Exit Sub
End Sub

Sub SaveParms(FName As String)
  Dim i As Integer
  On Error GoTo SaveParmsError
  Open FName For Output As #1
    Write #1, GraphRes 'iinspnr1 '0
    Write #1, ino '1
    Write #1, ops '2
    Write #1, RNR1 '3
    Write #1, SNR1 '4
    Write #1, DNR1 '5
    Write #1, DPR1 '6
    Write #1, RNR2 '7
    Write #1, BRC2 '8
    Write #1, fch2 '9
    Write #1, econoT '10
    Write #1, SNR2 '11
    Write #1, DNR2 '12
    Write #1, EfC1 '13
    Write #1, BRC1
    Write #1, DPR2
    Write #1, Mutsim
    Write #1, mutation
    Write #1, EfC2
    Write #1, dangers
    Write #1, fch1
    Write #1, ssconst
    Write #1, inspnr1
    Write #1, inspnr2
    Write #1, mafood
    
    For i = 0 To 20
      Write #1, scmax(i)
    Next
      
    For i = 0 To 13
     Write #1, graf(i)
    Next
    
    For i = 1 To 10
     Write #1, allel(i)
    Next
    
    Write #1, acol
    
    For i = 0 To 20
     Write #1, dom(i, 0)
    Next
    
    For i = 0 To 20
      Write #1, scmin(i)
    Next
  
   For i = 0 To 20
    Write #1, dom(i, 1), dom(i, 2), dom(i, 3)
   Next

   Write #1, foodprice
   Write #1, minprice
   Write #1, profit
   Write #1, foodreserve
   Write #1, minreserve
   Write #1, srage
   Write #1, Interest
   Write #1, TaxType
   Write #1, SSTax
   Write #1, TaxAmount
   Write #1, FixedTax
   Write #1, TaxUse
   Write #1, Socef
    
   For i = 21 To 30
    Write #1, dom(i, 0), dom(i, 1), dom(i, 2), dom(i, 3)
   Next
   
   Write #1, CostY
   Write #1, Pridistortion
   Write #1, Inflation
   
Close #1
i = MsgBox(FName + " saved", MB_OK, "Save File")
Exit Sub

SaveParmsError:
Close
MsgBox "Error" + Str$(Err) + " in file " + FName, MB_OK + MB_IconExclamation, "Save File"
Exit Sub

End Sub
Sub SaveParmFile()
 Dim i As Integer
 Dim Text As String
 Text = ParseFName(Fileparm)
 Text = ParseExtOut(Text) + ".txt"
 
  On Error GoTo SaveParmsError
  Open Text For Output As #1
    Print #1, "Maxium Time Steps                    ", GraphRes
    Print #1, "Initial population                   ", ino  '1
    Print #1, "Optimal population size              ", ops '2
    Write #1,
    Print #1, "Richness of Natural Resources 1       ", RNR1 '3
    Print #1, "Size of Natural Resources 1           ", SNR1 '4
    Print #1, "Degradation of Natural Resources 1    ", DNR1 '5"
    Print #1, "Distribution Pattern of Resource 1    ", DPR1 '6
    Print #1, "Basal Rate of Consumtion Resource 1   ", BRC1
    Print #1, "Efficiency of consumtion Resource 1   ", EfC1 '13
    Print #1, "Frequency of change resource 1        ", fch1
       
    Print #1, "Richness of Resource 2                ", RNR2 '7
    Print #1, "Size of Resource 2                    ", SNR2 '11
    Print #1, "Degradation of Resource 2             ", DNR2 '12
    Print #1, "Distribution Pattern of Resource 2    ", DPR2
    Print #1, "Basal Rate of Consumption Resource 2  ", BRC2 '8
    Print #1, "Efficiency of Consumption Resource 2  ", EfC2
    Print #1, "Frequency of change resource 1        ", fch2 '9
    Write #1,
    Print #1, "Maximum value of x                    ", scmax(0)
    Print #1, "Maximum value of y                    ", scmax(1)
    Print #1, "Type of tax or economy                ", econoT '10
    Print #1, "Dangers                               ", dangers
    Print #1, "Simulation Scenario                   ", ssconst
  '  Print #1, inspnr1
  '  Print #1, inspnr2
  '  Print #1, i
    Write #1,
    Print #1, "                                      ", "Min", "Max"
    For i = 2 To 20
      Print #1, VarList(i); , "  ", scmin(i), scmax(i)
    Next
      
  '  For i = 0 To 13
  '   Print #1, graf(i)
  '  Next
    
  '  For i = 1 To 10
  '   Print #1, allel(i)
  '  Next
  '  Print #1, acol
 '   For i = 2 To 20
 '    Print #1, dom(i)
 '   Next
'
  
Close #1
i = MsgBox(Text + " saved", MB_OK, "Save File")
Exit Sub

SaveParmsError:
Close
MsgBox "Error" + Str$(Err) + " in file " + Text, MB_OK + MB_IconExclamation, "Save File"
Exit Sub

End Sub
Sub SavePops(FName As String)
Dim i, ii, j, jj As Integer
 ' frmGauge.Show
  On Error GoTo SavePopsError
  Open FName For Output As #1
    Write #1, no
    'save organisms
    For i = 1 To no
     ' frmGauge!hgaUpdate.Value = Int((i / no) * 100)
      For jj = 1 To 3
        For j = 0 To ng
          Write #1, agent(i, j)
        Next
      Next
    Next
    'save phenotypes
    For i = 1 To no
      For j = 0 To ng
        Write #1, agent(i, j)
      Next
    Next
    'save graphics parameters
    For ii = 0 To 13
    For i = 1 To 10
      Write #1, iLastY(i, ii)
    Next
    Next
 ' Unload frmGauge
  Close #1
  Exit Sub
SavePopsError:
Close #1
MsgBox "Error" + Str$(Err) + " in file " + FName, MB_OK + MB_IconExclamation, "Read Population File"
Exit Sub
End Sub