#include "externals.h"


*###[ ffdel3:
	subroutine ffdel3(del3,piDpj)
***#[*comment:***********************************************************
*									*
*	Calculate del3(piDpj) = det(si.sj)	with			*
*	the momenta as follows:						*
*	p(1-3) = s(i)							*
*	p(4-6) = p(i)							*
*									*
*	Input:	xpi(ns)		(real)	m^2(i),i=1,3; p^2(i-3),i=4,10	*
*		piDpj(ns,ns)	(real)					*
*		ns		(integer)				*
*		ier		(integer)				*
*									*
*	Output:	del3		(real)	det(si.sj)			*
*									*
***#]*comment:***********************************************************
*  #[ declarations:
	implicit none
*
*	arguments:
*
	DOUBLE PRECISION del3,piDpj(6,6)
*
*	local variables:
*
	integer mem,nperm
	parameter(mem=10,nperm=16)
	integer i,jj(6),iperm(3,nperm),imem,memarr(mem,3),memind,inow
	DOUBLE PRECISION s(6),xmax,del3p,xmaxp
	save iperm,memind,memarr,inow
*
*	common blocks:
*
#include "ff.h"
*  #] declarations:
*  #[ data:
	data memind /0/
	data memarr /mem*0,mem*0,mem*1/
	data inow /1/
*
*	these are all permutations that give a non-zero result with the
*	correct sign.  This list was generated with getperm3.
*
	data iperm/
     +		1,2,3,  1,2,5,  1,6,2,  1,4,3,
     +		1,3,5,  1,4,5,  1,6,4,  1,5,6,
     +		2,4,3,  2,3,6,  2,4,5,  2,6,4,
     +		2,5,6,  3,4,5,  3,6,4,  3,5,6/
*  #] data:
*  #[ starting point in memory?:
*
*	see if we know were to start, if not: go on as last time
*
	do 5 i=1,mem
	    if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then
		inow = memarr(i,3)
		goto 6
	    endif
    5	continue
    6	continue
*  #] starting point in memory?:
*  #[ calculations:
	imem = inow
	del3 = 0
	xmax = 0

   10	continue

	jj(1) = iperm(1,inow)
	jj(3) = iperm(2,inow)
	jj(5) = iperm(3,inow)

	jj(2) = iperm(1,inow)
	jj(4) = iperm(2,inow)
	jj(6) = iperm(3,inow)

	s(1) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(6))
	s(2) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(2))
	s(3) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(4))
	s(4) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(4))
	s(5) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(2))
	s(6) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(6))

	del3p = 0
	xmaxp = 0
	do 20 i=1,6
	    del3p = del3p + s(i)
	    xmaxp = max(xmaxp,abs(s(i)))
   20	continue
	if ( abs(del3p) .lt. xloss*xmaxp ) then
	    if ( inow .eq. imem .or. xmaxp .lt. xmax ) then
		del3 = del3p
		xmax = xmaxp
	    endif
	    inow = inow + 1
	    if ( inow .gt. nperm ) inow = 1
	    if ( inow .eq. imem ) goto 800
	    goto 10
	endif
	del3 = del3p
	xmax = xmaxp
*  #] calculations:
*  #[ into memory:
  800	continue
	memind = memind + 1
	if ( memind .gt. mem ) memind = 1
	memarr(memind,1) = id
	memarr(memind,2) = idsub
	memarr(memind,3) = inow
*  #] into memory:
*###] ffdel3:
	end


*(##[ ffdl3s:
	subroutine ffdl3s(dl3s,piDpj,ii,ns)
***#[*comment:***********************************************************
*									*
*	Calculate dl3s(piDpj) = det(si.sj)	with			*
*	the momenta indicated by the indices ii(1-6,1), ii(1-6,2)	*
*	as follows:							*
*	p(|ii(1,)|-|ii(3,)|) = s(i)					*
*	p(|ii(4,)|-|ii(6,)|) = p(i) = sgn(ii())*(s(i+1) - s(i))		*
*									*
*	At this moment (26-apr-1990) only the diagonal is tried		*
*									*
*	Input:	xpi(ns)		(real)	m^2(i),i=1,3; p^2(i-3),i=4,10	*
*		piDpj(ns,ns)	(real)					*
*		ii(6,2)		(integer)	see above		*
*		ns		(integer)				*
*		ier		(integer)				*
*									*
*	Output:	dl3s		(real)	det(si.sj)			*
*									*
***#]*comment:***********************************************************
*  #[ declarations:
	implicit none
*
*	arguments:
*
	integer ii(6,2),ns
	DOUBLE PRECISION dl3s,piDpj(ns,ns)
*
*	local variables:
*
	integer mem,nperm
	parameter(mem=10,nperm=16)
	integer i,jj(6),jsgn,iperm(3,nperm),imem,memarr(mem,3),
     +		memind,inow
	DOUBLE PRECISION s(6),xmax,dl3sp,xmaxp
	save iperm,memind,memarr,inow
*
*	common blocks:
*
#include "ff.h"
*  #] declarations:
*  #[ data:
	data memind /0/
	data memarr /mem*0,mem*0,mem*1/
	data inow /1/
*
*	these are all permutations that give a non-zero result with the
*	correct sign.  This list was generated with getperm3.
*
	data iperm/
     +		1,2,3,  1,2,5,  1,6,2,  1,4,3,
     +		1,3,5,  1,4,5,  1,6,4,  1,5,6,
     +		2,4,3,  2,3,6,  2,4,5,  2,6,4,
     +		2,5,6,  3,4,5,  3,6,4,  3,5,6/
*  #] data:
*  #[ starting point in memory?:
*
*	see if we know were to start, if not: go on as last time
*
	do 5 i=1,mem
	    if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then
		inow = memarr(i,3)
		goto 6
	    endif
    5	continue
    6	continue
*  #] starting point in memory?:
*  #[ calculations:
	imem = inow
	dl3s = 0
	xmax = 0

   10	continue

	jj(1) = abs(ii(iperm(1,inow),1))
	jj(3) = abs(ii(iperm(2,inow),1))
	jj(5) = abs(ii(iperm(3,inow),1))

	jj(2) = abs(ii(iperm(1,inow),2))
	jj(4) = abs(ii(iperm(2,inow),2))
	jj(6) = abs(ii(iperm(3,inow),2))

	jsgn =  sign(1,ii(iperm(1,inow),1))
     +		*sign(1,ii(iperm(2,inow),1))
     +		*sign(1,ii(iperm(3,inow),1))
     +		*sign(1,ii(iperm(1,inow),2))
     +		*sign(1,ii(iperm(2,inow),2))
     +		*sign(1,ii(iperm(3,inow),2))

	s(1) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(6))
	s(2) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(2))
	s(3) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(4))
	s(4) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(4))
	s(5) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(2))
	s(6) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(6))

	dl3sp = 0
	xmaxp = 0
	do 20 i=1,6
	    dl3sp = dl3sp + s(i)
	    xmaxp = max(xmaxp,abs(s(i)))
   20	continue
	if ( abs(dl3sp) .lt. xloss*xmaxp ) then
	    if ( inow .eq. imem .or. xmaxp .lt. xmax ) then
		dl3s = jsgn*dl3sp
		xmax = xmaxp
	    endif
	    inow = inow + 1
	    if ( inow .gt. nperm ) inow = 1
	    if ( inow .eq. imem ) goto 800
	    goto 10
	endif
	dl3s = jsgn*dl3sp
	xmax = xmaxp
*  #] calculations:
*  #[ into memory:
  800	continue
	memind = memind + 1
	if ( memind .gt. mem ) memind = 1
	memarr(memind,1) = id
	memarr(memind,2) = idsub
	memarr(memind,3) = inow
*  #] into memory:
*)##] ffdl3s:
	end
