/* revcons2.gau  for Revenue-Constrained STIP Note 21-22/5/2003:
  Simulate welfare and profits as functions of R&D and output subsidies in R&D+Bertrand game and print Fig. 2*/
/*************************************************************************/
/*      USER-SPECIFIED VARIABLES                                     */
eta = 0.4;   /* Relative Effectiveness of R&D */
alph=0.5; /* Demand intercept; equals free-trade market share when only price ratio matters */
stepsize=.005;               /* stepsize in s1 (R&D Subsidy) loops: .005 for publication; .05 is coarsest valid for research */
stepsizeB=stepsize;    /* stepsize in s2 (Output Subsidy) loops  */
s1min=-0.5;
s1max=1.0;
n=1+(s1max-s1min)/stepsize;  /* n: # of values of s1 considered (=31 for stepsize=.05)*/
s2min=-1.0;
s2max=.5;
m=1+(s2max-s2min)/stepsize;  /* m: # of values of s2 considered */
/*************************************************************************/
/*              INITIALISE VECTORS */
s1=zeros(1,n);   /*  R&D Subsidy  */
s2=zeros(m,1);  /*  Output Subsidy  */
Ppi=zeros(m,n);  /*  Home Profits  */
W=zeros(m,n);   /* Home Welfare  */
s2PCW=zeros(1,n);  /* Profit-Constrained Welfare Locus */
ccode=zeros(m,n); 
/*************************************************************************/
/*  Preliminary calculations (independent of s1 and s2)  */
Delt=3-(4/3)*eta;  /* Det. of LHS Matrix of Generalised Reac. Funcs */
HH=1-(8/9)*eta;
WFT=alph^2 *(1-(2/9)*eta);  /* Welfare in free trade; q=.5 (=mkt share, alpha), x=(2/3)*eta*q */
/*************************************************************************/
sig0=(2/3)*alph;   /* Specify parameters for PCW locus */
sig1=2*(1+(2/3)*eta/Delt);
sig2=(5/3)/Delt;
phi0=alph;
phi1=(5/3)*eta/Delt;
phi2=2/Delt;
ome0=(HH/Delt-1/3)*alph;
ome1=1+(1/3+HH/Delt)*eta/Delt;
ome2=(2/3+HH/Delt)/Delt;
psi0=HH*alph/Delt;
psi1=(2/3+HH/Delt)*eta/Delt;
psi2=(1+HH/Delt)/Delt;
AAA=ome2*phi2-psi2*sig2;
/*************************************************************************/
i=1;                                  /*      BEGIN i - s1 (R&D Subsidy) DO LOOP    */
ss1=s1min-stepsize;  /* ss1: Current value of s1 */
DO until i>n;
ss1=ss1+stepsize;
s1[1,i]=ss1;		
/*************************************************************************/
/*  Calculate profit-constrained welfare (PCW) locus:  W_1.S_2=W_2.S_1 */
sig3=sig0+sig1*ss1;
phi3=phi0+phi1*ss1;
ome3=ome0+ome1*ss1;
psi3=psi0+psi1*ss1;
BBB=(ome3*phi2+ome2*phi3)-(psi3*sig2+psi2*sig3);
CCC=ome3*phi3-psi3*sig3;
DDD=BBB^2-4*AAA*CCC;
IF DDD<=0;
	s2PCW[1,i]=-10;
	GOTO ENDPCW;
ENDIF;
s2PCW[1,i]=(-BBB-DDD^0.5)/(2*AAA);   /* Note: pick the negative root */
ENDPCW:
/*************************************************************************/
/*              BEGIN j - s2 (Output Subsidy) DO LOOP    */
j=1;
ss2=s2min-stepsizeB;  /* ss2: Current value of s2 */
DO until j>m;
ss2=ss2+stepsizeB;
s2[j,1]=ss2;		
q= alph +(eta*ss1+ss2) / Delt;
/*************************************************************************/
qstar= 2*alph - q;
x = eta*((2/3)*q+ss1);
w[j,i]= ( (q - ss2)*q - 0.5*eta*((2/3)*q+ss1)^2)/WFT;  /* Welfare normalised by FT value */
ppi[j,i]=w[j,i]+(ss1*x+ss2*q)/WFT;
/*************** Check for negative output, R&D or profit levels and set CODE accordingly ***/
  IF q <0;					
       ccode[j,i]=1;
  ENDIF;					
  IF x <0;				
       ccode[j,i]=1;
  ENDIF;								
  IF ppi[j,i] <0;				
       ccode[j,i]=1;
  ENDIF;								
IF ccode[j,i]>=1;
      GOTO W_EQ_0;
ENDIF;
  GOTO ENDLOOP;
  W_EQ_0:
  W[j,i]=0;
  ppi[j,i]=0;
/*************************************************************************/
ENDLOOP:
        j=j+1;		/*  END OF j LOOP */
    endo;
    i=i+1;			/*  END OF i LOOP */
endo;
/*************************************************************************/
library pgraph;		/* COMPUTE AND PRINT FIGURES */
BEGWIND;
MAKEWIND(7.69,6.27,.6,0,0);  /*Create a transparent window that fills the page */
graphset;
/********************     PRINT FIG. 2     **************************/
fonts("complex simgrma");  /* load fonts: \201, \202 */
xlabel("s]1[");
ylabel("s]2[");
_paxes=1;
_ptitlht=0;
xtics(-0.5,1.0,0.5,1); 
ytics(-1,0.5,0.5,1); 
	_pcross=1;      /* axes intersect at zero */
title("Fig. 2:  Revenue-Constrained Optimal Subsidy Locus in R&D-Bertrand Game");     /* Home Profits (Contour) */
_pmsgctl= { 0.15 -0.30  .15  0  1  2  0 };  /* format control for label A */  _pmsgstr = "A" ;  /* text of label A */
/* _pmsgctl= { 0.17 -0.28  .15  0  1  2  0 };  /* format control for label A */  _pmsgstr = "A" ;  /* text of label A */ */
ztics (0, .4, 0.1,0) ;  	        contour(s1,s2,Ppi); 
ztics (.6, 1.2, 0.2,0) ;  	contour(s1,s2,Ppi); 
ztics (1.5, 3.5, 0.5,0) ;  	contour(s1,s2,Ppi); 
ztics (.95,1.1,.05,0);               contour(s1,s2,W); 
ztics (0,0.9,.1,0);               contour(s1,s2,W); 
	xy(s1',s2PCW'); 
xy ( s1', - alph * Delt - eta*s1' - 1.5 * Delt * s1');  /* Exact s2(s1) boundary corresponding to x=0 (R&D)*/
/* N.B.  Exact s2(s1) boundary corresponding to q=0 is only binding for s1>0, s2<<-1 */
GOTO PRINTEND;
 _plev={-.2,0,.2,.4,.6,.7,.8,.9,1.0,1.1,1.2,1.25}; 
	contour(s1,s2,W); 
GOTO PRINTEND;
/*************************************************************************/
PRINTEND:
ENDWIND;
finish:
end