diff --git a/event2_03.f b/event2_03.f index e6be1dd..298b32b 100644 --- a/event2_03.f +++ b/event2_03.f @@ -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----------------------------------------------------------------------- diff --git a/gbook.f b/gbook.f index 84dcd56..f098c30 100644 --- a/gbook.f +++ b/gbook.f @@ -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