File indexing completed on 2025-08-05 08:21:18
0001
0002
0003
0004
0005
0006
0007
0008 SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP)
0009
0010
0011 IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012 IMPLICIT INTEGER(I-N)
0013 INTEGER PYK,PYCHGE,PYCOMP
0014
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
0020 DIMENSION KFL(3)
0021
0022
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
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
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
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
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
0130
0131 ELSEIF(KFLIN.EQ.22.AND.MSTP(98).EQ.1) then
0132 KFLSP=KFA
0133 KFLCH=0
0134
0135
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
0194 KFLCH=KFLCH*KFS
0195 KFLSP=KFLSP*KFS
0196
0197 RETURN
0198 END