c
c
c               C:\DRW2\SIMPLE\IMP1.F, 
c
c               a program to calculate 
c			  (a) return as a function of H
c			  (b) impulse response function for one-time shock in H
c
c			  same as the Excel program simple1.xls
c
c
c               This program: 
c
c               - uses simple two point distribution {0,hu}
c               - the fraction that receives hu, gamh,depends on H
c               - to calculate the impulse response functions, 
c				it is assumed that H never drops so much that 
c                 agents who receive hu would like to quit
c                 this means that the endogenous breakup probability
c                 is equal to 1-gamh
c
c               September 15 1998
c
c       
		implicit real*8(a-h,o-z),integer(i-n)
		common/par/xvalue,alpha,prob,depr,bbbb,xi,rox,gam,eta,
     $          hstst,vcost,ststg,ststw,ststge,ubar
		common/iiii/iend,ifunc
		dimension qn(1000),qh(1000),
     $          qlabx(1000),qv(1000),qubar(1000),qhu(1000),
     $          q1(1000),q2(1000)


		open(98,file='for098.dat',
     $    status='unknown')
		open(99,file='for099.dat',
     $    status='unknown')

			alpha  = 0.3
			prob   = 0.5
			depr   = 0.0
			bbbb   = 0.96
			xi	   = 0.25


c
c			x = 3, ifunc = 2
c
c 			gam    = 0.069777
c			eta    = 32.5
c
c			gam    = 0.059246
c			eta    = 25.
c
c			gam    = 0.053831
c			eta    = 20.
c
c			gam    = 0.065874
c			eta    = 30.
c
c			gam    = 0.042246
c			eta    = 5.
c			iii    = 11
c			rox    = 0.999
c
c			x = 3, ifunc = 3
c			gam    = 0.323145
c			eta    = 0.25
c			iii    = 22
c			rox    = 0.99
c			
c			when x = 3 then hstst  = 74.6980935014833
c
c
c			x = 1 values, ifunc = 2
c
c			gam    = 0.075705
c			eta    = 40.
c			gam    = 0.086873
c			eta    = 45.
c			gam    = 0.080809
c			eta    = 42.5
c			hstst  = 78.89381
c
c
c			these values were obtained as follows:
c
c			First, the return equation was used to solve for hstst setting the breakup
c			probability equal to 0.05 and the value of N and m to the implied values
c			Second, then for different values of eta the value of gam was found at which
c			the breakup probability at that value of hstst was indeed equal to 0.05
c
c


			ifunc   = 3
			gam     = 0.400925
			eta     = 0.2
			
			hstst   = 74.6980935014833
			xvalue  = 3.
			zero    = 0.



			iend = 30				

c
c
c			solve for the posting cost. We impose that at hstst the breakup probability
c			is equal to prob
c
c


			ststgam =  fgam(hstst)
			ubar    =  1-ststgam
			write(*,*) 'ubar',ubar
			ststn   =  prob/(prob+ubar-prob*ubar)
			ststv   =  (1.-ststn+ubar*ststn)*(prob/xi)**2.
			xge     =  ststgam*bbbb*xvalue
			write(*,*) ststv
			vcost   =  xi*xge*((1.-ststn+ubar*ststn)/ststv)**0.5             

	
		write(*,*) 'matching probability lender at hstst',prob
		write(*,*) 'matching probability firm   at hstst',
     $    xi*((1.-ststn+ubar*ststn)/ststv)**0.5

		pause


c
c
c			solve for return series as a function of H
c
c

		caph = 1.

		do 110 ih = 1,1000
		
		
		gamh   =  fgam(caph)
		xge    =  gamh*bbbb*xvalue
		xm     =  xvalue-xge
		xhu    =  caph/gamh
		xprod  =  ((1.-depr)*xhu)**alpha
		probh =  xi**2.*xge/vcost
		write(*,*) probh
		

			cw = -probh*xge - (1.-probh)*bbbb*depr*caph
			cw =    cw /(1.-(1.-probh)*bbbb)
			sw =  probh/(1.-(1.-probh)*bbbb)
			xg =  bbbb*gamh*xprod-bbbb*depr*caph+(1.-gamh)*bbbb*cw
			xg =  xg/(1.-bbbb*gamh-(1.-gamh)*bbbb*sw)
			xw =  cw + sw*xg

		xn   =  probh/(1.-gamh+probh*gamh)
		
		xret1  =  xn*gamh*(xprod-xm) - depr*caph
		xret1  =  xret1/caph
		xret2  =  gamh*(xprod) - depr*caph
		xret2  =  xret2/caph

		xfrag = xprod+xg-xw-xvalue
		xliq  = xprod+(1.-depr)*xhu-xm

		if(xfrag.lt.0.or.xliq.lt.0) then
		xret  = 0
		else
		xret  = xret1
		endif

		write(*,'(10f8.4)') caph,gamh,xn,xhu,xprod,xret,
     $    xret1,xret2,xfrag,xliq
		write(98,'(14f12.8)') caph,gamh,xn,xhu,xprod,xret,
     $    xret1,xret2,xfrag,xliq,xg,xw,xprod,probh
		caph = caph+0.1
110		continue


c
c
c		solve for steady state values
c
c
 			
		ststgam =  fgam(hstst)
		ubar    =  1-ststgam
		ststn   =  prob/(prob+ubar-prob*ubar)
		ststv   =  (1.-ststn+ubar*ststn)*(prob/xi)**2.
		xge     =  ststgam*bbbb*xvalue
		vcost   =  xi*xge*((1.-ststn+ubar*ststn)/ststv)**0.5             
		



c
c
c               solve for impulse response functions
c
c

		qh(1) = hstst*0.99
		qn(1) = ststn

		do 300 i = 2,1000
		qh(i) = hstst
300             continue

		do 200 i = 1,iend
		write(*,*) i                             

		temp     = qh(i)		
		gamh     = fgam(temp)
		qhu(i)   = qh(i)/gamh
		qubar(i) = 1.-gamh
		unemp    = 1.-qn(i)+qn(i)*qubar(i)

c               qv(i)    = unemp*(xi*xge/vcost)**2.
c               qlabx(i) = xi*(qv(i)/unemp)**0.5
				
		qlabx(i) = prob

c
c               note that here we use proposition 4 part c that says that
c               the matching probability doesn't change in reponse to an\
c               surprise liquidity shock
c
		qn(i+1)  = gamh*qn(i) + qlabx(i)*(1-gamh*qn(i))
		
		q1(i) = qn(i)*gamh*qhu(i)**alpha
		q2(i) = gamh*qhu(i)**alpha
200             continue
		
c
c               actually print out impulse response functions 
c
		
		do 400 i = 1,15
		write(*,'(i6,7f10.6)') i,qubar(i),qn(i),q1(i),q2(i)
		write(99,'(i6,7f14.8)') i,qubar(i),qh(i),qhu(i),
     $    qn(i),q1(i),q2(i)
400             continue
		
		stop
		end

		real*8 function fgam(hhhh)
		implicit real*8(a-h,o-z),integer(i-n)
		common/par/xvalue,alpha,prob,depr,bbbb,xi,rox,gam,eta,
     $          hstst,vcost,ststg,ststw,ststge,ubar
		common/iiii/iend,ifunc


		if(ifunc.eq.1) fgam = (gam*hhhh)**eta/(1.+(gam*hhhh)**eta)
		if(ifunc.eq.2) fgam = 1./(1.+exp(-gam*(hhhh-eta)))
		if(ifunc.eq.3) fgam = dmin1(gam*hhhh**eta,dble(1))
		
		return
		end