You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1411 lines
51 KiB
1411 lines
51 KiB
subroutine pvDfill(p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,N)
|
|
implicit none
|
|
C N is the offset in the common block
|
|
C p1,p2,p3,p4 are the invariant masses sqaured of external lines
|
|
C m1,m2,m3,m4 are the masses squared of internal lines
|
|
include 'lib/TensorReduction/Include/types.f'
|
|
include 'lib/TensorReduction/Include/TRconstants.f'
|
|
include 'lib/TensorReduction/Include/TRscale.f'
|
|
include 'lib/TensorReduction/Include/pvCnames.f'
|
|
include 'lib/TensorReduction/Include/pvDnames.f'
|
|
include 'lib/TensorReduction/Include/pvCv.f'
|
|
include 'lib/TensorReduction/Include/pvDv.f'
|
|
include 'lib/TensorReduction/Include/pvverbose.f'
|
|
include 'lib/TensorReduction/Include/TRmaxindex.f'
|
|
include 'lib/TensorReduction/Include/pvRespectmaxcindex.f'
|
|
include 'lib/TensorReduction/Include/pvrecurflags.f'
|
|
include 'lib/TensorReduction/Include/pvforcerecalc.f'
|
|
integer:: C234,C134,C124,C123,ep,epmj,N,j,perm(3),pvCcache
|
|
integer,parameter::np=3
|
|
real(dp):: p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,f1,f2,f3
|
|
complex(dp) G(np,np),csum(-2:0),c1sum(-2:0),c2sum(-2:0),
|
|
. c0sum(-2:0),in(3,-2:0),trI4
|
|
complex(dp):: c11sum(-2:0),c00sum(-2:0),c12sum(-2:0),c22sum(-2:0)
|
|
logical:: exceptional
|
|
logical,save:: first=.true.
|
|
real(dp):: q1save(4),q2save(4),q3save(4)
|
|
real(dp):: triq1save(4),triq2save(4)
|
|
common/q123save/q1save,q2save,q3save
|
|
common/q12save/triq1save,triq2save
|
|
!$omp threadprivate(first,/q123save/,/q12save/)
|
|
real(dp),save:: idp2(0:2),idp1(0:2),id(0:2),idm1(0:2),
|
|
& idm2(0:2),idm3(0:2)
|
|
!$omp threadprivate(idp2,idp1,id,idm1,idm2,idm3)
|
|
integer,save:: icall,irecur,irecur2,irecur3,irecur4
|
|
!$omp threadprivate(icall,irecur,irecur2,irecur3,irecur4)
|
|
include 'lib/TensorReduction/Include/cplx.h'
|
|
|
|
if (first) then
|
|
first=.false.
|
|
C--idp2=1/[D+2]
|
|
idp2(0)=1._dp/six
|
|
idp2(1)=idp2(0)/3._dp
|
|
idp2(2)=idp2(1)/3._dp
|
|
C--idp1=1/[D+1]
|
|
idp1(0)=0.2_dp
|
|
idp1(1)=idp1(0)*0.4_dp
|
|
idp1(2)=idp1(1)*0.4_dp
|
|
C--id=1/D
|
|
id(0)=0.25_dp
|
|
id(1)=id(0)*half
|
|
id(2)=id(1)*half
|
|
C--idm1=1/[D-1]
|
|
idm1(0)=1._dp/3._dp
|
|
idm1(1)=idm1(0)*2._dp/3._dp
|
|
idm1(2)=idm1(1)*2._dp/3._dp
|
|
C--idm2=1/[D-2]
|
|
idm2(0)=half
|
|
idm2(1)=idm2(0)
|
|
idm2(2)=idm2(1)
|
|
C--idm3=1/[D-3]
|
|
idm3(0)=1._dp
|
|
idm3(1)=2._dp*idm3(0)
|
|
idm3(2)=4._dp*idm3(1)
|
|
c--- variables for statistics reporting
|
|
irecur=0
|
|
irecur2=0
|
|
irecur3=0
|
|
irecur4=0
|
|
icall=0
|
|
c--- print out flags for recursion
|
|
c write(6,*) 'pvDfill recursion flags:'
|
|
c write(6,*) ' doGsing ',doGsing
|
|
c write(6,*) ' doGYsing ',doGYsing
|
|
c write(6,*) ' doPsing ',doPsing
|
|
c write(6,*) ' doPFsing ',doPFsing
|
|
endif
|
|
|
|
c--- statistics accounting and reporting
|
|
icall=icall+1
|
|
if (pvverbose) then
|
|
if (mod(icall,50000) .eq. 0) then
|
|
write(6,77) icall,
|
|
& 1d2*dfloat(icall-irecur-irecur2-irecur3-irecur4)/dfloat(icall),
|
|
& 1d2*dfloat(irecur)/dfloat(icall),
|
|
& 1d2*dfloat(irecur2)/dfloat(icall),
|
|
& 1d2*dfloat(irecur3)/dfloat(icall),
|
|
& 1d2*dfloat(irecur4)/dfloat(icall)
|
|
endif
|
|
endif
|
|
77 format(' +++ Dfill ',i9,': ',5(f6.2,'% : '))
|
|
|
|
f1 = m2 - m1 - p1
|
|
f2 = m3 - m1 - p1p2
|
|
f3 = m4 - m1 - p4
|
|
|
|
!---double up the Gram matrix to remove factors of 1/2 in Eqs.
|
|
G(1,1) = cplx1(two*p1)
|
|
G(2,2) = cplx1(two*p1p2)
|
|
G(3,3) = cplx1(two*p4)
|
|
G(1,2) = cplx1(p1+p1p2 - p2)
|
|
G(2,1) = G(1,2)
|
|
G(1,3) = cplx1(p1+p4 - p2p3)
|
|
G(3,1) = G(1,3)
|
|
G(2,3) = cplx1(p1p2 - p3+p4)
|
|
G(3,2) = G(2,3)
|
|
|
|
c--- Check for small kinematic quantities requiring alternate recursion
|
|
c if (pvverbose) write(6,*) 'Check box Gsing'
|
|
c Gsing=pvGramsing(G,3)
|
|
|
|
C Y(i,j)=mi^2+mj^2-(q_i-q_j)^2
|
|
C where q_1=0, q_2=p1, q_3=p_1+p_2, q_4=p_1+p_2+p_3;
|
|
|
|
c Y(1,1) = cplx1(two*m1)
|
|
c Y(1,2) = cplx1(m1 + m2 - p1)
|
|
c Y(2,1) = Y(1,2)
|
|
c Y(1,3) = cplx1(m1 + m3 - p1p2)
|
|
c Y(3,1) = Y(1,3)
|
|
c Y(1,4) = cplx1(m1 + m4 - p4)
|
|
c Y(4,1) = Y(1,4)
|
|
c Y(2,2) = cplx1(two*m2)
|
|
c Y(2,3) = cplx1(m2 + m3 - p2)
|
|
c Y(3,2) = Y(2,3)
|
|
c Y(2,4) = cplx1(m2 + m4 - p2p3)
|
|
c Y(4,2) = Y(2,4)
|
|
c Y(3,3) = cplx1(two*m3)
|
|
c Y(3,4) = cplx1(m3 + m4 - p3)
|
|
c Y(4,3) = Y(3,4)
|
|
c Y(4,4) = cplx1(two*m4)
|
|
|
|
c if (pvverbose) write(6,*) 'Check box Ysing'
|
|
c Ysing=pvGramsing(Y,4)
|
|
|
|
c-- find maximum entry in Gram matrix
|
|
c Gmax=zip
|
|
c do j=1,3
|
|
c do k=j,3
|
|
c if (abs(G(j,k)) .gt. Gmax) Gmax=abs(G(j,k))
|
|
c enddo
|
|
c enddo
|
|
|
|
c if (pvverbose) write(6,*) 'Gmax=',Gmax
|
|
c Psing=.false.
|
|
c--- criterion for small momenta recursion
|
|
c if (Gmax .lt. weenumber) Psing=.true.
|
|
|
|
c-- find maximum of f1, f2 and f3
|
|
c fmax=max(abs(f1),abs(f2),abs(f3))
|
|
|
|
c if (pvverbose) write(6,*) 'fmax=',fmax
|
|
c Fsing=.false.
|
|
c--- criterion for small momenta and small f(k) recursion
|
|
c if (fmax .lt. weenumber) Fsing=.true.
|
|
|
|
c if (pvverbose) write(6,*) 'pvDfill: Gsing,Ysing,Psing,Fsing',
|
|
c & Gsing,Ysing,Psing,Fsing
|
|
|
|
c--- If alternative recursion required, ensure triangle integrals
|
|
c--- are computed to maximum available rank
|
|
if (doPFsing) pvRespectmaxcindex=.false.
|
|
if (doPsing) pvRespectmaxcindex=.false.
|
|
if (doGYsing) pvRespectmaxcindex=.false.
|
|
if (doGsing) pvRespectmaxcindex=.false.
|
|
|
|
pvRespectmaxcindex=.true.
|
|
|
|
pvforcerecalc=.false.
|
|
c--- Set up relevant triangle pinchings
|
|
triq1save(:)=q2save(:)-q1save(:)
|
|
triq2save(:)=q3save(:)-q1save(:)
|
|
C234=pvCcache(p2,p3,p2p3,m2,m3,m4)
|
|
triq1save(:)=q2save(:)
|
|
triq2save(:)=q3save(:)
|
|
C134=pvCcache(p1p2,p3,p4,m1,m3,m4)
|
|
triq1save(:)=q1save(:)
|
|
triq2save(:)=q3save(:)
|
|
C124=pvCcache(p1,p2p3,p4,m1,m2,m4)
|
|
triq1save(:)=q1save(:)
|
|
triq2save(:)=q2save(:)
|
|
C123=pvCcache(p1,p2,p1p2,m1,m2,m3)
|
|
|
|
c--- Return to default behaviour
|
|
pvRespectmaxcindex=.true.
|
|
|
|
c--- Make call to alternate recursion routines if required
|
|
exceptional=.false.
|
|
|
|
if (doPFsing) then
|
|
c--- for small momenta and small f(k)
|
|
if (pvverbose) then
|
|
write(6,*) 'USING BOX SMALL MOMENTA AND f(k) RECURSION'
|
|
endif
|
|
call Dfill_recur4(p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,N)
|
|
irecur4=irecur4+1
|
|
return
|
|
elseif (doPsing) then
|
|
c--- for small momenta
|
|
if (pvverbose) then
|
|
write(6,*) 'USING BOX SMALL MOMENTA RECURSION'
|
|
endif
|
|
call Dfill_recur3(p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,N)
|
|
irecur3=irecur3+1
|
|
return
|
|
elseif (doGYsing) then
|
|
c--- for small Gram and small Y
|
|
if (pvverbose) then
|
|
write(6,*) 'USING BOX SMALL Y AND SMALL G RECURSION'
|
|
endif
|
|
call Dfill_recur2(p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,N,
|
|
. exceptional)
|
|
irecur2=irecur2+1
|
|
if (exceptional) then
|
|
c------ for exceptional configurations, fall through to normal PV
|
|
continue
|
|
else
|
|
c------ otherwise, we're done
|
|
return
|
|
endif
|
|
elseif (doGsing) then
|
|
c--- for small Gram only
|
|
if (pvverbose) then
|
|
write(6,*) 'USING BOX SMALL G RECURSION'
|
|
endif
|
|
call Dfill_recur (p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,N)
|
|
irecur=irecur+1
|
|
return
|
|
endif
|
|
c--- otherwise, usual PV is fine
|
|
|
|
c if (exceptional) write(6,*) 'WARNING: EXCEPTIONAL POINT'
|
|
|
|
c--- initialize integrals
|
|
do ep=-2,0
|
|
do j=1,Ndd
|
|
Dv(N+j,ep)=cplx2(1d5,-1d5)
|
|
enddo
|
|
enddo
|
|
|
|
call XLUDecomp(G, 3, perm)
|
|
|
|
do ep=-2,0
|
|
do j=1,Ndd
|
|
Dv(N+j,ep)=cplx1(10000._dp)
|
|
enddo
|
|
enddo
|
|
|
|
do ep=-2,0
|
|
Dv(N+dd0,ep) =trI4(p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,musq,ep)
|
|
enddo
|
|
|
|
c0sum(:)=Cv(cc0+C234,:)+Cv(cc1+C234,:)+Cv(cc2+C234,:)
|
|
c1sum(:)=Cv(cc1+C234,:)+Cv(cc11+C234,:)+Cv(cc12+C234,:)
|
|
c2sum(:)=Cv(cc2+C234,:)+Cv(cc12+C234,:)+Cv(cc22+C234,:)
|
|
csum(:)=c0sum(:)+c1sum(:)+c2sum(:)
|
|
|
|
c00sum(:) = Cv(cc00+C234,:) +
|
|
& Cv(cc001+C234,:)+Cv(cc002+C234,:)
|
|
c11sum(:) = Cv(cc11+C234,:) +
|
|
& Cv(cc111+C234,:)+Cv(cc112+C234,:)
|
|
c12sum(:) = Cv(cc12+C234,:) +
|
|
& Cv(cc112+C234,:)+Cv(cc122+C234,:)
|
|
c22sum(:) = Cv(cc22+C234,:) +
|
|
& Cv(cc122+C234,:)+Cv(cc222+C234,:)
|
|
|
|
|
|
in(1,:) = f1*Dv(N+dd0,:) - Cv(cc0+C234,:)+Cv(cc0+C134,:)
|
|
in(2,:) = f2*Dv(N+dd0,:) - Cv(cc0+C234,:)+Cv(cc0+C124,:)
|
|
in(3,:) = f3*Dv(N+dd0,:) - Cv(cc0+C234,:)+Cv(cc0+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1,:) = in(1,:)
|
|
Dv(N+dd2,:) = in(2,:)
|
|
Dv(N+dd3,:) = in(3,:)
|
|
|
|
do ep=-2,0
|
|
Dv(N+dd00,ep) = czip
|
|
if (ep .eq. -2) goto 20
|
|
do j=0,ep+2
|
|
epmj=ep-j
|
|
Dv(N+dd00,ep) = Dv(N+dd00,ep)+idm3(j)*(m1*Dv(N+dd0,epmj)
|
|
& -half*(Dv(N+dd1,epmj)*f1 +Dv(N+dd2,epmj)*f2 +Dv(N+dd3,epmj)*f3
|
|
& - Cv(cc0+C234,epmj)))
|
|
enddo
|
|
20 continue
|
|
enddo
|
|
|
|
in(1,:) = f1*Dv(N+dd1,:)+c0sum(:) - two*Dv(N+dd00,:)
|
|
in(2,:) = f2*Dv(N+dd1,:)+c0sum(:)+Cv(cc1+C124,:)
|
|
in(3,:) = f3*Dv(N+dd1,:)+c0sum(:)+Cv(cc1+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd11,:) = in(1,:)
|
|
Dv(N+dd12,:) = in(2,:)
|
|
Dv(N+dd13,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd2,:) - Cv(cc1+C234,:)+Cv(cc1+C134,:)
|
|
in(2,:) = f2*Dv(N+dd2,:) - Cv(cc1+C234,:) - two*Dv(N+dd00,:)
|
|
in(3,:) = f3*Dv(N+dd2,:) - Cv(cc1+C234,:)+Cv(cc2+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd12,:) = half*(Dv(N+dd12,:)+in(1,:))
|
|
Dv(N+dd22,:) = in(2,:)
|
|
Dv(N+dd23,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd3,:) - Cv(cc2+C234,:)+Cv(cc2+C134,:)
|
|
in(2,:) = f2*Dv(N+dd3,:) - Cv(cc2+C234,:)+Cv(cc2+C124,:)
|
|
in(3,:) = f3*Dv(N+dd3,:) - Cv(cc2+C234,:) - two*Dv(N+dd00,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd13,:) = half*(Dv(N+dd13,:)+in(1,:))
|
|
Dv(N+dd23,:) = half*(Dv(N+dd23,:)+in(2,:))
|
|
Dv(N+dd33,:) = in(3,:)
|
|
|
|
C --- end of two index tensors
|
|
|
|
if (maxdindex .eq. 2) return
|
|
|
|
C--- three index tensors
|
|
do ep=-2,0
|
|
do j=dd001,dd003
|
|
Dv(N+j,ep) = czip
|
|
enddo
|
|
if (ep .eq. -2) goto 30
|
|
do j=0,ep+2
|
|
epmj=ep-j
|
|
Dv(N+dd001,ep)=Dv(N+dd001,ep)+idm2(j)*half*(-f1*Dv(N +
|
|
& dd11,epmj)-f2*Dv(N+dd12,epmj)-f3*Dv(N+dd13,epmj
|
|
& )-Cv(cc0+C234,epmj)-Cv(cc1+C234,epmj)-Cv(cc2 +
|
|
& C234,epmj)+two*m1*Dv(N+dd1,epmj))
|
|
Dv(N+dd002,ep)=Dv(N+dd002,ep)+idm2(j)*half*(-f1*Dv(N +
|
|
& dd12,epmj)-f2*Dv(N+dd22,epmj)-f3*Dv(N+dd23,epmj
|
|
& )+Cv(cc1+C234,epmj)+two*m1*Dv(N+dd2,epmj))
|
|
Dv(N+dd003,ep)=Dv(N+dd003,ep)+idm2(j)*half*(-f1*Dv(N +
|
|
& dd13,epmj)-f2*Dv(N+dd23,epmj)-f3*Dv(N+dd33,epmj
|
|
& )+Cv(cc2+C234,epmj)+two*m1*Dv(N+dd3,epmj))
|
|
enddo
|
|
30 continue
|
|
enddo
|
|
|
|
in(1,:) = f1*Dv(N+dd11,:) - csum(:) - four*Dv(N+dd001,:)
|
|
in(2,:) = f2*Dv(N+dd11,:) - csum(:)+Cv(cc11+C124,:)
|
|
in(3,:) = f3*Dv(N+dd11,:) - csum(:)+Cv(cc11+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd111,:) = in(1,:)
|
|
Dv(N+dd112,:) = in(2,:)
|
|
Dv(N+dd113,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd22,:) - Cv(cc11+C234,:)+Cv(cc11+C134,:)
|
|
in(2,:) = f2*Dv(N+dd22,:) - Cv(cc11+C234,:)
|
|
. - four*Dv(N+dd002,:)
|
|
in(3,:) = f3*Dv(N+dd22,:) - Cv(cc11+C234,:)+Cv(cc22+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd122,:) = in(1,:)
|
|
Dv(N+dd222,:) = in(2,:)
|
|
Dv(N+dd223,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd33,:) - Cv(cc22+C234,:)+Cv(cc22+C134,:)
|
|
in(2,:) = f2*Dv(N+dd33,:) - Cv(cc22+C234,:)+Cv(cc22+C124,:)
|
|
in(3,:) = f3*Dv(N+dd33,:) - Cv(cc22+C234,:)
|
|
. - four*Dv(N+dd003,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd133,:) = in(1,:)
|
|
Dv(N+dd233,:) = in(2,:)
|
|
Dv(N+dd333,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd13,:)+c2sum(:) - two*Dv(N+dd003,:)
|
|
in(2,:) = f2*Dv(N+dd13,:)+c2sum(:)+Cv(cc12+C124,:)
|
|
in(3,:) = f3*Dv(N+dd13,:)+c2sum(:) - two*Dv(N+dd001,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd113,:) = half*(Dv(N+dd113,:)+in(1,:))
|
|
Dv(N+dd123,:) = in(2,:)
|
|
Dv(N+dd133,:) = half*(Dv(N+dd133,:)+in(3,:))
|
|
|
|
c--- check the contents of box array
|
|
c write(6,*) 'PV: D array'
|
|
c do j=1,24
|
|
c write(6,'(i3,2e20.12)') j,Dv(j+N,0)
|
|
c enddo
|
|
|
|
if (maxdindex .eq. 3) return
|
|
|
|
C--- four index tensors
|
|
do ep=-2,0
|
|
do j=dd0000,dd0033
|
|
Dv(N+j,ep) = czip
|
|
enddo
|
|
if (ep .eq. -2) goto 40
|
|
do j=0,ep+2
|
|
epmj=ep-j
|
|
Dv(N+dd0000,ep) = Dv(N+dd0000,ep)+idm1(j)*(m1*Dv(N+dd00,epmj) -
|
|
& half
|
|
& *(f1*Dv(N+dd001,epmj)+f2*Dv(N+dd002,epmj)+f3*Dv(N+dd003,epmj)-
|
|
& Cv(cc00+C234,epmj)))
|
|
Dv(N+dd0011,ep) = Dv(N+dd0011,ep)+idm1(j)*(m1*Dv(N+dd11,epmj)-
|
|
& half
|
|
& *(f1*Dv(N+dd111,epmj)+f2*Dv(N+dd112,epmj)+f3*Dv(N+dd113,epmj)
|
|
& -csum(epmj)))
|
|
Dv(N+dd0012,ep) = Dv(N+dd0012,ep)+idm1(j)*(m1*Dv(N+dd12,epmj)-
|
|
& half
|
|
& *(f1*Dv(N+dd112,epmj)+f2*Dv(N+dd122,epmj)+f3*Dv(N+dd123,epmj)
|
|
& +c1sum(epmj)))
|
|
Dv(N+dd0013,ep) = Dv(N+dd0013,ep)+idm1(j)*(m1*Dv(N+dd13,epmj)-
|
|
& half
|
|
& *(f1*Dv(N+dd113,epmj)+f2*Dv(N+dd123,epmj)+f3*Dv(N+dd133,epmj)
|
|
& +c2sum(epmj)))
|
|
Dv(N+dd0022,ep) = Dv(N+dd0022,ep)+idm1(j)*(m1*Dv(N+dd22,epmj)-
|
|
& half
|
|
& *(f1*Dv(N+dd122,epmj)+f2*Dv(N+dd222,epmj)+f3*Dv(N+dd223,epmj)-
|
|
& Cv(cc11+C234,epmj)))
|
|
Dv(N+dd0023,ep) = Dv(N+dd0023,ep)+idm1(j)*(m1*Dv(N+dd23,epmj)-
|
|
& half
|
|
& *(f1*Dv(N+dd123,epmj)+f2*Dv(N+dd223,epmj)+f3*Dv(N+dd233,epmj)-
|
|
& Cv(cc12+C234,epmj)))
|
|
Dv(N+dd0033,ep) = Dv(N+dd0033,ep)+idm1(j)*(m1*Dv(N+dd33,epmj)-
|
|
& half
|
|
& *(f1*Dv(N+dd133,epmj)+f2*Dv(N+dd233,epmj)+f3*Dv(N+dd333,epmj)-
|
|
& Cv(cc22+C234,epmj)))
|
|
enddo
|
|
40 continue
|
|
enddo
|
|
|
|
c1sum(:) = c1sum(:)+c11sum(:)+c12sum(:)
|
|
c2sum(:) = c2sum(:)+c12sum(:)+c22sum(:)
|
|
csum(:) = csum(:)+c1sum(:)+c2sum(:)
|
|
|
|
in(1,:) = f1*Dv(N+dd111,:)+csum(:) - 6d0*Dv(N+dd0011,:)
|
|
in(2,:) = f2*Dv(N+dd111,:)+csum(:)+Cv(cc111+C124,:)
|
|
in(3,:) = f3*Dv(N+dd111,:)+csum(:)+Cv(cc111+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1111,:) = in(1,:)
|
|
Dv(N+dd1112,:) = in(2,:)
|
|
Dv(N+dd1113,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd113,:) - c2sum(:) - four*Dv(N+dd0013,:)
|
|
in(2,:) = f2*Dv(N+dd113,:) - c2sum(:)+Cv(cc112+C124,:)
|
|
in(3,:) = f3*Dv(N+dd113,:) - c2sum(:) - two*Dv(N+dd0011,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1113,:) = half*(Dv(N+dd1113,:)+in(1,:))
|
|
Dv(N+dd1123,:) = in(2,:)
|
|
Dv(N+dd1133,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd122,:)+c11sum(:) - two*Dv(N+dd0022,:)
|
|
in(2,:) = f2*Dv(N+dd122,:)+c11sum(:) - four*Dv(N+dd0012,:)
|
|
in(3,:) = f3*Dv(N+dd122,:)+c11sum(:)+Cv(cc122+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1122,:) = in(1,:)
|
|
Dv(N+dd1222,:) = in(2,:)
|
|
Dv(N+dd1223,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd222,:)-Cv(cc111+C234,:)+Cv(cc111+C134,:)
|
|
in(2,:) = f2*Dv(N+dd222,:)-Cv(cc111+C234,:)-6*Dv(N+dd0022,:)
|
|
in(3,:) = f3*Dv(N+dd222,:)-Cv(cc111+C234,:)+Cv(cc222+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1222,:) = half*(Dv(N+dd1222,:)+in(1,:))
|
|
Dv(N+dd2222,:) = in(2,:)
|
|
Dv(N+dd2223,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd233,:)-Cv(cc122+C234,:)+Cv(cc122+C134,:)
|
|
in(2,:) = f2*Dv(N+dd233,:)-Cv(cc122+C234,:)-2*Dv(N+dd0033,:)
|
|
in(3,:) = f3*Dv(N+dd233,:)-Cv(cc122+C234,:)-4*Dv(N+dd0023,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1233,:) = in(1,:)
|
|
Dv(N+dd2233,:) = in(2,:)
|
|
Dv(N+dd2333,:) = in(3,:)
|
|
|
|
in(1,:) = f1*Dv(N+dd333,:)-Cv(cc222+C234,:)+Cv(cc222+C134,:)
|
|
in(2,:) = f2*Dv(N+dd333,:)-Cv(cc222+C234,:)+Cv(cc222+C124,:)
|
|
in(3,:) = f3*Dv(N+dd333,:)-Cv(cc222+C234,:)-6*Dv(N+dd0033,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd1333,:) = in(1,:)
|
|
Dv(N+dd2333,:) = half*(Dv(N+dd2333,:)+in(2,:))
|
|
Dv(N+dd3333,:) = in(3,:)
|
|
c00sum(:) = c00sum(:) +
|
|
& Cv(cc001+C234,:)+Cv(cc0011+C234,:)+Cv(cc0012+C234,:) +
|
|
& Cv(cc002+C234,:)+Cv(cc0012+C234,:)+Cv(cc0022+C234,:)
|
|
c11sum(:) = c11sum(:) +
|
|
& Cv(cc111+C234,:)+Cv(cc1111+C234,:)+Cv(cc1112+C234,:) +
|
|
& Cv(cc112+C234,:)+Cv(cc1112+C234,:)+Cv(cc1122+C234,:)
|
|
c12sum(:) = c12sum(:) +
|
|
& Cv(cc112+C234,:)+Cv(cc1112+C234,:)+Cv(cc1122+C234,:) +
|
|
& Cv(cc122+C234,:)+Cv(cc1122+C234,:)+Cv(cc1222+C234,:)
|
|
c22sum(:) = c22sum(:) +
|
|
& Cv(cc122+C234,:)+Cv(cc1122+C234,:)+Cv(cc1222+C234,:) +
|
|
& Cv(cc222+C234,:)+Cv(cc1222+C234,:)+Cv(cc2222+C234,:)
|
|
c1sum(:) = c1sum(:)+c11sum(:)+c12sum(:)
|
|
c2sum(:) = c2sum(:)+c12sum(:)+c22sum(:)
|
|
csum(:) = csum(:)+c1sum(:)+c2sum(:)
|
|
|
|
|
|
if (maxdindex .eq. 4) return
|
|
|
|
C------begin of five index tensors
|
|
do ep=-2,0
|
|
do j=dd00001,dd00333
|
|
Dv(N+j,ep)=czip
|
|
enddo
|
|
if (ep .eq. -2) goto 50
|
|
do j=0,ep+2
|
|
epmj=ep-j
|
|
Dv(N+dd00001,ep)=Dv(N+dd00001,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd0011,epmj)-f2*Dv(N+dd0012,epmj)-f3*Dv(N+dd0013,
|
|
& epmj)-Cv(cc00+C234,epmj)-Cv(cc001+C234,epmj)-
|
|
& Cv(cc002+C234,epmj)+two*m1*Dv(N+dd001,epmj))
|
|
|
|
Dv(N+dd00002,ep)=Dv(N+dd00002,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd0012,epmj)-f2*Dv(N+dd0022,epmj)-f3*Dv(N+dd0023,
|
|
& epmj)+Cv(cc001+C234,epmj)+two*m1*Dv(N+dd002,epmj))
|
|
|
|
Dv(N+dd00003,ep)=Dv(N+dd00003,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd0013,epmj)-f2*Dv(N+dd0023,epmj)-f3*Dv(N+dd0033,
|
|
& epmj)+Cv(cc002+C234,epmj)+two*m1*Dv(N+dd003,epmj))
|
|
|
|
Dv(N+dd00111,ep)=Dv(N+dd00111,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1111,epmj)-f2*Dv(N+dd1112,epmj)-f3*Dv(N+dd1113,
|
|
& epmj)-Cv(cc0+C234,epmj)-three*Cv(cc1+C234,epmj)
|
|
& -three*Cv(cc11+C234,epmj)-Cv(cc111+C234,epmj)-three
|
|
& *Cv(cc112+C234,epmj)-six*Cv(cc12+C234,epmj)-three
|
|
& *Cv(cc122+C234,epmj)-three*Cv(cc2+C234,epmj)-three*
|
|
& Cv(cc22+C234,epmj)-Cv(cc222+C234,epmj)
|
|
& +two*m1*Dv(N+dd111,epmj))
|
|
|
|
Dv(N+dd00112,ep)=Dv(N+dd00112,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1112,epmj)-f2*Dv(N+dd1122,epmj)-f3*Dv(N+dd1123,
|
|
& epmj)+Cv(cc1+C234,epmj)+two*Cv(cc11+C234,epmj)
|
|
& +Cv(cc111+C234,epmj)+two*Cv(cc112+C234,epmj)+two
|
|
& *Cv(cc12+C234,epmj)+Cv(cc122+C234,epmj)
|
|
& +two*m1*Dv(N+dd112,epmj))
|
|
|
|
Dv(N+dd00113,ep)=Dv(N+dd00113,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1113,epmj)-f2*Dv(N+dd1123,epmj)-f3*Dv(N+dd1133,
|
|
& epmj)+Cv(cc112+C234,epmj)+two*Cv(cc12+C234,ep-
|
|
& j)+two*Cv(cc122+C234,epmj)+Cv(cc2+C234,epmj)+two
|
|
& *Cv(cc22+C234,epmj)+Cv(cc222+C234,epmj)
|
|
& +two*m1*Dv(N+dd113,epmj))
|
|
|
|
Dv(N+dd00122,ep)=Dv(N+dd00122,ep)+id(j)*half *(-f1*Dv(N+
|
|
& dd1122,epmj)-f2*Dv(N+dd1222,epmj)-f3*Dv(N+dd1223,
|
|
& epmj)-Cv(cc11+C234,epmj)-Cv(cc111+C234,epmj)-
|
|
& Cv(cc112+C234,epmj)
|
|
& +two*m1*Dv(N+dd122,epmj))
|
|
|
|
Dv(N+dd00123,ep)=Dv(N+dd00123,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1123,epmj)-f2*Dv(N+dd1223,epmj)-f3*Dv(N+dd1233,
|
|
& epmj)-Cv(cc112+C234,epmj)-Cv(cc12+C234,epmj)-
|
|
& Cv(cc122+C234,epmj)
|
|
& +two*m1*Dv(N+dd123,epmj))
|
|
|
|
Dv(N+dd00133,ep)=Dv(N+dd00133,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1133,epmj)-f2*Dv(N+dd1233,epmj)-f3*Dv(N+dd1333,
|
|
& epmj)-Cv(cc122+C234,epmj)-Cv(cc22+C234,epmj)-
|
|
& Cv(cc222+C234,epmj)
|
|
& +two*m1*Dv(N+dd133,epmj))
|
|
|
|
Dv(N+dd00222,ep)=Dv(N+dd00222,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1222,epmj)-f2*Dv(N+dd2222,epmj)-f3*Dv(N+dd2223,
|
|
& epmj)+Cv(cc111+C234,epmj)
|
|
& +two*m1*Dv(N+dd222,epmj))
|
|
|
|
Dv(N+dd00223,ep)=Dv(N+dd00223,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1223,epmj)-f2*Dv(N+dd2223,epmj)-f3*Dv(N+dd2233,
|
|
& epmj)+Cv(cc112+C234,epmj)
|
|
& +two*m1*Dv(N+dd223,epmj))
|
|
|
|
Dv(N+dd00233,ep)=Dv(N+dd00233,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1233,epmj)-f2*Dv(N+dd2233,epmj)-f3*Dv(N+dd2333,
|
|
& epmj)+Cv(cc122+C234,epmj)
|
|
& +two*m1*Dv(N+dd233,epmj))
|
|
|
|
Dv(N+dd00333,ep)=Dv(N+dd00333,ep)+id(j)*half*(-f1*Dv(N+
|
|
& dd1333,epmj)-f2*Dv(N+dd2333,epmj)-f3*Dv(N+dd3333,
|
|
& epmj)+Cv(cc222+C234,epmj)
|
|
& +two*m1*Dv(N+dd333,epmj))
|
|
|
|
enddo
|
|
50 continue
|
|
enddo
|
|
|
|
in(1,:)=f1*Dv(N+dd1111,:)-csum(:)-8*Dv(N+dd00111,:)
|
|
in(2,:)=f2*Dv(N+dd1111,:)-csum(:)+Cv(cc1111+C124,:)
|
|
in(3,:)=f3*Dv(N+dd1111,:)-csum(:)+Cv(cc1111+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd11111,:)=in(1,:)
|
|
Dv(N+dd11112,:)=in(2,:)
|
|
Dv(N+dd11113,:)=in(3,:)
|
|
|
|
in(1,:)=f1*Dv(N+dd2222,:)-Cv(cc1111+C234,:)+Cv(cc1111+C134,:)
|
|
in(2,:)=f2*Dv(N+dd2222,:)-Cv(cc1111+C234,:)-8*Dv(N+dd00222,:)
|
|
in(3,:)=f3*Dv(N+dd2222,:)-Cv(cc1111+C234,:)+Cv(cc2222+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd12222,:)=in(1,:)
|
|
Dv(N+dd22222,:)=in(2,:)
|
|
Dv(N+dd22223,:)=in(3,:)
|
|
|
|
in(1,:)=f1*Dv(N+dd3333,:)-Cv(cc2222+C234,:)+Cv(cc2222+C134,:)
|
|
in(2,:)=f2*Dv(N+dd3333,:)-Cv(cc2222+C234,:)+Cv(cc2222+C124,:)
|
|
in(3,:)=f3*Dv(N+dd3333,:)-Cv(cc2222+C234,:)-8*Dv(N+dd00333,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd13333,:)=in(1,:)
|
|
Dv(N+dd23333,:)=in(2,:)
|
|
Dv(N+dd33333,:)=in(3,:)
|
|
|
|
in(1,:)=f1*Dv(N+dd1122,:)-c11sum(:)-4*Dv(N+dd00122,:)
|
|
in(2,:)=f2*Dv(N+dd1122,:)-c11sum(:)-4*Dv(N+dd00112,:)
|
|
in(3,:)=f3*Dv(N+dd1122,:)-c11sum(:)+Cv(cc1122+C123,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd11122,:)=in(1,:)
|
|
Dv(N+dd11222,:)=in(2,:)
|
|
Dv(N+dd11223,:)=in(3,:)
|
|
|
|
in(1,:)=f1*Dv(N+dd1133,:)-c22sum(:)-4*Dv(N+dd00133,:)
|
|
in(2,:)=f2*Dv(N+dd1133,:)-c22sum(:)+Cv(cc1122+C124,:)
|
|
in(3,:)=f3*Dv(N+dd1133,:)-c22sum(:)-4*Dv(N+dd00113,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd11133,:)=in(1,:)
|
|
Dv(N+dd11233,:)=in(2,:)
|
|
Dv(N+dd11333,:)=in(3,:)
|
|
|
|
in(1,:)=f1*Dv(N+dd2233,:)-Cv(cc1122+C234,:)+Cv(cc1122+C134,:)
|
|
in(2,:)=f2*Dv(N+dd2233,:)-Cv(cc1122+C234,:)-4*Dv(N+dd00233,:)
|
|
in(3,:)=f3*Dv(N+dd2233,:)-Cv(cc1122+C234,:)-4*Dv(N+dd00223,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd12233,:)=in(1,:)
|
|
Dv(N+dd22233,:)=in(2,:)
|
|
Dv(N+dd22333,:)=in(3,:)
|
|
|
|
in(1,:)=f1*Dv(N+dd1123,:)-c12sum(:)-4*Dv(N+dd00123,:)
|
|
in(2,:)=f2*Dv(N+dd1123,:)-c12sum(:)-2*Dv(N+dd00113,:)
|
|
in(3,:)=f3*Dv(N+dd1123,:)-c12sum(:)-2*Dv(N+dd00112,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd11123,:)=in(1,:)
|
|
Dv(N+dd11223,:)=half*(Dv(N+dd11223,:)+in(2,:))
|
|
Dv(N+dd11233,:)=half*(Dv(N+dd11233,:)+in(3,:))
|
|
|
|
in(1,:)=f1*Dv(N+dd2223,:)-Cv(cc1112+C234,:)+Cv(cc1112+C134,:)
|
|
in(2,:)=f2*Dv(N+dd2223,:)-Cv(cc1112+C234,:)-6*Dv(N+dd00223,:)
|
|
in(3,:)=f3*Dv(N+dd2223,:)-Cv(cc1112+C234,:)-2*Dv(N+dd00222,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd12223,:)=in(1,:)
|
|
Dv(N+dd22223,:)=half*(Dv(N+dd22223,:)+in(2,:))
|
|
Dv(N+dd22233,:)=half*(Dv(N+dd22233,:)+in(3,:))
|
|
|
|
in(1,:)=f1*Dv(N+dd2333,:)-Cv(cc1222+C234,:)+Cv(cc1222+C134,:)
|
|
in(2,:)=f2*Dv(N+dd2333,:)-Cv(cc1222+C234,:)-2*Dv(N+dd00333,:)
|
|
in(3,:)=f3*Dv(N+dd2333,:)-Cv(cc1222+C234,:)-6*Dv(N+dd00233,:)
|
|
call pvBackSubst(G,3,perm,in)
|
|
Dv(N+dd12333,:)=in(1,:)
|
|
Dv(N+dd22333,:)=half*(Dv(N+dd22333,:)+in(2,:))
|
|
Dv(N+dd23333,:)=half*(Dv(N+dd23333,:)+in(3,:))
|
|
|
|
C------end of five index tensors
|
|
|
|
if (maxdindex .eq. 5) return
|
|
|
|
C------six index tensors
|
|
do ep=-2,0
|
|
do j=dd000000,dd003333
|
|
Dv(N+j,ep)=czip
|
|
enddo
|
|
if (ep .eq. -2) goto 60
|
|
do j=0,ep+2
|
|
epmj=ep-j
|
|
Dv(N+dd000000,ep)=Dv(N+dd000000,ep)+idp1(j)*half
|
|
& *(-f1*Dv(N+dd00001,epmj)-f2*Dv(N+dd00002,epmj)
|
|
& -f3*Dv(N+dd00003,epmj)+Cv(cc0000+C234,epmj)
|
|
& +two*m1*Dv(N+dd0000,epmj))
|
|
Dv(N+dd001111,ep)=Dv(N+dd001111,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11111,epmj)-f2*Dv(N+dd11112,epmj)-f3*Dv(N+
|
|
& dd11113,epmj)+Cv(cc0+C234,epmj)+four*Cv(cc1+C234,
|
|
& epmj)+six*Cv(cc11+C234,epmj)+four*Cv(cc111+C234,
|
|
& epmj)+Cv(cc1111+C234,epmj)+four*Cv(cc1112+C234,epmj)
|
|
& +12._dp*Cv(cc112+C234,epmj)+six*Cv(cc1122+C234
|
|
& ,epmj)+12._dp*Cv(cc12+C234,epmj)+12._dp*Cv(cc122+
|
|
& C234,epmj)+four*Cv(cc1222+C234,epmj)+four*Cv(cc2+
|
|
& C234,epmj)+six*Cv(cc22+C234,epmj)+four*Cv(cc222+
|
|
& C234,epmj)+Cv(cc2222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1111,epmj))
|
|
Dv(N+dd001112,ep)=Dv(N+dd001112,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11112,epmj)-f2*Dv(N+dd11122,epmj)-f3*Dv(N+
|
|
& dd11123,epmj)-Cv(cc1+C234,epmj)-three*Cv(cc11+C234
|
|
& ,epmj)-three*Cv(cc111+C234,epmj)-Cv(cc1111+C234,epmj)
|
|
& -three*Cv(cc1112+C234,epmj)-six*Cv(cc112+C234,
|
|
& epmj)-three*Cv(cc1122+C234,epmj)-three*Cv(cc12+C234
|
|
& ,epmj)-three*Cv(cc122+C234,epmj)-Cv(cc1222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1112,epmj))
|
|
Dv(N+dd001113,ep)=Dv(N+dd001113,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11113,epmj)-f2*Dv(N+dd11123,epmj)-f3*Dv(N+
|
|
& dd11133,epmj)-Cv(cc1112+C234,epmj)-three*Cv(cc112+
|
|
& C234,epmj)-three*Cv(cc1122+C234,epmj)-three*Cv(cc12
|
|
& +C234,epmj)-six*Cv(cc122+C234,epmj)-three*Cv(
|
|
& cc1222+C234,epmj)-Cv(cc2+C234,epmj)-three*Cv(cc22
|
|
& +C234,epmj)-three*Cv(cc222+C234,epmj)-Cv(cc2222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1113,epmj))
|
|
Dv(N+dd001122,ep)=Dv(N+dd001122,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11122,epmj)-f2*Dv(N+dd11222,epmj)-f3*Dv(N+
|
|
& dd11223,epmj)+Cv(cc11+C234,epmj)+two*Cv(cc111+
|
|
& C234,epmj)+Cv(cc1111+C234,epmj)+two*Cv(cc1112+
|
|
& C234,epmj)+two*Cv(cc112+C234,epmj)
|
|
& +Cv(cc1122+C234,epmj)+two*m1*Dv(N+dd1122,epmj))
|
|
Dv(N+dd001123,ep)=Dv(N+dd001123,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11123,epmj)-f2*Dv(N+dd11223,epmj)-f3*Dv(N+
|
|
& dd11233,epmj)+Cv(cc1112+C234,epmj)+two*Cv(cc112+
|
|
& C234,epmj)+two*Cv(cc1122+C234,epmj)+Cv(cc12+C234
|
|
& ,epmj)+two*Cv(cc122+C234,epmj)+Cv(cc1222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1123,epmj))
|
|
Dv(N+dd001133,ep)=Dv(N+dd001133,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11133,epmj)-f2*Dv(N+dd11233,epmj)-f3*Dv(N+
|
|
& dd11333,epmj)+Cv(cc1122+C234,epmj)+two*Cv(cc122+
|
|
& C234,epmj)+two*Cv(cc1222+C234,epmj)+Cv(cc22+C234
|
|
& ,epmj)+two*Cv(cc222+C234,epmj)+Cv(cc2222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1133,epmj))
|
|
Dv(N+dd001222,ep)=Dv(N+dd001222,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11222,epmj)-f2*Dv(N+dd12222,epmj)-f3*Dv(N+
|
|
& dd12223,epmj)-Cv(cc111+C234,epmj)-Cv(cc1111+C234,
|
|
& epmj)-Cv(cc1112+C234,epmj)
|
|
& +two*m1*Dv(N+dd1222,epmj))
|
|
Dv(N+dd001223,ep)=Dv(N+dd001223,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11223,epmj)-f2*Dv(N+dd12223,epmj)-f3*Dv(N+
|
|
& dd12233,epmj)-Cv(cc1112+C234,epmj)-Cv(cc112+C234,
|
|
& epmj)-Cv(cc1122+C234,epmj)
|
|
& +two*m1*Dv(N+dd1223,epmj))
|
|
Dv(N+dd001233,ep)=Dv(N+dd001233,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11233,epmj)-f2*Dv(N+dd12233,epmj)-f3*Dv(N+
|
|
& dd12333,epmj)-Cv(cc1122+C234,epmj)-Cv(cc122+C234,
|
|
& epmj)-Cv(cc1222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1233,epmj))
|
|
Dv(N+dd001333,ep)=Dv(N+dd001333,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd11333,epmj)-f2*Dv(N+dd12333,epmj)-f3*Dv(N+
|
|
& dd13333,epmj)-Cv(cc1222+C234,epmj)-Cv(cc222+C234,
|
|
& epmj)-Cv(cc2222+C234,epmj)
|
|
& +two*m1*Dv(N+dd1333,epmj))
|
|
Dv(N+dd002222,ep)=Dv(N+dd002222,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd12222,epmj)-f2*Dv(N+dd22222,epmj)-f3*Dv(N+
|
|
& dd22223,epmj)+Cv(cc1111+C234,epmj)
|
|
& +two*m1*Dv(N+dd2222,epmj))
|
|
Dv(N+dd002223,ep)=Dv(N+dd002223,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd12223,epmj)-f2*Dv(N+dd22223,epmj)-f3*Dv(N+
|
|
& dd22233,epmj)+Cv(cc1112+C234,epmj)
|
|
& +two*m1*Dv(N+dd2223,epmj))
|
|
Dv(N+dd002233,ep)=Dv(N+dd002233,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd12233,epmj)-f2*Dv(N+dd22233,epmj)-f3*Dv(N+
|
|
& dd22333,epmj)+Cv(cc1122+C234,epmj)
|
|
& +two*m1*Dv(N+dd2233,epmj))
|
|
Dv(N+dd002333,ep)=Dv(N+dd002333,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd12333,epmj)-f2*Dv(N+dd22333,epmj)-f3*Dv(N+
|
|
& dd23333,epmj)+Cv(cc1222+C234,epmj)
|
|
& +two*m1*Dv(N+dd2333,epmj))
|
|
Dv(N+dd003333,ep)=Dv(N+dd003333,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd13333,epmj)-f2*Dv(N+dd23333,epmj)-f3*Dv(N+
|
|
& dd33333,epmj)+Cv(cc2222+C234,epmj)
|
|
& +two*m1*Dv(N+dd3333,epmj))
|
|
Dv(N+dd000011,ep)=Dv(N+dd000011,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd00111,epmj)-f2*Dv(N+dd00112,epmj)-f3*Dv(N+
|
|
& dd00113,epmj)+Cv(cc00+C234,epmj)+two*Cv(cc001+
|
|
& C234,epmj)+Cv(cc0011+C234,epmj)+two*Cv(cc0012+
|
|
& C234,epmj)+two*Cv(cc002+C234,epmj)+Cv(cc0022+
|
|
& C234,epmj)
|
|
& +two*m1*Dv(N+dd0011,epmj))
|
|
Dv(N+dd000012,ep)=Dv(N+dd000012,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd00112,epmj)-f2*Dv(N+dd00122,epmj)-f3*Dv(N+
|
|
& dd00123,epmj)-Cv(cc001+C234,epmj)-Cv(cc0011+C234,
|
|
& epmj)-Cv(cc0012+C234,epmj)
|
|
& +two*m1*Dv(N+dd0012,epmj))
|
|
Dv(N+dd000013,ep)=Dv(N+dd000013,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd00113,epmj)-f2*Dv(N+dd00123,epmj)-f3*Dv(N+
|
|
& dd00133,epmj)-Cv(cc0012+C234,epmj)-Cv(cc002+C234,
|
|
& epmj)-Cv(cc0022+C234,epmj)
|
|
& +two*m1*Dv(N+dd0013,epmj))
|
|
Dv(N+dd000022,ep)=Dv(N+dd000022,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd00122,epmj)-f2*Dv(N+dd00222,epmj)-f3*Dv(N+
|
|
& dd00223,epmj)+Cv(cc0011+C234,epmj)
|
|
& +two*m1*Dv(N+dd0022,epmj))
|
|
Dv(N+dd000023,ep)=Dv(N+dd000023,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd00123,epmj)-f2*Dv(N+dd00223,epmj)-f3*Dv(N+
|
|
& dd00233,epmj)+Cv(cc0012+C234,epmj)
|
|
& +two*m1*Dv(N+dd0023,epmj))
|
|
Dv(N+dd000033,ep)=Dv(N+dd000033,ep)+idp1(j)*half*(-f1*Dv(
|
|
& N+dd00133,epmj)-f2*Dv(N+dd00233,epmj)-f3*Dv(N+
|
|
& dd00333,epmj)+Cv(cc0022+C234,epmj)
|
|
& +two*m1*Dv(N+dd0033,epmj))
|
|
|
|
enddo
|
|
60 continue
|
|
enddo
|
|
|
|
C Dv(ppppp)
|
|
in(1,:) = f1*Dv(N+dd11111,:)-10.D0*Dv(N+dd001111,:)+
|
|
& Cv(cc0+C234,:)+5.D0*Cv(cc1+C234,:)+10.D0*Cv(cc11+
|
|
& C234,:)+10.D0*Cv(cc111+C234,:)+5.D0*Cv(cc1111+C234,:)
|
|
& +Cv(cc11111+C234,:)+5.D0*Cv(cc11112+C234,:)+20.D0*
|
|
& Cv(cc1112+C234,:)+10.D0*Cv(cc11122+C234,:)+30.D0*Cv(
|
|
& cc112+C234,:)+30.D0*Cv(cc1122+C234,:)+10.D0*Cv(cc11222
|
|
& +C234,:)+20.D0*Cv(cc12+C234,:)+30.D0*Cv(cc122+C234,
|
|
& :)+20.D0*Cv(cc1222+C234,:)+5.D0*Cv(cc12222+C234,:)+
|
|
& 5.D0*Cv(cc2+C234,:)+10.D0*Cv(cc22+C234,:)+10.D0*Cv(
|
|
& cc222+C234,:)+5.D0*Cv(cc2222+C234,:)+Cv(cc22222+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd11111,:)+Cv(cc0+C234,:)+5.D0*Cv(
|
|
& cc1+C234,:)+10.D0*Cv(cc11+C234,:)+10.D0*Cv(cc111+
|
|
& C234,:)+5.D0*Cv(cc1111+C234,:)+Cv(cc11111+C124,:)+
|
|
& Cv(cc11111+C234,:)+5.D0*Cv(cc11112+C234,:)+20.D0*Cv(
|
|
& cc1112+C234,:)+10.D0*Cv(cc11122+C234,:)+30.D0*Cv(cc112
|
|
& +C234,:)+30.D0*Cv(cc1122+C234,:)+10.D0*Cv(cc11222+
|
|
& C234,:)+20.D0*Cv(cc12+C234,:)+30.D0*Cv(cc122+C234,:)
|
|
& +20.D0*Cv(cc1222+C234,:)+5.D0*Cv(cc12222+C234,:)+5.D0
|
|
& *Cv(cc2+C234,:)+10.D0*Cv(cc22+C234,:)+10.D0*Cv(cc222
|
|
& +C234,:)+5.D0*Cv(cc2222+C234,:)+Cv(cc22222+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd11111,:)+Cv(cc0+C234,:)+5.D0*Cv(
|
|
& cc1+C234,:)+10.D0*Cv(cc11+C234,:)+10.D0*Cv(cc111+
|
|
& C234,:)+5.D0*Cv(cc1111+C234,:)+Cv(cc11111+C123,:)+
|
|
& Cv(cc11111+C234,:)+5.D0*Cv(cc11112+C234,:)+20.D0*Cv(
|
|
& cc1112+C234,:)+10.D0*Cv(cc11122+C234,:)+30.D0*Cv(cc112
|
|
& +C234,:)+30.D0*Cv(cc1122+C234,:)+10.D0*Cv(cc11222+
|
|
& C234,:)+20.D0*Cv(cc12+C234,:)+30.D0*Cv(cc122+C234,:)
|
|
& +20.D0*Cv(cc1222+C234,:)+5.D0*Cv(cc12222+C234,:)+5.D0
|
|
& *Cv(cc2+C234,:)+10.D0*Cv(cc22+C234,:)+10.D0*Cv(cc222
|
|
& +C234,:)+5.D0*Cv(cc2222+C234,:)+Cv(cc22222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd111111,:)=in(1,:)
|
|
Dv(N+dd111112,:)=in(2,:)
|
|
Dv(N+dd111113,:)=in(3,:)
|
|
|
|
C Dv(ppppk)
|
|
in(1,:) = f1*Dv(N+dd11112,:)-8._dp*Dv(N+dd001112,:)-Cv(
|
|
& cc1+C234,:)-four*Cv(cc11+C234,:)-six*Cv(cc111+C234,
|
|
& :)-four*Cv(cc1111+C234,:)-Cv(cc11111+C234,:)-four*
|
|
& Cv(cc11112+C234,:)-12._dp*Cv(cc1112+C234,:)-six*Cv(
|
|
& cc11122+C234,:)-12._dp*Cv(cc112+C234,:)-12._dp*Cv(cc1122
|
|
& +C234,:)-four*Cv(cc11222+C234,:)-four*Cv(cc12+C234,
|
|
& :)-six*Cv(cc122+C234,:)-four*Cv(cc1222+C234,:)-Cv(
|
|
& cc12222+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd11112,:)-two*Dv(N+dd001111,:)-Cv(
|
|
& cc1+C234,:)-four*Cv(cc11+C234,:)-six*Cv(cc111+C234,
|
|
& :)-four*Cv(cc1111+C234,:)-Cv(cc11111+C234,:)-four*
|
|
& Cv(cc11112+C234,:)-12._dp*Cv(cc1112+C234,:)-six*Cv(
|
|
& cc11122+C234,:)-12._dp*Cv(cc112+C234,:)-12._dp*Cv(cc1122
|
|
& +C234,:)-four*Cv(cc11222+C234,:)-four*Cv(cc12+C234,
|
|
& :)-six*Cv(cc122+C234,:)-four*Cv(cc1222+C234,:)-Cv(
|
|
& cc12222+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd11112,:)-Cv(cc1+C234,:)-four*Cv(
|
|
& cc11+C234,:)-six*Cv(cc111+C234,:)-four*Cv(cc1111+
|
|
& C234,:)-Cv(cc11111+C234,:)+Cv(cc11112+C123,:)-four*
|
|
& Cv(cc11112+C234,:)-12._dp*Cv(cc1112+C234,:)-six*Cv(
|
|
& cc11122+C234,:)-12._dp*Cv(cc112+C234,:)-12._dp*Cv(cc1122
|
|
& +C234,:)-four*Cv(cc11222+C234,:)-four*Cv(cc12+C234,
|
|
& :)-six*Cv(cc122+C234,:)-four*Cv(cc1222+C234,:)-Cv(
|
|
& cc12222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd111112,:)=in(1,:)
|
|
Dv(N+dd111122,:)=in(2,:)
|
|
Dv(N+dd111123,:)=in(3,:)
|
|
|
|
C Dv(pppkl)
|
|
in(1,:) = f1*Dv(N+dd11123,:)-six*Dv(N+dd001123,:)+Cv(
|
|
& cc11112+C234,:)+three*Cv(cc1112+C234,:)+three*Cv(cc11122
|
|
& +C234,:)+three*Cv(cc112+C234,:)+six*Cv(cc1122+C234,
|
|
& :)+three*Cv(cc11222+C234,:)+Cv(cc12+C234,:)+three*Cv(
|
|
& cc122+C234,:)+three*Cv(cc1222+C234,:)+Cv(cc12222+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd11123,:)-two*Dv(N+dd001113,:)+Cv(
|
|
& cc11112+C234,:)+three*Cv(cc1112+C234,:)+three*Cv(cc11122
|
|
& +C234,:)+three*Cv(cc112+C234,:)+six*Cv(cc1122+C234,
|
|
& :)+three*Cv(cc11222+C234,:)+Cv(cc12+C234,:)+three*Cv(
|
|
& cc122+C234,:)+three*Cv(cc1222+C234,:)+Cv(cc12222+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd11123,:)-two*Dv(N+dd001112,:)+Cv(
|
|
& cc11112+C234,:)+three*Cv(cc1112+C234,:)+three*Cv(cc11122
|
|
& +C234,:)+three*Cv(cc112+C234,:)+six*Cv(cc1122+C234,
|
|
& :)+three*Cv(cc11222+C234,:)+Cv(cc12+C234,:)+three*Cv(
|
|
& cc122+C234,:)+three*Cv(cc1222+C234,:)+Cv(cc12222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd111123,:)=in(1,:)
|
|
Dv(N+dd111223,:)=in(2,:)
|
|
Dv(N+dd111233,:)=in(3,:)
|
|
|
|
C Dv(pppll)
|
|
in(1,:) = f1*Dv(N+dd11133,:)-six*Dv(N+dd001133,:)+Cv(
|
|
& cc11122+C234,:)+three*Cv(cc1122+C234,:)+three*Cv(cc11222
|
|
& +C234,:)+three*Cv(cc122+C234,:)+six*Cv(cc1222+C234,
|
|
& :)+three*Cv(cc12222+C234,:)+Cv(cc22+C234,:)+three*Cv(
|
|
& cc222+C234,:)+three*Cv(cc2222+C234,:)+Cv(cc22222+C234
|
|
& ,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd11133,:)+Cv(cc11122+C124,:)+Cv(
|
|
& cc11122+C234,:)+three*Cv(cc1122+C234,:)+three*Cv(cc11222
|
|
& +C234,:)+three*Cv(cc122+C234,:)+six*Cv(cc1222+C234,
|
|
& :)+three*Cv(cc12222+C234,:)+Cv(cc22+C234,:)+three*Cv(
|
|
& cc222+C234,:)+three*Cv(cc2222+C234,:)+Cv(cc22222+C234
|
|
& ,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd11133,:)-four*Dv(N+dd001113,:)+Cv(
|
|
& cc11122+C234,:)+three*Cv(cc1122+C234,:)+three*Cv(cc11222
|
|
& +C234,:)+three*Cv(cc122+C234,:)+six*Cv(cc1222+C234,
|
|
& :)+three*Cv(cc12222+C234,:)+Cv(cc22+C234,:)+three*Cv(
|
|
& cc222+C234,:)+three*Cv(cc2222+C234,:)+Cv(cc22222+C234
|
|
& ,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd111133,:)=in(1,:)
|
|
Dv(N+dd111233,:)=in(2,:)
|
|
Dv(N+dd111333,:)=in(3,:)
|
|
|
|
C Dv(kkkpp)
|
|
in(1,:) = f1*Dv(N+dd11222,:)-four*Dv(N+dd001222,:)-Cv(
|
|
& cc111+C234,:)-two*Cv(cc1111+C234,:)-Cv(cc11111+C234
|
|
& ,:)-two*Cv(cc11112+C234,:)-two*Cv(cc1112+C234,:)-
|
|
& Cv(cc11122+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd11222,:)-six*Dv(N+dd001122,:)-Cv(
|
|
& cc111+C234,:)-two*Cv(cc1111+C234,:)-Cv(cc11111+C234
|
|
& ,:)-two*Cv(cc11112+C234,:)-two*Cv(cc1112+C234,:)-
|
|
& Cv(cc11122+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd11222,:)-Cv(cc111+C234,:)-two*Cv(
|
|
& cc1111+C234,:)-Cv(cc11111+C234,:)-two*Cv(cc11112+
|
|
& C234,:)-two*Cv(cc1112+C234,:)-Cv(cc11122+C234,:)+
|
|
& Cv(cc11222+C123,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd111222,:)=in(1,:)
|
|
Dv(N+dd112222,:)=in(2,:)
|
|
Dv(N+dd112223,:)=in(3,:)
|
|
|
|
C Dv(lllpp)
|
|
in(1,:) = f1*Dv(N+dd11333,:)-four*Dv(N+dd001333,:)-Cv(
|
|
& cc11222+C234,:)-two*Cv(cc1222+C234,:)-two*Cv(cc12222
|
|
& +C234,:)-Cv(cc222+C234,:)-two*Cv(cc2222+C234,:)-
|
|
& Cv(cc22222+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd11333,:)+Cv(cc11222+C124,:)-Cv(
|
|
& cc11222+C234,:)-two*Cv(cc1222+C234,:)-two*Cv(cc12222
|
|
& +C234,:)-Cv(cc222+C234,:)-two*Cv(cc2222+C234,:)-
|
|
& Cv(cc22222+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd11333,:)-six*Dv(N+dd001133,:)-Cv(
|
|
& cc11222+C234,:)-two*Cv(cc1222+C234,:)-two*Cv(cc12222
|
|
& +C234,:)-Cv(cc222+C234,:)-two*Cv(cc2222+C234,:)-
|
|
& Cv(cc22222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd111333,:)=in(1,:)
|
|
Dv(N+dd112333,:)=in(2,:)
|
|
Dv(N+dd113333,:)=in(3,:)
|
|
|
|
C Dv(kkllp)
|
|
in(1,:) = f1*Dv(N+dd12233,:)-two*Dv(N+dd002233,:)+Cv(
|
|
& cc11122+C234,:)+Cv(cc1122+C234,:)+Cv(cc11222+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd12233,:)-four*Dv(N+dd001233,:)+Cv(
|
|
& cc11122+C234,:)+Cv(cc1122+C234,:)+Cv(cc11222+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd12233,:)-four*Dv(N+dd001223,:)+Cv(
|
|
& cc11122+C234,:)+Cv(cc1122+C234,:)+Cv(cc11222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd112233,:)=in(1,:)
|
|
Dv(N+dd122233,:)=in(2,:)
|
|
Dv(N+dd122333,:)=in(3,:)
|
|
|
|
C Dv(kkkkk)
|
|
in(1,:) = f1*Dv(N+dd22222,:)+Cv(cc11111+C134,:)-Cv(
|
|
& cc11111+C234,:)
|
|
|
|
in(2,:) = f2*Dv(N+dd22222,:)-10.D0*Dv(N+dd002222,:)-
|
|
& Cv(cc11111+C234,:)
|
|
|
|
in(3,:) = f3*Dv(N+dd22222,:)-Cv(cc11111+C234,:)+Cv(
|
|
& cc22222+C123,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd122222,:)=in(1,:)
|
|
Dv(N+dd222222,:)=in(2,:)
|
|
Dv(N+dd222223,:)=in(3,:)
|
|
|
|
C Dv(kkkkl)
|
|
in(1,:) = f1*Dv(N+dd22223,:)+Cv(cc11112+C134,:)-Cv(
|
|
& cc11112+C234,:)
|
|
in(2,:) = f2*Dv(N+dd22223,:)-8._dp*Dv(N+dd002223,:)-Cv(
|
|
& cc11112+C234,:)
|
|
in(3,:) = f3*Dv(N+dd22223,:)-two*Dv(N+dd002222,:)-Cv(
|
|
& cc11112+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd122223,:)=in(1,:)
|
|
Dv(N+dd222223,:)=in(2,:)
|
|
Dv(N+dd222233,:)=in(3,:)
|
|
|
|
C Dv(kkkll)
|
|
in(1,:) = f1*Dv(N+dd22233,:)+Cv(cc11122+C134,:)-Cv(
|
|
& cc11122+C234,:)
|
|
in(2,:) = f2*Dv(N+dd22233,:)-six*Dv(N+dd002233,:)-Cv(
|
|
& cc11122+C234,:)
|
|
in(3,:) = f3*Dv(N+dd22233,:)-four*Dv(N+dd002223,:)-Cv(
|
|
& cc11122+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd122233,:)=in(1,:)
|
|
Dv(N+dd222233,:)=in(2,:)
|
|
Dv(N+dd222333,:)=in(3,:)
|
|
|
|
C Dv(llllk)
|
|
in(1,:) = f1*Dv(N+dd23333,:)+Cv(cc12222+C134,:)-Cv(
|
|
& cc12222+C234,:)
|
|
in(2,:) = f2*Dv(N+dd23333,:)-two*Dv(N+dd003333,:)-Cv(
|
|
& cc12222+C234,:)
|
|
in(3,:) = f3*Dv(N+dd23333,:)-8._dp*Dv(N+dd002333,:)-Cv(
|
|
& cc12222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd123333,:)=in(1,:)
|
|
Dv(N+dd223333,:)=in(2,:)
|
|
Dv(N+dd233333,:)=in(3,:)
|
|
|
|
C Dv(lllll)
|
|
in(1,:) = f1*Dv(N+dd33333,:)+Cv(cc22222+C134,:)-Cv(
|
|
& cc22222+C234,:)
|
|
in(2,:) = f2*Dv(N+dd33333,:)+Cv(cc22222+C124,:)-Cv(
|
|
& cc22222+C234,:)
|
|
in(3,:) = f3*Dv(N+dd33333,:)-10.D0*Dv(N+dd003333,:)-
|
|
& Cv(cc22222+C234,:)
|
|
call pvBackSubst(G, 3, perm, in)
|
|
Dv(N+dd133333,:)=in(1,:)
|
|
Dv(N+dd233333,:)=in(2,:)
|
|
Dv(N+dd333333,:)=in(3,:)
|
|
|
|
C------end of six index tensors
|
|
if (maxdindex .eq. 6) return
|
|
|
|
C----seven index
|
|
do ep=-2,0
|
|
do j=dd0000001,dd0033333
|
|
Dv(N+j,ep) = czip
|
|
enddo
|
|
if (ep .eq. -2) goto 70
|
|
do j=0,ep+2
|
|
epmj=ep-j
|
|
|
|
Dv(N+dd0000001,ep)=Dv(N+dd0000001,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd000011,epmj)
|
|
& + f2*Dv(N+dd000012,epmj)
|
|
& + f3*Dv(N+dd000013,epmj)
|
|
& - 2*Dv(N+dd00001,epmj)*m1
|
|
& + Cv(cc00001+C234,epmj)
|
|
& + Cv(cc00002+C234,epmj)
|
|
& + Cv(cc0000+C234,epmj))
|
|
|
|
Dv(N+dd0000002,ep)=Dv(N+dd0000002,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd000012,epmj)
|
|
& + f2*Dv(N+dd000022,epmj)
|
|
& + f3*Dv(N+dd000023,epmj)
|
|
& - 2*Dv(N+dd00002,epmj)*m1
|
|
& - Cv(cc00001+C234,epmj))
|
|
|
|
Dv(N+dd0000003,ep)=Dv(N+dd0000003,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd000013,epmj)
|
|
& + f2*Dv(N+dd000023,epmj)
|
|
& + f3*Dv(N+dd000033,epmj)
|
|
& - 2*Dv(N+dd00003,epmj)*m1
|
|
& - Cv(cc00002+C234,epmj))
|
|
|
|
Dv(N+dd0000111,ep)=Dv(N+dd0000111,ep)-half*idp2(j)*(
|
|
& + Cv(cc00+C234,epmj)
|
|
& + 3*Cv(cc001+C234,epmj)
|
|
& + 3*Cv(cc002+C234,epmj)
|
|
& + f1*Dv(N+dd001111,epmj)
|
|
& + f2*Dv(N+dd001112,epmj)
|
|
& + f3*Dv(N+dd001113,epmj)
|
|
& - 2*Dv(N+dd00111,epmj)*m1
|
|
& + Cv(cc00111+C234,epmj)
|
|
& + 3*Cv(cc00112+C234,epmj)
|
|
& + 3*Cv(cc00122+C234,epmj)
|
|
& + Cv(cc00222+C234,epmj)
|
|
& + 3*Cv(cc0011+C234,epmj)
|
|
& + 3*Cv(cc0022+C234,epmj)
|
|
& + 6*Cv(cc0012+C234,epmj))
|
|
|
|
Dv(N+dd0000112,ep)=Dv(N+dd0000112,ep)-half*idp2(j)*(
|
|
& - Cv(cc001+C234,epmj)
|
|
& + f1*Dv(N+dd001112,epmj)
|
|
& + f2*Dv(N+dd001122,epmj)
|
|
& + f3*Dv(N+dd001123,epmj)
|
|
& - 2*Dv(N+dd00112,epmj)*m1
|
|
& - Cv(cc00111+C234,epmj)
|
|
& - 2*Cv(cc00112+C234,epmj)
|
|
& - Cv(cc00122+C234,epmj)
|
|
& - 2*Cv(cc0011+C234,epmj)
|
|
& - 2*Cv(cc0012+C234,epmj))
|
|
|
|
|
|
Dv(N+dd0000113,ep)=Dv(N+dd0000113,ep)-half*idp2(j)*(
|
|
& - Cv(cc002+C234,epmj)
|
|
& + f1*Dv(N+dd001113,epmj)
|
|
& + f2*Dv(N+dd001123,epmj)
|
|
& + f3*Dv(N+dd001133,epmj)
|
|
& - 2*Dv(N+dd00113,epmj)*m1
|
|
& - Cv(cc00112+C234,epmj)
|
|
& - 2*Cv(cc00122+C234,epmj)
|
|
& - Cv(cc00222+C234,epmj)
|
|
& - 2*Cv(cc0022+C234,epmj)
|
|
& - 2*Cv(cc0012+C234,epmj))
|
|
|
|
Dv(N+dd0000122,ep)=Dv(N+dd0000122,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001122,epmj)
|
|
& + f2*Dv(N+dd001222,epmj)
|
|
& + f3*Dv(N+dd001223,epmj)
|
|
& - 2*Dv(N+dd00122,epmj)*m1
|
|
& + Cv(cc00111+C234,epmj)
|
|
& + Cv(cc00112+C234,epmj)
|
|
& + Cv(cc0011+C234,epmj))
|
|
|
|
Dv(N+dd0000123,ep)=Dv(N+dd0000123,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001123,epmj)
|
|
& + f2*Dv(N+dd001223,epmj)
|
|
& + f3*Dv(N+dd001233,epmj)
|
|
& - 2*Dv(N+dd00123,epmj)*m1
|
|
& + Cv(cc00112+C234,epmj)
|
|
& + Cv(cc00122+C234,epmj)
|
|
& + Cv(cc0012+C234,epmj))
|
|
|
|
Dv(N+dd0000133,ep)=Dv(N+dd0000133,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001133,epmj)
|
|
& + f2*Dv(N+dd001233,epmj)
|
|
& + f3*Dv(N+dd001333,epmj)
|
|
& - 2*Dv(N+dd00133,epmj)*m1
|
|
& + Cv(cc00122+C234,epmj)
|
|
& + Cv(cc00222+C234,epmj)
|
|
& + Cv(cc0022+C234,epmj))
|
|
|
|
Dv(N+dd0000222,ep)=Dv(N+dd0000222,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001222,epmj)
|
|
& + f2*Dv(N+dd002222,epmj)
|
|
& + f3*Dv(N+dd002223,epmj)
|
|
& - 2*Dv(N+dd00222,epmj)*m1
|
|
& - Cv(cc00111+C234,epmj))
|
|
|
|
Dv(N+dd0000223,ep)=Dv(N+dd0000223,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001223,epmj)
|
|
& + f2*Dv(N+dd002223,epmj)
|
|
& + f3*Dv(N+dd002233,epmj)
|
|
& - 2*Dv(N+dd00223,epmj)*m1
|
|
& - Cv(cc00112+C234,epmj))
|
|
|
|
Dv(N+dd0000233,ep)=Dv(N+dd0000233,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001233,epmj)
|
|
& + f2*Dv(N+dd002233,epmj)
|
|
& + f3*Dv(N+dd002333,epmj)
|
|
& - 2*Dv(N+dd00233,epmj)*m1
|
|
& - Cv(cc00122+C234,epmj))
|
|
|
|
Dv(N+dd0000333,ep)=Dv(N+dd0000333,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd001333,epmj)
|
|
& + f2*Dv(N+dd002333,epmj)
|
|
& + f3*Dv(N+dd003333,epmj)
|
|
& - 2*Dv(N+dd00333,epmj)*m1
|
|
& - Cv(cc00222+C234,epmj))
|
|
|
|
Dv(N+dd0011111,ep)=Dv(N+dd0011111,ep)-half*idp2(j)*(
|
|
& + Cv(cc0+C234,epmj)
|
|
& + 5*Cv(cc1+C234,epmj)
|
|
& + 5*Cv(cc2+C234,epmj)
|
|
& + 10*Cv(cc11+C234,epmj)
|
|
& + 20*Cv(cc12+C234,epmj)
|
|
& + 10*Cv(cc22+C234,epmj)
|
|
& + 10*Cv(cc111+C234,epmj)
|
|
& + 30*Cv(cc112+C234,epmj)
|
|
& + 30*Cv(cc122+C234,epmj)
|
|
& + 10*Cv(cc222+C234,epmj)
|
|
& + 5*Cv(cc1111+C234,epmj)
|
|
& + 20*Cv(cc1112+C234,epmj)
|
|
& + 30*Cv(cc1122+C234,epmj)
|
|
& + 20*Cv(cc1222+C234,epmj)
|
|
& + 5*Cv(cc2222+C234,epmj)
|
|
& + f1*Dv(N+dd111111,epmj)
|
|
& + f2*Dv(N+dd111112,epmj)
|
|
& + f3*Dv(N+dd111113,epmj)
|
|
& - 2*Dv(N+dd11111,epmj)*m1
|
|
& + Cv(cc11111+C234,epmj)
|
|
& + 5*Cv(cc11112+C234,epmj)
|
|
& + 10*Cv(cc11122+C234,epmj)
|
|
& + 10*Cv(cc11222+C234,epmj)
|
|
& + 5*Cv(cc12222+C234,epmj)
|
|
& + Cv(cc22222+C234,epmj))
|
|
|
|
Dv(N+dd0011112,ep)=Dv(N+dd0011112,ep)-half*idp2(j)*(
|
|
& - Cv(cc1+C234,epmj)
|
|
& - 4*Cv(cc11+C234,epmj)
|
|
& - 4*Cv(cc12+C234,epmj)
|
|
& - 6*Cv(cc111+C234,epmj)
|
|
& - 12*Cv(cc112+C234,epmj)
|
|
& - 6*Cv(cc122+C234,epmj)
|
|
& - 4*Cv(cc1111+C234,epmj)
|
|
& - 12*Cv(cc1112+C234,epmj)
|
|
& - 12*Cv(cc1122+C234,epmj)
|
|
& - 4*Cv(cc1222+C234,epmj)
|
|
& + f1*Dv(N+dd111112,epmj)
|
|
& + f2*Dv(N+dd111122,epmj)
|
|
& + f3*Dv(N+dd111123,epmj)
|
|
& - 2*Dv(N+dd11112,epmj)*m1
|
|
& - Cv(cc11111+C234,epmj)
|
|
& - 4*Cv(cc11112+C234,epmj)
|
|
& - 6*Cv(cc11122+C234,epmj)
|
|
& - 4*Cv(cc11222+C234,epmj)
|
|
& - Cv(cc12222+C234,epmj))
|
|
|
|
Dv(N+dd0011113,ep)=Dv(N+dd0011113,ep)-half*idp2(j)*(
|
|
& - Cv(cc2+C234,epmj)
|
|
& - 4*Cv(cc12+C234,epmj)
|
|
& - 4*Cv(cc22+C234,epmj)
|
|
& - 6*Cv(cc112+C234,epmj)
|
|
& - 12*Cv(cc122+C234,epmj)
|
|
& - 6*Cv(cc222+C234,epmj)
|
|
& - 4*Cv(cc1112+C234,epmj)
|
|
& - 12*Cv(cc1122+C234,epmj)
|
|
& - 12*Cv(cc1222+C234,epmj)
|
|
& - 4*Cv(cc2222+C234,epmj)
|
|
& + f1*Dv(N+dd111113,epmj)
|
|
& + f2*Dv(N+dd111123,epmj)
|
|
& + f3*Dv(N+dd111133,epmj)
|
|
& - 2*Dv(N+dd11113,epmj)*m1
|
|
& - Cv(cc11112+C234,epmj)
|
|
& - 4*Cv(cc11122+C234,epmj)
|
|
& - 6*Cv(cc11222+C234,epmj)
|
|
& - 4*Cv(cc12222+C234,epmj)
|
|
& - Cv(cc22222+C234,epmj))
|
|
|
|
Dv(N+dd0011122,ep)=Dv(N+dd0011122,ep)-half*idp2(j)*(
|
|
& + Cv(cc11+C234,epmj)
|
|
& + 3*Cv(cc111+C234,epmj)
|
|
& + 3*Cv(cc112+C234,epmj)
|
|
& + 3*Cv(cc1111+C234,epmj)
|
|
& + 6*Cv(cc1112+C234,epmj)
|
|
& + 3*Cv(cc1122+C234,epmj)
|
|
& + f1*Dv(N+dd111122,epmj)
|
|
& + f2*Dv(N+dd111222,epmj)
|
|
& + f3*Dv(N+dd111223,epmj)
|
|
& - 2*Dv(N+dd11122,epmj)*m1
|
|
& + Cv(cc11111+C234,epmj)
|
|
& + 3*Cv(cc11112+C234,epmj)
|
|
& + 3*Cv(cc11122+C234,epmj)
|
|
& + Cv(cc11222+C234,epmj))
|
|
|
|
Dv(N+dd0011123,ep)=Dv(N+dd0011123,ep)-half*idp2(j)*(
|
|
& + Cv(cc12+C234,epmj)
|
|
& + 3*Cv(cc112+C234,epmj)
|
|
& + 3*Cv(cc122+C234,epmj)
|
|
& + 3*Cv(cc1112+C234,epmj)
|
|
& + 6*Cv(cc1122+C234,epmj)
|
|
& + 3*Cv(cc1222+C234,epmj)
|
|
& + f1*Dv(N+dd111123,epmj)
|
|
& + f2*Dv(N+dd111223,epmj)
|
|
& + f3*Dv(N+dd111233,epmj)
|
|
& - 2*Dv(N+dd11123,epmj)*m1
|
|
& + Cv(cc11112+C234,epmj)
|
|
& + 3*Cv(cc11122+C234,epmj)
|
|
& + 3*Cv(cc11222+C234,epmj)
|
|
& + Cv(cc12222+C234,epmj))
|
|
|
|
Dv(N+dd0011133,ep)=Dv(N+dd0011133,ep)-half*idp2(j)*(
|
|
& + Cv(cc22+C234,epmj)
|
|
& + 3*Cv(cc122+C234,epmj)
|
|
& + 3*Cv(cc222+C234,epmj)
|
|
& + 3*Cv(cc1122+C234,epmj)
|
|
& + 6*Cv(cc1222+C234,epmj)
|
|
& + 3*Cv(cc2222+C234,epmj)
|
|
& + f1*Dv(N+dd111133,epmj)
|
|
& + f2*Dv(N+dd111233,epmj)
|
|
& + f3*Dv(N+dd111333,epmj)
|
|
& - 2*Dv(N+dd11133,epmj)*m1
|
|
& + Cv(cc11122+C234,epmj)
|
|
& + 3*Cv(cc11222+C234,epmj)
|
|
& + 3*Cv(cc12222+C234,epmj)
|
|
& + Cv(cc22222+C234,epmj))
|
|
|
|
Dv(N+dd0011222,ep)=Dv(N+dd0011222,ep)-half*idp2(j)*(
|
|
& - Cv(cc111+C234,epmj)
|
|
& - 2*Cv(cc1111+C234,epmj)
|
|
& - 2*Cv(cc1112+C234,epmj)
|
|
& + f1*Dv(N+dd111222,epmj)
|
|
& + f2*Dv(N+dd112222,epmj)
|
|
& + f3*Dv(N+dd112223,epmj)
|
|
& - 2*Dv(N+dd11222,epmj)*m1
|
|
& - Cv(cc11111+C234,epmj)
|
|
& - 2*Cv(cc11112+C234,epmj)
|
|
& - Cv(cc11122+C234,epmj))
|
|
|
|
Dv(N+dd0011223,ep)=Dv(N+dd0011223,ep)-half*idp2(j)*(
|
|
& - Cv(cc112+C234,epmj)
|
|
& - 2*Cv(cc1112+C234,epmj)
|
|
& - 2*Cv(cc1122+C234,epmj)
|
|
& + f1*Dv(N+dd111223,epmj)
|
|
& + f2*Dv(N+dd112223,epmj)
|
|
& + f3*Dv(N+dd112233,epmj)
|
|
& - 2*Dv(N+dd11223,epmj)*m1
|
|
& - Cv(cc11112+C234,epmj)
|
|
& - 2*Cv(cc11122+C234,epmj)
|
|
& - Cv(cc11222+C234,epmj))
|
|
|
|
Dv(N+dd0011233,ep)=Dv(N+dd0011233,ep)-half*idp2(j)*(
|
|
& - Cv(cc122+C234,epmj)
|
|
& - 2*Cv(cc1122+C234,epmj)
|
|
& - 2*Cv(cc1222+C234,epmj)
|
|
& + f1*Dv(N+dd111233,epmj)
|
|
& + f2*Dv(N+dd112233,epmj)
|
|
& + f3*Dv(N+dd112333,epmj)
|
|
& - 2*Dv(N+dd11233,epmj)*m1
|
|
& - Cv(cc11122+C234,epmj)
|
|
& - 2*Cv(cc11222+C234,epmj)
|
|
& - Cv(cc12222+C234,epmj))
|
|
|
|
Dv(N+dd0011333,ep)=Dv(N+dd0011333,ep)-half*idp2(j)*(
|
|
& - Cv(cc222+C234,epmj)
|
|
& - 2*Cv(cc1222+C234,epmj)
|
|
& - 2*Cv(cc2222+C234,epmj)
|
|
& + f1*Dv(N+dd111333,epmj)
|
|
& + f2*Dv(N+dd112333,epmj)
|
|
& + f3*Dv(N+dd113333,epmj)
|
|
& - 2*Dv(N+dd11333,epmj)*m1
|
|
& - Cv(cc11222+C234,epmj)
|
|
& - 2*Cv(cc12222+C234,epmj)
|
|
& - Cv(cc22222+C234,epmj))
|
|
|
|
Dv(N+dd0012222,ep)=Dv(N+dd0012222,ep)-half*idp2(j)*(
|
|
& + Cv(cc1111+C234,epmj)
|
|
& + f1*Dv(N+dd112222,epmj)
|
|
& + f2*Dv(N+dd122222,epmj)
|
|
& + f3*Dv(N+dd122223,epmj)
|
|
& - 2*Dv(N+dd12222,epmj)*m1
|
|
& + Cv(cc11111+C234,epmj)
|
|
& + Cv(cc11112+C234,epmj))
|
|
|
|
Dv(N+dd0012223,ep)=Dv(N+dd0012223,ep)-half*idp2(j)*(
|
|
& + Cv(cc1112+C234,epmj)
|
|
& + f1*Dv(N+dd112223,epmj)
|
|
& + f2*Dv(N+dd122223,epmj)
|
|
& + f3*Dv(N+dd122233,epmj)
|
|
& - 2*Dv(N+dd12223,epmj)*m1
|
|
& + Cv(cc11112+C234,epmj)
|
|
& + Cv(cc11122+C234,epmj))
|
|
|
|
Dv(N+dd0012233,ep)=Dv(N+dd0012233,ep)-half*idp2(j)*(
|
|
& + Cv(cc1122+C234,epmj)
|
|
& + f1*Dv(N+dd112233,epmj)
|
|
& + f2*Dv(N+dd122233,epmj)
|
|
& + f3*Dv(N+dd122333,epmj)
|
|
& - 2*Dv(N+dd12233,epmj)*m1
|
|
& + Cv(cc11122+C234,epmj)
|
|
& + Cv(cc11222+C234,epmj))
|
|
|
|
Dv(N+dd0012333,ep)=Dv(N+dd0012333,ep)-half*idp2(j)*(
|
|
& + Cv(cc1222+C234,epmj)
|
|
& + f1*Dv(N+dd112333,epmj)
|
|
& + f2*Dv(N+dd122333,epmj)
|
|
& + f3*Dv(N+dd123333,epmj)
|
|
& - 2*Dv(N+dd12333,epmj)*m1
|
|
& + Cv(cc11222+C234,epmj)
|
|
& + Cv(cc12222+C234,epmj))
|
|
|
|
Dv(N+dd0013333,ep)=Dv(N+dd0013333,ep)-half*idp2(j)*(
|
|
& + Cv(cc2222+C234,epmj)
|
|
& + f1*Dv(N+dd113333,epmj)
|
|
& + f2*Dv(N+dd123333,epmj)
|
|
& + f3*Dv(N+dd133333,epmj)
|
|
& - 2*Dv(N+dd13333,epmj)*m1
|
|
& + Cv(cc12222+C234,epmj)
|
|
& + Cv(cc22222+C234,epmj))
|
|
|
|
Dv(N+dd0022222,ep)=Dv(N+dd0022222,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd122222,epmj)
|
|
& + f2*Dv(N+dd222222,epmj)
|
|
& + f3*Dv(N+dd222223,epmj)
|
|
& - 2*Dv(N+dd22222,epmj)*m1
|
|
& - Cv(cc11111+C234,epmj))
|
|
|
|
Dv(N+dd0022223,ep)=Dv(N+dd0022223,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd122223,epmj)
|
|
& + f2*Dv(N+dd222223,epmj)
|
|
& + f3*Dv(N+dd222233,epmj)
|
|
& - 2*Dv(N+dd22223,epmj)*m1
|
|
& - Cv(cc11112+C234,epmj))
|
|
|
|
Dv(N+dd0022233,ep)=Dv(N+dd0022233,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd122233,epmj)
|
|
& + f2*Dv(N+dd222233,epmj)
|
|
& + f3*Dv(N+dd222333,epmj)
|
|
& - 2*Dv(N+dd22233,epmj)*m1
|
|
& - Cv(cc11122+C234,epmj))
|
|
|
|
Dv(N+dd0022333,ep)=Dv(N+dd0022333,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd122333,epmj)
|
|
& + f2*Dv(N+dd222333,epmj)
|
|
& + f3*Dv(N+dd223333,epmj)
|
|
& - 2*Dv(N+dd22333,epmj)*m1
|
|
& - Cv(cc11222+C234,epmj))
|
|
|
|
Dv(N+dd0023333,ep)=Dv(N+dd0023333,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd123333,epmj)
|
|
& + f2*Dv(N+dd223333,epmj)
|
|
& + f3*Dv(N+dd233333,epmj)
|
|
& - 2*Dv(N+dd23333,epmj)*m1
|
|
& - Cv(cc12222+C234,epmj))
|
|
|
|
Dv(N+dd0033333,ep)=Dv(N+dd0033333,ep)-half*idp2(j)*(
|
|
& + f1*Dv(N+dd133333,epmj)
|
|
& + f2*Dv(N+dd233333,epmj)
|
|
& + f3*Dv(N+dd333333,epmj)
|
|
& - 2*Dv(N+dd33333,epmj)*m1
|
|
& - Cv(cc22222+C234,epmj))
|
|
enddo
|
|
70 continue
|
|
enddo
|
|
|
|
do j=1,Ndd
|
|
c write(66,*) 'D:zx',j,Dv(N+j,-2),Dv(N+j,-1),Dv(N+j,0)
|
|
enddo
|
|
include 'lib/TensorReduction/Include/pvD7.f'
|
|
|
|
c--- to check recursion identities
|
|
c call Dfill_alt(p1,p2,p3,p4,p1p2,p2p3,m1,m2,m3,m4,N)
|
|
|
|
end
|
|
|