segment outside;

**********************************************************************
*                                                                    *
* SURVEY OF CONSUMER FINANCES            EMPLOYER SPONSORED PENSIONS *
*                                                                    *
*                     BENEFIT ESTIMATION PROGRAM                     *
*                                                                    *
* RICHARD CURTIN                                     PAUL PICKELMANN *
*                                                    SCOT ALLEN      *
*                                                                    *
*                (c) 1986  THE UNIVERSITY OF MICHIGAN                *
*                                                                    *
**********************************************************************


 These are the functions which estimate things which are not defined
 as part of a pension plan:

function aa     (b,e:real):   real; external;
function aage   (b,age:real): real; external;
function ai     (x,f,t:real): real; external;
function anytime(b,e:real):   real; external;
function apvla  (b:real):     real; external;
function ar     (n:real):     real; external;
function wage   (t:real):     real; external;
function ss     (k,t:real):   real; external;
function ssage  (k:real):     real; external;
function ssbase (t:real):     real; external;
function annpay(pvamt,b:real):real; external;

 They use the following functions and variables:

function a1a2  (b1,e1,b2,e2:real):  real; forward;
function death (t:real):            real; forward;
function lives (t:real;gender:real):integer; forward;

const
   sexmale = 1;  sexfemale=2;  sexunknown=3;
def
   benifitd, birthd,  quitd, minbend, todayd, vdq, lastwage,
   lninfl, pcintr, lnintr, lnwage, lnbase, lnben, prag, basegrow, bengrow,
   surveyd, married, shrs, swage, sssbase, sssben: real;
   sex,oppsex,anntype,continpmt: real;
   coefpumi,coefpume,coefpuma,coefjumi,coefjume,coefjuma : real;
   coefprmi,coefprme,coefprma,coefjrmi,coefjrme,coefjrma : real;
   coefpdmi,coefpdme,coefpdma,coefjdmi,coefjdme,coefjdma : real;
   coefdsmi,coefdsme,coefdsma : real;
   mincutss, maxcutss : real;

 As well as:

procedure  evalerr(m:string(4));  external;
%page
     Actuarial  Adjustment  Functions  for  Annuities

   Adjusted Anual Pension := f(...) * Original Annual Pension.

 A1A2 does all the work.  The rest just setup the parameters.

        ==== Original ==== ==== Adjusted ====
        ---From-- ---To--- ---From-- ---To---
 a1a2: !    B1   !   E1   !    B2   !   E2   !
   AA: !    B    !   E    ! BenfitD ! death  !
 AAGE: !    B    ! death  !   Age   ! death  !
   AI: ! BenfitD ! death  !    F    ! death  ! F Based on X, Max F-T
   AR: ! BfitD+n ! death  ! BenfitD ! death  !


function a1a2(b1,e1,b2,e2:real): real;
var  t0: real;
begin
  t0 := (b1+e1+b2+e2)/4;
a1a2 := (exp(lnintr*(t0-e1)) - exp(lnintr*(t0-b1)))
       /(exp(lnintr*(t0-e2)) - exp(lnintr*(t0-b2)));
end;

function aa(b,e:real): real;
var  f: real;
begin
if  (vdq=-1.0) and (b<minbend)  then  minbend := b;
if  e=0.0  then  e := death(b);
f  :=  death(benifitd);
if  e<=b  then  aa := 0.0  else  aa := a1a2(b,e,benifitd,f);
end;

function aage(b,age:real): real;
begin  aage := a1a2(b,death(b),birthd+age,death(birthd+age))  end;

function ai(x,f,t:real): real;
  var  f1,f2: real;
begin
if x<=f
  then  ai := 1.0
  else begin
    f1 := benifitd - (x - f);
    f2 := benifitd - max(0, x - t);
    ai := a1a2(f1,death(f1),f2,death(f2)); end;
end;

function ar(n:real):real;
begin
if n<=0.0
  then  ar := 1.0
  else  ar := aa(benifitd+n,death(benifitd+n));
end;
%page
PM:  Computes the probability that the person will
 live another year
function pm(rspndnt:integer;date1,date2:real):real;
begin
  if rspndnt = 1 then pm := lives(date1+date2,sex)/lives(date1,sex)
  else if ((married = 0.0) and (anntype <> 2.0)) or (anntype = 1.0) then pm := 0
  else pm := lives(date1+date2,oppsex)/lives(date1,oppsex);
end;
%page
APVLA:  Pv = pensionb * apvla(benifitd).  Used to compute
 present value of a pension amount, adjusted by prag.
function apvla(b:real): real;
var i:integer; ptx,pty,pvsum,lnprag:real;
begin
pvsum := 0; lnprag := ln(1+prag);
for i := 0 to (116-round(b-birthd)) do begin
ptx := pm(1,b,i); pty := pm(2,b,i);
pvsum := pvsum + ((exp(lnprag*i))/(exp(lnintr*i)))*(ptx+pty*continpmt/100-ptx*pty*continpmt/100); end;
apvla := pvsum;
end;
%page
ANYTIME: Used in BEG formulas to determine when payments
 begin.
function anytime(b,e:real): real;
begin
if  e=0  then  e := birthd+80;
if  b>e  then  evalerr('ATBE');
if      e<benifitd  then  anytime := max(e,quitd)
else if b>benifitd  then  anytime := b
                    else  anytime := benifitd
end;
%page
ANNPAY:  Similiar to APVLA except only computes single life
 annuities, and prag is not used.
function annpay(pvamt,b:real):real;
var i:integer; ptx,pvsum:real;
begin
pvsum := 0;
for i := 0 to (116-round(b-birthd)) do begin
ptx := pm(1,b,i);
pvsum := pvsum + (1/(exp(lnintr*i)))*ptx; end;
annpay := (1/pvsum)*pvamt;
end;
%page;
LIVES:  Returns the number of people still living at a
 given age.  Only used in computing the mortality rates.
function lives(t:real;gender:real):integer;
var age : real; lf, lm : integer;
begin
if gender = sex then age := t - birthd
else if married = 0.0 then age := t - birthd
else age := t - married;
case round(age) of
 15:lm := 1000000; 16:lm := 999560; 17:lm := 999110; 18:lm := 998650; 19:lm := 998181;
 20:lm := 997692; 21:lm := 997183; 22:lm := 996654; 23:lm := 996106; 24:lm := 995538;
 25:lm := 994941; 26:lm := 994324; 27:lm := 993678; 28:lm := 993002; 29:lm := 992307;
 30:lm := 991583; 31:lm := 990829; 32:lm := 990046; 33:lm := 989244; 34:lm := 988413;
 35:lm := 987543; 36:lm := 986634; 37:lm := 985677; 38:lm := 984662; 39:lm := 983569;
 40:lm := 982369; 41:lm := 981053; 42:lm := 979591; 43:lm := 977955; 44:lm := 976107;
 45:lm := 974028; 46:lm := 971690; 47:lm := 969076; 48:lm := 966159; 49:lm := 962932;
 50:lm := 959379; 51:lm := 955484; 52:lm := 951251; 53:lm := 946675; 54:lm := 941752;
 55:lm := 936488; 56:lm := 930878; 57:lm := 924911; 58:lm := 918585; 59:lm := 911889;
 60:lm := 904795; 61:lm := 897249; 62:lm := 889192; 63:lm := 880531; 64:lm := 871171;
 65:lm := 861013; 66:lm := 849949; 67:lm := 837880; 68:lm := 824709; 69:lm := 810351;
 70:lm := 794711; 71:lm := 777728; 72:lm := 759335; 73:lm := 739494; 74:lm := 718167;
 75:lm := 695336; 76:lm := 670964; 77:lm := 645045; 78:lm := 617573; 79:lm := 588578;
 80:lm := 558113; 81:lm := 526284; 82:lm := 493239; 83:lm := 459166; 84:lm := 424311;
 85:lm := 388996; 86:lm := 353601; 87:lm := 318552; 88:lm := 284282; 89:lm := 251214;
 90:lm := 219714; 91:lm := 190077; 92:lm := 162541; 93:lm := 137277; 94:lm := 114403;
 95:lm := 93977; 96:lm := 76008; 97:lm := 60448; 98:lm := 47203; 99:lm := 36123;
 100:lm := 27024; 101:lm := 19703; 102:lm := 13948; 103:lm := 9543; 104:lm := 6276;
 105:lm := 3941; 106:lm := 2344; 107:lm := 1307; 108:lm := 675; 109:lm := 318;
 110:lm := 134; 111:lm := 49; 112:lm := 15; 113:lm := 4; 114:lm := 1;
 115:lm := 0; 116:lm := 0; otherwise lm := 0;
end;
case round(age) of
 15:lf := 1000000; 16:lf := 999810; 17:lf := 999610; 18:lf := 999400; 19:lf := 999170;
 20:lf := 998930; 21:lf := 998670; 22:lf := 998390; 23:lf := 998100; 24:lf := 997791;
 25:lf := 997462; 26:lf := 997113; 27:lf := 996744; 28:lf := 996355; 29:lf := 995946;
 30:lf := 995528; 31:lf := 995090; 32:lf := 994632; 33:lf := 994155; 34:lf := 993658;
 35:lf := 993141; 36:lf := 992595; 37:lf := 992029; 38:lf := 991424; 39:lf := 990780;
 40:lf := 990096; 41:lf := 989363; 42:lf := 988572; 43:lf := 987712; 44:lf := 986784;
 45:lf := 985768; 46:lf := 984664; 47:lf := 983453; 48:lf := 982116; 49:lf := 980643;
 50:lf := 979015; 51:lf := 977223; 52:lf := 975249; 53:lf := 973084; 54:lf := 970719;
 55:lf := 968147; 56:lf := 965349; 57:lf := 962308; 58:lf := 959007; 59:lf := 955420;
 60:lf := 951522; 61:lf := 947269; 62:lf := 942618; 63:lf := 937518; 64:lf := 931902;
 65:lf := 925723; 66:lf := 918928; 67:lf := 911494; 68:lf := 903391; 69:lf := 894601;
 70:lf := 885073; 71:lf := 874718; 72:lf := 863425; 73:lf := 851061; 74:lf := 837461;
 75:lf := 822462; 76:lf := 805906; 77:lf := 787652; 78:lf := 767559; 79:lf := 745515;
 80:lf := 721413; 81:lf := 695154; 82:lf := 666667; 83:lf := 635920; 84:lf := 602922;
 85:lf := 567748; 86:lf := 530549; 87:lf := 491559; 88:lf := 451094; 89:lf := 409584;
 90:lf := 367606; 91:lf := 325842; 92:lf := 285037; 93:lf := 245924; 94:lf := 209168;
 95:lf := 175318; 96:lf := 144772; 97:lf := 117766; 98:lf := 94372; 99:lf := 74450;
 100:lf := 57740; 101:lf := 43927; 102:lf := 32684; 103:lf := 23689; 104:lf := 16642;
 105:lf := 11260; 106:lf := 7281; 107:lf := 4455; 108:lf := 2548; 109:lf := 1341;
 110:lf := 636; 111:lf := 264; 112:lf := 92; 113:lf := 25; 114:lf := 5;
 115:lf := 1; 116:lf := 0; otherwise lf := 0;
end;
case round(gender) of
    sexmale: lives := lm;
  sexfemale: lives := lf;
   otherwise lives := round((lm+lf)/2);
end;
end;
%page
DEATH: Expected death date at date t, given person is alive then
function death(t:real):real;
var  age, d,df,dm: real;
begin
age := t-birthd;
case round(age) of
  15:dm := 64.36;16:dm := 63.39;17:dm := 62.42;18:dm := 61.44;19:dm := 60.47;
  20:dm := 59.50;21:dm := 58.53;22:dm := 57.56;23:dm := 56.59;24:dm := 55.63;
  25:dm := 54.66;26:dm := 53.69;27:dm := 52.73;28:dm := 51.76;29:dm := 50.80;
  30:dm := 49.83;31:dm := 48.87;32:dm := 47.91;33:dm := 46.95;34:dm := 45.99;
  35:dm := 45.03;36:dm := 44.07;37:dm := 43.11;38:dm := 42.15;39:dm := 41.20;
  40:dm := 40.25;41:dm := 39.30;42:dm := 38.36;43:dm := 37.43;44:dm := 36.50;
  45:dm := 35.57;46:dm := 34.66;47:dm := 33.75;48:dm := 32.85;49:dm := 31.96;
  50:dm := 31.07;51:dm := 30.20;52:dm := 29.33;53:dm := 28.47;54:dm := 27.62;
  55:dm := 26.77;56:dm := 25.93;57:dm := 25.09;58:dm := 24.26;59:dm := 23.44;
  60:dm := 22.62;61:dm := 21.80;62:dm := 20.99;63:dm := 20.20;64:dm := 19.41;
  65:dm := 18.63;66:dm := 17.87;67:dm := 17.12;68:dm := 16.38;69:dm := 15.66;
  70:dm := 14.96;71:dm := 14.28;72:dm := 13.61;73:dm := 12.96;74:dm := 12.33;
  75:dm := 11.72;76:dm := 11.13;77:dm := 10.56;78:dm := 10.00;79:dm := 9.47;
  80:dm := 8.96;81:dm := 8.47;82:dm := 8.01;83:dm := 7.57;84:dm := 7.15;
  85:dm := 6.75;86:dm := 6.37;87:dm := 6.02;88:dm := 5.69;89:dm := 5.37;
  90:dm := 5.07;91:dm := 4.78;92:dm := 4.50;93:dm := 4.24;94:dm := 3.99;
  95:dm := 3.75;96:dm := 3.51;97:dm := 3.29;98:dm := 3.07;99:dm := 2.86;
  100:dm := 2.66;101:dm := 2.46;102:dm := 2.26;103:dm := 2.08;104:dm := 1.90;
  105:dm := 1.73;106:dm := 1.57;107:dm := 1.41;108:dm := 1.27;109:dm := 1.13;
  110:dm := 1.01;111:dm := 0.89;112:dm := 0.78;113:dm := 0.70;114:dm := 0.67;
  115:dm := 0.50;
end;
case round(age) of
  15:df := 69.47;16:df := 68.49;17:df := 67.50;18:df := 66.51;19:df := 65.53;
  20:df := 64.55;21:df := 63.56;22:df := 62.58;23:df := 61.60;24:df := 60.62;
  25:df := 59.64;26:df := 58.66;27:df := 57.68;28:df := 56.70;29:df := 55.72;
  30:df := 54.75;31:df := 53.77;32:df := 52.80;33:df := 51.82;34:df := 50.85;
  35:df := 49.87;36:df := 48.90;37:df := 47.93;38:df := 46.96;39:df := 45.99;
  40:df := 45.02;41:df := 44.05;42:df := 43.09;43:df := 42.12;44:df := 41.16;
  45:df := 40.20;46:df := 39.25;47:df := 38.30;48:df := 37.35;49:df := 36.40;
  50:df := 35.46;51:df := 34.53;52:df := 33.59;53:df := 32.67;54:df := 31.75;
  55:df := 30.83;56:df := 29.92;57:df := 29.01;58:df := 28.11;59:df := 27.21;
  60:df := 26.32;61:df := 25.44;62:df := 24.56;63:df := 23.69;64:df := 22.83;
  65:df := 21.98;66:df := 21.14;67:df := 20.31;68:df := 19.49;69:df := 18.67;
  70:df := 17.87;71:df := 17.07;72:df := 16.29;73:df := 15.52;74:df := 14.76;
  75:df := 14.02;76:df := 13.30;77:df := 12.60;78:df := 11.91;79:df := 11.25;
  80:df := 10.61;81:df := 9.99;82:df := 9.40;83:df := 8.83;84:df := 8.28;
  85:df := 7.77;86:df := 7.28;87:df := 6.81;88:df := 6.38;89:df := 5.98;
  90:df := 5.60;91:df := 5.26;92:df := 4.94;93:df := 4.64;94:df := 4.37;
  95:df := 4.12;96:df := 3.88;97:df := 3.65;98:df := 3.44;99:df := 3.22;
  100:df := 3.01;101:df := 2.80;102:df := 2.59;103:df := 2.38;104:df := 2.18;
  105:df := 1.98;106:df := 1.79;107:df := 1.60;108:df := 1.43;109:df := 1.26;
  110:df := 1.11;111:df := 0.97;112:df := 0.83;113:df := 0.71;114:df := 0.60;
  115:df := 0.50;
end;
case  round(sex)  of
     sexmale: d := dm;
  sexunknown: d := (dm+df)/2;
   sexfemale: d := df;
  end;
death := t + d;
end;
%page
WAGE:  Annual Wage at time t
function wage(t:real):real;
begin
wage := swage*exp(lnwage*(t-surveyd));
end;

SSAGE: Age at which person becomes eligeable for Social Security
function ssage(k:real):real; external;
begin
case  round(k)  of
  1:  ssage := 65;
  2:  ssage := 62;
  end;
end;

SSBASE: Social Securtiy wage base at time t
function ssbase(t:real):real;
begin  ssbase := (sssbase)*exp(lnbase*(t-surveyd));  end;

SSBEN: Social Security base benefit at time t
function ssben(t:real):real;
begin ssben := (sssben)*exp(lnben*(t-surveyd)); end;
%page;
SS: Adjusted Social Security benifit at time t

    k  0: Benifit Recieved
       1: Primary Unreduced
       2: Primary Reduced
       3: Joint   Unreduced
       4: Joint   Reduecd
       5: Disability
       6: Death

function ss(k,t:real): real;
  var  p,b,adjlastwage,adjmincut,adjmaxcut,tempms: real; j:integer;
begin
if  k=0.0  then  begin
  if  (t-birthd)>=62  then  k := 2;
  if  (t-birthd)>=65  then  k := 1;   end;
if anntype = 1.0 then tempms := 0.0
else if anntype = 2.0 then begin if married = 0.0 then
tempms := birthd else tempms := married; end
else tempms := married;
p := ssben(t);
adjmincut := mincutss * exp(lnbase*(t-surveyd));
adjmaxcut := maxcutss * exp(lnbase*(t-surveyd));
adjlastwage := lastwage * exp(lnwage*(t-surveyd));
if adjlastwage < adjmincut
  then j := 0
  else if adjlastwage > adjmaxcut
    then j := 2
    else j := 1;
if ((k = 3) or (k = 4)) and (tempms = 0) then k := k - 2;
case round(k) of
  1 : case j of
        0 : b := (coefpumi) * p;
        1 : b := (coefpume) * p;
        2 : b := (coefpuma) * p;
      end;
  3 : case j of
        0 : b := (coefjumi) * p;
        1 : b := (coefjume) * p;
        2 : b := (coefjuma) * p;
      end;
  2 : case j of
        0 : b := (coefprmi) * p;
        1 : b := (coefprme) * p;
        2 : b := (coefprma) * p;
      end;
  4 : case j of
        0 : b := (coefjrmi) * p;
        1 : b := (coefjrme) * p;
        2 : b := (coefjrma) * p;
      end;
  5 : if (tempms = 0) then
        case j of
          0 : b := (coefpdmi) * p;
          1 : b := (coefpdme) * p;
          2 : b := (coefpdma) * p;
        end
      else
        case j of
          0 : b := (coefjdmi) * p;
          1 : b := (coefjdme) * p;
          2 : b := (coefjdma) * p;
        end;
  6 : case j of
        0 : b := (coefdsmi) * p;
        1 : b := (coefdsme) * p;
        2 : b := (coefdsma) * p;
      end;
  0 : b := 0.0;
end;
ss := b;
end;
 .
