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