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

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-----------------------------------------------------------------------

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