#include "externals.h"


*###[ ffcdb0:
	subroutine ffcdb0(cdb0,cdb0p,cp,cma,cmb,ier)
***#[*comment:***********************************************************
*									*
*	Calculates the derivative of the two-point function with	*
*	respect to p2, plus the same times p2.				*
*									*
*	Input:	cp	(complex) k2, in B&D metric			*
*		cma	(complex) mass2					*
*		cmb	(complex) mass2					*
*									*
*	Output:	cdb0	(complex) dB0/dxp				*
*		cdb0p	(complex) cp*dB0/dxp				*
*		ier	(integer) # of digits lost, if >=100: error	*
*									*
***#]*comment:*********************************************************** 
*  #[ declarations:
	implicit none
*
*	arguments
*
	integer ier
	DOUBLE COMPLEX cdb0,cdb0p
	DOUBLE COMPLEX cp,cma,cmb
*
*	local variables
*
	integer ier0
	DOUBLE COMPLEX cmamb,cmap,cmbp
	DOUBLE PRECISION xp,xma,xmb
*
*	common
*
#include "ff.h"
*
*  #] declarations: 
*  #[ check input:
	if ( DIMAG(cma).eq.0 .and. DIMAG(cmb).eq.0 ) then
	    xma = DBLE(cma)
	    xmb = DBLE(cmb)
	    xp = DBLE(cp)
	    call ffxdb0(cdb0,cdb0p,xp,xma,xmb,ier)
	    return
	endif
*  #] check input: 
*  #[ get differences:
	ier0 = 0
	cmamb = cma - cmb
	cmap = cma - cp
	cmbp = cmb - cp
*  #] get differences: 
*  #[ calculations:
	call ffcdbp(cdb0,cdb0p,cp,cma,cmb,cmap,cmbp,cmamb,ier)
*  #] calculations: 
*###] ffcdb0: 
	end
*###[ ffcdbp:
	subroutine ffcdbp(cdb0,cdb0p,cp,cma,cmb,cmap,cmbp,cmamb,ier)
***#[*comment:***********************************************************
*									*
*	calculates the derivatives of the two-point function		*
*									*
*	Input:	cp	(complex) p.p, in B&D metric			*
*		cma	(complex) mass2,				*
*		cmb	(complex) mass2,				*
*		dm[ab]p	(complex) cm[ab] - cp				*
*		cmamb	(complex) cma - cmb				*
*									*
*	Output:	cdb0	(complex) B0' = dB0/dxp				*
*		cdb0p	(complex) cp*B0'				*
*		ier	(integer) 0=ok,>0=numerical problems,>100=error	*
*									*
***#]*comment:*********************************************************** 
*  #[ declarations:
	implicit none
*
*	arguments
*
	integer ier
	DOUBLE COMPLEX cdb0,cdb0p
	DOUBLE COMPLEX cp,cma,cmb,cmap,cmbp,cmamb
*
*	local variables
*
	integer i,initeq,jsign,init,ithres,initir,n1,n2,nffet1
	logical lreal
	DOUBLE PRECISION ax,ffbnd,ffbndc,
     +		xprceq,bdeq01,bdeq05,bdeq11,bdeq17,bdeq25,
     +		xprcn3,bdn301,bdn305,bdn310,bdn315,
     +		xprcn5,bdn501,bdn505,bdn510,bdn515,
     +		xprec0,bdn001,bdn005,bdn010,bdn015,bdn020,
     +		absc,xmax,prcsav
	DOUBLE COMPLEX cm,cdmp,cm1,cm2,cm1m2,cdm1p,
     +		cdm2p,s,s1,s1a,s1b,s1p,s2,s2a,s2b,s2p,s3,cx,som,
     +		clam,slam,xlogmm,alpha,alph1,xnoe,xpneq(30),
     +		zfflo1,zfflo3,d1,d2,diff,h,a,b,c,d,beta,
     +		betm2n,s1c,s1d,s1e,s1f,cqi(3),cqiqj(3,3),zm,zp
	DOUBLE COMPLEX cc
	DOUBLE PRECISION xp,xma,xmb,dmamb,dmap,dmbp,sprec
	save initeq,xpneq,init,initir,
     +		xprceq,bdeq01,bdeq05,bdeq11,bdeq17,bdeq25,
     +		xprcn3,bdn301,bdn305,bdn310,bdn315,
     +		xprcn5,bdn501,bdn505,bdn510,bdn515,
     +		xprec0,bdn001,bdn005,bdn010,bdn015,bdn020
*for ABSOFT only
*	DOUBLE COMPLEX csqrt
*	external csqrt
*
*	common blocks
*
#include "ff.h"
*
*	data
*
	data xprceq /-1./
	data xprec0 /-1./
	data xprcn3 /-1./
	data xprcn5 /-1./
	data initeq /0/
*
*	statement function
*
	absc(cc) = abs(DBLE(cc)) + abs(DIMAG(cc))
*  #] declarations: 
*  #[ the real cases:
*
	if ( DIMAG(cma) .eq. 0 .and. DIMAG(cmb) .eq. 0 ) then
	    lreal = .TRUE.
	elseif ( nschem.le.2 ) then
	    lreal = .TRUE.
	    if ( init.eq.0 ) then
		init = 1
		print *,'ffcb0: nschem <= 2, ignoring complex masses: ',
     +			nschem
	    endif
	elseif ( nschem.le.4 ) then
	    if ( init.eq.0 ) then
		init = 1
		print *,'ffcdbp: nschem = 3,4 complex masses near ',
     +			'singularity: ',nschem
	    endif
	    if ( abs(DBLE(cma)) .lt. -xloss*DIMAG(cmb)
     +		.and. abs(DBLE(cmbp)) .le. -nwidth*DIMAG(cmb)
     +	    .or. abs(DBLE(cmb)) .lt. -xloss*DIMAG(cma)
     +		.and. abs(DBLE(cmap)) .le. -nwidth*DIMAG(cma) ) then
		lreal = .FALSE.
	    else
		lreal = .TRUE.
	    endif
	elseif ( nschem.le.6 ) then
	    if ( init.eq.0 ) then
		init = 1
		print *,'ffcdbp: nschem = 5,6 complex masses near ',
     +			'threshold: ',nschem
	    endif
	    cqi(1) = cma
	    cqi(2) = cmb
	    cqi(3) = cp
	    cqiqj(1,2) = cmamb
	    cqiqj(2,1) = -cqiqj(1,2)
	    cqiqj(1,3) = cmap
	    cqiqj(3,1) = -cqiqj(1,3)
	    cqiqj(2,3) = cmbp
	    cqiqj(3,2) = -cqiqj(2,3)
	    cqiqj(1,1) = 0
	    cqiqj(2,2) = 0
	    cqiqj(3,3) = 0
	    call ffthre(ithres,cqi,cqiqj,3,1,2,3)
	    if ( ithres.eq.0 .or. ithres.eq.1 .and. nschem.eq.5 ) then
		lreal = .TRUE.
	    else
		lreal = .FALSE.
	    endif
	else
	    lreal = .FALSE.
	endif
	if ( lreal ) then
	    xp = DBLE(cp)
	    xma = DBLE(cma)
	    xmb = DBLE(cmb)
	    dmap = DBLE(cmap)
	    dmbp = DBLE(cmbp)
	    dmamb = DBLE(cmamb)
	    sprec = precx
	    precx = precc
	    call ffxdbp(cdb0,cdb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier)
	    precx = sprec
	    return
	endif
*
*  #] the real cases: 
*  #[ which case:
*
*	sort according to the type of masscombination encountered:
*	100: both masses zero, 200: one equal to zero, 300: both equal
*	400: rest.
*
	if ( cma .eq. 0 ) then
		if ( cmb .eq. 0 ) then
			goto 100
		endif
		cm = cmb
		cdmp = cmbp
		goto 200
	endif
	if ( cmb .eq. 0 ) then
		cm = cma
		cdmp = cmap
		goto 200
	elseif ( cmamb .eq. 0 ) then
		cm = cma
		cdmp = cmap
		goto 300
	elseif ( DBLE(cma) .gt. DBLE(cmb) ) then
		cm2 = cma
		cm1 = cmb
		cm1m2 = -cmamb
		cdm1p = cmbp
		cdm2p = cmap
	else
		cm1 = cma
		cm2 = cmb
		cm1m2 = cmamb
		cdm1p = cmap
		cdm2p = cmbp
	endif
	goto 400
*  #] which case: 
*  #[ both masses equal to zero:
  100	continue
	if ( cp.ne.0 ) cdb0 = -1/cp
	cdb0p = -1
	return
*  #] both masses equal to zero: 
*  #[ one mass equal to zero:
  200	continue
*
*	special case cp = 0
*
	if ( cp .eq. 0 ) then
	    cdb0p = 0
	    cdb0 = 1/(2*cm)
	    goto 990
*
*	special case cp = cm
*
	elseif ( cdmp.eq.0 ) then
	    if ( initir.eq.0 ) then
		initir = 1
		print *,'ffcdbd: IR divergent B0'', using cutoff ',
     &            lambda
	    endif
	    if ( lambda .le. 0 ) then
		cdb0p = -1 + log(cm/mudim)/2
	    else
		cdb0p = -1 + log(cm/lambda)/2
	    endif
	    cdb0 = cdb0p/cp
	    goto 990
	endif
*
*	Normal case:
*
	cx = cp/cm
	ax = absc(cx)
	if ( ax .lt. xloss ) then
* 	#[ Taylor expansion:
	    if ( xprec0 .ne. precx ) then
		xprec0 = precc
		prcsav = precx
		precx = precc
		bdn001 = ffbnd(2,1,xninv)
		bdn005 = ffbnd(2,5,xninv)
		bdn010 = ffbnd(2,10,xninv)
		bdn015 = ffbnd(2,15,xninv)
		bdn020 = ffbnd(2,20,xninv)
		precx = prcsav
	    endif
	    if ( ax .gt. bdn015 ) then
		som = cx*(DBLE(xninv(17)) + cx*(DBLE(xninv(18))
     +		    + cx*(DBLE(xninv(19)) + cx*(DBLE(xninv(20))
     +		    + cx*(DBLE(xninv(21)) )))))
	    else
		som = 0
	    endif
	    if ( ax .gt. bdn010 ) then
		som = cx*(DBLE(xninv(12)) + cx*(DBLE(xninv(13))
     +		    + cx*(DBLE(xninv(14)) + cx*(DBLE(xninv(15))
     +		    + cx*(DBLE(xninv(16)) + som )))))
	    endif
	    if ( ax .gt. bdn005 ) then
		som = cx*(DBLE(xninv(7)) + cx*(DBLE(xninv(8))
     +		    + cx*(DBLE(xninv(9)) + cx*(DBLE(xninv(10))
     +		    + cx*(DBLE(xninv(11)) + som )))))
	    endif
	    if ( ax .gt. bdn001 ) then
		som = cx*(DBLE(xninv(3)) + cx*(DBLE(xninv(4))
     +		    + cx*(DBLE(xninv(5)) + cx*(DBLE(xninv(6)) + som ))))
	    endif
	    cdb0p = cx*(DBLE(xninv(2)) + som)
* 	#] Taylor expansion: 
	else
* 	#[ short formula:
	    s = log(cdmp/cm)
	    cdb0p = -(1 + s*cm/cp)
* 	#] short formula: 
	endif
	cdb0 = cdb0p/cp
	goto 990
*  #] one mass equal to zero: 
*  #[ both masses equal:
  300	continue
*
*	Both masses are equal.	Not only this speeds up things, some
*	cancellations have to be avoided as well.
*
*	first a special case
*
	if ( absc(cp) .lt. 8*xloss*absc(cm) ) then
* -#[	    taylor expansion:
*
*	    a Taylor expansion seems appropriate as the result will go
*	    as k^2 but seems to go as 1/k !!
*
*--#[	    data and bounds:
	    if ( initeq .eq. 0 ) then
		initeq = 1
		xpneq(1) = 1/6D0
		do 1 i=2,30
		    xpneq(i) = - xpneq(i-1)*DBLE(i)/DBLE(2*(2*i+1))
    1		continue
	    endif
	    if (xprceq .ne. precx ) then
*
*		calculate the boundaries for the number of terms to be
*		included in the taylorexpansion
*
		xprceq = precx
		bdeq01 = ffbndc(1,1,xpneq)
		bdeq05 = ffbndc(1,5,xpneq)
		bdeq11 = ffbndc(1,11,xpneq)
		bdeq17 = ffbndc(1,17,xpneq)
		bdeq25 = ffbndc(1,25,xpneq)
	    endif
*--#]	    data and bounds: 
	    cx = -cp/cm
	    ax = absc(cx)
	    if ( ax .gt. bdeq17 ) then
		som = cx*(xpneq(18) + cx*(xpneq(19) + cx*(xpneq(20) +
     +		cx*(xpneq(21) + cx*(xpneq(22) + cx*(xpneq(23) +
     +		cx*(xpneq(24) + cx*(xpneq(25) ))))))))
	    else
		som = 0
	    endif
	    if ( ax .gt. bdeq11 ) then
		som = cx*(xpneq(12) + cx*(xpneq(13) + cx*(xpneq(14) +
     +		cx*(xpneq(15) + cx*(xpneq(16) + cx*(xpneq(17) + som ))))
     +		))
	    endif
	    if ( ax .gt. bdeq05 ) then
		som = cx*(xpneq(6) + cx*(xpneq(7) + cx*(xpneq(8) + cx*(
     +		xpneq(9) + cx*(xpneq(10) + cx*(xpneq(11) + som ))))))
	    endif
	    if ( ax .gt. bdeq01 ) then
		som = cx*(xpneq(2) + cx*(xpneq(3) + cx*(xpneq(4) + cx*(
     +		xpneq(5) + som ))))
	    endif
	    cdb0p = -cx*(xpneq(1)+som)
	    if ( cp.ne.0 ) then
		cdb0 = cdb0p*(1/DBLE(cp))
	    else
		cdb0 = xpneq(1)/cm
	    endif
	    goto 990
* -#]	    taylor expansion: 
	endif
* -#[	normal case:
*
*	normal case
*
	call ffclmb(clam,-cp,-cm,-cm,cdmp,cdmp,czero)
	slam = sqrt(clam)
	call ffcoot(zm,zp,cone,chalf,cm/cp,slam/(2*cp),ier)
	s1 = zp/zm
	if( abs(s1-1) .lt. xloss ) then
*	    In this case a quicker and more accurate way is to
*	    calculate log(1-cx).
	    print *,'Not tested, probably wrong'
	    ier = ier + 50
	    s2 = (cp - slam)
	    if ( absc(s2) .lt. xloss*absc(cp) ) then
		s2 = -slam*(cp+slam)/(4*cp*cm)
	    else
		s2 = -2*slam/s2
	    endif
	    s = -2*cm/slam*zfflo1(s2/(2*cm),ier)
	else
*	    finally the normal case
	    s = -2*cm/slam*log(s1)
	endif
*
*	eta terms
*
	n1 = nffet1(zp,1/zm,s1,ier)
	n2 = nffet1(-zp,-1/zm,s1,ier)
	if ( n1+n2 .ne. 0 ) then
	    s1 = cm/slam*c2ipi*(n1+n2)
	    s = s + s1
	endif
	cdb0p = s - 1
	cdb0 = cdb0p/cp
	goto 990
* -#]	normal case: 
*
*  #] both masses equal: 
*  #[ unequal nonzero masses:
  400	continue
* -#[	get log(cm2/cm1):
	cx = cm2/cm1
	c = cx-1
	if ( 1 .lt. xclogm*absc(cx) ) then
	    call fferr(8,ier)
	    xlogmm = 0
	elseif ( absc(c) .lt. xloss ) then
	    xlogmm = zfflo1(cm1m2/cm1,ier)
	else
	    xlogmm = log(cx)
	endif
* -#]	get log(cm2/cm1): 
* -#[	cp = 0:
*
*	first a special case
*
	if ( cp .eq. 0 ) then
*
*	    repaired 19-nov-1993, see b2.frm
*
	    s1 = cm1*cm2*xlogmm/cm1m2**3
	    s2 = (cm1+cm2)/(2*cm1m2**2)
	    s = s1 + s2
	    if ( absc(s) .lt. xloss**2*absc(s2) ) then
*
*		second try
*
		h = zfflo3(cm1m2/cm1,ier)
		s1 = -cm1*h/cm1m2**2
		s2 = 1/(2*cm1)
		s3 = cm1**2*h/cm1m2**3
		s = s1 + s2 + s3
		if ( absc(s) .lt. xloss*max(absc(s2),absc(s3)) ) then
		    call ffwarn(234,ier,absc(s),absc(s2))
		endif
	    endif
	    cdb0 = s
	    cdb0p = 0
	    goto 990
	endif
* -#]	cp = 0: 
* -#[	normal case:
*
*	proceeding with the normal case
*
	call ffclmb(clam,-cp,-cm2,-cm1,cdm2p,cdm1p,cm1m2)
	diff = clam + cp*(cdm2p+cm1)
	if ( absc(diff) .lt. xloss*absc(clam) ) then
	    h = cm1m2**2 - cp*(cm1+cm2)
	    if ( absc(h) .lt. xloss*absc(cm1m2)**2 ) then
		if ( absc(cm1m2)**2 .lt. absc(clam) ) diff = h
		call ffwarn(235,ier,absc(diff),min(absc(cm1m2)**2,
     +			absc(clam)))
	    endif
	endif
*--#[	first try:
*	first try the normal way
	slam = sqrt(clam)
	if ( abs(DBLE(cm1)) .lt. abs(DBLE(cm2)) ) then
	    s2a = cm1 + cdm2p
	else
	    s2a = cm2 + cdm1p
	endif
	s2 = s2a + slam
	if ( absc(s2) .gt. xloss*absc(slam) ) then
*	    looks fine
	    jsign = 1
	else
	    s2 = s2a - slam
	    jsign = -1
	endif
	s2 = s2/sqrt(4*cm1*cm2)
	if ( absc(s2) .lt. xclogm ) then
	    call fferr(9,ier)
	    s2 = 0
	elseif ( absc(s2-1) .lt. xloss ) then
	    ier = ier + 50
	    print *,'ffcdb0: untested: s2 better in first try'
	    if ( jsign.eq.1 ) then
		s2 = -slam*(s2a+slam)/(2*cm1*cm2)
		s2 = -diff/(2*slam*cp)*zfflo1(s2,ier)
	    else
		s2 = +slam*(s2a-slam)/(2*cm1*cm2)
		s2 = +diff/(2*slam*cp)*zfflo1(s2,ier)
	    endif
	else
	    s2 = -diff/(2*slam*cp)*2*log(s2)
	    if ( jsign .eq. -1 ) s2 = -s2
	endif
	s1 = -cm1m2*xlogmm/(2*cp)
	cdb0p = s1+s2-1
*--#]	first try: 
	if ( absc(cdb0p) .lt. xloss**2*max(absc(s1),absc(s2)) ) then
*--#[		second try:
*		this is unacceptable, try a better solution
		s1a = diff + slam*cm1m2
		if ( absc(s1a) .gt. xloss*absc(diff) ) then
*		    this works
		    s1 = -s1a/(2*cp*slam)
		else
*		    by division a more accurate form can be found
		    s1 = -2*cm1*cm2*cp/(slam*(diff - slam*cm1m2))
		endif
		s = s1
		s1 = s1*xlogmm
		if ( abs(DBLE(cp)).lt.abs(DBLE(cm2)) ) then
		    s2a = cp - cm1m2
		else
		    s2a = cm2 - cdm1p
		endif
		s2 = s2a - slam
		if ( absc(s2) .gt. xloss*absc(slam) ) then
*		    at least reasonable
		    s2 = s2 / (2*cm2)
		else
*		    division again
		    s2 = (2*cp) / (s2a+slam)
		endif
		if ( absc(s2) .lt. .1 ) then
*		    choose a quick way to get the logarithm
		    s2 = zfflo1(s2,ier)
		else
		    s2 = log(1-s2)
		endif
		s2 = -diff/(slam*cp)*s2
		cdb0p = s1 + s2 - 1
*--#]		second try: 
		if ( absc(cdb0p) .lt. xloss**2*max(absc(s1),absc(s2)) )
     +			then
*--#[		    third try:
*		    (we accept two times xloss because that's the same
*		    as in this try)
*		    A Taylor expansion might work.  We expand
*		    inside the logs. Only do the necessary work.
*
*		#[ split up 1:
		    xnoe = s2a+slam
		    a = 1
		    b = 2/xnoe-1/cp
		    c = -4/(cp*xnoe)
		    d = sqrt(cp**(-2) + (2/xnoe)**2)
		    call ffcoot(d1,d2,a,b,c,d,ier)
		    if ( DBLE(cp).gt.0 ) then
			beta = d2
		    else
			beta = d1
		    endif
		    alpha = beta*diff/slam
		    alph1 = 1-alpha
		    if ( absc(alph1) .lt. xloss ) then
			s1a = 4*cp**2*cm1*cm2/(slam*cm1m2*(diff-slam*
     +				cm1m2))
			s1b = -diff/slam*4*cm1*cp/(cm1m2*xnoe*(2*cp-
     +				xnoe))
			b = -1/cp
			c = -(2/xnoe)**2
			call ffcoot(d1,d2,a,b,c,d,ier)
			if ( DBLE(cp).gt.0 ) then
			    betm2n = d2
			else
			    betm2n = d1
			endif
			d1 = s1a + s1b - diff/slam*betm2n
			xmax = max(absc(s1a),absc(s1b))
			if ( xmax .lt. 1 ) then
			    alph1 = d1
			else
			    xmax = 1
			endif
			if ( absc(alph1) .lt. xloss*xmax )
     +				call ffwarn(236,ier,absc(alph1),xmax)
		    else
			betm2n = beta - 2/xnoe
		    endif
*		#] split up 1: 
*		#[ s2:
*
*		    first s2:
*
		    s2p = s2 - alpha
		    if ( absc(s2p) .lt. xloss*absc(s2) ) then
* -#[			bounds:
*			determine the boundaries for 1,5,10,15 terms
			if ( xprcn5 .ne. precx ) then
			    xprcn5 = precc
			    prcsav = precx
			    precx = precc
			    bdn501 = ffbnd(3,1,xinfac)
			    bdn505 = ffbnd(3,5,xinfac)
			    bdn510 = ffbnd(3,10,xinfac)
			    bdn515 = ffbnd(3,15,xinfac)
			    precx = prcsav
			endif
* -#]			bounds: 
			cx = beta*cp
			ax = absc(cx)
			if ( ax .gt. bdn510 ) then
			   s2a = cx*(DBLE(xinfac(13)) + cx*(DBLE(xinfac(
     +			   14))+ cx*(DBLE(xinfac(15)) + cx*(DBLE(xinfac(
     +			   16))+ cx*(DBLE(xinfac(17)))))))
			else
			    s2a = 0
			endif
			if ( ax .gt. bdn505 ) then
			   s2a = cx*(DBLE(xinfac( 8)) + cx*(DBLE(xinfac(
     +			    9))+ cx*(DBLE(xinfac(10)) + cx*(DBLE(xinfac(
     +			   11))+ cx*(DBLE(xinfac(12)) + s2a)))))
			endif
			if ( ax .gt. bdn501 ) then
			    s2a =cx*(DBLE(xinfac(4))+cx*(DBLE(xinfac(5))
     +				+cx*(DBLE(xinfac(6))+cx*(DBLE(xinfac(7))
     +				+ s2a))))
			endif
			s2a = cx**3*(DBLE(xinfac(3))+s2a)
			s2b = 2*cp/xnoe*(s2a + cx**2/2)
			s2p = s2b - s2a
			s2p = -diff/(cp*slam)*zfflo1(s2p,ier)
		    endif
*		#] s2: 
*		#[ s1:
*
*		    next s1:
*
		    s1p = s1 - alph1
		    if ( absc(s1p) .lt. xloss*absc(s1) ) then
* -#[			bounds:
*			determine the boundaries for 1,5,10,15 terms
			if ( xprcn3 .ne. precx ) then
			    xprcn3 = precc
			    prcsav = precx
			    precx = precc
			    bdn301 = ffbnd(3,1,xinfac)
			    bdn305 = ffbnd(3,5,xinfac)
			    bdn310 = ffbnd(3,10,xinfac)
			    bdn315 = ffbnd(3,15,xinfac)
			    precx = prcsav
			endif
* -#]			bounds: 
*
			cx = slam*(diff-slam*cm1m2)*alph1/(2*cp*cm1*cm2)
			ax = absc(cx)
			h = (2*cp*(cm1+cm2) - cp**2)/(slam-cm1m2)
*
*			see form job gets1.frm
*
			s1b = diff*(diff-slam*cm1m2)*betm2n/(2*cp*cm1*
     +				cm2)
			s1c = 1/(cm1*xnoe*(2*cp-xnoe))*(
     +				cp*( 4*cp*cm2 + 2*cm1m2**2/cm2*(cp-h) +
     +				2*cm1m2*(3*cp-h) - 8*cm1m2**2 )
     +				- 2*cm1m2**3/cm2*(3*cp-h)
     +				+ 4*cm1m2**4/cm2
     +				)
			s1d = cx*cm1m2/cm1
			s1e = -cx**2/2
			if ( ax .gt. bdn310 ) then
			   s1a = cx*(DBLE(xinfac(13)) + cx*(DBLE(xinfac(
     +			   14))+ cx*(DBLE(xinfac(15)) + cx*(DBLE(xinfac(
     +			   16))+ cx*(DBLE(xinfac(17)))))))
			else
			    s1a = 0
			endif
			if ( ax .gt. bdn305 ) then
			   s1a = cx*(DBLE(xinfac( 8)) + cx*(DBLE(xinfac(
     +			    9))+ cx*(DBLE(xinfac(10)) + cx*(DBLE(xinfac(
     +			   11))+ cx*(DBLE(xinfac(12)) + s1a)))))
			endif
			if ( ax .gt. bdn301 ) then
			    s1a =cx*(DBLE(xinfac(4))+cx*(DBLE(xinfac(5))
     +				+cx*(DBLE(xinfac(6))+cx*(DBLE(xinfac(7))
     +				+s1a))))
			endif
			s1a = -cx**3 *(DBLE(xinfac(3)) + s1a)
			s1f = cm1m2/cm1*(cx**2/2 - s1a)
			s1p = s1e + s1d + s1c + s1b + s1a + s1f
			xmax = max(absc(s1a),absc(s1b),absc(s1c),
     +				absc(s1d),absc(s1e))
			s1p = s*zfflo1(s1p,ier)
		    endif
*		#] s1: 
*
*		    finally ...
*
		    cdb0p = s1p + s2p
*--#]		    third try: 
		endif
	endif
	cdb0 = cdb0p*(1/DBLE(cp))
* -#]	normal case: 
*  #] unequal nonzero masses: 
  990	continue
*###] ffcdbp: 
	end
