bin/BCVEGPY/p_samp.F

0001 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0002 c...subroutines for gg ->bc+b+\bar{c}:  bc in p-wave states.         c

0003 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0004 c...       bc should be in color-singlet and color-octet states.     c

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

0006 c reference: phys.rev. d70,114019(2004);                             c

0007 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0008 c**********************************************************

0009 c******** to get square amplitude for 1p1   ***************

0010 c**********************************************************

0011       double precision function amps20_1p1()
0012       implicit double precision (a-h,o-z)
0013       implicit integer (i-n)
0014       common/cccc/c36,c35,c34,c33,c32,c31,c30,c29
0015      . ,c28,c27,c26,c25,c24,c23,c22,c21,c20,c19,c18,c17
0016      . ,c16,c15,c14,c13,c12,c11,c10,c9,c8,c7,c6,c5,c4,c3
0017      . ,c2,c1s2,c1s1
0018 #include "inclamp.h"
0019 c...color flow.

0020         common/colflow/amp2cf(10),smatval
0021         dimension tempamp(3)
0022
0023         do ii=1,10
0024            amp2cf(ii)=0.0d0
0025         end do
0026
0027       do 200 m=1,32
0028         do 400 n=1,3
0029           c(m,n)=0.0d0
0030 400     continue
0031 200   continue
0032
0033       call genppp()
0034
0035       call amp1s1_1p1(c1s1)
0036       call amp1s2_1p1(c1s2)
0037       call amp2_1p1(c2)
0038       call amp3_1p1(c3)
0039       call amp4_1p1(c4)
0040       call amp5_1p1(c5)
0041       call amp6_1p1(c6)
0042       call amp7_1p1(c7)
0043       call amp8_1p1(c8)
0044       call amp9_1p1(c9)
0045       call amp10_1p1(c10)
0046       call amp11_1p1(c11)
0047       call amp12_1p1(c12)
0048       call amp13_1p1(c13)
0049       call amp14_1p1(c14)
0050       call amp15_1p1(c15)
0051       call amp16_1p1(c16)
0052       call amp17_1p1(c17)
0053       call amp18_1p1(c18)
0054       call amp19_1p1(c19)
0055       call amp20_1p1(c20)
0056       call amp21_1p1(c21)
0057       call amp22_1p1(c22)
0058       call amp23_1p1(c23)
0059       call amp24_1p1(c24)
0060       call amp25_1p1(c25)
0061       call amp26_1p1(c26)
0062       call amp27_1p1(c27)
0063       call amp28_1p1(c28)
0064       call amp29_1p1(c29)
0065       call amp30_1p1(c30)
0066       call amp31_1p1(c31)
0067       call amp32_1p1(c32)
0068       call amp33_1p1(c33)
0069       call amp34_1p1(c34)
0070       call amp35_1p1(c35)
0071       call amp36_1p1(c36)
0072
0073         amps20_1p1=0.0d0
0074
0075       do 600 n=1,3
0076          call genpppn(n)
0077          tempamp(n)=ams1_1p1(n)
0078          amps20_1p1=amps20_1p1+tempamp(n)
0079 600   continue
0080
0081         nreduce=4
0082       amps20_1p1=nreduce*amps20_1p1
0083
0084 c... color-flow.

0085 c... note here: since the cross-terms in the color-flow are neglected,

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

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

0088
0089          amp2cf(1)=6.0d0/65.0d0*tempamp(1)+11.0d0/78.0d0*tempamp(2)
0090        amp2cf(2)=6.0d0/65.0d0*tempamp(1)+2.0d0/429.0d0*tempamp(2)
0091      &           +3.0d0/22.0d0*tempamp(3)
0092          amp2cf(3)=27.0d0/130.0d0*tempamp(1)+3.0d0/286.0d0*tempamp(2)
0093      &           +1.0d0/66.0d0*tempamp(3)
0094 c...smatval need not to be normalized to the whole amplitude,

0095 c...since we only need the relative probability for each color-flow.

0096          smatval=amp2cf(1)+amp2cf(2)+amp2cf(3)
0097
0098 c...the following is only to eliminate the numerical uncerntainty,

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

0100 c...to avoid some very particular cases.<--------> double precision

0101         if(amps20_1p1.lt.1.0d-16) amps20_1p1=1.0d-16
0102         do ii=1,3
0103            if(amp2cf(ii).lt.1.0d-16) amp2cf(ii)=1.0d-16
0104         end do
0105         if(smatval.lt.1.0d-16) smatval=1.0d-16
0106
0107         return
0108       end
0109
0110 c**********************************************************************

0111       double precision function amps2_1p1()
0112       implicit double precision (a-h,o-z)
0113       implicit integer (i-n)
0114       common/ppp/pp(4,40),guv(4)
0115 #include "inclcon.h"
0116       dimension ep1(4,2:3), ep2(4,2:3), ep3(4,2:4)
0117
0118       amps2_1p1=0.d0
0119
0120       call genpolar(pp(1,1),ep1)
0121       call genpolar(pp(1,2),ep2)
0122       call genpolar3(pp(1,3),ep3,hbcm)
0123
0124 c...the same for subprocess and tevatron and lhc

0125       do 400 nb1=2,2
0126         do 401 nb2=2,3
0127          do 402 nc3=2,4
0128           do i=1,4
0129             pp(i,6)=ep1(i,nb1)
0130             pp(i,7)=ep2(i,nb2)
0131             pp(i,8)=ep3(i,nc3)
0132           enddo
0133           amps2_1p1=amps2_1p1+2.0d0*amps20_1p1()
0134 402      continue
0135 401     continue
0136 400   continue
0137
0138       return
0139       end
0140
0141 c**********************************************************

0142 c******** to get square amplitude for 3p0   ***************

0143 c**********************************************************

0144       double precision function amps20_3p0()
0145       implicit double precision (a-h,o-z)
0146       implicit integer (i-n)
0147       common/cccc/c36,c35,c34,c33,c32,c31,c30,c29
0148      . ,c28,c27,c26,c25,c24,c23,c22,c21,c20,c19,c18,c17
0149      . ,c16,c15,c14,c13,c12,c11,c10,c9,c8,c7,c6,c5,c4,c3
0150      . ,c2,c1s2,c1s1
0151 #include "inclamp.h"
0152 c...color flow.

0153         common/colflow/amp2cf(10),smatval
0154         dimension tempamp(3)
0155
0156         do ii=1,10
0157            amp2cf(ii)=0.0d0
0158         end do
0159
0160        do 200 m=1,16
0161         do 400 n=1,3
0162            c(m,n)=0.d0
0163 400     continue
0164 200    continue
0165
0166          call genppp()
0167
0168          call amp1s1_3p0(c1s1)
0169        call amp1s2_3p0(c1s2)
0170        call amp2_3p0(c2)
0171        call amp3_3p0(c3)
0172        call amp4_3p0(c4)
0173        call amp5_3p0(c5)
0174        call amp6_3p0(c6)
0175        call amp7_3p0(c7)
0176        call amp8_3p0(c8)
0177        call amp9_3p0(c9)
0178        call amp10_3p0(c10)
0179        call amp11_3p0(c11)
0180        call amp12_3p0(c12)
0181        call amp13_3p0(c13)
0182        call amp14_3p0(c14)
0183        call amp15_3p0(c15)
0184        call amp16_3p0(c16)
0185        call amp17_3p0(c17)
0186        call amp18_3p0(c18)
0187        call amp19_3p0(c19)
0188        call amp20_3p0(c20)
0189        call amp21_3p0(c21)
0190        call amp22_3p0(c22)
0191        call amp23_3p0(c23)
0192        call amp24_3p0(c24)
0193        call amp25_3p0(c25)
0194        call amp26_3p0(c26)
0195        call amp27_3p0(c27)
0196        call amp28_3p0(c28)
0197        call amp29_3p0(c29)
0198        call amp30_3p0(c30)
0199        call amp31_3p0(c31)
0200        call amp32_3p0(c32)
0201        call amp33_3p0(c33)
0202        call amp34_3p0(c34)
0203        call amp35_3p0(c35)
0204        call amp36_3p0(c36)
0205
0206          amps20_3p0=0.0d0
0207
0208        do n=1,3
0209          tempamp(n)=ams1_3p0(n)
0210            amps20_3p0=amps20_3p0+tempamp(n)
0211        enddo
0212
0213        nreduce=4
0214        amps20_3p0=nreduce*amps20_3p0
0215
0216 c... color-flow.

0217 c... note here: since the cross-terms in the color-flow are neglected,

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

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

0220
0221          amp2cf(1)=6.0d0/65.0d0*tempamp(1)+11.0d0/78.0d0*tempamp(2)
0222        amp2cf(2)=6.0d0/65.0d0*tempamp(1)+2.0d0/429.0d0*tempamp(2)
0223      &           +3.0d0/22.0d0*tempamp(3)
0224          amp2cf(3)=27.0d0/130.0d0*tempamp(1)+3.0d0/286.0d0*tempamp(2)
0225      &           +1.0d0/66.0d0*tempamp(3)
0226 c...smatval need not to be normalized to the whole amplitude,

0227 c...since we only need the relative probability for each color-flow.

0228          smatval=amp2cf(1)+amp2cf(2)+amp2cf(3)
0229
0230 c...the following is only to eliminate the numerical uncerntainty,

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

0232 c...to avoid some very particular cases. <------> double precision

0233         if(amps20_3p0.lt.1.0d-16) amps20_3p0=1.0d-16
0234         do ii=1,3
0235            if(amp2cf(ii).lt.1.0d-16) amp2cf(ii)=1.0d-16
0236         end do
0237         if(smatval.lt.1.0d-16) smatval=1.0d-16
0238
0239         return
0240       end
0241
0242 c**********************************

0243       double precision function amps2_3p0()
0244       implicit double precision (a-h,o-z)
0245       implicit integer (i-n)
0246       common/ppp/pp(4,40),guv(4)
0247 #include "inclcon.h"
0248       dimension ep1(4,2:3), ep2(4,2:3)
0249
0250         amps2_3p0=0.d0
0251
0252       call genpolar(pp(1,1),ep1)
0253       call genpolar(pp(1,2),ep2)
0254
0255 c...the same for subprocess and tevatron and lhc

0256       do 400 nb1=2,2
0257         do 401 nb2=2,3
0258          do i=1,4
0259            pp(i,6)=ep1(i,nb1)
0260            pp(i,7)=ep2(i,nb2)
0261          enddo
0262          amps2_3p0=amps2_3p0+2.0d0*amps20_3p0()
0263 401     continue
0264 400   continue
0265
0266       return
0267       end
0268 c**********************************************************

0269 c******** to get square amplitude for 3p1   ***************

0270 c**********************************************************

0271       double precision function amps20_3p1()
0272       implicit double precision (a-h,o-z)
0273       implicit integer (i-n)
0274       common/cccc/c36,c35,c34,c33,c32,c31,c30,c29
0275      . ,c28,c27,c26,c25,c24,c23,c22,c21,c20,c19,c18,c17
0276      . ,c16,c15,c14,c13,c12,c11,c10,c9,c8,c7,c6,c5,c4,c3
0277      . ,c2,c1s2,c1s1
0278 #include "inclamp.h"
0279 c...color flow.

0280         common/colflow/amp2cf(10),smatval
0281         dimension tempamp(3)
0282
0283         do ii=1,10
0284            amp2cf(ii)=0.0d0
0285         end do
0286
0287       do 200 m=1,48
0288        do 400 n=1,3
0289          c(m,n)=0.0d0
0290 400    continue
0291 200   continue
0292
0293         call genppp()
0294
0295       call amp1s1_3p1(c1s1)
0296       call amp1s2_3p1(c1s2)
0297       call amp2_3p1(c2)
0298       call amp3_3p1(c3)
0299       call amp4_3p1(c4)
0300       call amp5_3p1(c5)
0301       call amp6_3p1(c6)
0302       call amp7_3p1(c7)
0303       call amp8_3p1(c8)
0304       call amp9_3p1(c9)
0305       call amp10_3p1(c10)
0306       call amp11_3p1(c11)
0307       call amp12_3p1(c12)
0308       call amp13_3p1(c13)
0309       call amp14_3p1(c14)
0310       call amp15_3p1(c15)
0311       call amp16_3p1(c16)
0312       call amp17_3p1(c17)
0313       call amp18_3p1(c18)
0314       call amp19_3p1(c19)
0315       call amp20_3p1(c20)
0316       call amp21_3p1(c21)
0317       call amp22_3p1(c22)
0318       call amp23_3p1(c23)
0319       call amp24_3p1(c24)
0320       call amp25_3p1(c25)
0321       call amp26_3p1(c26)
0322       call amp27_3p1(c27)
0323       call amp28_3p1(c28)
0324       call amp29_3p1(c29)
0325       call amp30_3p1(c30)
0326       call amp31_3p1(c31)
0327       call amp32_3p1(c32)
0328       call amp33_3p1(c33)
0329       call amp34_3p1(c34)
0330       call amp35_3p1(c35)
0331       call amp36_3p1(c36)
0332
0333         amps20_3p1=0.0d0
0334
0335       do 600 n=1,3
0336          call genpppn(n)
0337          tempamp(n)=ams1_3p1(n)
0338            amps20_3p1=amps20_3p1+tempamp(n)
0339   600 continue
0340
0341       nreduce=4
0342       amps20_3p1=nreduce*amps20_3p1
0343
0344 c... color-flow.

0345 c... note here: since the cross-terms in the color-flow are neglected,

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

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

0348
0349          amp2cf(1)=6.0d0/65.0d0*tempamp(1)+11.0d0/78.0d0*tempamp(2)
0350        amp2cf(2)=6.0d0/65.0d0*tempamp(1)+2.0d0/429.0d0*tempamp(2)
0351      &           +3.0d0/22.0d0*tempamp(3)
0352          amp2cf(3)=27.0d0/130.0d0*tempamp(1)+3.0d0/286.0d0*tempamp(2)
0353      &           +1.0d0/66.0d0*tempamp(3)
0354 c...smatval need not to be normalized to the whole amplitude,

0355 c...since we only need the relative probability for each color-flow.

0356          smatval=amp2cf(1)+amp2cf(2)+amp2cf(3)
0357
0358 c...the following is only to eliminate the numerical uncerntainty,

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

0360 c...to avoid some very particular cases. <----->double precision

0361         if(amps20_3p1.lt.1.0d-16) amps20_3p1=1.0d-16
0362         do ii=1,3
0363            if(amp2cf(ii).lt.1.0d-16) amp2cf(ii)=1.0d-16
0364         end do
0365         if(smatval.lt.1.0d-16) smatval=1.0d-16
0366
0367       return
0368       end
0369
0370 c********************************

0371       double precision function amps2_3p1()
0372       implicit double precision (a-h,o-z)
0373       implicit integer (i-n)
0374       common/ppp/pp(4,40),guv(4)
0375 #include "inclcon.h"
0376       dimension ep1(4,2:3), ep2(4,2:3), ep3(4,2:4)
0377
0378       amps2_3p1=0.0d0
0379
0380       call genpolar(pp(1,1),ep1)
0381       call genpolar(pp(1,2),ep2)
0382       call genpolar3(pp(1,3),ep3,hbcm)
0383
0384 c...the same for subprocess and tevatron and lhc

0385         do 400 nb1=2,2
0386         do 401 nb2=2,3
0387          do 402 nc3=2,4
0388            do i=1,4
0389              pp(i,6)=ep1(i,nb1)
0390              pp(i,7)=ep2(i,nb2)
0391              pp(i,8)=ep3(i,nc3)
0392            enddo
0393            amps2_3p1=amps2_3p1+2.0d0*amps20_3p1()
0394 402      continue
0395 401     continue
0396 400   continue
0397
0398       return
0399       end
0400
0401 c**********************************************************

0402 c******** to get square amplitude for 3p2   ***************

0403 c**********************************************************

0404       double precision function amps20_3p2()
0405       implicit double precision (a-h,o-z)
0406       implicit integer (i-n)
0407       common/cccc/c36,c35,c34,c33,c32,c31,c30,c29
0408      . ,c28,c27,c26,c25,c24,c23,c22,c21,c20,c19,c18,c17
0409      . ,c16,c15,c14,c13,c12,c11,c10,c9,c8,c7,c6,c5,c4,c3
0410      . ,c2,c1s2,c1s1
0411 #include "inclamp.h"
0412 c...color flow.

0413         common/colflow/amp2cf(10),smatval
0414         dimension tempamp(3)
0415
0416         do ii=1,10
0417            amp2cf(ii)=0.0d0
0418         end do
0419
0420       do 200 m=1,94
0421         do 400 n=1,3
0422           c(m,n)=0.0d0
0423 400     continue
0424 200   continue
0425
0426       call genppp()
0427       call amp1s1_3p2(c1s1)
0428       call amp1s2_3p2(c1s2)
0429       call amp2_3p2(c2)
0430       call amp3_3p2(c3)
0431       call amp4_3p2(c4)
0432       call amp5_3p2(c5)
0433       call amp6_3p2(c6)
0434       call amp7_3p2(c7)
0435       call amp8_3p2(c8)
0436       call amp9_3p2(c9)
0437       call amp10_3p2(c10)
0438       call amp11_3p2(c11)
0439       call amp12_3p2(c12)
0440       call amp13_3p2(c13)
0441       call amp14_3p2(c14)
0442       call amp15_3p2(c15)
0443       call amp16_3p2(c16)
0444       call amp17_3p2(c17)
0445       call amp18_3p2(c18)
0446       call amp19_3p2(c19)
0447       call amp20_3p2(c20)
0448       call amp21_3p2(c21)
0449       call amp22_3p2(c22)
0450       call amp23_3p2(c23)
0451       call amp24_3p2(c24)
0452       call amp25_3p2(c25)
0453       call amp26_3p2(c26)
0454       call amp27_3p2(c27)
0455       call amp28_3p2(c28)
0456       call amp29_3p2(c29)
0457       call amp30_3p2(c30)
0458       call amp31_3p2(c31)
0459       call amp32_3p2(c32)
0460       call amp33_3p2(c33)
0461       call amp34_3p2(c34)
0462       call amp35_3p2(c35)
0463       call amp36_3p2(c36)
0464
0465         amps20_3p2=0.0d0
0466
0467       do n=1,3
0468          call genpppn(n)
0469            tempamp(n)=ams1_3p2(n)
0470            amps20_3p2=amps20_3p2+tempamp(n)
0471       enddo
0472
0473         nreduce=4
0474       amps20_3p2=nreduce*amps20_3p2
0475
0476 c... color-flow.

0477 c... note here: since the cross-terms in the color-flow are neglected,

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

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

0480
0481          amp2cf(1)=6.0d0/65.0d0*tempamp(1)+11.0d0/78.0d0*tempamp(2)
0482        amp2cf(2)=6.0d0/65.0d0*tempamp(1)+2.0d0/429.0d0*tempamp(2)
0483      &           +3.0d0/22.0d0*tempamp(3)
0484          amp2cf(3)=27.0d0/130.0d0*tempamp(1)+3.0d0/286.0d0*tempamp(2)
0485      &           +1.0d0/66.0d0*tempamp(3)
0486 c...smatval need not to be normalized to the whole amplitude,

0487 c...since we only need the relative probability for each color-flow.

0488          smatval=amp2cf(1)+amp2cf(2)+amp2cf(3)
0489
0490 c...the following is only to eliminate the numerical uncerntainty,

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

0492 c...to avoid some very particular cases. <------>double precision

0493         if(amps20_3p2.lt.1.0d-16) amps20_3p2=1.0d-16
0494         do ii=1,3
0495            if(amp2cf(ii).lt.1.0d-16) amp2cf(ii)=1.0d-16
0496         end do
0497         if(smatval.lt.1.0d-16) smatval=1.0d-16
0498
0499       return
0500       end
0501 c*******************************************

0502       double precision function amps2_3p2()
0503       implicit double precision (a-h,o-z)
0504       implicit integer (i-n)
0505       common/ppp/pp(4,40),guv(4)
0506 #include "inclcon.h"
0507       dimension ep1(4,2:3), ep2(4,2:3), ept3(4,4,2:6)
0508
0509         amps2_3p2=0.0d0
0510
0511       call genpolar(pp(1,1),ep1)
0512       call genpolar(pp(1,2),ep2)
0513       call gentensor(pp(1,3),ept3,hbcm)
0514
0515 c...the same for subprocess and tevatron and lhc

0516         do 400 nb1=2,2
0517         do 401 nb2=2,3
0518          do 402 nt3=2,6
0519           do i=1,4
0520            pp(i,6)=ep1(i,nb1)
0521            pp(i,7)=ep2(i,nb2)
0522           enddo
0523           call def_p_eq_p_dot_tp(8,4,ept3,nt3)
0524           call def_p_eq_p_dot_tp(9,5,ept3,nt3)
0525           call def_p_eq_p_dot_tp(10,1,ept3,nt3)
0526           call def_p_eq_p_dot_tp(11,2,ept3,nt3)
0527           call def_p_eq_p_dot_tp(12,7,ept3,nt3)
0528           call def_p_eq_p_dot_tp(13,6,ept3,nt3)
0529           amps2_3p2=amps2_3p2+2.0d0*amps20_3p2()
0530 402      continue
0531 401     continue
0532 400   continue
0533
0534       return
0535         end
0536