]> git.uio.no Git - u/mrichter/AliRoot.git/blame - HERWIG/src/hwufne.f
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
renamed CorrectionMatrix class
[u/mrichter/AliRoot.git] / HERWIG / src / hwufne.f
CommitLineData
3820ca8e 1
2CDECK ID>, HWUFNE.
3
4*CMZ :- -16/10/93 12.42.15 by Mike Seymour
5
6*-- Author : Mike Seymour
7
8C-----------------------------------------------------------------------
9
10 SUBROUTINE HWUFNE
11
12C-----------------------------------------------------------------------
13
14C FINALISES THE EVENT BY UNDOING THE LORENTZ BOOST IF THERE WAS ONE,
15
16C CHECKING FOR ERRORS, AND PRINTING
17
18C-----------------------------------------------------------------------
19
20 INCLUDE 'HERWIG61.INC'
21
22 LOGICAL CALLED
23
24 COMMON/HWDBUG/CALLED
25
26 CALLED=.TRUE.
27
28C---UNBOOST EVENT RECORD IF NECESSARY
29
30 CALL HWUBST(0)
31
32C---CHECK FOR FATAL ERROR
33
34 IF (IERROR.NE.0) THEN
35
36 IF (IERROR.GT.0) THEN
37
38 NUMER=NUMER+1
39
40 ELSE
41
42 NUMERU=NUMERU+1
43
44 ENDIF
45
46 IF (NUMER.GT.MAXER) CALL HWWARN('HWUFNE',300,*999)
47
48 NEVHEP=NEVHEP-1
49
50C---PRINT FIRST MAXPR EVENTS
51
52 ELSEIF (NEVHEP.LE.MAXPR) THEN
53
54 CALL HWUEPR
55
56 END IF
57
58 999 END
59
60CDECK ID>, HWUGAU.
61
62*CMZ :- -26/04/91 11.11.56 by Bryan Webber
63
64*-- Author : Adapted by Bryan Webber
65
66C-----------------------------------------------------------------------
67
68 FUNCTION HWUGAU(F,A,B,EPS)
69
70C-----------------------------------------------------------------------
71
72C ADAPTIVE GAUSSIAN INTEGRATION OF FUNCTION F
73
74C IN INTERVAL (A,B) WITH PRECISION EPS
75
76C (MODIFIED CERN LIBRARY ROUTINE GAUSS)
77
78C-----------------------------------------------------------------------
79
80 DOUBLE PRECISION HWUGAU,F,A,B,EPS,CONST,AA,BB,C1,C2,S8,U,S16,
81
82 & W(12),X(12),ZERO
83
84 INTEGER I
85
86 EXTERNAL F
87
88 PARAMETER (ZERO=0.0D0)
89
90 DATA W/.1012285363D0,.2223810345D0,.3137066459D0,
91
92 & .3626837834D0,.0271524594D0,.0622535239D0,
93
94 & .0951585117D0,.1246289713D0,.1495959888D0,
95
96 & .1691565194D0,.1826034150D0,.1894506105D0/
97
98 DATA X/.9602898565D0,.7966664774D0,.5255324099D0,
99
100 & .1834346425D0,.9894009350D0,.9445750231D0,
101
102 & .8656312024D0,.7554044084D0,.6178762444D0,
103
104 & .4580167777D0,.2816035508D0,.0950125098D0/
105
106 HWUGAU=0.
107
108 IF (A.EQ.B) RETURN
109
110 CONST=.005/ABS(B-A)
111
112 BB=A
113
114 1 AA=BB
115
116 BB=B
117
118 2 C1=0.5*(BB+AA)
119
120 C2=0.5*(BB-AA)
121
122 S8=0.
123
124 DO 3 I=1,4
125
126 U=C2*X(I)
127
128 S8=S8+W(I)*(F(C1+U)+F(C1-U))
129
130 3 CONTINUE
131
132 S8=C2*S8
133
134 S16=0.
135
136 DO 4 I=5,12
137
138 U=C2*X(I)
139
140 S16=S16+W(I)*(F(C1+U)+F(C1-U))
141
142 4 CONTINUE
143
144 S16=C2*S16
145
146 IF (ABS(S16-S8).LE.EPS*(1.+ABS(S16))) GOTO 5
147
148 BB=C1
149
150 IF (CONST*ABS(C2).NE.ZERO) GOTO 2
151
152C---TOO HIGH ACCURACY REQUESTED
153
154 CALL HWWARN('HWUGAU',500,*999)
155
156 5 HWUGAU=HWUGAU+S16
157
158 IF (BB.NE.B) GOTO 1
159
160 999 END
161
162CDECK ID>, HWUIDT.
163
164*CMZ :- -26/04/91 10.18.58 by Bryan Webber
165
166*-- Author : Bryan Webber
167
168C-----------------------------------------------------------------------
169
170 SUBROUTINE HWUIDT(IOPT,IPDG,IWIG,NWIG)
171
172C-----------------------------------------------------------------------
173
174C TRANSLATES PARTICLE IDENTIFIERS:
175
176C IPDG = PARTICLE DATA GROUP CODE
177
178C IWIG = HERWIG IDENTITY CODE
179
180C NWIG = HERWIG CHARACTER*8 NAME
181
182C
183
184C IOPT= 1 GIVEN IPDG, RETURNS IWIG AND NWIG
185
186C IOPT= 2 GIVEN IWIG, RETURNS IPDG AND NWIG
187
188C IOPT= 3 GIVEN NWIG, RETURNS IPDG AND IWIG
189
190C-----------------------------------------------------------------------
191
192 INCLUDE 'HERWIG61.INC'
193
194 INTEGER IOPT,IPDG,IWIG,I
195
196 CHARACTER*8 NWIG
197
198 IF (IOPT.EQ.1) THEN
199
200 DO 10 I=0,NRES
201
202 IF (IDPDG(I).EQ.IPDG) THEN
203
204 IWIG=I
205
206 NWIG=RNAME(I)
207
208 RETURN
209
210 ENDIF
211
212 10 CONTINUE
213
214 WRITE(6,20) IPDG
215
216 20 FORMAT(1X,'Particle not recognised, PDG code: ',I8)
217
218 IWIG=20
219
220 NWIG=RNAME(20)
221
222 CALL HWWARN('HWUIDT',101,*999)
223
224 ELSEIF (IOPT.EQ.2) THEN
225
226 IF (IWIG.LT.0.OR.IWIG.GT.NRES) THEN
227
228 WRITE(6,30) IWIG
229
230 30 FORMAT(1X,'Particle not recognised, HERWIG code: ',I3)
231
232 IPDG=0
233
234 NWIG=RNAME(20)
235
236 CALL HWWARN('HWUIDT',102,*999)
237
238 ELSE
239
240 IPDG=IDPDG(IWIG)
241
242 NWIG=RNAME(IWIG)
243
244 RETURN
245
246 ENDIF
247
248 ELSEIF (IOPT.EQ.3) THEN
249
250 DO 40 I=0,NRES
251
252 IF (RNAME(I).EQ.NWIG) THEN
253
254 IWIG=I
255
256 IPDG=IDPDG(I)
257
258 RETURN
259
260 ENDIF
261
262 40 CONTINUE
263
264 WRITE(6,50) NWIG
265
266 50 FORMAT(1X,'Particle not recognised, HERWIG name: ',A8)
267
268 IWIG=20
269
270 IPDG=0
271
272 CALL HWWARN('HWUIDT',103,*999)
273
274 ELSE
275
276 CALL HWWARN('HWUIDT',404,*999)
277
278 ENDIF
279
280 999 END
281
282CDECK ID>, HWUINC.
283
284*CMZ :- -26/04/91 11.11.56 by Bryan Webber
285
286*-- Author : Bryan Webber
287
288C-----------------------------------------------------------------------
289
290 SUBROUTINE HWUINC
291
292C-----------------------------------------------------------------------
293
294C COMPUTES CONSTANTS AND LOOKUP TABLES
295
296C-----------------------------------------------------------------------
297
298 INCLUDE 'HERWIG61.INC'
299
300 DOUBLE PRECISION HWBVMC,HWUALF,HWUPCM,XMIN,XMAX,XPOW,QR,DQKWT,
301
302 & UQKWT,SQKWT,DIQWT,QMAX,PMAX,PTLIM,ETLIM,PGS,PTELM,X,QSCA,UPV,DNV,
303
304 & USEA,DSEA,STR,CHM,BTM,TOP,GLU,VAL(20),CLMXPW,RCLPOW,TEST,RPM(2)
305
306 INTEGER ISTOP,I,J,IQK,IDB,IDT,ISET,IOP1,IOP2,IP2,ID
307
308 LOGICAL FIRST,FSTPDF
309
310 CHARACTER*20 PARM(20)
311
312 EXTERNAL HWBVMC,HWUALF,HWUPCM
313
314 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
315
316 COMMON/W50516/FSTPDF
317
318 IPRO=MOD(IPROC/100,100)
319
320 IQK=MOD(IPROC,100)
321
322C---SET UP BEAMS
323
324 CALL HWUIDT(3,IDB,IPART1,PART1)
325
326 CALL HWUIDT(3,IDT,IPART2,PART2)
327
328 EBEAM1=SQRT(PBEAM1**2+RMASS(IPART1)**2)
329
330 EBEAM2=SQRT(PBEAM2**2+RMASS(IPART2)**2)
331
332C---PHOTON CUTOFF DEFAULTS TO ROOT S
333
334 PTLIM=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
335
336 ETLIM=TWO*PTLIM
337
338 IF (VPCUT.GT.ETLIM) VPCUT=ETLIM
339
340 IF (Q2MAX.GT.ETLIM**2) Q2MAX=ETLIM**2
341
342C---PRINT OUT MOST IMPORTANT INPUT PARAMETERS
343
344 IF (IPRINT.EQ.0) GOTO 50
345
346 WRITE (6,10) PART1,PBEAM1,PART2,PBEAM2,IPROC,NFLAV,NSTRU,
347
348 & AZSPIN,AZSOFT,QCDLAM,(RMASS(I),I=1,6),RMASS(13)
349
350 IF (ISPAC.LE.1) THEN
351
352 WRITE (6,20) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS
353
354 ELSE
355
356 WRITE (6,30) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS
357
358 ENDIF
359
360 IF (NOSPAC) WRITE (6,40)
361
362 10 FORMAT(/10X,'INPUT CONDITIONS FOR THIS RUN'//
363
364 & 10X,'BEAM 1 (',A8,') MOM. =',F10.2/
365
366 & 10X,'BEAM 2 (',A8,') MOM. =',F10.2/
367
368 & 10X,'PROCESS CODE (IPROC) =',I8/
369
370 & 10X,'NUMBER OF FLAVOURS =',I5/
371
372 & 10X,'STRUCTURE FUNCTION SET =',I5/
373
374 & 10X,'AZIM SPIN CORRELATIONS =',L5/
375
376 & 10X,'AZIM SOFT CORRELATIONS =',L5/
377
378 & 10X,'QCD LAMBDA (GEV) =',F10.4/
379
380 & 10X,'DOWN QUARK MASS =',F10.4/
381
382 & 10X,'UP QUARK MASS =',F10.4/
383
384 & 10X,'STRANGE QUARK MASS =',F10.4/
385
386 & 10X,'CHARMED QUARK MASS =',F10.4/
387
388 & 10X,'BOTTOM QUARK MASS =',F10.4/
389
390 & 10X,'TOP QUARK MASS =',F10.4/
391
392 & 10X,'GLUON EFFECTIVE MASS =',F10.4)
393
394 20 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/
395
396 & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/
397
398 & 10X,'PHOTON SHOWER CUTOFF =',F10.4/
399
400 & 10X,'CLUSTER MASS PARAMETER =',F10.4/
401
402 & 10X,'SPACELIKE EVOLN CUTOFF =',F10.4/
403
404 & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4)
405
406 30 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/
407
408 & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/
409
410 & 10X,'PHOTON SHOWER CUTOFF =',F10.4/
411
412 & 10X,'CLUSTER MASS PARAMETER =',F10.4/
413
414 & 10X,'PDF FREEZING CUTOFF =',F10.4/
415
416 & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4)
417
418 40 FORMAT(10X,'NO SPACE-LIKE SHOWERS')
419
420 50 ISTOP=0
421
422C---INITIALIZE ALPHA-STRONG
423
424 IF (QLIM.GT.ETLIM) QLIM=ETLIM
425
426 QR=HWUALF(0,QLIM)
427
428C---DO SOME SAFETY CHECKS ON INPUT PARAMETERS
429
430C Check beam order for point-like photon/QCD processes
431
432 IF (IPRO.GE.50.AND.IPRO.LE.59.AND.
433
434 & IDB.NE.22.AND.ABS(IDB).NE.11.AND.ABS(IDB).NE.13) THEN
435
436 WRITE(6,60)
437
438 60 FORMAT(1X,'WARNING: require FIRST beam to be a photon/lepton')
439
440 ISTOP=ISTOP+1
441
442 ENDIF
443
444 QG=HWBVMC(13)
445
446 QR=QG/QCDL3
447
448 IF (QR.GE.2.01) GOTO 80
449
450 WRITE (6,70) QG,QCDLAM,QCDL3
451
452 70 FORMAT(//10X,'SHOWER GLUON VIRTUAL MASS CUTOFF =',F8.5/
453
454 & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/
455
456 & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5)
457
458 ISTOP=ISTOP+1
459
460 80 QV=MIN(HWBVMC(1),HWBVMC(2))
461
462 IF (QV.GE.QG/(QR-1.)) GOTO 100
463
464 ISTOP=ISTOP+1
465
466 WRITE (6,90) QV,QCDLAM,QCDL3
467
468 90 FORMAT(//10X,'SHOWER QUARK VIRTUAL MASS CUTOFF =',F8.5/
469
470 & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/
471
472 & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5)
473
474 100 IF (ISTOP.NE.0) THEN
475
476 WRITE (6,110) ISTOP
477
478 110 FORMAT(//10X,'EXECUTION PREVENTED BY',I2,
479
480 & ' ERRORS IN INPUT PARAMETERS.')
481
482 STOP
483
484 ENDIF
485
486 DO 120 I=1,6
487
488 120 RMASS(I+6)=RMASS(I)
489
490 RMASS(199)=RMASS(198)
491
492C---A PRIORI WEIGHTS FOR QUARK AND DIQUARKS
493
494 DQKWT=PWT(1)
495
496 UQKWT=PWT(2)
497
498 SQKWT=PWT(3)
499
500 DIQWT=PWT(7)
501
502 PWT(10)=PWT(4)
503
504 PWT(11)=PWT(5)
505
506 PWT(12)=PWT(6)
507
508C
509
510 PWT(4)=UQKWT*UQKWT*DIQWT
511
512 PWT(5)=UQKWT*DQKWT*DIQWT*HALF
513
514 PWT(6)=DQKWT*DQKWT*DIQWT
515
516 PWT(7)=UQKWT*SQKWT*DIQWT*HALF
517
518 PWT(8)=DQKWT*SQKWT*DIQWT*HALF
519
520 PWT(9)=SQKWT*SQKWT*DIQWT
521
522 QMAX=MAX(PWT(1),PWT(2),PWT(3))
523
524 PMAX=MAX(PWT(4),PWT(5),PWT(6),PWT(7),PWT(8),PWT(9),
525
526 & PWT(10),PWT(11),PWT(12),QMAX)
527
528 PMAX=1./PMAX
529
530 QMAX=1./QMAX
531
532 DO 130 I=1,3
533
534 130 QWT(I)=PWT(I)*QMAX
535
536 DO 140 I=1,12
537
538 140 PWT(I)=PWT(I)*PMAX
539
540C MASSES OF DIQUARKS (ASSUME BINDING NEGLIGIBLE)
541
542 RMASS(109)=RMASS(2)+RMASS(2)
543
544 RMASS(110)=RMASS(1)+RMASS(2)
545
546 RMASS(111)=RMASS(1)+RMASS(1)
547
548 RMASS(112)=RMASS(2)+RMASS(3)
549
550 RMASS(113)=RMASS(1)+RMASS(3)
551
552 RMASS(114)=RMASS(3)+RMASS(3)
553
554 DO 150 I=109,114
555
556 150 RMASS(I+6)=RMASS(I)
557
558C MASSES OF TOP HADRONS (ASSUME BINDING NEGLIGIBLE)
559
560 RMASS(232)=RMASS(6)+RMASS(5)
561
562 RMASS(233)=RMASS(6)+RMASS(1)
563
564 RMASS(234)=RMASS(6)+RMASS(2)
565
566 RMASS(235)=RMASS(6)+RMASS(3)
567
568 RMASS(236)=RMASS(6)+RMASS(2)+RMASS(2)
569
570 RMASS(237)=RMASS(6)+RMASS(1)+RMASS(2)
571
572 RMASS(238)=RMASS(6)+RMASS(1)+RMASS(1)
573
574 RMASS(239)=RMASS(6)+RMASS(2)+RMASS(3)
575
576 RMASS(240)=RMASS(6)+RMASS(1)+RMASS(3)
577
578 RMASS(241)=RMASS(6)+RMASS(3)+RMASS(3)
579
580 RMASS(242)=RMASS(6)+RMASS(4)
581
582 RMASS(243)=RMASS(6)+RMASS(5)
583
584 RMASS(244)=RMASS(6)+RMASS(6)
585
586 RMASS(232)=RMASS(243)
587
588 DO 160 I=233,242
589
590 160 RMASS(I+22)=RMASS(I)
591
592C Set up an array of cluster mass threholds
593
594 CLMXPW=CLMAX**CLPOW
595
596 RCLPOW=ONE/CLPOW
597
598 CALL HWVZRO(144,CTHRPW(1,1))
599
600 DO 170 I=1,6
601
602 DO 170 J=1,6
603
604 CTHRPW(I ,J )=(CLMXPW+(RMASS(I )+RMASS(J+6 ))**CLPOW)**RCLPOW
605
606 CTHRPW(I ,J+6)=(CLMXPW+(RMASS(I )+RMASS(J+108))**CLPOW)**RCLPOW
607
608 170 CTHRPW(I+6,J )=(CLMXPW+(RMASS(I+114)+RMASS(J+6 ))**CLPOW)**RCLPOW
609
610C Decay length conversion factor GEV2MM hbar.c/e
611
612 GEV2MM=1.D-15*SQRT(GEV2NB/10.)
613
614C Plank's constant/2pi (GeV.s)
615
616 HBAR=GEV2MM/CSPEED
617
618C---IMPORTANCE SAMPLING
619
620 FIRST=.TRUE.
621
622 IF (IPRO.EQ.5) THEN
623
624 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
625
626 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
627
628 ELSEIF (IPRO.EQ.13) THEN
629
630 IF (EMMIN.EQ.ZERO) EMMIN=10
631
632 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
633
634 IF (IQK.GT.0.AND.IQK.LE.6) EMMIN=MAX(EMMIN,2*RMASS(IQK))
635
636 XMIN=EMMIN
637
638 XMAX=EMMAX
639
640 XPOW=-EMPOW
641
642 ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21
643
644 & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50
645
646 & .OR.IPRO.EQ.51.OR.IPRO.EQ.53.OR.IPRO.EQ.55.OR.IPRO.EQ.60) THEN
647
648 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
649
650 IF (IQK.NE.0.AND.IQK.LT.7.AND.IPRO.NE.23) THEN
651
652 XMIN=2.*SQRT(PTMIN**2+RMASS(IQK)**2)
653
654 XMAX=2.*SQRT(PTMAX**2+RMASS(IQK)**2)
655
656 IF (XMAX.GT.ETLIM) XMAX=ETLIM
657
658 ELSE
659
660 XMIN=2.*PTMIN
661
662 XMAX=2.*PTMAX
663
664 ENDIF
665
666 XPOW=-PTPOW
667
668 ELSEIF (IPRO.EQ.52) THEN
669
670 PTELM=PTLIM-RMASS(IQK)**2/(4.*PTLIM)
671
672 IF (PTMAX.GT.PTELM) PTMAX=PTELM
673
674 XMIN=PTMIN
675
676 XMAX=PTMAX
677
678 XPOW=-PTPOW
679
680 ELSEIF (IPRO.EQ.30) THEN
681
682C---CHECK THAT SUSY DATA HAVE BEEN INPUT
683
684 IF (.NOT.SUSYIN) CALL HWWARN('HWUINC',600,*999)
685
686 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
687
688 XMIN=2.*SQRT(PTMIN**2+RMMNSS**2)
689
690 XMAX=2.*SQRT(PTMAX**2+RMMNSS**2)
691
692 IF (XMAX.GT.ETLIM) XMAX=ETLIM
693
694 XPOW=-PTPOW
695
696C--PR MOD 7/7/99
697
698 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
699
700 IF (.NOT.SUSYIN) CALL HWWARN('HWUINC',600,*999)
701
702 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
703
704 ID = IPROC-100*IPRO
705
706 RPM(1) = RMMNSS
707
708 RPM(2) = ZERO
709
710 IF(ID.GE.10.AND.ID.LT.20) THEN
711
712 RPM(1) = ABS(RMASS(450))
713
714 IF(ID.GT.10) RPM(1) = ABS(RMASS(449+MOD(ID,10)))
715
716 ELSEIF(ID.GE.20.AND.ID.LT.30) THEN
717
718 RPM(1) = ABS(RMASS(454))
719
720 IF(ID.GT.20) RPM(1) = ABS(RMASS(453+MOD(ID,20)))
721
722 ELSEIF(ID.EQ.30) THEN
723
724 RPM(1) = RMASS(449)
725
726 ELSEIF(ID.EQ.40) THEN
727
728 IF(IPRO.EQ.40) THEN
729
730 RPM(1) = RMASS(425)
731
732 DO I=1,5
733
734 RPM(1) = MIN(RPM(1),RMASS(425+I))
735
736 ENDDO
737
738 ELSE
739
740 RPM(1) = MIN(RMASS(405),RMASS(406))
741
742 ENDIF
743
744 RPM(2) = RMASS(198)
745
746 ELSEIF(ID.EQ.50) THEN
747
748 IF(IPRO.EQ.40) THEN
749
750 RPM(1) = RMASS(425)
751
752 DO I=1,5
753
754 RPM(1) = MIN(RPM(1),RMASS(425+I))
755
756 ENDDO
757
758 DO I=1,3
759
760 RPM(2) = MIN(RPM(1),RMASS(433+2*I))
761
762 ENDDO
763
764 RPM(1) = MIN(RPM(1),RPM(2))
765
766 RPM(2) = RMASS(203)
767
768 DO I=1,2
769
770 RPM(2) = MIN(RPM(2),RMASS(204+I))
771
772 ENDDO
773
774 ELSE
775
776 RPM(1) = RMASS(401)
777
778 RPM(2) = RMASS(413)
779
780 DO I=1,5
781
782 RPM(1) = MIN(RPM(1),RMASS(401+I))
783
784 RPM(2) = MIN(RPM(2),RMASS(413+I))
785
786 ENDDO
787
788 RPM(1) = MIN(RPM(1),RPM(2))
789
790 RPM(2) = RMASS(203)
791
792 DO I=1,2
793
794 RPM(2) = MIN(RPM(2),RMASS(204+I))
795
796 ENDDO
797
798 ENDIF
799
800 RPM(2) = RMASS(203)
801
802 DO I=1,2
803
804 RPM(2) = MIN(RPM(2),RMASS(204+I))
805
806 ENDDO
807
808 ELSEIF(ID.GE.60) THEN
809
810 RPM(1) = ZERO
811
812 ENDIF
813
814 RPM(1) = RPM(1)**2
815
816 RPM(2) = RPM(2)**2
817
818 XMIN = SQRT(RPM(1)+RPM(2)+TWO*(PTMIN**2+
819
820 & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2))))
821
822 XMAX = SQRT(RPM(1)+RPM(2)+TWO*(PTMAX**2+
823
824 & SQRT(RPM(1)*RPM(2)+PTMAX**2*(RPM(1)+RPM(2)+PTMAX**2))))
825
826 IF (XMAX.GT.ETLIM) XMAX=ETLIM
827
828C--end of mod
829
830 ELSEIF (IPRO.EQ.90) THEN
831
832 XMIN=SQRT(Q2MIN)
833
834 XMAX=SQRT(Q2MAX)
835
836 XPOW=1.-2.*Q2POW
837
838 ELSEIF (IPRO.EQ.91) THEN
839
840 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
841
842 ENDIF
843
844C---CALCULATE HIGGS WIDTH
845
846 IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.16.OR.IPRO.EQ.19
847
848 &.OR.IPRO.EQ.23.OR.IPRO.EQ.95) THEN
849
850 GAMH=RMASS(201)
851
852 CALL HWDHIG(GAMH)
853
854 ENDIF
855
856C---IF Q**2 CAN BE TOO SMALL, BREIT FRAME MAKES NO SENSE
857
858 IF ((IPRO/10.EQ.9.AND.Q2MIN.LE.1.D-2).OR.
859
860 & (IPRO.EQ.91.AND.IQK.EQ.7)) BREIT=.FALSE.
861
862 IF (IPRINT.NE.0) THEN
863
864 IF (PBEAM1.NE.PBEAM2) WRITE (6,180) USECMF
865
866 IF (IPRO.EQ.91.OR.IPRO.EQ.92)
867
868 & WRITE (6,190) PTMIN
869
870 IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92)
871
872 & WRITE (6,200) Q2MIN,Q2MAX,BREIT
873
874 IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92)
875
876 & WRITE (6,210) YBMIN,YBMAX
877
878 IF (IPRO.EQ.91.AND.IQK.EQ.7)
879
880 & WRITE (6,220) Q2WWMN,Q2WWMX,BREIT,ZJMAX
881
882 IF (IPROC/10.EQ.11) WRITE (6,230) THMAX
883
884 IF (IPRO.EQ.13) WRITE (6,240) EMMIN,EMMAX
885
886 IF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21
887
888 & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50
889
890 & .OR.IPRO.EQ.51.OR.IPRO.EQ.52.OR.IPRO.EQ.53.OR.IPRO.EQ.55
891
892 & .OR.IPRO.EQ.60)
893
894 & WRITE (6,250) PTMIN,PTMAX
895
896 IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.16.OR.IPRO.EQ.19
897
898 & .OR.IPRO.EQ.23.OR.IPRO.EQ.95)
899
900 & WRITE (6,260) RMASS(201),GAMH,
901
902 & GAMMAX,RMASS(201)+GAMMAX*GAMH,(BRHIG(I)*100,I=1,12)
903
904 IF (IPRO.EQ.91) WRITE (6,270) BGSHAT,EMMIN,EMMAX
905
906 IF (IPRO.EQ.5.AND.IQK.LT.50)
907
908 & WRITE (6,280) EMMIN,EMMAX,PTMIN,PTMAX,CTMAX
909
910 IF (IPRO.EQ.5.AND.IQK.GE.50)
911
912 & WRITE (6,290) EMMIN,EMMAX,Q2MIN,Q2MAX,PTMIN
913
914 IF (IPRO.GT.10.AND.
915
916 & (IPRO.LT.90.AND.(ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR.
917
918 & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) THEN
919
920 WRITE (6,300) Q2WWMN,Q2WWMX,YWWMIN,YWWMAX
921
922 IF (PHOMAS.GT.ZERO) WRITE (6,310) PHOMAS
923
924 ENDIF
925
926 IF (IPROC/10.EQ.10.OR.IPRO.EQ.90)
927
928 & WRITE (6,320) HARDME,SOFTME
929
930C Check minimum mass threshold if ISR switched on
931
932 IF ((IPRO.LE.3.OR.IPRO.EQ.6).AND.ZMXISR.GT.ZERO) THEN
933
934 TEST=TWO*RMASS(IPART1)**2+ETLIM**2
935
936 TEST=FOUR*RMASS(2)**2/TEST
937
938 IF (TMNISR.LT.TEST) THEN
939
940 WRITE(6,175) TMNISR,TEST
941
942 175 FORMAT(10X,'Minimum invariant mass',F10.6,' too low'/
943
944 & 10X,'increasing to TMNISR=',F10.6)
945
946 TMNISR=TEST
947
948 ENDIF
949
950 WRITE (6,330) TMNISR,ONE-ZMXISR
951
952 ENDIF
953
954 IF (WHMIN.GT.ZERO .AND. IPRO.GT.10.AND.(IPRO.EQ.90.OR.
955
956 & (ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR.
957
958 & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) WRITE (6,340) WHMIN
959
960 180 FORMAT(10X,'USE BEAM-TARGET C.M.F. =',L5)
961
962 190 FORMAT(10X,'MIN P-T FOR O(AS) DILS =',F10.4)
963
964 200 FORMAT(10X,'MIN ABS(Q**2) FOR DILS =',E10.4/
965
966 & 10X,'MAX ABS(Q**2) FOR DILS =',E10.4/
967
968 & 10X,'BREIT FRAME SHOWERING =',L5)
969
970 210 FORMAT(10X,'MIN BJORKEN Y FOR DILS =',F10.4/
971
972 & 10X,'MAX BJORKEN Y FOR DILS =',F10.4)
973
974 220 FORMAT(10X,'MIN ABS(Q**2) FOR J/PSI=',E10.4/
975
976 & 10X,'MAX ABS(Q**2) FOR J/PSI=',E10.4/
977
978 & 10X,'BREIT FRAME SHOWERING =',L5/
979
980 & 10X,'MAX Z FOR J/PSI =',F10.4)
981
982 230 FORMAT(10X,'MAX THRUST FOR 2->3 =',F10.4)
983
984 240 FORMAT(10X,'MIN MASS FOR DRELL-YAN =',F10.4/
985
986 & 10X,'MAX MASS FOR DRELL-YAN =',F10.4)
987
988 250 FORMAT(10X,'MIN P-TRAN FOR 2->2 =',F10.4/
989
990 & 10X,'MAX P-TRAN FOR 2->2 =',F10.4)
991
992 260 FORMAT(10X,'HIGGS BOSON MASS =',F10.4/
993
994 & 10X,'HIGGS BOSON WIDTH =',F10.4/
995
996 & 10X,'CUTOFF = EMH +',F4.1,'*GAMH=',F10.4/
997
998 & 10X,'HIGGS D DBAR =',F10.4/
999
1000 & 10X,'BRANCHING U UBAR =',F10.4/
1001
1002 & 10X,'FRACTIONS S SBAR =',F10.4/
1003
1004 & 10X,'(PER CENT) C CBAR =',F10.4/
1005
1006 & 10X,' B BBAR =',F10.4/
1007
1008 & 10X,' T TBAR =',F10.4/
1009
1010 & 10X,' E+ E- =',F10.4/
1011
1012 & 10X,' MU+ MU- =',F10.4/
1013
1014 & 10X,' TAU+ TAU- =',F10.4/
1015
1016 & 10X,' W W =',F10.4/
1017
1018 & 10X,' Z Z =',F10.4/
1019
1020 & 10X,' GAMMA GAMMA =',F10.4)
1021
1022 270 FORMAT(10X,'SCALE FOR BGF IS S-HAT =',L5/
1023
1024 & 10X,'MIN MASS FOR BGF =',F10.4/
1025
1026 & 10X,'MAX MASS FOR BGF =',F10.4)
1027
1028 280 FORMAT(10X,'MIN MASS FOR 2 PHOTONS =',F10.4/
1029
1030 & 10X,'MAX MASS FOR 2 PHOTONS =',F10.4/
1031
1032 & 10X,'MIN PT OF 2 PHOTON CMF =',F10.4/
1033
1034 & 10X,'MAX PT OF 2 PHOTON CMF =',F10.4/
1035
1036 & 10X,'MAX COS THETA IN CMF =',F10.4)
1037
1038 290 FORMAT(10X,'MIN MASS FOR GAMMA + W =',F10.4/
1039
1040 & 10X,'MAX MASS FOR GAMMA + W =',F10.4/
1041
1042 & 10X,'MIN ABS(Q**2) =',E10.4/
1043
1044 & 10X,'MAX ABS(Q**2) =',E10.4/
1045
1046 & 10X,'MIN PT =',F10.4)
1047
1048 300 FORMAT(10X,'MIN Q**2 FOR WW PHOTON =',F10.4/
1049
1050 & 10X,'MAX Q**2 FOR WW PHOTON =',F10.4/
1051
1052 & 10X,'MIN MOMENTUM FRACTION =',F10.4/
1053
1054 & 10X,'MAX MOMENTUM FRACTION =',F10.4)
1055
1056 310 FORMAT(10X,'GAMMA* S.F. MASS PARAM =',F10.4)
1057
1058 320 FORMAT(10X,'HARD M.E. MATCHING =',L5/
1059
1060 & 10X,'SOFT M.E. MATCHING =',L5)
1061
1062 330 FORMAT(10X,'MIN MTM FRAC FOR ISR =',1PE10.4/
1063
1064 & 10X,'1-MAX MTM FRAC FOR ISR =',1PE10.4)
1065
1066 340 FORMAT(10X,'MINIMUM HADRONIC MASS =',F10.4)
1067
1068 IF (LWEVT.LE.0) THEN
1069
1070 WRITE (6,350)
1071
1072 ELSE
1073
1074 WRITE (6,360) LWEVT
1075
1076 ENDIF
1077
1078 350 FORMAT(/10X,'NO EVENTS WILL BE WRITTEN TO DISK')
1079
1080 360 FORMAT(/10X,'EVENTS WILL BE OUTPUT ON UNIT',I4)
1081
1082 ENDIF
1083
1084C Verify and print beam polarisations
1085
1086 IF (IPRO.EQ.1.OR.IPRO.EQ.3) THEN
1087
1088C Set up transverse polarisation parameters for e+e-
1089
1090 IF ((EPOLN(1)**2+EPOLN(2)**2)
1091
1092 & *(PPOLN(1)**2+PPOLN(2)**2).GT.ZERO) THEN
1093
1094 TPOL=.TRUE.
1095
1096 COSS=EPOLN(1)*PPOLN(1)-EPOLN(2)*PPOLN(2)
1097
1098 SINS=EPOLN(2)*PPOLN(1)+EPOLN(1)*PPOLN(2)
1099
1100 ELSE
1101
1102 TPOL=.FALSE.
1103
1104 ENDIF
1105
1106C print out lepton beam polarisation(s)
1107
1108 IF (IPRINT.NE.0) THEN
1109
1110 IF (IPART1.EQ.121) THEN
1111
1112 WRITE (6,370) PART1,EPOLN,PART2,PPOLN
1113
1114 ELSE
1115
1116 WRITE (6,370) PART1,PPOLN,PART2,EPOLN
1117
1118 ENDIF
1119
1120 370 FORMAT(/10X,A8,'Beam polarisation=',3F10.4/
1121
1122 & 10X,A8,'Beam polarisation=',3F10.4)
1123
1124 ENDIF
1125
1126 ELSEIF (IPRO.GE.90.AND.IPRO.LE.99) THEN
1127
1128 IF (IDB.GE.11.AND.IDB.LE.16) THEN
1129
1130 CALL HWVZRO(3,PPOLN)
1131
1132C Check neutrino polarisations for DIS
1133
1134 IF (IDB.EQ. 12.OR.IDB.EQ. 14.OR.IDB.EQ. 16.AND.
1135
1136 & EPOLN(3).NE.-ONE) EPOLN(3)=-ONE
1137
1138 IF (IPRINT.NE.0) WRITE(6,380) PART1,EPOLN(3)
1139
1140 ELSE
1141
1142 CALL HWVZRO(3,EPOLN)
1143
1144C Check anti-neutrino polarisations for DIS
1145
1146 IF (IDB.EQ.-12.OR.IDB.EQ.-14.OR.IDB.EQ.-16.AND.
1147
1148 & PPOLN(3).NE.ONE) PPOLN(3)=ONE
1149
1150 IF (IPRINT.NE.0) WRITE(6,380) PART1,PPOLN(3)
1151
1152 ENDIF
1153
1154 380 FORMAT(/10X,A8,1X,'Longitudinal beam polarisation=',F10.4/)
1155
1156 ENDIF
1157
1158 IF (IPRINT.NE.0) THEN
1159
1160 IF (ZPRIME) THEN
1161
1162 WRITE(6,390) RMASS(200),RMASS(202),GAMZ,GAMZP
1163
1164 WRITE(6,400) (RNAME(I),VFCH(I,1),AFCH(I,1),VFCH(I,2),
1165
1166 & AFCH(I,2),I=1,6)
1167
1168 WRITE(6,400) (RNAME(110+I),VFCH(I,1),AFCH(I,1),
1169
1170 & VFCH(I,2),AFCH(I,2),I=11,16)
1171
1172 390 FORMAT(/10X,'MASSIVE NEUTRAL VECTOR BOSON PARAMS'/
1173
1174 & 10X,'Z MASS=',F10.4,7X,'Z-PRIME MASS=',F10.4/
1175
1176 & 10X,' WIDTH=',F10.4,7X,' WIDTH=',F10.4/
1177
1178 & 10X,'FERMION COUPLINGS: e.(V.1+A.G_5)G_mu'/
1179
1180 & 10X,'FERMION: VECTOR AXIAL',6X,
1181
1182 & 'VECTOR AXIAL'/)
1183
1184 400 FORMAT(10X,A8,2X,F10.4,1X,F10.4,1X,F10.4,1X,F10.4)
1185
1186 ENDIF
1187
1188 IF (MIXING) THEN
1189
1190 WRITE(6,410) XMIX(2),YMIX(2),XMIX(1),YMIX(1)
1191
1192 410 FORMAT(/10X,'B_d: Delt-M/Gam =',F6.4,
1193
1194 & ' Delt-Gam/2*Gam =',F6.4,/
1195
1196 & 10X,'B_s: Delt-M/Gam =',F6.2,
1197
1198 & ' Delt-Gam/2*Gam =',F6.4)
1199
1200 ENDIF
1201
1202 IF (CLRECO) WRITE(6,420) PRECO,EXAG
1203
1204 420 FORMAT(/10X,'Colour rearrangement ALLOWED, probability =',F6.4,/
1205
1206 & 10x,'Weak boson life-time exaggeration factor =',F10.6)
1207
1208C---PDF STRUCTURE FUNCTIONS
1209
939427b9 1210 WRITE (6,'(1X)')
3820ca8e 1211
1212 DO 450 I=1,2
1213
1214 IF (MODPDF(I).GE.0) THEN
1215
1216 WRITE (6,430) I,MODPDF(I),AUTPDF(I)
1217
1218 ELSE
1219
1220 WRITE (6,440) I
1221
1222 ENDIF
1223
1224 430 FORMAT(10X,'PDFLIB USED FOR BEAM',I2,': SET',I3,' OF ',A20)
1225
1226 440 FORMAT(10X,'PDFLIB NOT USED FOR BEAM',I2)
1227
1228 450 CONTINUE
1229
1230C---GET THE UGLY INITIALISATION MESSAGES OVER AND DONE WITH NOW TOO
1231
1232 DO 460 I=1,2
1233
1234 IF (MODPDF(I).GE.0) THEN
1235
1236 PARM(1)=AUTPDF(I)
1237
1238 VAL(1)=MODPDF(I)
1239
1240 FSTPDF=.TRUE.
1241
1242 X=0.5
1243
1244 QSCA=10
1245
1246C---FIX TO CALL SCHULER-SJOSTRAND CODE
1247
1248 IF (AUTPDF(I).EQ.'SaSph') THEN
1249
1250 ISET=MOD(MODPDF(I),10)
1251
1252 IOP1=MOD(MODPDF(I)/10,2)
1253
1254 IOP2=MOD(MODPDF(I)/20,2)
1255
1256 IP2=MODPDF(I)/100
1257
1258 IF (ISET.EQ.1) THEN
1259
1260 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1D'
1261
1262 ELSEIF (ISET.EQ.2) THEN
1263
1264 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1M'
1265
1266 ELSEIF (ISET.EQ.3) THEN
1267
1268 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2D'
1269
1270 ELSEIF (ISET.EQ.4) THEN
1271
1272 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2M'
1273
1274 ELSE
1275
1276 WRITE (6,'(10X,A)')'UNKNOWN SCHULER-SJOSTRAND PDF SET'
1277
1278 CALL HWWARN('HWUINC',500,*999)
1279
1280 ENDIF
1281
1282 IF (IOP1.EQ.1) THEN
1283
1284 WRITE (6,'(10X,A)') 'WITH DIRECT COMPONENT IN DIS'
1285
1286 IF (IPRO.NE.90) WRITE (6,'(10X,A)')
1287
1288 $ 'NOT RECOMMENDED FOR NON-DIS PROCESSES'
1289
1290 ENDIF
1291
1292 IF (IOP2.EQ.1) THEN
1293
1294 WRITE (6,'(10X,A)') 'WITH P**2 DEPENDENCE INCLUDED'
1295
1296 IF (PHOMAS.GT.ZERO)
1297
1298 $ WRITE (6,'(10X,A)') 'NOT RECOMMENDED WITH PHOMAS.GT.0'
1299
1300 IF (IP2.GT.0)
1301
1302 $ WRITE (6,'(10X,A,I2)') 'WITH IP2 OPTION EQUAL TO',IP2
1303
1304 ENDIF
1305
1306 ELSEIF (AUTPDF(I).EQ.'SSph') THEN
1307
1308 WRITE (6,'(10X,A)') 'THE ACRONYM FOR SCHULER-SJOSTRAND'
1309
1310 WRITE (6,'(10X,A)') 'HAS CHANGED TO SaSph ACCORDING TO'
1311
1312 WRITE (6,'(10X,A)') 'THEIR WISHES. SSph NO LONGER WORKS'
1313
1314 STOP
1315
1316 ELSE
1317
1318 CALL PDFSET(PARM,VAL)
1319
1320 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
1321
1322 ENDIF
1323
1324 ENDIF
1325
1326 460 CONTINUE
1327
939427b9 1328 WRITE (6,'(1X)')
3820ca8e 1329
1330 ENDIF
1331
1332C Set up neutral B meson mixing parameters
1333
1334 IF (MIXING.AND..NOT.(RSTAB(223).AND.RSTAB(247))) THEN
1335
1336 XMRCT(1)=XMIX(1)*RMASS(223)/(CSPEED*RLTIM(223))
1337
1338 YMRCT(1)=YMIX(1)*RMASS(223)/(CSPEED*RLTIM(223))
1339
1340 ENDIF
1341
1342 IF (MIXING.AND..NOT.(RSTAB(221).AND.RSTAB(245))) THEN
1343
1344 XMRCT(2)=XMIX(2)*RMASS(221)/(CSPEED*RLTIM(221))
1345
1346 YMRCT(2)=YMIX(2)*RMASS(221)/(CSPEED*RLTIM(221))
1347
1348 ENDIF
1349
1350C---B DECAY PACKAGE
1351
1352 IF (BDECAY.EQ.'EURO') THEN
1353
1354 IF (IPRINT.NE.0) WRITE (6,470) 'EURODEC'
1355
1356 ELSEIF (BDECAY.EQ.'CLEO') THEN
1357
1358 IF (IPRINT.NE.0) WRITE (6,470) 'CLEO'
1359
1360 ELSE
1361
1362 BDECAY='HERW'
1363
1364 ENDIF
1365
1366 470 FORMAT (10X,A,' B DECAY PACKAGE WILL BE USED')
1367
1368C---COMPUTE PARTICLE PROPERTIES FOR HADRONIZATION
1369
1370 CALL HWURES
1371
1372C Prepare internal decay tables and do diagnostic checks
1373
1374 CALL HWUDKS
1375
1376C Convert ampersands to backslahes in particle LaTeX names
1377
1378 CALL HWUATS
1379
1380C Print particle decay tables here
1381
1382 IF (IPRINT.GE.2) CALL HWUDPR
1383
1384C---MISCELLANEOUS DERIVED QUANTITIES
1385
1386 TMTOP=2.*LOG(RMASS(6)/30.)
1387
1388 PXRMS=PTRMS/SQRT(2.)
1389
1390 ZBINM=0.25/ZBINM
1391
1392 PSPLT(1)=1./PSPLT(1)
1393
1394 PSPLT(2)=1./PSPLT(2)
1395
1396 NDTRY=2*NCTRY
1397
1398 NGSPL=0
1399
1400 PGSMX=0.
1401
1402 DO 480 I=1,4
1403
1404 PGS=HWUPCM(RMASS(13),RMASS(I),RMASS(I))
1405
1406 IF (PGS.GE.ZERO) NGSPL=I
1407
1408 IF (PGS.GE.PGSMX) PGSMX=PGS
1409
1410 480 PGSPL(I)=PGS
1411
1412 CALL HWVZRO(6,PTINT)
1413
1414 IF (IPRO.NE.80) THEN
1415
1416C---SET UP TABLES OF SUDAKOV FORM FACTORS, GIVING
1417
1418C PROBABILITY DISTRIBUTION IN VARIABLE Q = E*SQRT(XI)
1419
1420 NSUD=NFLAV
1421
1422 CALL HWBSUD
1423
1424C---SET PARAMETERS FOR SPACELIKE BRANCHING
1425
1426 DO 500 I=1,NSUD
1427
1428 DO 490 J=2,NQEV
1429
1430 IF (QEV(J,I).GT.QSPAC) GOTO 500
1431
1432 490 CONTINUE
1433
1434 500 NSPAC(I)=J-1
1435
1436 ENDIF
1437
1438 EVWGT=AVWGT
1439
1440 ISTAT=1
1441
1442 999 END
1443
1444CDECK ID>, HWUINE.
1445
1446*CMZ :- -16/10/93 12.42.15 by Mike Seymour
1447
1448*-- Author : Bryan Webber
1449
1450C-----------------------------------------------------------------------
1451
1452 SUBROUTINE HWUINE
1453
1454C-----------------------------------------------------------------------
1455
1456C INITIALISES AN EVENT
1457
1458C-----------------------------------------------------------------------
1459
1460 INCLUDE 'HERWIG61.INC'
1461
1462 DOUBLE PRECISION HWR,HWRGET,DUMMY
1463
1464 REAL TL
1465
1466 LOGICAL CALLED
1467
1468 EXTERNAL HWR,HWRGET
1469
1470 COMMON/HWDBUG/CALLED
1471
1472C---CHECK THAT MAIN PROGRAM HAS BEEN MODIFIED CORRECTLY
1473
1474 IF (NEVHEP.GT.0.AND..NOT.CALLED) THEN
1475
1476 WRITE (6,10)
1477
1478 10 FORMAT (1X,'A call to the subroutine HWUFNE should be added to',
1479
1480 & /,' the main program, immediately after the call to HWMEVT')
1481
1482 CALL HWWARN('HWUINE',500,*999)
1483
1484 ENDIF
1485
1486 CALLED=.FALSE.
1487
1488C---CHECK TIME LEFT
1489
1490c-jgc CALL HWUTIM(TL)
1491
1492c-jgc IF (TL.LT.TLOUT) CALL HWWARN('HWUINE',200,*999)
1493
1494C---UPDATE RANDOM NUMBER SEED
1495
1496 DUMMY = HWRGET(NRN)
1497
1498 NEVHEP=NEVHEP+1
1499
1500 NHEP=0
1501
1502 ISTAT=6
1503
1504 IERROR=0
1505
1506 EVWGT=AVWGT
1507
1508 HVFCEN=.FALSE.
1509
1510 ISLENT=1
1511
1512 NQDK=0
1513
1514C---DECIDE WHETHER TO GENERATE SOFT UNDERLYING EVENT
1515
1516 GENSOF=IPROC.GT.1000.AND.IPROC.LT.10000.AND.
1517
1518 & (IPROC.EQ.8000.OR.HWR().LT.PRSOF)
1519
1520C Zero arrays
1521
1522 CALL HWVZRI(2*NMXHEP,JMOHEP)
1523
1524 CALL HWVZRI(2*NMXHEP,JDAHEP)
1525
1526 CALL HWVZRO(4*NMXHEP,VHEP)
1527
1528 CALL HWVZRO(3*NMXHEP,RHOHEP)
1529
1530 EMSCA=ZERO
1531
1532 999 END
1533
1534CDECK ID>, HWULB4.
1535
1536*CMZ :- -05/11/95 19.33.42 by Mike Seymour
1537
1538*-- Author : Adapted by Bryan Webber
1539
1540C-----------------------------------------------------------------------
1541
1542 SUBROUTINE HWULB4(PS,PI,PF)
1543
1544C-----------------------------------------------------------------------
1545
1546C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB)
1547
1548C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M
1549
1550C-----------------------------------------------------------------------
1551
1552 DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4)
1553
1554 IF (PS(4).EQ.PS(5)) THEN
1555
1556 PF(1)= PI(1)
1557
1558 PF(2)= PI(2)
1559
1560 PF(3)= PI(3)
1561
1562 PF(4)= PI(4)
1563
1564 ELSE
1565
1566 PF4 = (PI(1)*PS(1)+PI(2)*PS(2)
1567
1568 & +PI(3)*PS(3)+PI(4)*PS(4))/PS(5)
1569
1570 FN = (PF4+PI(4)) / (PS(4)+PS(5))
1571
1572 PF(1)= PI(1) + FN*PS(1)
1573
1574 PF(2)= PI(2) + FN*PS(2)
1575
1576 PF(3)= PI(3) + FN*PS(3)
1577
1578 PF(4)= PF4
1579
1580 END IF
1581
1582 END