ISAJET/code/sigee.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SIGEE
   3 C
   4 C          Compute d(sigma)/d(cos theta) with interference
   5 C          and polarization for
   6 C          E+ E- --> GM, Z0 ----> QK QB, L LB, N NB, W+ W-, Z Z
   7 C
   8 C          SIGS(I)  = partial cross section for I1 + I2 --> I3 + I4.
   9 C          INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1
  10 C                     USING JETTYPE CODE.
  11 C
  12 C          Extra factor of 1/2 needed because all jets are treated
  13 C          as identical.
  14 C          Version 7.42 includes bremsstrahlung contribution;
  15 C          also, beamstrahlung
  16 C
  17 #if defined(CERNLIB_IMPNONE)
  18       IMPLICIT NONE
  19 #endif
  20 #include "isajet/itapes.inc"
  21 #include "isajet/jetsig.inc"
  22 #include "isajet/eepar.inc"
  23 #include "isajet/primar.inc"
  24 #include "isajet/jetpar.inc"
  25 #include "isajet/q1q2.inc"
  26 #include "isajet/const.inc"
  27 #include "isajet/wcon.inc"
  28 #include "isajet/brembm.inc"
  29 C
  30       REAL FLEP,FLEM,FREP,FREM,PROPZ,REDZ,SH,E,G,GP,COS2W,
  31      $TNTHW,CTTHW,ALQ(2),BEQ(2),ALL(2),BEL(2),AE,BE,EQ,AMQ,AMQ2,
  32      $PCM,Z,AF,BF,PHILRG,PHILRZ,PHILRI,PHIRLG,PHIRLZ,PHIRLI,
  33      $THT,UH,RSH,UT,PHIRL,PHILR,SIGLR,SIGRL,SIG,AMASS,
  34      $ALFAEM,AMZ,GAMZ,AMW,JAC,ESTRUC,SSFEL
  35       INTEGER I,IQ,IQ2,IFL,ISGN,IQ2EQ(25)
  36       DATA IQ2EQ/0,2,-2,-1,1,-1,1,2,-2,-1,1,2,-2,0,0,-3,3,
  37      $0,0,-3,3,0,0,-3,3/
  38 C          Fractional polarizations
  39       FLEP=(1.+PLEP)/2.
  40       FLEM=(1.+PLEM)/2.
  41       FREP=(1.-PLEP)/2.
  42       FREM=(1.-PLEM)/2.
  43 C          FUNCTIONS
  44       ALFAEM=1./128.
  45       AMZ=WMASS(4)
  46       GAMZ=WGAM(4)
  47       AMW=WMASS(3)
  48       IF (IBREM) THEN
  49         SH=SHAT
  50         JAC=2*(1.-SHAT/SCM)*2*SQRT(SH)*(RSHMAX-RSHMIN)/SCM/(X1+X2)
  51       ELSE
  52         SH=SCM
  53       END IF
  54       PROPZ=(SH-AMZ**2)**2+AMZ**2*GAMZ**2
  55       REDZ=(SH-AMZ**2)/PROPZ
  56 C
  57 C          CONSTANTS
  58       RSH=SQRT(SH)
  59       EB=RSH/2.
  60       QSQBM=QSQ
  61       E=SQRT(4*PI*ALFAEM)
  62       G=SQRT(4*PI*ALFAEM/SIN2W)
  63       GP=G*SQRT(SIN2W/(1.-SIN2W))
  64       COS2W=1.-SIN2W
  65       TNTHW=SQRT(SIN2W/COS2W)
  66       CTTHW=1./TNTHW
  67       ALQ(1)=CTTHW/4.-5*TNTHW/12.
  68       BEQ(1)=-(CTTHW+TNTHW)/4.
  69       ALQ(2)=TNTHW/12.-CTTHW/4.
  70       BEQ(2)=-BEQ(1)
  71       ALL(1)=(CTTHW+TNTHW)/4.
  72       BEL(1)=-(CTTHW+TNTHW)/4.
  73       ALL(2)=(3*TNTHW-CTTHW)/4.
  74       BEL(2)=-BEL(1)
  75       AE=ALL(2)
  76       BE=BEL(2)
  77 C
  78 C          ENTRY
  79       SIG=0.
  80       SIGMA=0.
  81       NSIGS=0
  82       DO 10 I=1,MXSIGS
  83 10    SIGS(I)=0.
  84 C
  85 C          Sum over allowed jet types. IQ labels JETTYPE1.
  86 C
  87       DO 100 IQ=2,25
  88         IQ2=MATCH(IQ,4)
  89         IF(.NOT.(GOQ(IQ,1).AND.GOQ(IQ2,2))) GO TO 100
  90         IFL=IQ/2
  91         EQ=ABS(FLOAT(IQ2EQ(IQ))/3.)
  92         IF (EQ.LT..5.OR.EQ.GT..8) EQ=-EQ
  93         ISGN=1
  94         IF(2*IFL.NE.IQ) ISGN=2
  95         AMQ=AMASS(IFL)
  96         AMQ2=AMQ**2
  97         IF(2.*AMQ.GE.ECM) GO TO 100
  98         PCM=.5*SQRT(SH-4.*AMQ2)
  99         Z=CTH(ISGN)
 100         IF (IQ.LE.13.AND.ABS(EQ).GT..5) THEN
 101           AF=ALQ(1)
 102           BF=BEQ(1)
 103         ELSE IF (IQ.LE.13.AND.ABS(EQ).LT..5) THEN
 104           AF=ALQ(2)
 105           BF=BEQ(2)
 106         ELSE IF (IQ.GT.13.AND.ABS(EQ).EQ.0.) THEN
 107           AF=ALL(1)
 108           BF=BEL(1)
 109         ELSE
 110           AF=ALL(2)
 111           BF=BEL(2)
 112         END IF
 113         PHILRG=EQ**2/SH**2*(EB**2*(1.+Z**2)+AMQ2*(1.-Z**2))
 114         PHILRZ=(AE-BE)**2/PROPZ*((AF**2+BF**2)*(EB**2+PCM**2*Z**2)-
 115      ,     4*AF*BF*EB*PCM*Z+(AF**2-BF**2)*AMQ2)
 116         PHILRI=-2*EQ*(AE-BE)*REDZ/SH*
 117      ,     (AF*(EB**2*(1.+Z**2)+AMQ2*(1.-Z**2))-2*BF*EB*PCM*Z)
 118         PHILR=E**4*(PHILRG+PHILRZ+PHILRI)
 119         PHIRLG=PHILRG
 120         PHIRLZ=(AE+BE)**2/PROPZ*((AF**2+BF**2)*(EB**2+PCM**2*Z**2)+
 121      ,     4*AF*BF*EB*PCM*Z+(AF**2-BF**2)*AMQ2)
 122         PHIRLI=-2*EQ*(AE+BE)*REDZ/SH*
 123      ,     (AF*(EB**2*(1.+Z**2)+AMQ2*(1.-Z**2))+2*BF*EB*PCM*Z)
 124         PHIRL=E**4*(PHIRLG+PHIRLZ+PHIRLI)
 125         SIGLR=4*PCM*PHILR/16./PI/EB
 126         SIGRL=4*PCM*PHIRL/16./PI/EB
 127         SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2.
 128         IF (IQ.LE.13) SIG=3*SIG
 129         IF (IBREM.AND..NOT.IBEAM) THEN
 130           SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC
 131         ELSE IF (IBEAM) THEN
 132           SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC
 133         END IF
 134         CALL SIGFIL(SIG,0,0,IQ,IQ2)
 135 100   CONTINUE
 136 C           Z Z Cross section
 137       IF(.NOT.(GOQ(29,1).AND.GOQ(29,2))) GO TO 200
 138         PCM=.5*SQRT(SH-4.*AMZ**2)
 139         THT=AMZ**2-SH/2.+RSH*PCM*CTH(1)
 140         UH=2*AMZ**2-SH-THT
 141         SIGLR=4*E**4*(AE-BE)**4*PCM/16./PI/SH/RSH*
 142      ,   (UH/THT+THT/UH+4*AMZ**2*SH/UH/THT-AMZ**4*(1./THT**2+1./UH**2))
 143         SIGRL=4*E**4*(AE+BE)**4*PCM/16./PI/SH/RSH*
 144      ,   (UH/THT+THT/UH+4*AMZ**2*SH/UH/THT-AMZ**4*(1./THT**2+1./UH**2))
 145         SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2.
 146         IF (IBREM.AND..NOT.IBEAM) THEN
 147           SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC
 148         ELSE IF (IBEAM) THEN
 149           SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC
 150         END IF
 151         CALL SIGFIL(SIG,0,0,29,29)
 152 200   CONTINUE
 153 C           W W Cross section
 154       IF(.NOT.(GOQ(27,1).AND.GOQ(28,2))) GO TO 300
 155         PCM=.5*SQRT(SH-4.*AMW**2)
 156         THT=AMW**2-SH/2.+RSH*PCM*CTH(2)
 157         UH=2*AMW**2-SH-THT
 158         UT=UH*THT-AMW**4
 159         PHIRL=4*(AE+BE)**2*TNTHW**2/SH/SH/PROPZ*
 160      ,        (UT*(PCM**2*SH+3*AMW**4)+4*AMW**2*PCM**2*SH*SH)
 161         PHILR=UT/SH/SH*(3.+2*(AE-BE)*TNTHW*(SH-6*AMW**2)*REDZ+
 162      ,      4*(AE-BE)**2*TNTHW**2*(PCM**2*SH+3*AMW**4)/PROPZ)+
 163      ,      8*(AE-BE)*TNTHW*AMW**2*REDZ+16*(AE-BE)**2*TNTHW**2*
 164      ,      AMW**2*PCM**2/PROPZ+2*(1.-2*(AE-BE)*TNTHW*AMW**2*REDZ)*
 165      ,      (UT/SH/THT-2*AMW**2/THT)+UT/THT**2
 166         SIGLR=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHILR
 167         SIGRL=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHIRL
 168         SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2.
 169         IF (IBREM.AND..NOT.IBEAM) THEN
 170           SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC
 171         ELSE IF (IBEAM) THEN
 172           SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC
 173         END IF
 174         CALL SIGFIL(SIG,0,0,27,28)
 175 300   CONTINUE
 176       IF(.NOT.(GOQ(28,1).AND.GOQ(27,2))) GO TO 400
 177         PCM=.5*SQRT(SH-4.*AMW**2)
 178         THT=AMW**2-SH/2.+RSH*PCM*CTH(1)
 179         UH=2*AMW**2-SH-THT
 180         UT=UH*THT-AMW**4
 181         PHIRL=4*(AE+BE)**2*TNTHW**2/SH/SH/PROPZ*
 182      ,        (UT*(PCM**2*SH+3*AMW**4)+4*AMW**2*PCM**2*SH*SH)
 183         PHILR=UT/SH/SH*(3.+2*(AE-BE)*TNTHW*(SH-6*AMW**2)*REDZ+
 184      ,      4*(AE-BE)**2*TNTHW**2*(PCM**2*SH+3*AMW**4)/PROPZ)+
 185      ,      8*(AE-BE)*TNTHW*AMW**2*REDZ+16*(AE-BE)**2*TNTHW**2*
 186      ,      AMW**2*PCM**2/PROPZ+2*(1.-2*(AE-BE)*TNTHW*AMW**2*REDZ)*
 187      ,      (UT/SH/THT-2*AMW**2/THT)+UT/THT**2
 188         SIGLR=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHILR
 189         SIGRL=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHIRL
 190         SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2.
 191         IF (IBREM.AND..NOT.IBEAM) THEN
 192           SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC
 193         ELSE IF (IBEAM) THEN
 194           SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC
 195         END IF
 196         CALL SIGFIL(SIG,0,0,28,27)
 197 400   CONTINUE
 198 C-----------------------------------------------------------------------
 199       RETURN
 200       END