Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:21

0001  
0002 C*********************************************************************
0003  
0004 C...PYXXZ6
0005 C...Used in the calculation of  inoi -> inoj + f + ~f.
0006  
0007       FUNCTION PYXXZ6(X)
0008  
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013 C...Parameter statement to help give large particle numbers.
0014       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0015      &KEXCIT=4000000,KDIMEN=5000000)
0016 C...Commonblocks.
0017       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0018 C      COMMON/PYINTS/XXM(20)
0019       COMPLEX*16 CXC
0020       COMMON/PYINTC/XXC(10),CXC(8)
0021       SAVE /PYDAT1/,/PYINTC/
0022  
0023 C...Local variables.
0024       COMPLEX*16 QLLS,QRRS,QRLS,QLRS,QLLU,QRRU,QLRT,QRLT
0025       DOUBLE PRECISION PYXXZ6,X
0026       DOUBLE PRECISION XM12,XM22,XM32,S,S13,WPROP2
0027       DOUBLE PRECISION WW,WF1,WF2,WFL1,WFL2
0028       DOUBLE PRECISION SIJ
0029       DOUBLE PRECISION XMV,XMG,XMSU1,XMSU2,XMSD1,XMSD2
0030       DOUBLE PRECISION OL2
0031       DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL
0032       INTEGER I
0033  
0034 C...Statement functions.
0035 C...Integral from x to y of (t-a)(b-t) dt.
0036       TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B)
0037 C...Integral from x to y of (t-a)(b-t)/(t-c) dt.
0038       TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))-
0039      &LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A)
0040 C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt.
0041       TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+
0042      &(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C)))
0043 C...Integral from x to y of (t-a)/(b-t) dt.
0044       UTINT(X,Y,A,B)=LOG(ABS((X-A)/(B-X)*(B-Y)/(Y-A)))/(B-A)
0045 C...Integral from x to y of 1/(t-a) dt.
0046       TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A)))
0047  
0048       XM12=XXC(1)**2
0049       XM22=XXC(2)**2
0050       XM32=XXC(3)**2
0051       S=XXC(4)**2
0052       S13=X
0053  
0054       S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S)
0055       S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)*
0056      &( (X-XM22-S)**2  -4D0*XM22*S  ) )
0057  
0058       S23MIN=(S23AVE-S23DEL)
0059       S23MAX=(S23AVE+S23DEL)
0060  
0061       XMSD1=XXC(5)**2
0062       XMSD2=XXC(7)**2
0063       XMSU1=XXC(6)**2
0064       XMSU2=XXC(8)**2
0065  
0066       XMV=XXC(9)
0067       XMG=XXC(10)
0068       QLLS=CXC(1)
0069       QLLU=CXC(2)
0070       QLRS=CXC(3)
0071       QLRT=CXC(4)
0072       QRLS=CXC(5)
0073       QRLT=CXC(6)
0074       QRRS=CXC(7)
0075       QRRU=CXC(8)
0076       WPROP2=(S13-XMV**2)**2+(XMV*XMG)**2
0077       SIJ=2D0*XXC(2)*XXC(4)*S13
0078       IF(XMV.LE.1000D0) THEN
0079         OL2=ABS(QLLS)**2+ABS(QRRS)**2+ABS(QLRS)**2+ABS(QRLS)**2
0080         OLR=-2D0*DBLE(QLRS*DCONJG(QLLS)+QRLS*DCONJG(QRRS))
0081         WW=(OL2*2D0*TINT(S23MAX,S23MIN,XM22,S)
0082      &  +OLR*SIJ*(S23MAX-S23MIN))/WPROP2
0083         IF(XXC(5).LE.10000D0) THEN
0084           WFL1=4D0*(DBLE(QLLS*DCONJG(QLLU))*
0085      &    TINT2(S23MAX,S23MIN,XM22,S,XMSD1)-
0086      &    .5D0*DBLE(QLLS*DCONJG(QLRT))*SIJ*TPROP(S23MAX,S23MIN,XMSD2)+
0087      &    DBLE(QLRS*DCONJG(QLRT))*TINT2(S23MAX,S23MIN,XM22,S,XMSD2)-
0088      &    .5D0*DBLE(QLRS*DCONJG(QLLU))*SIJ*TPROP(S23MAX,S23MIN,XMSD1))
0089      &    *(S13-XMV**2)/WPROP2
0090         ELSE
0091           WFL1=0D0
0092         ENDIF
0093  
0094         IF(XXC(6).LE.10000D0) THEN
0095           WFL2=4D0*(DBLE(QRRS*DCONJG(QRRU))*
0096      &    TINT2(S23MAX,S23MIN,XM22,S,XMSU1)-
0097      &    .5D0*DBLE(QRRS*DCONJG(QRLT))*SIJ*TPROP(S23MAX,S23MIN,XMSU2)+
0098      &    DBLE(QRLS*DCONJG(QRLT))*TINT2(S23MAX,S23MIN,XM22,S,XMSU2)-
0099      &    .5D0*DBLE(QRLS*DCONJG(QRRU))*SIJ*TPROP(S23MAX,S23MIN,XMSU1))
0100      &    *(S13-XMV**2)/WPROP2
0101         ELSE
0102           WFL2=0D0
0103         ENDIF
0104       ELSE
0105         WW=0D0
0106         WFL1=0D0
0107         WFL2=0D0
0108       ENDIF
0109       IF(XXC(5).LE.10000D0) THEN
0110         WF1=2D0*ABS(QLLU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD1)
0111      &  +2D0*ABS(QLRT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD2)
0112      &  - 2D0*DBLE(QLRT*DCONJG(QLLU))*
0113      &  SIJ*UTINT(S23MAX,S23MIN,XMSD1,XM22+S-S13-XMSD2)
0114       ELSE
0115         WF1=0D0
0116       ENDIF
0117       IF(XXC(6).LE.10000D0) THEN
0118         WF2=2D0*ABS(QRRU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU1)
0119      &  +2D0*ABS(QRLT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU2)
0120      &  - 2D0*DBLE(QRLT*DCONJG(QRRU))*
0121      &  SIJ*UTINT(S23MAX,S23MIN,XMSU1,XM22+S-S13-XMSU2)
0122       ELSE
0123         WF2=0D0
0124       ENDIF
0125  
0126       PYXXZ6=(WW+WF1+WF2+WFL1+WFL2)
0127  
0128       IF(PYXXZ6.LT.0D0) THEN
0129         WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXZ6 '
0130         WRITE(MSTU(11),*) XXc(1),XXc(2),XXc(3),XXc(4)
0131         WRITE(MSTU(11),*) (XXc(I),I=5,8)
0132         WRITE(MSTU(11),*) (XXc(I),I=9,12)
0133         WRITE(MSTU(11),*) (XXc(I),I=13,16)
0134         WRITE(MSTU(11),*) WW,WF1,WF2,WFL1,WFL2
0135         WRITE(MSTU(11),*) S23MIN,S23MAX
0136         PYXXZ6=0D0
0137       ENDIF
0138  
0139       RETURN
0140       END