PROGRAM lifecycle

IMPLICIT NONE

!!!!!!!!!!!!!!!!!!!!
! DEFINE VARIABLES !
!!!!!!!!!!!!!!!!!!!!

INTEGER :: i1, i2, i3, i4, i5, i6, i7, i8, i9
INTEGER :: index_out
INTEGER :: aux2
INTEGER :: tb, t1, tr, td, tn, tn1,t, count_a
parameter (tb=22, tr=66, td=100, tn=td-tb+1)
INTEGER :: na, ncash, n, nc
parameter (na=101, ncash=201, n=9, nc=101)
INTEGER, DIMENSION(1) :: pt
REAL :: maxcash=50.0, mincash=0.25
REAL :: l_maxcash, l_mincash, stepcash
REAL :: stepc, maxc, minc, mpc, temp_a
REAL :: aa=-1.9317, b1=0.3194, b2=-0.00577, b3=0.000033  
REAL :: ret_y=0.0, ret_fac=0.80                        
REAL :: smay=0.24166, smav=0.13, corr_v=0.0, corr_y=0.0  
REAL :: rho=4, delta=0.96, psi=0.25, theta, psi_1, psi_2
REAL :: rf=0.02, mu=0.04, sigr=0.185
REAL :: cash_1, riskret0
REAL :: auxVV, u, int_V, sav
REAL :: gyp_retire_adjust
REAL :: optimal_a

REAL, DIMENSION(tn+1,1) :: survprob=0.0 , delta2=0.0
REAL, DIMENSION(n,1) :: grid, weig, gret, ones_n_1=1.0, grid2
REAL, DIMENSION(n,n) :: yp
REAL, DIMENSION(n,n) :: yh
REAL, DIMENSION(n,n,n) :: nweig1
REAL, DIMENSION(tr-tb+1,1) :: f_y=0.0
REAL, DIMENSION(tr-tb,1) :: gy=0.0
REAL, DIMENSION(n,n,tn-1) :: gyp=0.0
REAL, DIMENSION(ncash,1) :: gcash, lgcash
REAL, DIMENSION(na,1) :: ga
REAL, DIMENSION(na,n) :: riskret
REAL, DIMENSION(nc,1) :: gc
REAL, DIMENSION(nc,1) :: auxV
REAL, DIMENSION(na*nc,1) :: vec_V

REAL, DIMENSION(ncash,tn) :: C=0.0, V=0.0, A = 0.6

REAL, DIMENSION(:,:), allocatable :: V_cgm
REAL :: read_cash

! Read consumption from CGM results
OPEN (unit=99, file='V_max.txt', status='old', access='sequential', action='read')
allocate(V_cgm(ncash,tn-1))

do i1=1,ncash
    read(99,*) read_cash
    read(99,*) V_cgm(i1,:)
    !write(*,*) read_cash
end do

close (99)


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! APPROXIMATION TO NORMAL DISTRIBUTION  !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
grid(1,1) = -3.19099320178152*1.41421356237  
grid(2,1) = -2.26658058453184*1.41421356237
grid(3,1) = -1.46855328921666*1.41421356237     
grid(4,1) = -0.723551018752837*1.41421356237         
grid(5,1) =  0.00000000000000*1.41421356237   
grid(6,1) =  0.723551018752837*1.41421356237    
grid(7,1) =  1.46855328921666*1.41421356237        
grid(8,1) =  2.26658058453184*1.41421356237       
grid(9,1) =  3.19099320178152*1.41421356237  

weig(1,1) = 0.0000396069772632643/1.77245385091
weig(2,1) = 0.00494362427553694/1.77245385091
weig(3,1) = 0.0884745273943765/1.77245385091 
weig(4,1) = 0.432651559002555/1.77245385091
weig(5,1) = 0.72023521560605/1.77245385091  
weig(6,1) = 0.432651559002555/1.77245385091
weig(7,1) = 0.0884745273943765/1.77245385091
weig(8,1) = 0.00494362427553694/1.77245385091 
weig(9,1) = 0.0000396069772632643/1.77245385091 

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! CONDITIONAL SURVIVAL PROBABILITIES  !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
survprob(1,1) =0.99925
survprob(2,1) =0.99916
survprob(3,1) =0.99908
survprob(4,1) =0.99902
survprob(5,1) =0.99898
survprob(6,1) =0.99894
survprob(7,1) =0.9989
survprob(8,1) =0.99886
survprob(9,1) =0.99881
survprob(10,1) =0.99875
survprob(11,1) =0.99869
survprob(12,1) =0.99863
survprob(13,1) =0.99856
survprob(14,1) =0.9985
survprob(15,1) =0.99844
survprob(16,1) =0.99836
survprob(17,1) =0.99829
survprob(18,1) =0.99822
survprob(19,1) =0.99815
survprob(20,1) =0.99809
survprob(21,1) =0.99801
survprob(22,1) =0.99791
survprob(23,1) =0.99779
survprob(24,1) =0.99766
survprob(25,1) =0.9975
survprob(26,1) =0.99732
survprob(27,1) =0.99712
survprob(28,1) =0.99691
survprob(29,1) =0.99667
survprob(30,1) =0.99639
survprob(31,1) =0.9961
survprob(32,1) =0.99576
survprob(33,1) =0.99536
survprob(34,1) =0.99489
survprob(35,1) =0.99439
survprob(36,1) =0.99388
survprob(37,1) =0.99337
survprob(38,1) =0.99283
survprob(39,1) =0.99225
survprob(40,1) =0.99161
survprob(41,1) =0.99091
survprob(42,1) =0.99019
survprob(43,1) =0.98948
survprob(44,1) =0.9888
survprob(45,1) =0.98811
survprob(46,1) =0.98738
survprob(47,1) =0.9865
survprob(48,1) =0.98553
survprob(49,1) =0.98443
survprob(50,1) =0.9832
survprob(51,1) =0.98186
survprob(52,1) =0.98032
survprob(53,1) =0.97881
survprob(54,1) =0.97647
survprob(55,1) =0.97442
survprob(56,1) =0.97171
survprob(57,1) =0.969
survprob(58,1) =0.96551
survprob(59,1) =0.96193
survprob(60,1) =0.95785
survprob(61,1) =0.95341
survprob(62,1) =0.94841
survprob(63,1) =0.94226
survprob(64,1) =0.93546
survprob(65,1) =0.92836
survprob(66,1) =0.91947
survprob(67,1) =0.91026
survprob(68,1) =0.89952
survprob(69,1) =0.88775
survprob(70,1) =0.87491
survprob(71,1) =0.86096
survprob(72,1) =0.8459
survprob(73,1) =0.82974
survprob(74,1) =0.81251
survprob(75,1) =0.79425
survprob(76,1) =0.77505
survprob(77,1) =0.75501
survprob(78,1) =0.73425
survprob(79,1) =0.71294
survprob(80,1) =0.69123

!!!!!!!!!!!!!!!!!!!!!!!!!!!
! ADDITIONAL COMPUTATIONS !
!!!!!!!!!!!!!!!!!!!!!!!!!!!
do i1=1,n
   gret(i1,1) = EXP(rf+mu+grid(i1,1)*sigr)
end do 
do i6=1,n
   do i7=1,n
      do i8=1,n
         nweig1(i6,i7,i8) = weig(i6,1)*weig(i7,1)*weig(i8,1)
      end do
   end do
end do

psi = 1.0/rho
!theta = (1.0-1.0/psi)/(1.0-rho)
theta = 1.0
!psi_1 = 1.0-1.0/psi
psi_1 = 1.0-rho
psi_2 = 1.0/psi_1 

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! GRIDS FOR THE STATE VARIABLES AND FOR PORTFOLIO RULE !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
DO i1=1,na
   ga(i1,1)=(na-i1)/(na-1.0)
END DO

do i5=1,na
   do i8=1,n
      riskret(i5,i8)=EXP(rf)*(1.0-ga(i5,1))+gret(i8,1)*ga(i5,1)
   end do   !i8
end do    !i5

l_maxcash = log(maxcash)
l_mincash = log(mincash)
stepcash = (l_maxcash-l_mincash)/(ncash-1)
DO i1=1,ncash
   lgcash(i1,1)=l_mincash+(i1-1.0)*stepcash
END DO
DO i1=1,ncash
   gcash(i1,1)=exp(lgcash(i1,1))
END DO


!!!!!!!!!!!!!!!!
! LABOR INCOME !
!!!!!!!!!!!!!!!!
do i1=1,n
   grid2(:,1) = grid(i1,1)*corr_y+grid(:,1)*ones_n_1(:,1)*(1-corr_y**2)**(0.5)
   yh(1:n,i1) = EXP(grid2(:,1)*smay)
end do

do i1=1,n
   grid2(:,1) = grid(i1,1)*corr_v+grid(:,1)*ones_n_1(:,1)*(1-corr_v**2)**(0.5)
   yp(:,i1) = grid2(:,1)*smav
end do

DO i1=tb,tr
   f_y(i1-tb+1,1) = EXP(aa+b1*i1+b2*i1**2+b3*i1**3)
END DO

do i1=tb,tr-1
   gy(i1-tb+1,1) = f_y(i1-tb+2,1)/f_y(i1-tb+1,1)
   do i2=1,n
!      gyp(:,i2,i1-tb+1) = EXP((gy(i1-tb+1,1)-1.0)*ones_n_1(:,1)+yp(:,i2))
      gyp(:,i2,i1-tb+1) = (gy(i1-tb+1,1)*ones_n_1(:,1))*EXP(yp(:,i2))
   end do
end do

do i1=tr-tb+1,tn-1
   do i2=1,n
      gyp(:,i2,i1) = EXP(0.0*ones_n_1(:,1))
   end do
end do

!!!!!!!!!!!!!!!!!!!
! TERMINAL PERIOD !
!!!!!!!!!!!!!!!!!!!
do i1=1,ncash
   C(i1,tn) = gcash(i1,1)
end do
A(:,tn) = 0.0
do i1=1,ncash
   V(i1,tn) = C(i1,tn)*((1.0-delta)**psi_2)
end do

!!!!!!!!!!!!!!!!!!!!!!
! RETIREMENT PERIODS !
!!!!!!!!!!!!!!!!!!!!!!
do i1= 1,td-tr
   t= tn-i1
   write(*,*) t
   !if (i1.eq.(td-tr)) then 
   !   gyp_retire_adjust = ret_fac
   !else
   !   gyp_retire_adjust = 1.0
   !end if
   temp_a = 1
   do i3=1,ncash
      if (i3.eq.1) then
         maxc = C(i3,t+1)
         minc = maxc/2
      else
         minc = C(i3-1,t)
         if (i3<10) then
            maxc = minc + (gcash(i3,1) - gcash(i3-1,1))
         else
            mpc = max((C(i3-1,t)-C(i3-9,t))/(gcash(i3-1,1) - gcash(i3-9,1)),0.5)
            maxc = minc + mpc*(gcash(i3,1) - gcash(i3-1,1))      
         end if         
      end if
      stepc=(maxc-minc)/(nc-1)
      do i9=1,nc
         gc(i9,1)=minc+(i9-1.0)*stepc
      end do
      do i4=1,nc
         u=(1.0-delta)*(gc(i4,1)**psi_1) !1-1/psi
         sav = gcash(i3,1)-gc(i4,1)
         optimal_a = A(i3,t)
         auxVV=0.0
         do i8=1,n
               cash_1= (EXP(rf)*(1.0-optimal_a)+gret(i8,1)*optimal_a)*sav + 1.0
               call linear_1d(gcash(:,1),V(:,t+1),ncash,cash_1,int_V)
               auxVV=auxVV+weig(i8,1)*survprob(t,1)*(int_V**(1.0-rho))
         end do   !i8
         auxV(i4,1) = (u+delta*(auxVV**(1.0/theta)))**psi_2    !1/(1-1/psi)
      end do   !i4
      V(i3,t) = MAXVAL(auxV(:,1))
      if (V_cgm(i3,t) < V(i3,t)) then
         V(i3,t) = V_cgm(i3,t)
      end if
      pt = MAXLOC(auxV(:,1))
      C(i3,t) = gc(pt(1),1)
   end do    !i3
end do    !i1

!!!!!!!!!!!!!!!!!
! OTHER PERIODS !
!!!!!!!!!!!!!!!!!

! gyp_retire_adjust is used for normalize the retirement period permanent income
! the value is set to 1.0 always except for the first iteration of the retirement period
! this is because the first iteration of the retirement period is age 65, and age 66 is not denominated by permanent income, but by the retirement income
! so we need to adjust the retirement income by the factor ret_fac
gyp_retire_adjust = 1.0

do i1= 1,tr-tb
   t= tr-tb-i1+1
   write(*,*) t
   if (i1.eq.1) then 
      gyp_retire_adjust = ret_fac
   else
      gyp_retire_adjust = 1.0
   end if
   temp_a = 1
   do i3=1,ncash
      if (i3.eq.1) then
         minc = gcash(i3,1)/5
         maxc = 0.999*gcash(i3,1)
      else
         minc = C(i3-1,t)
         if (i3<10) then
            maxc = minc + (gcash(i3,1) - gcash(i3-1,1))
         else
            mpc = max((C(i3-1,t)-C(i3-9,t))/(gcash(i3-1,1) - gcash(i3-9,1)),0.5)
            maxc = minc + mpc*(gcash(i3,1) - gcash(i3-1,1))      
         end if         
      end if
      stepc=(maxc-minc)/(nc-1)
      do i9=1,nc
         gc(i9,1)=minc+(i9-1.0)*stepc
      end do
      do i4=1,nc
         u=(1.0-delta)*(gc(i4,1)**psi_1)       !1-1/psi
         sav = gcash(i3,1)-gc(i4,1)
         auxVV=0.0
         optimal_a = A(i3,t)
            do i6=1,n
               do i8=1,n
                  do i7=1,n
                     cash_1= ((EXP(rf)*(1.0-optimal_a)+gret(i8,1)*optimal_a)*sav/gyp(i6,i8,t)+yh(i7,i8))/gyp_retire_adjust
                     call linear_1d(gcash(:,1),V(:,t+1),ncash,cash_1,int_V)
                     auxVV=auxVV+nweig1(i6,i7,i8)*survprob(t,1)*((int_V*gyp(i6,i8,t)*gyp_retire_adjust)**(1.0-rho))
                  end do   !i8
               end do      !i7
            end do         !i6
          auxV(i4,1) = (u+delta*(auxVV**(1.0/theta)))**psi_2    !1/(1-1/psi)                       
      end do   !i4
      V(i3,t) = MAXVAL(auxV(:,1))
      if (V_cgm(i3,t) < V(i3,t)) then
         V(i3,t) = V_cgm(i3,t)
      end if
      pt = MAXLOC(auxV(:,1))
      C(i3,t) = gc(pt(1),1)
   end do    !i3 
end do    !i1

OPEN(UNIT=2,FILE='C_sixty.txt',STATUS='replace',ACTION='write')
do i5=1,ncash
   WRITE(2,*) gcash(i5,1), C(i5,:) 
end do
CLOSE(UNIT=2)

OPEN(UNIT=1,FILE='V_sixty.txt',STATUS='replace',ACTION='write')
do i5=1,ncash
   WRITE(1,*) gcash(i5,1), V(i5,:) 
end do
CLOSE(UNIT=1)

end program

