Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C*********************************************************************
0003  
0004 C...PYFOWO
0005 C...Calculates the first few Fox-Wolfram moments.
0006  
0007       SUBROUTINE PYFOWO(H10,H20,H30,H40)
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/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0018       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0019       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0020       SAVE /PYJETS/,/PYDAT1/,/PYDAT2/
0021  
0022 C...Copy momenta for particles and calculate H0.
0023       NP=0
0024       H0=0D0
0025       HD=0D0
0026       DO 110 I=1,N
0027         IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
0028         IF(MSTU(41).GE.2) THEN
0029           KC=PYCOMP(K(I,2))
0030           IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
0031      &    KC.EQ.18.OR.K(I,2).EQ.KSUSY1+22.OR.K(I,2).EQ.39.OR.
0032      &    K(I,2).EQ.KSUSY1+39) GOTO 110
0033           IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
0034      &    GOTO 110
0035         ENDIF
0036         IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN
0037           CALL PYERRM(11,'(PYFOWO:) no more memory left in PYJETS')
0038           H10=-1D0
0039           H20=-1D0
0040           H30=-1D0
0041           H40=-1D0
0042           RETURN
0043         ENDIF
0044         NP=NP+1
0045         DO 100 J=1,3
0046           P(N+NP,J)=P(I,J)
0047   100   CONTINUE
0048         P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
0049         H0=H0+P(N+NP,4)
0050         HD=HD+P(N+NP,4)**2
0051   110 CONTINUE
0052       H0=H0**2
0053  
0054 C...Very low multiplicities (0 or 1) not considered.
0055       IF(NP.LE.1) THEN
0056         CALL PYERRM(8,'(PYFOWO:) too few particles for analysis')
0057         H10=-1D0
0058         H20=-1D0
0059         H30=-1D0
0060         H40=-1D0
0061         RETURN
0062       ENDIF
0063  
0064 C...Calculate H1 - H4.
0065       H10=0D0
0066       H20=0D0
0067       H30=0D0
0068       H40=0D0
0069       DO 130 I1=N+1,N+NP
0070         DO 120 I2=I1+1,N+NP
0071           CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
0072      &    (P(I1,4)*P(I2,4))
0073           H10=H10+P(I1,4)*P(I2,4)*CTHE
0074           H20=H20+P(I1,4)*P(I2,4)*(1.5D0*CTHE**2-0.5D0)
0075           H30=H30+P(I1,4)*P(I2,4)*(2.5D0*CTHE**3-1.5D0*CTHE)
0076           H40=H40+P(I1,4)*P(I2,4)*(4.375D0*CTHE**4-3.75D0*CTHE**2+
0077      &    0.375D0)
0078   120   CONTINUE
0079   130 CONTINUE
0080  
0081 C...Calculate H1/H0 - H4/H0. Output.
0082       MSTU(61)=N+1
0083       MSTU(62)=NP
0084       H10=(HD+2D0*H10)/H0
0085       H20=(HD+2D0*H20)/H0
0086       H30=(HD+2D0*H30)/H0
0087       H40=(HD+2D0*H40)/H0
0088  
0089       RETURN
0090       END