Attribute VB_Name = "a00_NewYear"
Option Explicit

'***********************************************************************
'*** Sub forward_one_year is the called every year in the simulation and
'*** controls the general order of execution in SESIM.
'***********************************************************************

Public Sub forward_one_year()

  '! Start simulation for one year ahead
  Printdok "forward_one_year"

  ' Increase time
  model_time = model_time + 1
  status "Year: " & model_time + base_year
  
  ' Calculate some macro figures
  Call calc_newyear_macro
  
  ' Reset random numbers
  If random = 0 Then
    Rnd (-1)
    Randomize maxi(0, model_time)
  End If
  
  ' Demographics
  Call new_population
  
  ' Regional migration
  Call Regional_Migration

  ' Education
  Call education
  
  ' Set status
  Call set_status
  
  ' Simulate number of days with sickness absence
  If get_scalefactor("BabyBoom_Active") <> 1 Then
    Call Sick_leave_Health
  Else
    Call Sick_leave
  End If

  ' new economy
  'If InStr(1, controlcenter.txt2Runsystem.text, "1") > 0 Then Call new_economy_1
  If InStr(1, controlcenter.txt2Runsystem.text, "2") > 0 Then Call new_economy_2
  If InStr(1, controlcenter.txt2Runsystem.text, "3") > 0 Then Call new_economy_3
  
  ' Tenure choice
  Call TenureChoice
    
  ' Wealth and pension savings
  Call Wealth_PensionSavings
  
  ' Debt
  Call Debt
  
  ' Interest and dividends
  Call Interest_Dividends
  
  ' Capital gains (excl. sales of own home)
  Call CapitalGain
  
  ' Debt interest
  Call DebtInterest
  
  ' Calculate rules
  Call calc_rules
  
  ' Simulation of Baby Boom modules
  If get_scalefactor("BabyBoom_Active") <> 1 Then
  
  ' Closeness to relative
    Call ClosenessToRelative
  
    ' Imputation of health index
    Call Health
  
    ' Imputation of days with inpatient care
    Call Inpatient_Care
  
    ' Imputation of disability (ADL)
    Call ADL
    
    ' Imputation of assistance for elderly
    Call AssistanceElderly
    
  End If

  'Necessary for calculation of balancing mechanism.
  '*** Erase previous information in the Uds matrix
  Dim i As Long
  For i = LBound(Uds) To UBound(Uds)
    Uds(i) = 0
  Next

  Call calculate_Uds
  
  ' Automatic balancing
  Call automatic_balancing
  
  ' Save binary files
  If controlcenter.chk2Saveoutfiles.value = 1 Then
    Call Write_Data
  End If
  
  ' Save data to Access DB
  If controlcenter.chk2SaveAccessdb.value = 1 Then
     'Call MDIForm1.menu_writeaccess_Click
  End If
  
  ' Write event history (if enabled)
  lifehist.write_now
  
  ' Write income history
  If controlcenter.chk2Saveincomehist.value = 1 Then
     inchist.write_now
  End If
  
  '*** Write data to textfile
  '*** Primarily for export to SAS
  Call Write_Output_Data_Old
  
  Printdok " -- forward_one_year ready"
End Sub

'*********************************************************** ' Sub set_status determines the status of each individual in ' the model population due to deterministic rules and/or ' stochastic models. '***********************************************************
Private Sub set_status() '! Update status variable Dim stat_text(9) As String, old_status As Integer, i As Long, x As Double Dim rand_unemp() As Double, rand_working() As Double Dim debug_unemp As Long, debug_work As Long Printdok "set_status" status "Set status" stat_text(1) = "Child" ' Child stat_text(2) = "Agepens" ' Old Pensioner stat_text(3) = "Stud" ' Education stat_text(4) = "Disabled" ' Early retired stat_text(5) = "Parent" ' Parental leave stat_text(6) = "Unemp" ' Unemployed stat_text(7) = "Misc" ' Miscellaneous stat_text(8) = "Work" ' Working stat_text(9) = "Emig" ' Emigrant '*** Draw random numbers for randomization of unemployment ReDim rand_unemp(1 To m_icount) Call RANUNI(m_icount, rand_unemp(1), model_time + base_year + random * Rnd) '*** Draw random numbers for randomization of employed individuals ReDim rand_working(1 To m_icount) Call RANUNI(m_icount, rand_working(1), model_time + base_year + 1 + random * Rnd) '*** Update h_bvux_work in loop belop For i = 1 To m_hcount h_bvux_work(i) = 1 Next Printdok " i loop in set_status: " Printdok " i loop in set_status: " Printdok " i loop in set_status: " Printdok " i loop in set_status: " Printdok " i loop in set_status: " '*** Check if the unemployment function is to write debug data? debug_unemp = 0 If get_scalefactor("debug_unemployment") <> 1 Then debug_unemp = 1 '*** Check if the employment function is to write debug data? debug_work = 0 If get_scalefactor("debug_work") <> 1 Then debug_work = 1 Dim status_unemployed As Byte, status_working As Byte Dim Pension_age_On As Integer, Pension_age As Double, alfa As Double Dim No_sector_change_On As Integer, pens As Long Dim Pension_replacement_limit_On As Integer, Pension_replacement_limit As Double Pension_age_On = get_scalefactor_active("Pension_age") Pension_age = get_scalefactor("Pension_age") alfa = (txtRetire - Pension_age) / (txtRetire - ((txtRetire + 60) / 2)) No_sector_change_On = get_scalefactor_active("No_sector_change") Pension_replacement_limit_On = get_scalefactor_active("Pension_replacement_limit_On") Pension_replacement_limit = get_scalefactor("Pension_replacement_limit_On") For i = 1 To m_icount i_status1(i) = i_status(i) ' lagged status variable old_status = i_status(i) '*** OS 020507: Varför inte använda i_status1(i)? i_status(i) = 0 i_prob_unemployed(i) = 1E+20 i_prob_working(i) = 1E+20 '*** Children If i_age(i) <= 15 Then i_status(i) = 1 '*** Retirement '-- Compulsary retirement of disability pensioners at age 65 If i_status1(i) = 4 And i_age(i) = 65 Then i_status(i) = 2 i_ap_pensmonth(i) = 0 End If ' Select Case (model_time + base_year) 'AW Testar en reform ' Case Is = 2005 'AW Testar en reform ' If i_status1(i) = 4 And i_age(i) >= 61 Then 'AW ' i_status(i) = 2 ' i_ap_pensmonth(i) = 0 ' End If ' Case Else ' If i_status1(i) = 4 And i_age(i) = 65 Then ' i_status(i) = 2 ' i_ap_pensmonth(i) = 0 ' End If ' End Select '-- Already retired continues to be retired If i_status1(i) = 2 Then i_status(i) = 2 End If '-- Compulsary retirement at age 70 If i_age(i) > 70 And i_status1(i) <> 2 Then i_status(i) = 2 i_ap_pensmonth(i) = 60 ' (70-65) * 12 End If '-- Exo- or endogenous retirement if checkbox in Controlcenter marked or not If chkRetire65 = True Then '-- Optional pension at a certain replacement limit If Pension_replacement_limit_On = 1 And i_age(i) >= 61 And _ i_status1(i) <> 4 And i_status1(i) <> 2 And i_status1(i) <> 9 Then pens = f_Public_Pension_Benefits(i) + f_Occupational_pension_benefits(i) + _ f_Private_Pension_Benefits(i, 10) If pens > Pension_replacement_limit * f_avg_income(i) And _ pens > 2.13 * m_basbelopp_income Then i_status(i) = 2 i_ap_pensmonth(i) = (i_age(i) - 65) * 12 End If Else '-- Optinal alignment of average pensions age If Pension_age_On = 1 And i_age(i) >= 61 And i_age(i) < txtRetire Then If Rnd < alfa / (txtRetire - 61) Then i_status(i) = 2 i_ap_pensmonth(i) = (i_age(i) - 65) * 12 End If End If End If '-- Exogenous retirement of individuals at age txtRetrire if not already retired If i_status(i) = 0 And i_age(i) >= txtRetire Then i_status(i) = 2 i_ap_pensmonth(i) = (txtRetire - 65) * 12 End If Else '-- Endogenous retirement: Run Retirement module ' If age>=61 and not already retired retirement is an option If i_age(i) >= 61 And i_status(i) = 0 And old_status <> 2 Then If old_status = 8 Then 'If working call pension_decision Call Pension_Decision(i) ElseIf i_age(i) >= 65 Then 'If older than 64 and not working then retired i_status(i) = 2 i_ap_pensmonth(i) = 0 End If End If End If '-- Retirement means no disability pension benefits If i_status(i) = 2 Then i_ftp(i) = 0 i_ftp_atp(i) = 0 i_ftp_fp(i) = 0 i_ftp_pts(i) = 0 i_ftp_ink(i) = 0 i_ftp_gar(i) = 0 i_ftp_just(i) = 0 i_ftp_antag(i) = 0 i_pgb_antag(i) = 0 'Pensionsright, assumed income disability i_pr_ip1(i) = i_pr_ip(i) '-- Lag pensions rights i_pr_pp1(i) = i_pr_pp(i) End If '*** Disabled If i_status(i) = 0 And (i_new_fp(i) = 1 Or old_status = 4) Then _ i_status(i) = 4 '*** Rehabilitated from disability If old_status = 4 And i_new_fp(i) = -1 Then i_status(i) = 0 '-- Rehabilitation means no disability pension benefits i_ftp(i) = 0 i_ftp_atp(i) = 0 i_ftp_fp(i) = 0 i_ftp_pts(i) = 0 i_ftp_ink(i) = 0 i_ftp_gar(i) = 0 i_ftp_just(i) = 0 i_ftp_antag(i) = 0 i_pgb_antag(i) = 0 'Pensionsright, assumed income disability i_ftp_typ(i) = 0 End If '*** On parental leave - note: only women If i_status(i) = 0 And i_sex(i) = 2 And exist_newborn(i_hhnr(i)) = 1 Then _ i_status(i) = 5 '*** Education If i_status(i) = 0 And i_student(i) > 0 Then i_status(i) = 3 '*** Participating in the workforce? If i_status(i) = 0 Then '*** Unemployed status_unemployed = unemployed(i, rand_unemp, debug_unemp) If status_unemployed = 1 Then i_status(i) = 6 '*** Increase the number of spells of unemployment ' If i_status1(i) <> 6 Then i_nr_unempspells(i) = i_nr_unempspells(i) + 1 '*** Now, the employed are to be randomized from the rest of the population Else '*** Working status_working = f_working(i, rand_working, debug_work) If status_working = 1 Then i_status(i) = 8 Else '*** Miscellaneous i_status(i) = 7 End If End If '*** Update the labor force sector classification i_sector1(i) = i_sector(i) Call Update_Sector(i) '-- No sector change after age 60 If i_age(i) > 60 And i_sector1(i) <> 0 And i_sector(i) <> i_sector1(i) Then i_sector(i) = i_sector1(i) End If '*** Optional: No sector change during lifetime If No_sector_change_On = 1 And i_sector1(i) <> 0 And i_sector(i) <> i_sector1(i) Then i_sector(i) = i_sector1(i) End If End If ' Emigrants (old or new) - note: disability pension and old age pension ' overrides the emigrant status If i_abroad(i) = 1 Or i_new_em(i) = 1 Then If (i_status(i) <> 2 And i_status(i) <> 4) Then i_status(i) = 9 End If '*** Temorary solution: Updating i_work_share If i_status(i) = 8 Then i_work_share(i) = 0 End If '-- Part-time work and share of full pension benefit '*** Temorary solution: Allways full-time retirement and no work if i_status=2 If i_status(i) = 2 And i_status1(i) <> 2 Then 'New pensioner i_p_andel(i) = 1 i_work_share1(i) = i_work_share(i) i_work_share(i) = 0 Else i_work_share(i) = 0 i_work_share1(i) = 0 End If ' If change in status - save to event db (if enabled) If i_status(i) <> i_status1(i) Then _ lifehist.write_hist i_indnr(i), "Stat " & stat_text(i_status1(i)) & _ "->" & stat_text(i_status(i)) '*** Update h_bvux_work If i_bvux(i) = 1 And i_status(i) <> 8 Then h_bvux_work(hhnr2index(i_hhnr(i))) = 0 Next ' -- Optional aligning of working If get_scalefactor_active("Align_working") = 1 Then Call Align_Working End If '-- End Align working Call code_variables End Sub
'-- Aligning of Status 6 and 8 to exogenous participation and unemployment rates ' Status 7 is the residual ("accordion") ' To activate write "Align_working" i Parm-form in Control center (On=1)
Private Sub Align_Working() Dim year As Integer, maxyear As Integer, i As Long year = model_time + base_year 'If year <= 2050 Then maxyear = year Else maxyear = 2050 'If year <= 2150 Then maxyear = year Else maxyear = 2150 If year <= 2110 Then maxyear = year Else maxyear = 2110 Dim Sorted() As Double Dim akbef1664_p As Double, al1664_p As Double, aptot_p As Double, apsys_p As Double Dim BEF1664 As Long, AK1664 As Long, SYS As Long, AL1664 As Long Dim APTOT As Long, APSYS As Long Dim Status5 As Long, goal_Status6 As Long, goal_Status8 As Long Dim plim As Double, n As Long '-- Reading align data from assumptions file akbef1664_p = parm_macro(maxyear, 16) / 100 '-- Participation rate al1664_p = parm_macro(maxyear, 17) / 100 '-- Unempoyment rate aptot_p = parm_macro(maxyear, 18) / 100 '-- Labour market program rate, total apsys_p = parm_macro(maxyear, 19) / 100 '-- Labour market program rate, employed '-- Calculates and initiation of some base variables For i = 1 To m_icount If i_abroad(i) = 0 Then If i_age(i) > 15 And i_age(i) < 65 Then '-- Population BEF1664 = BEF1664 + 1 End If If i_status(i) = 5 Then '-- On parental leave countes as employed Status5 = Status5 + 1 End If Else '-- Persons abroa not on domestic labour market i_prob_unemployed(i) = 1E+20 i_prob_working(i) = 1E+20 End If If (i_status(i) = 6 Or i_status(i) = 7 Or i_status(i) = 8) And i_age(i) < 65 Then i_status(i) = 0 End If Next '-- Calculates goals AK1664 = BEF1664 * akbef1664_p AL1664 = AK1664 * al1664_p SYS = AK1664 - AL1664 APTOT = AK1664 * aptot_p APSYS = AK1664 * apsys_p goal_Status6 = AL1664 + APTOT goal_Status8 = SYS - APSYS - Status5 '-- Align Unemployed ReDim Sorted(1 To m_icount) ' For i = 1 To m_icount ' Sorted(i, 1) = i_prob_unemployed ' Sorted(i, 2) = i_indnr(i) ' Next ' Call D_SORTVEC(i_prob_unemployed(1), m_icount, Sorted(1)) Sorted = wrap_D_SORTVEC(i_prob_unemployed, Sorted) 'plim = Sorted(m_icount - goal_Status6) plim = Sorted(goal_Status6) n = 0 For i = 1 To m_icount If i_status(i) = 0 And i_abroad(i) = 0 Then If i_prob_unemployed(i) <= plim And n < goal_Status6 Then i_status(i) = 6 i_prob_working(i) = 1E+20 n = n + 1 End If End If Next 'Debug.Print "Arbetslöshet mål: "; goal_Status6 & " Resultat: " & n '-- Align Working ReDim Sorted(1 To m_icount) 'Call D_SORTVEC(i_prob_working(1), m_icount, Sorted(1)) Sorted = wrap_D_SORTVEC(i_prob_working, Sorted) 'plim = Sorted(m_icount - goal_Status8) plim = Sorted(goal_Status8) n = 0 For i = 1 To m_icount If i_status(i) = 0 And i_abroad(i) = 0 Then If i_prob_working(i) <= plim And n < goal_Status8 Then i_status(i) = 8 n = n + 1 Else i_status(i) = 7 End If End If Next 'Debug.Print "Work mål: "; goal_Status8 & " Resultat: " & n End Sub
'Function Sector(ByVal indnr As Long) As Double ' ''**************************************************************************************** '' Sector: Routine for imputing sector. '' 1. Calculate the probability of own employed '' 2. Calculate the probability of blue collar, given employed '' 3. Calculate the probability of public, given employed and blue collar '' 4. Calculate the probability of public, given employed and white collar '' 5. Calculate the probability of state, given employed, blue collar and public '' 6. Calculate the probability of state, given employed, white collar and public '' '' Then define: '' Sector=1 Blue collar '' Sector=2 White collar '' Sector=3 State '' Sector=4 Local '' Sector=5 Own employed '' Sector=0 No sector '' ''**************************************************************************************** ' ' Dim pihat As Double, rndnr As Double ' Dim skod As Single, pown As Single, publicblue As Single, publicwhite As Single ' ' pihat = Sector_Mod1(indnr) 'probability of own employed ' rndnr = Rnd ' ' If rndnr < pihat Then ' pown = 1 ' Else ' pown = 0 ' End If ' ' If pown = 0 Then 'employed ' ' pihat = Sector_Mod2(indnr) 'probability of blue collar ' rndnr = Rnd ' ' If rndnr < pihat Then ' skod = 1 ' Else ' skod = 2 ' End If ' ' If skod = 1 Then ' If employed, blue collar ' ' pihat = Sector_Mod3(indnr) ' Probability public, given blue collar ' rndnr = Rnd ' ' If rndnr < pihat Then ' publicblue = 1 ' Else ' publicblue = 0 ' End If ' ' If publicblue = 1 Then ' If public, blue collar ' ' pihat = Sector_Mod4(indnr) ' Probability state, given blue collar public ' rndnr = Rnd ' ' If rndnr < pihat Then ' skod = 3 ' Else ' skod = 4 ' End If ' ' End If ' ' End If ' end employed blue collar ' ' If skod = 2 Then ' If employed, white collar ' ' pihat = Sector_Mod5(indnr) ' Probability public, given white collar ' rndnr = Rnd ' ' If rndnr < pihat Then ' publicwhite = 1 ' Else ' publicwhite = 0 ' End If ' ' If publicwhite = 1 Then ' If public, white collar ' ' pihat = Sector_Mod6(indnr) ' Probability state, given white collar public ' rndnr = Rnd ' ' If rndnr < pihat Then ' skod = 3 ' Else ' skod = 4 ' End If ' ' End If ' ' End If ' end employed white collar ' ' End If ' big loop over all employed ' ' If pown = 1 Then skod = 5 ' ' Sector = skod ' 'End Function ' ''******************************************************************** ''*** Model 1 - probability of own employed (1=own employed, 0=employed) *** '' logit model ' 'Function Sector_Mod1(ByVal indnr As Long) As Double ' ' Const a0 As Single = -3.92674 'Intercept ' Const a1 As Single = 0.93451 'Sex, 1=male 0=female ' Const a2 As Single = 1.40043 'Basic education 1=yes, else 0 ' Const a3 As Single = 0.91176 'Medium education 1=yes, else 0 ' Const a4 As Single = -0.17083 'Swedish 1=yes else 0 ' ' Dim v1, v2, v3, v4 As Byte ' Dim ex As Double ' ' v1 = Abs(i_sex(indnr) - 2) 'Kolla så att kön definierats rätt. Här man=1, kvinna=0 ' v2 = CInt(i_edlevel(indnr) = 0) * -1 ' v3 = CInt(i_edlevel(indnr) = 1) * -1 ' v4 = Abs(i_born_abroad(indnr) - 1) ' ' ex = Exp(a0 + a1 * v1 + a2 * v2 + a3 * v3 + a4 * v4) ' ' Sector_Mod1 = ex / (1 + ex) ' 'End Function ' ''******************************************************************** ''*** Model 2 - probability of blue collar (1=blue, 0=white) *** '' logit model ' 'Function Sector_Mod2(ByVal indnr As Long) As Double ' ' Const a0 As Single = -1.06208 'Intercept ' Const a1 As Single = -0.16205 'Sex, 1=male 0=female ' Const a2 As Single = 3.42842 'Basic education 1=yes, else 0 ' Const a3 As Single = 2.82787 'Medium education 1=yes, else 0 ' Const a4 As Single = -0.48615 'Swedish 1=yes else 0 ' ' Dim v1, v2, v3, v4 As Byte ' Dim ex As Double ' ' v1 = Abs(i_sex(indnr) - 2) 'Kolla så att kön definierats rätt. Här man=1, kvinna=0 ' v2 = CInt(i_edlevel(indnr) = 0) * -1 ' v3 = CInt(i_edlevel(indnr) = 1) * -1 ' v4 = Abs(i_born_abroad(indnr) - 1) ' ' ex = Exp(a0 + a1 * v1 + a2 * v2 + a3 * v3 + a4 * v4) ' ' Sector_Mod2 = ex / (1 + ex) ' 'End Function ' ''******************************************************************** ''*** Model 3 - probability of public blue collar (1=public, 0=private) *** '' logit model ' 'Function Sector_Mod3(ByVal indnr As Long) As Double ' ' Const a0 As Single = 0.03495 'Intercept ' Const a1 As Single = -1.55532 'Sex, 1=male 0=female ' Const a2 As Single = -0.56411 'Basic education 1=yes, else 0 ' Const a3 As Single = -0.29677 'Medium education 1=yes, else 0 ' Const a4 As Single = 0.28542 'Swedish 1=yes else 0 ' ' Dim v1, v2, v3, v4 As Byte ' Dim ex As Double ' ' v1 = Abs(i_sex(indnr) - 2) 'Kolla så att kön definierats rätt. Här man=1, kvinna=0 ' v2 = CInt(i_edlevel(indnr) = 0) * -1 ' v3 = CInt(i_edlevel(indnr) = 1) * -1 ' v4 = Abs(i_born_abroad(indnr) - 1) ' ' ex = Exp(a0 + a1 * v1 + a2 * v2 + a3 * v3 + a4 * v4) ' ' Sector_Mod3 = ex / (1 + ex) ' 'End Function ' ''******************************************************************** ''*** Model 4 - probability of state given public blue collar (1=state, 0=local) *** '' logit model ' 'Function Sector_Mod4(ByVal indnr As Long) As Double ' ' Const a0 As Single = -1.93797 'Intercept ' Const a1 As Single = 1.39267 'Sex, 1=male 0=female ' Const a2 As Single = -0.01886 'Basic education 1=yes, else 0 ' Const a3 As Single = -0.15427 'Medium education 1=yes, else 0 ' Const a4 As Single = 0.40724 'Swedish 1=yes else 0 ' ' Dim v1, v2, v3, v4 As Byte ' Dim ex As Double ' ' v1 = Abs(i_sex(indnr) - 2) 'Kolla så att kön definierats rätt. Här man=1, kvinna=0 ' v2 = CInt(i_edlevel(indnr) = 0) * -1 ' v3 = CInt(i_edlevel(indnr) = 1) * -1 ' v4 = Abs(i_born_abroad(indnr) - 1) ' ' ex = Exp(a0 + a1 * v1 + a2 * v2 + a3 * v3 + a4 * v4) ' ' Sector_Mod4 = ex / (1 + ex) ' 'End Function ' ''******************************************************************** ''*** Model 5 - probability of public white collar (1=public, 0=private) *** '' logit model ' 'Function Sector_Mod5(ByVal indnr As Long) As Double ' ' Const a0 As Single = 0.30062 'Intercept ' Const a1 As Single = -0.96267 'Sex, 1=male 0=female ' Const a2 As Single = -1.11035 'Basic education 1=yes, else 0 ' Const a3 As Single = -1.1315 'Medium education 1=yes, else 0 ' Const a4 As Single = 0.10668 'Swedish 1=yes else 0 ' ' Dim v1, v2, v3, v4 As Byte ' Dim ex As Double ' ' v1 = Abs(i_sex(indnr) - 2) 'Kolla så att kön definierats rätt. Här man=1, kvinna=0 ' v2 = CInt(i_edlevel(indnr) = 0) * -1 ' v3 = CInt(i_edlevel(indnr) = 1) * -1 ' v4 = Abs(i_born_abroad(indnr) - 1) ' ' ex = Exp(a0 + a1 * v1 + a2 * v2 + a3 * v3 + a4 * v4) ' ' Sector_Mod5 = ex / (1 + ex) ' 'End Function ' ''******************************************************************** ''*** Model 6 - probability of state given public white collar (1=state, 0=local) *** '' logit model ' 'Function Sector_Mod6(ByVal indnr As Long) As Double ' ' Const a0 As Single = -1.00085 'Intercept ' Const a1 As Single = 1.23202 'Sex, 1=male 0=female ' Const a2 As Single = 0.40871 'Basic education 1=yes, else 0 ' Const a3 As Single = 0.81667 'Medium education 1=yes, else 0 ' Const a4 As Single = -0.13386 'Swedish 1=yes else 0 ' ' Dim v1, v2, v3, v4 As Byte ' Dim ex As Double ' ' v1 = Abs(i_sex(indnr) - 2) 'Kolla så att kön definierats rätt. Här man=1, kvinna=0 ' v2 = CInt(i_edlevel(indnr) = 0) * -1 ' v3 = CInt(i_edlevel(indnr) = 1) * -1 ' v4 = Abs(i_born_abroad(indnr) - 1) ' ' ex = Exp(a0 + a1 * v1 + a2 * v2 + a3 * v3 + a4 * v4) ' ' Sector_Mod6 = ex / (1 + ex) ' 'End Function
Public Sub code_variables() '! Recalculate some variables Printdok "code_variables" Dim i As Long ReDim h_sum_inc_taxable(1 To m_hcount) For i = 1 To m_icount ' i_borndecade(i) = Int((base_year + model_time - i_age(i)) / 10) * 10 i_born_year(i) = base_year + model_time - i_age(i) ' Updating civil status If i_bvux(i) = 1 Then If h_n_adults(hhnr2index(i_hhnr(i))) = 2 Then i_civ_stat(i) = 1 ' cohabiting Else i_civ_stat(i) = 0 ' single End If End If '*** Updating work experience '*** NOTE: when i_workexperience is calculated in initprog_SAS delete the '*** model_time = 0 clause!!!!!!!! '*** TP030218 If model_time = 0 Then i_workexperience(i) = pp_hist(i).n_years Else If i_status(i) = 8 Then i_workexperience(i) = i_workexperience(i) + 1 End If ' Updating i_ftp_64 If i_age(i) = 64 And i_status(i) = 4 Then i_ftp_64(i) = 1 ' Updating individual household status If i_bvux(i) = 0 Then If i_age(i) < 18 Then i_hhstatus(i) = 4 ' child (0 - 17) living with parents Else i_hhstatus(i) = 3 ' child (18 -) living with parents End If Else If h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then i_hhstatus(i) = 2 ' cohabiting adult Else i_hhstatus(i) = 1 ' single adult End If End If '*** Update h_sum_inc_taxable h_sum_inc_taxable(hhnr2index(i_hhnr(i))) = h_sum_inc_taxable(hhnr2index(i_hhnr(i))) + _ i_inc_taxable(i) Next End Sub
Public Sub calc_newyear_macro() '! Calculating new macro variables Printdok " -- calc_newyear_macro" status "Calculating macro variables" Dim year As Integer Dim maxyear As Integer Dim price_change As Double Dim i As Integer year = base_year + model_time maxyear = year 'If year > 2050 Then maxyear = 2050 'If year > 2150 Then maxyear = 2150 If year > 2110 Then maxyear = 2110 '*** Delete old demographic macro variables m_born = 0 m_dead = 0 m_immigrated = 0 m_emigrated = 0 m_netmigration = 0 m_inflation = parm_macro(maxyear, 2) m_KPI = (1 + parm_macro(maxyear, 2) / 100) m_KPI1 = (1 + parm_macro(maxyear - 1, 2) / 100) m_KPI2 = (1 + parm_macro(maxyear - 2, 2) / 100) m_KPI3 = (1 + parm_macro(maxyear - 3, 2) / 100) m_KPI4 = (1 + parm_macro(maxyear - 4, 2) / 100) m_realwage = parm_macro(maxyear, 1) '*** Yields on financial assets m_shares_dividends = parm_macro(maxyear, 5) m_shares_rate = parm_macro(maxyear, 6) m_interest_long = parm_macro(maxyear, 9) m_interest_short = parm_macro(maxyear, 10) m_interest_short1 = parm_macro(maxyear - 1, 10) m_shares_return = m_shares_dividends + m_shares_rate ' basbelopp If year <= 2005 Then m_basbelopp1 = parm_macro(year - 1, 3) m_basbelopp2 = parm_macro(year - 2, 3) m_basbelopp3 = parm_macro(year - 3, 3) m_basbelopp4 = parm_macro(year - 4, 3) m_basbelopp5 = parm_macro(year - 5, 3) ' **** m_basbelopp = parm_macro(year, 3) m_basbelopp_f = parm_macro(year, 4) Else m_basbelopp5 = m_basbelopp4 m_basbelopp4 = m_basbelopp3 m_basbelopp3 = m_basbelopp2 m_basbelopp2 = m_basbelopp1 m_basbelopp1 = m_basbelopp m_basbelopp = round(m_KPI1 * m_basbelopp, -2) m_basbelopp_f = round(m_KPI1 * m_basbelopp_f, -2) End If '*** Pension contributions to AP-funds If year < 2001 Then 'm_ap_avg_ap3 = m_ap_avg_ap m_ap_avg_ap2 = m_ap_avg_ap1 m_ap_avg_ap1 = m_ap_avg_ap Else m_ap_avg_ap3 = m_ap_avg_ap2 m_ap_avg_ap2 = m_ap_avg_ap1 m_ap_avg_ap1 = m_ap_avg_ap End If '*** AP-funds Select Case year Case Is <= 2000 m_ap_apfond1 = m_ap_apfond Case Else m_ap_apfond2 = m_ap_apfond1 m_ap_apfond1 = m_ap_apfond End Select '*** Turnover duration Select Case year Case Is = 2000 'm_ap_ot3 = m_ap_ot2 'AW There are no historical values available for 1997 m_ap_ot2 = 31.86735 m_ap_ot1 = 31.68637 Case Else m_ap_ot3 = m_ap_ot2 m_ap_ot2 = m_ap_ot1 m_ap_ot1 = m_ap_ot End Select 'Price 99 If year <= 2003 Then m_price99 = parm_macro(maxyear, 8) Else m_price99 = m_price99 / (1 + m_inflation / 100) End If '*** Price indices for real wealth If year = 1999 Then m_price_rw_home = 1 m_price_rw_home99 = 1 m_price_rw_other = 1 m_price_rw_other99 = 1 Else 'm_price_rw_home = parm_macro(mini(2050, year), 25) / parm_macro(mini(2049, year - 1), 25) m_price_rw_home = parm_macro(maxyear, 25) / parm_macro(maxyear - 1, 25) m_price_rw_home99 = m_price_rw_home99 * m_price_rw_home 'm_price_rw_other = parm_macro(year, 26) / parm_macro(year - 1, 26) 'm_price_rw_other = parm_macro(mini(2050, year), 26) / parm_macro(mini(2049, year - 1), 26) m_price_rw_other = parm_macro(maxyear, 26) / parm_macro(maxyear - 1, 26) m_price_rw_other99 = m_price_rw_other99 * m_price_rw_other End If '*** Indexes (price, real wage and nominal wage), base=1999 If year = 1999 Then m_price_change99 = 1 m_realwage_change99 = 1 m_wage_change99 = 1 m_shares_dividends99 = 1 m_shares_rate99 = 1 m_interest_long99 = 1 m_shares_total99 = 1 Else m_price_change99 = m_price_change99 * (1 + m_inflation / 100) m_realwage_change99 = m_realwage_change99 * (1 + m_realwage / 100) m_wage_change99 = m_wage_change99 * (1 + (m_realwage + m_inflation) / 100) ' NOTE: m_shares_dividends given in nominal value in default parameters m_shares_dividends99 = m_shares_dividends99 * (1 + m_shares_dividends / 100) ' NOTE: m_shares_rate given in nominal value in default parameters m_shares_rate99 = m_shares_rate99 * (1 + m_shares_rate / 100) ' NOTE: m_interest_long given in nominal value in default parameters m_interest_long99 = m_interest_long99 * (1 + m_interest_long / 100) m_shares_total99 = m_shares_total99 * (1 + (m_shares_rate + m_shares_dividends) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2000 If year < 2000 Then m_price_change00 = 0 m_realwage_change00 = 0 m_wage_change00 = 0 ElseIf year = 2000 Then m_price_change00 = 1 m_realwage_change00 = 1 m_wage_change00 = 1 Else m_price_change00 = m_price_change00 * (1 + m_inflation / 100) m_realwage_change00 = m_realwage_change00 * (1 + m_realwage / 100) m_wage_change00 = m_wage_change00 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2001 If year < 2001 Then m_price_change01 = 0 m_realwage_change01 = 0 m_wage_change01 = 0 ElseIf year = 2001 Then m_price_change01 = 1 m_realwage_change01 = 1 m_wage_change01 = 1 Else m_price_change01 = m_price_change01 * (1 + m_inflation / 100) m_realwage_change01 = m_realwage_change01 * (1 + m_realwage / 100) m_wage_change01 = m_wage_change01 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2002 If year < 2002 Then m_price_change02 = 0 m_realwage_change02 = 0 m_wage_change02 = 0 ElseIf year = 2002 Then m_price_change02 = 1 m_realwage_change02 = 1 m_wage_change02 = 1 Else m_price_change02 = m_price_change02 * (1 + m_inflation / 100) m_realwage_change02 = m_realwage_change02 * (1 + m_realwage / 100) m_wage_change02 = m_wage_change02 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2003 If year < 2003 Then m_price_change03 = 0 m_realwage_change03 = 0 m_wage_change03 = 0 ElseIf year = 2003 Then m_price_change03 = 1 m_realwage_change03 = 1 m_wage_change03 = 1 Else m_price_change03 = m_price_change03 * (1 + m_inflation / 100) m_realwage_change03 = m_realwage_change03 * (1 + m_realwage / 100) m_wage_change03 = m_wage_change03 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2004 If year < 2004 Then m_price_change04 = 0 m_realwage_change04 = 0 m_wage_change04 = 0 ElseIf year = 2004 Then m_price_change04 = 1 m_realwage_change04 = 1 m_wage_change04 = 1 Else m_price_change04 = m_price_change04 * (1 + m_inflation / 100) m_realwage_change04 = m_realwage_change04 * (1 + m_realwage / 100) m_wage_change04 = m_wage_change05 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2005 If year < 2005 Then m_price_change05 = 0 m_realwage_change05 = 0 m_wage_change05 = 0 ElseIf year = 2005 Then m_price_change05 = 1 m_realwage_change05 = 1 m_wage_change05 = 1 Else m_price_change05 = m_price_change05 * (1 + m_inflation / 100) m_realwage_change05 = m_realwage_change05 * (1 + m_realwage / 100) m_wage_change05 = m_wage_change05 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2006 If year < 2006 Then m_price_change06 = 0 m_realwage_change06 = 0 m_wage_change06 = 0 ElseIf year = 2006 Then m_price_change06 = 1 m_realwage_change06 = 1 m_wage_change06 = 1 Else m_price_change06 = m_price_change06 * (1 + m_inflation / 100) m_realwage_change06 = m_realwage_change06 * (1 + m_realwage / 100) m_wage_change06 = m_wage_change06 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2007 If year < 2007 Then m_price_change07 = 0 m_realwage_change07 = 0 m_wage_change07 = 0 ElseIf year = 2007 Then m_price_change07 = 1 m_realwage_change07 = 1 m_wage_change07 = 1 Else m_price_change07 = m_price_change07 * (1 + m_inflation / 100) m_realwage_change07 = m_realwage_change07 * (1 + m_realwage / 100) m_wage_change07 = m_wage_change07 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2008 If year < 2008 Then m_price_change08 = 0 m_realwage_change08 = 0 m_wage_change08 = 0 ElseIf year = 2008 Then m_price_change08 = 1 m_realwage_change08 = 1 m_wage_change08 = 1 Else m_price_change08 = m_price_change08 * (1 + m_inflation / 100) m_realwage_change08 = m_realwage_change08 * (1 + m_realwage / 100) m_wage_change08 = m_wage_change08 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2009 If year < 2009 Then m_price_change09 = 0 m_realwage_change09 = 0 m_wage_change09 = 0 ElseIf year = 2009 Then m_price_change09 = 1 m_realwage_change09 = 1 m_wage_change09 = 1 Else m_price_change09 = m_price_change09 * (1 + m_inflation / 100) m_realwage_change09 = m_realwage_change09 * (1 + m_realwage / 100) m_wage_change09 = m_wage_change09 * (1 + (m_realwage + m_inflation) / 100) End If '*** Indexes (price, real wage and nominal wage), base=2010 If year < 2010 Then m_price_change10 = 0 m_realwage_change10 = 0 m_wage_change10 = 0 ElseIf year = 2010 Then m_price_change10 = 1 m_realwage_change10 = 1 m_wage_change10 = 1 Else m_price_change10 = m_price_change10 * (1 + m_inflation / 100) m_realwage_change10 = m_realwage_change10 * (1 + m_realwage / 100) m_wage_change10 = m_wage_change10 * (1 + (m_realwage + m_inflation) / 100) End If ' -- Pension income index ' Source: Prop 1997/98:151 sid 36, tablå 16.2) If year <= 2004 Then m_ap_inkind2 = parm_macro(year - 2, 11) m_ap_inkind1 = parm_macro(year - 1, 11) m_ap_inkind = parm_macro(year, 11) Else If get_scalefactor_active("Income_index_endo") = 1 Then '-- Endogenous pension income index ' Note: Not stable estimates (in small samples) m_ap_inkind2 = m_ap_inkind1 m_ap_inkind1 = m_ap_inkind m_ap_inkind = (m_inc_taxable_snitt1 / m_inc_taxable_snitt4) ^ (1 / 3) _ * m_KPI1 * m_ap_inkind1 Else ' -- Default: Exogenous solution based on makro numbers in default_parameters_2.xls m_pension_income_index = (1 + parm_macro(maxyear - 1, 1) / 100) _ * (1 + parm_macro(maxyear - 2, 1) / 100) _ * (1 + parm_macro(maxyear - 3, 1) / 100) m_pension_income_index = m_pension_income_index ^ (1 / 3) m_pension_income_index = m_pension_income_index * (1 + parm_macro(maxyear - 1, 2) / 100) '-- Scaling to an index series, 1999=100 m_ap_inkind2 = m_ap_inkind1 m_ap_inkind1 = m_ap_inkind m_ap_inkind = m_pension_income_index * m_ap_inkind1 End If End If Select Case year '-- Calculation of basic income amount ' Case Is >= 2009 ' m_basbelopp_income = m_basbelopp_income * (m_ap_inkind / m_ap_inkind1) Case Is > 2001 m_basbelopp_income = round(m_basbelopp_income * (m_ap_inkind / m_ap_inkind1), -2) Case Is <= 2001 m_basbelopp_income = m_basbelopp_f End Select '-- Help variable for calculation of guarantee pension base ' Optional choce of income indexation in Control Center - Parameters ' If income indexation wanted set ap_gp_Inkindex_On On=1 for actual years '-- Choice of indexation of guaranteed pension: Default price indexation m_ap_gp_Inkindex_On = 0 '-- Zero means price- 1 means income indexation m_ap_gp_Inkindex_On = get_scalefactor_active("ap_gp_Inkindex_On") If m_ap_gp_Inkindex_On = 0 Then m_basbelopp_gp = m_basbelopp Else '*** Följsamhetsindexering av GARP som en preliminär lösning. Bör tänkas över '*** ett varv till. TP020608 m_basbelopp_gp = m_basbelopp_gp * (m_ap_inkind / m_ap_inkind1) * (1 / m_ap_norm) End If '-- Help variable for calculation of disability pension base ' Optional choce of income indexation in Control Center - Parameters ' If income indexation wanted set ftp_Inkindex_On On=1 for actual years '-- Choice of indexation of disablity pension: Default price indexation m_ftp_Inkindex_On = 0 '-- Zero means price- 1 means income indexation m_ftp_Inkindex_On = get_scalefactor_active("ftp_Inkindex_On") If m_ftp_Inkindex_On = 0 Then m_basbelopp_ftp = m_basbelopp_f Else m_basbelopp_ftp = m_basbelopp_ftp * (m_ap_inkind / m_ap_inkind1) End If '-- Calculation of balance index, used when automatic balancing engaged Dim Automatic_balancing_limit As Double year = base_year + model_time 'AW test m_ap_balind_active = 0 '-- Binary marker if automatic balancing activated If get_scalefactor_active("Automatic_balancing") = 1 Then '********* EVENTUELLT KAN MAN GÖRA GÄNSEN FÖR AKTIVERING AV BALANSERINGEN EXOGEN **** Automatic_balancing_limit = get_scalefactor("Automatic_balancing") Select Case year Case Is > 2005 '-- NOTE: No balancing possible for "outcome" years m_ap_balind2 = m_ap_balind1 m_ap_balind1 = m_ap_balind If m_ap_balanstal >= 1 And m_ap_inkind1 = m_ap_balind1 Then m_ap_balind = m_ap_inkind Else m_ap_balind = mini(m_ap_inkind, m_ap_balind1 * (m_ap_inkind / m_ap_inkind1) * m_ap_balanstal) m_ap_balind_active = 1 End If Case Else m_ap_balind2 = m_ap_inkind2 m_ap_balind = m_ap_inkind m_ap_balind1 = m_ap_inkind1 End Select Else m_ap_balind2 = m_ap_inkind2 m_ap_balind1 = m_ap_inkind1 m_ap_balind = m_ap_inkind End If '-- Reading som parameters: ' Note: Variables below in external Sesimrun.mdb file '-- Reading miscellaneous contibuting rates: Source Fasit databbase (PARMHINK.XLS) Dim test As Double ' Arbetsgivaravgifter för anställd personal (summa) test = f_GetMakro("m_arbavg", year, "Contri"): If test <> 0 Then m_arbavg_p = test ' Särskild löneskatt(XWSLONE) test = f_GetMakro("m_arbavg_slon", year, "Contri"): If test <> 0 Then m_arbavg_slon_p = test ' Särskild löneskatt födda 1938 eller senare (XWSLONP) test = f_GetMakro("m_arbavg_slon38", year, "Contri"): If test <> 0 Then m_arbavg_slon38_p = test ' Ålderspensionsavg (XWAPAVG) test = f_GetMakro("m_arbavg_pens", year, "Contri"): If test <> 0 Then m_arbavg_pens_p = test ' Arbetsgivaravg anställda, exkl pensionsavgift test = f_GetMakro("m_arbavg_ovr", year, "Contri"): If test <> 0 Then m_arbavg_ovr_p = test ' Allmän egenavgift pension (XPROCPEN) test = f_GetMakro("m_egenavg_pens", year, "Contri"): If test <> 0 Then m_egenavg_pens_p = test ' Tak uttag allm pensavg (XMAXPEN) i basbelopp test = f_GetMakro("m_egenavg_tak", year, "Contri"): If test <> 0 Then m_egenavg_tak_basb = test ' Proc skattred allm pens avg (XSREDPEN) test = f_GetMakro("m_egenavg_red", year, "Contri"): If test <> 0 Then m_egenavg_red_p = test ' Arbetsgivaravgift för sjukdom (XWJUAVG) test = f_GetMakro("m_arbavg_sjuk", year, "Contri"): If test <> 0 Then m_arbavg_sjuk_p = test ' Arbetsgivaravgift för efterlevandeskydd (XWEPAVF) test = f_GetMakro("m_arbavg_eft", year, "Contri"): If test <> 0 Then m_arbavg_eft_p = test ' Arbetsgivaravgift för föräldrapenning (XWFFAVF) test = f_GetMakro("m_arbavg_forp", year, "Contri"): If test <> 0 Then m_arbavg_forp_p = test ' Arbetsgivaravgift för arbetskada (XWARBSEF) test = f_GetMakro("m_arbavg_arsk", year, "Contri"): If test <> 0 Then m_arbavg_arsk_p = test ' Arbetsgivaravgift för a-kassa (XWAMAVF) test = f_GetMakro("m_arbavg_akas", year, "Contri"): If test <> 0 Then m_arbavg_akas_p = test ' Arbetsgivaravgift för anställda, allmän löneavgift (XWLONAVG) test = f_GetMakro("m_arbavg_alon", year, "Contri"): If test <> 0 Then m_arbavg_alon_p = test ' Arbetsgivaravg anställda, exkl pensionsavgift '-- Reading parameters for pension calculations ' Parameter för beräkning av PTS för förtidpens och sjukbidrag m_ap_pts_kvot = f_GetMakro("ap_pts_kvot", 0, "Pension") ' Parameter vid beräkning av folkpension, gifta m_ap_fp_kvot_gifta = f_GetMakro("ap_fp_kvot_gifta", 0, "Pension") ' Parameter vid beräkning av folkpension, ogifta m_ap_fp_kvot_ogifta = f_GetMakro("ap_fp_kvot_ogifta", 0, "Pension") ' Parameter: Avsättning till inkomstpension m_ap_ip_avs = f_GetMakro("m_ap_ip_avs", 0, "Pension") ' Parameter: Avsättnin till premiepension m_ap_pp_avs = f_GetMakro("m_ap_pp_avs", 0, "Pension") ' Parameter: Förvaltningsavgift premiepension test = f_GetMakro("m_favg_pp", year, "Pension"): If test <> 0 Then m_favg_pp = test '-- Calculation of some contribution rates m_ap_aap_avs = m_arbavg_pens_p m_ap_avs = m_ap_ip_avs + m_ap_pp_avs '*** Reading norm growth of income pension system from the sesim run time-database. '*** Default value equals 1.016 m_ap_norm = 1.016 If get_scalefactor_active("m_ap_norm") = 1 Then m_ap_norm = get_scalefactor("m_ap_norm") End If '-- Method for calculation of accumulated pensions rights m_RFV_PB_On = get_scalefactor_active("RFV_PB_On") End Sub