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