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