From 01c9bf2018824aced35d0d6719db07509e27497d Mon Sep 17 00:00:00 2001 From: Yggdrasil Date: Mon, 27 Apr 2026 17:27:02 +0200 Subject: [PATCH] Added read histogram subroutine. Started work on hist merge utility. --- Makefile | 27 ++++++++----- event2_merge.f | 6 +++ gbook.f | 101 ++++++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 115 insertions(+), 19 deletions(-) create mode 100644 event2_merge.f diff --git a/Makefile b/Makefile index d4ea188..3285b70 100644 --- a/Makefile +++ b/Makefile @@ -14,22 +14,29 @@ endif # Output folder OUT = bin -# Target executable -TARGET = event2 +# Targets +TARGET1 = event2 +TARGET2 = event2_merge # Source files -SRCS = event2_03.f gbook.f +SRCS1 = event2_03.f gbook.f +SRCS2 = event2_merge.f gbook.f -# Executable path -EXE = $(OUT)/$(TARGET) +# Executable paths +EXE1 = $(OUT)/$(TARGET1) +EXE2 = $(OUT)/$(TARGET2) -# Default rule -all: $(EXE) +# Default rule (build both) +all: $(EXE1) $(EXE2) -# Build rule -$(EXE): $(SRCS) +# Build rules +$(EXE1): $(SRCS1) mkdir -p $(OUT) - $(FC) $(FFLAGS) -o $(EXE) $(SRCS) + $(FC) $(FFLAGS) -o $(EXE1) $(SRCS1) + +$(EXE2): $(SRCS2) + mkdir -p $(OUT) + $(FC) $(FFLAGS) -o $(EXE2) $(SRCS2) # Convenience targets debug: diff --git a/event2_merge.f b/event2_merge.f new file mode 100644 index 0000000..5fdec9b --- /dev/null +++ b/event2_merge.f @@ -0,0 +1,6 @@ + PROGRAM MAIN + CALL GREAD('./results/gtopdraw_THRUST_00000.dat') + CALL GTOPER( 3,1,1,0,100+3) + CALL GTOPER(10+3,0,0,0,110+3) + END PROGRAM +C----------------------------------------------------------------------- \ No newline at end of file diff --git a/gbook.f b/gbook.f index d5740c1..943d9a0 100644 --- a/gbook.f +++ b/gbook.f @@ -743,6 +743,12 @@ C SET UP PAGE... ENDIF NTYPE=MOD(NTYPE,4)+1 C PLOT... + WRITE (21,*) 'HIST ID ',ID + IF (IDERR.NE.0) THEN + WRITE (21,*) 'HIST IDERR',IDERR + ENDIF + WRITE (21,*) 'HIST NBINS',NX + WRITE (21,*) 'DATA' DO 200 I=1, NX IF ((ABS(X(I)).GE.1E-3.AND.ABS(X(I)).LT.1E5.OR.X(I).EQ.0).AND. & (ABS(Y(I)).GE.1E-5.AND.ABS(Y(I)).LT.1E3.OR.Y(I).EQ.0)) THEN @@ -925,6 +931,91 @@ C----------------------------------------------------------------------- GOTO 200 ENDIF END +C----------------------------------------------------------------------- + SUBROUTINE GREAD(FILE) + IMPLICIT INTEGER (I-N) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FILE + CHARACTER*200 LINE, TITLE + CHARACTER*100 KEYS(5) + DOUBLE PRECISION TX, TY, TE + + PARAMETER (NSIZE=200000, NMAX=2000) + COMMON /GBOOK/ A(NSIZE) + + INTEGER NX, IOS, ID, IDERR + LOGICAL INDATA + + INDATA = .FALSE. + IDERR = 0 + + OPEN(10, FILE=FILE, STATUS='OLD') + + 10 CONTINUE + READ(10,'(A)',END=900) LINE + +C --- Read keywords + READ(LINE,*,IOSTAT=IOS) KEYS + + IF (IOS.GT.0) GOTO 10 + +C --- PROCESS KEYS + IF (KEYS(1).EQ.'SET') THEN + + IF(KEYS(2).EQ.'LIMITS') THEN + READ(KEYS(4),*) XMIN + READ(KEYS(5),*) XMAX + ENDIF + + ELSE IF (KEYS(1).EQ.'TITLE') THEN + TITLE = KEYS(3) + + ELSE IF (KEYS(1).EQ.'HIST') THEN + + IF(KEYS(2).EQ.'ID') THEN + READ(KEYS(3),'(I4)') ID + ELSE IF(KEYS(2).EQ.'IDERR') THEN + READ(KEYS(3),'(I4)') IDERR + ELSE IF(KEYS(2).EQ.'NBINS') THEN + READ(KEYS(3),'(I4)') NX + ENDIF + + ELSE IF (KEYS(1).EQ.'DATA') THEN + INDATA = .TRUE. + CALL GBOOK1(ID,TITLE,NX,XMIN,XMAX) + IF(IDERR.NE.0) THEN + CALL GBOOK1(IDERR,TITLE,NX,XMIN,XMAX) + ENDIF + +C --- DATA LINES + ELSE IF (INDATA) THEN + + READ(LINE,*,IOSTAT=IOS) TX, TY, TE + + IF(IOS.EQ.0) THEN + CALL GFILL1(ID,TX,TY) + IF(IDERR.NE.0) THEN + CALL GFILL1(IDERR,TX,TE) + ENDIF + ELSE IF (IOS .EQ. 5010) THEN +C ------ FORMAT ERROR: CHECK IF END OF DATA OR JUST AN ERROR + IF(TRIM(LINE).EQ.'HIST ; PLOT'.OR. + $ TRIM(LINE).EQ.'JOIN DASH ; PLOT') THEN + INDATA = .FALSE. + ENDIF + GOTO 10 + ENDIF + + ENDIF + + GOTO 10 + + 900 CONTINUE + CLOSE(10) + + RETURN + END C----------------------------------------------------------------------- SUBROUTINE GOPENF C---OPEN TopDrawer FILE @@ -935,6 +1026,7 @@ C---OPEN TopDrawer FILE COMMON /GFILE/ OPEN, TITLE COMMON /FPATH/ OPATH DATA OPEN/.FALSE./ + DATA OPATH/'./'/ IF (OPEN) RETURN OPEN=.TRUE. N=0 @@ -968,13 +1060,4 @@ C----------------------------------------------------------------------- COMMON /GTCOM/ TYPE,NTYPE DATA TYPE,NTYPE/' ','DASH ','DOT-DASH','PATTERN ',0/ END -C----------------------------------------------------------------------- - double precision function ran(iseed) - implicit none - integer iseed - double precision r(1) - call rangen(1,r) - iseed=iseed+1 - ran=r(1) - end C-----------------------------------------------------------------------