１６ｃｄ - プログラム倉庫

Private Sub Command1_Click()
Dim byear As Single
Dim age As Single
Dim car As Single
Dim mis(1900 To 2100, 14 To 69, 1 To 49) As Single
Dim mos(1900 To 2100, 14 To 69, 1 To 49) As Single
Dim m2by(1900 To 2100, 15 To 69) As Single
Dim f2by(1900 To 2100, 15 To 69) As Single
Dim mdeby(1900 To 2100, 0 To 99) As Single
Dim fdeby(1900 To 2100, 0 To 99) As Single
Dim alpha(15 To 69) As Single
Dim beta(15 To 69) As Single
Dim gamma(15 To 69) As Single
Dim theta(15 To 64) As Single
Dim zan(1900 To 2100, 15 To 64, 1 To 49) As Single
Dim zant(1900 To 2100, 15 To 64, 1 To 49) As Single
Dim mde(1900 To 2100, 0 To 99) As Single
Dim minx(14 To 75, 0 To 50) As Single
Dim mout(14 To 75, 0 To 50) As Single
Dim mnew(1900 To 2100) As Single
Dim z1 As Single
Dim z2 As Single
Dim z3 As Single
Dim v As Single
Open "c:/nagoya/gdata/変形生命表.txt " For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3, a4
byear = a1
age = a2
mdeby(byear, age) = a3
fdeby(byear, age) = a4
Loop
Close #1
Open "c:/nagoya/data/男子脱退力.txt " For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4
age = a1
gamma(age) = a2
alpha(age) = a3
beta(age) = a4
Loop
Close #2
Open "c:/nagoya/data/再加入率.txt " For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3, a4
age = a1
theta(age) = a2
Loop
Close #3
Open "c:/nagoya/data/男子被保険者.txt " For Input As #6
Do Until EOF(6)
Input #6, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50, a51, a52
age = a1
minx(age, 0) = a2
minx(age, 1) = a3
minx(age, 2) = a4
minx(age, 3) = a5
minx(age, 4) = a6
minx(age, 5) = a7
minx(age, 6) = a8
minx(age, 7) = a9
minx(age, 8) = a10
minx(age, 9) = a11
minx(age, 10) = a12
minx(age, 11) = a13
minx(age, 12) = a14
minx(age, 13) = a15
minx(age, 14) = a16
minx(age, 15) = a17
minx(age, 16) = a18
minx(age, 17) = a19
minx(age, 18) = a20
minx(age, 19) = a21
minx(age, 20) = a22
minx(age, 21) = a23
minx(age, 22) = a24
minx(age, 23) = a25
minx(age, 24) = a26
minx(age, 25) = a27
minx(age, 26) = a28
minx(age, 27) = a29
minx(age, 28) = a30
minx(age, 29) = a31
minx(age, 30) = a32
minx(age, 31) = a33
minx(age, 32) = a34
minx(age, 33) = a35
minx(age, 34) = a36
minx(age, 35) = a37
minx(age, 36) = a38
minx(age, 37) = a39
minx(age, 38) = a40
minx(age, 39) = a41
minx(age, 40) = a42
minx(age, 41) = a43
minx(age, 42) = a44
minx(age, 43) = a45
minx(age, 44) = a46
minx(age, 45) = a47
minx(age, 46) = a48
minx(age, 47) = a49
minx(age, 48) = a50
minx(age, 49) = a51
minx(age, 50) = a52
Loop
Close #6
Open "c:/nagoya/data/男子待期者.txt " For Input As #7
Do Until EOF(7)
Input #7, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50, a51, a52
age = a1
mout(age, 0) = a2
mout(age, 1) = a3
mout(age, 2) = a4
mout(age, 3) = a5
mout(age, 4) = a6
mout(age, 5) = a7
mout(age, 6) = a8
mout(age, 7) = a9
mout(age, 8) = a10
mout(age, 9) = a11
mout(age, 10) = a12
mout(age, 11) = a13
mout(age, 12) = a14
mout(age, 13) = a15
mout(age, 14) = a16
mout(age, 15) = a17
mout(age, 16) = a18
mout(age, 17) = a19
mout(age, 18) = a20
mout(age, 19) = a21
mout(age, 20) = a22
mout(age, 21) = a23
mout(age, 22) = a24
mout(age, 23) = a25
mout(age, 24) = a26
mout(age, 25) = a27
mout(age, 26) = a28
mout(age, 27) = a29
mout(age, 28) = a30
mout(age, 29) = a31
mout(age, 30) = a32
mout(age, 31) = a33
mout(age, 32) = a34
mout(age, 33) = a35
mout(age, 34) = a36
mout(age, 35) = a37
mout(age, 36) = a38
mout(age, 37) = a39
mout(age, 38) = a40
mout(age, 39) = a41
mout(age, 40) = a42
mout(age, 41) = a43
mout(age, 42) = a44
mout(age, 43) = a45
mout(age, 44) = a46
mout(age, 45) = a47
mout(age, 46) = a48
mout(age, 47) = a49
mout(age, 48) = a50
mout(age, 49) = a51
mout(age, 50) = a52
Loop
Close #7
Open "c:/nagoya/gdata/変形厚生年金被保険者.txt " For Input As #5
Do Until EOF(5)
Input #5, a1, a2, a3, a4
byear = a1
age = a2
m2by(byear, age) = a3
f2by(byear, age) = a4
Loop
Close #5
For byear = 1941 To 1989
ageage = 2005 - byear
age = ageage
For car = 1 To 49
a1 = minx(age, car) / 10 ^ 4
a2 = mout(age, car) / 10 ^ 4
mis(byear, age, car) = a1
mos(byear, age, car) = a2
Next
age = ageage + 1
mis(byear, age, 1) = m2by(byear, age)
For age = ageage + 1 To 64
z1 = (1 - gamma(age - 1)) * m2by(byear, age - 1)
z2 = m2by(byear, age) - z1
If z2 < 0 Then z2 = 0
z3 = (1 - theta(age)) * z2
z4 = theta(age) * z2
mis(byear, age, 1) = z3
z5 = 0
For car = 1 To 49
z5 = z5 + mos(byear, age - 1, car)
Next
If z5 = 0 Then z5 = 1
v = z4 / z5
If v > 1 Then v = 1
For car = 2 To 49
mis(byear, age, car) = (1 - gamma(age - 1)) * mis(byear, age - 1, car - 1) + v * mos(byear, age - 1, car - 1)
Next
For car = 1 To 49
mos(byear, age, car) = (gamma(age - 1) - alpha(age - 1) - beta(age)) * mis(byear, age - 1, car) + (1 - mdeby(byear, age) - v) * mos(byear, age - 1, car)
Next
Next
age = 64
z1 = 0
For car = 1 To 24
z1 = z1 + mis(byear, age, car) + mos(byear, age, car)
Next
mnew(byear) = z1
Debug.Print byear
Next
Open "c:/nagoya/gdata/男子通算新規裁定者2.txt " For Output As #4
For byear = 1940 To 1989
Write #4, byear, mnew(byear)
Next
Close #4
End Sub