Attribute VB_Name = "a08_automatic_balancing"
Option Explicit
Option Base 1
' Number of individuals per age-group, which at any time have been credited with pension qualifying or
' imputed income.
' Please notice, - lagged values in column 1, present years value in column 2.
Dim n(15 To 80, 1 To 2) As Long
' Total sum of pension disbursement per age-group (U)
Dim u(60 To 130) As Double
' Total sum of pension disbursement for persons not surviving the given year (Ud)
Public Ud(60 To 130) As Double
' Total sum of pension disbursement for persons retiring and not surviving the given year (Uds)
Public Uds(60 To 130) As Double
' Contributions on earnings above the income-ceiling
Dim i_arbavg_pens_tak As Long
'Remaning average pay-out duration per age-cohort, annuitization dividsor, "economic divisor" (De)
Public De(61 To 130, 1 To 3) As Double
Private tabell As New ADODB.Recordset, db As New ADODB.Connection
Public Rfv_m_ap_pb_ip_pr(2000 To 2100) As Double
Public Rfv_m_ap_ap(2000 To 2100) As Double
'Public Ny_KPI_FJ(2000 To 2100) As Double
Public Sub automatic_balancing()
'Order of execution for automatic balancing
status "Automatic balancing"
'Necessary for stable calculation of economic "delningstal", FJ 2004-03-05
Call calculate_Uds
Call calculate_Ud
'Unblock the following line for a new simulation of TP.
'If model_time + base_year < 2018 Then Call calc_TP
'Avblockera om man vill testa lite Rfv-siffror istället.
' If model_time = 1 Then
' Call createRfv_m_ap_pb_ip_pr
' End If
'Pension contributions
Call pension_contributions
'Bufferfund
Call APFund
'Balance ratio
Call BalanceRatio
'-- Conditional transfer sum: Överföringsbelopp
' Note: Justerar utgående balans år t-1 = ingående balans år t
If get_scalefactor_active("APfund_transfer") = 1 Then
m_ap_apfond_trf = get_scalefactor("APfund_transfer") * 1000000000
m_ap_apfond = m_ap_apfond - m_ap_apfond_trf
Else
m_ap_apfond_trf = 0
End If
'-- Printing for debugging
Print_Balancing
'-- To print pension debug files, add variable "pension_debug", change "Value" to 0
' in the grid in form "Control center", tab "Param" ("On" always 1)
If get_scalefactor_active("pension_debug") = 1 Then
Call Pension_debugging_files
End If
If get_scalefactor_active("pension_micro") = 1 Then
Call Pension_micro_file
End If
' -- Optional printing of pension variables in PRN-format for export to eg. Aremos
If get_scalefactor_active("Pensions_macro") = 1 Then
Call Calculate_Macro
Call Print_Pensions_Macro
Call Print_Pension_Cohort
End If
If get_scalefactor_active("Print_elderly_care") = 1 Then
Call Print_elderly_care_micro
End If
End Sub
Public Sub pension_contributions()
' 'Printdok "pension_contributions: Calculating pension contributions"
' 'status "Calculating pension contributions"
' '--------------------------------------------------------------------------------------------
' 'Denna sub beräknar återstående avgifter i ålderspensionssystemet. Avgifterna i ålderspensions-
' 'systemet är följande: 1)Allmän egenavgift 2)Ålderspensionsavgift 3)Statlig ålderspensionsavgift.
' 'Allmän egenavgift beräknas i Rules. Samtliga inkomstbaser för beräkningarna bestäms i Pension rights.
' 'Nedan beräknas statlig ålderspensionsavgift, ålderspensionsavgift..
' '--------------------------------------------------------------------------------------------
' 'AW, tänk på premiepensionssystemet också! Komihåg tillfällig förvaltning
' 'AW, ingen särskild löneskatt beräknas i denna sub., bör tilläggas om egenföretagare beräknas
' 'AW, Egentligen sker en avräkning av socialavgifter först i takning av PGI. Beaktas?
' 'AW, Ålderspensionsavgiften (och egenavgifter för egenföretagare) över taket går till staten
' ändra i Rules.
Dim i As Long
Dim year As Integer
Dim aap_bas As Long 'AW
Dim staap_bas As Long 'AW
Dim ftp_bas As Long 'AW
Dim basb As Long ' Price basic amount or income basic amount
Dim tak As Double ' Social insurance limit (Intjänandetak)
Dim atak As Double ' Social insurance limit plus employee contribution (Avgiftstak)
year = model_time + base_year
If year < 2001 Then basb = m_basbelopp_f Else basb = m_basbelopp_income
tak = 7.5 * basb
atak = 8.07 * basb
For i = 1 To m_icount
aap_bas = 0 'AW
staap_bas = 0 'AW
ftp_bas = 0 'AW
If i_age(i) >= 16 And i_status(i) <> 2 Then '16 is actaully not relevant
' -- Pension contributions
' Income for projection of employers contribution.
aap_bas = i_inc_earning(i) 'AW
If aap_bas <= atak Then
i_aap(i) = round((aap_bas) - 50, -2)
Else
i_aap(i) = round(atak - 50, -2)
End If
'Income for projection of contributions paid by government. 'AW
'Note: disability pensioners are not included due to special rules.(STAAP =18,5%, APA=0%).
staap_bas = i_trf_unemployed(i) + i_trf_sickleave(i) + i_trf_parentleave(i)
If (staap_bas + i_aap(i)) >= atak Then
i_stap_trf(i) = atak - i_aap(i)
ElseIf staap_bas < atak Then
i_stap_trf(i) = i_trf_unemployed(i) + i_trf_sickleave(i) + i_trf_parentleave(i)
ElseIf staap_bas > atak Then
i_stap_trf(i) = atak
End If
'Special rules for disability pensioners.(STAAP =18,5%, APA=0%).
'AW kolla avräkningsordningen på i_antag och i_pgi för ftp, det är nåt lurigt!!.
If i_status(i) = 4 Then
'If i_stap_ftp(i) > i_pgi(i) Then
If i_ftp(i) > i_pgi(i) Then
i_stap_ftp(i) = i_pgi(i)
Else
i_stap_ftp(i) = i_ftp(i) - i_ftp_gar(i)
End If
Else
i_stap_ftp(i) = 0
End If
Select Case i_pu(i)
Case Is < f_bas_deduct_min(year) '***
i_avg(i) = 0 'Total pension contributions
i_avg_ip(i) = 0 'Pension contributions to the PAYG-system
i_avg_ip2(i) = 0 'Pension contributions to the PAYG-system, no transition 16% contribution for all cohorts
i_avg_aap(i) = 0 'Employers contribution
i_avg_pgb(i) = 0 'Central government contributions based on pension-qualifying amount
i_avg_trf(i) = 0 'Central government contributions based on pension-qualifying transfer payments
i_avg_ftp(1) = 0 'Central government contributions based on disability benefits (special rules)
i_avg_stap(i) = 0 'Sum of central government contributions
i_avg2(i) = 0 'Sum of employers contribution,central government contributions and employee contributions
Case Else
i_avg(i) = m_ap_avs * i_pu(i)
i_avg_ip(i) = i_avg(i) - i_pr_pp(i)
i_avg_ip2(i) = 0.16 * i_pu(i)
i_avg_aap(i) = m_ap_aap_avs * i_aap(i)
i_avg_pgb(i) = m_ap_avs * i_pgb(i)
i_avg_trf(i) = m_ap_aap_avs * i_stap_trf(i)
If year >= 2003 Then
i_avg_ftp(i) = m_ap_avs * i_stap_ftp(i) 'AW Förtidspensionärer betalar inte egenavgift, staten betalar allt
Else
i_avg_ftp(i) = 0
End If
i_avg_stap(i) = i_avg_trf(i) + i_avg_pgb(i) + i_avg_ftp(i)
i_avg2(i) = i_avg_stap(i) + i_avg_aap(i) + i_tax_contribution(i)
End Select
Else
i_avg(i) = 0
i_avg_ip(i) = 0
i_avg_ip2(i) = 0
i_avg_aap(i) = 0
i_avg_pgb(i) = 0
i_avg_trf(i) = 0
i_avg_ftp(i) = 0
i_avg_stap(i) = 0
i_avg2(i) = 0
End If
Next i
' Sum of contributions to the pension system (behövs detta?)
m_ap_avg = 0
m_ap_avg_ap = 0
m_ap_pr_ip = 0
m_ap_avg_ppm = 0
m_ap_pb_ip = 0
For i = 1 To m_icount
If i_age(i) >= 16 And i_status(i) <> 2 Then
m_ap_avg = m_ap_avg + i_avg(i)
m_ap_pr_ip = m_ap_pr_ip + i_pr_ip(i)
m_ap_avg_ap = m_ap_avg_ap + i_avg_ip(i)
m_ap_avg_ppm = m_ap_avg_ppm + i_pr_pp(i)
'--Sum of accumulated public pension rights
m_ap_pb_ip = m_ap_pb_ip + i_pb_ip(i)
End If
Next i
m_ap_avg = m_ap_avg * m_weight
m_ap_avg_ap = m_ap_avg_ap * m_weight
m_ap_pr_ip = m_ap_pr_ip * m_weight
m_ap_avg_ppm = m_ap_avg_ppm * m_weight
m_ap_pb_ip = m_ap_pb_ip * m_weight
' Summasnittkvoten visar förhållandet mellan avgiftsunderlagets och snittinkomstens
' årliga tillväxttakt. En positiv summasnittkvot medför att systemets tillgångar växer än dess skulder.
' HÄR RÄKNAS MED INKOMSTINDEX. SNITTINKOMSTERNA BEHÖVER INTE VÄXA I DENNA TAKT
If m_ap_avg_ap1 > 0 Then
m_ap_summasnitt = (((m_ap_avg_ap / m_ap_avg_ap1) / (m_ap_inkind / m_ap_inkind1)) - 1) * 100
Else
m_ap_summasnitt = 0
End If
End Sub
'-- Ap-fund: return, change and value of assets
'Data for reproduction of Annual report part of Balance sheet and note 3, 4, 13, 14
' + m_ap_avg_ap
' - m_ap_ap
'= nettoavgifter
' + avk stocks
' + avk shares & misc
' + avk skuld
' = Return
' - m_ap_adm_ip_ap
'= Return after admin
'- Admin ins
'=dFund
'+ Fund t-1
'= Fund
' -- Note: Cost of administation calculated in a06, Calculate_Public_Pension_Rights
'--------------------------------------------------------------------------------------------
'This sub projects the size of the AP-funds, which has the function of bufferfunds in the projections of
'the balance ratio. I dagsläget är samtliga fonder summerade till en fond och portföljen är endast
'differentierad på aktier och räntebärande tillgångar.
'--------------------------------------------------------------------------------------------
Public Sub APFund()
Dim i As Long
Dim year As Integer
year = base_year + model_time
'-- Proportion of AP-fund invested in shares and other items
' Source: Pensions system annual report, calulated from note 14. Updated in Sesim.mdb
' Exogenous for ex post years, last known value for all other years
If f_GetMakro("m_ap_shares_p", year, "Pension") <> 0 Then
m_ap_shares_p = f_GetMakro("m_ap_shares_p", year, "Pension")
End If
' -- Enligt uppgift från Lars Gavelin är avgiften på AP-fonderna i intervallet 0.13 - 0.16 %.
' favgift = 0.0014
' -- Avkastning på tillgångar i aktier respektive räntebärande papper, denna lösning bör förbättras,
' -- Avkastningen hämtas från Excelarket (?), valet av avkastning bör också avvägas mot andel aktier
' avkastningaktier = 1 + (m_shares_return / 100)
' avkastningrantor = 1 + (m_interest_long / 100)
'-- Summerar upp pensionsutbetalningar från AP-fonden
If (model_time + base_year) >= 2003 Then
'm_ap_ap = m_ap_ap + i_ap_ap(i)
' -- m_ap_ap corrected for semiannual phasing in of new pension system
m_ap_ap = m_ap_tp_ut + m_ap_ip_ut '-- Note: Paid out
Else
m_ap_ap = 0
For i = 1 To m_icount
If i_ap_atp(i) > 0 Then
m_ap_ap = m_ap_ap + i_ap_atp(i) + i_ap_fp(i)
End If
Next i
m_ap_ap = m_ap_ap * m_weight
End If
'---Avblockera för att testa m_ap_ap från Rfv istället.---
' If (model_time + base_year) < 2003 Then
' For i = 1 To m_icount
' If i_ap_atp(i) > 0 Then
' m_ap_ap = m_ap_ap + i_ap_atp(i) + i_ap_fp(i)
' End If
' Next i
' m_ap_ap = m_ap_ap * m_weight
' Else
' m_ap_ap = Rfv_m_ap_ap(model_time + base_year)
' End If
''--------------------------------------------------------------
m_netcontribution_ap = m_ap_avg_ap - m_ap_ap
m_shares_return_ap = (m_ap_shares_p) * (m_shares_return / 100) * m_ap_apfond '-- incl Other items
m_bonds_return_ap = (1 - m_ap_shares_p) * (m_interest_long / 100) * m_ap_apfond
m_return_ap = m_shares_return_ap + m_bonds_return_ap
If m_RFV_PB_On = 1 Then '-- Note: Inconsistency between calc adm cost and actual deduction when RFV version active
'AW testar. RFV verkar trots allt ha en förvaltningsavgift.
'm_netreturn_ap = m_return_ap - (0.00065 * m_ap_apfond)
m_netreturn_ap = m_return_ap - (0.003 * m_ap_apfond)
Else
m_netreturn_ap = m_return_ap - m_ap_adm_ip_ap - m_ap_adm_ip_ins
End If
'-- Exogenous AP-fund for outcome years updated in Sesim.mdb
If f_GetMakro("m_ap_apfond", year, "Pension") <> 0 Then
m_ap_apfond = f_GetMakro("m_ap_apfond", year, "Pension")
Else
m_ap_apfond = m_ap_apfond + m_netreturn_ap + m_netcontribution_ap
End If
End Sub
Public Sub BalanceRatio()
' Printdok "BalanceRatio: Calculating Balance Ratio"
' status " Calculating Balance Ratio"
' '--------------------------------------------------------------------------------------------
' 'This sub projects the balance ratio (m_ap_balanstal). The Balance ratio consist of three components:
' 'bufferfund (m_ap_apfond), contribution assets (m_ap_avgtill) och pension liabilities (m_ap_skuld).
' 'In the system, there are liabilities to retired individuals and to employed individuals (contributors) in the system.
' 'Contribution assets consists of contributions paid to the system and the estimated turnover
' 'duration (m_ap_ot) of contributions in the system, i.e., the relation between the average
' 'pay-in duration (m_ap_it) for contributions and the average pay-out duration (m_ap_ut) for pension benefits.
' '--------------------------------------------------------------------------------------------
'Variablenames are generally the same as formulas in prop 00/01:70, bilaga 1
Dim i As Long
Dim Rtak As Single 'Average retirement age.
Dim h() As Double 'Kvot för beräkning av individer som någon gång tillgodoräknats pgi, pu?
Dim l() As Double 'Mäter förändring i antal som någon gång tillgodoräknats pgi, pu?
Dim PR() As Double 'Pensionsrätt
Dim PRtak() As Double 'Pensionsrätt
Dim N1() As Long 'Antal individer som någon gång tillgodoräknats pgi, pu?
Dim ITt As Double 'Täljare till intjänandetid, m_ap_it
Dim ITn As Double 'Nämnare till intjänandetid, m_ap_it
Dim he() As Double 'Death ratio ("economic")
Dim Ls() As Double 'Ekonomisk livslängstabell specifik för pensionssystemet
Dim UTt As Double 'Täljare till utbetalningstid, m_ap_ut
Dim UTn As Double 'Nämnare till utbetalningstid, m_ap_ut
Dim DeT As Double 'Nominator, "economic divisors"
Dim TP As Double 'ATP-liability in regard to contributors, based on forecast
Dim j As Long
Dim year As Integer
year = base_year + model_time
Dim Pension_age_On As Integer 'AW Dessa bör ligga som globala i NewYear, kolla med Olles kod
Dim Pension_age As Double 'AW Dessa bör ligga som globala i NewYear, kolla med Olles kod
Pension_age_On = get_scalefactor_active("Pension_age") 'Dessa bör ligga som globala i NewYear, kolla med Olles kod
Pension_age = get_scalefactor("Pension_age") 'Dessa bör ligga som globala i NewYear, kolla med Olles kod
'+++++++++++++++++++++++++++++++++++++++++++++++++++++
' OBSOBSOBS att nästan samtliga storheter är känsliga för små sample, utjämningsteknik (spline)?
'+++++++++++++++++++++++++++++++++++++++++++++++++++++
'-----------------------------------------------------------------------------------
' Average retirement age
'-----------------------------------------------------------------------------------
' Rtak, the average retirement age.
If chkRetire65 = True And get_scalefactor_active("Pension_replacement_limit_On") = 0 Then
If Pension_age_On = 1 Then
Rtak = Pension_age '-- Value from Control center-parameter Pension_age_On
Else
Rtak = txtRetire '-- Value from check-box in Control center-Options
End If
Else
Rtak = f_m_ap_pensage '-- Calculates average pension age endogenously
End If
' Erase previous information in the U matrix
For i = LBound(Ud) To UBound(Ud)
u(i) = 0
Next
'U, Total sum of pension disbursement for a given year. For projection of the average
'retirement age and the pay-out duration.
For i = 1 To m_icount
If i_age(i) >= 61 Then
u(i_age(i)) = u(i_age(i)) + i_ap_ap(i) 'Varför har personer under 65 utbetalad pension?
End If
Next
ReDim h(17 To Rtak - 1)
ReDim l(16 To Rtak - 1)
ReDim PR(16 To Rtak)
ReDim PRtak(16 To Rtak - 1)
ReDim N1(16 To Rtak)
ReDim he(61 To 120)
ReDim Ls(60 To 120)
'--------------------------------------------------------------------------------------------
' Pay-in duration
'--------------------------------------------------------------------------------------------
'Moving previous years value to column 1
For i = LBound(n, 1) To UBound(n, 1)
n(i, 1) = n(i, 2)
n(i, 2) = 0
Next
'Projects number of individuals per age-group, which at any time have been credited with_
'pension qualifying or imputed income.
'AW Kolla upp om vi har samma antal personer med pu som finns i registren.
For i = 1 To m_icount
If (i_pb_ip(i) > 0 Or pp_hist(i).n_years > 0 Or i_pu(i) > 0) _
And i_age(i) >= 16 And i_age(i) <= Rtak And i_status(i) <> 2 Then
n(i_age(i), 2) = n(i_age(i), 2) + 1
N1(i_age(i)) = N1(i_age(i)) + 1
End If
Next
' h=ratio of change in number of individuals, which at any time have been credited with_
' pension qualifying or imputed income.
For i = LBound(h) To UBound(h) 'AW ställer detta kriterium till problem?
If n(i - 1, 1) > 0 Then
h(i) = n(i, 2) / n(i - 1, 1)
Else
h(i) = 0
End If
' If year = 2004 Then
' h(17) = 3.5
' End If
Next
' L = "normalised" number of individuals, which at any time have been credited with_
'pension qualifying or imputed income.
For i = LBound(l) To UBound(l)
If i = LBound(l) Then
l(i) = 1 'L(16) = 1 according to definition
Else
l(i) = l(i - 1) * h(i)
End If
Next
'Sum of pension rights (i.e., pension contributions) per age-group.
For i = 1 To m_icount
If i_avg_ip(i) > 0 And i_age(i) >= 16 And i_age(i) <= Rtak And i_status(i) <> 2 Then
'PR(i_age(i)) = PR(i_age(i)) + i_avg_ip(i)
PR(i_age(i)) = PR(i_age(i)) + i_avg_ip2(i)
End If
Next
'Mean of pension rights per age-group for individuals, which at any time have been credited with
'pension rights.
For i = LBound(PRtak) To UBound(PRtak)
If i = UBound(PRtak) Then
PRtak(i) = PR(i) / N1(i)
Else
If i <= UBound(PRtak) - 1 And N1(i) > 0 Then
' PRtak(i) = ((PR(i) / N1(i)) + (PR(i + 1) / N1(i + 1))) / 2
PRtak(i) = PR(i) / N1(i)
Else
PRtak(i) = 0
End If
End If
Next
'm_ap_it = pay-in duration
ITt = 0
ITn = 0
For i = LBound(PRtak) To UBound(PRtak)
ITt = ITt + (PRtak(i) * l(i) * (Rtak - i - 0.5))
' ITt = ITt + (PRtak(i) * l(i) * (Rtak - i)) 'AW tar bort 0.5 eftersom allt sker 1 jan i SESIM
ITn = ITn + (PRtak(i) * l(i))
Next
If ITn = 0 Then 'Fulfix för att Olle och andra ska kunna köra på sample mindre än 5 %
ITn = 0.0000001
End If
'AW lägger in historiska värden för m_ap_it
If f_GetMakro("m_ap_it", year, "Pension") <> 0 Then '-- Reading exogenous IT if avaliable
m_ap_it = f_GetMakro("m_ap_it", year, "Pension")
Else
m_ap_it = ITt / ITn
End If
'--------------------------------------------------------------------------------------------
' Pay-out duration
'--------------------------------------------------------------------------------------------
'he = death ratio projected from pension disbursements.
'U = total sum of pension disbursement for a given year, and
'Ud = total sum of pension disbursement for persons not surviving the given year
For i = LBound(he) To UBound(he)
If u(i) > 0 Then
he(i) = u(i) / (u(i) + Ud(i) + Uds(i))
Else
If u(i) = 0 And i < Rtak Then 'AW, Inte så snyggt men det är en lösning på att vi_
he(i) = 1 'inte har tillräcklig spridning i Rtak (ens vid stora sample!)
Else
he(i) = 0
End If
End If
Next
For i = LBound(Ls) To UBound(Ls)
If i = LBound(Ls) Then
Ls(i) = 1 'Ls(60)=1 according to definition
Else
Ls(i) = Ls(i - 1) * he(i)
End If
Next
UTt = 0
UTn = 0
If f_GetMakro("m_ap_ut", year, "Pension") <> 0 Then '-- Reading exogenous UT if avaliable
m_ap_ut = f_GetMakro("m_ap_ut", year, "Pension")
Else
For i = Rtak To 120
UTt = UTt + (Ls(i) * (i - Rtak + 0.5) * 1.016 ^ -(i - Rtak + 0.5))
UTn = UTn + (Ls(i) * 1.016 ^ -(i - Rtak + 0.5))
' UTt = UTt + (Ls(i) * (i - Rtak + 1) * 1.016 ^ -(i - Rtak + 1)) 'AW lägger till 0.5 eftersom allt sker 1 jan i SESIM
' UTn = UTn + (Ls(i) * 1.016 ^ -(i - Rtak + 1))
Next
m_ap_ut = UTt / UTn
End If
'--------------------------------------------------------------------------------------------
' Turnover duration, consists of pay-in duration and pay-out duration
'--------------------------------------------------------------------------------------------
m_ap_ot = m_ap_it + m_ap_ut
' Debug.Print m_ap_it & " " & m_ap_ut & " " & m_ap_ot
' Smoothed value for turnover duration
Dim q As Variant, temp_data() As Double
ReDim temp_data(1 To 3)
temp_data(1) = m_ap_ot1
temp_data(2) = m_ap_ot2
temp_data(3) = m_ap_ot3
q = arr_Percentile(temp_data(), 50) 'medianvalue of m_ap_ot(t-1), m_ap_ot(t-2), m_ap_ot(t-3)
If year < 2000 Then
m_ap_ottak = m_ap_ot
Else
' m_ap_ottak1 = m_ap_ottak 'AW Vad motiverar detta egentligen?
m_ap_ottak = q(1, 2)
End If
'--------------------------------------------------------------------------------------------
' Contribution assets, based on turnover duration and contributions paid to PAYG-system (AP-funds)
'--------------------------------------------------------------------------------------------
'Lagged structure, for projection of "contribution assets"
Select Case year
Case Is <= 2000
m_ap_avgtill1 = m_ap_avgtill
Case Else
m_ap_avgtill2 = m_ap_avgtill1
m_ap_avgtill1 = m_ap_avgtill
End Select
'Smoothed value for contributions
Select Case year
'AW lägger in utfall, bör endast användas tillsammans med align_pgi (PÅR not 5)
Case Is = 2000
m_ap_avg_atak = 147858000000#
Case Is = 2001
m_ap_avg_atak = 155268000000#
Case Is = 2002
m_ap_avg_atak = 163998000000#
Case Is = 2003
m_ap_avg_atak = 168681000000#
Case Is = 2004
m_ap_avg_atak = 173049000000#
Case Is = 2005
m_ap_avg_atak = 178116000000#
' Case Is <= 2002
' m_ap_avg_atak = m_ap_avg_ap
' Case Is = 2002
' m_ap_avg_atak = ((m_ap_avg_ap + m_ap_avg_ap1) / 2) * (((m_ap_avg_ap / m_ap_avg_ap2) _
' * (m_KPI2 * m_KPI)) ^ (1 / 2)) * (m_KPI / m_KPI1)
Case Else
If m_RFV_PB_On <> 1 Then
m_ap_avg_atak = ((m_ap_avg_ap + m_ap_avg_ap1 + m_ap_avg_ap2) / 3) * _
(((m_ap_avg_ap / m_ap_avg_ap3) * (m_KPI3 / m_KPI)) ^ (1 / 3)) * (m_KPI / m_KPI1)
Else
m_ap_avg_atak = ((m_ap_avg_ap + m_ap_avg_ap1 + m_ap_avg_ap2) / 3) * _
(((m_ap_avg_ap / m_ap_avg_ap3) * _
(f_GetMakro("RFV_KPI", year - 3, "Pension") / f_GetMakro("RFV_KPI", year, "Pension"))) ^ (1 / 3)) * _
(f_GetMakro("RFV_KPI", year, "Pension") / f_GetMakro("RFV_KPI", year - 1, "Pension"))
End If
End Select
'Contribution assets
'AW
'If year = 2005 Then
' m_ap_avg_atak = m_ap_avg_atak * 0.98813
'End If
m_ap_avgtill = m_ap_avg_atak * m_ap_ottak
'--------------------------------------------------------------------------------------------
' Pension liability
'--------------------------------------------------------------------------------------------
'Pension liability in regard to individuals paying contributions
'Note: If new simulation of m_ap_pb_tp then unblock the following line in automatic_balancing. The
'result is stored in text file that is imported manually to Sesim.mdb, see calc_TP for details.
'If model_time + base_year < 2018 Then Call calc_TP
m_ap_pb_tp = f_GetMakro("m_ap_pb_tp", year, "Pension")
'Pension liability in regard to individuals paying contributions (active)
'm_ap_sa = m_ap_pb_ip + m_ap_pr_ip + m_ap_pb_tp ' Tidigare def av PB
m_ap_sa = m_ap_pb_ip + m_ap_pb_tp ' RFV def av pensionsbehållning 031204
'Avblockera om Rfv_m_ap_sa ska testas.
' m_ap_sa = Rfv_m_ap_pb_ip_pr(model_time + base_year) + m_ap_pb_tp
'Lagged structure, for projection of "economic divisors"
For i = LBound(De) To UBound(De)
De(i, 3) = De(i, 2)
De(i, 2) = De(i, 1)
De(i, 1) = 0
Next
'Lagged structure, for projection of pension liabilites
Select Case year
Case Is <= 2000
m_ap_skuld1 = m_ap_skuld
Case Else
m_ap_skuld2 = m_ap_skuld1
m_ap_skuld1 = m_ap_skuld
End Select
'Pension liability in regard to retired
'De = remaning average pay-out duration per age-cohort, "economic divisors"
For i = 61 To UBound(Ls) - 1
DeT = 0
For j = i To UBound(Ls) - 1
DeT = DeT + 0.5 * (Ls(j) + Ls(j + 1)) * 1.016 ^ (i - j - 1)
Next
If Ls(i) <> 0 Then
De(i, 1) = DeT / Ls(i)
Else
De(i, 1) = 0
End If
If model_time = 1 Then
De(i, 2) = De(i, 1)
De(i, 3) = De(i, 1)
End If
Next
m_ap_sp = 0
For i = 61 To 120
m_ap_sp = m_ap_sp + (m_weight * u(i) * (De(i, 1) + De(i, 2) + De(i, 3)) / 3)
Next
''Upprepning av ovanstående men med vanliga delningstal istället
' For i = 61 To UBound(dtalip)
' m_ap_sp = m_ap_sp + (m_weight * U(i) * dtalip(i))
' Next
' Dim str As String
' str = "Ek. deltal" & vbTab & model_time & vbTab & m_ap_sp
' Call PrintFileFredrik("d:\sesim\m_ap_sp3.txt", str)
' If model_time > 2 Then
' For i = 61 To 104
' Debug.Print "ekdeltal" & vbTab & (De(i, 1) + De(i, 2) + De(i, 3)) / 3
' Next
' End If
'' str = "Deltal " & vbTab & model_time & vbTab & m_ap_sp
'' Call PrintFileFredrik("d:\sesim\m_ap_sp3.txt", str)
'' For i = 61 To 104
'' Debug.Print "deltal" & vbTab & dtalip(i)
'' Next
'' Call PrintFile("d:\sesim\test.txt", dtalip)
' Sum of pension liabilities
'AW, testar infasning av skulden
' Select Case year
' Case Is = 2000
' m_ap_skuld = 5105098788979#
' Case Is = 2001
' m_ap_skuld = 5546143676834#
' Case Is = 2002
' m_ap_skuld = 5815559914301#
' Case Is = 2003
' m_ap_skuld = 6011826558730#
' Case Is = 2004
' m_ap_skuld = 6183591862519#
' Case Is = 2005
' m_ap_skuld = 6447850520720#
' Case Is = 2006
' m_ap_skuld = 6740364331189#
' Case Is = 2007
' m_ap_skuld = 7022717471917#
' Case Is = 2008
' m_ap_skuld = 7307256683895#
' Case Else
' m_ap_skuld = m_ap_sa + m_ap_sp
' End Select
m_ap_skuld = m_ap_sa + m_ap_sp
' Debug.Print "Ek. deltal" & vbTab & model_time & vbTab & m_ap_skuld
'--------------------------------------------------------------------------------------------
' Balance ratio
'--------------------------------------------------------------------------------------------
If m_RFV_PB_On <> 1 Then
Select Case year
Case Is = 2000 'Balance ratio is not defined for 2000
m_ap_balanstal = 0
'Case Is = 2001
' m_ap_balanstal = (m_ap_avgtill + m_ap_apfond) / m_ap_skuld
Case Is <= 2005
m_ap_balanstal = 1 'helt förkastligt!!!
Case Else
' If f_GetMakro("m_ap_balanstal", year, "Pension") <> 0 Then '-- Reading exogenous BT if avaliable
' m_ap_balanstal = f_GetMakro("m_ap_balanstal", year, "Pension")
' Else
'm_ap_balanstal = (m_ap_avgtill2 + m_ap_apfond2) / m_ap_skuld2 'AW detta måste kollas, varför har jag kodat fördröjn!
m_ap_balanstal = (m_ap_avgtill + m_ap_apfond) / m_ap_skuld
' End If
End Select
Else
Select Case year
Case Is = 2000 'Balance ratio is not defined for 2000
m_ap_balanstal = 0
Case Is <= 2005
m_ap_balanstal = 1 'helt förkastligt!!!
Case Else
m_ap_balanstal = (m_ap_avgtill + m_ap_apfond) / m_ap_skuld
End Select
End If
'-- Accumulated balance index (used for LIP kap 6 § 8a
If m_ap_balanstal < 1 Then
m_ap_balanstal_accum = m_ap_balanstal_accum * m_ap_balanstal
Else
m_ap_balanstal_accum = 1
End If
End Sub
Public Sub Print_Balancing()
'-- Printing ***** DEBUGGING ******
Dim utvar As String, m As Double
m = 1000000
If model_time = 1 Then
Open sesimpath & "\tempdata\AP_fund_macro.prn" For Output As #51
'Open sesimpath & "\tempdata\AP_fund_macro.txt" For Output As #51
utvar = f_Concat_string_cita("DATE", "netcontrib_ap", "ap_avg_ap", "ap_ap", _
"shares_ret_ap", "bonds_ret_ap", "ret_ap", "ap_adm_ip_ap", "netret_ap", _
"ap_adm_ip_ins", "ap_apfond", "ap_adm_ip", "price99", _
"ap_avgtill", "ap_avgtill1", "ap_skuld", "ap_skuld1", _
"ap_ottak", "ap_ottak1", "ap_ot1", "m_ap_ot", "m_ap_it", "m_ap_ut", "ap_avg_atak", "ap_avg_ap1", _
"ap_sa", "ap_sp", "ap_pb_ip", "ap_pb_tp", _
"ap_arv", "ap_arv_59", "ap_arv60_", "ap_index", "ap_favg", _
"ap_balanstal", "ap_summasnitt", "m_ap_avg", "m_ap_avg_ppm", "ap_apfond_trf")
Print #51, utvar
Else
Open sesimpath & "\tempdata\AP_fund_macro.prn" For Append As #51
'Open sesimpath & "\tempdata\AP_fund_macro.txt" For Append As #51
End If
utvar = f_Concat_string_space(base_year + model_time & "01", m_netcontribution_ap / m, _
m_ap_avg_ap / m, m_ap_ap / m, m_shares_return_ap / m, m_bonds_return_ap / m, _
m_return_ap / m, m_ap_adm_ip_ap / m, m_netreturn_ap / m, _
m_ap_adm_ip_ins / m, m_ap_apfond / m, m_ap_adm_ip / m, m_price_change99, _
m_ap_avgtill / m, m_ap_avgtill1 / m, m_ap_skuld / m, m_ap_skuld1 / m, _
m_ap_ottak, m_ap_ottak1, m_ap_ot1, m_ap_ot, m_ap_it, m_ap_ut, m_ap_avg_atak / m, m_ap_avg_ap1 / m, _
m_ap_sa / m, m_ap_sp / m, m_ap_pb_ip / m, m_ap_pb_tp / m, _
m_ap_arv / m, m_ap_arv_59 / m, m_ap_arv60_ / m, m_ap_index / m, m_ap_favg / m, _
m_ap_balanstal, m_ap_summasnitt, m_ap_avg / m, m_ap_avg_ppm / m, m_ap_apfond_trf / m)
Print #51, utvar
Close #51
m_ap_ot = m_ap_it + m_ap_ut
End Sub
'***-------------------------------------------------------------------------
'Should be placed in services
'Subroutine for calculating Uds. Total sum of pension disbursement for
'persons retiring and not surviving the given year (Uds). It takes individuals
'that retired in this year and calculate the probability of dying the same year
'(which is an impossibility in SESIM). This is an estimation of Uds.
'-------------------------------------------------------------------------***
Public Sub calculate_Uds()
Dim i As Long
Dim age As Byte
'Nollställ Uds för varje nytt anrop till subrutinen
For i = LBound(Uds) To UBound(Uds): Uds(i) = 0: Next
For i = 1 To m_icount
If i_status(i) = 2 And i_status1(i) <> 2 Then
age = mini(i_age(i), 105)
Uds(mini(120, i_age(i))) = Uds(mini(120, i_age(i))) + parm_death(mini(2110, model_time + base_year), age, i_sex(i)) * i_ap_ap(i)
End If
Next
End Sub
'***-------------------------------------------------------------------------
'Should be placed in services
'Subroutine for calculating Ud. Total sum of pension disbursement for
'persons retired but dying within the year (Ud). It takes individuals
'that were retired last year and calculate the expected the probability of dying
'this year. This measure is less sensitive to sample size than calculating the
'measure directly.
'-------------------------------------------------------------------------***
Public Sub calculate_Ud()
Dim age As Byte
Dim i As Long
'Nollställ Ud för varje nytt anrop till subrutinen
For i = LBound(Ud) To UBound(Ud): Ud(i) = 0: Next
For i = 1 To m_icount
If i_status1(i) = 2 And i_status(i) = 2 Then
age = mini(i_age(i), 105)
Ud(mini(120, i_age(i))) = Ud(mini(120, i_age(i))) + parm_death(mini(2110, model_time + base_year), age, i_sex(i)) * i_ap_ap(i)
End If
Next
End Sub
Public Function PrintFileFredrik(filename As String, DATA As String) As Integer
Dim filenr As Integer, i As Long
On Error Resume Next
PrintFileFredrik = 1
filenr = FreeFile
Open filename For Append As #filenr
Print #filenr, DATA
Close #filenr
If Err.Number <> 0 Then
PrintFileFredrik = 0
End If
End Function
Public Sub CalculatePensionContributors()
'Calculates the number of pension contributors per age-group for 1999
Dim i As Long
For i = 1 To m_icount
If (i_pb_ip(i) > 0 Or pp_hist(i).n_years > 0) _
And i_age(i) >= 16 And i_status(i) <> 2 Then
n(i_age(i), 2) = n(i_age(i), 2) + 1
' N1(i_age(i)) = N1(i_age(i)) + 1 'AW ingår inte alla i i_pb_ip redan i pp_hist?
End If
Next
End Sub
'Nästföljande två subrutiner beräknar pgi för personer som kommer att utfasas och där pensionssystemet
'har en skuld i tilläggspensionen. Bör byta namn på i_pgi185() till i_pgi16().
Public Sub calc_TP()
Dim i As Long
Dim utfas As Double
For i = 1 To m_icount
If i_born_year(i) <= 1953 And i_born_year(i) > 1937 And i_age(i) < txtRetire And i_status(i) <> 2 Then
i_pgi185(i) = i_pgi185(i) + 0.16 * i_pgi(i) * (1 - f_utfasning_ATP(i_born_year(i), (i_born_year(i) + txtRetire)))
End If
Next
Call calc_TP_help
If model_time + base_year = 2017 Then
PrintFile "c:\tp_pensionsskuld.txt", TPinSA
End If
End Sub
Public Sub calc_TP_help()
Dim i As Long
For i = 1 To m_icount
If i_status(i) = 2 And i_age(i) = txtRetire Then
If model_time + base_year < 2003 Then
TPinSA(base_year + model_time) = TPinSA(base_year + model_time) + m_weight * (i_ap_atp(i) * De(txtRetire, 1) - i_pgi185(i))
Else
TPinSA(base_year + model_time) = TPinSA(base_year + model_time) + m_weight * (i_ap_tp(i) * De(txtRetire, 1) - i_pgi185(i))
End If
End If
Next
'Diskontera tp-pensionsskulden med 2% under tiden från idag till beräknat år
If base_year + model_time = 2017 Then
For i = 2000 To 2018
TPinSA(i) = TPinSA(i) / (1.02 ^ (i - 2000))
Next
End If
End Sub
'Sub createRfv_m_ap_pb_ip_pr()
'
' Dim check_if_null
' Dim year As Integer
' Dim i As Integer
'i = 1999
' '*************** macro ********************
'
' Open_Excel2 "s:\projekt\balanstal\rfv\pår_skuld"
'
' Read_Excel2 "Rfv"
'
' Do While tabell.EOF = False And IsNull(tabell("year")) = False
' i = i + 1
' check_if_null = tabell("year")
' If IsNull(check_if_null) = True Then Exit Do
'
' year = tabell("year")
'
' If IsNull(tabell("active_reformed")) = False Then Rfv_m_ap_pb_ip_pr(i) = tabell("active_reformed") * 1000000000
' tabell.MoveNext
' Loop
' tabell.Close
' db.Close
'
' i = 1999
'
' Open_Excel2 "s:\projekt\balanstal\rfv\pår_skuld"
' Read_Excel2 "Rfv"
'
' Do While tabell.EOF = False And IsNull(tabell("year")) = False
' i = i + 1
' check_if_null = tabell("year")
' If IsNull(check_if_null) = True Then Exit Do
'
' year = tabell("year")
'
' If IsNull(tabell("m_ap_ap")) = False Then Rfv_m_ap_ap(i) = tabell("m_ap_ap") * 1000000000
' tabell.MoveNext
' Loop
' tabell.Close
' db.Close
'
' i = 1999
'
' Open_Excel2 "s:\projekt\balanstal\rfv\pår_skuld"
' Read_Excel2 "Rfv"
'
' Do While tabell.EOF = False And IsNull(tabell("year")) = False
' i = i + 1
' check_if_null = tabell("year")
' If IsNull(check_if_null) = True Then Exit Do
'
' year = tabell("year")
'
' If IsNull(tabell("Ny_KPI_FJ")) = False Then Ny_KPI_FJ(i) = tabell("Ny_KPI_FJ")
' tabell.MoveNext
' Loop
' tabell.Close
' db.Close
'
'End Sub
Public Sub Open_Excel2(name As String)
With db
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & name & ";" & _
"Extended Properties=Excel 8.0;"
.Open
End With
End Sub
Public Sub Read_Excel2(name As String)
Set tabell.ActiveConnection = db
tabell.Open "Select * from [" & name & "$]", db, adOpenStatic, adLockBatchOptimistic
End Sub