*
* $Id$
*
* $Log$
* Revision 1.1  2000/06/19 20:00:34  eugenio
* Initial revision
*
* Revision 1.1.1.1  1994/10/08  02:21:29  zfiles
* first version of qqlib in CVS
*
*
#include "sys/CLEO_machine.h"
#include "pilot.h"
*CMZ :  1.00/00 04/06/90  18.55.46  by  Jorge L. Rodriguez
*-- Author :

      SUBROUTINE QED041(ARG1,ARG2)
C --------------------------------------------------------------------------
C...SETUP ROUTINE FOR CONSTANTS, PARAMETERS AND CROSSECTIONS
C --------------------------------------------------------------------------
      IMPLICIT DOUBLE PRECISION(A-Z)

      COMMON / CON1 / PI,M,ALFA,PI2,LE,E,DL,MU,S,K0,CMAX,BETA,
     *                SIG0,SIGA,SIGCOL,THRSLD,LK0
      COMMON / TRY4 / RHO,TTOT,IEV,ITRY,ISYM
      INTEGER IEV,ITRY,ISYM
      COMMON/QED000/IMODDD,IOUT
      INTEGER IMODDD,IOUT
      ENERGY=ARG1
      AMAX  =ARG2
      CMAX=DCOS(AMAX*3.1415926D0/180.D0)
C... NATURAL CONSTANTS
      BARN=(1.9732858D0)**2*(1.D+05)
      PI=3.1415927D0
      ME=0.5110034D-03
      ALFA=1.D0/137.035982D0
      PI2=PI*PI
      K0=0.01D0
      GOTO 1234
C
C
      ENTRY QED044(ARG1)
      K0=ARG1
C
1234  CONTINUE
C     THIS IS ONE OF THE PARAMETERS FOR SUBROUTINE EVENT
C...INPUT PARAMETERS
      S=4.D0*ENERGY*ENERGY
      M=ME/DSQRT(ENERGY*ENERGY-ME*ME)
      MU=0.5D0*M*M*(1.D0-0.25D0*M*M)
      E =1.D0+MU
      DL=2.D0+MU
      LE=DLOG(DL/MU)
      S=S/BARN
C...COEFFICIENT OF INFRARED DIVERGENCY
      LK0=DLOG(K0)
      BETA=2.D0*ALFA/PI*(LE-1.D0)
C...LOWEST ORDER CROSSECTION (NOW ANGULAR CUT, FULL FOURPI)
      SIG0=2.D0*ALFA**2*PI/S * (LE-1.D0)
C...APPLY ANGULAR CUT
      SIG00=2.D0*ALFA**2*PI/S * (DLOG((E+CMAX)/(E-CMAX))-CMAX)
C...ANALYTIC CORRECTION OF CROSSECTION
      SIGA=SIG0*(1.D0+BETA*LK0)
     Z   +2.D0*ALFA**3/S*(LE**3/6.D0+0.75D0*LE**2+(PI2/3.D0-3.D0)
     1 *LE-PI2/12.D0)
      DELA=SIGA/SIG0
C...TOTAL CROSSCECTIONS AND CORRECTION
C...EXACT TOTAL CROSSECTION INTEGRATED OVER ALL K (NO KMAX)
      SIGTOT=-SIG0*BETA*LK0  +  SIGA
     Z   +2.D0*ALFA**3*(-(LE-1.D0)**2+3.D0) /S
C...COLINEAR CROSSECTION INTEGRATED OVER ALL K
      SIGCOL=Y4K(1.D0)
      DELTOT=SIGTOT/SIG0
      DELCOL=SIGCOL/SIG0
C...PARAMETERS FOR SUBROUTINE EVENT
      IEV=0
      ITRY=0
      TTOT=0.D0
      ISYM=0
      RHO=2.0D0
      THRSLD=SIGA/SIGCOL
C...PRINTOUT AND RETURN
      WRITE(IOUT,1)ENERGY,LE
C*****TYPE       1,ENERGY,LE
    1 FORMAT(1H1,19X,'BEAM ENERGY              =',F12.3,'  GEV'
     Z        ,/,20X,'LOG(S/M**2)              =',F12.3)
      WRITE(IOUT,2)K0,THRSLD,RHO
C*****TYPE       2,K0,THRSLD,RHO
    2 FORMAT(  /,20X,'SOFT-HARD BORDER         =',F12.5
     Z        ,/,20X,'# SOFT EVENTS (COL.APP.) =',2PF12.5,' %'
     Z        ,/,20X,'TEST CUTOFF RHO          =',0PF12.5)
      WRITE(IOUT,3)SIG00,SIGA,DELA,SIGTOT,DELTOT,SIGCOL,DELCOL
C*****TYPE       3,SIG00,SIGA,DELA,SIGTOT,DELTOT,SIGCOL,DELCOL
    3 FORMAT(  /,20X,'LOWEST ORDER CROSSECTION =',F12.5,' NB'
     Z        ,/,20X,'TOTAL ANALYTIC XSN       =',F12.5,' NB',
     Z' =',2PF12.4,' %'
     Z        ,/,20X,'TOTAL EXACT XSN          =',0PF12.5,' NB',
     Z' =',2PF12.4,' %'
     Z        ,/,20X,'TOTAL COLINEAR XSN       =',0PF12.5,' NB',
     Z' =',2PF12.4,' %')
      RETURN
C
C
C
      ENTRY QED043
      FEV=DFLOAT(IEV)
      FTRY=DFLOAT(ITRY)
      TTRY=TTOT/FTRY
C...TTRY=SAME THING AS RATIO, EXCEPT USING WEIGHTS INSTEAD OF HIT/REJCT
      RATIO=FEV/FTRY*RHO
      SIGCOR=SIGCOL*TTRY
      DELCOR=SIGCOR/SIG00
      WRITE(IOUT,212)IEV,ITRY,ISYM,RHO,RATIO,SIGCOR,DELCOR
C*****TYPE     212,IEV,ITRY,ISYM,RHO,RATIO,SIGCOR,DELCOR
  212 FORMAT(////,
     Z 20X,'# EVENTS GENERATED    =',I10,/,
     Z 20X,'# TRIALS NECESSARY    =',I10,/,
     Z 20X,'# LOST DUE TO ANG.CUT =',I10,/,
     Z 20X,'RATIO FOR TESTING     =',F10.5,/,
     Z 20X,'RATIO CROSSECTIONS    =',F10.5,/,
     Z 20X,'THE ACCEPTED TOTAL CROSSECTION BECOMES ',/,
     Z 20X,'AFTER WEIGHING        :',F10.5,' NB',' =',2PF10.5,' %')
      RETURN
      END