From 873a720c0219c0e314b0f196004fe12a9b42a84e Mon Sep 17 00:00:00 2001 From: Yggdrasil Date: Wed, 8 Apr 2026 17:07:28 +0200 Subject: [PATCH] Added run card loading (EERAD style) and arbitrary output destination. --- Makefile | 4 +- card.input | 11 ++ event2_03.f | 367 ++++++++++++++++++++++++++++++++++++++++++++++------ gbook.f | 7 +- 4 files changed, 346 insertions(+), 43 deletions(-) create mode 100644 card.input diff --git a/Makefile b/Makefile index 06f2ebe..d4ea188 100644 --- a/Makefile +++ b/Makefile @@ -6,9 +6,9 @@ BUILD ?= release # Flags depending on build type ifeq ($(BUILD),debug) - FFLAGS = -g -O0 + FFLAGS = -g -O0 -std=legacy else - FFLAGS = -O2 + FFLAGS = -O2 -std=legacy endif # Output folder diff --git a/card.input b/card.input new file mode 100644 index 0000000..3f100de --- /dev/null +++ b/card.input @@ -0,0 +1,11 @@ +! Example run card + +! General run parameters +NEV = 5M +NF = 5 + +! Binning parameters: +! B: Bin, L: low, H: high +TB = 200 +TL = 0.0 +TH = 0.5 \ No newline at end of file diff --git a/event2_03.f b/event2_03.f index 298b32b..90a3af6 100644 --- a/event2_03.f +++ b/event2_03.f @@ -1,15 +1,12 @@ PROGRAM MAIN IMPLICIT NONE - INTEGER NF,NEV + INTEGER NFL,NEV DOUBLE PRECISION EM + COMMON /PARAMS/ NFL,NEV,EM EXTERNAL DEMO - NF=5 - EM=91.1876 -C NEV=1 000 000 000 -C NEV=5 000 000 - NEV= 500 000 + CALL READCARD CALL DEMOIN - CALL EVENT2(NEV,EM,NF,DEMO) + CALL EVENT2(NEV,EM,NFL,DEMO) CALL DEMOUT(NEV) END PROGRAM C----------------------------------------------------------------------- @@ -91,8 +88,6 @@ C---INITIALIZE CONSTANTS CQ=ND*QD**2+NU*QU**2 AEM=ONE/128 FPAL2=(4*PI*AEM)**2 - CUTOFF=1D-8 - CUTUP=1 C---METYPE IS 0 FOR ERT, 1 FOR LEIDEN AND 2 FOR GIELE-GLOVER C (CROSS-SECTION NORMALIZATION IS DIFFERENT IN THE DIFFERENT CASES. C FOR ERT, 2-PARTON CROSS-SECTION IS 1, FOR THE OTHERS IT IS THE @@ -194,14 +189,308 @@ C---TELL THE USER THAT THE EVENT IS COMPLETE END C----------------------------------------------------------------------- SUBROUTINE READCARD + implicit none + integer :: stat,n,nl,i,iline,ichar + character(2) :: flag(1:2) + character(40) :: val(1:2) + character(20) :: fname + character(72) :: line + character(12) :: keys(20),settings(20) + logical fexists + + INTEGER NFL,NEV + DOUBLE PRECISION EM + + INTEGER METYPE,NF + DOUBLE PRECISION CF,CA,TR,PI,PISQ,HF,CUTOFF,CUTUP, + $ CQ,FPAL2,ONF + + INTEGER CB1,CB2,DB,TB,YB,EB + DOUBLE PRECISION CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH + + 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/CL1,CL2,DL,TL,YL,EL,CH1,CH2,DH,TH,YH,EH + common /runcard/keys,settings + + PATH = './results/' + + n = iargc() + nl = -1 + if (n.ge.2) then + call getarg(1,flag(1)) + call getarg(2,val(1)) + nl = 1 + endif + if (n.ge.4)then + call getarg(3,flag(2)) + call getarg(4,val(2)) + nl = 2 + endif + + do i=1,nl + if (flag(i).eq.'-i')then + fname = val(i) + elseif (flag(i).eq.'-o')then + PATH = val(i) + else + print *, 'Option ', flag(i), + $ ' not recognized.' + endif + enddo + + call CREATEOUT(PATH) + + inquire(file=fname, exist=fexists) + if (.not.fexists)then + stop 'run card ' // trim(fname) // ' not found' + endif + + open(9,file=fname) + + iline = 1 + do + call getline(9, line, stat) + if (line.ne.'')then + ichar = index(line, "=") + if (ichar.gt.0)then + keys(iline) = line(:ichar-1) + settings(iline) = line(ichar+1:) + endif + iline = iline+1 + endif + if (stat.lt.0) exit + end do + + call readparm('EM ', EM, real(91.187, 8)) + + call readparm('CUTOFF ', CUTOFF, 1D-8) + call readparm('CUTUP ', CUTUP , 1D0) + + call readmode('NF ', NFL, 5) + call readmode('NEV ', NEV, 5 000 000) + + call readmode('CB1 ', CB1, 50) + call readmode('CB2 ', CB2, 37) + call readmode('DB ', DB, 50) + call readmode('TB ', TB, 50) + call readmode('YB ', YB, 40) + call readmode('EB ', EB, 50) + + call readparm('CL1 ', CL1 , 0.00D0) + call readparm('CH1 ', CH1 , 1.00D0) + call readparm('CL2 ', CL2 , 0.00D0) + call readparm('CH2 ', CH2 , 0.74D0) + call readparm('DL ', DL , 0.00D0) + call readparm('DH ', DH , 1.00D0) + call readparm('TL ', TL , 0.00D0) + call readparm('TH ', TH , 0.50D0) + call readparm('YL ', YL , 0.00D0) + call readparm('YH ', YH , 0.40D0) + call readparm('EL ', EL , -1.0D0) + call readparm('EH ', EH , 1.00D0) + +C Close file. + close(9) END + +c----------------------------------------------------------------------- +c Auxilliary subroutines. +c----------------------------------------------------------------------- + + subroutine getline(unit, line, stat) + implicit none + integer, intent(in) :: unit + integer, intent(out) :: stat + character(72), intent(out) :: line + integer :: size + integer :: i,j + integer :: stat2 + character(72) :: buffer + character(2) :: pattern +c List of characers where blanks after/before will be eliminated. + character(*), parameter :: killtrail = "=,>[*+" + character(*), parameter :: killlead = "=,>]*+" + +c Read the full line. + line = '' + do + read(unit, "(A)", iostat=stat) line + if (stat > 0) return + exit + end do + +c Replace all `tab` characters by a blank. + do + i = index(line, char(9)) + if (i.eq.0) exit + line(i:i) = " " + end do + +c Kill leading blanks. + line = trim(adjustl( line )) +c Kill possible comments. + i = index(line, "!") +c Kill trailing blanks. + if (i.gt.0) line = trim(adjustl(line(:i-1))) + +c Kill blanks before special characters. + do j=1,len(killlead) + pattern = ' ' // killlead(j:j) + do + i = index(line,pattern) + if (i.eq.0) exit + line = line(:i-1) // killtrail(j:j) // line(i+2:) + end do + end do + +c Kill blanks after special characters. + do j=1,len(killlead) + pattern = killlead(j:j) // ' ' + do + i = index(line,pattern) + if (i.eq.0) exit + line = line(:i-1) // killlead(j:j) // line(i+2:) + end do + end do + + return + end + +************************************************************************ + + subroutine readmode(cmode, var, def) + implicit none + character(12), intent(in) :: cmode + integer, intent(in) :: def + integer, intent(out) :: var + integer :: i, imode + character(12) :: keys(20),settings(20) +c Common blocks. + common/runcard/keys,settings + +c Try to find mode with name 'cmode' in settings. + imode = -1 + do i=1,20 + if (keys(i).eq.cmode)then + imode = i + exit + endif + end do +c If not found, set to default. + if (imode.lt.0) var = def +c Otherwise set to value present in settings. + if (imode.ge.0) call readInt(settings(imode), var) + + return + end + +************************************************************************ + + subroutine readparm(cparm, var, def) + implicit none + character(12), intent(in) :: cparm + real(8), intent(in) :: def + real(8), intent(out) :: var + integer :: i,iparm + character(12) :: keys(20),settings(20) +c Common blocks. + common/runcard/keys,settings + +c Try to find mode with name 'cparm' in settings. + iparm = -1 + do i=1,20 + if (keys(i).eq.cparm) iparm = i + end do +c If not found, set to default. + if (iparm.lt.0) var = def +c Otherwise set to value present in settings. + if (iparm.ge.0) read(settings(iparm),*) var + + return + end + +************************************************************************ + +c Auxiliary helper subroutine to read integers in different formats. + + subroutine readint(string,var) + implicit none + integer, intent(out) :: var + character(8), intent(in) :: string + integer :: iposk,iposm,ipose,iposd + real(8) :: helper + + iposk = index(string,'k') + if (iposk.eq.0) iposk = index(string,'K') + iposm = index(string,'m') + if (iposm.eq.0) iposm = index(string,'M') + ipose = index(string,'e') + if (ipose.eq.0) ipose = index(string,'E') + iposd = index(string,'d') + if (iposd.eq.0) iposd = index(string,'D') + + if (iposk.ne.0)then + read(string(1:iposk-1),'(I16)') var + var = 1000*var + elseif (iposm.ne.0)then + read(string(1:iposm-1),'(I16)') var + var = 1000000*var + elseif (ipose.ne.0 .or. iposd.ne.0)then + read(string,'(F16.0)') helper + var = helper + else + read(string, '(I16)') var + endif + + return + end + +************************************************************************ + +c Auxiliary helper subroutine to create output folder + + SUBROUTINE CREATEOUT(PATH) + IMPLICIT NONE + CHARACTER*40 PATH + + INTEGER L,EXITSTAT + CHARACTER*40 OPATH + COMMON /FPATH/ OPATH + + OPATH = PATH + L = LEN_TRIM(OPATH) + + IF (L == 0) THEN + OPATH = './' + ELSE IF (OPATH(L:L) /= '/') THEN + OPATH(L+1:L+1) = '/' + END IF + + CALL EXECUTE_COMMAND_LINE("mkdir -p " // TRIM(OPATH), + $ exitstat=EXITSTAT) + IF (EXITSTAT /= 0) THEN + PRINT *, "Error creating directory:", TRIM(OPATH) + STOP + END IF + + END + C----------------------------------------------------------------------- SUBROUTINE DEMOIN IMPLICIT NONE 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 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 DO I=1,8 CSUM(I)=0 CSQR(I)=0 @@ -212,36 +501,36 @@ C----------------------------------------------------------------------- BSQR(2,I)=0 ENDIF ENDDO - CALL GBOOK1( 1,'C-PARAMETER',50,0D0,1D0) - CALL GBOOK1(101,'C-PARAMETER',50,0D0,1D0) - CALL GBOOK1(201,'C-PARAMETER',50,0D0,1D0) - CALL GBOOK1( 11,'C-PARAMETER',37,0D0,0.74D0) - CALL GBOOK1(111,'C-PARAMETER',37,0D0,0.74D0) - CALL GBOOK1(211,'C-PARAMETER',37,0D0,0.74D0) - CALL GBOOK1( 2,'D-PARAMETER',50,0D0,1D0) - CALL GBOOK1(102,'D-PARAMETER',50,0D0,1D0) - CALL GBOOK1(202,'D-PARAMETER',50,0D0,1D0) - CALL GBOOK1( 12,'D-PARAMETER',50,0D0,1D0) - CALL GBOOK1(112,'D-PARAMETER',50,0D0,1D0) - CALL GBOOK1(212,'D-PARAMETER',50,0D0,1D0) - CALL GBOOK1( 3,'THRUST',50,0D0,0.5D0) - CALL GBOOK1(103,'THRUST',50,0D0,0.5D0) - CALL GBOOK1(203,'THRUST',50,0D0,0.5D0) - CALL GBOOK1( 13,'THRUST',50,0D0,0.5D0) - CALL GBOOK1(113,'THRUST',50,0D0,0.5D0) - CALL GBOOK1(213,'THRUST',50,0D0,0.5D0) - CALL GBOOK1( 4,'y3(JADE,P)',40,0D0,0.4D0) - CALL GBOOK1(104,'y3(JADE,P)',40,0D0,0.4D0) - CALL GBOOK1(204,'y3(JADE,P)',40,0D0,0.4D0) - CALL GBOOK1( 14,'y3(JADE,P)',40,0D0,0.4D0) - CALL GBOOK1(114,'y3(JADE,P)',40,0D0,0.4D0) - CALL GBOOK1(214,'y3(JADE,P)',40,0D0,0.4D0) - CALL GBOOK1( 5,'EEC',50,-1D0,1D0) - CALL GBOOK1(105,'EEC',50,-1D0,1D0) - CALL GBOOK1(205,'EEC',50,-1D0,1D0) - CALL GBOOK1( 15,'EEC',50,-1D0,1D0) - CALL GBOOK1(115,'EEC',50,-1D0,1D0) - CALL GBOOK1(215,'EEC',50,-1D0,1D0) + CALL GBOOK1( 1,'C-PARAMETER',CB1,CL1,CH1) + CALL GBOOK1(101,'C-PARAMETER',CB1,CL1,CH1) + CALL GBOOK1(201,'C-PARAMETER',CB1,CL1,CH1) + CALL GBOOK1( 11,'C-PARAMETER',CB2,CL2,CH2) + CALL GBOOK1(111,'C-PARAMETER',CB2,CL2,CH2) + CALL GBOOK1(211,'C-PARAMETER',CB2,CL2,CH2) + CALL GBOOK1( 2,'D-PARAMETER',DB,DL,DH) + CALL GBOOK1(102,'D-PARAMETER',DB,DL,DH) + CALL GBOOK1(202,'D-PARAMETER',DB,DL,DH) + CALL GBOOK1( 12,'D-PARAMETER',DB,DL,DH) + CALL GBOOK1(112,'D-PARAMETER',DB,DL,DH) + CALL GBOOK1(212,'D-PARAMETER',DB,DL,DH) + CALL GBOOK1( 3,'THRUST',TB,TL,TH) + CALL GBOOK1(103,'THRUST',TB,TL,TH) + CALL GBOOK1(203,'THRUST',TB,TL,TH) + CALL GBOOK1( 13,'THRUST',TB,TL,TH) + CALL GBOOK1(113,'THRUST',TB,TL,TH) + CALL GBOOK1(213,'THRUST',TB,TL,TH) + CALL GBOOK1( 4,'y3(JADE,P)',YB,YL,YH) + CALL GBOOK1(104,'y3(JADE,P)',YB,YL,YH) + CALL GBOOK1(204,'y3(JADE,P)',YB,YL,YH) + CALL GBOOK1( 14,'y3(JADE,P)',YB,YL,YH) + CALL GBOOK1(114,'y3(JADE,P)',YB,YL,YH) + CALL GBOOK1(214,'y3(JADE,P)',YB,YL,YH) + CALL GBOOK1( 5,'EEC',EB,EL,EH) + CALL GBOOK1(105,'EEC',EB,EL,EH) + CALL GBOOK1(205,'EEC',EB,EL,EH) + CALL GBOOK1( 15,'EEC',EB,EL,EH) + CALL GBOOK1(115,'EEC',EB,EL,EH) + CALL GBOOK1(215,'EEC',EB,EL,EH) END C----------------------------------------------------------------------- SUBROUTINE DEMOUT(NEV) diff --git a/gbook.f b/gbook.f index f098c30..585adb3 100644 --- a/gbook.f +++ b/gbook.f @@ -931,19 +931,22 @@ C---OPEN TopDrawer FILE LOGICAL OPEN CHARACTER TITLE * 60 CHARACTER FNAME * 74 + CHARACTER*40 OPATH COMMON /GFILE/ OPEN, TITLE + COMMON /FPATH/ OPATH DATA OPEN/.FALSE./ IF (OPEN) RETURN OPEN=.TRUE. N=0 - FNAME='gtopdraw_'//TRIM(TITLE)//'.top' + FNAME=TRIM(OPATH)//'gtopdraw_'//TRIM(TITLE)//'.top' OPEN (21,FILE=TRIM(FNAME),STATUS='NEW',ERR=10) WRITE (6,*) 'Using file "'//TRIM(FNAME)//'"' RETURN 10 N=N+1 IF (N.GE.100) STOP WRITE (6,*) 'Could not open file "',TRIM(FNAME),'"' - WRITE (FNAME,'(A,I2.2,A4)') 'gtopdraw_'//TRIM(TITLE)//'_',N,'.top' + WRITE (FNAME,'(A,I2.2,A4)') TRIM(OPATH)//'gtopdraw_' + $ //TRIM(TITLE)//'_',N,'.top' OPEN (21,FILE=TRIM(FNAME),STATUS='NEW',ERR=10) WRITE (6,*) 'Using file "',TRIM(FNAME),'" instead' END