pythiaeRHIC/pythia/pytecm.f

0001
0002 C*********************************************************************
0003
0004 C...PYTECM
0005 C...Finds the s-hat dependent eigenvalues of the inverse propagator
0006 C...matrix for gamma, Z, techni-rho, and techni-omega to optimize the
0007 C...phase space generation.
0008
0009       SUBROUTINE PYTECM(S1,S2)
0010
0011 C...Double precision and integer declarations.
0012       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0013       IMPLICIT INTEGER(I-N)
0014       INTEGER PYK,PYCHGE,PYCOMP
0015 C...Parameter statement to help give large particle numbers.
0016       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0017      &KEXCIT=4000000,KDIMEN=5000000)
0018 C...Commonblocks.
0019       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0020       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0021       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0022       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0023       SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYTCSM/
0024
0025 C...Local variables.
0026       DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),WORK(12,12),
0027      &AT(4,4),WI(4),FV1(4),FV2(4),FV3(4),sh,aem,tanw,ct2w,qupd,alprht,
0028      &far,fao,fzr,fzo,shr,R1,R2,S1,S2,WDTP(0:400),WDTE(0:400,0:5)
0029       INTEGER i,j,ierr
0030
0031       SH=PMAS(PYCOMP(KTECHN+113),1)**2
0032       AEM=PYALEM(SH)
0033
0034       TANW=SQRT(PARU(102)/(1D0-PARU(102)))
0035       CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW)
0036       QUPD=2D0*RTCM(2)-1D0
0037
0038       ALPRHT=2.91D0*(3D0/DBLE(ITCM(1)))
0039       FAR=SQRT(AEM/ALPRHT)
0040       FAO=FAR*QUPD
0041       FZR=FAR*CT2W
0042       FZO=-FAO*TANW
0043
0044       AR(1,1) = SH
0045       AR(2,2) = SH-PMAS(23,1)**2
0046       AR(3,3) = SH-PMAS(PYCOMP(KTECHN+113),1)**2
0047       AR(4,4) = SH-PMAS(PYCOMP(KTECHN+223),1)**2
0048       AR(1,2) = 0D0
0049       AR(2,1) = 0D0
0050       AR(1,3) = -SH*FAR
0051       AR(3,1) = AR(1,3)
0052       AR(1,4) = -SH*FAO
0053       AR(4,1) = AR(1,4)
0054       AR(2,3) = -SH*FZR
0055       AR(3,2) = AR(2,3)
0056       AR(2,4) = -SH*FZO
0057       AR(4,2) = AR(2,4)
0058       AR(3,4) = 0D0
0059       AR(4,3) = 0D0
0060 CCCCCCCC
0061       DO 110 I=1,4
0062         DO 100 J=1,4
0063           AT(I,J)=0D0
0064   100   CONTINUE
0065   110 CONTINUE
0066       SHR=SQRT(SH)
0067       CALL PYWIDT(23,SH,WDTP,WDTE)
0068       AT(2,2) = WDTP(0)*SHR
0069       CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE)
0070       AT(3,3) = WDTP(0)*SHR
0071       CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE)
0072       AT(4,4) = WDTP(0)*SHR
0073 CCCC
0074       CALL PYEICG(4,4,AR,AT,WR,WI,0,ZR,ZI,FV1,FV2,FV3,IERR)
0075       DO 120 I=1,4
0076         WI(I)=SQRT(ABS(SH-WR(I)))
0077         WR(I)=ABS(WR(I))
0078   120 CONTINUE
0079       R1=MIN(WR(1),WR(2),WR(3),WR(4))
0080       R2=1D20
0081       S1=0D0
0082       S2=0D0
0083       DO 130 I=1,4
0084         IF(ABS(WR(I)-R1).LT.1D-6) THEN
0085           S1=WI(I)
0086           GOTO 130
0087         ENDIF
0088         IF(WR(I).LE.R2) THEN
0089           R2=WR(I)
0090           S2=WI(I)
0091         ENDIF
0092   130 CONTINUE
0093       S1=S1**2
0094       S2=S2**2
0095       RETURN
0096       END