Attribute VB_Name = "a06_Pension_Rules"
'*************************************************************************************
'*** This module contains subroutines that handles old age pensions, both public,
'*** occupational and private.
'*** There are two versions of all subroutines - standard version and BabyBoom version.
'*** A conditional compilation is performed that uses the BabyBoom version if the
'*** conditional compilation constant BBPens (see Projekt->Properties->Make) equals 1
'*** and otherwise the standard version. TP050222
'*************************************************************************************
#If BBPens = 1 Then
'******* a06_Pension_Rules - Calculates pension benefits, pension rights etc *******
' ----------------------------------------------------------
' -- Approximative mneumonics (in swenglish)
' i_{tt}_{ss}_{ee}
' tt = type of pension
' ss = program
' qq = qualifying part
' i_ap = ålderspension = old age pensions
' i_ftp = förtidspension = disabilty pensions
' i_op = avtalspension = occupational pensions
' i_surv = efterlevandepension = survivors pensions
' i_pi = private insurance
' i_pr_ = pensionsunderlag = pension rights
' i_pb_ = pensionsbehållning = cumulative pension rights
' i_{tt}_fp = folkpension = basic pension
' i_{tt}_atp = ATP = national supplemental pension
' i_{tt}_fp = folkpension = national basic pension
' i_{tt}_ip = inkomstpension
' i_{tt}_gp = garantipension
' i_{tt}_tp = reformerad ATP = reformed supplemental pe
' i_{tt}_pp = national premium pension
' i_{tt}_ap = other old age pension
' i_{tt}_pts = PTS = basic pension supplement
' barn
' ank
' f_ = prefix indicating function
' ----------------------------------------------------------
Option Explicit
Option Base 1
'Private f_utfasning_ATP As Double
Public z_ap_atp As Double
Private year As Integer
Dim pnames(100) As String
Dim pvalues(100) As Variant
Public Sub Calculate_Disability_Pension(i As Long)
'! Calculation of disability pension benefits
'*** EGENTLIGEN SKA FÖRÄLDRAR TILL FÖRTIDSPENSIONÄRER YNGRE ÄN 19 HA VÅRDBIDRAG
Dim ftp_antag_p As Double ' Pensionsrätt för förtidspensionärer, antagandepoäng
Dim ftp_antag_p1 As Double ' do hjälpvariabel
Dim ftp_antag_p2 As Double ' do hjälpvariabel
Dim pp4(4) As Double ' do hjälpvariabel Vektor med senaste 4 årens pensionspoäng
Dim n As Long, y As Long ' do hjälpvariabel
Dim antag_bo_tid As Long ' Antagen bosättningstid (qualifying years for disabled)
Dim bokvot As Double ' Bosättningstidskvot
Dim ftp_pts_kvot As Double ' Parameter för beräkning av PTS för förtidpens och sjukbidrag
Dim ftp_fp_kvot_gifta As Double ' Parameter vid beräkning av folkpension, gifta
Dim ftp_fp_kvot_ogifta As Double ' Parameter vid beräkning av folkpension, ogifta
ftp_pts_kvot = 1.129 ' *** Kan ligga i parameterfil
ftp_fp_kvot_gifta = 0.725 ' *** Kan ligga i parameterfil
ftp_fp_kvot_ogifta = 0.9 ' *** Kan ligga i parameterfil
year = model_time + base_year
' -- Calculate & updates qualifying points antagandepoäng / antagandeinkomst
If i_status1(i) <> 4 Or (i_status1(i) = 4 And i_age(i) = 19) Then ' New Disability pensioner
If year < 2003 Then '-- Old system
' Villkor: Antingen ATP-poäng för minst 2 av de 4 åren närmast föregående pensionsfallet
' eller SGI > basb samt minst 1 historisk ATP-poäng
If pp_hist(i).n_years >= 4 Then
n = 0
For y = pp_hist(i).n_years - 3 To pp_hist(i).n_years
If pp_hist(i).pp_years(y) >= year - 4 Then
pp4(n + 1) = pp_hist(i).pp(y)
n = n + 1
End If
Next
End If
' -- Förvärvsvillkor
If (i_inc_taxable(i) >= m_basbelopp And pp_hist(i).n_years > 0) Or n >= 2 Then
' Alt 1: Average of ATP-points: The 2 best years of the last 4
If pp_hist(i).n_years >= 4 Then
Select Case n
Case Is > 1 ' -- Snitt av två bästa
Call Sort(pp4, True)
ftp_antag_p1 = (pp4(1) + pp4(2)) / 2
Case 1 ' -- Om endast 1 år 50% av detta
ftp_antag_p1 = pp4(1) / 2
Case 0 ' -- Det kan hända att inget av åren var nära i tiden
ftp_antag_p1 = 0
End Select
End If
' Alt 2: Medeltalet av bästa hälften av alla
Dim pp_sort() As Integer ' -- Kopierar vektorn för sortering
pp_sort = pp_hist(i).pp
Call Sort(pp_sort, True)
ftp_antag_p2 = 0
If pp_hist(i).n_years > 1 Then
For y = 1 To Int((pp_hist(i).n_years / 2) + 0.5)
ftp_antag_p2 = ftp_antag_p2 + pp_sort(y) '****pp_hist(i).pp(y)
Next
ftp_antag_p2 = ftp_antag_p2 / Int((pp_hist(i).n_years / 2) + 0.5)
Else
ftp_antag_p2 = pp_sort(1)
End If
' -- Choosing best alternative for the disabled
ftp_antag_p = maxi(ftp_antag_p1, ftp_antag_p2)
'-- Updating pension history pensionspoängsvektorn
Call Update_pp_hist(i, CInt(ftp_antag_p))
'-- Calculating qualifying income in SEK
i_ftp_antag(i) = ((ftp_antag_p / 100) + 1) * m_basbelopp_f
End If
Else '-- New system from 2003
'Qualifying points in new system
If i_pgi(i) > 0 Or pp_hist(i).n_years > 0 Then '-- Right to income based disab pens if 1 or more PGI-years
i_ftp_antag(i) = f_qualif_inc(i)
'-- Updating pension history pensionspoängsvektorn
' LÄGGER TILL VILLKOR SÅ ATT PP-VEKTORN ENDAST UPPDATERAS MED VÄRDEN STÖRRE ÄN 1 BASBELOPP
If (i_ftp_antag(i) - m_basbelopp_f) > 0 Then
Call Update_pp_hist(i, CInt(((i_ftp_antag(i) - m_basbelopp_f) / m_basbelopp_f) * 100))
End If
End If 'pgi
End If ' year < 2003
Else '-- This individual was disabled last year
' -- Only disability pensioners with qualifying points
If pp_hist(i).n_years > 0 Then
' -- Disab pensioner last year, gets same pensionrights as last year
If m_ftp_Inkindex_On = 0 Then '-- Optional income indexation of paid out disability pensions
ftp_antag_p = pp_hist(i).pp(pp_hist(i).n_years)
i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f)
Else
ftp_antag_p = (((((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1)) * _
((m_ap_inkind / m_ap_inkind1) - (m_KPI - 1))) - 1) * 100
i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f)
End If
Call Update_pp_hist(i, CInt(ftp_antag_p))
End If
End If '-- i_status1(i) <> 4
' -- Calculate benefits with price-correction
If year < 2004 Then
' -- ATP
If pp_hist(i).n_years > 0 Then
i_ftp_atp(i) = 0.6 * (pp_hist(i).pp(pp_hist(i).n_years) / 100) _
* m_basbelopp * mini(1, (pp_hist(i).n_years + (65 - i_age(i)) / 30))
End If
' -- Folkpension & PTS
antag_bo_tid = i_botid(i) + (65 - i_age(i)) * _
mini(1, i_botid(i) / 0.8 * (maxi(i_age(i), 17) - 16))
bokvot = maxi(mini(1, antag_bo_tid / 40), mini(1, pp_hist(i).n_years / 30))
If antag_bo_tid >= 3 Then ' -- Minst 3 bosättningsår krävs f folkpen & PTS
' -- Folkpension
If i_civ_stat(i) = 0 Then
i_ftp_fp(i) = ftp_fp_kvot_ogifta * m_basbelopp * bokvot
Else
i_ftp_fp(i) = ftp_fp_kvot_gifta * m_basbelopp * bokvot
End If
' -- PTS
i_ftp_pts(i) = bokvot * maxi((ftp_pts_kvot * m_basbelopp) - i_ftp_atp(i), 0)
Else
i_ftp_fp(i) = 0
i_ftp_pts(i) = 0
End If
i_ftp(i) = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
End If
'-- New disabbility pension system after 2002
If year >= 2003 Then
If i_age(i) >= 19 Then
If i_age(i) = 19 Or (i_status1(i) <> 4 And i_age(i) < 30) Then
i_ftp_typ(i) = 1
ElseIf i_ftp_typ(i) = 1 And i_age(i) >= 30 Then
End If
If i_ftp_typ(i) = 1 And i_age(i) >= 30 Then
i_ftp_typ(i) = 0
End If
'-- Income related part
i_ftp_ink(i) = 0.64 * i_ftp_antag(i) '-- i_ftp_antag optionally income indexed, see above
i_ftp_just(i) = (i_ftp_just(i) / m_basbelopp1) * m_basbelopp '** No income indexation: Transitional
'-- Guaranteed level (Rules on limit on insurance time not implemented
' m_ftp_Inkindex_On = 0 0> m_basbelopp_ftp = m_basbelopp, else income indexed
i_ftp_gar(i) = maxi(0, (f_disab_guarantee(i_age(i)) * m_basbelopp_ftp * _
mini(1, (i_botid(i) + (65 - i_age(i))) / 40)) - i_ftp_ink(i))
i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up
Else
i_ftp(i) = 0
i_ftp_ink(i) = 0
i_ftp_gar(i) = 0
i_ftp_just(i) = 0
End If
End If
'-- Transition rules: Recalculation of old disab pension rights
Dim omv_bruttoers As Long
Dim fakt_bruttoers As Long
Dim SGA_bel As Long
Dim ber_gar As Long
If year = 2003 And i_status1(i) = 4 Then '-- Only for old disablity pensioners
If i_age(i) >= 19 Then
fakt_bruttoers = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
SGA_bel = maxi(0, (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _
(f_SGA_2002(fakt_bruttoers, i_civ_stat(i), m_basbelopp) - _
f_basic_deduction_2002(fakt_bruttoers, m_basbelopp)))
omv_bruttoers = fakt_bruttoers + SGA_bel
ber_gar = (omv_bruttoers - (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _
(f_basic_deduction_2002(omv_bruttoers, m_basbelopp) - _
f_basic_deduction_2002(fakt_bruttoers, m_basbelopp))) _
- i_ftp_ink(i)
'i_ftp_just(i) = ber_gar - i_ftp_gar(i)
i_ftp_just(i) = maxi(0, ber_gar - i_ftp_gar(i)) '-- Not negative
i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up
Else
i_ftp(i) = 0
i_ftp_ink(i) = 0
i_ftp_gar(i) = 0
i_ftp_just(i) = 0
End If
End If
'-- New system replaces old benefits 2003
If year = 2003 Then
i_ftp_atp(i) = 0
i_ftp_fp(i) = 0
i_ftp_pts(i) = 0
End If
End Sub
'****** EJ KLAR!! ARBETAR MED DENNA PROCEDUR *****
Public Sub Calculate_Work_Injuries()
Dim i As Long
For i = 1 To m_icount
If i_trf_skada(i) > 0 Then
If i_age(i) >= 65 Then
i_trf_skada(i) = 0
Else 'Indexation
i_trf_skada(i) = i_trf_skada(i)
End If
End If
Next i
End Sub
Public Function f_local_taxrate(idx As Long, year)
'!-- Local tax rate for different years
Select Case year
Case Is >= 2006
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt06 / 100
Case 1999
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt99 / 100
Case 2000
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt00 / 100 'satserna efter 99 betydligt lägre ??
Case 2001 ' ThP beror kanske på kyrkoavgiften??
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt01 / 100
Case 2002
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt02 / 100
Case 2003
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt03 / 100
Case 2004
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt04 / 100
Case 2005
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt05 / 100
End Select
End Function
Public Function f_ramtid(age As Byte) As Byte
'!-- Qualifying time in new disability pension system
Select Case age
Case Is < 47
f_ramtid = 8
Case Is < 50
f_ramtid = 7
Case Is < 53
f_ramtid = 6
Case Is >= 53
f_ramtid = 5
End Select
End Function
'-- Antagandeinkomst from 2003 enligt lag 1963:381 "Om antagandeinkomst"
' Funktionen bortser från specialregler i 8§ om aktivitetsersättningen
Public Function f_qualif_inc(idx As Long) As Long
'!-- Disablity pensions qualifying income from 2003
Dim i As Integer
Dim n As Integer
Dim inc_average As Long
Dim inc(1 To 8) As Double
Dim ramtid As Byte
inc(1) = i_inc_taxable1(idx) * 1.07 / m_basbelopp1
inc(2) = i_inc_taxable2(idx) * 1.07 / m_basbelopp2
inc(3) = i_inc_taxable3(idx) * 1.07 / m_basbelopp3
inc(4) = i_inc_taxable4(idx) * 1.07 / m_basbelopp4
inc(5) = i_inc_taxable5(idx) * 1.07 / m_basbelopp5
'-- Note: pp_hist truncated for incomes from 0 to 1 basic amount
Select Case pp_hist(idx).n_years
Case Is > 7
inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07
inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07
inc(8) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 7) / 100) + 1) * 1.07
Case 7
inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07
inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07
inc(8) = 0
Case 6
inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07
inc(7) = 0
inc(8) = 0
Case Else
inc(6) = 0
inc(7) = 0
inc(8) = 0
End Select
'-- Truncation at 7.5 basic amounts
For n = 1 To 5
inc(n) = mini(7.5, inc(n))
Next
'sortera inc 1 to f_ramtid(i_age(idx) till inc_sort
ramtid = f_ramtid(i_age(idx))
ReDim inc_sort(1 To ramtid) As Double ' -- Kopierar vektorn för sortering
For n = 1 To ramtid
inc_sort(n) = inc(n)
Next
Call Sort(inc_sort, True)
f_qualif_inc = ((inc_sort(1) + inc_sort(2) + inc_sort(3)) / 3) * m_basbelopp
' **** NOT IMPLEMENTED ****
'-- Lite andra villkor för aktivitetsers
' If i_age(idx) < 30 Then
' Select Case n
' Case 1
' Case 2
' Case 3
' End Select
' End If
End Function
Public Function f_disab_guarantee(age As Byte) As Double
'!-- Calculates guaranteed level in basic amounts in new disability pensions system
Select Case age
Case Is >= 30
f_disab_guarantee = 2.4
Case Is < 21
f_disab_guarantee = 2.1
Case Is < 23
f_disab_guarantee = 2.15
Case Is < 25
f_disab_guarantee = 2.2
Case Is < 27
f_disab_guarantee = 2.25
Case Is < 29
f_disab_guarantee = 2.3
Case 29
f_disab_guarantee = 2.35
End Select
End Function
Public Function f_SGA_2002(ink As Long, civ_stat As Byte, basbelopp As Long) As Double
'!-- Särskilt grundavdrag 2002 (Bygger på a05 f_basic_deduction)
'! Used for calculation of transition to new disability pension system
Dim sga As Double
Dim sgae As Double
Dim sgag As Double
Dim sgaproc As Double
Dim sgamax As Double
Dim sgared As Double
sgae = 1.5749 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS
sgag = 1.3969 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS
sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDRAG
'REDUCERING
If civ_stat = 0 Then
sgamax = sgae 'Ogift
Else
sgamax = sgag 'Gift
End If
sgared = sgaproc * maxi(ink - sgamax, 0)
sgared = maxi(sgamax - sgared, 0)
f_SGA_2002 = round(sgared, -2)
If f_SGA_2002 > ink Then f_SGA_2002 = ink
End Function
Public Function f_basic_deduction_2002(ink, basbelopp As Long) As Double
'!-- Basic deduction 2002 (Bygger på a05 f_basic_deduction)
Dim g As Double
Dim i As Integer
Dim limits(1 To 9) As Double
Dim lutning(1 To 8) As Double
Dim xgr As Double
limits(1) = 0
limits(2) = 0.293 * basbelopp
limits(3) = 1.86 * basbelopp
limits(4) = 2.89 * basbelopp
limits(5) = 3.04 * basbelopp
limits(6) = 9E+99 * basbelopp
limits(7) = 0
limits(8) = 0
limits(9) = 0
lutning(1) = 1
lutning(2) = 0
lutning(3) = 0.25
lutning(4) = 0
lutning(5) = -0.1
lutning(6) = 0
lutning(7) = 0
lutning(8) = 0
xgr = Int((0.293 * basbelopp + 99) / 100) * 100 ' LÄGSTA GRUNDAVDRAG
g = 0
i = LBound(limits) + 1
Do Until ink <= limits(i)
If ink > limits(i) Then g = g + (limits(i) - limits(i - 1)) * lutning(i - 1)
i = i + 1
Loop
g = g + (ink - limits(i - 1)) * lutning(i - 1)
If g < limits(LBound(limits) + 1) Then g = limits(LBound(limits) + 1)
If ink > xgr Then g = maxi(xgr, g)
If base_year + model_time < 2001 Then
g = Int(g / 100) * 100
Else
g = Int((g + 99.9) / 100) * 100
End If
'JÄMFÖRELSE MED G
' If g > sga Then sga = g
' g = 0
' If sga > ink Then sga = ink
'
' End If
'
' f_basic_deduction = g + sga
f_basic_deduction_2002 = g
End Function
'-- Calculation of survivors pension Efterlevandepensioner
' Call from x03_Service - delete_individuals whenever a cohabiting person dies
' Only calculation of widow and children pensions currently
' Se also procedure Update_Survivors_pension in this module
'**** Only calc of aggregate i_surv, not divided in i_surv_atp and i_surv_fp now
'**** Som det är nu är endast en schablonregel med ett basb per änke och barnpens med
' 1 stämmer ungefär för 2005.
'**** Egentligen ska man ha 90% av basb+PTS 62,9% (bökiga reglöer f inkomstprövning)
' 40% av mannens ATP, 35% om det finns barn, 15% f 1:a barnet, 10% f ytterligare barn
' (fördelas lika mellan barnen)
Public Sub Calculate_Survivors_pension(i As Long)
'!-- Calculation of survivors pension Efterlevandepensioner
Dim surv_nr As Long 'Indexnr for survivor
'Dim child_nr As Long 'Indexnr for surviving child
Dim civ_stat_dat As Integer
Dim widow_base_atp As Double, child_base_atp As Double, widow_base_fp As Double
Dim child_base_fp As Double, surv_base_omst As Double
Dim basbelopp As Long
surv_nr = i_indnr(i)
civ_stat_dat = h_form_year(hhnr2index(i_hhnr(i))) 'Household formation year
'-- Koefficienter hämtade f RFV:s budgetunderlag år 2001
' PTS modelleras ej - FP-koeff avser såväl FP som PTS
widow_base_atp = 0.877 '>=18 år **** Provisoriskt: Senare ordentlig beräkning
child_base_atp = 0.635 '<18 år **** Provisoriskt: -"-
widow_base_fp = 0.678 '>=18 år & <65 år inkl PTS **** Provisoriskt: Senare ordentlig beräkning
child_base_fp = 0.282 '<18 år **** Provisoriskt: -"-
surv_base_omst = 1.22 ' Samma f omst o förlängd omst pens
' Note: Indexation in Update_Survivors_pension, even the first year
If year < 2001 Then ' therefore back-indexation here
basbelopp = m_basbelopp_f / m_KPI1
Else
basbelopp = m_basbelopp_income * (m_ap_inkind1 / m_ap_inkind)
End If
'-- Widow's pension Övergångsvis änkepension TP
'If i_sex(i) = 1 And h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if the husband dies
If h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if more than one person in household
'Searching for survivors indexnr
surv_nr = h_first_indnr(hhnr2index(i_hhnr(i)))
Do Until (i_bvux(indnr2index(surv_nr)) = 1 And i_sex(indnr2index(surv_nr)) <> i_sex(i)) Or surv_nr = 0
surv_nr = i_next_indnr(indnr2index(surv_nr))
Loop
'-- Widows pension
If i_sex(i) = 1 And surv_nr <> 0 And civ_stat_dat < 1990 And civ_stat_dat > 0 Then 'Only to widows married before 1990
i_surv_atp(indnr2index(surv_nr)) = widow_base_atp * basbelopp
If i_age(indnr2index(surv_nr)) < 65 Then
i_surv_fp(indnr2index(surv_nr)) = widow_base_fp * basbelopp
Else
i_surv_fp(indnr2index(surv_nr)) = 0
End If
i_surv_year(indnr2index(surv_nr)) = model_time + base_year
i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _
i_surv_atp(indnr2index(surv_nr))
'-- Transitional survivors pension
ElseIf i_age(indnr2index(surv_nr)) < 65 And i_age(indnr2index(surv_nr)) > 17 Then
i_surv_omst(indnr2index(surv_nr)) = surv_base_omst * basbelopp
i_surv_year(indnr2index(surv_nr)) = model_time + base_year
i_surv(indnr2index(surv_nr)) = i_surv_omst(indnr2index(surv_nr))
Else
i_surv_atp(indnr2index(surv_nr)) = 0
i_surv_fp(indnr2index(surv_nr)) = 0
i_surv(indnr2index(surv_nr)) = 0
End If
Else
i_surv_atp(indnr2index(surv_nr)) = 0
i_surv_fp(indnr2index(surv_nr)) = 0
i_surv(indnr2index(surv_nr)) = 0
End If
'-- Childrens pension
' Only if parents with children in household dies
If i_bvux(i) = 1 And h_n_child(hhnr2index(i_hhnr(i))) > 0 Then
'Searching for childrens indexnr
surv_nr = h_first_indnr(hhnr2index(i_hhnr(i)))
Do Until surv_nr = 0
If i_age(indnr2index(surv_nr)) < 18 Then
i_surv_year(indnr2index(surv_nr)) = model_time + base_year
i_surv_atp(indnr2index(surv_nr)) = child_base_atp * basbelopp
i_surv_fp(indnr2index(surv_nr)) = child_base_fp * basbelopp
i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _
i_surv_atp(indnr2index(surv_nr))
End If
surv_nr = i_next_indnr(indnr2index(surv_nr))
Loop
' Else
' i_surv_atp(indnr2index(surv_nr)) = 0
' i_surv_fp(indnr2index(surv_nr)) = 0
' i_surv(indnr2index(surv_nr)) = 0
End If
End Sub
Public Sub Update_Survivors_pension(i As Long)
'!-- Yearly updating of previously calculated survivors pensiona Efterlevandepensioner
If i_surv(i) > 0 Then
If i_age(i) = 18 Then '-- Barnpension upphör då man blir 18
i_surv_fp(i) = 0
i_surv_atp(i) = 0
' i_surv(i) = 0
End If
' Änkor antas avstå från att gifta om sig formellt
' If i_civ_stat(i) = 1 Then '-- Rätt till änkepension upphör om man gifter sig
' i_surv_fp(i) = 0
' i_surv_atp(i) = 0
' i_surv(i) = 0
' End If
If i_status(i) = 2 Then '-- Folkpensionsdelen av änkepension upphör vid ålderpensionen
i_surv_fp(i) = 0
' i_surv(i) = i_surv_atp(i)
End If
'Transitional survivors pension
If i_surv_omst(i) > 0 Then
If (i_surv_year(i) = model_time + base_year) Or (i_surv_year(i) = model_time + base_year - 1 _
And h_n_child(hhnr2index(i_hhnr(i))) > 0) Or _
h_n_childlt12(hhnr2index(i_hhnr(i))) > 0 Then
i_surv_omst(i) = i_surv_omst(i) * f_pens_index("ATP", 65)
Else
i_surv_omst(i) = 0
End If
End If
' Indexering
i_surv_fp(i) = i_surv_fp(i) * f_pens_index("ATP", 65)
i_surv_atp(i) = i_surv_atp(i) * f_pens_index("ATP", 65)
i_surv(i) = i_surv_fp(i) + i_surv_atp(i) + i_surv_omst(i)
End If
End Sub
'-- Defined benefit occupational pensions
Public Function f_Occupational_DB_pension_benefits(i As Long, Sector As Byte, pensmonth As Integer)
Dim op_ap_db As Long
Dim cv_rate As Double
cv_rate = -0.03 ' cv_rate = -0.03 gives results that are close to tables supplied by Dan-Evert Eriksson
' interest rate for calculating capital values, i.e., present values (PV), and alike.
' PV = \sum_{t=1}^T (1+r)^{-t}B_t = \sum_{t=1}^T (1+r)^{-t}(1+d)^{t}B_0
' = \sum_{t=1}^T [(1+d)/(1+r)]^{t}B_0 = \sum_{t=1}^T [1+(d-r)/(1+r)]^{t}B_0
' = \sum_{t=1}^T [1+cv_rate]^{-t}B_0
' where cv_rate = (r-d)/(1+d) and d is the growth rate of pension benefits (indexed)
' and r is the long interest rate. If cv_rate = 0 we assume that these are identical.
' cv_rate > 0 => interest rate is higher than growth rate of benefits.
' cv_rate < 0 => interest rate is lower than growth rate of benefits
Select Case Sector
Case 1 '-- Blue collar
'-- Defined benefit part STP (Transitional rule)
If i_status1(i) <> 2 Then '-- New pensioner
If i_born_year(i) >= 1932 And i_born_year(i) < 1968 Then
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
10, 10, 10, mini(1, (f_pp_years(i, 1995) / 37)))
Else
op_ap_db = 0
End If
Else '-- Retired last year: Indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
Case 2 '-- White collar
' OLD VERSION WITHOUT EARLY WITHDRAWAL OF OCCUPATIONAL PENSION
' If i_status1(i) <> 2Then '-- New pensioner
' op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
' 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30))
'
' Else '-- Retired last year: Indexation
' op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
' End If
'
' BABY_BOOM VERSION WITH HIGHER REPLACEMENT RATIOS FOR EARLY WITHDRAWAL:
' In this version the individual recieves a replacement ratio of 65 percent of average
' past income upto his/hers 65 birthday. At this point the replacement ratio
' is reduced to the standard 10 percent (up to 7.5 basic amounts). Hence, we need
' to calculate the levels at two points in time. First, when the individual retires
' and second, when the individual turns 65 years old. For other ages, the benefits
' are calculated using indexation. (ME 2004-10-04)
' If individual retires before age 65, we store the average income for the past 5 years.
' This value is then re-used as we re-calculate the pension benefits from age 65.
If i_status1(i) <> 2 And i_age(i) > 60 And i_age(i) < 65 Then '-- New pensioner younger than 65
i_avg_inc_at_retirement(i) = f_avg_income(i) ' we need this to re-calculate benefits after 65
If i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019)
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
80, 70, 40, mini(1, i_op_pp_years(i) / 30), i_age(i), 0#, 0#)
ElseIf i_op_erp(i) = 0 Then
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
65, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i), 0.005, 0.006)
End If
ElseIf i_status1(i) <> 2 And i_age(i) > 64 Then ' new pensioneer older than 64
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i), 0.005, 0.006)
ElseIf i_status1(i) = 2 And i_age(i) = 65 Then ' previously retired individual turns 65, re-calculate benefits
If i_op_erp(i) = 0 Then
op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0.005, 0.006)
ElseIf i_op_erp(i) = 1 Then ' No actuarial adjustment for early withdrawal if there is an early retirement program (ME 051019)
op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0#, 0.006)
End If
Else '-- Retired last year: Indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
Case 3 '-- State
'-- Part-time pension agreement from age 61 to 65
If i_status1(i) <> 2 And i_age(i) > 60 And i_age(i) < 65 And i_work_share(i) > 0 Then
op_ap_db = f_avg_income(i) * 0.6 * (1 - i_work_share(i))
Else '-- Normal occup pens
'-- Defined benefit part
If (i_status1(i) <> 2) Or _
(i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner
' Select Case year
' Case Is > 2002 '-- PA03
' According to transition rules in PA03 (p. 47 "Övergångsbestämmelser"), PA03 applies to individuals
' born after 1942. For individuals born before 1943, PA91 applies. Hence, PA91 is still in effect for
' individuals born in 1942 until 2007 (=1942+65). In previous version of SESIM, this is handled by the f_op_pa03
' procedure where replacement ratios for individuals born before 1942 is in line with replacement ratios in PA91.
' However, these replacement ratios does not handle the case of higher repl. ratios if retiring before age 65.
' Hence, in this new version we use the actual PA91 rules for individuals born before 1943.
If year > 2002 And i_born_year(i) > 1942 Then
If i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019)
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
80, 70, 40, mini(1, i_op_pp_years(i) / 30), 65, 0, 0)
ElseIf i_op_erp(i) = 0 Then
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
f_op_pa03(i_born_year(i), 1), _
f_op_pa03(i_born_year(i), 2), _
f_op_pa03(i_born_year(i), 3), mini(1, i_op_pp_years(i) / 30))
' Calculate annual benefits if using temporary pension according to §21 PA03
If 60 < i_age(i) And i_age(i) < 65 Then
' Capital value of future stream of benefits when retiring at age 65
Dim op_cv_db As Long
' PV(rate,Nper,Pmt) such that PV = sum_{t=1}^Nper [1/(1+rate)]^t Pmt
' Pmt < 0 cash-out, Pmt>0 cash-in. See help for Pmt-function.
op_cv_db = PV(cv_rate, explife(65), -op_ap_db)
' Calculate maximum annuity allowed according to tax legislation §21 PA03
Dim lim As Long
If i_inc_taxable1(i) < 7.5 * m_basbelopp Then
lim = 0.8 * i_inc_taxable1(i)
ElseIf i_inc_taxable1(i) < 20 * m_basbelopp Then
lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (i_inc_taxable1(i) - 7.5 * m_basbelopp)
ElseIf i_inc_taxable1(i) < 30 * m_basbelopp Then
lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (20 - 7.5) * m_basbelopp + 0.4 * (i_inc_taxable1(i) - 20 * m_basbelopp)
Else
lim = (0.8 * 7.5 + 0.7 * (20 - 7.5) + 0.4 * (30 - 20)) * m_basbelopp
End If
' Calculate annuities (pmt) before 65 limited by lim
Dim op_an_db_before_65 As Long, xpmt As Long
xpmt = Pmt(cv_rate, 65 - i_age(i), -op_cv_db)
op_an_db_before_65 = mini(lim, xpmt)
' Calculate annuities after 65 as a payments from remainder of the capital value
Dim op_cv_remainder_at_65 As Long, op_an_db_after_65 As Long
op_cv_remainder_at_65 = op_cv_db - PV(cv_rate, 65 - i_age(i), -op_an_db_before_65)
op_an_db_after_65 = maxi(0, Pmt(cv_rate, explife(65), -op_cv_remainder_at_65))
i_op_an_db_before_65(i) = op_an_db_before_65
i_op_an_db_after_65(i) = op_an_db_after_65
i_using_temp_pension(i) = 1 ' Flags the use of temporary pension
op_ap_db = op_an_db_before_65
End If
End If
Else
' Case Else '-- PA-91
' In PA-91 the individuals are allowed to withdraw benefits from age 60.
' If so, the benefit ratios are given in §17 PA91 uptil age 65, and in §16 PA91
' thereafter.
If 60 < i_age(i) And i_age(i) < 65 Then 'Early withdrawal, higher repl. ratios
i_avg_inc_at_retirement(i) = f_avg_income(i)
If i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019)
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
80, 70, 40, mini(1, i_op_pp_years(i) / 30), i_age(i), 0, 0)
ElseIf i_op_erp(i) = 0 Then
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
65, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i), 0.004, 0.004)
' We also need to add a small amount stemming from the fact that the
' replacement ratio is 101% for 0-1 BA rather then 65% as assumed above.
' pensmonth is negative for early withdrawal
op_ap_db = op_ap_db + (1.01 - 0.65) * mini(f_avg_income(i), m_basbelopp) * _
(1 + pensmonth * 0.004)
End If
Else
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), maxi(i_age(i), 65), 0.004, 0.004)
End If
' End Select
End If
Else '-- Retired last year
If i_work_share(i) > 0 Then '-- Correction for changed work-time
op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i))
End If
'-- Indexation
If i_age(i) = 65 Then 'we need to recalculate benefits if previously retired and aged 65
If i_using_temp_pension(i) = 1 Then ' use annuities after 65 for temporary pensions
op_ap_db = i_op_an_db_after_65(i)
Else
' QUESTION: Shouldn't we inflate i_avg_inc_at_retirement(i) to the price level of the
' year in which the individual turns 65? Otherwise the average income will be in the
' price level of the year the individual first retired. (ME 041015)
If i_op_erp(i) = 1 Then ' No actuarial adjustement for early withdrawal with early retirement program (ME 051019)
op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0#, 0#)
ElseIf i_op_erp(i) = 0 Then
op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0.004, 0.004)
End If
End If
Else '-- standard indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
' we also need to index the annuities paid out after age 65.
i_op_an_db_after_65(i) = i_op_an_db_after_65(i) * f_pens_index("OP", 65)
' ' we also update the "average income at retirement"
' i_avg_inc_at_retirement(i) = i_avg_inc_at_retirement(i) * f_pens_index("OP", 65)
End If
End If
End If
Case 4 '-- Local government
'-- Defined benefit part
If (i_status1(i) <> 2) Then '-- New pensioner
i_avg_inc_at_retirement(i) = f_avg_income(i) ' we need this to re-calculate benefits after 65
If i_age(i) < 65 And i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019)
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
80, 70, 40, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0#, 0#)
Else ' No early retirement program
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
0, 62.5, 31.25, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0.004, 0.004)
'-- Simplified transitional rule PA-KL
' Note: Extra 10% compens level below social insur ceiling
' corrected for actual work experience 1997
If i_born_year(i) < 1969 And i_born_year(i) > 1933 Then
If i_op_erp(i) = 0 Then
op_ap_db = op_ap_db + _
f_op_db_comp(i_avg_income_1997(i) * m_basbelopp / 100, _
f_pens_bas("OP"), 10, 0, 0, _
mini(1, f_pp_years(i, 1997) / 30), f_ap_pensage(pensmonth), 0.004, 0.001)
End If
End If
End If
'-- Correction for work-time
op_ap_db = op_ap_db * (1 - i_work_share(i))
Else '-- Retired last year
If i_work_share(i) > 0 Then '-- Correction for changed work-time
op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i))
End If
'-- Indexation
If i_op_erp(i) = 1 And i_age(i) = 65 Then ' We need to recalculate pension benefits when ERP turns 65, no actuarial adjustment
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
0, 62.5, 31.25, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0#, 0#)
'-- Simplified transitional rule PA-KL
' Note: Extra 10% compens level below social insur ceiling
' corrected for actual work experience 1997
If i_born_year(i) < 1969 And i_born_year(i) > 1933 Then
If i_op_erp(i) = 0 Then
op_ap_db = op_ap_db + _
f_op_db_comp(i_avg_income_1997(i) * m_basbelopp / 100, _
f_pens_bas("OP"), 10, 0, 0, _
mini(1, f_pp_years(i, 1997) / 30), f_ap_pensage(pensmonth), 0#, 0#)
End If
End If
Else ' Standard indexation when no ERP
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
End If
Case Else '-- Other
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_db = 0
Else '-- Indexation (individuals with occup pens in start data
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
End Select
f_Occupational_DB_pension_benefits = op_ap_db
End Function
'**********************************************************************
' Function for calculation of occupational pensions Tjänstepensioner
'**********************************************************************
Public Function f_Occupational_pension_benefits(i As Long)
'! Calculation of occupational pension Tjänstepensioner
Dim m_op_rate As Double '-- Return on pension fund during pay out period
Dim pensmonth As Integer, n_pens_years As Integer, payout_time As Integer
Dim op As Long, op_ap_db As Long, op_ap_dc As Long, op_ap_tp As Long
Dim pb_op_ap As Long, pb_op_tp As Long
year = model_time + base_year
Dim cv_rate As Double
cv_rate = -0.03 ' see comments in f_Occupational_DB_pension_benefits() above
m_op_rate = m_interest_long '-- Standard assumption
payout_time = 5 '-- Payout time for supplemental benefits
If i_status(i) = 2 Then
pensmonth = i_ap_pensmonth(i)
If i_work_share(i) > 0 Then '-- If part-time retired no pension years counted
n_pens_years = 0
Else
n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth)
End If
Else
pensmonth = (i_age(i) - 65) * 12
n_pens_years = 0
End If
'-- Defined benefit occupational pensions
op_ap_db = f_Occupational_DB_pension_benefits(i, i_sector(i), pensmonth)
'-- Defined contribution occupational pensions
Select Case i_sector(i)
Case 1 '-- Blue collar
'-- Defined contribution part
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector
Else '-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
op_ap_tp = i_op_ap_tp(i)
End If
Case 2 '-- White collar
'-- Defined contribution part
If i_status1(i) <> 2 Then '-- New pensioner may have rights from earlier sector
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
Else '-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
End If
'-- Defined contribution suppl part: ITPK payed out in payout_time years
If n_pens_years < payout_time And i_pb_op_tp(i) > 0 Then
op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i))
pb_op_tp = i_pb_op_tp(i) - _
PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0)
Else
op_ap_tp = 0
pb_op_tp = 0
End If
Case 3 '-- State
'-- Defined contribution part PA03
If (i_status1(i) <> 2) Or (i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
If i_age(i) > 60 And i_age(i) < 65 And year > 2002 Then
' Calculate temporary pension annuities according to §12 PA03
' Capital value calculated as if individual retires at age 65
' Hence, we need to add employers contributions upto age 65. We assume that
' contributions are based on last years taxable income (max 30 BA).
' The contributions are defined in §9 PA03.
' We assume that real wage rates are constant (hence rate=0 in PV below)
Dim op_cv_dc As Long, contr_to_65 As Long
contr_to_65 = PV(0, 65 - i_age(i), -0.023 * mini(i_inc_taxable1(i), 30 * m_basbelopp))
op_cv_dc = i_pb_op_ap(i) + contr_to_65
' Calculate maximum annuity allowed according to tax
' legislation (and §12 PA03)
Dim lim As Long
If i_inc_taxable(i) < 7.5 * m_basbelopp Then
lim = 0.8 * i_inc_taxable1(i)
ElseIf i_inc_taxable1(i) < 20 * m_basbelopp Then
lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (i_inc_taxable1(i) - 7.5 * m_basbelopp)
ElseIf i_inc_taxable1(i) < 30 * m_basbelopp Then
lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (20 - 7.5) * m_basbelopp + 0.4 * (i_inc_taxable1(i) - 20 * m_basbelopp)
Else
lim = (0.8 * 7.5 + 0.7 * (20 - 7.5) + 0.4 * (30 - 20)) * m_basbelopp
End If
' The sum of annuities from DB and DC are limited by §12 PA03
Dim op_an_dc_before_65 As Long
op_an_dc_before_65 = Pmt(cv_rate, 65 - i_age(i), -op_cv_dc)
op_an_dc_before_65 = mini(lim - i_op_an_db_before_65(i), op_an_dc_before_65)
' Calculate annuities after 65 as a payment from remainder of capital values
Dim op_cv_remainder_at_65 As Long, op_an_dc_after_65 As Long
op_cv_remainder_at_65 = op_cv_dc - PV(cv_rate, 65 - i_age(i), -op_an_dc_before_65)
op_an_dc_after_65 = Pmt(m_interest_long / 100, explife(65), -op_cv_remainder_at_65)
i_op_an_dc_before_65(i) = op_an_dc_before_65
i_op_an_dc_after_65(i) = op_an_dc_after_65
i_using_temp_pension(i) = 1 ' Flags the use of temporary pension
op_ap_dc = op_an_dc_before_65
End If
Else '-- DC payed out as an life-long annuity without indexation
' However, if paid out as temporary pensions, then they should be indexed according to
' Dan-Evert Eriksson at SPV (ME 041025)
If i_age(i) = 65 And i_using_temp_pension(i) = 1 Then
op_ap_dc = i_op_an_dc_after_65(i)
Else
op_ap_dc = i_op_ap_dc(i)
End If
' We also need to index annuities paid out after 65
i_op_an_dc_after_65(i) = i_op_an_dc_after_65(i) * f_pens_index("OP", 65)
End If
'-- Supplemental defined contribution part, extra KÅPAN, payed out in payout_time years
If n_pens_years < payout_time And i_pb_op_tp(i) > 0 And i_work_share(i) = 0 Then
op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i))
pb_op_tp = i_pb_op_tp(i) - _
PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0)
Else
op_ap_tp = 0
pb_op_tp = 0
End If
Case 4 '-- Local government
'-- Defined contribution part: Yearly recalculation if part-time retired
If i_work_share1(i) > 0 Or i_status1(i) <> 2 Then '-- Part-time or new
op_ap_dc = (i_pb_op_ap(i) / dtalpp(i_age(i))) * (1 - i_work_share(i))
' In PFA-98 the individual is allowed for temporary pension for the defined
' contribution part. This is calculated as for the state sector.
If i_age(i) > 60 And i_age(i) < 65 Then
' Calculate temporary pension annuities according to §12 PFA-98 mom. 4
' We ignore the fact that only the part below 7.5BA is contributing to the
' temporary pension.
' Capital value calculated as if individual retires at age 65
' Hence, we need to add the employer's contributions upto age 65. We assume that
' contributions are based on last years taxable income (max 7.5BA).
' The contributions are defined in §8 PFA-98.
' We assume that real wage rates are constant (hence rate=0 in PV below)
' Dim op_cv_dc As Long, contr_to_65 As Long
contr_to_65 = PV(0, 65 - i_age(i), -0.034 * mini(i_inc_taxable1(i), 7.5 * m_basbelopp))
op_cv_dc = i_pb_op_ap(i) + contr_to_65
' Calculate maximum annuity allowed according to tax
' legislation (and §12 PFA-98, see also §12 PA03)
' Dim lim As Long
If i_inc_taxable(i) < 7.5 * m_basbelopp Then
lim = 0.8 * i_inc_taxable1(i)
ElseIf i_inc_taxable1(i) < 20 * m_basbelopp Then
lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (i_inc_taxable1(i) - 7.5 * m_basbelopp)
ElseIf i_inc_taxable1(i) < 30 * m_basbelopp Then
lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (20 - 7.5) * m_basbelopp + 0.4 * (i_inc_taxable1(i) - 20 * m_basbelopp)
Else
lim = (0.8 * 7.5 + 0.7 * (20 - 7.5) + 0.4 * (30 - 20)) * m_basbelopp
End If
' The sum of annuities from DB and DC are limited by §12 PFA-98 mom. 6
' Dim op_an_dc_before_65 As Long
op_an_dc_before_65 = Pmt(cv_rate, 65 - i_age(i), -op_cv_dc)
op_an_dc_before_65 = mini(lim - i_op_an_db_before_65(i), op_an_dc_before_65)
' Calculate annuities after 65 as a payment from remainder of capital values
' Dim op_cv_remainder_at_65 As Long, op_an_dc_after_65 As Long
op_cv_remainder_at_65 = op_cv_dc - PV(cv_rate, 65 - i_age(i), -op_an_dc_before_65)
op_an_dc_after_65 = Pmt(m_interest_long / 100, explife(65), -op_cv_remainder_at_65)
i_op_an_dc_before_65(i) = op_an_dc_before_65
i_op_an_dc_after_65(i) = op_an_dc_after_65
i_using_temp_pension(i) = 1 ' Flags the use of temporary pension
op_ap_dc = op_an_dc_before_65
End If
Else '-- DC payed out as an life-long annuity without indexation from last work year
If i_age(i) = 65 And i_using_temp_pension(i) = 1 Then
op_ap_dc = i_op_an_dc_after_65(i)
Else
op_ap_dc = i_op_ap_dc(i)
End If
' We also need to index annuities paid out after 65
i_op_an_dc_after_65(i) = i_op_an_dc_after_65(i) * f_pens_index("OP", 65)
End If
'-- Supplemental defined contribution part
If i_status1(i) <> 2 And i_work_share1(i) = 0 Then '-- New full-time pensioner
op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector
Else '-- DC payed out as an life-long annuity without indexation
op_ap_tp = i_op_ap_tp(i)
End If
Case Else '-- Other
'-- Defined contribution part
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i))
Else '-- Indexation (individuals with occup pens in start data
'-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
op_ap_tp = i_op_ap_tp(i)
End If
End Select
'-- Summing up
Dim opx As Long
op = op_ap_db + op_ap_dc + op_ap_tp
opx = op
'-- Updating global variables if retired
' Updating accum pens rights i_pb_op_ap in Calc_Occup_Pens_Rights()
If i_status(i) = 2 Then
i_op_ap_db(i) = op_ap_db
i_op_ap_dc(i) = op_ap_dc
i_op_ap_tp(i) = op_ap_tp
i_op(i) = op
i_pb_op_tp(i) = pb_op_tp
End If
' If i_sector(i) = 3 Then
' Dim f1 As Integer 'writing to disc, see also init...
' f1 = FreeFile
' Open "C:\sesim\microdata\op.txt" For Append As #f1
' Write #f1, year, i_indnr(i), i_age(i), i_ap_pensmonth(i), i_sector(i), _
' i_inc_taxable1(i) / 12, i_using_temp_pension(i), op_ap_db / 12, op_ap_dc / 12, op_ap_tp / 12, _
' (op_ap_db + op_ap_dc + op_ap_tp) / 12
' Close #f1
' End If
'AW testar
'f_Occupational_pension_benefits = op
f_Occupational_pension_benefits = i_op(i)
End Function
' Used for calculation of occupational pensions benefits in defined benefit systems
' Note: Not indepent function. Uses index as input
' Eg borde man definiera inkomsterna noggrannare. Kräver dock även laggade status.
Public Function f_avg_income(idxnr As Long) As Long
'!-- Calculation of fixed price average income for the last five years
f_avg_income = (i_inc_taxable1(idxnr) / m_basbelopp1 + _
i_inc_taxable2(idxnr) / m_basbelopp2 + _
i_inc_taxable3(idxnr) / m_basbelopp3 + _
i_inc_taxable4(idxnr) / m_basbelopp4 + _
i_inc_taxable5(idxnr) / m_basbelopp5) * m_basbelopp1 / 5
End Function
'*** Occupational pension: Calculation of compensation level in defined benefit systems
' Input:
' income = qualifying wage = pensionsmedförande lön
' basb = basic amount = basbelopp för beräkning av skiktgränser
' comp_tak = compensation level below social insurance limit
' comp_tak_20 = compensation level between social insurance limit and 20 basic amounts
' comp_20_30 = compensation level between 10 and 30 basic amounts
' NOTE: COMPENSATION LEVEL IN PERCENT EG 10, 30 ETC
' time = time in service = tjänstetidsfaktor
' early = monthly down correction if early pension. Optional, default=005% per month
' early=-999 means actuarial calculation
' late = monthly up correction if late pension. Optional, default=007% per month
' -----------------------------------------------------------------------------------
Public Function f_op_db_comp(income As Long, basb As Long, comp_tak As Double, _
comp_tak_20 As Double, comp_20_30 As Double, Optional time_factor As Double = 1, _
Optional pensage As Byte = 65, Optional Early As Double = 0.005, _
Optional Late As Double = 0.007) As Long
'!-- Occupational pensions: General procedure for Calculation of compensation levels in defined benefit systems
'-- Scaling of comp level
comp_tak = comp_tak / 100
comp_tak_20 = comp_tak_20 / 100
comp_20_30 = comp_20_30 / 100
Select Case income
Case Is <= 7.5 * basb
f_op_db_comp = income * comp_tak
Case Is <= 20 * basb
f_op_db_comp = (7.5 * basb * comp_tak) + _
(income - 7.5 * basb) * comp_tak_20
Case Is <= 30 * basb
f_op_db_comp = (7.5 * basb * comp_tak) + _
((20 - 7.5) * basb) * comp_tak_20 + _
(income - 20 * basb) * comp_20_30
Case Is > 30 * basb
f_op_db_comp = (7.5 * basb * comp_tak) + _
((20 - 7.5) * basb) * comp_tak_20 + _
((30 - 20) * basb) * comp_20_30
Case Else
f_op_db_comp = 0
End Select
'-- Correction for empoyment time and early or late withdrawal
f_op_db_comp = f_op_db_comp * time_factor * f_fu_kvot(pensage, Early, Late)
End Function
'**** Occupational pension, State employed PA03
' Calculates compensations levels, transitional rules
' Input: Year = born year YYYY
' Intervall = income intervall
' 1 = income <7,5 basbelopp
' 2 = 7,5 basbelopp < income < 20 basbelopp
' 3 = 20 basbelopp < income < 30 basbelopp
' -----------------------------
Public Function f_op_pa03(year As Integer, intervall As Byte) As Double
'Occupational pension: Transitional rules PA03
Dim pa03(31, 3) As Double
pa03(1, 1) = 9.5: pa03(1, 2) = 64.85: pa03(1, 3) = 32.4
pa03(2, 1) = 9.3: pa03(2, 2) = 64.7: pa03(2, 3) = 32.3
pa03(3, 1) = 9.1: pa03(3, 2) = 64.55: pa03(3, 3) = 32.2
pa03(4, 1) = 8.9: pa03(4, 2) = 64.4: pa03(4, 3) = 32.1
pa03(5, 1) = 8.7: pa03(5, 2) = 64.25: pa03(5, 3) = 32#
pa03(6, 1) = 8.4: pa03(6, 2) = 64.1: pa03(6, 3) = 31.9
pa03(7, 1) = 8.2: pa03(7, 2) = 63.95: pa03(7, 3) = 31.8
pa03(8, 1) = 7.9: pa03(8, 2) = 63.8: pa03(8, 3) = 31.7
pa03(9, 1) = 7.7: pa03(9, 2) = 63.65: pa03(9, 3) = 31.6
pa03(10, 1) = 7.4: pa03(10, 2) = 63.5: pa03(10, 3) = 31.5
pa03(11, 1) = 7.2: pa03(11, 2) = 63.35: pa03(11, 3) = 31.4
pa03(12, 1) = 6.9: pa03(12, 2) = 63.2: pa03(12, 3) = 31.3
pa03(13, 1) = 6.6: pa03(13, 2) = 63.05: pa03(13, 3) = 31.2
pa03(14, 1) = 6.3: pa03(14, 2) = 62.9: pa03(14, 3) = 31.1
pa03(15, 1) = 6: pa03(15, 2) = 62.75: pa03(15, 3) = 31#
pa03(16, 1) = 5.7: pa03(16, 2) = 62.6: pa03(16, 3) = 30.9
pa03(17, 1) = 5.4: pa03(17, 2) = 62.45: pa03(17, 3) = 30.8
pa03(18, 1) = 5.1: pa03(18, 2) = 62.3: pa03(18, 3) = 30.7
pa03(19, 1) = 4.7: pa03(19, 2) = 62.15: pa03(19, 3) = 30.6
pa03(20, 1) = 4.3: pa03(20, 2) = 62#: pa03(20, 3) = 30.5
pa03(21, 1) = 3.9: pa03(21, 2) = 61.85: pa03(21, 3) = 30.4
pa03(22, 1) = 3.6: pa03(22, 2) = 61.7: pa03(22, 3) = 30.3
pa03(23, 1) = 3.2: pa03(23, 2) = 61.5: pa03(23, 3) = 30.2
pa03(24, 1) = 2.9: pa03(24, 2) = 61.3: pa03(24, 3) = 30.1
pa03(25, 1) = 2.5: pa03(25, 2) = 61.1: pa03(25, 3) = 30#
pa03(26, 1) = 2.1: pa03(26, 2) = 60.9: pa03(26, 3) = 30#
pa03(27, 1) = 1.7: pa03(27, 2) = 60.7: pa03(27, 3) = 30#
pa03(28, 1) = 1.3: pa03(28, 2) = 60.5: pa03(28, 3) = 30#
pa03(29, 1) = 0.9: pa03(29, 2) = 60.3: pa03(29, 3) = 30#
pa03(30, 1) = 0.5: pa03(30, 2) = 60.1: pa03(30, 3) = 30#
pa03(31, 1) = 0: pa03(31, 2) = 60#: pa03(31, 3) = 30#
If year <= 1942 Then
Select Case intervall
Case 1
f_op_pa03 = 10
Case 2
f_op_pa03 = 65
Case 3
f_op_pa03 = 32.5
Case Else
f_op_pa03 = 0
End Select
ElseIf year > 1942 And year < 1973 Then
f_op_pa03 = pa03(year - 1942, intervall)
ElseIf year > 1972 Then
Select Case intervall
Case 1
f_op_pa03 = 0
Case 2
f_op_pa03 = 60
Case 3
f_op_pa03 = 30
Case Else
f_op_pa03 = 0
End Select
Else
f_op_pa03 = 0
End If
End Function
' -- Function returns pontential or paid out sum of public pensions depending on status.
' If individual retired the function also updates public pension variables
'-- Antar normalt att alla går i pension 1/1. Vidare antas alla som dör göra det den 1/1. Approximativt
' innebär detta att folk i genomsnitt får pension 1/2 år för tidigt, men å andra sidan förlorar
' 1/2 år i slutet av livet. För IP & TP beräknas även utgiftsmässiga belopp (suffix _ut)
Public Function f_Public_Pension_Benefits(i As Long) As Long
'!-- Calculation of old age public pension benefits
' BABYBOOM VERSION: (ME 2004-10-29)
' We assume that individuals do not withdraw public pensions until 65 years old.
' This assumption is motivated by observed data.
' As an individual could be flagged as a pensioneer last year without having withdrawn
' public pension benefits, we need to modify the concept of "retired last year".
' We consider an individual "non-retired" last year (i_status1(i)<>2) if
' public pension benefits are zero last year.
If i_age(i) < 65 And i_sector(i) <> 1 Then ' Blue collars are allowed to withdraw public pension before 65 (ME 2005-12-02)
f_Public_Pension_Benefits = 0
Else
Dim status1 As Integer, ap_pensmonth As Integer
status1 = i_status1(i) ' These are used to restore the lagged status at the end of this else-statment
ap_pensmonth = i_ap_pensmonth(i)
' There is something strange with i=267. This person is 82 years old in 2000 and has no public pensions pay-outs!
If i_ap(i) = 0 And i_age(i) <= 70 Then ' There was no public pension pay-outs last year, hence the individual
' is considered as a "new pensioneer"
i_ap_pensmonth(i) = maxi(0, (i_age(i) - 65) * 12) ' pensmonth is either 0 (at 65) or positive if i_age>65
i_status1(i) = 0 ' This variable is reset before we exit this procedure
End If
Dim bokvot As Double ' Bosättningstidskvot
Dim ap_fp_kvot As Double
Dim ap_fp_kvot1 As Double
Dim ap_berund As Long 'Beräkningsunderlag för garantipension
'Dim ap_atp_1994, ap_fp30_1994 As Double
'-- Dim as local variables. If retired also global variables calculated
Dim ap_atp As Long, ap_atp_old As Long, ap_pts As Long, ap_fp As Long
Dim ap_fp30 As Long, ap_tp As Long, ap_gp As Long, ap_ip As Long, ap_fiktiv As Long
Dim ap_pp As Long, ap_fp30_1994 As Long, ap_atp_1994 As Long, ap_gartill As Long
Dim ap As Long, ap_ap As Long, pensmonth As Integer, ap_ip_ut As Long
Dim PB_IP As Long, pb_pp As Long, pb_fiktiv As Long
Dim ap_atp_ut As Long, ap_fp30_ut As Long, ap_tp_ut As Long, ap_pp_ut As Long
year = model_time + base_year
If i_status(i) = 2 Then
pensmonth = i_ap_pensmonth(i)
Else
pensmonth = (i_age(i) - 65) * 12
End If
' -- Diverse kvoter
'deltid= 1 '-- Parameter för uttagsandel **** Skall implementeras senare. Tv. endast heltidspension
bokvot = mini(1, maxi(i_botid(i) / 40, pp_hist(i).n_years / f_krav_atp_ar(i_born_year(i))))
' -- Ersättningsnivå för folkpen etc beroende på civilstånd
ap_fp_kvot = f_ap_fp_kvot(i_civ_stat(i)) 'Basic pension ratio depends on civil status
ap_fp_kvot1 = f_ap_fp_kvot(i_civ_stat1(i)) ' -"- last year
'! -- Old system Gamla systemet
'! -- ATP - National supplementary pension Allmän tilläggspension
' We assume that the individuals do not withdraw public pensions before age 65.
If i_status1(i) <> 2 Then '-- New pensioner
If i_age(i) >= 61 And pp_hist(i).n_years >= 3 Then
ap_atp = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _
(pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
(1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth)))
' Korrigering för halvårseffekt av utfasningen.
' Also adjusted for deceased persons in a02, new_economy2
ap_atp_ut = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _
(pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _
+ (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2
ap_atp_old = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _
(pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth))
Else
ap_atp = 0
ap_atp_ut = 0
ap_atp_old = 0
End If
Else ' -- Retired last year
ap_atp = i_ap_atp(i) * f_pens_index("ATP", i_age(i))
If ap_atp < 0 Then
i = i
End If
ap_atp_ut = i_ap_atp_ut(i) * f_pens_index("ATP", i_age(i))
ap_atp_old = i_ap_atp_old(i) * (m_basbelopp / m_basbelopp1)
End If
'! -- Basic pension & pension supplement Folkpension & PTS
If i_age(i) > 61 And i_botid(i) >= 3 Then ' *** Behövs vid beräkn Ö-garpAnd year < 2003 Then
ap_fp = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * ap_fp_kvot * m_basbelopp
'**** PTS-kvot 0,555 för 990601
ap_pts = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * _
maxi((0.569 * m_basbelopp) - (ap_atp + i_surv(i)), 0)
Else
ap_fp = 0
ap_pts = 0
End If
'! -- Reformed system Reformerat system
' Balance indexing of suppl pens for transition generation (LIP 6 kap, § 8a)
If year > 2003 And (i_born_year(i) >= 1938 And i_born_year(i) <= 1953) And i_age(i) = 65 Then
i_ap_atp(i) = i_ap_atp(i) * m_ap_balanstal_accum
End If
'! -- FP30 - Old part Reformed basic pension
If i_age(i) >= 61 And pp_hist(i).n_years >= 3 And year >= 2001 Then
If i_status1(i) <> 2 Or (year = 2001 And i_status(i) = 2) Then ' -- Not retired last year
If ap_atp > 0 Then '-- Only calculated for individuals with ATP
ap_fp30 = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
ap_fp_kvot * m_basbelopp * (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))
ap_fp30_ut = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
ap_fp_kvot * m_basbelopp * _
((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _
+ (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2
Else
ap_fp30 = 0
ap_fp30_ut = 0
End If
Else ' Retired last year - Indexation and correction for changed civil status
ap_fp30 = i_ap_fp30(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation
ap_fp30_ut = i_ap_fp30_ut(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation
End If
Else
ap_fp30 = 0
ap_fp30_ut = 0
End If
'! -- IP - Income pension Inkomstpension
If i_age(i) >= 61 And year >= 2001 Then
If (i_status1(i) <> 2) Then ' -- Not retired last year
'-- Special rules for indexing the year of retirement: No indexation
'PB_IP = i_pb_ip(i) + i_pr_ip1(i) '-- Tidigare metod
PB_IP = i_pb_ip(i)
ap_ip = PB_IP / dtalip(i_age(i))
'-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt
' f att få rätt makro. Nya får endast halv IP utbetald 1:a året.
ap_ip_ut = ap_ip * 0.5
Else ' -- Retired last year
ap_ip = i_ap_ip(i) * f_pens_index("IP", i_age(i)) ' -- Indexation
ap_ip_ut = ap_ip '-- ap_ip_ut later adjusted for deceased persons in a02
End If
Else
ap_ip = 0
End If
'! -- Calculates fictious pension. Used in calc of reformed basic pension
' and ap_gartill.
If i_age(i) >= 65 And year >= 2003 Then
If (i_status1(i) <> 2 Or i_age(i) = 65) Then ' -- Not retired last year
' pb_fiktiv = i_pb_fiktiv(i) + i_pr_ip1(i) + i_pr_pp1(i) 'Tidigare metod
pb_fiktiv = i_pb_fiktiv(i)
ap_fiktiv = pb_fiktiv / dtalip(65) ' or 65 years
Else ' -- Retired last year
ap_fiktiv = i_ap_fiktiv(i) * f_pens_index("IP", i_age(i)) ' -- Indexation
End If
Else
ap_fiktiv = 0
End If
'! -- PP - PremiePension
If i_status1(i) <> 2 Then ' New pensioner
' Man kan välja om pp skall utbetalas som en livränta eller kvarstå i fonder
' Man kan välja att ta ut pp från 61-79:11 års ålder, välja 25, 50, 75
' eller 100%:s uttag. Det går att göra uppehåll i uttaget och ändra den andel som tas ut.
' Som standardantagande antas att alla väljer livränta, räknar som en annuitet, och
' 100% från 65 år för alla.
' Note: Discounting facor=1 + ((m_interest_long / 100) - m_favg_pp) in call to Calculate_Dtal
'*** OBS: Delningstal beräknade på detta sätt låga jämfört med PPM:s ***
'pb_pp = i_pb_pp(i) + i_pr_pp1(i) 'Tidigare metod
pb_pp = i_pb_pp(i)
ap_pp = pb_pp / dtalpp(i_age(i))
'-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt
' f att få rätt makro. Nya får endast halv IP utbetald 1:a året.
ap_pp_ut = ap_pp * 0.5
Else '-- Retired last year: Note - No indexation of PP, just an annuity
ap_pp = i_ap_pp(i)
ap_pp_ut = ap_pp '-- ap_pp_ut later adjusted for deceased persons in a02
End If
'! -- Retirement pension, Reformed transitional supplement Garantitillägg
' Endast till mellagenerationen, ej vid uttag av enbart PP, tidigast from 65 år
'**** Eg inget gartill vid uttag vid enbart PP
If i_born_year(i) > 1937 And i_born_year(i) <= 1953 And i_age(i) >= 65 Then
If i_age(i) = 65 Or i_status1(i) <> 2 Then '-- 65 years old OR newly retired
ap_fp30_1994 = ap_fp_kvot * m_basbelopp * f_fu_kvot(f_ap_pensage(pensmonth)) _
* mini(1, (i_ATP_ar_1994(i) / 30))
ap_atp_1994 = 0.6 * (i_mATP_1994(i) / 100) * m_basbelopp * mini(1, _
(i_ATP_ar_1994(i) / 30)) * f_fu_kvot(f_ap_pensage(pensmonth))
Else ' -- Indexation and correction for changed civil status
ap_fp30_1994 = i_ap_fp30_1994(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("IP", i_age(i))
ap_atp_1994 = i_ap_atp_1994(i) * f_pens_index("IP", i_age(i))
End If
ap_gartill = maxi(0, ((ap_fp30_1994 + ap_atp_1994) - _
(ap_fiktiv + ap_fp30 + ap_atp)))
Else
ap_gartill = 0
End If
'! -- GP - Reformed basic retirement pensions Garantipension
' If i_age(i) >= 61 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then 'AW Testar en reform
If i_age(i) >= 65 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then
Select Case i_born_year(i)
Case Is > 1937 '!-- . Persons born 1938 and later Garantipension
ap_tp = ap_fp30 + ap_atp + ap_gartill
ap_gp = f_ap_garp_38_(i_civ_stat(i), f_pens_bas("GP"), _
ap_tp, ap_fiktiv, i_surv(i))
Case Is <= 1937 '! -- Transitional reformed basic retirement pension
' f.d. Övergångsvis garantipension
ap_gp = f_ap_garp_37(i_civ_stat(i), f_pens_bas("GP"), _
ap_atp, ap_fp30, ap_fp, ap_pts, _
i_surv(i), i_op(i), i_botid(i))
End Select
Else
ap_gp = 0
End If
'! -- Summing up different pension components
If year < 2003 Then '-- Old system
ap = ap_fp + ap_pts + ap_atp
If ap_atp > 0 Then
ap_ap = ap_fp + ap_atp
Else
ap_ap = 0
End If
Else '-- Reformed system
ap_tp = ap_fp30 + ap_atp + ap_gartill ' -- Supplemental pension Tilläggspension
ap_tp_ut = ap_fp30_ut + ap_atp_ut + ap_gartill
ap = ap_tp + ap_ip + ap_pp + ap_gp ' -- Total old age
ap_ap = ap_tp_ut + ap_ip_ut
End If
If i_status(i) = 2 Then
i_ap_atp(i) = ap_atp
i_ap_atp_ut(i) = ap_atp_ut
i_ap_atp_old(i) = ap_atp_old
i_ap_pts(i) = ap_pts
i_ap_fp(i) = ap_fp
i_ap_fp30(i) = ap_fp30
i_ap_fp30_ut(i) = ap_fp30_ut
i_ap_tp(i) = ap_tp
i_ap_tp_ut(i) = ap_tp_ut
i_ap_gp(i) = ap_gp
i_ap_ip(i) = ap_ip
i_ap_ip_ut(i) = ap_ip_ut
i_ap_fiktiv(i) = ap_fiktiv
i_ap_pp(i) = ap_pp
i_ap_pp_ut(i) = ap_pp_ut
i_ap_fp30_1994(i) = ap_fp30_1994
i_ap_atp_1994(i) = ap_atp_1994
i_ap_gartill(i) = ap_gartill
i_ap_tp(i) = ap_tp
i_ap(i) = ap
i_ap_ap(i) = ap_ap
If (i_status1(i) <> 2) Then
i_pb_ip1(i) = i_pb_ip(i)
i_pb_ip(i) = PB_IP
i_pb_pp(i) = pb_pp
i_pb_fiktiv(i) = pb_fiktiv
End If
End If
f_Public_Pension_Benefits = i_ap(i)
i_status1(i) = status1 ' Restore status
i_ap_pensmonth(i) = ap_pensmonth ' Restore pensmonth
End If ' age < 65
End Function
' -- Function returns sum of private pensions.
' If individual retired the function also updates private pension variables
' Note: i_wealth_pension_total not a part private wealth or the wealth tax base
Public Function f_Private_Pension_Benefits(i As Long, payout_time As Integer) As Long
Dim pp As Long, wealth_pension_total As Long
Dim pensmonth As Integer, pp_rate As Double, n_pens_years As Integer
pp_rate = m_interest_long '-- Standard assumption
If i_status(i) = 2 Then
pensmonth = i_ap_pensmonth(i)
n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth)
Else
pensmonth = (i_age(i) - 65) * 12
n_pens_years = 0
End If
If i_age(i) >= 55 And payout_time <> 0 Then 'minimum 55 years age and savings
'-- Assumed that pension captital payed out in payout_time years from pension time
If payout_time < 0 Then '-- Lifelong annuity
If i_status1(i) <> 2 Then '-- New private pensioner with annuity
pp = Pmt((pp_rate * (1 - 0.15)) / 100, explife(i_age(i)), -i_wealth_pension_total(i))
'pp = i_wealth_pension_total(i) / dtalpp(i_age(i))
Else
pp = i_pp(i)
End If
wealth_pension_total = maxi(0, i_wealth_pension_total(i) + _
((i_wealth_pension_total(i) - pp / 2) * ((pp_rate * (1 - 0.15)) / 100)) - pp)
Else '-- Fixed pay out time
If n_pens_years < payout_time Then
pp = Pmt((pp_rate * (1 - 0.15)) / 100, payout_time - n_pens_years, -i_wealth_pension_total(i))
wealth_pension_total = i_wealth_pension_total(i) - _
PPmt((pp_rate * (1 - 0.15)) / 100, 1, payout_time - n_pens_years, -i_wealth_pension_total(i), 0)
Else
pp = 0
wealth_pension_total = 0
payout_time = 0
End If
End If
If i_status(i) = 2 Then
i_pp(i) = pp
i_wealth_pension_total(i) = wealth_pension_total
i_wealth_pension_year(i) = 0 '*** Not simultanous saving and pay out
i_pp_payout_time(i) = payout_time
End If
Else
i_pp(i) = 0
End If
f_Private_Pension_Benefits = i_pp(i)
End Function
Sub Pension_debugging_files()
'!-- Optional printing of pension debugging files (micro data)
status "Printing pension debugging files"
Dim utvar As String
Dim demofile As Integer
Dim i As Long
year = model_time + base_year
If model_time = 0 Then
Open sesimpath & "\tempdata\valid_pens.txt" For Output As #11
utvar = f_Concat_string("i", "bidnr", "year", "i_age", "i_sex", "i_civ_stat", "i_abroad", _
"i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _
"i_ap_atp", "f_mean_ATP", "m_basbelopp", "i_botid", "ATP_years", _
"f_krav_atp_ar", "f_fu_kvot", "f_utfasning_ATP", "i_born_year ", "f_ap_pensyear", _
"i_ap_fp30", "i_ap_ip", "i_pb_ip", "dtal", _
"i_ap_fiktiv", "i_pb_fiktiv", _
"m_interest_short", "i_ap_pp", "explife", "i_pb_pp", "i_ap_gp", _
"i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", _
"i_pu", "i_pgi", "i_pgb", "i_pgb_barn", "i_pgb_plikt", _
"i_pgb_stud", "i_pgb_antag", "i_pb_op_ap", "i_pb_op_tp", "i_pbhi", "i_status1", _
"i_indnr", "i_ap", "i_p_andel", "i_ap_pensmonth", "i_pp", "i_pp_payout_time")
Print #11, utvar
Else
Open sesimpath & "\tempdata\valid_pens.txt" For Append As #11
End If
For i = 1 To m_icount
If i_status(i) = 2 And i_status1(i) <> 2 Then '-- Only for new pensioners
' If i_status(i) = 2 And i_ap_gp(i) > 0 Then '-- Pensionärer med garantipension
utvar = f_Concat_string(i, i_bidnr(i), year, i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), _
i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _
i_ap_atp(i), f_mean_ATP(i), m_basbelopp, i_botid(i), pp_hist(i).n_years, _
f_krav_atp_ar(i_born_year(i)), f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i))), _
f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i))), _
i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _
i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), dtalip(65), _
i_ap_fiktiv(i), i_pb_fiktiv(i), _
m_interest_short, i_ap_pp(i), explife(65), i_pb_pp(i), i_ap_gp(i), _
i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), _
i_pu(i), i_pgi(i), i_pgb(i), i_pgb_barn(i), i_pgb_plikt(i), _
i_pgb_stud(i), i_pgb_antag(i), i_pb_op_ap(i), i_pb_op_tp(i), i_pbhi(i), i_status1(i), _
i_indnr(i), i_ap(i), i_p_andel(i), i_ap_pensmonth(i), i_pp(i), i_pp_payout_time(i))
'***** m_interest_short, i_ap_pp(i), explife(i_age(i)), i_pb_pp(i), i_ap_gp(i),
Print #11, utvar
End If
Next i
Close #11
'If year <= 2020 Then
If model_time = 0 Then
Open sesimpath & "\tempdata\valid_pgi.txt" For Output As #12
utvar = f_Concat_string("year", "i", "bidnr", "i_status", "i_sector", "i_abroad", _
"m_interest_short", "m_interest_long", "m_ap_inkind", "m_ap_balind", "m_basbelopp", _
"i_age", "i_sex", "i_civ_stat", "i_inc_taxable", "i_born_year ", _
"i_pu", "i_pgi", "i_pgb", _
"i_pgb_barn", "i_pgb_plikt", "i_pgb_stud", "i_pgb_antag", _
"i_pb_ip", "i_pbhi", "i_pb_pp", "i_pb_fiktiv", "i_pb_op_ap", "i_pb_op_tp", _
"i_wealth_pension_total", "i_wealth_pension_year")
Print #12, utvar
Else
Open sesimpath & "\tempdata\valid_pgi.txt" For Append As #12
End If
For i = 1 To m_icount
If i_born_year(i) >= 1938 And i_born_year(i) < 1984 Then
' If i_bidnr(i) <> 0 And _
' i_born_year(i) >= 1938 And i_born_year(i) < 1984 And i_abroad(i) = 1 Then 'And Rnd < 0.05 Then
' var 20:e individ skrivs ut
utvar = f_Concat_string(year, i, i_bidnr(i), i_status(i), i_sector(i), i_abroad(i), _
m_interest_short, m_interest_long, m_ap_inkind, m_ap_balind, m_basbelopp, _
i_age(i), i_sex(i), i_civ_stat(i), i_inc_taxable(i), i_born_year(i), _
i_pu(i), i_pgi(i), i_pgb(i), _
i_pgb_barn(i), i_pgb_plikt(i), i_pgb_stud(i), i_pgb_antag(i), _
i_pb_ip(i), i_pbhi(i), i_pb_pp(i), i_pb_fiktiv(i), i_pb_op_ap(i), i_pb_op_tp(i), _
i_wealth_pension_total(i), i_wealth_pension_year(i))
Print #12, utvar
End If
Next i
'End If
Close #12
End Sub
Sub Pension_micro_file()
'!-- Optional printing of pension micro file (micro data)
status "Printing pension micro file"
Dim utvar As String
Dim demofile As Integer
Dim i As Long
year = model_time + base_year
If model_time = 0 Then
Open sesimpath & "\tempdata\pension_micro.txt" For Output As #13
utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_age", "i_sex", _
"i_civ_stat", "i_abroad", "i_status", "i_sector", _
"i_edlevel", "i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _
"i_ap_atp", "i_born_year ", "f_ap_pensyear", _
"i_ap_fp30", "i_ap_ip", "i_pb_ip", "i_ap_pp", "i_pb_pp", "i_ap_gp", _
"i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", "i_pu", "i_pgi", "i_pgb", _
"i_pb_op_ap", "i_pb_op_tp", _
"i_ap", "i_ap_tp", "i_p_andel", "i_pp", "i_pp_payout_time", _
"i_wealth_pension_total", "i_wealth_pension_year", "i_ap_tp")
Print #13, utvar
Else
Open sesimpath & "\tempdata\pension_micro.txt" For Append As #13
End If
For i = 1 To m_icount
utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_age(i), i_sex(i), _
i_civ_stat(i), i_abroad(i), i_status(i), i_sector(i), _
i_edlevel(i), i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _
i_ap_atp(i), i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _
i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), i_ap_pp(i), i_pb_pp(i), i_ap_gp(i), _
i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), i_pu(i), i_pgi(i), i_pgb(i), _
i_pb_op_ap(i), i_pb_op_tp(i), _
i_ap(i), i_ap_tp(i), i_p_andel(i), i_pp(i), i_pp_payout_time(i), _
i_wealth_pension_total(i), i_wealth_pension_year(i), i_ap_tp(i))
Print #13, utvar
Next i
Close #13
End Sub
'**********************************************************************
' Calculation of pension rights for
' - the ATP pension system (tilläggspension, TP
' - the reformed pension system (inkomstpension, IP and premiepension, PP)
'**********************************************************************
'**** KVAR ATT GÖRA:
'**** - TA EV BORT 16-ÅRS GRÄNSEN FÖR INTJÄNANDET.
Public Sub Calculate_Public_Pension_Rights()
'!-- Calculation of pension rights ATP-system and new system PGI & PGB
status "Calculate public pensions rights"
Printdok " Calculate_Public_Pension_Rights"
Dim i As Long
Dim j As Long
Dim tak As Double ' Social insurance limit (Intjänandetak)
' Dim atak As Double ' Social insurance limit plus employee contribution (Avgiftstak)
Dim pgi_snitt As Double ' Average taxable income
Dim pgb_barn1 As Long ' Pension rights f child years, alternative 1
Dim pgb_barn2 As Long ' Pension rights f child years, alternative 2
Dim pgb_barn3 As Long ' Pension rights f child years, alternative 3
Dim rand As Double ' Help variable for calc of random number
Dim randvek() As Double
Dim basb As Long ' Price basic amount or income basic amount
Dim sum As Double
Dim n As Long
Dim pgi_bas As Long
'-- Optional aligning OT regarding the career effect, see below
Dim OTfix2 As Byte
If get_scalefactor_active("OTfix2") = 1 Then
OTfix2 = 1
Else
OTfix2 = 0
End If
sum = 0
n = 0
m_pgi = 0
m_pgb = 0
Dim year As Integer
Dim maxyear As Integer
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
'-- Calculation of administration costs and fee on income pension funds
m_pb_ip_active_n = cnt0(i_pb_ip) * m_weight
m_pb_ip_active = L_SUMVEC(i_pb_ip(1), m_icount) * m_weight
' Förvaltningskostnad 0.075 Källa: Pensionsystemets årsredovisning 2001, sid 20
' -- Costs of insurance administarion: A function of the number of active savers
' m_ap_admin_ip_ins_pers exognous for outcome years: Source Pension System annual report
'm_pensadmin_ip_ins_pers = (m_pensadmin_ip_ins / m_cnt_pb_ip_active) * m_inkind
If f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension") <> 0 Then
m_ap_adm_ip_ins_p = f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension")
Else
m_ap_adm_ip_ins_p = m_ap_adm_ip_ins_p * (m_ap_inkind / m_ap_inkind1)
End If
m_ap_adm_ip_ins = m_ap_adm_ip_ins_p * m_pb_ip_active_n '-- Note: t-1 value
' -- Costs of AP-fund administration: A function of the fund value
' m_ap_admin_ip_ap_p exognous for outcome years: Source Pension System annual report
If f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension") <> 0 Then
m_ap_adm_ip_ap_p = f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension")
End If
m_ap_adm_ip_ap = (m_ap_adm_ip_ap_p / 100) * m_ap_apfond '-- Note: t-1 value
' -- Total administration costs
m_ap_adm_ip = m_ap_adm_ip_ins + m_ap_adm_ip_ap
' Administration fee as a part of pension liabilities to active savers
m_ap_adm_ip_p = m_ap_adm_ip / m_pb_ip_active '-- Note: t-1 value
' -- Reduced administration fee on pension liabilities:
' Gradual transition from 62% to 100% fee on individual accounts until 2021
' Infasing t 2021 för att de med behållningar i nya systemet ej ska subventionera gamla ATP
' (Lag 1998:674 5 kap 8§)
Select Case year
Case Is <= 2001
m_favg_ip = 0.6 * m_ap_adm_ip_p
Case Is < 2022
m_favg_ip = (((year - 1999) * 0.02) + 0.56) * m_ap_adm_ip_p
Case Else
m_favg_ip = m_ap_adm_ip_p
End Select
'-- Basic amount and income limit Aktuellt basbelopp och intjänandetak
If year < 2001 Then basb = m_basbelopp_f Else basb = m_basbelopp_income
tak = 7.5 * basb
'!-- Calculate pensionable income Beräknar pensionsgrundande inkomst PGI
'!-- Helpvariables for calculation of pension income index and income basic amount
j = 0
m_inc_taxable_snitt4 = m_inc_taxable_snitt3
m_inc_taxable_snitt3 = m_inc_taxable_snitt2
m_inc_taxable_snitt2 = m_inc_taxable_snitt1
m_inc_taxable_snitt1 = m_inc_taxable_snitt
m_inc_taxable_snitt = 0
For i = 1 To m_icount
pgi_bas = 0
If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI
pgi_bas = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i)
i_pgi_bas(i) = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i)
If i_pgi_bas(i) < 0 Then
i = i
End If
If (pgi_bas * (1 - m_egenavg_pens_p)) <= tak Then
i_pgi(i) = round((pgi_bas * (1 - m_egenavg_pens_p)) - 50, -2)
Else
i_pgi(i) = round(tak - 50, -2)
End If
'-- For disab pensioners. Pension rights only based on qualifying points before 2003
If i_status(i) = 4 And year < 2003 Then
i_pgi(i) = 0
End If
' -- Individual comparison pension base PU (Used in calculation of i_pgb_barn)
If exist_child0_3(i_hhnr(i)) <> 1 Then
i_pu_ind_comp(i) = i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)
End If
' -- Cumulation of base for income index
If pgi_bas > 0 Then
j = j + 1
m_inc_taxable_snitt = m_inc_taxable_snitt + (pgi_bas * (1 - m_egenavg_pens_p))
End If
Else
i_pgi(i) = 0
End If
Next i
If j > 0 Then
m_inc_taxable_snitt = (m_inc_taxable_snitt / j) / m_price_change99
Else
m_inc_taxable_snitt = 0
Debug.Print "Calculate_public_pension_rights: ingen har nollskild PGI!"
End If
'-- Calculate average pensionable income Beräknar genomsnittlig PGI
' and averge income used for calculation of pension income index
j = 0
pgi_snitt = 0
For i = 1 To m_icount
If i_age(i) > 15 And i_age(i) < 65 And i_abroad(i) = 0 And i_pgi(i) > 0 Then
j = j + 1
pgi_snitt = pgi_snitt + i_pgi(i)
End If
Next
pgi_snitt = pgi_snitt / j
'*** Draw vector of standard normal variates
ReDim randvek(1 To m_icount)
Call RANNOR(m_icount, randvek(1), model_time + base_year + random * Rnd)
'!-- Pensionable amounts, pension rights Pensionsgrundande belopp och pensionsunderlag
For i = 1 To m_icount
If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI
'! -- Pensionable amounts, military service
' Endast 20 åriga män antas göra värnplikt
'0.45 = Andel som gör lumpen enligt Pliktverkets hemsida (avser 1999)
'För varje dag tjänstgöringenpågår pågår > 120 dagar. Beräknas som
'50% av PGI för alla försäkrade < 65 år/365 * antalet dagar
'Vägt genomsnitt för olika utbildniugskategoriers (enl Pliktverket)
'tjänstgöringstider ger ca 250 dagar
' ***** OBS Info om antal finns i AKU. Kolla detta.
' ***** LF har skattat modell. Ev implementera denna
If i_sex(i) = 1 And i_age(i) = 20 And Rnd < 0.45 Then
i_pgb_plikt(i) = 0.5 * (pgi_snitt / 365) * 250
Else
i_pgb_plikt(i) = 0
End If
'! -- Pensionable amounts, studies 138% of study grants (Endast av bidragsbeloppet)
If i_status(i) = 3 Then
i_pgb_stud(i) = 1.38 * i_trf_study_grant(i)
Else
i_pgb_stud(i) = 0
End If
'!-- Pensionable amounts, disability pension (Antagandeinkomst)
' Only if qualifying points for the current year has been calculated in new_economy
If i_status(i) = 4 And pp_hist(i).n_years > 0 Then ' If disab pens AND ATP-points
If pp_hist(i).pp_years(pp_hist(i).n_years) = year Then '..and points the current year
If year < 2003 Then
i_pgb_antag(i) = ((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1) _
* m_basbelopp_f
Else
'-- Note: No contribution from the disability pensioner
i_pgb_antag(i) = i_ftp_antag(i) - i_pgi(i)
End If
End If
Else
i_pgb_antag(i) = 0
End If
'! -- Pensionable amounts, child years
' Women with child age 0 to 3 years. Kvinna får t.v. all pensrätt för barn
'**** ÄNDRA SÅ ATT DEN MED LÄGST INKOMST FÅR POÄNGEN ****
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
If i_sex(i) = 2 And exist_child0_3(i_hhnr(i)) = 1 Then
' Check for gainful employment limit: PGI>2 inc basic i minst 5 år ( <2001 2 basbf)
If pp_hist_limit(i, 100) >= 5 Then
'-- Best of 3 alternatives Bäst av tre alternativ
' 1) Individual comp PGI Utfyllnad till inkomst året före barnets födelse
pgb_barn1 = maxi(0, i_pu_ind_comp(i) - i_pgi(i))
' 2) General comp PGI Utfyllnad t 75% av genomsnittl PGI
pgb_barn2 = maxi(0, 0.75 * pgi_snitt - _
(i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)))
' 3) One income base amount Ett inkomstbasbelopp (ett förh prisbasb före 2001)
pgb_barn3 = basb
'-- Choosing best alternative
i_pgb_barn(i) = maxi(pgb_barn1, maxi(pgb_barn2, pgb_barn3))
Select Case i_pgb_barn(i)
Case pgb_barn1
i_pgb_barn_typ(i) = 1
Case pgb_barn2
i_pgb_barn_typ(i) = 2
Case pgb_barn3
i_pgb_barn_typ(i) = 3
End Select
End If
End If
'! -- Summing up pensionable amounts
i_pgb(i) = i_pgb_barn(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_antag(i)
' -- PGB + PGI max social insurance income limit
Select Case tak
Case Is < i_pgi(i)
i_pgb_antag(i) = 0
i_pgb_plikt(i) = 0
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i)
i_pgb_antag(i) = tak - i_pgi(i)
i_pgb_plikt(i) = 0
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i)
i_pgb_plikt(i) = tak - i_pgi(i) - (i_pgb_antag(i))
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)
i_pgb_stud(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i))
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i)
i_pgb_barn(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i))
End Select
i_pgb(i) = round((i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i)) - 50, -2)
'-- Optional aligning OT regarding the career effect
' OTfix2: Justerar PGI (inkomstprofilen) för äldre för att få OT enl RFV
' Note: Förutsätter att även PGI alignas
If OTfix2 = 1 Then
Select Case i_age(i)
Case Is = 57 And i_status(i) <> 2
i_pgi(i) = 0.96 * i_pgi(i)
Case Is = 58 And i_status(i) <> 2
i_pgi(i) = 0.92 * i_pgi(i)
Case Is = 59 And i_status(i) <> 2
i_pgi(i) = 0.87 * i_pgi(i)
Case Is = 60 And i_status(i) <> 2
i_pgi(i) = 0.82 * i_pgi(i)
Case Is > 61 And i_status(i) <> 2
i_pgi(i) = 0.78 * i_pgi(i)
End Select
End If
i_pu(i) = i_pgb(i) + i_pgi(i)
Else
i_pgb(i) = 0
i_pgb_antag(i) = 0
i_pgb_plikt(i) = 0
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 1
i_pgi(i) = 0
i_pu(i) = 0
End If
'-- Macro for aligning
m_pgi = m_pgi + i_pgi(i)
m_pgb = m_pgb + i_pgb(i)
Next i
'!-- Optional calculation of determinstic pension rights
' Samma procedur som i Orange kuvert
Dim Orange As Byte
Dim growth As Double
If get_scalefactor_active("Pension_Orange") = 1 Then
growth = get_scalefactor("Pension_Orange")
For i = 1 To m_icount
' AW Inga pensionsgrundande belopp i orange brev i framtiden, sätter pu=pgi
i_pu_orange(i) = i_pu_orange(i) * growth
i_pu(i) = i_pu_orange(i)
i_pgi_orange(i) = i_pgi_orange(i) * growth
i_pgi(i) = round(i_pgi_orange(i) - 50, -2)
Next i
End If
'!-- Optional aligning of pensionable income etc
Dim Align_PGI As Byte
Dim pgb As Double
Dim pgi As Double
Dim pu As Double
If get_scalefactor_active("Align_PGI") = 1 Then
' pgb = parm_macro(maxyear, 13)
' pgi = parm_macro(maxyear, 15)
m_zpgb_korr = parm_macro(maxyear, 13)
m_zpgi_korr = parm_macro(maxyear, 15)
If m_zpgi_korr = 0 Then m_zpgi_korr = 1
If m_zpgb_korr = 0 Then m_zpgb_korr = 1
' If pgi > 1 Then m_zpgi_korr = pgi / (m_pgi * m_weight)
' If pgb > 1 Then m_zpgb_korr = pgb / (m_pgb * m_weight)
For i = 1 To m_icount
i_pgi(i) = i_pgi(i) * m_zpgi_korr
i_pgb(i) = i_pgb(i) * m_zpgb_korr
i_pu(i) = i_pgi(i) + i_pgb(i)
Next i
End If
If get_scalefactor_active("Align_PGI2") = 1 Then '-- Align t RFV årsredov
' -- PGI & PGB aggregerat, endast mått på PU nivå f RFV
pu = parm_macro(maxyear, 15) 'Hack: Lägger PU i PGI-kolumnen
pgi = pu - (m_pgb * m_weight)
If pgi > 0 Then
m_zpgi_korr = pgi / (m_pgi * m_weight)
Else
m_zpgi_korr = 1
End If
Debug.Print pu & " " & pgi & " " & m_zpgi_korr
For i = 1 To m_icount
i_pgi(i) = i_pgi(i) * m_zpgi_korr
i_pu(i) = i_pgi(i) + i_pgb(i)
Next i
End If
'! -- Cumulative pension rights PR
m_ap_arv_59 = 0: m_ap_arv60_ = 0: m_ap_index = 0: m_ap_favg = 0
For i = 1 To m_icount
i_pr_ip1(i) = i_pr_ip(i)
i_pr_pp1(i) = i_pr_pp(i)
i_pb_ip1(i) = i_pb_ip(i)
If i_age(i) >= 16 And i_status(i) <> 2 Then
'! -- Pension rights for the ATP-system
' PP-vector for disab pens already updated in Calculate_Disablity_Pension_Benefits
If i_pgi(i) > m_basbelopp_f + 100 And i_status(i) <> 4 Then
Call Update_pp_hist(i, CInt(((i_pgi(i) - m_basbelopp_f) / m_basbelopp_f) * 100))
End If
'! -- Pension rights and pension contributions for the reformed system
Select Case i_pu(i)
Case Is < f_bas_deduct_min(year)
i_pr_ip(i) = 0
i_pr_pp(i) = 0
Case Else
'-- Tidigare version utkommenterad
'i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0))
'i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0))
'-- Snabb uppskruvning av avgifterna kräver korr för halvårseffekt
i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _
+ f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2
i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _
+ f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2
End Select
'! -- Cumulative pension rights
'! -- Income pension Inkomstpension
' -- First calculation of some aggregated variables for balancing
If i_age(i) < 60 Then
m_ap_arv_59 = m_ap_arv_59 + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i))))
Else
m_ap_arv60_ = m_ap_arv60_ + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i))))
End If
m_ap_index = m_ap_index + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _
* ((m_ap_balind / m_ap_balind1) - 1))
m_ap_favg = m_ap_favg + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _
* m_favg_ip)
'! -- Cumulative pension rights
' -- Then individual pension rights
'! -- Income pension Inkomstpension
' Tidigare version
'i_pb_ip(i) = ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i) - 1) + i_pr_ip1(i)) _
' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2))
'i_pb_fiktiv(i) = ((i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) _
' + (i_pr_ip1(i) + i_pr_pp1(i))) _
' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2))
If m_RFV_PB_On <> 1 Then
i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _
(m_ap_balind / m_ap_balind1)) + i_pr_ip(i)
i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _
(m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i))
Else 'RFV:s förvaltningskostnadsavdrag
i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _
(m_ap_balind / m_ap_balind1)) + i_pr_ip(i)
i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _
(m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i))
End If
'! -- Premium pension
' Parameter i fördeln nedan avsedd att modellera osäkerheten i placeringarna
' Räknar med årsgenomsnitt på tillfälliga avkastningen,dvs div m 2
' Förenkling nedan. Eg så skall pengarna ha tillf placering i snitt 1,5 år
rand = randvek(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100))
i_pb_pp(i) = (i_pb_pp(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_pp) * rand) + _
(i_pr_pp(i) * (1 + (m_interest_short / 100) / 2))
Else
i_pr_ip(i) = 0
i_pr_pp(i) = 0
End If
Next i
m_ap_arv_59 = m_ap_arv_59 * m_weight
m_ap_arv60_ = m_ap_arv60_ * m_weight
m_ap_arv = m_ap_arv_59 + m_ap_arv60_
m_ap_index = m_ap_index * m_weight
m_ap_favg = m_ap_favg * m_weight
'!-- Optional aligning of cumulative pension rights
' Proportional adjustment factor updated i Default_parameters2
Dim Align_PB As Byte
'Dim PB_IP As Double
Dim pb_fiktiv As Double
Dim pb_pp As Double
Dim yy As Integer
If get_scalefactor_active("Align_PB") = 1 And year = 2000 Then
' cohort sex {1=RFV,2=Sesim,3=Quota}
Dim PB_IP(1938 To 1987, 2, 3) As Double
'-- Read RFV values per cohort and sex f Sesim.mdb
For yy = 1938 To 1987
PB_IP(yy, 1, 1) = f_GetMakro("PB_IP_M", year, CStr(yy))
PB_IP(yy, 2, 1) = f_GetMakro("PB_IP_F", year, CStr(yy))
Next
'-- Aggregate Sesim values per cohort and sex
For i = 1 To m_icount
If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then
PB_IP(i_born_year(i), i_sex(i), 2) = _
PB_IP(i_born_year(i), i_sex(i), 2) + (i_pb_ip(i) * m_weight)
End If
Next i
'-- Calculation of aligning factors
For yy = 1938 To 1987
If PB_IP(yy, 1, 2) > 0 And PB_IP(yy, 2, 2) > 0 Then
PB_IP(yy, 1, 3) = PB_IP(yy, 1, 1) / PB_IP(yy, 1, 2)
PB_IP(yy, 2, 3) = PB_IP(yy, 2, 1) / PB_IP(yy, 2, 2)
Else
PB_IP(yy, 1, 3) = 1
PB_IP(yy, 2, 3) = 1
End If
Next
'-- Printing align factors for pension rights
Open sesimpath & "\tempdata\PB_align.prn" For Output As #93
Print #93, "Cohort Male Female"
For yy = 1938 To 1987
Print #93, yy & " " & PB_IP(yy, 1, 3) & " " & PB_IP(yy, 2, 3)
Next
Close #93
'-- Aligning
For i = 1 To m_icount
If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then
i_pb_ip(i) = i_pb_ip(i) * PB_IP(i_born_year(i), i_sex(i), 3)
i_pb_fiktiv(i) = i_pb_fiktiv(i) * PB_IP(i_born_year(i), i_sex(i), 3)
'i_pb_pp(i) = i_pb_pp(i) * m_zpb_pp_korr
End If
Next i
End If
End Sub
Public Sub Calculate_Occupational_Pension_Rights()
'!-- Calculation of occupational pension rights for defined contribution systems
status "Calculate occupational pensions rights"
Printdok " Calculate_Occupational_Pension_Rights"
Dim i As Long, pgi_bas As Long
Dim tak As Double, rand() As Double, r1 As Double, r2 As Double
year = model_time + base_year
If year < 2001 Then tak = 7.5 * m_basbelopp_f Else tak = 7.5 * m_basbelopp_income
'*** Draw random numbers
ReDim rand(1 To 2 * m_icount)
Call RANNOR(2 * m_icount, rand(1), model_time + base_year + random * Rnd)
For i = 1 To m_icount
If (i_status(i) <> 2 And i_abroad(i) = 0) Or _
(i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65) Then
'-- Simplified calc of pension rights for part-time retired. Assumes that all
' all income qualifies for pension rights even pensions.
pgi_bas = i_inc_earning(i) + i_trf_sickleave(i)
If i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65 Then
'-- Part-time retired normally gets pensions rights as if full-time to age 65
pgi_bas = (i_inc_earning(i) + i_trf_sickleave(i)) / i_work_share(i) '-- Rough calc of full-time pay
Else
pgi_bas = i_inc_earning(i) + i_trf_sickleave(i)
End If
Select Case i_sector(i)
Case 1 '-- Blue collar: SAF-LO
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.035, , tak, 21, 1932)
i_pr_op_tp(i) = 0
i_op_pp_years_Blue(i) = i_op_pp_years_Blue(i) + 1
Case 2 '-- White collar: ITPK
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.02, , tak, 28, 1939)
i_op_pp_years_White(i) = i_op_pp_years_White(i) + 1
Case 3 '-- State: PA03 & Kåpan
If year >= 2003 Then '-- PA03
i_pr_op_ap(i) = f_op_pens_rights(mini(pgi_bas, 30 * m_basbelopp_income), _
i_age(i), i_born_year(i), 0.023, , tak, 23, 1943)
Else
i_pr_op_ap(i) = 0
End If
Select Case year '-- Extra Kåpan
Case Is < 2003
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.015, , tak, 28)
Case 2003
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.019, , tak, 28)
Case Is > 2003
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.02, , tak, 28)
End Select
i_op_pp_years_State(i) = i_op_pp_years_State(i) + 1
Case 4 '-- Local goverment: PFA-01
Select Case year '-- PFA98 (Kommunalarbetareförbundets premier)
Case Is < 2004
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.045, 0.021, tak, 28, 1938)
i_pr_op_tp(i) = 0
Case Is >= 2004
'-- Employed 2003, minimum age 28, still 4,5% fee
If i_born_year(i) < 1976 Then
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.045, 0.011, tak, 28, 1938)
Else '-- Still 28 year age limit above social insurance limit
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.04, 0, tak, 21, 1938) + _
f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0, 0.011, tak, 28, 1938)
End If
i_pr_op_tp(i) = 0
End Select
i_op_pp_years_Local(i) = i_op_pp_years_Local(i) + 1
Case Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End Select
Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End If
'! -- Cumulative occupational pension rights
' Parameter in distribution below measures uncertainty in investment
' Assumes same average return on occupational pension funds as public premium pension
' Also tax on return 15% (avkastningsskatt) on occup pens rights
r1 = rand(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100))
r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_shares_return / 100))
If i_status(i) = 2 And i_work_share(i) > 0 Then '-- Updating the stock
i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _
+ i_pr_op_ap(i) - i_op_ap_dc(i)
Else
i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _
+ i_pr_op_ap(i)
i_pb_op_tp(i) = (i_pb_op_tp(i) * r2 * (1 - ((m_interest_long / 100) * 0.15))) _
+ i_pr_op_tp(i)
End If
' -- DB-rights for persons who has changed sector capitalized and added to DC-rights
' Upparbetade DB-rätter omvandlas t DC-rätter f 65 års ålder
If i_sector(i) <> i_sector1(i) And (i_sector1(i) <> 0 And i_sector1(i) <> 5) Then
i_pb_op_ap(i) = i_pb_op_ap(i) + mini(1, (i_op_pp_years(i) / 30)) * _
(PV(m_interest_long / 100, explife(65), _
-f_Occupational_DB_pension_benefits(i, i_sector1(i), 0)))
i_op_pp_years(i) = 0
i_op_pp_years_trans(i) = 0
Else
i_op_pp_years(i) = i_op_pp_years(i) + 1
End If
Next i
End Sub
' Note: ' No information about lagged statuses. Uses the status for the base year for whole period
' Note: Possible to move this procedure to start data program
' Procedure call from c00_Init
Public Sub Init_Occupational_Pension_Rights()
'!-- Initiation of occupational pension stocks in DC systems
status "Init occupational pensions"
Printdok " Init_Occupational_Pension_Rights"
Dim i As Long
Dim tak As Double
Dim yr As Integer
Dim rand() As Double, r1 As Double, r2 As Double
Dim Interest_long As Double
For yr = 1977 To base_year
Interest_long = f_GetMakro("Interest_long", yr)
m_basbelopp_f = f_GetMakro("BASBF", yr)
tak = 7.5 * m_basbelopp_f
'*** Draw random numbers
ReDim rand(1 To 2 * m_icount)
Call RANNOR(2 * m_icount, rand(1), yr * 10 + random * Rnd)
For i = 1 To m_icount '-- Loops all individuals
If i_status(i) = 8 And i_abroad(i) = 0 Then
'**** Syntax for function call: x = f_op_pens_rights(fee,fee top, age, born)
Select Case i_sector(i)
Case 1 '-- Blue collar: SAF-LO
If yr >= 1996 Then
i_pr_op_ap(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _
i_age(i), i_born_year(i), 0.02, , tak, 21, 1932)
Else
i_pr_op_ap(i) = 0
End If
i_pr_op_tp(i) = 0
Case 2 '-- White collar: ITPK
i_pr_op_ap(i) = 0
If yr >= 1977 Then
i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _
i_age(i), i_born_year(i), 0.02, , tak, 28, 1939)
Else
i_pr_op_tp(i) = 0
End If
Case 3 '-- State: PA03 & Kåpan
i_pr_op_ap(i) = 0
If yr >= 1991 Then '-- Kåpan
i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _
i_age(i), i_born_year(i), 0.015, , tak, 28)
Else
i_pr_op_tp(i) = 0
End If
Case 4 '-- Local goverment: PFA98
If yr >= 1998 Then '-- PFA98 (Kommunalarbetareförbundets premier)
i_pr_op_ap(i) = f_op_pens_rights(i_inc_taxable1(i), i_age(i), i_born_year(i), _
0.045, 0.021, tak, 28, 1938)
Else
i_pr_op_ap(i) = 0
End If
If yr >= 1998 Then
End If
i_pr_op_tp(i) = 0
Case Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End Select
Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End If
'! -- Cumulative occupational pension rights
' Parameter in distribution below measures uncertainty in investment
' Assumes same average return on occupational pension funds as public premium pension
r1 = rand(i) * Sqr(0.0000001) + (1 + (m_interest_long / 100))
r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_interest_long / 100))
i_pb_op_ap(i) = i_pb_op_ap(i) * r1 + i_pr_op_ap(i)
i_pb_op_tp(i) = i_pb_op_tp(i) * r2 + i_pr_op_tp(i)
Next i
Next yr
' -- Saving 4 year averaged income 1997 x 100 / basb
' Used primarily in cal of transitional rules for local government employees
For i = 1 To m_icount '-- Loops all individuals
i_avg_income_1997(i) = (i_inc_taxable2(i) / m_basbelopp2 + _
i_inc_taxable3(i) / m_basbelopp3 + _
i_inc_taxable4(i) / m_basbelopp4 + _
i_inc_taxable5(i) / m_basbelopp5) * 100 / 4
Next i
End Sub
' Note: Uses truncated pp_hist values years less than base_year-5 years,
' lagged income variables for base_year-5 to base_year
'-- Syntax for function call:
' x = f_hist_income(ix,y)
' ix = index for actual individual
' y = historical year
' basb = basic amount for the historical year
Public Function f_hist_income(ix As Long, y As Integer, basb As Long) As Long
'!-- Returns the historical income for a certain year
Dim j As Integer
f_hist_income = 0
If y < base_year - 5 Then
If pp_hist(ix).n_years > 0 Then
For j = 1 To pp_hist(ix).n_years
If pp_hist(ix).pp_years(j) = y Then
f_hist_income = (pp_hist(ix).pp(j) + 100) * basb / 100
Exit For
End If
Next
End If
Else
Select Case y
Case base_year - 5
f_hist_income = i_inc_taxable5(ix)
Case base_year - 4
f_hist_income = i_inc_taxable4(ix)
Case base_year - 3
f_hist_income = i_inc_taxable3(ix)
Case base_year - 2
f_hist_income = i_inc_taxable2(ix)
Case base_year - 1
f_hist_income = i_inc_taxable1(ix)
Case base_year
f_hist_income = i_inc_taxable(ix)
Case Else
f_hist_income = 0
End Select
End If
End Function
'-- Syntax for function call:
' x = f_op_pens_rights(income,age,born,fee,fee top, top limit, agelimit, bornlimit)
' income = pensionsmedförande lön (i kr)
' age = age of individual
' born = year of birth of individual
' fee = premium (eg 0.035) below a certain limit, eg the social security limit 7,5 basb.
' fee top = premie above the limit (eg 0.035) Optional: Default= fee
' toplim = The limit (eg 7,5 basb) Optional: Default=7.5 basb
' agelim = åldergräns för intjänande (tex 28) Optional: Default= 19
' bornlim = gäller personer födda efter detta år (tex 1943) Optional: Default= 1900
Public Function f_op_pens_rights(income As Long, age As Byte, born As Integer, _
fee As Double, Optional feetop As Double = -1, Optional toplim As Double = -1, _
Optional agelim As Integer = 19, Optional bornlim As Integer = 1900) As Long
'!-- Calculation of occupational pension rights (defined contribution systems)
' for different labour market sectors
If feetop = -1 Then
feetop = fee
End If
If toplim = -1 Then
toplim = 7.5 * m_basbelopp
End If
If age > agelim And born > bornlim Then
If income <= toplim Then
f_op_pens_rights = fee * income
Else
f_op_pens_rights = (fee * toplim) + (feetop * (income - toplim))
End If
End If
End Function
'-- Updates the pension history vectors in pp_hist
' Input:
' ix = index for actual individual
' pp = calculated value for pp_hist(i).pp
' Automatically updated:
' Number of years in pp_hist(i).n_years = n_years + 1
' Income year in pp_hist(i).pp_years = year
' Output: Nothing
Public Sub Update_pp_hist(ix As Long, pp As Integer)
'!-- Updates pension history vectors in pp_hist
ReDim Preserve pp_hist(ix).pp(pp_hist(ix).n_years + 1)
ReDim Preserve pp_hist(ix).pp_years(pp_hist(ix).n_years + 1)
pp_hist(ix).n_years = pp_hist(ix).n_years + 1
pp_hist(ix).pp(pp_hist(ix).n_years) = pp
pp_hist(ix).pp_years(pp_hist(ix).n_years) = year
End Sub
'-- Returns number of ATP years for individual i up to year y
' Input:
' ix = index for actual individual
' year = number of ATP years up to this year
Public Function f_pp_years(ix As Long, year As Integer) As Byte
'!-- Number of ATP years for individual i up to year y
Dim y As Integer
f_pp_years = 0
If pp_hist(ix).n_years > 0 Then
For y = 1 To pp_hist(ix).n_years
If pp_hist(ix).pp_years(y) <= year Then
f_pp_years = f_pp_years + 1
Else
Exit For
End If
Next
End If
End Function
' -- Returns the ratio used for adjustment of calculated ATP-pension for early /
' late retirement (Note: time unit = month)
' Default values from public ATP system
' Input: pensage = early or late pension in years compared to 65 year
' early = monthly down correction if early pension. Optional, default=005% per month
' early=-999 means actuarial calculation
' late = monthly up correction if late pension. Optional, default=007% per month
' Note: explife and m_interest_short must be defined before execution
'Examples: x=f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i)),0.005,0.007) or x=f_fu_kvot(f_ap_pensage(i),-999)
'-----------------------------------------------------------------------------------------
Public Function f_fu_kvot(pensage As Byte, Optional Early As Double = 0.005, Optional Late As Double = 0.007) As Double
'!-- Returns the ratio used for adjustment of calculated ATP-pension for early /
'! late retirement (Note: time unit = month)
Dim rate As Double '-- Yearly discounting factor
rate = m_interest_long / 100 'Standardantagande: Långränta
If Early = -999 Then '-- Code -999 for actuarial calculation (Ja, jag vet: Ett hack)
f_fu_kvot = Pmt(rate, explife(pensage), PV(rate, explife(65), 1))
Else
Select Case pensage
Case Is < 60 ' No pensions before 60
MsgBox ("Error in f_fu_kvot: Pension age less than 60. Check pension age in function call")
Case Is < 65 ' -- Early withdrawal
f_fu_kvot = 1 + ((pensage - 65) * Early * 12)
Case 65 ' -- 65 years
f_fu_kvot = 1
Case Is <= 70 ' -- Late withdrawal
f_fu_kvot = 1 + ((pensage - 65) * Late * 12)
Case Is > 70
MsgBox ("Error in f_fu_kvot: Pension age greater than 70. Check pension age in function call")
End Select
End If
End Function
'-- Returns basic pension ratio used for calculation of i_ap_fp, i_ap_fp30, i_ap_pts etc
' Input: Civil status 0=Not married, 1= Married
' Note: m_ap_fp_kvot_ogifta and m_ap_fp_kvot_gifta must be initiated before execution
Public Function f_ap_fp_kvot(civ_stat As Byte) As Double
If civ_stat = 0 Then
f_ap_fp_kvot = m_ap_fp_kvot_ogifta
ElseIf civ_stat = 1 Then
f_ap_fp_kvot = m_ap_fp_kvot_gifta
Else
MsgBox "Fel i f_ap_fp_kvot: Parameter ska vara 0 eller 1"
End If
End Function
'-- Reduction of benefits on account of inadequate period of service
' In swedish: Tjänstetidsfaktor
'Note: Not indepent. Uses pp-history
' Examples: x= f_red_service_time(i,f_krav_atp_ar(i_borm_year(i))
Public Function f_red_service_time(ix As Long, Optional limit As Integer = 30) As Double
'!-- Tjänstetidsfaktor
f_red_service_time = mini(1, (pp_hist(ix).n_years) / limit)
End Function
'-- Calculates the income pension annuity factors (delningstal), annuity facors for
' premium pension and inheritance gains
' Annuity factors caculated on death hazards in assumptions file
' Income pension: dtalip(age 50-106) with 1,6% norm growth as default
' Premium pension: dtalpp(age 50-106) default 3.2%. If 0 expected remaining lifetime
' Inheritance gains based on a direct and simplified method based on death hazards
' i.e. no summing up of actual cumulated pension funds for persons younger than 60
' Creates a public array defined from 0 to 106 years: Arvsvinstfactor(y=0-106)
' Note: Call and defintion of global variables in new_economy_2 once a year
Public Sub Calculate_Deltal(Optional norm As Double = 1.016, Optional normpp As Double = 1)
'!-- Calculates pension annuity factors (delningstal)
'!-- and inheritance factors (arvsvinstfaktor)
Printdok " Calculate_Deltal"
Dim maxyear As Long
Dim B(0 To 106, 1 To 2) As Double
Dim q(0 To 106, 1 To 2) As Double
Dim lx(0 To 106, 1 To 2) As Double
Dim lx_(0 To 106) As Double
Dim sex As Long, year As Long, age As Long, n As Long, x As Long, k As Long, j As Long
Dim pop As Double, d As Double, e As Double, r As Double
year = model_time + base_year
maxyear = mini(2050, year)
Dim q_lag As Double, l As Integer
For sex = 1 To 2
pop = 100000
For age = 0 To 106
q_lag = 1
For l = 1 To 5 '-- 5-year smoothed hazards
q_lag = q_lag * parm_death(mini(2110, maxi(1999, year - l)), age, sex)
Next
q_lag = q_lag ^ (1 / 5)
pop = pop * (1 - q_lag)
B(age, sex) = pop
Next
Next
For sex = 1 To 2
For age = 0 To 106
If age < 106 Then
lx(age, sex) = (B(age, sex) + B(age + 1, sex)) / 2
Else
lx(age, sex) = B(age, sex)
End If
Next
Next
For age = 1 To 106 '-- Note: One year shift i age, i.e age 0 = -1 etc.
lx_(age) = (lx(age - 1, 1) * 0.5145) + (lx(age - 1, 2) * (1 - 0.5145))
Next
For n = 50 To 106
d = 0
e = 0
r = 0
For x = 0 To 11
For k = n To 105
d = d + ((norm) ^ (-(k - n))) * _
(lx_(k) + (lx_(k + 1) - lx_(k)) _
* (x / 12)) * (norm) ^ (-x / 12)
e = e + (normpp) ^ (-(k - n)) * _
(lx_(k) + (lx_(k + 1) - lx_(k)) _
* (x / 12)) * (normpp) ^ (-x / 12)
r = r + (1) ^ (-(k - n)) * _
(lx_(k) + (lx_(k + 1) - lx_(k)) _
* (x / 12)) * (1) ^ (-x / 12)
Next
Next
dtalip(n) = round(d / (12 * lx_(n)), 2)
dtalpp(n) = round(e / (12 * lx_(n)), 2)
explife(n) = r / (12 * lx_(n))
Next
For age = 1 To 106
Arvsvinstfaktor(age) = 1 + ((lx_(age - 1) - lx_(age)) / lx_(age))
Next
'-- Optional switch to exogenous "Orange envelopes"-annuity factors
If get_scalefactor_active("Pension_Orange") = 1 And year >= 2003 Then
dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249")
dtalpp(65) = f_GetMakro("dtal_rfvpp", CInt(maxyear), "dtal_rfv")
End If
'-- Optional switch to exognous discounted expected remaining lifetime according to
' RFV 2002.
' Note: Only active if pensions at age 65, and for year 2003 to 2100.
If get_scalefactor_active("Deltal_RFV") = 1 Then
If year > 2002 Then
dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249")
End If
End If
End Sub
Public Function f_krav_atp_ar(born_year As Integer) As Integer
'! -- Calculates required number of years for ATP for different cohorts
Select Case born_year
Case Is > 1923
f_krav_atp_ar = 30
Case 1915 To 1923
f_krav_atp_ar = 20 + born_year - 1914
Case Else
f_krav_atp_ar = 20
End Select
End Function
Public Function f_utfasning_ATP(born_year As Integer, ap_pens_year As Integer) As Double
'! -- Calculates parameter for phasing out the ATP system Note: > 1953 = 1 and <1938 = 0
' Includes transitions rules for persons born 1938 and 1939
Select Case born_year
Case Is > 1953
f_utfasning_ATP = 1
Case 1938 To 1953
If born_year <= 1939 And ap_pens_year <= 2000 And year <= 2003 Then
f_utfasning_ATP = 0
Else
f_utfasning_ATP = (born_year - 1937 + 3) / 20
End If
Case Else
f_utfasning_ATP = 0
End Select
End Function
' Note: If i_ap_pensmonth <0 => early withdrawal (in months), >0 late, 0 = pensage=65
' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal
'Public Function f_ap_pensage(idxnr As Long) As Byte
Public Function f_ap_pensage(pensmonth As Integer) As Byte
'! -- Calculates pension age in years
f_ap_pensage = 65 + Int(pensmonth / 12)
End Function
' -- Calculates pension year (ex post and ex ante).
' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal
' from the default value 65.
'Public Function f_ap_pensyear(idxnr As Long) As Integer
Public Function f_ap_pensyear(year As Integer, age As Byte, pensmonth As Integer) As Integer
'! -- Calculates pension year
'f_ap_pensyear = year - (i_age(idxnr) - (65 + Int(i_ap_pensmonth(idxnr) / 12)))
f_ap_pensyear = year - (age - (65 + Int(pensmonth / 12)))
End Function
' -- Choice of price indexation method
' Note: Price indexation m_basbelopp / m_basbelopp1 not m_KPI, but same result in steady state.
Public Function f_pens_index(program As String, age As Byte) As Double
'! -- Calculates actual price indexation method for different pension programs and years
Select Case year
Case Is >= 2003
Select Case program
Case "ATP" '-- LIP 5 kap, 14§
If age < 65 Then '-- Before age 65 only price indexing
f_pens_index = m_basbelopp / m_basbelopp1
Else '-- Discounted income indexation after age 65 (Följsamhetsindexering)
f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm)
End If
Case "IP"
f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm)
Case "GP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "OP" '-- Payed out defined benefit occupational pensions
f_pens_index = m_basbelopp / m_basbelopp1
Case Else
f_pens_index = 0
End Select
Case Is <= 2001
Select Case program
Case "ATP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "FP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "PTS"
f_pens_index = m_basbelopp / m_basbelopp1
Case "IP" '-- Eg kan uttag av IP ske f 2001, men ej Sesim
f_pens_index = 0
Case "OP" '-- Payed out defined benefit occupational pensions
f_pens_index = m_basbelopp / m_basbelopp1
Case Else
f_pens_index = 0
End Select
Case 2002
Select Case program
Case "ATP" '-- Enl Prop 1999/00:138, sid 72
'f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / m_ap_norm)
f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996)
Case "FP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "PTS"
f_pens_index = m_basbelopp / m_basbelopp1
Case "IP"
' **** Skall ev vara 1.026 i nämnaren???
f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996)
Case "OP" '-- Payed out defined benefit occupational pensions
f_pens_index = m_basbelopp / m_basbelopp1
Case Else
f_pens_index = 0
End Select
End Select
End Function
'! -- Reformed basic retirement pensions for individuals born from 1938 on
' Garantipension för personer födda from 1938
' Output: Reformed basic pension, current SEK Utbetald garantipension
Public Function f_ap_garp_38_(civ_stat As Byte, basbelopp As Long, ap_tp As Long, _
ap_fiktiv As Long, surv As Long) As Long
'! -- Reformed basic retirement pensions Garantipension
Dim berunderlag As Long
berunderlag = ap_tp + ap_fiktiv + surv
Select Case civ_stat '-- Marital status
Case 0 '-- Not married
If berunderlag <= 1.26 * basbelopp Then
f_ap_garp_38_ = (2.13 * basbelopp) - berunderlag
Else
f_ap_garp_38_ = maxi(0, ((2.13 - 1.26) * basbelopp) - 0.48 * _
(berunderlag - (1.26 * basbelopp)))
End If
Case 1 '-- Married
If berunderlag <= 1.14 * basbelopp Then
f_ap_garp_38_ = 1.9 * basbelopp - berunderlag
Else
f_ap_garp_38_ = maxi(0, ((1.9 - 1.14) * basbelopp) - 0.48 * _
(berunderlag - (1.14 * basbelopp)))
End If
End Select
End Function
'! -- Transitional reformed basic retirement pension for individuals born until 1938
' f.d. Övergångsvis garantipension för indvider födda tom 1937
Public Function f_ap_garp_37(civ_stat As Byte, basbelopp As Long, _
ap_atp As Long, ap_fp30 As Long, ap_fp As Long, ap_pts As Long, _
surv As Long, op As Long, botid As Integer) As Long
Dim berunderlag As Long
Dim berunderlag_korr As Long
'!-- 1: Beräkning av beräkningsunderlag
berunderlag = ap_atp + maxi(ap_fp30, ap_fp) + ap_pts + surv + op
'!-- 2: Uppräkning av beräkningsunderlag som komp för SGA
If berunderlag <= 0.25 * basbelopp Then
berunderlag_korr = berunderlag * 1.04
ElseIf berunderlag > 0.25 * basbelopp And berunderlag < 1.354 * basbelopp Then
berunderlag_korr = 1.5174 * berunderlag - 0.1193 * basbelopp
Else
Select Case civ_stat '-- Marital status
Case 0 '-- Not married
If berunderlag >= 1.354 * basbelopp And berunderlag < 1.529 * basbelopp Then
berunderlag_korr = 1.343 * berunderlag + 0.1168 * basbelopp
ElseIf berunderlag >= 1.529 * basbelopp And berunderlag < 3.16 * basbelopp Then
berunderlag_korr = 2.17 * basbelopp + 0.6 * (berunderlag - 1.51 * basbelopp)
Else
berunderlag_korr = berunderlag
End If
Case 1 '-- Married
If berunderlag >= 1.354 * basbelopp And berunderlag < 2.8275 * basbelopp Then
berunderlag_korr = 1.935 * basbelopp + 0.6 * (berunderlag - 1.34 * basbelopp)
Else
berunderlag_korr = berunderlag
End If
End Select
End If
'!-- 3: Beräkning av garantipension mht inkomst, civilstånd etc
f_ap_garp_37 = maxi(0, berunderlag_korr - (ap_atp + ap_fp30 + surv + op)) _
* mini(1, botid / 40)
End Function
' Note: Do NOT use in loops
Public Function f_GetMakro(Namn As String, yr As Integer, Optional typ As String = "Macro") As Double
'!-- Reading data from table T_DATA in Sesimrun.MDB
'! If no hit in the database the latest number is retained
On Error Resume Next
Dim rs As New ADODB.Recordset, cn As New ADODB.Connection
Dim SQL As String
SQL = "select * from T_Data where (Type='" & typ & "' AND Name='" & Namn & "' AND year=" & yr & ")"
rs.Open SQL, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sesimpath & "\source\sesim.mdb" _
& "; Persist Security Info=False"
f_GetMakro = rs![value]
End Function
'**** Note: Its faster write direct to a file witout open and close within the loop as in the procedure
' below
' Syntax: Print_to_file
' "filenamne"
' "{Y/N}" = "Y" if New file, "N" if append
' any number of variable names incl index within () or text strings
' within "", all comma separated
' Example: Print_to_file "valid_pens.txt", "N", i, year, i_age(i), i_sex(i)
' Examples also in procedure "Pension_debugging_files" in this module
Sub Print_to_file(filn As String, Clear As String, ParamArray var() As Variant)
'!-- General procedure for printing of text or variables to a file
Dim demofile As Integer
Dim x As Variant
Dim utvar As String
demofile = FreeFile
If Clear = "Y" Then
Open sesimpath & "\" & filn For Output As #demofile
Else
Open sesimpath & "\" & filn For Append As #demofile
End If
For Each x In var
utvar = utvar & CStr(x) & Chr$(9)
Next x
Print #demofile, utvar
Close #demofile
End Sub
Public Function f_Concat_string(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string = f_Concat_string & CStr(x) & Chr$(9)
Next x
End Function
Public Function f_Concat_string_space(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string_space = f_Concat_string_space & CStr(round(x, 5)) & Chr$(32)
Next x
End Function
Public Function f_Concat_string_comma(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string_comma = f_Concat_string_comma & CStr(x) & Chr$(44)
Next x
End Function
Public Function f_Concat_string_cita(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string_cita = f_Concat_string_cita & Chr$(34) & CStr(x) & Chr$(34) & Chr$(32)
Next x
End Function
Public Function f_pens_bas(program As String) As Double
'! -- Choice of basic amount definition for different pension programs and years
Select Case year
Case Is >= 2003
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp_income
Case "OP"
f_pens_bas = m_basbelopp_income
Case "IP"
f_pens_bas = m_basbelopp_income
Case "GP" '-- Optional choce of income indexation in Control Center - Parameters
' If income indexation wanted set m_ap_gp_Inkindex_On On=1 for actual years
f_pens_bas = m_basbelopp_gp
Case Else
f_pens_bas = 0
End Select
Case 1997 To 1998 '-- Minskat basbelopp tom 1998
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp * 0.98
Case "OP"
f_pens_bas = m_basbelopp * 0.98
Case "FP"
f_pens_bas = m_basbelopp * 0.98
Case "PTS"
f_pens_bas = m_basbelopp * 0.98
Case Else
f_pens_bas = 0
End Select
Case 1999 To 2001
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp
Case "OP"
f_pens_bas = m_basbelopp
Case "FP"
f_pens_bas = m_basbelopp
Case "PTS"
f_pens_bas = m_basbelopp
Case Else
f_pens_bas = 0
End Select
Case 2002
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp_income
Case "OP"
f_pens_bas = m_basbelopp_income
Case "FP"
f_pens_bas = m_basbelopp
Case "PTS"
f_pens_bas = m_basbelopp
Case Else
f_pens_bas = 0
End Select
End Select
End Function
'-- Calculation of some macro variables for reporting
Public Sub Calculate_Macro()
Dim Bef(1 To 6) As Double, p(1 To 6) As Double, status(1 To 9) As Long
Dim Bef_Status_Sex() As Long, maxyear As Integer
Dim i As Long, j As Long, s As Long
Dim Bef5(1 To 22) As Long, Bef5_M(1 To 22) As Long, Bef5_K(1 To 22) As Long
Dim AK5(1 To 22) As Long, AK5_M(1 To 22) As Long, AK5_K(1 To 22) As Long
Dim AL5(1 To 22) As Long, AL5_M(1 To 22) As Long, AL5_K(1 To 22) As Long
Dim akbef1664_p As Double, al1664_p As Double, aptot_p As Double, apsys_p As Double
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
'!-- Calculation and aggregation of some macro variables
Printdok " Calculate_Macro"
m_inc_earning = L_SUMVEC(i_inc_earning(1), m_icount) * m_weight
m_arbavg = L_SUMVEC(i_arbavg(1), m_icount) * m_weight ' m_arbavg_p * m_inc_earning
m_arbavg_pens = L_SUMVEC(i_arbavg_pens(1), m_icount) * m_weight ' m_arbavg_pens_p * m_inc_earning
m_arbavg_ovr = m_arbavg - m_arbavg_pens
m_pr_op = (L_SUMVEC(i_pr_op_ap(1), m_icount) + L_SUMVEC(i_pr_op_tp(1), m_icount)) * m_weight
m_arbavg_slon = m_arbavg_slon_p * m_pr_op
m_pgi_bas = L_SUMVEC(i_pgi_bas(1), m_icount) * m_weight
m_pgi_bas_n = cnt0(i_pgi_bas) * m_weight
m_pgi_bas_gt_basb = sumif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight
m_pgi_bas_gt_basb_n = cntif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight / 1000
'-- Participation rate etc.
ReDim Bef_Status_Sex(0 To 106, 1 To 9, 1 To 2) As Long
For i = 1 To m_icount
If i_abroad(i) = 0 Then
Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) = _
Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) + 1
End If
Next
For i = 0 To 106
For j = 1 To 8
Bef5_M(Int(i / 5) + 1) = Bef5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1)
Bef5_K(Int(i / 5) + 1) = Bef5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 2)
Bef5(Int(i / 5) + 1) = Bef5(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1) + _
Bef_Status_Sex(i, j, 2)
Next
AK5_M(Int(i / 5) + 1) = AK5_M(Int(i / 5) + 1) + _
Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1)
AK5_K(Int(i / 5) + 1) = AK5_K(Int(i / 5) + 1) + _
Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2)
AK5(Int(i / 5) + 1) = AK5(Int(i / 5) + 1) + _
Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) + _
Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2)
AL5_M(Int(i / 5) + 1) = AL5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 1)
AL5_K(Int(i / 5) + 1) = AL5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 2)
Next
For j = 1 To 9
For i = 0 To 106
status(j) = status(j) + Bef_Status_Sex(i, j, 1) + Bef_Status_Sex(i, j, 2)
Next
Next
m_BEFM0015 = 0
m_BEFK0015 = 0
m_BEFM1664 = 0
m_BEFK1664 = 0
m_BEFM65WW = 0
m_BEFK65WW = 0
Dim AK1664 As Long
For i = 0 To 15
For j = 1 To 8
m_BEFM0015 = m_BEFM0015 + Bef_Status_Sex(i, j, 1)
m_BEFK0015 = m_BEFK0015 + Bef_Status_Sex(i, j, 2)
Next
Next
For i = 16 To 64
AK1664 = AK1664 + Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) _
+ Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2)
For j = 1 To 8
m_BEFM1664 = m_BEFM1664 + Bef_Status_Sex(i, j, 1)
m_BEFK1664 = m_BEFK1664 + Bef_Status_Sex(i, j, 2)
Next
Next
For i = 65 To 106
For j = 1 To 8
m_BEFM65WW = m_BEFM65WW + Bef_Status_Sex(i, j, 1)
m_BEFK65WW = m_BEFK65WW + Bef_Status_Sex(i, j, 2)
Next
Next
'-- Definition of macrovariables for different agegroups
' Labour supply = Sesim status 5+6+8.
' Note: Persons in labour market programs out of labour force included
m_AKM1619 = (AK5_M(4)) * m_weight / 1000
m_AKK1619 = (AK5_K(4)) * m_weight / 1000
m_AKM2024 = (AK5_M(5)) * m_weight / 1000
m_AKK2024 = (AK5_K(5)) * m_weight / 1000
m_AKM2529 = (AK5_M(6)) * m_weight / 1000
m_AKK2529 = (AK5_K(6)) * m_weight / 1000
m_AKM3034 = (AK5_M(7)) * m_weight / 1000
m_AKK3034 = (AK5_K(7)) * m_weight / 1000
m_AKM3539 = (AK5_M(8)) * m_weight / 1000
m_AKK3539 = (AK5_K(8)) * m_weight / 1000
m_AKM4044 = (AK5_M(9)) * m_weight / 1000
m_AKK4044 = (AK5_K(9)) * m_weight / 1000
m_AKM4549 = (AK5_M(10)) * m_weight / 1000
m_AKK4549 = (AK5_K(10)) * m_weight / 1000
m_AKM5054 = (AK5_M(11)) * m_weight / 1000
m_AKK5054 = (AK5_K(11)) * m_weight / 1000
m_AKM5559 = (AK5_M(12)) * m_weight / 1000
m_AKK5559 = (AK5_K(12)) * m_weight / 1000
m_AKM6064 = (AK5_M(13)) * m_weight / 1000
m_AKK6064 = (AK5_K(13)) * m_weight / 1000
m_AKM6569 = (AK5_M(14)) * m_weight / 1000
m_AKK6569 = (AK5_K(14)) * m_weight / 1000
m_AKM7074 = (AK5_M(15)) * m_weight / 1000
m_AKK7074 = (AK5_K(15)) * m_weight / 1000
m_AKT1664 = AK1664 * m_weight / 1000
' -- Unemployed
m_ALM1619 = (AL5_M(4)) * m_weight / 1000
m_ALK1619 = (AL5_K(4)) * m_weight / 1000
m_ALM2024 = (AL5_M(5)) * m_weight / 1000
m_ALK2024 = (AL5_K(5)) * m_weight / 1000
m_ALM2529 = (AL5_M(6)) * m_weight / 1000
m_ALK2529 = (AL5_K(6)) * m_weight / 1000
m_ALM3034 = (AL5_M(7)) * m_weight / 1000
m_ALK3034 = (AL5_K(7)) * m_weight / 1000
m_ALM3539 = (AL5_M(8)) * m_weight / 1000
m_ALK3539 = (AL5_K(8)) * m_weight / 1000
m_ALM4044 = (AL5_M(9)) * m_weight / 1000
m_ALK4044 = (AL5_K(9)) * m_weight / 1000
m_ALM4549 = (AL5_M(10)) * m_weight / 1000
m_ALK4549 = (AL5_K(10)) * m_weight / 1000
m_ALM5054 = (AL5_M(11)) * m_weight / 1000
m_ALK5054 = (AL5_K(11)) * m_weight / 1000
m_ALM5559 = (AL5_M(12)) * m_weight / 1000
m_ALK5559 = (AL5_K(12)) * m_weight / 1000
m_ALM6064 = (AL5_M(13)) * m_weight / 1000
m_ALK6064 = (AL5_K(13)) * m_weight / 1000
m_ALM6569 = (AL5_M(14)) * m_weight / 1000
m_ALK6569 = (AL5_K(14)) * m_weight / 1000
m_ALM7074 = (AL5_M(15)) * m_weight / 1000
m_ALK7074 = (AL5_K(15)) * m_weight / 1000
' Population = Status 1 to 8. Not persons abroad.
m_BEFM0014 = (Bef5_M(1) + Bef5_M(2) + Bef5_M(3)) * m_weight / 1000
m_BEFK0014 = (Bef5_K(1) + Bef5_K(2) + Bef5_K(3)) * m_weight / 1000
m_BEFM0015 = m_BEFM0015 * m_weight / 1000
m_BEFK0015 = m_BEFK0015 * m_weight / 1000
m_BEFM1519 = (Bef5_M(4)) * m_weight / 1000
m_BEFK1519 = (Bef5_K(4)) * m_weight / 1000
m_BEFM1619 = (Bef5_M(4) - Bef_Status_Sex(15, 1, 1)) * m_weight / 1000
m_BEFK1619 = (Bef5_K(4) - Bef_Status_Sex(15, 1, 2)) * m_weight / 1000
m_BEFM2024 = Bef5_M(5) * m_weight / 1000
m_BEFK2024 = Bef5_K(5) * m_weight / 1000
m_BEFM2529 = (Bef5_M(6)) * m_weight / 1000
m_BEFK2529 = (Bef5_K(6)) * m_weight / 1000
m_BEFM3034 = (Bef5_M(7)) * m_weight / 1000
m_BEFK3034 = (Bef5_K(7)) * m_weight / 1000
m_BEFM3539 = (Bef5_M(8)) * m_weight / 1000
m_BEFK3539 = (Bef5_K(8)) * m_weight / 1000
m_BEFM4044 = (Bef5_M(9)) * m_weight / 1000
m_BEFK4044 = (Bef5_K(9)) * m_weight / 1000
m_BEFM4549 = (Bef5_M(10)) * m_weight / 1000
m_BEFK4549 = (Bef5_K(10)) * m_weight / 1000
m_BEFM5054 = (Bef5_M(11)) * m_weight / 1000
m_BEFK5054 = (Bef5_K(11)) * m_weight / 1000
m_BEFM5559 = (Bef5_M(12)) * m_weight / 1000
m_BEFK5559 = (Bef5_K(12)) * m_weight / 1000
m_BEFM6064 = (Bef5_M(13)) * m_weight / 1000
m_BEFK6064 = (Bef5_K(13)) * m_weight / 1000
m_BEFM6569 = (Bef5_M(14)) * m_weight / 1000
m_BEFK6569 = (Bef5_K(14)) * m_weight / 1000
m_BEFM7074 = (Bef5_M(15)) * m_weight / 1000
m_BEFK7074 = (Bef5_K(15)) * m_weight / 1000
m_BEFM1664 = m_BEFM1664 * m_weight / 1000
m_BEFK1664 = m_BEFK1664 * m_weight / 1000
m_BEFM65WW = m_BEFM65WW * m_weight / 1000
m_BEFK65WW = m_BEFK65WW * m_weight / 1000
'!-- Effective retirement age. (Ministry of Health and Social affairs definition)
For i = 1 To 6
p(i) = AK5(i + 9) / Bef5(i + 9)
Next
m_pensage = ((p(1) - p(2)) * 50 + (p(2) - p(3)) * 55 + (p(3) - p(4)) * 60 + _
(p(4) - p(5)) * 65 + (p(5) - p(6)) * 70 + p(6) * 72) / p(1)
'-- Labour market macro variables with labour market survey (AKU) definitions
'-- Reading data from assumptions file
akbef1664_p = parm_macro(maxyear, 16) / 100
al1664_p = parm_macro(maxyear, 17) / 100
aptot_p = parm_macro(maxyear, 18) / 100
apsys_p = parm_macro(maxyear, 19) / 100
' Fix if data is missing
' If akbef1664_p = 0 Then akbef1664_p = 0.78
' If al1664_p = 0 Then al1664_p = 0.04
' If aptot_p = 0 Then aptot_p = 0.02
' If apsys_p = 0 Then apsys_p = 0.004
If (al1664_p + aptot_p) > 0 Then
m_AAL1664 = ((al1664_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000
m_AAPTOT = ((aptot_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000
m_AAPSYS = ((apsys_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000
End If
m_ASY1664 = (status(5) + status(8) - (AK5(14) + AK5(15))) * (m_weight / 1000) + m_AAPSYS
m_AAK1664 = m_ASY1664 + m_AAL1664
'-- Reguljär sysselsättning 20-64 enligt målet
m_ASY2064R = 0
For i = 1 To m_icount
If i_age(i) >= 20 And i_age(i) < 65 And (i_status(i) = 5 Or i_status(i) = 8) Then
m_ASY2064R = m_ASY2064R + 1
End If
Next
m_ASY2064R = m_ASY2064R * (m_weight / 1000)
'-- Summering av stockar - sum of pension assets
' -- Public premium pension fund - Premiepensionsfonder
m_ap_ppfond = (m_ap_ppfond * (1 + (m_shares_return / 100)) * (1 - m_favg_pp)) + _
(((L_SUMVEC(i_pr_pp(1), m_icount) * m_weight) - m_ap_pp_ut) * (1 + (m_interest_short / 100) / 2))
' -- Occupational pension funds - Avtalspensionsfonder
m_op_fond = (m_op_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _
((L_SUMVEC(i_pr_op_ap(1), m_icount) - L_SUMVEC(i_op_ap_dc(1), m_icount) + _
L_SUMVEC(i_pr_op_tp(1), m_icount) - L_SUMVEC(i_op_ap_tp(1), m_icount)) * _
(1 + (m_interest_short * (1 - 0.15) / 100) / 2) * m_weight)
' -- Private tax deductible pension saving funds - Privat pensionssparande
' Note: 15 % tax (avkastningskatt) on return of pension capital (15% av statslåneräntan egentligen)
m_pp_fond = (m_pp_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _
((L_SUMVEC(i_wealth_pension_year(1), m_icount) - L_SUMVEC(i_pp(1), m_icount)) * _
(1 + ((m_interest_short * (1 - 0.15)) / 100) / 2) * m_weight)
'-- Summering av pensionsutgifter från AP-systemet
' If year >= 2003 Then
' m_ap_ip_ut = (L_SUMVEC(i_ap_ip(1), m_icount) * m_weight) _
' + (0.5 * m_ap_ip_dead)
' End If
'-- BNP etc
m_bnpaf = parm_macro(maxyear, 22)
m_bnpal = parm_macro(maxyear, 21)
End Sub
Sub Print_Pension_Cohort()
'-- Printing of cohort data for pensions
' age sex abroad variable
Dim pens(0 To 106, 2, 2, 15) As Double, pens_n(0 To 106, 2, 2, 15) As Double
Dim age As Integer, i As Long, utvar As String
Dim A As Integer, s As Integer, v As Integer, u As Integer
'-- Summing up
For i = 1 To m_icount
age = mini(i_age(i), 106)
'-- 1 PGI, 2 PGB, 3 PU, 4 PR_IP, 5 PB_IP, 6 AP_AP, 7 AP_TP, 8 AP_IP,
' 9 AP_GP, 10 PR_PP, 11 PB_PP, 12 AP_PP, 13 AP_AVG_AP
'-- 1 I_PGI
pens(age, i_sex(i), i_abroad(i) + 1, 1) = pens(age, i_sex(i), _
i_abroad(i) + 1, 1) + (i_pgi(i) * m_weight / 1000000)
If i_pgi(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 1) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 1) + m_weight
End If
'-- 2 I_PGB
pens(age, i_sex(i), i_abroad(i) + 1, 2) = pens(age, i_sex(i), _
i_abroad(i) + 1, 2) + (i_pgb(i) * m_weight / 1000000)
If i_pgb(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 2) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 2) + m_weight
End If
'-- 3 I_PU
pens(age, i_sex(i), i_abroad(i) + 1, 3) = pens(age, i_sex(i), _
i_abroad(i) + 1, 3) + (i_pu(i) * m_weight / 1000000)
If i_pu(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 3) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 3) + m_weight
End If
'-- 4 I_PR_IP
pens(age, i_sex(i), i_abroad(i) + 1, 4) = pens(age, i_sex(i), _
i_abroad(i) + 1, 4) + (i_pr_ip(i) * m_weight / 1000000)
If i_pr_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 4) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 4) + m_weight
End If
'-- 5 I_PB_IP
pens(age, i_sex(i), i_abroad(i) + 1, 5) = pens(age, i_sex(i), _
i_abroad(i) + 1, 5) + (i_pb_ip(i) * m_weight / 1000000)
If i_pb_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 5) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 5) + m_weight
End If
'-- 6 I_AP_AP
pens(age, i_sex(i), i_abroad(i) + 1, 6) = pens(age, i_sex(i), _
i_abroad(i) + 1, 6) + (i_ap_ap(i) * m_weight / 1000000)
If i_ap_ap(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 6) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 6) + m_weight
End If
'-- 7 I_AP_TP
pens(age, i_sex(i), i_abroad(i) + 1, 7) = pens(age, i_sex(i), _
i_abroad(i) + 1, 7) + (i_ap_tp(i) * m_weight / 1000000)
If i_ap_tp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 7) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 7) + m_weight
End If
'-- 8 I_AP_IP
pens(age, i_sex(i), i_abroad(i) + 1, 8) = pens(age, i_sex(i), _
i_abroad(i) + 1, 8) + (i_ap_ip(i) * m_weight / 1000000)
If i_ap_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 8) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 8) + m_weight
End If
'-- 9 I_AP_GP
pens(age, i_sex(i), i_abroad(i) + 1, 9) = pens(age, i_sex(i), _
i_abroad(i) + 1, 9) + (i_ap_gp(i) * m_weight / 1000000)
If i_ap_gp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 9) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 9) + m_weight
End If
'-- 10 I_PR_PP
pens(age, i_sex(i), i_abroad(i) + 1, 10) = pens(age, i_sex(i), _
i_abroad(i) + 1, 10) + (i_pr_pp(i) * m_weight / 1000000)
If i_pr_pp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 10) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 10) + m_weight
End If
'-- 11 I_PB_PP
pens(age, i_sex(i), i_abroad(i) + 1, 11) = pens(age, i_sex(i), _
i_abroad(i) + 1, 11) + (i_pb_pp(i) * m_weight / 1000000)
If i_pb_pp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 11) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 11) + m_weight
End If
'-- 12 I_AP_PP
pens(age, i_sex(i), i_abroad(i) + 1, 12) = pens(age, i_sex(i), _
i_abroad(i) + 1, 12) + (i_ap_pp(i) * m_weight / 1000000)
If i_ap_pp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 12) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 12) + m_weight
End If
'-- 13 I_AVG_IP
pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _
i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000)
If i_avg_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight
End If
'-- 13 I_AVG_IP
pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _
i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000)
If i_avg_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight
End If
'-- 14 I_PR_IP1
pens(age, i_sex(i), i_abroad(i) + 1, 14) = pens(age, i_sex(i), _
i_abroad(i) + 1, 14) + (i_pr_ip1(i) * m_weight / 1000000)
If i_pr_ip1(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 14) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 14) + m_weight
End If
'-- 15 I_PB_IP1
pens(age, i_sex(i), i_abroad(i) + 1, 15) = pens(age, i_sex(i), _
i_abroad(i) + 1, 15) + (i_pb_ip1(i) * m_weight / 1000000)
If i_pb_ip1(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 15) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 15) + m_weight
End If
Next
'-- Printing to file
If model_time = 1 Then
Open sesimpath & "\tempdata\Pension_Cohort.prn" For Output As #71
utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _
"PGI", "PGB", "PU", "PR_IP", "PB_IP", "AP_AP", "AP_TP", "AP_IP", _
"AP_GP", "PR_PP", "PB_PP", "AP_PP", "AP_AVG_AP", "PR_IP1", "PB_IP1", _
"Arvsv", "ap_favg", "balind", "inkind")
Print #71, utvar
Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Output As #72
utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _
"PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PB_IP_N", "AP_AP_N", "AP_TP_N", "AP_IP_N", _
"AP_GP_N", "PR_PP_N", "PB_PP_N", "AP_PP_N", "AP_AVG_AP_N""PR_IP1_N", "PB_IP1_N")
Print #72, utvar
Else
Open sesimpath & "\tempdata\Pension_Cohort.prn" For Append As #71
Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Append As #72
End If
For A = 0 To 106
For s = 1 To 2
For u = 1 To 2
utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _
pens(A, s, u, 1), pens(A, s, u, 2), pens(A, s, u, 3), pens(A, s, u, 4), _
pens(A, s, u, 5), pens(A, s, u, 6), pens(A, s, u, 7), pens(A, s, u, 8), _
pens(A, s, u, 9), pens(A, s, u, 10), pens(A, s, u, 11), pens(A, s, u, 12), _
pens(A, s, u, 13), pens(A, s, u, 14), pens(A, s, u, 15), _
Arvsvinstfaktor(A), m_favg_ip, m_ap_balind, m_ap_inkind)
Print #71, utvar
utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _
pens_n(A, s, u, 1), pens_n(A, s, u, 2), pens_n(A, s, u, 3), pens_n(A, s, u, 4), _
pens_n(A, s, u, 5), pens_n(A, s, u, 6), pens_n(A, s, u, 7), pens_n(A, s, u, 8), _
pens_n(A, s, u, 9), pens_n(A, s, u, 10), pens_n(A, s, u, 11), pens_n(A, s, u, 12), _
pens_n(A, s, u, 13), pens_n(A, s, u, 14), pens_n(A, s, u, 15))
Print #72, utvar
Next u
Next s
Next A
Close #71
Close #72
End Sub
Sub Print_Pensions_Macro()
'!-- Optional printing of macro variables to Aremos-format
status "Printing macro variables to Aremos-format"
Dim utvar As String
Dim demofile As Integer
Dim i As Long, h As Long, wm As Double, wk As Double
year = model_time + base_year
wm = m_weight / 1000000
wk = m_weight / 1000
'-- Some variables for EU AWG04-calculations that requires nested conditions
' Scaling when printing
Dim ap_ut As Double, ovr_pens As Double, ovr_pens_n As Long
Dim ap_inc_ut As Double, ap_inc_off_ut As Double, pr_op As Double, avg_off As Double
Dim ap_ut_n As Long, pens_n As Long, pens_54_n As Long, pens55_59_n As Long, pens60_64_n As Long, pens65_n As Long
Dim ap_inc_ut_n As Long, ap_inc_off_ut_n As Long, pr_op_n As Long, avg_off_n As Long
Dim afs As Double, afs_n As Long, inc_taxable_2 As Double, tax_income_2 As Double
Dim op_off As Double, op_off_n As Long, op_65 As Double, surv_65 As Double
For i = 1 To m_icount
If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i)) > 0 Then
ap_ut = ap_ut + (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i))
ap_ut_n = ap_ut_n + 1
End If
If (i_ap_ap(i) + i_ap_pp_ut(i)) > 0 Then
ap_inc_ut = ap_inc_ut + (i_ap_ap(i) + i_ap_pp_ut(i))
ap_inc_ut_n = ap_inc_ut_n + 1
If (i_sector(i) = 3 Or i_sector(i) = 4) Then
ap_inc_off_ut = ap_inc_off_ut + (i_ap_ap(i) + i_ap_pp_ut(i))
ap_inc_off_ut_n = ap_inc_off_ut_n + 1
End If
End If
If (i_ftp(i) + i_surv(i)) > 0 Then
ovr_pens = ovr_pens + i_ftp(i) + i_surv(i)
ovr_pens_n = ovr_pens_n + 1
End If
If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i) + i_ftp(i) + i_surv(i) + i_op(i)) > 0 Then
pens_n = pens_n + 1
Select Case i_age(i)
Case Is < 54
pens_54_n = pens_54_n + 1
Case Is < 59
pens55_59_n = pens55_59_n + 1
Case Is < 64
pens60_64_n = pens60_64_n + 1
Case Else
pens65_n = pens65_n + 1
End Select
End If
If (i_sector(i) = 3 Or i_sector(i) = 4) And i_avg(i) > 0 Then
avg_off = avg_off + i_avg(i)
avg_off_n = avg_off_n + 1
End If
If (i_sector(i) = 3 Or i_sector(i) = 4) Then
op_off = op_off + i_op(i)
op_off_n = op_off_n + 1
End If
If (i_pr_op_ap(i) + i_pr_op_tp(i)) > 0 Then
pr_op = pr_op + i_pr_op_ap(i) + i_pr_op_tp(i)
pr_op_n = pr_op_n + 1
End If
If i_age(i) > 64 Then
surv_65 = surv_65 + i_surv(i)
op_65 = op_65 + i_op(i)
End If
If i_status(i) = 2 Then
inc_taxable_2 = inc_taxable_2 + i_inc_taxable(i)
tax_income_2 = tax_income_2 + i_tax_income(i)
End If
Next
For h = 1 To m_hcount
If h_max_age(h) > 64 Then
afs = afs + h_trf_socialassistance(h)
afs_n = afs_n + 1
End If
Next
If model_time = 0 Then
Open sesimpath & "\tempdata\Labour_macro.prn" For Output As #41
utvar = f_Concat_string_cita("DATE", "AKT1664", "BEFM1664", "BEFK1664", _
"AKM1619", "AKM2024", "AKM2529", "AKM3034", "AKM3539", "AKM4044", "AKM4549", _
"AKM5054", "AKM5559", "AKM6064", "AKM6569", "AKM7074", _
"AKK1619", "AKK2024", "AKK2529", "AKK3034", "AKK3539", "AKK4044", "AKK4549", _
"AKK5054", "AKK5559", "AKK6064", "AKK6569", "AKM7074", _
"BEFM1619", "BEFM2024", "BEFM2529", "BEFM3034", "BEFM3539", "BEFM4044", "BEFM4549", _
"BEFM5054", "BEFM5559", "BEFM6064", "BEFM6569", "BEFM7074", _
"BEFK1619", "BEFK2024", "BEFK2529", "BEFK3034", "BEFK3539", "BEFK4044", "BEFK4549", _
"BEFK5054", "BEFK5559", "BEFK6064", "BEFK6569", "BEFM7074", _
"BEFM0015", "BEFK0015", "BEFM65WW", "BEFK65WW", _
"BEFM0014", "BEFK0014", "BEFM1519", "BEFK1519", _
"AAL1664", "AAPTOT", "AAPSYS", "ASY1664", "AAK1664", "ASY2064R", _
"ALM1619", "ALM2024", "ALM2529", "ALM3034", "ALM3539", "ALM4044", "ALM4549", _
"ALM5054", "ALM5559", "ALM6064", "ALM6569", "ALM7074", _
"ALK1619", "ALK2024", "ALK2529", "ALK3034", "ALK3539", "ALK4044", "ALK4549", _
"ALK5054", "ALK5559", "ALK6064", "ALK6569", "ALM7074")
Print #41, utvar
Open sesimpath & "\tempdata\Pensions_macro.prn" For Output As #42
utvar = f_Concat_string_cita("DATE", _
"INC_TAX", "PGI", "PGB", "PU", "PR_IP", "PR_PP", "PB_IP", "PB_PP", "FP", "ATP", "AP", _
"AP_IP", "AP_PP", "AP_GP", "AP_TP", "OP", "SURV", "FTP", "AVG_IP", "AVG", "INC_WORK", _
"INC_EARN", "INC_MARK", _
"RWAGE", "RWAGE_99", "INFLATION", "PRICE_99", "BASB", _
"BASB_F", "BASB_INC", "INKIND", "BALIND", "Int_short", "Int_long", _
"PENSAGE", "DTALIP_65", "DTALPP_65", "ARVSV_60", "Shares_Return", "PP", _
"AP_GP_EJ_AP", "AP_AP_SV", "AP_AP_UTL", "pgi_bas", "pgi_bas_gt", _
"PR_IP1", "PR_PP1", _
"AP_IP_UT", "AP_TP_UT", "AP_ATP_UT", "AP_FP30_UT", "AP_PP_UT", "EXPLIFE65", _
"PP_fund", "PP_save")
Print #42, utvar
Open sesimpath & "\tempdata\Pensions_count.prn" For Output As #43
utvar = f_Concat_string_cita("DATE", _
"INC_TAX_N", "PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PR_PP_N", "PB_IP_N", "PB_PP_N", _
"FP_N", "ATP_N", "AP_N", "AP_IP_N", "AP_PP_N", "AP_GP_N", "AP_TP_N", "OP_N", _
"SURV_N", "FTP_N", "AVG_IP_N", "AVG_N", "INC_WORK_N", "INC_EARN_N", "INC_MARK_N", "PP_N", _
"AP_GP_EJ_AP_N", "AP_AP_NSV", "AP_AP_NUTL", "pgi_bas_n", "pgi_bas_gt_n", "PP_fund_n", "PP_save_n")
Print #43, utvar
Open sesimpath & "\tempdata\Transfers_macro.prn" For Output As #44
utvar = f_Concat_string_cita("DATE", "STSHPEAVT", "STKHPEAVT", "ap", "atp", _
"tp", "ip", "ap_pp", "gp", "fp", "STSHFORT", "STSHEFTANK", "STSHEFTBARN", _
"STSHBTP", "STSHSJUK", "STSHFORF", "STSHARBSK", "unemployed", "STSHBARN", _
"study", "STSHSTUDMED", "Study_loan", "STSHBOBI", _
"bidfor_brutto", "STKHSOCBI", "PGI_BAS", "BNPAF", "BNPAL", "STSHBTP_65")
Print #44, utvar
Open sesimpath & "\tempdata\AWG04_macro.prn" For Output As #45
utvar = f_Concat_string_cita("DATE", "ap_ut", "ap_inc_ut", "ap_inc_off_ut", _
"ovr_pens", "avg_off", "pr_op", "ap_ut_n", "ap_inc_ut_n", "ap_inc_off_ut_n", "ovr_pens_n", _
"pens_n", "pens_54_n", "pens55_59_n", "pens60_64_n", "pens65_n", "avg_off_n", "pr_op_n", _
"AFS", "AFS_n", "inc_taxable_2", "tax_income_2", "ap_ppfond", "pp_fond", "op_fond", _
"op_off", "op_off_n", "surv_65", "op_65")
Print #45, utvar
Else
Open sesimpath & "\tempdata\Labour_macro.prn" For Append As #41
Open sesimpath & "\tempdata\Pensions_macro.prn" For Append As #42
Open sesimpath & "\tempdata\Pensions_count.prn" For Append As #43
Open sesimpath & "\tempdata\Transfers_macro.prn" For Append As #44
Open sesimpath & "\tempdata\AWG04_macro.prn" For Append As #45
End If
utvar = f_Concat_string_space(year & "01", m_AKT1664, m_BEFM1664, m_BEFK1664, _
m_AKM1619, m_AKM2024, m_AKM2529, m_AKM3034, m_AKM3539, m_AKM4044, m_AKM4549, _
m_AKM5054, m_AKM5559, m_AKM6064, m_AKM6569, m_AKM7074, _
m_AKK1619, m_AKK2024, m_AKK2529, m_AKK3034, m_AKK3539, m_AKK4044, m_AKK4549, _
m_AKK5054, m_AKK5559, m_AKK6064, m_AKK6569, m_AKM7074, _
m_BEFM1619, m_BEFM2024, m_BEFM2529, m_BEFM3034, m_BEFM3539, m_BEFM4044, m_BEFM4549, _
m_BEFM5054, m_BEFM5559, m_BEFM6064, m_BEFM6569, m_BEFM7074, _
m_BEFK1619, m_BEFK2024, m_BEFK2529, m_BEFK3034, m_BEFK3539, m_BEFK4044, m_BEFK4549, _
m_BEFK5054, m_BEFK5559, m_BEFK6064, m_BEFK6569, m_BEFM7074, _
m_BEFM0015, m_BEFK0015, m_BEFM65WW, m_BEFK65WW, _
m_BEFM0014, m_BEFK0014, m_BEFM1519, m_BEFK1519, _
m_AAL1664, m_AAPTOT, m_AAPSYS, m_ASY1664, m_AAK1664, m_ASY2064R, _
m_ALM1619, m_ALM2024, m_ALM2529, m_ALM3034, m_ALM3539, m_ALM4044, m_ALM4549, _
m_ALM5054, m_ALM5559, m_ALM6064, m_ALM6569, m_ALM7074, _
m_ALK1619, m_ALK2024, m_ALK2529, m_ALK3034, m_ALK3539, m_ALK4044, m_ALK4549, _
m_ALK5054, m_ALK5559, m_ALK6064, m_ALK6569, m_ALK7074)
Print #41, utvar
Close #41
utvar = f_Concat_string_space(year & "01", _
(L_SUMVEC(i_inc_taxable(1), m_icount) * wm), (L_SUMVEC(i_pgi(1), m_icount) * wm), _
(L_SUMVEC(i_pgb(1), m_icount) * wm), (L_SUMVEC(i_pu(1), m_icount) * wm), _
(L_SUMVEC(i_pr_ip(1), m_icount) * wm), (L_SUMVEC(i_pr_pp(1), m_icount) * wm), _
(L_SUMVEC(i_pb_ip(1), m_icount) * wm), (L_SUMVEC(i_pb_pp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _
(L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _
(L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_op(1), m_icount) * wm), _
(L_SUMVEC(i_surv(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _
(L_SUMVEC(i_avg_ip(1), m_icount) * wm), (L_SUMVEC(i_avg(1), m_icount) * wm), _
(L_SUMVEC(i_inc_work(1), m_icount) * wm), _
(L_SUMVEC(i_inc_earning(1), m_icount) * wm), (L_SUMVEC(i_inc_market(1), m_icount) * wm), _
m_realwage, m_realwage_change99, m_inflation, m_price_change99, m_basbelopp, _
m_basbelopp_f, m_basbelopp_income, m_ap_inkind, m_ap_balind, m_interest_short, m_interest_long, _
m_pensage, m_dtalip_65, m_dtalpp_65, m_arvsvinst_60, m_shares_return, (L_SUMVEC(i_pp(1), m_icount) * wm), _
(sumif(i_ap_gp, i_ap_ap, "EQ", 0) * wm), (sumif(i_ap_ap, i_abroad, "EQ", 0) * wm), _
(sumif(i_ap_ap, i_abroad, "EQ", 1) * wm), m_pgi_bas / 1000000, m_pgi_bas_gt_basb / 1000000, _
(L_SUMVEC(i_pr_ip1(1), m_icount) * wm), (L_SUMVEC(i_pr_pp1(1), m_icount) * wm), _
m_ap_ip_ut / 1000000, m_ap_tp_ut / 1000000, m_ap_atp_ut / 1000000, _
m_ap_fp30_ut / 1000000, m_ap_pp_ut / 1000000, explife(65), _
(L_SUMVEC(i_wealth_pension_total(1), m_icount) * wm), (L_SUMVEC(i_wealth_pension_year(1), m_icount) * wm))
Print #42, utvar
Close #42
utvar = f_Concat_string_space(year & "01", _
cnt0(i_inc_taxable) * wk, cnt0(i_pgi) * wk, _
cnt0(i_pgb) * wk, cnt0(i_pu) * wk, _
cnt0(i_pr_ip) * wk, cnt0(i_pr_pp) * wk, _
cnt0(i_pb_ip) * wk, cnt0(i_pb_pp) * wk, _
cnt0(i_ap_fp) * wk, cnt0(i_ap_atp) * wk, _
cnt0(i_ap) * wk, cnt0(i_ap_ip) * wk, _
cnt0(i_ap_pp) * wk, cnt0(i_ap_gp) * wk, _
cnt0(i_ap_tp) * wk, cnt0(i_op) * wk, _
cnt0(i_surv) * wk, cnt0(i_ftp) * wk, _
cnt0(i_avg_ip) * wk, cnt0(i_avg) * wk, _
cnt0(i_inc_work) * wk, _
cnt0(i_inc_earning) * wk, cnt0(i_inc_market) * wk, _
cnt0(i_pp) * wk, _
cntstatusif(i_ap_gp, i_ap_ap, "EQ", 0, 2) * wk, _
cntstatusif(i_ap_ap, i_abroad, "EQ", 0, 2) * wk, _
cntstatusif(i_ap_ap, i_abroad, "EQ", 1, 2) * wk, _
m_pgi_bas_n, m_pgi_bas_gt_basb_n, _
cnt0(i_wealth_pension_total) * wk, cnt0(i_wealth_pension_year) * wk)
Print #43, utvar
Close #43
utvar = f_Concat_string_space(year & "01", _
(sumif(i_op, i_sector, "EQ", 3) * wm), (sumif(i_op, i_sector, "EQ", 4) * wm), _
(L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _
(L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _
(sumif(i_surv, i_age, "GT", 17) * wm), (sumif(i_surv, i_age, "LT", 18) * wm), _
(L_SUMVEC(h_trf_btp(1), m_hcount) * wm), (L_SUMVEC(i_trf_sickleave(1), m_icount) * wm), _
(L_SUMVEC(i_trf_parentleave(1), m_icount) * wm), (L_SUMVEC(i_trf_skada(1), m_icount) * wm), _
(L_SUMVEC(i_trf_unemployed(1), m_icount) * wm), (L_SUMVEC(h_trf_childallowance(1), m_hcount) * wm), _
(L_SUMVEC(i_trf_study(1), m_icount) * wm), (L_SUMVEC(i_trf_study_grant(1), m_icount) * wm), _
(L_SUMVEC(i_trf_study_loan(1), m_icount) * wm), (L_SUMVEC(h_trf_housingallowance(1), m_hcount) * wm), _
(L_SUMVEC(h_maintenance_received(1), m_hcount) * wm), (L_SUMVEC(h_trf_socialassistance(1), m_hcount) * wm), _
(L_SUMVEC(i_pgi_bas(1), m_icount) * wm), m_bnpaf, m_bnpal, (sumif(h_trf_btp, i_age, "GT", 64) * wm))
Print #44, utvar
Close #44
utvar = f_Concat_string_space(year & "01", _
ap_ut * wm, ap_inc_ut * wm, ap_inc_off_ut * wm, ovr_pens * wm, avg_off * wm, pr_op * wm, _
ap_ut_n * wk, ap_inc_ut_n * wk, ap_inc_off_ut_n * wk, ovr_pens_n * wk, _
pens_n * wk, pens_54_n * wk, pens55_59_n * wk, pens60_64_n * wk, pens65_n * wk, _
avg_off_n * wk, pr_op_n * wk, afs * wm, afs_n * wk, inc_taxable_2 * wm, tax_income_2 * wm, _
m_ap_ppfond / 1000000, m_pp_fond / 1000000, m_op_fond / 1000000, op_off * wm, op_off_n * wk, _
surv_65 * wk, op_65 * wk)
Print #45, utvar
Close #45
End Sub
'-- Counts element i vector not equal 0
Public Function cnt0(x) As Long
Dim i As Long
cnt0 = 0
For i = 1 To UBound(x)
If x(i) <> 0 Then
cnt0 = cnt0 + 1
End If
Next
End Function
'-- Count number of persons in a status conditioned on an other vector
Public Function cntstatusif(x, ifvar, ifop, ifval, status) As Long
Dim i As Long
cntstatusif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) = ifval And i_status(i) = status Then
cntstatusif = cntstatusif + 1
End If
Next
Case "GT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) > ifval And i_status(i) = status Then
cntstatusif = cntstatusif + 1
End If
Next
Case "LT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) < ifval And i_status(i) = status Then
cntstatusif = cntstatusif + 1
End If
Next
End Select
End Function
'-- Sum of vector conditioned on an other vector
Public Function sumif(x, ifvar, ifop, ifval) As Double
Dim i As Long
sumif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If ifvar(i) = ifval Then
sumif = sumif + x(i)
End If
Next
Case "GT"
For i = 1 To UBound(x)
If ifvar(i) > ifval Then
sumif = sumif + x(i)
End If
Next
Case "LT"
For i = 1 To UBound(x)
If ifvar(i) < ifval Then
sumif = sumif + x(i)
End If
Next
Case "NE"
For i = 1 To UBound(x)
If ifvar(i) <> ifval Then
sumif = sumif + x(i)
End If
Next
End Select
End Function
Public Function f_m_ap_pensage() As Double
Dim n As Long, i As Long
n = 1
For i = 1 To m_icount
If i_status(i) = 2 And i_status1(i) <> 2 Then
f_m_ap_pensage = f_m_ap_pensage + i_ap_pensmonth(i)
n = n + 1
End If
Next
f_m_ap_pensage = Int(f_m_ap_pensage / 12) / n + 65
End Function
'-- Count number of persons conditioned on an other vector
Public Function cntif(x, ifvar, ifop, ifval) As Long
Dim i As Long
cntif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) = ifval Then
cntif = cntif + 1
End If
Next
Case "GT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) > ifval Then
cntif = cntif + 1
End If
Next
Case "LT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) < ifval Then
cntif = cntif + 1
End If
Next
End Select
End Function
Sub Print_elderly_care_micro()
'!-- Optional printing of data for analysis of elderly care(micro data)
status "Printing elderly care micro file"
Dim utvar As String
Dim demofile As Integer
Dim i As Long, h As Long
year = model_time + base_year
If year = 1999 Then
Open sesimpath & "\tempdata\i_elderly_micro.txt" For Output As #33
utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_hhnr", _
"i_age", "i_sex", "i_civ_stat", "i_abroad", "i_status", _
"i_edlevel", "i_born_year ", _
"i_inc_taxable", "i_inc_capital", "i_pc_elderly", "m_basbelopp", "m_basbelopp_income")
Print #33, utvar
Close #33
Open sesimpath & "\tempdata\h_elderly_micro.txt" For Output As #34
utvar = f_Concat_string_comma("h", "year", "h_hhnr", "h_size", "h_max_age", _
"h_inc_disposable", "h_wealth_financial", "h_wealth_real", _
"h_n_child", "h_n_adults", "h_house_cost")
Print #34, utvar
Close #34
End If
If year = 1999 Or year = 2003 Or year = 2015 Or year = 2025 Then
Open sesimpath & "\tempdata\i_elderly_micro.txt" For Append As #33
For i = 1 To m_icount
utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_hhnr(i), _
i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), i_status(i), _
i_edlevel(i), i_born_year(i), _
i_inc_taxable(i), i_inc_capital(i), i_pc_elderly(i), m_basbelopp, m_basbelopp_income)
Print #33, utvar
Next i
Close #33
Open sesimpath & "\tempdata\h_elderly_micro.txt" For Append As #34
For h = 1 To m_hcount
utvar = f_Concat_string_comma(h, year, h_hhnr(h), h_size(h), h_max_age(h), _
h_inc_disposable(h), h_wealth_financial(h), h_wealth_real(h), _
h_n_child(h), h_n_adults(h), h_house_cost(h))
Print #34, utvar
Next h
Close #34
End If 'year
End Sub
'*************************************************************************************
'*************************************************************************************
'*************************************************************************************
'*************************************************************************************
#Else ' End compilation of BabyBoom version
'******* a06_Pension_Rules - Calculates pension benefits, pension rights etc *******
' ----------------------------------------------------------
' -- Approximative mneumonics (in swenglish)
' i_{tt}_{ss}_{ee}
' tt = type of pension
' ss = program
' qq = qualifying part
' i_ap = ålderspension = old age pensions
' i_ftp = förtidspension = disabilty pensions
' i_op = avtalspension = occupational pensions
' i_surv = efterlevandepension = survivors pensions
' i_pi = private insurance
' i_pr_ = pensionsunderlag = pension rights
' i_pb_ = pensionsbehållning = cumulative pension rights
' i_{tt}_fp = folkpension = basic pension
' i_{tt}_atp = ATP = national supplemental pension
' i_{tt}_fp = folkpension = national basic pension
' i_{tt}_ip = inkomstpension
' i_{tt}_gp = garantipension
' i_{tt}_tp = reformerad ATP = reformed supplemental pe
' i_{tt}_pp = national premium pension
' i_{tt}_ap = other old age pension
' i_{tt}_pts = PTS = basic pension supplement
' barn
' ank
' f_ = prefix indicating function
' ----------------------------------------------------------
Option Explicit
Option Base 1
'Private f_utfasning_ATP As Double
Public z_ap_atp As Double
Private year As Integer
Dim pnames(100) As String
Dim pvalues(100) As Variant
Public Sub Calculate_Disability_Pension(i As Long)
'! Calculation of disability pension benefits
'*** EGENTLIGEN SKA FÖRÄLDRAR TILL FÖRTIDSPENSIONÄRER YNGRE ÄN 19 HA VÅRDBIDRAG
Dim ftp_antag_p As Double ' Pensionsrätt för förtidspensionärer, antagandepoäng
Dim ftp_antag_p1 As Double ' do hjälpvariabel
Dim ftp_antag_p2 As Double ' do hjälpvariabel
Dim pp4(4) As Double ' do hjälpvariabel Vektor med senaste 4 årens pensionspoäng
Dim n As Long, y As Long ' do hjälpvariabel
Dim antag_bo_tid As Long ' Antagen bosättningstid (qualifying years for disabled)
Dim bokvot As Double ' Bosättningstidskvot
Dim ftp_pts_kvot As Double ' Parameter för beräkning av PTS för förtidpens och sjukbidrag
Dim ftp_fp_kvot_gifta As Double ' Parameter vid beräkning av folkpension, gifta
Dim ftp_fp_kvot_ogifta As Double ' Parameter vid beräkning av folkpension, ogifta
ftp_pts_kvot = 1.129 ' *** Kan ligga i parameterfil
ftp_fp_kvot_gifta = 0.725 ' *** Kan ligga i parameterfil
ftp_fp_kvot_ogifta = 0.9 ' *** Kan ligga i parameterfil
year = model_time + base_year
' -- Calculate & updates qualifying points antagandepoäng / antagandeinkomst
If i_status1(i) <> 4 Or (i_status1(i) = 4 And i_age(i) = 19) Then ' New Disability pensioner
If year < 2003 Then '-- Old system
' Villkor: Antingen ATP-poäng för minst 2 av de 4 åren närmast föregående pensionsfallet
' eller SGI > basb samt minst 1 historisk ATP-poäng
If pp_hist(i).n_years >= 4 Then
n = 0
For y = pp_hist(i).n_years - 3 To pp_hist(i).n_years
If pp_hist(i).pp_years(y) >= year - 4 Then
pp4(n + 1) = pp_hist(i).pp(y)
n = n + 1
End If
Next
End If
' -- Förvärvsvillkor
If (i_inc_taxable(i) >= m_basbelopp And pp_hist(i).n_years > 0) Or n >= 2 Then
' Alt 1: Average of ATP-points: The 2 best years of the last 4
If pp_hist(i).n_years >= 4 Then
Select Case n
Case Is > 1 ' -- Snitt av två bästa
Call Sort(pp4, True)
ftp_antag_p1 = (pp4(1) + pp4(2)) / 2
Case 1 ' -- Om endast 1 år 50% av detta
ftp_antag_p1 = pp4(1) / 2
Case 0 ' -- Det kan hända att inget av åren var nära i tiden
ftp_antag_p1 = 0
End Select
End If
' Alt 2: Medeltalet av bästa hälften av alla
Dim pp_sort() As Integer ' -- Kopierar vektorn för sortering
pp_sort = pp_hist(i).pp
Call Sort(pp_sort, True)
ftp_antag_p2 = 0
If pp_hist(i).n_years > 1 Then
For y = 1 To Int((pp_hist(i).n_years / 2) + 0.5)
ftp_antag_p2 = ftp_antag_p2 + pp_sort(y) '****pp_hist(i).pp(y)
Next
ftp_antag_p2 = ftp_antag_p2 / Int((pp_hist(i).n_years / 2) + 0.5)
Else
ftp_antag_p2 = pp_sort(1)
End If
' -- Choosing best alternative for the disabled
ftp_antag_p = maxi(ftp_antag_p1, ftp_antag_p2)
'-- Updating pension history pensionspoängsvektorn
Call Update_pp_hist(i, CInt(ftp_antag_p))
'-- Calculating qualifying income in SEK
i_ftp_antag(i) = ((ftp_antag_p / 100) + 1) * m_basbelopp_f
End If
Else '-- New system from 2003
'Qualifying points in new system
If i_pgi(i) > 0 Or pp_hist(i).n_years > 0 Then '-- Right to income based disab pens if 1 or more PGI-years
i_ftp_antag(i) = f_qualif_inc(i)
'-- Updating pension history pensionspoängsvektorn
' LÄGGER TILL VILLKOR SÅ ATT PP-VEKTORN ENDAST UPPDATERAS MED VÄRDEN STÖRRE ÄN 1 BASBELOPP
If (i_ftp_antag(i) - m_basbelopp_f) > 0 Then
Call Update_pp_hist(i, CInt(((i_ftp_antag(i) - m_basbelopp_f) / m_basbelopp_f) * 100))
End If
End If 'pgi
End If ' year < 2003
Else '-- This individual was disabled last year
' -- Only disability pensioners with qualifying points
If pp_hist(i).n_years > 0 Then
' -- Disab pensioner last year, gets same pensionrights as last year
If m_ftp_Inkindex_On = 0 Then '-- Optional income indexation of paid out disability pensions
ftp_antag_p = pp_hist(i).pp(pp_hist(i).n_years)
i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f)
Else
'-- Antagandeinkomsten assumed income indexed
ftp_antag_p = (((((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1)) * _
((m_ap_inkind / m_ap_inkind1) - (m_KPI - 1))) - 1) * 100
i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f)
End If
Call Update_pp_hist(i, CInt(ftp_antag_p))
End If
End If '-- i_status1(i) <> 4
' -- Calculate benefits with price-correction
If year < 2004 Then
' -- ATP
If pp_hist(i).n_years > 0 Then
i_ftp_atp(i) = 0.6 * (pp_hist(i).pp(pp_hist(i).n_years) / 100) _
* m_basbelopp * mini(1, (pp_hist(i).n_years + (65 - i_age(i)) / 30))
End If
' -- Folkpension & PTS
antag_bo_tid = i_botid(i) + (65 - i_age(i)) * _
mini(1, i_botid(i) / 0.8 * (maxi(i_age(i), 17) - 16))
bokvot = maxi(mini(1, antag_bo_tid / 40), mini(1, pp_hist(i).n_years / 30))
If antag_bo_tid >= 3 Then ' -- Minst 3 bosättningsår krävs f folkpen & PTS
' -- Folkpension
If i_civ_stat(i) = 0 Then
i_ftp_fp(i) = ftp_fp_kvot_ogifta * m_basbelopp * bokvot
Else
i_ftp_fp(i) = ftp_fp_kvot_gifta * m_basbelopp * bokvot
End If
' -- PTS
i_ftp_pts(i) = bokvot * maxi((ftp_pts_kvot * m_basbelopp) - i_ftp_atp(i), 0)
Else
i_ftp_fp(i) = 0
i_ftp_pts(i) = 0
End If
i_ftp(i) = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
End If
'-- New disabbility pension system after 2002
If year >= 2003 Then
If i_age(i) >= 19 Then
If i_age(i) = 19 Or (i_status1(i) <> 4 And i_age(i) < 30) Then
i_ftp_typ(i) = 1
ElseIf i_ftp_typ(i) = 1 And i_age(i) >= 30 Then
End If
If i_ftp_typ(i) = 1 And i_age(i) >= 30 Then
i_ftp_typ(i) = 0
End If
'-- Income related part
i_ftp_ink(i) = 0.64 * i_ftp_antag(i) '-- i_ftp_antag optionally income indexed, see above
i_ftp_just(i) = (i_ftp_just(i) / m_basbelopp1) * m_basbelopp '** No income indexation: Transitional
'-- Guaranteed level (Rules on limit on insurance time not implemented
' m_ftp_Inkindex_On = 0 0> m_basbelopp_ftp = m_basbelopp, else income indexed
i_ftp_gar(i) = maxi(0, (f_disab_guarantee(i_age(i)) * m_basbelopp_ftp * _
mini(1, (i_botid(i) + (65 - i_age(i))) / 40)) - i_ftp_ink(i))
i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up
Else
i_ftp(i) = 0
i_ftp_ink(i) = 0
i_ftp_gar(i) = 0
i_ftp_just(i) = 0
End If
End If
'-- Transition rules: Recalculation of old disab pension rights
Dim omv_bruttoers As Long
Dim fakt_bruttoers As Long
Dim SGA_bel As Long
Dim ber_gar As Long
If year = 2003 And i_status1(i) = 4 Then '-- Only for old disablity pensioners
If i_age(i) >= 19 Then
fakt_bruttoers = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
SGA_bel = maxi(0, (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _
(f_SGA_2002(fakt_bruttoers, i_civ_stat(i), m_basbelopp) - _
f_basic_deduction_2002(fakt_bruttoers, m_basbelopp)))
omv_bruttoers = fakt_bruttoers + SGA_bel
ber_gar = (omv_bruttoers - (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _
(f_basic_deduction_2002(omv_bruttoers, m_basbelopp) - _
f_basic_deduction_2002(fakt_bruttoers, m_basbelopp))) _
- i_ftp_ink(i)
i_ftp_just(i) = maxi(0, ber_gar - i_ftp_gar(i)) '-- Not negative
'i_ftp_just(i) = ber_gar - i_ftp_gar(i)
i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up
Else
i_ftp(i) = 0
i_ftp_ink(i) = 0
i_ftp_gar(i) = 0
i_ftp_just(i) = 0
End If
End If
'-- New system replaces old benefits 2003
If year = 2003 Then
i_ftp_atp(i) = 0
i_ftp_fp(i) = 0
i_ftp_pts(i) = 0
End If
End Sub
'****** EJ KLAR!! ARBETAR MED DENNA PROCEDUR *****
Public Sub Calculate_Work_Injuries()
Dim i As Long
For i = 1 To m_icount
If i_trf_skada(i) > 0 Then
If i_age(i) >= 65 Then
i_trf_skada(i) = 0
Else 'Indexation
i_trf_skada(i) = i_trf_skada(i)
End If
End If
Next i
End Sub
Public Function f_local_taxrate(idx As Long, year)
'!-- Local tax rate for different years
Select Case year
Case Is >= 2006
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt06 / 100
Case 1999
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt99 / 100
Case 2000
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt00 / 100 'satserna efter 99 betydligt lägre ??
Case 2001 ' ThP beror kanske på kyrkoavgiften??
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt01 / 100
Case 2002
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt02 / 100
Case 2003
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt03 / 100
Case 2004
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt04 / 100
Case 2005
f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt05 / 100
End Select
End Function
Public Function f_ramtid(age As Byte) As Byte
'!-- Qualifying time in new disability pension system
Select Case age
Case Is < 47
f_ramtid = 8
Case Is < 50
f_ramtid = 7
Case Is < 53
f_ramtid = 6
Case Is >= 53
f_ramtid = 5
End Select
End Function
'-- Antagandeinkomst from 2003 enligt lag 1963:381 "Om antagandeinkomst"
' Funktionen bortser från specialregler i 8§ om aktivitetsersättningen
Public Function f_qualif_inc(idx As Long) As Long
'!-- Disablity pensions qualifying income from 2003
Dim i As Integer
Dim n As Integer
Dim inc_average As Long
Dim inc(1 To 8) As Double
Dim ramtid As Byte
inc(1) = i_inc_taxable1(idx) * 1.07 / m_basbelopp1
inc(2) = i_inc_taxable2(idx) * 1.07 / m_basbelopp2
inc(3) = i_inc_taxable3(idx) * 1.07 / m_basbelopp3
inc(4) = i_inc_taxable4(idx) * 1.07 / m_basbelopp4
inc(5) = i_inc_taxable5(idx) * 1.07 / m_basbelopp5
'-- Note: pp_hist truncated for incomes from 0 to 1 basic amount
Select Case pp_hist(idx).n_years
Case Is > 7
inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07
inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07
inc(8) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 7) / 100) + 1) * 1.07
Case 7
inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07
inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07
inc(8) = 0
Case 6
inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07
inc(7) = 0
inc(8) = 0
Case Else
inc(6) = 0
inc(7) = 0
inc(8) = 0
End Select
'-- Truncation at 7.5 basic amounts
For n = 1 To 5
inc(n) = mini(7.5, inc(n))
Next
'sortera inc 1 to f_ramtid(i_age(idx) till inc_sort
ramtid = f_ramtid(i_age(idx))
ReDim inc_sort(1 To ramtid) As Double ' -- Kopierar vektorn för sortering
For n = 1 To ramtid
inc_sort(n) = inc(n)
Next
Call Sort(inc_sort, True)
f_qualif_inc = ((inc_sort(1) + inc_sort(2) + inc_sort(3)) / 3) * m_basbelopp
' **** NOT IMPLEMENTED ****
'-- Lite andra villkor för aktivitetsers
' If i_age(idx) < 30 Then
' Select Case n
' Case 1
' Case 2
' Case 3
' End Select
' End If
End Function
Public Function f_disab_guarantee(age As Byte) As Double
'!-- Calculates guaranteed level in basic amounts in new disability pensions system
Select Case age
Case Is >= 30
f_disab_guarantee = 2.4
Case Is < 21
f_disab_guarantee = 2.1
Case Is < 23
f_disab_guarantee = 2.15
Case Is < 25
f_disab_guarantee = 2.2
Case Is < 27
f_disab_guarantee = 2.25
Case Is < 29
f_disab_guarantee = 2.3
Case 29
f_disab_guarantee = 2.35
End Select
End Function
Public Function f_SGA_2002(ink As Long, civ_stat As Byte, basbelopp As Long) As Double
'!-- Särskilt grundavdrag 2002 (Bygger på a05 f_basic_deduction)
'! Used for calculation of transition to new disability pension system
Dim sga As Double
Dim sgae As Double
Dim sgag As Double
Dim sgaproc As Double
Dim sgamax As Double
Dim sgared As Double
sgae = 1.5749 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS
sgag = 1.3969 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS
sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDRAG
'REDUCERING
If civ_stat = 0 Then
sgamax = sgae 'Ogift
Else
sgamax = sgag 'Gift
End If
sgared = sgaproc * maxi(ink - sgamax, 0)
sgared = maxi(sgamax - sgared, 0)
f_SGA_2002 = round(sgared, -2)
If f_SGA_2002 > ink Then f_SGA_2002 = ink
End Function
Public Function f_basic_deduction_2002(ink, basbelopp As Long) As Double
'!-- Basic deduction 2002 (Bygger på a05 f_basic_deduction)
Dim g As Double
Dim i As Integer
Dim limits(1 To 9) As Double
Dim lutning(1 To 8) As Double
Dim xgr As Double
limits(1) = 0
limits(2) = 0.293 * basbelopp
limits(3) = 1.86 * basbelopp
limits(4) = 2.89 * basbelopp
limits(5) = 3.04 * basbelopp
limits(6) = 9E+99 * basbelopp
limits(7) = 0
limits(8) = 0
limits(9) = 0
lutning(1) = 1
lutning(2) = 0
lutning(3) = 0.25
lutning(4) = 0
lutning(5) = -0.1
lutning(6) = 0
lutning(7) = 0
lutning(8) = 0
xgr = Int((0.293 * basbelopp + 99) / 100) * 100 ' LÄGSTA GRUNDAVDRAG
g = 0
i = LBound(limits) + 1
Do Until ink <= limits(i)
If ink > limits(i) Then g = g + (limits(i) - limits(i - 1)) * lutning(i - 1)
i = i + 1
Loop
g = g + (ink - limits(i - 1)) * lutning(i - 1)
If g < limits(LBound(limits) + 1) Then g = limits(LBound(limits) + 1)
If ink > xgr Then g = maxi(xgr, g)
If base_year + model_time < 2001 Then
g = Int(g / 100) * 100
Else
g = Int((g + 99.9) / 100) * 100
End If
'JÄMFÖRELSE MED G
' If g > sga Then sga = g
' g = 0
' If sga > ink Then sga = ink
'
' End If
'
' f_basic_deduction = g + sga
f_basic_deduction_2002 = g
End Function
'-- Calculation of survivors pension Efterlevandepensioner
' Call from x03_Service - delete_individuals whenever a cohabiting person dies
' Only calculation of widow and children pensions currently
' Se also procedure Update_Survivors_pension in this module
'**** Only calc of aggregate i_surv, not divided in i_surv_atp and i_surv_fp now
'**** Som det är nu är endast en schablonregel med ett basb per änke och barnpens med
' 1 stämmer ungefär för 2005.
'**** Egentligen ska man ha 90% av basb+PTS 62,9% (bökiga reglöer f inkomstprövning)
' 40% av mannens ATP, 35% om det finns barn, 15% f 1:a barnet, 10% f ytterligare barn
' (fördelas lika mellan barnen)
Public Sub Calculate_Survivors_pension(i As Long)
'!-- Calculation of survivors pension Efterlevandepensioner
Dim surv_nr As Long 'Indexnr for survivor
'Dim child_nr As Long 'Indexnr for surviving child
Dim civ_stat_dat As Integer
Dim widow_base_atp As Double, child_base_atp As Double, widow_base_fp As Double
Dim child_base_fp As Double, surv_base_omst As Double
Dim basbelopp As Long
surv_nr = i_indnr(i)
civ_stat_dat = h_form_year(hhnr2index(i_hhnr(i))) 'Household formation year
'-- Koefficienter hämtade f RFV:s budgetunderlag år 2001
' PTS modelleras ej - FP-koeff avser såväl FP som PTS
widow_base_atp = 0.877 '>=18 år **** Provisoriskt: Senare ordentlig beräkning
child_base_atp = 0.635 '<18 år **** Provisoriskt: -"-
widow_base_fp = 0.678 '>=18 år & <65 år inkl PTS **** Provisoriskt: Senare ordentlig beräkning
child_base_fp = 0.282 '<18 år **** Provisoriskt: -"-
surv_base_omst = 1.22 ' Samma f omst o förlängd omst pens
' Note: Indexation in Update_Survivors_pension, even the first year
If year < 2001 Then ' therefore back-indexation here
basbelopp = m_basbelopp_f / m_KPI1
Else
basbelopp = m_basbelopp_income * (m_ap_inkind1 / m_ap_inkind)
End If
'-- Widow's pension Övergångsvis änkepension TP
'If i_sex(i) = 1 And h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if the husband dies
If h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if more than one person in household
'Searching for survivors indexnr
surv_nr = h_first_indnr(hhnr2index(i_hhnr(i)))
Do Until (i_bvux(indnr2index(surv_nr)) = 1 And i_sex(indnr2index(surv_nr)) <> i_sex(i)) Or surv_nr = 0
surv_nr = i_next_indnr(indnr2index(surv_nr))
Loop
'-- Widows pension
If i_sex(i) = 1 And surv_nr <> 0 And civ_stat_dat < 1990 And civ_stat_dat > 0 Then 'Only to widows married before 1990
i_surv_atp(indnr2index(surv_nr)) = widow_base_atp * basbelopp
If i_age(indnr2index(surv_nr)) < 65 Then
i_surv_fp(indnr2index(surv_nr)) = widow_base_fp * basbelopp
Else
i_surv_fp(indnr2index(surv_nr)) = 0
End If
i_surv_year(indnr2index(surv_nr)) = model_time + base_year
i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _
i_surv_atp(indnr2index(surv_nr))
'-- Transitional survivors pension
ElseIf i_age(indnr2index(surv_nr)) < 65 And i_age(indnr2index(surv_nr)) > 17 Then
i_surv_omst(indnr2index(surv_nr)) = surv_base_omst * basbelopp
i_surv_year(indnr2index(surv_nr)) = model_time + base_year
i_surv(indnr2index(surv_nr)) = i_surv_omst(indnr2index(surv_nr))
Else
i_surv_atp(indnr2index(surv_nr)) = 0
i_surv_fp(indnr2index(surv_nr)) = 0
i_surv(indnr2index(surv_nr)) = 0
End If
Else
i_surv_atp(indnr2index(surv_nr)) = 0
i_surv_fp(indnr2index(surv_nr)) = 0
i_surv(indnr2index(surv_nr)) = 0
End If
'-- Childrens pension
' Only if parents with children in household dies
If i_bvux(i) = 1 And h_n_child(hhnr2index(i_hhnr(i))) > 0 Then
'Searching for childrens indexnr
surv_nr = h_first_indnr(hhnr2index(i_hhnr(i)))
Do Until surv_nr = 0
If i_age(indnr2index(surv_nr)) < 18 Then
i_surv_year(indnr2index(surv_nr)) = model_time + base_year
i_surv_atp(indnr2index(surv_nr)) = child_base_atp * basbelopp
i_surv_fp(indnr2index(surv_nr)) = child_base_fp * basbelopp
i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _
i_surv_atp(indnr2index(surv_nr))
End If
surv_nr = i_next_indnr(indnr2index(surv_nr))
Loop
' Else
' i_surv_atp(indnr2index(surv_nr)) = 0
' i_surv_fp(indnr2index(surv_nr)) = 0
' i_surv(indnr2index(surv_nr)) = 0
End If
End Sub
Public Sub Update_Survivors_pension(i As Long)
'!-- Yearly updating of previously calculated survivors pensiona Efterlevandepensioner
If i_surv(i) > 0 Then
If i_age(i) = 18 Then '-- Barnpension upphör då man blir 18
i_surv_fp(i) = 0
i_surv_atp(i) = 0
' i_surv(i) = 0
End If
' Änkor antas avstå från att gifta om sig formellt
' If i_civ_stat(i) = 1 Then '-- Rätt till änkepension upphör om man gifter sig
' i_surv_fp(i) = 0
' i_surv_atp(i) = 0
' i_surv(i) = 0
' End If
If i_status(i) = 2 Then '-- Folkpensionsdelen av änkepension upphör vid ålderpensionen
i_surv_fp(i) = 0
' i_surv(i) = i_surv_atp(i)
End If
'Transitional survivors pension
If i_surv_omst(i) > 0 Then
If (i_surv_year(i) = model_time + base_year) Or (i_surv_year(i) = model_time + base_year - 1 _
And h_n_child(hhnr2index(i_hhnr(i))) > 0) Or _
h_n_childlt12(hhnr2index(i_hhnr(i))) > 0 Then
i_surv_omst(i) = i_surv_omst(i) * f_pens_index("ATP", 65)
Else
i_surv_omst(i) = 0
End If
End If
' Indexering
i_surv_fp(i) = i_surv_fp(i) * f_pens_index("ATP", 65)
i_surv_atp(i) = i_surv_atp(i) * f_pens_index("ATP", 65)
i_surv(i) = i_surv_fp(i) + i_surv_atp(i) + i_surv_omst(i)
End If
End Sub
'-- Defined benefit occupational pensions
Public Function f_Occupational_DB_pension_benefits(i As Long, Sector As Byte, pensmonth As Integer)
Dim op_ap_db As Long
Select Case Sector
Case 1 '-- Blue collar
'-- Defined benefit part STP (Transitional rule)
If i_status1(i) <> 2 Then '-- New pensioner
If i_born_year(i) >= 1932 And i_born_year(i) < 1968 Then
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
10, 10, 10, mini(1, (f_pp_years(i, 1995) / 37)))
Else
op_ap_db = 0
End If
Else '-- Retired last year: Indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
Case 2 '-- White collar
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30))
Else '-- Retired last year: Indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
Case 3 '-- State
'-- Part-time pension agreement from age 61 to 65
If i_status1(i) <> 2 And i_age(i) >= 61 And i_age(i) < 65 And i_work_share(i) > 0 Then
op_ap_db = f_avg_income(i) * 0.6 * (1 - i_work_share(i))
Else '-- Normal occup pens
'-- Defined benefit part
If (i_status1(i) <> 2) Or _
(i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner
Select Case year
Case Is > 2002
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
f_op_pa03(i_born_year(i), 1), _
f_op_pa03(i_born_year(i), 2), _
f_op_pa03(i_born_year(i), 3), mini(1, i_op_pp_years(i) / 30))
Case Else
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
10, 65, 32.5, mini(1, i_op_pp_years(i) / 30))
End Select
Else '-- Retired last year
If i_work_share(i) > 0 Then '-- Correction for changed work-time
op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i))
End If
'-- Indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
End If
Case 4 '-- Local government
'-- Defined benefit part
If (i_status1(i) <> 2) Then '-- New pensioner
op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _
0, 62.5, 31.25, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0.004, 0.004)
'-- Simplified transitional rule PA-KL
' Note: Extra 10% compens level below social insur ceiling
' corrected for actual work experience 1997
If i_born_year(i) < 1969 And i_born_year(i) > 1933 Then
op_ap_db = op_ap_db + _
f_op_db_comp(i_avg_income_1997(i) * m_basbelopp / 100, _
f_pens_bas("OP"), 10, 0, 0, _
mini(1, f_pp_years(i, 1997) / 30), f_ap_pensage(pensmonth), 0.004, 0.001)
End If
'-- Correction for work-time
op_ap_db = op_ap_db * (1 - i_work_share(i))
Else '-- Retired last year
If i_work_share(i) > 0 Then '-- Correction for changed work-time
op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i))
End If
'-- Indexation
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
Case Else '-- Other
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_db = 0
Else '-- Indexation (individuals with occup pens in start data
op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65)
End If
End Select
f_Occupational_DB_pension_benefits = op_ap_db
End Function
'**********************************************************************
' Function for calculation of occupational pensions Tjänstepensioner
'**********************************************************************
Public Function f_Occupational_pension_benefits(i As Long)
'! Calculation of occupational pension Tjänstepensioner
Dim m_op_rate As Double '-- Return on pension fund during pay out period
Dim pensmonth As Integer, n_pens_years As Integer, payout_time As Integer
Dim op As Long, op_ap_db As Long, op_ap_dc As Long, op_ap_tp As Long
Dim pb_op_ap As Long, pb_op_tp As Long
m_op_rate = m_interest_long '-- Standard assumption
payout_time = 5 '-- Payout time for supplemental benefits
If i_status(i) = 2 Then
pensmonth = i_ap_pensmonth(i)
If i_work_share(i) > 0 Then '-- If part-time retired no pension years counted
n_pens_years = 0
Else
n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth)
End If
Else
pensmonth = (i_age(i) - 65) * 12
n_pens_years = 0
End If
'-- Defined benefit occupational pensions
op_ap_db = f_Occupational_DB_pension_benefits(i, i_sector(i), pensmonth)
'-- Defined contribution occupational pensions
Select Case i_sector(i)
Case 1 '-- Blue collar
'-- Defined contribution part
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector
Else '-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
op_ap_tp = i_op_ap_tp(i)
End If
Case 2 '-- White collar
'-- Defined contribution part
If i_status1(i) <> 2 Then '-- New pensioner may have rights from earlier sector
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
Else '-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
End If
'-- Defined contribution suppl part: ITPK payed out in payout_time years
If n_pens_years < payout_time And i_pb_op_tp(i) > 0 Then
op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i))
pb_op_tp = i_pb_op_tp(i) - _
PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0)
Else
op_ap_tp = 0
pb_op_tp = 0
End If
Case 3 '-- State
'-- Defined contribution part PA03
If (i_status1(i) <> 2) Or _
(i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
Else '-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
End If
'-- Supplemental defined contribution part, extra KÅPAN, payd out in payout_time years
If n_pens_years < payout_time And i_pb_op_tp(i) > 0 And i_work_share(i) = 0 Then
op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i))
pb_op_tp = i_pb_op_tp(i) - _
PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0)
Else
op_ap_tp = 0
pb_op_tp = 0
End If
Case 4 '-- Local government
'-- Defined contribution part: Yearly recalculation if part-time retired
If i_work_share1(i) > 0 Or i_status1(i) <> 2 Then '-- Part-time or new
op_ap_dc = (i_pb_op_ap(i) / dtalpp(i_age(i))) * (1 - i_work_share(i))
Else '-- DC payed out as an life-long annuity without indexation from last work year
op_ap_dc = i_op_ap_dc(i)
End If
'-- Supplemental defined contribution part
If i_status1(i) <> 2 And i_work_share1(i) = 0 Then '-- New full-time pensioner
op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector
Else '-- DC payed out as an life-long annuity without indexation
op_ap_tp = i_op_ap_tp(i)
End If
Case Else '-- Other
'-- Defined contribution part
If i_status1(i) <> 2 Then '-- New pensioner
op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i))
op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i))
Else '-- Indexation (individuals with occup pens in start data
'-- DC payed out as an life-long annuity without indexation
op_ap_dc = i_op_ap_dc(i)
op_ap_tp = i_op_ap_tp(i)
End If
End Select
'-- Summing up
op = op_ap_db + op_ap_dc + op_ap_tp
'-- Updating global variables if retired
' Updating accum pens rights i_pb_op_ap in Calc_Occup_Pens_Rights)
If i_status(i) = 2 Then
i_op_ap_db(i) = op_ap_db
i_op_ap_dc(i) = op_ap_dc
i_op_ap_tp(i) = op_ap_tp
i_op(i) = op
i_pb_op_tp(i) = pb_op_tp
End If
'AW testar
'f_Occupational_pension_benefits = op
f_Occupational_pension_benefits = i_op(i)
End Function
' Used for calculation of occupational pensions benefits in defined benefit systems
' Note: Not indepent function. Uses index as input
' Eg borde man definiera inkomsterna noggrannare. Kräver dock även laggade status.
Public Function f_avg_income(idxnr As Long) As Long
'!-- Calculation of fixed price average income for the last five years
f_avg_income = (i_inc_taxable1(idxnr) / m_basbelopp1 + _
i_inc_taxable2(idxnr) / m_basbelopp2 + _
i_inc_taxable3(idxnr) / m_basbelopp3 + _
i_inc_taxable4(idxnr) / m_basbelopp4 + _
i_inc_taxable5(idxnr) / m_basbelopp5) * m_basbelopp1 / 5
End Function
'*** Occupational pension: Calculation of compensation level in defined benefit systems
' Input:
' income = qualifying wage = pensionsmedförande lön
' basb = basic amount = basbelopp för beräkning av skiktgränser
' comp_tak = compensation level below social insurance limit
' comp_tak_20 = compensation level between social insurance limit and 20 basic amounts
' comp_20_30 = compensation level between 10 and 30 basic amounts
' NOTE: COMPENSATION LEVEL IN PERCENT EG 10, 30 ETC
' time = time in service = tjänstetidsfaktor
' early = monthly down correction if early pension. Optional, default=005% per month
' early=-999 means actuarial calculation
' late = monthly up correction if late pension. Optional, default=007% per month
' -----------------------------------------------------------------------------------
Public Function f_op_db_comp(income As Long, basb As Long, comp_tak As Double, _
comp_tak_20 As Double, comp_20_30 As Double, Optional time_factor As Double = 1, _
Optional pensage As Byte = 65, Optional Early As Double = 0.005, _
Optional Late As Double = 0.007) As Long
'!-- Occupational pensions: General procedure for Calculation of compensation levels in defined benefit systems
'-- Scaling of comp level
comp_tak = comp_tak / 100
comp_tak_20 = comp_tak_20 / 100
comp_20_30 = comp_20_30 / 100
Select Case income
Case Is <= 7.5 * basb
f_op_db_comp = income * comp_tak
Case Is <= 20 * basb
f_op_db_comp = (7.5 * basb * comp_tak) + _
(income - 7.5 * basb) * comp_tak_20
Case Is <= 30 * basb
f_op_db_comp = (7.5 * basb * comp_tak) + _
((20 - 7.5) * basb) * comp_tak_20 + _
(income - 20 * basb) * comp_20_30
Case Is > 30 * basb
f_op_db_comp = (7.5 * basb * comp_tak) + _
((20 - 7.5) * basb) * comp_tak_20 + _
((30 - 20) * basb) * comp_20_30
Case Else
f_op_db_comp = 0
End Select
'-- Correction for empoyment time and early or late withdrawal
f_op_db_comp = f_op_db_comp * time_factor * f_fu_kvot(pensage, Early, Late)
End Function
'**** Occupational pension, State employed PA03
' Calculates compensations levels, transitional rules
' Input: Year = born year YYYY
' Intervall = income intervall
' 1 = income <7,5 basbelopp
' 2 = 7,5 basbelopp < income < 20 basbelopp
' 3 = 20 basbelopp < income < 30 basbelopp
' -----------------------------
Public Function f_op_pa03(year As Integer, intervall As Byte) As Double
'Occupational pension: Transitional rules PA03
Dim pa03(31, 3) As Double
pa03(1, 1) = 9.5: pa03(1, 2) = 64.85: pa03(1, 3) = 32.4
pa03(2, 1) = 9.3: pa03(2, 2) = 64.7: pa03(2, 3) = 32.3
pa03(3, 1) = 9.1: pa03(3, 2) = 64.55: pa03(3, 3) = 32.2
pa03(4, 1) = 8.9: pa03(4, 2) = 64.4: pa03(4, 3) = 32.1
pa03(5, 1) = 8.7: pa03(5, 2) = 64.25: pa03(5, 3) = 32#
pa03(6, 1) = 8.4: pa03(6, 2) = 64.1: pa03(6, 3) = 31.9
pa03(7, 1) = 8.2: pa03(7, 2) = 63.95: pa03(7, 3) = 31.8
pa03(8, 1) = 7.9: pa03(8, 2) = 63.8: pa03(8, 3) = 31.7
pa03(9, 1) = 7.7: pa03(9, 2) = 63.65: pa03(9, 3) = 31.6
pa03(10, 1) = 7.4: pa03(10, 2) = 63.5: pa03(10, 3) = 31.5
pa03(11, 1) = 7.2: pa03(11, 2) = 63.35: pa03(11, 3) = 31.4
pa03(12, 1) = 6.9: pa03(12, 2) = 63.2: pa03(12, 3) = 31.3
pa03(13, 1) = 6.6: pa03(13, 2) = 63.05: pa03(13, 3) = 31.2
pa03(14, 1) = 6.3: pa03(14, 2) = 62.9: pa03(14, 3) = 31.1
pa03(15, 1) = 6: pa03(15, 2) = 62.75: pa03(15, 3) = 31#
pa03(16, 1) = 5.7: pa03(16, 2) = 62.6: pa03(16, 3) = 30.9
pa03(17, 1) = 5.4: pa03(17, 2) = 62.45: pa03(17, 3) = 30.8
pa03(18, 1) = 5.1: pa03(18, 2) = 62.3: pa03(18, 3) = 30.7
pa03(19, 1) = 4.7: pa03(19, 2) = 62.15: pa03(19, 3) = 30.6
pa03(20, 1) = 4.3: pa03(20, 2) = 62#: pa03(20, 3) = 30.5
pa03(21, 1) = 3.9: pa03(21, 2) = 61.85: pa03(21, 3) = 30.4
pa03(22, 1) = 3.6: pa03(22, 2) = 61.7: pa03(22, 3) = 30.3
pa03(23, 1) = 3.2: pa03(23, 2) = 61.5: pa03(23, 3) = 30.2
pa03(24, 1) = 2.9: pa03(24, 2) = 61.3: pa03(24, 3) = 30.1
pa03(25, 1) = 2.5: pa03(25, 2) = 61.1: pa03(25, 3) = 30#
pa03(26, 1) = 2.1: pa03(26, 2) = 60.9: pa03(26, 3) = 30#
pa03(27, 1) = 1.7: pa03(27, 2) = 60.7: pa03(27, 3) = 30#
pa03(28, 1) = 1.3: pa03(28, 2) = 60.5: pa03(28, 3) = 30#
pa03(29, 1) = 0.9: pa03(29, 2) = 60.3: pa03(29, 3) = 30#
pa03(30, 1) = 0.5: pa03(30, 2) = 60.1: pa03(30, 3) = 30#
pa03(31, 1) = 0: pa03(31, 2) = 60#: pa03(31, 3) = 30#
If year <= 1942 Then
Select Case intervall
Case 1
f_op_pa03 = 10
Case 2
f_op_pa03 = 65
Case 3
f_op_pa03 = 32.5
Case Else
f_op_pa03 = 0
End Select
ElseIf year > 1942 And year < 1973 Then
f_op_pa03 = pa03(year - 1942, intervall)
ElseIf year > 1972 Then
Select Case intervall
Case 1
f_op_pa03 = 0
Case 2
f_op_pa03 = 60
Case 3
f_op_pa03 = 30
Case Else
f_op_pa03 = 0
End Select
Else
f_op_pa03 = 0
End If
End Function
' -- Function returns pontential or paid out sum of public pensions depending on status.
' If individual retired the function also updates public pension variables
'-- Antar normalt att alla går i pension 1/1. Vidare antas alla som dör göra det den 1/1. Approximativt
' innebär detta att folk i genomsnitt får pension 1/2 år för tidigt, men å andra sidan förlorar
' 1/2 år i slutet av livet. För IP & TP beräknas även utgiftsmässiga belopp (suffix _ut)
Public Function f_Public_Pension_Benefits(i As Long) As Long
'!-- Calculation of old age public pension benefits
Dim bokvot As Double ' Bosättningstidskvot
Dim ap_fp_kvot As Double
Dim ap_fp_kvot1 As Double
Dim ap_berund As Long 'Beräkningsunderlag för garantipension
'Dim ap_atp_1994, ap_fp30_1994 As Double
'-- Dim as local variables. If retired also global variables calculated
Dim ap_atp As Long, ap_atp_old As Long, ap_pts As Long, ap_fp As Long
Dim ap_fp30 As Long, ap_tp As Long, ap_gp As Long, ap_ip As Long, ap_fiktiv As Long
Dim ap_pp As Long, ap_fp30_1994 As Long, ap_atp_1994 As Long, ap_gartill As Long
Dim ap As Long, ap_ap As Long, pensmonth As Integer, ap_ip_ut As Long
Dim PB_IP As Long, pb_pp As Long, pb_fiktiv As Long
Dim ap_atp_ut As Long, ap_fp30_ut As Long, ap_tp_ut As Long, ap_pp_ut As Long
year = model_time + base_year
If i_status(i) = 2 Then
pensmonth = i_ap_pensmonth(i)
Else
pensmonth = (i_age(i) - 65) * 12
End If
' -- Diverse kvoter
'deltid= 1 '-- Parameter för uttagsandel **** Skall implementeras senare. Tv. endast heltidspension
bokvot = mini(1, maxi(i_botid(i) / 40, pp_hist(i).n_years / f_krav_atp_ar(i_born_year(i))))
' -- Ersättningsnivå för folkpen etc beroende på civilstånd
ap_fp_kvot = f_ap_fp_kvot(i_civ_stat(i)) 'Basic pension ratio depends on civil status
ap_fp_kvot1 = f_ap_fp_kvot(i_civ_stat1(i)) ' -"- last year
'! -- Old system Gamla systemet
'! -- ATP - National supplementary pension Allmän tilläggspension
If i_status1(i) <> 2 Then '-- New pensioner
If i_age(i) >= 61 And pp_hist(i).n_years >= 3 Then
ap_atp = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _
(pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
(1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth)))
' Korrigering för halvårseffekt av utfasningen.
' Also adjusted for deceased persons in a02, new_economy2
ap_atp_ut = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _
(pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _
+ (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2
ap_atp_old = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _
(pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth))
Else
ap_atp = 0
ap_atp_ut = 0
ap_atp_old = 0
End If
Else ' -- Retired last year
ap_atp = i_ap_atp(i) * f_pens_index("ATP", i_age(i))
If ap_atp < 0 Then
i = i
End If
ap_atp_ut = i_ap_atp_ut(i) * f_pens_index("ATP", i_age(i))
ap_atp_old = i_ap_atp_old(i) * (m_basbelopp / m_basbelopp1)
End If
'! -- Basic pension & pension supplement Folkpension & PTS
If i_age(i) > 61 And i_botid(i) >= 3 Then ' *** Behövs vid beräkn Ö-garpAnd year < 2003 Then
ap_fp = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * ap_fp_kvot * m_basbelopp
'**** PTS-kvot 0,555 för 990601
ap_pts = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * _
maxi((0.569 * m_basbelopp) - (ap_atp + i_surv(i)), 0)
Else
ap_fp = 0
ap_pts = 0
End If
'! -- Reformed system Reformerat system
' Balance indexing of suppl pens for transition generation (LIP 6 kap, § 8a)
If year > 2003 And (i_born_year(i) >= 1938 And i_born_year(i) <= 1953) And i_age(i) = 65 Then
i_ap_atp(i) = i_ap_atp(i) * m_ap_balanstal_accum
End If
'! -- FP30 - Old part Reformed basic pension
If i_age(i) >= 61 And pp_hist(i).n_years >= 3 And year >= 2001 Then
If i_status1(i) <> 2 Or (year = 2001 And i_status(i) = 2) Then ' -- Not retired last year
If ap_atp > 0 Then '-- Only calculated for individuals with ATP
ap_fp30 = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
ap_fp_kvot * m_basbelopp * (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))
ap_fp30_ut = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _
ap_fp_kvot * m_basbelopp * _
((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _
+ (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2
Else
ap_fp30 = 0
ap_fp30_ut = 0
End If
Else ' Retired last year - Indexation and correction for changed civil status
ap_fp30 = i_ap_fp30(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation
ap_fp30_ut = i_ap_fp30_ut(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation
End If
Else
ap_fp30 = 0
ap_fp30_ut = 0
End If
'! -- IP - Income pension Inkomstpension
If i_age(i) >= 61 And year >= 2001 Then
If (i_status1(i) <> 2) Then ' -- Not retired last year
'-- Special rules for indexing the year of retirement: No indexation
'PB_IP = i_pb_ip(i) + i_pr_ip1(i) '-- Tidigare metod
PB_IP = i_pb_ip(i)
ap_ip = PB_IP / dtalip(i_age(i))
'-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt
' f att få rätt makro. Nya får endast halv IP utbetald 1:a året.
ap_ip_ut = ap_ip * 0.5
Else ' -- Retired last year
ap_ip = i_ap_ip(i) * f_pens_index("IP", i_age(i)) ' -- Indexation
ap_ip_ut = ap_ip '-- ap_ip_ut later adjusted for deceased persons in a02
End If
Else
ap_ip = 0
End If
'! -- Calculates fictious pension. Used in calc of reformed basic pension
' and ap_gartill.
If i_age(i) >= 65 And year >= 2003 Then
If (i_status1(i) <> 2 Or i_age(i) = 65) Then ' -- Not retired last year
' pb_fiktiv = i_pb_fiktiv(i) + i_pr_ip1(i) + i_pr_pp1(i) 'Tidigare metod
pb_fiktiv = i_pb_fiktiv(i)
ap_fiktiv = pb_fiktiv / dtalip(65) ' or 65 years
Else ' -- Retired last year
ap_fiktiv = i_ap_fiktiv(i) * f_pens_index("IP", i_age(i)) ' -- Indexation
End If
Else
ap_fiktiv = 0
End If
'! -- PP - PremiePension
If i_status1(i) <> 2 Then ' New pensioner
' Man kan välja om pp skall utbetalas som en livränta eller kvarstå i fonder
' Man kan välja att ta ut pp från 61-79:11 års ålder, välja 25, 50, 75
' eller 100%:s uttag. Det går att göra uppehåll i uttaget och ändra den andel som tas ut.
' Som standardantagande antas att alla väljer livränta, räknar som en annuitet, och
' 100% från 65 år för alla.
' Note: Discounting facor=1 + ((m_interest_long / 100) - m_favg_pp) in call to Calculate_Dtal
'*** OBS: Delningstal beräknade på detta sätt låga jämfört med PPM:s ***
'pb_pp = i_pb_pp(i) + i_pr_pp1(i) 'Tidigare metod
pb_pp = i_pb_pp(i)
ap_pp = pb_pp / dtalpp(i_age(i))
'-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt
' f att få rätt makro. Nya får endast halv IP utbetald 1:a året.
ap_pp_ut = ap_pp * 0.5
Else '-- Retired last year: Note - No indexation of PP, just an annuity
ap_pp = i_ap_pp(i)
ap_pp_ut = ap_pp '-- ap_pp_ut later adjusted for deceased persons in a02
End If
'! -- Retirement pension, Reformed transitional supplement Garantitillägg
' Endast till mellagenerationen, ej vid uttag av enbart PP, tidigast from 65 år
'**** Eg inget gartill vid uttag vid enbart PP
If i_born_year(i) > 1937 And i_born_year(i) <= 1953 And i_age(i) >= 65 Then
If i_age(i) = 65 Or i_status1(i) <> 2 Then '-- 65 years old OR newly retired
ap_fp30_1994 = ap_fp_kvot * m_basbelopp * f_fu_kvot(f_ap_pensage(pensmonth)) _
* mini(1, (i_ATP_ar_1994(i) / 30))
ap_atp_1994 = 0.6 * (i_mATP_1994(i) / 100) * m_basbelopp * mini(1, _
(i_ATP_ar_1994(i) / 30)) * f_fu_kvot(f_ap_pensage(pensmonth))
Else ' -- Indexation and correction for changed civil status
ap_fp30_1994 = i_ap_fp30_1994(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("IP", i_age(i))
ap_atp_1994 = i_ap_atp_1994(i) * f_pens_index("IP", i_age(i))
End If
ap_gartill = maxi(0, ((ap_fp30_1994 + ap_atp_1994) - _
(ap_fiktiv + ap_fp30 + ap_atp)))
Else
ap_gartill = 0
End If
'! -- GP - Reformed basic retirement pensions Garantipension
'If i_age(i) >= 61 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then 'AW Testar en reform
If i_age(i) >= 65 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then
Select Case i_born_year(i)
Case Is > 1937 '!-- . Persons born 1938 and later Garantipension
ap_tp = ap_fp30 + ap_atp + ap_gartill
ap_gp = f_ap_garp_38_(i_civ_stat(i), f_pens_bas("GP"), _
ap_tp, ap_fiktiv, i_surv(i))
Case Is <= 1937 '! -- Transitional reformed basic retirement pension
' f.d. Övergångsvis garantipension
ap_gp = f_ap_garp_37(i_civ_stat(i), f_pens_bas("GP"), _
ap_atp, ap_fp30, ap_fp, ap_pts, _
i_surv(i), i_op(i), i_botid(i))
End Select
Else
ap_gp = 0
End If
'! -- Summing up different pension components
If year < 2003 Then '-- Old system
ap = ap_fp + ap_pts + ap_atp
If ap_atp > 0 Then
ap_ap = ap_fp + ap_atp
Else
ap_ap = 0
End If
Else '-- Reformed system
ap_tp = ap_fp30 + ap_atp + ap_gartill ' -- Supplemental pension Tilläggspension
ap_tp_ut = ap_fp30_ut + ap_atp_ut + ap_gartill
ap = ap_tp + ap_ip + ap_pp + ap_gp ' -- Total old age
ap_ap = ap_tp_ut + ap_ip_ut
End If
If i_status(i) = 2 Then
i_ap_atp(i) = ap_atp
i_ap_atp_ut(i) = ap_atp_ut
i_ap_atp_old(i) = ap_atp_old
i_ap_pts(i) = ap_pts
i_ap_fp(i) = ap_fp
i_ap_fp30(i) = ap_fp30
i_ap_fp30_ut(i) = ap_fp30_ut
i_ap_tp(i) = ap_tp
i_ap_tp_ut(i) = ap_tp_ut
i_ap_gp(i) = ap_gp
i_ap_ip(i) = ap_ip
i_ap_ip_ut(i) = ap_ip_ut
i_ap_fiktiv(i) = ap_fiktiv
i_ap_pp(i) = ap_pp
i_ap_pp_ut(i) = ap_pp_ut
i_ap_fp30_1994(i) = ap_fp30_1994
i_ap_atp_1994(i) = ap_atp_1994
i_ap_gartill(i) = ap_gartill
i_ap_tp(i) = ap_tp
i_ap(i) = ap
i_ap_ap(i) = ap_ap
If (i_status1(i) <> 2) Then
i_pb_ip1(i) = i_pb_ip(i)
i_pb_ip(i) = PB_IP
i_pb_pp(i) = pb_pp
i_pb_fiktiv(i) = pb_fiktiv
End If
End If
f_Public_Pension_Benefits = i_ap(i)
End Function
' -- Function returns sum of private pensions.
' If individual retired the function also updates private pension variables
' Note: i_wealth_pension_total not a part private wealth or the wealth tax base
Public Function f_Private_Pension_Benefits(i As Long, payout_time As Integer) As Long
Dim pp As Long, wealth_pension_total As Long
Dim pensmonth As Integer, pp_rate As Double, n_pens_years As Integer
pp_rate = m_interest_long '-- Standard assumption
If i_status(i) = 2 Then
pensmonth = i_ap_pensmonth(i)
n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth)
Else
pensmonth = (i_age(i) - 65) * 12
n_pens_years = 0
End If
If i_age(i) >= 55 And payout_time <> 0 Then 'minimum 55 years age and savings
'-- Assumed that pension captital payed out in payout_time years from pension time
If payout_time < 0 Then '-- Lifelong annuity
If i_status1(i) <> 2 Then '-- New private pensioner with annuity
pp = Pmt((pp_rate * (1 - 0.15)) / 100, explife(i_age(i)), -i_wealth_pension_total(i))
'pp = i_wealth_pension_total(i) / dtalpp(i_age(i))
Else
pp = i_pp(i)
End If
wealth_pension_total = maxi(0, i_wealth_pension_total(i) + _
((i_wealth_pension_total(i) - pp / 2) * ((pp_rate * (1 - 0.15)) / 100)) - pp)
Else '-- Fixed pay out time
If n_pens_years < payout_time Then
pp = Pmt((pp_rate * (1 - 0.15)) / 100, payout_time - n_pens_years, -i_wealth_pension_total(i))
wealth_pension_total = i_wealth_pension_total(i) - _
PPmt((pp_rate * (1 - 0.15)) / 100, 1, payout_time - n_pens_years, -i_wealth_pension_total(i), 0)
Else
pp = 0
wealth_pension_total = 0
payout_time = 0
End If
End If
If i_status(i) = 2 Then
i_pp(i) = pp
i_wealth_pension_total(i) = wealth_pension_total
i_wealth_pension_year(i) = 0 '*** Not simultanous saving and pay out
i_pp_payout_time(i) = payout_time
End If
Else
i_pp(i) = 0
End If
f_Private_Pension_Benefits = i_pp(i)
End Function
Sub Pension_debugging_files()
'!-- Optional printing of pension debugging files (micro data)
status "Printing pension debugging files"
Dim utvar As String
Dim demofile As Integer
Dim i As Long
year = model_time + base_year
If model_time = 0 Then
Open sesimpath & "\tempdata\valid_pens.txt" For Output As #11
utvar = f_Concat_string("i", "bidnr", "year", "i_age", "i_sex", "i_civ_stat", "i_abroad", _
"i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _
"i_ap_atp", "f_mean_ATP", "m_basbelopp", "i_botid", "ATP_years", _
"f_krav_atp_ar", "f_fu_kvot", "f_utfasning_ATP", "i_born_year ", "f_ap_pensyear", _
"i_ap_fp30", "i_ap_ip", "i_pb_ip", "dtal", _
"i_ap_fiktiv", "i_pb_fiktiv", _
"m_interest_short", "i_ap_pp", "explife", "i_pb_pp", "i_ap_gp", _
"i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", _
"i_pu", "i_pgi", "i_pgb", "i_pgb_barn", "i_pgb_plikt", _
"i_pgb_stud", "i_pgb_antag", "i_pb_op_ap", "i_pb_op_tp", "i_pbhi", "i_status1", _
"i_indnr", "i_ap", "i_p_andel", "i_ap_pensmonth", "i_pp", "i_pp_payout_time")
Print #11, utvar
Else
Open sesimpath & "\tempdata\valid_pens.txt" For Append As #11
End If
For i = 1 To m_icount
If i_status(i) = 2 And i_status1(i) <> 2 Then '-- Only for new pensioners
' If i_status(i) = 2 And i_ap_gp(i) > 0 Then '-- Pensionärer med garantipension
utvar = f_Concat_string(i, i_bidnr(i), year, i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), _
i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _
i_ap_atp(i), f_mean_ATP(i), m_basbelopp, i_botid(i), pp_hist(i).n_years, _
f_krav_atp_ar(i_born_year(i)), f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i))), _
f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i))), _
i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _
i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), dtalip(65), _
i_ap_fiktiv(i), i_pb_fiktiv(i), _
m_interest_short, i_ap_pp(i), explife(65), i_pb_pp(i), i_ap_gp(i), _
i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), _
i_pu(i), i_pgi(i), i_pgb(i), i_pgb_barn(i), i_pgb_plikt(i), _
i_pgb_stud(i), i_pgb_antag(i), i_pb_op_ap(i), i_pb_op_tp(i), i_pbhi(i), i_status1(i), _
i_indnr(i), i_ap(i), i_p_andel(i), i_ap_pensmonth(i), i_pp(i), i_pp_payout_time(i))
'***** m_interest_short, i_ap_pp(i), explife(i_age(i)), i_pb_pp(i), i_ap_gp(i),
Print #11, utvar
End If
Next i
Close #11
'If year <= 2020 Then
If model_time = 0 Then
Open sesimpath & "\tempdata\valid_pgi.txt" For Output As #12
utvar = f_Concat_string("year", "i", "bidnr", "i_status", "i_sector", "i_abroad", _
"m_interest_short", "m_interest_long", "m_ap_inkind", "m_ap_balind", "m_basbelopp", _
"i_age", "i_sex", "i_civ_stat", "i_inc_taxable", "i_born_year ", _
"i_pu", "i_pgi", "i_pgb", _
"i_pgb_barn", "i_pgb_plikt", "i_pgb_stud", "i_pgb_antag", _
"i_pb_ip", "i_pbhi", "i_pb_pp", "i_pb_fiktiv", "i_pb_op_ap", "i_pb_op_tp", _
"i_wealth_pension_total", "i_wealth_pension_year")
Print #12, utvar
Else
Open sesimpath & "\tempdata\valid_pgi.txt" For Append As #12
End If
For i = 1 To m_icount
If i_born_year(i) >= 1938 And i_born_year(i) < 1984 Then
' If i_bidnr(i) <> 0 And _
' i_born_year(i) >= 1938 And i_born_year(i) < 1984 And i_abroad(i) = 1 Then 'And Rnd < 0.05 Then
' var 20:e individ skrivs ut
utvar = f_Concat_string(year, i, i_bidnr(i), i_status(i), i_sector(i), i_abroad(i), _
m_interest_short, m_interest_long, m_ap_inkind, m_ap_balind, m_basbelopp, _
i_age(i), i_sex(i), i_civ_stat(i), i_inc_taxable(i), i_born_year(i), _
i_pu(i), i_pgi(i), i_pgb(i), _
i_pgb_barn(i), i_pgb_plikt(i), i_pgb_stud(i), i_pgb_antag(i), _
i_pb_ip(i), i_pbhi(i), i_pb_pp(i), i_pb_fiktiv(i), i_pb_op_ap(i), i_pb_op_tp(i), _
i_wealth_pension_total(i), i_wealth_pension_year(i))
Print #12, utvar
End If
Next i
'End If
Close #12
End Sub
Sub Pension_micro_file()
'!-- Optional printing of pension micro file (micro data)
status "Printing pension micro file"
Dim utvar As String
Dim demofile As Integer
Dim i As Long
year = model_time + base_year
If model_time = 0 Then
Open sesimpath & "\tempdata\pension_micro.txt" For Output As #13
utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_age", "i_sex", _
"i_civ_stat", "i_abroad", "i_status", "i_sector", _
"i_edlevel", "i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _
"i_ap_atp", "i_born_year ", "f_ap_pensyear", _
"i_ap_fp30", "i_ap_ip", "i_pb_ip", "i_ap_pp", "i_pb_pp", "i_ap_gp", _
"i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", "i_pu", "i_pgi", "i_pgb", _
"i_pb_op_ap", "i_pb_op_tp", _
"i_ap", "i_ap_tp", "i_p_andel", "i_pp", "i_pp_payout_time", _
"i_wealth_pension_total", "i_wealth_pension_year", "i_ap_tp")
Print #13, utvar
Else
Open sesimpath & "\tempdata\pension_micro.txt" For Append As #13
End If
For i = 1 To m_icount
utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_age(i), i_sex(i), _
i_civ_stat(i), i_abroad(i), i_status(i), i_sector(i), _
i_edlevel(i), i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _
i_ap_atp(i), i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _
i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), i_ap_pp(i), i_pb_pp(i), i_ap_gp(i), _
i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), i_pu(i), i_pgi(i), i_pgb(i), _
i_pb_op_ap(i), i_pb_op_tp(i), _
i_ap(i), i_ap_tp(i), i_p_andel(i), i_pp(i), i_pp_payout_time(i), _
i_wealth_pension_total(i), i_wealth_pension_year(i), i_ap_tp(i))
Print #13, utvar
Next i
Close #13
End Sub
'**********************************************************************
' Calculation of pension rights for
' - the ATP pension system (tilläggspension, TP
' - the reformed pension system (inkomstpension, IP and premiepension, PP)
'**********************************************************************
'**** KVAR ATT GÖRA:
'**** - TA EV BORT 16-ÅRS GRÄNSEN FÖR INTJÄNANDET.
Public Sub Calculate_Public_Pension_Rights()
'!-- Calculation of pension rights ATP-system and new system PGI & PGB
status "Calculate public pensions rights"
Printdok " Calculate_Public_Pension_Rights"
Dim i As Long
Dim j As Long
Dim tak As Double ' Social insurance limit (Intjänandetak)
' Dim atak As Double ' Social insurance limit plus employee contribution (Avgiftstak)
Dim pgi_snitt As Double ' Average taxable income
Dim pgb_barn1 As Long ' Pension rights f child years, alternative 1
Dim pgb_barn2 As Long ' Pension rights f child years, alternative 2
Dim pgb_barn3 As Long ' Pension rights f child years, alternative 3
Dim rand As Double ' Help variable for calc of random number
Dim randvek() As Double
Dim basb As Long ' Price basic amount or income basic amount
Dim sum As Double
Dim n As Long
Dim pgi_bas As Long
'-- Optional aligning OT regarding the career effect, see below
Dim OTfix2 As Byte
If get_scalefactor_active("OTfix2") = 1 Then
OTfix2 = 1
Else
OTfix2 = 0
End If
sum = 0
n = 0
m_pgi = 0
m_pgb = 0
Dim year As Integer
Dim maxyear As Integer
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
'-- Calculation of administration costs and fee on income pension funds
m_pb_ip_active_n = cnt0(i_pb_ip) * m_weight
m_pb_ip_active = L_SUMVEC(i_pb_ip(1), m_icount) * m_weight
' Förvaltningskostnad 0.075 Källa: Pensionsystemets årsredovisning 2001, sid 20
' -- Costs of insurance administarion: A function of the number of active savers
' m_ap_admin_ip_ins_pers exognous for outcome years: Source Pension System annual report
'm_pensadmin_ip_ins_pers = (m_pensadmin_ip_ins / m_cnt_pb_ip_active) * m_inkind
If f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension") <> 0 Then
m_ap_adm_ip_ins_p = f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension")
Else
m_ap_adm_ip_ins_p = m_ap_adm_ip_ins_p * (m_ap_inkind / m_ap_inkind1)
End If
m_ap_adm_ip_ins = m_ap_adm_ip_ins_p * m_pb_ip_active_n '-- Note: t-1 value
' -- Costs of AP-fund administration: A function of the fund value
' m_ap_admin_ip_ap_p exognous for outcome years: Source Pension System annual report
If f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension") <> 0 Then
m_ap_adm_ip_ap_p = f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension")
End If
If get_scalefactor_active("ap_adm_ip_ap_p") = 1 Then
m_ap_adm_ip_ap_p = get_scalefactor("ap_adm_ip_ap_p")
End If
m_ap_adm_ip_ap = (m_ap_adm_ip_ap_p / 100) * m_ap_apfond '-- Note: t-1 value
' -- Total administration costs
m_ap_adm_ip = m_ap_adm_ip_ins + m_ap_adm_ip_ap
' Administration fee as a part of pension liabilities to active savers
m_ap_adm_ip_p = m_ap_adm_ip / m_pb_ip_active '-- Note: t-1 value
' -- Reduced administration fee on pension liabilities:
' Gradual transition from 62% to 100% fee on individual accounts until 2021
' Infasing t 2021 för att de med behållningar i nya systemet ej ska subventionera gamla ATP
' (Lag 1998:674 5 kap 8§)
Select Case year
Case Is <= 2001
m_favg_ip = 0.6 * m_ap_adm_ip_p
Case Is < 2022
m_favg_ip = (((year - 1999) * 0.02) + 0.56) * m_ap_adm_ip_p
Case Else
m_favg_ip = m_ap_adm_ip_p
End Select
'-- Basic amount and income limit Aktuellt basbelopp och intjänandetak
If year < 2001 Then basb = m_basbelopp_f Else basb = m_basbelopp_income
tak = 7.5 * basb
'!-- Calculate pensionable income Beräknar pensionsgrundande inkomst PGI
'!-- Helpvariables for calculation of pension income index and income basic amount
j = 0
m_inc_taxable_snitt4 = m_inc_taxable_snitt3
m_inc_taxable_snitt3 = m_inc_taxable_snitt2
m_inc_taxable_snitt2 = m_inc_taxable_snitt1
m_inc_taxable_snitt1 = m_inc_taxable_snitt
m_inc_taxable_snitt = 0
For i = 1 To m_icount
pgi_bas = 0
If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI
pgi_bas = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i)
i_pgi_bas(i) = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i)
If i_pgi_bas(i) < 0 Then
i = i
End If
If (pgi_bas * (1 - m_egenavg_pens_p)) <= tak Then
i_pgi(i) = round((pgi_bas * (1 - m_egenavg_pens_p)) - 50, -2)
Else
i_pgi(i) = round(tak - 50, -2)
End If
'-- For disab pensioners. Pension rights only based on qualifying points before 2003
If i_status(i) = 4 And year < 2003 Then
i_pgi(i) = 0
End If
' -- Individual comparison pension base PU (Used in calculation of i_pgb_barn)
If exist_child0_3(i_hhnr(i)) <> 1 Then
i_pu_ind_comp(i) = i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)
End If
' -- Cumulation of base for income index
If pgi_bas > 0 Then
j = j + 1
m_inc_taxable_snitt = m_inc_taxable_snitt + (pgi_bas * (1 - m_egenavg_pens_p))
End If
Else
i_pgi(i) = 0
End If
Next i
If j > 0 Then
m_inc_taxable_snitt = (m_inc_taxable_snitt / j) / m_price_change99
Else
m_inc_taxable_snitt = 0
Debug.Print "Calculate_public_pension_rights: ingen har nollskild PGI!"
End If
'-- Calculate average pensionable income Beräknar genomsnittlig PGI
' and averge income used for calculation of pension income index
j = 0
pgi_snitt = 0
For i = 1 To m_icount
If i_age(i) > 15 And i_age(i) < 65 And i_abroad(i) = 0 And i_pgi(i) > 0 Then
j = j + 1
pgi_snitt = pgi_snitt + i_pgi(i)
End If
Next
pgi_snitt = pgi_snitt / j
'*** Draw vector of standard normal variates
ReDim randvek(1 To m_icount)
Call RANNOR(m_icount, randvek(1), model_time + base_year + random * Rnd)
'!-- Pensionable amounts, pension rights Pensionsgrundande belopp och pensionsunderlag
For i = 1 To m_icount
If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI
'! -- Pensionable amounts, military service
' Endast 20 åriga män antas göra värnplikt
'0.45 = Andel som gör lumpen enligt Pliktverkets hemsida (avser 1999)
'För varje dag tjänstgöringenpågår pågår > 120 dagar. Beräknas som
'50% av PGI för alla försäkrade < 65 år/365 * antalet dagar
'Vägt genomsnitt för olika utbildniugskategoriers (enl Pliktverket)
'tjänstgöringstider ger ca 250 dagar
' ***** OBS Info om antal finns i AKU. Kolla detta.
' ***** LF har skattat modell. Ev implementera denna
If i_sex(i) = 1 And i_age(i) = 20 And Rnd < 0.45 Then
i_pgb_plikt(i) = 0.5 * (pgi_snitt / 365) * 250
Else
i_pgb_plikt(i) = 0
End If
'! -- Pensionable amounts, studies 138% of study grants (Endast av bidragsbeloppet)
If i_status(i) = 3 Then
i_pgb_stud(i) = 1.38 * i_trf_study_grant(i)
Else
i_pgb_stud(i) = 0
End If
'!-- Pensionable amounts, disability pension (Antagandeinkomst)
' Only if qualifying points for the current year has been calculated in new_economy
If i_status(i) = 4 And pp_hist(i).n_years > 0 Then ' If disab pens AND ATP-points
If pp_hist(i).pp_years(pp_hist(i).n_years) = year Then '..and points the current year
If year < 2003 Then
i_pgb_antag(i) = ((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1) _
* m_basbelopp_f
Else
'-- Note: No contribution from the disability pensioner
' gamla koden i_pgb_antag(i) = i_ftp_antag(i) - i_pgi(i)
If year < 2007 Then
i_pgb_antag(i) = (i_ftp_antag(i) * (1 - 0.07)) - i_pgi(i)
Else
i_pgb_antag(i) = (i_ftp_antag(i) * (1 - 0.2)) - i_pgi(i)
End If
End If
End If
Else
i_pgb_antag(i) = 0
End If
'! -- Pensionable amounts, child years
' Women with child age 0 to 3 years. Kvinna får t.v. all pensrätt för barn
'**** ÄNDRA SÅ ATT DEN MED LÄGST INKOMST FÅR POÄNGEN ****
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
If i_sex(i) = 2 And exist_child0_3(i_hhnr(i)) = 1 Then
' Check for gainful employment limit: PGI>2 inc basic i minst 5 år ( <2001 2 basbf)
If pp_hist_limit(i, 100) >= 5 Then
'-- Best of 3 alternatives Bäst av tre alternativ
' 1) Individual comp PGI Utfyllnad till inkomst året före barnets födelse
pgb_barn1 = maxi(0, i_pu_ind_comp(i) - i_pgi(i))
' 2) General comp PGI Utfyllnad t 75% av genomsnittl PGI
pgb_barn2 = maxi(0, 0.75 * pgi_snitt - _
(i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)))
' 3) One income base amount Ett inkomstbasbelopp (ett förh prisbasb före 2001)
pgb_barn3 = basb
'-- Choosing best alternative
i_pgb_barn(i) = maxi(pgb_barn1, maxi(pgb_barn2, pgb_barn3))
Select Case i_pgb_barn(i)
Case pgb_barn1
i_pgb_barn_typ(i) = 1
Case pgb_barn2
i_pgb_barn_typ(i) = 2
Case pgb_barn3
i_pgb_barn_typ(i) = 3
End Select
End If
End If
'! -- Summing up pensionable amounts
i_pgb(i) = i_pgb_barn(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_antag(i)
' -- PGB + PGI max social insurance income limit
Select Case tak
Case Is < i_pgi(i)
i_pgb_antag(i) = 0
i_pgb_plikt(i) = 0
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i)
i_pgb_antag(i) = tak - i_pgi(i)
i_pgb_plikt(i) = 0
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i)
i_pgb_plikt(i) = tak - i_pgi(i) - (i_pgb_antag(i))
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)
i_pgb_stud(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i))
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 0
Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i)
i_pgb_barn(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i))
End Select
i_pgb(i) = round((i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i)) - 50, -2)
'-- Optional aligning OT regarding the career effect
' OTfix2: Justerar PGI (inkomstprofilen) för äldre för att få OT enl RFV
' Note: Förutsätter att även PGI alignas
If OTfix2 = 1 Then
Select Case i_age(i)
Case Is = 57 And i_status(i) <> 2
i_pgi(i) = 0.96 * i_pgi(i)
Case Is = 58 And i_status(i) <> 2
i_pgi(i) = 0.92 * i_pgi(i)
Case Is = 59 And i_status(i) <> 2
i_pgi(i) = 0.87 * i_pgi(i)
Case Is = 60 And i_status(i) <> 2
i_pgi(i) = 0.82 * i_pgi(i)
Case Is > 61 And i_status(i) <> 2
i_pgi(i) = 0.78 * i_pgi(i)
End Select
End If
i_pu(i) = i_pgb(i) + i_pgi(i)
Else
i_pgb(i) = 0
i_pgb_antag(i) = 0
i_pgb_plikt(i) = 0
i_pgb_stud(i) = 0
i_pgb_barn(i) = 0
i_pgb_barn_typ(i) = 1
i_pgi(i) = 0
i_pu(i) = 0
End If
'-- Macro for aligning
m_pgi = m_pgi + i_pgi(i)
m_pgb = m_pgb + i_pgb(i)
Next i
'!-- Optional calculation of determinstic pension rights
' Samma procedur som i Orange kuvert
Dim Orange As Byte
Dim growth As Double
If get_scalefactor_active("Pension_Orange") = 1 Then
growth = get_scalefactor("Pension_Orange")
For i = 1 To m_icount
' AW Inga pensionsgrundande belopp i orange brev i framtiden, sätter pu=pgi
i_pu_orange(i) = i_pu_orange(i) * growth
i_pu(i) = i_pu_orange(i)
i_pgi_orange(i) = i_pgi_orange(i) * growth
i_pgi(i) = round(i_pgi_orange(i) - 50, -2)
Next i
End If
'!-- Optional aligning of pensionable income etc
Dim Align_PGI As Byte
Dim pgb As Double
Dim pgi As Double
Dim pu As Double
If get_scalefactor_active("Align_PGI") = 1 Then
' pgb = parm_macro(maxyear, 13)
' pgi = parm_macro(maxyear, 15)
m_zpgb_korr = parm_macro(maxyear, 13)
m_zpgi_korr = parm_macro(maxyear, 15)
If m_zpgi_korr = 0 Then m_zpgi_korr = 1
If m_zpgb_korr = 0 Then m_zpgb_korr = 1
' If pgi > 1 Then m_zpgi_korr = pgi / (m_pgi * m_weight)
' If pgb > 1 Then m_zpgb_korr = pgb / (m_pgb * m_weight)
For i = 1 To m_icount
i_pgi(i) = i_pgi(i) * m_zpgi_korr
i_pgb(i) = i_pgb(i) * m_zpgb_korr
i_pu(i) = i_pgi(i) + i_pgb(i)
Next i
End If
If get_scalefactor_active("Align_PGI2") = 1 Then '-- Align t RFV årsredov
' -- PGI & PGB aggregerat, endast mått på PU nivå f RFV
pu = parm_macro(maxyear, 15) 'Hack: Lägger PU i PGI-kolumnen
pgi = pu - (m_pgb * m_weight)
If pgi > 0 Then
m_zpgi_korr = pgi / (m_pgi * m_weight)
Else
m_zpgi_korr = 1
End If
Debug.Print pu & " " & pgi & " " & m_zpgi_korr
For i = 1 To m_icount
i_pgi(i) = i_pgi(i) * m_zpgi_korr
i_pu(i) = i_pgi(i) + i_pgb(i)
Next i
End If
'! -- Cumulative pension rights PR
m_ap_arv_59 = 0: m_ap_arv60_ = 0: m_ap_index = 0: m_ap_favg = 0
For i = 1 To m_icount
i_pr_ip1(i) = i_pr_ip(i)
i_pr_pp1(i) = i_pr_pp(i)
i_pb_ip1(i) = i_pb_ip(i)
If i_age(i) >= 16 And i_status(i) <> 2 Then
'! -- Pension rights for the ATP-system
' PP-vector for disab pens already updated in Calculate_Disablity_Pension_Benefits
If i_pgi(i) > m_basbelopp_f + 100 And i_status(i) <> 4 Then
Call Update_pp_hist(i, CInt(((i_pgi(i) - m_basbelopp_f) / m_basbelopp_f) * 100))
End If
'! -- Pension rights and pension contributions for the reformed system
Select Case i_pu(i)
Case Is < f_bas_deduct_min(year)
i_pr_ip(i) = 0
i_pr_pp(i) = 0
Case Else
'-- Tidigare version utkommenterad
'i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0))
'i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0))
'-- Snabb uppskruvning av avgifterna kräver korr för halvårseffekt
i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _
+ f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2
i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _
+ f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2
End Select
'! -- Cumulative pension rights
'! -- Income pension Inkomstpension
' -- First calculation of some aggregated variables for balancing
If i_age(i) < 60 Then
m_ap_arv_59 = m_ap_arv_59 + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i))))
Else
m_ap_arv60_ = m_ap_arv60_ + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i))))
End If
m_ap_index = m_ap_index + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _
* ((m_ap_balind / m_ap_balind1) - 1))
m_ap_favg = m_ap_favg + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _
* m_favg_ip)
'! -- Cumulative pension rights
' -- Then individual pension rights
'! -- Income pension Inkomstpension
' Tidigare version
'i_pb_ip(i) = ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i) - 1) + i_pr_ip1(i)) _
' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2))
'i_pb_fiktiv(i) = ((i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) _
' + (i_pr_ip1(i) + i_pr_pp1(i))) _
' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2))
If m_RFV_PB_On <> 1 Then
i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _
(m_ap_balind / m_ap_balind1)) + i_pr_ip(i)
i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _
(m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i))
Else 'RFV:s förvaltningskostnadsavdrag
i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _
(m_ap_balind / m_ap_balind1)) + i_pr_ip(i)
i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _
(m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i))
End If
'! -- Premium pension
' Parameter i fördeln nedan avsedd att modellera osäkerheten i placeringarna
' Räknar med årsgenomsnitt på tillfälliga avkastningen,dvs div m 2
' Förenkling nedan. Eg så skall pengarna ha tillf placering i snitt 1,5 år
rand = randvek(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100))
i_pb_pp(i) = (i_pb_pp(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_pp) * rand) + _
(i_pr_pp(i) * (1 + (m_interest_short / 100) / 2))
Else
i_pr_ip(i) = 0
i_pr_pp(i) = 0
End If
Next i
m_ap_arv_59 = m_ap_arv_59 * m_weight
m_ap_arv60_ = m_ap_arv60_ * m_weight
m_ap_arv = m_ap_arv_59 + m_ap_arv60_
m_ap_index = m_ap_index * m_weight
m_ap_favg = m_ap_favg * m_weight
'!-- Optional aligning of cumulative pension rights
' Proportional adjustment factor updated i Default_parameters2
Dim Align_PB As Byte
'Dim PB_IP As Double
Dim pb_fiktiv As Double
Dim pb_pp As Double
Dim yy As Integer
If get_scalefactor_active("Align_PB") = 1 And year = 2000 Then
' cohort sex {1=RFV,2=Sesim,3=Quota}
Dim PB_IP(1938 To 1987, 2, 3) As Double
'-- Read RFV values per cohort and sex f Sesim.mdb
For yy = 1938 To 1987
PB_IP(yy, 1, 1) = f_GetMakro("PB_IP_M", year, CStr(yy))
PB_IP(yy, 2, 1) = f_GetMakro("PB_IP_F", year, CStr(yy))
Next
'-- Aggregate Sesim values per cohort and sex
For i = 1 To m_icount
If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then
PB_IP(i_born_year(i), i_sex(i), 2) = _
PB_IP(i_born_year(i), i_sex(i), 2) + (i_pb_ip(i) * m_weight)
End If
Next i
'-- Calculation of aligning factors
For yy = 1938 To 1987
If PB_IP(yy, 1, 2) > 0 And PB_IP(yy, 2, 2) > 0 Then
PB_IP(yy, 1, 3) = PB_IP(yy, 1, 1) / PB_IP(yy, 1, 2)
PB_IP(yy, 2, 3) = PB_IP(yy, 2, 1) / PB_IP(yy, 2, 2)
Else
PB_IP(yy, 1, 3) = 1
PB_IP(yy, 2, 3) = 1
End If
Next
'-- Printing align factors for pension rights
Open sesimpath & "\tempdata\PB_align.prn" For Output As #93
Print #93, "Cohort Male Female"
For yy = 1938 To 1987
Print #93, yy & " " & PB_IP(yy, 1, 3) & " " & PB_IP(yy, 2, 3)
Next
Close #93
'-- Aligning
For i = 1 To m_icount
If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then
i_pb_ip(i) = i_pb_ip(i) * PB_IP(i_born_year(i), i_sex(i), 3)
i_pb_fiktiv(i) = i_pb_fiktiv(i) * PB_IP(i_born_year(i), i_sex(i), 3)
'i_pb_pp(i) = i_pb_pp(i) * m_zpb_pp_korr
End If
Next i
End If
End Sub
Public Sub Calculate_Occupational_Pension_Rights()
'!-- Calculation of occupational pension rights for defined contribution systems
status "Calculate occupational pensions rights"
Printdok " Calculate_Occupational_Pension_Rights"
Dim i As Long, pgi_bas As Long
Dim tak As Double, rand() As Double, r1 As Double, r2 As Double
year = model_time + base_year
If year < 2001 Then tak = 7.5 * m_basbelopp_f Else tak = 7.5 * m_basbelopp_income
'*** Draw random numbers
ReDim rand(1 To 2 * m_icount)
Call RANNOR(2 * m_icount, rand(1), model_time + base_year + random * Rnd)
For i = 1 To m_icount
If (i_status(i) <> 2 And i_abroad(i) = 0) Or _
(i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65) Then
'-- Simplified calc of pension rights for part-time retired. Assumes that all
' all income qualifies for pension rights even pensions.
pgi_bas = i_inc_earning(i) + i_trf_sickleave(i)
If i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65 Then
'-- Part-time retired normally gets pensions rights as if full-time to age 65
pgi_bas = (i_inc_earning(i) + i_trf_sickleave(i)) / i_work_share(i) '-- Rough calc of full-time pay
Else
pgi_bas = i_inc_earning(i) + i_trf_sickleave(i)
End If
Select Case i_sector(i)
Case 1 '-- Blue collar: SAF-LO
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.035, , tak, 21, 1932)
i_pr_op_tp(i) = 0
i_op_pp_years_Blue(i) = i_op_pp_years_Blue(i) + 1
Case 2 '-- White collar: ITPK
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.02, , tak, 28, 1939)
i_op_pp_years_White(i) = i_op_pp_years_White(i) + 1
Case 3 '-- State: PA03 & Kåpan
If year >= 2003 Then '-- PA03
i_pr_op_ap(i) = f_op_pens_rights(mini(pgi_bas, 30 * m_basbelopp_income), _
i_age(i), i_born_year(i), 0.023, , tak, 23, 1943)
Else
i_pr_op_ap(i) = 0
End If
Select Case year '-- Extra Kåpan
Case Is < 2003
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.015, , tak, 28)
Case 2003
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.019, , tak, 28)
Case Is > 2003
i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.02, , tak, 28)
End Select
i_op_pp_years_State(i) = i_op_pp_years_State(i) + 1
Case 4 '-- Local goverment: PFA-01
Select Case year '-- PFA98 (Kommunalarbetareförbundets premier)
Case Is < 2004
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.045, 0.021, tak, 28, 1938)
i_pr_op_tp(i) = 0
Case Is >= 2004
'-- Employed 2003, minimum age 28, still 4,5% fee
If i_born_year(i) < 1976 Then
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.045, 0.011, tak, 28, 1938)
Else '-- Still 28 year age limit above social insurance limit
i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0.04, 0, tak, 21, 1938) + _
f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _
0, 0.011, tak, 28, 1938)
End If
i_pr_op_tp(i) = 0
End Select
i_op_pp_years_Local(i) = i_op_pp_years_Local(i) + 1
Case Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End Select
Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End If
'! -- Cumulative occupational pension rights
' Parameter in distribution below measures uncertainty in investment
' Assumes same average return on occupational pension funds as public premium pension
' Also tax on return 15% (avkastningsskatt) on occup pens rights
r1 = rand(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100))
r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_shares_return / 100))
'VARFÖR INTE RÄKNA NER STOCKEN ÄVEN FÖR DE SOM INTE ARBETAR DELTID, ALLTSÅ
'VARFÖR INTE TA BORT VILLKORET OM work_share
If i_status(i) = 2 And i_work_share(i) > 0 Then '-- Updating the stock
i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _
+ i_pr_op_ap(i) - i_op_ap_dc(i)
Else
i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _
+ i_pr_op_ap(i)
i_pb_op_tp(i) = (i_pb_op_tp(i) * r2 * (1 - ((m_interest_long / 100) * 0.15))) _
+ i_pr_op_tp(i)
End If
' -- DB-rights for persons who has changed sector capitalized and added to DC-rights
' Upparbetade DB-rätter omvandlas t DC-rätter f 65 års ålder
If i_sector(i) <> i_sector1(i) And (i_sector1(i) <> 0 And i_sector1(i) <> 5) Then
i_pb_op_ap(i) = i_pb_op_ap(i) + mini(1, (i_op_pp_years(i) / 30)) * _
(PV(m_interest_long / 100, explife(65), _
-f_Occupational_DB_pension_benefits(i, i_sector1(i), 0)))
i_op_pp_years(i) = 0
i_op_pp_years_trans(i) = 0
Else
i_op_pp_years(i) = i_op_pp_years(i) + 1
End If
Next i
End Sub
' Note: ' No information about lagged statuses. Uses the status for the base year for whole period
' Note: Possible to move this procedure to start data program
' Procedure call from c00_Init
Public Sub Init_Occupational_Pension_Rights()
'!-- Initiation of occupational pension stocks in DC systems
status "Init occupational pensions"
Printdok " Init_Occupational_Pension_Rights"
Dim i As Long
Dim tak As Double
Dim yr As Integer
Dim rand() As Double, r1 As Double, r2 As Double
Dim Interest_long As Double
For yr = 1977 To base_year
Interest_long = f_GetMakro("Interest_long", yr)
m_basbelopp_f = f_GetMakro("BASBF", yr)
tak = 7.5 * m_basbelopp_f
'*** Draw random numbers
ReDim rand(1 To 2 * m_icount)
Call RANNOR(2 * m_icount, rand(1), yr * 10 + random * Rnd)
For i = 1 To m_icount '-- Loops all individuals
If i_status(i) = 8 And i_abroad(i) = 0 Then
'**** Syntax for function call: x = f_op_pens_rights(fee,fee top, age, born)
Select Case i_sector(i)
Case 1 '-- Blue collar: SAF-LO
If yr >= 1996 Then
i_pr_op_ap(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _
i_age(i), i_born_year(i), 0.02, , tak, 21, 1932)
Else
i_pr_op_ap(i) = 0
End If
i_pr_op_tp(i) = 0
Case 2 '-- White collar: ITPK
i_pr_op_ap(i) = 0
If yr >= 1977 Then
i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _
i_age(i), i_born_year(i), 0.02, , tak, 28, 1939)
Else
i_pr_op_tp(i) = 0
End If
Case 3 '-- State: PA03 & Kåpan
i_pr_op_ap(i) = 0
If yr >= 1991 Then '-- Kåpan
i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _
i_age(i), i_born_year(i), 0.015, , tak, 28)
Else
i_pr_op_tp(i) = 0
End If
Case 4 '-- Local goverment: PFA98
If yr >= 1998 Then '-- PFA98 (Kommunalarbetareförbundets premier)
i_pr_op_ap(i) = f_op_pens_rights(i_inc_taxable1(i), i_age(i), i_born_year(i), _
0.045, 0.021, tak, 28, 1938)
Else
i_pr_op_ap(i) = 0
End If
If yr >= 1998 Then
End If
i_pr_op_tp(i) = 0
Case Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End Select
Else
i_pr_op_ap(i) = 0
i_pr_op_tp(i) = 0
End If
'! -- Cumulative occupational pension rights
' Parameter in distribution below measures uncertainty in investment
' Assumes same average return on occupational pension funds as public premium pension
r1 = rand(i) * Sqr(0.0000001) + (1 + (m_interest_long / 100))
r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_interest_long / 100))
i_pb_op_ap(i) = i_pb_op_ap(i) * r1 + i_pr_op_ap(i)
i_pb_op_tp(i) = i_pb_op_tp(i) * r2 + i_pr_op_tp(i)
Next i
Next yr
' -- Saving 4 year averaged income 1997 x 100 / basb
' Used primarily in cal of transitional rules for local government employees
For i = 1 To m_icount '-- Loops all individuals
i_avg_income_1997(i) = (i_inc_taxable2(i) / m_basbelopp2 + _
i_inc_taxable3(i) / m_basbelopp3 + _
i_inc_taxable4(i) / m_basbelopp4 + _
i_inc_taxable5(i) / m_basbelopp5) * 100 / 4
Next i
End Sub
' Note: Uses truncated pp_hist values years less than base_year-5 years,
' lagged income variables for base_year-5 to base_year
'-- Syntax for function call:
' x = f_hist_income(ix,y)
' ix = index for actual individual
' y = historical year
' basb = basic amount for the historical year
Public Function f_hist_income(ix As Long, y As Integer, basb As Long) As Long
'!-- Returns the historical income for a certain year
Dim j As Integer
f_hist_income = 0
If y < base_year - 5 Then
If pp_hist(ix).n_years > 0 Then
For j = 1 To pp_hist(ix).n_years
If pp_hist(ix).pp_years(j) = y Then
f_hist_income = (pp_hist(ix).pp(j) + 100) * basb / 100
Exit For
End If
Next
End If
Else
Select Case y
Case base_year - 5
f_hist_income = i_inc_taxable5(ix)
Case base_year - 4
f_hist_income = i_inc_taxable4(ix)
Case base_year - 3
f_hist_income = i_inc_taxable3(ix)
Case base_year - 2
f_hist_income = i_inc_taxable2(ix)
Case base_year - 1
f_hist_income = i_inc_taxable1(ix)
Case base_year
f_hist_income = i_inc_taxable(ix)
Case Else
f_hist_income = 0
End Select
End If
End Function
'-- Syntax for function call:
' x = f_op_pens_rights(income,age,born,fee,fee top, top limit, agelimit, bornlimit)
' income = pensionsmedförande lön (i kr)
' age = age of individual
' born = year of birth of individual
' fee = premium (eg 0.035) below a certain limit, eg the social security limit 7,5 basb.
' fee top = premie above the limit (eg 0.035) Optional: Default= fee
' toplim = The limit (eg 7,5 basb) Optional: Default=7.5 basb
' agelim = åldergräns för intjänande (tex 28) Optional: Default= 19
' bornlim = gäller personer födda efter detta år (tex 1943) Optional: Default= 1900
Public Function f_op_pens_rights(income As Long, age As Byte, born As Integer, _
fee As Double, Optional feetop As Double = -1, Optional toplim As Double = -1, _
Optional agelim As Integer = 19, Optional bornlim As Integer = 1900) As Long
'!-- Calculation of occupational pension rights (defined contribution systems)
' for different labour market sectors
If feetop = -1 Then
feetop = fee
End If
If toplim = -1 Then
toplim = 7.5 * m_basbelopp
End If
If age > agelim And born > bornlim Then
If income <= toplim Then
f_op_pens_rights = fee * income
Else
f_op_pens_rights = (fee * toplim) + (feetop * (income - toplim))
End If
End If
End Function
'-- Updates the pension history vectors in pp_hist
' Input:
' ix = index for actual individual
' pp = calculated value for pp_hist(i).pp
' Automatically updated:
' Number of years in pp_hist(i).n_years = n_years + 1
' Income year in pp_hist(i).pp_years = year
' Output: Nothing
Public Sub Update_pp_hist(ix As Long, pp As Integer)
'!-- Updates pension history vectors in pp_hist
ReDim Preserve pp_hist(ix).pp(pp_hist(ix).n_years + 1)
ReDim Preserve pp_hist(ix).pp_years(pp_hist(ix).n_years + 1)
pp_hist(ix).n_years = pp_hist(ix).n_years + 1
pp_hist(ix).pp(pp_hist(ix).n_years) = pp
pp_hist(ix).pp_years(pp_hist(ix).n_years) = year
End Sub
'-- Returns number of ATP years for individual i up to year y
' Input:
' ix = index for actual individual
' year = number of ATP years up to this year
Public Function f_pp_years(ix As Long, year As Integer) As Byte
'!-- Number of ATP years for individual i up to year y
Dim y As Integer
f_pp_years = 0
If pp_hist(ix).n_years > 0 Then
For y = 1 To pp_hist(ix).n_years
If pp_hist(ix).pp_years(y) <= year Then
f_pp_years = f_pp_years + 1
Else
Exit For
End If
Next
End If
End Function
' -- Returns the ratio used for adjustment of calculated ATP-pension for early /
' late retirement (Note: time unit = month)
' Default values from public ATP system
' Input: pensage = early or late pension in years compared to 65 year
' early = monthly down correction if early pension. Optional, default=005% per month
' early=-999 means actuarial calculation
' late = monthly up correction if late pension. Optional, default=007% per month
' Note: explife and m_interest_short must be defined before execution
'Examples: x=f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i)),0.005,0.007) or x=f_fu_kvot(f_ap_pensage(i),-999)
'-----------------------------------------------------------------------------------------
Public Function f_fu_kvot(pensage As Byte, Optional Early As Double = 0.005, Optional Late As Double = 0.007) As Double
'!-- Returns the ratio used for adjustment of calculated ATP-pension for early /
'! late retirement (Note: time unit = month)
Dim rate As Double '-- Yearly discounting factor
rate = m_interest_long / 100 'Standardantagande: Långränta
If Early = -999 Then '-- Code -999 for actuarial calculation (Ja, jag vet: Ett hack)
f_fu_kvot = Pmt(rate, explife(pensage), PV(rate, explife(65), 1))
Else
Select Case pensage
Case Is < 60 ' No pensions before 60
MsgBox ("Error in f_fu_kvot: Check pension age in function call")
Case Is < 65 ' -- Early withdrawal
f_fu_kvot = 1 + ((pensage - 65) * Early * 12)
Case 65 ' -- 65 years
f_fu_kvot = 1
Case Is <= 70 ' -- Late withdrawal
f_fu_kvot = 1 + ((pensage - 65) * Late * 12)
Case Is > 70
MsgBox ("Error in f_fu_kvot: Check pension age in function call")
End Select
End If
End Function
'-- Returns basic pension ratio used for calculation of i_ap_fp, i_ap_fp30, i_ap_pts etc
' Input: Civil status 0=Not married, 1= Married
' Note: m_ap_fp_kvot_ogifta and m_ap_fp_kvot_gifta must be initiated before execution
Public Function f_ap_fp_kvot(civ_stat As Byte) As Double
If civ_stat = 0 Then
f_ap_fp_kvot = m_ap_fp_kvot_ogifta
ElseIf civ_stat = 1 Then
f_ap_fp_kvot = m_ap_fp_kvot_gifta
Else
MsgBox "Fel i f_ap_fp_kvot: Parameter ska vara 0 eller 1"
End If
End Function
'-- Reduction of benefits on account of inadequate period of service
' In swedish: Tjänstetidsfaktor
'Note: Not indepent. Uses pp-history
' Examples: x= f_red_service_time(i,f_krav_atp_ar(i_borm_year(i))
Public Function f_red_service_time(ix As Long, Optional limit As Integer = 30) As Double
'!-- Tjänstetidsfaktor
f_red_service_time = mini(1, (pp_hist(ix).n_years) / limit)
End Function
'-- Calculates the income pension annuity factors (delningstal), annuity facors for
' premium pension and inheritance gains
' Annuity factors caculated on death hazards in assumptions file
' Income pension: dtalip(age 50-106) with 1,6% norm growth as default
' Premium pension: dtalpp(age 50-106) default 3.2%. If 0 expected remaining lifetime
' Inheritance gains based on a direct and simplified method based on death hazards
' i.e. no summing up of actual cumulated pension funds for persons younger than 60
' Creates a public array defined from 0 to 106 years: Arvsvinstfactor(y=0-106)
' Note: Call and defintion of global variables in new_economy_2 once a year
Public Sub Calculate_Deltal(Optional norm As Double = 1.016, Optional normpp As Double = 1)
'!-- Calculates pension annuity factors (delningstal)
'!-- and inheritance factors (arvsvinstfaktor)
Printdok " Calculate_Deltal"
Dim maxyear As Long
Dim B(0 To 106, 1 To 2) As Double
Dim q(0 To 106, 1 To 2) As Double
Dim lx(0 To 106, 1 To 2) As Double
Dim lx_(0 To 106) As Double
Dim sex As Long, year As Long, age As Long, n As Long, x As Long, k As Long, j As Long
Dim pop As Double, d As Double, e As Double, r As Double
year = model_time + base_year
maxyear = mini(2050, year)
Dim q_lag As Double, l As Integer
For sex = 1 To 2
pop = 100000
For age = 0 To 106
q_lag = 1
For l = 1 To 5 '-- 5-year smoothed hazards
q_lag = q_lag * parm_death(mini(2110, maxi(1999, year - l)), age, sex)
Next
q_lag = q_lag ^ (1 / 5)
pop = pop * (1 - q_lag)
B(age, sex) = pop
Next
Next
For sex = 1 To 2
For age = 0 To 106
If age < 106 Then
lx(age, sex) = (B(age, sex) + B(age + 1, sex)) / 2
Else
lx(age, sex) = B(age, sex)
End If
Next
Next
For age = 1 To 106 '-- Note: One year shift i age, i.e age 0 = -1 etc.
lx_(age) = (lx(age - 1, 1) * 0.5145) + (lx(age - 1, 2) * (1 - 0.5145))
Next
For n = 50 To 106
d = 0
e = 0
r = 0
For x = 0 To 11
For k = n To 105
d = d + ((norm) ^ (-(k - n))) * _
(lx_(k) + (lx_(k + 1) - lx_(k)) _
* (x / 12)) * (norm) ^ (-x / 12)
e = e + (normpp) ^ (-(k - n)) * _
(lx_(k) + (lx_(k + 1) - lx_(k)) _
* (x / 12)) * (normpp) ^ (-x / 12)
r = r + (1) ^ (-(k - n)) * _
(lx_(k) + (lx_(k + 1) - lx_(k)) _
* (x / 12)) * (1) ^ (-x / 12)
Next
Next
dtalip(n) = round(d / (12 * lx_(n)), 2)
dtalpp(n) = round(e / (12 * lx_(n)), 2)
explife(n) = r / (12 * lx_(n))
Next
For age = 1 To 106
Arvsvinstfaktor(age) = 1 + ((lx_(age - 1) - lx_(age)) / lx_(age))
Next
'-- Optional switch to exogenous "Orange envelopes"-annuity factors
If get_scalefactor_active("Pension_Orange") = 1 And year >= 2003 Then
dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249")
dtalpp(65) = f_GetMakro("dtal_rfvpp", CInt(maxyear), "dtal_rfv")
End If
'-- Optional switch to exognous discounted expected remaining lifetime according to
' RFV 2002.
' Note: Only active if pensions at age 65, and for year 2003 to 2100.
If get_scalefactor_active("Deltal_RFV") = 1 Then
If year > 2002 Then
dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249")
End If
End If
End Sub
Public Function f_krav_atp_ar(born_year As Integer) As Integer
'! -- Calculates required number of years for ATP for different cohorts
Select Case born_year
Case Is > 1923
f_krav_atp_ar = 30
Case 1915 To 1923
f_krav_atp_ar = 20 + born_year - 1914
Case Else
f_krav_atp_ar = 20
End Select
End Function
Public Function f_utfasning_ATP(born_year As Integer, ap_pens_year As Integer) As Double
'! -- Calculates parameter for phasing out the ATP system Note: > 1953 = 1 and <1938 = 0
' Includes transitions rules for persons born 1938 and 1939
Select Case born_year
Case Is > 1953
f_utfasning_ATP = 1
Case 1938 To 1953
If born_year <= 1939 And ap_pens_year <= 2000 And year <= 2003 Then
f_utfasning_ATP = 0
Else
f_utfasning_ATP = (born_year - 1937 + 3) / 20
End If
Case Else
f_utfasning_ATP = 0
End Select
End Function
' Note: If i_ap_pensmonth <0 => early withdrawal (in months), >0 late, 0 = pensage=65
' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal
'Public Function f_ap_pensage(idxnr As Long) As Byte
Public Function f_ap_pensage(pensmonth As Integer) As Byte
'! -- Calculates pension age in years
f_ap_pensage = 65 + Int(pensmonth / 12)
End Function
' -- Calculates pension year (ex post and ex ante).
' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal
' from the default value 65.
'Public Function f_ap_pensyear(idxnr As Long) As Integer
Public Function f_ap_pensyear(year As Integer, age As Byte, pensmonth As Integer) As Integer
'! -- Calculates pension year
'f_ap_pensyear = year - (i_age(idxnr) - (65 + Int(i_ap_pensmonth(idxnr) / 12)))
f_ap_pensyear = year - (age - (65 + Int(pensmonth / 12)))
End Function
' -- Choice of price indexation method
' Note: Price indexation m_basbelopp / m_basbelopp1 not m_KPI, but same result in steady state.
Public Function f_pens_index(program As String, age As Byte) As Double
'! -- Calculates actual price indexation method for different pension programs and years
Select Case year
Case Is >= 2003
Select Case program
Case "ATP" '-- LIP 5 kap, 14§
If age < 65 Then '-- Before age 65 only price indexing
f_pens_index = m_basbelopp / m_basbelopp1
Else '-- Discounted income indexation after age 65 (Följsamhetsindexering)
f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm)
End If
Case "IP"
f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm)
Case "GP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "OP" '-- Payed out defined benefit occupational pensions
f_pens_index = m_basbelopp / m_basbelopp1
Case Else
f_pens_index = 0
End Select
Case Is <= 2001
Select Case program
Case "ATP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "FP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "PTS"
f_pens_index = m_basbelopp / m_basbelopp1
Case "IP" '-- Eg kan uttag av IP ske f 2001, men ej Sesim
f_pens_index = 0
Case "OP" '-- Payed out defined benefit occupational pensions
f_pens_index = m_basbelopp / m_basbelopp1
Case Else
f_pens_index = 0
End Select
Case 2002
Select Case program
Case "ATP" '-- Enl Prop 1999/00:138, sid 72
'f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / m_ap_norm)
f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996)
Case "FP"
f_pens_index = m_basbelopp / m_basbelopp1
Case "PTS"
f_pens_index = m_basbelopp / m_basbelopp1
Case "IP"
' **** Skall ev vara 1.026 i nämnaren???
f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996)
Case "OP" '-- Payed out defined benefit occupational pensions
f_pens_index = m_basbelopp / m_basbelopp1
Case Else
f_pens_index = 0
End Select
End Select
End Function
'! -- Reformed basic retirement pensions for individuals born from 1938 on
' Garantipension för personer födda from 1938
' Output: Reformed basic pension, current SEK Utbetald garantipension
Public Function f_ap_garp_38_(civ_stat As Byte, basbelopp As Long, ap_tp As Long, _
ap_fiktiv As Long, surv As Long) As Long
'! -- Reformed basic retirement pensions Garantipension
Dim berunderlag As Long
berunderlag = ap_tp + ap_fiktiv + surv
Select Case civ_stat '-- Marital status
Case 0 '-- Not married
If berunderlag <= 1.26 * basbelopp Then
f_ap_garp_38_ = (2.13 * basbelopp) - berunderlag
Else
f_ap_garp_38_ = maxi(0, ((2.13 - 1.26) * basbelopp) - 0.48 * _
(berunderlag - (1.26 * basbelopp)))
End If
Case 1 '-- Married
If berunderlag <= 1.14 * basbelopp Then
f_ap_garp_38_ = 1.9 * basbelopp - berunderlag
Else
f_ap_garp_38_ = maxi(0, ((1.9 - 1.14) * basbelopp) - 0.48 * _
(berunderlag - (1.14 * basbelopp)))
End If
End Select
End Function
'! -- Transitional reformed basic retirement pension for individuals born until 1938
' f.d. Övergångsvis garantipension för indvider födda tom 1937
Public Function f_ap_garp_37(civ_stat As Byte, basbelopp As Long, _
ap_atp As Long, ap_fp30 As Long, ap_fp As Long, ap_pts As Long, _
surv As Long, op As Long, botid As Integer) As Long
Dim berunderlag As Long
Dim berunderlag_korr As Long
'!-- 1: Beräkning av beräkningsunderlag
berunderlag = ap_atp + maxi(ap_fp30, ap_fp) + ap_pts + surv + op
'!-- 2: Uppräkning av beräkningsunderlag som komp för SGA
If berunderlag <= 0.25 * basbelopp Then
berunderlag_korr = berunderlag * 1.04
ElseIf berunderlag > 0.25 * basbelopp And berunderlag < 1.354 * basbelopp Then
berunderlag_korr = 1.5174 * berunderlag - 0.1193 * basbelopp
Else
Select Case civ_stat '-- Marital status
Case 0 '-- Not married
If berunderlag >= 1.354 * basbelopp And berunderlag < 1.529 * basbelopp Then
berunderlag_korr = 1.343 * berunderlag + 0.1168 * basbelopp
ElseIf berunderlag >= 1.529 * basbelopp And berunderlag < 3.16 * basbelopp Then
berunderlag_korr = 2.17 * basbelopp + 0.6 * (berunderlag - 1.51 * basbelopp)
Else
berunderlag_korr = berunderlag
End If
Case 1 '-- Married
If berunderlag >= 1.354 * basbelopp And berunderlag < 2.8275 * basbelopp Then
berunderlag_korr = 1.935 * basbelopp + 0.6 * (berunderlag - 1.34 * basbelopp)
Else
berunderlag_korr = berunderlag
End If
End Select
End If
'!-- 3: Beräkning av garantipension mht inkomst, civilstånd etc
f_ap_garp_37 = maxi(0, berunderlag_korr - (ap_atp + ap_fp30 + surv + op)) _
* mini(1, botid / 40)
End Function
' Note: Do NOT use in loops
Public Function f_GetMakro(Namn As String, yr As Integer, Optional typ As String = "Macro") As Double
'!-- Reading data from table T_DATA in Sesimrun.MDB
'! If no hit in the database the latest number is retained
On Error Resume Next
Dim rs As New ADODB.Recordset, cn As New ADODB.Connection
Dim SQL As String
SQL = "select * from T_Data where (Type='" & typ & "' AND Name='" & Namn & "' AND year=" & yr & ")"
rs.Open SQL, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sesimpath & "\source\sesim.mdb" _
& "; Persist Security Info=False"
f_GetMakro = rs![value]
End Function
'**** Note: Its faster write direct to a file witout open and close within the loop as in the procedure
' below
' Syntax: Print_to_file
' "filenamne"
' "{Y/N}" = "Y" if New file, "N" if append
' any number of variable names incl index within () or text strings
' within "", all comma separated
' Example: Print_to_file "valid_pens.txt", "N", i, year, i_age(i), i_sex(i)
' Examples also in procedure "Pension_debugging_files" in this module
Sub Print_to_file(filn As String, Clear As String, ParamArray var() As Variant)
'!-- General procedure for printing of text or variables to a file
Dim demofile As Integer
Dim x As Variant
Dim utvar As String
demofile = FreeFile
If Clear = "Y" Then
Open sesimpath & "\" & filn For Output As #demofile
Else
Open sesimpath & "\" & filn For Append As #demofile
End If
For Each x In var
utvar = utvar & CStr(x) & Chr$(9)
Next x
Print #demofile, utvar
Close #demofile
End Sub
Public Function f_Concat_string(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string = f_Concat_string & CStr(x) & Chr$(9)
Next x
End Function
Public Function f_Concat_string_space(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string_space = f_Concat_string_space & CStr(round(x, 5)) & Chr$(32)
Next x
End Function
Public Function f_Concat_string_comma(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string_comma = f_Concat_string_comma & CStr(x) & Chr$(44)
Next x
End Function
Public Function f_Concat_string_cita(ParamArray var() As Variant)
'-- Concatenates any number of arguments to a string (tab separated)
Dim x As Variant
For Each x In var
f_Concat_string_cita = f_Concat_string_cita & Chr$(34) & CStr(x) & Chr$(34) & Chr$(32)
Next x
End Function
Public Function f_pens_bas(program As String) As Double
'! -- Choice of basic amount definition for different pension programs and years
Select Case year
Case Is >= 2003
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp_income
Case "OP"
f_pens_bas = m_basbelopp_income
Case "IP"
f_pens_bas = m_basbelopp_income
Case "GP" '-- Optional choce of income indexation in Control Center - Parameters
' If income indexation wanted set m_ap_gp_Inkindex_On On=1 for actual years
f_pens_bas = m_basbelopp_gp
Case Else
f_pens_bas = 0
End Select
Case 1997 To 1998 '-- Minskat basbelopp tom 1998
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp * 0.98
Case "OP"
f_pens_bas = m_basbelopp * 0.98
Case "FP"
f_pens_bas = m_basbelopp * 0.98
Case "PTS"
f_pens_bas = m_basbelopp * 0.98
Case Else
f_pens_bas = 0
End Select
Case 1999 To 2001
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp
Case "OP"
f_pens_bas = m_basbelopp
Case "FP"
f_pens_bas = m_basbelopp
Case "PTS"
f_pens_bas = m_basbelopp
Case Else
f_pens_bas = 0
End Select
Case 2002
Select Case program
Case "ATP"
f_pens_bas = m_basbelopp_income
Case "OP"
f_pens_bas = m_basbelopp_income
Case "FP"
f_pens_bas = m_basbelopp
Case "PTS"
f_pens_bas = m_basbelopp
Case Else
f_pens_bas = 0
End Select
End Select
End Function
'-- Calculation of some macro variables for reporting
Public Sub Calculate_Macro()
Dim Bef(1 To 6) As Double, p(1 To 6) As Double, status(1 To 9) As Long
Dim Bef_Status_Sex() As Long, maxyear As Integer
Dim i As Long, j As Long, s As Long
Dim Bef5(1 To 22) As Long, Bef5_M(1 To 22) As Long, Bef5_K(1 To 22) As Long
Dim AK5(1 To 22) As Long, AK5_M(1 To 22) As Long, AK5_K(1 To 22) As Long
Dim AL5(1 To 22) As Long, AL5_M(1 To 22) As Long, AL5_K(1 To 22) As Long
Dim akbef1664_p As Double, al1664_p As Double, aptot_p As Double, apsys_p As Double
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
'!-- Calculation and aggregation of some macro variables
Printdok " Calculate_Macro"
m_inc_earning = L_SUMVEC(i_inc_earning(1), m_icount) * m_weight
m_arbavg = L_SUMVEC(i_arbavg(1), m_icount) * m_weight ' m_arbavg_p * m_inc_earning
m_arbavg_pens = L_SUMVEC(i_arbavg_pens(1), m_icount) * m_weight ' m_arbavg_pens_p * m_inc_earning
m_arbavg_ovr = m_arbavg - m_arbavg_pens
m_pr_op = (L_SUMVEC(i_pr_op_ap(1), m_icount) + L_SUMVEC(i_pr_op_tp(1), m_icount)) * m_weight
m_arbavg_slon = m_arbavg_slon_p * m_pr_op
m_pgi_bas = L_SUMVEC(i_pgi_bas(1), m_icount) * m_weight
m_pgi_bas_n = cnt0(i_pgi_bas) * m_weight
m_pgi_bas_gt_basb = sumif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight
m_pgi_bas_gt_basb_n = cntif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight / 1000
'-- Participation rate etc.
ReDim Bef_Status_Sex(0 To 106, 1 To 9, 1 To 2) As Long
For i = 1 To m_icount
If i_abroad(i) = 0 Then
Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) = _
Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) + 1
End If
Next
For i = 0 To 106
For j = 1 To 8
Bef5_M(Int(i / 5) + 1) = Bef5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1)
Bef5_K(Int(i / 5) + 1) = Bef5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 2)
Bef5(Int(i / 5) + 1) = Bef5(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1) + _
Bef_Status_Sex(i, j, 2)
Next
AK5_M(Int(i / 5) + 1) = AK5_M(Int(i / 5) + 1) + _
Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1)
AK5_K(Int(i / 5) + 1) = AK5_K(Int(i / 5) + 1) + _
Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2)
AK5(Int(i / 5) + 1) = AK5(Int(i / 5) + 1) + _
Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) + _
Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2)
AL5_M(Int(i / 5) + 1) = AL5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 1)
AL5_K(Int(i / 5) + 1) = AL5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 2)
Next
For j = 1 To 9
For i = 0 To 106
status(j) = status(j) + Bef_Status_Sex(i, j, 1) + Bef_Status_Sex(i, j, 2)
Next
Next
m_BEFM0015 = 0
m_BEFK0015 = 0
m_BEFM1664 = 0
m_BEFK1664 = 0
m_BEFM65WW = 0
m_BEFK65WW = 0
Dim AK1664 As Long
For i = 0 To 15
For j = 1 To 8
m_BEFM0015 = m_BEFM0015 + Bef_Status_Sex(i, j, 1)
m_BEFK0015 = m_BEFK0015 + Bef_Status_Sex(i, j, 2)
Next
Next
For i = 16 To 64
AK1664 = AK1664 + Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) _
+ Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2)
For j = 1 To 8
m_BEFM1664 = m_BEFM1664 + Bef_Status_Sex(i, j, 1)
m_BEFK1664 = m_BEFK1664 + Bef_Status_Sex(i, j, 2)
Next
Next
For i = 65 To 106
For j = 1 To 8
m_BEFM65WW = m_BEFM65WW + Bef_Status_Sex(i, j, 1)
m_BEFK65WW = m_BEFK65WW + Bef_Status_Sex(i, j, 2)
Next
Next
'-- Definition of macrovariables for different agegroups
' Labour supply = Sesim status 5+6+8.
' Note: Persons in labour market programs out of labour force included
m_AKM1619 = (AK5_M(4)) * m_weight / 1000
m_AKK1619 = (AK5_K(4)) * m_weight / 1000
m_AKM2024 = (AK5_M(5)) * m_weight / 1000
m_AKK2024 = (AK5_K(5)) * m_weight / 1000
m_AKM2529 = (AK5_M(6)) * m_weight / 1000
m_AKK2529 = (AK5_K(6)) * m_weight / 1000
m_AKM3034 = (AK5_M(7)) * m_weight / 1000
m_AKK3034 = (AK5_K(7)) * m_weight / 1000
m_AKM3539 = (AK5_M(8)) * m_weight / 1000
m_AKK3539 = (AK5_K(8)) * m_weight / 1000
m_AKM4044 = (AK5_M(9)) * m_weight / 1000
m_AKK4044 = (AK5_K(9)) * m_weight / 1000
m_AKM4549 = (AK5_M(10)) * m_weight / 1000
m_AKK4549 = (AK5_K(10)) * m_weight / 1000
m_AKM5054 = (AK5_M(11)) * m_weight / 1000
m_AKK5054 = (AK5_K(11)) * m_weight / 1000
m_AKM5559 = (AK5_M(12)) * m_weight / 1000
m_AKK5559 = (AK5_K(12)) * m_weight / 1000
m_AKM6064 = (AK5_M(13)) * m_weight / 1000
m_AKK6064 = (AK5_K(13)) * m_weight / 1000
m_AKM6569 = (AK5_M(14)) * m_weight / 1000
m_AKK6569 = (AK5_K(14)) * m_weight / 1000
m_AKM7074 = (AK5_M(15)) * m_weight / 1000
m_AKK7074 = (AK5_K(15)) * m_weight / 1000
m_AKT1664 = AK1664 * m_weight / 1000
' -- Unemployed
m_ALM1619 = (AL5_M(4)) * m_weight / 1000
m_ALK1619 = (AL5_K(4)) * m_weight / 1000
m_ALM2024 = (AL5_M(5)) * m_weight / 1000
m_ALK2024 = (AL5_K(5)) * m_weight / 1000
m_ALM2529 = (AL5_M(6)) * m_weight / 1000
m_ALK2529 = (AL5_K(6)) * m_weight / 1000
m_ALM3034 = (AL5_M(7)) * m_weight / 1000
m_ALK3034 = (AL5_K(7)) * m_weight / 1000
m_ALM3539 = (AL5_M(8)) * m_weight / 1000
m_ALK3539 = (AL5_K(8)) * m_weight / 1000
m_ALM4044 = (AL5_M(9)) * m_weight / 1000
m_ALK4044 = (AL5_K(9)) * m_weight / 1000
m_ALM4549 = (AL5_M(10)) * m_weight / 1000
m_ALK4549 = (AL5_K(10)) * m_weight / 1000
m_ALM5054 = (AL5_M(11)) * m_weight / 1000
m_ALK5054 = (AL5_K(11)) * m_weight / 1000
m_ALM5559 = (AL5_M(12)) * m_weight / 1000
m_ALK5559 = (AL5_K(12)) * m_weight / 1000
m_ALM6064 = (AL5_M(13)) * m_weight / 1000
m_ALK6064 = (AL5_K(13)) * m_weight / 1000
m_ALM6569 = (AL5_M(14)) * m_weight / 1000
m_ALK6569 = (AL5_K(14)) * m_weight / 1000
m_ALM7074 = (AL5_M(15)) * m_weight / 1000
m_ALK7074 = (AL5_K(15)) * m_weight / 1000
' Population = Status 1 to 8. Not persons abroad.
m_BEFM0014 = (Bef5_M(1) + Bef5_M(2) + Bef5_M(3)) * m_weight / 1000
m_BEFK0014 = (Bef5_K(1) + Bef5_K(2) + Bef5_K(3)) * m_weight / 1000
m_BEFM0015 = m_BEFM0015 * m_weight / 1000
m_BEFK0015 = m_BEFK0015 * m_weight / 1000
m_BEFM1519 = (Bef5_M(4)) * m_weight / 1000
m_BEFK1519 = (Bef5_K(4)) * m_weight / 1000
m_BEFM1619 = (Bef5_M(4) - Bef_Status_Sex(15, 1, 1)) * m_weight / 1000
m_BEFK1619 = (Bef5_K(4) - Bef_Status_Sex(15, 1, 2)) * m_weight / 1000
m_BEFM2024 = Bef5_M(5) * m_weight / 1000
m_BEFK2024 = Bef5_K(5) * m_weight / 1000
m_BEFM2529 = (Bef5_M(6)) * m_weight / 1000
m_BEFK2529 = (Bef5_K(6)) * m_weight / 1000
m_BEFM3034 = (Bef5_M(7)) * m_weight / 1000
m_BEFK3034 = (Bef5_K(7)) * m_weight / 1000
m_BEFM3539 = (Bef5_M(8)) * m_weight / 1000
m_BEFK3539 = (Bef5_K(8)) * m_weight / 1000
m_BEFM4044 = (Bef5_M(9)) * m_weight / 1000
m_BEFK4044 = (Bef5_K(9)) * m_weight / 1000
m_BEFM4549 = (Bef5_M(10)) * m_weight / 1000
m_BEFK4549 = (Bef5_K(10)) * m_weight / 1000
m_BEFM5054 = (Bef5_M(11)) * m_weight / 1000
m_BEFK5054 = (Bef5_K(11)) * m_weight / 1000
m_BEFM5559 = (Bef5_M(12)) * m_weight / 1000
m_BEFK5559 = (Bef5_K(12)) * m_weight / 1000
m_BEFM6064 = (Bef5_M(13)) * m_weight / 1000
m_BEFK6064 = (Bef5_K(13)) * m_weight / 1000
m_BEFM6569 = (Bef5_M(14)) * m_weight / 1000
m_BEFK6569 = (Bef5_K(14)) * m_weight / 1000
m_BEFM7074 = (Bef5_M(15)) * m_weight / 1000
m_BEFK7074 = (Bef5_K(15)) * m_weight / 1000
m_BEFM1664 = m_BEFM1664 * m_weight / 1000
m_BEFK1664 = m_BEFK1664 * m_weight / 1000
m_BEFM65WW = m_BEFM65WW * m_weight / 1000
m_BEFK65WW = m_BEFK65WW * m_weight / 1000
'!-- Effective retirement age. (Ministry of Health and Social affairs definition)
For i = 1 To 6
p(i) = AK5(i + 9) / Bef5(i + 9)
Next
m_pensage = ((p(1) - p(2)) * 50 + (p(2) - p(3)) * 55 + (p(3) - p(4)) * 60 + _
(p(4) - p(5)) * 65 + (p(5) - p(6)) * 70 + p(6) * 72) / p(1)
'-- Labour market macro variables with labour market survey (AKU) definitions
'-- Reading data from assumptions file
akbef1664_p = parm_macro(maxyear, 16) / 100
al1664_p = parm_macro(maxyear, 17) / 100
aptot_p = parm_macro(maxyear, 18) / 100
apsys_p = parm_macro(maxyear, 19) / 100
' Fix if data is missing
' If akbef1664_p = 0 Then akbef1664_p = 0.78
' If al1664_p = 0 Then al1664_p = 0.04
' If aptot_p = 0 Then aptot_p = 0.02
' If apsys_p = 0 Then apsys_p = 0.004
If (al1664_p + aptot_p) > 0 Then
m_AAL1664 = ((al1664_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000
m_AAPTOT = ((aptot_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000
m_AAPSYS = ((apsys_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000
End If
m_ASY1664 = (status(5) + status(8) - (AK5(14) + AK5(15))) * (m_weight / 1000) + m_AAPSYS
m_AAK1664 = m_ASY1664 + m_AAL1664
'-- Reguljär sysselsättning 20-64 enligt målet
m_ASY2064R = 0
For i = 1 To m_icount
If i_age(i) >= 20 And i_age(i) < 65 And (i_status(i) = 5 Or i_status(i) = 8) Then
m_ASY2064R = m_ASY2064R + 1
End If
Next
m_ASY2064R = m_ASY2064R * (m_weight / 1000)
'-- Summering av stockar - sum of pension assets
' -- Public premium pension fund - Premiepensionsfonder
m_ap_ppfond = (m_ap_ppfond * (1 + (m_shares_return / 100)) * (1 - m_favg_pp)) + _
(((L_SUMVEC(i_pr_pp(1), m_icount) * m_weight) - m_ap_pp_ut) * (1 + (m_interest_short / 100) / 2))
' -- Occupational pension funds - Avtalspensionsfonder
m_op_fond = (m_op_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _
((L_SUMVEC(i_pr_op_ap(1), m_icount) - L_SUMVEC(i_op_ap_dc(1), m_icount) + _
L_SUMVEC(i_pr_op_tp(1), m_icount) - L_SUMVEC(i_op_ap_tp(1), m_icount)) * _
(1 + (m_interest_short * (1 - 0.15) / 100) / 2) * m_weight)
' -- Private tax deductible pension saving funds - Privat pensionssparande
' Note: 15 % tax (avkastningskatt) on return of pension capital (15% av statslåneräntan egentligen)
m_pp_fond = (m_pp_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _
((L_SUMVEC(i_wealth_pension_year(1), m_icount) - L_SUMVEC(i_pp(1), m_icount)) * _
(1 + ((m_interest_short * (1 - 0.15)) / 100) / 2) * m_weight)
'-- Summering av pensionsutgifter från AP-systemet
' If year >= 2003 Then
' m_ap_ip_ut = (L_SUMVEC(i_ap_ip(1), m_icount) * m_weight) _
' + (0.5 * m_ap_ip_dead)
' End If
'-- BNP etc
m_bnpaf = parm_macro(maxyear, 22)
m_bnpal = parm_macro(maxyear, 21)
End Sub
Sub Print_Pension_Cohort()
'-- Printing of cohort data for pensions
' age sex abroad variable
Dim pens(0 To 106, 2, 2, 15) As Double, pens_n(0 To 106, 2, 2, 15) As Double
Dim age As Integer, i As Long, utvar As String
Dim A As Integer, s As Integer, v As Integer, u As Integer
'-- Summing up
For i = 1 To m_icount
age = mini(i_age(i), 106)
'-- 1 PGI, 2 PGB, 3 PU, 4 PR_IP, 5 PB_IP, 6 AP_AP, 7 AP_TP, 8 AP_IP,
' 9 AP_GP, 10 PR_PP, 11 PB_PP, 12 AP_PP, 13 AP_AVG_AP
'-- 1 I_PGI
pens(age, i_sex(i), i_abroad(i) + 1, 1) = pens(age, i_sex(i), _
i_abroad(i) + 1, 1) + (i_pgi(i) * m_weight / 1000000)
If i_pgi(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 1) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 1) + m_weight
End If
'-- 2 I_PGB
pens(age, i_sex(i), i_abroad(i) + 1, 2) = pens(age, i_sex(i), _
i_abroad(i) + 1, 2) + (i_pgb(i) * m_weight / 1000000)
If i_pgb(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 2) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 2) + m_weight
End If
'-- 3 I_PU
pens(age, i_sex(i), i_abroad(i) + 1, 3) = pens(age, i_sex(i), _
i_abroad(i) + 1, 3) + (i_pu(i) * m_weight / 1000000)
If i_pu(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 3) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 3) + m_weight
End If
'-- 4 I_PR_IP
pens(age, i_sex(i), i_abroad(i) + 1, 4) = pens(age, i_sex(i), _
i_abroad(i) + 1, 4) + (i_pr_ip(i) * m_weight / 1000000)
If i_pr_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 4) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 4) + m_weight
End If
'-- 5 I_PB_IP
pens(age, i_sex(i), i_abroad(i) + 1, 5) = pens(age, i_sex(i), _
i_abroad(i) + 1, 5) + (i_pb_ip(i) * m_weight / 1000000)
If i_pb_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 5) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 5) + m_weight
End If
'-- 6 I_AP_AP
pens(age, i_sex(i), i_abroad(i) + 1, 6) = pens(age, i_sex(i), _
i_abroad(i) + 1, 6) + (i_ap_ap(i) * m_weight / 1000000)
If i_ap_ap(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 6) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 6) + m_weight
End If
'-- 7 I_AP_TP
pens(age, i_sex(i), i_abroad(i) + 1, 7) = pens(age, i_sex(i), _
i_abroad(i) + 1, 7) + (i_ap_tp(i) * m_weight / 1000000)
If i_ap_tp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 7) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 7) + m_weight
End If
'-- 8 I_AP_IP
pens(age, i_sex(i), i_abroad(i) + 1, 8) = pens(age, i_sex(i), _
i_abroad(i) + 1, 8) + (i_ap_ip(i) * m_weight / 1000000)
If i_ap_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 8) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 8) + m_weight
End If
'-- 9 I_AP_GP
pens(age, i_sex(i), i_abroad(i) + 1, 9) = pens(age, i_sex(i), _
i_abroad(i) + 1, 9) + (i_ap_gp(i) * m_weight / 1000000)
If i_ap_gp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 9) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 9) + m_weight
End If
'-- 10 I_PR_PP
pens(age, i_sex(i), i_abroad(i) + 1, 10) = pens(age, i_sex(i), _
i_abroad(i) + 1, 10) + (i_pr_pp(i) * m_weight / 1000000)
If i_pr_pp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 10) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 10) + m_weight
End If
'-- 11 I_PB_PP
pens(age, i_sex(i), i_abroad(i) + 1, 11) = pens(age, i_sex(i), _
i_abroad(i) + 1, 11) + (i_pb_pp(i) * m_weight / 1000000)
If i_pb_pp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 11) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 11) + m_weight
End If
'-- 12 I_AP_PP
pens(age, i_sex(i), i_abroad(i) + 1, 12) = pens(age, i_sex(i), _
i_abroad(i) + 1, 12) + (i_ap_pp(i) * m_weight / 1000000)
If i_ap_pp(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 12) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 12) + m_weight
End If
'-- 13 I_AVG_IP
pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _
i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000)
If i_avg_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight
End If
'-- 13 I_AVG_IP
pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _
i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000)
If i_avg_ip(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight
End If
'-- 14 I_PR_IP1
pens(age, i_sex(i), i_abroad(i) + 1, 14) = pens(age, i_sex(i), _
i_abroad(i) + 1, 14) + (i_pr_ip1(i) * m_weight / 1000000)
If i_pr_ip1(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 14) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 14) + m_weight
End If
'-- 15 I_PB_IP1
pens(age, i_sex(i), i_abroad(i) + 1, 15) = pens(age, i_sex(i), _
i_abroad(i) + 1, 15) + (i_pb_ip1(i) * m_weight / 1000000)
If i_pb_ip1(i) > 0 Then
pens_n(age, i_sex(i), i_abroad(i) + 1, 15) = _
pens_n(age, i_sex(i), i_abroad(i) + 1, 15) + m_weight
End If
Next
'-- Printing to file
If model_time = 1 Then
Open sesimpath & "\tempdata\Pension_Cohort.prn" For Output As #71
utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _
"PGI", "PGB", "PU", "PR_IP", "PB_IP", "AP_AP", "AP_TP", "AP_IP", _
"AP_GP", "PR_PP", "PB_PP", "AP_PP", "AP_AVG_AP", "PR_IP1", "PB_IP1", _
"Arvsv", "ap_favg", "balind", "inkind")
Print #71, utvar
Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Output As #72
utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _
"PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PB_IP_N", "AP_AP_N", "AP_TP_N", "AP_IP_N", _
"AP_GP_N", "PR_PP_N", "PB_PP_N", "AP_PP_N", "AP_AVG_AP_N""PR_IP1_N", "PB_IP1_N")
Print #72, utvar
Else
Open sesimpath & "\tempdata\Pension_Cohort.prn" For Append As #71
Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Append As #72
End If
For A = 0 To 106
For s = 1 To 2
For u = 1 To 2
utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _
pens(A, s, u, 1), pens(A, s, u, 2), pens(A, s, u, 3), pens(A, s, u, 4), _
pens(A, s, u, 5), pens(A, s, u, 6), pens(A, s, u, 7), pens(A, s, u, 8), _
pens(A, s, u, 9), pens(A, s, u, 10), pens(A, s, u, 11), pens(A, s, u, 12), _
pens(A, s, u, 13), pens(A, s, u, 14), pens(A, s, u, 15), _
Arvsvinstfaktor(A), m_favg_ip, m_ap_balind, m_ap_inkind)
Print #71, utvar
utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _
pens_n(A, s, u, 1), pens_n(A, s, u, 2), pens_n(A, s, u, 3), pens_n(A, s, u, 4), _
pens_n(A, s, u, 5), pens_n(A, s, u, 6), pens_n(A, s, u, 7), pens_n(A, s, u, 8), _
pens_n(A, s, u, 9), pens_n(A, s, u, 10), pens_n(A, s, u, 11), pens_n(A, s, u, 12), _
pens_n(A, s, u, 13), pens_n(A, s, u, 14), pens_n(A, s, u, 15))
Print #72, utvar
Next u
Next s
Next A
Close #71
Close #72
End Sub
Sub Print_Pensions_Macro()
'!-- Optional printing of macro variables to Aremos-format
status "Printing macro variables to Aremos-format"
Dim utvar As String
Dim demofile As Integer
Dim i As Long, h As Long, wm As Double, wk As Double
year = model_time + base_year
wm = m_weight / 1000000
wk = m_weight / 1000
'-- Some variables for EU AWG04-calculations that requires nested conditions
' Scaling when printing
Dim ap_ut As Double, ovr_pens As Double, ovr_pens_n As Long
Dim ap_inc_ut As Double, ap_inc_off_ut As Double, pr_op As Double, avg_off As Double
Dim ap_ut_n As Long, pens_n As Long, pens_54_n As Long, pens55_59_n As Long, pens60_64_n As Long, pens65_n As Long
Dim ap_inc_ut_n As Long, ap_inc_off_ut_n As Long, pr_op_n As Long, avg_off_n As Long
Dim afs As Double, afs_n As Long, inc_taxable_2 As Double, tax_income_2 As Double
Dim op_off As Double, op_off_n As Long, op_65 As Double, surv_65 As Double
For i = 1 To m_icount
If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i)) > 0 Then
ap_ut = ap_ut + (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i))
ap_ut_n = ap_ut_n + 1
End If
If (i_ap_ap(i) + i_ap_pp_ut(i)) > 0 Then
ap_inc_ut = ap_inc_ut + (i_ap_ap(i) + i_ap_pp_ut(i))
ap_inc_ut_n = ap_inc_ut_n + 1
If (i_sector(i) = 3 Or i_sector(i) = 4) Then
ap_inc_off_ut = ap_inc_off_ut + (i_ap_ap(i) + i_ap_pp_ut(i))
ap_inc_off_ut_n = ap_inc_off_ut_n + 1
End If
End If
If (i_ftp(i) + i_surv(i)) > 0 Then
ovr_pens = ovr_pens + i_ftp(i) + i_surv(i)
ovr_pens_n = ovr_pens_n + 1
End If
If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i) + i_ftp(i) + i_surv(i) + i_op(i)) > 0 Then
pens_n = pens_n + 1
Select Case i_age(i)
Case Is < 54
pens_54_n = pens_54_n + 1
Case Is < 59
pens55_59_n = pens55_59_n + 1
Case Is < 64
pens60_64_n = pens60_64_n + 1
Case Else
pens65_n = pens65_n + 1
End Select
End If
If (i_sector(i) = 3 Or i_sector(i) = 4) And i_avg(i) > 0 Then
avg_off = avg_off + i_avg(i)
avg_off_n = avg_off_n + 1
End If
If (i_sector(i) = 3 Or i_sector(i) = 4) Then
op_off = op_off + i_op(i)
op_off_n = op_off_n + 1
End If
If (i_pr_op_ap(i) + i_pr_op_tp(i)) > 0 Then
pr_op = pr_op + i_pr_op_ap(i) + i_pr_op_tp(i)
pr_op_n = pr_op_n + 1
End If
If i_age(i) > 64 Then
surv_65 = surv_65 + i_surv(i)
op_65 = op_65 + i_op(i)
End If
If i_status(i) = 2 Then
inc_taxable_2 = inc_taxable_2 + i_inc_taxable(i)
tax_income_2 = tax_income_2 + i_tax_income(i)
End If
Next
For h = 1 To m_hcount
If h_max_age(h) > 64 Then
afs = afs + h_trf_socialassistance(h)
afs_n = afs_n + 1
End If
Next
If model_time = 0 Then
Open sesimpath & "\tempdata\Labour_macro.prn" For Output As #41
utvar = f_Concat_string_cita("DATE", "AKT1664", "BEFM1664", "BEFK1664", _
"AKM1619", "AKM2024", "AKM2529", "AKM3034", "AKM3539", "AKM4044", "AKM4549", _
"AKM5054", "AKM5559", "AKM6064", "AKM6569", "AKM7074", _
"AKK1619", "AKK2024", "AKK2529", "AKK3034", "AKK3539", "AKK4044", "AKK4549", _
"AKK5054", "AKK5559", "AKK6064", "AKK6569", "AKM7074", _
"BEFM1619", "BEFM2024", "BEFM2529", "BEFM3034", "BEFM3539", "BEFM4044", "BEFM4549", _
"BEFM5054", "BEFM5559", "BEFM6064", "BEFM6569", "BEFM7074", _
"BEFK1619", "BEFK2024", "BEFK2529", "BEFK3034", "BEFK3539", "BEFK4044", "BEFK4549", _
"BEFK5054", "BEFK5559", "BEFK6064", "BEFK6569", "BEFM7074", _
"BEFM0015", "BEFK0015", "BEFM65WW", "BEFK65WW", _
"BEFM0014", "BEFK0014", "BEFM1519", "BEFK1519", _
"AAL1664", "AAPTOT", "AAPSYS", "ASY1664", "AAK1664", "ASY2064R", _
"ALM1619", "ALM2024", "ALM2529", "ALM3034", "ALM3539", "ALM4044", "ALM4549", _
"ALM5054", "ALM5559", "ALM6064", "ALM6569", "ALM7074", _
"ALK1619", "ALK2024", "ALK2529", "ALK3034", "ALK3539", "ALK4044", "ALK4549", _
"ALK5054", "ALK5559", "ALK6064", "ALK6569", "ALM7074")
Print #41, utvar
Open sesimpath & "\tempdata\Pensions_macro.prn" For Output As #42
utvar = f_Concat_string_cita("DATE", _
"INC_TAX", "PGI", "PGB", "PU", "PR_IP", "PR_PP", "PB_IP", "PB_PP", "FP", "ATP", "AP", _
"AP_IP", "AP_PP", "AP_GP", "AP_TP", "OP", "SURV", "FTP", "AVG_IP", "AVG", "INC_WORK", _
"INC_EARN", "INC_MARK", _
"RWAGE", "RWAGE_99", "INFLATION", "PRICE_99", "BASB", _
"BASB_F", "BASB_INC", "INKIND", "BALIND", "Int_short", "Int_long", _
"PENSAGE", "DTALIP_65", "DTALPP_65", "ARVSV_60", "Shares_Return", "PP", _
"AP_GP_EJ_AP", "AP_AP_SV", "AP_AP_UTL", "pgi_bas", "pgi_bas_gt", _
"PR_IP1", "PR_PP1", _
"AP_IP_UT", "AP_TP_UT", "AP_ATP_UT", "AP_FP30_UT", "AP_PP_UT", "EXPLIFE65", _
"PP_fund", "PP_save", "SURV55", "FTP55")
Print #42, utvar
Open sesimpath & "\tempdata\Pensions_count.prn" For Output As #43
utvar = f_Concat_string_cita("DATE", _
"INC_TAX_N", "PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PR_PP_N", "PB_IP_N", "PB_PP_N", _
"FP_N", "ATP_N", "AP_N", "AP_IP_N", "AP_PP_N", "AP_GP_N", "AP_TP_N", "OP_N", _
"SURV_N", "FTP_N", "AVG_IP_N", "AVG_N", "INC_WORK_N", "INC_EARN_N", "INC_MARK_N", "PP_N", _
"AP_GP_EJ_AP_N", "AP_AP_NSV", "AP_AP_NUTL", "pgi_bas_n", "pgi_bas_gt_n", "PP_fund_n", "PP_save_n", _
"SURV55_N", "FTP55_N")
Print #43, utvar
Open sesimpath & "\tempdata\Transfers_macro.prn" For Output As #44
utvar = f_Concat_string_cita("DATE", "STSHPEAVT", "STKHPEAVT", "ap", "ap_atp", _
"ap_tp", "ap_ip", "ap_pp", "ap_gp", "ap_fp", "STSHFORT", "STSHEFTANK", "STSHEFTBARN", _
"STSHBTP", "STSHSJUK", "STSHFORF", "STSHARBSK", "unemployed", "STSHBARN", _
"study", "STSHSTUDMED", "Study_loan", "STSHBOBI", _
"bidfor_brutto", "STKHSOCBI", "PGI_BAS", "BNPAF", "BNPAL", "STSHBTP_65")
Print #44, utvar
Open sesimpath & "\tempdata\ftp_macro.prn" For Output As #45
utvar = f_Concat_string_cita("DATE", "ap_ut", "ap_inc_ut", "ap_inc_off_ut", _
"ovr_pens", "avg_off", "pr_op", "ap_ut_n", "ap_inc_ut_n", "ap_inc_off_ut_n", "ovr_pens_n", _
"pens_n", "pens_54_n", "pens55_59_n", "pens60_64_n", "pens65_n", "avg_off_n", "pr_op_n", _
"AFS", "AFS_n", "inc_taxable_2", "tax_income_2", "ap_ppfond", "pp_fond", "op_fond", _
"op_off", "op_off_n", "surv_65", "op_65", _
"PR_IP_4", "PR_PP_4", "AP_IP_UT_4", "AP_TP_UT_4", "AP_PP_UT_4", "AP_4", "AP_AP_4", _
"AP_GP_4", "STSHBTP_4", "FTP_INK", "FTP_GAR", "FTP_JUST", _
"PR_IP_4_n", "PR_PP_4_n", "AP_IP_UT_4_n", "AP_TP_UT_4_n", "AP_PP_UT_4_n", "AP_4_n", "AP_AP_4_n", _
"AP_GP_4_n", "STSHBTP_4_n", "FTP_INK_n", "FTP_GAR_n", "FTP_JUST_n", _
"INC_TAX_4", "INC_TAX_4_N") ', "DISP2", "DISP4", "DISP2_4", "DISP")
Print #45, utvar
Else
Open sesimpath & "\tempdata\Labour_macro.prn" For Append As #41
Open sesimpath & "\tempdata\Pensions_macro.prn" For Append As #42
Open sesimpath & "\tempdata\Pensions_count.prn" For Append As #43
Open sesimpath & "\tempdata\Transfers_macro.prn" For Append As #44
Open sesimpath & "\tempdata\ftp_macro.prn" For Append As #45
End If
utvar = f_Concat_string_space(year & "01", m_AKT1664, m_BEFM1664, m_BEFK1664, _
m_AKM1619, m_AKM2024, m_AKM2529, m_AKM3034, m_AKM3539, m_AKM4044, m_AKM4549, _
m_AKM5054, m_AKM5559, m_AKM6064, m_AKM6569, m_AKM7074, _
m_AKK1619, m_AKK2024, m_AKK2529, m_AKK3034, m_AKK3539, m_AKK4044, m_AKK4549, _
m_AKK5054, m_AKK5559, m_AKK6064, m_AKK6569, m_AKM7074, _
m_BEFM1619, m_BEFM2024, m_BEFM2529, m_BEFM3034, m_BEFM3539, m_BEFM4044, m_BEFM4549, _
m_BEFM5054, m_BEFM5559, m_BEFM6064, m_BEFM6569, m_BEFM7074, _
m_BEFK1619, m_BEFK2024, m_BEFK2529, m_BEFK3034, m_BEFK3539, m_BEFK4044, m_BEFK4549, _
m_BEFK5054, m_BEFK5559, m_BEFK6064, m_BEFK6569, m_BEFM7074, _
m_BEFM0015, m_BEFK0015, m_BEFM65WW, m_BEFK65WW, _
m_BEFM0014, m_BEFK0014, m_BEFM1519, m_BEFK1519, _
m_AAL1664, m_AAPTOT, m_AAPSYS, m_ASY1664, m_AAK1664, m_ASY2064R, _
m_ALM1619, m_ALM2024, m_ALM2529, m_ALM3034, m_ALM3539, m_ALM4044, m_ALM4549, _
m_ALM5054, m_ALM5559, m_ALM6064, m_ALM6569, m_ALM7074, _
m_ALK1619, m_ALK2024, m_ALK2529, m_ALK3034, m_ALK3539, m_ALK4044, m_ALK4549, _
m_ALK5054, m_ALK5559, m_ALK6064, m_ALK6569, m_ALK7074)
Print #41, utvar
Close #41
utvar = f_Concat_string_space(year & "01", _
(L_SUMVEC(i_inc_taxable(1), m_icount) * wm), (L_SUMVEC(i_pgi(1), m_icount) * wm), _
(L_SUMVEC(i_pgb(1), m_icount) * wm), (L_SUMVEC(i_pu(1), m_icount) * wm), _
(L_SUMVEC(i_pr_ip(1), m_icount) * wm), (L_SUMVEC(i_pr_pp(1), m_icount) * wm), _
(L_SUMVEC(i_pb_ip(1), m_icount) * wm), (L_SUMVEC(i_pb_pp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _
(L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _
(L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_op(1), m_icount) * wm), _
(L_SUMVEC(i_surv(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _
(L_SUMVEC(i_avg_ip(1), m_icount) * wm), (L_SUMVEC(i_avg(1), m_icount) * wm), _
(L_SUMVEC(i_inc_work(1), m_icount) * wm), _
(L_SUMVEC(i_inc_earning(1), m_icount) * wm), (L_SUMVEC(i_inc_market(1), m_icount) * wm), _
m_realwage, m_realwage_change99, m_inflation, m_price_change99, m_basbelopp, _
m_basbelopp_f, m_basbelopp_income, m_ap_inkind, m_ap_balind, m_interest_short, m_interest_long, _
m_pensage, m_dtalip_65, m_dtalpp_65, m_arvsvinst_60, m_shares_return, (L_SUMVEC(i_pp(1), m_icount) * wm), _
(sumif(i_ap_gp, i_ap_ap, "EQ", 0) * wm), (sumif(i_ap_ap, i_abroad, "EQ", 0) * wm), _
(sumif(i_ap_ap, i_abroad, "EQ", 1) * wm), m_pgi_bas / 1000000, m_pgi_bas_gt_basb / 1000000, _
(L_SUMVEC(i_pr_ip1(1), m_icount) * wm), (L_SUMVEC(i_pr_pp1(1), m_icount) * wm), _
m_ap_ip_ut / 1000000, m_ap_tp_ut / 1000000, m_ap_atp_ut / 1000000, _
m_ap_fp30_ut / 1000000, m_ap_pp_ut / 1000000, explife(65), _
(L_SUMVEC(i_wealth_pension_total(1), m_icount) * wm), (L_SUMVEC(i_wealth_pension_year(1), m_icount) * wm), _
(sumif(i_surv, i_age, "GT", 54) * wm), (sumif(i_ftp, i_age, "GT", 54) * wm))
Print #42, utvar
Close #42
utvar = f_Concat_string_space(year & "01", _
cnt0(i_inc_taxable) * wk, cnt0(i_pgi) * wk, _
cnt0(i_pgb) * wk, cnt0(i_pu) * wk, _
cnt0(i_pr_ip) * wk, cnt0(i_pr_pp) * wk, _
cnt0(i_pb_ip) * wk, cnt0(i_pb_pp) * wk, _
cnt0(i_ap_fp) * wk, cnt0(i_ap_atp) * wk, _
cnt0(i_ap) * wk, cnt0(i_ap_ip) * wk, _
cnt0(i_ap_pp) * wk, cnt0(i_ap_gp) * wk, _
cnt0(i_ap_tp) * wk, cnt0(i_op) * wk, _
cnt0(i_surv) * wk, cnt0(i_ftp) * wk, _
cnt0(i_avg_ip) * wk, cnt0(i_avg) * wk, _
cnt0(i_inc_work) * wk, _
cnt0(i_inc_earning) * wk, cnt0(i_inc_market) * wk, _
cnt0(i_pp) * wk, _
cntstatusif(i_ap_gp, i_ap_ap, "EQ", 0, 2) * wk, _
cntstatusif(i_ap_ap, i_abroad, "EQ", 0, 2) * wk, _
cntstatusif(i_ap_ap, i_abroad, "EQ", 1, 2) * wk, _
m_pgi_bas_n, m_pgi_bas_gt_basb_n, _
cnt0(i_wealth_pension_total) * wk, cnt0(i_wealth_pension_year) * wk, _
(cntif(i_surv, i_age, "GT", 54) * wm), (cntif(i_ftp, i_age, "GT", 54) * wm))
Print #43, utvar
Close #43
utvar = f_Concat_string_space(year & "01", _
(sumif(i_op, i_sector, "EQ", 3) * wm), (sumif(i_op, i_sector, "EQ", 4) * wm), _
(L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _
(L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _
(L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _
(sumif(i_surv, i_age, "GT", 17) * wm), (sumif(i_surv, i_age, "LT", 18) * wm), _
(L_SUMVEC(h_trf_btp(1), m_hcount) * wm), (L_SUMVEC(i_trf_sickleave(1), m_icount) * wm), _
(L_SUMVEC(i_trf_parentleave(1), m_icount) * wm), (L_SUMVEC(i_trf_skada(1), m_icount) * wm), _
(L_SUMVEC(i_trf_unemployed(1), m_icount) * wm), (L_SUMVEC(h_trf_childallowance(1), m_hcount) * wm), _
(L_SUMVEC(i_trf_study(1), m_icount) * wm), (L_SUMVEC(i_trf_study_grant(1), m_icount) * wm), _
(L_SUMVEC(i_trf_study_loan(1), m_icount) * wm), (L_SUMVEC(h_trf_housingallowance(1), m_hcount) * wm), _
(L_SUMVEC(h_maintenance_received(1), m_hcount) * wm), (L_SUMVEC(h_trf_socialassistance(1), m_hcount) * wm), _
(L_SUMVEC(i_pgi_bas(1), m_icount) * wm), m_bnpaf, m_bnpal, (sumif(h_trf_btp, i_age, "GT", 64) * wm))
Print #44, utvar
Close #44
utvar = f_Concat_string_space(year & "01", _
ap_ut * wm, ap_inc_ut * wm, ap_inc_off_ut * wm, ovr_pens * wm, avg_off * wm, pr_op * wm, _
ap_ut_n * wk, ap_inc_ut_n * wk, ap_inc_off_ut_n * wk, ovr_pens_n * wk, _
pens_n * wk, pens_54_n * wk, pens55_59_n * wk, pens60_64_n * wk, pens65_n * wk, _
avg_off_n * wk, pr_op_n * wk, afs * wm, afs_n * wk, inc_taxable_2 * wm, tax_income_2 * wm, _
m_ap_ppfond / 1000000, m_pp_fond / 1000000, m_op_fond / 1000000, op_off * wm, op_off_n * wk, _
surv_65 * wk, op_65 * wk, _
sumif(i_pr_ip, i_status, "EQ", 4) * wm, sumif(i_pr_pp, i_status, "EQ", 4) * wm, _
sumif(i_ap_ip_ut, i_ftp_64, "EQ", 1) * wm, sumif(i_ap_tp_ut, i_ftp_64, "EQ", 1) * wm, _
sumif(i_ap_pp_ut, i_ftp_64, "EQ", 1) * wm, sumif(i_ap, i_ftp_64, "EQ", 1) * wm, _
sumif(i_ap_ap, i_ftp_64, "EQ", 1) * wm, sumif(i_ap_gp, i_ftp_64, "EQ", 1) * wm, _
sumif(h_trf_btp, i_ftp_64, "EQ", 1) * wm, sum(i_ftp_ink), sum(i_ftp_gar), sum(i_ftp_just), _
cntif(i_pr_ip, i_status, "EQ", 4) * wk, cntif(i_pr_pp, i_status, "EQ", 4) * wk, _
cntif(i_ap_ip_ut, i_ftp_64, "EQ", 1) * wk, cntif(i_ap_tp_ut, i_ftp_64, "EQ", 1) * wk, _
cntif(i_ap_pp_ut, i_ftp_64, "EQ", 1) * wk, cntif(i_ap, i_ftp_64, "EQ", 1) * wk, _
cntif(i_ap_ap, i_ftp_64, "EQ", 1) * wk, cntif(i_ap_gp, i_ftp_64, "EQ", 1) * wk, _
cntif(h_trf_btp, i_ftp_64, "EQ", 1) * wk, cnt0(i_ftp_ink) * wk, cnt0(i_ftp_gar) * wk, _
cnt0(i_ftp_just) * wk, _
sumif(i_inc_taxable, i_status, "EQ", 4) * wm, cntif(i_inc_taxable, i_status, "EQ", 4) * wk)
', DISP2 * wm, DISP4 * wm, DISP2_4 * wm, sum(h_inc_disposable) * wm)
Print #45, utvar
Close #45
End Sub
'-- Counts element i vector not equal 0
Public Function cnt0(x) As Long
Dim i As Long
cnt0 = 0
For i = 1 To UBound(x)
If x(i) <> 0 Then
cnt0 = cnt0 + 1
End If
Next
End Function
'-- Count number of persons in a status conditioned on an other vector
Public Function cntstatusif(x, ifvar, ifop, ifval, status) As Long
Dim i As Long
cntstatusif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) = ifval And i_status(i) = status Then
cntstatusif = cntstatusif + 1
End If
Next
Case "GT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) > ifval And i_status(i) = status Then
cntstatusif = cntstatusif + 1
End If
Next
Case "LT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) < ifval And i_status(i) = status Then
cntstatusif = cntstatusif + 1
End If
Next
End Select
End Function
'-- Sum of vector conditioned on status and an other vector
Public Function sumstatusif(x, ifvar, ifop, ifval, status) As Long
Dim i As Long
sumstatusif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) = ifval And i_status(i) = status Then
sumstatusif = sumstatusif + x(i)
End If
Next
Case "GT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) > ifval And i_status(i) = status Then
sumstatusif = sumstatusif + x(i)
End If
Next
Case "LT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) < ifval And i_status(i) = status Then
sumstatusif = sumstatusif + x(i)
End If
Next
End Select
End Function
'-- Sum of vector conditioned on an other vector
Public Function sumif(x, ifvar, ifop, ifval) As Double
Dim i As Long
sumif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If ifvar(i) = ifval Then
sumif = sumif + x(i)
End If
Next
Case "GT"
For i = 1 To UBound(x)
If ifvar(i) > ifval Then
sumif = sumif + x(i)
End If
Next
Case "LT"
For i = 1 To UBound(x)
If ifvar(i) < ifval Then
sumif = sumif + x(i)
End If
Next
Case "NE"
For i = 1 To UBound(x)
If ifvar(i) <> ifval Then
sumif = sumif + x(i)
End If
Next
End Select
End Function
'-- Sum of vector
Public Function sum(x) As Double
Dim i As Long
sum = 0
For i = 1 To UBound(x)
sum = sum + x(i)
Next
End Function
Public Function f_m_ap_pensage() As Double
Dim n As Long, i As Long
n = 1
For i = 1 To m_icount
If i_status(i) = 2 And i_status1(i) <> 2 Then
f_m_ap_pensage = f_m_ap_pensage + i_ap_pensmonth(i)
n = n + 1
End If
Next
f_m_ap_pensage = Int(f_m_ap_pensage / 12) / n + 65
End Function
'-- Count number of persons conditioned on an other vector
Public Function cntif(x, ifvar, ifop, ifval) As Long
Dim i As Long
cntif = 0
Select Case ifop
Case "EQ"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) = ifval Then
cntif = cntif + 1
End If
Next
Case "GT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) > ifval Then
cntif = cntif + 1
End If
Next
Case "LT"
For i = 1 To UBound(x)
If x(i) <> 0 And ifvar(i) < ifval Then
cntif = cntif + 1
End If
Next
End Select
End Function
Sub Print_elderly_care_micro()
'!-- Optional printing of data for analysis of elderly care(micro data)
status "Printing elderly care micro file"
Dim utvar As String
Dim demofile As Integer
Dim i As Long, h As Long
year = model_time + base_year
If year = 1999 Then
Open sesimpath & "\tempdata\i_elderly_micro.txt" For Output As #33
utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_hhnr", _
"i_age", "i_sex", "i_civ_stat", "i_abroad", "i_status", _
"i_edlevel", "i_born_year ", _
"i_inc_taxable", "i_inc_capital", "i_pc_elderly", "m_basbelopp", "m_basbelopp_income")
Print #33, utvar
Close #33
Open sesimpath & "\tempdata\h_elderly_micro.txt" For Output As #34
utvar = f_Concat_string_comma("h", "year", "h_hhnr", "h_size", "h_max_age", _
"h_inc_disposable", "h_wealth_financial", "h_wealth_real", _
"h_n_child", "h_n_adults", "h_house_cost")
Print #34, utvar
Close #34
End If
If year = 1999 Or year = 2003 Or year = 2015 Or year = 2025 Then
Open sesimpath & "\tempdata\i_elderly_micro.txt" For Append As #33
For i = 1 To m_icount
utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_hhnr(i), _
i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), i_status(i), _
i_edlevel(i), i_born_year(i), _
i_inc_taxable(i), i_inc_capital(i), i_pc_elderly(i), m_basbelopp, m_basbelopp_income)
Print #33, utvar
Next i
Close #33
Open sesimpath & "\tempdata\h_elderly_micro.txt" For Append As #34
For h = 1 To m_hcount
utvar = f_Concat_string_comma(h, year, h_hhnr(h), h_size(h), h_max_age(h), _
h_inc_disposable(h), h_wealth_financial(h), h_wealth_real(h), _
h_n_child(h), h_n_adults(h), h_house_cost(h))
Print #34, utvar
Next h
Close #34
End If 'year
End Sub
#End If ' Compilation of standard version