Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C*********************************************************************
0003  
0004 C...PYSPLI
0005 C...Splits a hadron remnant into two (partons or hadron + parton)
0006 C...in case it is more complicated than just a quark or a diquark.
0007  
0008       SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP)
0009  
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Commonblocks. PYDAT1 temporary
0015       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0016       COMMON/PYINT1/MINT(400),VINT(400)
0017       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0018       SAVE /PYPARS/,/PYINT1/,/PYDAT1/
0019 C...Local array.
0020       DIMENSION KFL(3)
0021  
0022 C...Preliminaries. Parton composition.
0023       KFA=IABS(KF)
0024       KFS=ISIGN(1,KF)
0025       KFL(1)=MOD(KFA/1000,10)
0026       KFL(2)=MOD(KFA/100,10)
0027       KFL(3)=MOD(KFA/10,10)
0028       IF(KFA.EQ.22.AND.MINT(109).EQ.2) THEN
0029         KFL(2)=INT(1.5D0+PYR(0))
0030         IF(MINT(105).EQ.333) KFL(2)=3
0031         IF(MINT(105).EQ.443) KFL(2)=4
0032         KFL(3)=KFL(2)
0033       ELSEIF((KFA.EQ.111.OR.KFA.EQ.113).AND.PYR(0).GT.0.5D0) THEN
0034         KFL(2)=2
0035         KFL(3)=2
0036       ELSEIF(KFA.EQ.223.AND.PYR(0).GT.0.5D0) THEN
0037         KFL(2)=1
0038         KFL(3)=1
0039       ELSEIF((KFA.EQ.130.OR.KFA.EQ.310).AND.PYR(0).GT.0.5D0) THEN
0040         KFL(2)=MOD(KFA/10,10)
0041         KFL(3)=MOD(KFA/100,10)
0042       ENDIF
0043       IF(KFLIN.NE.21.AND.KFLIN.NE.22.AND.KFLIN.NE.23) THEN
0044         KFLR=KFLIN*KFS
0045       ELSE
0046         KFLR=KFLIN
0047       ENDIF
0048       KFLCH=0
0049  
0050 C...Subdivide lepton.
0051       IF(KFA.GE.11.AND.KFA.LE.18) THEN
0052         IF(KFLR.EQ.KFA) THEN
0053           KFLSP=KFS*22
0054         ELSEIF(KFLR.EQ.22) THEN
0055           KFLSP=KFA
0056         ELSEIF(KFLR.EQ.-24.AND.MOD(KFA,2).EQ.1) THEN
0057           KFLSP=KFA+1
0058         ELSEIF(KFLR.EQ.24.AND.MOD(KFA,2).EQ.0) THEN
0059           KFLSP=KFA-1
0060         ELSEIF(KFLR.EQ.21) THEN
0061           KFLSP=KFA
0062           KFLCH=KFS*21
0063         ELSE
0064           KFLSP=KFA
0065           KFLCH=-KFLR
0066         ENDIF
0067  
0068 C...Subdivide photon.
0069       ELSEIF(KFA.EQ.22.AND.MINT(109).NE.2) THEN
0070         IF(KFLR.NE.21) THEN
0071           KFLSP=-KFLR
0072         ELSE
0073           RAGR=0.75D0*PYR(0)
0074           KFLSP=1
0075           IF(RAGR.GT.0.125D0) KFLSP=2
0076           IF(RAGR.GT.0.625D0) KFLSP=3
0077           IF(PYR(0).GT.0.5D0) KFLSP=-KFLSP
0078           KFLCH=-KFLSP
0079         ENDIF
0080  
0081 C...Subdivide Reggeon or Pomeron.
0082       ELSEIF(KFA.EQ.110.OR.KFA.EQ.990) THEN
0083         IF(KFLIN.EQ.21) THEN
0084           KFLSP=KFS*21
0085         ELSE
0086           KFLSP=-KFLIN
0087         ENDIF
0088  
0089 C...Subdivide meson.
0090       ELSEIF(KFL(1).EQ.0) THEN
0091         KFL(2)=KFL(2)*(-1)**KFL(2)
0092         KFL(3)=-KFL(3)*(-1)**IABS(KFL(2))
0093         IF(KFLR.EQ.KFL(2)) THEN
0094           KFLSP=KFL(3)
0095         ELSEIF(KFLR.EQ.KFL(3)) THEN
0096           KFLSP=KFL(2)
0097         ELSEIF(KFLR.EQ.21.AND.PYR(0).GT.0.5D0) THEN
0098           KFLSP=KFL(2)
0099           KFLCH=KFL(3)
0100         ELSEIF(KFLR.EQ.21) THEN
0101           KFLSP=KFL(3)
0102           KFLCH=KFL(2)
0103         ELSEIF(KFLR*KFL(2).GT.0) THEN
0104           NTRY=0
0105   100     NTRY=NTRY+1
0106           CALL PYKFDI(-KFLR,KFL(2),KFDUMP,KFLCH)
0107           IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN
0108             GOTO 100
0109           ELSEIF(KFLCH.EQ.0) THEN
0110             CALL PYERRM(14,'(PYSPLI:) caught in infinite loop')
0111             MINT(51)=1
0112             RETURN
0113           ENDIF
0114           KFLSP=KFL(3)
0115         ELSE
0116           NTRY=0
0117   110     NTRY=NTRY+1
0118           CALL PYKFDI(-KFLR,KFL(3),KFDUMP,KFLCH)
0119           IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN
0120             GOTO 110
0121           ELSEIF(KFLCH.EQ.0) THEN
0122             CALL PYERRM(14,'(PYSPLI:) caught in infinite loop')
0123             MINT(51)=1
0124             RETURN
0125           ENDIF
0126           KFLSP=KFL(2)
0127         ENDIF
0128 
0129 C...Special case for extracting photon from baryon without splitting
0130 C...the latter. (Currently only used by external programs.)
0131       ELSEIF(KFLIN.EQ.22.AND.MSTP(98).EQ.1) then
0132         KFLSP=KFA
0133         KFLCH=0
0134  
0135 C...Subdivide baryon.
0136       ELSE
0137         NAGR=0
0138         DO 120 J=1,3
0139           IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1
0140   120   CONTINUE
0141         IF(NAGR.GE.1) THEN
0142           RAGR=0.00001D0+(NAGR-0.00002D0)*PYR(0)
0143           IAGR=0
0144           DO 130 J=1,3
0145             IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1D0
0146             IF(IAGR.EQ.0.AND.RAGR.LE.0D0) IAGR=J
0147   130     CONTINUE
0148         ELSE
0149           IAGR=1.00001D0+2.99998D0*PYR(0)
0150         ENDIF
0151         ID1=1
0152         IF(IAGR.EQ.1) ID1=2
0153         IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3
0154         ID2=6-IAGR-ID1
0155         KSP=3
0156         IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN
0157           IF(IAGR.NE.3.AND.PYR(0).GT.0.25D0) KSP=1
0158         ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN
0159           IF(IAGR.NE.1.AND.PYR(0).GT.0.25D0) KSP=1
0160         ELSEIF(MOD(KFA,10).EQ.2) THEN
0161           IF(IAGR.EQ.1) KSP=1
0162           IF(IAGR.NE.1.AND.PYR(0).GT.0.75D0) KSP=1
0163         ENDIF
0164         KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP
0165         IF(KFLR.EQ.21) THEN
0166           KFLCH=KFL(IAGR)
0167         ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN
0168           NTRY=0
0169   140     NTRY=NTRY+1
0170           CALL PYKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH)
0171           IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN
0172             GOTO 140
0173           ELSEIF(KFLCH.EQ.0) THEN
0174             CALL PYERRM(14,'(PYSPLI:) caught in infinite loop')
0175             MINT(51)=1
0176             RETURN
0177           ENDIF
0178         ELSEIF(NAGR.EQ.0) THEN
0179           NTRY=0
0180   150     NTRY=NTRY+1
0181           CALL PYKFDI(10000*KFL(ID1)+KFLSP,-KFLR,KFDUMP,KFLCH)
0182           IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN
0183             GOTO 150
0184           ELSEIF(KFLCH.EQ.0) THEN
0185             CALL PYERRM(14,'(PYSPLI:) caught in infinite loop')
0186             MINT(51)=1
0187             RETURN
0188           ENDIF
0189           KFLSP=KFL(IAGR)
0190         ENDIF
0191       ENDIF
0192  
0193 C...Add on correct sign for result.
0194       KFLCH=KFLCH*KFS
0195       KFLSP=KFLSP*KFS
0196  
0197       RETURN
0198       END