* * This is smatasy.f, version 5.02, 1997 (16 Oct 1997). * It runs together with zfitr_beta as of from Feb. 1997: * zfitr_beta_02_1997.uu * both smatasy and zfitter may be got from http://www.ifh.de/~riemann/ * * authors: M. Gr\"unewald, Martin.Grunewald@cern.ch * S. Kirsch * T. Riemann, Tord.Riemann@ifh.de *\bibitem{Kirsch:1995cf} *S.~Kirsch and T.~Riemann, {\em Comp. Phys. Commun.} {\bf 88} (1995) 89--108. **\bibitem{Leike:1991pq} *A.~Leike, T.~Riemann, and J.~Rose, {\em Phys. Lett.} {\bf B273} (1991) * 513--518. **\bibitem{Riemann:1992gv} *T.~Riemann, {\em Phys. Lett.} {\bf B293} (1992) 451--456. * CDECK ID>, SMATADOC. ************************************************************************* * * The FORTRAN package SMATASY is described in: * * S. Kirsch, T. Riemann * SMATASY - * A Program for the Model Independent Description of the Z Resonance * Preprint DESY 94-125, * Comp. Phys. Comm. 88 (1995) 89. * * * SMATASY is an extension of the ZFITTER (see reference below) branch * ZUSMAT which allows to calculate also asymmetries in the S-matrix * approach. * For the installation of SMATASY the subroutine BORN of ZFITTER * must be replaced with subroutine BORN of SMATASY. To use SMATASY * one has to initialize first ZFITTER following the procedure * described in the reference below, section 6. Then, SMATASY is * initialized by a call to subroutine ASYINIT. Subroutine ASYTEST * illustrates the initialization procedure and performs a comparison * with the other model independent approaches of ZFITTER. * * Reference: * D. Bardin et al., FORTRAN package ZFITTER and preprint * CERN-TH. 6443/92 (1992) [hep-ph] 9412201. * ************************************************************************* * * Contacts: T. Riemann, riemann@ifh.de * M. Gruenewald, Martin.Grunewald@cern.ch * S. Riemann, riemanns@ifh.de * ************************************************************************* * * 97/03/07 * * SMATA502 is a SMATASY version for ZFITTER 5_0 of 97/02/07. * * ----------------------------------------------------------------------- * * SMATASY 5.02 was tested together with ZFITTER 5_0 on HP. * ************************************************************************* * * 97/01/16 * * SMATA501 is a SMATASY version for ZFITTER 5_0 of 96/11/16. * * ----------------------------------------------------------------------- * * SMATASY 5.01 was tested together with ZFITTER 5_0 on HP. * ************************************************************************* * * 96/02/05 * * SMATA500 is a SMATASY version for ZFITTER 5_0 of 96/02/05. * * ----------------------------------------------------------------------- * * SMATASY 5.00 was tested together with ZFITTER 5_0 on HP and CERNVM. * ************************************************************************* * * 95/07/01 * * SMATA490 is a SMATASY version for ZFITTER 4_9 of 95/07/01. * * The SMATASY initialization subroutine ASYINIT is now called with * parameters including those of ZUWEAK and calls this routine * automatically, because at least one call to ZUWEAK is mandatory! * The example subroutine ASYTEST now performs also a comparison * with the SM interface of ZFITTER, ZUTHSM. * A new utility subroutine, RJFRSM, has been added to calculate the * values of the S-Matrix parameters r, j and g as expected in the SM. * The new s/r BORN is - as before - backward compatible to the * s/r BORN of ZFITTER 4_9 (95/07/01) for all branches except ZUSMAT. * The ZUSMAT part of the subroutine BORN is now nothing else but the * SMATASY part, so that the cross sections calculated by ZUSMAT are * identical to those calculated by SMATASY. * * ----------------------------------------------------------------------- * * Furthermore, a few routines useful for fitting the five and nine * parameter sets of the LEPEWWG (R=GAMZ_H/GAMZ_F, Afb0=(3/4)*A_E*A_F) * are added: * * VAFRGA: calculates GVF and GAF from Z partial width (GAMZ_F) and A_F * GAFRVA: calculates Z partial width (GAMZ_F) and A_F from GVF and GAF * using the auxiliary routine: * GZFRVA: calculates Z partial width (GAMZ_F) from GVF and GAF * (a la s/r ZWRATE of DIZET) * * ----------------------------------------------------------------------- * * SMATASY 4.90 was tested together with ZFITTER 4_9 on HP and CERNVM. * ************************************************************************* * * 95/06/01 * * SMATA481 is a SMATASY version for zfitr4_8. * In SMATA481, the calculation of the quantity KAPPA in subroutine * RZFRVA is corrected. * Within the revised subroutine BORN, the trivial mass corrections * and the final state QED radiation factor are put explicitly. * Thus the S-Matrix parameters r/j/g absorb only the genuine electro- * weak and QCD corrections. * An additional subroutine, RJFRVA, is included, which calculates * the S-Matrix parameters r/j/g in terms of the effective couplings * ga and gv. For the total cross section (sigma) and the forward- * backward asymmetry (A_fb), QCD corrections and imaginary parts of * the effective couplings are taken into account. In these two cases, * perfect agreement between SMATASY and ZFITTER (ZUXSEC, ZUXSA) is * observed (see output of subroutine ASYTEST). * The subroutine RJFRVA is also useful to extract the effective * couplings from the results of an S-Matrix fit by fitting couplings * to the S-Matrix parameters, errors and correlations (Mini-Fit). * * Note, that within the S-Matrix approach it is not possible to * include the initial-final state QED interference corrections. * (FLAG 'INTF' 1 will be ignored!) * * SMATASY 4.81 was tested together with ZFITTER 4.8 on HP7000 and on * cernvm. * ************************************************************************* * * SMATA4_8 is a SMATASY version for zfitr4_8. * In SMATA4_8 is CORQCD = 1 also for quarks/hadrons. The * new QCD correction factors R_QCD^A and R_QCD^V * for g_a and g_v in zfitr4_8 are set to 1. This gives in the * test example differences between the S-matrix approach (ZUSMAT, * SMATASY) and the other Zfitter branches (ZUXSEC, ZUXSA) * If \alpha_s = 0 the differences disappear. * After a fit of the S-matrix parameters of ee-->qq, hadrons * the interpretation of these parameters in terms of couplings * must include the QCD corrections! * * SMATASY 4.8 was tested together with ZFITTER 4.8 on HP7000 and on * cernvm. * ************************************************************************* * * SMATASY 2.1 was tested together with ZFITTER 4.53 on HP7000. * ************************************************************************* CDECK ID>, MAIN. ************************************************************************** program main ************************************************************************** call asytest end CDECK ID>, ASYTEST. ************************************************************************* subroutine AsyTest ************************************************************************* * * SUBR. ASYTEST * * Example program to demonstrate the use of the SMATASY package * together with the ZFITTER package. * ************************************************************************ implicit none REAL*8 GMU,ALFA,ALFAI,CONS PARAMETER (GMU = 1.166388D-5 , + ALFAI = 137.0359895D0, + ALFA = 1D0/ALFAI, + CONS = 1D0) integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) *** ZFITTER common blocks ****************************************** REAL*8 QDF,QCDCOR ,ALPHST,SIN2TW,S2TEFF , & WIDTHS COMMON /ZUPARS/QDF,QCDCOR(0:14),ALPHST,SIN2TW,S2TEFF(0:11), & WIDTHS(0:11) REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) COMPLEX*16 XALLCH ,XFOTF COMMON /EWFORM/XALLCH(5,4),XFOTF *** variables ************************************************************ double precision SZMass,SGamZ, + xsm(0:11,0:6),xzf(0:11,6),taupol(2), + rasy(0:6),jasy(0:6),gasy(0:6),rr,jj,gg, + gve,gae,rs,s,GamZ,ga,gv,af, + ftot(3),gamee,gamff,dalfai complex*16 SGmu,vacpol data ftot /0.d0,0.d0,0.d0/ integer i,j,k,indf,iasy,ialem,iborn,iconv,iintf,iqcdc,icut *** constants ************************************************************ double precision ZMass,TMass,HMass PARAMETER(ZMASS=91.195D0,TMASS=180.D0,HMASS=300.D0) double precision alfas,alqed,scut PARAMETER(ALFAS=0.123D0) * *========================================================================= * * initialize ZFITTER * CALL ZUINIT * * set ZFITTER flags and print flag values * IALEM=2 IBORN=0 ICONV=0 IINTF=0 IQCDC=1 ICUT=-1 SCUT=0D0 DALFAI=128.894D0 C MWG PRINT*,'Enter Flag ALEM [0-3,I]:' READ(*,*)IALEM PRINT*,'Enter Flag BORN [0-1,I]:' READ(*,*)IBORN PRINT*,'Enter Flag CONV [0-1,I]:' READ(*,*)ICONV PRINT*,'Enter Flag INTF [0-1,I]:' READ(*,*)IINTF PRINT*,'Enter Flag QCDC [0-2,I]:' READ(*,*)IQCDC PRINT*,'Enter SCUT [D]:' READ(*,*) SCUT SCUT=ABS(SCUT) IF(SCUT.GT.0D0)ICUT=1 PRINT*,'Enter 1/alpha [D]:' READ(*,*) DALFAI C MWG * call zuflag('ALEM',IALEM) call zuflag('BORN',IBORN) call zuflag('CONV',ICONV) call zuflag('INTF',IINTF) call zuflag('QCDC',IQCDC) call zuflag('PRNT',1) call zuinfo(0) * * initialize SMATASY * ALQED=1D0/DALFAI * output parameter SGMU is COMPLEX*16 ! call AsyInit(ZMASS,TMASS,HMASS,ALQED,ALFAS,GMU, + GAMZ,SZMASS,SGAMZ,SGMU) vacpol = 1d0/(2d0-xfotf) DO INDF=0,10 CALL ZUCUTS(INDF,ICUT,0D0,0D0,SCUT**2,0D0,180D0) END DO call zuinfo(1) * make test output PRINT* PRINT*,'Accuracy of utility routines GAFRVA, VAFRGA:' PRINT*,'--------------------------------------------' PRINT* PRINT 5,'INDF',' GVF ',' GAF ','Width',' A_F ' 5 FORMAT(1X,A4,4(10X,A5,5X)) PRINT* DO I=0,9 GA=+SQRT(ARROFZ(I))/2D0 GV=ARVEFZ(I)*GA CALL GAFRVA(ZMASS,I,GV,GA,GAMFF,AF) PRINT 6,I,GV,GA,GAMFF*1D3,AF GAMFF=WIDTHS(I)/1D3 AF=ARVEFZ(I) AF=2D0*AF/(1D0+AF*AF) CALL VAFRGA(ZMASS,I,GAMFF,AF,GV,GA) PRINT 6,I,GV,GA,GAMFF*1D3,AF PRINT* END DO 6 FORMAT(1X,I4,2F20.17,F20.14,F20.17) * make table of S-Matrix parameters PRINT* PRINT*,'SM prediction of SMATASY S-Matrix parameters R/J/G:' PRINT*,'---------------------------------------------------' PRINT* PRINT 7,'INDF','R_TOT','J_TOT','G_TOT',' R_FB',' J_FB',' G_FB' 7 FORMAT(1X,A4,6(5X,A5),/,1X,64('-')) DO INDF=0,10 CALL RJFRSM(INDF,SZMASS,SGAMZ, + RASY(ITOT),JASY(ITOT),GASY(ITOT),ITOT) CALL RJFRSM(INDF,SZMASS,SGAMZ, + RASY(IFB ),JASY(IFB ),GASY(IFB ),IFB ) PRINT 8,INDF, + RASY(ITOT),JASY(ITOT),GASY(ITOT), + RASY(IFB ),JASY(IFB ),GASY(IFB ) END DO 8 FORMAT(1X,I4,6F10.6) PRINT* PRINT 17,'INDF' +,' R_POL',' J_POL' +,'R_FBPOL','J_FBPOL' +,' R_LR',' J_LR' +,' R_FBLR',' J_FBLR' +,'R_LRPOL','J_LRPOL' 17 FORMAT(1X,A4,10(3X,A7),/,1X,104('-')) DO INDF=0,10 DO IASY=IPOL,ILRPOL CALL RJFRSM(INDF,SZMASS,SGAMZ, + RASY(IASY),JASY(IASY),GASY(IASY),IASY) END DO PRINT 18,INDF,(RASY(IASY),JASY(IASY),IASY=IPOL,ILRPOL) END DO 18 FORMAT(1X,I4,10F10.6) PRINT* * make table of cross sections and asymmetries PRINT* PRINT*,'Tables of cross sections and asymmetries:' PRINT*,'-----------------------------------------' PRINT* GAE = +SQRT(ARROFZ(1))/2D0 GVE = ARVEFZ(1)*GAE GAMEE= WIDTHS( 1)/1D3 GAMZ = WIDTHS(11)/1D3 DO I = 1,9 if (i.eq.1) then rs = 57.77d0 elseif (i.eq.2) then rs = 89.50D0 elseif (i.eq.3) then rs = 91.19D0 elseif (i.eq.4) then rs = 93.05D0 elseif (i.eq.5) then rs = 130.3D0 elseif (i.eq.6) then rs = 136.3D0 elseif (i.eq.7) then rs = 161.3d0 elseif (i.eq.8) then rs = 172.1d0 elseif (i.eq.9) then rs = 184.0d0 endif call vzero(xsm,12*7*2) call vzero(xzf,12*6*2) * table header PRINT *,' SQRT(S) = ',REAL(RS) print 9060 print 9050 print 9070 * loop over fermion indices DO INDF = 0,10 if (indf.eq.8) goto 66 S=RS**2 gamff = widths(indf)/1000d0 call zuthsm(indf,rs,zmass,tmass,hmass,alqed,alfas, + xzf(indf,1),xzf(indf,5)) call zuxsec(indf,rs,zmass,gamz,gamee,gamff,XZF(INDF,2)) if (indf.ne.10) then GA = +SQRT(ARROFZ(indf))/2. GV = ARVEFZ(indf)*GA if (indf.ne.0) + call zuxsa (indf,rs,zmass,gamz,0,gve,gae,gv,ga, + xzf(indf,3),xzf(indf,6)) do iasy=itot,ilrpol call rjfrva(indf,SZMASS,SGAMZ,GVE,GAE,GV,GA, + rasy(iasy),jasy(iasy),gasy(iasy),iasy) end do call zusmat(indf,rs,SZmass,SGamz, + rasy(itot),rasy(itot)+jasy(itot), + 0.d0,0.d0,0.d0,gasy(itot),xzf(indf,4)) do iasy=itot,ilrpol call Smatasy(indf,rs,SZmass,SGamz, + rasy(itot),jasy(itot),gasy(itot),ftot, + rasy(iasy),jasy(iasy),ftot,iasy,xsm(INDF,iasy)) end do *** tau polarization ****************************************************** IF(INDF.EQ.3) THEN CALL ZUTAU(RS,ZMASS,GAMZ,0,GVE,GAE,GV,GA,TAUPOL(1), + TAUPOL(2)) ENDIF else *** cross section and asymmetries for hadrons **************************** * *** method A: sum over quark cross sections and asymmetries (weighted) * do j=4,9 if (j.ne.8) then xzf(11,1)=xzf(11,1)+xzf(j,1) xzf(11,2)=xzf(11,2)+xzf(j,2) xzf(11,3)=xzf(11,3)+xzf(j,3) xzf(11,4)=xzf(11,4)+xzf(j,4) xzf(11,5)=xzf(11,5)+xzf(j,5)*xzf(j,1) xzf(11,6)=xzf(11,6)+xzf(j,6)*xzf(j,3) xsm(11,itot)=xsm(11,itot)+xsm(j,itot) do iasy=itot+1,ilrpol xsm(11,iasy)=xsm(11,iasy)+xsm(j,iasy)*xsm(j,itot) end do endif end do xzf(11,5)=xzf(11,5)/xzf(11,1) xzf(11,6)=xzf(11,6)/xzf(11,3) do iasy=itot+1,ilrpol xsm(11,iasy)=xsm(11,iasy)/xsm(11,itot) end do PRINT 9030,-INDF, + (xzf(indf+1,j),j=1,4), + xsm(indf+1,0),(xzf(indf+1,j),j=5,6), + (xsm(indf+1,j),j=1,6) * *** method B: sum S-Matrix parameters r/j/g and calculate sigma & afbs * do iasy=itot,ilrpol rasy(iasy)=0d0 jasy(iasy)=0d0 gasy(iasy)=0d0 do j=4,9 if (j.ne.8) then ga = +SQRT(ARROFZ(j))/2. gv = ARVEFZ(j)*ga call rjfrva (j,SZMASS,SGAMZ,GVE,GAE,GV,GA, + rr,jj,gg,iasy) rasy(iasy)=rasy(iasy)+rr jasy(iasy)=jasy(iasy)+jj gasy(iasy)=gasy(iasy)+gg endif end do call Smatasy(indf,rs,SZmass,SGamz, + rasy(itot),jasy(itot),gasy(itot),ftot, + rasy(iasy),jasy(iasy),ftot,iasy,xsm(INDF,iasy)) end do call zusmat(indf,rs,SZmass,SGamz, + rasy(itot),rasy(itot)+jasy(itot), + 0.d0,0.d0,0.d0,gasy(itot),xzf(indf,4)) endif * results IF(INDF.EQ.0.OR.INDF.EQ.10)THEN PRINT 9020,INDF, + (xzf(indf,j),j=1,2),xzf(indf,4), + xsm(indf,0),xzf(indf,5), + (xsm(indf,j),j=1,6) ELSE PRINT 9030,INDF, + (xzf(indf,j),j=1,4), + xsm(indf,0),(xzf(indf,j),j=5,6), + (xsm(indf,j),j=1,6) IF(INDF.EQ.3) PRINT 9040,INDF,'ZUTAU=>',taupol(1),taupol(2) ENDIF 66 CONTINUE ENDDO PRINT*,'Row INDF=-10 is the sum of INDF=4,5,6,7,9 rows.' PRINT * ENDDO RETURN 9020 FORMAT(1X,I4,1x,'|',2(F7.4,'|'),1( 7X ,'|'),2(F7.4,'|'),'|', + 1(F7.4,'|'),1( 7X ,'|'),6(F7.4,'|')) 9030 FORMAT(1X,I4,1x,'|',5(F7.4,'|'),'|',8(F7.4,'|')) 9040 FORMAT(1X,I4,1x,'|',5( 7X ,'|'),'|',2( 7X ,'|'),A7,'|', + 2(F7.4,'|'), 3( 7X ,'|')) 9060 format(' <------------Cross Sections------------->', + '<-------------------Asymmetries----------------------', + '----------->') 9050 format(' INDF |ZUTHSM |ZUXSEC | ZUXSA |ZUSMAT |SMATASY|', + '|ZUTHSM | ZUXSA |', + '<-------------------SMATASY------------------->|') 9070 format(' | | | | | tot |', + '| | |', + ' fb | pol | fbpol | lr | fblr | lrpol |') 9080 format(1x,'|',a6,'|',3(f7.4,'|')) * END ASYTEST END CDECK ID>, SMATRZ. ********************************************************************** subroutine Smatrz (indf,ss,szmass,sgamz,rz0,rz1,rz2,rz3,vacpol, + iasy,asy) * * * subroutine to calculate asymmetries with s-matrix ansatz * * * * input parameter: * * ================ * * indf - fermion identifier (ZFITTER convention) * * ss - energy * * szmass - z mass * * sgamz - z width * * rz0-3 - helicity amplitudes * * vacpol - vacuum polarization * * iasy - xs flag * * 0 = total cross section * * 1 = forward-backward asymmetry * * 2 = polarisation asymmetry * * 3 = forward-backward polarisation asymmetry * * 4 = left-right asymmetry * * 5 = forward-backward left-right asymmetry * * 6 = left-right polarization asymmetry * * output parameter * * ================ * * asy - xs according to iasy * * * ********************************************************************** implicit none *** input parameter ************************************************** double precision ss,szmass,sgamz integer indf,iasy complex*16 vacpol,rz0,rz1,rz2,rz3 *** output parameter ************************************************* double precision asy *** variables ******************************************************** integer max parameter(max = 3) double precision rtot,jtot,gtot,ftot(max),rasy,jasy,fasy(max) integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) *===================================================================== call RJfrRz (indf,SZMass,SGamZ,rz0,rz1,rz2,rz3,vacpol, + rtot,jtot,gtot,Itot) if (Iasy.ne.Itot) then call RJfrRz (indf,SZMass,SGamZ,rz0,rz1,rz2,rz3,vacpol,rasy, + jasy,0.d0,Iasy) else rasy = 1.d0 jasy = 1.d0 endif call vzero(ftot(1),2*max) call vzero(fasy(1),2*max) call SmatAsy (indf,ss,SZMass,SGamZ,rtot,jtot,gtot,ftot, + rasy,jasy,fasy,iasy,asy) end CDECK ID>, SMATA01. ********************************************************************** subroutine SmatA01 (indf,ss,Szmass,Sgamz,rtot,jtot,gtot,a0,a1, + iasy,asy) * * * subroutine to calculate asymmetries from a0, a1 * * * * input parameter: * * ================ * * indf - fermion identifier (ZFITTER convention) * * ss - energy * * Szmass- z mass * * Sgamz - z width * * rtot - z exchange term for total cross section * * jtot - gamma - z interference term for total cross section * * gtot - gamma exchange term for total cross section * * iasy - xs flag * * 1 = forward-backward asymmetry * * 2 = polarisation asymmetry * * 3 = forward-backward polarisation asymmetry * * 4 = left-right asymmetry * * 5 = forward-backward left-right asymmetry * * 6 = left-right polarization asymmetry * * output parameter * * ================ * * asy - asymmetry according to iasy * * * ********************************************************************** implicit none *** input parameter ************************************************** double precision ss,Szmass,Sgamz,rtot,jtot,gtot,a0,a1 integer indf,iasy *** output parameter ************************************************* double precision asy *** variables ******************************************************** integer max parameter(max = 3) double precision ftot(max),rasy,jasy,fasy(max),gamma2 integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) *===================================================================== if (iasy.eq.itot) then print *, '*** subroutine SmatA01 calculates only ' + ,'asymmetries!' stop endif gamma2 = SgamZ*SgamZ/(SZmass*SZmass) rasy = a0*(rtot+gamma2*gtot) jasy = a1/a0 - (2*gamma2*gtot - jtot)/(rtot+gamma2*gtot) jasy = jasy*rasy call vzero(ftot(1),2*max) call vzero(fasy(1),2*max) call SmatAsy (indf,ss,SZMass,SGamZ,rtot,jtot,gtot,ftot, + rasy,jasy,fasy,iasy,asy) end CDECK ID>, SMATASY. ********************************************************************** subroutine SmatAsy (indf,ss,szmass,sgamz,rtot,jtot,gtot,ftot, +rasy,jasy,fasy,iasy,asy) * * * subroutine to calculate asymmetries with s-matrix ansatz * * * * input parameter: * * ================ * * indf - fermion identifier (ZFITTER convention) * * ss - energy * * szmass - z mass * * sgamz - z width * * rtot - z exchange term for total cross section * * jtot - gamma - z interference term for total cross section * * gtot - gamma exchange term for total cross section * * ftot - first three taylor exponents in (ss-zmass**2) to * * describe non resonant contributions to the total cross* * section * * rasy - z exchange term for asymmetry * * jasy - gamma - z interference term for asymmetry * * fasy - first three taylor exponents in (ss-zmass**2) to * * describe non resonant contributions to the asymmetries* * iasy - xs flag * * 0 = total cross section * * 1 = forward-backward asymmetry * * 2 = polarisation asymmetry * * 3 = forward-backward polarisation asymmetry * * 4 = left-right asymmetry * * 5 = forward-backward left-right asymmetry * * 6 = left-right polarization asymmetry * * output parameter * * ================ * * asy - xs according to iasy * * * ********************************************************************** implicit none *** input parameter ************************************************** integer maxp parameter(maxp = 3) double precision ss,szmass,sgamz,rtot,jtot,gtot,ftot(maxp), + rasy,jasy,fasy(maxp) integer indf,iasy *** output parameter ************************************************* double precision asy *** variables ******************************************************** double precision + iitot,iiasy,xstot,xsasy,asyy,zero *** constants ******************************************************** integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) * *===================================================================== * zero = 0d0 iitot = rtot+jtot iiasy = rasy+jasy if (indf.eq.10) call smcoup(szmass,sgamz,itot,iasy) call zusma1(indf,ss,szmass,sgamz, +rtot,iitot,ftot(1),ftot(2),ftot(3),gtot,xstot,itot, +rasy,iiasy,fasy(1),fasy(2),fasy(3),zero,xsasy,asyy,iasy) if (iasy.eq.ipol.or.iasy.eq.ilr.or.iasy.eq.ilrpol) + call zusma1(indf,ss,szmass,sgamz, + rasy,iiasy,fasy(1),fasy(2),fasy(3),zero,xsasy,iasy, + rasy,iiasy,fasy(1),fasy(2),fasy(3),zero,zero ,asyy,iasy) if (iasy.eq.itot) then asyy = xstot elseif (iasy.eq.ipol.or.iasy.eq.ilr.or.iasy.eq.ilrpol) then asyy = xsasy/xstot endif asy = asyy * end smatasy 999 end CDECK ID>, RJFRRZ. **************************************************************** subroutine RJfrRZ(indf,SZMass,SGamz,rz0,rz1,rz2,rz3,vacpol, + rr,jj,gg,iasy) * *subroutine to calculate rr,jj as function of the helicity *amplitudes, assuming the amplitudes are real,no radiative corr **************************************************************** implicit none *** ZFITTER common blocks ****************************************** REAL*8 ALLCH ,ALLMS COMMON/ZFCHMS/ALLCH(0:11),ALLMS(0:11) *** input parameters ******************************************* double precision SZMass,SGamZ complex*16 rz0,rz1,rz2,rz3,vacpol integer iasy,indf *** output parameters ****************************************** double precision rr,jj,gg *** variables ************************************************** complex*16 Cz,Cr,Cg double precision rz02,rz12,rz22,rz32,rz,cf,qq integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) *=============================================================== rz02 = cdabs(rz0)*cdabs(rz0) rz12 = cdabs(rz1)*cdabs(rz1) rz22 = cdabs(rz2)*cdabs(rz2) rz32 = cdabs(rz3)*cdabs(rz3) if (indf.lt.4) then cf = 1d0 else cf = 3d0 endif *** charge ***************************************************** if (indf.ne.10) then qq = abs(allch(indf)) else print *,'*** subroutine RJfrRZ not usable with INDF=10 !!!' stop endif Cg = vacpol*abs(allch(1))*qq if (Iasy.eq.Itot) then Cz = 0.25d0 * (rz0+rz1+rz2+rz3) rz = 0.25d0 * (rz02+rz12+rz22+rz32) gg = cdabs(Cg)*cdabs(Cg) elseif (Iasy.eq.Ifb.or.Iasy.eq.Ilrpol) then Cz = 0.25d0 * (rz0-rz1+rz2-rz3) rz = 0.25d0 * (rz02-rz12+rz22-rz32) gg = 0.d0 elseif (Iasy.eq.Ipol.or.Iasy.eq.Ifblr) then Cz = 0.25d0 * (-rz0+rz1+rz2-rz3) rz = 0.25d0 * (-rz02+rz12+rz22-rz32) gg = 0.d0 elseif (Iasy.eq.Ifbpol.or.Iasy.eq.Ilr) then Cz = 0.25d0 * (-rz0-rz1+rz2+rz3) rz = 0.25d0 * (-rz02-rz12+rz22+rz32) gg = 0.d0 endif Cr = Cg*dconjg(Cz) rr = cf*(rz - 2d0*SGamZ/SZMass*dimag(Cr)) jj = cf*2d0*(dreal(Cr)+SGamZ/SZMass*dimag(Cr)) gg = cf*gg end CDECK ID>, A01FRRJ. ************************************************************************ subroutine A01frRJ (indf,SZMass,SGamZ,rtot,jtot,gtot,rasy,jasy, + a0,a1) ************************************************************************ implicit none ***input parameter ***************************************************** double precision SZMass,SgamZ,rtot,jtot,gtot,rasy,jasy integer indf ***output parameter **************************************************** double precision a0,a1 ***variables************************************************************ double precision gamma2 *===================================================================== if (indf.eq.10) then print *,'*** subroutine A01frRJ not usable with INDF=10 !!!' stop endif gamma2 = SgamZ*SgamZ/(SZmass*SZmass) a0 = rasy/(rtot+gamma2*gtot) a1 = jasy/rasy + (2*gamma2*gtot - jtot)/(rtot+gamma2*gtot) a1 = a1*a0 end CDECK ID>, RZFRVA. ************************************************************************ subroutine RzfrVA (indf,SZMass,SGmu,gve,gae,gvf,gaf, + rz0,rz1,rz2,rz3) ************************************************************************ implicit none REAL*8 PI PARAMETER (PI = 3.14159265358979324D0) REAL*8 GMU,ALFA,ALFAI,CONS PARAMETER (GMU = 1.166388D-5 , + ALFAI = 137.0359895D0, + ALFA = 1D0/ALFAI, + CONS = 1D0) ***input parameter ***************************************************** double precision SZMass,gve,gae,gvf,gaf double precision trafac complex*16 SGmu integer indf ***output parameter **************************************************** complex*16 rz0,rz1,rz2,rz3 ***variables************************************************************ complex*16 kappa *===================================================================== if (indf.eq.10) then print *,'*** subroutine RZfrVA not usable with INDF=10 !!!' stop endif trafac=DIMAG(GMU/SGMU) trafac=1D0+trafac**2 kappa = SGmu*SZMass*SZMass*trafac*alfai/(sqrt(2d0)*2d0*pi) rz0 = kappa * (gve + gae) * (gvf + gaf) rz1 = kappa * (gve + gae) * (gvf - gaf) rz2 = kappa * (gve - gae) * (gvf - gaf) rz3 = kappa * (gve - gae) * (gvf + gaf) end CDECK ID>, ASYTRAF. ************************************************************************* subroutine AsyTraf(ZMass,GamZ,Gmu,SZMass,SGamZ,SGmu) ************************************************************************* implicit none *** input parameter ***************************************************** double precision ZMass,GamZ,Gmu *** output parameter **************************************************** double precision SZMass,SGamZ complex*16 SGmu *** variables *********************************************************** double precision trafac *======================================================================== trafac = sqrt(1+GamZ*GamZ/(ZMass*ZMass)) SZMass = ZMass/trafac SGamZ = GamZ/trafac SGmu = Gmu/dcmplx(1d0,GAmZ/ZMass) end CDECK ID>, CORQED. ************************************************************************* subroutine CorQED (indf,ss,SZMass,SGamZ,CAr,CAj,CAg,CA0,iasy) ************************************************************************* implicit none INTEGER*4 NFLGMX PARAMETER(NFLGMX=25) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFINCL , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFINCL=11, & IFINTF=12,IFBARB=13,IFPART=14,IFPOWR=15,IFPRNT=16,IFALEM=17, & IFQCDC=18,IFVPOL=19,IFWEAK=20,IFFTJR=21,IFEXPR=22,IFEXPF=23, & IFHIGS=24,IFAFMT=25) ************************************************************************* integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) *** input parameter ***************************************************** integer indf,iasy double precision ss,SZMass,SGamZ *** output parameter **************************************************** double precision CAr,CAj,CAg,CA0 *** variables *********************************************************** integer Iold,i,maxf parameter (maxf=3) double precision xsr(2),xsj(2),xsg(2),xs0(2), + asyr(2),asyj(2),asy0(2),ftot(maxf),fasy(maxf) data ftot /0d0,0d0,0d0/ data fasy /0d0,0d0,0d0/ *======================================================================== Iold = IFlags(IfBorn) do i=1,2 if (i.eq.1) then * *** BORN convolution * IFlags(IfBorn) = 0 else * *** no BORN convolution * IFlags(IfBorn) = 1 endif call Smatasy (indf,ss,SZMass,SGamZ,1d0,0d0,0d0,ftot, + 1d0,0d0,fasy,itot,xsr(i)) call Smatasy (indf,ss,SZMass,SGamZ,0d0,1d0,0d0,ftot, + 0d0,1d0,fasy,itot,xsj(i)) call Smatasy (indf,ss,SZMass,SGamZ,0d0,0d0,1d0,ftot, + 0d0,1d0,fasy,itot,xsg(i)) ftot(1) = 1d0 call Smatasy (indf,ss,SZMass,SGamZ,0d0,0d0,0d0,ftot, + 0d0,1d0,fasy,itot,xs0(i)) ftot(1) = 0d0 if (iasy.ne.itot) then call Smatasy (indf,ss,SZMass,SGamZ,1d0,0d0,0d0,ftot, + 1d0,0d0,fasy,iasy,asyr(i)) asyr(i) = asyr(i)*xsr(i) call Smatasy (indf,ss,SZMass,SGamZ,0d0,1d0,0d0,ftot, + 0d0,1d0,fasy,iasy,asyj(i)) asyj(i) = asyj(i)*xsj(i) ftot(1) = 1d0 fasy(1) = 1d0 call Smatasy (indf,ss,SZMass,SGamZ,0d0,0d0,0d0,ftot, + 0d0,0d0,fasy,iasy,asy0(i)) asy0(i) = asy0(i)*xs0(i) ftot(1) = 0d0 fasy(1) = 0d0 endif enddo if (iasy.eq.itot) then CAr = xsr(1)/xsr(2) CAj = xsj(1)/xsj(2) CAg = xsg(1)/xsg(2) CA0 = xs0(1)/xs0(2) else CAr = asyr(1)/asyr(2) CAj = asyj(1)/asyj(2) CAg = 0d0 CA0 = asy0(1)/asy0(2) endif IFlags(IfBorn) = Iold end CDECK ID>, ASYINIT. ************************************************************************* subroutine AsyInit(ZMASS,TMASS,HMASS,ALQED,ALFAS,GMU, + GAMZ,SZMASS,SGAMZ,SGMU) ************************************************************************* IMPLICIT NONE * * *** input REAL*8 ZMASS,TMASS,HMASS,ALQED,ALFAS,GMU * * *** output REAL*8 GAMZ,SZMASS,SGAMZ COMPLEX*16 SGMU * * *** local LOGICAL*4 LFIRST DATA LFIRST /.TRUE./ * * *** ZFITTER common blocks INTEGER*4 NFLGMX PARAMETER(NFLGMX=25) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFINCL , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFINCL=11, & IFINTF=12,IFBARB=13,IFPART=14,IFPOWR=15,IFPRNT=16,IFALEM=17, & IFQCDC=18,IFVPOL=19,IFWEAK=20,IFFTJR=21,IFEXPR=22,IFEXPF=23, & IFHIGS=24,IFAFMT=25) REAL*8 QDF,QCDCOR ,ALPHST,SIN2TW,S2TEFF , & WIDTHS COMMON /ZUPARS/QDF,QCDCOR(0:14),ALPHST,SIN2TW,S2TEFF(0:11), & WIDTHS(0:11) * *========================================================================= * IF(LFIRST)THEN print * print *,'******************************************************' print *,'******************************************************' print *,'** This is SMATASY version 5.02 **' print *,'** 97/02/07 **' print *,'******************************************************' print *,'** The authors of the SMATASY package are: **' print *,'** **' print *,'** S.Kirsch (DESY IfH-Zeuthen, now at PSI) **' print *,'** T.Riemann (DESY IfH-Zeuthen) **' print *,'** M.Gruenewald (Humboldt University, Berlin) **' print *,'** **' print *,'******************************************************' print *,'** Questions and comments to: **' print *,'** Martin.Grunewald@cern.ch **' print *,'** Riemann@ifh.de **' print *,'******************************************************' print * CALL ZUINFO(0) ENDIF * * do weak sector calculations * CALL ZUWEAK(ZMASS,TMASS,HMASS,ALQED,ALFAS) GAMZ=WIDTHS(11)/1D3 * * transformation to the values in the s-matrix approach * call AsyTraf(ZMass,GamZ,Gmu,SZMass,SGamZ,SGmu) * IF(LFIRST.OR.IFLAGS(IFPRNT).EQ.1)THEN print * print *,'SMATASY S-Matrix calculations:' print *,'+-------------+---------+----------+-------------+' print *,'| | Z Mass | Z Width | G_mu |' print *,'+-------------+---------+----------+-------------+' print 3000,'Conventional ',ZMass,GamZ,Gmu print 3000,' => S-Matrix ',SZMass,SGamZ,dreal(SGmu) print *,'+-------------+---------+----------+-------------+' print 3000,'Difference ',ZMass-SZMass,GamZ-SGamZ,Gmu-dreal(SGmu) print *,'+-------------+---------+----------+-------------+' print * ENDIF * LFIRST=.FALSE. * return 3000 format(1x,'|',a13,'|',f9.5,'|',f10.7,'|',g13.7,'|') end CDECK ID>, ZUSMA1. ************************************************************************ SUBROUTINE ZUSMA1(INDF,SQRS,SZMASS,SGAMZ,RR,RI,R0,R1,R2,RG,CS, + NTOT,AR,AI,A0,A1,A2,AG,CA,AFB,NASY) *********************************************************************** * ROUTINE RETURNS CROSS SECTIONS FROM S-MATRIX APPROACH * * INDF (INT/READ) = FERMION INDEX * SQRS (REAL/READ) = SQRT(S) * SZMASS (REAL/READ) = Z0 MASS (GEV) * SGAMZ (REAL/READ) = Z0 WIDTH (GEV) * RR-RG (REAL/READ) = 5 PARAMETERS IN S_MATRIX APPROACH * FOR TOTAL CROSS SECTION * CS (READ/WRITE) = TOTAL CROSS SECTION (NB) * NTOT (INT/READ) = CROSS SECTION REQUESTED * AR-AG (REAL/READ) = 5 PARAMETERS IN S_MATRIX APPROACH * FOR ASYMMETRY CROSS SECTION * CA (READ/WRITE) = ASYMMETRY CROSS SECTION (NB) * AFB (READ/WRITE) = ASYMMETRY * NASY (INT/READ) = ASYMMETRY REQUESTED * * CALLED BY USER * *********************************************************************** * IMPLICIT REAL*8(A-H,O-W,Y-Z) IMPLICIT COMPLEX*16(X) * * FLAGS * INTEGER*4 NFLGMX PARAMETER(NFLGMX=25) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFINCL , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFINCL=11, & IFINTF=12,IFBARB=13,IFPART=14,IFPOWR=15,IFPRNT=16,IFALEM=17, & IFQCDC=18,IFVPOL=19,IFWEAK=20,IFFTJR=21,IFEXPR=22,IFEXPF=23, & IFHIGS=24,IFAFMT=25) * * PARAMETERS * REAL*8 QDF,QCDCOR ,ALPHST,SIN2TW,S2TEFF , & WIDTHS COMMON /ZUPARS/QDF,QCDCOR(0:14),ALPHST,SIN2TW,S2TEFF(0:11), & WIDTHS(0:11) * * CUTS * REAL*8 ACOLIN ,EF_MIN ,SPRIME , + ANGMIN ,ANGMAX INTEGER*4 IRCUTS ,IRFAST COMMON /ZUDATA/ ACOLIN(0:11),EF_MIN(0:11),SPRIME(0:11), + ANGMIN(0:11),ANGMAX(0:11),IRCUTS(0:11),IRFAST(0:11) * * CONSTANTS * REAL*8 ALLCH ,ALLMS COMMON/ZFCHMS/ALLCH(0:11),ALLMS(0:11) INTEGER*4 NPAR REAL*8 ZPAR COMMON/FRINIT/ NPAR(30),ZPAR(30) REAL*8 AMZS,GAMZS,RESR,RESI,RES0,RES1,RES2,RESG INTEGER*4 ISMA COMMON /SMATRS/ AMZS,GAMZS,RESR,RESI,RES0,RES1,RES2,RESG,ISMA REAL*8 REAR,REAI,REA0,REA1,REA2,REAG INTEGER*4 ITOT,IASY COMMON /SMATR1/ REAR,REAI,REA0,REA1,REA2,REAG,ITOT,IASY * * LOCAL * COMPLEX*16 XFZ(4),XFZT(2),XFZTA(2) * *----------------------------------------------------------------------- * * S=SQRS*SQRS * INTERF. 5 IFAST= IRFAST(INDF) INTRF= 5 ISMA = 2 * QE = ALLCH(1) AMF = ALLMS(INDF) QF = ALLCH(INDF) ZPAR(2) = QF ZPAR(4) = AMF DO IQCDC=0,14 ZPAR(7+IQCDC) = QCDCOR(IQCDC) ENDDO C******* EXCLUDE INITITIAL-FINAL INTERFERENCE CORR. FOR S-MATRIX APPR. IMEMOR = NPAR(8) NPAR(8) = 0 NPAR(11)= IRCUTS(INDF) NPAR(13)= 1 * FILL /SMATR1 & SMATRH/ AMZS=SZMASS GAMZS=SGAMZ RESR=RR RESI=RI RES0=R0 RES1=R1 RES2=R2 RESG=RG CTR FOR ASYMMETRIC CROSS SECTION: REAR=AR REAI=AI REA0=A0 REA1=A1 REA2=A2 REAG=AG ITOT=NTOT IASY=NASY * *** get corrections due to running alpha IF(NPAR(20).GE.2)THEN FG=1D0 FJ=1D0 FR=1D0 IBOXF=0 IBFLA=0 IF(AMF.GT.4D0) IBFLA=1 SS=SZMASS**2+SGAMZ**2 Q2=SS/2D0 U2=Q2-SS CALL ROKANC(IBOXF,IBFLA,U2,-SS,-Q2,QE,QF,XFZ,XFZT(1),XFZTA(1)) SS=S Q2=SS/2D0 U2=Q2-SS CALL ROKANC(IBOXF,IBFLA,U2,-SS,-Q2,QE,QF,XFZ,XFZT(2),XFZTA(2)) XFZT(1)=1D0/(2D0-XFZT(1)) XFZT(2)=1D0/(2D0-XFZT(2)) FG1=DREAL(XFZT(1))**2+DIMAG(XFZT(1))**2 FG2=DREAL(XFZT(2))**2+DIMAG(XFZT(2))**2 FG=FG2/FG1 FJ1=DREAL(XFZT(1))+DIMAG(XFZT(1))*SGAMZ/SZMASS FJ2=DREAL(XFZT(2))+DIMAG(XFZT(2))*SGAMZ/SZMASS FJ=FJ2/FJ1 RESG=FG*RESG RESI=FJ*(RESI-RESR)+FR*RESR RESR=FR*RESR REAG=FG*REAG REAI=FJ*(REAI-REAR)+FR*REAR REAR=FR*REAR ENDIF * DELTA=1D0-SPRIME(INDF)/S ZPAR(26)=DELTA ZPAR(27)=ACOLIN(INDF) ZPAR(28)=EF_MIN(INDF) ZPAR(29)=ANGMAX(INDF) ZPAR(30)=ANGMIN(INDF) CALL ZCUT(INTRF,IFAST,INDF, & S,SZMASS,SGAMZ,WIDTHS,SIN2TW,NPAR,ZPAR,SBORN,STOT,ABORN,ATOT) IF(IFLAGS(IFBORN).EQ.0) THEN CS =STOT ELSE CS =SBORN ENDIF IF(IFLAGS(IFBORN).EQ.0) THEN AFB=ATOT CA =ATOT*STOT ELSE AFB=ABORN CA =ABORN*SBORN ENDIF ISMA=0 ITOT=0 IASY=0 NPAR(8)=IMEMOR * END CDECK ID>, BORN. SUBROUTINE BORN(R1,R2,SBORN,ABORN) * ========== ======================= IMPLICIT COMPLEX*16(X) IMPLICIT REAL*8(A-H,O-W,Y-Z) * COMMON / SVAR/ S COMMON /MASSZ / AME,AMF,AME2,AMF2 COMMON /COUPL/ VEFA,XVEFI,VEFZ,AEFA,XAEFI,AEFZ,VEEZ,XVPOL,VPOL2 COMMON /FORCHI/ XKAPP,XKAPPC,XMZ2,XMZ2C COMMON /PCONST/ ALFAI,AL1PI,ALQE2,ALQF2,ALQEF,GMU,CSIGNB COMMON /SMATRS/ AMZS,GAMZS,RESR,RESI,RES0,RES1,RES2,RESG,ISMA COMMON /INTRFS/ INTRF COMMON /CDZRUN/ CMQRUN(8) * COMMON /CALQED/ CALQED COMMON /PSCONS/ SW2,AMZ,GAMZ * * For total hadronic cross-section * COMMON/INDFIT/IND,INDF COMMON/ZFCHMS/ALLCH(0:11),ALLMS(0:11) COMMON/HADRON/XXVEFI(6),AVEFA(6),AVEEZ(6),AVEFZ(6) * * flags * PARAMETER(NFLGMX=25) COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFINCL=11, & IFINTF=12,IFBARB=13,IFPART=14,IFPOWR=15,IFPRNT=16,IFALEM=17, & IFQCDC=18,IFVPOL=19,IFWEAK=20,IFFTJR=21,IFEXPR=22,IFEXPF=23, & IFHIGS=24,IFAFMT=25) * * for SMATASY * REAL*8 PI PARAMETER (PI = 3.14159265358979324D0) REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) INTEGER*4 IAFB,IBORN,IRCUT,IFINAL,INTERF,IWEAK,IPHOT2,ISYM COMMON /FLAGZ / IAFB,IBORN,IRCUT,IFINAL,INTERF,IWEAK,IPHOT2,ISYM REAL*8 REAR,REAI,REA0,REA1,REA2,REAG INTEGER*4 ITOT,IASY COMMON /SMATR1/ REAR,REAI,REA0,REA1,REA2,REAG,ITOT,IASY * S1=S*R1 S2=S*R2 * IF (ISMA .EQ. 0) THEN * AMZ2 = AMZ*AMZ XCHI1=XKAPP*S1/(S1-XMZ2) XCHI2=XKAPPC*S2/(S2-XMZ2C) XCHI =XCHI1+XKAPP*S2/(S2-XMZ2) c to have the same expression for fit and analytics IF(INDF.NE.10.OR.IND.EQ.0) THEN IF((INDF.EQ.6.OR.INDF.EQ.9).AND.IFLAGS(IFQCDC).NE.0) THEN AMF2S1=(CMQRUN(INDF-3))**2/S1 ELSE AMF2S1=AMF2/S1 ENDIF IF(IFLAGS(IFPOWR).EQ.0.AND.INDF.LE.2) AMF2S1=0D0 IF(IFLAGS(IFPOWR).EQ.0.AND. & (INDF.EQ.4.OR.INDF.EQ.5.OR.INDF.EQ.7)) AMF2S1=0D0 IF(INDF.GE.4.AND.IFLAGS(IFQCDC).NE.0) AMF2S1=0D0 THRESH=SQRT(MAX(1D0-4D0*AMF2S1,0D0)) CORF2 =1D0+2D0*AMF2S1 CORF3 = -6D0*AMF2S1 IF(INDF.GE.4.AND.IFLAGS(IFQCDC).NE.0) CORF3 = 0D0 * * Here XVPOLS and VPOL2S are: If ALEM=0,1 at M^2_Z, if ALEM=2,3 at S * XVPOLS=XVPOL VPOL2S=VPOL2 * * BORN CROSS-SECTION * IF(IFLAGS(IFCONV).EQ.1.AND.IFLAGS(IFALEM).GE.2) THEN IF(S1.LT.1D-2) THEN XFOT = DCMPLX(1D0,0D0) ELSE XFOT = 1d0+AL1PI/4d0 & *XFOTF1(IFLAGS(IFVPOL),1,1,-S1) IF(MOD(IFLAGS(IFALEM),2).EQ.0) THEN RCOR = 1D0-1D0/ALFAI/CALQED RCOR = RCOR/(AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-AMZ2))) RCOR = RCOR-1D0 RCOR = RCOR*(AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-S1))) XFOT = XFOT+RCOR ENDIF ENDIF * * These XVPOLS and VPOL2S are at S' * XVPOLS=1D0/(2D0-XFOT) VPOL2S=DREAL(XVPOLS)**2+DIMAG(XVPOLS)**2 ENDIF * SBORN=THRESH* & (CORF2*(VEFA*VPOL2S+DREAL(XVEFI*XCHI*DCONJG(XVPOLS))) & +(CORF2*VEFZ +CORF3*VEEZ)*DREAL(XCHI1*XCHI2))/R1 * BORN ASYMMETRY ABORN=THRESH**2*(AEFA*VPOL2S & +DREAL(XAEFI*XCHI*DCONJG(XVPOLS))+AEFZ*DREAL(XCHI1*XCHI2))/R1 * ELSE * * SPECIAL CHAIN TO CALCULATE TOTAL HADRONIC CROSS SECTION * * Here XVPOLS and VPOL2S are: If ALEM=0,1 at M^2_Z, if ALEM=2,3 at S * XVPOLS=XVPOL VPOL2S=VPOL2 * IF(IFLAGS(IFCONV).EQ.1.AND.IFLAGS(IFALEM).GE.2) THEN IF(S1.LT.1D-2) THEN XFOT = DCMPLX(1D0,0D0) ELSE XFOT = 1d0+AL1PI/4d0 & *XFOTF1(IFLAGS(IFVPOL),1,1,-S1) IF(MOD(IFLAGS(IFALEM),2).EQ.0) THEN RCOR = 1D0-1D0/ALFAI/CALQED RCOR = RCOR/(AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-AMZ2))) RCOR = RCOR-1D0 RCOR = RCOR* (AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-S1))) XFOT = XFOT+RCOR ENDIF ENDIF * * These XVPOLS and VPOL2S are at S' * XVPOLS=1D0/(2D0-XFOT) VPOL2S=DREAL(XVPOLS)**2+DIMAG(XVPOLS)**2 ENDIF * SBORN=0D0 * DO 1 I=4,9 IF(I.EQ.8) GO TO 1 AMQ2=ALLMS(I)**2 IF(4D0*AMQ2.GE.S1) GOTO 1 IF(IFLAGS(IFPOWR).EQ.0.AND.(I.EQ.4.OR.I.EQ.5.OR.I.EQ.7)) & AMQ2=0D0 IF(I.GE.4.AND.IFLAGS(IFQCDC).NE.0) AMQ2=0D0 THRESH=SQRT(MAX(1D0-4D0*AMQ2/S1,0.D0)) CORF2 =(1D0+2D0*AMQ2/S1) CORF3 =( -6D0*AMQ2/S1) IF(I.GE.4.AND.IFLAGS(IFQCDC).NE.0) CORF3 = 0D0 * BORN CROSS-SECTION J=I-3 SBORN=SBORN+THRESH* & (CORF2*(AVEFA(J)*VPOL2S+DREAL(XXVEFI(J)*XCHI*DCONJG(XVPOLS))) & +(CORF2*AVEFZ(J)+CORF3*AVEEZ(J))*DREAL(XCHI1*XCHI2))/R1 1 CONTINUE ENDIF * ELSE * * USING THE S-MATRIX APPROACH * MODEL INDEPENDEND FIT FOR LEP USING THE GENERAL FORMULA FOR * THE LINE SHAPE: * *sigma = ( resr*amz**2 + resi*(s-amz**2) )/abs(s-sz)**2 + resg/s + * + res0/amz**2 * + res1*(s-amz**2)/amz**4 * + res2*(s-amz**2)**2/amz**6 * sz = amz*amz-i*amz*gamz * * HERE IS CALCULATED THE BORN CROSS SECTION ONLY, QED IS TAKEN * INTO ACCOUNT AS IN THE OTHER CHAINS * S1MZ2 =S1-AMZS**2 XSZ =DCMPLX(AMZS*AMZS,-AMZS*GAMZS) * * >>> SMATASY modifications until end of subroutine! * AMZ2=AMZS**2+GAMZS**2 if(isma.eq.1)then * *** ZUSMAT of ZFITTER good for TOTAL cross section only itot=0 iasy=0 if(indf.eq.10) call smcoup(amzs,gamzs,0,0) isma=-1 endif is=itot ia=iasy if (indf.eq.10) then srtot=avefz(5) sjtot=aveez(5) sgtot=avefa(5) if(sgtot.eq.0d0)sgtot=1d0 srasy=dreal(xxvefi(5)) sjasy=dimag(xxvefi(5)) sgasy=1d0 IF(IFLAGS(IFCONV).EQ.1.AND.IFLAGS(IFALEM).GE.2)THEN FG=1D0 FJ=1D0 FR=1D0 IF(S1.LT.1D-2) THEN XFOT = DCMPLX(1D0,0D0) ELSE XFOT = 1d0+AL1PI/4d0 & *XFOTF1(IFLAGS(IFVPOL),1,1,-S1) IF(MOD(IFLAGS(IFALEM),2).EQ.0) THEN RCOR = 1D0-1D0/ALFAI/CALQED RCOR = RCOR/(AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-AMZ2))) RCOR = RCOR-1D0 RCOR = RCOR* (AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-S1))) XFOT = XFOT+RCOR ENDIF ENDIF XFOT=1D0/(2D0-XFOT) FG1=DREAL(XVPOL)**2+DIMAG(XVPOL)**2 FG2=DREAL(XFOT )**2+DIMAG(XFOT )**2 FG=FG2/FG1 FJ1=DREAL(XVPOL)+DIMAG(XVPOL)*GAMZS/AMZS FJ2=DREAL(XFOT )+DIMAG(XFOT )*GAMZS/AMZS FJ=FJ2/FJ1 TRESG=FG*RESG TRESI=FJ*(RESI-RESR)+FR*RESR TRESR=FR*RESR TREAG=FG*REAG TREAI=FJ*(REAI-REAR)+FR*REAR TREAR=FR*REAR ELSE TRESG=RESG TRESI=RESI TRESR=RESR TREAG=REAG TREAI=REAI TREAR=REAR ENDIF sborn=0d0 aborn=0d0 do i=4,9 if (i.ne.8)then AMQ2=ALLMS(I)**2 IF(4D0*AMQ2.LT.S1)THEN CORQED=1D0 QF2 =ALLCH(I)**2 IF(IFLAGS(IFINCL).EQ.0) & CORQED=1D0/(1D0+.75D0*CALQED/PI*QF2) IF(IFINAL.EQ.0) CORQED=1D0 IF(IFLAGS(IFPOWR).EQ.0.AND. & (I.EQ.4.OR.I.EQ.5.OR.I.EQ.7)) AMQ2=0D0 IF(I.GE.4.AND.IFLAGS(IFQCDC).NE.0) AMQ2=0D0 THRESH=SQRT(MAX(1D0-4D0*AMQ2/S1,0D0)) CORF2 =1D0+2D0*AMQ2/S1 CORF3 = -6D0*AMQ2/S1 IF(I.GE.4.AND.IFLAGS(IFQCDC).NE.0) CORF3 = 0D0 facnor=avefz(i-3)/srtot facnoj=aveez(i-3)/sjtot facnog=avefa(i-3)/sgtot sbornq=corqed*thresh*corf2*( + (facnor*(1d0+(corf3/corf2)/(1d0+arvefz(i)**2)) * *tresr*amzs**2 + +facnoj*tresi*s1mz2)/abs(s1-xsz)**2 + +facnog*tresg/s1 + )*s sborn=sborn+sbornq facnor=dreal(xxvefi(i-3))/srasy facnoj=dimag(xxvefi(i-3))/sjasy facnog=0d0 abornq=thresh**2*( + (facnor*trear*amzs**2 + +facnoj*treai*s1mz2)/abs(s1-xsz)**2 + +facnog*treag/s1 + )*s aborn=aborn+abornq ENDIF endif enddo sborn=sborn+ + (res0/amzs**2 + +res1*s1mz2/amzs**4 + +res2*s1mz2**2/amzs**6 = )*s aborn=aborn+ + (rea0/amzs**2 + +rea1*s1mz2/amzs**4 + +rea2*s1mz2**2/amzs**6 = )*s else CORQED=1D0 QF2 =ALLCH(INDF)**2 IF(INDF.GE.1.AND.INDF.LE.3) THEN IF(IFINAL.EQ.0) CORQED=1D0+.75D0*CALQED/PI*QF2 ELSEIF(INDF.GE.4.AND.INDF.LE.9) THEN IF(IFLAGS(IFINCL).EQ.0) & CORQED=1D0/(1D0+.75D0*CALQED/PI*QF2) IF(IFINAL.EQ.0) CORQED=1D0 ENDIF IF((INDF.EQ.6.OR.INDF.EQ.9).AND.IFLAGS(IFQCDC).NE.0) THEN AMF2S1=(CMQRUN(INDF-3))**2/S1 ELSE AMF2S1=AMF2/S1 ENDIF IF(IFLAGS(IFPOWR).EQ.0.AND.INDF.LE.2) AMF2S1=0D0 IF(IFLAGS(IFPOWR).EQ.0.AND. & (INDF.EQ.4.OR.INDF.EQ.5.OR.INDF.EQ.7)) AMF2S1=0D0 IF(INDF.GE.4.AND.IFLAGS(IFQCDC).NE.0) AMF2S1=0D0 THRESH=SQRT(MAX(1D0-4D0*AMF2S1,0D0)) CORF2 =1D0+2D0*AMF2S1 CORF3 = -6D0*AMF2S1 IF(INDF.GE.4.AND.IFLAGS(IFQCDC).NE.0) CORF3 = 0D0 IF(IFLAGS(IFCONV).EQ.1.AND.IFLAGS(IFALEM).GE.2)THEN FG=1D0 FJ=1D0 FR=1D0 IF(S1.LT.1D-2) THEN XFOT = DCMPLX(1D0,0D0) ELSE XFOT = 1d0+AL1PI/4d0 & *XFOTF1(IFLAGS(IFVPOL),1,1,-S1) IF(MOD(IFLAGS(IFALEM),2).EQ.0) THEN RCOR = 1D0-1D0/ALFAI/CALQED RCOR = RCOR/(AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-AMZ2))) RCOR = RCOR-1D0 RCOR = RCOR* (AL1PI/4d0 & *DREAL(XFOTF1(IFLAGS(IFVPOL),0,0,-S1))) XFOT = XFOT+RCOR ENDIF ENDIF XFOT=1D0/(2D0-XFOT) FG1=DREAL(XVPOL)**2+DIMAG(XVPOL)**2 FG2=DREAL(XFOT )**2+DIMAG(XFOT )**2 FG=FG2/FG1 FJ1=DREAL(XVPOL)+DIMAG(XVPOL)*GAMZS/AMZS FJ2=DREAL(XFOT )+DIMAG(XFOT )*GAMZS/AMZS FJ=FJ2/FJ1 TRESG=FG*RESG TRESI=FJ*(RESI-RESR)+FR*RESR TRESR=FR*RESR TREAG=FG*REAG TREAI=FJ*(REAI-REAR)+FR*REAR TREAR=FR*REAR ELSE TRESG=RESG TRESI=RESI TRESR=RESR TREAG=REAG TREAI=REAI TREAR=REAR ENDIF sborn=corqed*thresh*corf2*( + ((1d0+(corf3/corf2)/(1d0+arvefz(indf)**2))*tresr*amzs**2 + +tresi*s1mz2)/abs(s1-xsz)**2 + +tresg/s1 + +res0/amzs**2 + +res1*s1mz2/amzs**4 + +res2*s1mz2**2/amzs**6 = )*S aborn=thresh**2*( + (trear*amzs**2+treai*s1mz2)/abs(s1-xsz)**2 + +treag/s1 + +rea0/amzs**2 + +rea1*s1mz2/amzs**4 + +rea2*s1mz2**2/amzs**6 = )*S endif * * <<< SMATASY modifications end! * ENDIF * END CDECK ID>, RJFRSM. SUBROUTINE RJFRSM(INDF,SZMASS,SGAMZ,RR,JJ,GG,IASY) C------------------------------------------------------------------------------ C In this SUBR. the S-Matrix parameters r, j and g are calculated C in the framwork of the Standard Model. C------------------------------------------------------------------------------ * IMPLICIT NONE * * *** input INTEGER INDF,IASY REAL*8 SZMASS,SGAMZ * * *** output REAL*8 RR,JJ,GG * * *** local REAL*8 GAE,GVE,GAF,GVF,R,J,G INTEGER*4 IMIN,IMAX,INOT,I * * *** ZFITTER common blocks REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) C C------------------------------------------------------------------------------ C RR = 0D0 JJ = 0D0 GG = 0D0 GAE = +SQRT(ARROFZ(1))/2D0 GVE = ARVEFZ(1)*GAE IF(INDF.EQ.10)THEN IMIN=4 IMAX=9 INOT=+8 ELSE IMIN=INDF IMAX=INDF INOT=-8 ENDIF DO I=IMIN,IMAX IF(I.NE.INOT)THEN GAF = +SQRT(ARROFZ(I))/2D0 GVF = ARVEFZ(I)*GAF CALL RJFRVA(I,SZMASS,SGAMZ,GVE,GAE,GVF,GAF,R,J,G,IASY) RR=RR+R JJ=JJ+J GG=GG+G ENDIF ENDDO * RETURN END CDECK ID>, RJFRVA. SUBROUTINE RJFRVA(INDF,SZMASS,SGAMZ,GVE,GAE,GVF,GAF, + RR,JJ,GG,IASY) C------------------------------------------------------------------------------ C In this SUBR. the S-Matrix parameters r, j and g are calculated C using the effective couplings. Thus also vector and axial-vector C specific QCD corrrections can be applied. C------------------------------------------------------------------------------ IMPLICIT NONE * * *** input INTEGER*4 INDF,IASY REAL*8 SZMASS,SGAMZ,GVE,GAE,GVF,GAF * * *** output REAL *8 RR,JJ,GG * * *** local REAL*8 GMU,ALFA,ALFAI,CONS PARAMETER (GMU = 1.166388D-5 , + ALFAI = 137.0359895D0, + ALFA = 1D0/ALFAI, + CONS = 1D0) integer Itot ,Ifb ,Ipol ,Ifbpol ,Ilr ,Ifblr ,Ilrpol parameter (Itot=0,Ifb=1,Ipol=2,Ifbpol=3,Ilr=4,Ifblr=5,Ilrpol=6) COMPLEX*16 SGMU,VACPOL,KAPPA COMPLEX*16 RZ0,RZ1,RZ2,RZ3 REAL*8 COMB1,HOMB1,COMB2,HOMB2,HELPL,HELMI,HELI1,HELI2 INTEGER*4 IHP,IHM REAL*8 CORQED,SW2 REAL*8 ROEC,GVEC,GAEC,ROFC,GVFC,GAFC REAL*8 RQCDA,RQCDV,COLOR,AMF,QE,QEM,QF,QFM,QF2 REAL*8 RO2,RO2C,VPOL2,VPOL2S COMPLEX*16 XFZ(4),XFZT,XFZTA COMPLEX*16 XRO,XVE,XVF,XVEF,XROC,XVEC,XVFC,XVEFC,XVPOL,XVPOLS REAL*8 GAE2,GAF2,VZ1,VZ2,AZ1,AZ2 REAL*8 VEEZ,VEFZ,VEFA,AEFZ,AEFA,QEF,QEFM COMPLEX*16 XAEFI,XVEFI INTEGER*4 IBOXF,IBFLA REAL*8 Q2,S,U2 * * *** ZFITTER common blocks REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) REAL*8 ALAMP,ALAMM,HELP,HELM COMMON /POLAR/ ALAMP,ALAMM,HELP,HELM REAL*8 ALLCH ,ALLMS COMMON/ZFCHMS/ALLCH(0:11),ALLMS(0:11) REAL*8 QDF,QCDCOR ,ALPHST,SIN2TW,S2TEFF , & WIDTHS COMMON /ZUPARS/QDF,QCDCOR(0:14),ALPHST,SIN2TW,S2TEFF(0:11), & WIDTHS(0:11) * * *** misc INTEGER*4 INDQ(10) DATA INDQ /0,0,0,0,1,2,3,4,5,6/ REAL*8 FAA,FZA,FZZ DATA FAA/1D0/,FZA/1D0/,FZZ/1D0/ C C------------------------------------------------------------------------------ C if (indf.eq.10) then print *,'*** subroutine RJfrVA not usable with INDF=10 !!!' stop endif * * *** get complex form factors at standard Z pole IBOXF=0 IBFLA=0 IF(INDF.EQ.9) IBFLA=1 QE = ALLCH(1) QF = ALLCH(INDF) S=SZMASS**2+SGAMZ**2 Q2=S/2D0 U2=Q2-S CALL ROKANC(IBOXF,IBFLA,U2,-S,-Q2,QE,QF,XFZ,XFZT,XFZTA) * * *** Helicities from Couplings SGMU = GMU/DCMPLX(1D0,SGAMZ/SZMASS) CALL RZFRVA(INDF,SZMASS,SGMU,GVE,GAE,GVF,GAF, + RZ0,RZ1,RZ2,RZ3) * * *** r/j/g from Helicities VACPOL = 1D0/(2D0-XFZT) CALL RJFRRZ(INDF,SZMASS,SGAMZ,RZ0,RZ1,RZ2,RZ3,VACPOL, + RR,JJ,GG,IASY) * IF(IASY.EQ.ITOT.OR.IASY.EQ.IFB)THEN KAPPA=RZ0/( (GVE+GAE)*(GVF+GAF) ) * * *** from ZUXSA ROEC = 1D0 GVEC = 2D0*GVE GAEC = 2D0*GAE ROFC = 1D0 GVFC = 2D0*GVF GAFC = 2D0*GAF * * *** additional init COLOR= 1.D0 IF(INDF.GE.4) COLOR=3D0 AMF = ALLMS(INDF) QE = ALLCH(1) QF = ALLCH(INDF) QF2 = QF*QF QEM = ABS(QE) QFM = ABS(QF) QEF = QE*QF QEFM = ABS(QEF) SW2 = SIN2TW * * *** from EWCOUP (init) CORQED=1D0 * XRO =XFZ(1) RO2 =DREAL(XRO)**2+DIMAG(XRO)**2 XVE =1D0-4D0*SW2*XFZ(2)*QEM XVF =1D0-4D0*SW2*XFZ(3)*QFM XVEF=-1D0+XVE+XVF+16D0*SW2*SW2*QEM*QFM*XFZ(4) XROC =XFZ(1) RO2C =DREAL(XROC)**2+DIMAG(XROC)**2 XVEC =1D0-4D0*SW2*XFZ(2)*QEM XVFC =1D0-4D0*SW2*XFZ(3)*QFM XVEFC=-1D0+XVE+XVF+16D0*SW2*SW2*QEM*QFM*XFZ(4) XVPOL =1D0/(2D0-XFZT) VPOL2 =DREAL(XVPOL)**2+DIMAG(XVPOL)**2 * IF(INDF.GE.4.AND.INDF.LE.9) THEN RQCDV=QCDCOR(MAX(0,2*INDQ(INDF+1)-1)) RQCDA=QCDCOR(MAX(0,2*INDQ(INDF+1) )) ELSE RQCDV=1D0 RQCDA=1D0 ENDIF * CORQED=1D0 * * POLAR COMB1=1.-ALAMP*ALAMM COMB2=ALAMP-ALAMM * HELPL = HELP HELMI = HELM * PREPARATION FOR DIFFERENT HELICITY STATES IHP = INT(HELPL) IHM = INT(HELMI) IF(IHP.NE.0.AND.IHM.NE.0) THEN HELI1 = (1.D0-HELPL*HELMI)/4.D0 HELI2 = (HELPL-HELMI)/4.D0 ENDIF IF(IHP.EQ.0.AND.IHM.EQ.0) THEN HELI1 = 1.D0 HELI2 = 0.D0 ENDIF IF(IHP.EQ.0.AND.IHM.NE.0) THEN HELI1 = .5D0 HELI2 = -.5D0*HELMI ENDIF IF(IHP.NE.0.AND.IHM.EQ.0) THEN HELI1 = .5D0 HELI2 = .5D0*HELPL ENDIF HOMB1 = HELI1 HOMB2 = HELI2 * * *** from EWCOUP: INTRF = 3 CROSS SECTION AND ASYMMETRY * XRO = DCMPLX(SQRT(ROEC*ROFC),DIMAG(XFZ(1))) & -SQRT(ARROFZ(1)*ARROFZ(INDF))+DREAL(XFZ(1)) RO2 = DREAL(XRO)**2 + DIMAG(XRO)**2 XVE = DCMPLX(GVEC,DIMAG(1-4*SW2*XFZ(2)*QEM)) & -ARVEFZ(1) +DREAL(1D0-4D0*SW2*XFZ(2)*QEM) XVF = DCMPLX(GVFC,DIMAG(1-4*SW2*XFZ(3)*QFM)) & -ARVEFZ(INDF)+DREAL(1D0-4D0*SW2*XFZ(3)*QFM) XVEF=DCMPLX(GVEC*GVFC,DIMAG(-1+XVE+XVF+16*SW2*SW2*QEM*QFM*XFZ(4))) & +16*SW2*SW2*QEM*QFM*(DREAL(XFZ(4))-DREAL(XFZ(2))*DREAL(XFZ(3))) & -ARVEFZ(1)*ARVEFZ(INDF) & +DREAL(1D0-4D0*SW2*XFZ(2)*QEM)*DREAL(1D0-4D0*SW2*XFZ(3)*QFM) * GAE2=GAEC**2 GAF2=GAFC**2 * VZ1 = (GAE2+XVE*DCONJG(XVE))*GAF2*RQCDA & + (GAE2*XVF*DCONJG(XVF)+XVEF*DCONJG(XVEF))*RQCDV VZ2 = 2*DREAL(GAF2*GAEC*XVE*RQCDA+GAEC*XVF*DCONJG(XVEF)*RQCDV) AZ1 = 2*DREAL(XVE*DCONJG(XVF)+XVEF)*GAEC*GAFC AZ2 = 2*DREAL(GAE2*GAFC*XVF+GAFC*XVE*DCONJG(XVEF)) * VEEZ=COMB1*HOMB1* & (GAE2+XVE*DCONJG(XVE))*COLOR*RQCDA*CORQED*GAF2*RO2 *FZZ VEFZ=(COMB1*HOMB1*VZ1+COMB2*HOMB1*VZ2+COMB1*HOMB2*AZ2+ & COMB2*HOMB2*AZ1)*RO2*COLOR*CORQED *FZZ AEFZ=(COMB1*HOMB1*AZ1+COMB2*HOMB1*AZ2+COMB1*HOMB2*VZ2+ & COMB2*HOMB2*VZ1)*RO2*COLOR *FZZ XVEFI=QEFM* &(COMB1*HOMB1*XVEF+COMB2*HOMB1*XVF*GAEC+COMB1*HOMB2*XVE*GAFC+ & GAEC*GAFC*COMB2*HOMB2)* XRO*RQCDV*COLOR*CORQED *FZA XAEFI=QEFM* &(COMB1*HOMB1*GAEC*GAFC+COMB2*HOMB1*XVE*GAFC+COMB1*HOMB2*XVF*GAEC+ & COMB2*HOMB2*XVEF)* XRO *COLOR *FZA VEFA=QEF**2*COMB1*HOMB1* RQCDV*COLOR*CORQED *FAA AEFA=QEF**2*COMB2*HOMB2* COLOR *FAA * * *** from BORN VPOL2S=VPOL2 XVPOLS=XVPOL IF(IASY.EQ.ITOT)THEN GG=VEFA*VPOL2S JJ=(DREAL(KAPPA*XVEFI*DCONJG(XVPOLS))- + DIMAG(KAPPA*XVEFI*DCONJG(XVPOLS))*SGAMZ/SZMASS)/2D0 RR=VEFZ*(DREAL(KAPPA)**2+DIMAG(KAPPA)**2)/16D0+ + (DIMAG(KAPPA*XVEFI*DCONJG(XVPOLS))*SGAMZ/SZMASS)/2D0 ELSEIF(IASY.EQ.IFB)THEN GG=0D0 JJ=(DREAL(KAPPA*XAEFI*DCONJG(XVPOLS))- + DIMAG(KAPPA*XAEFI*DCONJG(XVPOLS))*SGAMZ/SZMASS)/2D0 RR=AEFZ*(DREAL(KAPPA)**2+DIMAG(KAPPA)**2)/16D0+ + (DIMAG(KAPPA*XAEFI*DCONJG(XVPOLS))*SGAMZ/SZMASS)/2D0 ENDIF ENDIF * RETURN END CDECK ID>, SMCOUP. SUBROUTINE SMCOUP(SZMASS,SGAMZ,ITOT,IASY) C------------------------------------------------------------------------------ C In this SUBR. the common block /HADRON/ is loaded with the S-Matrix C parameters r, j and g for quark flavors and summed. C------------------------------------------------------------------------------ IMPLICIT NONE * * *** input REAL*8 SZMASS,SGAMZ INTEGER*4 ITOT,IASY * * *** loaded COMPLEX*16 XXVEFI REAL*8 AVEFA ,AVEEZ ,AVEFZ COMMON/HADRON/XXVEFI(6),AVEFA(6),AVEEZ(6),AVEFZ(6) * * *** local REAL*8 RR,JJ,GG INTEGER INDF,I C C------------------------------------------------------------------------------ C AVEFZ(5)=0D0 AVEEZ(5)=0D0 AVEFA(5)=0D0 XXVEFI(5)=DCMPLX(0D0,0D0) DO INDF=4,9 IF(INDF.NE.8)THEN CALL RJFRSM(INDF,SZMASS,SGAMZ,RR,JJ,GG,ITOT) I=INDF-3 AVEFZ(I)=RR AVEEZ(I)=JJ+RR AVEFA(I)=GG AVEFZ(5)=AVEFZ(5)+AVEFZ(I) AVEEZ(5)=AVEEZ(5)+AVEEZ(I) AVEFA(5)=AVEFA(5)+AVEFA(I) IF(IASY.NE.ITOT) + CALL RJFRSM(INDF,SZMASS,SGAMZ,RR,JJ,GG,IASY) XXVEFI(I)=DCMPLX(RR,JJ+RR) XXVEFI(5)=XXVEFI(5)+XXVEFI(I) ENDIF ENDDO * END CDECK ID>, VAFRGA. SUBROUTINE VAFRGA(ZMASS,INDF,GAMZF,AF,GVF,GAF) C------------------------------------------------------------------------------ C This subroutine calculates GVF and GAF from the Z partial width C (GAMZ_F) and A_F=2*(GVF/GAF)/(1+(GVF/GAF)**2). C This interpretation of A_F requires ABS(AF)<=1. C (ZMASS/GAMZF according to BW with s-dependent width.) C------------------------------------------------------------------------------ * IMPLICIT NONE * * *** input INTEGER*4 INDF REAL*8 ZMASS,GAMZF,AF * * *** output REAL*8 GVF,GAF * * *** local REAL*8 RATIO,GAM C C------------------------------------------------------------------------------ C GVF=0D0 GAF=0D0 * IF(ABS(AF).GT.1D0)THEN RETURN ELSEIF(ABS(AF).EQ.1D0)THEN RATIO=1D0/AF ELSEIF(AF.GT.0D0)THEN RATIO=1D0/AF-SQRT( (1D0/AF)**2-1D0 ) ELSEIF(AF.LT.0D0)THEN RATIO=1D0/AF+SQRT( (1D0/AF)**2-1D0 ) ELSE RATIO=0D0 ENDIF * CALL GZFRVA(ZMASS,INDF,0.5D0*RATIO,0.5D0,GAM) IF(GAM.GT.0D0)THEN GAF=SQRT(GAMZF/GAM)/2D0 GVF=RATIO*GAF ENDIF * RETURN END CDECK ID>, GAFRVA. SUBROUTINE GAFRVA(ZMASS,INDF,GVF,GAF,GAMZF,AF) C------------------------------------------------------------------------------ C This subroutine calculates the Z partial width (GAMZ_F) and C A_F=2*(GVF/GAF)/(1+(GVF/GAF)**2) from GVF and GAF. C This interpretation of A_F requires GAF<>0. C (ZMASS/GAMZF according to BW with s-dependent width.) C------------------------------------------------------------------------------ * IMPLICIT NONE * * *** input INTEGER*4 INDF REAL*8 ZMASS,GVF,GAF * * *** output REAL*8 GAMZF,AF C C------------------------------------------------------------------------------ C GAMZF = 0D0 AF = 0D0 * IF(GAF.NE.0D0)THEN CALL GZFRVA(ZMASS,INDF,GVF,GAF,GAMZF) AF=2D0*GAF*GVF/(GAF**2+GVF**2) ENDIF * RETURN END CDECK ID>, GZFRVA. SUBROUTINE GZFRVA(ZMASS,INF,GVF,GAF,GAMZF) C------------------------------------------------------------------------------ C This subroutine calculates the Z partial width (GAMZ_F) from C GVF and GAF in analogy to s/r ZWRATE of DIZET (assuming IFACT<=3). C (ZMASS/GAMZF according to BW with s-dependent width.) C------------------------------------------------------------------------------ * IMPLICIT NONE * * *** input INTEGER*4 INF REAL*8 ZMASS,GVF, GAF * * *** output REAL*8 GAMZF * * *** local REAL*8 CONSTZ,RAT,SQR,GAM1I,RQCDV,RQCDA,ROFZ,VEFZ INTEGER NCF * * *** ZFITTER common blocks REAL*8 ALLCH ,ALLMS COMMON/ZFCHMS/ALLCH(0:11),ALLMS(0:11) REAL*8 QDF,QCDCOR ,ALPHST,SIN2TW,S2TEFF , & WIDTHS COMMON /ZUPARS/QDF,QCDCOR(0:14),ALPHST,SIN2TW,S2TEFF(0:11), & WIDTHS(0:11) * * *** ZFITTER common blocks (copy from s/r ZWRATE of DIZET) REAL*8 PI,PI2,F1,D3,ALFAI,AL4PI,AL2PI,AL1PI COMMON/CDZCON/PI,PI2,F1,D3,ALFAI,AL4PI,AL2PI,AL1PI INTEGER*4 IHVP,IAMT4,IQCD,IMOMS,IMASS,IALEM,IMASK,IBARB,IFTJR COMMON/CDZFLG/IHVP,IAMT4,IQCD,IMOMS,IMASS,IALEM,IMASK,IBARB,IFTJR INTEGER*4 ISCRE,ISCAL,IAFMT,IFACR,IFACT,IHIGS,IEWLC COMMON /CDZSCT/ ISCRE,ISCAL,IAFMT,IFACR,IFACT,IHIGS,IEWLC REAL*8 AMZ,AMH,GMU,A0,GAMZ,GAMW,CALSZ,CALST,CALXI,CALQED COMMON/CDZZWG/AMZ,AMH,GMU,A0,GAMZ,GAMW,CALSZ,CALST,CALXI,CALQED REAL*8 AMW2,AMZ2,R,R1,R12,R2,AMH2,RW,RW1,RW12,RW2,RZ,RZ1, * RZ12,RZ2,ALR,ALRW,ALRZ,SW2M,CW2M,AKSX,R1W,R1W2 COMMON/CDZWSM/AMW2,AMZ2,R,R1,R12,R2,AMH2,RW,RW1,RW12,RW2,RZ,RZ1, * RZ12,RZ2,ALR,ALRW,ALRZ,SW2M,CW2M,AKSX,R1W,R1W2 REAL*8 CLM ,AML ,CQM ,AMQ ,VB,VT,VB2,VB2T,VT2,VT2T COMMON/CDZFER/CLM(8),AML(8),CQM(8),AMQ(8),VB,VT,VB2,VB2T,VT2,VT2T REAL*8 AMTH COMMON/CDZTHR/AMTH(6) REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ COMMON/CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) * INTEGER*4 INDQ(0:9) DATA INDQ /0,0,0,0,1,2,3,4,5,6/ C C------------------------------------------------------------------------------ C IF(IFACT.GT.3) +PRINT*,'GZFRVA> Warning: using IFACT<=3 instead of ',IFACT CONSTZ=GMU*ZMASS**3/12.D0/PI/SQRT(2.D0) IF(INF.LT.0.OR.INF.EQ.8.OR.INF.GE.10)THEN GAMZF=0D0 ELSE RAT=0D0 SQR=1D0 IF(INF.LT.4)THEN NCF=1 RAT=(ALLMS(INF)/ZMASS)**2 ELSE NCF=3 IF(ABS(QCDCOR((MAX(0,2*INDQ(INF)-1)))-1).LT.1D-8) * RAT=(ALLMS(INF)/ZMASS)**2 ENDIF SQR=SQRT(1D0-4D0*RAT) IF(INF.LT.4.OR. + ABS(QCDCOR((MAX(0,2*INDQ(INF)-1)))-1).LT.1D-8) THEN RQCDV=1D0+0.75D0*CALQED/PI*ALLCH(INF)**2 RQCDA=RQCDV ELSE RQCDV=QCDCOR(MAX(0,2*INDQ(INF)-1)) RQCDA=QCDCOR(MAX(0,2*INDQ(INF) )) ENDIF VEFZ=ABS(GVF/GAF) ROFZ=(2D0*GAF)**2 GAM1I=CONSTZ*ROFZ*SQR*((1+2*RAT)*(VEFZ**2*RQCDV+RQCDA)/2 & -3*RAT*RQCDA) GAMZF=GAM1I*NCF END IF * RETURN END