c			  C:\DRW2\SIMPLE\1LENDA.F
c
c
c               Program to calculate:
c
c			  (a) stuff for fixed H when you have one lender
c
c               This program: 
c
c               - uses simple two point distribution {0,hu}
c               - the fraction that receives hu, gamh, depends on H
c
c               December 2 1998
c

		use msimsl
		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
	
     		external fgam


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


		do 448 ih = 1,180

			alpha  = 0.9
			depr   = 0.0
			bbbb   = 0.96
			xi	   = 0.25

			ifunc   = 3
			gam     = 0.400925
			eta     = 0.2

c			hstst   = 74.6980935014833-dble(ih-1)
			hstst   = 80.-0.5*dble(ih-1)

			xvalue  = 3.
			zero    = 0.
			vcost   = 0.342

			ststgam  =  fgam(hstst)
			ubar1    =  1-ststgam
			ststhu   =  hstst/ststgam
			ststge1  =  (1-ubar1)*bbbb*xvalue

			expv1    =  ststgam*ststhu**alpha

			ratuv  =  (vcost/(ststge1*xi))**2.
			probe  =  xi*ratuv**0.5
			probl  =  xi/(ratuv**0.5)

			ststn  =  probl/(ubar1+probl-probl*ubar1)
			ststu  =  1.-ststn+ststn*ubar1
			ststv  =  ststu/ratuv


			denom  =  1.-bbbb*(1.-ubar1)

			cg1    =  bbbb*expv1/denom
			sg1    =  bbbb*ubar1/denom			

			denom  =  1.-probl*sg1-bbbb*(1.-probl)

			ststw  =  probl*(cg1-ststge1)/denom

			ststg1 =  cg1 + sg1*ststw
			
c
c
c			check some stuff
c
c

			frag1 = ststhu**alpha+ststg1-xvalue-ststw
			xliq1 = ststhu**alpha+ststhu+ststge1-xvalue

		
		write(*,'(8f10.4)') ststg1,ststw,probe,probl,ststge1
		write(*,'(5f10.4)') expv1,hstst,ststgam,ststhu

c		write(*,*)
c		write(*,*) 'check fragility and liquidity'
c		write(*,*) 'check whether these values are > 0'
		write(*,'(4f14.6)') frag1,xliq1


		if(frag1.lt.0.or.xliq1.lt.0) stop


c
c
c		calculate return
c
c

		ststm1 = xvalue-ststge1		

		ret = ststn*(1.-ubar1)*(ststhu**alpha-ststm1)
     		ret = ret/hstst
		write(*,'(4f10.6)') ststn,ubar1,ststhu,ststm1

		write(*,'(8f9.5)') hstst,
     $ret,probe,probl,ststn,ststv,ststu
		write(99,'(9f9.5)') hstst,
     $ret,probe,probl,ststn,ststv,ststu,ubar1,
     $ststn*(1.-ubar)*ststhu**alpha

						pause
448		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(0.999))
		
		return
		end