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 old ZFITTER~[1] branch ZUSMAT. (Note, * that with ZFITTER 6.11, ZUSMAT is removed from ZFITTER.) In * addition to total cross sections, SMATASY also calculates various * forward-backward and polarised asymmetries in the S-matrix approach. * * SMATASY uses many ZFITTER routines. For the installation of SMATASY * the subroutine BORN of ZFITTER must be replaced with subroutine BORN * of SMATASY. SMATASY's BORN provides the complete functionality and * the identical calculations of the original BORN of ZFITTER, plus all * extensions needed for the S-matrix calculations. Both SMATASY and * ZFITTER are initialized by a call to the SMATASY subroutine ASYINIT, * which itself calls ZUWEAK. ASYTEST illustrates the initialization * procedure and performs a comparison with the other model independent * approaches of ZFITTER. * * Reference: * [1] D. Bardin et al., FORTRAN package ZFITTER, * Old: Preprint CERN-TH.6443/92 (March 1992), hep-ph/9412201. * New: Comput.Phys.Commun. 133 (2001) 229-395 * ************************************************************************* * * Contacts: T. Riemann, riemann@ifh.de * M. Gruenewald, Martin.Grunewald@cern.ch * S. Riemann, riemanns@ifh.de * ************************************************************************* * * 2005/06/02 6.42/01 * * SMATA642 is a SMATASY version for ZFITTER 6_42 of 2005/05/18. * * ----------------------------------------------------------------------- * * SMATASY 6.42 was tested together with ZFITTER 6_42 on Linux. * ************************************************************************* * * 2004/10/18 6.41/01 * * SMATA641 is a SMATASY version for ZFITTER 6_41 of 2004/10/15. * * ----------------------------------------------------------------------- * * SMATASY 6.41 was tested together with ZFITTER 6_41 on HP and Linux. * ************************************************************************* * * 2004/08/03 6.40/01 * * SMATA640 is a SMATASY version for ZFITTER 6_40 of 2004/08/03. * * ----------------------------------------------------------------------- * * SMATASY 6.40 was tested together with ZFITTER 6_40 on HP. * ************************************************************************* * * 2001/06/25 6.36/01 * * SMATA636 is a SMATASY version for ZFITTER 6_36 of 2001/06/21. * * ----------------------------------------------------------------------- * * SMATASY 6.36 was tested together with ZFITTER 6_36 on HP. * ************************************************************************* * * 2001/02/18 6.35/01 * * SMATA635 is a SMATASY version for ZFITTER 6_35 of 2001/02/18. * * ----------------------------------------------------------------------- * * SMATASY 6.35 was tested together with ZFITTER 6_35 on HP. * ************************************************************************* * * 2001/01/26 6.34/01 * * SMATA634 is a SMATASY version for ZFITTER 6_34 of 2001/01/26. * * ----------------------------------------------------------------------- * * SMATASY 6.34 was tested together with ZFITTER 6_34 on HP. * ************************************************************************* * * 2000/12/12 6.33/01 * * SMATA633 is a SMATASY version for ZFITTER 6_33 of 2000/12/12. * * ----------------------------------------------------------------------- * * SMATASY 6.33 was tested together with ZFITTER 6_33 on HP. * ************************************************************************* * * 1999/12/13 6.23/01 * * SMATA623 is a SMATASY version for ZFITTER 6_23 of 1999/12/13. * * ----------------------------------------------------------------------- * * SMATASY 6.23 was tested together with ZFITTER 6_23 on HP. * ************************************************************************* * * 1999/12/01 6.22/01 * * SMATA622 is a SMATASY version for ZFITTER 6_22 of 1999/10/15. * * ----------------------------------------------------------------------- * * SMATASY 6.22 was tested together with ZFITTER 6_22 on HP. * ************************************************************************* * * 1999/10/15 6.21/01 * * SMATA621 is a SMATASY version for ZFITTER 6_21 of 1999/10/13. * * ----------------------------------------------------------------------- * * SMATASY 6.21 was tested together with ZFITTER 6_21 on HP. * ************************************************************************* * * 1999/06/30 6.11/02 * * Fix of bug indicated by G.Quast, affecting calculations including * non-resonant polynomial terms in the cross sections (introduced * with 6.11/01). * * 1999/06/24 6.11/01 * * SMATA611 is a SMATASY version for ZFITTER 6_11 of 1999/06/22! * * With 6.11, ZUSMAT is removed from ZFITTER. Indeed, all S-Matrix * calculations should be made with SMATASY. * * ----------------------------------------------------------------------- * * SMATASY 6.11 was tested together with ZFITTER 6_11 on HP. * ************************************************************************* * * 1999/05/27 6.10/01 * * SMATA610 is a SMATASY version for ZFITTER 6_10 of 1999/05/27! * * ----------------------------------------------------------------------- * * SMATASY 6.10 was tested together with ZFITTER 6_10 on HP. * ************************************************************************* * * 1999/05/17 6.06/01 * * SMATA606 is a SMATASY version for ZFITTER 6_06 of 1999/05/17! * (Earlier versions of ZFITTER606 are not to be used!) * * ----------------------------------------------------------------------- * * SMATASY 6.06 was tested together with ZFITTER 6_06 on HP. * ************************************************************************* * * 1999/04/28 6.05/01 * * SMATA605 is a SMATASY version for ZFITTER 6_05 of 1999/04/24. * * Clean-up of subroutines performing the LEP parameter transformations * between the set of PO parameters consisting of effective couplings, * (gVf,gAf), and the set of PO parameters consisting of partial widths * and coupling-parameters, (\G_f,A_f). The routines VAfrGA and GAfrVA * transform between the two sets of parameters; both use the routine * GZfrVA which calculates the partial width \G_f of the Z based on gVf * and gAf. * * The new ZFITTER 6_05 flag MISC is taken into account by the affected * transformation routine, ie, GZfrVA! * Recall the meaning of flag MISC: * Flag value MISC=0 (default, unscaled rhos) corresponds to the usual * definition of the PO rho as given, for example, in the PCP report * written by BGP (Bardin, Gr\"unewald and Passarino). * Flag value MISC=1 (scaled rhos) adopts a different definition of the * PO rho. These different rhos absorb a scale-factor in addition, such * that the simple pre-Degrassi formula for the calculation of \G_f in * terms of gVf and gAf, \G_f \propto gVf^2+gAf^2, still produces the * correct result for \G_f. * * ----------------------------------------------------------------------- * * SMATASY 6.05 was tested together with ZFITTER 6_05 on HP. * ************************************************************************* * * 1999/04/20 5.21/02 * 1999/03/18 5.21/01 * * SMATA521 is a SMATASY version for ZFITTER 5_21 of 1999/03/09. * * Adaption to new BORN subroutine and logic of ZFITTER 5_21 * Update initialisation subroutine ASYINIT to handle * \Delta\alpha(5)had instead of \alpha(5) * Fermi constant updated to GMU = 1.16637D-5 (/ASYKON/) * General streamlining of code * * NOTE: The ZUSMAT part in the subroutine BORN is no longer modified * to become identical to SMATASY; instead, it is now kept identical to * that of the original BORN subroutine of ZFITTER. * * ----------------------------------------------------------------------- * * SMATASY 5.21 was tested together with ZFITTER 5_21 on HP. * ************************************************************************* * * 98/07/07 * * SMATA512 is a SMATASY version for ZFITTER 5_12 of 98/06/15. * * ----------------------------------------------------------------------- * * Modifications of utility routines VAFRGA and GZFRVA to treat the * CZAK corrections, implemented as additive shifts for partial widths * in ZF512, properly: * * 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) * * See also output of test program asytest. * * ----------------------------------------------------------------------- * * SMATASY 5.12 was tested together with ZFITTER 5_12 on HP. * ************************************************************************* * * 98/05/25 * * SMATA510 is a SMATASY version for ZFITTER 5_10 of 98/03/09. * * ----------------------------------------------------------------------- * * SMATASY 5.10 was tested together with ZFITTER 5_10 on HP. * ************************************************************************* * * 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.16637D-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 & ,AROTFZ ,AIROFZ ,AIKAFZ ,AIVEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) & ,AROTFZ(0:10),AIROFZ(0:10),AIKAFZ(0:10),AIVEFZ(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,dal5h complex*16 SGmu data ftot /0.d0,0.d0,0.d0/ integer i,j,indf,iasy integer iafmt,ialem,iamt4,iascr,iborn,iboxd,iconv integer iczak,ifbho,iintf,imisc,imisd *** constants ************************************************************ double precision ZMass,TMass,HMass PARAMETER(ZMASS=91.1867D0,TMASS=173.8D0,HMASS=100.D0) double precision alfas,RSPCUT PARAMETER(ALFAS=0.119D0) * *========================================================================= * * * initialize ZFITTER * CALL ZUINIT(1) * * set ZFITTER flags and print flag values * CALL ZUFLAG('PRNT',1) * IAFMT=3 IALEM=3 IAMT4=4 IASCR=0 IBORN=0 IBOXD=1 ICONV=1 ICZAK=1 IFBHO=0 IINTF=0 IMISC=0 IMISD=0 * RSPCUT=0.1D0 DAL5H=2.8039808929734D-02 * call zuflag('AFMT',IAFMT) call zuflag('ALEM',IALEM) call zuflag('AMT4',IAMT4) call zuflag('ASCR',IASCR) call zuflag('BORN',IBORN) call zuflag('BOXD',IBOXD) call zuflag('CONV',ICONV) call zuflag('CZAK',ICZAK) call zuflag('FBHO',IFBHO) call zuflag('INTF',IINTF) call zuflag('MISC',IMISC) call zuflag('MISD',IMISD) * call zuflag('PRNT',1) call zuinfo(0) * * initialize SMATASY * * output parameter SGMU is COMPLEX*16 ! call AsyInit(ZMASS,TMASS,HMASS,DAL5H,ALFAS,GMU, + GAMZ,SZMASS,SGAMZ,SGMU) 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 IF (I.NE.8) THEN IF (IMISC.EQ.0) THEN GA=+SQRT(AROTFZ(I))/2D0 ELSE GA=+SQRT(ARROFZ(I))/2D0 ENDIF 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* ENDIF 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=1,10 IF (INDF.NE.8) THEN 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 ) ENDIF 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=1,10 IF (INDF.NE.8) THEN 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) ENDIF 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* IF (IMISC.EQ.0) THEN GAE = +SQRT(AROTFZ(1))/2D0 ELSE GAE = +SQRT(ARROFZ(1))/2D0 ENDIF GVE = ARVEFZ(1)*GAE GAMEE= WIDTHS( 1)/1D3 GAMZ = WIDTHS(11)/1D3 DO I = 1,10 if (i.eq.1) then rs = 35D0 elseif (i.eq.2) then rs = 65D0 elseif (i.eq.3) then rs = ZMASS-2D0 elseif (i.eq.4) then rs = ZMASS elseif (i.eq.5) then rs = ZMASS+2D0 elseif (i.eq.6) then rs = 100D0 elseif (i.eq.7) then rs = 140D0 elseif (i.eq.8) then rs = 175D0 elseif (i.eq.9) then rs = 190D0 elseif (i.eq.10) then rs = 210D0 endif * call vzero(xsm,12*7*2) call vzero(xzf,12*6*2) * table header PRINT *,' SQRT(S) =',REAL(RS),' SQRT(S''/S) >',REAL(RSPCUT) print 9060 print 9050 print 9070 * loop over fermion indices DO indf=1,10 if (indf.eq.8) goto 66 S=RS**2 CALL ZUCUTS(INDF,-1,0D0,0D0,S*RSPCUT**2,0D0,180D0,0.25D0*S) gamff = widths(indf)/1000d0 call zuthsm(indf,rs,zmass,tmass,hmass,dal5h,alfas, + xzf(indf,1),xzf(indf,5)) call zuxsec(indf,rs,zmass,gamz,gamee,gamff,XZF(INDF,2)) if (indf.ne.10) then if (imisc.eq.0) then GA = +SQRT(AROTFZ(indf))/2d0 else GA = +SQRT(ARROFZ(indf))/2d0 endif 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 C call zusmat(indf,rs,SZmass,SGamz, C + rasy(itot),rasy(itot)+jasy(itot), C + 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 if (imisc.eq.0) then ga = +SQRT(AROTFZ(j))/2d0 else ga = +SQRT(ARROFZ(j))/2d0 endif 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 C call zusmat(indf,rs,SZmass,SGamz, C + rasy(itot),rasy(itot)+jasy(itot), C + 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(F9.5),1( 9X ),2(F9.5),'|', + 1(F9.5),1( 9X ),6(F9.5),'|') 9030 FORMAT(1X,I4,1x,'|',5(F9.5),'|',8(F9.5),'|') 9040 FORMAT(1X,I4,1x,'|',5( 9X ),'|',2( 9X ),A9, + 2(F9.5), 3( 9X ),'|') 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 |') * * 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 + 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 if (indf.eq.10) call smcoup(szmass,sgamz,itot,iasy) call zusma1(indf,ss,szmass,sgamz, +rtot,jtot,ftot(1),ftot(2),ftot(3),gtot,xstot,itot, +rasy,jasy,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,jasy,fasy(1),fasy(2),fasy(3),zero,xsasy,iasy, + rasy,jasy,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.16637D-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=46) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFDIAG , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT ,IFCZAK ,IFPREC ,IFHIG2 ,IFALE2 , & IFGFER ,IFISPP ,IFFSRS ,IFMISC ,IFMISD ,IFIPFC , & IFIPSC ,IFIPTO ,IFFBHO ,IFFSPP ,IFFUNA ,IFASCR , & IFSFSR ,IFENUE ,IFTUPV ,IFDMWW ,IFDSWW PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) ************************************************************************* 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,DAL5H,ALFAS,GMU, + GAMZ,SZMASS,SGAMZ,SGMU) ************************************************************************* IMPLICIT NONE * * *** input REAL*8 ZMASS,TMASS,HMASS,DAL5H,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=46) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFDIAG , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT ,IFCZAK ,IFPREC ,IFHIG2 ,IFALE2 , & IFGFER ,IFISPP ,IFFSRS ,IFMISC ,IFMISD ,IFIPFC , & IFIPSC ,IFIPTO ,IFFBHO ,IFFSPP ,IFFUNA ,IFASCR , & IFSFSR ,IFENUE ,IFTUPV ,IFDMWW ,IFDSWW PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) 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 6.42/01 **' print *,'** 2005/06/02 **' 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 (University College Dublin) **' 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,DAL5H,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 NONE * * SUBROUTINE PARAMETER * INTEGER*4 INDF,NTOT,NASY REAL*8 SQRS,SZMASS,SGAMZ REAL*8 RR,RI,R0,R1,R2,RG REAL*8 AR,AI,A0,A1,A2,AG REAL*8 CS,CA,AFB * * FLAGS * INTEGER*4 NFLGMX PARAMETER(NFLGMX=46) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFDIAG , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT ,IFCZAK ,IFPREC ,IFHIG2 ,IFALE2 , & IFGFER ,IFISPP ,IFFSRS ,IFMISC ,IFMISD ,IFIPFC , & IFIPSC ,IFIPTO ,IFFBHO ,IFFSPP ,IFFUNA ,IFASCR , & IFSFSR ,IFENUE ,IFTUPV ,IFDMWW ,IFDSWW PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) * * PHYSICS PARAMETERS * REAL*8 DAL5H COMMON /CDAL5H/ DAL5H 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 ,SPRIPP INTEGER*4 IRCUTS ,IRFAST COMMON /ZUDATA/ ACOLIN(0:11),EF_MIN(0:11),SPRIME(0:11), + ANGMIN(0:11),ANGMAX(0:11),SPRIPP(0:11),IRCUTS(0:11),IRFAST(0:11) * * PARAMETER ARRAYS * INTEGER*4 NPAR REAL*8 ZPAR COMMON/FRINIT/ NPAR(30),ZPAR(31) * * S-MATRIX * REAL*8 PI PARAMETER (PI = 3.14159265358979324D0) REAL*8 GMU,ALFA,ALFAI,CONS PARAMETER (GMU = 1.16637D-5 , + ALFAI = 137.0359895D0, + ALFA = 1D0/ALFAI, + CONS = 1D0) 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 * * CONSTANTS * REAL*8 ALLCH ,ALLMS COMMON/ZFCHMS/ALLCH(0:11),ALLMS(0:11) * * LOCAL * INTEGER*4 INTRF,INTERF,IQCDC,IHVP,IQCD,IALEM,IALE2 REAL*8 S,S1,S2,FG,FI,FR,FG1,FG2,FI1,FI2 REAL*8 AL1PI,AL4PI REAL*8 SBORN,STOT,ABORN,ATOT COMPLEX*16 XFZT(2) * * FUNCTION * COMPLEX*16 XFOTF3 EXTERNAL XFOTF3 * *----------------------------------------------------------------------- * CS=0D0 CA=0D0 AFB=0D0 * IF(INDF.LE.0.OR.INDF.GT.10.OR.INDF.EQ.8) THEN PRINT*,'ZUSMA1> Fermion index out of range: INDF = ',INDF RETURN ENDIF * IF(SQRS.LT.9.5D0.OR.SQRS.GT.350D0) THEN PRINT*,'ZUSMA1> Required SQRS out of range: SQRS = ',SQRS RETURN ENDIF * * INTERF. 0 ISMA=2 * INTRF = 0 ISMA = 2 C******* EXCLUDE INITITIAL-FINAL INTERFERENCE CORR. FOR S-MATRIX APPR. INTERF = NPAR(8) NPAR(8) = 0 * S = SQRS*SQRS NPAR(11) = IRCUTS(INDF) NPAR(13) = 1 ZPAR(2) = ALLCH(INDF) ZPAR(4) = ALLMS(INDF) DO IQCDC=0,14 ZPAR(7+IQCDC) = QCDCOR(IQCDC) ENDDO ZPAR(26) = 1D0-SPRIME(INDF)/S ZPAR(27) = ACOLIN(INDF) ZPAR(28) = EF_MIN(INDF) ZPAR(29) = ANGMAX(INDF) ZPAR(30) = ANGMIN(INDF) ZPAR(31) = SPRIPP(INDF) * * 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 * * CORRECTIONS FOR RUNNING ALPHA_QED THE SAME FOR ALL INTERFACES. * IHVP =NPAR(2) IQCD =NPAR(3) IALEM=NPAR(20) IALE2=NPAR(21) * IF (IALEM.GE.2) THEN ! go from scale MZ**2 to scale S * FG=1D0 FI=1D0 FR=1D0 * S1=SZMASS**2+SGAMZ**2 S2=S AL1PI=1D0/(PI*ALFAI) AL4PI=0.25D0*AL1PI IF (IALE2.EQ.0) THEN XFZT(1)=1D0+AL4PI*XFOTF3(IALEM,1 ,IHVP,IQCD,1,DAL5H,-S1) XFZT(2)=1D0+AL4PI*XFOTF3(IALEM,1 ,IHVP,IQCD,1,DAL5H,-S2) ELSE XFZT(1)=1D0+AL4PI*XFOTF3(IALEM,IALE2,IHVP,IQCD,1,DAL5H,-S1) XFZT(2)=1D0+AL4PI*XFOTF3(IALEM,IALE2,IHVP,IQCD,1,DAL5H,-S2) ENDIF * 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 FI1=DREAL(XFZT(1)) FI2=DREAL(XFZT(2)) FI=FI2/FI1 * RESG=FG*RESG RESI=FI*RESI RESR=FR*RESR REAG=FG*REAG REAI=FI*REAI REAR=FR*REAR * ENDIF * CALL ZCUT(INTRF,IRFAST(INDF),INDF, & S,SZMASS,SGAMZ,WIDTHS,SIN2TW,NPAR,ZPAR,SBORN,STOT,ABORN,ATOT) * IF (IFLAGS(IFBORN).EQ.1) THEN CS = SBORN CA = ABORN*SBORN AFB = ABORN ELSE CS = STOT CA = ATOT*STOT AFB = ATOT ENDIF * ISMA = 0 ITOT = 0 IASY = 0 * NPAR(8) = INTERF * RETURN * END CDECK ID>, BORN. SUBROUTINE BORN(IFINLA,R1,R2,SBORN,ABORN,SBORNS,ABORNS) * ========== ============================== IMPLICIT COMPLEX*16(X) IMPLICIT REAL*8(A-H,O-W,Y-Z) * COMMON / SVAR/ S COMMON /NCONST/ PI,F1,AL2,ZET3 COMMON /CHARGZ/ QE,QF,QEM,QFM,QEF,QEFM,QE2,QF2 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 /FLAGZ / IAFB,IBORN,IRCUT,IFINAL,INTERF,IWEAK,IPHOT2,ISYM COMMON /INTRFS/ INTRF COMMON /CDZRUN/ CMQRUN(8) 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),XXAEFI(6),AVEFA(6),AAEFA(6), & AVEEZ(6),AVEFZ(6),AAEFZ(6) COMMON /COUPL0/ VEFZ0,AVEFZ0(6) COMMON /CZAKCO/ CZAKFF COMMON /CDAL5H/ DAL5H COMMON /CALQED/ ALQEDZ,ALQEDS COMMON /KAPPAC/ AKAPPA COMMON /FORSPR/ ECUT,ACUT * * M. JACK, 18/03/1999 13:00 ADDED COMMON/INDFIN/: * COMMON /INDFIN/ IFUNFIN * * flags * PARAMETER(NFLGMX=46) 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,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) * * for SMATASY * REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ & ,AROTFZ ,AIROFZ ,AIKAFZ ,AIVEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) & ,AROTFZ(0:10),AIROFZ(0:10),AIKAFZ(0:10),AIVEFZ(0:10) 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 AMZ2 = AMZ*AMZ GAMZ2=GAMZ*GAMZ * * Running electromagnetic coupling * * Here XVPOLS, VPOL2S and ALQEDS are: IF ALEM=0,1 at M^2_Z; * IF ALEM=2,3 at S. * XVPOLS=XVPOL VPOL2S=VPOL2 * IF(IFLAGS(IFCONV).GE.1.AND.IFLAGS(IFALEM).GE.2) THEN IF(S1.LT.1D-2) THEN XFOT = DCMPLX(1D0,0D0) ELSE IF(IFLAGS(IFALE2).EQ.0) THEN XFOT = 1D0+AL1PI/4D0*XFOTF3 & (IFLAGS(IFALEM), 1,IFLAGS(IFVPOL),1,1,DAL5H,-S1) ELSE XFOT = 1D0+AL1PI/4D0*XFOTF3 & (IFLAGS(IFALEM),IFLAGS(IFALE2),IFLAGS(IFVPOL),1,1,DAL5H,-S1) ENDIF ENDIF * * Here XVPOLS, VPOL2S and ALQEDS are at S' * XVPOLS=1D0/(2D0-XFOT) VPOL2S=DREAL(XVPOLS)**2+DIMAG(XVPOLS)**2 ALQEDS=1D0/ALFAI/(2D0-DREAL(XFOT)) ELSEIF(IFLAGS(IFCONV).EQ.-1) THEN XVPOLS=DCMPLX(1D0,0D0) VPOL2S=1D0 ENDIF * * Running EW couplings * * MG's fix IF(IFLAGS(IFCONV).EQ.2) CALL EWCOUP(INTRF,INDF,MAX(1D2,S1)) * * Czarnecki-Kuehn corrections * IF(IFLAGS(IFCZAK).EQ.0.OR.IFLAGS(IFCZAK).EQ.2 & .OR.IFINLA.EQ.-1) THEN CZAKUE=0D0 ELSEIF(IFLAGS(IFCZAK).EQ.1) THEN CZAKUE=CZAKFF ENDIF * IF(ISMA .EQ. 0) THEN * XCHI1=XKAPP *S1/(S1-XMZ2 ) XCHI2=XKAPPC*S2/(S2-XMZ2C) XCHI =XCHI1+XKAPP*S2/(S2-XMZ2) * * to have the same expression for fit and analytics * IF(INDF.NE.10.OR.IND.EQ.0) THEN * * Regular chain for all INDF and INTRF * SBORN=0D0 ABORN=0D0 * IF(INDF.NE.6.AND.INDF.NE.9) THEN AMFH2=(ALLMS(INDF))**2 ELSE AMFH2=(CMQRUN(INDF-3))**2 ENDIF QFH2=(ALLCH(INDF))**2 IF(4D0*AMFH2.GE.S1) RETURN * * Final State QED corrections, governed by IFINLA=-1 or IFINAL * SFIN=1D0 AFIN=1D0 IF(IFINLA.EQ.0) THEN IF(INDF.GE.1.AND.INDF.LE.3) THEN SFIN=1D0+3D0/4*ALQEDS/PI*QFH2 ELSE SFIN=1D0 ENDIF ELSEIF(IFINLA.EQ.1.AND.INDF.NE.0) THEN CALL FUNFIN(S,AMFH2,QFH2,R1,SFIN,AFIN) ENDIF * AMF2S1=0D0 IF(INDF.LE.3) THEN IF(IFLAGS(IFPOWR).EQ.1) AMF2S1=AMF2/S1 ELSE IF(IFLAGS(IFFINR).EQ.-1.AND.IFLAGS(IFPOWR).EQ.1) & AMF2S1=(CMQRUN(INDF-3))**2/S1 ENDIF THRESH=SQRT(MAX(1D0-4D0*AMF2S1,0D0)) CORF2 =1D0+2D0*AMF2S1 CORF3 = -6D0*AMF2S1 * * BORN CROSS-SECTION * SBORN=THRESH*( & SFIN*CORF2*(VEFA*VPOL2S & +DREAL(XVEFI*XCHI*DCONJG(XVPOLS)) & ) & +(CORF2*(VEFZ+(SFIN-1D0+CZAKUE)*VEFZ0)+CORF3*VEEZ) & *DREAL(XCHI1*XCHI2) & )/R1 * * print *,'INDF=',INDF,CORF2,CORF3,VEFZ * * BORN ASYMMETRY * ABORN=THRESH**2*AFIN*(AEFA*VPOL2S & +DREAL(XAEFI*XCHI*DCONJG(XVPOLS))+AEFZ*DREAL(XCHI1*XCHI2))/R1 * * ELSE * * Special chain for the total hadronic cross-section for INTRF=2 and INDF=10 * SBORN=0D0 ABORN=0D0 * DO 1 I=4,9 IF(I.EQ.8) GO TO 1 * IF(I.NE.6.AND.I.NE.9) THEN AMFH2=(ALLMS(I))**2 ELSE AMFH2=(CMQRUN(I-3))**2 ENDIF QFH2=(ALLCH(I))**2 IF(4D0*AMFH2.GE.S1) GOTO 1 * * Final State QED corrections * SFIN=1D0 IF(IFINLA.EQ.0) THEN IF(I.GE.1.AND.I.LE.3) THEN SFIN=1D0+3D0/4*ALQEDS/PI*QFH2 ELSE SFIN=1D0 ENDIF ELSEIF(IFINLA.EQ.1) THEN CALL FUNFIN(S,AMFH2,QFH2,R1,SFIN,AFIN) ENDIF * AMQ2=0D0 IF(IFLAGS(IFFINR).EQ.-1.AND.IFLAGS(IFPOWR).EQ.1) & AMQ2=ALLMS(I)**2 * THRESH=SQRT(MAX(1D0-4D0*AMQ2/S1,0.D0)) CORF2 =(1D0+2D0*AMQ2/S1) CORF3 =( -6D0*AMQ2/S1) * * BORN CROSS-SECTION * J=I-3 SBORN=SBORN+THRESH*(SFIN*CORF2*(AVEFA(J)*VPOL2S & +DREAL(XXVEFI(J)*XCHI*DCONJG(XVPOLS)) & ) & +(CORF2*(AVEFZ(J)+(SFIN-1D0+CZAKUE)*AVEFZ0(J)) & +CORF3*AVEEZ(J) & )*DREAL(XCHI1*XCHI2) & )/R1 * * BORN ASYMMETRY needed for IFI * ABORN=ABORN+THRESH**2*AFIN*(AAEFA(J)*VPOL2S & +DREAL(XXAEFI(J)*XCHI*DCONJG(XVPOLS)) & +AAEFZ(J)*DREAL(XCHI1*XCHI2))/R1 1 CONTINUE * ENDIF * SBORNS=0D0 ABORNS=0D0 IF(INDF.EQ.10.AND.INTRF.EQ.2) THEN * * New addition for INTRF=2 and INDF=10 * * BORN CROSS-SECTION * SBORNS=(VEFA*VPOL2S+DREAL(XVEFI*XCHI*DCONJG(XVPOLS)) & +VEFZ*DREAL(XCHI1*XCHI2))/R1 * * BORN ASYMMETRY * ABORNS=(AEFA*VPOL2S & +DREAL(XAEFI*XCHI*DCONJG(XVPOLS))+AEFZ*DREAL(XCHI1*XCHI2))/R1 * ENDIF * ELSE * * >>> SMATASY modifications until end of subroutine! * AMZ2=AMZS**2+GAMZS**2 * S1MZ2 =S1-AMZS**2 XSZ =DCMPLX(AMZS*AMZS,-AMZS*GAMZS) * is=itot ia=iasy * IF(IFLAGS(IFCONV).GE.1.AND.IFLAGS(IFALEM).GE.2)THEN FG=1D0 FI=1D0 FR=1D0 FG1=DREAL(XVPOL )**2+DIMAG(XVPOL )**2 FG2=DREAL(XVPOLS)**2+DIMAG(XVPOLS)**2 FG=FG2/FG1 FI1=DREAL(XVPOL ) FI2=DREAL(XVPOLS) FI=FI2/FI1 TRESG=FG*RESG TRESI=FI*RESI TRESR=FR*RESR TREAG=FG*REAG TREAI=FI*REAI TREAR=FR*REAR ELSE TRESG=RESG TRESI=RESI TRESR=RESR TREAG=REAG TREAI=REAI TREAR=REAR ENDIF * 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 * * Special chain for the total hadronic cross-section for INTRF=2 and INDF=10 * SBORN=0D0 ABORN=0D0 * DO 11 I=4,9 IF(I.EQ.8) GO TO 11 * IF(I.NE.6.AND.I.NE.9) THEN AMFH2=(ALLMS(I))**2 ELSE AMFH2=(CMQRUN(I-3))**2 ENDIF QFH2=(ALLCH(I))**2 IF(4D0*AMFH2.GE.S1) GOTO 11 * * Final State QED corrections * SFIN=1D0 AFIN=1D0 IF(IFINLA.EQ.0) THEN IF(I.GE.1.AND.I.LE.3) THEN SFIN=1D0+3D0/4*ALQEDS/PI*QFH2 ELSE SFIN=1D0 ENDIF ELSEIF(IFINLA.EQ.1) THEN CALL FUNFIN(S,AMFH2,QFH2,R1,SFIN,AFIN) ENDIF * AMQ2=0D0 IF(IFLAGS(IFFINR).EQ.-1.AND.IFLAGS(IFPOWR).EQ.1) & AMQ2=ALLMS(I)**2 * THRESH=SQRT(MAX(1D0-4D0*AMQ2/S1,0.D0)) CORF2 =(1D0+2D0*AMQ2/S1) CORF3 =( -6D0*AMQ2/S1) * * BORN CROSS-SECTION * XCHI1=S1/DCMPLX(S1-AMZS*AMZS,AMZS*GAMZS) XCHI2=S2/DCMPLX(S2-AMZS*AMZS,AMZS*GAMZS) * J=I-3 * facnor=avefz(j)/srtot facnoj=aveez(j)/sjtot facnog=avefa(j)/sgtot * C sbornq=sfin*thresh*corf2*( C + (facnor*(1d0+(corf3/corf2)/(1d0+arvefz(i)**2)) C * *tresr*amzs**2 C + +facnoj*tresi*s1mz2)/abs(s1-xsz)**2 C + +facnog*tresg/s1 C + )*s * sbornq=sfin*thresh*corf2*( + (facnor*(1d0+(corf3/corf2)/(1d0+arvefz(i)**2))*tresr* * (1d0+czakue)* & DREAL(XCHI1*DCONJG(XCHI2)+XCHI2*DCONJG(XCHI1))/2D0/S1 + +facnoj*tresi* & DREAL(XCHI1+DCONJG(XCHI1)+XCHI2+DCONJG(XCHI2))/4D0/S1) + +facnog*tresg/s1 + )*s * sborn=sborn+sbornq * facnor=dreal(xxvefi(j))/srasy facnoj=dimag(xxvefi(j))/sjasy facnog=0d0 * C abornq=afin*thresh**2*( C + (facnor*trear*amzs**2 C + +facnoj*treai*s1mz2)/abs(s1-xsz)**2 C + +facnog*treag/s1 C + )*s * abornq=afin*thresh**2*( + (facnor*trear* & DREAL(XCHI1*DCONJG(XCHI2)+XCHI2*DCONJG(XCHI1))/2D0/S1 + +facnoj*treai* & DREAL(XCHI1+DCONJG(XCHI1)+XCHI2+DCONJG(XCHI2))/4D0/S1) + +facnog*treag/s1 + )*s * aborn=aborn+abornq * 11 CONTINUE * 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 * SBORN=0D0 ABORN=0D0 * IF(INDF.NE.6.AND.INDF.NE.9) THEN AMFH2=(ALLMS(INDF))**2 ELSE AMFH2=(CMQRUN(INDF-3))**2 ENDIF QFH2=(ALLCH(INDF))**2 IF(4D0*AMFH2.GE.S1) RETURN * * Final State QED corrections, governed by IFINLA=-1 or IFINAL * SFIN=1D0 AFIN=1D0 IF(IFINLA.EQ.0) THEN IF(INDF.GE.1.AND.INDF.LE.3) THEN SFIN=1D0+3D0/4*ALQEDS/PI*QFH2 ELSE SFIN=1D0 ENDIF ELSEIF(IFINLA.EQ.1.AND.INDF.NE.0) THEN CALL FUNFIN(S,AMFH2,QFH2,R1,SFIN,AFIN) ENDIF * AMF2S1=0D0 IF(INDF.LE.3) THEN IF(IFLAGS(IFPOWR).EQ.1) AMF2S1=AMF2/S1 ELSE IF(IFLAGS(IFFINR).EQ.-1.AND.IFLAGS(IFPOWR).EQ.1) & AMF2S1=(CMQRUN(INDF-3))**2/S1 ENDIF THRESH=SQRT(MAX(1D0-4D0*AMF2S1,0D0)) CORF2 =1D0+2D0*AMF2S1 CORF3 = -6D0*AMF2S1 * * BORN CROSS-SECTION * XCHI1=S1/DCMPLX(S1-AMZS*AMZS,AMZS*GAMZS) XCHI2=S2/DCMPLX(S2-AMZS*AMZS,AMZS*GAMZS) * C sborn=sfin*thresh*corf2*( C + ((1d0+(corf3/corf2)/(1d0+arvefz(indf)**2))*tresr*amzs**2 C + +tresi*s1mz2)/abs(s1-xsz)**2 C + +tresg/s1 C + +res0/amzs**2 C + +res1*s1mz2/amzs**4 C + +res2*s1mz2**2/amzs**6 C = )*S * C aborn=afin*thresh**2*( C + (trear*amzs**2+treai*s1mz2)/abs(s1-xsz)**2 C + +treag/s1 C + +rea0/amzs**2 C + +rea1*s1mz2/amzs**4 C + +rea2*s1mz2**2/amzs**6 C = )*S * sborn=sfin*thresh*corf2*( + ((1d0+(corf3/corf2)/(1d0+arvefz(indf)**2))*tresr* * (1d0+czakue)* & DREAL(XCHI1*DCONJG(XCHI2)+XCHI2*DCONJG(XCHI1))/2D0/S1 + +tresi* & DREAL(XCHI1+DCONJG(XCHI1)+XCHI2+DCONJG(XCHI2))/4D0/S1) + +tresg/s1 + +res0/amzs**2 + +res1*s1mz2/amzs**4 + +res2*s1mz2**2/amzs**6 = )*S * aborn=afin*thresh**2*( + (trear* & DREAL(XCHI1*DCONJG(XCHI2)+XCHI2*DCONJG(XCHI1))/2D0/S1 + +treai* & DREAL(XCHI1+DCONJG(XCHI1)+XCHI2+DCONJG(XCHI2))/4D0/S1) + +treag/s1 + +rea0/amzs**2 + +rea1*s1mz2/amzs**4 + +rea2*s1mz2**2/amzs**6 = )*S * endif * 9999 FORMAT(I3,10E20.13) * * <<< SMATASY modifications end! * * ENDIF * END BORN 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 IMISC,IMIN,IMAX,INOT,I * * *** ZFITTER common blocks INTEGER*4 NFLGMX PARAMETER(NFLGMX=46) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFDIAG , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT ,IFCZAK ,IFPREC ,IFHIG2 ,IFALE2 , & IFGFER ,IFISPP ,IFFSRS ,IFMISC ,IFMISD ,IFIPFC , & IFIPSC ,IFIPTO ,IFFBHO ,IFFSPP ,IFFUNA ,IFASCR , & IFSFSR ,IFENUE ,IFTUPV ,IFDMWW ,IFDSWW PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) REAL*8 ARROFZ ,ARKAFZ ,ARVEFZ ,ARSEFZ & ,AROTFZ ,AIROFZ ,AIKAFZ ,AIVEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) & ,AROTFZ(0:10),AIROFZ(0:10),AIKAFZ(0:10),AIVEFZ(0:10) C C------------------------------------------------------------------------------ C RR = 0D0 JJ = 0D0 GG = 0D0 * IF(INDF.LE.0.OR.INDF.GT.10.OR.INDF.EQ.8) THEN PRINT*,'RJfrSM> Fermion index out of range: INDF = ',INDF RETURN ENDIF * IMISC = IFLAGS(IFMISC) * IF (IMISC.EQ.0) THEN GAE = +SQRT(AROTFZ(1))/2D0 ELSE GAE = +SQRT(ARROFZ(1))/2D0 ENDIF 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 IF (IMISC.EQ.0) THEN GAF = +SQRT(AROTFZ(I))/2D0 ELSE GAF = +SQRT(ARROFZ(I))/2D0 ENDIF 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 * * *** parameters REAL*8 GMU,ALFA,ALFAI,CONS PARAMETER (GMU = 1.16637D-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 couplings common blocks REAL*8 VEFA, VEFZ,AEFA, AEFZ,VEEZ, VPOL2 COMPLEX*16 XVEFI, XAEFI, XVPOL COMMON /COUPL / VEFA,XVEFI,VEFZ,AEFA,XAEFI,AEFZ,VEEZ,XVPOL,VPOL2 COMPLEX*16 XALLCH ,XFOTF COMMON /EWFORM/XALLCH(5,4),XFOTF INTEGER*4 NPAR REAL*8 ZPAR COMMON/FRINIT/ NPAR(30),ZPAR(31) INTEGER*4 NFLGMX PARAMETER(NFLGMX=46) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFDIAG , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT ,IFCZAK ,IFPREC ,IFHIG2 ,IFALE2 , & IFGFER ,IFISPP ,IFFSRS ,IFMISC ,IFMISD ,IFIPFC , & IFIPSC ,IFIPTO ,IFFBHO ,IFFSPP ,IFFUNA ,IFASCR , & IFSFSR ,IFENUE ,IFTUPV ,IFDMWW ,IFDSWW PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) * * *** local INTEGER*4 IBORN REAL*8 TRAFAC,ZMASS,GAMZ,XS,AFB,VPOL2S COMPLEX*16 XVPOLS,SGMU,RZ0,RZ1,RZ2,RZ3,KAPPA C C------------------------------------------------------------------------------ C RR=0D0 JJ=0D0 GG=0D0 * IF(INDF.LE.0.OR.INDF.GE.10.OR.INDF.EQ.8) THEN PRINT*,'RJfrVA> Fermion index out of range: INDF = ',INDF RETURN ENDIF * XVPOLS=1D0/(2D0-XFOTF) VPOL2S=DREAL(XVPOLS)**2+DIMAG(XVPOLS)**2 * * *** Initialise everything via ZUXSA call * TRAFAC=SQRT(1D0+(SGAMZ/SZMASS)**2) ZMASS =TRAFAC*SZMASS GAMZ =TRAFAC*SGAMZ IBORN=NPAR(14) NPAR(14)=1 CALL ZUXSA(INDF,ZMASS,ZMASS,GAMZ,0,GVE,GAE,GVF,GAF,XS,AFB) NPAR(14)=IBORN VPOL2S=VPOL2 XVPOLS=XVPOL * * *** 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 * CALL RJFRRZ(INDF,SZMASS,SGAMZ,RZ0,RZ1,RZ2,RZ3,XVPOLS, + RR,JJ,GG,IASY) IF (IASY.EQ.ITOT.AND.INDF.GT.3) THEN RR=RR*ZPAR(7+MAX(0,2*(INDF-4)+2)) JJ=JJ*ZPAR(7+MAX(0,2*(INDF-4)+1)) GG=GG*ZPAR(7+MAX(0,2*(INDF-4)+1)) ENDIF * * *** Full calculation for specific cases TOT and AFB * IF(IASY.EQ.ITOT.OR.IASY.EQ.IFB)THEN KAPPA=RZ0/( (GVE+GAE)*(GVF+GAF) ) IF(IASY.EQ.ITOT)THEN GG=VEFA*VPOL2S JJ=(DREAL(KAPPA*XVEFI*DCONJG(XVPOLS)))/2D0 + -(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=AEFA*VPOL2S JJ=(DREAL(KAPPA*XAEFI*DCONJG(XVPOLS)))/2D0 + -(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 ,XXAEFI REAL*8 AVEFA ,AAEFA REAL*8 AVEEZ ,AVEFZ ,AAEFZ COMMON /HADRON/ XXVEFI(6),XXAEFI(6),AVEFA(6),AAEFA(6), & AVEEZ(6),AVEFZ(6),AAEFZ(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 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) 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 the effective couplings GVF and GAF based C on the Z partial width GAMZ_F and the coupling parameter C A_F = 2*(GVF/GAF)/(1+(GVF/GAF)**2). C This interpretation of A_F requires ABS(AF)<=1 (fixed up if not). C (ZMASS/GAMZF according to BW with s-dependent width.) C C Input: C ZMASS Mass of the Z boson / GeV C INDF Fermion index (ZFITTER convention) C GAMZF Partial decay width / GeV C AF Coupling parameter C C Output: C GVF Effective vector coupling C GAF Effective axial coupling C C 1999/04/28 C C------------------------------------------------------------------------------ * IMPLICIT NONE * * *** input INTEGER*4 INDF REAL*8 ZMASS,GAMZF,AF * * *** output REAL*8 GVF,GAF * * *** local REAL*8 XAF,RATIO,GAM,DELTA C C------------------------------------------------------------------------------ C GVF=0D0 GAF=0D0 * IF(INDF.LT.0.OR.INDF.GE.10.OR.INDF.EQ.8) THEN PRINT*,'VAfrGA> Fermion index out of range: INDF = ',INDF RETURN ENDIF * IF(ABS(AF).GT.1D0)THEN PRINT*,'VAfrGA> Warning: A_F out of range - INDF = ',INDF XAF=SIGN(1D0,AF) ELSE XAF=AF ENDIF * * *** Ratio GVF/GAF * IF(ABS(XAF).EQ.1D0)THEN RATIO=1D0/XAF ELSEIF(XAF.GT.0D0)THEN RATIO=1D0/XAF-SQRT( (1D0/XAF)**2-1D0 ) ELSEIF(XAF.LT.0D0)THEN RATIO=1D0/XAF+SQRT( (1D0/XAF)**2-1D0 ) ELSE RATIO=0D0 ENDIF * * *** Get additive non-factorisable corrections to partial width * *** to be subtracted * CALL GZFRVA(ZMASS,INDF,0D0,0D0,DELTA) * CALL GZFRVA(ZMASS,INDF,0.5D0*RATIO,0.5D0,GAM) GAF=SQRT(MAX(0D0,(GAMZF-DELTA)/(GAM-DELTA)))/2D0 GVF=RATIO*GAF * 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 the coupling C parameter A_F = 2*(GVF*GAF)/(GVF**2+GAF**2) from GVF and GAF. C This interpretation of A_F requires GVF**2+GAF**2<>0. C (ZMASS/GAMZF according to BW with s-dependent width.) C C Input: C ZMASS Mass of the Z boson / GeV C INDF Fermion index (ZFITTER convention) C GVF Effective vector coupling C GAF Effective axial coupling C C Output: C GAMZF Partial decay width / GeV C AF Coupling parameter C C 1999/04/28 C 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(INDF.LT.0.OR.INDF.GE.10.OR.INDF.EQ.8) THEN PRINT*,'GAfrVA> Fermion index out of range: INDF = ',INDF RETURN ENDIF * CALL GZFRVA(ZMASS,INDF,GVF,GAF,GAMZF) IF (GVF.EQ.0D0.AND.GAF.EQ.0D0) THEN PRINT*,'GAfrVA> Warning: gVf=gAf=0 (A_F:=0) INDF = ',INDF ELSE AF=2D0*GVF*GAF/(GVF**2+GAF**2) ENDIF * RETURN END CDECK ID>, GZFRVA. SUBROUTINE GZFRVA(ZMASS,IDF,GVF,GAF,GAMZF) C------------------------------------------------------------------------------ C This subroutine calculates the Z partial width GAMZ_F from GVF and GAF C in analogy to s/r ZWRATE of DIZET (partial functionality). C (ZMASS/GAMZF according to BW with s-dependent width.) C C Input: C ZMASS Mass of the Z boson / GeV C IDF Fermion index (ZFITTER convention) C GVF Effective vector coupling C GAF Effective axial coupling C C Output: C GAMZF Partial decay width / GeV C C This is the only complicated part of the parameter transformation, C as it involves the Standard Model part (aka SM complement). Thus C this routine makes use of data stored in ZFITTER and DIZET common C blocks. C C 1999/04/28 C C------------------------------------------------------------------------------ * IMPLICIT NONE * * *** input INTEGER*4 IDF REAL*8 ZMASS,GVF,GAF * * *** output REAL*8 GAMZF * * *** local INTEGER*4 INF,ICZ REAL*8 CONSTZ,RAT,SQR,GAM1I,RQCDV,RQCDA,RKIMAG * * *** ZFITTER common blocks INTEGER*4 NFLGMX PARAMETER(NFLGMX=46) INTEGER*4 IFLAGS COMMON /ZUFLGS/ IFLAGS(NFLGMX),CFLAGS(NFLGMX) CHARACTER CFLAGS*4 INTEGER*4 IFAFBC ,IFSCAL ,IFSCRE ,IFAMT4 ,IFBORN , & IFBOXD ,IFCONV ,IFFINR ,IFFOT2 ,IFGAMS ,IFDIAG , & IFINTF ,IFBARB ,IFPART ,IFPOWR ,IFPRNT ,IFALEM , & IFQCDC ,IFVPOL ,IFWEAK ,IFFTJR ,IFEXPR ,IFEXPF , & IFHIGS ,IFAFMT ,IFCZAK ,IFPREC ,IFHIG2 ,IFALE2 , & IFGFER ,IFISPP ,IFFSRS ,IFMISC ,IFMISD ,IFIPFC , & IFIPSC ,IFIPTO ,IFFBHO ,IFFSPP ,IFFUNA ,IFASCR , & IFSFSR ,IFENUE ,IFTUPV ,IFDMWW ,IFDSWW PARAMETER (IFAFBC= 1,IFSCAL= 2,IFSCRE= 3,IFAMT4= 4,IFBORN= 5, & IFBOXD= 6,IFCONV= 7,IFFINR= 8,IFFOT2= 9,IFGAMS=10,IFDIAG=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,IFCZAK=26,IFPREC=27,IFHIG2=28,IFALE2=29, & IFGFER=30,IFISPP=31,IFFSRS=32,IFMISC=33,IFMISD=34,IFIPFC=35, & IFIPSC=36,IFIPTO=37,IFFBHO=38,IFFSPP=39,IFFUNA=40,IFASCR=41, & IFSFSR=42,IFENUE=43,IFTUPV=44,IFDMWW=45,IFDSWW=46) REAL*8 QDF,QCDCOR ,ALPHST,SIN2TW,S2TEFF , & WIDTHS COMMON /ZUPARS/QDF,QCDCOR(0:14),ALPHST,SIN2TW,S2TEFF(0:11), & WIDTHS(0:11) * * *** ZWRATE common blocks * *** DIZET 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,ICZAK & ,IHIG2,IALE2,IGFER COMMON/CDZSCT/ISCRE,ISCAL,IAFMT,IFACR,IFACT,IHIGS,IEWLC,ICZAK & ,IHIG2,IALE2,IGFER 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 & ,AROTFZ ,AIROFZ ,AIKAFZ ,AIVEFZ COMMON /CDZRKZ/ARROFZ(0:10),ARKAFZ(0:10),ARVEFZ(0:10),ARSEFZ(0:10) & ,AROTFZ(0:10),AIROFZ(0:10),AIKAFZ(0:10),AIVEFZ(0:10) REAL*8 PARTZA ,PARTZI ,RENFAC ,SRENFC COMMON /CDZAUX/PARTZA(0:10),PARTZI(0:10),RENFAC(0:10),SRENFC(0:10) * REAL*8 AQFI COMMON/CDZAQF/AQFI(10) * INTEGER*4 IDDZZ COMMON/CDZDDZ/IDDZZ * INTEGER*4 MCOLFZ(10) INTEGER*4 INDF(10),INDL(10),INDQ(10) INTEGER*4 MWFAC(2) REAL*8 AQFW(2),ARCZAK(0:6) * DATA MWFAC/3,6/ DATA INDF /2,1,1,1,4,3,4,3,4,5/ DATA INDL /1,2,4,6,0,0,0,0,0,0/ DATA INDQ /0,0,0,0,1,2,3,4,5,6/ DATA MCOLFZ/1,1,1,1,3,3,3,3,3,3/ * * C C------------------------------------------------------------------------------ C GAMZF=0D0 * IF(IDF.LT.0.OR.IDF.GE.10.OR.IDF.EQ.8) THEN PRINT*,'GZfrVA> Fermion index out of range: INDF = ',IDF RETURN ENDIF * IF(IFACT.GT.3) +PRINT*,'GZfrVA> Warning: using IFACT<=3 instead of ',IFACT * INF=IDF+1 * * MWFAC AND MZFAC - FLAVOUR*COLOR FACTORS FOR W- AND Z- DECAYS * AQFI(1)=0.D0 AQFI(2)=1.D0 AQFI(3)=1.D0 AQFI(4)=1.D0 AQFI(5)=2.D0/3.D0 AQFI(6)=1.D0/3.D0 AQFI(7)=2.D0/3.D0 AQFI(8)=1.D0/3.D0 AQFI(9)=2.D0/3.D0 AQFI(10)=1.D0/3.D0 * * AQFI - ARRAY OF FINAL PARTICLE CHARGES FOR PARTIAL Z- WIDTHS% * T,TBAR DECAY CHANNEL IS ASSUMED TO BE ABOVE Z- THRESHOLD AND IS * NOT ADDED TO THE TOTAL Z- WIDTH * AQFW(1)=1.D0 AQFW(2)=2.D0/3.D0 * * Numerical implementation of Czarnecki-Kuehn's corrections * IF(CALSZ.LE.1D-4) THEN DO ICZ=0,6 ARCZAK(ICZ)=0D0 ENDDO ELSE ARCZAK(0)= 0.D0 ARCZAK(1)=-0.113D-3/3 ARCZAK(2)=-0.160D-3/3 ARCZAK(3)=-0.113D-3/3 ARCZAK(4)=-0.160D-3/3 ARCZAK(5)= 0.D0 ARCZAK(6)=-0.040D-3/3 ENDIF * CONSTZ=GMU*ZMASS**3/12.D0/PI/SQRT(2.D0) * IF(INF.LT.1.OR.INF.EQ.9.OR.INF.GT.10)THEN GAMZF=0D0 ELSE * RAT=0D0 SQR=1D0 IF(INF.LE.4)THEN RAT=AML(INDL(INF))**2/AMZ2 ELSEIF(INF.NE.9.AND. & INF.GT.4.AND.ABS(QCDCOR((MAX(0,2*INDQ(INF)-1)))-1).LT.1D-8) THEN RAT=AMQ(INDQ(INF))**2/AMZ2 ENDIF SQR=SQRT(1D0-4D0*RAT) IF(INF.EQ.9) SQR=0D0 * IF(INF.LE.4.OR. + ABS(QCDCOR((MAX(0,2*INDQ(INF)-1)))-1).LT.1D-8) THEN RQCDV=1D0+0.75D0*CALQED/PI*AQFI(INF)**2 RQCDA=RQCDV ELSE RQCDV=QCDCOR(MAX(0,2*INDQ(INF)-1)) RQCDA=QCDCOR(MAX(0,2*INDQ(INF) )) ENDIF * IF (IFLAGS(IFMISC).EQ.0) THEN * *** unscaled rhos (usual definition, e.g., PCP) RKIMAG=AIVEFZ(IDF) ELSE * *** scaled (to have simple formula without IMs) RKIMAG=0D0 ENDIF * GAM1I=CONSTZ*4D0*SQR*( & (1D0+2D0*RAT)*(RQCDV*(GVF**2+(GAF*RKIMAG)**2) & +RQCDA*GAF**2)/2D0 & -3D0*RAT*RQCDA*GAF**2) * * Add CZAK correction * GAM1I=GAM1I+ICZAK*ARCZAK(INDQ(INF)) * * Colour factor * GAMZF=GAM1I*MCOLFZ(INF) * END IF * RETURN END