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...PYXTOT
0005 C...Parametrizes total, elastic and diffractive cross-sections
0006 C...for different energies and beams. Donnachie-Landshoff for
0007 C...total and Schuler-Sjostrand for elastic and diffractive.
0008 C...Process code IPROC:
0009 C...=  1 : p + p;
0010 C...=  2 : pbar + p;
0011 C...=  3 : pi+ + p;
0012 C...=  4 : pi- + p;
0013 C...=  5 : pi0 + p;
0014 C...=  6 : phi + p;
0015 C...=  7 : J/psi + p;
0016 C...= 11 : rho + rho;
0017 C...= 12 : rho + phi;
0018 C...= 13 : rho + J/psi;
0019 C...= 14 : phi + phi;
0020 C...= 15 : phi + J/psi;
0021 C...= 16 : J/psi + J/psi;
0022 C...= 21 : gamma + p (DL);
0023 C...= 22 : gamma + p (VDM).
0024 C...= 23 : gamma + pi (DL);
0025 C...= 24 : gamma + pi (VDM);
0026 C...= 25 : gamma + gamma (DL);
0027 C...= 26 : gamma + gamma (VDM).
0028  
0029       SUBROUTINE PYXTOT
0030  
0031 C...Double precision and integer declarations.
0032       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0033       IMPLICIT INTEGER(I-N)
0034       INTEGER PYK,PYCHGE,PYCOMP
0035 C...Commonblocks.
0036       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0037       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0038       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0039       COMMON/PYINT1/MINT(400),VINT(400)
0040       COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
0041       COMMON/PYINT7/SIGT(0:6,0:6,0:5)
0042       SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT5/,/PYINT7/
0043 C...Local arrays.
0044       DIMENSION NPROC(30),XPAR(30),YPAR(30),IHADA(20),IHADB(20),
0045      &PMHAD(4),BHAD(4),BETP(4),IFITSD(20),IFITDD(20),CEFFS(10,8),
0046      &CEFFD(10,9),SIGTMP(6,0:5),EXPO(4)
0047  
0048 C...Common constants.
0049       DATA EPS/0.0808D0/, ETA/-0.4525D0/, ALP/0.25D0/, CRES/2D0/,
0050      &PMRC/1.062D0/, SMP/0.880D0/, FACEL/0.0511D0/, FACSD/0.0336D0/,
0051      &FACDD/0.0084D0/
0052  
0053 C...Number of multiple processes to be evaluated (= 0 : undefined).
0054       DATA NPROC/7*1,3*0,6*1,4*0,4*3,2*6,4*0/
0055 C...X and Y parameters of sigmatot = X * s**epsilon + Y * s**(-eta).
0056       DATA XPAR/2*21.70D0,3*13.63D0,10.01D0,0.970D0,3*0D0,
0057      &8.56D0,6.29D0,0.609D0,4.62D0,0.447D0,0.0434D0,4*0D0,
0058      &0.0677D0,0.0534D0,0.0425D0,0.0335D0,2.11D-4,1.31D-4,4*0D0/
0059       DATA YPAR/
0060      &56.08D0,98.39D0,27.56D0,36.02D0,31.79D0,-1.51D0,-0.146D0,3*0D0,
0061      &13.08D0,-0.62D0,-0.060D0,0.030D0,-0.0028D0,0.00028D0,4*0D0,
0062      &0.129D0,0.115D0,0.081D0,0.072D0,2.15D-4,1.70D-4,4*0D0/
0063  
0064 C...Beam and target hadron class:
0065 C...= 1 : p/n ; = 2 : pi/rho/omega; = 3 : phi; = 4 : J/psi.
0066       DATA IHADA/2*1,3*2,3,4,3*0,3*2,2*3,4,4*0/
0067       DATA IHADB/7*1,3*0,2,3,4,3,2*4,4*0/
0068 C...Characteristic class masses, slope parameters, beta = sqrt(X).
0069       DATA PMHAD/0.938D0,0.770D0,1.020D0,3.097D0/
0070       DATA BHAD/2.3D0,1.4D0,1.4D0,0.23D0/
0071       DATA BETP/4.658D0,2.926D0,2.149D0,0.208D0/
0072       DATA EXPO/2.575D0,2.575D0,2.4D0,2.55D0/
0073  
0074 C...Fitting constants used in parametrizations of diffractive results.
0075       DATA IFITSD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/
0076       DATA IFITDD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/
0077       DATA ((CEFFS(J1,J2),J2=1,8),J1=1,10)/
0078      &0.213D0, 0.0D0, -0.47D0, 150D0, 0.213D0, 0.0D0, -0.47D0, 150D0,
0079      &0.213D0, 0.0D0, -0.47D0, 150D0, 0.267D0, 0.0D0, -0.47D0, 100D0,
0080      &0.213D0, 0.0D0, -0.47D0, 150D0, 0.232D0, 0.0D0, -0.47D0, 110D0,
0081      &0.213D0, 7.0D0, -0.55D0, 800D0, 0.115D0, 0.0D0, -0.47D0, 110D0,
0082      &0.267D0, 0.0D0, -0.46D0,  75D0, 0.267D0, 0.0D0, -0.46D0,  75D0,
0083      &0.232D0, 0.0D0, -0.46D0,  85D0, 0.267D0, 0.0D0, -0.48D0, 100D0,
0084      &0.115D0, 0.0D0, -0.50D0,  90D0, 0.267D0, 6.0D0, -0.56D0, 420D0,
0085      &0.232D0, 0.0D0, -0.48D0, 110D0, 0.232D0, 0.0D0, -0.48D0, 110D0,
0086      &0.115D0, 0.0D0, -0.52D0, 120D0, 0.232D0, 6.0D0, -0.56D0, 470D0,
0087      &0.115D0, 5.5D0, -0.58D0, 570D0, 0.115D0, 5.5D0, -0.58D0, 570D0/
0088       DATA ((CEFFD(J1,J2),J2=1,9),J1=1,10)/
0089      &3.11D0, -7.34D0,  9.71D0, 0.068D0, -0.42D0,  1.31D0,
0090      &-1.37D0,  35.0D0,  118D0,  3.11D0, -7.10D0,  10.6D0,
0091      &0.073D0, -0.41D0, 1.17D0, -1.41D0,  31.6D0,   95D0,
0092      &3.12D0, -7.43D0,  9.21D0, 0.067D0, -0.44D0,  1.41D0,
0093      &-1.35D0,  36.5D0,  132D0,  3.13D0, -8.18D0, -4.20D0,
0094      &0.056D0, -0.71D0, 3.12D0, -1.12D0,  55.2D0, 1298D0,
0095      &3.11D0, -6.90D0,  11.4D0, 0.078D0, -0.40D0,  1.05D0,
0096      &-1.40D0,  28.4D0,   78D0,  3.11D0, -7.13D0,  10.0D0,
0097      &0.071D0, -0.41D0, 1.23D0, -1.34D0,  33.1D0,  105D0,
0098      &3.12D0, -7.90D0, -1.49D0, 0.054D0, -0.64D0,  2.72D0,
0099      &-1.13D0,  53.1D0,  995D0,  3.11D0, -7.39D0,  8.22D0,
0100      &0.065D0, -0.44D0, 1.45D0, -1.36D0,  38.1D0,  148D0,
0101      &3.18D0, -8.95D0, -3.37D0, 0.057D0, -0.76D0,  3.32D0,
0102      &-1.12D0,  55.6D0, 1472D0,  4.18D0, -29.2D0,  56.2D0,
0103      &0.074D0, -1.36D0, 6.67D0, -1.14D0, 116.2D0, 6532D0/
0104  
0105 C...Parameters. Combinations of the energy.
0106       AEM=PARU(101)
0107       PMTH=PARP(102)
0108       S=VINT(2)
0109       SRT=VINT(1)
0110       SEPS=S**EPS
0111       SETA=S**ETA
0112       SLOG=LOG(S)
0113  
0114 C...Ratio of gamma/pi (for rescaling in parton distributions).
0115       VINT(281)=(XPAR(22)*SEPS+YPAR(22)*SETA)/
0116      &(XPAR(5)*SEPS+YPAR(5)*SETA)
0117       VINT(317)=1D0
0118       IF(MINT(50).NE.1) RETURN
0119  
0120 C...Order flavours of incoming particles: KF1 < KF2.
0121       IF(IABS(MINT(11)).LE.IABS(MINT(12))) THEN
0122         KF1=IABS(MINT(11))
0123         KF2=IABS(MINT(12))
0124         IORD=1
0125       ELSE
0126         KF1=IABS(MINT(12))
0127         KF2=IABS(MINT(11))
0128         IORD=2
0129       ENDIF
0130       ISGN12=ISIGN(1,MINT(11)*MINT(12))
0131  
0132 C...Find process number (for lookup tables).
0133       IF(KF1.GT.1000) THEN
0134         IPROC=1
0135         IF(ISGN12.LT.0) IPROC=2
0136       ELSEIF(KF1.GT.100.AND.KF2.GT.1000) THEN
0137         IPROC=3
0138         IF(ISGN12.LT.0) IPROC=4
0139         IF(KF1.EQ.111) IPROC=5
0140       ELSEIF(KF1.GT.100) THEN
0141         IPROC=11
0142       ELSEIF(KF2.GT.1000) THEN
0143         IPROC=21
0144         IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=22
0145       ELSEIF(KF2.GT.100) THEN
0146         IPROC=23
0147         IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=24
0148       ELSE
0149         IPROC=25
0150         IF(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7) IPROC=26
0151       ENDIF
0152  
0153 C... Number of multiple processes to be stored; beam/target side.
0154       NPR=NPROC(IPROC)
0155       MINT(101)=1
0156       MINT(102)=1
0157       IF(NPR.EQ.3) THEN
0158         MINT(100+IORD)=4
0159       ELSEIF(NPR.EQ.6) THEN
0160         MINT(101)=4
0161         MINT(102)=4
0162       ENDIF
0163       N1=0
0164       IF(MINT(101).EQ.4) N1=4
0165       N2=0
0166       IF(MINT(102).EQ.4) N2=4
0167  
0168 C...Do not do any more for user-set or undefined cross-sections.
0169       IF(MSTP(31).LE.0) RETURN
0170       IF(NPR.EQ.0) CALL PYERRM(26,
0171      &'(PYXTOT:) cross section for this process not yet implemented')
0172  
0173 C...Parameters. Combinations of the energy.
0174       AEM=PARU(101)
0175       PMTH=PARP(102)
0176       S=VINT(2)
0177       SRT=VINT(1)
0178       SEPS=S**EPS
0179       SETA=S**ETA
0180       SLOG=LOG(S)
0181  
0182 C...Loop over multiple processes (for VDM).
0183       DO 110 I=1,NPR
0184         IF(NPR.EQ.1) THEN
0185           IPR=IPROC
0186         ELSEIF(NPR.EQ.3) THEN
0187           IPR=I+4
0188           IF(KF2.LT.1000) IPR=I+10
0189         ELSEIF(NPR.EQ.6) THEN
0190           IPR=I+10
0191         ENDIF
0192  
0193 C...Evaluate hadron species, mass, slope contribution and fit number.
0194         IHA=IHADA(IPR)
0195         IHB=IHADB(IPR)
0196         PMA=PMHAD(IHA)
0197         PMB=PMHAD(IHB)
0198         BHA=BHAD(IHA)
0199         BHB=BHAD(IHB)
0200         ISD=IFITSD(IPR)
0201         IDD=IFITDD(IPR)
0202  
0203 C...Skip if energy too low relative to masses.
0204         DO 100 J=0,5
0205           SIGTMP(I,J)=0D0
0206   100   CONTINUE
0207         IF(SRT.LT.PMA+PMB+PARP(104)) GOTO 110
0208  
0209 C...Total cross-section. Elastic slope parameter and cross-section.
0210 C...change of elastic slope parameter for rho, phi and J/psi (08/2010)
0211 C        SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA
0212 C If we include the q2 dependence of the deltafor rho, we need also 
0213 C to change xpar
0214 C          seps=s**(0.173+0.068*dlog(VINT(307)/(PMVIRT**2)+1.D0))
0215         IF(IHA.eq.2) then 
0216           PMVIRT=PMAS(PYCOMP(113),1)
0217           SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA
0218         BEL=5.84/(1+(PARP(165))*(VINT(307)/(PMVIRT**2))**PARP(166))+4.5
0219         ELSEIF(IHA.eq.3) then
0220           PMVIRT=PMAS(PYCOMP(333),1)
0221           SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA
0222         BEL=5.84/(1+(PARP(165))*(VINT(307)/(PMVIRT**2))**PARP(166))+4.5
0223         elseif(IHA.eq.4) then
0224           PMVIRT=PMAS(PYCOMP(443),1)
0225           SEPS=S**0.2D0 
0226           BEL=4.5
0227           SIGTMP(I,0)=XPAR(IPR)*SEPS*0.550D0
0228         ELSE
0229           SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA
0230           BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0
0231           write(*,*), IHA, IPR, SIGTMP(I,0), I
0232         ENDIF
0233         SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL
0234  
0235 C...Diffractive scattering A + B -> X + B.
0236         BSD=2D0*BHB
0237         SQML=(PMA+PMTH)**2
0238         SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2)
0239         SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/
0240      &  (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP)
0241         BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S
0242         SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/
0243      &  (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB)
0244         SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2)
0245  
0246 C...Diffractive scattering A + B -> A + X.
0247         BSD=2D0*BHA
0248         SQML=(PMB+PMTH)**2
0249         SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6)
0250         SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/
0251      &  (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP)
0252         BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S
0253         SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/
0254      &  (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX)
0255         SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2)
0256  
0257 C...Order single diffractive correctly.
0258         IF(IORD.EQ.2) THEN
0259           SIGSAV=SIGTMP(I,2)
0260           SIGTMP(I,2)=SIGTMP(I,3)
0261           SIGTMP(I,3)=SIGSAV
0262         ENDIF
0263  
0264 C...Double diffractive scattering A + B -> X1 + X2.
0265         YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2)
0266         DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2
0267         SUM1=(DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0))/(2D0*ALP)
0268         IF(YEFF.LE.0) SUM1=0D0
0269         SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2)
0270         SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC))))
0271         SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC))))
0272         SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/
0273      &  (2D0*ALP)
0274         SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC))))
0275         SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC))))
0276         SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/
0277      &  (2D0*ALP)
0278         BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S
0279         SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB+PMRC)))
0280         SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*
0281      &  LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX)
0282         SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4)
0283  
0284 C...Non-diffractive by unitarity.
0285         SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)-
0286      &  SIGTMP(I,4)
0287   110 CONTINUE
0288  
0289 C...Put temporary results in output array: only one process.
0290       IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN
0291         DO 120 J=0,5
0292           SIGT(0,0,J)=SIGTMP(1,J)
0293   120   CONTINUE
0294  
0295 C...Beam multiple processes.
0296 C   In principle the power is rho:2.575, phi:2.4 and J/psi:2.55
0297       ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN
0298         DO 140 I=1,4
0299          IF(MINT(107).EQ.2) THEN
0300             VINT(317)=(PMHAD(I)**2/(PMHAD(I)**2+VINT(307)))**expo(I)
0301          ELSE
0302           VINT(317)=16D0*PARP(15)**2*VINT(154)**2/
0303      &    ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307)))
0304          ENDIF
0305          IF(MSTP(20).GT.0) THEN
0306            VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)))**MSTP(20)
0307          ENDIF
0308          IF(MINT(107).EQ.2) THEN
0309            CONV=(AEM/PARP(160+I))*VINT(317)
0310          ELSEIF(VINT(154).GT.PARP(15)) THEN
0311            CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2*
0312      &     (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317)
0313          ELSE
0314            CONV=0D0
0315          ENDIF
0316           I1=MAX(1,I-1)
0317          DO 130 J=0,5
0318            SIGT(I,0,J)=CONV*SIGTMP(I1,J)
0319   130    CONTINUE
0320   140   CONTINUE
0321         DO 150 J=0,5
0322           SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J)
0323   150   CONTINUE
0324  
0325 C...Target multiple processes.
0326       ELSEIF(MINT(101).EQ.1.AND.MINT(102).EQ.4) THEN
0327         DO 170 I=1,4
0328          IF(MINT(108).EQ.2) THEN
0329             VINT(317)=(PMHAD(I)**2/(PMHAD(I)**2+VINT(308)))**expo(I)
0330          ELSE
0331           VINT(317)=16D0*PARP(15)**2*VINT(154)**2/
0332      &    ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308)))
0333          ENDIF
0334          IF(MSTP(20).GT.0) THEN
0335            VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(308)))**MSTP(20)
0336          ENDIF
0337          IF(MINT(108).EQ.2) THEN
0338            CONV=(AEM/PARP(160+I))*VINT(317)
0339          ELSEIF(VINT(154).GT.PARP(15)) THEN
0340            CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2*
0341      &     (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317)
0342          ELSE
0343            CONV=0D0
0344          ENDIF
0345          IV=MAX(1,I-1)
0346          DO 160 J=0,5
0347            SIGT(0,I,J)=CONV*SIGTMP(IV,J)
0348   160    CONTINUE
0349   170   CONTINUE
0350         DO 180 J=0,5
0351           SIGT(0,0,J)=SIGT(0,1,J)+SIGT(0,2,J)+SIGT(0,3,J)+SIGT(0,4,J)
0352   180   CONTINUE
0353  
0354 C...Both beam and target multiple processes.
0355       ELSE
0356         IF(MINT(107).EQ.2) THEN
0357           VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2
0358         ELSE
0359           VINT(317)=16D0*PARP(15)**2*VINT(154)**2/
0360      &    ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307)))
0361         ENDIF
0362         IF(MINT(108).EQ.2) THEN
0363           VINT(317)=VINT(317)*(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2
0364         ELSE
0365           VINT(317)=VINT(317)*16D0*PARP(15)**2*VINT(154)**2/
0366      &    ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308)))
0367         ENDIF
0368         IF(MSTP(20).GT.0) THEN
0369           VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)+
0370      &    VINT(308)))**MSTP(20)
0371         ENDIF
0372         DO 210 I1=1,4
0373           DO 200 I2=1,4
0374             IF(MINT(107).EQ.2) THEN
0375               CONV=(AEM/PARP(160+I1))*VINT(317)
0376             ELSEIF(VINT(154).GT.PARP(15)) THEN
0377               CONV=(AEM/PARU(1))*(KCHG(I1,1)/3D0)**2*PARP(18)**2*
0378      &        (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317)
0379             ELSE
0380               CONV=0D0
0381             ENDIF
0382             IF(MINT(108).EQ.2) THEN
0383               CONV=CONV*(AEM/PARP(160+I2))
0384             ELSEIF(VINT(154).GT.PARP(15)) THEN
0385               CONV=CONV*(AEM/PARU(1))*(KCHG(I2,1)/3D0)**2*PARP(18)**2*
0386      &        (1D0/PARP(15)**2-1D0/VINT(154)**2)
0387             ELSE
0388               CONV=0D0
0389             ENDIF
0390             IF(I1.LE.2) THEN
0391               IV=MAX(1,I2-1)
0392             ELSEIF(I2.LE.2) THEN
0393               IV=MAX(1,I1-1)
0394             ELSEIF(I1.EQ.I2) THEN
0395               IV=2*I1-2
0396             ELSE
0397               IV=5
0398             ENDIF
0399             DO 190 J=0,5
0400               JV=J
0401               IF(I2.GT.I1.AND.(J.EQ.2.OR.J.EQ.3)) JV=5-J
0402               SIGT(I1,I2,J)=CONV*SIGTMP(IV,JV)
0403   190       CONTINUE
0404   200     CONTINUE
0405   210   CONTINUE
0406         DO 230 J=0,5
0407           DO 220 I=1,4
0408             SIGT(I,0,J)=SIGT(I,1,J)+SIGT(I,2,J)+SIGT(I,3,J)+SIGT(I,4,J)
0409             SIGT(0,I,J)=SIGT(1,I,J)+SIGT(2,I,J)+SIGT(3,I,J)+SIGT(4,I,J)
0410   220     CONTINUE
0411           SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J)
0412   230   CONTINUE
0413       ENDIF
0414  
0415 C...Scale up uniformly for Donnachie-Landshoff parametrization.
0416       IF(IPROC.EQ.21.OR.IPROC.EQ.23.OR.IPROC.EQ.25) THEN
0417         RFAC=(XPAR(IPROC)*SEPS+YPAR(IPROC)*SETA)/SIGT(0,0,0)
0418         DO 260 I1=0,N1
0419           DO 250 I2=0,N2
0420             DO 240 J=0,5
0421               SIGT(I1,I2,J)=RFAC*SIGT(I1,I2,J)
0422   240       CONTINUE
0423   250     CONTINUE
0424   260   CONTINUE
0425       ENDIF
0426  
0427       RETURN
0428       END