hijing/src/pyhimaxi.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE PYHIMAXI
0005
0006 C...Finds optimal set of coefficients for kinematical variable selection
0007 C...and the maximum of the part of the differential cross-section used
0008 C...in the event weighting.
0009       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0010       SAVE /LUDAT1/
0011       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0012       SAVE /LUDAT2/
0013       COMMON/PYHISUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
0014       SAVE /PYHISUBS/
0015       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0016       SAVE /PYHIPARS/
0017       COMMON/PYHIINT1/MINT(400),VINT(400)
0018       SAVE /PYHIINT1/
0019       COMMON/PYHIINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
0020       SAVE /PYHIINT2/
0021       COMMON/PYHIINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0022       SAVE /PYHIINT3/
0023       COMMON/PYHIINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
0024       SAVE /PYHIINT4/
0025       COMMON/PYHIINT5/NGEN(0:200,3),XSEC(0:200,3)
0026       SAVE /PYHIINT5/
0027       COMMON/PYHIINT6/PROC(0:200)
0028       CHARACTER PROC*28
0029       SAVE /PYHIINT6/
0030       CHARACTER CVAR(4)*4
0031       DIMENSION NPTS(4),MVARPT(200,4),VINTPT(200,30),SIGSPT(200),
0032      &NAREL(6),WTREL(6),WTMAT(6,6),COEFU(6),IACCMX(4),SIGSMX(4),
0033      &SIGSSM(3)
0034       DATA CVAR/'tau ','tau''','y*  ','cth '/
0035
0036 C...Select subprocess to study: skip cases not applicable.
0037       VINT(143)=1.
0038       VINT(144)=1.
0039       XSEC(0,1)=0.
0040       DO 350 ISUB=1,200
0041       IF(ISUB.GE.91.AND.ISUB.LE.95) THEN
0042         XSEC(ISUB,1)=VINT(ISUB+11)
0043         IF(MSUB(ISUB).NE.1) GOTO 350
0044         GOTO 340
0045       ELSEIF(ISUB.EQ.96) THEN
0046         IF(MINT(43).NE.4) GOTO 350
0047         IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) GOTO 350
0048       ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR.
0049      &ISUB.EQ.53.OR.ISUB.EQ.68) THEN
0050         IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 350
0051       ELSE
0052         IF(MSUB(ISUB).NE.1) GOTO 350
0053       ENDIF
0054       MINT(1)=ISUB
0055       ISTSB=ISET(ISUB)
0056       IF(ISUB.EQ.96) ISTSB=2
0057       IF(MSTP(122).GE.2) WRITE(MSTU(11),1000) ISUB
0058
0059 C...Find resonances (explicit or implicit in cross-section).
0060       MINT(72)=0
0061       KFR1=0
0062       IF(ISTSB.EQ.1.OR.ISTSB.EQ.3) THEN
0063         KFR1=KFPR(ISUB,1)
0064       ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN
0065         KFR1=25
0066       ENDIF
0067       IF(KFR1.NE.0) THEN
0068         TAUR1=PMAS(KFR1,1)**2/VINT(2)
0069         GAMR1=PMAS(KFR1,1)*PMAS(KFR1,2)/VINT(2)
0070         MINT(72)=1
0071         MINT(73)=KFR1
0072         VINT(73)=TAUR1
0073         VINT(74)=GAMR1
0074       ENDIF
0075       IF(ISUB.EQ.141) THEN
0076         KFR2=23
0077         TAUR2=PMAS(KFR2,1)**2/VINT(2)
0078         GAMR2=PMAS(KFR2,1)*PMAS(KFR2,2)/VINT(2)
0079         MINT(72)=2
0080         MINT(74)=KFR2
0081         VINT(75)=TAUR2
0082         VINT(76)=GAMR2
0083       ENDIF
0084
0085 C...Find product masses and minimum pT of process.
0086       SQM3=0.
0087       SQM4=0.
0088       MINT(71)=0
0089       VINT(71)=CKIN(3)
0090       IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
0091         IF(KFPR(ISUB,1).NE.0) SQM3=PMAS(KFPR(ISUB,1),1)**2
0092         IF(KFPR(ISUB,2).NE.0) SQM4=PMAS(KFPR(ISUB,2),1)**2
0093         IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1
0094         IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5))
0095         IF(ISUB.EQ.96.AND.MSTP(82).LE.1) VINT(71)=PARP(81)
0096         IF(ISUB.EQ.96.AND.MSTP(82).GE.2) VINT(71)=0.08*PARP(82)
0097       ENDIF
0098       VINT(63)=SQM3
0099       VINT(64)=SQM4
0100
0101 C...Number of points for each variable: tau, tau', y*, cos(theta-hat).
0102       NPTS(1)=2+2*MINT(72)
0103       IF(MINT(43).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) NPTS(1)=1
0104       NPTS(2)=1
0105       IF(MINT(43).GE.2.AND.(ISTSB.EQ.3.OR.ISTSB.EQ.4)) NPTS(2)=2
0106       NPTS(3)=1
0107       IF(MINT(43).EQ.4) NPTS(3)=3
0108       NPTS(4)=1
0109       IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5
0110       NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4)
0111
0112 C...Reset coefficients of cross-section weighting.
0113       DO 100 J=1,20
0114   100 COEF(ISUB,J)=0.
0115       COEF(ISUB,1)=1.
0116       COEF(ISUB,7)=0.5
0117       COEF(ISUB,8)=0.5
0118       COEF(ISUB,10)=1.
0119       COEF(ISUB,15)=1.
0120       MCTH=0
0121       MTAUP=0
0122       CTH=0.
0123       TAUP=0.
0124       SIGSAM=0.
0125
0126 C...Find limits and select tau, y*, cos(theta-hat) and tau' values,
0127 C...in grid of phase space points.
0128       CALL PYHIKLIM(1)
0129       NACC=0
0130       DO 120 ITRY=1,NTRY
0131       IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN
0132         MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4))
0133         CALL PYHIKMAP(1,MTAU,0.5)
0134         IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) CALL PYHIKLIM(4)
0135       ENDIF
0136       IF((ISTSB.EQ.3.OR.ISTSB.EQ.4).AND.MOD(ITRY-1,NPTS(3)*NPTS(4)).
0137      &EQ.0) THEN
0138         MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2))
0139         CALL PYHIKMAP(4,MTAUP,0.5)
0140       ENDIF
0141       IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) CALL PYHIKLIM(2)
0142       IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN
0143         MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3))
0144         CALL PYHIKMAP(2,MYST,0.5)
0145         CALL PYHIKLIM(3)
0146       ENDIF
0147       IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
0148         MCTH=1+MOD(ITRY-1,NPTS(4))
0149         CALL PYHIKMAP(3,MCTH,0.5)
0150       ENDIF
0151       IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2)
0152
0153 C...Calculate and store cross-section.
0154       MINT(51)=0
0155       CALL PYHIKLIM(0)
0156       IF(MINT(51).EQ.1) GOTO 120
0157       NACC=NACC+1
0158       MVARPT(NACC,1)=MTAU
0159       MVARPT(NACC,2)=MTAUP
0160       MVARPT(NACC,3)=MYST
0161       MVARPT(NACC,4)=MCTH
0162       DO 110 J=1,30
0163   110 VINTPT(NACC,J)=VINT(10+J)
0164       CALL PYHISIGH(NCHN,SIGS)
0165       SIGSPT(NACC)=SIGS
0166       IF(SIGS.GT.SIGSAM) SIGSAM=SIGS
0167       IF(MSTP(122).GE.2) WRITE(MSTU(11),1100) MTAU,MTAUP,MYST,MCTH,
0168      &VINT(21),VINT(22),VINT(23),VINT(26),SIGS
0169   120 CONTINUE
0170       IF(SIGSAM.EQ.0.) THEN
0171         WRITE(MSTU(11),1200) ISUB
0172         STOP
0173       ENDIF
0174
0175 C...Calculate integrals in tau and y* over maximal phase space limits.
0176       TAUMIN=VINT(11)
0177       TAUMAX=VINT(31)
0178       ATAU1=LOG(TAUMAX/TAUMIN)
0179       ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
0180       IF(NPTS(1).GE.3) THEN
0181         ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1
0182         ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/
0183      &  GAMR1
0184       ENDIF
0185       IF(NPTS(1).GE.5) THEN
0186         ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2
0187         ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/
0188      &  GAMR2
0189       ENDIF
0190       YSTMIN=0.5*LOG(TAUMIN)
0191       YSTMAX=-YSTMIN
0192       AYST0=YSTMAX-YSTMIN
0193       AYST1=0.5*(YSTMAX-YSTMIN)**2
0194       AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
0195
0196 C...Reset. Sum up cross-sections in points calculated.
0197       DO 230 IVAR=1,4
0198       IF(NPTS(IVAR).EQ.1) GOTO 230
0199       IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 230
0200       NBIN=NPTS(IVAR)
0201       DO 130 J1=1,NBIN
0202       NAREL(J1)=0
0203       WTREL(J1)=0.
0204       COEFU(J1)=0.
0205       DO 130 J2=1,NBIN
0206   130 WTMAT(J1,J2)=0.
0207       DO 140 IACC=1,NACC
0208       IBIN=MVARPT(IACC,IVAR)
0209       NAREL(IBIN)=NAREL(IBIN)+1
0210       WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC)
0211
0212 C...Sum up tau cross-section pieces in points used.
0213       IF(IVAR.EQ.1) THEN
0214         TAU=VINTPT(IACC,11)
0215         WTMAT(IBIN,1)=WTMAT(IBIN,1)+1.
0216         WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU
0217         IF(NBIN.GE.3) THEN
0218           WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1)
0219           WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/
0220      &    ((TAU-TAUR1)**2+GAMR1**2)
0221         ENDIF
0222         IF(NBIN.GE.5) THEN
0223           WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2)
0224           WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/
0225      &    ((TAU-TAUR2)**2+GAMR2**2)
0226         ENDIF
0227
0228 C...Sum up tau' cross-section pieces in points used.
0229       ELSEIF(IVAR.EQ.2) THEN
0230         TAU=VINTPT(IACC,11)
0231         TAUP=VINTPT(IACC,16)
0232         TAUPMN=VINTPT(IACC,6)
0233         TAUPMX=VINTPT(IACC,26)
0234         ATAUP1=LOG(TAUPMX/TAUPMN)
0235         ATAUP2=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
0236         WTMAT(IBIN,1)=WTMAT(IBIN,1)+1.
0237         WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)*(1.-TAU/TAUP)**3/
0238      &  TAUP
0239
0240 C...Sum up y* and cos(theta-hat) cross-section pieces in points used.
0241       ELSEIF(IVAR.EQ.3) THEN
0242         YST=VINTPT(IACC,12)
0243         WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN)
0244         WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST1)*(YSTMAX-YST)
0245         WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST)
0246       ELSE
0247         RM34=2.*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2
0248         RSQM=1.+RM34
0249         CTHMAX=SQRT(1.-4.*VINT(71)**2/(TAUMAX*VINT(2)))
0250         CTHMIN=-CTHMAX
0251         IF(CTHMAX.GT.0.9999) RM34=MAX(RM34,2.*VINT(71)**2/
0252      &  (TAUMAX*VINT(2)))
0253         ACTH1=CTHMAX-CTHMIN
0254         ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX))
0255         ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN))
0256         ACTH4=1./MAX(RM34,RSQM-CTHMAX)-1./MAX(RM34,RSQM-CTHMIN)
0257         ACTH5=1./MAX(RM34,RSQM+CTHMIN)-1./MAX(RM34,RSQM+CTHMAX)
0258         CTH=VINTPT(IACC,13)
0259         WTMAT(IBIN,1)=WTMAT(IBIN,1)+1.
0260         WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/MAX(RM34,RSQM-CTH)
0261         WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/MAX(RM34,RSQM+CTH)
0262         WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/MAX(RM34,RSQM-CTH)**2
0263         WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/MAX(RM34,RSQM+CTH)**2
0264       ENDIF
0265   140 CONTINUE
0266
0267 C...Check that equation system solvable; else trivial way out.
0268       IF(MSTP(122).GE.2) WRITE(MSTU(11),1300) CVAR(IVAR)
0269       MSOLV=1
0270       DO 150 IBIN=1,NBIN
0271       IF(MSTP(122).GE.2) WRITE(MSTU(11),1400) (WTMAT(IBIN,IRED),
0272      &IRED=1,NBIN),WTREL(IBIN)
0273   150 IF(NAREL(IBIN).EQ.0) MSOLV=0
0274       IF(MSOLV.EQ.0) THEN
0275         DO 160 IBIN=1,NBIN
0276   160   COEFU(IBIN)=1.
0277
0278 C...Solve to find relative importance of cross-section pieces.
0279       ELSE
0280         DO 170 IRED=1,NBIN-1
0281         DO 170 IBIN=IRED+1,NBIN
0282         RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED)
0283         WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED)
0284         DO 170 ICOE=IRED,NBIN
0285   170   WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE)
0286         DO 190 IRED=NBIN,1,-1
0287         DO 180 ICOE=IRED+1,NBIN
0288   180   WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE)
0289   190   COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED)
0290       ENDIF
0291
0292 C...Normalize coefficients, with piece shared democratically.
0293       COEFSU=0.
0294       DO 200 IBIN=1,NBIN
0295       COEFU(IBIN)=MAX(0.,COEFU(IBIN))
0296   200 COEFSU=COEFSU+COEFU(IBIN)
0297       IF(IVAR.EQ.1) IOFF=0
0298       IF(IVAR.EQ.2) IOFF=14
0299       IF(IVAR.EQ.3) IOFF=6
0300       IF(IVAR.EQ.4) IOFF=9
0301       IF(COEFSU.GT.0.) THEN
0302         DO 210 IBIN=1,NBIN
0303   210   COEF(ISUB,IOFF+IBIN)=PARP(121)/NBIN+(1.-PARP(121))*COEFU(IBIN)/
0304      &  COEFSU
0305       ELSE
0306         DO 220 IBIN=1,NBIN
0307   220   COEF(ISUB,IOFF+IBIN)=1./NBIN
0308       ENDIF
0309       IF(MSTP(122).GE.2) WRITE(MSTU(11),1500) CVAR(IVAR),
0310      &(COEF(ISUB,IOFF+IBIN),IBIN=1,NBIN)
0311   230 CONTINUE
0312
0313 C...Find two most promising maxima among points previously determined.
0314       DO 240 J=1,4
0315       IACCMX(J)=0
0316   240 SIGSMX(J)=0.
0317       NMAX=0
0318       DO 290 IACC=1,NACC
0319       DO 250 J=1,30
0320   250 VINT(10+J)=VINTPT(IACC,J)
0321       CALL PYHISIGH(NCHN,SIGS)
0322       IEQ=0
0323       DO 260 IMV=1,NMAX
0324   260 IF(ABS(SIGS-SIGSMX(IMV)).LT.1E-4*(SIGS+SIGSMX(IMV))) IEQ=IMV
0325       IF(IEQ.EQ.0) THEN
0326         DO 270 IMV=NMAX,1,-1
0327         IIN=IMV+1
0328         IF(SIGS.LE.SIGSMX(IMV)) GOTO 280
0329         IACCMX(IMV+1)=IACCMX(IMV)
0330   270   SIGSMX(IMV+1)=SIGSMX(IMV)
0331         IIN=1
0332   280   IACCMX(IIN)=IACC
0333         SIGSMX(IIN)=SIGS
0334         IF(NMAX.LE.1) NMAX=NMAX+1
0335       ENDIF
0336   290 CONTINUE
0337
0338 C...Read out starting position for search.
0339       IF(MSTP(122).GE.2) WRITE(MSTU(11),1600)
0340       SIGSAM=SIGSMX(1)
0341       DO 330 IMAX=1,NMAX
0342       IACC=IACCMX(IMAX)
0343       MTAU=MVARPT(IACC,1)
0344       MTAUP=MVARPT(IACC,2)
0345       MYST=MVARPT(IACC,3)
0346       MCTH=MVARPT(IACC,4)
0347       VTAU=0.5
0348       VYST=0.5
0349       VCTH=0.5
0350       VTAUP=0.5
0351
0352 C...Starting point and step size in parameter space.
0353       DO 320 IRPT=1,2
0354       DO 310 IVAR=1,4
0355       IF(NPTS(IVAR).EQ.1) GOTO 310
0356       IF(IVAR.EQ.1) VVAR=VTAU
0357       IF(IVAR.EQ.2) VVAR=VTAUP
0358       IF(IVAR.EQ.3) VVAR=VYST
0359       IF(IVAR.EQ.4) VVAR=VCTH
0360       IF(IVAR.EQ.1) MVAR=MTAU
0361       IF(IVAR.EQ.2) MVAR=MTAUP
0362       IF(IVAR.EQ.3) MVAR=MYST
0363       IF(IVAR.EQ.4) MVAR=MCTH
0364       IF(IRPT.EQ.1) VDEL=0.1
0365       IF(IRPT.EQ.2) VDEL=MAX(0.01,MIN(0.05,VVAR-0.02,0.98-VVAR))
0366       IF(IRPT.EQ.1) VMAR=0.02
0367       IF(IRPT.EQ.2) VMAR=0.002
0368       IMOV0=1
0369       IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0
0370       DO 300 IMOV=IMOV0,8
0371
0372 C...Define new point in parameter space.
0373       IF(IMOV.EQ.0) THEN
0374         INEW=2
0375         VNEW=VVAR
0376       ELSEIF(IMOV.EQ.1) THEN
0377         INEW=3
0378         VNEW=VVAR+VDEL
0379       ELSEIF(IMOV.EQ.2) THEN
0380         INEW=1
0381         VNEW=VVAR-VDEL
0382       ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND.
0383      &VVAR+2.*VDEL.LT.1.-VMAR) THEN
0384         VVAR=VVAR+VDEL
0385         SIGSSM(1)=SIGSSM(2)
0386         SIGSSM(2)=SIGSSM(3)
0387         INEW=3
0388         VNEW=VVAR+VDEL
0389       ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND.
0390      &VVAR-2.*VDEL.GT.VMAR) THEN
0391         VVAR=VVAR-VDEL
0392         SIGSSM(3)=SIGSSM(2)
0393         SIGSSM(2)=SIGSSM(1)
0394         INEW=1
0395         VNEW=VVAR-VDEL
0396       ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN
0397         VDEL=0.5*VDEL
0398         VVAR=VVAR+VDEL
0399         SIGSSM(1)=SIGSSM(2)
0400         INEW=2
0401         VNEW=VVAR
0402       ELSE
0403         VDEL=0.5*VDEL
0404         VVAR=VVAR-VDEL
0405         SIGSSM(3)=SIGSSM(2)
0406         INEW=2
0407         VNEW=VVAR
0408       ENDIF
0409
0410 C...Convert to relevant variables and find derived new limits.
0411       IF(IVAR.EQ.1) THEN
0412         VTAU=VNEW
0413         CALL PYHIKMAP(1,MTAU,VTAU)
0414         IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) CALL PYHIKLIM(4)
0415       ENDIF
0416       IF(IVAR.LE.2.AND.(ISTSB.EQ.3.OR.ISTSB.EQ.4)) THEN
0417         IF(IVAR.EQ.2) VTAUP=VNEW
0418         CALL PYHIKMAP(4,MTAUP,VTAUP)
0419       ENDIF
0420       IF(IVAR.LE.2) CALL PYHIKLIM(2)
0421       IF(IVAR.LE.3) THEN
0422         IF(IVAR.EQ.3) VYST=VNEW
0423         CALL PYHIKMAP(2,MYST,VYST)
0424         CALL PYHIKLIM(3)
0425       ENDIF
0426       IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
0427         IF(IVAR.EQ.4) VCTH=VNEW
0428         CALL PYHIKMAP(3,MCTH,VCTH)
0429       ENDIF
0430       IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2)
0431
0432 C...Evaluate cross-section. Save new maximum. Final maximum.
0433       CALL PYHISIGH(NCHN,SIGS)
0434       SIGSSM(INEW)=SIGS
0435       IF(SIGS.GT.SIGSAM) SIGSAM=SIGS
0436       IF(MSTP(122).GE.2) WRITE(MSTU(11),1700) IMAX,IVAR,MVAR,IMOV,
0437      &VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS
0438   300 CONTINUE
0439   310 CONTINUE
0440   320 CONTINUE
0441       IF(IMAX.EQ.1) SIGS11=SIGSAM
0442   330 CONTINUE
0443       XSEC(ISUB,1)=1.05*SIGSAM
0444   340 IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1)
0445   350 CONTINUE
0446
0447 C...Print summary table.
0448       IF(MSTP(122).GE.1) THEN
0449         WRITE(MSTU(11),1800)
0450         WRITE(MSTU(11),1900)
0451         DO 360 ISUB=1,200
0452         IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 360
0453         IF(ISUB.EQ.96.AND.MINT(43).NE.4) GOTO 360
0454         IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 360
0455         IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.
0456      &  ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 360
0457         WRITE(MSTU(11),2000) ISUB,PROC(ISUB),XSEC(ISUB,1)
0458   360   CONTINUE
0459         WRITE(MSTU(11),2100)
0460       ENDIF
0461
0462 C...Format statements for maximization results.
0463  1000 FORMAT(/1X,'Coefficient optimization and maximum search for ',
0464      &'subprocess no',I4/1X,'Coefficient modes     tau',10X,'y*',9X,
0465      &'cth',9X,'tau''',7X,'sigma')
0466  1100 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,E12.4)
0467  1200 FORMAT(1X,'Error: requested subprocess ',I3,' has vanishing ',
0468      &'cross-section.'/1X,'Execution stopped!')
0469  1300 FORMAT(1X,'Coefficients of equation system to be solved for ',A4)
0470  1400 FORMAT(1X,1P,7E11.3)
0471  1500 FORMAT(1X,'Result for ',A4,':',6F9.4)
0472  1600 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ',
0473      &'MOD MOV   VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma')
0474  1700 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,E12.4)
0475  1800 FORMAT(/1X,8('*'),1X,'PYHIMAXI: summary of differential ',
0476      &'cross-section maximum search',1X,8('*'))
0477  1900 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I  ISUB  ',
0478      &'Subprocess name',15X,'I  Maximum value  I'/11X,'I',38X,'I',
0479      &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I')
0480  2000 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,E12.4,3X,'I')
0481  2100 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('='))
0482
0483       RETURN
0484       END