* * $Id: headh.F,v 1.1.1.1 1996/01/11 14:14:38 mclareni Exp $ * * $Log: headh.F,v $ * Revision 1.1.1.1 1996/01/11 14:14:38 mclareni * Cojets * * #include "cojets/pilot.h" SUBROUTINE HEADH C **************** C-- JET EVENTS PART OF HEADING #if defined(CERNLIB_SINGLE) IMPLICIT REAL (A-H,O-Z) #endif #if defined(CERNLIB_DOUBLE) IMPLICIT DOUBLE PRECISION (A-H,O-Z) #endif #include "cojets/alqgen.inc" #include "cojets/data1.inc" #include "cojets/data3.inc" #include "cojets/eicht.inc" #include "cojets/event.inc" #include "cojets/evtype.inc" #include "cojets/forcsl.inc" #include "cojets/forgen.inc" #include "cojets/fstate.inc" #include "cojets/idrun.inc" #include "cojets/iflghv.inc" #include "cojets/intype.inc" #include "cojets/itapes.inc" #include "cojets/kfact.inc" #include "cojets/nflav.inc" #include "cojets/nkinpt.inc" #include "cojets/thrfla.inc" #include "cojets/total.inc" #include "cojets/tpretb.inc" #include "cojets/tweigh.inc" CHARACTER*6 CHFLA(3),CHFLA2(3) C DATA CHFLA/'CHARM','BOTTOM','TOP'/ DATA CHFLA2/'CH-CB','BT-BB','TP-TB'/ C-- BASIC CONSTANTS NEVNTS=NEVENT PTCUT=PTMIN IF(KPRHEV.NE.1) GO TO 60 DIFF=PTMIN**2-AM2HEV(KFRFLA) IF(DIFF.LT.1.E-10) PTCUT=0. IF(DIFF.GE.1.E-10) PTCUT=SQRT(DIFF) 60 CONTINUE WRITE(ITLIS,21) ALAMB,PTCUT,PT2INT,SIGINL WRITE(ITLIS,71) QZEV,FACTK C-- CROSS SECTION IF(NEVENT.EQ.0) THEN SIGTOT=0. WRITE(ITLIS,102) GO TO 101 ENDIF IF(KPRHEV.EQ.0) THEN IF(PTMGE.LE.PTMIN) THEN SIGTOT=SIGINL IF(INTYPE.EQ.1) SIGTOT=SIGTOT*FLOAT(IEVT)/FLOAT(NEVENT) WRITE(ITLIS,31) FRHARD WRITE(ITLIS,34) SIGTOT ELSE SIGTOT=SIGHRD IF(INTYPE.EQ.1) SIGTOT=SIGTOT*FLOAT(IEVT)/FLOAT(NEVENT) WRITE(ITLIS,30) PTMGE,SIGTOT ENDIF C-- FORCING OF HEAVY QUARK PRODUCTION ELSE IF(KPRHEV.EQ.1) WRITE(ITLIS,28) CHFLA(KFRFLA-3) IF(KPRHEV.EQ.2) WRITE(ITLIS,58) CHFLA(KFRFLA-3) IF(KPRHEV.EQ.3) WRITE(ITLIS,57) CHFLA(KFRFLA-3) IF(KPRHEV.EQ.4) WRITE(ITLIS,59) CHFLA(KFRFLA-3) IF(PTMGE.LE.PTMIN) THEN SIGHEV=FRHARD*SIGINL SIGHEV=SIGHEV*FLOAT(NEVENT)/FLOAT(NEVENT+NHVREJ) IF(LFORSL.NE.0) SIGHEV=SIGHEV*BRXFSL**NFORSL SIGTOT=SIGHEV IF(INTYPE.EQ.1) SIGTOT=SIGTOT*FLOAT(IEVT)/FLOAT(NEVENT) IF(PTMGE.LE.PTMIN) WRITE(ITLIS,29) CHFLA2(KFRFLA-3),SIGTOT ELSE SIGHRD=SIGHRD*FLOAT(NEVENT)/FLOAT(NEVENT+NHVREJ) IF(LFORSL.NE.0) SIGHRD=SIGHRD*BRXFSL**NFORSL SIGTOT=SIGHRD IF(INTYPE.EQ.1) SIGTOT=SIGTOT*FLOAT(IEVT)/FLOAT(NEVENT) WRITE(ITLIS,30) PTMGE,SIGTOT ENDIF ENDIF IF(INTYPE.EQ.1) THEN NRJTP=NEVENT-IEVT WRITE(ITLIS,85) NRJTP ENDIF WRITE(ITLIS,83) FACTK IF(LFORSL.NE.0) WRITE(ITLIS,82) CHA4(KFORSL,1) IF(KFRFLA.EQ.6) WRITE(ITLIS,32) QMAS(6) C 101 CONTINUE WRITE(ITLIS,25) NKINPT,TPRETB IF(KPRHEV.GE.3) WRITE(ITLIS,26) NHVREJ ITENT=INT(TENTRS) IF(INTYPE.EQ.0) THEN WRITE(ITLIS,24) NEVENT,ITENT ELSE IF(INTYPE.EQ.1) THEN WRITE(ITLIS,35) IEVT ENDIF IF(IPTWGT.EQ.0) WRITE(ITLIS,22) FRAGEX=FRAGEH*100. IF(IPTWGT.EQ.1) WRITE(ITLIS,23) FRAGEX WRITE(ITLIS,27) NFLAV IF(KMPSCA.GT.1) WRITE(ITLIS,33) KMPSCA IF(IEICHT.EQ.0) WRITE(ITLIS,72) IF(IEICHT.GE.1.AND.IEICHT.LE.2) WRITE(ITLIS,73) IEICHT 21 FORMAT(T2,1H*,3X,8HLAMBDA = ,E10.3,4H GEV,3X,11HPT CUTOFF = , *E10.3,4H GEV,3X,12HMEAN KT**2 = ,E10.3,7H GEV**2,3X, *15HINEL. X-SECT. = ,E10.3,3H MB ,T121,1H*/T2,1H*,T121,1H*) 71 FORMAT(T2,1H*,3X,8HQZEV = ,E10.3,4H GEV,3X,11HK FACTOR = ,E10.3 *,T121,1H*/T2,1H*,T121,1H*) 22 FORMAT(T2,1H*,3X,'WEIGHT=1 EVENTS',T121,1H*/T2,1H*,T121, +1H*) 23 FORMAT(T2,1H*,3X,36HWEIGHTED EVENTS -- HARD EVENTS .GT. ,F4.0, *4H PER ,14H CENT (APPROX),T121,1H*/T2,1H*,T121,1H*) 25 FORMAT(T2,1H*,3X,'NO. OF KINEMATIC POINTS TO CALCULATE X-SECTION' *,' =',I10,5X,'(TIME SPENT = ',E10.3,' SEC)' *,T121,1H*/T2,1H*,T121,1H*) 26 FORMAT(T2,1H*,3X,'NO. OF REJECTED EVENTS' *,' =',I10,' (X-SECTION ACCURACY IS DETERMINED BY THE' *,' NO. OF ACCEPTED EVENTS)' *,T121,1H*/T2,1H*,T121,1H*) 27 FORMAT(T2,1H*,3X,20HNO. OF QUARK FLAVORS ,I3,T121,1H*/T2,1H*, *T121,1H*) 28 FORMAT(T2,1H*,3X,28HFORCED FUSION PRODUCTION OF ,A6 * ,T121,1H*/T2,1H*,T121,1H*) 58 FORMAT(T2,1H*,3X,39HFORCED FLAVOR EXCITATION PRODUCTION OF ,A6 * ,T121,1H*/T2,1H*,T121,1H*) 59 FORMAT(T2,1H*,3X,'FORCED GLUON SPLITTING PRODUCTION OF ' ,A6 * ,T121,1H*/T2,1H*,T121,1H*) 57 FORMAT(T2,1H*,3X,'FORCED PRODUCTION OF ',A6 * ,T121,1H*/T2,1H*,T121,1H*) 29 FORMAT(T2,1H*,3X,14HX-SECTION FOR ,A5,E10.3,5H (MB) ,T121,1H*/T2, *1H*,T121,1H*) 30 FORMAT(T2,1H*,3X,42HGENERATION FORCED OVER PT(HARD SCATTERING) , *6H .GT. ,E10.3,25H (GEV) WITH X-SECTION = ,E10.3,5H (MB) ,T121, *1H*/T2,1H* ,T121,1H*) 32 FORMAT(T2,1H*,3X,17HTOP QUARK MASS = ,E10.3,4H GEV,T121,1H*/T2, *1H* ,T121,1H*) 31 FORMAT(T2,1H*,3X,14HQCD X-SECT. = ,E12.4,1X,16HOF INEL. X-SECT. , * T121,1H*/T2,1H*,T121,1H*) 34 FORMAT(T2,1H*,3X,'(NO PT FORCING) TOTAL X-SECTION = ' *,E10.3,' (MB)' *,T121,1H*/T2,1H*,T121,1H*) 82 FORMAT(T2,1H*,3X, *' ***X-SECTION VALUE INCLUDES THE EFFECTS OF SEMILEPTONIC DECAY' *,' FORCING OF QUARK ',A2 *,T121,1H*/T2,1H*,T121,1H*) 83 FORMAT(T2,1H*,3X, *' ***X-SECTION VALUE INCLUDES K-FACTOR =',E10.3 *,T121,1H*/T2,1H*,T121,1H*) 85 FORMAT(T2,1H*,3X, *' ***X-SECTION VALUE INCLUDES EFFECTS FROM EDIT SELECTIONS' *,' WHEN WRITING TO TAPE - REJECTED EVENTS =',I10 *,T121,1H*/T2,1H*,T121,1H*) 33 FORMAT(T2,1H*,3X,'FORCED ',I3,' PARTON COLLISIONS -- ALL ' *,'YIELDING PURELY JET PRODUCTION',T121,1H*/T2,1H*,T121,1H*) 72 FORMAT(T2,1H*,3X,'NA3 STRUCTURE FUNCTIONS USED' *,T121,1H*/T2,1H*,T121,1H*) 73 FORMAT(T2,1H*,3X,'EICHTEN ET AL. STRUCTURE FUNCTIONS SET ',I1 *,' USED' *,T121,1H*/T2,1H*,T121,1H*) 24 FORMAT(T2,1H*,3X,20HTOTAL NO. OF EVENTS ,I7,5X, *19HNO. OF HARD EVENTS ,I7,T121,1H*/T2,1H*,T121,1H*) 35 FORMAT(T2,1H*,3X,20HTOTAL NO. OF EVENTS ,I7 *,T121,1H*/T2,1H*,T121,1H*) 102 FORMAT(T2,1H*,3X,'***NO EVENTS GENERATED***' *,T121,1H*/T2,1H*,T121,1H*) C RETURN END