Attribute VB_Name = "x01_Readparameters"
Option Explicit
Option Base 1

Public parm_death(1999 To 2110, 0 To 106, 2) As Double
Public parm_death_er(17 To 65, 2) As Double

Public parm_macro(1992 To 2110, 1 To 27) As Double
Public parm_beginner(1993 To 2050, 1 To 2, 1 To 2) As Double
Public parm_studycount(1993 To 2050, 1 To 3, 1 To 3) As Double
Public parm_takeupkv(1992 To 2005, 1 To 10) As Double
Public parm_takeuphs(1992 To 2005, 1 To 4) As Double

'*** The following parameter matrices are not used in the code right now!! TP 011114
'Public parm_wanted(1993 To 2100, 1 To 2) ' wanted deaths (1) and births(2)
'Public parm_work(19 To 64, 1 To 2) As Double
'Public parm_fertility(1996 To 2037, 16 To 49) As Double

'*** Alignment data for mortality: counts for five-year groups (0-4, 5-9, ..., 95-)
'*** by sex and year
Public parm_align_mortality(2000 To 2110, 1 To 20, 1 To 2) As Double

' Alignment data for fertility: wanted # of births by year
Public parm_align_fertility(1999 To 2110) As Long

'Wanted number of emigrants, men and women. Ändrat från 1998 till 1997. Av Fredrik 24/10-01
'*** Emigrants differentiated by origin: swedish or foreign (TP 020906)
Public n_em(1999 To 2110, 2) As Long

'Wanted total number of immigrants, men and women. Ändrat från 1998 till 1997. Av Fredrik 24/10-01
'*** Immigrants differentiated by origin: swedish or foreign (TP 020906)
Public n_im(1999 To 2110, 2) As Long

'Transition matrix for distribution of new immigrants
Public n_im_trans(1 To 4, 1 To 24) As Single

' Age(grop) and sex distribution of emigrants and immigrants (regardless of nationality). Data
' for alignment of migration in order to get correct age and sex distribution. Age-indexation
' according to idx = min(21, floor(i_age / 5) + 1), that is 1: 0-4, 2: 5-9, ..., 20: 95-99
' and 21: 100+. TP 060522
Public agedist_immigration(2000 To 2110, 1 To 2, 1 To 21) As Long
Public agedist_emigration(2000 To 2110, 1 To 2, 1 To 21) As Long

'Pension liability in regard to individuals paying contributions, supplementary pension
Public TPinSA(2000 To 2018) As Double

'Public pconst As New Collection
Public Parm As New Collection

' Datatype used for storage of run-time scale parameters for alignment
Private Type parm_scale
  name As String
  time_from  As Long
  time_to As Long
  scalefactor As Double
  active As Integer
End Type
Private parm_scalefactor() As parm_scale
Private tabell As New ADODB.Recordset, db As New ADODB.Connection
Dim i As Long


Public Sub read_parameters()
   Printdok "read_parameters"
   
   Call read_BASE_parametrar
   If error_flag = 0 Then Call read_MY_parametrar
End Sub

' -- Opens an Excel-file ' Assumes that db is declared as a private variable in actual module ' Note: Explicit closing required
Public Sub Open_Excel(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
' -- Reads a complete sheet from an open Excel-file ' Assumes that db is open and tabell declared as a private variable in actual module ' Note: Explicit closing required
Public Sub Read_Excel(name As String) Set tabell.ActiveConnection = db tabell.Open "Select * from [" & name & "$]", db, adOpenStatic, adLockBatchOptimistic End Sub
Public Sub read_BASE_parametrar() Dim year As Integer Dim age As Integer, ad Dim i As Integer Dim txtFilename As String ' Handle errors... On Error Resume Next Call read_scaleparm(0) status "Reading BASE parameters" If Err.Number <> 0 Then status "ERROR in scale parameters" Err.Clear End If txtFilename = controlcenter.txt2BASEparameterfilname.text If Mid$(txtFilename, 2, 1) <> ":" And Mid$(txtFilename, 2, 1) <> "\" Then txtFilename = sesimpath & "\" & txtFilename If Dir(txtFilename) = "" Then MsgBox "Error: Can't find parameterfile:" & vbCrLf & txtFilename End End If Printdok ("Excel file with demographic assumptions: " & txtFilename) Open_Excel txtFilename '*** One-year hazards (Statistics Sweden) *** Read_Excel "p_death" Do While tabell.EOF = False And IsNull(tabell("year")) = False year = tabell("year") age = tabell("age") parm_death(year, age, 1) = tabell("men") / 1000000# parm_death(year, age, 2) = tabell("women") / 1000000# tabell.MoveNext Loop tabell.Close '*** Alignment data for mortality *** Read_Excel "align_mortality" Dim agegrp As Integer agegrp = 1 Do While tabell.EOF = False And IsNull(tabell("year")) = False year = tabell("year") parm_align_mortality(year, agegrp, 1) = tabell("men") parm_align_mortality(year, agegrp, 2) = tabell("women") tabell.MoveNext agegrp = agegrp + 1 If agegrp > 20 Then agegrp = 1 Loop tabell.Close '*** Alignment data for fertility Read_Excel "align_fertility" 'Do While tabell("year") <> "" '.EOF = False ' Do While tabell.EOF = False And IsNull(tabell("year")) = False year = tabell("year") parm_align_fertility(year) = tabell("wanted") tabell.MoveNext Loop tabell.Close '*** Excess risk for early retired individuals *** Read_Excel "p_death_er" Do While tabell.EOF = False And IsNull(tabell("age")) = False age = tabell("age") parm_death_er(age, 1) = tabell("men") / 1000000# parm_death_er(age, 2) = tabell("women") / 1000000# tabell.MoveNext Loop tabell.Close '*** Alignment data for migration *** Read_Excel "migration" Do While tabell.EOF = False And IsNull(tabell("year")) = False year = tabell("year") n_em(year, 1) = tabell("em_swe") '*** Swedish emigrants n_em(year, 2) = tabell("em_for") '*** Foreign emigrants n_im(year, 1) = tabell("im_swe") '*** Swedish immigrants n_im(year, 2) = tabell("im_for") '*** Foreign immigrants tabell.MoveNext Loop tabell.Close Dim sex As Byte Read_Excel "migration_agedist" Do While tabell.EOF = False And IsNull(tabell("year")) = False year = tabell("year") agegrp = tabell("ageidx") sex = tabell("sex") agedist_emigration(year, sex, agegrp) = tabell("emig") agedist_immigration(year, sex, agegrp) = tabell("immig") tabell.MoveNext Loop tabell.Close '*** Transition matrix for new immigrants *** Read_Excel "new_immigration" Do While tabell.EOF = False And IsNull(tabell("counter")) = False year = tabell("counter") n_im_trans(1, year) = tabell("low_age") '*** Swedish emigrants n_im_trans(2, year) = tabell("high_age") '*** Foreign emigrants n_im_trans(3, year) = tabell("h_size") '*** Swedish immigrants n_im_trans(4, year) = tabell("probability") '*** Foreign immigrants tabell.MoveNext Loop tabell.Close db.Close If Err.Number <> 0 Then status "ERROR IN BASE PARAMETERS!!" Err.Clear End If End Sub
Public Sub read_MY_parametrar() Dim year As Integer Dim age As Integer Dim i As Integer Dim txtFilename As String Dim check_if_null As Variant ' Handle errors... On Error Resume Next Call read_scaleparm(1) If Err.Number <> 0 Then status "ERROR in scale parameters" Err.Clear End If status "Reading MY parameters" txtFilename = controlcenter.txt2MYparameterfilname.text If Mid$(txtFilename, 2, 1) <> ":" And Mid$(txtFilename, 2, 1) <> "\" Then _ txtFilename = sesimpath & "\" & txtFilename If Dir(txtFilename) = "" Then MsgBox "Error: Can't find parameterfile:" & vbCrLf & txtFilename End End If Printdok ("Excel file with macro assumptions: " & txtFilename) Open_Excel txtFilename '*************** macro ******************** Dim LastVal(1 To 27) As Double Read_Excel "Macro" Do While tabell.EOF = False check_if_null = tabell("year") If IsNull(check_if_null) = True Then Exit Do year = tabell("year") If IsNull(tabell("realwage")) = False Then parm_macro(year, 1) = tabell("realwage") LastVal(1) = parm_macro(year, 1) Else parm_macro(year, 1) = LastVal(1) End If If IsNull(tabell("inflation")) = False Then parm_macro(year, 2) = tabell("inflation") LastVal(2) = parm_macro(year, 2) Else parm_macro(year, 2) = LastVal(2) End If If IsNull(tabell("basbelopp")) = False Then parm_macro(year, 3) = tabell("basbelopp") LastVal(3) = parm_macro(year, 3) Else parm_macro(year, 3) = LastVal(3) End If If IsNull(tabell("basbelopp_förhöjt")) = False Then parm_macro(year, 4) = tabell("basbelopp_förhöjt") LastVal(4) = parm_macro(year, 4) Else parm_macro(year, 4) = LastVal(4) End If If IsNull(tabell("shares_dividends")) = False Then parm_macro(year, 5) = tabell("shares_dividends") LastVal(5) = parm_macro(year, 5) Else parm_macro(year, 5) = LastVal(5) End If If IsNull(tabell("shares_rate")) = False Then parm_macro(year, 6) = tabell("shares_rate") LastVal(6) = parm_macro(year, 6) Else parm_macro(year, 6) = LastVal(6) End If If IsNull(tabell("historicwage")) = False Then parm_macro(year, 7) = tabell("historicwage") LastVal(7) = parm_macro(year, 7) Else parm_macro(year, 7) = LastVal(7) End If If IsNull(tabell("to_price99")) = False Then parm_macro(year, 8) = tabell("to_price99") LastVal(8) = parm_macro(year, 8) Else parm_macro(year, 8) = LastVal(8) End If If IsNull(tabell("interest_long")) = False Then parm_macro(year, 9) = tabell("interest_long") LastVal(9) = parm_macro(year, 9) Else parm_macro(year, 9) = LastVal(9) End If If IsNull(tabell("interest_short")) = False Then parm_macro(year, 10) = tabell("interest_short") LastVal(10) = parm_macro(year, 10) Else parm_macro(year, 10) = LastVal(10) End If If IsNull(tabell("inkomstindex")) = False Then parm_macro(year, 11) = tabell("inkomstindex") LastVal(11) = parm_macro(year, 11) Else parm_macro(year, 11) = LastVal(11) End If If IsNull(tabell("earnings")) = False Then parm_macro(year, 12) = tabell("earnings") LastVal(12) = parm_macro(year, 12) Else parm_macro(year, 12) = LastVal(12) End If If IsNull(tabell("pgb")) = False Then parm_macro(year, 13) = tabell("pgb") LastVal(13) = parm_macro(year, 13) Else parm_macro(year, 13) = LastVal(13) End If If IsNull(tabell("trf_taxable")) = False Then parm_macro(year, 14) = tabell("trf_taxable") LastVal(14) = parm_macro(year, 14) Else parm_macro(year, 14) = LastVal(14) End If If IsNull(tabell("inc_taxable")) = False Then parm_macro(year, 15) = tabell("inc_taxable") LastVal(15) = parm_macro(year, 15) Else parm_macro(year, 15) = LastVal(15) End If If IsNull(tabell("AAKBEF1664")) = False Then parm_macro(year, 16) = tabell("AAKBEF1664") LastVal(16) = parm_macro(year, 16) Else parm_macro(year, 16) = LastVal(16) End If If IsNull(tabell("AAL1664")) = False Then parm_macro(year, 17) = tabell("AAL1664") LastVal(17) = parm_macro(year, 17) Else parm_macro(year, 17) = LastVal(17) End If If IsNull(tabell("AAPTOT")) = False Then parm_macro(year, 18) = tabell("AAPTOT") LastVal(18) = parm_macro(year, 18) Else parm_macro(year, 18) = LastVal(18) End If If IsNull(tabell("AAPSYS")) = False Then parm_macro(year, 19) = tabell("AAPSYS") LastVal(19) = parm_macro(year, 19) Else parm_macro(year, 19) = LastVal(19) End If If IsNull(tabell("TIESYS")) = False Then parm_macro(year, 20) = tabell("TIESYS") LastVal(20) = parm_macro(year, 20) Else parm_macro(year, 20) = LastVal(20) End If If IsNull(tabell("BNPAL")) = False Then parm_macro(year, 21) = tabell("BNPAL") LastVal(21) = parm_macro(year, 21) Else parm_macro(year, 21) = LastVal(21) End If If IsNull(tabell("BNPAF")) = False Then parm_macro(year, 22) = tabell("BNPAF") LastVal(22) = parm_macro(year, 22) Else parm_macro(year, 22) = LastVal(22) End If If IsNull(tabell("PB_IP")) = False Then parm_macro(year, 23) = tabell("PB_IP") LastVal(23) = parm_macro(year, 23) Else parm_macro(year, 23) = LastVal(23) End If If IsNull(tabell("PB_PP")) = False Then parm_macro(year, 24) = tabell("PB_PP") LastVal(24) = parm_macro(year, 24) Else parm_macro(year, 24) = LastVal(24) End If If IsNull(tabell("m_price_rw_home")) = False Then parm_macro(year, 25) = tabell("m_price_rw_home") LastVal(25) = parm_macro(year, 25) Else parm_macro(year, 25) = LastVal(25) End If If IsNull(tabell("m_price_rw_other")) = False Then parm_macro(year, 26) = tabell("m_price_rw_other") LastVal(26) = parm_macro(year, 26) Else parm_macro(year, 26) = LastVal(26) End If tabell.MoveNext Loop tabell.Close '*************** kommundata ******************** ReDim kommundata(1 To 289) Dim index As Long Read_Excel "Kommundata" Do While tabell.EOF = False index = tabell("index") If IsNull(index) = True Then Exit Do kommundata(index).name = tabell("name") kommundata(index).taxvalue = tabell("taxvalue") kommundata(index).kb = tabell("kb") kommundata(index).kod = tabell("kod") kommundata(index).h_region = tabell("h_region") kommundata(index).abcd_region = tabell("abcd_region") kommundata(index).bklimat = tabell("bklimat") kommundata(index).immig_loc = tabell("immig_loc") kommundata(index).pop_loc = tabell("pop_loc") kommundata(index).skatt99 = tabell("skatt99") kommundata(index).skatt00 = tabell("skatt00") kommundata(index).skatt01 = tabell("skatt01") kommundata(index).skatt02 = tabell("skatt02") kommundata(index).skatt03 = tabell("skatt03") kommundata(index).skatt04 = tabell("skatt04") kommundata(index).skatt05 = tabell("skatt05") kommundata(index).skatt06 = tabell("skatt06") kommundata(index).LA_region = tabell("LA_region") tabell.MoveNext Loop tabell.Close db.Close If Err.Number <> 0 Then status "ERROR IN MY PARAMETERS!!" Err.Clear End If End Sub
Public Sub read_scaleparm(param_to_log As Byte) If param_to_log = 1 Then Printdok "read_scaleparm: ************ ACTUAL SELECTIONS BELOW *********" 'Dim db As Database 'Dim tabell As Recordset 'Set db = OpenDatabase(sesimpath & "\parameterdata\sesimrun.mdb", , vbReadOnly) 'Set tabell = db.OpenRecordset("parm_scale") ' OS 2002-02-12 Byte t ADO för att fungera med standatd Win 2000 datorer Dim tabell As New ADODB.Recordset, db As New ADODB.Connection Dim i As Integer db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & sesimpath & "\parameterdata\sesimrun.mdb" db.Open ' db.CursorLocation = adUseClient Set tabell.ActiveConnection = db tabell.Open "parm_scale", db, adOpenStatic, adLockBatchOptimistic i = 0 ' If tabell is non-empty then point to first record else create "false" ' record to prevent errors If tabell.EOF = False Then tabell.MoveFirst Else ReDim parm_scalefactor(1 To 1) parm_scalefactor(1).name = "false record" End If Do While tabell.EOF = False i = i + 1 ReDim Preserve parm_scalefactor(1 To i) parm_scalefactor(i).name = tabell("Name") parm_scalefactor(i).time_from = tabell("From") parm_scalefactor(i).time_to = tabell("To") parm_scalefactor(i).scalefactor = tabell("Value") parm_scalefactor(i).active = tabell("On") tabell.MoveNext If param_to_log = 1 Then Printdok (parm_scalefactor(i).name & " ative from " & parm_scalefactor(i).time_from & _ " to " & parm_scalefactor(i).time_to & " Value: " & parm_scalefactor(i).scalefactor & _ " On: " & parm_scalefactor(i).active) End If Loop If param_to_log = 1 Then Printdok ("************* End of scaleparams *******************") End Sub
Public Function get_scalefactor(name) Dim i As Integer, year As Integer year = base_year + model_time get_scalefactor = 1# For i = 1 To UBound(parm_scalefactor) If parm_scalefactor(i).active = 1 And _ LCase(parm_scalefactor(i).name) = LCase(name) And _ parm_scalefactor(i).time_from <= year And _ parm_scalefactor(i).time_to >= year Then get_scalefactor = parm_scalefactor(i).scalefactor End If Next End Function
Public Function get_scalefactor_active(name) Dim i As Integer, year As Integer year = base_year + model_time get_scalefactor_active = 0# For i = 1 To UBound(parm_scalefactor) If LCase(parm_scalefactor(i).name) = LCase(name) And _ parm_scalefactor(i).time_from <= year And _ parm_scalefactor(i).time_to >= year Then get_scalefactor_active = parm_scalefactor(i).active End If Next End Function