gchiurato
/
EVENT2
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Refactored event2 to modern fortran structure. Fixed bug in gbook.

This commit is contained in:
Yggdrasil 2026-04-08 11:14:54 +02:00
parent 28475c31b6
commit caa644ebc6
2 changed files with 95 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

183
event2_03.f
View File

@ -1,3 +1,4 @@
PROGRAM MAIN
IMPLICIT NONE
INTEGER NF,NEV
DOUBLE PRECISION EM
@ -10,7 +11,7 @@ C NEV=5 000 000
CALL DEMOIN
CALL EVENT2(NEV,EM,NF,DEMO)
CALL DEMOUT(NEV)
END
END PROGRAM
C-----------------------------------------------------------------------
SUBROUTINE EVENT2(NEV,EM,NFL,USER)
IMPLICIT NONE
@ -190,6 +191,10 @@ C---GIVE THE SUBTRACTION CONFIGURATIONS TO THE USER
C---TELL THE USER THAT THE EVENT IS COMPLETE
1000 CALL USER(0,0,0,P,ZERO)
ENDDO
END
C-----------------------------------------------------------------------
SUBROUTINE READCARD
END
C-----------------------------------------------------------------------
SUBROUTINE DEMOIN
@ -3374,94 +3379,6 @@ c
end
c
c**********************************************************************
c function zspv(smu,snu) calculates a smu*snu inproduct in
c spinor-tensor language. both smu and snu are co-variant tensors.
c the factor 2 is due to spinor transformation algebra.
c**********************************************************************
function zspv(smu,snu)
complex*16 zspv,smu(1:2,1:2),snu(1:2,1:2)
zspv=2D0*(+smu(1,1)*snu(2,2)
. +smu(2,2)*snu(1,1)
. -smu(1,2)*snu(2,1)
. -smu(2,1)*snu(1,2) )
end
c
c
c spence function
c
block data splint
implicit double precision (a-h,o-z)
common/spint/a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,zeta2
data a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,zeta2/
1 -0.250000000000000D0,
2 -0.111111111111111D0,
3 -0.010000000000000D0,
4 -0.017006802721088D0,
5 -0.019444444444444D0,
6 -0.020661157024793D0,
7 -0.021417300648069D0,
8 -0.021948866377231D0,
9 -0.022349233811171D0,
1 -0.022663689135191D0,
2 1.644934066848226D0/
end
c
c spence function taking only real arguments
c
function rsp(x)
implicit double precision(a-h,o-z)
common/spint/a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,zeta2
x2=x*x
if(x.gt.1.D0)then
write(*,*)' argument greater than 1 passed to spence function'
rsp=0.D0
return
endif
if(x2.gt.1.D0.and.x.gt.0.5D0)then
y=(x-1.D0)/x
z=-log(1.D0-y)
z2=z*z
rsp=z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
3 +zeta2-log(x)*log(1.D0-x)+0.5D0*log(x)**2
return
elseif(x2.gt.1.D0.and.x.le.0.5D0)then
y=1.D0/x
z=-log(1.D0-y)
z2=z*z
rsp=-z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
3 -zeta2-0.5D0*log(-x)**2
return
elseif(x2.eq.1.D0)then
rsp=zeta2
return
elseif(x2.le.1.D0.and.x.gt.0.5D0)then
y=1.D0-x
z=-log(1.D0-y)
z2=z*z
rsp=-z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
3 +zeta2-log(x)*log(1.D0-x)
return
elseif(x2.le.1.D0.and.x.le.0.5D0)then
y=x
z=-log(1.D0-y)
z2=z*z
rsp=z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
return
else
write(*,*)' illegal x value in spence function'
rsp=0.D0
endif
return
end
c***********************************************************************
c
c two loop strong coupling constant at scale rq
c
@ -3616,6 +3533,94 @@ C IF (N.LT.0) PRINT THE CURRENT VALUES OF THE SEEDS
ISEED(2)=NINT(R(2))
ENDIF
END
c function zspv(smu,snu) calculates a smu*snu inproduct in
c spinor-tensor language. both smu and snu are co-variant tensors.
c the factor 2 is due to spinor transformation algebra.
c**********************************************************************
function zspv(smu,snu)
complex*16 zspv,smu(1:2,1:2),snu(1:2,1:2)
zspv=2D0*(+smu(1,1)*snu(2,2)
. +smu(2,2)*snu(1,1)
. -smu(1,2)*snu(2,1)
. -smu(2,1)*snu(1,2) )
end
c
c
c spence function taking only real arguments
c
function rsp(x)
implicit double precision(a-h,o-z)
common/spint/a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,zeta2
x2=x*x
if(x.gt.1.D0)then
write(*,*)' argument greater than 1 passed to spence function'
rsp=0.D0
return
endif
if(x2.gt.1.D0.and.x.gt.0.5D0)then
y=(x-1.D0)/x
z=-log(1.D0-y)
z2=z*z
rsp=z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
3 +zeta2-log(x)*log(1.D0-x)+0.5D0*log(x)**2
return
elseif(x2.gt.1.D0.and.x.le.0.5D0)then
y=1.D0/x
z=-log(1.D0-y)
z2=z*z
rsp=-z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
3 -zeta2-0.5D0*log(-x)**2
return
elseif(x2.eq.1.D0)then
rsp=zeta2
return
elseif(x2.le.1.D0.and.x.gt.0.5D0)then
y=1.D0-x
z=-log(1.D0-y)
z2=z*z
rsp=-z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
3 +zeta2-log(x)*log(1.D0-x)
return
elseif(x2.le.1.D0.and.x.le.0.5D0)then
y=x
z=-log(1.D0-y)
z2=z*z
rsp=z*(1.D0+a1*z*(1.D0+a2*z*(1.D0+a3*z2*(1.D0+a4*z2*
1 (1.D0+a5*z2*(1.D0+a6*z2*(1.D0+a7*z2*(1.D0+a8*z2*(1.D0+a9*z2*
2 (1.D0+a10*z2))))))))))
return
else
write(*,*)' illegal x value in spence function'
rsp=0.D0
endif
return
end
c spence function
c
block data splint
implicit double precision (a-h,o-z)
common/spint/a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,zeta2
data a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,zeta2/
1 -0.250000000000000D0,
2 -0.111111111111111D0,
3 -0.010000000000000D0,
4 -0.017006802721088D0,
5 -0.019444444444444D0,
6 -0.020661157024793D0,
7 -0.021417300648069D0,
8 -0.021948866377231D0,
9 -0.022349233811171D0,
1 -0.022663689135191D0,
2 1.644934066848226D0/
end block data splint
c
c***********************************************************************
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

2
gbook.f
View File

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