*
* $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 :

      DOUBLE PRECISION FUNCTION QEDTS4(DUMMY)
      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 / OUT13 / K,C,Z,FI,FG
      COMMON / OUT12 / SC,SZ,CGAM,X
      COMMON/QED000/IMODDD,IOUT
      INTEGER IMODDD,IOUT
C...COMPUTE RATIO BETWEEN EXACT CROSSECTION AND COLINEAR APPROXIMATION
C...IN BOTH EXPRESSIONS THERE IS AN OVERALL FACTOR
C...ALFA**3/8./PI**2/S LEFT OUT
      IF(K.EQ.0.D0) GO TO 1
C...HARD PART
C...CALCULATE ENERGY AND SCATTERING ANGLE OF THIRD PHOTON AS WELL
C...THIS IS NECESSARY TO CALCULATE SYMMETRIC APPROXIMANT
      X1=2.D0*E-K-X
      IF(X1.LE.0.D0)WRITE(5,11)X1
      IF(X1.LE.0.D0)WRITE(IOUT,11)X1
   11 FORMAT(1X,'  X1 <= 0',F20.16)
      C1=-(X*C+K*Z)/X1
      IF(DABS(C1).GT.1.D0)WRITE(5,12)C1
      IF(DABS(C1).GT.1.D0)WRITE(IOUT,12)C1
   12 FORMAT(1X,'  /C1/ > 1',F20.16)
C...CALCULATE VALUE OF APPROXIMANT AVERAGED OVER ALL PERMUTATIONS
      COLL=    PROXIM(  K,Z    ,X,C    ,X1,C1 )
     Z       + PROXIM(  X,C    ,X1,C1  ,K,Z   )
     Z       + PROXIM(  X1,C1  ,K,Z    ,X,C   )
     Z       + PROXIM(  X1,C1  ,X,C    ,K,Z   )
     Z       + PROXIM(  X,C    ,K,Z    ,X1,C1 )
     Z       + PROXIM(  K,Z    ,X1,C1  ,X,C   )
      IF(COLL.LE.0.D0) WRITE(5,13)ACOLL,K,C,Z
      IF(COLL.LE.0.D0) WRITE(IOUT,13)ACOLL,K,C,Z
   13 FORMAT('COLL <= 0',4D15.7)
C...CALCULATE EXACT CROSSECTION
      ACOLL=EXACT(K,Z,X,C,X1,C1)
      IF(ACOLL.LE.0.D0) WRITE(5,14)ACOLL,K,Z,X,C,X1,C1
      IF(ACOLL.LE.0.D0) WRITE(IOUT,14)ACOLL,K,Z,X,C,X1,C1
   14 FORMAT(1X,'  EXCT <= 0',7F15.6)
C...TEST IS THE RATIO BETWEEN THE TWO EXPRESSIONS
      QEDTS4=ACOLL/COLL
      RETURN
C...SOFT CASE
C...REMEMBER THAT THE C DISTRIBUTION IN THE SOFT PART IS NOT
C...GENERATED AS (1+C**2)/(1-C**2) BUT AS 2/(1-C**2)
    1 QEDTS4=1.D0 + BETA*LK0
     Z +ALFA/2.D0/PI*(LE*LE+PI2/3.D0+(E*E-C*C)/(E*E+C*C)*QED04Z(C))
C...NORMALIZE FOR CORRECT TOTAL NUMBER OF EVENTS
      QEDTS4=QEDTS4*SIG0/SIGA
C...NORMALIZE AGAIN FOR SLIGHTLY DIFFERENT ANGULAR DISTRIBUTION
      QEDTS4=QEDTS4*(1.D0+C*C)/2.D0*LE/(LE-1.D0)
      IF(QEDTS4.LE.0.D0) WRITE(5,21)QEDTS4,C
      IF(QEDTS4.LE.0.D0) WRITE(IOUT,21)QEDTS4,C
   21 FORMAT(1X,'TEST(K=0) <=0',2F20.16)
      RETURN
      END