TopBSM: matrix.f

File matrix.f, 8.4 KB (added by anonymous, 7 years ago)
Line 
1      SUBROUTINE SMATRIX(P1,ANS)
2
3C Generated by MadGraph II                                             
4C RETURNS AMPLITUDE SQUARED SUMMED/AVG OVER COLORS
5C AND HELICITIES
6C FOR THE POINT IN PHASE SPACE P(0:3,NEXTERNAL)
7
8C FOR PROCESS : g g -> t t~ 
9
10C Crossing   1 is g g -> t t~ 
11      IMPLICIT NONE
12
13C CONSTANTS
14
15      Include "genps.inc"
16      INTEGER                 NCOMB,     NCROSS         
17      PARAMETER (             NCOMB=  16, NCROSS=  1)
18      INTEGER    THEL
19      PARAMETER (THEL=NCOMB*NCROSS)
20
21C ARGUMENTS
22
23      REAL*8 P1(0:3,NEXTERNAL),ANS(NCROSS)
24
25C LOCAL VARIABLES
26
27      INTEGER NHEL(NEXTERNAL,NCOMB),NTRY
28      REAL*8 T, P(0:3,NEXTERNAL)
29      REAL*8 MATRIX
30      INTEGER IHEL,IDEN(NCROSS),IC(NEXTERNAL,NCROSS)
31      INTEGER IPROC,JC(NEXTERNAL), I
32      LOGICAL GOODHEL(NCOMB,NCROSS)
33      INTEGER NGRAPHS
34      REAL*8 hwgt, xtot, xtry, xrej, xr, yfrac(0:ncomb)
35      INTEGER idum, ngood, igood(ncomb), jhel, j, jj
36      LOGICAL warned
37      REAL     xran1
38      EXTERNAL xran1
39
40C GLOBAL VARIABLES
41
42      Double Precision amp2(maxamps), jamp2(0:maxamps)
43      common/to_amps/  amp2,       jamp2
44
45      character*79         hel_buff
46      common/to_helicity/  hel_buff
47
48      REAL*8 POL(2)
49      common/to_polarization/ POL
50
51      integer          isum_hel
52      logical                    multi_channel
53      common/to_matrix/isum_hel, multi_channel
54      INTEGER MAPCONFIG(0:LMAXCONFIGS), ICONFIG
55      common/to_mconfigs/mapconfig, iconfig
56      DATA NTRY,IDUM /0,-1/
57      DATA xtry, xrej, ngood /0,0,0/
58      DATA warned, isum_hel/.false.,0/
59      DATA multi_channel/.true./
60      SAVE yfrac, igood, jhel
61      DATA NGRAPHS /    4/         
62      DATA jamp2(0) /   3/         
63      DATA GOODHEL/THEL*.FALSE./
64      DATA (NHEL(IHEL,   1),IHEL=1,4) /-1,-1,-1,-1/
65      DATA (NHEL(IHEL,   2),IHEL=1,4) /-1,-1,-1, 1/
66      DATA (NHEL(IHEL,   3),IHEL=1,4) /-1,-1, 1,-1/
67      DATA (NHEL(IHEL,   4),IHEL=1,4) /-1,-1, 1, 1/
68      DATA (NHEL(IHEL,   5),IHEL=1,4) /-1, 1,-1,-1/
69      DATA (NHEL(IHEL,   6),IHEL=1,4) /-1, 1,-1, 1/
70      DATA (NHEL(IHEL,   7),IHEL=1,4) /-1, 1, 1,-1/
71      DATA (NHEL(IHEL,   8),IHEL=1,4) /-1, 1, 1, 1/
72      DATA (NHEL(IHEL,   9),IHEL=1,4) / 1,-1,-1,-1/
73      DATA (NHEL(IHEL,  10),IHEL=1,4) / 1,-1,-1, 1/
74      DATA (NHEL(IHEL,  11),IHEL=1,4) / 1,-1, 1,-1/
75      DATA (NHEL(IHEL,  12),IHEL=1,4) / 1,-1, 1, 1/
76      DATA (NHEL(IHEL,  13),IHEL=1,4) / 1, 1,-1,-1/
77      DATA (NHEL(IHEL,  14),IHEL=1,4) / 1, 1,-1, 1/
78      DATA (NHEL(IHEL,  15),IHEL=1,4) / 1, 1, 1,-1/
79      DATA (NHEL(IHEL,  16),IHEL=1,4) / 1, 1, 1, 1/
80      DATA (  IC(IHEL,  1),IHEL=1,4) / 1, 2, 3, 4/
81      DATA (IDEN(IHEL),IHEL=  1,  1) / 256/
82C ----------
83C BEGIN CODE
84C ----------
85      NTRY=NTRY+1
86      DO IPROC=1,NCROSS
87      CALL SWITCHMOM(P1,P,IC(1,IPROC),JC,NEXTERNAL)
88      DO IHEL=1,NEXTERNAL
89         JC(IHEL) = +1
90      ENDDO
91       
92      IF (multi_channel) THEN
93          DO IHEL=1,NGRAPHS
94              amp2(ihel)=0d0
95              jamp2(ihel)=0d0
96          ENDDO
97          DO IHEL=1,int(jamp2(0))
98              jamp2(ihel)=0d0
99          ENDDO
100      ENDIF
101      ANS(IPROC) = 0D0
102      write(hel_buff,'(16i5)') (0,i=1,nexternal)
103      IF (ISUM_HEL .EQ. 0 .OR. NTRY .LT. 10) THEN
104          DO IHEL=1,NCOMB
105              IF (GOODHEL(IHEL,IPROC) .OR. NTRY .LT. 2) THEN
106                 T=MATRIX(P ,NHEL(1,IHEL),JC(1))           
107                 DO JJ=1,2
108                   IF(POL(JJ).NE.1d0.AND.
109     $                NHEL(JJ,IHEL).EQ.SIGN(1,POL(JJ))) THEN
110                     T=T*ABS(POL(JJ))
111                   ELSE IF(POL(JJ).NE.1d0)THEN
112                     T=T*(2d0-ABS(POL(JJ)))
113                   ENDIF
114                 ENDDO
115                 ANS(IPROC)=ANS(IPROC)+T
116                  IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL,IPROC)) THEN
117                      GOODHEL(IHEL,IPROC)=.TRUE.
118                      NGOOD = NGOOD +1
119                      IGOOD(NGOOD) = IHEL
120C                WRITE(*,*) ngood,IHEL,T
121                  ENDIF
122              ENDIF
123          ENDDO
124          JHEL = 1
125          ISUM_HEL=MIN(ISUM_HEL,NGOOD)
126      ELSE              !RANDOM HELICITY
127          DO J=1,ISUM_HEL
128              JHEL=JHEL+1
129              IF (JHEL .GT. NGOOD) JHEL=1
130              HWGT = REAL(NGOOD)/REAL(ISUM_HEL)
131              IHEL = IGOOD(JHEL)
132              T=MATRIX(P ,NHEL(1,IHEL),JC(1))           
133              DO JJ=1,2
134                IF(POL(JJ).NE.1d0.AND.
135     $             NHEL(JJ,IHEL).EQ.SIGN(1,POL(JJ))) THEN
136                  T=T*ABS(POL(JJ))
137                ELSE IF(POL(JJ).NE.1d0)THEN
138                  T=T*(2d0-ABS(POL(JJ)))
139                ENDIF
140              ENDDO
141              ANS(IPROC)=ANS(IPROC)+T*HWGT
142          ENDDO
143          IF (ISUM_HEL .EQ. 1) THEN
144              WRITE(HEL_BUFF,'(16i5)')(NHEL(i,IHEL),i=1,nexternal)
145          ENDIF
146      ENDIF
147      IF (MULTI_CHANNEL) THEN
148          XTOT=0D0
149          DO IHEL=1,MAPCONFIG(0)
150              XTOT=XTOT+AMP2(MAPCONFIG(IHEL))
151          ENDDO
152          IF (XTOT.NE.0D0) THEN
153              ANS(IPROC)=ANS(IPROC)*AMP2(MAPCONFIG(ICONFIG))/XTOT
154          ELSE
155              ANS(IPROC)=0D0
156          ENDIF
157      ENDIF
158      ANS(IPROC)=ANS(IPROC)/DBLE(IDEN(IPROC))
159      ENDDO
160      END
161       
162       
163      REAL*8 FUNCTION MATRIX(P,NHEL,IC)
164
165C Generated by MadGraph II                                             
166C RETURNS AMPLITUDE SQUARED SUMMED/AVG OVER COLORS
167C FOR THE POINT WITH EXTERNAL LINES W(0:6,NEXTERNAL)
168
169C FOR PROCESS : g g -> t t~ 
170
171      IMPLICIT NONE
172
173C CONSTANTS
174
175      INTEGER    NGRAPHS,    NEIGEN
176      PARAMETER (NGRAPHS=   4,NEIGEN=  3)
177      include "genps.inc"
178      INTEGER    NWAVEFUNCS     , NCOLOR
179      PARAMETER (NWAVEFUNCS=   8, NCOLOR=   3)
180      REAL*8     ZERO
181      PARAMETER (ZERO=0D0)
182
183C ARGUMENTS
184
185      REAL*8 P(0:3,NEXTERNAL)
186      INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL)
187
188C LOCAL VARIABLES
189
190      INTEGER I,J
191      COMPLEX*16 ZTEMP
192      REAL*8 DENOM(NCOLOR), CF(NCOLOR,NCOLOR)
193      COMPLEX*16 AMP(NGRAPHS), JAMP(NCOLOR)
194      COMPLEX*16 W(18,NWAVEFUNCS)
195
196C GLOBAL VARIABLES
197
198      Double Precision amp2(maxamps), jamp2(0:maxamps)
199      common/to_amps/  amp2,       jamp2
200      include "coupl.inc"
201
202C COLOR DATA
203
204      DATA Denom(1  )/            3/                                       
205      DATA (CF(i,1  ),i=1  ,3  ) /    16,   -2,   -4/                     
206C               T[3,4,2,1]                                                 
207      DATA Denom(2  )/            3/                                       
208      DATA (CF(i,2  ),i=1  ,3  ) /    -2,   16,   -4/                     
209C               T[3,4,1,2]                                                 
210      DATA Denom(3  )/            3/                                       
211      DATA (CF(i,3  ),i=1  ,3  ) /    -4,   -4,    8/                     
212C               F[1,2]T[3,4]                                               
213C ----------
214C BEGIN CODE
215C ----------
216      CALL VXXXXX(P(0,1   ),ZERO ,NHEL(1   ),-1*IC(1   ),W(1,1   ))       
217      CALL VXXXXX(P(0,2   ),ZERO ,NHEL(2   ),-1*IC(2   ),W(1,2   ))       
218      CALL OXXXXX(P(0,3   ),TMASS ,NHEL(3   ),+1*IC(3   ),W(1,3   ))       
219      CALL IXXXXX(P(0,4   ),TMASS ,NHEL(4   ),-1*IC(4   ),W(1,4   ))       
220      CALL FVOXXX(W(1,3   ),W(1,2   ),GG ,TMASS   ,TWIDTH  ,W(1,5   ))     
221      CALL IOVXXX(W(1,4   ),W(1,5   ),W(1,1   ),GG ,AMP(1   ))             
222      CALL FVOXXX(W(1,3   ),W(1,1   ),GG ,TMASS   ,TWIDTH  ,W(1,6   ))     
223      CALL IOVXXX(W(1,4   ),W(1,6   ),W(1,2   ),GG ,AMP(2   ))             
224      CALL JVVXXX(W(1,1   ),W(1,2   ),G ,ZERO    ,ZERO    ,W(1,7   ))     
225      CALL IOVXXX(W(1,4   ),W(1,3   ),W(1,7   ),GG ,AMP(3   ))             
226      CALL HVVhXX(W(1,1   ),W(1,2   ),Gs0g ,S0MASS  ,S0WIDTH ,W(1,         
227     &     8   ))                                                         
228      CALL IOSXXX(W(1,4   ),W(1,3   ),W(1,8   ),Gs0t ,AMP(4   ))           
229      JAMP(   1) = -AMP(1)+AMP(3)-AMP(4)/2d0
230      JAMP(   2) = -AMP(2)-AMP(3)-AMP(4)/2d0
231      JAMP(   3) = -AMP(4)/2d0
232      MATRIX = 0.D0
233      DO I = 1, NCOLOR
234          ZTEMP = (0.D0,0.D0)
235          DO J = 1, NCOLOR
236              ZTEMP = ZTEMP + CF(J,I)*JAMP(J)
237          ENDDO
238          MATRIX =MATRIX+ZTEMP*DCONJG(JAMP(I))/DENOM(I)   
239      ENDDO
240      Do I = 1, NGRAPHS
241          amp2(i)=amp2(i)+amp(i)*dconjg(amp(i))
242      Enddo
243      Do I = 1, NCOLOR
244          Jamp2(i)=Jamp2(i)+Jamp(i)*dconjg(Jamp(i))
245      Enddo
246C      CALL GAUGECHECK(JAMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NCOLOR,NEIGEN)
247      END
248       
249