* * $Id$ * * $Log$ * Revision 1.1 2000/06/19 20:00:34 eugenio * Initial revision * * Revision 1.1.1.1 1994/10/08 02:21:28 zfiles * first version of qqlib in CVS * * #include "sys/CLEO_machine.h" #include "pilot.h" *CMZ : 1.03/10 12/06/91 11.30.21 by Peter C Kim *CMZ : 1.00/00 04/06/90 18.55.46 by Jorge L. Rodriguez *-- Author : SUBROUTINE QED021(ARG1,ARG2,ARG3,ARG4,IARG5,IARG6) IMPLICIT DOUBLE PRECISION(A-H,K,O-Z) COMMON / CONSTQ / E,AE,AM,ALE,ALM,ALL,PI,PI2,ALFA,BETA COMMON /CONST1/ CMAX,K0,KMIN,KMAX,SIG0,SOFT1,TRSHLD,CHI,GV2,DELW COMMON / TRY / RHO,TES,ITRY,IEV,ISYM COMMON/QED000/IMODDD,LOUT LOGICAL LWK ENER=ARG1 AMAX=ARG2 KMIN=ARG3 KMAX=ARG4 CLSFOT=IARG5.NE.0 CALL QED027(IARG5) LWK =IARG6.NE.0 C...NATURAL CONSTANTS BARN=(1.9732858D0)**2*(1.D+05) C THIS IS A CONVERSION FROM GEV**-2 TO NANOBARN PI=3.1415927D0 AE=0.5110034D-03 AM=105.65948D-03 AT=1782.D-03 ALFA=1.D0/137.035982D0 PI2=PI*PI C...CALCULATE ENERGY-DEPENDENT CONSTANTS S=4.D0*ENER**2 AE=AE/ENER AM=AM/ENER AT=AT/ENER ALE=2.D0*DLOG(2.D0/AE) ALM=2.D0*DLOG(2.D0/AM) ALL=ALE+ALM E=DSQRT(1.D0+AE*AE) C...RESTRICTIONS ON PHASE SPACE C AMAX=5.D0 C THIS IS THE SMALLEST ANGLE BETWEEN E+ AND MU+TO BE GENERATED C WHEN THIS BECOMES TOO SMALL,NEGATIVE CROSSECTIONS WILL RESULT C IF IT BECOMES TOO LARGE,FUNCTION Y2K IS NO LONGER CORRECT CMAX=DCOS(AMAX*PI/180.D0) C...REPRODUCE INPUT WRITE (LOUT,1) ENER,AMAX,KMIN,KMAX C*****TYPE 1,ENER,AMAX,KMIN,KMAX 1 FORMAT(/,20X,'BEAM ENERGY ',F10.4,' GEV', Z /,20X,'ANGLE CUT AT',F10.4,' DEGREES', Z /,20X,'K MIN ',F10.7, Z /,20X,'K MAX ',F10.7) C...LOWEST ORDER CROSSECTION AND ORDER OF MAGNITUDE FOR BREMSSTRAHLUNG C THE LOWEST ORDER IS ALSO RESTRICTED WITHIN AMAX AND 180-AMAX SIG1=2.D0*CMAX*(1.D0+CMAX**2/3.D0) SIG0=BARN*ALFA**2/4.D0/S*2.D0*PI*SIG1 SIG00=SIG0*(8./3./SIG1) C...SIG00 IS THE ZERORDER #SECT. WITHOUT ANGLE LIMITS C...VERTEX CORRECTIONS AND VACUUM POLARIZATION OF ELECTRON AND MUON FAKTOR=2.D0*ALFA/PI BETA=FAKTOR*(ALL-2.D0) DELE=FAKTOR*(0.333D0*ALE-5.D0/9.D0) DELM=FAKTOR*(0.333D0*ALM-5.D0/9.D0) DELV=FAKTOR*(0.75D0*(ALE+ALM)+PI2/3.D0-2.D0) DAR=DELE+DELM+DELV C...VACUUM POLARIZATION OF TAU A2=1.D0-AT**2 A=DSQRT(A2) DELT=8.D0/9.D0-A2/3.D0+A*(1.D0-A2/3.D0)*DLOG(AT/(1.D0+A)) DELT=-FAKTOR*DELT C...HADRONIC VACUUM POLARIZATION DELH=-2.D0*PIHINT(S) C IT IS FASTER TO USE PIHINT(S) THAN PIH(S) C...WEAK CONTRIBUTION TO TOTAL CROSSECTION SIN2=0.22D0 C THIS IS A POPULAR VALUE FOR SIN(TH.W)**2 GKL=4.4D-05 C GKL HAS DIMENSION GEV**-2 AZ2=1.D0/(16.D0*GKL*SIN2*(1.D0-SIN2)) GV2=(-1.D0+4.D0*SIN2)**2 CHI=0.D0 IF(LWK) CHI=GKL*S*AZ2/(S-AZ2) DELW=2.D0*CHI*GV2 C...TOTAL CROSSECTION IN COLINEAR APPROXIMATION C K0 =0.01D0 GOTO 1234 C C ENTRY QED024(ARG1,ARG2) K0=ARG1 KMAX=ARG2 C C 1234 CONTINUE IF(KMAX.LT.1.D0) GOTO 1235 KMAX=0.9999D0 WRITE (LOUT,1236) KMAX C***** TYPE 1236,KMAX 1236 FORMAT(' KMAX=1.0 ILLEGAL...CHANGED TO',F10.7) 1235 CONTINUE C C THIS IS ONE OF THE INTERNAL PARAMETERS FOR SUBROUTINE EVENT SOFT1=1.D0 + DAR + DELT + DELH + BETA*DLOG(K0) Y2KMIN=Y2K(KMIN) Y2KMAX=Y2K(KMAX) SIGTOT=Y2KMAX-Y2KMIN C...EXACT TOTAL CROSSECTION WITHOUT ANGLE LIMITS!! EXMAX= KMAX - 0.5D0*KMAX**2 + DLOG(1.D0-KMAX) EXMIN= KMIN - 0.5D0*KMIN**2 + DLOG(1.D0-KMIN) SIGEX=SIGTOT+0.5D0*(FAKTOR*SIG00)*(EXMAX-EXMIN) DELTOT=SIGTOT/SIG0 DELTEX=SIGEX /SIG0 C...PRINTOUT WRITE (LOUT,2) SIG0,DELV,DELE,DELM,DELT,DELH, * SIGTOT,DELTOT,SIGEX,DELTEX C*****TYPE 2,SIG0,DELV,DELE,DELM,DELT,DELH, C * SIGTOT,DELTOT,SIGEX,DELTEX 2 FORMAT(/,20X,'LOWEST ORDER CROSSECTION ',0PF10.6,' NANOBARN', Z /,20X,'VERTEX CORRECTIONS ',2PF10.3,' %', Z /,20X,'VAC. POL. (ELECTR) ',2PF10.3,' %', Z /,20X,'VAC. POL. (MUON) ',2PF10.3,' %', Z /,20X,'VAC. POL. (TAU) ',2PF10.3,' %', Z /,20X,'VAC. POL. (HADRONS) ',2PF10.3,' %', Z /,20X,'WITH HARD PHOTONS IN COLINEAR APPROXIMATION :', Z /,20X,'TOTAL CROSSECTION ',0PF10.6,' NANOBARN', Z /,20X,' = ',2PF10.3,' %', Z /,20X,'WITH HARD PHOTONS TREATED EXACTLY :', Z /,20X,'TOTAL CROSSECTION ',0PF10.6,' NANOBARN', Z /,20X,' = ',2PF10.3,' %') IF(LWK) WRITE (LOUT,3) DELW C*****IF(LWK) TYPE 3,DELW 3 FORMAT( 20X,'CONTRIBUTION FROM Z0= ',2PF10.3,' %') WRITE (LOUT,4) C*****TYPE 4 4 FORMAT(/,20X,'PERCENTAGES REFER TO THE LOWEST ORDER CROSSECTION ') C (GENERATED EVENTS CORRESPOND TO THE EXACT CROSSSECTION) C...INTERNAL PARAMETERS FOR EVENT GENERATION ITRY=0 IEV=0 ISYM=0 RHO=2.0D0 TRSHLD=0.D0 Y2KK0=Y2K(K0) IF(KMIN.LT.K0)TRSHLD=(Y2KK0-Y2KMIN)/SIGTOT K0=DMAX1(K0,KMIN) C TRSHLD DETERMINES THE APPROXIMATE FRACTION OF SOFT EVENTS C IF KMIN > K0 , THERE WILL BE NO ELASTIC EVENTS POSSIBLE C...CHECK ON EXOTIC INPUT AND RETURN IF(KMAX.LT.K0) WRITE (LOUT,5) KMAX,K0 C*****IF(KMAX.LT.K0) TYPE 5,KMAX,K0 5 FORMAT(///,20X,'KMAX =',F10.5,' IS SMALLER THAN ',F10.5,/, Z 20X,'THIS WILL LEAD TO ERRORS IN ROUTINE EVENT') C C---> ADDITION 1-19-81 C KTEST=1.D0-.5D0*AM IF(KMAX.GT.KTEST) WRITE (LOUT,6) KMAX,KTEST C*****IF(KMAX.GT.KTEST) TYPE 6,KMAX,KTEST 6 FORMAT(///,20X,'KMAX =',F10.5,' IS LARGER THAN ',F10.5,/, Z 20X,'FOR VERY HARD PHOTONS THE EVENT ' Z ,'DISTRIBUTION MAY BE DISTORTED.') IF(KMAX.LT.KMIN) WRITE (LOUT,7) C*****IF(KMAX.LT.KMIN) TYPE 7 7 FORMAT(///,20X,'KMAX IS SMALLER THAN KMIN ,',/, Z 20X,'THIS GIVES NEGATIVE CROSSECTIONS ETC.') RETURN C-------------------------------- C C ENTRY QED023 FEV=DFLOAT(IEV) FTRY=DFLOAT(ITRY) CROSS=(FEV/FTRY*RHO) * SIGEX DCROSS=CROSS/SIG0 WRITE (LOUT,11) IEV,ITRY,ISYM,RHO,CROSS,DCROSS C*****TYPE 11,IEV,ITRY,ISYM,RHO,CROSS,DCROSS 11 FORMAT( Z 20X,'# EVENTS GENERATED =',I10,/, Z 20X,'# TRIALS NECESSARY =',I10,/, Z 20X,'# WASTED DUE TO SYMM. =',I10,/, Z 20X,'RATIO FOR TESTING =',F10.3,//, Z 20X,'TRUE CROSSECTION ',F10.5,' NANOBARN',/, Z 20X,' =',2PF10.5,' %') RETURN END