Fixed a bug in bin size, changed output files extension and added new header.

This commit is contained in:
Yggdrasil 2026-04-23 17:51:59 +02:00
parent 873a720c02
commit 6d42adc8e3
2 changed files with 37 additions and 12 deletions

View File

@ -21,6 +21,9 @@ C VERSION 0.2 - 15th March 1996 - removed need for Lorentz boosts
C VERSION 0.3 - 10th November 1997 - improved numerical convergence
C and safety against arithmetic errors
C - added CUTUP variable
C VERSION 0.4 - 23th April 2026 - separated hist ouput
C - added runcard input
C - allowed different bin sizes
C
C - NEV IS THE NUMBER OF EVENTS TO GENERATE
C - EM IS THE TOTAL CENTRE-OF-MASS ENERGY
@ -69,7 +72,8 @@ C---PRINT OPENING MESSAGE
WRITE (*,'(2A)') ' S.Catani & M.H.Seymour,',
$ ' Phys. Lett. B378 (1996) 287.'
WRITE (*,'(/A)') ' Written by Mike Seymour, January 1996'
WRITE (*,'(A/)') ' Version 0.3, November 1997'
WRITE (*,'(A)') ' Edited by Giorgio Chiurato, April 2026'
WRITE (*,'(A/)') ' Version 0.4, April 2026'
WRITE (*,'(A,I10)')' NEV=',NEV
C---INITIALIZE CONSTANTS
PI=ATAN(ONE)*4
@ -207,14 +211,16 @@ C-----------------------------------------------------------------------
INTEGER CB1,CB2,DB,TB,YB,EB
DOUBLE PRECISION CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH
DOUBLE PRECISION CBS1,CBS2,DBS,TBS,YBS,EBS
CHARACTER*40 PATH
COMMON /PARAMS/ NFL,NEV,EM
COMMON /CONCOM/ CF,CA,TR,PI,PISQ,HF,CUTOFF,CUTUP,
$ CQ,FPAL2,ONF,NF,METYPE
COMMON /GBINS/ CB1,CB2,DB,TB,YB,EB
COMMON /GBINS/CB1,CB2,DB,TB,YB,EB
COMMON /GBINS/CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH
COMMON /GBINS/CBS1,CBS2,DBS,TBS,YBS,EBS
common /runcard/keys,settings
PATH = './results/'
@ -487,10 +493,20 @@ C-----------------------------------------------------------------------
INTEGER I
INTEGER CB1,CB2,DB,TB,YB,EB
DOUBLE PRECISION CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH
DOUBLE PRECISION CBS1,CBS2,DBS,TBS,YBS,EBS
DOUBLE PRECISION CSUM,CSQR,BSUM,BSQR
COMMON /DEMCOM/CSUM(8),CSQR(8),BSUM(2,6),BSQR(2,6)
COMMON /GBINS/CB1,CB2,DB,TB,YB,EB
COMMON /GBINS/CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH
COMMON /GBINS/CBS1,CBS2,DBS,TBS,YBS,EBS
CBS1=(CH1-CL1)/CB1
CBS2=(CH2-CL2)/CB2
DBS=(DH-DL)/DB
TBS=(TH-TL)/TB
YBS=(YH-YL)/YB
EBS=(EH-EL)/EB
DO I=1,8
CSUM(I)=0
CSQR(I)=0
@ -588,11 +604,20 @@ C-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER N,NA,ITYPE,I,J,K,L,ORD
DOUBLE PRECISION P(4,7),WEIGHT,DOT,C,D,OS,ORS,E(7),OE(7),COSANG,
$ COSLIM,BEEC,T,TAU,TL,TA(3),PT(3),PC(3,4),Y3,Y,Q(4,7),
$ COSLIM,BEEC,T,TAU,TTL,TA(3),PT(3),PC(3,4),Y3,Y,Q(4,7),
$ CSUM(8),CSQR(8),CS(8),BSUM(2,6),BSQR(2,6),BS(2,6)
DOUBLE PRECISION CFSUB,CASUB,TFSUB,GGSUB,QQSUB,QPSUB
INTEGER CB1,CB2,DB,TB,YB,EB
DOUBLE PRECISION CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH
DOUBLE PRECISION CBS1,CBS2,DBS,TBS,YBS,EBS
COMMON /SUBCOM/ CFSUB,CASUB,TFSUB,GGSUB,QQSUB,QPSUB
COMMON /DEMCOM/CSUM,CSQR,BSUM,BSQR
COMMON /GBINS/CB1,CB2,DB,TB,YB,EB
COMMON /GBINS/CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH
COMMON /GBINS/CBS1,CBS2,DBS,TBS,YBS,EBS
DATA CS,BS/20*0/
C---FILL THE HISTOGRAMS AT THE END OF EACH EVENT
C (THIS IS SO THAT PAIRS OF LARGE POSITIVE AND NEGATIVE WEIGHTS
@ -644,7 +669,7 @@ C---CALCULATE THE C-PARAMETER
C=C-3*DOT(P,I,J)**2*OS/(E(I)*E(J))
ENDDO
ENDDO
CALL GFILL1(201+ORD,C,C*WEIGHT*50)
CALL GFILL1(201+ORD,C,C*WEIGHT/CBS1)
IF (ORD.EQ.0) CS(3)=CS(3)+WEIGHT*C
C---CALCULATE THE D-PARAMETER
IF (N.EQ.4) THEN
@ -660,7 +685,7 @@ C---CALCULATE THE D-PARAMETER
ELSE
D=0
ENDIF
CALL GFILL1(202+ORD,D,D*WEIGHT*50)
CALL GFILL1(202+ORD,D,D*WEIGHT/DBS)
IF (ORD.EQ.0) CS(4)=CS(4)+WEIGHT*D
C---CALCULATE THE THRUST
IF (N.EQ.4) THEN
@ -693,8 +718,8 @@ C---CALCULATE THE THRUST
PC(I,4)=PT(I)-P(I,J)-P(I,K)
ENDDO
DO I=1,4
TL=PC(1,I)**2+PC(2,I)**2+PC(3,I)**2
IF (TL.GT.T) T=TL
TTL=PC(1,I)**2+PC(2,I)**2+PC(3,I)**2
IF (TTL.GT.T) T=TTL
ENDDO
ENDDO
ENDDO
@ -703,7 +728,7 @@ C---CALCULATE THE THRUST
T=MAX(E(1),E(2),E(3))*ORS*2
ENDIF
TAU = 1 - T
CALL GFILL1(203+ORD,TAU,TAU*WEIGHT*100)
CALL GFILL1(203+ORD,TAU,TAU*WEIGHT/TBS)
IF (ORD.EQ.0) CS(5)=CS(5)+TAU*WEIGHT
C---CALCULATE THE Y3 VALUE (USES P SCHEME FOR NO PARTICULAR REASON)
IF (N.EQ.4) THEN
@ -744,7 +769,7 @@ C---CALCULATE THE Y3 VALUE (USES P SCHEME FOR NO PARTICULAR REASON)
ELSE
Y3=1-T
ENDIF
CALL GFILL1(204+ORD,Y3,Y3*WEIGHT*100)
CALL GFILL1(204+ORD,Y3,Y3*WEIGHT/YBS)
IF (ORD.EQ.0) CS(6)=CS(6)+Y3*WEIGHT
C---CALCULATE THE ENERGY-ENERGY CORRELATION
DO I=2,N
@ -752,7 +777,7 @@ C---CALCULATE THE ENERGY-ENERGY CORRELATION
COSANG=1-DOT(P,I,J)*OE(I)*OE(J)
IF (ABS(COSANG).GE.1) COSANG=SIGN(1-1D-12,COSANG)
BEEC=(1-COSANG**2)*2*WEIGHT*E(I)*E(J)*OS
CALL GFILL1(205+ORD,COSANG,BEEC*50/2)
CALL GFILL1(205+ORD,COSANG,BEEC/EBS)
COSLIM=0.1D0
IF (ORD.EQ.0) THEN
IF (ABS(COSANG).LT.COSLIM)

View File

@ -938,7 +938,7 @@ C---OPEN TopDrawer FILE
IF (OPEN) RETURN
OPEN=.TRUE.
N=0
FNAME=TRIM(OPATH)//'gtopdraw_'//TRIM(TITLE)//'.top'
FNAME=TRIM(OPATH)//'gtopdraw_'//TRIM(TITLE)//'.dat'
OPEN (21,FILE=TRIM(FNAME),STATUS='NEW',ERR=10)
WRITE (6,*) 'Using file "'//TRIM(FNAME)//'"'
RETURN
@ -946,7 +946,7 @@ C---OPEN TopDrawer FILE
IF (N.GE.100) STOP
WRITE (6,*) 'Could not open file "',TRIM(FNAME),'"'
WRITE (FNAME,'(A,I2.2,A4)') TRIM(OPATH)//'gtopdraw_'
$ //TRIM(TITLE)//'_',N,'.top'
$ //TRIM(TITLE)//'_',N,'.dat'
OPEN (21,FILE=TRIM(FNAME),STATUS='NEW',ERR=10)
WRITE (6,*) 'Using file "',TRIM(FNAME),'" instead'
END