bin/BCVEGPY/s_samp.F

0001 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0002 c...subroutines for gg (or q\bar{q})->bc+b+\bar{c}:  bc in s-wave    c

0003 c...xsection()------square of the amplitude in the c.m.s.            c

0004 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0005 c...       bc in color-singlet and color-octet states.               c

0006 c copyright (c) z.x zhang, chafik driouich, paula eerola and x.g. wu c

0007 c reference: comput.phys.commun. 159,192(2004); hep-ph/0309120;      c

0008 c reference: comput.phys.commun. 174,241(2006); hep-ph/0502155;      c

0009 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0010         subroutine xsection(sigscl,sigvct)
0011         implicit double precision (a-h,o-z)
0012         implicit integer (i-n)
0013
0014         double precision colfac(10),cfscl(10),cfvct(10)
0015         double complex fincol(10,16),colmat,bundamp
0016         common/upcom/ecm,pmbc,pmb,pmc,fbcc,pmomup(5,8),
0017      &  colmat(10,64),bundamp(4),pmomzero(5,8)
0018         common/colflow/amp2cf(10),smatval
0019
0020 c...for transform the subprocess information, i.e.,  whether using

0021 c...the subprocess q\bar{q}->bc+b+\bar{c} to generate events.

0022       common/qqbar/iqqbar,iqcode
0023
0024 c...transform the bound state information.

0025       common/counter/ibcstate,nev
0026         common/coloct/ioctet
0027
0028 c...initial value.

0029       smatval=0.0d0
0030         sigscl =0.0d0
0031         sigvct =0.0d0
0032
0033         do ii=1,10
0034           cfvct(ii) =0.0d0
0035           cfscl(ii) =0.0d0
0036           amp2cf(ii)=0.0d0
0037           colfac(ii)=0.0d0
0038         end do
0039
0040 c...color factors for the hadronic production of bc meson.

0041 c...it is used only for the subprocess: gg->bc+b+~c.

0042         if(iqqbar.eq.0) then
0043           if(ioctet.eq.0) then
0044             colfac(1) =4.0d0/27.0d0
0045             colfac(2) =4.0d0/27.0d0
0046           colfac(3) =-1.0d0/27.0d0
0047           colfac(4) =3.0d0/2.0d0
0048             colfac(5) =-1.0d0/3.0d0
0049           end if
0050           if(ioctet.eq.1) then
0051             colfac(1) = 32.0d0/81.0d0
0052             colfac(2) =-4.0d0/81.0d0
0053             colfac(3) = 4.0d0/9.0d0
0054             colfac(4) =-1.0d0/18.0d0
0055             colfac(5) =-1.0d0/9.0d0
0056             colfac(6) = 7.0d0/18.0d0
0057             colfac(7) = 1.0d0/162.0d0
0058             colfac(8) = 10.0d0/162.0d0
0059             colfac(9) = 1.0d0/2.0d0
0060             colfac(10)= 7.0d0/2.0d0
0061           end if
0062         end if
0063 c...change all the momenta into light-like.those light-like momenta

0064 c...will be used in inner scalar product and spinner product.

0065       do 411, i=1,8
0066          if (pmomup(5,i) .gt. 1.0d-16) then
0067            do k=1,4
0068             pmomzero(k,i)=pmomup(k,i)-pmomup(k,8)*pmomup(5,i)**2/
0069      &      (2.0d0*dotup(8,i))
0070            end do
0071            pmomzero(5,i)=0.0d0
0072          else
0073            do j=1,5
0074              pmomzero(j,i)=pmomup(j,i)
0075          end do
0076        end if
0077 411     continue
0078
0079 c...get the helicity matrix elements for the free quark part.

0080 c...note here for the condition ibcstate=1, the

0081 c...obtained result for sigscl and sigvct is the same

0082 c...(this is only used to save time, because now we only need

0083 c...the results for ibcstate=1).

0084         call freehelicity
0085
0086         if(ibcstate.eq.1) then
0087              ilow=1
0088              iup =1
0089         end if
0090         if(ibcstate.eq.2) then
0091              ilow=2
0092              iup =2
0093         end if
0094
0095 c...begin of big circle.

0096         do ibc=ilow,iup
0097          call bundhelicity(ibc)
0098 c...get the five subsets matrix elements of the process gg->bc+b+\bar{c}:

0099 c...i.e., summing the free quark part (gg->\bar{b}+c+b+\bar{c}) and

0100 c...the bound state part (\bar{c}+c->bc) together.

0101          do jj=1,8
0102           fincol(1,jj)=colmat(1,jj)*bundamp(1)+colmat(1,jj+8)*bundamp(2)
0103      &    +colmat(1,jj+32)*bundamp(3)+colmat(1,jj+40)*bundamp(4)
0104           fincol(2,jj)=colmat(2,jj)*bundamp(1)+colmat(2,jj+8)*bundamp(2)
0105      &    +colmat(2,jj+32)*bundamp(3)+colmat(2,jj+40)*bundamp(4)
0106           fincol(3,jj)=colmat(3,jj)*bundamp(1)+colmat(3,jj+8)*bundamp(2)
0107      &    +colmat(3,jj+32)*bundamp(3)+colmat(3,jj+40)*bundamp(4)
0108           if(iqqbar.eq.0) then
0109            fincol(4,jj)=colmat(4,jj)*bundamp(1)+colmat(4,jj+8)*bundamp(2)
0110      &    +colmat(4,jj+32)*bundamp(3)+colmat(4,jj+40)*bundamp(4)
0111            fincol(5,jj)=colmat(5,jj)*bundamp(1)+colmat(5,jj+8)*bundamp(2)
0112      &    +colmat(5,jj+32)*bundamp(3)+colmat(5,jj+40)*bundamp(4)
0113            if(ioctet.eq.1) then
0114           fincol(6,jj)=colmat(6,jj)*bundamp(1)+colmat(6,jj+8)*bundamp(2)
0115      &    +colmat(6,jj+32)*bundamp(3)+colmat(6,jj+40)*bundamp(4)
0116           fincol(7,jj)=colmat(7,jj)*bundamp(1)+colmat(7,jj+8)*bundamp(2)
0117      &    +colmat(7,jj+32)*bundamp(3)+colmat(7,jj+40)*bundamp(4)
0118           fincol(8,jj)=colmat(8,jj)*bundamp(1)+colmat(8,jj+8)*bundamp(2)
0119      &    +colmat(8,jj+32)*bundamp(3)+colmat(8,jj+40)*bundamp(4)
0120           fincol(9,jj)=colmat(9,jj)*bundamp(1)+colmat(9,jj+8)*bundamp(2)
0121      &    +colmat(9,jj+32)*bundamp(3)+colmat(9,jj+40)*bundamp(4)
0122             fincol(10,jj)=colmat(10,jj)*bundamp(1)+colmat(10,jj+8)
0123      &    *bundamp(2)+colmat(10,jj+32)*bundamp(3)+colmat(10,jj+40)*
0124      &      bundamp(4)
0125            end if
0126           end if
0127        end do
0128
0129          do jj=17,24
0130         fincol(1,jj-8)=colmat(1,jj)*bundamp(2)+colmat(1,jj+8)*bundamp(1)
0131      &    +colmat(1,jj+32)*bundamp(4)+colmat(1,jj+40)*bundamp(3)
0132         fincol(2,jj-8)=colmat(2,jj)*bundamp(2)+colmat(2,jj+8)*bundamp(1)
0133      &    +colmat(2,jj+32)*bundamp(4)+colmat(2,jj+40)*bundamp(3)
0134         fincol(3,jj-8)=colmat(3,jj)*bundamp(2)+colmat(3,jj+8)*bundamp(1)
0135      &    +colmat(3,jj+32)*bundamp(4)+colmat(3,jj+40)*bundamp(3)
0136 c2---------

0137           if(iqqbar.eq.0) then
0138         fincol(4,jj-8)=colmat(4,jj)*bundamp(2)+colmat(4,jj+8)*bundamp(1)
0139      &    +colmat(4,jj+32)*bundamp(4)+colmat(4,jj+40)*bundamp(3)
0140         fincol(5,jj-8)=colmat(5,jj)*bundamp(2)+colmat(5,jj+8)*bundamp(1)
0141      &    +colmat(5,jj+32)*bundamp(4)+colmat(5,jj+40)*bundamp(3)
0142 c---------

0143           if(ioctet.eq.1) then
0144         fincol(6,jj-8)=colmat(6,jj)*bundamp(2)+colmat(6,jj+8)*bundamp(1)
0145      &    +colmat(6,jj+32)*bundamp(4)+colmat(6,jj+40)*bundamp(3)
0146         fincol(7,jj-8)=colmat(7,jj)*bundamp(2)+colmat(7,jj+8)*bundamp(1)
0147      &    +colmat(7,jj+32)*bundamp(4)+colmat(7,jj+40)*bundamp(3)
0148         fincol(8,jj-8)=colmat(8,jj)*bundamp(2)+colmat(8,jj+8)*bundamp(1)
0149      &    +colmat(8,jj+32)*bundamp(4)+colmat(8,jj+40)*bundamp(3)
0150         fincol(9,jj-8)=colmat(9,jj)*bundamp(2)+colmat(9,jj+8)*bundamp(1)
0151      &    +colmat(9,jj+32)*bundamp(4)+colmat(9,jj+40)*bundamp(3)
0152           fincol(10,jj-8)=colmat(10,jj)*bundamp(2)+colmat(10,jj+8)*
0153      &    bundamp(1)+colmat(10,jj+32)*bundamp(4)+colmat(10,jj+40)*
0154      &      bundamp(3)
0155           end if
0156 c---------

0157           end if
0158 c2--------

0159        end do
0160
0161 c...to get the possibility of three color flows which are used in main

0162 c...program for the subprocess gg->bc+b+\bar{c}. these three color flow

0163 c...directions are not orthogonal but are corresponding to particular

0164 c...color flow, which can be equivalent derived from the color-flow

0165 c...decomposition in prd67,014026(2003) by f.maltoni etal.

0166          if (iqqbar.eq.0) then
0167 c---------

0168        if(ioctet.eq.0) then
0169           if (ibc.eq.1) then
0170          do jj=1,16
0171            cfscl(1)=cfscl(1)+1.0d0/36.0d0*dble(abs(8*fincol(1,jj)
0172      &  -fincol(3,jj)))**2
0173            cfscl(2)=cfscl(2)+1.0d0/36.0d0*dble(abs(8*fincol(2,jj)
0174      &  -fincol(4,jj)))**2
0175            cfscl(3)=cfscl(3)+1.0d0/4.0d0*dble(abs(fincol(5,jj))**2)
0176            end do
0177           end if
0178           if(ibc.eq.2) then
0179          do jj=1,16
0180            cfvct(1)=cfvct(1)+1.0d0/36.0d0*dble(abs(8*fincol(1,jj)
0181      &  -fincol(3,jj)))**2
0182            cfvct(2)=cfvct(2)+1.0d0/36.0d0*dble(abs(8*fincol(2,jj)
0183      &  -fincol(4,jj)))**2
0184            cfvct(3)=cfvct(3)+1.0d0/4.0d0*dble(abs(fincol(5,jj))**2)
0185            end do
0186           end if
0187          end if
0188 c----------

0189        if(ioctet.eq.1) then
0190           if (ibc.eq.1) then
0191          do jj=1,16
0192             cfscl(1)=cfscl(1)+1.0d0/18.0d0*dble(abs(fincol(1,jj))**2)
0193             cfscl(2)=cfscl(2)+1.0d0/18.0d0*dble(abs(fincol(2,jj))**2)
0194             cfscl(3)=cfscl(3)+1.0d0/2.0d0*dble(abs(fincol(3,jj))**2)
0195             cfscl(4)=cfscl(3)+1.0d0/2.0d0*dble(abs(fincol(4,jj))**2)
0196             cfscl(5)=cfscl(3)+1.0d0/2.0d0*dble(abs(fincol(5,jj))**2)
0197             cfscl(6)=cfscl(3)+1.0d0/2.0d0*dble(abs(fincol(6,jj))**2)
0198             cfscl(7)=cfscl(3)+1.0d0/18.0d0*dble(abs(fincol(7,jj))**2)
0199             cfscl(8)=cfscl(3)+1.0d0/18.0d0*dble(abs(fincol(8,jj))**2)
0200             cfscl(9)=cfscl(3)+1.0d0/18.0d0*dble(abs(fincol(9,jj))**2)
0201            cfscl(10)=cfscl(3)+1.0d0/18.0d0*dble(abs(fincol(10,jj))**2)
0202            end do
0203           end if
0204           if(ibc.eq.2) then
0205          do jj=1,16
0206             cfvct(1)=cfvct(1)+1.0d0/18.0d0*dble(abs(fincol(1,jj))**2)
0207             cfvct(2)=cfvct(2)+1.0d0/18.0d0*dble(abs(fincol(2,jj))**2)
0208             cfvct(3)=cfvct(3)+1.0d0/2.0d0*dble(abs(fincol(3,jj))**2)
0209             cfvct(4)=cfvct(3)+1.0d0/2.0d0*dble(abs(fincol(4,jj))**2)
0210             cfvct(5)=cfvct(3)+1.0d0/2.0d0*dble(abs(fincol(5,jj))**2)
0211             cfvct(6)=cfvct(3)+1.0d0/2.0d0*dble(abs(fincol(6,jj))**2)
0212             cfvct(7)=cfvct(3)+1.0d0/18.0d0*dble(abs(fincol(7,jj))**2)
0213             cfvct(8)=cfvct(3)+1.0d0/18.0d0*dble(abs(fincol(8,jj))**2)
0214             cfvct(9)=cfvct(3)+1.0d0/18.0d0*dble(abs(fincol(9,jj))**2)
0215            cfvct(10)=cfvct(3)+1.0d0/18.0d0*dble(abs(fincol(10,jj))**2)
0216            end do
0217           end if
0218          end if
0219 c----------

0220        end if
0221
0222 c...to get the possibility of two color flow which is used in main

0223 c...program for the subprocess q\bar{q}->bc+b+\bar{c}. the two color

0224 c...flow directions are orthogonal.

0225          if(iqqbar.eq.1) then
0226           if(ibc.eq.1) then
0227          do jj=1,16
0228             cfscl(1)=cfscl(1)+9.0d0*dble(abs(-fincol(1,jj)/12.0d0+
0229      &     2.0d0/3.0d0*fincol(2,jj)-1.0d0/6.0d0*fincol(3,jj)))**2
0230      &     +3.0d0*dreal((-fincol(1,jj)/12.0d0+2.0d0/3.0d0*fincol(2,jj)
0231      &     -1.0d0/6.0d0*fincol(3,jj))*dconjg(-fincol(1,jj)/36.0d0-
0232      &     2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))
0233             cfscl(2)=cfscl(2)+9.0d0*dble(abs(fincol(1,jj)/36.0d0-
0234      &     2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))**2
0235      &     +3.0d0*dreal((-fincol(1,jj)/12.0d0+2.0d0/3.0d0*fincol(2,jj)-
0236      &     1.0d0/6.0d0*fincol(3,jj))*dconjg(fincol(1,jj)/36.0d0-
0237      &     2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))
0238          end do
0239           end if
0240           if(ibc.eq.2) then
0241            do jj=1,16
0242             cfvct(1)=cfvct(1)+9.0d0*dble(abs(-fincol(1,jj)/12.0d0+
0243      &     2.0d0/3.0d0*fincol(2,jj)-1.0d0/6.0d0*fincol(3,jj)))**2
0244      &     +3.0d0*dreal((-fincol(1,jj)/12.0d0+2.0d0/3.0d0*fincol(2,jj)
0245      &     -1.0d0/6.0d0*fincol(3,jj))*dconjg(-fincol(1,jj)/36.0d0-
0246      &     2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))
0247             cfvct(2)=cfvct(2)+9.0d0*dble(abs(fincol(1,jj)/36.0d0-
0248      &     2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))**2
0249      &     +3.0d0*dreal((-fincol(1,jj)/12.0d0+2.0d0/3.0d0*fincol(2,jj)-
0250      &     1.0d0/6.0d0*fincol(3,jj))*dconjg(fincol(1,jj)/36.0d0-
0251      &     2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))
0252            end do
0253           end if
0254          end if
0255
0256 c... note here: since the cross-terms in the color-flow are neglected,

0257 c... the total square of amplitude does not equal to the sum of the

0258 c... square of the partial amplitude (pertain to a certain color-flow).

0259
0260         if(iqqbar.eq.0) then
0261 c6-----------

0262          if(ibc.eq.1) then
0263 c1-----------

0264            if(ioctet.eq.0) then
0265            do jj=1,16
0266            sigscl=sigscl+colfac(1)*dble(abs(8*fincol(1,jj)-fincol(3,jj)))
0267      &  **2+colfac(2)*dble(abs(8*fincol(2,jj)-fincol(4,jj)))**2
0268      &    +colfac(3)*dreal((8*fincol(1,jj)-fincol(3,jj))*dconjg(8*
0269      &    fincol(2,jj)-fincol(4,jj)))+colfac(4)*dble(abs(fincol
0270      &    (5,jj)))**2+colfac(5)*dreal(dconjg(8*fincol(1,jj)+8*
0271      &    fincol(2,jj)-fincol(3,jj)-fincol(4,jj))*fincol(5,jj))
0272            end do
0273            end if
0274 c1-----------

0275 c2-----------

0276           if(ioctet.eq.1) then
0277            do jj=1,16
0278            sigscl=sigscl+colfac(1)*abs(fincol(1,jj))**2+2*colfac(2)*
0279      &     dreal(fincol(1,jj)*dconjg(fincol(2,jj)))+2*colfac(3)*
0280      &     dreal(fincol(1,jj)*dconjg(fincol(3,jj)))+2*colfac(4)*
0281      &     dreal(fincol(1,jj)*dconjg(fincol(4,jj)))+2*colfac(6)*
0282      &     dreal(fincol(1,jj)*dconjg(fincol(5,jj)))+2*colfac(5)*
0283      &     dreal(fincol(1,jj)*dconjg(fincol(6,jj)))+2*colfac(7)*
0284      &     dreal(fincol(1,jj)*dconjg(fincol(7,jj)))+2*colfac(8)*
0285      &     dreal(fincol(1,jj)*dconjg(fincol(8,jj)))+2*colfac(7)*
0286      &     dreal(fincol(1,jj)*dconjg(fincol(9,jj)))+2*colfac(2)*
0287      &     dreal(fincol(1,jj)*dconjg(fincol(10,jj)))+colfac(1)*
0288      &       abs(fincol(2,jj))**2+2*colfac(4)*dreal(fincol(2,jj)*
0289      &     dconjg(fincol(3,jj)))+2*colfac(3)*dreal(fincol(2,jj)*
0290      &     dconjg(fincol(4,jj)))+2*colfac(5)*dreal(fincol(2,jj)*
0291      &     dconjg(fincol(5,jj)))+2*colfac(6)*dreal(fincol(2,jj)*
0292      &     dconjg(fincol(6,jj)))+2*colfac(8)*dreal(fincol(2,jj)*
0293      &     dconjg(fincol(7,jj)))+2*colfac(7)*dreal(fincol(2,jj)*
0294      &     dconjg(fincol(8,jj)))+2*colfac(2)*dreal(fincol(2,jj)*
0295      &     dconjg(fincol(9,jj)))+2*colfac(7)*dreal(fincol(2,jj)*
0296      &     dconjg(fincol(10,jj)))+4.0d0*abs(fincol(3,jj))**2+
0297      &       2*colfac(9)*dreal(fincol(3,jj)*dconjg(fincol(4,jj)))+
0298      &       2*colfac(4)*dreal(fincol(3,jj)*dconjg(fincol(7,jj)))+
0299      &       2*colfac(3)*dreal(fincol(3,jj)*dconjg(fincol(8,jj)))+
0300      &       2*colfac(3)*dreal(fincol(3,jj)*dconjg(fincol(9,jj)))+
0301      &       2*colfac(3)*dreal(fincol(3,jj)*dconjg(fincol(10,jj)))+
0302      &       4*abs(fincol(4,jj))**2+2*colfac(3)*dreal(fincol(4,jj)*
0303      &     dconjg(fincol(7,jj)))+2*colfac(4)*dreal(fincol(4,jj)*
0304      &     dconjg(fincol(8,jj)))+2*colfac(3)*dreal(fincol(4,jj)*
0305      &     dconjg(fincol(9,jj)))+2*colfac(3)*dreal(fincol(4,jj)*
0306      &     dconjg(fincol(10,jj)))+colfac(10)*abs(fincol(5,jj))**2-
0307      &       2*dreal(fincol(5,jj)*dconjg(fincol(6,jj)))+2*colfac(6)*
0308      &       dreal(fincol(5,jj)*dconjg(fincol(7,jj)))+2*colfac(5)*
0309      &       dreal(fincol(5,jj)*dconjg(fincol(8,jj)))+2*colfac(6)*
0310      &       dreal(fincol(5,jj)*dconjg(fincol(9,jj)))+2*colfac(5)*
0311      &       dreal(fincol(5,jj)*dconjg(fincol(10,jj)))+colfac(10)*
0312      &       abs(fincol(6,jj))**2+2*colfac(5)*dreal(fincol(6,jj)*
0313      &     dconjg(fincol(7,jj)))+2*colfac(6)*dreal(fincol(6,jj)*
0314      &     dconjg(fincol(8,jj)))+2*colfac(5)*dreal(fincol(6,jj)*
0315      &     dconjg(fincol(9,jj)))+2*colfac(6)*dreal(fincol(6,jj)*
0316      &     dconjg(fincol(10,jj)))+colfac(1)*abs(fincol(7,jj))**2+
0317      &     2*colfac(2)*dreal(fincol(7,jj)*dconjg(fincol(8,jj)))+
0318      &     2*colfac(7)*dreal(fincol(7,jj)*dconjg(fincol(9,jj)))+
0319      &     2*colfac(2)*dreal(fincol(7,jj)*dconjg(fincol(10,jj)))
0320      &       +colfac(1)*abs(fincol(8,jj))**2+2*colfac(2)*
0321      &       dreal(fincol(8,jj)*dconjg(fincol(9,jj)))+2*colfac(7)*
0322      &       dreal(fincol(8,jj)*dconjg(fincol(10,jj)))+
0323      &       colfac(1)*abs(fincol(9,jj))**2+2*colfac(8)*
0324      &       dreal(fincol(9,jj)*dconjg(fincol(10,jj)))+
0325      &       colfac(1)*abs(fincol(10,jj))**2
0326           end do
0327          end if
0328 c2----------

0329          end if
0330 c6-----------

0331 c7-----------

0332          if(ibc.eq.2) then
0333 c3----------

0334           if(ioctet.eq.0) then
0335            do jj=1,16
0336            sigvct=sigvct+colfac(1)*dble(abs(8*fincol(1,jj)-fincol(3,jj)))
0337      &  **2+colfac(2)*dble(abs(8*fincol(2,jj)-fincol(4,jj)))**2
0338      &    +colfac(3)*dreal((8*fincol(1,jj)-fincol(3,jj))*dconjg(8*
0339      &    fincol(2,jj)-fincol(4,jj)))+colfac(4)*dble(abs(fincol
0340      &    (5,jj)))**2+colfac(5)*dreal(dconjg(8*fincol(1,jj)+8*
0341      &    fincol(2,jj)-fincol(3,jj)-fincol(4,jj))*fincol(5,jj))
0342            end do
0343           end if
0344 c3---------

0345 c4---------

0346           if(ioctet.eq.1) then
0347            do jj=1,16
0348            sigvct=sigvct+colfac(1)*abs(fincol(1,jj))**2+2*colfac(2)*
0349      &     dreal(fincol(1,jj)*dconjg(fincol(2,jj)))+2*colfac(3)*
0350      &     dreal(fincol(1,jj)*dconjg(fincol(3,jj)))+2*colfac(4)*
0351      &     dreal(fincol(1,jj)*dconjg(fincol(4,jj)))+2*colfac(6)*
0352      &     dreal(fincol(1,jj)*dconjg(fincol(5,jj)))+2*colfac(5)*
0353      &     dreal(fincol(1,jj)*dconjg(fincol(6,jj)))+2*colfac(7)*
0354      &     dreal(fincol(1,jj)*dconjg(fincol(7,jj)))+2*colfac(8)*
0355      &     dreal(fincol(1,jj)*dconjg(fincol(8,jj)))+2*colfac(7)*
0356      &     dreal(fincol(1,jj)*dconjg(fincol(9,jj)))+2*colfac(2)*
0357      &     dreal(fincol(1,jj)*dconjg(fincol(10,jj)))+colfac(1)*
0358      &       abs(fincol(2,jj))**2+2*colfac(4)*dreal(fincol(2,jj)*
0359      &     dconjg(fincol(3,jj)))+2*colfac(3)*dreal(fincol(2,jj)*
0360      &     dconjg(fincol(4,jj)))+2*colfac(5)*dreal(fincol(2,jj)*
0361      &     dconjg(fincol(5,jj)))+2*colfac(6)*dreal(fincol(2,jj)*
0362      &     dconjg(fincol(6,jj)))+2*colfac(8)*dreal(fincol(2,jj)*
0363      &     dconjg(fincol(7,jj)))+2*colfac(7)*dreal(fincol(2,jj)*
0364      &     dconjg(fincol(8,jj)))+2*colfac(2)*dreal(fincol(2,jj)*
0365      &     dconjg(fincol(9,jj)))+2*colfac(7)*dreal(fincol(2,jj)*
0366      &     dconjg(fincol(10,jj)))+4.0d0*abs(fincol(3,jj))**2+
0367      &       2*colfac(9)*dreal(fincol(3,jj)*dconjg(fincol(4,jj)))+
0368      &       2*colfac(4)*dreal(fincol(3,jj)*dconjg(fincol(7,jj)))+
0369      &       2*colfac(3)*dreal(fincol(3,jj)*dconjg(fincol(8,jj)))+
0370      &       2*colfac(3)*dreal(fincol(3,jj)*dconjg(fincol(9,jj)))+
0371      &       2*colfac(3)*dreal(fincol(3,jj)*dconjg(fincol(10,jj)))+
0372      &       4*abs(fincol(4,jj))**2+2*colfac(3)*dreal(fincol(4,jj)*
0373      &     dconjg(fincol(7,jj)))+2*colfac(4)*dreal(fincol(4,jj)*
0374      &     dconjg(fincol(8,jj)))+2*colfac(3)*dreal(fincol(4,jj)*
0375      &     dconjg(fincol(9,jj)))+2*colfac(3)*dreal(fincol(4,jj)*
0376      &     dconjg(fincol(10,jj)))+colfac(10)*abs(fincol(5,jj))**2-
0377      &       2*dreal(fincol(5,jj)*dconjg(fincol(6,jj)))+2*colfac(6)*
0378      &       dreal(fincol(5,jj)*dconjg(fincol(7,jj)))+2*colfac(5)*
0379      &       dreal(fincol(5,jj)*dconjg(fincol(8,jj)))+2*colfac(6)*
0380      &       dreal(fincol(5,jj)*dconjg(fincol(9,jj)))+2*colfac(5)*
0381      &       dreal(fincol(5,jj)*dconjg(fincol(10,jj)))+colfac(10)*
0382      &       abs(fincol(6,jj))**2+2*colfac(5)*dreal(fincol(6,jj)*
0383      &     dconjg(fincol(7,jj)))+2*colfac(6)*dreal(fincol(6,jj)*
0384      &     dconjg(fincol(8,jj)))+2*colfac(5)*dreal(fincol(6,jj)*
0385      &     dconjg(fincol(9,jj)))+2*colfac(6)*dreal(fincol(6,jj)*
0386      &     dconjg(fincol(10,jj)))+colfac(1)*abs(fincol(7,jj))**2+
0387      &     2*colfac(2)*dreal(fincol(7,jj)*dconjg(fincol(8,jj)))+
0388      &     2*colfac(7)*dreal(fincol(7,jj)*dconjg(fincol(9,jj)))+
0389      &     2*colfac(2)*dreal(fincol(7,jj)*dconjg(fincol(10,jj)))
0390      &       +colfac(1)*abs(fincol(8,jj))**2+2*colfac(2)*
0391      &       dreal(fincol(8,jj)*dconjg(fincol(9,jj)))+2*colfac(7)*
0392      &       dreal(fincol(8,jj)*dconjg(fincol(10,jj)))+
0393      &       colfac(1)*abs(fincol(9,jj))**2+2*colfac(8)*
0394      &       dreal(fincol(9,jj)*dconjg(fincol(10,jj)))+
0395      &       colfac(1)*abs(fincol(10,jj))**2
0396           end do
0397           end if
0398 c4----------

0399          end if
0400 c7----------

0401         end if
0402
0403         if(iqqbar.eq.1) then
0404           if(ibc.eq.1) then
0405            do jj=1,16
0406             sigscl=sigscl+9.0d0*dble(abs(fincol(1,jj)/36.0d0-2.0d0/9.0d0
0407      &    *fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))**2+6.0d0*dreal(
0408      &    (-fincol(1,jj)/12.0d0+2.0d0/3.0d0*fincol(2,jj)-
0409      &    1.0d0/6.0d0*fincol(3,jj))*dconjg(fincol(1,jj)/36.0d0-
0410      &    2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))+
0411      &    9.0d0*dble(abs(-fincol(1,jj)/12.0d0+2.0d0/3.0d0
0412      &    *fincol(2,jj)-1.0d0/6.0d0*fincol(3,jj)))**2
0413            end do
0414           end if
0415           if(ibc.eq.2) then
0416            do jj=1,16
0417             sigvct=sigvct+9.0d0*dble(abs(fincol(1,jj)/36.0d0-2.0d0/9.0d0
0418      &    *fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))**2+6.0d0*dreal(
0419      &    (-fincol(1,jj)/12.0d0+2.0d0/3.0d0*fincol(2,jj)-
0420      &    1.0d0/6.0d0*fincol(3,jj))*dconjg(fincol(1,jj)/36.0d0-
0421      &    2.0d0/9.0d0*fincol(2,jj)+5.0d0/18.0d0*fincol(3,jj)))+
0422      &    9.0d0*dble(abs(-fincol(1,jj)/12.0d0+2.0d0/3.0d0
0423      &    *fincol(2,jj)-1.0d0/6.0d0*fincol(3,jj)))**2
0424            end do
0425           end if
0426         end if
0427
0428         end do
0429 c...end of big circle.

0430
0431 c...collect the color-flow information:

0432
0433         if(ibcstate.eq.1) then
0434            do jj=1,10
0435              amp2cf(jj)=cfscl(jj)
0436              smatval=smatval+amp2cf(jj)
0437            end do
0438         end if
0439         if(ibcstate.eq.2) then
0440            do jj=1,10
0441              amp2cf(jj)=cfvct(jj)
0442              smatval=smatval+amp2cf(jj)
0443            end do
0444         end if
0445
0446 c...the following is only to eliminate the numerical uncerntainty,

0447 c...which in principle does not needed. however we added here

0448 c...to avoid some very particular cases.

0449 c...double precision.

0450         do ii=1,3
0451            if(amp2cf(ii).lt.1.0d-16) amp2cf(ii)=1.0d-16
0452         end do
0453         if(smatval.lt.1.0d-16) smatval=1.0d-16
0454         if(sigscl.lt.1.0d-16)  sigscl =1.0d-16
0455         if(sigvct.lt.1.0d-16)  sigvct =1.0d-16
0456
0457       return
0458         end