#include "externals.h"
#include "types.h"


*###[ ffx2ir:
	subroutine ffx2ir(cs1,cs2,xpip,dpipjp,ier)
***#[*comment:***********************************************************
*									*
*	Get the terms to correct for the second IR pole which is	*
*	treated incorrectly if the first one is regulated with a small	*
*	mass lam and they are adjacent.  It is assumed that xpi(3)=	*
*	xpi(4)=xpi(7)=0, xpi(1)=xpi(8), xpi(2)=xpi(6).  The correction	*
*	terms are							*
*									*
*	cs1 = -C0(m2^2,0,lam^2;m2^2,0,p10^2)/(s-m1^2)			*
*	cs2 = +C0(m2^2,lam^2,0;m2^2,0,p10^2)/(s-m1^2)			*
*									*
*	when xpi(4) = lambda is taken in the D0,			*
*									*
*	cs1 = -C0(lam^2,0,m1^2;0,m1^2,p9^2)/(t-m2^2)			*
*	cs2 = +C0(0,lam^2,m1^2;0,m1^2,p9^2)/(t-m2^2)			*
*									*
*	when xpi(3) = lambda.  Not yet tested.				*
*									*
*				10-oct-1991 Geert Jan van Oldenborgh	*
*									*
*	Input:	xpip(13)	(real)	usual 4point pi.pi		*
*		dpipjp(10,13)	(real)	xpip(i) - xpip(j)		*
*	output:	xpip(13)	(real)	usual 4point pi.pi modified	*
*		dpipjp(10,13)	(real)	xpip(i) - xpip(j)  modified	*
*		cs1,cs2		(complex)				*
*		ier		(integer)				*
*	calls:	ffxc0							*
*									*
***#]*comment:*********************************************************** 
*  #[ declarations:
	implicit none
*
*	arguments
*
	integer ier
	ComplexType cs1,cs2
	RealType xpip(13),dpipjp(10,13)
*
*	local vars
*
	integer itest,ier0,ier1,i,j,iinx(6,4)
	ComplexType cc0
	RealType xpi3(6),dpipj3(6,6)
	save itest,iinx
*
*	common
*
#include "ff.h"
*
*	data
*
*	3=put mass on xpi(3)
*	4=put mass on xpi(4)
	data itest /4/
	data iinx /2,3,4,6,7,10,
     +		   1,3,4,9,7,8,
     +		   1,2,4,5,10,8,
     +		   1,2,3,5,6,9/
*
*  #] declarations: 
*  #[ work 3:
	if ( itest .eq. 3 ) then
*
*	modify xpip,dpipjp
*
	xpip(3) = lambda
	do 10 i=1,10
	    dpipjp(i,3) = dpipjp(i,3) - lambda
   10	continue
	do 20 i=1,13
	    dpipjp(3,i) = dpipjp(3,i) + lambda
   20	continue
*
*	call first C0
*
	do 120 i=1,6
	    xpi3(i) = xpip(iinx(i,2))
	    do 110 j=1,6
		dpipj3(j,i) = dpipjp(iinx(j,2),iinx(i,2))
  110	    continue
  120	continue
	idsub = idsub + 1
	ier1 = 0
	call ffxc0a(cc0,xpi3,dpipj3,ier1)
	cs1 = -cc0/Re(dpipjp(9,2))
*
*	call second C0
*
	xpi3(2) = 0
	xpi3(3) = lambda
	do 130 i=1,6
	    dpipj3(i,2) = dpipj3(i,2) + lambda
	    dpipj3(i,3) = dpipj3(i,3) - lambda
  130	continue
	do 140 i=1,6
	    dpipj3(2,i) = dpipj3(2,i) - lambda
	    dpipj3(3,i) = dpipj3(3,i) + lambda
  140	continue
	idsub = idsub + 1
	ier0 = 0
	call ffxc0a(cc0,xpi3,dpipj3,ier0)
	cs2 = +cc0/Re(dpipjp(9,2))
	ier1 = max(ier1,ier0)
	ier = ier + ier1
*  #] work 3: 
*  #[ work 4:
	elseif ( itest .eq. 4 ) then
*
*	modify xpip,dpipjp
*
	xpip(4) = lambda
	do 210 i=1,10
	    dpipjp(i,4) = dpipjp(i,4) - lambda
  210	continue
	do 220 i=1,13
	    dpipjp(4,i) = dpipjp(4,i) + lambda
  220	continue
*
*	call first C0
*
	do 320 i=1,6
	    xpi3(i) = xpip(iinx(i,1))
	    do 310 j=1,6
		dpipj3(j,i) = dpipjp(iinx(j,1),iinx(i,1))
  310	    continue
  320	continue
	idsub = idsub + 1
	ier1 = 0
	call ffxc0a(cc0,xpi3,dpipj3,ier1)
	cs1 = -cc0/Re(dpipjp(10,1))
*
*	call second C0
*
	xpi3(3) = 0
	xpi3(2) = lambda
	do 330 i=1,6
	    dpipj3(i,3) = dpipj3(i,3) + lambda
	    dpipj3(i,2) = dpipj3(i,2) - lambda
  330	continue
	do 340 i=1,6
	    dpipj3(3,i) = dpipj3(3,i) - lambda
	    dpipj3(2,i) = dpipj3(2,i) + lambda
  340	continue
	idsub = idsub + 1
	ier0 = 0
	call ffxc0a(cc0,xpi3,dpipj3,ier0)
	cs2 = +cc0/Re(dpipjp(10,1))
	ier1 = max(ier1,ier0)
	ier = ier + ier1
*  #] work 4: 
*  #[ error:
	else
	print *,'ffx2ir: error: itest should be either 3 or 4!',itest
	endif
*  #] error: 
*###] ffx2ir: 
	end
