184 lines
5.8 KiB
Fortran
184 lines
5.8 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C --- HISTOGRAM MERGING UTILITY, VERSION 0.1
|
|
C --- DESIGNED TO BE USED IN CONJUNCTION WITH EERAD2 V0.4
|
|
C
|
|
C VERSION 0.0 - 28th April 2026
|
|
C VERSION 0.1 - 5th May 2026 - Added log binning.
|
|
C
|
|
C WRITTEN BY G. CHIURATO
|
|
C
|
|
PROGRAM MAIN
|
|
IMPLICIT NONE
|
|
INTEGER I
|
|
CHARACTER*256 IPATH, OPATH, LPATH
|
|
CHARACTER*30 OBS(5)
|
|
COMMON /CONST/OBS
|
|
|
|
C --- TODO: ADD EXTERNALLY CONFIG. PATHS
|
|
IPATH = './results/'
|
|
OPATH = './merge/'
|
|
LPATH = TRIM(OPATH)//'lists/'
|
|
|
|
CALL PRINTHEADER
|
|
CALL CREATEOUT(LPATH)
|
|
CALL CREATEOUT(OPATH)
|
|
CALL SCANDIR(IPATH, LPATH)
|
|
DO 10 I = 1,5
|
|
C ------ TODO: FIXED IDS ARE NOT GREAT
|
|
CALL MERGE(OBS(I), I, OPATH, LPATH)
|
|
10 CONTINUE
|
|
END PROGRAM
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE SCANDIR(IPATH, OPATH)
|
|
IMPLICIT NONE
|
|
INTEGER I
|
|
INTEGER STAT
|
|
CHARACTER*30 OBS(5), ESCOBS
|
|
CHARACTER*256 IPATH, OPATH
|
|
COMMON /CONST/OBS
|
|
DATA OBS/'C-PARAMETER','D-PARAMETER',
|
|
$ 'THRUST','y3(JADE,P)','EEC'/
|
|
|
|
C CREATE FILE LIST USING SYSTEM COMMAND
|
|
DO 10 I = 1, 5
|
|
CALL BRACKETESC(OBS(I), ESCOBS)
|
|
CALL SYSTEM('ls '//TRIM(IPATH)//'gtopdraw_'//TRIM(ESCOBS)//
|
|
$ '_* > '//TRIM(OPATH)//'filelist_'//TRIM(ESCOBS)//'.txt',
|
|
$ STATUS=STAT)
|
|
10 CONTINUE
|
|
|
|
END
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE MERGE(OBS, ID, OPATH, LPATH)
|
|
IMPLICIT NONE
|
|
CHARACTER*30 OBS
|
|
CHARACTER*256 OPATH, LPATH
|
|
CHARACTER*256 LINE
|
|
CHARACTER*60 TITLE
|
|
INTEGER LENTIT
|
|
INTEGER ID, NX, LH
|
|
DOUBLE PRECISION XMIN, XMAX
|
|
|
|
NX = 0
|
|
XMIN = 0
|
|
XMAX = 0
|
|
LH = 0
|
|
|
|
C --- NEED TO USE UNIT 20 TO AVOID CONFLICT WITH UNIT 10 USED BY GREAD
|
|
OPEN(UNIT=20, FILE=TRIM(LPATH)//'filelist_'//TRIM(OBS)//'.txt',
|
|
$ STATUS='OLD', ERR=30)
|
|
|
|
C --- READ FIRST HIST AND SAVE BIN NUMBER AND TITLE
|
|
READ(20, '(A)', END=20) LINE
|
|
CALL GREAD(LINE)
|
|
CALL GPROP1(ID, NX, XMIN, XMAX, LH)
|
|
C --- TODO: IN THIS WAY THE MERGED HIST HAS THE SAME NAME AS THE LAST
|
|
C OPENED HIST. NEED TO CHANGE THIS TO SOMETHING DIFFERENT
|
|
CALL GTITLE(ID, TITLE, LENTIT)
|
|
|
|
C --- 2XX IS VALUE ACC., 3XX IS WEIGHT ACC.
|
|
CALL GBOOK1(200+ID,TITLE,NX,XMIN,XMAX,LH)
|
|
CALL GBOOK1(300+ID,TITLE,NX,XMIN,XMAX,LH)
|
|
CALL GBOOK1(210+ID,TITLE,NX,XMIN,XMAX,LH)
|
|
CALL GBOOK1(310+ID,TITLE,NX,XMIN,XMAX,LH)
|
|
|
|
C --- ACCUMULATE WEIGHTS
|
|
CALL GOPERA(100+ID,'*',100+ID,100+ID,1D0,1D0)
|
|
CALL GOPERA(100+ID,'I', 0,100+ID,1D0,1D0)
|
|
CALL GOPERA(300+ID,'+',100+ID,300+ID,1D0,1D0)
|
|
CALL GOPERA(110+ID,'*',110+ID,110+ID,1D0,1D0)
|
|
CALL GOPERA(110+ID,'I', 0,110+ID,1D0,1D0)
|
|
CALL GOPERA(310+ID,'+',110+ID,310+ID,1D0,1D0)
|
|
C --- ACCUMULATE VALUES
|
|
CALL GOPERA( ID,'*',100+ID, ID,1D0,1D0)
|
|
CALL GOPERA(200+ID,'+', ID,200+ID,1D0,1D0)
|
|
CALL GOPERA( 10+ID,'*',110+ID, 10+ID,1D0,1D0)
|
|
CALL GOPERA(210+ID,'+', 10+ID,210+ID,1D0,1D0)
|
|
|
|
10 CONTINUE
|
|
CALL GRESET(ID)
|
|
CALL GRESET(100+ID)
|
|
READ(20, '(A)', END=20) LINE
|
|
CALL GREAD(LINE)
|
|
C --- ACCUMULATE WEIGHTS
|
|
CALL GOPERA(100+ID,'*',100+ID,100+ID,1D0,1D0)
|
|
CALL GOPERA(100+ID,'I', 0,100+ID,1D0,1D0)
|
|
CALL GOPERA(300+ID,'+',100+ID,300+ID,1D0,1D0)
|
|
CALL GOPERA(110+ID,'*',110+ID,110+ID,1D0,1D0)
|
|
CALL GOPERA(110+ID,'I', 0,110+ID,1D0,1D0)
|
|
CALL GOPERA(310+ID,'+',110+ID,310+ID,1D0,1D0)
|
|
C --- ACCUMULATE VALUES
|
|
CALL GOPERA( ID,'*',100+ID, ID,1D0,1D0)
|
|
CALL GOPERA(200+ID,'+', ID,200+ID,1D0,1D0)
|
|
CALL GOPERA( 10+ID,'*',110+ID, 10+ID,1D0,1D0)
|
|
CALL GOPERA(210+ID,'+', 10+ID,210+ID,1D0,1D0)
|
|
GOTO 10
|
|
|
|
20 CONTINUE
|
|
CALL GRESET(ID)
|
|
CALL GRESET(100+ID)
|
|
C --- COMPUTE FINAL VALUES
|
|
CALL GOPERA(200+ID,'/',300+ID,ID,1D0,1D0)
|
|
CALL GOPERA(210+ID,'/',310+ID,10+ID,1D0,1D0)
|
|
C --- COMPUTE FINAL ERRORS
|
|
CALL GOPERA(300+ID,'I',0,300+ID,1D0,1D0)
|
|
CALL GOPERA(300+ID,'S',0,100+ID,1D0,0D0)
|
|
CALL GOPERA(310+ID,'I',0,310+ID,1D0,1D0)
|
|
CALL GOPERA(310+ID,'S',0,110+ID,1D0,0D0)
|
|
C --- WRITE OUT RESULTS
|
|
CALL GTOPER( ID,1,1,0,100+ID)
|
|
CALL GTOPER( 10+ID,0,0,0,110+ID)
|
|
|
|
CLOSE(10)
|
|
RETURN
|
|
30 PRINT *, 'Error opening filelist for observable '//TRIM(OBS)
|
|
STOP
|
|
END
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE BRACKETESC(IN, OUT)
|
|
C Escapes ( and ) for Unix shell globbing
|
|
CHARACTER*(*) IN, OUT
|
|
INTEGER I, J, L
|
|
CHARACTER C
|
|
|
|
OUT = ' '
|
|
J = 1
|
|
L = LEN(IN)
|
|
|
|
DO 10 I = 1, L
|
|
C = IN(I:I)
|
|
|
|
IF (C .EQ. '(') THEN
|
|
OUT(J:J) = '\'
|
|
J = J + 1
|
|
OUT(J:J) = '('
|
|
|
|
ELSE IF (C .EQ. ')') THEN
|
|
OUT(J:J) = '\'
|
|
J = J + 1
|
|
OUT(J:J) = ')'
|
|
|
|
ELSE
|
|
OUT(J:J) = C
|
|
END IF
|
|
|
|
J = J + 1
|
|
10 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE PRINTHEADER
|
|
IMPLICIT NONE
|
|
C --- PRINT OPENING MESSAGE
|
|
WRITE (*,'(/2A)') ' This is EVENT2 merge utility, ',
|
|
$ ' used to merge EVENT2 histogram from different runs.'
|
|
WRITE (*,'(A)') ' Results will be stored in merge folder.'
|
|
WRITE (*,'(2A)') ' If you use this program, on EVENT2 runs, ',
|
|
$ ' please reference:'
|
|
WRITE (*,'(2A)') ' S.Catani & M.H.Seymour,',
|
|
$ ' Phys. Lett. B378 (1996) 287.'
|
|
WRITE (*,'(/A)') ' Written by Giorgio Chiurato, April 2026'
|
|
WRITE (*,'(A/)') ' Version 0.0, April 2026'
|
|
END
|
|
C----------------------------------------------------------------------- |