Attribute VB_Name = "a03_Economics_3"
Option Explicit
Public Sub new_economy_3()
'! Calculate various income for different status
Printdok "new_economy_3"
Dim i As Long
status "Economy 3"
For i = 1 To m_icount
If i_status(i) <> 2 Then i_income(i) = income_3(i_indnr(i))
Select Case i_status(i)
' Kids
Case 1
i_income(i) = 0
' Retired
Case 2
'********* New routines for calculation of old age pension benefits *******
i_ap(i) = f_Public_Pension_Benefits(i)
i_op(i) = f_Occupational_pension_benefits(i)
'**************************************************************************
'i_income(i) = 4 * m_basbelopp
If base_year + model_time < 2002 Then i_income(i) = 0
If i_status1(i) = 2 Then
' Gammal pensionär
If base_year + model_time >= 2002 Then
' i_income(i) = (m_pension_income_index - 1.016 + 1) * i_income(i)
i_income(i) = (m_pension_income_index - 1# + 1) * i_income(i)
End If
Else
' Ny pensionär
Dim delningstal As Double
Dim ip As Double ' Inkomstberoende pension
Dim gp As Double ' Grundpension
delningstal = 17.54288
'i_income(i) = (i_pension_right_public(i) + i_pension_right_premie(i)) / delningstal
' TP2 - 010207: deleted the variables i_pension_right_public and
' i_pension_right_premie
' ip = (i_pension_right_public(i) + i_pension_right_premie(i)) / delningstal
' i_pension_right_public(i) = 0
' i_pension_right_premie(i) = 0
' Grundpension
If h_n_adults(hhnr2index(i_hhnr(i))) = 1 Then
If ip >= 0 And ip <= 1.26 * m_basbelopp Then
gp = 2.13 * m_basbelopp - ip
Else
gp = 2.13 * m_basbelopp - 1.26 * m_basbelopp - 0.48 * ip
If gp < 0 Then gp = 0
End If
Else
If ip >= 0 And ip <= 1.14 * m_basbelopp Then
gp = 1.9 * m_basbelopp - ip
Else
gp = 1.9 * m_basbelopp - 1.14 * m_basbelopp - 0.48 * ip
If gp < 0 Then gp = 0
End If
End If
i_income(i) = gp + ip
End If
' Students
Case 3
'i_income(i) = Exp(gauss(10.09, 0.929))
'*** Student incomes need to be defined here!!! TP 020308
'*** As a temporary solution the distribution of incomes for
'*** students could be estimated using a regressiom model.
i_income(i) = Exp(gauss(10.09, 0.929)) '*** NOTE: old estimate
If Rnd < 0.06 Then i_income(i) = 0
i_income(i) = i_income(i) * m_wage_change99
' Early retired
Case 4
'********* New routines for calculation of disability pension benefits ****
Call Calculate_Disability_Pension(i)
'**************************************************************************
' New fp
' i_income(i) = 0.7 * i_wincome(i)
i_income(i) = 0.8 * i_income(i)
If i_income(i) < 2 * m_basbelopp Then i_income(i) = 2 * m_basbelopp
i_income(i) = i_income(i) * m_wage_change99
' At home with children
Case 5
i_income(i) = i_income(i) / 2 + mini(0.4 * i_income(i), 0.4 * 7.5 * m_basbelopp)
'i_income(i) = mini(0.8 * i_wincome(i), 0.8 * 7.5 * m_basbelopp)
i_income(i) = i_income(i) * m_wage_change99
' Unemployed
Case 6
' i_income(i) = 0.8 * i_wincome(i)
' If i_income(i) > 4.2 * m_basbelopp Then i_income(i) = 4.2 * m_basbelopp
i_income(i) = i_income(i) / 2 + mini(0.4 * i_income(i), 2.1 * m_basbelopp)
i_income(i) = i_income(i) * m_wage_change99
'Misc
Case 7
i_income(i) = gauss(41348 - 667.18 * i_age(i), 47055) * m_wage_change99
If i_income(i) < 0 Then i_income(i) = 0
If i_abroad(i) = 1 Then i_income(i) = 0
' Working
Case 8
' i_wincome(i) = i_income(i)
i_income(i) = i_income(i) * m_wage_change99
i_inc_capital(i) = -28711.246 + 386.398803 - 0.0140121 * i_income(i) + gauss(0, 23110.6035)
If i_inc_capital(i) < 0 Then i_inc_capital(i) = 0
End Select
If i_income(i) < 0 Then i_income(i) = 0
Next
'Simulate wages, labor supply and labor income
' Simulate an hourly wage rate
For i = 1 To m_icount
' i_wage(i) = 0
' i_hours(i) = 0
' i_wage(i) = wage(i)
Next
' Simulate hours of work
For i = 1 To m_hcount
Call labor_supply(i)
Next
'Incomes
For i = 1 To m_icount
' i_income(i) = i_hours(i) * i_wage(i)
Next
End Sub
Private Function income_3(indnr)
'! Income function for working individuals
'! Estimated from HINK-panel
Dim previous_income As Double
Dim dummy_short_uni As Integer
Dim dummy_long_uni As Integer
Dim age As Integer
'previous_income = i_income(indnr2index(indnr)) * m_price99
' Get start income
' If i_status1(indnr2index(indnr)) = 3 And _
' i_status(indnr2index(indnr)) = 8 Then
' previous_income = i_wincome(indnr2index(indnr))
' End If
'
' If previous_income <= 0 Then
' previous_income = start_income(i_edlevel(indnr2index(indnr)), i_sex(indnr2index(indnr)))
' End If
' Get start income
' If previous_income <= 0 Or _
' ( _
' i_status1(indnr2index(indnr)) = 3 And _
' i_status(indnr2index(indnr)) = 8 _
' ) Then
'
' previous_income = start_income(i_edlevel(indnr2index(indnr)), i_sex(indnr2index(indnr)))
' End If
'
' previous_income = previous_income / 1000
dummy_short_uni = 0
dummy_long_uni = 0
Select Case i_edlevel(indnr2index(indnr))
Case 1
dummy_short_uni = 1
Case 2
dummy_long_uni = 1
End Select
age = i_age(indnr2index(indnr))
' income = 1.59109565709792 _
' + 0.829177856285058 * Log(previous_income) _
' + -5.14001749366099E-02 * age _
' + 5.24679509000653E-02 * (age ^ 2) / 40 _
' + -1.73555928505761E-02 * (age ^ 3) / 1600 _
' + -6.70318117252498E-02 * (i_sex(indnr2index(indnr)) - 1) _
' + 4.47465962491152E-02 * dummy_short_uni _
' + 0.085023186147375 * dummy_long_uni _
' + i_inc_ivariance(indnr2index(indnr)) _
' + gauss(0, 0.199804292632823)
'4.047 int
'0.06525 age
'-0.03477 a2
'0.003041 a3
'-0.3243 d3
'-0.07014 d4
'-0.1049 d5
'-0.06191 d6
'-0.3422 dkv
'0.1780 dku
'0.4129 dlu
'0.3842 indv
'0.2609 err
' i_inc_itvariance(indnr2index(indnr)) = gauss(0, 0.2609)
' income = 4.047 _
' + 0.06525 * age _
' - 0.03477 * (age ^ 2) / 40 _
' + 0.003041 * (age ^ 3) / 1600 _
' - 0.3422 * (i_sex(indnr2index(indnr)) - 1) _
' + 0.178 * dummy_short_uni _
' + 0.4129 * dummy_long_uni _
' + i_inc_ivariance(indnr2index(indnr)) _
' + i_inc_itvariance(indnr2index(indnr))
' MODEL 4
' i_inc_itvariance(indnr2index(indnr)) = gauss(0, 0.2175)
' income = -3.1122 _
' + 0.8237 * age _
' - 1.17 * (age ^ 2) / 40 _
' + 0.73 * (age ^ 3) / 1600 _
' - 0.16796 * (age ^ 4) / 64000 _
' + 4.491 * (i_sex(indnr2index(indnr)) - 1) _
' - 0.5318 * (i_sex(indnr2index(indnr)) - 1) * age _
' + 0.7985 * (i_sex(indnr2index(indnr)) - 1) * (age ^ 2) / 40 _
' - 0.5051 * (i_sex(indnr2index(indnr)) - 1) * (age ^ 3) / 1600 _
' + 0.116 * (i_sex(indnr2index(indnr)) - 1) * (age ^ 4) / 64000 _
' + 0.00438 * dummy_short_uni * age _
' + 0.008436 * dummy_long_uni * age _
' + i_inc_ivariance(indnr2index(indnr)) _
' + i_inc_itvariance(indnr2index(indnr))
' Model 6
i_inc_itvariance(indnr2index(indnr)) = gauss(0, 0.2167 * 0.6)
income_3 = -2.9612 _
+ 0.8096 * age _
- 1.1498 * (age ^ 2) / 40 _
+ 0.717 * (age ^ 3) / 1600 _
- 0.1665 * (age ^ 4) / 64000 _
+ 4.4258 * (i_sex(indnr2index(indnr)) - 1) _
- 0.5248 * (i_sex(indnr2index(indnr)) - 1) * age _
+ 0.7882 * (i_sex(indnr2index(indnr)) - 1) * (age ^ 2) / 40 _
- 0.4983 * (i_sex(indnr2index(indnr)) - 1) * (age ^ 3) / 1600 _
+ 0.1144 * (i_sex(indnr2index(indnr)) - 1) * (age ^ 4) / 64000 _
+ 0.004324 * dummy_short_uni * age _
+ 0.008945 * dummy_long_uni * age _
- 0.00013 * dummy_short_uni * age * (i_sex(indnr2index(indnr)) - 1) _
- 0.00139 * dummy_long_uni * age * (i_sex(indnr2index(indnr)) - 1) _
+ i_inc_ivariance(indnr2index(indnr)) _
+ i_inc_itvariance(indnr2index(indnr))
If income_3 > 0 Then
income_3 = Exp(income_3) * 1000
Else
income_3 = 0
End If
End Function
Private Function start_income_3(edlevel, bkon)
'! Start income function for working individuals
Select Case bkon * 10 + edlevel
Case 10
start_income_3 = gauss(11.5377789, 0.656172)
Case 11
start_income_3 = gauss(11.61393, 0.76758)
Case 12
start_income_3 = gauss(12.271775, 0.4406683)
Case 20
start_income_3 = gauss(11.3565746, 0.5721239)
Case 21
start_income_3 = gauss(11.4997289, 0.6607105)
Case 22
start_income_3 = gauss(12.0121163, 0.4559312)
End Select
If start_income_3 > 0 Then
start_income_3 = Exp(start_income_3)
Else
start_income_3 = 0
End If
End Function
Public Function wage(indexnr)
Dim ed1, ed2, ed3, ed4 As Integer
Dim age2, wagerate, wageeps As Double
age2 = i_age(indexnr) ^ 2 / 100
' level of education
If i_edlevel(indexnr) = 0 Then ed1 = 1 Else ed1 = 0
If i_edlevel(indexnr) = 1 Then ed2 = 1 Else ed2 = 0
If i_edlevel(indexnr) = 2 Then ed3 = 1 Else ed3 = 0
If i_edlevel(indexnr) = 3 Then ed4 = 1 Else ed4 = 0
If i_age(indexnr) > 18 Then
'wageeps = gauss(0, 0.0668)
'add ind effect 0.151
' replace wageeps with a new wageeps (above) and an individual effect (above)
wageeps = gauss(0, 0.16)
wagerate = 4.02 + 0.0185 * i_age(indexnr) - 0.0174 * age2 + 0.0892 * ed2 + 0.118 * ed3 _
+ 0.271 * ed4 + 0.148 * (2 - i_sex(indexnr)) + wageeps
wage = Exp(wagerate)
Else
wage = 0
End If
End Function
Public Sub labor_supply(hnr As Long)
Dim m As Long
Dim f As Long
Dim kid, indexnr, indexnr_f, indexnr_m, indnr, maxh, nch, ii, filenum As Integer
Dim nsup_sm, nsup_f, nsup_m, hours, hours_hf, hours_hm, select_support As Integer
Dim stepsize, earnings, selector, support, hetero, ran_uni As Double
Dim edf1, edf2, edf3, edf4, af1, af2, af3, af4 As Integer
Dim edm1, edm2, edm3, edm4, am1, am2, am3, am4 As Integer
Dim hmax As Double
'parameters
maxh = 3 'upper limit hours of work
hmax = 4 'upper limit hours in utility
nsup_sm = 2 'number of support points single mothers
nsup_f = 2 'number of support points single females wo children
nsup_m = 2 'number of support points single males
stepsize = 0.5 'length of hours interval
Const mc As Integer = 7 'number of hours class
Const npar_sm As Integer = 16 'number of parameters single mother
Const npar_f As Integer = 14 'number of parameters single females wo children
Const npar_m As Integer = 14 'number of parameters single males
Const npar_h As Integer = 29 'number of parameters household, both work
'get indnr, zero if nonexist
Call get_malefemale_indnr(h_hhnr(hnr), m, f)
'get some household variables
'number of children in hosehold
nch = h_n_child(hnr)
'dummy=1 if youngest child < 2 years of age
kid = 0
indnr = h_first_indnr(hnr)
Do While indnr <> 0
indexnr = indnr2index(indnr)
If i_bvux(indexnr) = 0 And i_age(indexnr) < 2 Then kid = 1
indnr = i_next_indnr(indnr2index(indnr))
Loop
' The labor supply model distinguish between four types of housholds;
' Single mothers, Single women without children, Single men and Couples.
' Start with Singles
If mini(m, f) = 0 Then
'Single women
If f > 0 Then
indexnr = indnr2index(f)
If i_status(indexnr) = 8 Then 'working
If nch > 0 Then 'Single mothers
'read parameters from file
Dim temppar_sm(npar_sm) As Variant
Dim par_sm(npar_sm) As Double
filenum = FreeFile()
Open "t:\sesim\parameter_peter\utpar_sm_nosup_fc.txt" For Input As #filenum%
For ii = 1 To npar_sm
Input #filenum%, temppar_sm(ii)
par_sm(ii) = CDbl(temppar_sm(ii))
Next
Close filenum
'create individual variables
'education
If i_edlevel(indexnr) = 0 Then edf1 = 1 Else edf1 = 0
If i_edlevel(indexnr) = 1 Then edf2 = 1 Else edf2 = 0
If i_edlevel(indexnr) = 2 Then edf3 = 1 Else edf3 = 0
If i_edlevel(indexnr) = 3 Then edf4 = 1 Else edf4 = 0
'ageclass
If (18 <= i_age(indexnr) And i_age(indexnr) <= 24) Then af1 = 1 Else af1 = 0
If (25 <= i_age(indexnr) And i_age(indexnr) <= 34) Then af2 = 1 Else af2 = 0
If (35 <= i_age(indexnr) And i_age(indexnr) <= 44) Then af3 = 1 Else af3 = 0
If (45 <= i_age(indexnr) And i_age(indexnr) <= 54) Then af4 = 1 Else af4 = 0
'disp.inc. corresponding to class of hours of work
Dim disp_income_sm(mc) As Double
For hours = 1 To mc
' i_income(indexnr) = i_wage(indexnr) * 1000 * (hours - 1) * stepsize
Call calc_disp_household(h_hhnr(hnr))
disp_income_sm(hours) = h_inc_disposable(hnr)
Next
' utility function
Dim utility_sm(mc) As Double
support = par_sm(15)
'define utility corresponding to each class of hours of work
Dim hours_sm, cons_sm As Double
Dim fc_sm As Integer
hetero = support + par_sm(1) * nch + par_sm(2) * kid + par_sm(3) * edf2 + _
par_sm(4) * edf3 + par_sm(5) * edf4 + par_sm(6) * af1 + par_sm(7) * af2 + _
par_sm(8) * af3 * par_sm(9) * af4
For hours = 1 To mc
If hours > 1 Then fc_sm = 1 Else fc_sm = 0
hours_sm = (hours - 1) * stepsize
cons_sm = disp_income_sm(hours) / 100000
If cons_sm < 0.1 Then cons_sm = 0.1
ran_uni = Rnd()
While ran_uni = 0
ran_uni = Rnd()
Wend
utility_sm(hours) = par_sm(10) * Log(cons_sm) + hetero * Log(hmax - hours_sm) + _
par_sm(11) * (Log(cons_sm)) ^ 2 + _
par_sm(12) * (Log(hmax - hours_sm)) ^ 2 + _
par_sm(13) * 2 * Log(hmax - hours_sm) * Log(cons_sm) _
- par_sm(16) * fc_sm - Log(-Log(ran_uni))
Next
'choose max utility
Dim utility_max_sm As Double
utility_max_sm = -99999
For hours = 1 To mc
If utility_sm(hours) > utility_max_sm Then utility_max_sm = utility_sm(hours)
Next
'get corresponding hours of work
For hours = 1 To mc
If utility_max_sm = utility_sm(hours) Then
' i_hours(indexnr) = (hours - 1) * stepsize * 1000
Exit For
End If
Next
' If i_hours(indexnr) > 0 Then i_hours(indexnr) = i_hours(indexnr) - 250
'add measurement error in hours of work for single mothers
'soon
Else 'Single women without children
'read parameters
Dim temppar_f(npar_f) As Variant
Dim par_f(npar_f) As Double
filenum = FreeFile()
Open "t:\sesim\parameter_peter\utpar_f_nosup_fc.txt" For Input As #filenum%
For ii = 1 To npar_f
Input #filenum%, temppar_f(ii)
par_f(ii) = CDbl(temppar_f(ii))
Next
Close filenum
'create individual variables
'education
If i_edlevel(indexnr) = 0 Then edf1 = 1 Else edf1 = 0
If i_edlevel(indexnr) = 1 Then edf2 = 1 Else edf2 = 0
If i_edlevel(indexnr) = 2 Then edf3 = 1 Else edf3 = 0
If i_edlevel(indexnr) = 3 Then edf4 = 1 Else edf4 = 0
'ageclass
If (18 <= i_age(indexnr) And i_age(indexnr) <= 24) Then af1 = 1 Else af1 = 0
If (25 <= i_age(indexnr) And i_age(indexnr) <= 34) Then af2 = 1 Else af2 = 0
If (35 <= i_age(indexnr) And i_age(indexnr) <= 44) Then af3 = 1 Else af3 = 0
If (45 <= i_age(indexnr) And i_age(indexnr) <= 54) Then af4 = 1 Else af4 = 0
'disp.inc. corresponding to class of hours of work
Dim disp_income_f(mc) As Double
For hours = 1 To mc
' i_income(indexnr) = i_wage(indexnr) * 1000 * (hours - 1) * stepsize
Call calc_disp_household(h_hhnr(hnr))
disp_income_f(hours) = h_inc_disposable(hnr)
Next
'utility
Dim utility_f(mc) As Double
Dim fc_f As Integer
support = par_f(13)
'define utility corresponding to each class of hours of work
Dim hours_f, cons_f As Double
hetero = par_f(1) * edf2 + _
par_f(2) * edf3 + par_f(3) * edf4 + par_f(4) * af1 + par_f(5) * af2 + _
par_f(6) * af3 * par_f(7) * af4 + support
For hours = 1 To mc
If hours > 1 Then fc_f = 1 Else fc_f = 0
hours_f = (hours - 1) * stepsize
cons_f = disp_income_f(hours) / 100000
If cons_f < 0.1 Then cons_f = 0.1
ran_uni = Rnd()
While ran_uni = 0
ran_uni = Rnd()
Wend
utility_f(hours) = par_f(8) * Log(cons_f) + hetero * Log(hmax - hours_f) + _
par_f(9) * (Log(cons_f)) ^ 2 + _
par_f(10) * (Log(hmax - hours_f)) ^ 2 + _
par_f(11) * 2 * Log(hmax - hours_f) * Log(cons_f) _
- par_f(14) * fc_f - Log(-Log(ran_uni))
Next
'choose max utility
Dim utility_max_f As Double
utility_max_f = -99999
For hours = 1 To mc
If utility_f(hours) > utility_max_f Then utility_max_f = utility_f(hours)
Next
'get corresponding hours of work
For hours = 1 To mc
If utility_max_f = utility_f(hours) Then
' i_hours(indexnr) = (hours - 1) * stepsize * 1000
Exit For
End If
Next
' If i_hours(indexnr) > 0 Then i_hours(indexnr) = i_hours(indexnr) - 250
'add measurement error in hours of work for single female without children
'soon
End If
Else 'if not working
' i_hours(indnr2index(f)) = 0
End If
'men
Else 'Single men
indexnr = indnr2index(m)
If i_status(indnr2index(m)) = 8 Then 'working
'read parameters
Dim temppar_m(npar_m) As Variant
Dim par_m(npar_m) As Double
filenum = FreeFile()
Open "t:\sesim\parameter_peter\utpar_m_nosup_fc.txt" For Input As #filenum%
For ii = 1 To npar_m
Input #filenum%, temppar_m(ii)
par_m(ii) = CDbl(temppar_m(ii))
Next
Close filenum
'create individual variables
'education
If i_edlevel(indexnr) = 0 Then edm1 = 1 Else edm1 = 0
If i_edlevel(indexnr) = 1 Then edm2 = 1 Else edm2 = 0
If i_edlevel(indexnr) = 2 Then edm3 = 1 Else edm3 = 0
If i_edlevel(indexnr) = 3 Then edm4 = 1 Else edm4 = 0
'ageclass
If (18 <= i_age(indexnr) And i_age(indexnr) <= 24) Then am1 = 1 Else am1 = 0
If (25 <= i_age(indexnr) And i_age(indexnr) <= 34) Then am2 = 1 Else am2 = 0
If (35 <= i_age(indexnr) And i_age(indexnr) <= 44) Then am3 = 1 Else am3 = 0
If (45 <= i_age(indexnr) And i_age(indexnr) <= 54) Then am4 = 1 Else am4 = 0
'disp.inc. corresponding to class of hours of work
Dim disp_income_m(mc) As Double
For hours = 1 To mc
' i_income(indexnr) = i_wage(indexnr) * 1000 * (hours - 1) * stepsize
Call calc_disp_household(h_hhnr(hnr))
disp_income_m(hours) = h_inc_disposable(hnr)
Next
'utility
Dim utility_m(mc) As Double
Dim fc_m As Integer
support = par_m(13)
'define utility corresponding to each class of hours of work
Dim hours_m, cons_m As Double
hetero = par_m(1) * edm2 + _
par_m(2) * edm3 + par_m(3) * edm4 + par_m(4) * am1 + par_m(5) * am2 + _
par_m(6) * am3 * par_m(7) * am4 + support
For hours = 1 To mc
If hours > 1 Then fc_m = 1 Else fc_m = 0
hours_m = (hours - 1) * stepsize
cons_m = disp_income_m(hours) / 100000
If cons_m < 0.1 Then cons_m = 0.1
ran_uni = Rnd()
While ran_uni = 0
ran_uni = Rnd()
Wend
utility_m(hours) = par_m(8) * Log(cons_m) + hetero * Log(hmax - hours_m) + _
par_m(9) * (Log(cons_m)) ^ 2 + _
par_m(10) * (Log(hmax - hours_m)) ^ 2 + _
par_m(11) * 2 * Log(hmax - hours_m) * Log(cons_m) _
- par_m(14) * fc_m - Log(-Log(ran_uni))
Next
'choose max utility
Dim utility_max_m As Double
utility_max_m = -99999
For hours = 1 To mc
If utility_m(hours) > utility_max_m Then utility_max_m = utility_m(hours)
Next
'get corresponding hours of work
For hours = 1 To mc
If utility_max_m = utility_m(hours) Then
' i_hours(indexnr) = (hours - 1) * stepsize * 1000
Exit For
End If
Next
' If i_hours(indexnr) > 0 Then i_hours(indexnr) = i_hours(indexnr) - 250
'add measurement error in hours of work for single female without children
'soon
Else 'if not working
' i_hours(indnr2index(m)) = 0
End If
End If
Else 'Couples
'
'get variables
indexnr_f = indnr2index(f)
indexnr_m = indnr2index(m)
'education
If i_edlevel(indexnr_f) = 0 Then edf1 = 1 Else edf1 = 0
If i_edlevel(indexnr_f) = 1 Then edf2 = 1 Else edf2 = 0
If i_edlevel(indexnr_f) = 2 Then edf3 = 1 Else edf3 = 0
If i_edlevel(indexnr_f) = 3 Then edf4 = 1 Else edf4 = 0
If i_edlevel(indexnr_m) = 0 Then edm1 = 1 Else edm1 = 0
If i_edlevel(indexnr_m) = 1 Then edm2 = 1 Else edm2 = 0
If i_edlevel(indexnr_m) = 2 Then edm3 = 1 Else edm3 = 0
If i_edlevel(indexnr_m) = 3 Then edm4 = 1 Else edm4 = 0
'ageclass
If (18 <= i_age(indexnr_f) And i_age(indexnr) <= 24) Then af1 = 1 Else af1 = 0
If (25 <= i_age(indexnr_f) And i_age(indexnr) <= 34) Then af2 = 1 Else af2 = 0
If (35 <= i_age(indexnr_f) And i_age(indexnr) <= 44) Then af3 = 1 Else af3 = 0
If (45 <= i_age(indexnr_f) And i_age(indexnr) <= 54) Then af4 = 1 Else af4 = 0
If (18 <= i_age(indexnr_m) And i_age(indexnr) <= 24) Then am1 = 1 Else am1 = 0
If (25 <= i_age(indexnr_m) And i_age(indexnr) <= 34) Then am2 = 1 Else am2 = 0
If (35 <= i_age(indexnr_m) And i_age(indexnr) <= 44) Then am3 = 1 Else am3 = 0
If (45 <= i_age(indexnr_m) And i_age(indexnr) <= 54) Then am4 = 1 Else am4 = 0
' Three cases:Both work, only male work, only female work
If i_status(indexnr_m) = 8 Or i_status(indexnr_f) = 8 Then 'at least one person work
'read parameters
Dim temppar_h(npar_h) As Variant
Dim par_h(npar_h) As Double
filenum = FreeFile()
Open "t:\sesim\parameter_peter\utpar_peter_alla_nosup.txt" For Input As #filenum%
For ii = 1 To npar_h
Input #filenum%, temppar_h(ii)
par_h(ii) = CDbl(temppar_h(ii))
Next
Close filenum
'create select variable for three different cases
'1. both are working
'2. only male working
'3. only female working
Dim work_select As Integer
If i_status(indexnr_m) = 8 And i_status(indexnr_f) = 8 Then
work_select = 1
ElseIf i_status(indexnr_m) = 8 And i_status(indexnr_f) <> 8 Then
work_select = 2
Else
work_select = 3
End If
'disp.inc. corresponding to class of hours of work
Dim disp_income_h(1 To mc, 1 To mc) As Double
For hours_hm = 1 To mc
For hours_hf = 1 To mc
Select Case work_select
Case 1
' i_income(indexnr_m) = i_wage(indexnr_m) * 1000 * (hours_hm - 1) * stepsize
' i_income(indexnr_f) = i_wage(indexnr_f) * 1000 * (hours_hf - 1) * stepsize
Case 2
' i_income(indexnr_m) = i_wage(indexnr_m) * 1000 * (hours_hm - 1) * stepsize
Case 3
' i_income(indexnr_f) = i_wage(indexnr_f) * 1000 * (hours_hf - 1) * stepsize
End Select
Call calc_disp_household(h_hhnr(hnr))
disp_income_h(hours_hm, hours_hf) = h_inc_disposable(hnr)
Next
Next
'simulate a support point
Dim support_hf, support_hm As Double
'female
support_hf = par_h(27)
'male
support_hm = par_h(26)
'define utility corresponding to each class of hours of work
Dim cons_h, hetero_hf, hetero_hm As Double
Dim fc_hf, fc_hm As Integer
Dim utility_h(1 To mc, 1 To mc) As Double
hetero_hm = par_h(1) * nch + _
par_h(2) * edf2 + par_h(3) * edf3 + par_h(4) * edf4 + par_h(5) * af1 + _
par_h(6) * af2 + par_h(7) * af3 + par_h(8) * af4 + support_hm
hetero_hf = par_h(9) * nch + _
par_h(10) * edm2 + par_h(11) * edm3 + par_h(12) * edm4 + par_h(13) * am1 + _
par_h(14) * am2 + par_h(15) * am3 + par_h(16) * am4 + support_hf
For hours_hm = 1 To mc
For hours_hf = 1 To mc
If hours_hm > 1 Then fc_hm = 1 Else fc_hm = 0
If hours_hf > 1 Then fc_hf = 1 Else fc_hf = 0
hours_f = (hours_hf - 1) * stepsize
hours_m = (hours_hm - 1) * stepsize
cons_h = disp_income_h(hours_hm, hours_hf) / 100000
If cons_h < 0.1 Then cons_h = 0.1
Dim u(1 To 10) As Double
ran_uni = Rnd()
While ran_uni = 0
ran_uni = Rnd()
Wend
utility_h(hours_hm, hours_hf) = par_h(17) * Log(cons_h) + hetero_hm * Log(hmax - hours_m) + _
hetero_hf * Log(hmax - hours_f) + par_h(18) * (Log(cons_h)) ^ 2 + _
par_h(19) * (Log(hmax - hours_m)) ^ 2 + _
par_h(20) * (Log(hmax - hours_f)) ^ 2 + _
2 * par_h(21) * (Log(hmax - hours_m)) * Log(cons_h) + _
2 * par_h(22) * (Log(hmax - hours_f)) * Log(cons_h) + _
2 * par_h(23) * (Log(hmax - hours_m)) * (Log(hmax - hours_f)) _
- fc_hm * par_h(28) - fc_hf * par_h(29) - Log(-Log(ran_uni))
Next
Next
'choose max utility
Dim utility_max_h As Double
utility_max_h = -99999
Select Case work_select
Case 1
For hours_hm = 1 To mc
For hours_hf = 1 To mc
If utility_h(hours_hm, hours_hf) > utility_max_h Then utility_max_h = utility_h(hours_hm, hours_hf)
Next
Next
Case 2
For hours_hm = 1 To mc
If utility_h(hours_hm, 1) > utility_max_h Then utility_max_h = utility_h(hours_hm, 1)
Next
Case 3
For hours_hf = 1 To mc
If utility_h(1, hours_hf) > utility_max_h Then utility_max_h = utility_h(1, hours_hf)
Next
End Select
'get corresponding hours of work
Select Case work_select
Case 1
For hours_hm = 1 To mc
For hours_hf = 1 To mc
If utility_max_h = utility_h(hours_hm, hours_hf) Then
' i_hours(indexnr_f) = (hours_hf - 1) * stepsize * 1000
' i_hours(indexnr_m) = (hours_hm - 1) * stepsize * 1000
End If
Next
Next
Case 2
' i_hours(indexnr_f) = 0
For hours_hm = 1 To mc
If utility_max_h = utility_h(hours_hm, 1) Then
' i_hours(indexnr_m) = (hours_hm - 1) * stepsize * 1000
End If
Next
Case 3
' i_hours(indexnr_m) = 0
For hours_hf = 1 To mc
If utility_max_h = utility_h(1, hours_hf) Then
' i_hours(indexnr_f) = (hours_hf - 1) * stepsize * 1000
End If
Next
End Select
' If i_hours(indexnr_f) > 0 Then i_hours(indexnr_f) = i_hours(indexnr_f) - 250
' If i_hours(indexnr_m) > 0 Then i_hours(indexnr_m) = i_hours(indexnr_m) - 250
End If
If i_status(indnr2index(m)) = 8 And i_status(indnr2index(f)) <> 8 Then 'only male work
' i_hours(indnr2index(f)) = 0
End If
If i_status(indnr2index(m)) <> 8 And i_status(indnr2index(f)) = 8 Then 'only female work
' i_hours(indnr2index(m)) = 0
End If
End If
End Sub