* * THIS IS TOPAZ0 VERSION 4.4 * 26/7/1999 * * !!! Link with NAGLIB !!! * *-------------------------------------------------------------------------- * * 16/3/1999 New * * The code runs regardless of whether s0 or Eth (effectively) * impose an acol cut tighter than the value acol-cut the users specify. * (M.Grunewald) * *-------------------------------------------------------------------------- * * 21/5/1999 New * * FSR has been updated for the setup where both fermion and anti-fermion * are within the same angular acceptance (function TWOC) * (M.Grunewald, J.Mnich) * *-------------------------------------------------------------------------- * * 3/6/1999 A small change * In subroutine TEPAIRS the arrays WRKSTRV,WRKSTRS,WRKSTRH only used in * the calls to D01EAF have been reduced to one (WRKSTR). * (M.Grunewald, J.Mnich) * *-------------------------------------------------------------------------- * * 21/6/1999 * * The code runs regardless of whether s0 or Eth (effectively) * impose an acol cut tighter than the value acol-cut the users specify. * A bug on tau variables, introduced on 16/3/1999 is fixed. * *-------------------------------------------------------------------------- * * 23/6/1999 * * There was a complaint about getting the following message * * ** MAXCLS too small to obtain required accuracy * ** ABNORMAL EXIT from NAG Library routine D01EAF: IFAIL = 1 * ** NAG soft failure - control returned * D01EAF CALLED BY `ROUTINENAME' * * This is only a soft exit from NAG with control returned and no effect, * it is useful for the author. A new flag has been introduced * that prevents NAGLIB from printing messages (it corresponds to NAG * flag IFAIL= 1, instead of IFAIL= -1) * *--------------------------------------------------------------------------- * * 30/6/1999 * * Compilation bugs fixed (J.Mnich) * *--------------------------------------------------------------------------- * * 26/7/199 * ONP = I, improved with third order radiator * *--------------------------------------------------------------------------- * SUBROUTINE TCOPT(OU0N,OU1N,OU2N,OU3N,OU4N,OU5N,OU6N,OU7N,OU8N) CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 OU0N,OU1N,OU2N,OU3N,OU4N,OU5N,OU6N,OU7N,OU8N * COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 * OU0= OU0N OU1= OU1N OU2= OU2N OU3= OU3N OU4= OU4N OU5= OU5N OU6= OU6N OU7= OU7N OU8= OU8N * RETURN END * *-------------------------------------------------------------------- * SUBROUTINE TCAQED(ALPHAN) IMPLICIT REAL*8 (A-H,O-Z) * COMMON/TALEM/OVNAL * OVNAL= ALPHAN * RETURN END * *-------------------------------------------------------------------- * SUBROUTINE TCGF(GFN) IMPLICIT REAL*8 (A-H,O-Z) * COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS * GF= GFN/SQRT(2.D0) * RETURN END * *--------------------------------------------------------------------- * SUBROUTINE TCBQM(BQMN) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM * COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM * BQM= BQMN QBQM= BQMN*1.D15*1.Q-15 * RETURN END * *-----CFLAG------------------------------------------------------------------ * SUBROUTINE TCFLAG(OFLAG,OVAL) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*(*) OFLAG,OVAL CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 ONP,OWEAK,OEXT,OTHRE,OTHRMT,OCHAN,OFB,OCUTS,ONIF, # OHC,ORAD,OCREE,OCUTES,OAL,OAAS,OWBOX,OPWM,OFS,OCN, # OSP,OBHABHA,OREST,OLHO,OMA,OIMAG,OFM,OPREC,ONIFH, # OIFAIL,ORISPP CHARACTER*2 OCUT,OCUTF,OINDX,ONPAR CHARACTER*3 OPO CHARACTER*4 OMODES * PARAMETER(MNRS=30) * COMMON/TMF/OFM COMMON/TMA/OMA COMMON/THC/OHC COMMON/TP/OPREC COMMON/TOPO/OPO COMMON/TFSO/OFS COMMON/TOR/ORAD COMMON/TLHO/OLHO COMMON/TNP/ONPAR COMMON/TCALEM/OAL COMMON/TOPWM/OPWM COMMON/TCAAS/OAAS COMMON/TBOX/OWBOX COMMON/TIXS/OIMAG COMMON/TSUP/OMODES COMMON/TOHARDC/OCN COMMON/TCHAN/OCHAN COMMON/TALEM/OVNAL COMMON/TIFL/OIFAIL COMMON/TCUTF/OXCUTF COMMON/TCUTEC/OCREE COMMON/TSPEC/OSP,OFB COMMON/TRISPP/ORISPP COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TIFSRH/ONIFH(MNRS) COMMON/TOCUTF/OCUTF(MNRS) COMMON/TCCUTE/OCUTES(MNRS) COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 * IF(OFLAG.EQ.'OEXT') THEN OEXT= OVAL ELSE IF(OFLAG.EQ.'OTHRMT') THEN OTHRMT= OVAL ELSE IF(OFLAG.EQ.'OTHRE') THEN OTHRE= OVAL ELSE IF(OFLAG.EQ.'OCHAN') THEN OCHAN= OVAL ELSE IF(OFLAG.EQ.'OAL') THEN OAL= OVAL ELSE IF(OFLAG.EQ.'OU0') THEN OU0= OVAL ELSE IF(OFLAG.EQ.'OU1') THEN OU1= OVAL ELSE IF(OFLAG.EQ.'OU2') THEN OU2= OVAL ELSE IF(OFLAG.EQ.'OU3') THEN OU3= OVAL ELSE IF(OFLAG.EQ.'OU4') THEN OU4= OVAL ELSE IF(OFLAG.EQ.'OU5') THEN OU5= OVAL ELSE IF(OFLAG.EQ.'OU6') THEN OU6= OVAL ELSE IF(OFLAG.EQ.'OU7') THEN OU7= OVAL ELSE IF(OFLAG.EQ.'OU8') THEN OU8= OVAL ELSE IF(OFLAG.EQ.'OWEAK') THEN OWEAK= OVAL ELSE IF(OFLAG.EQ.'OFB') THEN OFB= OVAL ELSE IF(OFLAG.EQ.'OHC') THEN OHC= OVAL ELSE IF(OFLAG.EQ.'ORAD') THEN ORAD= OVAL ELSE IF(OFLAG.EQ.'OWBOX') THEN OWBOX= OVAL ELSE IF(OFLAG.EQ.'OPWM') THEN OPWM= OVAL ELSE IF(OFLAG.EQ.'OFS') THEN OFS= OVAL ELSE IF(OFLAG.EQ.'OCN') THEN OCN= OVAL ELSE IF(OFLAG.EQ.'OBHABHA') THEN OBHABHA= OVAL ELSE IF(OFLAG.EQ.'OREST') THEN OREST= OVAL ELSE IF(OFLAG.EQ.'OINDX') THEN OINDX= OVAL ELSE IF(OFLAG.EQ.'OLHO') THEN OLHO= OVAL ELSE IF(OFLAG.EQ.'OMA') THEN OMA= OVAL ELSE IF(OFLAG.EQ.'OIMAG') THEN OIMAG= OVAL ELSE IF(OFLAG.EQ.'ORISPP') THEN ORISPP= OVAL ELSE IF(OFLAG.EQ.'OMODES') THEN OMODES= OVAL ELSE IF(OFLAG.EQ.'OFM') THEN OFM= OVAL ELSE IF(OFLAG.EQ.'OPO') THEN OPO= OVAL ELSE IF(OFLAG.EQ.'ONPAR') THEN ONPAR= OVAL ELSE IF(OFLAG.EQ.'OAAS') THEN OAAS= OVAL ELSE IF(OFLAG.EQ.'OSP') THEN OSP= OVAL ELSE IF(OFLAG.EQ.'OCREE') THEN OCREE= OVAL ELSE IF(OFLAG.EQ.'OPREC') THEN OPREC= OVAL ELSE IF(OFLAG.EQ.'OIFAIL') THEN OIFAIL= OVAL ELSE IF(OFLAG.EQ.'ONP') THEN ONP(1)= OVAL DO I=2,MNRS ONP(I)= ONP(1) ENDDO ELSE IF(OFLAG.EQ.'OCUTS') THEN OCUTS(1)= OVAL DO I=2,MNRS OCUTS(I)= OCUTS(1) ENDDO ELSE IF(OFLAG.EQ.'OCUTES') THEN OCUTES(1)= OVAL DO I=2,MNRS OCUTES(I)= OCUTES(1) ENDDO ELSE IF(OFLAG.EQ.'ONIF') THEN ONIF(1)= OVAL DO I=2,MNRS ONIF(I)= ONIF(1) ENDDO ELSE IF(OFLAG.EQ.'ONIFH') THEN ONIFH(1)= OVAL DO I=2,MNRS ONIFH(I)= ONIFH(1) ENDDO ELSE IF(OFLAG.EQ.'OCUT') THEN OCUT(1)= OVAL DO I=2,MNRS OCUT(I)= OCUT(1) ENDDO ELSE IF(OFLAG.EQ.'OCUTF') THEN OCUTF(1)= OVAL DO I=2,MNRS OCUTF(I)= OCUTF(1) ENDDO ELSE WRITE(6,*) ' TOPFLAG: FLAG NOT RECOGNISED: ',OFLAG ENDIF * RETURN END * *-----CUTSET---------------------------------------------------------- * SUBROUTINE TCUTSET(IND,S0C,THMN,THMNP,ACLL,E0C,XCUT,XCUTF,XPCUT, # XSEPA) IMPLICIT REAL*8 (A-H,O-Z) * PARAMETER(NL=3) * COMMON/TSEP/SEPA COMMON/TPC/ZPCUT COMMON/TCUTF/OXCUTF COMMON/TCUT/OXCUT,OXCUTS COMMON/TLCUTS/S0CUT(NL),THMIN(NL),THMINP(NL),THMAX(NL),THMAXP(NL), # ACOLL(NL),E0(NL) * IF(S0C.GE.0.D0) THEN S0CUT(IND)= S0C ENDIF IF(THMN.GE.0.D0) THEN THMIN(IND)= THMN ENDIF IF(THMNP.GE.0.D0) THEN THMINP(IND)= THMNP ENDIF IF(ACLL.GE.0.D0) THEN ACOLL(IND)= ACLL ENDIF IF(E0C.GE.0.D0) THEN E0(IND)= E0C ENDIF IF(XSEPA.GT.0.D0) THEN SEPA= XSEPA ENDIF * IF(XCUT.GE.0.D0) THEN OXCUT= XCUT ENDIF IF(XCUTF.GE.0.D0) THEN OXCUTF= XCUTF ENDIF IF(XPCUT.GE.0.D0) THEN ZPCUT= XPCUT ENDIF * RETURN END * *----------------------------------------------------------------------- * SUBROUTINE TCINFO(MODE) * ************************************************************************ * * Dump info about TOPAZ0 flags and cuts (courtesy of M. Grunewald) * * Input: * * INTEGER MODE * =0 dump flags * =1 dump cuts * ************************************************************************ IMPLICIT REAL*8 (A-H,O-Z) * * *** Subr. Parameter * INTEGER MODE * * *** TOPAZ0 flags (see TCFLAG) * PARAMETER(MNRS=30) * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 ONP,OWEAK,OEXT,OTHRE,OTHRMT,OCHAN,OFB,OCUTS,ONIF, # OHC,ORAD,OCREE,OCUTES,OAL,OAAS,OWBOX,OPWM,OFS,OCN, # OSP,OBHABHA,OREST,OLHO,OMA,OIMAG,OFM,ONIFH,OPREC, # OIFAIL,ORISPP CHARACTER*2 OCUT,OCUTF,OINDX,ONPAR CHARACTER*3 OPO CHARACTER*4 OMODES * COMMON/TMF/OFM COMMON/TMA/OMA COMMON/THC/OHC COMMON/TOPO/OPO COMMON/TP/OPREC COMMON/TFSO/OFS COMMON/TOR/ORAD COMMON/TLHO/OLHO COMMON/TSEP/SEPA COMMON/TNP/ONPAR COMMON/TCALEM/OAL COMMON/TOPWM/OPWM COMMON/TCAAS/OAAS COMMON/TBOX/OWBOX COMMON/TIXS/OIMAG COMMON/TCNRS0/NRS0 COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TOHARDC/OCN COMMON/TCHAN/OCHAN COMMON/TALEM/OVNAL COMMON/TCUTEC/OCREE COMMON/TSPEC/OSP,OFB COMMON/TRISPP/ORISPP COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TIFSRH/ONIFH(MNRS) COMMON/TOCUTF/OCUTF(MNRS) COMMON/TCCUTE/OCUTES(MNRS) COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 * * *** TOPAZ0 cuts (see TCUTSET) * PARAMETER(NL=3) * COMMON/TCUT/OXCUT,OXCUTS COMMON/TCUTE/OXCUTES COMMON/TCUTF/OXCUTF COMMON/TPC/ZPCUT COMMON/THARDC/DEL COMMON/TLCUTS/S0CUT(NL),THMIN(NL),THMINP(NL),THMAX(NL),THMAXP(NL), # ACOLL(NL),E0(NL) * * *** TOPAZ0 misc * COMMON/TAAS/SC COMMON/TESC/SE COMMON/TMED/XMED * *----------------------------------------------------------------------- * IF (MODE.EQ.0)THEN PRINT* PRINT*,'TOPAZ0 flag values:' PRINT* PRINT 1,'General flags:', # 'OEXT ',OEXT, # 'OTHRMT ',OTHRMT, # 'OTHRE ',OTHRE, # 'OCHAN ',OCHAN, # 'OAL ',OAL, # 'OWEAK ',OWEAK, # 'OFB ',OFB, # 'OHC ',OHC, # 'ORAD ',ORAD, # 'OWBOX ',OWBOX, # 'OPWM ',OPWM, # 'OFS ',OFS, # 'OCN ',OCN, # 'OBHABHA',OBHABHA, # 'OREST ',OREST, # 'OINDX ',OINDX, # 'OLHO ',OLHO, # 'OMA ',OMA, # 'OIMAG ',OIMAG, # 'OMODES ',OMODES, # 'OFM ',OFM, # 'OPO ',OPO, # 'ONPAR ',ONPAR, # 'OAAS ',OAAS, # 'OSP ',OSP, # 'OCREE ',OCREE, # 'OPREC ',OPREC, # 'OIFAIL ',OIFAIL, # 'ORISPP ',ORISPP 1 FORMAT(1X,A,8(/,4(1X,A7,': ',A4,1X))) PRINT* PRINT*,'General flag arrays:' PRINT 2,'ONP ',(ONP (I),I=1,NRS0) PRINT 2,'OCUTS ',(OCUTS (I),I=1,NRS0) PRINT 2,'OCUTES ',(OCUTES(I),I=1,NRS0) PRINT 2,'ONIF ',(ONIF (I),I=1,NRS0) PRINT 2,'ONIFH ',(ONIFH (I),I=1,NRS0) PRINT 2,'OCUT ',(OCUT (I),I=1,NRS0) PRINT 2,'OCUTF ',(OCUTF (I),I=1,NRS0) 2 FORMAT(1X,A7,': ',30(A2,1X)) PRINT* PRINT 3,'Special flags:', # 'OU0 ',OU0, # 'OU1 ',OU1, # 'OU2 ',OU2, # 'OU3 ',OU3, # 'OU4 ',OU4, # 'OU5 ',OU5, # 'OU6 ',OU6, # 'OU7 ',OU7, # 'OU8 ',OU8 3 FORMAT(1X,A,2(/,5(1X,A4,': ',A1,1X))) PRINT* PRINT 4,'Miscellaneous:', # 'SC ',SC, # 'SE ',SE, # 'XMED',XMED 4 FORMAT(1X,A,/,3(1X,A4,': ',F12.6,1X)) PRINT* ELSE IF (MODE.EQ.1) THEN PRINT* PRINT*,'TOPAZ0 cut values:' PRINT* PRINT 6,'General cuts:', # 'OXCUT ',OXCUT, # 'OXCUTF ',OXCUTF, # 'OXCUTES',OXCUTES, # 'OXCUTS ',OXCUTS, # 'ZPCUT ',ZPCUT, # 'DEL ',DEL, # 'SEPA ',SEPA 6 FORMAT(1X,A,3(/,2(1X,A7,': ',F14.8,1X))) PRINT* PRINT 7,'Lepton:','Electron','Muon','Tau' 7 FORMAT(1X,A,3(1X,A14,1X)) PRINT 8,'S0CUT ',(S0CUT (I),I=1,NL) PRINT 8,'THMIN ',(THMIN (I),I=1,NL) PRINT 8,'THMINP ',(THMINP(I),I=1,NL) PRINT 8,'ACOLL ',(ACOLL (I),I=1,NL) PRINT 8,'E0 ',(E0 (I),I=1,NL) 8 FORMAT(1X,A,3(1X,F14.8,1X)) PRINT* ENDIF * RETURN END * *-----INIT------------------------------------------------------------------ * SUBROUTINE TINIT(NRTS,OSETUP) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,KM,MM2,NM2 * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 ONP,OWEAK,OEXT,OTHRE,OTHRMT,OCHAN,OFB,OCUTS,ONIF, # OHC,ORAD,OCREE,OCUTES,OAL,OAAS,OWBOX,OPWM,OFS,OCN, # OSETUP,OSP,OBHABHA,OREST,OLHO,OMA,OIMAG,OFM,OPREC, # ONIFH,OIFAIL,ORISPP CHARACTER*2 OCUT,OCUTF,OINDX,ONPAR CHARACTER*3 OPO CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3) * COMMON/TMF/OFM COMMON/TAAS/SC COMMON/TMA/OMA COMMON/THC/OHC COMMON/TFSO/OFS COMMON/TOR/ORAD COMMON/TOPO/OPO COMMON/TP/OPREC COMMON/TNP/ONPAR COMMON/TLHO/OLHO COMMON/TPC/ZPCUT COMMON/TMED/XMED COMMON/TSEP/SEPA COMMON/THARDC/DEL COMMON/TIXS/OIMAG COMMON/TCALEM/OAL COMMON/TOPWM/OPWM COMMON/TCAAS/OAAS COMMON/TBOX/OWBOX COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TOHARDC/OCN COMMON/TCHAN/OCHAN COMMON/TALEM/OVNAL COMMON/TCUTF/OXCUTF COMMON/TCUTEC/OCREE COMMON/TRISPP/ORISPP COMMON/TSPEC/OSP,OFB COMMON/TCUTE/OXCUTES COMMON/TICOUPLING/NF COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TCUT/OXCUT,OXCUTS COMMON/TIFSRH/ONIFH(MNRS) COMMON/TOCUTF/OCUTF(MNRS) COMMON/THMASS/PIM,KM,DM,BM COMMON/TCCUTE/OCUTES(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TNUMC/SCS2,SCD3,SCB4 COMMON/TQVARIA/QALPHA,QSLLC COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TLCUTS/S0CUT(NL),THMIN(NL),THMINP(NL),THMAX(NL),THMAXP(NL), # ACOLL(NL),E0(NL) * NRS= NRTS+1 * *-----DELTA(QDELTA) TAKES CARE OF THE UV INFINITIES * QDELTA= 9.025809333Q0 QEPS= 1.Q-90 QPI= 3.141592653589793238462643Q0 QALPHA= 1.Q0/137.0359895Q0 * PI= 3.141592653589793238462643D0 CONV= 0.38937966D6 * *-----GF IS THE FERMI COUPLING CONSTANT (BEWARE OF THE DEFINITION) * RS0 IS THE REFERENCE ENERGY FOR ALPHA_S | FIXED TO M_Z !!!! * NF IS THE NUMBER OF ACTIVE FLAVORS * ALPHA= 1.D0/137.0359895D0 * * INTRODUCED OCTOBER 98, AFTER STUART * GF= 1.16637D-5/SQRT(2.D0) NF= 5 * *-----FERMION MASSES: THEY ARE PDG '98 * EM= 0.51099907D-3 MM= 0.105658389D0 NM= 1.D-10 TLM= 1.77705D0 UQM= 0.041D0 DQM= 0.041D0 CQM= 1.5D0 SQM= 0.15D0 BQM= 4.7D0 * QEM= 0.51099907Q-3 QMM= 0.105658389Q0 QNM= 1.Q-10 QTM= 1.77705Q0 QUQM= 0.041Q0 QDQM= 0.041Q0 QCQM= 1.5Q0 QSQM= 0.15Q0 QBQM= 4.7Q0 * PIM= 0.1395675D0 KM= 0.493646D0 DM= 1.8693D0 BM= 5.2776D0 * *-----FERMION QUANTUM NUMBERS * BQL= -1.D0 BQN= 0.D0 ZIU= 0.5D0 ZID= -0.5D0 BQDQ= -1.D0/3.D0 BQUQ= 2.D0/3.D0 * *-----COEFF. FOR THE RUNNING OF ALPHA IN THE S-CHANNEL AND IN THE * T-CHANNEL. UPDATED WITH A NEW FIT NOVEMBER 98 * CSAL(1,1)= 0.10002912D+00 CSAL(1,2)= -0.54465023D-02 CSAL(1,3)= -0.85641368D+00 CSAL(1,4)= -0.83236837D-02 CSAL(1,5)= -0.27317322D-03 CTAL(1,1)= 0.10892558D+00 CTAL(1,2)= -0.50670526D-02 CTAL(1,3)= -0.83115092D+00 CTAL(1,4)= 0.19767778D-01 CTAL(1,5)= 0.27516096D-03 * CSAL(2,1)= 0.80108195D-01 CSAL(2,2)= -0.53750224D-02 CSAL(2,3)= -0.41383641D+00 CSAL(2,4)= -0.46722152D-03 CSAL(2,5)= -0.27877535D-03 CTAL(2,1)= 0.10430147D+00 CTAL(2,2)= -0.52912297D-02 CTAL(2,3)= -0.85571829D+00 CTAL(2,4)= 0.41409754D-03 CTAL(2,5)= 0.27093793D-03 * CSAL(3,1)= 0.14059933D+00 CSAL(3,2)= -0.52683868D-02 CSAL(3,3)= 0.43863253D+01 CSAL(3,4)= -0.19252960D-03 CSAL(3,5)= -0.28677302D-03 CTAL(3,1)= 0.78129140D-01 CTAL(3,2)= -0.52945704D-02 CTAL(3,3)= 0.34743961D+00 CTAL(3,4)= 0.17461523D-03 CTAL(3,5)= 0.26416830D-03 * CSAL(4,1)= 0.15973767D+00 CSAL(4,2)= -0.52772607D-02 CSAL(4,3)= -0.13156147D+02 CSAL(4,4)= -0.24944155D-03 CSAL(4,5)= -0.30091274D-03 CTAL(4,1)= 0.14564790D+00 CTAL(4,2)= -0.52855820D-02 CTAL(4,3)= 0.59563789D+01 CTAL(4,4)= 0.18420482D-03 CTAL(4,5)= 0.25365348D-03 * CSAL(5,1)= 0.19125659D+00 CSAL(5,2)= -0.52764514D-02 CSAL(5,3)= 0.10658963D+03 CSAL(5,4)= -0.27430909D-03 CSAL(5,5)= -0.32355363D-03 CTAL(5,1)= 0.10378970D+00 CTAL(5,2)= -0.52825789D-02 CTAL(5,3)= -0.82019461D+00 CTAL(5,4)= 0.17303513D-03 CTAL(5,5)= 0.24056199D-03 * *-----RIEMANN Z-FUNCTIONS * EGAM= 0.577215664901533D0 RZ3= 1.20205690315959428540D0 RA4= 0.5174790617D0 RZ5= 1.03692775514336992633D0 SCS2= 0.260434137632162099D0 SCD3= -3.027009493987652020D0 SCB4= -1.762800087073770086D0 * *-----INITIALIZATION OF SHARABLE VARIABLES * QPIS= QPI*QPI PIS= PI*PI RZ2= PIS/6.D0 FPI= 4.D0*PI AEXP= ALPHA/FPI API= ALPHA/PI TAEXP= 2.D0*AEXP QSLLC= 1.Q0+3.Q0/4.Q0*QALPHA/QPI HOF= 19.D0-2.D0*PIS APIS= API*API * *-----FERMION MASSES * EM2= EM*EM MM2= MM*MM TLM2= TLM*TLM NM2= NM*NM UQM2= UQM*UQM DQM2= DQM*DQM CQM2= CQM*CQM SQM2= SQM*SQM BQM2= BQM*BQM * QEM2= QEM*QEM QMM2= QMM*QMM QTM2= QTM*QTM QNM2= QNM*QNM QUQM2= QUQM*QUQM QDQM2= QDQM*QDQM QCQM2= QCQM*QCQM QSQM2= QSQM*QSQM QBQM2= QBQM*QBQM * *-----RUNNING FLAGS DEFAULT * OEXT= OSETUP OMODES= 'CALC' ONPAR= 'FP' OFM= 'U' OWEAK= 'R' OPWM= 'F' OWBOX= 'Y' OHC= 'Y' ORAD= 'F' XMED= 0.98D0 OAL= 'D' OVNAL= 0.D0 OAAS= 'N' SC= 1.D0 OCN= 'Y' DEL= 0.5D0 OFS= 'Z' OBHABHA= 'N' OREST= 'E' OLHO= 'Y' OMA= 'N' OIMAG= 'Y' ORISPP= 'T' OIFAIL= 'N' OPO= 'ORT' OINDX= 'NO' OPREC= 'H' ONP(1)= 'N' ONIF(1)= 'N' ONIFH(1)= 'N' SEPA= 16.D0 DO I=2,NRS ONP(I)= ONP(1) ONIF(I)= ONIF(1) ONIFH(I)= ONIFH(1) ENDDO DO I=NRS+1,MNRS ONP(I)= 'V' ONIF(I)= 'V' ONIFH(I)= 'V' ENDDO OU0= 'S' OU1= 'Y' OU2= 'N' OU3= 'Y' OU4= 'N' OU5= 'Y' OU6= 'Y' OU7= 'N' OU8= 'C' * ZPCUT= 0.01D0 IF(OEXT.EQ.'E'.OR.OEXT.EQ.'P') THEN OCUT(1)= 'FC' OCUTF(1)= 'NC' DO I=2,NRS OCUT(I)= OCUT(1) OCUTF(I)= OCUTF(1) ENDDO DO I=NRS+1,MNRS OCUT(I)= 'VV' OCUTF(I)= 'VV' ENDDO OFB= 'N' OCHAN= 'S' OXCUT= 0.01D0 OXCUTF= 0.01D0 OTHRE= 'E' OTHRMT= 'E' IF(OTHRE.EQ.'E') THEN E0(1)= 1.D0 ELSE IF(OTHRE.EQ.'M') THEN S0CUT(1)= 10.D0 ENDIF THMIN(1)= 44.D0 THMINP(1)= 0.D0 ACOLL(1)= 10.D0 IF(OTHRMT.EQ.'M') THEN DO I=2,3 S0CUT(I)= 10.D0 THMIN(I)= 40.D0 THMINP(I)= 0.D0 ACOLL(I)= 10.D0 ENDDO ELSE IF(OTHRMT.EQ.'E') THEN DO I=2,3 E0(I)= 1.D0 THMIN(I)= 40.D0 THMINP(I)= 0.D0 ACOLL(I)= 10.D0 ENDDO ENDIF OCREE= 'N' DO I=1,NRS OCUTS(I)= 'N' ENDDO DO I=NRS+1,MNRS OCUTS(I)= 'V' ENDDO DO I=1,NRS OCUTES(I)= 'N' ENDDO DO I=NRS+1,MNRS OCUTES(I)= 'V' ENDDO ELSE IF(OEXT.EQ.'C') THEN OCUT(1)= 'HC' OCUTF(1)= 'NC' DO I=2,NRS OCUT(I)= OCUT(1) OCUTF(I)= OCUTF(1) ENDDO DO I=NRS+1,MNRS OCUT(I)= 'VV' OCUTF(I)= 'VV' ENDDO OFB= 'N' DO I=1,NRS OCUTS(I)= 'N' ENDDO DO I=NRS+1,MNRS OCUTS(I)= 'V' ENDDO OXCUTS= 0.D0 OCHAN= 'S' OXCUT= 0.01D0 OXCUTF= 4.D-7 OTHRMT= 'E' IF(OTHRMT.EQ.'E') THEN DO I=2,3 E0(I)= 1.D0 ENDDO ELSE IF(OTHRMT.EQ.'M') THEN DO I=2,3 S0CUT(I)= 10.D0 ENDDO ENDIF DO I=2,3 THMIN(I)= 40.D0 THMINP(I)= 0.D0 ACOLL(I)= 10.D0 ENDDO OSP= 'N' OCREE= 'N' DO I=1,NRS OCUTES(I)= 'N' ENDDO DO I=NRS+1,MNRS OCUTES(I)= 'V' ENDDO OXCUTES= 0.01D0 OTHRE= 'E' IF(OTHRE.EQ.'E') THEN E0(1)= 1.D0 ELSE IF(OTHRE.EQ.'M') THEN S0CUT(1)= 10.D0 ENDIF THMIN(1)= 40.D0 THMINP(1)= 0.D0 ACOLL(1)= 10.D0 ENDIF * RETURN END * *----- RESULTS ARE STORED IN ARRAY OTPPO(34), OTPRO(26*NRS) * * PO ARE * * W MASS * G_NU * G_ELECTRON * G_MUON * G_TAU * G_UP * G_DOWN(STRANGE) * G_CHARM * G_BOTTOM * SIN^2(E) * SIN^2(B) * A_FB(L) * A_LR * TOTAL WIDTH * G_H/G_E * SIGMA0_H * R_B * A_FB(B) * HADRONIC WIDTH * INVISIBLE * A_FB(C) * R_C * A_LR(B) * A_LR(C) * SIN^2(C) * RHO(E) * RHO(C) * RHO(B) * 1/ALPHA^5 * 1/ALPHA * SIGMA0_L * ALPHA_S(M_T) * G_H/G_MU * G_H/G_TAU * * RO ARE * * SIGMA(E), DELTA(SIGMA(E)) * SIGMA(MU), DELTA(SIGMA(MU)) * SIGMA(TAU), DELTA(SIGMA(TAU)) * SIGMA(HAD), DELTA(SIGMA(HAD)) * SIGMA(B), DELTA(SIGMA(B)) * R_B, DELTA(R_B) * SIGMA(C), DELTA(SIGMA(C)) * R_C, DELTA(R_C) * A_FB(E), DELTA(A_FB(E)) * A_FB(MU), DELTA(A_FB(MU)) * A_FB(TAU), DELTA(A_FB(TAU)) * A_FB(C), DELTA(A_FB(C)) * A_FB(B), DELTA(A_FB(B)) * *-----TOPAZ0------------------------------------------------------------ * * UPDATED AND UPGRADED OCTOBER-DECEMBER 98. * INFORMATIONS ON DE-CONVOLUTED RO ARE STORED IN ARRAY OTPDRO. * SUBROUTINE TOPAZ0(SEP,NRTS,RTS,ZMT,TQMT,HMT,ALST, # OTPPO,OTPRO,OTPDRO) IMPLICIT REAL*8(A-H,O-Z) * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 ONP,OWEAK,OEXT,OTHRE,OTHRMT,OCHAN,OSP,OFB,OTHRMT0, # OTHRE0,OFB0,OCUTS,ONIF,OHC,ORAD,OCREE,OCUTES,OAL, # OAAS,OWBOX,OPWM,OFS,OCN,OBHABHA,OREST,OFM,ONIFH CHARACTER*2 OCUT,OCUTF,OINDX,ONPAR CHARACTER*4 OMODES * PARAMETER(MNDEC=4,MNRS=30,MNVAR=4*MNRS,MNVAR2=MNVAR*MNVAR, # NOBS=11,MNFN=MNRS*NOBS,NL=3,NIN=20,NPO=34) PARAMETER(NFIT=7*MNRS) * COMMON/TK/IFK COMMON/TMF/OFM COMMON/TESC/SE COMMON/TAAS/SC COMMON/THC/OHC COMMON/TFSO/OFS COMMON/TIBOX/NB COMMON/TOR/ORAD COMMON/TNP/ONPAR COMMON/TPC/ZPCUT COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/THARDC/DEL COMMON/TCALEM/OAL COMMON/TOPWM/OPWM COMMON/TCAAS/OAAS COMMON/TBOX/OWBOX COMMON/TCNRS0/NRS0 COMMON/TOHARDC/OCN COMMON/TCHAN/OCHAN COMMON/TALEM/OVNAL COMMON/TSUP/OMODES COMMON/TFITO/APO(9) COMMON/TCUTF/OXCUTF COMMON/TCUTEC/OCREE COMMON/TECM/RS(MNRS) COMMON/TSPEC/OSP,OFB COMMON/TCUTE/OXCUTES COMMON/TFIT/FIT(NFIT) COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TTABOBS/TAB(NPO) COMMON/TCUT/OXCUT,OXCUTS COMMON/TOCUTF/OCUTF(MNRS) COMMON/TIFSRH/ONIFH(MNRS) COMMON/TCCUTE/OCUTES(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TSCALE/ZM,TQM,HM,CALS COMMON/TBQ/SBT(MNRS),ESBT(MNRS) COMMON/TCQ/SCT(MNRS),ESCT(MNRS) COMMON/TSPEC0/OFB0,OTHRMT0,OTHRE0 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TDEC/DECXSMU(MNRS),DECXSU(MNRS),DECXSD(MNRS), # DECXSC(MNRS),DECXSS(MNRS),DECXSB(MNRS), # DECASMU(MNRS),DECASC(MNRS),DECASB(MNRS) COMMON/TDDEC/DDECXSMU(MNRS),DDECXSU(MNRS),DDECXSD(MNRS), # DDECXSC(MNRS),DDECXSS(MNRS),DDECXSB(MNRS), # DDECASMU(MNRS),DDECASC(MNRS),DDECASB(MNRS) COMMON/TDDDEC/DDDECXSMU(MNRS),DDDECXSU(MNRS),DDDECXSD(MNRS), # DDDECXSC(MNRS),DDDECXSS(MNRS),DDDECXSB(MNRS), # DDDECASMU(MNRS),DDDECASC(MNRS),DDDECASB(MNRS) COMMON/TZZEC/ZZECXSMU(MNRS),ZZECXSU(MNRS),ZZECXSD(MNRS), # ZZECXSC(MNRS),ZZECXSS(MNRS),ZZECXSB(MNRS), # ZZECASMU(MNRS),ZZECASC(MNRS),ZZECASB(MNRS) COMMON/TWIEC/WIECXSMU(MNRS),WIECXSU(MNRS),WIECXSD(MNRS), # WIECXSC(MNRS),WIECXSS(MNRS),WIECXSB(MNRS), # WIECASMU(MNRS),WIECASC(MNRS),WIECASB(MNRS) COMMON/TQAFBTH/ACT(MNRS),ABT(MNRS),EACT(MNRS),EABT(MNRS) COMMON/TTH/SET(MNRS),AET(MNRS),SMUT(MNRS),AMUT(MNRS),STAUT(MNRS), # ATAUT(MNRS),SHADT(MNRS),ESET(MNRS),EAET(MNRS), # ESMUT(MNRS),EAMUT(MNRS),ESTAUT(MNRS),EATAUT(MNRS), # ESHADT(MNRS) COMMON/TEXP/SEE(MNRS),AEE(MNRS),SMUE(MNRS),AMUE(MNRS),STAUE(MNRS), # ATAUE(MNRS),SHADE(MNRS) COMMON/TERR/ESE(MNRS),EAE(MNRS),ESMU(MNRS),EAMU(MNRS),ESTAU(MNRS), # EATAU(MNRS),ESHAD(MNRS) COMMON/TLCUTS/S0CUT(NL),THMIN(NL),THMINP(NL),THMAX(NL),THMAXP(NL), # ACOLL(NL),E0(NL) * DIMENSION RTS(NRTS) DIMENSION OTPPO(NPO),OTPRO(26*NRTS),OTPDRO(5,9,MNRS), # OTPROD(9,MNRS),OTPRODD(9,MNRS),OTPRODDD(9,MNRS), # OTPROZZ(9,MNRS),OTPROWI(9,MNRS) DIMENSION SIGF0(MNFN),AEST0(MNFN),SIGF1(MNFN),AEST1(MNFN), # BRAT(MNRS),EBRAT(MNRS),CRAT(MNRS),ECRAT(MNRS) * *-----STARTS THE INITIALIZATION OF THE INPUT VARIABLES * IF(OMODES.EQ.'CALC') THEN DO LL=1,9 APO(LL)= 0.D0 ENDDO ENDIF * IF(OMODES.NE.'CALC') THEN IF(OEXT.NE.'E'.AND.OWEAK.NE.'R'.AND. # OCUTF(1).NE.'NC') THEN PRINT*,' WRONG SETUP FOR FIT ' STOP ENDIF ENDIF * SE= SEP NRS= NRTS+1 NRS0= NRTS NRO= 26*NRTS DO I=1,NRTS RS(I)= RTS(I) ENDDO IF(OMODES.EQ.'FITE'.OR.OMODES.EQ.'FITC') THEN RS(NRS)= APO(1) ELSE RS(NRS)= ZMT ENDIF DO I=NRS+1,MNRS RS(I)= 0.D0 ENDDO DO I=1,NPO OTPPO(I)= 0.D0 ENDDO DO I=1,NRO OTPRO(I)= 0.D0 ENDDO DO I=1,9 DO J=1,MNRS OTPROD(I,J)= 0.D0 OTPRODD(I,J)= 0.D0 OTPRODD(I,J)= 0.D0 OTPROZZ(I,J)= 0.D0 OTPROWI(I,J)= 0.D0 ENDDO ENDDO IF(OHC.EQ.'N') THEN ORAD= 'A' ENDIF * DO J=1,MNRS SET(J)= 0.D0 AET(J)= 0.D0 SMUT(J)= 0.D0 AMUT(J)= 0.D0 STAUT(J)= 0.D0 ATAUT(J)= 0.D0 SHADT(J)= 0.D0 ESET(J)= 0.D0 EAET(J)= 0.D0 ESMUT(J)= 0.D0 EAMUT(J)= 0.D0 ESTAUT(J)= 0.D0 EATAUT(J)= 0.D0 ESHADT(J)= 0.D0 ENDDO * *-----UPDATED VALUE FOR ALPHA_EM: * IF(OAL.EQ.'D') THEN OVNAL= 0.D0 ENDIF * IF(OAAS.EQ.'N') THEN SC= 1.D0 ENDIF * IF(OEXT.EQ.'P') THEN NB= 1 ELSE IF(OEXT.EQ.'E') THEN IF(OMODES.EQ.'FITC') THEN NB= 0 ELSE NB= 1 ENDIF ELSE IF(OEXT.EQ.'C') THEN NB= 0 ENDIF OFB0= OFB OTHRMT0= OTHRMT OTHRE0= OTHRE IF(OXCUTF.GT.OXCUT) THEN PRINT*,' M^2 MUST BE < S_0 ' STOP ENDIF IF(OCUTF(1).NE.'NC'.AND.XMED.GE.(1.D0-OXCUTF)) THEN XMED= 1.D0-OXCUTF-0.01D0 ENDIF IF(OBHABHA.NE.'N'.AND.OEXT.NE.'E') THEN IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN CONTINUE ELSE PRINT*,' WRONG SETUP FOR OBHABHA' STOP ENDIF ENDIF OSP= 'N' * IF((OEXT.EQ.'E'.OR.OEXT.EQ.'P').AND.OCHAN.EQ.'S') THEN IF(OCREE.EQ.'N') THEN DO I=1,NRS OCUTES(I)= 'N' ENDDO ENDIF ELSE OCREE= 'N' DO I=1,NRS OCUTES(I)= 'N' ENDDO OXCUTES= 0.01D0 ENDIF OTHRE0= OTHRE IF(OCREE.EQ.'Y'.AND.(THMIN(1).NE.0.D0.OR.THMINP(1).NE.0.D0. # OR.ACOLL(1).NE.180.D0.OR.OTHRE.NE.'M')) THEN PRINT*,' THIS OPTION IS NOT ALLOWED UNLESS THE SETUP IS ' PRINT*,' FULLY EXTRAPOLATED ' STOP ENDIF * IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'HA') THEN NFN= 4*NRS ELSE NFN= 2*NRS ENDIF ELSE NFN= 10*NRS ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN NFN= 4*NRS ELSE IF(OEXT.EQ.'E'.OR.OEXT.EQ.'P') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'NO') THEN NFN= NOBS*NRS ELSE IF(OINDX.EQ.'HA') THEN NFN= 5*NRS ELSE NFN= 2*NRS ENDIF ELSE NFN= NRS*NOBS ENDIF ELSE IF(OEXT.EQ.'C') THEN NFN= NRS*(NOBS-4) ENDIF ENDIF * ZM= ZMT TQM= TQMT HM= HMT ALS= ALST CALS= ALST RS0= ZM DELTA= 2.D0*LOG(ZM) * CALL TWIDTHO(ZM,TQM,HM,ALS,WT) DO I=1,NPO OTPPO(I)= TAB(I) ENDDO IF(OEXT.EQ.'P') THEN RETURN ENDIF IF(OMODES.EQ.'FITE'.OR.OMODES.EQ.'FITC') THEN CALL TWIDTHO(APO(1),TQM,HM,ALS,WT) CALL TPO(APO) RS0= APO(1) DELTA= 2.D0*LOG(APO(1)) IF(OMODES.EQ.'FITC'.AND.OBHABHA.NE.'N') THEN CONTINUE ELSE CALL TEWFIT(NRS,NFN,SIGF0,SIGF1,AEST0,AEST1) ENDIF IF(OMODES.EQ.'FITC') THEN IFK= 0 CALL TEWCUT(NRS) ENDIF DO IT=1,7 DO IF=1,NRS K= NRS*(IT-1)+IF IF(IT.EQ.1) THEN FIT(K)= SET(IF) ELSE IF(IT.EQ.2) THEN FIT(K)= SMUT(IF) ELSE IF(IT.EQ.3) THEN FIT(K)= STAUT(IF) ELSE IF(IT.EQ.4) THEN FIT(K)= SHADT(IF) ELSE IF(IT.EQ.5) THEN FIT(K)= AET(IF) ELSE IF(IT.EQ.6) THEN FIT(K)= AMUT(IF) ELSE IF(IT.EQ.7) THEN FIT(K)= ATAUT(IF) ENDIF ENDDO ENDDO RETURN ENDIF * KPR= 1 IF(OBHABHA.EQ.'N') THEN CALL TEWEXT(KPR,NRS,NFN,SIGF0,SIGF1,AEST0,AEST1) IF(OEXT.EQ.'E') THEN DO J=1,NRTS OTPROD(1,J)= DECXSMU(J) OTPROD(2,J)= DECXSU(J) OTPROD(3,J)= DECXSD(J) OTPROD(4,J)= DECXSC(J) OTPROD(5,J)= DECXSS(J) OTPROD(6,J)= DECXSB(J) OTPROD(7,J)= DECASMU(J) OTPROD(8,J)= DECASC(J) OTPROD(9,J)= DECASB(J) ENDDO DO J=1,NRTS OTPRODD(1,J)= DDECXSMU(J) OTPRODD(2,J)= DDECXSU(J) OTPRODD(3,J)= DDECXSD(J) OTPRODD(4,J)= DDECXSC(J) OTPRODD(5,J)= DDECXSS(J) OTPRODD(6,J)= DDECXSB(J) OTPRODD(7,J)= DDECASMU(J) OTPRODD(8,J)= DDECASC(J) OTPRODD(9,J)= DDECASB(J) ENDDO DO J=1,NRTS OTPRODDD(1,J)= DDDECXSMU(J) OTPRODDD(2,J)= DDDECXSU(J) OTPRODDD(3,J)= DDDECXSD(J) OTPRODDD(4,J)= DDDECXSC(J) OTPRODDD(5,J)= DDDECXSS(J) OTPRODDD(6,J)= DDDECXSB(J) OTPRODDD(7,J)= DDDECASMU(J) OTPRODDD(8,J)= DDDECASC(J) OTPRODDD(9,J)= DDDECASB(J) ENDDO DO J=1,NRTS OTPROZZ(1,J)= ZZECXSMU(J) OTPROZZ(2,J)= ZZECXSU(J) OTPROZZ(3,J)= ZZECXSD(J) OTPROZZ(4,J)= ZZECXSC(J) OTPROZZ(5,J)= ZZECXSS(J) OTPROZZ(6,J)= ZZECXSB(J) OTPROZZ(7,J)= ZZECASMU(J) OTPROZZ(8,J)= ZZECASC(J) OTPROZZ(9,J)= ZZECASB(J) ENDDO DO J=1,NRTS OTPROWI(1,J)= WIECXSMU(J) OTPROWI(2,J)= WIECXSU(J) OTPROWI(3,J)= WIECXSD(J) OTPROWI(4,J)= WIECXSC(J) OTPROWI(5,J)= WIECXSS(J) OTPROWI(6,J)= WIECXSB(J) OTPROWI(7,J)= WIECASMU(J) OTPROWI(8,J)= WIECASC(J) OTPROWI(9,J)= WIECASB(J) ENDDO DO J1=1,NRTS DO J2=1,9 OTPDRO(1,J2,J1)= OTPROD(J2,J1) OTPDRO(2,J2,J1)= OTPRODD(J2,J1) OTPDRO(3,J2,J1)= OTPRODDD(J2,J1) OTPDRO(4,J2,J1)= OTPROZZ(J2,J1) OTPDRO(5,J2,J1)= OTPROWI(J2,J1) ENDDO ENDDO ENDIF CALL TEWCUT(NRS) ELSE IF(OBHABHA.EQ.'B') THEN CALL TEWCUT(NRS) ELSE IF(OBHABHA.EQ.'R') THEN IF(OREST.EQ.'E') THEN CALL TEWEXT(KPR,NRS,NFN,SIGF0,SIGF1,AEST0,AEST1) ELSE IF(OREST.EQ.'C') THEN CALL TEWCUT(NRS) ENDIF ENDIF * IF(OBHABHA.NE.'B') THEN * DO I=1,NRS * BRAT(I)= SBT(I)/SHADT(I) * EBRAT(I)= SHADT(I)*SHADT(I)*ESBT(I)*ESBT(I)+ * # SBT(I)*SBT(I)*ESHADT(I)*ESHADT(I) * EBRAT(I)= SQRT(EBRAT(I))/SHADT(I)/SHADT(I) * CRAT(I)= SCT(I)/SHADT(I) * ECRAT(I)= SHADT(I)*SHADT(I)*ESCT(I)*ESCT(I)+ * # SCT(I)*SCT(I)*ESHADT(I)*ESHADT(I) * ECRAT(I)= SQRT(ECRAT(I))/SHADT(I)/SHADT(I) * ENDDO * ENDIF * DO I=1,NRTS DO J=1,2 DO L=1,13 K= 13*(2*(I-1)+J-1)+L IF(L.EQ.1) THEN IF(J.EQ.1) THEN OTPRO(K)= SET(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ESET(I) ENDIF ELSE IF(L.EQ.2) THEN IF(J.EQ.1) THEN OTPRO(K)= SMUT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ESMUT(I) ENDIF ELSE IF(L.EQ.3) THEN IF(J.EQ.1) THEN OTPRO(K)= STAUT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ESTAUT(I) ENDIF ELSE IF(L.EQ.4) THEN IF(J.EQ.1) THEN OTPRO(K)= SHADT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ESHADT(I) ENDIF ELSE IF(L.EQ.5) THEN IF(J.EQ.1) THEN OTPRO(K)= SBT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ESBT(I) ENDIF ELSE IF(L.EQ.6) THEN IF(J.EQ.1) THEN OTPRO(K)= BRAT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= EBRAT(I) ENDIF ELSE IF(L.EQ.7) THEN IF(J.EQ.1) THEN OTPRO(K)= SCT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ESCT(I) ENDIF ELSE IF(L.EQ.8) THEN IF(J.EQ.1) THEN OTPRO(K)= CRAT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= ECRAT(I) ENDIF ELSE IF(L.EQ.9) THEN IF(J.EQ.1) THEN OTPRO(K)= AET(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= EAET(I) ENDIF ELSE IF(L.EQ.10) THEN IF(J.EQ.1) THEN OTPRO(K)= AMUT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= EAMUT(I) ENDIF ELSE IF(L.EQ.11) THEN IF(J.EQ.1) THEN OTPRO(K)= ATAUT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= EATAUT(I) ENDIF ELSE IF(L.EQ.12) THEN IF(J.EQ.1) THEN OTPRO(K)= ACT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= EACT(I) ENDIF ELSE IF(L.EQ.13) THEN IF(J.EQ.1) THEN OTPRO(K)= ABT(I) ELSE IF(J.EQ.2) THEN OTPRO(K)= EABT(I) ENDIF ENDIF ENDDO ENDDO ENDDO * RETURN END * *-----EWEXT------------------------------------------------------------- * WEAK CORRECTIONS ARE COMPUTED AND THE PHYSICAL QUANTITIES ARE * CONVOLUTED WHEN NO CUT (BUT ON THE INVARIANT MASS) IS APPLIED * RETURNS IN COMMON/TTH/ SIGMA(MU),SIGMA(TAU),SIGMA(HAD), * A_FB(MU),A_FB(TAU) * SUBROUTINE TEWEXT(KPR,NRS,NFN,SIGF0,SIGF1,AEST0,AEST1) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,KM,NM * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OCUTS,ONP,ONIF,OPRAD, # OBHABHA,OREST,OPREC,ONIFH,OIFAIL CHARACTER*2 OCUT,OINDX * PARAMETER(NDIM=1,NOBS=11,MNRS=30,MNFN=NOBS*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0) PARAMETER(NFL=4,NPO=34) * COMMON/TESC/SE COMMON/TP/OPREC COMMON/TMED/XMED COMMON/TSNOM/NBSM COMMON/TOPR/OPRAD COMMON/TIFL/OIFAIL COMMON/TFIXED/AX(4) COMMON/TECM/RS(MNRS) COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TNOM/NOBSS,NOBSM COMMON/TCUT/OXCUT,OXCUTS COMMON/TIFSRH/ONIFH(MNRS) COMMON/TADJBASYM/AJNB,AJDB COMMON/THMASS/PIM,KM,DM,BM COMMON/TPARAM/PI,PIS,DELTA COMMON/TEPP/EDEL(MNRS,NFL) COMMON/TXVAR/SEPS(MNRS,NOBS) COMMON/TSCALE/ZM,TQM,HM,CALS COMMON/TBQ/SBT(MNRS),ESBT(MNRS) COMMON/TCQ/SCT(MNRS),ESCT(MNRS) COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TS0/SIGMA0(MNRS,NOBS),SIGMA1(MNRS,NOBS) COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TDEC/DECXSMU(MNRS),DECXSU(MNRS),DECXSD(MNRS), # DECXSC(MNRS),DECXSS(MNRS),DECXSB(MNRS), # DECASMU(MNRS),DECASC(MNRS),DECASB(MNRS) COMMON/TDDEC/DDECXSMU(MNRS),DDECXSU(MNRS),DDECXSD(MNRS), # DDECXSC(MNRS),DDECXSS(MNRS),DDECXSB(MNRS), # DDECASMU(MNRS),DDECASC(MNRS),DDECASB(MNRS) COMMON/TDDDEC/DDDECXSMU(MNRS),DDDECXSU(MNRS),DDDECXSD(MNRS), # DDDECXSC(MNRS),DDDECXSS(MNRS),DDDECXSB(MNRS), # DDDECASMU(MNRS),DDDECASC(MNRS),DDDECASB(MNRS) COMMON/TZZEC/ZZECXSMU(MNRS),ZZECXSU(MNRS),ZZECXSD(MNRS), # ZZECXSC(MNRS),ZZECXSS(MNRS),ZZECXSB(MNRS), # ZZECASMU(MNRS),ZZECASC(MNRS),ZZECASB(MNRS) COMMON/TWIEC/WIECXSMU(MNRS),WIECXSU(MNRS),WIECXSD(MNRS), # WIECXSC(MNRS),WIECXSS(MNRS),WIECXSB(MNRS), # WIECASMU(MNRS),WIECASC(MNRS),WIECASB(MNRS) COMMON/TQAFBTH/ACT(MNRS),ABT(MNRS),EACT(MNRS),EABT(MNRS) COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TTH/SET(MNRS),AET(MNRS),SMUT(MNRS),AMUT(MNRS),STAUT(MNRS), # ATAUT(MNRS),SHADT(MNRS),ESET(MNRS),EAET(MNRS), # ESMUT(MNRS),EAMUT(MNRS),ESTAUT(MNRS),EATAUT(MNRS), # ESHADT(MNRS) * DIMENSION CFP(MNFN,NFL),XMAX(MNRS,NOBS) DIMENSION SIG(MNFN),SIG0(MNFN),ARS(NOBS,MNRS),RSP(MNRS) DIMENSION XL(NDIM),XU(NDIM),AEST0(NFN),SIGF0(NFN), # SIGF1(NFN),WRKSTR(LENWRK),AEST1(NFN) DIMENSION SIGMAZGM(MNRS,NOBS),RSZGM(MNRS),ARSZGM(NOBS,MNRS) DIMENSION DELIFS(4,MNRS),DELIFA(4,MNRS),ADELIFF(4), # ADELIFB(4) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFUB0,TFUB1 * *-----NOBS = # OF OBSERVABLES: 1 = SIG_T(MU), 2 = SIG_T(TAU) *----- 3 = SIG_FB(MU), 4 = SIG_FB(TAU), 5-9 = SIG_T(HAD), *----- 10 = SIG_FB(C), 11= SIG_FB(B) * IF CUTS ARE APPLIED *-----NOBS = # OF OBSERVABLES: 1-5 = SIG_T(HAD), *----- 6 = SIG_FB(C), 7= SIG_FB(B) * *-----NRS = # OF ENERGIES * OPRAD= 'E' IF(OPREC.EQ.'H') THEN MNCLSA= 1000 ELSE MNCLSA= MNCLS ENDIF * *-----IF REQUIRED MU AND TAUS ARE NOT INCLUDED * IF(OEXT.EQ.'C') THEN NOBSS= 4 ELSE NOBSS= 0 ENDIF NOBSM= NOBS-NOBSS IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'NO') THEN NBSM= NOBSM ELSE IF(OINDX.EQ.'HA') THEN NBSM= 5 ELSE NBSM= 2 ENDIF ELSE NBSM= NOBSM ENDIF * ALPHAS= CALS * CALL TWIDTHO(ZM,TQM,HM,ALPHAS,WT) * *-----QED CORRECTIONS ARE COMPUTED, INCLUDING PAIR PRODUCTION * CALL TQED(NRS,RS,RL,BETA,SDELTA,SDELTAP,WT,PCDEL,PCDELH, # AD1,ADD,SDELTA3,SDELTAP3) * *-----PART OF WEAK CORRECTIONS (THOSE NOT IN CONVOLUTION) ARE COMPUTED *-----AT THE WEAKLY CORRECTED PEAK OR ENERGY BY ENERGY * KO= 0 IF(OWEAK.EQ.'F') THEN MAXE= 1 SW= WT/ZM RSP(1)= ZM/SQRT(1.D0+SW*SW) CALL TWEAK(MAXE,RSP,KO) ELSE IF(OWEAK.EQ.'R') THEN MAXE= NRS CALL TWEAK(MAXE,RS,KO) ENDIF * *-----THE BORN+WEAK CROSS SECTIONS AND ASYMMETRIES ARE COMPUTED * COMPLETE (ONLY WITH EXTRAPOLATED SET-UP) * IF(OEXT.EQ.'E'.AND.KPR.EQ.1.AND.OBHABHA.EQ.'N') THEN DO J=1,NRS RSZGM(J)= RS(J) ENDDO * DO I=1,NOBSM DO J=1,NRS ARSZGM(I,J)= RSZGM(J) ENDDO ENDDO * KFLAG= 1 CALL TOBSR(KFLAG,NRS,NOBSM,ARSZGM,SIGMAZGM,RSZGM,AJN,AJD) AJNB= AJN AJDB= AJD DO J=1,NRS ZZECXSMU(J)= SIGMAZGM(J,1) ZZECASMU(J)= SIGMAZGM(J,3)/SIGMAZGM(J,1) ZZECXSC(J)= SIGMAZGM(J,6) ZZECXSB(J)= SIGMAZGM(J,9) ZZECXSU(J)= SIGMAZGM(J,5) ZZECXSD(J)= SIGMAZGM(J,7) ZZECXSS(J)= SIGMAZGM(J,8) ZZECASC(J)= SIGMAZGM(J,10)/SIGMAZGM(J,6) ZZECASB(J)= SIGMAZGM(J,11)/SIGMAZGM(J,9) ENDDO * KFLAG= 5 CALL TOBSR(KFLAG,NRS,NOBSM,ARSZGM,SIGMAZGM,RSZGM,AJN,AJD) DO J=1,NRS DECXSMU(J)= SIGMAZGM(J,1) DECASMU(J)= SIGMAZGM(J,3)/SIGMAZGM(J,1) ENDDO * KFLAG= 4 CALL TOBSR(KFLAG,NRS,NOBSM,ARSZGM,SIGMAZGM,RSZGM,AJN,AJD) DO J=1,NRS DECXSC(J)= SIGMAZGM(J,6) DECXSB(J)= SIGMAZGM(J,9) DECXSU(J)= SIGMAZGM(J,5) DECXSD(J)= SIGMAZGM(J,7) DECXSS(J)= SIGMAZGM(J,8) DECASC(J)= SIGMAZGM(J,10)/SIGMAZGM(J,6) DECASB(J)= SIGMAZGM(J,11)/SIGMAZGM(J,9) ENDDO * KFLAG= 6 CALL TOBSR(KFLAG,NRS,NOBSM,ARSZGM,SIGMAZGM,RSZGM,AJN,AJD) DO J=1,NRS DDECXSMU(J)= SIGMAZGM(J,1) DDECASMU(J)= SIGMAZGM(J,3)/SIGMAZGM(J,1) DDECXSC(J)= SIGMAZGM(J,6) DDECXSB(J)= SIGMAZGM(J,9) DDECXSU(J)= SIGMAZGM(J,5) DDECXSD(J)= SIGMAZGM(J,7) DDECXSS(J)= SIGMAZGM(J,8) DDECASC(J)= SIGMAZGM(J,10)/SIGMAZGM(J,6) DDECASB(J)= SIGMAZGM(J,11)/SIGMAZGM(J,9) ENDDO * KFLAG= 7 CALL TOBSR(KFLAG,NRS,NOBSM,ARSZGM,SIGMAZGM,RSZGM,AJN,AJD) DO J=1,NRS DDDECXSMU(J)= SIGMAZGM(J,1) DDDECASMU(J)= SIGMAZGM(J,3)/SIGMAZGM(J,1) DDDECXSC(J)= SIGMAZGM(J,6) DDDECXSB(J)= SIGMAZGM(J,9) DDDECXSU(J)= SIGMAZGM(J,5) DDDECXSD(J)= SIGMAZGM(J,7) DDDECXSS(J)= SIGMAZGM(J,8) DDDECASC(J)= SIGMAZGM(J,10)/SIGMAZGM(J,6) DDDECASB(J)= SIGMAZGM(J,11)/SIGMAZGM(J,9) ENDDO * KFLAG= 2 CALL TOBSR(KFLAG,NRS,NOBSM,ARSZGM,SIGMAZGM,RSZGM,AJN,AJD) DO J=1,NRS WIECXSMU(J)= SIGMAZGM(J,1) WIECASMU(J)= SIGMAZGM(J,3)/SIGMAZGM(J,1) WIECXSC(J)= SIGMAZGM(J,6) WIECXSB(J)= SIGMAZGM(J,9) WIECXSU(J)= SIGMAZGM(J,5) WIECXSD(J)= SIGMAZGM(J,7) WIECXSS(J)= SIGMAZGM(J,8) WIECASC(J)= SIGMAZGM(J,10)/SIGMAZGM(J,6) WIECASB(J)= SIGMAZGM(J,11)/SIGMAZGM(J,9) ENDDO ENDIF * *-----AT E_CM * DO I=1,NOBSM DO J=1,NRS ARS(I,J)= RS(J) ENDDO ENDDO KFLAG= 0 CALL TOBSR(KFLAG,NRS,NOBSM,ARS,SIGMA0,RS,AJN,AJD) * *-----AT 2*M_F/M_Z*E_CM * *-----MUONS, TAUS AND QUARKS MAY HAVE DIFFERENT THRESHOLDS: * BUT F+B AND F-B HAVE THE SAME CUTS. * THERE ARE IN GENERAL I = 11 CONFIGURATIONS EVEN IF SO FAR * (F-B) = (F+B) (I = 7 IF CUTS ARE APPLIED). THEREFORE IF MU * AND TAU ARE EXTRAPOLATED ONLY I = 1,2,5-9 IS USED FOR THE * ENERGIES, WHILE IF CUTS ARE APPLIED TO MU AND TAU ONLY * I = 1-5 IS USED. TO SUMMARIZE THE SEQUENCE IS: * I 1 2 3 4 5 6 7 8 9 10 11 * EXTRAPOLATED +MU,+TAU,-MU,-TAU,+U,+C,+D,+S,+B,-C,-B * I 1 2 3 4 5 6 7 * CUTS +U,+C,+D,+S,+B,-C,-B * IF(OEXT.EQ.'E') THEN DO I=1,NRS IF(OCUT(I).NE.'FC') THEN SEPS(I,1)= 4.D0*(MM/RS(I))**2 SEPS(I,2)= 4.D0*(TLM/RS(I))**2 ELSE SEPS(I,1)= DMAX1(OXCUT,4.D0*(MM/RS(I))**2) SEPS(I,2)= DMAX1(OXCUT,4.D0*(TLM/RS(I))**2) ENDIF IF(OCUT(I).EQ.'NC') THEN SEPS(I,5)= 4.D0*(PIM/RS(I))**2 SEPS(I,6)= 4.D0*(DM/RS(I))**2 SEPS(I,7)= 4.D0*(PIM/RS(I))**2 SEPS(I,8)= 4.D0*(KM/RS(I))**2 SEPS(I,9)= 4.D0*(BM/RS(I))**2 ELSE SEPS(I,5)= DMAX1(OXCUT,4.D0*(PIM/RS(I))**2) SEPS(I,6)= DMAX1(OXCUT,4.D0*(DM/RS(I))**2) SEPS(I,7)= DMAX1(OXCUT,4.D0*(PIM/RS(I))**2) SEPS(I,8)= DMAX1(OXCUT,4.D0*(KM/RS(I))**2) SEPS(I,9)= DMAX1(OXCUT,4.D0*(BM/RS(I))**2) ENDIF SEPS(I,3)= SEPS(I,1) SEPS(I,4)= SEPS(I,2) SEPS(I,10)= SEPS(I,6) SEPS(I,11)= SEPS(I,9) ENDDO ELSE IF(OEXT.EQ.'C') THEN DO I=1,NRS IF(OCUT(I).EQ.'NC') THEN SEPS(I,1)= 4.D0*(PIM/RS(I))**2 SEPS(I,2)= 4.D0*(DM/RS(I))**2 SEPS(I,3)= 4.D0*(PIM/RS(I))**2 SEPS(I,4)= 4.D0*(KM/RS(I))**2 SEPS(I,5)= 4.D0*(BM/RS(I))**2 ELSE SEPS(I,1)= DMAX1(OXCUT,4.D0*(PIM/RS(I))**2) SEPS(I,2)= DMAX1(OXCUT,4.D0*(DM/RS(I))**2) SEPS(I,3)= DMAX1(OXCUT,4.D0*(PIM/RS(I))**2) SEPS(I,4)= DMAX1(OXCUT,4.D0*(KM/RS(I))**2) SEPS(I,5)= DMAX1(OXCUT,4.D0*(BM/RS(I))**2) ENDIF SEPS(I,6)= SEPS(I,2) SEPS(I,7)= SEPS(I,5) ENDDO ENDIF * DO I=1,NOBSM DO J=1,NRS XMAX(J,I)= 1.D0-SEPS(J,I) ENDDO ENDDO * DO I=1,NOBSM DO J=1,NRS ARS(I,J)= SQRT(SEPS(J,I))*RS(J) ENDDO ENDDO KFLAG= 0 CALL TOBSR(KFLAG,NRS,NOBSM,ARS,SIGMA1,RS,AJN,AJD) * *-----LIMITS OF X-INTEGRATION ARE ALWAYS RESCALED * DO I=1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO MULFAC= 2**NDIM * *-----STARTS THE 0<->XMED (SCALED) INTEGRATION * MINCLS= MNCLSA MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-5*SE 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUB0,AEQ,REQ, # LENWRK,WRKSTR,SIGF0,AEST0,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EWEXT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * *-----STARTS THE XMED<->1-SEPS (SCALED) INTEGRATION * MINCLS= MNCLSA MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-5*SE 50 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUB1,AEQ,REQ, # LENWRK,WRKSTR,SIGF1,AEST1,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EWEXT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 50 ENDIF * *-----THE CORRECTED OBSERVABLES * SMED= 1.D0-XMED DO I3=1,NBSM IF(OBHABHA.EQ.'R'.AND.OINDX.NE.'NO') THEN IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 3 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+4 ELSE IF(OINDX.EQ.'BQ') THEN IF(I3.EQ.1) THEN I2= 9 ELSE IF(I3.EQ.2) THEN I2= 11 ENDIF ELSE IF(OINDX.EQ.'CQ') THEN IF(I3.EQ.1) THEN I2= 6 ELSE IF(I3.EQ.2) THEN I2= 10 ENDIF ENDIF ELSE I2= I3 ENDIF * DO I1=1,NRS I= NRS*(I3-1)+I1 PRDMX= TPRAD(I1,I2,XMAX(I1,I2),SEPS(I1,I2)) PRDMD= TPRAD(I1,I2,XMED,SMED) SIG0(I)= SIGMA0(I1,I2) SIG(I)= SIGF0(I)+SIGF1(I)+SIGMA0(I1,I2)*PRDMD+ # SIGMA1(I1,I2)*PRDMX*(1.D0-PRDMD/PRDMX) ENDDO ENDDO * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * ZERO= 0.D0 KFL= 0 KFLP= 0 * DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(OEXT.EQ.'C') THEN DO J=1,2 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE IF(OEXT.EQ.'E'.AND.OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'MU') THEN CALL TIFINT(KFL,KFLP,1,RS(I),ZERO,SEPS(I,1),WT,ADELIFF(1), # ADELIFB(1)) ADELIFF(2)= 0.D0 ADELIFB(2)= 0.D0 DO J=1,2 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE IF(OINDX.EQ.'TA') THEN ADELIFF(1)= 0.D0 ADELIFB(1)= 0.D0 CALL TIFINT(KFL,KFLP,2,RS(I),ZERO,SEPS(I,2),WT,ADELIFF(2), # ADELIFB(2)) DO J=1,2 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE DO J=1,2 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE DO J=1,2 CALL TIFINT(KFL,KFLP,J,RS(I),ZERO,SEPS(I,J),WT,ADELIFF(J), # ADELIFB(J)) DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE DO J=1,2 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF IF(ONIFH(I).EQ.'Y') THEN IF(OEXT.EQ.'C'.AND.OBHABHA.EQ.'R'.AND.(OINDX.EQ.'MU'.OR. # OINDX.EQ.'TA')) THEN DO J=3,4 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE IF(OEXT.EQ.'E'.AND.OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'MU'.OR.OINDX.EQ.'TA') THEN DO J=3,4 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE IF(OINDX.EQ.'CQ') THEN CALL TIFINT(KFL,KFLP,3,RS(I),ZERO,SEPS(I,3),WT,ADELIFF(3), # ADELIFB(3)) ADELIFF(4)= 0.D0 ADELIFB(4)= 0.D0 DO J=3,4 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE IF(OINDX.EQ.'CQ') THEN CALL TIFINT(KFL,KFLP,4,RS(I),ZERO,SEPS(I,4),WT,ADELIFF(4), # ADELIFB(4)) ADELIFF(3)= 0.D0 ADELIFB(3)= 0.D0 DO J=3,4 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE DO J=3,4 CALL TIFINT(KFL,KFLP,J,RS(I),ZERO,SEPS(I,J),WT,ADELIFF(J), # ADELIFB(J)) DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE DO J=3,4 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ENDDO * IF(OEXT.EQ.'E') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'MU'.OR.OINDX.EQ.'TA'.OR. # OINDX.EQ.'BQ'.OR.OINDX.EQ.'CQ') THEN K3MX= 0 ELSE IF(OINDX.EQ.'HA') THEN K3MX= 4 ELSE IF(OINDX.EQ.'NO') THEN K3MX= 8 ENDIF ELSE K3MX= 8 ENDIF ELSE IF(OEXT.EQ.'C') THEN K3MX= 4 ENDIF * IF(ONP(1).EQ.'I') THEN CALL TEPAIRS(NRS,NFL,WT) DO K1=1,4 DO K2=1,NRS DO K3=0,K3MX IF(ONP(K2).EQ.'I') THEN CFP(K3*NRS+K2,K1)= EDEL(K2,K1) ELSE CFP(K3*NRS+K2,K1)= 0.D0 ENDIF ENDDO ENDDO ENDDO ELSE DO K1=1,4 DO K2=1,NRS DO K3=0,K3MX IF(ONP(K2).EQ.'Y') THEN TEST= ABS(RS(K2)-ZM) IF(TEST.LE.3.D0) THEN CFP(K3*NRS+K2,K1)= PCDEL(K2,K1)+PCDELH(K2,K1) ELSE CFP(K3*NRS+K2,K1)= PCDEL(K2,K1)+SIG0(K3*NRS+K2)/ # SIG(K3*NRS+K2)*PCDELH(K2,K1) ENDIF ELSE CFP(K3*NRS+K2,K1)= 0.D0 ENDIF ENDDO ENDDO ENDDO ENDIF * *-----CORRECTED CROSS SECTIONS AND ASYMMETRIES * DO I1=1,NRS NRS1= NRS+I1 NRS2= 2*NRS+I1 NRS3= 3*NRS+I1 NRS4= 4*NRS+I1 NRS5= 5*NRS+I1 NRS6= 6*NRS+I1 NRS7= 7*NRS+I1 NRS8= 8*NRS+I1 NRS9= 9*NRS+I1 NRS10= 10*NRS+I1 IF(ONP(I1).EQ.'Y') THEN DO J1=1,4 CFP(I1,J1)= SIG(I1)*CFP(I1,J1) CFP(NRS1,J1)= SIG(NRS1)*CFP(NRS1,J1) CFP(NRS2,J1)= SIG(NRS2)*CFP(NRS2,J1) CFP(NRS3,J1)= SIG(NRS3)*CFP(NRS3,J1) CFP(NRS4,J1)= SIG(NRS4)*CFP(NRS4,J1) CFP(NRS5,J1)= SIG(NRS5)*CFP(NRS5,J1) CFP(NRS6,J1)= SIG(NRS6)*CFP(NRS6,J1) CFP(NRS7,J1)= SIG(NRS7)*CFP(NRS7,J1) CFP(NRS8,J1)= SIG(NRS8)*CFP(NRS8,J1) CFP(NRS9,J1)= SIG(NRS9)*CFP(NRS9,J1) CFP(NRS10,J1)= SIG(NRS10)*CFP(NRS10,J1) ENDDO ENDIF IF(OEXT.EQ.'E') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'MU') THEN SMUT(I1)= SIG(I1)+CFP(I1,1)+DELIFS(1,I1) AMUT(I1)= (SIG(NRS1)+DELIFA(1,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(1,I1)) ESMUT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1) ESMUT(I1)= SQRT(ESMUT(I1)) EAMUT(I1)= AEST0(NRS1)*AEST0(NRS1) # +AEST1(NRS1)*AEST1(NRS1) EAMUT(I1)= SQRT(EAMUT(I1)) EAMUT(I1)= EAMUT(I1)/SMUT(I1)*ABS(1.D0+ESMUT(I1) # /EAMUT(I1)*ABS(AMUT(I1))) ELSE IF(OINDX.EQ.'TA') THEN STAUT(I1)= SIG(I1)+CFP(I1,1)+DELIFS(2,I1) ATAUT(I1)= (SIG(NRS1)+DELIFA(2,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(2,I1)) ESTAUT(I1)= AEST0(I1)*AEST0(I1) # +AEST1(I1)*AEST1(I1) ESTAUT(I1)= SQRT(ESTAUT(I1)) EATAUT(I1)= AEST0(NRS1)*AEST0(NRS1) # +AEST1(NRS1)*AEST1(NRS1) EATAUT(I1)= SQRT(EATAUT(I1)) EATAUT(I1)= EATAUT(I1)/STAUT(I1)*ABS(1.D0+ESTAUT(I1) # /EATAUT(I1)*ABS(ATAUT(I1))) ELSE IF(OINDX.EQ.'HA') THEN SHADT(I1)= SIG(I1)+CFP(I1,2)+DELIFS(3,I1) # +SIG(NRS1)+CFP(NRS1,2)+DELIFS(3,I1) # +SIG(NRS2)+CFP(NRS2,3)+DELIFS(4,I1) # +SIG(NRS3)+CFP(NRS3,3)+DELIFS(4,I1) # +SIG(NRS4)+CFP(NRS4,4)+DELIFS(4,I1) ESHADT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1)+ # AEST0(NRS1)*AEST0(NRS1)+ # AEST1(NRS1)*AEST1(NRS1)+ # AEST0(NRS2)*AEST0(NRS2)+ # AEST1(NRS2)*AEST1(NRS2)+ # AEST0(NRS3)*AEST0(NRS3)+ # AEST1(NRS3)*AEST1(NRS3)+ # AEST0(NRS4)*AEST0(NRS4)+ # AEST1(NRS4)*AEST1(NRS4) ESHADT(I1)= SQRT(ESHADT(I1)) ELSE IF(OINDX.EQ.'BQ') THEN SBT(I1)= SIG(I1)+CFP(I1,4)+DELIFS(4,I1) ABT(I1)= (SIG(NRS1)+DELIFA(4,I1))/(SIG(I1)+ # CFP(I1,4)+DELIFS(4,I1)) ESBT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1) ESBT(I1)= SQRT(ESBT(I1)) EABT(I1)= AEST0(NRS1)*AEST0(NRS1) # +AEST1(NRS1)*AEST1(NRS1) EABT(I1)= SQRT(EABT(I1)) EABT(I1)= EABT(I1)/SBT(I1)*ABS(1.D0+ESBT(I1) # /EABT(I1)*ABS(ABT(I1))) ELSE IF(OINDX.EQ.'CQ') THEN SCT(I1)= SIG(I1)+CFP(I1,2)+DELIFS(3,I1) ACT(I1)= (SIG(NRS1)+DELIFA(3,I1))/(SIG(I1)+ # CFP(I1,2)+DELIFS(3,I1)) ESCT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1) ESCT(I1)= SQRT(ESCT(I1)) EACT(I1)= AEST0(NRS1)*AEST0(NRS1) # +AEST1(NRS1)*AEST1(NRS1) EACT(I1)= SQRT(EACT(I1)) EACT(I1)= EACT(I1)/SCT(I1)*ABS(1.D0+ESCT(I1) # /EACT(I1)*ABS(ACT(I1))) ELSE IF(OINDX.EQ.'NO') THEN SMUT(I1)= SIG(I1)+CFP(I1,1)+DELIFS(1,I1) STAUT(I1)= SIG(NRS1)+CFP(NRS1,1)+DELIFS(2,I1) AMUT(I1)= (SIG(NRS2)+DELIFA(1,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(1,I1)) ATAUT(I1)= (SIG(NRS3)+DELIFA(2,I1))/ # (SIG(NRS1)+CFP(NRS1,1)+DELIFS(2,I1)) SHADT(I1)= SIG(NRS4)+CFP(NRS4,2)+DELIFS(3,I1) # +SIG(NRS5)+CFP(NRS5,2)+DELIFS(3,I1) # +SIG(NRS6)+CFP(NRS6,3)+DELIFS(4,I1) # +SIG(NRS7)+CFP(NRS7,3)+DELIFS(4,I1) # +SIG(NRS8)+CFP(NRS8,4)+DELIFS(4,I1) ACT(I1)= (SIG(NRS9)+DELIFA(3,I1))/(SIG(NRS5) # +CFP(NRS5,2)+DELIFS(3,I1)) ABT(I1)= (SIG(NRS10)+DELIFA(4,I1))/(SIG(NRS8) # +CFP(NRS8,4)+DELIFS(4,I1)) SBT(I1)= SIG(NRS8)+CFP(NRS8,4)+DELIFS(4,I1) SCT(I1)= SIG(NRS5)+CFP(NRS5,2)+DELIFS(3,I1) ESMUT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1) ESMUT(I1)= SQRT(ESMUT(I1)) EAMUT(I1)= AEST0(NRS2)*AEST0(NRS2) # +AEST1(NRS2)*AEST1(NRS2) EAMUT(I1)= SQRT(EAMUT(I1)) EAMUT(I1)= EAMUT(I1)/SMUT(I1)*ABS(1.D0+ESMUT(I1) # /EAMUT(I1)*ABS(AMUT(I1))) ESTAUT(I1)= AEST0(NRS1)*AEST0(NRS1) # +AEST1(NRS1)*AEST1(NRS1) ESTAUT(I1)= SQRT(ESTAUT(I1)) EATAUT(I1)= AEST0(NRS3)*AEST0(NRS3) # +AEST1(NRS3)*AEST1(NRS3) EATAUT(I1)= SQRT(EATAUT(I1)) EATAUT(I1)= EATAUT(I1)/STAUT(I1)*ABS(1.D0+ESTAUT(I1) # /EATAUT(I1)*ABS(ATAUT(I1))) ESHADT(I1)= AEST0(NRS4)*AEST0(NRS4)+ # AEST1(NRS4)*AEST1(NRS4)+ # AEST0(NRS5)*AEST0(NRS5)+ # AEST1(NRS5)*AEST1(NRS5)+ # AEST0(NRS6)*AEST0(NRS6)+ # AEST1(NRS6)*AEST1(NRS6)+ # AEST0(NRS7)*AEST0(NRS7)+ # AEST1(NRS7)*AEST1(NRS7)+ # AEST0(NRS8)*AEST0(NRS8)+ # AEST1(NRS8)*AEST1(NRS8) ESHADT(I1)= SQRT(ESHADT(I1)) ESBT(I1)= AEST0(NRS8)*AEST0(NRS8)+ # AEST1(NRS8)*AEST1(NRS8) ESBT(I1)= SQRT(ESBT(I1)) ESCT(I1)= AEST0(NRS5)*AEST0(NRS5)+ # AEST1(NRS5)*AEST1(NRS5) ESCT(I1)= SQRT(ESCT(I1)) EACT(I1)= AEST0(NRS9)*AEST0(NRS9) # +AEST1(NRS9)*AEST1(NRS9) EACT(I1)= SQRT(EACT(I1)) EACT(I1)= EACT(I1)/SCT(I1)*ABS(1.D0+ESCT(I1) # /EACT(I1)*ABS(ACT(I1))) EABT(I1)= AEST0(NRS10)*AEST0(NRS10) # +AEST1(NRS10)*AEST1(NRS10) EABT(I1)= SQRT(EABT(I1)) EABT(I1)= EABT(I1)/SBT(I1)*ABS(1.D0+ESBT(I1) # /EABT(I1)*ABS(ABT(I1))) ENDIF ELSE SMUT(I1)= SIG(I1)+CFP(I1,1)+DELIFS(1,I1) STAUT(I1)= SIG(NRS1)+CFP(NRS1,1)+DELIFS(2,I1) AMUT(I1)= (SIG(NRS2)+DELIFA(1,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(1,I1)) ATAUT(I1)= (SIG(NRS3)+DELIFA(2,I1))/ # (SIG(NRS1)+CFP(NRS1,1)+DELIFS(2,I1)) SHADT(I1)= SIG(NRS4)+CFP(NRS4,2)+DELIFS(3,I1) # +SIG(NRS5)+CFP(NRS5,2)+DELIFS(3,I1) # +SIG(NRS6)+CFP(NRS6,3)+DELIFS(4,I1) # +SIG(NRS7)+CFP(NRS7,3)+DELIFS(4,I1) # +SIG(NRS8)+CFP(NRS8,4)+DELIFS(4,I1) ACT(I1)= (SIG(NRS9)+DELIFA(3,I1))/(SIG(NRS5) # +CFP(NRS5,2)+DELIFS(3,I1)) ABT(I1)= (SIG(NRS10)+DELIFA(4,I1))/(SIG(NRS8) # +CFP(NRS8,4)+DELIFS(4,I1)) SBT(I1)= SIG(NRS8)+CFP(NRS8,4)+DELIFS(4,I1) SCT(I1)= SIG(NRS5)+CFP(NRS5,2)+DELIFS(3,I1) ESMUT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1) ESMUT(I1)= SQRT(ESMUT(I1)) EAMUT(I1)= AEST0(NRS2)*AEST0(NRS2) # +AEST1(NRS2)*AEST1(NRS2) EAMUT(I1)= SQRT(EAMUT(I1)) EAMUT(I1)= EAMUT(I1)/SMUT(I1)*ABS(1.D0+ESMUT(I1) # /EAMUT(I1)*ABS(AMUT(I1))) ESTAUT(I1)= AEST0(NRS1)*AEST0(NRS1) # +AEST1(NRS1)*AEST1(NRS1) ESTAUT(I1)= SQRT(ESTAUT(I1)) EATAUT(I1)= AEST0(NRS3)*AEST0(NRS3) # +AEST1(NRS3)*AEST1(NRS3) EATAUT(I1)= SQRT(EATAUT(I1)) EATAUT(I1)= EATAUT(I1)/STAUT(I1)*ABS(1.D0+ESTAUT(I1) # /EATAUT(I1)*ABS(ATAUT(I1))) ESHADT(I1)= AEST0(NRS4)*AEST0(NRS4)+ # AEST1(NRS4)*AEST1(NRS4)+ # AEST0(NRS5)*AEST0(NRS5)+ # AEST1(NRS5)*AEST1(NRS5)+ # AEST0(NRS6)*AEST0(NRS6)+ # AEST1(NRS6)*AEST1(NRS6)+ # AEST0(NRS7)*AEST0(NRS7)+ # AEST1(NRS7)*AEST1(NRS7)+ # AEST0(NRS8)*AEST0(NRS8)+ # AEST1(NRS8)*AEST1(NRS8) ESHADT(I1)= SQRT(ESHADT(I1)) ESBT(I1)= AEST0(NRS8)*AEST0(NRS8)+ # AEST1(NRS8)*AEST1(NRS8) ESBT(I1)= SQRT(ESBT(I1)) ESCT(I1)= AEST0(NRS5)*AEST0(NRS5)+ # AEST1(NRS5)*AEST1(NRS5) ESCT(I1)= SQRT(ESCT(I1)) EACT(I1)= AEST0(NRS9)*AEST0(NRS9) # +AEST1(NRS9)*AEST1(NRS9) EACT(I1)= SQRT(EACT(I1)) EACT(I1)= EACT(I1)/SCT(I1)*ABS(1.D0+ESCT(I1) # /EACT(I1)*ABS(ACT(I1))) EABT(I1)= AEST0(NRS10)*AEST0(NRS10) # +AEST1(NRS10)*AEST1(NRS10) EABT(I1)= SQRT(EABT(I1)) EABT(I1)= EABT(I1)/SBT(I1)*ABS(1.D0+ESBT(I1) # /EABT(I1)*ABS(ABT(I1))) ENDIF ELSE IF(OEXT.EQ.'C') THEN SHADT(I1)= SIG(I1)+CFP(I1,2)+DELIFS(3,I1) # +SIG(NRS1)+CFP(NRS1,2)+DELIFS(3,I1) # +SIG(NRS2)+CFP(NRS2,3)+DELIFS(4,I1) # +SIG(NRS3)+CFP(NRS3,3)+DELIFS(4,I1) # +SIG(NRS4)+CFP(NRS4,4)+DELIFS(4,I1) ACT(I1)= (SIG(NRS5)+DELIFA(3,I1))/(SIG(NRS1) # +CFP(NRS1,2)+DELIFS(3,I1)) ABT(I1)= (SIG(NRS6)+DELIFA(4,I1))/(SIG(NRS4) # +CFP(NRS4,4))+DELIFS(4,I1) SBT(I1)= SIG(NRS4)+CFP(NRS4,4)+DELIFS(4,I1) SCT(I1)= SIG(NRS1)+CFP(NRS1,2)+DELIFS(3,I1) ESHADT(I1)= AEST0(I1)*AEST0(I1)+ # AEST1(I1)*AEST1(I1)+ # AEST0(NRS1)*AEST0(NRS1)+ # AEST1(NRS1)*AEST1(NRS1)+ # AEST0(NRS2)*AEST0(NRS2)+ # AEST1(NRS2)*AEST1(NRS2)+ # AEST0(NRS3)*AEST0(NRS3)+ # AEST1(NRS3)*AEST1(NRS3)+ # AEST0(NRS4)*AEST0(NRS4)+ # AEST1(NRS4)*AEST1(NRS4) ESHADT(I1)= SQRT(ESHADT(I1)) ESBT(I1)= AEST0(NRS4)*AEST0(NRS4)+ # AEST1(NRS4)*AEST1(NRS4) ESBT(I1)= SQRT(ESBT(I1)) ESCT(I1)= AEST0(NRS1)*AEST0(NRS1)+ # AEST1(NRS1)*AEST1(NRS1) ESCT(I1)= SQRT(ESCT(I1)) EACT(I1)= AEST0(NRS5)*AEST0(NRS5) # +AEST1(NRS5)*AEST1(NRS5) EACT(I1)= SQRT(EACT(I1)) EACT(I1)= EACT(I1)/SCT(I1)*ABS(1.D0+ESCT(I1) # /EACT(I1)*ABS(ACT(I1))) EABT(I1)= AEST0(NRS6)*AEST0(NRS6) # +AEST1(NRS6)*AEST1(NRS6) EABT(I1)= SQRT(EABT(I1)) EABT(I1)= EABT(I1)/SBT(I1)*ABS(1.D0+ESBT(I1) # /EABT(I1)*ABS(ABT(I1))) ENDIF ENDDO * RETURN END * *-----FUNSUB0----------------------------------------------------------- *-----INTEGRANDS FOR (SCALED) 0<->XMED INTEGRATION. SCALE FACTOR = XMED * SUBROUTINE TFUB0(NDIM,ZZ,NFN,F) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OHC,ORAD,OBHABHA,OREST CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT CHARACTER*2 OINDX * PARAMETER(MNRS=30,NO=11) PARAMETER(NFL=4,NL=3) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/TSNOM/NBSM COMMON/TECM/RS(MNRS) COMMON/TICOUPLING/NF COMMON/TNOM/NOBSS,NOBSM COMMON/TXVAR/SEPS(MNRS,NO) COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TS0/SIGMA0(MNRS,NO),SIGMA1(MNRS,NO) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION ZZ(NDIM),F(NFN),SIGMA(MNRS,NO),RSH(NO,MNRS),RAD(MNRS), # RADFB(MNRS) * IF(OHC.EQ.'Y') THEN A2L0= APIS A1L0= API X= XMED*ZZ(1) XL= LOG(X) OMXL= LOG(1.D0-X) * *-----REDUCED ENERGIES * DO I=1,NOBSM DO J=1,NRS RSH(I,J)= SQRT(1.D0-X)*RS(J) ENDDO ENDDO * KFLAG= 0 CALL TOBSR(KFLAG,NRS,NOBSM,RSH,SIGMA,RS,AJN,AJD) * *-----THE HARD CONSTANTS * Z= 1.D0-X ZS= Z*Z OMZ= X OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZL= LOG(OMZ) ZL02= OMZL*OMZL OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) ZL20= ZL*ZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL-ZL20)+ # OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)*ZL11- # 25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)*RZ2+ # (1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/OMZ* # (1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) * DO J=1,NRS A2L2= APIS*RL(J)*RL(J) A2L1= APIS*RL(J) A1L1= API*RL(J) RLM1= RL(J)-1.D0 SP1= A2L2*(HR2-OPZ*(2.D0*OMZL+1.5D0)) SP2= A2L1*(HR1-OPZ*(-4.D0*OMZL-1.5D0+2.D0*RZ2-2.D0)) SP3= A2L0*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -A1L1*OPZ SP5= A1L0*OPZ RH= SP1+SP2+SP3+SP4+SP5 RH3= -27.D0/2.D0+15.D0/4.D0*OMZ+4.D0*(1.D0-0.5D0*OMZ) # *(PIS-6.D0*OMZL**2+3.D0*S11) # +3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0*OMZ) # +ZL**2*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ) # -6.D0*OMZL*(6.D0-OMZ) # +6.D0*OMZL*ZL*(6.D0-4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETA(J)**3/48.D0 RH1FB= BETA(J)/2.D0/X*(1.D0+ZS-2.D0*OPZS/4.D0/Z) # -API*(LOG(4.D0*Z/OPZS)) RH1FB= RH1FB*4.D0*Z/OPZS RH2S= 1.D0/8.D0*BETA(J)*BETA(J)*(OPZ* # (3.D0*OMXL-4.D0*XL)-4.D0/X*OMXL-6.D0+X) SOMX= SQRT(Z) RH2FB= X**3/2.D0/Z+X**2/SOMX*(ATAN(1.D0/SOMX)-ATAN(SOMX)) # -OPZ*LOG(Z)+2.D0*X RH2FB= RH2FB*(API/2.D0*RL(J))**2 RH2FB= RH2FB+RH2S RH2FB= RH2FB*4.D0*Z/OPZS YH0= 0.5D0*(1.D0+ZS) YHA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA(J) # +1.D0/8.D0*(4.D0*(1.D0+ZS)*(S11+OMZL*ZL) # -(1.D0+3.D0*ZS)*ZL20+2.D0*(3.D0+2.D0*Z+ZS)*ZL # +2.D0*OMZ*(3.D0-2.D0*Z)) YHA= API*YHA YHB= 1.D0/8.D0*BETA(J)*(-(1.D0+3.D0*ZS)*ZL-2.D0*OMZ2) YHB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ZL20+0.5D0*OMZ* # (1.D0-3.D0*Z)*ZL+OMZ2+(1.D0-ZS)*S11 YHB2= 1.D0/8.D0*BETA(J)**2*YHB2 * IF(ORAD.EQ.'A') THEN RAD(J)= SDELTA(J)*BETA(J)*X**(BETA(J)-1.D0)+RH ELSE IF(ORAD.EQ.'D') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= BETA(J)*X**(BETA(J)-1.D0)*FGL*EXP(AD1(J))* # ADD(J)+RH ELSE IF(ORAD.EQ.'E') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= 0.5D0*OPZ2*BETA(J)*X**(BETA(J)-1.D0)*FGL* # EXP(AD1(J))*ADD(J)+A2L2*HR2+A2L1*HR1+A2L0*HR0 ELSE IF(ORAD.EQ.'F') THEN RAD(J)= (SDELTA(J)+SDELTA3(J))*BETA(J)*X**(BETA(J)-1.D0) # +RH+RH3 ELSE IF(ORAD.EQ.'Y') THEN ARGE= (3.D0/4.D0-EGAM)*BETA(J)+API*(2.D0*RZ2-0.5D0) ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= BETA(J)*X**(BETA(J)-1.D0)*FGL # *(YH0+YHA+YHB+YHB2) ENDIF RADFB(J)= SDELTA(J)*BETA(J)*X**(BETA(J)-1.D0)+RH1FB+RH2FB ENDDO * DO I3=1,NBSM IF(OBHABHA.EQ.'R'.AND.OINDX.NE.'NO') THEN IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 3 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+4 ELSE IF(OINDX.EQ.'BQ') THEN IF(I3.EQ.1) THEN I2= 9 ELSE IF(I3.EQ.2) THEN I2= 11 ENDIF ELSE IF(OINDX.EQ.'CQ') THEN IF(I3.EQ.1) THEN I2= 6 ELSE IF(I3.EQ.2) THEN I2= 10 ENDIF ENDIF ELSE I2= I3 ENDIF DO I1=1,NRS I= NRS*(I3-1)+I1 IF((OEXT.EQ.'E'.AND. # (I2.EQ.3.OR.I2.EQ.4.OR.I2.EQ.10.OR.I2.EQ.11)) # .OR. # (OEXT.EQ.'C'.AND. # (I2.EQ.6.OR.I2.EQ.7))) THEN F(I)= XMED*(SIGMA(I1,I2)-SIGMA0(I1,I2))*RADFB(I1) ELSE F(I)= XMED*(SIGMA(I1,I2)-SIGMA0(I1,I2))*RAD(I1) ENDIF ENDDO ENDDO * ELSE IF(OHC.EQ.'N') THEN X= XMED*ZZ(1) XL= LOG(X) OMXL= LOG(1.D0-X) * *-----REDUCED ENERGIES * DO I=1,NOBSM DO J=1,NRS RSH(I,J)= SQRT(1.D0-X)*RS(J) ENDDO ENDDO * KFLAG= 0 CALL TOBSR(KFLAG,NRS,NOBSM,RSH,SIGMA,RS,AJN,AJD) * DO J=1,NRS RH1= -0.5D0*BETA(J)*(2.D0-X) RH2= 1.D0/8.D0*BETA(J)*BETA(J)*((2.D0-X)* # (3.D0*OMXL-4.D0*XL)-4.D0/X*OMXL-6.D0+X) * RAD(J)= SDELTA(J)*BETA(J)*X**(BETA(J)-1.D0)+ # RH1+RH2 ENDDO * DO I3=1,NBSM IF(OBHABHA.EQ.'R'.AND.OINDX.NE.'NO') THEN IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 3 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+4 ELSE IF(OINDX.EQ.'BQ') THEN IF(I3.EQ.1) THEN I2= 9 ELSE IF(I3.EQ.2) THEN I2= 11 ENDIF ELSE IF(OINDX.EQ.'CQ') THEN IF(I3.EQ.1) THEN I2= 6 ELSE IF(I3.EQ.2) THEN I2= 10 ENDIF ENDIF ELSE I2= I3 ENDIF DO I1=1,NRS I= NRS*(I3-1)+I1 F(I)= XMED*(SIGMA(I1,I2)-SIGMA0(I1,I2))* # RAD(I1) ENDDO ENDDO * ENDIF * RETURN END * *-----FUNSUB1------------------------------------------------------------- *-----INTEGRANDS FOR (SCALED) XMED<->1-SEPS INTEGRATION. SSCALE * FACTOR = 1-XMED-SEPS * SUBROUTINE TFUB1(NDIM,ZZ,NFN,F) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OHC,ORAD,OBHABHA,OREST CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT CHARACTER*2 OINDX * PARAMETER(MNRS=30,NO=11) PARAMETER(NFL=4,NL=3) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/TSNOM/NBSM COMMON/TECM/RS(MNRS) COMMON/TICOUPLING/NF COMMON/TNOM/NOBSS,NOBSM COMMON/TXVAR/SEPS(MNRS,NO) COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TS0/SIGMA0(MNRS,NO),SIGMA1(MNRS,NO) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION ZZ(NDIM),F(NFN),SIGMA(MNRS,NO),X(MNRS,NO), # XL(MNRS,NO),OMXL(MNRS,NO),RAD(NO,MNRS),RSH(NO,MNRS), # RADFB(NO,MNRS) * OMXMED= 1.D0-XMED IF(OHC.EQ.'Y') THEN A2L0= APIS A1L0= API * *-----MUONS, TAUS AND QUARKS HAVE DIFFERENT THRESHOLDS * DO J=1,NRS A2L2= APIS*RL(J)*RL(J) A2L1= APIS*RL(J) A1L1= API*RL(J) BETAH= 0.5D0*BETA(J) BETAS= 1.D0/8.D0*BETA(J)*BETA(J) BETAM1= BETA(J)-1.D0 SBETA= SDELTA(J)*BETA(J) SBETA3= SDELTA3(J)*BETA(J) DO IP=1,NBSM IF(OBHABHA.EQ.'R'.AND.OINDX.NE.'NO') THEN IF(OINDX.EQ.'MU') THEN IF(IP.EQ.1) THEN I= 1 ELSE IF(IP.EQ.2) THEN I= 3 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(IP.EQ.1) THEN I= 2 ELSE IF(IP.EQ.2) THEN I= 4 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I= IP+4 ELSE IF(OINDX.EQ.'BQ') THEN IF(IP.EQ.1) THEN I= 9 ELSE IF(IP.EQ.2) THEN I= 11 ENDIF ELSE IF(OINDX.EQ.'CQ') THEN IF(IP.EQ.1) THEN I= 6 ELSE IF(IP.EQ.2) THEN I= 10 ENDIF ENDIF ELSE I= IP ENDIF X(J,IP)= (OMXMED-SEPS(J,I))*ZZ(1)+XMED XL(J,IP)= LOG(X(J,IP)) OMXL(J,IP)= LOG(1.D0-X(J,IP)) * *-----THE HARD CONSTANTS * Z= 1.D0-X(J,IP) ZS= Z*Z OMZ= X(J,IP) OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) OMZL= LOG(OMZ) ZL20= ZL*ZL ZL02= OMZL*OMZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL- # ZL20)+OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)* # ZL11-25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)* # RZ2+(1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/ # OMZ*(1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) * RLM1= RL(J)-1.D0 SP1= A2L2*(HR2-OPZ*(2.D0*OMZL+1.5D0)) SP2= A2L1*(HR1-OPZ*(-4.D0*OMZL-1.5D0+ # 2.D0*RZ2-2.D0)) SP3= A2L0*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -A1L1*OPZ SP5= A1L0*OPZ RH= SP1+SP2+SP3+SP4+SP5 RH3= -27.D0/2.D0+15.D0/4.D0*OMZ+4.D0*(1.D0- # 0.5D0*OMZ)*(PIS-6.D0*OMZL**2+3.D0*S11)+ # 3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0*OMZ)+ # ZL20*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ)- # 6.D0*OMZL*(6.D0-OMZ)+6.D0*OMZL*ZL*(6.D0- # 4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETA(J)**3/48.D0 RH1FB= BETA(J)/2.D0/X(J,IP)*(1.D0+ZS- # 2.D0*OPZS/4.D0/Z)-API*(LOG(4.D0*Z/OPZS)) RH1FB= RH1FB*4.D0*Z/OPZS RH2S= 1.D0/8.D0*BETA(J)*BETA(J)*(OPZ* # (3.D0*OMXL(J,IP)-4.D0*XL(J,IP))- # 4.D0/X(J,IP)*OMXL(J,IP)-6.D0+X(J,IP)) SOMX= SQRT(Z) RH2FB= X(J,IP)**3/2.D0/Z+X(J,IP)**2/SOMX* # (ATAN(1.D0/SOMX)-ATAN(SOMX))- # OPZ*LOG(Z)+2.D0*X(J,IP) RH2FB= RH2FB*(API/2.D0*RL(J))**2 RH2FB= RH2FB+RH2S RH2FB= RH2FB*4.D0*Z/OPZS YH0= 0.5D0*(1.D0+ZS) YHA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA(J) # +1.D0/8.D0*(4.D0*(1.D0+ZS)*(S11+OMZL*ZL) # -(1.D0+3.D0*ZS)*ZL20+2.D0*(3.D0+2.D0*Z+ZS)*ZL # +2.D0*OMZ*(3.D0-2.D0*Z)) YHA= API*YHA YHB= 1.D0/8.D0*BETA(J)*(-(1.D0+3.D0*ZS)*ZL # -2.D0*OMZ2) YHB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ZL20 # +0.5D0*OMZ*(1.D0-3.D0*Z)*ZL # +OMZ2+(1.D0-ZS)*S11 YHB2= 1.D0/8.D0*BETA(J)**2*YHB2 * IF(ORAD.EQ.'A') THEN RAD(IP,J)= SBETA*X(J,IP)**BETAM1+RH ELSE IF(ORAD.EQ.'D') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(IP,J)= BETA(J)*X(J,IP)**(BETA(J)-1.D0)* # FGL*EXP(AD1(J))*ADD(J)+RH ELSE IF(ORAD.EQ.'E') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(IP,J)= 0.5D0*OPZ2*BETA(J)*X(J,IP)** # (BETA(J)-1.D0)*FGL*EXP(AD1(J))* # ADD(J)+A2L2*HR2+A2L1*HR1+A2L0*HR0 ELSE IF(ORAD.EQ.'F') THEN RAD(IP,J)= (SBETA+SBETA3)*X(J,IP)**BETAM1 # +RH+RH3 ELSE IF(ORAD.EQ.'Y') THEN ARGE= (3.D0/4.D0-EGAM)*BETA(J)+ # API*(2.D0*RZ2-0.5D0) ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(IP,J)= BETA(J)*X(J,IP)**(BETA(J)-1.D0)*FGL # *(YH0+YHA+YHB+YHB2) ENDIF RADFB(IP,J)= SDELTA(J)*BETA(J)*X(J,IP)**(BETA(J) # -1.D0)+RH1FB+RH2FB ENDDO ENDDO * *-----REDUCED ENERGIES * DO J=1,NRS DO I=1,NOBSM RSH(I,J)= SQRT(1.D0-((OMXMED-SEPS(J,I))*ZZ(1)+ # XMED))*RS(J) ENDDO ENDDO * KFLAG= 0 CALL TOBSR(KFLAG,NRS,NOBSM,RSH,SIGMA,RS,AJN,AJD) * DO I3=1,NBSM IF(OBHABHA.EQ.'R'.AND.OINDX.NE.'NO') THEN IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 3 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+4 ELSE IF(OINDX.EQ.'BQ') THEN IF(I3.EQ.1) THEN I2= 9 ELSE IF(I3.EQ.2) THEN I2= 11 ENDIF ELSE IF(OINDX.EQ.'CQ') THEN IF(I3.EQ.1) THEN I2= 6 ELSE IF(I3.EQ.2) THEN I2= 10 ENDIF ENDIF ELSE I2= I3 ENDIF DO I1=1,NRS I= NRS*(I3-1)+I1 IF((OEXT.EQ.'E'.AND. # (I2.EQ.3.OR.I2.EQ.4.OR.I2.EQ.10.OR.I2.EQ.11)) # .OR. # (OEXT.EQ.'C'.AND. # (I2.EQ.6.OR.I2.EQ.7))) THEN F(I)= (OMXMED-SEPS(I1,I2))*SIGMA1(I1,I2)* # (SIGMA(I1,I2)/SIGMA1(I1,I2)-1.D0)*RADFB(I3,I1) ELSE F(I)= (OMXMED-SEPS(I1,I2))*SIGMA1(I1,I2)* # (SIGMA(I1,I2)/SIGMA1(I1,I2)-1.D0)*RAD(I3,I1) ENDIF ENDDO ENDDO * ELSE IF(OHC.EQ.'N') THEN DO I=1,NOBSM DO J=1,NRS X(J,I)= (OMXMED-SEPS(J,I))*ZZ(1)+XMED XL(J,I)= LOG(X(J,I)) OMXL(J,I)= LOG(1.D0-X(J,I)) ENDDO ENDDO * *-----REDUCED ENERGIES * DO J=1,NRS DO I=1,NOBSM RSH(I,J)= SQRT(1.D0-X(J,I))*RS(J) ENDDO ENDDO * KFLAG= 0 CALL TOBSR(KFLAG,NRS,NOBSM,RSH,SIGMA,RS,AJN,AJD) * DO J=1,NRS BETAH= 0.5D0*BETA(J) BETAS= 1.D0/8.D0*BETA(J)*BETA(J) BETAM1= BETA(J)-1.D0 SBETA= SDELTA(J)*BETA(J) DO I=1,NOBSM RH1= -BETAH*(2.D0-X(J,I)) RH2= BETAS*((2.D0-X(J,I))*(3.D0*OMXL(J,I)- # 4.D0*XL(J,I))-4.D0/X(J,I)*OMXL(J,I)- # 6.D0+X(J,I)) * RAD(I,J)= SBETA*X(J,I)**BETAM1+RH1+RH2 ENDDO ENDDO * DO I3=1,NBSM IF(OBHABHA.EQ.'R'.AND.OINDX.NE.'NO') THEN IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 3 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+4 ELSE IF(OINDX.EQ.'BQ') THEN IF(I3.EQ.1) THEN I2= 9 ELSE IF(I3.EQ.2) THEN I2= 11 ENDIF ELSE IF(OINDX.EQ.'CQ') THEN IF(I3.EQ.1) THEN I2= 6 ELSE IF(I3.EQ.2) THEN I2= 10 ENDIF ENDIF ELSE I2= I3 ENDIF DO I1=1,NRS I= NRS*(I3-1)+I1 F(I)= (OMXMED-SEPS(I1,I2))*SIGMA1(I1,I2)* # (SIGMA(I1,I2)/SIGMA1(I1,I2)-1.D0)*RAD(I2,I1) ENDDO ENDDO * ENDIF * RETURN END * *-----EWCUT------------------------------------------------------ * WEAK CORRECTIONS ARE COMPUTED AND THE PHYSICAL QUANTITIES ARE * CONVOLUTED FOR LEPTONS WHEN CUTS ARE APPLIED * RETURNS IN COMMON/TTH/ SIGMA(E),A_FB(E) AND SIGMA(MU),SIGMA(TAU), * SIGMA(HAD),A_FB(MU),A_FB(TAU) IF CUTS ARE * PRESENT * SUBROUTINE TEWCUT(NRS) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8,OWBOX CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OCHAN,ORAD,OPRAD,OCN, # OBHABHA,OREST,OIFAIL CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3,NFL=4,KMX=NL*MNRS) PARAMETER (NDIM=1,MNFN=3*MNRS,IRCLS=2**NDIM+2*NDIM*NDIM+ # 2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS,LENWRK0=6*NDIM+ # 9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0) PARAMETER(NI=4,MAXPTS=30000*NI,LWRK=(NI+2)*(1+MAXPTS/ # (2**NI+2*NI*NI+2*NI+1))) * COMMON/TESC/SE COMMON/TIWOC/II COMMON/TOR/ORAD COMMON/TIBOX/NB COMMON/TSBOX/SB COMMON/TOPR/OPRAD COMMON/THARDC/DEL COMMON/TBOX/OWBOX COMMON/TMNL/IFMAX COMMON/TIFL/OIFAIL COMMON/TTWOC/SS,EE COMMON/TOHARDC/OCN COMMON/TSUP/OMODES COMMON/TCHAN/OCHAN COMMON/TFIXED/AX(4) COMMON/TACT/CM(KMX) COMMON/TIPARBOX/MXE COMMON/TECM/RS(MNRS) COMMON/TTCHANN/IT(NL) COMMON/TTYPI/JCOM,LCOM COMMON/TPARAM/PI,PIS,DELTA COMMON/TSCALE/ZM,TQM,HM,CALS COMMON/TGFER/GZ,GE0,GE,GM,GT,GH COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TPARBOXC/BSA(MNRS),BFI3(3),BBQF(3),BFM(3),BFMD(3), # RCHS(MNRS),AICHS(MNRS) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR COMMON/TLCUTS/S0CUT(3),THMIN(3),THMINP(3),THMAX(3),THMAXP(3), # ACOLL(3),E0(3) COMMON/TTH/SET(MNRS),AET(MNRS),SMUT(MNRS),AMUT(MNRS),STAUT(MNRS), # ATAUT(MNRS),SHADT(MNRS),ESET(MNRS),EAET(MNRS), # ESMUT(MNRS),EAMUT(MNRS),ESTAUT(MNRS),EATAUT(MNRS), # ESHADT(MNRS) COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION AL(NI),AU(NI),WRKST(LWRK) DIMENSION FBOX(MNRS,NL),BBOX(MNRS,NL) DIMENSION ESTV(MNRS,NI),SUBF(NL,MNRS),SUBB(NL,MNRS) DIMENSION XL(NDIM),XU(NDIM),AESTBF(MNFN),FESTBF(MNFN), # WRKSTR(LENWRK),AESTBB(MNFN),FESTBB(MNFN) * COMMON/TWA/WRKSTR COMMON/TWB/WRKST * EXTERNAL D01FCF,TWOC EXTERNAL D01EAF,TFUBBC * ALPHAS= CALS OPRAD= 'C' * *-----IT(I) SELECTS: * 0 S-CHANNEL ONLY * 1 ALL * IF(OEXT.EQ.'E') THEN IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN IFMAX= 3 IF(OCHAN.EQ.'S')THEN IT(1)= 0 ELSE IF(OCHAN.EQ.'F') THEN IT(1)= 1 ENDIF IT(2)= 0 IT(3)= 0 ELSE IF(OBHABHA.EQ.'R') THEN IFMAX= 1 IF(OINDX.EQ.'EL') THEN IF(OCHAN.EQ.'S')THEN IT(1)= 0 ELSE IF(OCHAN.EQ.'F') THEN IT(1)= 1 ENDIF IT(2)= 0 IT(3)= 0 ELSE IT(1)= 0 IT(2)= 0 IT(3)= 0 ENDIF ENDIF ELSE IFMAX= 1 IF(OCHAN.EQ.'S') THEN IT(1)= 0 ELSE IF(OCHAN.EQ.'F') THEN IT(1)= 1 ENDIF ENDIF ELSE IF(OEXT.EQ.'C') THEN IFMAX= 3 IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IT(1)= 0 IT(2)= 0 IT(3)= 0 ELSE IF(OCHAN.EQ.'S')THEN IT(1)= 0 ELSE IF(OCHAN.EQ.'F') THEN IT(1)= 1 ENDIF IT(2)= 0 IT(3)= 0 ENDIF ENDIF * IF(OMODES.EQ.'CALC') THEN CALL TWIDTHO(ZM,TQM,HM,ALPHAS,WT) ENDIF IF(OMODES.EQ.'FITC') THEN WT= GZ ENDIF CALL TQED(NRS,RS,RL,BETA,SDELTA,SDELTAP,WT,PCDEL,PCDELH, # AD1,ADD,SDELTA3,SDELTAP3) * IF(OBHABHA.EQ.'B'.OR.(OBHABHA.EQ.'R'.AND.OREST.EQ.'C'). # OR.(OMODES.EQ.'FITC'.AND.OBHABHA.NE.'N')) THEN KO= 0 MAXE= NRS CALL TWEAK(MAXE,RS,KO) ENDIF * IO= 1 CALL TOBSCUT(IO,NRS,ZM,IFMAX,S0CUT,E0,THMIN,THMINP, # ACOLL,OCN,DEL) * IF(OWBOX.EQ.'N') THEN DO I1=1,NRS DO I2=1,IFMAX FBOX(I1,I2)= 0.D0 BBOX(I1,I2)= 0.D0 ENDDO ENDDO * ELSE IF(OWBOX.EQ.'Y') THEN MXE= NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R'.AND.OINDX.EQ.'EL') THEN NFN= MXE BFI3(1)= ZID BBQF(1)= BQL BFM(1)= EM BFMD(1)= NM ELSE IF(OBHABHA.EQ.'R'.AND.OINDX.EQ.'MU') THEN NFN= MXE BFI3(1)= ZID BBQF(1)= BQL BFMD(1)= NM BFM(1)= MM IFCURR= 2 ELSE IF(OBHABHA.EQ.'R'.AND.OINDX.EQ.'TA') THEN NFN= MXE BFI3(1)= ZID BBQF(1)= BQL BFMD(1)= NM BFM(1)= TLM IFCURR= 3 ELSE IF(OBHABHA.EQ.'N') THEN NFN= 3*MXE BFI3(1)= ZID BBQF(1)= BQL BFM(1)= EM BFMD(1)= NM BFI3(2)= ZID BBQF(2)= BQL BFM(2)= MM BFMD(2)= NM BFI3(3)= ZID BBQF(3)= BQL BFM(3)= TLM BFMD(3)= NM ENDIF ELSE IF(NB.EQ.1) THEN NFN= MXE BFI3(1)= ZID BBQF(1)= BQL BFM(1)= EM BFMD(1)= NM ELSE IF(NB.EQ.0) THEN IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN NFN= MXE BFI3(1)= ZID BBQF(1)= BQL BFMD(1)= NM IF(OINDX.EQ.'MU') THEN BFM(1)= MM IFCURR= 2 ELSE IF(OINDX.EQ.'TA') THEN BFM(1)= TLM IFCURR= 3 ENDIF ELSE NFN= 3*MXE BFI3(1)= ZID BBQF(1)= BQL BFM(1)= EM BFMD(1)= NM BFI3(2)= ZID BBQF(2)= BQL BFM(2)= MM BFMD(2)= NM BFI3(3)= ZID BBQF(3)= BQL BFM(3)= TLM BFMD(3)= NM ENDIF ENDIF ENDIF * DO JE=1,MXE ORS= RS(JE) S= RS(JE)*RS(JE) BSA(JE)= S S2= S*S SMZM2= S-ZM2 ZWD= S/ZM2*WT DENS= SMZM2*SMZM2+ZM2*ZWD*ZWD RCHS(JE)= S*SMZM2/DENS AICHS(JE)= -S*SQRT(ZM2)*ZWD/DENS ENDDO * DTR= PI/180.D0 DO JE=1,MXE IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN THC= THMIN(1)*DTR ELSE IF(OINDX.EQ.'MU') THEN THC= THMIN(2)*DTR ELSE IF(OINDX.EQ.'TA') THEN THC= THMIN(3)*DTR ENDIF CM(JE)= COS(THC) ELSE DO JCS=1,IFMAX KK= MXE*(JCS-1)+JE THC= THMIN(JCS)*DTR CM(KK)= COS(THC) ENDDO ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN THC= THMIN(2)*DTR ELSE IF(OINDX.EQ.'TA') THEN THC= THMIN(3)*DTR ENDIF CM(JE)= COS(THC) ELSE DO JCS=1,IFMAX KK= MXE*(JCS-1)+JE THC= THMIN(JCS)*DTR CM(KK)= COS(THC) ENDDO ENDIF ENDIF ENDDO * *-----ONE-DIM. FORWARD INTEGRATION OF BOXES * SB= 1.D0 DO I= 1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO * MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-2*SE 400 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBBC, # AEQ,REQ,LENWRK,WRKSTR,FESTBF, # AESTBF,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EWCUT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 400 ENDIF * DO JE=1,MXE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN FBOX(JE,1)= FESTBF(JE) ELSE IF(NB.EQ.1) THEN FBOX(JE,1)= FESTBF(JE) ELSE IF(NB.EQ.0) THEN FBOX(JE,1)= FESTBF(JE) FBOX(JE,2)= FESTBF(JE+MXE) FBOX(JE,3)= FESTBF(JE+2*MXE) ENDIF ENDIF ENDDO * *-----ONE-DIM. BACKWARD INTEGRATION OF THE SOFT CONTRIBUTION * SB= -1.D0 DO I= 1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO * MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-2*SE 500 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBBC, # AEQ,REQ,LENWRK,WRKSTR,FESTBB, # AESTBB,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EWCUT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 500 ENDIF * DO JE=1,MXE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN BBOX(JE,1)= FESTBB(JE) ELSE IF(NB.EQ.1) THEN BBOX(JE,1)= FESTBB(JE) ELSE IF(NB.EQ.0.D0) THEN BBOX(JE,1)= FESTBB(JE) BBOX(JE,2)= FESTBB(JE+MXE) BBOX(JE,3)= FESTBB(JE+2*MXE) ENDIF ENDIF ENDDO ENDIF * DO IF=1,3 IF(THMINP(IF).NE.0.D0) THEN II= IF DO I1= 1,NRS SS= RS(I1)*RS(I1) IF(OTHRE.EQ.'M') THEN EE= S0CUT(IF)*S0CUT(IF)/SS IF(S0CUT(IF).GT.RS(NRS)) THEN EE= 0.01D0*ZM2/S ENDIF ELSE IF(OTHRE.EQ.'E') THEN EE= 2.D0*E0(IF)/RS(I1) IF(E0(IF).GT.(RS(NRS)/2.D0)) THEN EE= 0.01D0*ZM2/S ENDIF ENDIF DO J=1,2 DO L=1,2 JCOM= J LCOM= L K= 2*(L-1)+J DO IS=1,NI AL(IS)= 0.D0 AU(IS)= 1.D0 ENDDO REQ= 1.D-2 MINPTS= 0 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01FCF(NI,AL,AU,MINPTS,MAXPTS,TWOC,REQ,SAEST, # LWRK,WRKST,SEST,IFAIL) ESTV(I1,K)= SEST ENDDO ENDDO SUBF(IF,I1)= 0.D0 SUBB(IF,I1)= 0.D0 DO L=1,2 KF= 2*(L-1)+1 KB= 2*(L-1)+2 SUBF(IF,I1)= SUBF(IF,I1)+ESTV(I1,KF) SUBB(IF,I1)= SUBB(IF,I1)+ESTV(I1,KB) ENDDO ENDDO ELSE DO I1= 1,NRS SUBF(IF,I1)= 0.D0 SUBB(IF,I1)= 0.D0 ENDDO ENDIF ENDDO * DO I1=1,NRS IF(OEXT.EQ.'C') THEN IF(OBHABHA.EQ.'N') THEN SET(I1)= SET(I1)-SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)+BBOX(I1,1) SMUT(I1)= SMUT(I1)-SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,2)+BBOX(I1,2) STAUT(I1)= STAUT(I1)-SUBF(3,I1)-SUBB(3,I1)+ # FBOX(I1,3)+BBOX(I1,3) AET(I1)= (AET(I1)*SET(I1)+SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)-BBOX(I1,1))/(SET(I1)-SUBF(1,I1)- # SUBB(1,I1)+FBOX(I1,1)+BBOX(I1,1)) AMUT(I1)= (AMUT(I1)*SMUT(I1)+SUBF(2,I1)- # SUBB(2,I1)+FBOX(I1,2)- # BBOX(I1,2))/(SMUT(I1)-SUBF(2,I1)- # SUBB(2,I1)+FBOX(I1,2)+BBOX(I1,2)) ATAUT(I1)= (ATAUT(I1)*STAUT(I1)+SUBF(3,I1)- # SUBB(3,I1)+FBOX(I1,3)- # BBOX(I1,3))/(STAUT(I1)-SUBF(3,I1)- # SUBB(3,I1)+FBOX(I1,3)+BBOX(I1,3)) ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN SMUT(I1)= SMUT(I1)-SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,1)+BBOX(I1,1) AMUT(I1)= (AMUT(I1)*SMUT(I1)+SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,1)-BBOX(I1,1))/(SMUT(I1)-SUBF(2,I1)- # SUBB(2,I1)+FBOX(I1,1)+BBOX(I1,1)) ELSE IF(OINDX.EQ.'TA') THEN STAUT(I1)= STAUT(I1)-SUBF(3,I1)-SUBB(3,I1)+ # FBOX(I1,1)+BBOX(I1,1) ATAUT(I1)= (ATAUT(I1)*STAUT(I1)+SUBF(3,I1)- # SUBB(3,I1)+FBOX(I1,1)- # BBOX(I1,1))/(STAUT(I1)-SUBF(3,I1)- # SUBB(3,I1)+FBOX(I1,1)+BBOX(I1,1)) ENDIF ENDIF ELSE IF(OEXT.EQ.'E') THEN IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN SET(I1)= SET(I1)-SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)+BBOX(I1,1) SMUT(I1)= SMUT(I1)-SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,2)+BBOX(I1,2) STAUT(I1)= STAUT(I1)-SUBF(3,I1)-SUBB(3,I1)+ # FBOX(I1,3)+BBOX(I1,3) AET(I1)= (AET(I1)*SET(I1)+SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)-BBOX(I1,1))/(SET(I1)-SUBF(1,I1)- # SUBB(1,I1)+FBOX(I1,1)+BBOX(I1,1)) AMUT(I1)= (AMUT(I1)*SMUT(I1)+SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,2)-BBOX(I1,2))/(SMUT(I1)-SUBF(2,I1)- # SUBB(2,I1)+FBOX(I1,2)+BBOX(I1,2)) ATAUT(I1)= (ATAUT(I1)*STAUT(I1)+SUBF(3,I1)-SUBB(3,I1)+ # FBOX(I1,3)-BBOX(I1,3))/(STAUT(I1)-SUBF(3,I1)- # SUBB(3,I1)+FBOX(I1,3)+BBOX(I1,3)) ELSE IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN SET(I1)= SET(I1)-SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)+BBOX(I1,1) AET(I1)= (AET(I1)*SET(I1)+SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)-BBOX(I1,1))/(SET(I1)-SUBF(1,I1)- # SUBB(1,I1)+FBOX(I1,1)+BBOX(I1,1)) ELSE IF(OINDX.EQ.'MU') THEN SMUT(I1)= SMUT(I1)-SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,1)+BBOX(I1,1) AMUT(I1)= (AMUT(I1)*SMUT(I1)+SUBF(2,I1)-SUBB(2,I1)+ # FBOX(I1,1)-BBOX(I1,1))/(SMUT(I1)-SUBF(2,I1)- # SUBB(2,I1)+FBOX(I1,1)+BBOX(I1,1)) ELSE IF(OINDX.EQ.'TA') THEN STAUT(I1)= STAUT(I1)-SUBF(3,I1)-SUBB(3,I1)+ # FBOX(I1,1)+BBOX(I1,1) ATAUT(I1)= (ATAUT(I1)*STAUT(I1)+SUBF(3,I1)-SUBB(3,I1)+ # FBOX(I1,1)-BBOX(I1,1))/(STAUT(I1)-SUBF(3,I1)- # SUBB(3,I1)+FBOX(I1,1)+BBOX(I1,1)) ENDIF ENDIF ELSE SET(I1)= SET(I1)-SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)+BBOX(I1,1) AET(I1)= (AET(I1)*SET(I1)+SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)-BBOX(I1,1))/ # (SET(I1)-SUBF(1,I1)-SUBB(1,I1)+ # FBOX(I1,1)+BBOX(I1,1)) ENDIF ENDIF ENDDO * RETURN END * *-----FUNSUBBC--------------------------------------------------------- * SUBROUTINE TFUBBC(NDIM,X,NFN,F) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 CHARACTER*1 OWBOX,OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3,KMX=NL*MNRS) * COMMON/TIBOX/NB COMMON/TSBOX/SB COMMON/TBOX/OWBOX COMMON/TSUP/OMODES COMMON/TACT/CM(KMX) COMMON/TIPARBOX/MXE COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TPARBOXC/BSA(MNRS),BFI3(3),BBQF(3),BFM(3),BFMD(3), # RCHS(MNRS),AICHS(MNRS) COMMON/TCOBOX/CZZ(MNRS),CGZR(MNRS),CZW(MNRS),CGWR(MNRS), # CGZI(MNRS),CGWI(MNRS) * DIMENSION X(NDIM),F(NFN) DIMENSION Q0S1T(2),Q1S1T(2,3),Q2S1T(2,7) DIMENSION Q0S2T(2),Q1S2T(2,3),Q2S2T(2,7) DIMENSION Q0S3T(2),Q1S3T(2,3),Q2S3T(2,7) DIMENSION Q0S1(2),Q1S1(2,3),Q2S1(2,7) DIMENSION Q0S2(2),Q1S2(2,3),Q2S2(2,7) DIMENSION Q0S3(2),Q1S3(2,3),Q2S3(2,7) * VE= -0.5D0+2.D0*STH2 VEP= STH2 VEM= -0.5D0+STH2 IF(NB.EQ.1) THEN JCSM= 1 ELSE IF(NB.EQ.0) THEN IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN JCSM= 3 ELSE JCSM= 1 ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN JCSM= 1 ELSE JCSM= 3 ENDIF ENDIF ENDIF DO JE=1,MXE DO JCS=1,JCSM K= MXE*(JCS-1)+JE QS= BSA(JE)*1.D15*1.Q-15 QFM= BFM(JCS)*1.D15*1.Q-15 QFM2= QFM*QFM QFMD= BFMD(JCS)*1.D15*1.Q-15 QFMD2= QFMD*QFMD QC= SB*CM(K)*X(1)*1.D15*1.Q-15 QEB2= QS/4.Q0 QT= QEM2+QFM2-2.Q0*QEB2+2.Q0*SQRT(QEB2-QEM2)* # SQRT(QEB2-QFM2)*QC QU= 2.Q0*(QEM2+QFM2)-QS-QT QS2= QS*QS QT2= QT*QT QU2= QU*QU QT3= QT2*QT QU3= QU2*QU * *-----COMPUTES THE BOX CROSS SECTIONS * QP2S= -QS QP2T= -QT QP2U= -QU QZER= 0.Q0 * *-----DIRECT Z0 * CALL TDFFS(QP2S,QP2T,QFM2,QZM2,QZER,QZM2, # Q0S1T,Q1S1T,Q2S1T) * *-----CROSSED Z0 * CALL TDFFS(QP2S,QP2U,QFM2,QZM2,QZER,QZM2, # Q0S3T,Q1S3T,Q2S3T) * *-----DIRECT W * CALL TDFFS(QP2S,QP2T,QFMD2,QWM2,QZER,QWM2, # Q0S2T,Q1S2T,Q2S2T) * DO I=1,2 Q0S1(I)= Q0S1T(I) Q1S1(I,1)= Q1S1T(I,1) Q1S1(I,2)= Q1S1T(I,1)-Q1S1T(I,2)+Q1S1T(I,3) Q1S1(I,3)= Q1S1T(I,3) Q2S1(I,1)= Q2S1T(I,1) Q2S1(I,2)= Q2S1T(I,1)+Q2S1T(I,2)+Q2S1T(I,3)- # 2.Q0*(Q2S1T(I,4)-Q2S1T(I,5)+ # Q2S1T(I,6)) Q2S1(I,3)= Q2S1T(I,3) Q2S1(I,4)= Q2S1T(I,1)-Q2S1T(I,4)+Q2S1T(I,5) Q2S1(I,5)= Q2S1T(I,5) Q2S1(I,6)= Q2S1T(I,3)+Q2S1T(I,5)-Q2S1T(I,6) Q2S1(I,7)= Q2S1T(I,7) * Q0S2(I)= Q0S2T(I) Q1S2(I,1)= Q1S2T(I,1) Q1S2(I,2)= Q1S2T(I,1)-Q1S2T(I,2)+Q1S2T(I,3) Q1S2(I,3)= Q1S2T(I,3) Q2S2(I,1)= Q2S2T(I,1) Q2S2(I,2)= Q2S2T(I,1)+Q2S2T(I,2)+Q2S2T(I,3)- # 2.Q0*(Q2S2T(I,4)-Q2S2T(I,5)+ # Q2S2T(I,6)) Q2S2(I,3)= Q2S2T(I,3) Q2S2(I,4)= Q2S2T(I,1)-Q2S2T(I,4)+Q2S2T(I,5) Q2S2(I,5)= Q2S2T(I,5) Q2S2(I,6)= Q2S2T(I,3)+Q2S2T(I,5)-Q2S2T(I,6) Q2S2(I,7)= Q2S2T(I,7) * Q0S3(I)= Q0S3T(I) Q1S3(I,1)= Q1S3T(I,1) Q1S3(I,2)= Q1S3T(I,1)-Q1S3T(I,2)+Q1S3T(I,3) Q1S3(I,3)= Q1S3T(I,3) Q2S3(I,1)= Q2S3T(I,1) Q2S3(I,2)= Q2S3T(I,1)+Q2S3T(I,2)+Q2S3T(I,3)- # 2.Q0*(Q2S3T(I,4)-Q2S3T(I,5)+ # Q2S3T(I,6)) Q2S3(I,3)= Q2S3T(I,3) Q2S3(I,4)= Q2S3T(I,1)-Q2S3T(I,4)+Q2S3T(I,5) Q2S3(I,5)= Q2S3T(I,5) Q2S3(I,6)= Q2S3T(I,3)+Q2S3T(I,5)-Q2S3T(I,6) Q2S3(I,7)= Q2S3T(I,7) * ENDDO * VF= BFI3(JCS)-2.D0*BBQF(JCS)*STH2 VFP= -BBQF(JCS)*STH2 VFM= BFI3(JCS)-BBQF(JCS)*STH2 * VMM= VEM*VFM VMP= VEM*VFP VPM= VEP*VFM VPP= VEP*VFP RKA= VPP*VPP*VPP+VMM*VMM*VMM RKB= VPM*VPM*VPM+VMP*VMP*VMP RLA= VPP*VPP+VMM*VMM RLB= VPM*VPM+VMP*VMP RH= VMM * FCGZR= -256.D0/BSA(JE)*CGZR(JE)*BBQF(JCS) FCGZI= -256.D0/BSA(JE)*CGZI(JE)*BBQF(JCS) * FCGWR= -256.D0/BSA(JE)*CGWR(JE)*BBQF(JCS) FCGWI= -256.D0/BSA(JE)*CGWI(JE)*BBQF(JCS) * FCZZ= 1024.D0/BSA(JE)*CZZ(JE) * FCZW= 1024.D0/BSA(JE)*CZW(JE) * CMD1= QT*(QU2*RLA+QT2*RLB) CMD2= QT3*RLB CMD3= QT*(QU2*RLA+2.D0*QT2*RLB) CMD4= QT*QU*(-QU*RLA+2.D0*QT*RLB) CMD5= 2.D0*QT2*QS*RLB CMD6= -2.D0*(QU2*RLA+4.D0*QT2*RLB) * CMC1= -QU*(QU2*RLA+QT2*RLB) CMC2= -QU3*RLA CMC3= -QU*(2.D0*QU2*RLA+QT2*RLB) CMC4= -QT*QU*(2.D0*QU*RLA-QT*RLB) CMC5= -2.D0*QU2*QS*RLA CMC6= 2.D0*(4.D0*QU2*RLA+QT2*RLB) * *-----GAMMA X ZZ(DIRECT) * DGDZR= CMD1*Q1S1(1,1)+CMD2*(Q1S1(1,2)-Q1S1(1,3))+ # CMD3*Q2S1(1,4)+CMD4*Q2S1(1,5)+ # CMD5*Q2S1(1,6)+CMD6*Q2S1(1,7) DGDZI= CMD1*Q1S1(2,1)+CMD2*(Q1S1(2,2)-Q1S1(2,3))+ # CMD3*Q2S1(2,4)+CMD4*Q2S1(2,5)+ # CMD5*Q2S1(2,6)+CMD6*Q2S1(2,7) DGDZ= FCGZR*DGDZR+FCGZI*DGDZI * *-----GAMMA X ZZ(CROSSED) * DGCZR= CMC1*Q1S3(1,1)+CMC2*(Q1S3(1,2)-Q1S3(1,3))+ # CMC3*Q2S3(1,4)+CMC4*Q2S3(1,5)+ # CMC5*Q2S3(1,6)+CMC6*Q2S3(1,7) DGCZI= CMC1*Q1S3(2,1)+CMC2*(Q1S3(2,2)-Q1S3(2,3))+ # CMC3*Q2S3(2,4)+CMC4*Q2S3(2,5)+ # CMC5*Q2S3(2,6)+CMC6*Q2S3(2,7) DGCZ= FCGZR*DGCZR+FCGZI*DGCZI * *-----GAMMA X WW * DGWR= QU2*(QT*(Q1S2(1,1)+Q2S2(1,4)-Q2S2(1,5))- # 2.D0*Q2S2(1,7)) DGWI= QU2*(QT*(Q1S2(2,1)+Q2S2(2,4)-Q2S2(2,5))- # 2.D0*Q2S2(2,7)) DGW= FCGWR*DGWR+FCGWI*DGWI * CMDZ1= QT*(QU2*RKA+QT2*RKB) CMDZ2= QT3*RKB CMDZ3= QT*(QU2*RKA+2.D0*QT2*RKB) CMDZ4= QT*QU*(-QU*RKA+2.D0*QT*RKB) CMDZ5= 2.D0*QT2*QS*RKB CMDZ6= -2.D0*(QU2*RKA+4.D0*QT2*RKB) * CMCZ1= -QU*(QU2*RKA+QT2*RKB) CMCZ2= -QU3*RKA CMCZ3= -QU*(2.D0*QU2*RKA+QT2*RKB) CMCZ4= -QT*QU*(2.D0*QU*RKA-QT*RKB) CMCZ5= -2.D0*QU2*QS*RKA CMCZ6= 2.D0*(4.D0*QU2*RKA+QT2*RKB) * *-----Z X ZZ(DIRECT) * DZDZR= CMDZ1*Q1S1(1,1)+CMDZ2*(Q1S1(1,2)-Q1S1(1,3))+ # CMDZ3*Q2S1(1,4)+CMDZ4*Q2S1(1,5)+ # CMDZ5*Q2S1(1,6)+CMDZ6*Q2S1(1,7) DZDZI= CMDZ1*Q1S1(2,1)+CMDZ2*(Q1S1(2,2)-Q1S1(2,3))+ # CMDZ3*Q2S1(2,4)+CMDZ4*Q2S1(2,5)+ # CMDZ5*Q2S1(2,6)+CMDZ6*Q2S1(2,7) DZDZ= FCZZ*(RCHS(JE)*DZDZR+AICHS(JE)*DZDZI) * *-----Z X ZZ(CROSSED) * DZCZR= CMCZ1*Q1S3(1,1)+CMCZ2*(Q1S3(1,2)-Q1S3(1,3))+ # CMCZ3*Q2S3(1,4)+CMCZ4*Q2S3(1,5)+ # CMCZ5*Q2S3(1,6)+CMCZ6*Q2S3(1,7) DZCZI= CMCZ1*Q1S3(2,1)+CMCZ2*(Q1S3(2,2)-Q1S3(2,3))+ # CMCZ3*Q2S3(2,4)+CMCZ4*Q2S3(2,5)+ # CMCZ5*Q2S3(2,6)+CMCZ6*Q2S3(2,7) DZCZ= FCZZ*(RCHS(JE)*DZCZR+AICHS(JE)*DZCZI) * *-----Z X WW * DZWR= QU2*(QT*(Q1S2(1,1)+Q2S2(1,4)- # Q2S2(1,5))-2.D0*Q2S2(1,7)) DZWI= QU2*(QT*(Q1S2(2,1)+Q2S2(2,4)- # Q2S2(2,5))-2.D0*Q2S2(2,7)) DZW= RH*FCZW*(RCHS(JE)*DZWR+AICHS(JE)*DZWI) * CONVF= 2.D0*PI*CONV/4.D0/64.D0/PIS/QS F(K)= CONVF*(DGDZ+DGCZ+DGW+DZDZ+DZCZ+DZW)*CM(K) * ENDDO ENDDO RETURN END * *-----PRAD--------------------------------------------------------------- *-----PRIMITIVE OF THE RADIATOR * REAL*8 FUNCTION TPRAD(I,II,X,OMX) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*1 OHC,ORAD,OPRAD,OCHAN,OIFAIL CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST,OPREC CHARACTER*2 OINDX CHARACTER*4 OMODES * EXTERNAL D01EAF,THYFS,THRADA * PARAMETER(NDM=1,NFN=1,IRCLS=2**NDM+2*NDM*NDM+2*NDM+1, # MNCLS=0,MXCLS=5000*IRCLS, # LENWRK0=6*NDM+9*NFN+(NDM+NFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0) PARAMETER(MNRS=30) PARAMETER(NFL=4,NL=3) * DIMENSION YL(NDM),YU(NDM),YFSH(NFN),EYFSH(NFN),WRKSTR(LENWRK) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TP/OPREC COMMON/TOPR/OPRAD COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TCHAN/OCHAN COMMON/TXLM/XX,BETAI COMMON/TICOUPLING/NF COMMON/TSDRL/RLJ,SDELTAI COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TWA/WRKSTR * IF(OPREC.EQ.'H') THEN MNCLSA= 1000 ELSE MNCLSA= MNCLS ENDIF * IF(OHC.EQ.'Y') THEN BL= RL(I) BLM1= BL-1.D0 X2= X*X OMX2= OMX*OMX RLX= LOG(X) RLOMX= LOG(OMX) RLX2= RLX*RLX RLOMX2= RLOMX*RLOMX RLOMX3= RLOMX2*RLOMX CALL TPOLYL(X,OMX,S11,S12,S13,S21,S22) S112= S11*S11 * IF(((OEXT.EQ.'E'.AND.OPRAD.EQ.'E'.AND. # (II.EQ.3.OR.II.EQ.4.OR.II.EQ.10.OR.II.EQ.11)) # .OR.(OEXT.EQ.'C'.AND.OPRAD.EQ.'E'.AND. # (II.EQ.6.OR.II.EQ.7))).OR. # ((OEXT.EQ.'E'.AND.OPRAD.EQ.'C'.AND. # (OCHAN.EQ.'S'.AND.(II.EQ.2))) # .OR.(OEXT.EQ.'C'.AND.OPRAD.EQ.'C'.AND. # ((OCHAN.EQ.'S'.AND.II.EQ.2).OR.II.EQ.4.OR.II.EQ.6))). # OR.(OMODES.EQ.'FITC'.AND.(II.EQ.2.OR.II.EQ.4. # OR.II.EQ.6))) THEN X2= X*X OMXL= LOG(OMX) SOMX= SQRT(OMX) EPS= -1.D-37 RLI2X= TRSPENCE(X,EPS) XL= LOG(X) ARGD= OMX/(2.D0-X) DLARGD= TRSPENCE(ARGD,EPS) DLOH= TRSPENCE(0.5D0,EPS) PRADFB1= BETA(I)/2.D0*(4.D0*(0.5D0-X-1.D0/(2.D0-X) # +1.5D0*LOG(2.D0/(2.D0-X)))) # -API*4.D0*(2.D0*LOG(2.D0)*(LOG(2.D0/(2.D0-X)) # +0.5D0-1.D0/(2.D0-X)) # -RLOMX*(-OMX/(2.D0-X)+LOG(2.D0-X)) # -1.5D0*((LOG(2.D0))**2-(LOG(2.D0-X))**2) # +X/(2.D0-X)*(LOG(2.D0-X)+1.D0) # +DLARGD-DLOH) PRAD2S= 1.D0/8.D0*BETA(I)*BETA(I)*(-2.5D0*X+0.25D0*X2- # 6.D0*OMXL+6.D0*X*OMXL-1.5D0*X2*OMXL+1.5D0*OMXL- # 8.D0*X*XL+2.D0*X2*XL+4.D0*RLI2X) PRADFB2= (API/2.D0*RL(I))**2* # (8.D0+20.D0/3.D0*X+X2-16.D0/(2.D0-X) # +48.D0*(PIS/16.D0-(ATAN(SOMX))**2) # +4.D0*(-2.D0/3.D0*(11.D0+X)*SOMX # -4.D0*SOMX/(2.D0-X)+12.D0*ATAN(SOMX)) # *(ATAN(SOMX)-ATAN(1.D0/SOMX) ) # -104.D0/3.D0*LOG(2.D0/(2.D0-X)) # -4.D0*LOG(OMX)*(LOG(2.D0-X)+X-1.D0) # +4.D0*(DLARGD-DLOH) # +2.D0*((LOG(2.D0-X))**2-(LOG(2.D0))**2)) PRADFB2= PRAD2S+PRADFB2 TPRAD= SDELTA(I)*X**BETA(I)+PRADFB1+PRADFB2 ELSE * BX2= RLOMX*OMX*(-1.5D0)+RLOMX*OMX2*(-0.75D0)+ # S11*(2.D0)+OMX*(2.5D0)+OMX2*(-0.125D0)- # 19.D0/8.D0 BX1= RLX*RLOMX*OMX+RLX*RLOMX*OMX2*(0.5D0)+ # RLX*S11*(-2.D0)-RLX*OMX+RLX*OMX2*(-0.25D0)+ # RLX*(1.25D0)+RLOMX*OMX*(6.D0)+ # RLOMX*OMX2*(17.D0/8.D0)+RLOMX2*OMX*(-0.75D0)+ # RLOMX2*OMX2*(-0.375D0)+S11*OMX BX1= BX1+S11*OMX2*(0.5D0)+S11*(-7.D0)+ # S21*(4.D0)+S12*(-2.D0)+OMX*(-33.D0/4.D0)+ # OMX2*(9.D0/16.D0)+123.D0/16.D0 BX0= RLOMX2*OMX2/X2*(1.D0/3.D0)+RLOMX*OMX/X* # (2.D0/3.D0)+RLOMX2*OMX/X*(-2.D0)+ # RLX*RLOMX*OMX*(-1.5D0)+RLX*RLOMX*OMX2+ # RLX*RLOMX2*OMX*(0.5D0)+RLX*RLOMX2*OMX2* # (0.25D0)+RLX*S11*OMX+RLX*S11*OMX2*(0.5D0)+ # RLX*S11*(1.5D0)+RLX*S12*(2.D0) BX0= BX0+RLX*OMX*(0.75D0)+RLX*OMX2*(0.625D0)+ # RLX*(-11.D0/8.D0)+RLX2*OMX*(0.25D0)+ # RLX2*OMX2*(-0.625D0)+RLX2*(0.375D0)+ # RLOMX*S11*OMX*(0.5D0)+RLOMX*S11*OMX2* # (0.25D0)+RLOMX*OMX*(-1.D0/12.D0+RZ2)+ # RLOMX*OMX2*(-685.D0/264.D0+0.5D0*RZ2) BX0= BX0+RLOMX2*OMX*(-2.D0)+RLOMX2*OMX2* # (45.D0/88.D0)+RLOMX3*OMX*(-1.D0/6.D0)+ # RLOMX3*OMX2*(-1.D0/12.D0)+S11*OMX* # (-1.25D0)+S11*OMX2*(4.D0/3.D0)+ # S11*(101.D0/12.D0-2.D0*RZ2)+S112*(-0.5D0)+ # S21*OMX*(-1.5D0)+S21*OMX2*(-0.75D0) BX0= BX0+S21*(-15.D0/4.D0)+S12*OMX*(2.D0)+ # S12*OMX2+S12*(-7.D0)+S13*(2.D0)+ # S22*(-2.D0)+OMX*(-35.D0/24.D0)+ # OMX2*(163.D0/132.D0-29.D0/12.D0*RZ2)+ # 49.D0/88.D0+29.D0/12.D0*RZ2 * IF((OEXT.EQ.'E'.AND.OPRAD.EQ.'C'.AND. # OCHAN.EQ.'F'.AND.II.EQ.1) # .OR.(OEXT.EQ.'C'.AND.OPRAD.EQ.'C'.AND. # OCHAN.EQ.'F'.AND.II.EQ.1).OR.(OMODES.EQ.'FITC'.AND. # (OBHABHA.EQ.'N'.OR.(OBHABHA.EQ.'R'.AND.OINDX.EQ.'EL')). # AND.OCHAN.EQ.'F'.AND.II.EQ.1)) THEN EPS= -1.D-37 RLI2X= TRSPENCE(X,EPS) XL= LOG(X) OMXL= LOG(OMX) PRAD1= -0.5D0*BETA(I)*(2.D0*X-0.5D0*X2) PRAD2= 1.D0/8.D0*BETA(I)*BETA(I)*(-2.5D0*X+0.25D0*X2- # 6.D0*OMXL+6.D0*X*OMXL-1.5D0*X2*OMXL+1.5D0*OMXL- # 8.D0*X*XL+2.D0*X2*XL+4.D0*RLI2X) TPRAD= SDELTA(I)*X**BETA(I)+PRAD1+PRAD2 ELSE IF(ORAD.EQ.'A') THEN PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0-2.D0*BLM1*BLM1*X* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*X*(2.D0-0.5D0*X)) TPRAD= SDELTA(I)*X**BETA(I)+PRAD1+PRAD2 * PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0-2.D0*BLM1*BLM1*X* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*X*(2.D0-0.5D0*X)) TPRAD= SDELTA(I)*X**BETA(I)+PRAD1+PRAD2 ELSE IF(ORAD.EQ.'D') THEN PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0+X*(-2.D0*BLM1*BLM1* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*(2.D0-0.5D0*X))) ARGE= -BETA(I)*EGAM ARGG= 1.D0+BETA(I) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB TPRAD= X**BETA(I)*FGL*EXP(AD1(I))*ADD(I)+PRAD1+PRAD2 ELSE IF(ORAD.EQ.'E') THEN PRAD2= APIS*((BX2*BL+BX1)*BL+BX0) BETAI= BETA(I) ARGE= -BETA(I)*EGAM ARGG= 1.D0+BETA(I) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB TPRAD= X**BETAI*(1.D0-BETAI/(BETAI+1.D0)*X+0.5D0*BETAI/ # (BETAI+2.D0)*X*X)*FGL*EXP(AD1(I))*ADD(I)+PRAD2 ELSE IF(ORAD.EQ.'F') THEN PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0-2.D0*BLM1*BLM1*X* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*X*(2.D0-0.5D0*X)) S121= RZ3 S11OMX= -S11-RLX*RLOMX+RZ2 S12OMX= -S21+RLX*S11+0.5D0*RLOMX*RLX2+RZ3 PRAD3= (13.D0/8.D0-PIS)*X2+(4.D0*PIS-5.D0)*X # -9.D0/2.D0*PIS-24.D0*S121 # +6.D0*X*(X-4.D0)*RLX2 # +3.D0*X*(X/2.D0-5.D0)*RLX+7.D0*(X2/4.D0-X # +3.D0/4.D0)*RLOMX2 # +(-X2+15.D0/2.D0*X-13.D0/2.D0)*RLOMX # -12.D0*RLX2*RLOMX # +9.D0*X*(4.D0-X)*RLX*RLOMX # +(-3.D0*X2+12.D0*X+18.D0)*S11 # +27.D0*S11OMX+8.D0*S12+24.D0*S12OMX PRAD3= PRAD3*BETA(I)**3/48.D0 TPRAD= (SDELTA(I)+SDELTA3(I))*X**BETA(I) # +PRAD1+PRAD2+PRAD3 ELSE IF(ORAD.EQ.'Y') THEN XX= X BETAI= BETA(I) DO JJ=1,NDM YL(JJ)= 0.D0 YU(JJ)= 1.D0 ENDDO DO JJ=1,NFN YFSH(JJ)= 0.D0 EYFSH(JJ)= 0.D0 ENDDO MULFAC= 2**NDM MINCLS= MNCLSA MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-8 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDM,YL,YU,MINCLS,MAXCLS,NFN,THYFS,AEQ,REQ, # LENWRK,WRKSTR,YFSH,EYFSH,IFAIL) IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY TPRAD ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF TPRAD= YFSH(1) ENDIF ENDIF ENDIF * ELSE IF(OHC.EQ.'N') THEN X2= X*X OMXL= LOG(OMX) EPS= -1.D-37 RLI2X= TRSPENCE(X,EPS) XL= LOG(X) * PRAD1= -0.5D0*BETA(I)*(2.D0*X-0.5D0*X2) PRAD2= 1.D0/8.D0*BETA(I)*BETA(I)*(-2.5D0*X+0.25D0*X2- # 6.D0*OMXL+6.D0*X*OMXL-1.5D0*X2*OMXL+1.5D0*OMXL- # 8.D0*X*XL+2.D0*X2*XL+4.D0*RLI2X) * TPRAD= SDELTA(I)*X**BETA(I)+PRAD1+PRAD2 * ENDIF * RETURN END * *-----POLYLOGARITHMS------------------------------------------- * SUBROUTINE TPOLYL(X,EP,S11,S12,S13,S21,S22) IMPLICIT REAL*8(A-H,O-Z) * COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 * DIMENSION C31(0:14) DIMENSION C21(0:14),C22(0:14) DIMENSION C11(0:14),C12(0:14),C13(0:14) * DATA C11/1.D0,-0.25D0,0.277777777777778D-1,0.D0, # -0.277777777777778D-3,0.D0,0.472411186696901D-5, # 0.D0,-0.918577307466196D-7,0.D0, # 0.189788699889710D-8,0.D0,-0.406476164514423D-10, # 0.D0,0.892169102045645D-12/ DATA C12/0.5D0,-0.166666666666667D0,0.208333333333333D-1, # 0.D0,-0.231481481481481D-3,0.D0, # 0.413359788359788D-5,0.D0,-0.826719576719577D-7, # 0.D0,0.173972974898901D-8,0.D0, # -0.377442152763392D-10,0.D0,0.836408533167792D-12/ DATA C13/0.333333333333333D0,-0.125D0,0.166666666666667D-1, # 0.D0,-0.198412698412698D-3,0.D0, # 0.367430922986479D-5,0.D0,-0.751563251563252D-7, # 0.D0,0.160590438368216D-8,0.D0, # -0.352279342579166D-10,0.D0, # 0.787208031216746D-12/ DATA C21/1.D0,-0.375D0,0.787037037037037D-1, # -0.868055555555556D-2,0.129629629629630D-3, # 0.810185185185185D-4,-0.341935716085376D-5, # -0.132865646258503D-5,0.866087175610985D-7, # 0.252608759553204D-7,-0.214469446836406D-8, # -0.514011062201298D-9,0.524958211460083D-10, # 0.108877544066363D-10,-0.127793960944937D-11/ DATA C22/0.25D0,-0.138888888888889D0, # 0.364583333333333D-1,-0.486111111111111D-2, # 0.135030864197531D-3,0.496031746031746D-4, # -0.344466490299824D-5,-0.842029198510680D-6, # 0.858869782480894D-7,0.162838704505371D-7, # -0.211087209544000D-8,-0.334563413267117D-9, # 0.514886915462357D-10,0.712946288553074D-11, # -0.125165407568878D-11/ DATA C31/1.D0,-0.4375D0,0.116512345679012D0, # -0.198206018518519D-1,0.192793209876543D-2, # -0.310570987654321D-4,-0.156240091148578D-4, # 0.848512354677321D-6,0.229096166031897D-6, # -0.218326142185269D-7,-0.388282487917202D-8, # 0.544629210322033D-9,0.696080521068273D-10, # -0.133757376864452D-10,-0.127848526852666D-11/ * IF(X.EQ.0.5D0) THEN RLT= LOG(2.D0) RLTS= RLT*RLT RLTC= RLTS*RLT RLTF= RLTC*RLT S11= 0.5D0*(RZ2-RLTS) S21= 7.D0/8.D0*RZ3-0.5D0*RLT*RZ2+1.D0/6.D0*RLTC S12= -RLTC/6.D0+RZ3/8.D0 S22= -RLT*RZ3/8.D0+RLTF/24.D0+RZ2*RZ2/20.D0 S13= 2.D0/5.D0*RZ2*RZ2-RA4-RLT*S21-0.5D0*RLTS*S11- # RLTF/6.D0 S31= RA4 RETURN ENDIF * IF(X.GT.0.D0.AND.X.LT.0.5D0) THEN Z= X AR= -LOG(EP) ELSE IF(X.GT.0.5D0.AND.X.LT.1.D0) THEN Z= EP IF(EP.LE.1.D-5) THEN AR= EP*(1.D0+EP*(0.5D0+EP*(1.D0/3.D0+0.25D0*EP))) ELSE AR= -LOG(X) ENDIF ELSE PRINT*,' ANOMALOUS ARGUMENT IN POLYL' ENDIF * AS11= AR*(C11(0)+AR*(C11(1)+AR*(C11(2)+AR*(C11(3)+ # AR*(C11(4)+AR*(C11(5)+AR*(C11(6)+AR*(C11(7)+ # AR*(C11(8)+AR*(C11(9)+AR*(C11(10)+AR*(C11(11)+ # AR*(C11(12)+AR*(C11(13)+AR*C11(14))))))))))))))) AS12= AR*AR/2.D0*(C12(0)+AR*(C12(1)+AR*(C12(2)+AR*(C12(3)+ # AR*(C12(4)+AR*(C12(5)+AR*(C12(6)+AR*(C12(7)+ # AR*(C12(8)+AR*(C12(9)+AR*(C12(10)+AR*(C12(11)+ # AR*(C12(12)+AR*(C12(13)+AR*C12(14))))))))))))))) AS13= AR*AR*AR/6.D0*(C13(0)+AR*(C13(1)+AR*(C13(2)+AR*(C13(3)+ # AR*(C13(4)+AR*(C13(5)+AR*(C13(6)+AR*(C13(7)+ # AR*(C13(8)+AR*(C13(9)+AR*(C13(10)+AR*(C13(11)+ # AR*(C13(12)+AR*(C13(13)+AR*C13(14))))))))))))))) AS21= AR*(C21(0)+AR*(C21(1)+AR*(C21(2)+AR*(C21(3)+ # AR*(C21(4)+AR*(C21(5)+AR*(C21(6)+AR*(C21(7)+ # AR*(C21(8)+AR*(C21(9)+AR*(C21(10)+AR*(C21(11)+ # AR*(C21(12)+AR*(C21(13)+AR*C21(14))))))))))))))) AS22= AR*AR/2.D0*(C22(0)+AR*(C22(1)+AR*(C22(2)+AR*(C22(3)+ # AR*(C22(4)+AR*(C22(5)+AR*(C22(6)+AR*(C22(7)+ # AR*(C22(8)+AR*(C22(9)+AR*(C22(10)+AR*(C22(11)+ # AR*(C22(12)+AR*(C22(13)+AR*C22(14))))))))))))))) IF(X.GT.0.5D0.AND.X.LT.1.D0) THEN AS31= AR*(C31(0)+AR*(C31(1)+AR*(C31(2)+AR*(C31(3)+ # AR*(C31(4)+AR*(C31(5)+AR*(C31(6)+AR*(C31(7)+ # AR*(C31(8)+AR*(C31(9)+AR*(C31(10)+AR*(C31(11)+ # AR*(C31(12)+AR*(C31(13)+AR*C31(14))))))))))))))) ENDIF * IF(EP.LE.1.D-5) THEN RLX= -EP*(1.D0+EP*(0.5D0+EP*(1.D0/3.D0+0.25D0*EP))) ELSE RLX= LOG(X) ENDIF RLX2= RLX*RLX RLOMX= LOG(1.D0-X) RLOMX2= RLOMX*RLOMX RLOMX3= RLOMX2*RLOMX IF(X.GT.0.5D0.AND.X.LT.1.D0) THEN S11= -AS11-RLX*RLOMX+RZ2 S21= -AS12-RLX*AS11-0.5D0*RLOMX*RLX2+RZ2*RLX+RZ3 S12= RZ3-AS21+RLOMX*AS11+0.5D0*RLX*RLOMX2 S22= RZ2*RZ2/10.D0-AS22+RLOMX*AS12+RLX*(RZ3-AS21+ # RLOMX*AS11)+0.25D0*RLX2*RLOMX2 S13= 2.D0/5.D0*RZ2*RZ2-AS31+RLOMX*AS21-0.5D0*RLOMX2*AS11- # 1.D0/6.D0*RLX*RLOMX3 ELSE IF(X.GT.0.D0.AND.X.LT.0.5D0) THEN S11= AS11 S12= AS12 S13= AS13 S21= AS21 S22= AS22 ENDIF * RETURN END * *-----THYFS---------------------------------------------------------------- *-----COMPUTES NUMERICALLY THE PRIMITIVE OF THE RADIATOR (YFS FORM) * SUBROUTINE THYFS(NDIM,C,NFUN,F) IMPLICIT REAL*8 (A-H,O-Z) * COMMON/TXLM/XX,BETAI COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS * DIMENSION C(NDIM),F(NFUN) * BETA= BETAI BETAS= BETA*BETA AN= XX**BETA OOB= 1.D0/BETA Y= XX*C(1)**OOB Z= 1.D0-Y ZS= Z*Z * EPS= -1.D-37 RLI2Y= TRSPENCE(Y,EPS) * OMZ= Y OMZS= OMZ*OMZ ALZ= LOG(Z) ALOMZ= LOG(OMZ) ALZ2= ALZ*ALZ EULG= EGAM * ARGG= 1.D0+BETA IFG= 1 GAMB= S14AAF(ARGG,IFG) H_YFSEXP= AN/GAMB*EXP((3.D0/4.D0-EULG)*BETA+ # API*(2.D0*RZ2-0.5D0)) H0= 0.5D0*(1.D0+ZS) HA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA HA= HA+1.D0/8.D0*(4.D0*(1.D0+ZS)*(RLI2Y+ALOMZ*ALZ)- # (1.D0+3.D0*ZS)*ALZ2+2.D0*(3.D0+2.D0*Z+ZS)*ALZ+ # 2.D0*OMZ*(3.D0-2.D0*Z)) HA= API*HA HB= 1.D0/8.D0*BETA*(-(1.D0+3.D0*ZS)*ALZ-2.D0*OMZS) HB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ALZ2+0.5D0*OMZ*(1.D0-3.D0*Z)* # ALZ+OMZS+(1.D0-ZS)*RLI2Y HB2= 1.D0/8.D0*BETAS*HB2 H_YFS= H_YFSEXP*(H0+HA+HB+HB2) F(1)= H_YFS * RETURN END * *-----THRADA---------------------------------------------------------------- *-----COMPUTES NUMERICALLY THE PRIMITIVE OF THE RADIATOR (A) * SUBROUTINE THRADA(NDIM,C,NFUN,F) IMPLICIT REAL*8 (A-H,O-Z) * COMMON/TXLM/XX,BETAI COMMON/TSDRL/RLJ,SDELTAI COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS * DIMENSION C(NDIM),F(NFUN) * BETA= BETAI BETAM= 0.5D0*BETA BETAS= BETA*BETA SDELTA= SDELTAI AN= XX**BETA OOB= 1.D0/BETA Y= XX*C(1)**OOB PM1= AN/BETA*Y**(1.D0-BETA) Z= 1.D0-Y ZS= Z*Z * OMZ= Y OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZL= LOG(OMZ) ZL02= OMZL*OMZL OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) ZL20= ZL*ZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z IF(OMZ.LT.1.D-30) THEN HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL-ZL20)+ # OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)*ZL11- # 25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)*RZ2+ # (1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0+11.D0/6.D0*OMZ-49.D0/99.D0*OMZ*OMZ ELSE HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL-ZL20)+ # OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)*ZL11- # 25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)*RZ2+ # (1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/OMZ* # (1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) ENDIF * A2L2= APIS*RLJ*RLJ A2L1= APIS*RLJ A1L1= API*RLJ A1L0= API A2L0= APIS RLM1= RLJ-1.D0 SP1= A2L2*(HR2-OPZ*(2.D0*OMZL+1.5D0)) SP2= A2L1*(HR1-OPZ*(-4.D0*OMZL-1.5D0+2.D0*RZ2-2.D0)) SP3= A2L0*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -A1L1*OPZ SP5= A1L0*OPZ RH= SP1+SP2+SP3+SP4+SP5 H_A= SDELTA*AN+RH*PM1 F(1)= H_A * RETURN END * *-----QED----------------------------------------------------------------- *-----COMPUTES THE INGREDIENTS NEEDED FOR QED INITIAL STATE CORRECTIONS * SUBROUTINE TQED(NRS,ARS,ARL,ABETA,ASDELTA,ASDELTAP,WT, # APDEL,APDELH,AD1,ADD,ASDELTA3,ASDELTAP3) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM2,NM2 CHARACTER*1 ONP,OHC,ORAD * PARAMETER(MNRS=30) PARAMETER(NFL=4) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TICOUPLING/NF COMMON/TPAIR/ONP(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 * DIMENSION ARS(MNRS),ARL(MNRS),ABETA(MNRS),ASDELTA(MNRS), # ASDELTAP(MNRS),APDEL(MNRS,NFL),APDELH(MNRS,NFL), # ASDELTA3(MNRS),ASDELTAP3(MNRS) DIMENSION PCDELT(NFL),PCDELTH(NFL),AD1(MNRS),ADD(MNRS) * *-----COMPUTES RL, BETA AND SDELTA * TL= LOG(2.D0) RZ2S= RZ2*RZ2 DO I=1,NRS RS= ARS(I) S= RS*RS RL= LOG(S/EM2) RL2= RL*RL BETA= 2.D0*API*(RL-1.D0) BETAS= BETA*BETA BETAC= BETAS*BETA DELTA1= API*(1.5D0*RL+PIS/3.D0-2.D0) DELTA2= APIS*((9.D0/8.D0-2.D0*RZ2)*RL2+ # (-45.D0/16.D0+11.D0/2.D0*RZ2+3.D0*RZ3)*RL- # 6.D0/5.D0*RZ2S-9.D0/2.D0*RZ3-6.D0*RZ2*TL+ # 19.D0/24.D0*RZ2+19.D0/4.D0) DELTAD= 1.D0+APIS*((3.D0/16.D0-1.5D0*RZ2+3.D0*RZ3)*RL- # 16.D0/5.D0*RZ2S-9.D0/2.D0*RZ3-6.D0*RZ2*TL+ # 163.D0/24.D0*RZ2+11.D0/4.D0) SDELTA= 1.D0+DELTA1+DELTA2 G1= 3.D0/4.D0*BETA PG21= -2.40411380631919D0 G3= BETAC/32.D0*(9.D0/4.D0-PIS-4.D0/3.D0*PG21) SDELTA3= G3-BETAS*(PIS/24.D0*G1+BETA/8.D0*PG21) * *-----INCLUDES PAIR PRODUCTION AT THE REQUESTED ENERGIES * IF(ONP(I).EQ.'Y') THEN CALL TPAIRS(RS,WT,PCDELT,PCDELTH) ELSE DO I1= 1,NFL PCDELT(I1)= 0.D0 PCDELTH(I1)= 0.D0 ENDDO ENDIF * ARL(I)= RL ABETA(I)= BETA ASDELTA(I)= SDELTA ASDELTAP(I)= SQRT(SDELTA+PIS/24.D0*BETAS) * IF(OHC.EQ.'Y'.AND.ORAD.EQ.'F') THEN ASDELTA3(I)= SDELTA3 ASDELTAP3(I)= SQRT(SDELTA+PIS/24.D0*BETAS+ # SDELTA3+BETAS*(PIS/24.D0*DELTA1+ # PG21*BETA/8.D0)) ELSE ASDELTA3(I)= 0.D0 ASDELTAP3(I)= ASDELTAP(I) ENDIF * AD1(I)= DELTA1 ADD(I)= DELTAD DO I2= 1,NFL APDEL(I,I2)= PCDELT(I2) APDELH(I,I2)= PCDELTH(I2) ENDDO * ENDDO * RETURN END * *-----W MASS AND S^2-------------------------------------------------- * SUBROUTINE TBASIC(NT,ST,FVECMS,IFLAG) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 * CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OAAS,OAL CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 * PARAMETER(NPO=34) * COMMON/TAAS/SC COMMON/OST/OSTR2 COMMON/TCALEM/OAL COMMON/TCAAS/OAAS COMMON/TSSCAL/QSPSC COMMON/TICOUPLING/NF COMMON/TTRANS/REST(2) COMMON/TSUB/OSINT2,ODSWW COMMON/TAFJTR/ALST,ALSTSZ COMMON/TPARAM/PI,PIS,DELTA COMMON/TNUMC/SCS2,SCD3,SCB4 COMMON/TCBASI/BZM,BTQM,BHM,BALS COMMON/TMIX/QALST,QALSTZ,QALSTS COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION ST(NT),FVECMS(NT) DIMENSION XXXR(30),YYYR(30),ZZZR(30),XARRR(15),YARRR(15) * *-----VARIA * IF(OU7.EQ.'Y') THEN OU8= 'C' ENDIF Z4= PIS*PIS/90.D0 * *-----MASSES * ZM= BZM TQM= BTQM HM= BHM ALS= BALS * ZM2= ZM*ZM QZM= ZM*1.D15*1.Q-15 QZM2= QZM*QZM TQM2= TQM*TQM QTQM= TQM*1.D15*1.Q-15 QTQM2= QTQM*QTQM HM2= HM*HM QHM= HM*1.D15*1.Q-15 QHM2= QHM*QHM XI= TQM2/ZM2 XI2= XI*XI * WM2= ST(1)*ZM2 WM= SQRT(WM2) STR2= ST(2) OSTR2= STR2 STR4= STR2*STR2 CTR2= 1.D0-STR2 CTR4= CTR2*CTR2 CTR6= CTR4*CTR2 CMSTR2= CTR2-STR2 CSTR2= CTR2*STR2 * GWEAK= GF*ZM2 GWEAK2= GWEAK*GWEAK GFC= GWEAK/2.D0/PIS * *-----QCD CORRECTION TO RHO * IF(TQM.GT.ZM) THEN RSQCD= TQM ELSE RSQCD= ZM ENDIF ALST= TRALPHAS(RS0,RSQCD,ALS,NF) ALSTZ= TRALPHAS(RS0,ZM,ALS,NF) SPSC= SC*TQM QSPSC= SPSC*1.D15*1.Q-15 ALSTS= TRALPHAS(RS0,SPSC,ALS,NF) * SCLU= 0.204D0*TQM ALSTU= TRALPHAS(RS0,SCLU,ALS,NF) IF(OU7.EQ.'N') THEN RSCEFF= 0.D0 ELSE IF(OU7.EQ.'Y') THEN RSCEFF= 3.D0/4.D0*XI*2.86D0*(ALSTU-ALST)/PI ENDIF * QALST= ALST*1.D15*1.Q-15 QALSTZ= ALSTZ*1.D15*1.Q-15 QALSTS= ALSTS*1.D15*1.Q-15 * P2Z= -ZM2 QP2Z= -QZM2 QWM= WM*1.D15*1.Q-15 QWM2= QWM*QWM * *-----THE ALPHA*ALPHA_S CORRECTIONS ARE INITIALIZED * CALL TALALS(QP2Z,QV1,QA1,QDF1,QV1P,QA1P,QV1I) * CALL TPSELF(QP2Z,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # PGGI,PGZI,PGGIS,PGZIS,PGGIW,PGGHO) * CTM2= WM2/ZM2 STM2= 1.D0-CTM2 DG= 6.D0+LOG(CTM2)/STM2*(7.D0/2.D0-5.D0/2.D0*STM2- # STR2*(5.D0-3.D0/2.D0*CTM2/CTR2))+4.D0*LOG(CTM2) ODSWW= WM2*DG OSINT2= STR2 * CALL TVBSELF0(PGGF0,PGGFL0,PGGB0,SWW0F,SWW0B) PIFZ= PGGFZ-PGGF0+PGGHO+PGGNPZ PGGTZ= PGGFZ+PGGLQZ+PGGBZ AEXPH= AEXP/(1.D0-AEXP*PIFZ) AEXPHZ= AEXPH AEXPH2= AEXPH*AEXPH ALPHAH= 4.D0*PI*AEXPH * PIBZ= PGGBZ-PGGB0 SWW0= SWW0F+SWW0B PITZ= PIFZ+PIBZ * *-----COMPUTES RHO * CALL TVBSELF(QP2Z,S3GFZ,S33FZ,S3GBZ,S33BZ,SP3GZ,SP33Z, # S33IWZ,S3GIWZ) * SZZT= (S33FZ+S33BZ)-2.D0*STR2*(S3GFZ+S3GBZ)-STR4*ZM2* # PGGTZ RESS2= CMSTR2*(S3GFZ+S3GBZ+STR2*ZM2*PGGTZ) DSIGF= (SWW0B+S3GBZ-S33BZ)/ZM2+CSTR2*PIBZ-RESS2/ZM2 SIGF= (SWW0F+S3GFZ-S33FZ)/ZM2 SIGFP= (SWW0F+S3GFZ-S33FZ)/ZM2+DSIGF SIGT= SIGF+(SWW0B+S3GBZ-S33BZ)/ZM2 * QP2W= -QWM2 CALL TALALS(QP2W,QDV1,QDA1,QF1,QDV1P,QDA1P,QDV1I) CALL TWSELF(QP2W,SWW,PWW) SWWT= SWW-WM2*PWW * *-----O(M_T^4,M_T^2) CORRECTIONS TO RHO, ANALYTICAL * *-----BASIC FOR INTERPOLATION OD DRHH2 * DO NIT=1,30 RHT= 0.05D0+NIT*0.07D0 IF(RHT.EQ.2.D0) THEN RHT= RHT+0.001D0 ENDIF HT= RHT*RHT XXXR(NIT)= RHT ZT= ZM2/TQM2 SHT= SQRT(HT) HTTH= HT-4.D0 HTTHS= HTTH*HTTH HTS= HT*HT HTC= HTS*HT HTIV= HTC*HT HTV= HTIV*HT HTVI= HTV*HT OMHT= 1.D0-HT HTI= -1.D-37 SPOMHT= TRSPENCE(OMHT,HTI) ZTS= ZT*ZT ZTC= ZTS*ZT WM2O= -WM2 ZM2O= -ZM2 CALL TB0FUN(WM2O,HM2,WM2,B0WHW) CALL TB0FUN(WM2O,WM2,ZM2,B0WWZ) CALL TB0FUN(ZM2O,HM2,ZM2,B0ZHZ) CALL TB0FUN(ZM2O,WM2,WM2,B0ZWW) CALL TGLA(HT,GFHT,BLFHT) ARGHT= HT/4.D0 CALL TPHI(ARGHT,PHIHT) RLHT= LOG(HT) RLHTS= RLHT*RLHT RLZT= LOG(ZT) F1HT= -PHIHT/2.D0 * DRHH2LH= 19.D0-53.D0/3.D0*HT+3.D0/2.D0*PI*SQRT(HTC)+ # 8.D0/9.D0*HTS/ZT-5.D0/9.D0/CTR2*HTS/ZT+ # (845.D0/27.D0-1.D0/3.D0/CTR2+427.D0/27.D0*CTR2- # 122.D0/9.D0*CTR4)*ZT+PIS/27.D0*(54.D0*HT-54.D0- # 119.D0*ZT+44.D0*CTR2*ZT)+4.D0/27.D0*SHT*PI* # (-27.D0+34.D0*ZT-116.D0*CTR2*ZT+64.D0*CTR4*ZT)+ # (32.D0/9.D0*HT-8.D0/9.D0*HTS/ZT-32.D0/3.D0*ZT)* # B0ZHZ+(1.D0+20.D0*CTR2-24.D0*CTR4)*ZT/3.D0/CTR2* # B0WWZ-2.D0/3.D0*(1.D0+18.D0*CTR2-16.D0*CTR4)*ZT* # B0ZWW-5.D0/9.D0*(4.D0*HT-HTS/CTR2/ZT-12.D0*CTR2* # ZT)*B0WHW-1.D0/9.D0*(5.D0*HT+3.D0*ZT+32.D0*CTR2* # ZT+48.D0*CTR4*ZT)*LOG(CTR2)+HT/9.D0/CTR2/ZT*( # 5.D0*HT-8.D0*CTR2*HT-18.D0*CTR2*ZT)*RLHT-8.D0/ # 9.D0*(4.D0-26.D0*CTR2-5.D0*CTR4)*ZT*RLZT+( # HT/3.D0-11.D0/9.D0*ZT+ZT/3.D0/CTR2-16.D0/9.D0* # CTR2*ZT-16.D0/3.D0*CTR4*ZT)*RLZT DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT DRHH2S= 1.D0/54.D0/CTR2/HTTH/HT*(-1776.D0* # CTR4+(72.D0-6250.D0*CTR2-3056.D0*CTR4+3696.D0*CTR6)* # HT+(-18.D0+1283.D0*CTR2+1371.D0*CTR4-1436.D0*CTR6)* # HTS+(68.D0*CTR2-124.D0*CTR4+128.D0*CTR6)*HTC)+ # PIS/27.D0/HTS*(6.D0*CTR2*HT-37.D0*CTR2-119.D0* # HTS+56.D0*CTR2*HTS)+(32.D0/3.D0*CTR4-2.D0/3.D0- # 12.D0*CTR2)*B0ZWW+(20.D0/3.D0+1.D0/3.D0/CTR2- # 8.D0*CTR2)*B0WWZ+1.D0/27.D0*(17.D0-58.D0*CTR2+ # 32.D0*CTR4)*(4.D0-HT)*SHT*GFHT-40.D0/3.D0* # STR2*(4.D0-HT)/HT*BLFHT+2.D0/9.D0*CTR2/HTS*( # 37.D0-6.D0*HT-12.D0*HTS-22.D0*HTC+9.D0*HTIV)* # SPOMHT-1.D0/3.D0*(1.D0+14.D0*CTR2+ # 16.D0*CTR4)*LOG(CTR2)+(11520.D0-15072.D0*CTR2- # (7170.D0-8928.D0*CTR2-768.D0*CTR4)*HT+ # (3411.D0-7062.D0*CTR2+3264.D0*CTR4)*HTS-(1259.D0- # 3547.D0*CTR2+2144.D0*CTR4)*HTC+(238.D0-758.D0*CTR2+ # 448.D0*CTR4)*HTIV-(17.D0-58.D0*CTR2+32.D0*CTR4)* # HTV)*RLHT/27.D0/HTTHS/HT-8.D0/9.D0*(4.D0- # 26.D0*CTR2-5.D0*CTR4)*RLZT+1.D0/9.D0/CTR2*( # 3.D0+5.D0*CTR2-26.D0*CTR4-48.D0*CTR6)*RLZT+ # (3840.D0*STR2-(4310.D0-4224.D0*CTR2-256.D0*CTR4)* # HT+(1706.D0-1312.D0*CTR2-320.D0*CTR4)*HTS- # (315.D0+476.D0*CTR2-64.D0*CTR4)*HTC+(24.D0+ # 454.D0*CTR2)*HTIV-112.D0*CTR2*HTV+9.D0*CTR2* # HTVI)*PHIHT/9.D0/HTTHS/HTS DRHH2HH= DRHH2L+ZT*DRHH2S * YYYR(NIT)= DRHH2LH ZZZR(NIT)= DRHH2HH ENDDO * DO NIT=1,4 XARRR(NIT)= XXXR(NIT) YARRR(NIT)= YYYR(NIT) ENDDO DO NIT=5,15 XARRR(NIT)= XXXR(NIT+10) YARRR(NIT)= ZZZR(NIT+10) ENDDO * HT= HM2/TQM2 ZT= ZM2/TQM2 SHT= SQRT(HT) HTTH= HT-4.D0 HTTHS= HTTH*HTTH HTS= HT*HT HTC= HTS*HT HTIV= HTC*HT HTV= HTIV*HT HTVI= HTV*HT OMHT= 1.D0-HT HTI= -1.D-37 SPOMHT= TRSPENCE(OMHT,HTI) ZTS= ZT*ZT WM2O= -WM2 ZM2O= -ZM2 CALL TB0FUN(WM2O,HM2,WM2,B0WHW) CALL TB0FUN(WM2O,WM2,ZM2,B0WWZ) CALL TB0FUN(ZM2O,HM2,ZM2,B0ZHZ) CALL TB0FUN(ZM2O,WM2,WM2,B0ZWW) CALL TGLA(HT,GFHT,BLFHT) ARGHT= HT/4.D0 CALL TPHI(ARGHT,PHIHT) RLHT= LOG(HT) RLZT= LOG(ZT) * IF(OU0.NE.'S') THEN DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT HOC= DRHH2L ELSE * IF(HM.LT.(0.3D0*TQM)) THEN DRHW2= -13.D0/144.D0-1.D0/48.D0/CTR4-41.D0/96.D0/CTR2+ # 61.D0/72.D0*CTR2+(7.D0-16.D0*CTR2)/27.D0*PI* # SHT-PIS/36.D0-5.D0/144.D0*HTS/CTR4/ZTS+ # 35.D0/288.D0*HT/CTR2/ZT+5.D0/12.D0*(1.D0+ # HTS/12.D0/CTR4/ZTS-HT/3.D0/CTR2/ZT)*B0WHW+ # (1.D0+20.D0*CTR2-24.D0*CTR4)/48.D0/CTR4*B0WWZ- # 1.D0/144.D0/CTR2/STR2/ZT/(HT-CTR2*ZT)*( # 5.D0*STR2*HTS+3.D0*HT*ZT+48.D0*CTR2*HT*ZT- # 60.D0*CTR4*HT*ZT-3.D0*CTR2*ZTS-8.D0*CTR4*ZTS+ # 20.D0*CTR6*ZTS)*LOG(CTR2)+5.D0/144.D0/CTR4/ZTS/ # (HT-CTR2*ZT)*HT*(HTS-4.D0*CTR2*HT*ZT+12.D0*CTR4* # ZTS)*RLHT-(17.D0/36.D0-13.D0/18.D0*CTR2)*RLZT- # 1.D0/144.D0/CTR4/ZT/(HT-CTR2*ZT)*(5.D0*CTR2*HTS- # 3.D0*HT*ZT-60.D0*CTR2*HT*ZT+60.D0*CTR4*HT*ZT+( # 3.D0*CTR2+60.D0*CTR4-20.D0*CTR6)*ZTS)*RLZT ELSE DRHW2= -121.D0/288.D0-1.D0/48.D0/CTR4-41.D0/96.D0/CTR2+ # 77.D0/72.D0*CTR2+19.D0/72.D0/HT+(41.D0/216.D0- # 4.D0/27.D0*CTR2)*HT-(19.D0+21.D0*HT)*PIS/432.D0/ # HTS-(1.D0/2.D0-1.D0/48.D0/CTR4-5.D0/12.D0/CTR2)* # B0WWZ+(16.D0*CTR2-7.D0)/216.D0*HTTH*SHT* # GFHT-(1.D0/12.D0-1.D0/3.D0/HT)*BLFHT+1.D0/72.D0/ # HTS*(19.D0+21.D0*HT-12.D0*HTS-31.D0*HTC+9.D0* # HTIV)*SPOMHT-1.D0/48.D0/CTR2/STR2*( # 1.D0+21.D0*CTR2-25.D0*CTR4)*LOG(CTR2)-(17.D0/ # 36.D0-13.D0/18.D0*CTR2)*RLZT+1.D0/48.D0/CTR4*( # 1.D0+20.D0*CTR2-25.D0*CTR4)*RLZT+1.D0/216.D0/HT/ # HTTH*(372.D0+(96.D0*CTR2-213.D0)*HT+(432.D0* # CTR2-318.D0)*HTS+(97.D0-160.D0*CTR2)*HTC-(7.D0- # 16.D0*CTR2)*HTIV)*RLHT+1.D0/144.D0/HTS/HTTH* # (96.D0-(384.D0-64.D0*CTR2)*HT-(2.D0+64.D0*CTR2)* # HTS+231.D0*HTC-85.D0*HTIV+9.D0*HTV)*PHIHT ENDIF IF(HM.LT.(0.2D0*TQM)) THEN DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT DRHH2= 19.D0-53.D0/3.D0*HT+3.D0/2.D0*PI*SQRT(HTC)+ # 8.D0/9.D0*HTS/ZT-5.D0/9.D0/CTR2*HTS/ZT+ # (845.D0/27.D0-1.D0/3.D0/CTR2+427.D0/27.D0*CTR2- # 122.D0/9.D0*CTR4)*ZT+PIS/27.D0*(54.D0*HT-54.D0- # 119.D0*ZT+44.D0*CTR2*ZT)+4.D0/27.D0*SHT*PI* # (-27.D0+34.D0*ZT-116.D0*CTR2*ZT+64.D0*CTR4*ZT)+ # (32.D0/9.D0*HT-8.D0/9.D0*HTS/ZT-32.D0/3.D0*ZT)* # B0ZHZ+(1.D0+20.D0*CTR2-24.D0*CTR4)*ZT/3.D0/CTR2* # B0WWZ-2.D0/3.D0*(1.D0+18.D0*CTR2-16.D0*CTR4)*ZT* # B0ZWW-5.D0/9.D0*(4.D0*HT-HTS/CTR2/ZT-12.D0*CTR2* # ZT)*B0WHW-1.D0/9.D0*(5.D0*HT+3.D0*ZT+32.D0*CTR2* # ZT+48.D0*CTR4*ZT)*LOG(CTR2)+HT/9.D0/CTR2/ZT*( # 5.D0*HT-8.D0*CTR2*HT-18.D0*CTR2*ZT)*RLHT-8.D0/ # 9.D0*(4.D0-26.D0*CTR2-5.D0*CTR4)*ZT*RLZT+( # HT/3.D0-11.D0/9.D0*ZT+ZT/3.D0/CTR2-16.D0/9.D0* # CTR2*ZT-16.D0/3.D0*CTR4*ZT)*RLZT ELSE IF(HM.GT.(0.95D0*TQM)) THEN DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT DRHH2S= 1.D0/54.D0/CTR2/HTTH/HT*(-1776.D0* # CTR4+(72.D0-6250.D0*CTR2-3056.D0*CTR4+3696.D0*CTR6)* # HT+(-18.D0+1283.D0*CTR2+1371.D0*CTR4-1436.D0*CTR6)* # HTS+(68.D0*CTR2-124.D0*CTR4+128.D0*CTR6)*HTC)+ # PIS/27.D0/HTS*(6.D0*CTR2*HT-37.D0*CTR2-119.D0* # HTS+56.D0*CTR2*HTS)+(32.D0/3.D0*CTR4-2.D0/3.D0- # 12.D0*CTR2)*B0ZWW+(20.D0/3.D0+1.D0/3.D0/CTR2- # 8.D0*CTR2)*B0WWZ+1.D0/27.D0*(17.D0-58.D0*CTR2+ # 32.D0*CTR4)*(4.D0-HT)*SHT*GFHT-40.D0/3.D0* # STR2*(4.D0-HT)/HT*BLFHT+2.D0/9.D0*CTR2/HTS*( # 37.D0-6.D0*HT-12.D0*HTS-22.D0*HTC+9.D0*HTIV)* # SPOMHT-1.D0/3.D0*(1.D0+14.D0*CTR2+ # 16.D0*CTR4)*LOG(CTR2)+(11520.D0-15072.D0*CTR2- # (7170.D0-8928.D0*CTR2-768.D0*CTR4)*HT+ # (3411.D0-7062.D0*CTR2+3264.D0*CTR4)*HTS-(1259.D0- # 3547.D0*CTR2+2144.D0*CTR4)*HTC+(238.D0-758.D0*CTR2+ # 448.D0*CTR4)*HTIV-(17.D0-58.D0*CTR2+32.D0*CTR4)* # HTV)*RLHT/27.D0/HTTHS/HT-8.D0/9.D0*(4.D0- # 26.D0*CTR2-5.D0*CTR4)*RLZT+1.D0/9.D0/CTR2*( # 3.D0+5.D0*CTR2-26.D0*CTR4-48.D0*CTR6)*RLZT+ # (3840.D0*STR2-(4310.D0-4224.D0*CTR2-256.D0*CTR4)* # HT+(1706.D0-1312.D0*CTR2-320.D0*CTR4)*HTS- # (315.D0+476.D0*CTR2-64.D0*CTR4)*HTC+(24.D0+ # 454.D0*CTR2)*HTIV-112.D0*CTR2*HTV+9.D0*CTR2* # HTVI)*PHIHT/9.D0/HTTHS/HTS DRHH2= DRHH2L+ZT*DRHH2S ELSE DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT NINTP= 15 RHT= SQRT(HM2/TQM2) CALL TPOLINT(XARRR,YARRR,NINTP,RHT,DRHH2,DRHH2C) ENDIF IF(HM.LT.(0.5D0*TQM)) THEN DEOE= 61.D0/72.D0-16.D0/27.D0*PI*SHT+13.D0/18.D0* # RLZT ELSE DEOE= (231.D0-32.D0*HT)/216.D0-2.D0/27.D0*(4.D0-HT)* # SHT*GFHT+2.D0/27.D0/HTTH*(6.D0+ # 27.D0*HT-10.D0*HTS+HTC)*RLHT+13.D0/18.D0* # RLZT-4.D0/9.D0*(HT-1.D0)/HTTH/HT*PHIHT ENDIF DRHW2= 3.D0*(AEXP/STR2)**2*TQM2/WM2*DRHW2 DRHH2= 3.D0*AEXP*AEXPH*(1.D0/4.D0/STR2/CTR2*TQM2/ZM2)**2* # DRHH2+4.D0*(AEXP/STR2)**2*LOG(WM2/ZM2)*(SZZT-SWWT)/WM2 DEOE= 3.D0*AEXP**2/STR2*TQM2/ZM2/CTR2*DEOE ENDIF * IF(OU7.EQ.'N') THEN NFP1= NF+1 DQCD3= 157.D0/648.D0-3313.D0/162.D0*RZ2-308.D0/27.D0*RZ3+ # 143.D0/18.D0*Z4-4.D0/3.D0*RZ2*LOG(2.D0)+ # 441.D0/8.D0*SCS2-1.D0/9.D0*SCB4-1.D0/18.D0*SCD3- # (1.D0/18.D0-13.D0/9.D0*RZ2+4.D0/9.D0*RZ3)*NFP1- # (11.D0/6.D0-NF/9.D0)*(1.D0+2.D0*RZ2)*2.D0*LOG(SC) DQCD3= DQCD3*ALSTS*ALSTS/PIS DRHO3= -3.D0/4.D0*XI*DQCD3 ELSE IF(OU7.EQ.'Y') THEN DRHO3= 0.D0 ENDIF SIGF0C= SIGF+RSCEFF+DRHO3 SIGFP0C= SIGFP+RSCEFF+DRHO3 SIGFC= SIGF+RSCEFF+DRHO3-3.D0/16.D0*GFC*HOC*XI2 SIGFPC= SIGFP+RSCEFF+DRHO3-3.D0/16.D0*GFC*HOC*XI2 SIGTC= SIGT-RESS2/ZM2+RSCEFF+DRHO3 RHO= 1.D0/(1.D0+GFC*SIGFC) RHOP= 1.D0/(1.D0+GFC*SIGFPC) * RHOS1= -AEXP*(SIGTC/STR2/CTR2+PITZ) RHOS1S= AEXP**2/STR2/CTR2*(-SIGT+RESS2/ZM2- # 3.D0/4.D0*TQM2/ZM2) RHOS2= -WM2/ZM2/CTR2*(DRHW2-DRHH2)- # (WM2/ZM2/CTR2-1.D0)*DEOE RHOSC= 1.D0+RHOS1+RHOS2 IF(OU8.EQ.'C') THEN RHOS= RHOSC ELSE IF(OU8.EQ.'L') THEN RHOS= RHOSC-RHOS1S ELSE IF(OU8.EQ.'R') THEN RHOS= RHOSC+RHOS1S ENDIF * ARGRP= 1.D0-2.D0*PI*ALPHA/GF/ZM2/RHOP* # 1.D0/(1.D0-AEXP*PIFZ) ARGRS= 1.D0-2.D0*PI*ALPHA/GF/ZM2/RHOS * S33Z= S33FZ+S33BZ S3GZ= S3GFZ+S3GBZ PZ= PIFZ+PIBZ * *-----COMPUTES THE W MASS *-----COMPUTES THE EFFECTIVE SIN^2 * IF(OU0.NE.'S') THEN DCZ= STR2*(-PIBZ+PGGTZ) FVECMS(1)= 1.D0-(ZM2/WM2*RHOP*CTR2+AEXPH/STR2/WM2*(SWW0-SWW))/ # (1.D0-AEXPH/STR2*(PWW-DCZ)) REST(1)= (RHOP*CTR2+AEXPH/STR2/ZM2*(SWW0-SWW))/ # (1.D0-AEXPH/STR2*(PWW-DCZ)) ELSE IF(OU0.EQ.'S') THEN FVECMS(1)= CTR2*RHOS-WM2/ZM2*(1.D0+AEXP/STR2*( # -STR2*(PITZ-PGGTZ)+ # 1.D0/WM2*(SWWT-SWW0)))+WM2/ZM2*DRHW2 REST(1)= (ZM2*CTR2*RHOS-(AEXP/STR2*(-WM2*STR2*(PITZ-PGGTZ)+ # SWWT-SWW0))+WM2*DRHW2)/ZM2 ENDIF IF(OU0.NE.'S') THEN FVECMS(2)= STR2-0.5D0*(1.D0-SQRT(ARGRP)) REST(2)= 0.5D0*(1.D0-SQRT(ARGRP)) ELSE IF(OU0.EQ.'S') THEN FVECMS(2)= STR2-0.5D0*(1.D0-SQRT(ARGRS))- # AEXPH2/CMSTR2*(PGZI/ZM2+STR2*PGGI)**2 REST(2)= 0.5D0*(1.D0-SQRT(ARGRS))+ # AEXPH2/CMSTR2*(PGZI/ZM2+STR2*PGGI)**2 ENDIF * RETURN END * *-----WIDTHO------------------------------------------------------------- * SUBROUTINE TWIDTHO(ZM,TQM,HM,OALS,OWT) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OAAS,OPWM,OAL,OMA,OIMAG CHARACTER*3 OPO * PARAMETER(NPO=34) PARAMETER(NT=2,LWAMS=(NT*(3*NT+13))/2) * COMMON/TMA/OMA COMMON/TAAS/SC COMMON/TOPO/OPO COMMON/OST/OSTR2 COMMON/TPW/PW(10) COMMON/TIXS/OIMAG COMMON/TCALEM/OAL COMMON/TCAAS/OAAS COMMON/TOPWM/OPWM COMMON/TSSCAL/QSPSC COMMON/TAFBB/AFBBEFF COMMON/TICOUPLING/NF COMMON/TRESUM/JRESUM COMMON/TTRANS/REST(2) COMMON/TTABOBS/TAB(NPO) COMMON/TONCE/CFACTZ,GGIZ COMMON/TSUB/OSINT2,ODSWW COMMON/TIPA/VIM(7),AIM(7) COMMON/TAFJTR/ALST,ALSTSZ COMMON/TPARAM/PI,PIS,DELTA COMMON/TNUMC/SCS2,SCD3,SCB4 COMMON/TCK/XSZ(6),XNFACT(6) COMMON/TCBASI/BZM,BTQM,BHM,BALS COMMON/TMIX/QALST,QALSTZ,QALSTS COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION ZW(9),ZWQCDS(9) DIMENSION ANUM(3),ADEN(3),ARAT(3) DIMENSION ST(NT),FVECMS(NT),WAMS(LWAMS) DIMENSION XXX(30),YYY(30),ZZZ(30),XARR(15),YARR(15), # XXXR(30),YYYR(30),ZZZR(30),XARRR(15),YARRR(15) * EXTERNAL C05NBF,TBASIC * *-----VARIA * Z4= PIS*PIS/90.D0 DO I=1,9 ZWQCDS(I)= 0.D0 ENDDO IF(OU1.EQ.'N') THEN OU8= 'C' ENDIF IF(OU7.EQ.'Y') THEN OU8= 'C' ENDIF * *-----MASSES * ZM2= ZM*ZM QZM= ZM*1.D15*1.Q-15 QZM2= QZM*QZM ZM3= ZM2*ZM TQM2= TQM*TQM QTQM= TQM*1.D15*1.Q-15 QTQM2= QTQM*QTQM HM2= HM*HM QHM= HM*1.D15*1.Q-15 QHM2= QHM*QHM XI= TQM2/ZM2 XI2= XI*XI ALS= OALS BZM= ZM BTQM= TQM BHM= HM BALS= ALS * *-----A STARTING POINT * ARG0= 1.D0-2.D0*PI*ALPHA/GF/ZM2 ST02= 0.5D0*(1.D0-SQRT(ARG0)) OSTR2= ST02 CT02= 1.D0-ST02 WM2= ZM2*CT02 WM= SQRT(WM2) QWM= WM*1.D15*1.Q-15 QWM2= QWM*QWM P2Z= -ZM2 QP2Z= -QZM2 * *-----QCD * IF(TQM.GT.ZM) THEN RSQCD= TQM ELSE RSQCD= ZM ENDIF ALST= TRALPHAS(RS0,RSQCD,ALS,NF) ALSTZ= TRALPHAS(RS0,ZM,ALS,NF) SPSC= SC*TQM QSPSC= SPSC*1.D15*1.Q-15 ALSTS= TRALPHAS(RS0,SPSC,ALS,NF) * CALL TALALS(QP2Z,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2Z,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # PGGI,PGZI,PGGIS,PGZIS,PGGIW,PGGHOZ) OSINT2= ST02 CALL TVBSELF0(PGGF0,PGGFL0,PGGB0,SWW0F,SWW0B) PIFZ= PGGFZ-PGGF0+PGGHOZ+PGGNPZ * ARG= 1.D0-2.D0*PI*ALPHA/GF/ZM2/(1.D0-AEXP*PIFZ) ST12= 0.5D0*(1.D0-SQRT(ARG)) CT12= 1.D0-ST12 * *-----UPGRADING THE STARTING POINT * IFLAG= 1 DO NI=1,10 IF(NI.EQ.1) THEN ST(1)= CT12 ST(2)= ST12 CALL TBASIC(NT,ST,FVECMS,IFLAG) ST(1)= REST(1) ST(2)= REST(2) ELSE CALL TBASIC(NT,ST,FVECMS,IFLAG) ST(1)= REST(1) ST(2)= REST(2) ENDIF ENDDO * TOL= SQRT(X02AJF()) IFAIL= 1 CALL C05NBF(TBASIC,NT,ST,FVECMS,TOL,WAMS,LWAMS,IFAIL) * *-----END OF ITERATION FOR W MASS AND S^2 * WM2= ST(1)*ZM2 WM= SQRT(WM2) STR2= ST(2) OSTR2= STR2 STR4= STR2*STR2 CTR2= 1.D0-STR2 CTR4= CTR2*CTR2 CTR6= CTR4*CTR2 CMSTR2= CTR2-STR2 CSTR2= CTR2*STR2 QWM= WM*1.D15*1.Q-15 QWM2= QWM*QWM * GWEAK= GF*ZM2 GWEAK2= GWEAK*GWEAK GFC= GWEAK/2.D0/PIS * *-----QCD CORRECTION TO RHO * SCLU= 0.204D0*TQM ALSTU= TRALPHAS(RS0,SCLU,ALS,NF) IF(OU7.EQ.'N') THEN RSCEFF= 0.D0 ELSE IF(OU7.EQ.'Y') THEN RSCEFF= 3.D0/4.D0*XI*2.86D0*(ALSTU-ALST)/PI ENDIF * QALST= ALST*1.D15*1.Q-15 QALSTZ= ALSTZ*1.D15*1.Q-15 QALSTS= ALSTS*1.D15*1.Q-15 * P2Z= -ZM2 QP2Z= -QZM2 * *-----THE ALPHA*ALPHA_S CORRECTIONS ARE INITIALIZED * CALL TALALS(QP2Z,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2Z,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # PGGI,PGZI,PGGIS,PGZIS,PGGIW,PGGHOZ) OSINT2= STR2 CALL TVBSELF0(PGGF0,PGGFL0,PGGB0,SWW0F,SWW0B) PIFZ= PGGFZ-PGGF0+PGGHOZ+PGGNPZ ARG= 1.D0-2.D0*PI*ALPHA/GF/ZM2/(1.D0-AEXP*PIFZ) STH2= 0.5D0*(1.D0-SQRT(ARG)) * STH2NR= STH2 CTH2= 1.D0-STH2 STH4= STH2*STH2 STH6= STH4*STH2 CTH4= CTH2*CTH2 CSTH2= CTH2*STH2 CMSTH2= CTH2-STH2 TSCTH2= 2.D0/CTH2 FSCTH2= 4.D0/CTH2 CTTH2= CTH2/STH2 FACT= 1.D0/CSTH2 IF(OU5.EQ.'Y') THEN STH2= STR2 CTH2= CTR2 STH4= STH2*STH2 STH6= STH4*STH2 CTH4= CTH2*CTH2 CSTH2= CTH2*STH2 CMSTH2= CTH2-STH2 TSCTH2= 2.D0/CTH2 FSCTH2= 4.D0/CTH2 CTTH2= CTH2/STH2 FACT= 1.D0/CSTH2 ENDIF * CTM2= WM2/ZM2 STM2= 1.D0-CTM2 IF(OU0.EQ.'S') THEN DG= 6.D0+LOG(CTM2)/STM2*(7.D0/2.D0-5.D0/2.D0*STM2- # STR2*(5.D0-3.D0/2.D0*CTM2/CTR2))+4.D0*LOG(CTM2) ODSWW= WM2*DG OSINT2= STR2 ELSE DG= 6.D0+LOG(CTM2)/STM2*(7.D0/2.D0-5.D0/2.D0*STM2- # STH2*(5.D0-3.D0/2.D0*CTM2/CTH2))+4.D0*LOG(CTM2) ODSWW= WM2*DG OSINT2= STH2 ENDIF * CALL TALALS(QP2Z,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2Z,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # PGGI,PGZI,PGGIS,PGZIS,PGGIW,PGGHOZ) CALL TVBSELF0(PGGF0,PGGFL0,PGGB0,SWW0F,SWW0B) PIFZ= PGGFZ-PGGF0+PGGHOZ+PGGNPZ PIFLZ= PGGFLZ-PGGFL0+PGGHOZ+PGGNPZ CFACTZ= 1.D0-AEXP*PIFZ GGIZ= PGGI AEXPH= AEXP/(1.D0-AEXP*PIFZ) AEXPHL= AEXP/(1.D0-AEXP*PIFLZ) AEXPHZ= AEXPH AEXPH2= AEXPH*AEXPH ALPHAH= 4.D0*PI*AEXPH ALI5= 1.D0/(4.D0*PI*AEXPHL) PGGTZ= PGGFZ+PGGLQZ+PGGBZ * PIBZ= PGGBZ-PGGB0 PITZ= PIFZ+PIBZ SWW0= SWW0F+SWW0B * DELW= DELTA-LOG(WM2) DELZ= DELTA-LOG(ZM2) * *-----COMPUTES RHO * CALL TVBSELF(QP2Z,S3GFZ,S33FZ,S3GBZ,S33BZ,SP3GZ,SP33Z, # S33IWZ,S3GIWZ) SZZT= (S33FZ+S33BZ)-2.D0*STR2*(S3GFZ+S3GBZ)-STR4*ZM2* # PGGTZ S3GTZ= S3GFZ+S3GBZ QP2W= -QWM2 CALL TALALS(QP2W,QDV1,QDA1,QF1,QDV1P,QDA1P,QDV1I) CALL TWSELF(QP2W,SWW,PWW) SWWT= SWW-WM2*PWW * IF(OU0.EQ.'S') THEN RESS2= CMSTR2*(S3GTZ+STR2*ZM2*PGGTZ) ELSE RESS2= CMSTH2*(S3GTZ+STH2*ZM2*PGGTZ) ENDIF * DSIGF= (SWW0B+S3GBZ-S33BZ)/ZM2+CSTH2*PIBZ-RESS2/ZM2 SIGF= (SWW0F+S3GFZ-S33FZ)/ZM2 SIGFP= (SWW0F+S3GFZ-S33FZ)/ZM2+DSIGF SIGT= SIGF+(SWW0B+S3GBZ-S33BZ)/ZM2 * *-----O(M_T^4,M_T^2) CORRECTIONS TO RHO AND TAU, * M_T^4 ANALYTICAL * M_T^2 EXPANSIONS FOR LIGHT AND HEAVY HIGGS * ONLY DRHH2,DEH2 ARE INTERPOLATED * *-----BASIC FOR INTERPOLATION * DO NIT=1,30 RHT= 0.05D0+NIT*0.05D0 IF(RHT.EQ.2.D0) THEN RHT= RHT+0.001D0 ENDIF HT= RHT*RHT XXX(NIT)= RHT ZT= ZM2/TQM2 SHT= SQRT(HT) HTTH= HT-4.D0 HTTHS= HTTH*HTTH HTS= HT*HT HTC= HTS*HT HTIV= HTC*HT HTV= HTIV*HT HTVI= HTV*HT OMHT= 1.D0-HT HTI= -1.D-37 SPOMHT= TRSPENCE(OMHT,HTI) ZTS= ZT*ZT ZTC= ZTS*ZT WM2O= -WM2 ZM2O= -ZM2 CALL TB0FUN(WM2O,HM2,WM2,B0WHW) CALL TB0FUN(WM2O,WM2,ZM2,B0WWZ) CALL TB0FUN(ZM2O,HM2,ZM2,B0ZHZ) CALL TB0FUN(ZM2O,WM2,WM2,B0ZWW) CALL TGLA(HT,GFHT,BLFHT) ARGHT= HT/4.D0 CALL TPHI(ARGHT,PHIHT) RLHT= LOG(HT) RLHTS= RLHT*RLHT RLZT= LOG(ZT) F1HT= -PHIHT/2.D0 * DEH2LH= (-17.D0+40.D0*CTR2-32.D0*CTR4)*(-4.D0+2.D0*SHT*PI)/ # (108.D0*CTR2)+(-24.D0*HTC+96.D0*CTR2*HTC+144.D0* # HTS*ZT-576.D0*CTR2*HTS*ZT-313.D0*HT*ZTS+1345.D0* # CTR2*HT*ZTS+349.D0*CTR4*HT*ZTS-292.D0*CTR6*HT*ZTS+ # 196.D0*ZTC-1156.D0*CTR2*ZTC-1396.D0*CTR4*ZTC+ # 1168.D0*CTR6*ZTC)/(216.D0*CTR2*(-1.D0+4.D0*CTR2)* # (HT-4.D0*ZT)*ZTS)+(-2.D0*HTC+13.D0*HTS*ZT-32.D0* # HT*ZTS+36.D0*ZTC)*B0ZHZ/(18.D0*CTR2*(HT-4.D0*ZT)* # ZTS)+(-1.D0+4.D0*CTR2-44.D0*CTR4+32.D0*CTR6)*B0ZWW/ # (-24.D0*CTR2+96.D0*CTR4)+(-1.D0-18.D0*CTR2+16.D0* # CTR4)*LOG(CTR2)/(2.D0*(-6.D0+24.D0*CTR2))+(-2.D0* # HTC+11.D0*HTS*ZT-24.D0*HT*ZTS+24.D0*ZTC)*RLHT/ # (18.D0*CTR2*(HT-4.D0*ZT)*ZTS)-(8.D0*HTC-32.D0*CTR2* # HTC-52.D0*HTS*ZT+208.D0*CTR2*HTS*ZT+159.D0*HT*ZTS- # 704.D0*CTR2*HT*ZTS+192.D0*CTR4*HT*ZTS-112.D0*CTR6* # HT*ZTS-268.D0*ZTC+1344.D0*CTR2*ZTC-768.D0*CTR4*ZTC+ # 448.D0*CTR6*ZTC)*RLZT/(72.D0*CTR2*(-1.D0+4.D0* # CTR2)*(HT-4.D0*ZT)*ZTS)+(-4.D0*HTS+16.D0*CTR2*HTS+ # 20.D0*HT*ZT-79.D0*CTR2*HT*ZT-70.D0*CTR4*HT*ZT+ # 48.D0*CTR6*HT*ZT-40.D0*ZTS+156.D0*CTR2*ZTS+280.D0* # CTR4*ZTS-192.D0*CTR6*ZTS)*RLZT/(36.D0*CTR2*(-1.D0+ # 4.D0*CTR2)*(HT-4.D0*ZT)*ZT) DEH2HH= (-1152.D0+4608.D0*CTR2+50.D0*HT+2248.D0*CTR2*HT+ # 976.D0*CTR4*HT-1600.D0*CTR6*HT+67.D0*HTS-880.D0* # CTR2*HTS-244.D0*CTR4*HTS+400.D0*CTR6*HTS)/(864.D0* # CTR2*(1.D0-4.D0*CTR2)*HTTH*HT)+(-1.D0+4.D0*CTR2- # 44.D0*CTR4+32.D0*CTR6)*B0ZWW/(-24.D0*CTR2+96.D0* # CTR4)+(4.D0/3.D0-4.D0/HT-(1.D0-4.D0/HT)*BLFHT)/ # (12.D0*CTR2)+(-1.D0-18.D0*CTR2+16.D0*CTR4)* # LOG(CTR2)/(2.D0*(-6.D0+24.D0*CTR2))+(-384.D0- # 202.D0*HT+320.D0*CTR2*HT-256.D0*CTR4*HT+55.D0*HTS+ # 80.D0*CTR2*HTS-64.D0*CTR4*HTS+3.D0*HTC-40.D0*CTR2* # HTC+32.D0*CTR4*HTC)*RLHT/(144.D0*CTR2*HTTHS*HT)+ # (-17.D0+40.D0*CTR2-32.D0*CTR4)*(-4.D0+HT/2.D0+ # (1.D0-HT/4.D0)*SHT*GFHT+(6.D0-HT)*HT*RLHT/4.D0)/ # (108.D0*CTR2)-(-31.D0+192.D0*CTR2-192.D0*CTR4+ # 112.D0*CTR6)*RLZT/(72.D0*CTR2-288.D0*CTR4)+(2.D0- # 7.D0*CTR2-70.D0*CTR4+48.D0*CTR6)*RLZT/(-36.D0* # CTR2+144.D0*CTR4)+(-384.D0-10.D0*HT+320.D0*CTR2* # HT-256.D0*CTR4*HT+238.D0*HTS-400.D0*CTR2*HTS+ # 320.D0*CTR4*HTS-63.D0*HTC+80.D0*CTR2*HTC-64.D0* # CTR4*HTC+3.D0*HTIV)*PHIHT/(144.D0*CTR2*HTTHS*HTS) * YYY(NIT)= DEH2LH ZZZ(NIT)= DEH2LH ENDDO * DO NIT=1,4 XARR(NIT)= XXX(NIT) YARR(NIT)= YYY(NIT) ENDDO DO NIT=5,15 XARR(NIT)= XXX(NIT+4) YARR(NIT)= ZZZ(NIT+4) ENDDO * DO NIT=1,30 RHT= 0.05D0+NIT*0.07D0 IF(RHT.EQ.2.D0) THEN RHT= RHT+0.001D0 ENDIF HT= RHT*RHT XXXR(NIT)= RHT ZT= ZM2/TQM2 SHT= SQRT(HT) HTTH= HT-4.D0 HTTHS= HTTH*HTTH HTS= HT*HT HTC= HTS*HT HTIV= HTC*HT HTV= HTIV*HT HTVI= HTV*HT OMHT= 1.D0-HT HTI= -1.D-37 SPOMHT= TRSPENCE(OMHT,HTI) ZTS= ZT*ZT ZTC= ZTS*ZT WM2O= -WM2 ZM2O= -ZM2 CALL TB0FUN(WM2O,HM2,WM2,B0WHW) CALL TB0FUN(WM2O,WM2,ZM2,B0WWZ) CALL TB0FUN(ZM2O,HM2,ZM2,B0ZHZ) CALL TB0FUN(ZM2O,WM2,WM2,B0ZWW) CALL TGLA(HT,GFHT,BLFHT) ARGHT= HT/4.D0 CALL TPHI(ARGHT,PHIHT) RLHT= LOG(HT) RLHTS= RLHT*RLHT RLZT= LOG(ZT) F1HT= -PHIHT/2.D0 * DRHH2LH= 19.D0-53.D0/3.D0*HT+3.D0/2.D0*PI*SQRT(HTC)+ # 8.D0/9.D0*HTS/ZT-5.D0/9.D0/CTR2*HTS/ZT+ # (845.D0/27.D0-1.D0/3.D0/CTR2+427.D0/27.D0*CTR2- # 122.D0/9.D0*CTR4)*ZT+PIS/27.D0*(54.D0*HT-54.D0- # 119.D0*ZT+44.D0*CTR2*ZT)+4.D0/27.D0*SHT*PI* # (-27.D0+34.D0*ZT-116.D0*CTR2*ZT+64.D0*CTR4*ZT)+ # (32.D0/9.D0*HT-8.D0/9.D0*HTS/ZT-32.D0/3.D0*ZT)* # B0ZHZ+(1.D0+20.D0*CTR2-24.D0*CTR4)*ZT/3.D0/CTR2* # B0WWZ-2.D0/3.D0*(1.D0+18.D0*CTR2-16.D0*CTR4)*ZT* # B0ZWW-5.D0/9.D0*(4.D0*HT-HTS/CTR2/ZT-12.D0*CTR2* # ZT)*B0WHW-1.D0/9.D0*(5.D0*HT+3.D0*ZT+32.D0*CTR2* # ZT+48.D0*CTR4*ZT)*LOG(CTR2)+HT/9.D0/CTR2/ZT*( # 5.D0*HT-8.D0*CTR2*HT-18.D0*CTR2*ZT)*RLHT-8.D0/ # 9.D0*(4.D0-26.D0*CTR2-5.D0*CTR4)*ZT*RLZT+( # HT/3.D0-11.D0/9.D0*ZT+ZT/3.D0/CTR2-16.D0/9.D0* # CTR2*ZT-16.D0/3.D0*CTR4*ZT)*RLZT DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT DRHH2S= 1.D0/54.D0/CTR2/HTTH/HT*(-1776.D0* # CTR4+(72.D0-6250.D0*CTR2-3056.D0*CTR4+3696.D0*CTR6)* # HT+(-18.D0+1283.D0*CTR2+1371.D0*CTR4-1436.D0*CTR6)* # HTS+(68.D0*CTR2-124.D0*CTR4+128.D0*CTR6)*HTC)+ # PIS/27.D0/HTS*(6.D0*CTR2*HT-37.D0*CTR2-119.D0* # HTS+56.D0*CTR2*HTS)+(32.D0/3.D0*CTR4-2.D0/3.D0- # 12.D0*CTR2)*B0ZWW+(20.D0/3.D0+1.D0/3.D0/CTR2- # 8.D0*CTR2)*B0WWZ+1.D0/27.D0*(17.D0-58.D0*CTR2+ # 32.D0*CTR4)*(4.D0-HT)*SHT*GFHT-40.D0/3.D0* # STR2*(4.D0-HT)/HT*BLFHT+2.D0/9.D0*CTR2/HTS*( # 37.D0-6.D0*HT-12.D0*HTS-22.D0*HTC+9.D0*HTIV)* # SPOMHT-1.D0/3.D0*(1.D0+14.D0*CTR2+ # 16.D0*CTR4)*LOG(CTR2)+(11520.D0-15072.D0*CTR2- # (7170.D0-8928.D0*CTR2-768.D0*CTR4)*HT+ # (3411.D0-7062.D0*CTR2+3264.D0*CTR4)*HTS-(1259.D0- # 3547.D0*CTR2+2144.D0*CTR4)*HTC+(238.D0-758.D0*CTR2+ # 448.D0*CTR4)*HTIV-(17.D0-58.D0*CTR2+32.D0*CTR4)* # HTV)*RLHT/27.D0/HTTHS/HT-8.D0/9.D0*(4.D0- # 26.D0*CTR2-5.D0*CTR4)*RLZT+1.D0/9.D0/CTR2*( # 3.D0+5.D0*CTR2-26.D0*CTR4-48.D0*CTR6)*RLZT+ # (3840.D0*STR2-(4310.D0-4224.D0*CTR2-256.D0*CTR4)* # HT+(1706.D0-1312.D0*CTR2-320.D0*CTR4)*HTS- # (315.D0+476.D0*CTR2-64.D0*CTR4)*HTC+(24.D0+ # 454.D0*CTR2)*HTIV-112.D0*CTR2*HTV+9.D0*CTR2* # HTVI)*PHIHT/9.D0/HTTHS/HTS DRHH2HH= DRHH2L+ZT*DRHH2S * YYYR(NIT)= DRHH2LH ZZZR(NIT)= DRHH2HH ENDDO * DO NIT=1,4 XARRR(NIT)= XXXR(NIT) YARRR(NIT)= YYYR(NIT) ENDDO DO NIT=5,15 XARRR(NIT)= XXXR(NIT+10) YARRR(NIT)= ZZZR(NIT+10) ENDDO * HT= HM2/TQM2 ZT= ZM2/TQM2 SHT= SQRT(HT) HTTH= HT-4.D0 HTTHS= HTTH*HTTH HTS= HT*HT HTC= HTS*HT HTIV= HTC*HT HTV= HTIV*HT HTVI= HTV*HT OMHT= 1.D0-HT HTI= -1.D-37 SPOMHT= TRSPENCE(OMHT,HTI) ZTS= ZT*ZT ZTC= ZTS*ZT WM2O= -WM2 ZM2O= -ZM2 CALL TB0FUN(WM2O,HM2,WM2,B0WHW) CALL TB0FUN(WM2O,WM2,ZM2,B0WWZ) CALL TB0FUN(ZM2O,HM2,ZM2,B0ZHZ) CALL TB0FUN(ZM2O,WM2,WM2,B0ZWW) CALL TGLA(HT,GFHT,BLFHT) ARGHT= HT/4.D0 CALL TPHI(ARGHT,PHIHT) RLHT= LOG(HT) RLHTS= RLHT*RLHT RLZT= LOG(ZT) F1HT= -PHIHT/2.D0 * TCOR= 9.D0-13.D0/4.D0*HT-2.D0*HTS-HT/4.D0*(19.D0+6.D0*HT)* # RLHT-HTS/4.D0*(7.D0-6.D0*HT)*RLHTS-PIS/6.D0* # (0.25D0+7.D0/2.D0*HTS-3.D0*HTC)+(0.5D0*HT-2.D0)* # SHT*GFHT+(HT-1.D0)*(HT-1.D0)*(4.D0*HT-7.D0/4.D0)* # SPOMHT-(HTC-33.D0/4.D0*HTS+18.D0*HT-7.D0)*F1HT * IF(OU0.NE.'S') THEN DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT HOC= DRHH2L ELSE * IF(HM.LT.(0.2D0*TQM)) THEN DEH2= (-17.D0+40.D0*CTR2-32.D0*CTR4)*(-4.D0+2.D0*SHT*PI)/ # (108.D0*CTR2)+(-24.D0*HTC+96.D0*CTR2*HTC+144.D0* # HTS*ZT-576.D0*CTR2*HTS*ZT-313.D0*HT*ZTS+1345.D0* # CTR2*HT*ZTS+349.D0*CTR4*HT*ZTS-292.D0*CTR6*HT*ZTS+ # 196.D0*ZTC-1156.D0*CTR2*ZTC-1396.D0*CTR4*ZTC+ # 1168.D0*CTR6*ZTC)/(216.D0*CTR2*(-1.D0+4.D0*CTR2)* # (HT-4.D0*ZT)*ZTS)+(-2.D0*HTC+13.D0*HTS*ZT-32.D0* # HT*ZTS+36.D0*ZTC)*B0ZHZ/(18.D0*CTR2*(HT-4.D0*ZT)* # ZTS)+(-1.D0+4.D0*CTR2-44.D0*CTR4+32.D0*CTR6)*B0ZWW/ # (-24.D0*CTR2+96.D0*CTR4)+(-1.D0-18.D0*CTR2+16.D0* # CTR4)*LOG(CTR2)/(2.D0*(-6.D0+24.D0*CTR2))+(-2.D0* # HTC+11.D0*HTS*ZT-24.D0*HT*ZTS+24.D0*ZTC)*RLHT/ # (18.D0*CTR2*(HT-4.D0*ZT)*ZTS)-(8.D0*HTC-32.D0*CTR2* # HTC-52.D0*HTS*ZT+208.D0*CTR2*HTS*ZT+159.D0*HT*ZTS- # 704.D0*CTR2*HT*ZTS+192.D0*CTR4*HT*ZTS-112.D0*CTR6* # HT*ZTS-268.D0*ZTC+1344.D0*CTR2*ZTC-768.D0*CTR4*ZTC+ # 448.D0*CTR6*ZTC)*RLZT/(72.D0*CTR2*(-1.D0+4.D0* # CTR2)*(HT-4.D0*ZT)*ZTS)+(-4.D0*HTS+16.D0*CTR2*HTS+ # 20.D0*HT*ZT-79.D0*CTR2*HT*ZT-70.D0*CTR4*HT*ZT+ # 48.D0*CTR6*HT*ZT-40.D0*ZTS+156.D0*CTR2*ZTS+280.D0* # CTR4*ZTS-192.D0*CTR6*ZTS)*RLZT/(36.D0*CTR2*(-1.D0+ # 4.D0*CTR2)*(HT-4.D0*ZT)*ZT) ELSE IF(HM.GT.(0.95D0*TQM)) THEN DEH2= (-1152.D0+4608.D0*CTR2+50.D0*HT+2248.D0*CTR2*HT+ # 976.D0*CTR4*HT-1600.D0*CTR6*HT+67.D0*HTS-880.D0* # CTR2*HTS-244.D0*CTR4*HTS+400.D0*CTR6*HTS)/(864.D0* # CTR2*(1.D0-4.D0*CTR2)*HTTH*HT)+(-1.D0+4.D0*CTR2- # 44.D0*CTR4+32.D0*CTR6)*B0ZWW/(-24.D0*CTR2+96.D0* # CTR4)+(4.D0/3.D0-4.D0/HT-(1.D0-4.D0/HT)*BLFHT)/ # (12.D0*CTR2)+(-1.D0-18.D0*CTR2+16.D0*CTR4)* # LOG(CTR2)/(2.D0*(-6.D0+24.D0*CTR2))+(-384.D0- # 202.D0*HT+320.D0*CTR2*HT-256.D0*CTR4*HT+55.D0*HTS+ # 80.D0*CTR2*HTS-64.D0*CTR4*HTS+3.D0*HTC-40.D0*CTR2* # HTC+32.D0*CTR4*HTC)*RLHT/(144.D0*CTR2*HTTHS*HT)+ # (-17.D0+40.D0*CTR2-32.D0*CTR4)*(-4.D0+HT/2.D0+ # (1.D0-HT/4.D0)*SHT*GFHT+(6.D0-HT)*HT*RLHT/4.D0)/ # (108.D0*CTR2)-(-31.D0+192.D0*CTR2-192.D0*CTR4+ # 112.D0*CTR6)*RLZT/(72.D0*CTR2-288.D0*CTR4)+(2.D0- # 7.D0*CTR2-70.D0*CTR4+48.D0*CTR6)*RLZT/(-36.D0* # CTR2+144.D0*CTR4)+(-384.D0-10.D0*HT+320.D0*CTR2* # HT-256.D0*CTR4*HT+238.D0*HTS-400.D0*CTR2*HTS+ # 320.D0*CTR4*HTS-63.D0*HTC+80.D0*CTR2*HTC-64.D0* # CTR4*HTC+3.D0*HTIV)*PHIHT/(144.D0*CTR2*HTTHS*HTS) ELSE NINTP= 15 RHT= SQRT(HM2/TQM2) CALL TPOLINT(XARR,YARR,NINTP,RHT,DEH2,DEH2C) ENDIF * IF(HM.LT.(0.3D0*TQM)) THEN DRHW2= -13.D0/144.D0-1.D0/48.D0/CTR4-41.D0/96.D0/CTR2+ # 61.D0/72.D0*CTR2+(7.D0-16.D0*CTR2)/27.D0*PI* # SHT-PIS/36.D0-5.D0/144.D0*HTS/CTR4/ZTS+ # 35.D0/288.D0*HT/CTR2/ZT+5.D0/12.D0*(1.D0+ # HTS/12.D0/CTR4/ZTS-HT/3.D0/CTR2/ZT)*B0WHW+ # (1.D0+20.D0*CTR2-24.D0*CTR4)/48.D0/CTR4*B0WWZ- # 1.D0/144.D0/CTR2/STR2/ZT/(HT-CTR2*ZT)*( # 5.D0*STR2*HTS+3.D0*HT*ZT+48.D0*CTR2*HT*ZT- # 60.D0*CTR4*HT*ZT-3.D0*CTR2*ZTS-8.D0*CTR4*ZTS+ # 20.D0*CTR6*ZTS)*LOG(CTR2)+5.D0/144.D0/CTR4/ZTS/ # (HT-CTR2*ZT)*HT*(HTS-4.D0*CTR2*HT*ZT+12.D0*CTR4* # ZTS)*RLHT-(17.D0/36.D0-13.D0/18.D0*CTR2)*RLZT- # 1.D0/144.D0/CTR4/ZT/(HT-CTR2*ZT)*(5.D0*CTR2*HTS- # 3.D0*HT*ZT-60.D0*CTR2*HT*ZT+60.D0*CTR4*HT*ZT+( # 3.D0*CTR2+60.D0*CTR4-20.D0*CTR6)*ZTS)*RLZT ELSE DRHW20= -121.D0/288.D0-1.D0/48.D0/CTR4-41.D0/96.D0/CTR2+ # 77.D0/72.D0*CTR2+19.D0/72.D0/HT+(41.D0/216.D0- # 4.D0/27.D0*CTR2)*HT-(19.D0+21.D0*HT)*PIS/432.D0/ # HTS-(1.D0/2.D0-1.D0/48.D0/CTR4-5.D0/12.D0/CTR2)* # B0WWZ+(16.D0*CTR2-7.D0)/216.D0*HTTH*SHT* # GFHT-(1.D0/12.D0-1.D0/3.D0/HT)*BLFHT+1.D0/72.D0/ # HTS*(19.D0+21.D0*HT-12.D0*HTS-31.D0*HTC+9.D0* # HTIV)*SPOMHT-1.D0/48.D0/CTR2/STR2*( # 1.D0+21.D0*CTR2-25.D0*CTR4)*LOG(CTR2)-(17.D0/ # 36.D0-13.D0/18.D0*CTR2)*RLZT+1.D0/48.D0/CTR4*( # 1.D0+20.D0*CTR2-25.D0*CTR4)*RLZT DRHW2L= 1.D0/216.D0/HT/ # HTTH*(372.D0+(96.D0*CTR2-213.D0)*HT+(432.D0* # CTR2-318.D0)*HTS+(97.D0-160.D0*CTR2)*HTC-(7.D0- # 16.D0*CTR2)*HTIV)*RLHT DRHW2P= 1.D0/144.D0/HTS/HTTH* # (96.D0-(384.D0-64.D0*CTR2)*HT-(2.D0+64.D0*CTR2)* # HTS+231.D0*HTC-85.D0*HTIV+9.D0*HTV)*PHIHT DRHW2= DRHW20+DRHW2L+DRHW2P ENDIF * IF(HM.LT.(0.2D0*TQM)) THEN DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT DRHH2= 19.D0-53.D0/3.D0*HT+3.D0/2.D0*PI*SQRT(HTC)+ # 8.D0/9.D0*HTS/ZT-5.D0/9.D0/CTR2*HTS/ZT+ # (845.D0/27.D0-1.D0/3.D0/CTR2+427.D0/27.D0*CTR2- # 122.D0/9.D0*CTR4)*ZT+PIS/27.D0*(54.D0*HT-54.D0- # 119.D0*ZT+44.D0*CTR2*ZT)+4.D0/27.D0*SHT*PI* # (-27.D0+34.D0*ZT-116.D0*CTR2*ZT+64.D0*CTR4*ZT)+ # (32.D0/9.D0*HT-8.D0/9.D0*HTS/ZT-32.D0/3.D0*ZT)* # B0ZHZ+(1.D0+20.D0*CTR2-24.D0*CTR4)*ZT/3.D0/CTR2* # B0WWZ-2.D0/3.D0*(1.D0+18.D0*CTR2-16.D0*CTR4)*ZT* # B0ZWW-5.D0/9.D0*(4.D0*HT-HTS/CTR2/ZT-12.D0*CTR2* # ZT)*B0WHW-1.D0/9.D0*(5.D0*HT+3.D0*ZT+32.D0*CTR2* # ZT+48.D0*CTR4*ZT)*LOG(CTR2)+HT/9.D0/CTR2/ZT*( # 5.D0*HT-8.D0*CTR2*HT-18.D0*CTR2*ZT)*RLHT-8.D0/ # 9.D0*(4.D0-26.D0*CTR2-5.D0*CTR4)*ZT*RLZT+( # HT/3.D0-11.D0/9.D0*ZT+ZT/3.D0/CTR2-16.D0/9.D0* # CTR2*ZT-16.D0/3.D0*CTR4*ZT)*RLZT ELSE IF(HM.GT.(0.95D0*TQM)) THEN DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT DRHH2S= 1.D0/54.D0/CTR2/HTTH/HT*(-1776.D0* # CTR4+(72.D0-6250.D0*CTR2-3056.D0*CTR4+3696.D0*CTR6)* # HT+(-18.D0+1283.D0*CTR2+1371.D0*CTR4-1436.D0*CTR6)* # HTS+(68.D0*CTR2-124.D0*CTR4+128.D0*CTR6)*HTC)+ # PIS/27.D0/HTS*(6.D0*CTR2*HT-37.D0*CTR2-119.D0* # HTS+56.D0*CTR2*HTS)+(32.D0/3.D0*CTR4-2.D0/3.D0- # 12.D0*CTR2)*B0ZWW+(20.D0/3.D0+1.D0/3.D0/CTR2- # 8.D0*CTR2)*B0WWZ+1.D0/27.D0*(17.D0-58.D0*CTR2+ # 32.D0*CTR4)*(4.D0-HT)*SHT*GFHT-40.D0/3.D0* # STR2*(4.D0-HT)/HT*BLFHT+2.D0/9.D0*CTR2/HTS*( # 37.D0-6.D0*HT-12.D0*HTS-22.D0*HTC+9.D0*HTIV)* # SPOMHT-1.D0/3.D0*(1.D0+14.D0*CTR2+ # 16.D0*CTR4)*LOG(CTR2)+(11520.D0-15072.D0*CTR2- # (7170.D0-8928.D0*CTR2-768.D0*CTR4)*HT+ # (3411.D0-7062.D0*CTR2+3264.D0*CTR4)*HTS-(1259.D0- # 3547.D0*CTR2+2144.D0*CTR4)*HTC+(238.D0-758.D0*CTR2+ # 448.D0*CTR4)*HTIV-(17.D0-58.D0*CTR2+32.D0*CTR4)* # HTV)*RLHT/27.D0/HTTHS/HT-8.D0/9.D0*(4.D0- # 26.D0*CTR2-5.D0*CTR4)*RLZT+1.D0/9.D0/CTR2*( # 3.D0+5.D0*CTR2-26.D0*CTR4-48.D0*CTR6)*RLZT+ # (3840.D0*STR2-(4310.D0-4224.D0*CTR2-256.D0*CTR4)* # HT+(1706.D0-1312.D0*CTR2-320.D0*CTR4)*HTS- # (315.D0+476.D0*CTR2-64.D0*CTR4)*HTC+(24.D0+ # 454.D0*CTR2)*HTIV-112.D0*CTR2*HTV+9.D0*CTR2* # HTVI)*PHIHT/9.D0/HTTHS/HTS DRHH2= DRHH2L+ZT*DRHH2S ELSE DRHH2L= 25.D0-4.D0*HT+(1.D0/2.D0-1.D0/HT)*PIS+HTTH* # SHT*GFHT/2.D0+(-6.D0-6.D0*HT+HTS/2.D0)*RLHT+ # (6.D0/HT-15.D0+12.D0*HT-3.D0*HTS)* # SPOMHT+3.D0/2.D0*(-10.D0+6.D0*HT-HTS)* # PHIHT NINTP= 15 RHT= SQRT(HM2/TQM2) CALL TPOLINT(XARRR,YARRR,NINTP,RHT,DRHH2,DRHHWC) ENDIF IF(HM.LT.(0.5D0*TQM)) THEN DEOE= 61.D0/72.D0-16.D0/27.D0*PI*SHT+13.D0/18.D0* # RLZT ELSE DEOE= (231.D0-32.D0*HT)/216.D0-2.D0/27.D0*(4.D0-HT)* # SHT*GFHT+2.D0/27.D0/HTTH*(6.D0+ # 27.D0*HT-10.D0*HTS+HTC)*RLHT+13.D0/18.D0* # RLZT-4.D0/9.D0*(HT-1.D0)/HTTH/HT*PHIHT ENDIF DRHW2= 3.D0*(AEXP/STR2)**2*TQM2/WM2*DRHW2 DRHH2= 3.D0*AEXP*AEXPH*(1.D0/4.D0/STR2/CTR2*TQM2/ZM2)**2* # DRHH2+4.D0*(AEXP/STR2)**2*LOG(WM2/ZM2)*(SZZT-SWWT)/WM2 DEOE= 3.D0*AEXP**2/STR2*TQM2/ZM2/CTR2*DEOE DKH2= (-211.D0+24.D0*HT+462.D0*STR2-64.D0*HT*STR2)/432.D0+ # (3.D0/8.D0-STR2/3.D0)*B0ZWW-STR2/6.D0*LOG(CTR2)+ # HTTH/108.D0*(8.D0*STR2-3.D0)*SHT*GFHT+(8.D0*STR2- # 3.D0)/108.D0/HTTH*(6.D0+27.D0*HT-10.D0*HTS+HTC)* # RLHT+(1.D0/4.D0+2.D0/9.D0*STR2)*RLZT+(3.D0*STR2- # 2.D0)/18.D0*RLZT-(HT-1.D0)*(8.D0*STR2-3.D0)/18.D0/ # HTTH/HT*PHIHT DKH2= 3.D0*(AEXPH/STR2)**2*TQM2/WM2*DKH2 DEH2= 3.D0*AEXP*AEXPH/STR4*TQM2/WM2*DEH2 ENDIF * IF(OU7.EQ.'N') THEN NFP1= NF+1 DQCD3= 157.D0/648.D0-3313.D0/162.D0*RZ2-308.D0/27.D0*RZ3+ # 143.D0/18.D0*Z4-4.D0/3.D0*RZ2*LOG(2.D0)+ # 441.D0/8.D0*SCS2-1.D0/9.D0*SCB4-1.D0/18.D0*SCD3- # (1.D0/18.D0-13.D0/9.D0*RZ2+4.D0/9.D0*RZ3)*NFP1- # (11.D0/6.D0-NF/9.D0)*(1.D0+2.D0*RZ2)*2.D0*LOG(SC) DQCD3= DQCD3*ALSTS*ALSTS/PIS DRHO3= -3.D0/4.D0*XI*DQCD3 ELSE IF(OU7.EQ.'Y') THEN DRHO3= 0.D0 ENDIF SIGF0C= SIGF+RSCEFF+DRHO3 SIGFP0C= SIGFP+RSCEFF+DRHO3 SIGFS0C= SIGT+RSCEFF+DRHO3 * SIGFC= SIGF+RSCEFF+DRHO3-3.D0/16.D0*GFC*DRHH2L*XI2 RHO= 1.D0/(1.D0+GFC*SIGFC) * SIGFPC= SIGFP+RSCEFF+DRHO3-3.D0/16.D0*GFC*DRHH2L*XI2 RHOP= 1.D0/(1.D0+GFC*SIGFPC) * SIGTC= SIGT-RESS2/ZM2+RSCEFF+DRHO3 RHOS1= -AEXP*(SIGTC/STR2/CTR2+PITZ) RHOS1S= AEXP**2/STR2/CTR2*(-SIGT+RESS2/ZM2- # 3.D0/4.D0*TQM2/ZM2) RHOS2= -WM2/ZM2/CTR2*(DRHW2-DRHH2)- # (WM2/ZM2/CTR2-1.D0)*DEOE RHOSC= 1.D0+RHOS1+RHOS2 IF(OU8.EQ.'C') THEN RHOS= RHOSC ELSE IF(OU8.EQ.'L') THEN RHOS= RHOSC-RHOS1S ELSE IF(OU8.EQ.'R') THEN RHOS= RHOSC+RHOS1S ENDIF * JRESUM= 0 AUX0= SIGF0C/CMSTH2 AUX1= SIGFP0C/CMSTH2 AUX2= 3.D0/16.D0/CMSTH2*(16.D0/3.D0*AUX0*AUX0- # 1.D0/CSTH2*DRHH2L*XI2) * ARGR= 1.D0-2.D0*PI*ALPHA/GF/ZM2/RHO*1.D0/(1.D0-AEXP*PIFZ) ARGRP= 1.D0-2.D0*PI*ALPHA/GF/ZM2/RHOP* # 1.D0/(1.D0-AEXP*PIFZ) * SIGBM= (SWW0B+S3GBZ-S33BZ)/ZM2+CSTH2*PIBZ IF(OU0.EQ.'N'.OR.OU0.EQ.'L') THEN SIGB= CMSTH2*(S3GTZ+STH2*ZM2*PGGTZ)/ZM2 SIGBNR= 0.D0 ELSE IF(OU0.EQ.'S') THEN SIGB= CMSTR2*(S3GTZ+STR2*ZM2*PGGTZ)/ZM2 SIGBNR= 0.D0 SIGBB= CMSTH2*(S3GTZ+STH2*ZM2*PGGTZ)/ZM2 ENDIF * S33Z= S33FZ+S33BZ S3GZ= S3GFZ+S3GBZ PZ= PIFZ+PIBZ * *-----COMPUTES THE Z0 WAVE-FUNCTION FACTOR * IF(OU0.EQ.'N') THEN DPIZ= (SWW0B-S33BZ-S3GFZ-ZM2*SP33Z+ # 2.D0*STH2*(S3GZ+ZM2*SP3GZ)+STH4*ZM2*ZM2* # (PPGGZ+PPGGNPZ))/ZM2 RHOL= RHO ELSE IF(OU0.EQ.'L') THEN DPIZ= -SP33Z+2.D0*STH2*SP3GZ+STH4*(ZM2*(PPGGZ+PPGGNPZ)- # PGGTZ)+CSTH2*(PGGFZ+PGGLQZ+PGGB0) RHOL= RHOP ELSE IF(OU0.EQ.'S') THEN DPIZ= -SP33Z+2.D0*STR2*SP3GZ+STR4*(ZM2*(PPGGZ+PPGGNPZ)- # PGGTZ)+CSTR2*(-PITZ+PGGTZ) SIGFCB= SIGF+RSCEFF+DRHO3-3.D0/16.D0*GFC*DRHH2L*XI2 RHOL= 1.D0/(1.D0+GFC*SIGFCB) DPIZB= (SWW0B-S33BZ-S3GFZ-ZM2*SP33Z+ # 2.D0*STH2*(S3GZ+ZM2*SP3GZ)+STH4*ZM2*ZM2* # (PPGGZ+PPGGNPZ))/ZM2 ENDIF * IF(OU0.NE.'S') THEN WZZ= DPIZ/CSTH2 ELSE WZZ= DPIZB/CSTH2 ENDIF * *-----COMPUTES THE RESIDUAL CORRECTIONS TO SIN^2 * IF(OU0.NE.'S') THEN DST2= SIGB/CMSTH2 DST2B= DST2 ELSE DST2= SIGB/CMSTR2 DST2B= SIGBB/CMSTH2 DST2= DST2-AEXPH/ZM2*PGGI*(PGZI+STR2*ZM2*PGGI) DST2B= DST2B-AEXPH/ZM2*PGGI*(PGZI+STR2*ZM2*PGGI) ENDIF * *-----COMUPTES THE TOTAL Z0 WIDTH * *-----QCD & MASS CORRECTIONS * CALL TCORRQCD(ZM) DO JC=1,9 * IF(OU1.EQ.'N') THEN AX= AEXP ELSE IF(OU1.EQ.'Y') THEN AX= AEXPH ENDIF * *-----LEPTONIC WIDTHS * IF(JC.LE.3) THEN IF(JC.EQ.1) THEN FM= EM QFM= QEM QFMD= QNM ACM= 0.D0 ELSE IF(JC.EQ.2) THEN FM= MM QFM= QMM QFMD= QNM ACM= ACMM ELSE IF(JC.EQ.3) THEN FM= TLM QFM= QTM QFMD= QNM ACM= ACMT ENDIF * QFM2= QFM*QFM QFMD2= QFMD*QFMD * *-----AUXILIARY FUNCTIONS FOR VERTICES * N1= 1 N2= 2 FF1= QRFS(N1,QFM2,QZM2,QFM2) FF2= QRFS(N1,QFMD2,QWM2,QFMD2) FF3= QRFS(N2,QWM2,QFMD2,QWM2) FF3P= 2.D0*FF3+DELW * VHL= ZID-2.D0*BQL*STH2 VHL2= VHL*VHL VRL= ZID-2.D0*BQL*STR2 VRL2= VRL*VRL CALL TWFF(STH2,BQL,ZID,WVL,WAL) FRAD= 1.D0+ALPHAH/PI*(3.D0/4.D0-1.D0/4.D0*ALSTZ/PI) * *-----VERTEX CORRECTIONS * FVL= WVL*VHL+WAL*ZID-2.D0*VHL*(VHL2+3.D0/4.D0)* # FF1+4.D0*ZID*CTH2*FF2-CTH4*ZID*FF3P * FAL= WVL*ZID+WAL*VHL-2.D0*ZID*(3.D0*VHL2+0.25D0)* # FF1+4.D0*ZID*CTH2*FF2-CTH4*ZID*FF3P * *-----EFFECTIVE ASYMMETRIES * COMPUTED ARE ALSO ASYMMETRIES ACCORDING TO THE CONVENTIONAL * DEFINITION WHERE POWERS OF G_V AND G_A ARE NEVER EXPANDED * IF(JC.EQ.1) THEN DGV= 2.D0*FVL/CSTH2+2.D0*DST2-0.5D0*VHL*WZZ DGA= 2.D0*FAL/CSTH2+0.25D0*WZZ GV= VRL+AX*DGV GA= -0.5D0+AX*DGA GV2= VRL2+2.D0*AX*VHL*DGV GA2= 0.25D0-AX*DGA IF(OU2.EQ.'N') THEN AFBN= 0.25D0*VRL2+AX*(-VHL2*DGA+0.5D0*VHL*DGV) AFBD= (VRL2+0.25D0)*(VRL2+0.25D0)+2.D0*AX* # (VHL2+0.25D0)*(2.D0*VHL*DGV-DGA) AFBEFF= 3.D0*AFBN/AFBD ALRN= -0.5D0*VRL+AX*(-0.5D0*DGV+VHL*DGA) ALRD= VRL2+0.25D0+AX*(2.D0*VHL*DGV-DGA) ALR= 2.D0*ALRN/ALRD ELSE IF(OU2.EQ.'Y') THEN GVGA= GV/GA GVGA2= GVGA*GVGA AFBEFF= 3.D0*GVGA2/(1.D0+GVGA2)**2 ALR= 2.D0*GVGA/(1.D0+GVGA2) ENDIF IF(OU0.NE.'S') THEN IF(OU2.EQ.'N') THEN ST2E= STR2+0.5D0*AX*(DGV+(4.D0*STR2-1.D0)*DGA) ELSE IF(OU2.EQ.'Y') THEN ST2E= (STR2+0.5D0*AX*(DGV-DGA))/(1.D0-2.D0*AX*DGA) ENDIF ENDIF ENDIF * IF(OU0.NE.'S') THEN IF(OU2.EQ.'N') THEN ZW(JC)= GF*RHOL*ZM3/6.D0/PI*((VRL2+0.25D0)*FRAD+ # GA2*ACM+AX*(2.D0*FACT*(2.D0*VHL*FVL-FAL)+ # 4.D0*VHL*DST2-(VHL2+0.25D0)*WZZ)) PW(JC)= GF*RHOL*ZM3/6.D0/PI*((VRL2+0.25D0)+ # AX*(2.D0*FACT*(2.D0*VHL*FVL-FAL)+ # 4.D0*VHL*DST2-(VHL2+0.25D0)*WZZ)) * ELSE IF(OU2.EQ.'Y') THEN ZW(JC)= GF*RHOL*ZM3/6.D0/PI*(GV*GV+GA*GA*(1.D0+ACM))* # FRAD PW(JC)= GF*RHOL*ZM3/6.D0/PI*(GV*GV+GA*GA) ENDIF ELSE CALL TWFF(STR2,BQL,ZID,WVLI,WALI) FVLI= WVLI*VRL+WALI*ZID-2.D0*VRL*(VRL2+3.D0/4.D0)* # FF1+4.D0*ZID*CTR2*FF2-CTR4*ZID*FF3P FALI= WVLI*ZID+WALI*VRL-2.D0*ZID*(3.D0*VRL2+0.25D0)* # FF1+4.D0*ZID*CTR2*FF2-CTR4*ZID*FF3P * *-----IMAGINARY PARTS FROM VERTICES * N1= 1 N2= 2 FF1I= QIFS(N1,QFM2,QZM2,QFM2) FF2I= QIFS(N1,QFMD2,QWM2,QFMD2) FF3I= QIFS(N2,QWM2,QFMD2,QWM2) FF3PI= 2.D0*FF3I * FVLII= -2.D0*VRL*(VRL2+3.D0/4.D0)*FF1I+4.D0*ZID*CTR2*FF2I- # CTR4*ZID*FF3PI FALII= -2.D0*ZID*(3.D0*VRL2+0.25D0)* # FF1I+4.D0*ZID*CTR2*FF2I-CTR4*ZID*FF3PI * DGVI= 4.D0*VRL*FALI/CSTR2+2.D0*FVLI/CSTR2+2.D0*DST2 GVI= VRL+AX*DGVI+2.D0*STR2*DKH2 GAI= ZID IF(OIMAG.EQ.'Y') THEN GVII= 2.D0*AX*(FVLII/CSTR2+(PGZI+STR2*ZM2*PGGI)/ZM2) * GAII= 2.D0*AX*FALII/CSTR2 GAII= 2.D0*AX*FALII/CSTR2*(1.D0+4.D0*AX*FALI/CSTR2) ELSE GVII= 0.D0 GAII= 0.D0 ENDIF VIM(JC)= GVII AIM(JC)= GAII * DPIZC= AEXP/CSTR2*(DPIZ+8.D0*FALI)+DEOE-DEH2/CTR2 DPIZCF= 1.D0/(1.D0+DPIZC) ZW(JC)= GF*ZM3/6.D0/PI*RHOS*DPIZCF* # (GVI*GVI+GVII*GVII+GAII*GAII+ # GAI*GAI*(1.D0+ACM))*FRAD PW(JC)= GF*ZM3/6.D0/PI*RHOS*DPIZCF* # (GVI*GVI+GVII*GVII+GAII*GAII+GAI*GAI) * ST2EFF(JC)= STR2+AX*(2.D0*VRL*FALI/CSTR2+FVLI/CSTR2+DST2)+ # DKH2*STR2 RHOEFF(JC)= RHOS*DPIZCF ST2E= ST2EFF(1) RHOE= RHOEFF(1) IF(JC.LE.3) THEN IF(OPO.EQ.'ICO') THEN ANUM(JC)= GVI*GAI+GVII*GAII ADEN(JC)= GVI*GVI+GVII*GVII+GAI*GAI+GAII*GAII ELSE IF(OPO.EQ.'ORT') THEN ANUM(JC)= GVI*GAI ADEN(JC)= GVI*GVI+GAI*GAI ENDIF ARAT(JC)= ANUM(JC)/ADEN(JC) ENDIF AFBEFF= 3.D0*ARAT(1)*ARAT(1) ALR= 2.D0*ARAT(1) ENDIF * *-----HADRONIC WIDTHS * ELSE IF(JC.GT.3.AND.JC.LT.8) THEN SINGF= -0.5D0-2.D0/3.D0*STR2 VUP= 0.5D0-4.D0/3.D0*STR2 VDO= -0.5D0+2.D0/3.D0*STR2 ALS3= (ALSR/PI)**3 IF(JC.EQ.4) THEN FM= UQM FMD= DQM QFM= QUQM QFMD= QDQM VCM= VCML ACM= VCML ACORQ= ACORU VCORQC= -0.41318D0*ALS3*SINGF/VUP ZI3= ZIU BQCH= BQUQ BQCHD= BQDQ ELSE IF(JC.EQ.5) THEN FM= DQM FMD= UQM QFM= QDQM QFMD= QUQM VCM= VCML ACM= VCML ACORQ= ACORD VCORQC= -0.41318D0*ALS3*SINGF/VDO ZI3= ZID BQCH= BQDQ BQCHD= BQUQ ELSE IF(JC.EQ.6) THEN FM= SQM FMD= CQM QFM= QSQM QFMD= QCQM VCM= VCML ACM= VCML ACORQ= ACORD VCORQC= -0.41318D0*ALS3*SINGF/VDO ZI3= ZID BQCH= BQDQ BQCHD= BQUQ ELSE IF(JC.EQ.7) THEN FM= CQM FMD= SQM QFM= QCQM QFMD= QSQM VCM= VCMC ACM= ACMC ACORQ= ACORU VCORQC= -0.41318D0*ALS3*SINGF/VUP ZI3= ZIU BQCH= BQUQ BQCHD= BQDQ ENDIF FM2= FM*FM FMD2= FMD*FMD BQCH2= BQCH*BQCH FRADQ= 1.D0+ALPHAH/PI*BQCH2*(3.D0/4.D0-1.D0/4.D0*ALSR/PI) * *-----UP/DOWN QUARKS (NOT B) * QFM2= QFM*QFM QFMD2= QFMD*QFMD2 * *-----AUXILIARY FUNCTIONS FOR VERTICES * N1= 1 N2= 2 FF1= QRFS(N1,QFM2,QZM2,QFM2) FF2= QRFS(N1,QFMD2,QWM2,QFMD2) FF3= QRFS(N2,QWM2,QFMD2,QWM2) FF3P= 2.D0*FF3+DELW * VHQ= ZI3-2.D0*BQCH*STH2 VHQ2= VHQ*VHQ VQT= -ZI3-BQCHD*STH2 VRQ= ZI3-2.D0*BQCH*STR2 VRQT= -ZI3-BQCHD*STR2 VRQ2= VRQ*VRQ CALL TWFF(STH2,BQCH,ZI3,WVQ,WAQ) * *-----VERTEX CORRECTIONS * FVQ= WVQ*VHQ+WAQ*ZI3-2.D0*VHQ*(VHQ2+3.D0/4.D0)* # FF1-4.D0*VQT*CTH2*FF2-CTH4*ZI3*FF3P * FAQ= WVQ*ZI3+WAQ*VHQ-2.D0*ZI3*(3.D0*VHQ2+0.25D0)* # FF1-4.D0*VQT*CTH2*FF2-CTH4*ZI3*FF3P * ACMQ0= -6.D0*FM2/ZM2 DGVQ= 2.D0*FVQ/CSTH2-2.D0*BQCH*DST2-0.5D0*VHQ*WZZ DGAQ= 2.D0*FAQ/CSTH2-0.5*ZI3*WZZ GVQ0= VRQ GAQ0= ZI3 GVQC= AX*DGVQ GAQC= AX*DGAQ GVQ= GVQ0+GVQC GAQ= GAQ0+GAQC GVQS= GVQ*GVQ CMX1= -1.57D0/16.D0/STR2/CTR2 CMX2= -1.68D0/8.D0/STR2 CMX3= -0.87D0*3.D0/2.D0*CTR2/STR2 FMIX= ALPHAH*ALSTZ/PIS CMIX= (1.D0/8.D0+VRQ2*(3.D0+2.D0*VRQ2))*CMX1+ # (VRQ+ZI3)*(VRQT-ZI3)*CMX2+ZI3*(VRQ+ZI3)*CMX3 GQQFMIX= GF*RHO*ZM3/2.D0/PI*FMIX*CMIX * IF(OU0.NE.'S') THEN IF(OU6.EQ.'Y') THEN IF(OU2.EQ.'Y') THEN GQQF= GF*RHOL*ZM3/2.D0/PI*(GVQ*GVQ*(FRADQ+VCORQ+ODQCD+ # VCM)+GAQ*GAQ*(FRADQ+ACORQ+ODQCD+ACM)) PQQF= GF*RHOL*ZM3/2.D0/PI*(GVQ*GVQ+GAQ*GAQ) ELSE IF(OU2.EQ.'N') THEN GQQF= GF*RHOL*ZM3/2.D0/PI*((VRQ2+2.D0*VHQ*GVQC)* # (FRADQ+VCORQ+ODQCD+VCM)+GAQ0*(GAQ0+2.D0*GAQC)* # (FRADQ+ACORQ+ODQCD+ACM)+GAQC*GAQC*ACMQ0) PQQF= GF*RHOL*ZM3/2.D0/PI*((VRQ2+2.D0*VHQ*GVQC) # +GAQ0*(GAQ0+2.D0*GAQC)+GAQC*GAQC*ACMQ0) ENDIF GQQF= GQQF+GQQFMIX ZW(JC)= GQQF PW(JC)= PQQF ELSE IF(OU6.EQ.'N') THEN IF(OU2.EQ.'N') THEN GQQQCD= GF*RHOL*ZM3/2.D0/PI*(VRQ2*(VCORQ+ODQCD+VCM)+ # 0.25D0*(ACORQ+ODQCD+ACM)+2.D0*GAQ0*GAQC*ACMQ0) GQQEW= GF*RHOL*ZM3/2.D0/PI*((VRQ2+0.25D0)*FRADQ+ # AX*(4.D0*FACT*(VHQ*FVQ+ZI3*FAQ)- # 4.D0*BQCH*VHQ*DST2-(VHQ2+0.25D0)*WZZ)) PQQEW= GF*RHOL*ZM3/2.D0/PI*(VRQ2+0.25D0+ # AX*(4.D0*FACT*(VHQ*FVQ+ZI3*FAQ)- # 4.D0*BQCH*VHQ*DST2-(VHQ2+0.25D0)*WZZ)) ELSE IF(OU2.EQ.'Y') THEN GQQQCD= GF*RHOL*ZM3/2.D0/PI*(VRQ2*(VCORQ+ODQCD+VCM)+ # 0.25D0*(ACORQ+ODQCD+ACM)+(2.D0*GAQ0*GAQC+ # GAQC*GAQC)*ACMQ0) GQQEW= GF*RHOL*ZM3/2.D0/PI*(GVQ*GVQ+GAQ*GAQ)*FRADQ PQQEW= GF*RHOL*ZM3/2.D0/PI*(GVQ*GVQ+GAQ*GAQ) ENDIF ZW(JC)= GQQEW+GQQQCD+GQQFMIX PW(JC)= PQQEW ENDIF ZWQCDS(JC)= GF*RHOL*ZM3/2.D0/PI*VRQ2*VCORQC ELSE CALL TWFF(STR2,BQCH,ZI3,WVQI,WAQI) FVQI= WVQI*VRQ+WAQI*ZI3-2.D0*VRQ*(VRQ2+3.D0/4.D0)* # FF1-4.D0*VRQT*CTR2*FF2-CTR4*ZI3*FF3P FAQI= WVQI*ZI3+WAQI*VRQ-2.D0*ZI3*(3.D0*VRQ2+0.25D0)* # FF1-4.D0*VRQT*CTR2*FF2-CTR4*ZI3*FF3P * *-----IMAGINARY PARTS FROM VERTICES * N1= 1 N2= 2 FF1I= QIFS(N1,QFM2,QZM2,QFM2) FF2I= QIFS(N1,QFMD2,QWM2,QFMD2) FF3I= QIFS(N2,QWM2,QFMD2,QWM2) FF3PI= 2.D0*FF3I * FVQII= -2.D0*VRQ*(VRQ2+3.D0/4.D0)*FF1I-4.D0*VRQT*CTR2*FF2I- # CTR4*ZI3*FF3PI FAQII= -2.D0*ZI3*(3.D0*VRQ2+0.25D0)* # FF1I-4.D0*VRQT*CTR2*FF2I-CTR4*ZI3*FF3PI * GVQI= VRQ+AX*(-8.D0*ZI3*VRQ*FAQI/CSTR2+2.D0*FVQI/CSTR2- # 2.D0*BQCH*DST2)-2.D0*BQCH*STR2*DKH2 GAQI= ZI3 IF(OIMAG.EQ.'Y') THEN GVQII= 2.D0*AX*(FVQII/CSTR2-BQCH/ZM2*(PGZI+STR2*ZM2*PGGI)) * GAQII= 2.D0*AX*FAQII/CSTR2 GAQII= 2.D0*AX*FAQII/CSTR2*(1.D0-8.D0*AX*ZI3*FAQI/CSTR2) ELSE GVQII= 0.D0 GAQII= 0.D0 ENDIF VIM(JC)= GVQII AIM(JC)= GAQII DPIZC= AEXP/CSTR2*(DPIZ-16.D0*ZI3*FAQI)+DEOE-DEH2/CTR2 GQQFMIXI= GF*RHOS/(1.D0+DPIZC)*ZM3/2.D0/PI*FMIX*CMIX IF(OU6.EQ.'Y') THEN GQQFI= GF*RHOS/(1.D0+DPIZC)*ZM3/2.D0/PI*((GVQI*GVQI+ # GVQII*GVQII)*(FRADQ+VCORQ+ODQCD+VCM)+ # (GAQI*GAQI+GAQII*GAQII)*(FRADQ+ACORQ+ODQCD+ACM)) PQQFI= GF*RHOS/(1.D0+DPIZC)*ZM3/2.D0/PI*(GVQI*GVQI+ # GVQII*GVQII+GAQI*GAQI+GAQII*GAQII) GQQFI= GQQFI+GQQFMIXI ZW(JC)= GQQFI PW(JC)= PQQFI ELSE IF(OU6.EQ.'N') THEN GQQQCDI= GF*RHOS/(1.D0+DPIZC)*ZM3/2.D0/PI*(VRQ2* # (VCORQ+ODQCD+VCM)+0.25D0*(ACORQ+ODQCD+ACM)) GQQEWI= GF*RHOS/(1.D0+DPIZC)*ZM3/2.D0/PI*(GVQI*GVQI+ # GAQI*GAQI+GVQII*GVQII+GAQII*GAQII)*FRADQ PQQEWI= GF*RHOS/(1.D0+DPIZC)*ZM3/2.D0/PI*(GVQI*GVQI+ # GAQI*GAQI+GVQII*GVQII+GAQII*GAQII) ZW(JC)= GQQEWI+GQQQCDI+GQQFMIXI PW(JC)= PQQEWI ENDIF ST2EFF(JC)= STR2+AX*(4.D0*ZI3/BQCH*VRQ*FAQI/CSTR2- # FVQI/BQCH/CSTR2+DST2)+DKH2*STR2 RHOEFF(JC)= RHOS/(1.D0+DPIZC) ST2C= ST2EFF(7) RHOCQ= RHOEFF(7) DPIZCF= 1.D0/(1.D0+DPIZC) ZWQCDS(JC)= GF*RHOS*DPIZCF*ZM3/2.D0/PI*VRQ2*VCORQC ENDIF * *-----EFFECTIVE DECONVOLUTED C ASYMMETRY * IF(JC.EQ.7) THEN IF(OU0.NE.'S') THEN GVQ00= VHQ GVL0= VRL GVL00= VHL GVLC= AX*DGV GAL0= -0.5D0 GALC= AX*DGA IF(OMA.EQ.'Y') THEN BETC2= 1.D0-4.D0*CQM2/ZM2 ELSE BETC2= 1.D0 ENDIF BETC= SQRT(BETC2) BETCP= 0.5D0*(3.D0-BETC2) IF(OU2.EQ.'N') THEN AFBCN= GVL0*GAL0*GVQ0*GAQ0+GVLC*GAL0*GVQ00*GAQ0+ # GVL00*GALC*GVQ00*GAQ0+GVL00*GAL0*GVQC*GAQ0+ # GVL00*GAL0*GVQ00*GAQC AFBCN= 3.D0*BETC*AFBCN AFBCD= (GVL0*GVL0+GAL0*GAL0)*(BETCP*GVQ0*GVQ0+BETC2* # GAQ0*GAQ0)+2.D0*(GVL00*GVL00+GAL0*GAL0)*(BETCP* # GVQ00*GVQC+BETC2*GAQ0*GAQC)+(BETCP*GVQ00*GVQ00+ # BETC2*GAQ0*GAQ0)*2.D0*(GVL00*GVLC+GAL0*GALC) AFBCEFF= AFBCN/AFBCD ALRCN= GVQ0*GAQ0+GVQ00*GAQC+GAQ0*GVQC ALRCD= GVQ0*GVQ0+GAQ0*GAQ0+2.D0*(GVQ00*GVQC+GAQ0*GAQC) ALRCEFF= 2.D0*ALRCN/ALRCD ELSE IF(OU2.EQ.'Y') THEN XVL= GVL0+GVLC XAL= GAL0+GALC ETAL= XVL*XAL/(XVL*XVL+XAL*XAL) XVC= GVQ0+GVQC XAC= GAQ0+GAQC ETAC= XVC*XAC/(BETCP*XVC*XVC+BETC2*XAC*XAC) AFBCEFF= 3.D0*BETC*ETAL*ETAC ALRCEFF= 2.D0*XVC*XAC/(XVC*XVC+XAC*XAC) ENDIF ELSE IF(OMA.EQ.'Y') THEN BETC2= 1.D0-4.D0*CQM2/ZM2 ELSE BETC2= 1.D0 ENDIF BETC= SQRT(BETC2) BETCP= 0.5D0*(3.D0-BETC2) IF(OPO.EQ.'ICO') THEN ETAL= (GVI*GAI+GVII*GAII)/(GVI*GVI+GAI*GAI+ # GVII*GVII+GAII*GAII) ETAC= (GVQI*GAQI+GVQII*GAQII)/ # (BETCP*(GVQI*GVQI+GVQII*GVQII)+ # BETC2*(GAQI*GAQI+GAQII*GAQII)) ALRCEFF= 2.D0*(GVQI*GAQI+GVQII*GAQII)/ # (GVQI*GVQI+GAQI*GAQI+GVQII*GVQII+GAQII*GAQII) ELSE IF(OPO.EQ.'ORT') THEN ETAL= GVI*GAI/(GVI*GVI+GAI*GAI) ETAC= GVQI*GAQI/(BETCP*GVQI*GVQI+BETC2*GAQI*GAQI) ALRCEFF= 2.D0*GVQI*GAQI/(GVQI*GVQI+GAQI*GAQI) ENDIF AFBCEFF= 3.D0*BETC*ETAL*ETAC ENDIF ENDIF * *-----B QUARK * ELSE IF(JC.EQ.8) THEN * VHB= -0.5D0+2.D0/3.D0*STH2 VHB2= VHB*VHB VBT= -VHB VRB= -0.5D0+2.D0/3.D0*STR2 VRB2= VRB*VRB * FRADB= 1.D0+ALPHAH/PI/9.D0*(3.D0/4.D0-1.D0/4.D0*ALSTZ/PI) FRADB= 1.D0+ALPHAH/PI/9.D0*(3.D0/4.D0-1.D0/4.D0*ALSR/PI) * *-----VERTICES * DTW= TQM2-WM2 * B1= -0.5D0*(DELW+0.5D0)+0.5D0*TQM2/DTW*( # TQM2/DTW*LOG(TQM2/WM2)-1.D0) WCOM= 0.25D0*(1.D0+0.5D0*TQM2/WM2)*B1+1.D0/8.D0 WVB= -1.D0/32.D0*(4.D0*VHB2+1.D0)*(DELZ-0.5D0)+ # CTH2*WCOM * WAB= 1.D0/8.D0*VHB*(DELZ-0.5D0)+CTH2*WCOM * N3= 3 N4= 4 N5= 5 N6= 6 * FF4= QRF(N3,QBQM,QTQM2,QWM2,QTQM2) FF5= QRF(N4,QBQM,QTQM2,QWM2,QTQM2) FF6= QRF(N2,QBQM,QWM2,QTQM2,QWM2) FF7= QRF(N5,QBQM,QWM2,QTQM2,QWM2) FF8= QRF(N6,QBQM,QWM2,QTQM2,QWM2) FF9= QRF(N1,QBQM,QBQM2,QZM2,QBQM2) * TFAC= 4.D0*VHB*FF4-1.D0/3.D0*STH2*FF5+CTH2*FF6- # 0.25D0*CMSTH2*FF7+0.5D0*STH2*FF8+0.5D0*CTH2*DELW * FVB= VHB*WVB-0.5D0*WAB+(1.D0-2.D0*STH2+4.D0/3.D0*STH4- # 16.D0/27.D0*STH6)*FF9+CTH2*TFAC * FAB= -0.5D0*WVB+VHB*WAB+(1.D0-2.D0*STH2+4.D0/3.D0*STH4)* # FF9+CTH2*TFAC * IF(OU1.EQ.'N') THEN XIP= XI+(8.D0/3.D0*CTH2+1.D0/6.D0)*LOG(TQM2/WM2) ELSE IF(OU1.EQ.'Y') THEN XIP= 0.D0 ENDIF * *-----CORRECTIONS O(G_F^2*M_T^4) * XVAR= GFC*XI/4.D0 XVAR2= XVAR*XVAR GBB4= GF*RHOL*ZM3/2.D0/PI*XVAR2*((2.D0*VHB-1.D0)*TCOR+2.D0) SINGF= -0.5D0-2.D0/3.D0*STR2 VDO= -0.5D0+2.D0/3.D0*STR2 VCORQC= -0.41318D0*(ALSR/PI)**3*SINGF/VDO IF(OU4.EQ.'Y') THEN ACMB0= -6.D0*RBM2/ZM2 BET2= 1.D0-4.D0*RBM2/ZM2 ELSE IF(OU4.EQ.'N') THEN ACMB0= -6.D0*BQM2/ZM2 BET2= 1.D0-4.D0*BQM2/ZM2 ENDIF DQCDBV= 1.D0+VCORQ+ODQCD+VCMB DQCDBA= 1.D0+ACORB+ODQCD+ACMB DQCDBA0= 1.D0+ACMB0 * *-----CORRECTIONS O(ALS*G_F*M_T^2) * HVAR= GF/8.D0/PIS*TQM2*(ALSTZ/PI-PIS/3.D0*ALST/PI) HVARS= -GF/24.D0*TQM2*ALST/PI HVARSS= GF/8.D0/PIS*TQM2*ALSTZ/PI IF(OU2.EQ.'N') THEN GBBMIX= GF*RHOL*ZM3/2.D0/PI*HVAR*(2.D0*VHB-1.D0) ELSE IF(OU2.EQ.'Y') THEN GBBMIX= GF*RHOL*ZM3/2.D0/PI*HVARSS*(2.D0*VHB-1.D0) ENDIF * DGVB= 2.D0*FVB/CSTH2+2.D0/3.D0*DST2B-0.5D0*VHB*WZZ DGAB= 2.D0*FAB/CSTH2+0.25D0*WZZ GVB0= VRB GAB0= -0.5D0 IF(OU1.EQ.'Y') THEN GVBC= GFC*(2.D0*FVB+CSTH2*(2.D0/3.D0*DST2B-0.5D0*VHB*WZZ))+ # HVARS+XVAR2*TCOR GABC= GFC*(2.D0*FAB+0.25D0*CSTH2*WZZ)+HVARS+XVAR2*TCOR GVB= GVB0+GVBC GAB= GAB0+GABC ELSE IF(OU1.EQ.'N') THEN GVBC= 0.25D0*GFC*XIP+HVARS+XVAR2*TCOR+ # AEXP*(DGVB-0.25D0/CSTH2*XIP) GABC= 0.25D0*GFC*XIP+HVARS+XVAR2*TCOR+ # AEXP*(DGAB-0.25D0/CSTH2*XIP) GVB= GVB0+GVBC GAB= GAB0+GABC ENDIF * IF(OU6.EQ.'Y') THEN IF(OU2.EQ.'Y') THEN GBBF= GF*RHOL*ZM3/2.D0/PI*(GVB*GVB*(FRADB+VCORQ+ # ODQCD+VCMB)+GAB*GAB*(FRADB+ACORB+ODQCD+ACMB)) ELSE IF(OU2.EQ.'N') THEN GBBF= GF*RHOL*ZM3/2.D0/PI*((VRB2+2.D0*VHB*GVBC)* # (FRADB+VCORQ+ODQCD+VCMB)+GAB0*(GAB0+2.D0*GABC)* # (FRADB+ACORB+ODQCD+ACMB)+GABC*GABC*ACMB0) ENDIF ZW(JC)= GBBF ELSE IF(OU6.EQ.'N') THEN * IF(OU2.EQ.'Y') THEN GBBQCD= GF*RHOL*ZM3/2.D0/PI*(VRB2*(VCORQ+ODQCD+VCMB)+ # 0.25D0*(ACORB+ODQCD+ACMB)+(2.D0*GAB0*GABC+ # GABC*GABC)*ACMB0) ELSE IF(OU2.EQ.'N') THEN GBBQCD= GF*RHOL*ZM3/2.D0/PI*(VRB2*(VCORQ+ODQCD+VCMB)+ # 0.25D0*(ACORB+ODQCD+ACMB)+(2.D0*GAB0*GABC+XVAR2)* # ACMB0) ENDIF * IF(OU1.EQ.'N'.AND.OU2.EQ.'N') THEN GBBEW= GF*RHOL*ZM3/2.D0/PI*((VRB2+0.25D0)*FRADB+ # 0.25D0*GFC*XIP*(2.D0*VHB-1.D0)+AEXP*FACT* # (2.D0*VHB*(2.D0*FVB-0.25D0*XIP)-(2.D0*FAB- # 0.25D0*XIP))+AEXP*(4.D0/3.D0*VHB*DST2B-(VHB2+ # 0.25D0)*WZZ)) ZW(JC)= GBBEW+GBBQCD+GBB4+GBBMIX ELSE IF(OU1.EQ.'Y'.AND.OU2.EQ.'N') THEN GBBEW= GF*RHOL*ZM3/2.D0/PI*((VRB2+0.25D0)*FRADB+ # AEXPH*(2.D0*FACT*(2.D0*VHB*FVB-FAB)+4.D0/3.D0* # VHB*DST2B-(VHB2+0.25D0)*WZZ)) ZW(JC)= GBBEW+GBBQCD+GBB4+GBBMIX ELSE IF(OU1.EQ.'Y'.AND.OU2.EQ.'Y') THEN ZW(JC)= GF*RHOL*ZM3/2.D0/PI*FRADB*(GVB*GVB+GAB*GAB)+ # GBBQCD+GBBMIX ELSE IF(OU1.EQ.'N'.AND.OU2.EQ.'Y') THEN ZW(JC)= GF*RHOL*ZM3/2.D0/PI*FRADB*(GVB*GVB+GAB*GAB)+ # GBBQCD+GBBMIX ENDIF ENDIF ZWQCDS(JC)= GF*RHOL*ZM3/2.D0/PI*VRB2*VCORQC * *-----EFFECTIVE DECONVOLUTED B ASYMMETRY * GVB0= VRB GVB00= VHB GVL0= VRL GVL00= VHL GVLC= AX*DGV GAL0= -0.5D0 GALC= AX*DGA IF(OMA.EQ.'Y') THEN BBET= SQRT(BET2) BBET2= BET2 BETP= 0.5D0*(3.D0-BET2) ELSE BBET= 1.D0 BBET2= 1.D0 BETP= 1.D0 ENDIF IF(OU2.EQ.'N') THEN AFBBN= GVL0*GAL0*GVB0*GAB0+GVLC*GAL0*GVB00*GAB0+ # GVL00*GALC*GVB00*GAB0+GVL00*GAL0*GVBC*GAB0+ # GVL00*GAL0*GVB00*GABC AFBBN= 3.D0*BBET*AFBBN AFBBD= (GVL0*GVL0+GAL0*GAL0)*(BETP*GVB0*GVB0+BBET2*GAB0* # GAB0)+2.D0*(GVL00*GVL00+GAL0*GAL0)*(BETP*GVB00* # GVBC+BBET2*GAB0*GABC)+(BETP*GVB00*GVB00+BBET2* # GAB0*GAB0)*2.D0*(GVL00*GVLC+GAL0*GALC) AFBBEFF= AFBBN/AFBBD ABPOL= 2.D0*(-0.5D0*GVB0+GVB00*GABC-0.5D0*GVBC)/ # (GVB0*GVB0+0.25D0+2.D0*GVB00*GVBC-GABC) ALRBEFF= ABPOL ELSE IF(OU2.EQ.'Y') THEN XVL= GVL0+GVLC XAL= GAL0+GALC ETAL= XVL*XAL/(XVL*XVL+XAL*XAL) XVB= GVB0+GVBC XAB= GAB0+GABC ETAB= XVB*XAB/(BETP*XVB*XVB+BBET2*XAB*XAB) AFBBEFF= 3.D0*BBET*ETAL*ETAB ABPOL= 2.D0*GVB*GAB/(GVB*GVB+GAB*GAB) ALRBEFF= ABPOL ENDIF * IF(OU2.EQ.'N') THEN ST2B= STR2-1.5D0*((1.D0-4.D0/3.D0*STR2)*GABC-GVBC)+ # 4.D0*XVAR2*STR2 ELSE IF(OU2.EQ.'Y') THEN ST2B= (STR2+1.5D0*(GVBC-GABC))/(1.D0-2.D0*GABC) ENDIF RHOBQ= 4.D0*GAB*GAB*RHOL PW(JC)= 0.D0 * *-----INVISIBLE WIDTH * ELSE IF(JC.EQ.9) THEN * VNT= ZID-BQL*STH2 CALL TWFF(STH2,BQN,ZIU,WVN,WAN) * *-----VERTEX CORRECTIONS * QZER= 0.D0 FF10= QRFS(N1,QZER,QZM2,QZER) FF11= QRFS(N1,QZER,QWM2,QZER) FF12= QRFS(N2,QWM2,QZER,QWM2) * IF(OU0.NE.'S') THEN FN= (WVN+WAN)*ZIU-2.D0*ZIU*FF10-4.D0*VNT*CTH2*FF11- # 2.D0*CTH4*ZIU*FF12-CTH4*ZIU*DELW ZW(JC)= GF*RHOL*ZM3/3.D0/PI*(0.25D0+AX*(2.D0*FACT*FN- # WZZ/4.D0)) ELSE CALL TWFF(STR2,BQN,ZIU,WVNI,WANI) VNTI= ZID-BQL*STR2 FNI= (WVNI+WANI)*ZIU-2.D0*ZIU*FF10-4.D0*VNTI*CTR2*FF11- # 2.D0*CTR4*ZIU*FF12-CTR4*ZIU*DELW DPIZC= AEXP/CSTR2*(DPIZ-8.D0*FNI)+DEOE-DEH2/CTR2 DPIZCF= 1.D0/(1.D0+DPIZC) ZW(JC)= GF*RHOS*DPIZCF*ZM3/12.D0/PI PW(JC)= 0.D0 ENDIF * ENDIF ENDDO * *-----COLLECTS THE RESULTS * WL= (ZW(1)+ZW(2)+ZW(3))/3.D0 WH= ZW(4)+ZW(7)+ZW(5)+ZW(6)+ZW(8)+ # ZWQCDS(4)+ZWQCDS(7)+ZWQCDS(5)+ZWQCDS(6)+ZWQCDS(8) WT= ZW(1)+ZW(2)+ZW(3)+3.D0*ZW(9)+WH PW(10)= WT PIC= PIS*PI SIGHAD= 12.D0*PI/ZM2*ZW(1)*WH/WT/WT*0.38937966D6 RH= WH/ZW(1) RD= ZW(5)/ZW(1) RB= ZW(8)/ZW(1) OWT= WT OWH= WH GBGH= ZW(8)/WH * XSFACT= 12.D0*PI*PW(1)/ZM2/(PW(10)*PW(10))*0.38937966D6 XSZ(1)= XSFACT*PW(2) XSZ(2)= XSFACT*PW(3) XSZ(3)= XSFACT*PW(4) XSZ(4)= XSFACT*PW(7) XSZ(5)= XSFACT*PW(5) XSZ(6)= XSFACT*PW(6) * STR= SQRT(STR2) CTR= SQRT(CTR2) GPU= -2.D0/3.D0*STR/CTR GPD= 1.D0/3.D0*STR/CTR GMU= (0.5D0-2.D0/3.D0*STR2)/STR/CTR GMD= (-0.5D0+1.D0/3.D0*STR2)/STR/CTR GPU4= GPU**4 GMU4= GMU**4 GPD4= GPD**4 GMD4= GMD**4 RL02= 1.080D0 RL12= -0.37D0 RL02P= 1.182D0 RL12P= -0.37D0 * XRA= ZM2/WM2 XRA2= XRA*XRA XRA3= XRA2*XRA XRA4= XRA3*XRA XRAL= LOG(XRA) XRAL2= XRAL*XRAL AXRA= SQRT(4.D0/XRA-1.D0) XRAAT= ATAN(1.D0/AXRA) XRAAT2= XRAAT*XRAAT RL03P= 5.D0/6.D0-2.D0/3.D0/XRA+(4.D0+2.D0*XRA)/3.D0/XRA* # AXRA*XRAAT-8.D0/3.D0*(2.D0*XRA+1.D0)/XRA2*XRAAT2 RL13P= -1.D0/72.D0*XRA*(14.D0+XRA*(89.D0/60.D0+XRA* # (116.D0/525.D0+XRA*(53.D0/1400.D0+XRA*(851.D0/121275.D0+ # 1381.D0/1009008.D0*XRA))))) RL13P= RL13P-29.D0/24.D0+3.D0/8.D0/XRA*(1.D0+2.D0*XRAL)+ # 1.D0/8.D0/XRA2*(7.D0-2.D0*XRAL)-1.D0/24.D0/XRA3 RL13P= RL13P+1.D0/3.D0/XRA2*( # 1.D0/XRA*(-121.D0/81.D0-1.D0/9.D0*XRAL2-22.D0/27.D0*XRAL)+ # 1.D0/XRA2*(-169.D0/5184.D0-1.D0/144.D0*XRAL2-13.D0/432.D0* # XRAL)+ # 1.D0/XRA3*(-2209.D0/810000.D0-1.D0/900.D0*XRAL2-47.D0/ # 13500.D0*XRAL)+ # 1.D0/XRA4*(-1369.D0/3240000.D0-1.D0/3600.D0*XRAL2-37.D0/ # 54000.D0*XRAL)) * * RL03P= -0.288D0 * RL13P= -0.87D0 * DGU= ALS/PI/4.D0*ALPHAH**2/PI*ZM*((GPU4+GMU4)* # (4.D0/3.D0*RL12-RL02)+0.5D0*GMU/STR2*(GMD*( # 4.D0/3.D0*RL12P-RL02P)+3.D0*CTR/STR*(4.D0/3.D0* # RL13P-RL03P))) DGD= ALS/PI/4.D0*ALPHAH**2/PI*ZM*((GPD4+GMD4)* # (4.D0/3.D0*RL12-RL02)+0.5D0*GMD/STR2*(GMU*( # 4.D0/3.D0*RL12P-RL02P)-3.D0*CTR/STR*(4.D0/3.D0* # RL13P-RL03P))) XNFACT(1)= 0.D0 XNFACT(2)= 0.D0 XNFACT(3)= XSFACT*DGU XNFACT(4)= XSFACT*DGU XNFACT(5)= XSFACT*DGD XNFACT(6)= XSFACT*DGD * TAB(1)= WM TAB(2)= ZW(9) TAB(3)= ZW(1) TAB(4)= ZW(2) TAB(5)= ZW(3) TAB(6)= ZW(4) TAB(7)= ZW(5) TAB(8)= ZW(7) TAB(9)= ZW(8) TAB(10)= ST2E TAB(11)= ST2B TAB(12)= AFBEFF TAB(13)= ALR TAB(14)= WT TAB(15)= RH TAB(16)= SIGHAD TAB(17)= GBGH TAB(18)= AFBBEFF TAB(19)= WH TAB(20)= 3.D0*ZW(9) TAB(21)= AFBCEFF TAB(22)= ZW(7)/WH TAB(23)= ALRBEFF TAB(24)= ALRCEFF TAB(25)= ST2C TAB(26)= RHOE TAB(27)= RHOCQ TAB(28)= RHOBQ TAB(29)= ALI5 TAB(30)= 1.D0/ALPHAH TAB(31)= SIGHAD/RH TAB(32)= ALST TAB(33)= WH/ZW(2) TAB(34)= WH/ZW(3) * RETURN END * *-----OBSERVABLES----------------------------------------------------- * COMPUTES THE (WEAKLY CORRECTED) TOTAL AND FORW-BACK * KERNEL CROSS SECTIONS FOR MU,TAU AND QUARKS * * UPDATED AND UPGRADED OCTOBER-NOVEMBER 98 WITH NLO * SUBROUTINE TOBSR(KFLAG,NRS,NOBS,ORS,OSIGMA,OARS,AJN,AJD) IMPLICIT REAL*8 (A-H,I,O-P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OCUTS,OBHABHA,OIMAG,OREST CHARACTER*2 OCUT,OCUTF,OINDX * PARAMETER(MNRS=30,NO=7,MNOBS=11) * COMMON/TNAL/ODA COMMON/TIXS/OIMAG COMMON/TPW/PW(10) COMMON/TCUTF/OXCUTF COMMON/TICOUPLING/NF COMMON/TAFBB/AFBBEFF COMMON/TCUT/OXCUT,OXCUTS COMMON/TOCUTF/OCUTF(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TADJBASYM/AJNB,AJDB COMMON/TPARAM/PI,PIS,DELTA COMMON/TCK/XSZ(6),XNFACT(6) COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * COMMON/TWEAKPAR/IPGGF(MNRS),IDSTH2(MNRS), # DELGG(MNRS,NO),DELZZP(MNRS,NO), # DELZZM(MNRS,NO),DELGZP1(MNRS,NO), # DELGZP2(MNRS,NO),DELGZP3(MNRS,NO), # DELGZP4(MNRS,NO),DELGZM1(MNRS,NO), # DELGZM2(MNRS,NO),DELGZM3(MNRS,NO), # DELGZM4(MNRS,NO),FBOX(MNRS,NO),BBOX(MNRS,NO) * DIMENSION CST(MNRS,NO),CSFMB(MNRS,NO),OSIGMA(MNRS,MNOBS), # AGZ(MNRS,NO),AZZ(MNRS,NO),DSGG(MNRS,NO),DSZZ(MNRS,NO), # DSGZ(MNRS,NO),CSTMQCD(MNRS,NO),ORS(MNOBS,MNRS), # SVV(MNRS,NO),SAA(MNRS,NO),SVA(MNRS,NO),SVV4(MNRS,NO), # SEE(MNRS,NO),SEV(MNRS,NO),SLO(MNRS,NO),SVVT(MNRS,NO), # SAA4(MNRS,NO),SVA4(MNRS,NO),OARS(MNRS), # SVVMIX(MNRS,NO),SAAMIX(MNRS,NO),SVAMIX(MNRS,NO), # CQEDFPB(MNRS,NO),CQEDFMB(MNRS,NO),CKCORR(MNRS,NO), # ACHI2(MNRS) * DO J=1,MNRS DO K=1,NO CST(J,K)= 0.D0 CSFMB(J,K)= 0.D0 ENDDO ENDDO * ZM= SQRT(ZM2) EI3= ZID SEI3= -1.D0 BQE= BQL TQE= 2.D0*BQE DPT= 2.D0/3.D0 DMT= -1.D0/2.D0 G2= GWEAK*RHO G4= G2*G2 * PGGFIZ= IPGGF(NRS) DSTH2IZ= IDSTH2(NRS) QS= -QZM2 CALL TALALS(QS,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QS,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # GGIZ,GZIZ,GGISZ,GZISZ,GGIWZ,PGGHOZ) CALL TVBSELF0(PGGF0,PGGFL0,PGGB0,SWW0F,SWW0B) PIFZ= PGGFZ-PGGF0+PGGHOZ+PGGNPZ CFACTZ= 1.D0-AEXP*PIFZ AIPGGFZ= AEXP*GGIZ DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ RALHZ= ALPHA*CFACTZ/DENAZ IF(OIMAG.EQ.'N') THEN IALHZ= 0.D0 ELSE IALHZ= ALPHA*AIPGGFZ/DENAZ ENDIF ARZ= RALHZ/FPI AIZ= IALHZ/FPI * *-----ENERGY LOOP * DO J=1,NRS RSN= OARS(J) * *-----TYPE OF PARTICLE LOOP * 1 = MU, 2 = TAU, 3 = UP, 4 = C, 5 = D, 6 = S, 7 = B * IF(OEXT.EQ.'E') THEN MNO= 1 ELSE IF(OEXT.EQ.'C') THEN MNO= 3 ENDIF * IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'MU') THEN KMIN= 1 KMAX= 1 ELSE IF(OINDX.EQ.'TA') THEN KMIN= 2 KMAX= 2 ELSE IF(OINDX.EQ.'HA') THEN KMIN= 3 KMAX= 7 ELSE IF(OINDX.EQ.'BQ') THEN KMIN= 7 KMAX= 7 ELSE IF(OINDX.EQ.'CQ') THEN KMIN= 4 KMAX= 4 ELSE KMIN= MNO KMAX= NO ENDIF ELSE KMIN= MNO KMAX= NO ENDIF DO K=KMIN,KMAX * *-----THE CORRECTED ENERGY IS ASSIGNED * IF(OEXT.EQ.'E') THEN IF(K.LE.2) THEN KK= K ELSE KK= K+2 ENDIF ELSE IF(OEXT.EQ.'C') THEN KK= K-2 ENDIF * RS= ORS(KK,J) * *-----QCD & MASS CORRECTIONS * CALL TCORRQCD(RS) AEXPS= ALSR/PI * IF(OWEAK.EQ.'F') THEN PGGFI= IPGGF(1) DSTH2I= IDSTH2(1) ELSE IF(OWEAK.EQ.'R') THEN PGGFI= IPGGF(J) DSTH2I= IDSTH2(J) ENDIF S= RS*RS P2= -S S2= S*S SMZM2= S-ZM2 CONVF= 2.D0*PI*CONV/4.D0/64.D0/PIS * *-----COMPUTES THE RUNNING ALPHA * QRS= RS*1.D15*1.Q-15 QS= -QRS*QRS CALL TALALS(QS,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QS,PGGFS,PGGFLS,PGGLQS,PGGBS,PGGNPS,PPGGS,PPGGNPS, # GGI,GZI,GGIS,GZIS,GGIW,PGGHOS) CALL TVBSELF0(PGGF0,PGGFL0,PGGB0,SWW0F,SWW0B) PIFS= PGGFS-PGGF0+PGGHOS+PGGNPS CFACT= 1.D0-AEXP*PIFS AIPGGF= AEXP*GGI DENA= CFACT*CFACT+AIPGGF*AIPGGF RALH= ALPHA*CFACT/DENA IF(OIMAG.EQ.'N') THEN IALH= 0.D0 ELSE IALH= ALPHA*AIPGGF/DENA ENDIF ALH2= RALH*RALH+IALH*IALH * *-----COMPUTES THE RUNNING SIN(THETA) * AR= RALH/FPI AI= IALH/FPI * RSTH2= STR2+(AR-AEXPHZ)*AUX1+ # (AR*AR-AI*AI-AEXPHZ*AEXPHZ)*AUX2 RSTH2Z= STR2+(ARZ-AEXPHZ)*AUX1+ # (ARZ*ARZ-AIZ*AIZ-AEXPHZ*AEXPHZ)*AUX2 * *-----COMPUTES THE IMAGINARY OF SIN(THETA) * IF(OIMAG.EQ.'N') THEN ISTH2= 0.D0 ISTH2Z= 0.D0 ELSE ISTH2= AI*(AUX1+2.D0*AR*AUX2)+AR*DSTH2I ISTH2Z= AIZ*(AUX1+2.D0*ARZ*AUX2)+ARZ*DSTH2IZ ENDIF * RVE= EI3-TQE*RSTH2 RVEZ= EI3-TQE*RSTH2Z ERVE= EI3-TQE*ST2EFF(1) IVE= -TQE*ISTH2 IVEZ= -TQE*ISTH2Z IVEZZ= VIM(1) VEM2= RVE*RVE+IVE*IVE VEM2Z= RVEZ*RVEZ+IVEZ*IVEZ * *-----PROPAGATORS RESIDUAL CORRECTIONS AND ANGULAR FACTORS * ZWD= S/ZM*WT DENS= SMZM2*SMZM2+ZWD*ZWD RCHI= SMZM2/DENS ICHI= -ZWD/DENS ICHIZ= -ZM*WT/DENS CHI2= S/DENS ACHI2(J)= CHI2 CHI2Z= ZM2/DENS CVFP= ZM2*WT*WT * RACC= RALH*RCHI+IALH*ICHI IACC= RALH*ICHI-IALH*RCHI RARC= RALH*RCHI IAIC= IALH*ICHI RAIC= RALH*ICHI RACCZ= IALHZ*ICHIZ IACCZ= RALHZ*ICHIZ RARCZ= 0.D0 IAICZ= IALHZ*ICHIZ RAICZ= RALHZ*ICHIZ * *-----CORRECTION FACTORS FOR THE CROSS SECTIONS FOR ALL *-----FERMIONIC FINAL STATES * *-----MU * IF(K.EQ.1) THEN FM= MM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= ACMM CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(2) ERHO= RHOEFF(2) EVI= VIM(2) EAI= AIM(2) * *-----TAU * ELSE IF(K.EQ.2) THEN FM= TLM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= ACMT CORAQCD= 0.D0 CORAM= CAMT EST2= ST2EFF(3) ERHO= RHOEFF(3) EVI= VIM(3) EAI= AIM(3) * *-----UP * ELSE IF(K.EQ.3) THEN FM= UQM FI3= ZIU BQF= BQUQ BQFD= BQDQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORU+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(4) ERHO= RHOEFF(4) EVI= VIM(4) EAI= AIM(4) * *-----CHARM * ELSE IF(K.EQ.4) THEN FM= CQM FI3= ZIU BQF= BQUQ BQFD= BQDQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCMC ACORQ= ACORU+ODQCD ACM= ACMC CORAQCD= CAQCDC CORAM= CAMC EST2= ST2EFF(7) ERHO= RHOEFF(7) EVI= VIM(7) EAI= AIM(7) * *-----DOWN * ELSE IF(K.EQ.5) THEN FM= DQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORD+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(5) ERHO= RHOEFF(5) EVI= VIM(5) EAI= AIM(5) * *-----STRANGE * ELSE IF(K.EQ.6) THEN FM= SQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORD+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(6) ERHO= RHOEFF(6) EVI= VIM(6) EAI= AIM(6) * *-----BOTTOM * ELSE IF(K.EQ.7) THEN FM= BQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCMB ACORQ= ACORB+ODQCD ACM= ACMB CORAQCD= CAQCDB CORAM= CAMB ENDIF * CONVFC= CONVF*FNC RFM2= FM*FM/S SFI3= 2.D0*FI3 TQF= 2.D0*BQF BQF2= BQF*BQF * RVF= FI3-TQF*RSTH2 RVFZ= FI3-TQF*RSTH2Z ERVF= FI3-TQF*EST2 IVF= -TQF*ISTH2 IVFZ= -TQF*ISTH2Z IVFZZ= EVI VFM2= RVF*RVF+IVF*IVF VFM2Z= RVFZ*RVFZ+IVFZ*IVFZ * VMP2= VEM2+VFM2 VMP2Z= VEM2Z+VFM2Z VMT2= VEM2*VFM2 VMT2Z= VEM2Z*VFM2Z RVETVF= RVE*RVF RVETVFZ= RVEZ*RVFZ ERVETVF= ERVE*ERVF IVETVF= IVE*IVF IVETVFZ= IVEZ*IVFZ IVETVFZZ= IVEZZ*IVFZZ RVEIVF= RVE*IVF RVFIVE= RVF*IVE * IF(K.GE.3) THEN SINGVV= -0.5D0-2.D0/3.D0*RSTH2 SINGEE= 1.D0/3.D0 ALS3= (ALSR/PI)**3 VCORVV= VCOR-0.41318D0*ALS3*SINGVV/RVF VCOREE= VCOR-0.41318D0*ALS3*SINGEE/BQF VCOREV= VCOR-0.41318D0*ALS3*0.5D0*(SINGVV/RVF+SINGEE/BQF) ELSE VCORVV= 0.D0 VCOREE= 0.D0 VCOREV= 0.D0 ENDIF * *-----COMPUTES THE TOTAL AND THE FORW-BACK CROSS SECTIONS *-----BOXES EXCLUDED * RVAE= RVE*RVE+0.25D0 RVAEZ= RVEZ*RVEZ+0.25D0 ERVAE= ERVE*ERVE+0.25D0+VIM(1)*VIM(1)+AIM(1)*AIM(1) * IF(K.EQ.7) THEN SVV(J,K)= 64.D0*G4*CHI2*RVAE*RVF*RVF*DPT SEE(J,K)= 64.D0*4.D0*PIS*BQF2*ALH2*DPT/S SEV(J,K)= -64.D0*4.D0*PI*G2*BQF*RARC*RVETVF*DPT SAA(J,K)= 16.D0*G4*CHI2*RVAE*DPT SVA(J,K)= 128.D0*FI3*G2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT ELSE EG2= GWEAK*SQRT(RHOEFF(1)*ERHO) EG4= EG2*EG2 SVVZ= 64.D0*EG4*CHI2Z*ERVAE*(ERVF*ERVF+EVI*EVI)*DPT SAAZ= 64.D0*EG4*CHI2Z*ERVAE*(0.25D0+EAI*EAI)*DPT SVAZ= 4.D0*EG4*CHI2Z*32.D0*DMT*( # ERVE*EAI*EVI-2.D0*ERVF*AIM(1)*VIM(1)*FI3+ # FI3*ERVETVF-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+256.D0*PI*EG2*BQF*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*IACCZ)*DMT SEVZ= 256.D0*PI*BQF*EG2*(RACCZ*(IVETVFZZ-ERVETVF)+ # IACCZ*(ERVE*IVFZZ+ERVF*IVEZZ))*DPT SVV(J,K)= SVVZ+64.D0*G4*(CHI2*RVAE*RVF*RVF- # CHI2Z*RVAEZ*RVFZ*RVFZ)*DPT SEE(J,K)= 256.D0*PIS*BQF2*ALH2*DPT/S SEV(J,K)= SEVZ+256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE))*DPT- # 256.D0*PI*G2*BQF*(RACCZ*(IVETVFZ-RVETVFZ)+ # IACCZ*(RVEZ*IVFZ+RVFZ*IVEZ))*DPT SAA(J,K)= SAAZ+16.D0*G4*(CHI2*RVAE-CHI2Z*RVAEZ)*DPT SVA(J,K)= SVAZ+128.D0*FI3*G2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT- # 128.D0*FI3*G4*CHI2Z*RVETVFZ*DMT ENDIF SLO(J,K)= SVV(J,K)+SEE(J,K)+SEV(J,K)+SAA(J,K) SVVT(J,K)= SVV(J,K)+SEE(J,K)+SEV(J,K) * IF(OWEAK.EQ.'F') THEN DSGG(J,K)= 256.D0*PIS*BQF2*ALH2*(1.D0+DELGG(1,K))/S*DPT * DSZZ(J,K)= 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(1,K))*DPT AZZ(J,K)= 4.D0*G4*CHI2*(32.D0*FI3*RVETVF+DELZZM(1,K))*DMT * DSGZ(J,K)= 256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE)+0.5D0*(DELGZP1(1,K)* # RARC+DELGZP2(1,K)*RAIC+DELGZP3(1,K)*IAIC+ # DELGZP4(1,K)*RACC))*DPT AGZ(J,K)= 256.D0*PI*G2*BQF*(-0.5D0*FI3*RACC+0.5D0* # (DELGZM1(1,K)*RACC+DELGZM2(1,K)*RAIC+DELGZM3(1,K)* # RARC+DELGZM4(1,K)*IAIC))*DMT ELSE IF(OWEAK.EQ.'R') THEN DSGG(J,K)= 256.D0*PIS*BQF2*ALH2*(1.D0+DELGG(J,K))/S*DPT * IF(K.EQ.7) THEN DSZZ(J,K)= 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,K))*DPT ELSE DSZZ(J,K)= XSZ(K)/CONVFC*CVFP/DENS+ # 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,K))*DPT- # 4.D0*G4*CHI2Z*(1.D0+4.D0*(VMP2Z+4.D0*VMT2Z)+ # DELZZP(NRS,K))*DPT ENDIF * IF(K.EQ.7) THEN AZZ(J,K)= 4.D0*G4*CHI2*(32.D0*FI3*RVETVF+DELZZM(J,K))*DMT ELSE AZZZ= 4.D0*EG4*CHI2Z*32.D0*DMT*( # ERVE*EAI*EVI-2.D0*ERVF*AIM(1)*VIM(1)*FI3+ # FI3*ERVETVF-2.D0*AIM(1)*VIM(1)*EAI*EVI) AZZ(J,K)= AZZZ+ # 4.D0*G4*CHI2*(32.D0*FI3*RVETVF+DELZZM(J,K))*DMT- # 4.D0*G4*CHI2Z*(32.D0*FI3*RVETVFZ+DELZZM(NRS,K))* # DMT ENDIF * IF(K.EQ.7) THEN DSGZ(J,K)= 256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE)+0.5D0*(DELGZP1(J,K)* # RARC+DELGZP2(J,K)*RAIC+DELGZP3(J,K)*IAIC+ # DELGZP4(J,K)*RACC))*DPT ELSE DSGZZ= 256.D0*PI*BQF*EG2*(RACCZ*(IVETVFZZ-ERVETVF)+ # IACCZ*(ERVE*IVFZZ+ERVF*IVEZZ))*DPT* # (1.D0+0.5D0*DELGG(NRS,K)) DSGZ(J,K)= DSGZZ+256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE))*DPT+ # 128.D0*PI*G2*BQF*(DELGZP1(J,K)* # RARC+DELGZP2(J,K)*RAIC+DELGZP3(J,K)*IAIC+ # DELGZP4(J,K)*RACC)*DPT- # 256.D0*PI*G2*BQF*(RACCZ*(IVETVFZ-RVETVFZ)+ # IACCZ*(RVEZ*IVFZ+RVFZ*IVEZ))*DPT- # 128.D0*PI*G2*BQF*(DELGZP1(NRS,K)* # RARCZ+DELGZP2(NRS,K)*RAICZ+DELGZP3(NRS,K)* # IAICZ+DELGZP4(NRS,K)*RACCZ)*DPT ENDIF * IF(K.EQ.7) THEN AGZ(J,K)= -128.D0*PI*G2*BQF*FI3*RACC*DMT+128.D0*PI*G2*BQF*( # DELGZM1(J,K)*RACC+DELGZM2(J,K)*RAIC+DELGZM3(J,K)* # RARC+DELGZM4(J,K)*IAIC)*DMT ELSE AGZZ= 256.D0*PI*EG2*BQF*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*IACCZ)* # (1.D0+0.5D0*DELGG(NRS,K))*DMT * AGZ(J,K)= AGZZ- # 128.D0*PI*G2*BQF*FI3*RACC*DMT+ # 128.D0*PI*G2*BQF*FI3*RACCZ*DMT+ # 128.D0*PI*G2*BQF*(DELGZM1(J,K)*RACC+DELGZM2(J,K)* # RAIC+DELGZM3(J,K)*RARC+DELGZM4(J,K)*IAIC)*DMT- # 128.D0*PI*G2*BQF*( # DELGZM1(NRS,K)*RACCZ+DELGZM2(NRS,K)*RAICZ+ # DELGZM3(NRS,K)*RARCZ+DELGZM4(NRS,K)*IAICZ)*DMT ENDIF ENDIF * IF(K.EQ.7) THEN XVAR= GWEAK/8.D0/PIS*TQM2/ZM2 XVAR2= XVAR*XVAR SVV4(J,K)= 64.D0*G4*CHI2*RVAE*XVAR2* # (2.D0*RVF*TCOR+1.D0)*DPT SAA4(J,K)= 64.D0*G4*CHI2*RVAE*XVAR2*(1.D0-TCOR)*DPT SVA4(J,K)= 128.D0*G4*CHI2*RVE*XVAR2*(1.D0-0.5D0* # (1.D0-2.D0*RVF)*TCOR)*DMT * CSTMQCD(J,K)= SVV(J,K)*VCORVV+SEE(J,K)*VCOREE+SEV(J,K)* # VCOREV+SVVT(J,K)*VCM+SAA(J,K)*(ACORQ+ACM)+ # 4.D0*G4*CHI2*DELZZP(J,K)*DPT*ALSR/PI HVAR= GF/8.D0/PIS*TQM2*(-PIS/3.D0*ALST/PI) HVARS= -GF/24.D0*TQM2*ALST/PI SVVMIX(J,K)= 64.D0*G4*CHI2*RVAE*2.D0* # RVF*HVAR*DPT SAAMIX(J,K)= -64.D0*G4*CHI2*RVAE*HVAR*DPT SVAMIX(J,K)= 128.D0*G4*CHI2*RVE*HVARS*(RVF-0.5D0)*DMT CKCORR(J,K)= 0.D0 ELSE CSTMQCD(J,K)= SVV(J,K)*VCORVV+SEE(J,K)*VCOREE+SEV(J,K)* # VCOREV+SVVT(J,K)*VCM+SAA(J,K)*(ACORQ+ACM) SVV4(J,K)= 0.D0 SAA4(J,K)= 0.D0 SVA4(J,K)= 0.D0 SVVMIX(J,K)= 0.D0 SAAMIX(J,K)= 0.D0 SVAMIX(J,K)= 0.D0 IF(K.GE.3) THEN CKCORR(J,K)= XNFACT(K)/CONVFC*CVFP/DENS ELSE CKCORR(J,K)= 0.D0 ENDIF ENDIF * *-----QED FINAL STATE CORRECTIONS ARE EXACT ALSO FOR A CUT ON THE * FINAL STATE INVARIANT MASS * XCUT= OXCUTF*(RSN/RS)**2 XCUT2= XCUT*XCUT * IF(OU1.EQ.'N') THEN AX= AR ELSE IF(OU1.EQ.'Y') THEN AX= AEXP ENDIF * IF(OCUTF(J).EQ.'NC') THEN IF(K.LE.2) THEN CQEDFPB(J,K)= 3.D0*AR*BQF2 CQEDFMB(J,K)= 0.D0 ELSE CQEDFPB(J,K)= AR*BQF2*(3.D0-AEXPS) CQEDFMB(J,K)= 0.D0 ENDIF ELSE IF(OCUTF(J).EQ.'HC') THEN IF(K.LE.2) THEN CQEDFPB(J,K)= 3.D0*AR*BQF2 CQEDFMB(J,K)= 0.D0 ELSE RLX= LOG(XCUT) IF(XCUT.GE.1.D0) THEN ADD= 1.D-10 ELSE ADD= 0.D0 ENDIF RLOMX= LOG(1.D0-XCUT+ADD) EPSM= -1.D-37 RLI2= TRSPENCE(XCUT,EPSM) CQEDFPB(J,K)= 4.D0*AX*BQF2*(-(XCUT+0.5*XCUT2+2.D0*RLOMX)* # LOG(RFM2)+XCUT*(1.D0+0.5D0*XCUT)*RLX-2.D0*RLOMX+ # 2.D0*RLX*RLOMX+2.D0*RLI2+3.D0/4.D0*(1.D0-XCUT2)- # 2.D0*XCUT) CQEDFMB(J,K)= 4.D0*AX*BQF2*(-(XCUT+0.5*XCUT2+2.D0*RLOMX)* # LOG(RFM2)-2.D0*RLOMX+2.D0*RLX*RLOMX+2.D0*RLI2- # 2.D0*XCUT) ENDIF ELSE IF(OCUTF(J).EQ.'FC') THEN RLX= LOG(XCUT) IF(XCUT.GE.1.D0) THEN ADD= 1.D-10 ELSE ADD= 0.D0 ENDIF RLOMX= LOG(1.D0-XCUT+ADD) EPSM= -1.D-37 RLI2= TRSPENCE(XCUT,EPSM) CQEDFPB(J,K)= 4.D0*AX*BQF2*(-(XCUT+0.5*XCUT2+2.D0*RLOMX)* # LOG(RFM2)+XCUT*(1.D0+0.5D0*XCUT)*RLX-2.D0*RLOMX+ # 2.D0*RLX*RLOMX+2.D0*RLI2+3.D0/4.D0*(1.D0-XCUT2)- # 2.D0*XCUT) CQEDFMB(J,K)= 4.D0*AX*BQF2*(-(XCUT+0.5*XCUT2+2.D0*RLOMX)* # LOG(RFM2)-2.D0*RLOMX+2.D0*RLX*RLOMX+2.D0*RLI2- # 2.D0*XCUT) ENDIF * IF(KFLAG.EQ.0) THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCD(J,K)+CKCORR(J,K)+CQEDFPB(J,K)*SLO(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K))+ # FNC*(FBOX(J,K)+BBOX(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+ # SVA(J,K)*(CORAQCD+CORAM+CQEDFMB(J,K))+SVA4(J,K)+ # SVAMIX(J,K))+FNC*(FBOX(J,K)-BBOX(J,K)) * * KFLAG = 1 ZZ, 2 ZZ+GG, 3 ZZ+GZ, 4 TOTAL + QCD * * 4(5 FOR MU) INCLUDES FINAL STATE FACTORS (BOTH QED AND QCD) * 6 EXCLUDES THEM * ELSE IF(KFLAG.EQ.1) THEN CST(J,K)= CONVFC*(DSZZ(J,K)+SVV4(J,K)+SAA4(J,K)) CSFMB(J,K)= CONVFC*(AZZ(J,K)+SVA4(J,K)) ELSE IF(KFLAG.EQ.2) THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSZZ(J,K)+ # SVV4(J,K)+SAA4(J,K)) CSFMB(J,K)= CONVFC*(AZZ(J,K)+SVA4(J,K)) ELSE IF(KFLAG.EQ.3) THEN CST(J,K)= CONVFC*(DSGZ(J,K)+DSZZ(J,K)+SVV4(J,K)+SAA4(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+SVA4(J,K)) ELSE IF(KFLAG.EQ.4) THEN IF(K.LE.2) THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCD(J,K)+SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+ # SAAMIX(J,K))+FNC*(FBOX(J,K)+BBOX(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+ # SVA(J,K)*(CORAQCD+CORAM)+SVA4(J,K)+ # SVAMIX(J,K))+FNC*(FBOX(J,K)-BBOX(J,K)) ELSE CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCD(J,K)+CKCORR(J,K)+CQEDFPB(J,K)*SLO(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K))+ # FNC*(FBOX(J,K)+BBOX(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+ # SVA(J,K)*(CORAQCD+CORAM+CQEDFMB(J,K))+ # SVA4(J,K)+SVAMIX(J,K))+FNC*(FBOX(J,K)- # BBOX(J,K)) ENDIF * * 5 IS TOTAL FOR MU CROSS-SECTION * ELSE IF(KFLAG.EQ.5) THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCD(J,K)+CQEDFPB(J,K)*SLO(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K))+ # FNC*(FBOX(J,K)+BBOX(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+SVA(J,K)* # (CORAQCD+CORAM+CQEDFMB(J,K))+SVA4(J,K)+ # SVAMIX(J,K))+FNC*(FBOX(J,K)-BBOX(J,K)) * * 6 NO FS QED NO FS QCD NO MASS CORRECTIONS * ELSE IF(KFLAG.EQ.6) THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K)+ # CKCORR(J,K))+FNC*(FBOX(J,K)+BBOX(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+ # SVA4(J,K)+SVAMIX(J,K))+FNC* # (FBOX(J,K)-BBOX(J,K)) * * 7 NO FS QED NO FS QCD NO MASS CORRECTIONS NO MIXED CORRECTIONS * ELSE IF(KFLAG.EQ.7) THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # SVV4(J,K)+SAA4(J,K))+FNC*(FBOX(J,K)+BBOX(J,K)) CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+SVA4(J,K))+FNC* # (FBOX(J,K)-BBOX(J,K)) ENDIF * ENDDO ENDDO * *-----UPDATED TO MATCH A_FB(B) WITH THE CORRESPONDING PO * * IF(KFLAG.EQ.1) THEN AJD= CONVFC*AFBBEFF*(DSZZ(NRS,7)+SVV4(NRS,7)+SAA4(NRS,7)) AJN= CONVFC*(AZZ(NRS,7)+SVA4(NRS,7)) AJNB= AJN AJDB= AJD ELSE AJN= 0.D0 AJD= 0.D0 ENDIF * DO J=1,NRS IF(OEXT.EQ.'E') THEN OSIGMA(J,1)= CST(J,1) OSIGMA(J,2)= CST(J,2) OSIGMA(J,3)= CSFMB(J,1) OSIGMA(J,4)= CSFMB(J,2) OSIGMA(J,5)= CST(J,3) OSIGMA(J,6)= CST(J,4) OSIGMA(J,7)= CST(J,5) OSIGMA(J,8)= CST(J,6) OSIGMA(J,9)= CST(J,7) OSIGMA(J,10)= CSFMB(J,4) OSIGMA(J,11)= CSFMB(J,7)+(AJDB-AJNB)*ACHI2(J)/CHI2Z ELSE IF(OEXT.EQ.'C') THEN OSIGMA(J,1)= CST(J,3) OSIGMA(J,2)= CST(J,4) OSIGMA(J,3)= CST(J,5) OSIGMA(J,4)= CST(J,6) OSIGMA(J,5)= CST(J,7) OSIGMA(J,6)= CSFMB(J,4) OSIGMA(J,7)= CSFMB(J,7)+(AJDB-AJNB)*ACHI2(J)/CHI2Z ENDIF ENDDO * RETURN END * *-----OBSCUT------------------------------------------------------- *-----1-,2- E 3-DIM INTEGRATIONS INCLUDED, FOR BOTH * JACOBIAN AND GEOMETRIC CORRECTIONS. S AND T CHANNEL * SUBROUTINE TOBSCUT(KEY,NRS,ZM,IFM,S0,E0,THMIN,THMINP,ACOLL, # OCNF,DELF) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OSP,OFB,OFB0,OTHRMT0, # OTHRE0,OCHAN,ONP,ONIF,OCNF,OCN,OBHABHA,OREST,OFM, # ORAD,OPRAD CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER (MNRS=30,NL=3,NOBS=6,MNFN=NOBS*MNRS) PARAMETER(NFL=4) * *-----NL = LEPTON NUMBER * COMMON/TK/IFK COMMON/TESC/SE COMMON/TMF/OFM COMMON/TOR/ORAD COMMON/TOPR/OPRAD COMMON/TMNL/IFMAX COMMON/THARDCR/DEL COMMON/TOHARDC/OCN COMMON/TCHAN/OCHAN COMMON/TSUP/OMODES COMMON/TICOUPLING/NF COMMON/TSPEC/OSP,OFB COMMON/TECM/RS(MNRS) COMMON/TTCHANN/IT(NL) COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TSPEC0/OFB0,OTHRMT0,OTHRE0 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TS0C/SIGMA0C(MNRS,NOBS),SIGMA1C(MNRS,NOBS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TTH/SET(MNRS),AET(MNRS),SMUT(MNRS),AMUT(MNRS),STAUT(MNRS), # ATAUT(MNRS),SHADT(MNRS),ESET(MNRS),EAET(MNRS), # ESMUT(MNRS),EAMUT(MNRS),ESTAUT(MNRS),EATAUT(MNRS), # ESHADT(MNRS) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION SUNI(NL,MNRS),AUNI(NL,MNRS),SJAC2(NL,MNRS), # AJAC2(NL,MNRS),SJAC3(NL,MNRS),AJAC3(NL,MNRS), # ESJAC2(NL,MNRS),EAJAC2(NL,MNRS),ESJAC3(NL,MNRS), # EAJAC3(NL,MNRS),SIGF0(MNFN),AEST0(MNFN), # SIGF1(MNFN),AEST1(MNFN),SIGF2C(MNFN), # AEST2C(MNFN),SIGF3C(MNFN),AEST3C(MNFN), # SJAC1(NL,MNRS),AJAC1(NL,MNRS),ESJAC1(NL,MNRS), # EAJAC1(NL,MNRS),SIGF1C(MNFN),AEST1C(MNFN), # ESUNI(NL,MNRS),EAUNI(NL,MNRS) DIMENSION S0(NL),E0(NL),THMIN(NL),THMINP(NL),ACOLL(NL), # THMAX(NL),THMAXP(NL) DIMENSION S00(NL),THMIN0(NL),THMINP0(NL),ACOLL0(NL) DIMENSION SEPS(NL,MNRS),ADELIFF(NL),ADELIFB(NL), # DELIFS(NL,MNRS),DELIFA(NL,MNRS) DIMENSION SET0(MNRS),SMUT0(MNRS),STAUT0(MNRS),YT(NL),RSS(MNRS) * *-----DIFFERENT CUTS AND DIFFERENT ACCEPTANCES ARE ALLOWED FOR E, MU AND TAU * IFMAX= IFM IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IFCURR= 1 ELSE IF(OINDX.EQ.'MU') THEN IFCURR= 2 ELSE IF(OINDX.EQ.'TA') THEN IFCURR= 3 ENDIF ELSE IFCURR= 0 ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN IFCURR= 2 ELSE IF(OINDX.EQ.'TA') THEN IFCURR= 3 ENDIF ELSE IFCURR= 0 ENDIF ENDIF * DO I=1,NRS RSS(I)= RS(I)*RS(I) ENDDO * IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(OTHRE.EQ.'M') THEN DO I=1,NRS S0CUT(1,I)= S0(1)*S0(1) ENDDO IF(S0(1).GT.RS(NRS)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRE.EQ.'E') THEN DO I=1,NRS S0CUT(1,I)= 2.D0*E0(1)*RS(I) ENDDO IF(E0(1).GT.(RS(NRS)/2.D0)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(OTHRMT.EQ.'M') THEN DO I=1,NRS S0CUT(2,I)= S0(2)*S0(2) ENDDO IF(S0(2).GT.RS(NRS)) THEN S0CUT(2,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRMT.EQ.'E') THEN DO I=1,NRS S0CUT(2,I)= 2.D0*E0(2)*RS(I) ENDDO IF(E0(2).GT.(RS(NRS)/2.D0)) THEN S0CUT(2,NRS)= 0.01D0*ZM2 ENDIF ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(OTHRMT.EQ.'M') THEN DO I=1,NRS S0CUT(3,I)= S0(3)*S0(3) ENDDO IF(S0(3).GT.RS(NRS)) THEN S0CUT(3,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRMT.EQ.'E') THEN DO I=1,NRS S0CUT(3,I)= 2.D0*E0(3)*RS(I) ENDDO IF(E0(3).GT.(RS(NRS)/2.D0)) THEN S0CUT(3,NRS)= 0.01D0*ZM2 ENDIF ENDIF ENDIF ELSE IF(OBHABHA.EQ.'N') THEN IF(OTHRE.EQ.'M') THEN DO I=1,NRS S0CUT(1,I)= S0(1)*S0(1) ENDDO IF(S0(1).GT.RS(NRS)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRE.EQ.'E') THEN DO I=1,NRS S0CUT(1,I)= 2.D0*E0(1)*RS(I) ENDDO IF(E0(1).GT.(RS(NRS)/2.D0)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ENDIF DO J=2,3 IF(OTHRMT.EQ.'M') THEN DO I=1,NRS S0CUT(J,I)= S0(J)*S0(J) ENDDO IF(S0(J).GT.RS(NRS)) THEN S0CUT(J,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRMT.EQ.'E') THEN DO I=1,NRS S0CUT(J,I)= 2.D0*E0(J)*RS(I) ENDDO IF(E0(J).GT.(RS(NRS)/2.D0)) THEN S0CUT(J,NRS)= 0.01D0*ZM2 ENDIF ENDIF ENDDO ENDIF ELSE IF(IFMAX.EQ.1) THEN IF(OTHRE.EQ.'M') THEN DO I=1,NRS S0CUT(1,I)= S0(1)*S0(1) ENDDO IF(S0(1).GT.RS(NRS)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRE.EQ.'E') THEN DO I=1,NRS S0CUT(1,I)= 2.D0*E0(1)*RS(I) ENDDO IF(E0(1).GT.(RS(NRS)/2.D0)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ENDIF ELSE IF(IFMAX.EQ.3) THEN IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN IF(OTHRMT.EQ.'M') THEN DO I=1,NRS S0CUT(2,I)= S0(2)*S0(2) ENDDO IF(S0(2).GT.RS(NRS)) THEN S0CUT(2,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRMT.EQ.'E') THEN DO I=1,NRS S0CUT(2,I)= 2.D0*E0(2)*RS(I) ENDDO IF(E0(2).GT.(RS(NRS)/2.D0)) THEN S0CUT(2,NRS)= 0.01D0*ZM2 ENDIF ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(OTHRMT.EQ.'M') THEN DO I=1,NRS S0CUT(3,I)= S0(3)*S0(3) ENDDO IF(S0(3).GT.RS(NRS)) THEN S0CUT(3,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRMT.EQ.'E') THEN DO I=1,NRS S0CUT(3,I)= 2.D0*E0(3)*RS(I) ENDDO IF(E0(3).GT.(RS(NRS)/2.D0)) THEN S0CUT(3,NRS)= 0.01D0*ZM2 ENDIF ENDIF ENDIF ELSE IF(OTHRE.EQ.'M') THEN DO I=1,NRS S0CUT(1,I)= S0(1)*S0(1) ENDDO IF(S0(1).GT.RS(NRS)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRE.EQ.'E') THEN DO I=1,NRS S0CUT(1,I)= 2.D0*E0(1)*RS(I) ENDDO IF(E0(1).GT.(RS(NRS)/2.D0)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF ENDIF DO J=2,IFMAX IF(OTHRMT.EQ.'M') THEN DO I=1,NRS S0CUT(J,I)= S0(J)*S0(J) ENDDO IF(S0(J).GT.RS(NRS)) THEN S0CUT(J,NRS)= 0.01D0*ZM2 ENDIF ELSE IF(OTHRMT.EQ.'E') THEN DO I=1,NRS S0CUT(J,I)= 2.D0*E0(J)*RS(I) ENDDO IF(E0(J).GT.(RS(NRS)/2.D0)) THEN S0CUT(J,NRS)= 0.01D0*ZM2 ENDIF ENDIF ENDDO ENDIF ENDIF ENDIF * DTR= PI/180.D0 DO I=1,3 THMAX(I)= 180.D0-THMIN(I) THMINR(I)= THMIN(I)*DTR THMAXR(I)= THMAX(I)*DTR THMAXP(I)= 180.D0-THMINP(I) THMINPR(I)= THMINP(I)*DTR THMAXPR(I)= THMAXP(I)*DTR ACOLLR(I)= ACOLL(I)*DTR YT(I)= (1.D0-SIN(ACOLLR(I)/2.D0))/ # (1.D0+SIN(ACOLLR(I)/2.D0)) ENDDO * OCN= OCNF DEL= DELF*DTR * *-----ORIGINAL VALUES ARE STORED * DO I=1,3 THMIN0(I)= THMIN(I) THMINP0(I)= THMINP(I) ACOLL0(I)= ACOLL(I) S00(I)= S0(I) ENDDO * *-----THE AVERAGE ANGLE IS DEFINED AS [MAX_I(THMAX)-MIN_I(THMIN)]/2 * I= E,MU AMD TAU * IF(OEXT.EQ.'E') THEN THMAXMAX= THMAX(1) THMINMIN= THMIN(1) ELSE IF(OEXT.EQ.'C') THEN THMAXMAX= DMAX1(THMAX(1),THMAX(2),THMAX(3)) THMINMIN= DMIN1(THMIN(1),THMIN(2),THMIN(3)) ENDIF * *-----REALISTIC CUTS BUT THE MU AND TAU LINESHAPES ARE EXTRAPOLATED * IF(OEXT.EQ.'C'.AND.OFB.EQ.'Y') THEN IC= 0 * *-----E OBSERVABLES AND MU AND TAU ASYMMETRIES ARE COMPUTED * *-----WEAK CORRECTIONS ARE COMPUTED AT THE WEAKLY CORRECTED PEAK * AND FOR THETA=(THMAX-THMIN)/2 * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) * *-----JACOBIAN CORRECTION ARE COMPUTED * CALL TAJI1(IC,NRS,NFN,SIGF1C,AEST1C,SJAC1,AJAC1, # ESJAC1,EAJAC1) * CALL TAJI2(IC,NRS,NFN,SIGF2C,AEST2C,SJAC2,AJAC2, # ESJAC2,EAJAC2) * CALL TAJI3(IC,NRS,NFN,SIGF3C,AEST3C,SJAC3,AJAC3, # ESJAC3,EAJAC3) * DO I=1,NRS IF(IFMAX.EQ.1) THEN SET0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(1,I))/(SET0(I)+DELIFS(1,I)) ESET(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESET(I)= SQRT(ESET(I)) EAET(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAET(I)= SQRT(EAET(I)) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ELSE SET0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(1,I))/(SET0(I)+DELIFS(1,I)) SMUT0(I)= SUNI(2,I)-SJAC1(2,I)-SJAC2(2,I)-SJAC3(2,I) SMUT0(I)= SMUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1) SMUT(I)= SMUT0(I)+DELIFS(2,I) AMUT(I)= (AUNI(2,I)-AJAC1(2,I)-AJAC2(2,I)-AJAC3(2,I) # +DELIFA(2,I) )/(SMUT0(I)+DELIFS(2,I)) STAUT0(I)= SUNI(3,I)-SJAC1(3,I)-SJAC2(3,I)-SJAC3(3,I) STAUT0(I)= STAUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1) STAUT(I)= STAUT0(I)+DELIFS(3,I) ATAUT(I)= (AUNI(3,I)-AJAC1(3,I)-AJAC2(3,I)-AJAC3(3,I) # +DELIFA(3,I))/(STAUT0(I)+DELIFS(3,I)) ESET(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESET(I)= SQRT(ESET(I)) EAET(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAET(I)= SQRT(EAET(I)) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ESMUT(I)= ESUNI(2,I)*ESUNI(2,I)+ESJAC1(2,I)*ESJAC1(2,I) # +ESJAC2(2,I)*ESJAC2(2,I) # +ESJAC3(2,I)*ESJAC3(2,I) ESMUT(I)= SQRT(ESMUT(I)) EAMUT(I)= EAUNI(2,I)*EAUNI(2,I)+EAJAC1(2,I)*EAJAC1(2,I) # +EAJAC2(2,I)*EAJAC2(2,I) # +EAJAC3(2,I)*EAJAC3(2,I) EAMUT(I)= SQRT(EAMUT(I)) EAMUT(I)= EAMUT(I)/SMUT(I)*ABS(1.D0+ESMUT(I)/EAMUT(I) # *ABS(AMUT(I))) ESTAUT(I)= ESUNI(3,I)*ESUNI(3,I)+ESJAC1(3,I)*ESJAC1(3,I) # +ESJAC2(3,I)*ESJAC2(3,I) # +ESJAC3(3,I)*ESJAC3(3,I) ESTAUT(I)= SQRT(ESTAUT(I)) EATAUT(I)= EAUNI(3,I)*EAUNI(3,I)+EAJAC1(3,I)*EAJAC1(3,I) # +EAJAC2(3,I)*EAJAC2(3,I) # +EAJAC3(3,I)*EAJAC3(3,I) EATAUT(I)= SQRT(EATAUT(I)) EATAUT(I)= EATAUT(I)/STAUT(I)*ABS(1.D0+ESTAUT(I)/ # EATAUT(I)*ABS(ATAUT(I))) ENDIF ENDDO * *-----EXTRAPOLATED MU,TAU LINESHAPES ARE COMPUTED * IF(OCHAN.EQ.'S'.AND.OSP.EQ.'Y') THEN IC= 0 OFB= 'N' OTHRMT= 'M' OTHRE= 'M' DO II=1,3 THMIN(II)= 0.D0 THMINP(II)= 0.D0 ACOLL(II)= 180.D0 THMAX(II)= 180.D0-THMIN(II) THMINR(II)= THMIN(II)*DTR THMAXR(II)= THMAX(II)*DTR THMAXP(II)= 180.D0-THMINP(II) THMINPR(II)= THMINP(II)*DTR THMAXPR(II)= THMAXP(II)*DTR ACOLLR(II)= ACOLL(II)*DTR ENDDO S0(1)= 1.022D-3 S0(2)= 2.120D-1 S0(3)= 3.5682D0 DO II=1,3 DO I=1,NRS S0CUT(II,I)= S0(II)*S0(II) ENDDO IF(S0(II).GT.RS(NRS)) THEN S0CUT(II,NRS)= 0.01D0*ZM2 ENDIF ENDDO * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES *-----FOR LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) DO I=1,NRS SET(I)= SUNI(1,I) SET(I)= SET(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1)+DELIFS(1,I) SMUT(I)= SUNI(2,I) SMUT(I)= SMUT(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1)+DELIFS(2,I) STAUT(I)= SUNI(3,I) STAUT(I)= STAUT(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1)+DELIFS(3,I) ESET(I)= ESUNI(1,I) ESMUT(I)= ESUNI(2,I) ESTAUT(I)= ESUNI(3,I) ENDDO ELSE IC= 0 OFB= 'N' OTHRMT= 'M' DO II=2,3 THMIN(II)= 0.D0 THMINP(II)= 0.D0 ACOLL(II)= 180.D0 THMAX(II)= 180.D0-THMIN(II) THMINR(II)= THMIN(II)*DTR THMAXR(II)= THMAX(II)*DTR THMAXP(II)= 180.D0-THMINP(II) THMINPR(II)= THMINP(II)*DTR THMAXPR(II)= THMAXP(II)*DTR ACOLLR(II)= ACOLL(II)*DTR ENDDO S0(2)= 2.120D-1 S0(3)= 3.5682D0 DO II=2,3 DO I=1,NRS S0CUT(II,I)= S0(II)*S0(II) ENDDO IF(S0(II).GT.RS(NRS)) THEN S0CUT(II,NRS)= 0.01D0*ZM2 ENDIF ENDDO * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) DO I=1,NRS SMUT(I)= SUNI(2,I) SMUT(I)= SMUT(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1)+DELIFS(2,I) STAUT(I)= SUNI(3,I) STAUT(I)= STAUT(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1)+DELIFS(3,I) ESMUT(I)= ESUNI(2,I) ESTAUT(I)= ESUNI(3,I) ENDDO ENDIF * *-----ORIGINAL VALUES ARE RESTORED * OFB= OFB0 OTHRMT= OTHRMT0 DO I1=1,IFMAX THMIN(I1)= THMIN0(I1) THMINP(I1)= THMINP0(I1) ACOLL(I1)= ACOLL0(I1) S0(I1)= S00(I1) ENDDO RETURN ENDIF * *-----S-CHANNEL ELECTRONS BUT THE E LINESHAPE IS EXTRAPOLATED * IF(OCHAN.EQ.'S'.AND.OSP.EQ.'Y') THEN * *-----E ASYMMETRY IS COMPUTED WITH CUTS * IFMAX= 1 SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS IC= 1 CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) * *-----JACOBIAN CORRECTION ARE COMPUTED * CALL TAJI1(IC,NRS,NFN,SIGF1C,AEST1C,SJAC1,AJAC1, # ESJAC1,EAJAC1) * CALL TAJI2(IC,NRS,NFN,SIGF2C,AEST2C,SJAC2,AJAC2, # ESJAC2,EAJAC2) * CALL TAJI3(IC,NRS,NFN,SIGF3C,AEST3C,SJAC3,AJAC3, # ESJAC3,EAJAC3) * DO I=1,NRS IF(IFMAX.EQ.1) THEN SET0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(1,I))/(SET0(I)+DELIFS(1,I)) EAET(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAET(I)= SQRT(EAET(I)) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ENDIF ENDDO * *-----SUBROUTINE WIDTH HAS ALREADY BEEN CALLED IN SUBROUTINE EWEXT * *-----WEAK CORRECTIONS ARE COMPUTED AT THE WEAKLY CORRECTED PEAK * AND FOR THETA=(THMAX-THMIN)/2 * *-----ALL OTHER EXTRAPOLATED OBSERVABLES ARE COMPUTED * IFMAX= 3 THMIN(1)= 0.D0 THMINP(1)= 0.D0 ACOLL(1)= 180.D0 OTHRE= 'M' S0(1)= 1.022D-3 DO I=1,NRS S0CUT(1,I)= S0(1)*S0(1) ENDDO IF(S0(1).GT.RS(NRS)) THEN S0CUT(1,NRS)= 0.01D0*ZM2 ENDIF THMAX(1)= 180.D0-THMIN(1) THMINR(1)= THMIN(1)*DTR THMAXR(1)= THMAX(1)*DTR THMAXP(1)= 180.D0-THMINP(1) THMINPR(1)= THMINP(1)*DTR THMAXPR(1)= THMAXP(1)*DTR ACOLLR(1)= ACOLL(1)*DTR * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS IC= 0 CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) * *-----JACOBIAN CORRECTION ARE COMPUTED * CALL TAJI1(IC,NRS,NFN,SIGF1C,AEST1C,SJAC1,AJAC1, # ESJAC1,EAJAC1) * CALL TAJI2(IC,NRS,NFN,SIGF2C,AEST2C,SJAC2,AJAC2, # ESJAC2,EAJAC2) * CALL TAJI3(IC,NRS,NFN,SIGF3C,AEST3C,SJAC3,AJAC3, # ESJAC3,EAJAC3) * DO I=1,NRS IF(IFMAX.EQ.1) THEN SET(I)= SUNI(1,I) SET(I)= SET(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1)+DELIFS(1,I) ESET(I)= ESUNI(1,I) ELSE IF(IFMAX.EQ.3 # .AND.IT(2).EQ.0.AND.THMIN(2).EQ.0.D0.AND.THMINP(2).EQ.0.D0 # .AND.ACOLL(2).EQ.180.D0.AND.OTHRMT.EQ.'M' # .AND.IT(3).EQ.0.AND.THMIN(3).EQ.0.D0.AND.THMINP(3).EQ.0.D0 # .AND.ACOLL(3).EQ.180.D0) THEN SET(I)= SUNI(1,I) SET(I)= SET(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1)+DELIFS(1,I) SMUT0(I)= SUNI(2,I) SMUT0(I)= SMUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1) SMUT(I)= SMUT0(I)+DELIFS(2,I) AMUT(I)= (AUNI(2,I)+DELIFA(2,I))/ # (SMUT0(I)+DELIFS(2,I)) STAUT0(I)= SUNI(3,I) STAUT0(I)= STAUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1) STAUT(I)= STAUT0(I)+DELIFS(3,I) ATAUT(I)= (AUNI(3,I)+DELIFA(3,I))/ # (STAUT0(I)+DELIFS(3,I)) ESET(I)= ESUNI(1,I) ESMUT(I)= ESUNI(2,I) EAMUT(I)= EAUNI(2,I) EAMUT(I)= EAMUT(I)/SMUT(I)*ABS(1.D0+ESMUT(I)/EAMUT(I) # *ABS(AMUT(I))) ESTAUT(I)= ESUNI(3,I) EATAUT(I)= EAUNI(3,I) EATAUT(I)= EATAUT(I)/STAUT(I)*ABS(1.D0+ESTAUT(I) # /EATAUT(I)*ABS(ATAUT(I))) ELSE SET(I)= SUNI(1,I) SET(I)= SET(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1)+DELIFS(1,I) SMUT0(I)= SUNI(2,I)-SJAC1(2,I)-SJAC2(2,I)-SJAC3(2,I) SMUT0(I)= SMUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1) SMUT(I)= SMUT0(I)+DELIFS(2,I) AMUT(I)= (AUNI(2,I)-AJAC1(2,I)-AJAC2(2,I)-AJAC3(2,I) # +DELIFA(2,I))/(SMUT0(I)+DELIFS(2,I)) STAUT0(I)= SUNI(3,I)-SJAC1(3,I)-SJAC2(3,I)-SJAC3(3,I) STAUT0(I)= STAUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1) STAUT(I)= STAUT0(I)+DELIFS(3,I) ATAUT(I)= (AUNI(3,I)-AJAC1(3,I)-AJAC2(3,I)-AJAC3(3,I) # +DELIFA(3,I))/(STAUT0(I)+DELIFS(3,I)) ESET(I)= ESUNI(1,I) ESMUT(I)= ESUNI(2,I)*ESUNI(2,I)+ESJAC1(2,I)*ESJAC1(2,I) # +ESJAC2(2,I)*ESJAC2(2,I) # +ESJAC3(2,I)*ESJAC3(2,I) ESMUT(I)= SQRT(ESMUT(I)) EAMUT(I)= EAUNI(2,I)*EAUNI(2,I)+EAJAC1(2,I)*EAJAC1(2,I) # +EAJAC2(2,I)*EAJAC2(2,I) # +EAJAC3(2,I)*EAJAC3(2,I) EAMUT(I)= SQRT(EAMUT(I)) EAMUT(I)= EAMUT(I)/SMUT(I)*ABS(1.D0+ESMUT(I)/EAMUT(I) # *ABS(AMUT(I))) ESTAUT(I)= ESUNI(3,I)*ESUNI(3,I)+ESJAC1(3,I)*ESJAC1(3,I) # +ESJAC2(3,I)*ESJAC2(3,I) # +ESJAC3(3,I)*ESJAC3(3,I) ESTAUT(I)= SQRT(ESTAUT(I)) EATAUT(I)= EAUNI(3,I)*EAUNI(3,I)+EAJAC1(3,I)*EAJAC1(3,I) # +EAJAC2(3,I)*EAJAC2(3,I) # +EAJAC3(3,I)*EAJAC3(3,I) EATAUT(I)= SQRT(EATAUT(I)) EATAUT(I)= EATAUT(I)/STAUT(I)*ABS(1.D0+ESTAUT(I)/ # EATAUT(I)*ABS(ATAUT(I))) * ENDIF ENDDO * *-----ORIGINAL VALUES ARE RESTORED * OTHRE= OTHRE0 DO I2=1,IFMAX THMIN(I2)= THMIN0(I2) THMINP(I2)= THMINP0(I2) ACOLL(I2)= ACOLL0(I2) S0(I2)= S00(I2) ENDDO RETURN ENDIF * *-----TOTALLY INCLUSIVE SET-UP (ONE SHOULD NOT ENTER THIS BRANCH, THERE * WAS A PREVIOUS CHOICE) * IT IS ASSUMED THAT THIS SET-UP, IF REQUESTED, IS REQUESTED * FOR ALL LEPTONS * IF(IT(1).EQ.0.AND.THMIN(1).EQ.0.D0.AND.THMINP(1).EQ.0.D0 # .AND.ACOLL(1).EQ.180.D0.AND.OTHRE.EQ.'M' # .AND.IT(2).EQ.0.AND.THMIN(2).EQ.0.D0.AND.THMINP(2).EQ.0.D0 # .AND.ACOLL(2).EQ.180.D0.AND.OTHRMT.EQ.'M' # .AND.IT(3).EQ.0.AND.THMIN(3).EQ.0.D0.AND.THMINP(3).EQ.0.D0 # .AND.ACOLL(3).EQ.180.D0.OR.OEXT.EQ.'E'.AND # .IT(1).EQ.0.AND.THMIN(1).EQ.0.D0.AND.THMINP(1).EQ.0.D0 # .AND.ACOLL(1).EQ.180.D0.AND.OTHRE.EQ.'M') # THEN IC= 0 * *-----SUBROUTINE WIDTH HAS ALREADY BEEN CALLED IN SUBROUTINE EWEXT * *-----WEAK CORRECTIONS ARE COMPUTED AT THE WEAKLY CORRECTED PEAK * AND FOR THETA=(THMAX-THMIN)/2 * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) DO I=1,NRS IF(IFMAX.EQ.1) THEN SET0(I)= SUNI(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)+DELIFA(1,I))/ # (SET0(I)+DELIFS(1,I)) ESET(I)= ESUNI(1,I) EAET(I)= EAUNI(1,I) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ELSE SET0(I)= SUNI(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)+DELIFA(1,I))/ # (SET0(I)+DELIFS(1,I)) SMUT0(I)= SUNI(2,I) SMUT0(I)= SMUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1) SMUT(I)= SMUT0(I)+DELIFS(2,I) AMUT(I)= (AUNI(2,I)+DELIFA(2,I))/ # (SMUT0(I)+DELIFS(2,I)) STAUT0(I)= SUNI(3,I) STAUT0(I)= STAUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1) STAUT(I)= STAUT0(I)+DELIFS(3,I) ATAUT(I)= (AUNI(3,I)+DELIFA(3,I))/ # (STAUT0(I)+DELIFS(3,I)) ESET(I)= ESUNI(1,I) EAET(I)= EAUNI(1,I) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ESMUT(I)= ESUNI(2,I) EAMUT(I)= EAUNI(2,I) EAMUT(I)= EAMUT(I)/SMUT(I)*ABS(1.D0+ESMUT(I)/EAMUT(I) # *ABS(AMUT(I))) ESTAUT(I)= ESUNI(3,I) EATAUT(I)= EAUNI(3,I) EATAUT(I)= EATAUT(I)/STAUT(I)*ABS(1.D0+ESTAUT(I) # /EATAUT(I)*ABS(ATAUT(I))) ENDIF ENDDO RETURN ENDIF * *-----SINGLE CHANNEL * IF((OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'R').OR. # (OBHABHA.EQ.'R'.AND.OREST.EQ.'C')) THEN IC= 0 I= IFCURR IF(DELF.GE.ACOLL(1).AND.I.EQ.1.AND.OCN.EQ.'Y') THEN PRINT*,' NOT SUITED FOR THESE ACOLL AND DELTA ' STOP ENDIF IF(IT(I).EQ.1.AND.I.NE.1) THEN PRINT*,' T-CHANNEL ONLY FOR ELECTRONS ' STOP ENDIF IF(IT(I).EQ.1.AND.THMIN(I).LT.20.D0) THEN PRINT*,' NOT SUITED FOR THETA(-) < 20 DEG ' STOP ENDIF IF(THMINP(I).GT.THMIN(I)) THEN PRINT*,' NOT SUITED FOR SUCH AN ANGULAR ACCEPTANCE ' STOP ENDIF * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF J= IFCURR DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO IF(KEY.EQ.1) THEN J= IFCURR DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J),SEPS(J,I),WT, # ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF * NFN= 2*NRS CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) CALL TAJI1(IC,NRS,NFN,SIGF1C,AEST1C,SJAC1,AJAC1, # ESJAC1,EAJAC1) CALL TAJI2(IC,NRS,NFN,SIGF2C,AEST2C,SJAC2,AJAC2, # ESJAC2,EAJAC2) CALL TAJI3(IC,NRS,NFN,SIGF3C,AEST3C,SJAC3,AJAC3, # ESJAC3,EAJAC3) * DO I=1,NRS IF(OINDX.EQ.'EL') THEN SET0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(1,I))/(SET0(I)+DELIFS(1,I)) ESET(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESET(I)= SQRT(ESET(I)) EAET(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAET(I)= SQRT(EAET(I)) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ELSE IF(OINDX.EQ.'MU') THEN SMUT0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SMUT0(I)= SMUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SMUT(I)= SMUT0(I)+DELIFS(2,I) AMUT(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(2,I))/(SMUT0(I)+DELIFS(2,I)) ESMUT(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESMUT(I)= SQRT(ESMUT(I)) EAMUT(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAMUT(I)= SQRT(EAMUT(I)) EAMUT(I)= EAMUT(I)/SMUT(I)*ABS(1.D0+ESMUT(I)/EAMUT(I) # *ABS(AMUT(I))) ELSE IF(OINDX.EQ.'TA') THEN STAUT0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) STAUT0(I)= STAUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) STAUT(I)= STAUT0(I)+DELIFS(3,I) ATAUT(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(3,I))/(STAUT0(I)+DELIFS(3,I)) ESTAUT(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESTAUT(I)= SQRT(ESTAUT(I)) EATAUT(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EATAUT(I)= SQRT(EATAUT(I)) EATAUT(I)= EATAUT(I)/STAUT(I)*ABS(1.D0+ESTAUT(I)/ # EATAUT(I)*ABS(ATAUT(I))) ENDIF ENDDO RETURN ENDIF * IC= 0 DO I=1,IFMAX IF(DELF.GE.ACOLL(1).AND.I.EQ.1.AND.OCN.EQ.'Y') THEN PRINT*,' NOT SUITED FOR THESE ACOLL AND DELTA ' STOP ENDIF * IF(IT(I).EQ.1.AND.I.NE.1) THEN PRINT*,' T-CHANNEL ONLY FOR ELECTRONS ' STOP ENDIF * IF(IT(I).EQ.1.AND.THMIN(I).LT.20.D0) THEN PRINT*,' NOT SUITED FOR THETA(-) < 20 DEG ' STOP ENDIF * IF(THMINP(I).GT.THMIN(I)) THEN PRINT*,' NOT SUITED FOR SUCH AN ANGULAR ACCEPTANCE ' STOP ENDIF ENDDO * *-----REALISTIC CUTS, SUBROUTINE WIDTH HAS ALREADY BEEN CALLED * *-----WEAK CORRECTIONS ARE COMPUTED AT THE WEAKLY CORRECTED PEAK * AND FOR THETA=(THMAX-THMIN)/2 * SW= WT/ZM RSP= ZM/SQRT(1.D0+SW*SW) EBP= RSP/2.D0 AVANGLE= (THMAXMAX-THMINMIN)/2.D0 * IF(OMODES.EQ.'FITC'.AND.OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN CALL TWEAKT(NRS,RS,AVANGLE) ENDIF IFK= IFK+1 ELSE CALL TWEAKT(NRS,RS,AVANGLE) ENDIF * *-----QED CORRECTIONS HAVE ALREADY BEEN COMPUTED, INCLUDING PAIR PRODUCTION * IF REQUESTED * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * DO J=1,IFMAX DO I=1,NRS SEPS(J,I)= S0CUT(J,I)/RSS(I) ENDDO ENDDO IF(KEY.EQ.1) THEN DO J=1,IFMAX DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(SEPS(J,I).GT.YT(J)) THEN KFL= 0 KFLP= 1 ELSE KFL= 1 KFLP= 0 ENDIF CALL TIFINT(KFL,KFLP,J,RS(I),THMIN(J), # SEPS(J,I),WT,ADELIFF(J),ADELIFB(J)) ELSE ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 ENDIF DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDDO ENDIF * *-----ONE-DIM. INTEGRATION IS PERFORMED * NFN= 2*IFMAX*NRS CALL TUNIDINT(IC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) * *-----JACOBIAN CORRECTION ARE COMPUTED * CALL TAJI1(IC,NRS,NFN,SIGF1C,AEST1C,SJAC1,AJAC1, # ESJAC1,EAJAC1) * CALL TAJI2(IC,NRS,NFN,SIGF2C,AEST2C,SJAC2,AJAC2, # ESJAC2,EAJAC2) * CALL TAJI3(IC,NRS,NFN,SIGF3C,AEST3C,SJAC3,AJAC3, # ESJAC3,EAJAC3) * DO I=1,NRS IF(IFMAX.EQ.1) THEN SET0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(1,I))/(SET0(I)+DELIFS(1,I)) ESET(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESET(I)= SQRT(ESET(I)) EAET(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAET(I)= SQRT(EAET(I)) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ELSE SET0(I)= SUNI(1,I)-SJAC1(1,I)-SJAC2(1,I)-SJAC3(1,I) SET0(I)= SET0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,1)*PCDELH(I,1) SET(I)= SET0(I)+DELIFS(1,I) AET(I)= (AUNI(1,I)-AJAC1(1,I)-AJAC2(1,I)-AJAC3(1,I) # +DELIFA(1,I))/(SET0(I)+DELIFS(1,I)) SMUT0(I)= SUNI(2,I)-SJAC1(2,I)-SJAC2(2,I)-SJAC3(2,I) SMUT0(I)= SMUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,3)*PCDELH(I,1) SMUT(I)= SMUT0(I)+DELIFS(2,I) AMUT(I)= (AUNI(2,I)-AJAC1(2,I)-AJAC2(2,I)-AJAC3(2,I) # +DELIFA(2,I))/(SMUT0(I)+DELIFS(2,I)) STAUT0(I)= SUNI(3,I)-SJAC1(3,I)-SJAC2(3,I)-SJAC3(3,I) STAUT0(I)= STAUT0(I)*(1.D0+PCDEL(I,1))+ # SIGMA0C(I,5)*PCDELH(I,1) STAUT(I)= STAUT0(I)+DELIFS(3,I) ATAUT(I)= (AUNI(3,I)-AJAC1(3,I)-AJAC2(3,I)-AJAC3(3,I) # +DELIFA(3,I))/(STAUT0(I)+DELIFS(3,I)) ESET(I)= ESUNI(1,I)*ESUNI(1,I)+ESJAC1(1,I)*ESJAC1(1,I) # +ESJAC2(1,I)*ESJAC2(1,I) # +ESJAC3(1,I)*ESJAC3(1,I) ESET(I)= SQRT(ESET(I)) EAET(I)= EAUNI(1,I)*EAUNI(1,I)+EAJAC1(1,I)*EAJAC1(1,I) # +EAJAC2(1,I)*EAJAC2(1,I) # +EAJAC3(1,I)*EAJAC3(1,I) EAET(I)= SQRT(EAET(I)) EAET(I)= EAET(I)/SET(I)*ABS(1.D0+ESET(I)/EAET(I) # *ABS(AET(I))) ESMUT(I)= ESUNI(2,I)*ESUNI(2,I)+ESJAC1(2,I)*ESJAC1(2,I) # +ESJAC2(2,I)*ESJAC2(2,I) # +ESJAC3(2,I)*ESJAC3(2,I) ESMUT(I)= SQRT(ESMUT(I)) EAMUT(I)= EAUNI(2,I)*EAUNI(2,I)+EAJAC1(2,I)*EAJAC1(2,I) # +EAJAC2(2,I)*EAJAC2(2,I) # +EAJAC3(2,I)*EAJAC3(2,I) EAMUT(I)= SQRT(EAMUT(I)) EAMUT(I)= EAMUT(I)/SMUT(I)*ABS(1.D0+ESMUT(I)/EAMUT(I) # *ABS(AMUT(I))) ESTAUT(I)= ESUNI(3,I)*ESUNI(3,I)+ESJAC1(3,I)*ESJAC1(3,I) # +ESJAC2(3,I)*ESJAC2(3,I) # +ESJAC3(3,I)*ESJAC3(3,I) ESTAUT(I)= SQRT(ESTAUT(I)) EATAUT(I)= EAUNI(3,I)*EAUNI(3,I)+EAJAC1(3,I)*EAJAC1(3,I) # +EAJAC2(3,I)*EAJAC2(3,I) # +EAJAC3(3,I)*EAJAC3(3,I) EATAUT(I)= SQRT(EATAUT(I)) EATAUT(I)= EATAUT(I)/STAUT(I)*ABS(1.D0+ESTAUT(I)/ # EATAUT(I)*ABS(ATAUT(I))) ENDIF ENDDO * RETURN END * *-----UNIDINT-------------------------------------------------------- * SUBROUTINE TUNIDINT(JC,NRS,IFMAX,NFN,SUNI,AUNI,SIGF0,AEST0, # SIGF1,AEST1,ESUNI,EAUNI) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,ONP,OSP,OFB,OREST,ORAD, # OPRAD,OIFAIL CHARACTER*1 OFB0,OTHRMT0,OTHRE0,OCUTS,OCREE,OCUTES,OBHABHA CHARACTER*2 OCUT,OINDX CHARACTER*4 OMODES * PARAMETER(NDIM=1,NOBS=6,MNRS=30,MNFN=NOBS*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0,NL=3) PARAMETER(NFL=4) * * NOBS = # OF OBSERVABLES: 1 = SIG_T(E), 2 = SIG_FB(E), * 3 = SIG_T(MU), 4 = SIG_FB(MU), 5 = SIG_T(TAU), * 6 = SIG_FB(TAU) * NRS = # OF ENERGIES, NL = LEPTON NUMBER * COMMON/TESC/SE COMMON/TICF/IC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TOPR/OPRAD COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TCUTEC/OCREE COMMON/TNOBSL/NOBSM COMMON/TECM/RS(MNRS) COMMON/TCUTE/OXCUTES COMMON/TSPEC/OSP,OFB COMMON/TPAIR/ONP(MNRS) COMMON/TCUT/OXCUT,OXCUTS COMMON/TCCUTE/OCUTES(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TSCALE/ZM,TQM,HM,CALS COMMON/TXVARC/SEPS(MNRS,NOBS) COMMON/TRMED/RXMED(MNRS,NOBS) COMMON/TSPEC0/OFB0,OTHRMT0,OTHRE0 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TS0C/SIGMA0C(MNRS,NOBS),SIGMA1C(MNRS,NOBS) COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * DIMENSION RSMED(MNRS,NOBS),XMAX(MNRS,NOBS),SUNI(NL,MNRS), # AUNI(NL,MNRS),ESUNI(NL,MNRS),EAUNI(NL,MNRS) DIMENSION SIG(MNFN),ARS(NOBS,MNRS),XL(NDIM),XU(NDIM),AEST0(NFN), # SIGF0(NFN),SIGF1(NFN),WRKSTR(LENWRK),AEST1(NFN), # RSS(MNRS) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFUB0C,TFUB1C * *-----THE BORN+WEAK TOTAL AND FORW-BACK CROSS SECTIONS ARE COMPUTED * AT E_CM * IC= JC DO I=1,NRS RSS(I)= RS(I)*RS(I) ENDDO IF(OEXT.EQ.'E') THEN IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN NOBSM= NOBS ELSE IF(OBHABHA.EQ.'R') THEN NOBSM= 2 ENDIF ELSE NOBSM= 2 ENDIF ELSE IF(OEXT.EQ.'C') THEN IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN NOBSM= 2 ELSE IF(IC.EQ.0) THEN NOBSM= NOBS ELSE NOBSM= 2 ENDIF ENDIF ENDIF * DO I=1,NOBSM DO J=1,NRS ARS(I,J)= RS(J) ENDDO ENDDO * CALL TBORNCUT(IC,NOBS,NRS,NOBSM,ARS,SIGMA0C) * *-----THRESHOLDS ARE COMPUTED; HERE AND IN FUNSUB0C, FUNSUB1C * I = 6 CONFIGURATIONS ARE ALLOWED EVEN IF (F-B) = (F+B), * THEREFORE SUBSEQUENTLY ONLY I = 1,3,5 ARE USED WHEN THE * ENERGIES ARE REQUESTED * DO I=1,NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN SEPS(I,1)= S0CUT(1,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ELSE IF(OINDX.EQ.'MU') THEN SEPS(I,1)= S0CUT(2,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ELSE IF(OINDX.EQ.'TA') THEN SEPS(I,1)= S0CUT(3,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ENDIF ELSE SEPS(I,1)= S0CUT(1,I)/RSS(I) SEPS(I,2)= SEPS(I,1) SEPS(I,3)= S0CUT(2,I)/RSS(I) SEPS(I,4)= SEPS(I,3) SEPS(I,5)= S0CUT(3,I)/RSS(I) SEPS(I,6)= SEPS(I,5) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN SEPS(I,1)= S0CUT(2,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ELSE IF(OINDX.EQ.'TA') THEN SEPS(I,1)= S0CUT(3,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ENDIF ELSE IF(OCREE.EQ.'Y') THEN IF(OCUTES(I).EQ.'Y') THEN SEPS(I,1)= OXCUTES SEPS(I,2)= SEPS(I,1) ELSE IF(OCUTES(I).EQ.'N') THEN SEPS(I,1)= S0CUT(1,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ENDIF ELSE IF(OCREE.EQ.'N') THEN SEPS(I,1)= S0CUT(1,I)/RSS(I) SEPS(I,2)= SEPS(I,1) ENDIF IF(OEXT.EQ.'C') THEN IF(OFB0.EQ.'N') THEN SEPS(I,3)= S0CUT(2,I)/RSS(I) SEPS(I,4)= SEPS(I,3) SEPS(I,5)= S0CUT(3,I)/RSS(I) SEPS(I,6)= SEPS(I,5) ELSE IF(OFB.EQ.'Y') THEN SEPS(I,3)= S0CUT(2,I)/RSS(I) SEPS(I,4)= SEPS(I,3) SEPS(I,5)= S0CUT(3,I)/RSS(I) SEPS(I,6)= SEPS(I,5) ELSE IF(OFB.EQ.'N') THEN IF(OCUTS(I).EQ.'N') THEN SEPS(I,3)= 4.D0*(MM/RS(I))**2 SEPS(I,5)= 4.D0*(TLM/RS(I))**2 ELSE IF(OCUTS(I).EQ.'Y') THEN SEPS(I,3)= OXCUTS SEPS(I,5)= OXCUTS ENDIF SEPS(I,4)= SEPS(I,3) SEPS(I,6)= SEPS(I,5) ENDIF ENDIF ENDIF ENDIF ENDIF ENDDO * DO I=1,NOBSM DO J=1,NRS XMAX(J,I)= 1.D0-SEPS(J,I) ARS(I,J)= SQRT(SEPS(J,I))*RS(J) ENDDO ENDDO * CALL TBORNCUT(IC,NOBS,NRS,NOBSM,ARS,SIGMA1C) * *-----LIMITS OF X-INTEGRATION * DO I=1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO MULFAC= 2**NDIM * *-----STARTS THE 0<->XMED (SCALED) INTEGRATION * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-5*SE 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUB0C,AEQ,REQ, # LENWRK,WRKSTR,SIGF0,AEST0,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY UNIDINT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * *-----STARTS THE XMED<->1-SEPS (SCALED) INTEGRATION * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-5*SE 50 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUB1C,AEQ,REQ, # LENWRK,WRKSTR,SIGF1,AEST1,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY UNIDINT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 50 ENDIF * *-----THE CORRECTED OBSERVABLES * DO I2=1,NOBSM DO I1=1,NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(I2.EQ.1) THEN I3= 1 ELSE IF(I2.EQ.2) THEN I3= 2 ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(I2.EQ.1) THEN I3= 3 ELSE IF(I2.EQ.2) THEN I3= 4 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I2.EQ.1) THEN I3= 5 ELSE IF(I2.EQ.2) THEN I3= 6 ENDIF ENDIF ELSE I3= I2 ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN IF(I2.EQ.1) THEN I3= 3 ELSE IF(I2.EQ.2) THEN I3= 4 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I2.EQ.1) THEN I3= 5 ELSE IF(I2.EQ.2) THEN I3= 6 ENDIF ENDIF ELSE I3= I2 ENDIF ENDIF * RSMED(I1,I2)= 1.D0-RXMED(I1,I2) I= NRS*(I2-1)+I1 PRDMX= TPRAD(I1,I3,XMAX(I1,I2),SEPS(I1,I2)) PRDMD= TPRAD(I1,I3,RXMED(I1,I2),RSMED(I1,I2)) SIG(I)= SIGF0(I)+SIGF1(I)+SIGMA0C(I1,I2)*PRDMD+ # SIGMA1C(I1,I2)*PRDMX*(1.D0-PRDMD/PRDMX) * ENDDO ENDDO * IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN DO I=1,NRS SUNI(1,I)= SIG(I) AUNI(1,I)= SIG(NRS+I) ESUNI(1,I)= AEST0(I)*AEST0(I)+AEST1(I)*AEST1(I) ESUNI(1,I)= SQRT(ESUNI(1,I)) EAUNI(1,I)= AEST0(NRS+I)*AEST0(NRS+I) # +AEST1(NRS+I)*AEST1(NRS+I) ENDDO ELSE DO I=1,NRS SUNI(1,I)= SIG(I) AUNI(1,I)= SIG(NRS+I) ESUNI(1,I)= AEST0(I)*AEST0(I)+AEST1(I)*AEST1(I) ESUNI(1,I)= SQRT(ESUNI(1,I)) EAUNI(1,I)= AEST0(NRS+I)*AEST0(NRS+I) # +AEST1(NRS+I)*AEST1(NRS+I) SUNI(2,I)= SIG(2*NRS+I) AUNI(2,I)= SIG(3*NRS+I) SUNI(3,I)= SIG(4*NRS+I) AUNI(3,I)= SIG(5*NRS+I) ESUNI(2,I)= AEST0(2*NRS+I)*AEST0(2*NRS+I) # +AEST1(2*NRS+I)*AEST1(2*NRS+I) ESUNI(2,I)= SQRT(ESUNI(2,I)) EAUNI(2,I)= AEST0(3*NRS+I)*AEST0(3*NRS+I) # +AEST1(3*NRS+I)*AEST1(3*NRS+I) EAUNI(2,I)= SQRT(EAUNI(2,I)) ESUNI(3,I)= AEST0(4*NRS+I)*AEST0(4*NRS+I) # +AEST1(4*NRS+I)*AEST1(4*NRS+I) ESUNI(3,I)= SQRT(ESUNI(3,I)) EAUNI(3,I)= AEST0(5*NRS+I)*AEST0(5*NRS+I) # +AEST1(5*NRS+I)*AEST1(5*NRS+I) EAUNI(3,I)= SQRT(EAUNI(3,I)) ENDDO RETURN ENDIF ENDIF * IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN DO I=1,NRS SUNI(1,I)= SIG(I) AUNI(1,I)= SIG(NRS+I) ESUNI(1,I)= AEST0(I)*AEST0(I)+AEST1(I)*AEST1(I) ESUNI(1,I)= SQRT(ESUNI(1,I)) EAUNI(1,I)= AEST0(NRS+I)*AEST0(NRS+I) # +AEST1(NRS+I)*AEST1(NRS+I) ENDDO ELSE DO I=1,NRS SUNI(1,I)= SIG(I) AUNI(1,I)= SIG(NRS+I) ESUNI(1,I)= AEST0(I)*AEST0(I)+AEST1(I)*AEST1(I) ESUNI(1,I)= SQRT(ESUNI(1,I)) EAUNI(1,I)= AEST0(NRS+I)*AEST0(NRS+I) # +AEST1(NRS+I)*AEST1(NRS+I) EAUNI(1,I)= SQRT(EAUNI(1,I)) IF(OEXT.EQ.'C'.AND.IC.EQ.0) THEN SUNI(2,I)= SIG(2*NRS+I) AUNI(2,I)= SIG(3*NRS+I) SUNI(3,I)= SIG(4*NRS+I) AUNI(3,I)= SIG(5*NRS+I) ESUNI(2,I)= AEST0(2*NRS+I)*AEST0(2*NRS+I) # +AEST1(2*NRS+I)*AEST1(2*NRS+I) ESUNI(2,I)= SQRT(ESUNI(2,I)) EAUNI(2,I)= AEST0(3*NRS+I)*AEST0(3*NRS+I) # +AEST1(3*NRS+I)*AEST1(3*NRS+I) EAUNI(2,I)= SQRT(EAUNI(2,I)) ESUNI(3,I)= AEST0(4*NRS+I)*AEST0(4*NRS+I) # +AEST1(4*NRS+I)*AEST1(4*NRS+I) ESUNI(3,I)= SQRT(ESUNI(3,I)) EAUNI(3,I)= AEST0(5*NRS+I)*AEST0(5*NRS+I) # +AEST1(5*NRS+I)*AEST1(5*NRS+I) EAUNI(3,I)= SQRT(EAUNI(3,I)) ENDIF ENDDO ENDIF * RETURN END * *-----FUNSUB0C---------------------------------------------------- *-----INTEGRANDS FOR (SCALED) 0<->XMED INTEGRATION * SCALE FACTOR = XMED * SUBROUTINE TFUB0C(NDIM,ZZ,NFN,F) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OHC,ORAD,OPRAD,OCHAN CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NOBS=6) PARAMETER(NFL=4,NL=3) * COMMON/THC/OHC COMMON/TICF/IC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/TOPR/OPRAD COMMON/TSUP/OMODES COMMON/TCHAN/OCHAN COMMON/TNOBSL/NOBSM COMMON/TECM/RS(MNRS) COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TXVARC/SEPS(MNRS,NOBS) COMMON/TRMED/RXMED(MNRS,NOBS) COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TS0C/SIGMA0C(MNRS,NOBS),SIGMA1C(MNRS,NOBS) COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION ZZ(NDIM),F(NFN),SIGMA(MNRS,NOBS),RSH(NOBS,MNRS), # TESTXM(MNRS,NOBS),X(MNRS,NOBS),RAD(NOBS,MNRS), # RADFB(NOBS,MNRS) * DO I2=1,NOBSM DO I1=1,NRS TESTXM(I1,I2)= 1.D0-XMED-SEPS(I1,I2) IF(TESTXM(I1,I2).GT.0.D0) THEN RXMED(I1,I2)= XMED ELSE RXMED(I1,I2)= XMED-SEPS(I1,I2) ENDIF ENDDO ENDDO * IF(OHC.EQ.'Y') THEN DO J=1,NRS DO I=1,NOBSM X(J,I)= RXMED(J,I)*ZZ(1) XL= LOG(X(J,I)) OMXL= LOG(1.D0-X(J,I)) * *-----THE HARD CONSTANTS * Z= 1.D0-X(J,I) ZS= Z*Z OMZ= X(J,I) OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) OMZL= LOG(OMZ) ZL20= ZL*ZL ZL02= OMZL*OMZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL-ZL20)+ # OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)*ZL11- # 25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)*RZ2+ # (1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/OMZ* # (1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) * RLM1= RL(J)-1.D0 SP1= APIS*RL(J)*RL(J)*(HR2-OPZ*(2.D0*OMZL+ # 1.5D0)) SP2= APIS*RL(J)*(HR1-OPZ*(-4.D0*OMZL-1.5D0+ # 2.D0*RZ2-2.D0)) SP3= APIS*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -API*RL(J)*OPZ SP5= API*OPZ RH= SP1+SP2+SP3+SP4+SP5 RHE= APIS*(RL(J)*(RL(J)*HR2+HR1)+HR0) RH3= -27.D0/2.D0+15.D0/4.D0*OMZ # +4.D0*(1.D0-0.5D0*OMZ) # *(PIS-6.D0*OMZL**2+3.D0*S11) # +3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0*OMZ) # +ZL20*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ) # -6.D0*OMZL*(6.D0-OMZ) # +6.D0*OMZL*ZL*(6.D0-4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETA(J)**3/48.D0 RH1FB= BETA(J)/2.D0/X(J,I)*(1.D0+ZS # -2.D0*OPZS/4.D0/Z)-API*(LOG(4.D0*Z/OPZS)) RH1FB= RH1FB*4.D0*Z/OPZS RH1S= -0.5D0*BETA(J)*OPZ RH2S= 1.D0/8.D0*BETA(J)*BETA(J)*(OPZ* # (3.D0*OMXL-4.D0*XL)-4.D0/X(J,I)*OMXL-6.D0+X(J,I)) SOMX= SQRT(Z) RH2FB= X(J,I)**3/2.D0/Z+X(J,I)**2/SOMX*(ATAN(1.D0/SOMX) # -ATAN(SOMX))-OPZ*LOG(Z)+2.D0*X(J,I) RH2FB= RH2FB*(API/2.D0*RL(J))**2 RH2FB= RH2FB+RH2S RH2FB= RH2FB*4.D0*Z/OPZS YH0= 0.5D0*(1.D0+ZS) YHA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA(J) # +1.D0/8.D0*(4.D0*(1.D0+ZS)*(S11+OMZL*ZL) # -(1.D0+3.D0*ZS)*ZL20+2.D0*(3.D0+2.D0*Z+ZS)*ZL # +2.D0*OMZ*(3.D0-2.D0*Z)) YHA= API*YHA YHB= 1.D0/8.D0*BETA(J)*(-(1.D0+3.D0*ZS)*ZL-2.D0*OMZ2) YHB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ZL20+0.5D0*OMZ* # (1.D0-3.D0*Z)*ZL+OMZ2+(1.D0-ZS)*S11 YHB2= 1.D0/8.D0*BETA(J)**2*YHB2 * IF((OBHABHA.EQ.'N'.AND.OCHAN.EQ.'F'. # AND.(I.EQ.1.OR.I.EQ.2)).OR. # (OBHABHA.EQ.'B'.AND.OCHAN.EQ.'F'. # AND.(I.EQ.1.OR.I.EQ.2))) THEN IF(OCHAN.EQ.'F'.AND.(I.EQ.1.OR.I.EQ.2)) THEN RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J)-1.D0)+ # RH1S+RH2S RADFB(I,J)= RAD(I,J) ENDIF ELSE IF((OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N'.AND. # OCHAN.EQ.'F'.AND.(I.EQ.1.OR.I.EQ.2)).OR. # (OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'R'.AND. # OCHAN.EQ.'F'.AND.OINDX.EQ.'EL'.AND. # (I.EQ.1.OR.I.EQ.2))) THEN RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J)-1.D0)+ # RH1S+RH2S RADFB(I,J)= RAD(I,J) ELSE IF(ORAD.EQ.'A') THEN RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J)-1.D0)+ # RH ELSE IF(ORAD.EQ.'D') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(I,J)= BETA(J)*X(J,I)**(BETA(J)-1.D0)*FGL* # EXP(AD1(J))*ADD(J)+RH ELSE IF(ORAD.EQ.'E') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(I,J)= 0.5D0*OPZ2*BETA(J)*X(J,I)**(BETA(J)-1.D0)* # FGL*EXP(AD1(J))*ADD(J)+RHE ELSE IF(ORAD.EQ.'F') THEN RAD(I,J)= (SDELTA(J)+SDELTA3(J))*BETA(J)*X(J,I) # **(BETA(J)-1.D0)+RH+RH3 ELSE IF(ORAD.EQ.'Y') THEN ARGE= (3.D0/4.D0-EGAM)*BETA(J)+API*(2.D0*RZ2-0.5D0) ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(I,J)= BETA(J)*X(J,I)**(BETA(J)-1.D0)*FGL # *(YH0+YHA+YHB+YHB2) ENDIF RADFB(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J)-1.D0) # +RH1FB+RH2FB ENDIF ENDDO ENDDO * *-----REDUCED ENERGIES * DO I=1,NOBSM DO J=1,NRS RSH(I,J)= SQRT(1.D0-X(J,I))*RS(J) ENDDO ENDDO * CALL TBORNCUT(IC,NOBS,NRS,NOBSM,RSH,SIGMA) * DO I2=1,NOBSM DO I1=1,NRS I= NRS*(I2-1)+I1 IF(OMODES.EQ.'FITC') THEN IF((OBHABHA.EQ.'R'.AND.I2.EQ.2).OR.( # OBHABHA.EQ.'N'.AND.(I2.EQ.2.OR.I2.EQ.4.OR. # I2.EQ.6))) THEN F(I)= RXMED(I1,I2)*(SIGMA(I1,I2)-SIGMA0C(I1,I2))* # RADFB(I2,I1) ELSE F(I)= RXMED(I1,I2)*(SIGMA(I1,I2)-SIGMA0C(I1,I2))* # RAD(I2,I1) ENDIF ELSE IF((OEXT.EQ.'E'.AND.(I2.EQ.2)) # .OR.(OBHABHA.EQ.'R'.AND.OREST.EQ.'C' # .AND.(I2.EQ.2)) # .OR.(OEXT.EQ.'C'.AND. # (I2.EQ.2.OR.I2.EQ.4.OR.I2.EQ.6)).OR. # (OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'R'.AND. # I2.EQ.2).OR.(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N'. # AND.(I2.EQ.2.OR.I2.EQ.4.OR.I2.EQ.6))) THEN F(I)= RXMED(I1,I2)*(SIGMA(I1,I2)-SIGMA0C(I1,I2))* # RADFB(I2,I1) ELSE F(I)= RXMED(I1,I2)*(SIGMA(I1,I2)-SIGMA0C(I1,I2))* # RAD(I2,I1) ENDIF ENDIF ENDDO ENDDO * ELSE IF(OHC.EQ.'N') THEN * DO J=1,NRS DO I=1,NOBSM X(J,I)= RXMED(J,I)*ZZ(1) XL= LOG(X(J,I)) OMXL= LOG(1.D0-X(J,I)) RH1= -0.5D0*BETA(J)*(2.D0-X(J,I)) RH2= 1.D0/8.D0*BETA(J)*BETA(J)*((2.D0-X(J,I))* # (3.D0*OMXL-4.D0*XL)-4.D0/X(J,I)*OMXL-6.D0+ # X(J,I)) * RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J)-1.D0)+ # RH1+RH2 ENDDO ENDDO * *-----REDUCED ENERGIES * DO I=1,NOBSM DO J=1,NRS RSH(I,J)= SQRT(1.D0-X(J,I))*RS(J) ENDDO ENDDO * CALL TBORNCUT(IC,NOBS,NRS,NOBSM,RSH,SIGMA) * DO I2=1,NOBSM DO I1=1,NRS I= NRS*(I2-1)+I1 F(I)= RXMED(I1,I2)*(SIGMA(I1,I2)-SIGMA0C(I1,I2))* # RAD(I2,I1) ENDDO ENDDO * ENDIF * RETURN END * *-----FUNSUB1C---------------------------------------------------------- *-----INTEGRANDS FOR (SCALED) XMED<->1-SEPS INTEGRATION * SCALE FACTOR = 1-XMED-SEPS * SUBROUTINE TFUB1C(NDIM,ZZ,NFN,F) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OHC,ORAD,OPRAD,OCHAN CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NOBS=6) PARAMETER(NFL=4,NL=3) * COMMON/THC/OHC COMMON/TICF/IC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/TOPR/OPRAD COMMON/TSUP/OMODES COMMON/TCHAN/OCHAN COMMON/TNOBSL/NOBSM COMMON/TECM/RS(MNRS) COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TXVARC/SEPS(MNRS,NOBS) COMMON/TRMED/RXMED(MNRS,NOBS) COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TS0C/SIGMA0C(MNRS,NOBS),SIGMA1C(MNRS,NOBS) COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION ZZ(NDIM),F(NFN),SIGMA(MNRS,NOBS),X(MNRS,NOBS), # RAD(NOBS,MNRS),RSH(NOBS,MNRS),XL(MNRS,NOBS), # OMXL(MNRS,NOBS),TESTXM(MNRS,NOBS), # RADFB(NOBS,MNRS) * DO I2=1,NOBSM DO I1=1,NRS TESTXM(I1,I2)= 1.D0-XMED-SEPS(I1,I2) IF(TESTXM(I1,I2).GT.0.D0) THEN RXMED(I1,I2)= XMED ELSE RXMED(I1,I2)= XMED-SEPS(I1,I2) ENDIF ENDDO ENDDO * IF(OHC.EQ.'Y') THEN A2L0= APIS A1L0= API * *-----MUONS, TAUS AND QUARKS HAVE DIFFERENT THRESHOLDS * DO J=1,NRS A2L2= APIS*RL(J)*RL(J) A2L1= APIS*RL(J) A1L1= API*RL(J) BETAH= 0.5D0*BETA(J) BETAS= 1.D0/8.D0*BETA(J)*BETA(J) BETAM1= BETA(J)-1.D0 SBETA= SDELTA(J)*BETA(J) DO I=1,NOBSM X(J,I)= ((1.D0-RXMED(J,I))-SEPS(J,I))*ZZ(1)+ # RXMED(J,I) XL(J,I)= LOG(X(J,I)) OMXL(J,I)= LOG(1.D0-X(J,I)) * *-----THE HARD CONSTANTS * Z= 1.D0-X(J,I) ZS= Z*Z OMZ= X(J,I) OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) OMZL= LOG(OMZ) ZL20= ZL*ZL ZL02= OMZL*OMZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL- # ZL20)+OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)* # ZL11-25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)* # RZ2+(1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/ # OMZ*(1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) * RLM1= RL(J)-1.D0 SP1= A2L2*(HR2-OPZ*(2.D0*OMZL+1.5D0)) SP2= A2L1*(HR1-OPZ*(-4.D0*OMZL-1.5D0+ # 2.D0*RZ2-2.D0)) SP3= A2L0*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -A1L1*OPZ SP5= A1L0*OPZ RH= SP1+SP2+SP3+SP4+SP5 RHE= A2L2*HR2+A2L1*HR1+A2L0*HR0 RH3= -27.D0/2.D0+15.D0/4.D0*OMZ # +4.D0*(1.D0-0.5D0*OMZ) # *(PIS-6.D0*OMZL**2+3.D0*S11) # +3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0*OMZ) # +ZL**2*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ) # -6.D0*OMZL*(6.D0-OMZ) # +6.D0*OMZL*ZL*(6.D0-4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETA(J)**3/48.D0 RH1FB= BETA(J)/2.D0/X(J,I)*(1.D0+ZS # -2.D0*OPZS/4.D0/Z)-API*(LOG(4.D0*Z # /OPZS)) RH1FB= RH1FB*4.D0*Z/OPZS RH1S= -BETA(J)/2.D0*OPZ RH2S= 1.D0/8.D0*BETA(J)*BETA(J)*(OPZ* # (3.D0*OMXL(J,I)-4.D0*XL(J,I)) # -4.D0/X(J,I)*OMXL(J,I)-6.D0+X(J,I)) SOMX= SQRT(Z) RH2FB= X(J,I)**3/2.D0/Z+X(J,I)**2/SOMX # *(ATAN(1.D0/SOMX)-ATAN(SOMX)) # -OPZ*LOG(Z)+2.D0*X(J,I) RH2FB= RH2FB*(API/2.D0*RL(J))**2 RH2FB= RH2FB+RH2S RH2FB= RH2FB*4.D0*Z/OPZS YH0= 0.5D0*(1.D0+ZS) YHA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA(J) # +1.D0/8.D0*(4.D0*(1.D0+ZS)*(S11+OMZL*ZL) # -(1.D0+3.D0*ZS)*ZL20+2.D0*(3.D0+2.D0*Z+ZS)*ZL # +2.D0*OMZ*(3.D0-2.D0*Z)) YHA= API*YHA YHB= 1.D0/8.D0*BETA(J)*(-(1.D0+3.D0*ZS)*ZL # -2.D0*OMZ2) YHB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ZL20 # +0.5D0*OMZ*(1.D0-3.D0*Z)*ZL + OMZ2 # +(1.D0-ZS)*S11 YHB2= 1.D0/8.D0*BETA(J)**2*YHB2 * IF((OBHABHA.EQ.'N'.AND.OCHAN.EQ.'F'. # AND.(I.EQ.1.OR.I.EQ.2)).OR. # (OBHABHA.EQ.'B'.AND.OCHAN.EQ.'F'. # AND.(I.EQ.1.OR.I.EQ.2))) THEN IF(OCHAN.EQ.'F'.AND.(I.EQ.1.OR.I.EQ.2)) THEN RAD(I,J)= SDELTA(J)*BETA(J)* # X(J,I)**(BETA(J)-1.D0)+RH1S+RH2S RADFB(I,J)= RAD(I,J) ENDIF ELSE IF((OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N'. # AND.OCHAN.EQ.'F'.AND.(I.EQ.1.OR.I.EQ.2)).OR. # (OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'R'.AND. # OCHAN.EQ.'F'.AND.OINDX.EQ.'EL'.AND. # (I.EQ.1.OR.I.EQ.2))) THEN RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J)- # 1.D0)+RH1S+RH2S RADFB(I,J)= RAD(I,J) ELSE IF(ORAD.EQ.'A') THEN RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**BETAM1+ # RH ELSE IF(ORAD.EQ.'D') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(I,J)= BETA(J)*X(J,I)**(BETA(J)-1.D0)* # FGL*EXP(AD1(J))*ADD(J)+RH ELSE IF(ORAD.EQ.'E') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(I,J)= 0.5D0*OPZ2*BETA(J)*X(J,I)**(BETA(J)- # 1.D0)*FGL*EXP(AD1(J))*ADD(J)+RHE ELSE IF(ORAD.EQ.'F') THEN RAD(I,J)= (SDELTA(J)+SDELTA3(J))*BETA(J)*X(J,I) # **BETAM1+RH+RH3 ELSE IF(ORAD.EQ.'Y') THEN ARGE= (3.D0/4.D0-EGAM)*BETA(J)+ # API*(2.D0*RZ2-0.5D0) ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(I,J)= BETA(J)*X(J,I)**(BETA(J)-1.D0)*FGL # *(YH0+YHA+YHB+YHB2) ENDIF RADFB(I,J)= SDELTA(J)*BETA(J)*X(J,I)**(BETA(J) # -1.D0)+RH1FB+RH2FB ENDIF ENDDO ENDDO * *-----REDUCED ENERGIES * DO J=1,NRS DO I=1,NOBSM RSH(I,J)= SQRT(1.D0-X(J,I))*RS(J) ENDDO ENDDO * CALL TBORNCUT(IC,NOBS,NRS,NOBSM,RSH,SIGMA) * DO I2=1,NOBSM DO I1=1,NRS I= NRS*(I2-1)+I1 IF(OMODES.EQ.'FITC') THEN IF((OBHABHA.EQ.'R'.AND.I2.EQ.2).OR.( # OBHABHA.EQ.'N'.AND.(I2.EQ.2.OR.I2.EQ.4.OR. # I2.EQ.6))) THEN F(I)= ((1.D0-RXMED(I1,I2))-SEPS(I1,I2))* # (SIGMA(I1,I2)-SIGMA1C(I1,I2))* # RADFB(I2,I1) ELSE F(I)= ((1.D0-RXMED(I1,I2))-SEPS(I1,I2))* # (SIGMA(I1,I2)-SIGMA1C(I1,I2))* # RAD(I2,I1) ENDIF ELSE IF((OEXT.EQ.'E'.AND.(I2.EQ.2)) # .OR.(OBHABHA.EQ.'R'.AND.OREST.EQ.'C' # .AND.(I2.EQ.2)) # .OR.(OEXT.EQ.'C'.AND. # (I2.EQ.2.OR.I2.EQ.4.OR.I2.EQ.6))) THEN F(I)= ((1.D0-RXMED(I1,I2))-SEPS(I1,I2))* # (SIGMA(I1,I2)-SIGMA1C(I1,I2))* # RADFB(I2,I1) ELSE F(I)= ((1.D0-RXMED(I1,I2))-SEPS(I1,I2))* # (SIGMA(I1,I2)-SIGMA1C(I1,I2))* # RAD(I2,I1) ENDIF ENDIF ENDDO ENDDO * ELSE IF(OHC.EQ.'N') THEN DO I=1,NOBSM DO J=1,NRS X(J,I)= ((1.D0-RXMED(J,I))-SEPS(J,I))*ZZ(1)+ # RXMED(J,I) XL(J,I)= LOG(X(J,I)) OMXL(J,I)= LOG(1.D0-X(J,I)) ENDDO ENDDO * *-----REDUCED ENERGIES * DO J=1,NRS DO I=1,NOBSM RSH(I,J)= SQRT(1.D0-X(J,I))*RS(J) ENDDO ENDDO * CALL TBORNCUT(IC,NOBS,NRS,NOBSM,RSH,SIGMA) * DO J=1,NRS BETAH= 0.5D0*BETA(J) BETAS= 1.D0/8.D0*BETA(J)*BETA(J) BETAM1= BETA(J)-1.D0 SBETA= SDELTA(J)*BETA(J) DO I=1,NOBSM RH1= -BETAH*(2.D0-X(J,I)) RH2= BETAS*((2.D0-X(J,I))*(3.D0*OMXL(J,I)- # 4.D0*XL(J,I))-4.D0/X(J,I)*OMXL(J,I)- # 6.D0+X(J,I)) * RAD(I,J)= SDELTA(J)*BETA(J)*X(J,I)**BETAM1+ # RH1+RH2 ENDDO ENDDO * DO I2=1,NOBSM DO I1=1,NRS I= NRS*(I2-1)+I1 F(I)= ((1.D0-RXMED(I1,I2))-SEPS(I1,I2))* # (SIGMA(I1,I2)-SIGMA1C(I1,I2))* # RAD(I2,I1) ENDDO ENDDO * ENDIF * RETURN END * *-----AJI1----------------------------------------------------- * SUBROUTINE TAJI1(IC,NRS,NFN,SIGF1C,AEST1C,SJAC1,AJAC1, # ESJAC1,EAJAC1) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST,oifail CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(NDIM=1,NOBS=6,MNRS=30,MNFN=NOBS*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0,NL=3) PARAMETER(NFL=4) * * NOBS = # OF OBSERVABLES: 1 = SIG_T(E), 2 = SIG_FB(E), * 3 = SIG_T(MU), 4 = SIG_FB(MU), 5 = SIG_T(TAU), * 6 = SIG_FB(TAU) * NRS = # OF ENERGIES, NL = LEPTON NUMBER * COMMON/TESC/SE COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TECM/RS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * DIMENSION XL(NDIM),XU(NDIM),AEST1C(NFN),SIGF1C(NFN), # WRKSTR(LENWRK),DLTH(3) DIMENSION SJAC1(NL,MNRS),AJAC1(NL,MNRS),ESJAC1(NL,MNRS), # EAJAC1(NL,MNRS) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFSJAC1 * *-----LIMITS OF X-INTEGRATION * XL(1)= 0.D0 XU(1)= 1.D0 * MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-4*SE 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFSJAC1,AEQ,REQ, # LENWRK,WRKSTR,SIGF1C,AEST1C,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY AJI1 ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * *-----THE CORRECTED JACOBIAN X-SECT. * DO J=1,3 DLTH(J)= THMAXR(J)-THMINR(J) ENDDO DO I=1,NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN SJAC1(1,I)= DLTH(1)*SIGF1C(I) AJAC1(1,I)= DLTH(1)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(1)*AEST1C(I) EAJAC1(1,I)= DLTH(1)*AEST1C(NRS+I) ELSE IF(OINDX.EQ.'MU') THEN SJAC1(1,I)= DLTH(2)*SIGF1C(I) AJAC1(1,I)= DLTH(2)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(2)*AEST1C(I) EAJAC1(1,I)= DLTH(2)*AEST1C(NRS+I) ELSE IF(OINDX.EQ.'TA') THEN SJAC1(1,I)= DLTH(3)*SIGF1C(I) AJAC1(1,I)= DLTH(3)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(3)*AEST1C(I) EAJAC1(1,I)= DLTH(3)*AEST1C(NRS+I) ENDIF ELSE SJAC1(1,I)= DLTH(1)*SIGF1C(I) AJAC1(1,I)= DLTH(1)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(1)*AEST1C(I) EAJAC1(1,I)= DLTH(1)*AEST1C(NRS+I) SJAC1(2,I)= DLTH(2)*SIGF1C(2*NRS+I) AJAC1(2,I)= DLTH(2)*SIGF1C(3*NRS+I) SJAC1(3,I)= DLTH(3)*SIGF1C(4*NRS+I) AJAC1(3,I)= DLTH(3)*SIGF1C(5*NRS+I) ESJAC1(2,I)= DLTH(2)*AEST1C(2*NRS+I) EAJAC1(2,I)= DLTH(2)*AEST1C(3*NRS+I) ESJAC1(3,I)= DLTH(3)*AEST1C(4*NRS+I) EAJAC1(3,I)= DLTH(3)*AEST1C(5*NRS+I) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN SJAC1(1,I)= DLTH(2)*SIGF1C(I) AJAC1(1,I)= DLTH(2)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(2)*AEST1C(I) EAJAC1(1,I)= DLTH(2)*AEST1C(NRS+I) ELSE IF(OINDX.EQ.'TA') THEN SJAC1(1,I)= DLTH(3)*SIGF1C(I) AJAC1(1,I)= DLTH(3)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(3)*AEST1C(I) EAJAC1(1,I)= DLTH(3)*AEST1C(NRS+I) ENDIF ELSE SJAC1(1,I)= DLTH(1)*SIGF1C(I) AJAC1(1,I)= DLTH(1)*SIGF1C(NRS+I) ESJAC1(1,I)= DLTH(1)*AEST1C(I) EAJAC1(1,I)= DLTH(1)*AEST1C(NRS+I) IF(OEXT.EQ.'C'.AND.IC.EQ.0) THEN SJAC1(2,I)= DLTH(2)*SIGF1C(2*NRS+I) AJAC1(2,I)= DLTH(2)*SIGF1C(3*NRS+I) SJAC1(3,I)= DLTH(3)*SIGF1C(4*NRS+I) AJAC1(3,I)= DLTH(3)*SIGF1C(5*NRS+I) ESJAC1(2,I)= DLTH(2)*AEST1C(2*NRS+I) EAJAC1(2,I)= DLTH(2)*AEST1C(3*NRS+I) ESJAC1(3,I)= DLTH(3)*AEST1C(4*NRS+I) EAJAC1(3,I)= DLTH(3)*AEST1C(5*NRS+I) ENDIF ENDIF ENDIF ENDDO * RETURN END * *-----AJI2----------------------------------------------------- * SUBROUTINE TAJI2(IC,NRS,NFN,SIGF2C,AEST2C,SJAC2,AJAC2, # ESJAC2,EAJAC2) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST,OIFAIL CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(NDIM=2,NOBS=6,MNRS=30,MNFN=NOBS*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=1000*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0,NL=3) PARAMETER(NFL=4) * * NOBS = # OF OBSERVABLES: 1 = SIG_T(E), 2 = SIG_FB(E), * 3 = SIG_T(MU), 4 = SIG_FB(MU), 5 = SIG_T(TAU), * 6 = SIG_FB(TAU) * NRS = # OF ENERGIES, NL = LEPTON NUMBER * COMMON/TESC/SE COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TECM/RS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * DIMENSION XL(NDIM),XU(NDIM),AEST2C(NFN),SIGF2C(NFN), # WRKSTR(LENWRK),DLTH(3) DIMENSION SJAC2(NL,MNRS),AJAC2(NL,MNRS),ESJAC2(NL,MNRS), # EAJAC2(NL,MNRS) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFSJAC2 * *-----LIMITS OF X-INTEGRATION * DO I=1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 1.D-5*SE * REQ= 1.D-2*SE REQ= 1.D-3*SE 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFSJAC2,AEQ,REQ, # LENWRK,WRKSTR,SIGF2C,AEST2C,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY AJI2 ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * *-----THE CORRECTED JACOBIAN X-SECT. * DO J=1,3 DLTH(J)= THMAXR(J)-THMINR(J) ENDDO DO I=1,NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN SJAC2(1,I)= DLTH(1)*SIGF2C(I) AJAC2(1,I)= DLTH(1)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(1)*AEST2C(I) EAJAC2(1,I)= DLTH(1)*AEST2C(NRS+I) ELSE IF(OINDX.EQ.'MU') THEN SJAC2(1,I)= DLTH(2)*SIGF2C(I) AJAC2(1,I)= DLTH(2)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(2)*AEST2C(I) EAJAC2(1,I)= DLTH(2)*AEST2C(NRS+I) ELSE IF(OINDX.EQ.'TA') THEN SJAC2(1,I)= DLTH(3)*SIGF2C(I) AJAC2(1,I)= DLTH(3)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(3)*AEST2C(I) EAJAC2(1,I)= DLTH(3)*AEST2C(NRS+I) ENDIF ELSE SJAC2(1,I)= DLTH(1)*SIGF2C(I) AJAC2(1,I)= DLTH(1)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(1)*AEST2C(I) EAJAC2(1,I)= DLTH(1)*AEST2C(NRS+I) SJAC2(2,I)= DLTH(2)*SIGF2C(2*NRS+I) AJAC2(2,I)= DLTH(2)*SIGF2C(3*NRS+I) SJAC2(3,I)= DLTH(3)*SIGF2C(4*NRS+I) AJAC2(3,I)= DLTH(3)*SIGF2C(5*NRS+I) ESJAC2(2,I)= DLTH(2)*AEST2C(2*NRS+I) EAJAC2(2,I)= DLTH(2)*AEST2C(3*NRS+I) ESJAC2(3,I)= DLTH(3)*AEST2C(4*NRS+I) EAJAC2(3,I)= DLTH(3)*AEST2C(5*NRS+I) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN SJAC2(1,I)= DLTH(2)*SIGF2C(I) AJAC2(1,I)= DLTH(2)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(2)*AEST2C(I) EAJAC2(1,I)= DLTH(2)*AEST2C(NRS+I) ELSE IF(OINDX.EQ.'TA') THEN SJAC2(1,I)= DLTH(3)*SIGF2C(I) AJAC2(1,I)= DLTH(3)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(3)*AEST2C(I) EAJAC2(1,I)= DLTH(3)*AEST2C(NRS+I) ENDIF ELSE SJAC2(1,I)= DLTH(1)*SIGF2C(I) AJAC2(1,I)= DLTH(1)*SIGF2C(NRS+I) ESJAC2(1,I)= DLTH(1)*AEST2C(I) EAJAC2(1,I)= DLTH(1)*AEST2C(NRS+I) IF(OEXT.EQ.'C'.AND.IC.EQ.0) THEN SJAC2(2,I)= DLTH(2)*SIGF2C(2*NRS+I) AJAC2(2,I)= DLTH(2)*SIGF2C(3*NRS+I) SJAC2(3,I)= DLTH(3)*SIGF2C(4*NRS+I) AJAC2(3,I)= DLTH(3)*SIGF2C(5*NRS+I) ESJAC2(2,I)= DLTH(2)*AEST2C(2*NRS+I) EAJAC2(2,I)= DLTH(2)*AEST2C(3*NRS+I) ESJAC2(3,I)= DLTH(3)*AEST2C(4*NRS+I) EAJAC2(3,I)= DLTH(3)*AEST2C(5*NRS+I) ENDIF ENDIF ENDIF ENDDO * RETURN END * *-----AJI3----------------------------------------------------------- * SUBROUTINE TAJI3(IC,NRS,NFN,SIGF3C,AEST3C,SJAC3,AJAC3, # ESJAC3,EAJAC3) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST,OIFAIL CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(NDIM=3,NOBS=6,MNRS=30,MNFN=NOBS*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0,NL=3) PARAMETER(NFL=4) * * NOBS = # OF OBSERVABLES: 1 = SIG_T(E), 2 = SIG_FB(E), * 3 = SIG_T(MU), 4 = SIG_FB(MU), 5 = SIG_T(TAU), * 6 = SIG_FB(TAU) * NRS = # OF ENERGIES, NL = LEPTON NUMBER * COMMON/TESC/SE COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TECM/RS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * DIMENSION XL(NDIM),XU(NDIM),AEST3C(NFN),SIGF3C(NFN), # WRKSTR(LENWRK),DLTH(3) DIMENSION SJAC3(NL,MNRS),AJAC3(NL,MNRS),ESJAC3(NL,MNRS), # EAJAC3(NL,MNRS) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFSJAC3 * *-----LIMITS OF X-INTEGRATION * DO I=1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 1.D-5*SE REQ= 1.D-3*SE 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFSJAC3,AEQ,REQ, # LENWRK,WRKSTR,SIGF3C,AEST3C,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY AJI3 ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * *-----THE CORRECTED JACOBIAN X-SECT. * DO J=1,3 DLTH(J)= THMAXR(J)-THMINR(J) ENDDO DO I=1,NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN SJAC3(1,I)= DLTH(1)*SIGF3C(I) AJAC3(1,I)= DLTH(1)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(1)*AEST3C(I) EAJAC3(1,I)= DLTH(1)*AEST3C(NRS+I) ELSE IF(OINDX.EQ.'MU') THEN SJAC3(1,I)= DLTH(2)*SIGF3C(I) AJAC3(1,I)= DLTH(2)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(2)*AEST3C(I) EAJAC3(1,I)= DLTH(2)*AEST3C(NRS+I) ELSE IF(OINDX.EQ.'TA') THEN SJAC3(1,I)= DLTH(3)*SIGF3C(I) AJAC3(1,I)= DLTH(3)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(3)*AEST3C(I) EAJAC3(1,I)= DLTH(3)*AEST3C(NRS+I) ENDIF ELSE SJAC3(1,I)= DLTH(1)*SIGF3C(I) AJAC3(1,I)= DLTH(1)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(1)*AEST3C(I) EAJAC3(1,I)= DLTH(1)*AEST3C(NRS+I) SJAC3(2,I)= DLTH(2)*SIGF3C(2*NRS+I) SJAC3(3,I)= DLTH(3)*SIGF3C(4*NRS+I) AJAC3(2,I)= DLTH(2)*SIGF3C(3*NRS+I) AJAC3(3,I)= DLTH(3)*SIGF3C(5*NRS+I) ESJAC3(2,I)= DLTH(2)*AEST3C(2*NRS+I) ESJAC3(3,I)= DLTH(3)*AEST3C(4*NRS+I) EAJAC3(2,I)= DLTH(2)*AEST3C(3*NRS+I) EAJAC3(3,I)= DLTH(3)*AEST3C(5*NRS+I) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN SJAC3(1,I)= DLTH(2)*SIGF3C(I) AJAC3(1,I)= DLTH(2)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(2)*AEST3C(I) EAJAC3(1,I)= DLTH(2)*AEST3C(NRS+I) ELSE IF(OINDX.EQ.'TA') THEN SJAC3(1,I)= DLTH(3)*SIGF3C(I) AJAC3(1,I)= DLTH(3)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(3)*AEST3C(I) EAJAC3(1,I)= DLTH(3)*AEST3C(NRS+I) ENDIF ELSE SJAC3(1,I)= DLTH(1)*SIGF3C(I) AJAC3(1,I)= DLTH(1)*SIGF3C(NRS+I) ESJAC3(1,I)= DLTH(1)*AEST3C(I) EAJAC3(1,I)= DLTH(1)*AEST3C(NRS+I) IF(OEXT.EQ.'C'.AND.IC.EQ.0) THEN SJAC3(2,I)= DLTH(2)*SIGF3C(2*NRS+I) SJAC3(3,I)= DLTH(3)*SIGF3C(4*NRS+I) AJAC3(2,I)= DLTH(2)*SIGF3C(3*NRS+I) AJAC3(3,I)= DLTH(3)*SIGF3C(5*NRS+I) ESJAC3(2,I)= DLTH(2)*AEST3C(2*NRS+I) ESJAC3(3,I)= DLTH(3)*AEST3C(4*NRS+I) EAJAC3(2,I)= DLTH(2)*AEST3C(3*NRS+I) EAJAC3(3,I)= DLTH(3)*AEST3C(5*NRS+I) ENDIF ENDIF ENDIF ENDDO * RETURN END * *-----FSJAC1--------------------------------------------------------- * INTEGRANDS FOR JACOBIAN AND GEOMETRIC (I.E. CUTS) * INTEGRATION (1-DIM INTEGRATION) * SUBROUTINE TFSJAC1(NDIM,Z,NFN,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM CHARACTER*1 OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30) PARAMETER(NFL=4,NL=3) * COMMON/TCNRS/NRS COMMON/TMNL/IFMAX COMMON/TSUP/OMODES COMMON/TECM/RS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION Z(NDIM),F(NFN),EPS(NL,MNRS),ORS(MNRS), # ONE(NL,MNRS),AKP(NL,MNRS),AKM(NL,MNRS), # AHM(NL,MNRS),AHP(NL,MNRS), # AKPM1(NL,MNRS),UPH(NL,MNRS),UPL(NL,MNRS), # UMH(NL,MNRS),UML(NL,MNRS),SNR(NL,MNRS), # STRDL(NL,MNRS),SUPH(NL,MNRS),SUMH(NL,MNRS), # PFDH(NL,MNRS),PFUPH(NL,MNRS),PFUMH(NL,MNRS), # DH(NL,MNRS),DL(NL,MNRS),DMY(3,NL,MNRS),DMYO(3,NL,MNRS) DIMENSION CPMAX(NL),AAC(NL),BAC(NL),AACP(NL),AACM(NL), # BACP(NL),BACM(NL),CACP(NL),CACM(NL),CZ2(NL), # CZ2P(NL),CZ2M(NL),PIMAC(NL),FM2(NL) DIMENSION ZTH(NL),RSS(MNRS),DSTRU(1,NL,MNRS),DSTRUO(1,NL,MNRS), # X1D(2,NL,MNRS),X2D(2,NL,MNRS),XSD(2,NL,MNRS) * FM2(1)= EM*EM FM2(2)= MM*MM FM2(3)= TLM*TLM * IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN IFCURR= IFMAX ELSE IFCURR= 1 ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IFCURR= 1 ELSE IFCURR= IFMAX ENDIF ENDIF DO J=1,IFCURR IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN JP= 1 ELSE IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ENDIF ZTH(J)= (THMAXR(JP)-THMINR(JP))*Z(1)+THMINR(JP) CPMAX(J)= COS(THMINPR(JP)) PIMAC(J)= PI-ACOLLR(JP) CZ2(J)= COS(ZTH(J)) AAC(J)= COS(ZTH(J)+ACOLLR(JP)) BAC(J)= COS(ZTH(J)-ACOLLR(JP)) CZ2P(J)= 1.D0+CZ2(J) CZ2M(J)= 1.D0-CZ2(J) AACP(J)= 1.D0+AAC(J) AACM(J)= 1.D0-AAC(J) BACP(J)= 1.D0+BAC(J) BACM(J)= 1.D0-BAC(J) CACP(J)= 1.D0+CPMAX(J) CACM(J)= 1.D0-CPMAX(J) * DO I=1,NRS ORS(I)= RS(I) RSS(I)= RS(I)*RS(I) ONE(J,I)= 1.D0 EPS(J,I)= S0CUT(JP,I)/RSS(I) * * 1/AKP AND AKM ARE COMPUTED * IF(ZTH(J).GT.PIMAC(J)) THEN AKM(J,I)= 0.D0 ELSE AKM(J,I)= SQRT(CZ2M(J)*AACP(J)/CZ2P(J)/AACM(J)) ENDIF * IF(ZTH(J).LT.ACOLLR(JP)) THEN AKP(J,I)= 0.D0 ELSE AKP(J,I)= SQRT(CZ2P(J)*BACM(J)/CZ2M(J)/BACP(J)) ENDIF * AHM(J,I)= SQRT(CZ2M(J)*CACM(J)/CZ2P(J)/CACP(J)) AHP(J,I)= SQRT(CZ2P(J)*CACM(J)/CZ2M(J)/CACP(J)) * AKM(J,I)= DMAX1(EPS(J,I),AKM(J,I),AHM(J,I)) AKPM1(J,I)= DMAX1(EPS(J,I),AKP(J,I),AHP(J,I)) AKP(J,I)= 1.D0/AKPM1(J,I) * * COMPLEMENTARY SPACE (+) * UPH(J,I)= DMAX1(AKPM1(J,I),0.5D0) DH(J,I)= DMAX1(EPS(J,I),0.5D0) * UPL(J,I)= DMIN1(AKPM1(J,I),0.5D0) DL(J,I)= DMIN1(EPS(J,I),0.5D0) * * COMPLEMENTARY SPACE (-) * UMH(J,I)= DMAX1(AKM(J,I),0.5D0) * UML(J,I)= DMIN1(AKM(J,I),0.5D0) ENDDO ENDDO * IFM= IFCURR * LMX= 1 DO I=1,IFM DO J=1,NRS DSTRU(1,I,J)= DL(I,J) ENDDO ENDDO CALL TSTRUCFUN(LMX,NRS,IFM,DSTRU,DSTRUO) DO I=1,IFM DO J=1,MNRS STRDL(I,J)= DSTRUO(1,I,J) ENDDO ENDDO * DO I=1,IFM DO J=1,NRS DMY(1,I,J)= DH(I,J) DMY(2,I,J)= UPH(I,J) DMY(3,I,J)= UMH(I,J) ENDDO ENDDO LMX= 3 CALL TPDFUN(LMX,NRS,IFM,DMY,DMYO) DO I=1,IFM DO J=1,NRS PFDH(I,J)= DMYO(1,I,J) PFUPH(I,J)= DMYO(2,I,J) PFUMH(I,J)= DMYO(3,I,J) ENDDO ENDDO * CALL TBRNDFFMNR(NRS,IFM,ORS,ONE,ONE,ZTH,SNR) KMX= 2 DO I=1,IFM DO J=1,NRS X1D(1,I,J)= ONE(I,J) X2D(1,I,J)= UPH(I,J) X1D(2,I,J)= ONE(I,J) X2D(2,I,J)= UMH(I,J) ENDDO ENDDO CALL TBORNDIFFM(KMX,NRS,IFM,ORS,X1D,X2D,ZTH,XSD) DO I=1,IFM DO J=1,NRS SUPH(I,J)= XSD(1,I,J) SUMH(I,J)= XSD(2,I,J) ENDDO ENDDO * DO J=1,IFCURR DO I=1,NRS IF(J.EQ.1) THEN JJ= 0 ELSE IF(J.EQ.2) THEN JJ= 2 ELSE IF(J.EQ.3) THEN JJ= 4 ENDIF IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN JP=1 ELSE IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ENDIF * S0JI= S0CUT(JP,I) IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN FM2J= FM2(1) ELSE IF(OINDX.EQ.'MU') THEN FM2J= FM2(2) ELSE IF(OINDX.EQ.'TA') THEN FM2J= FM2(3) ENDIF ELSE FM2J= FM2(J) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN FM2J= FM2(2) ELSE IF(OINDX.EQ.'TA') THEN FM2J= FM2(3) ENDIF ELSE FM2J= FM2(J) ENDIF ENDIF * SUPHF= UPH(J,I)*RSS(I) SUMHF= UMH(J,I)*RSS(I) * * CONTRIBUTIONS TO THE F+B XSECT. * * COMPLEMENTARY SPACE (+) * F1PC= STRDL(J,I)*SNR(J,I)*LOG(UPL(J,I)/DL(J,I))+ # SUPH(J,I)*(PFDH(J,I)-PFUPH(J,I)) # *TFSCFPB(JP,S0JI,SUPHF,FM2J) * * COMPLEMENTARY SPACE (-) * F1MC= STRDL(J,I)*SNR(J,I)*LOG(UML(J,I)/DL(J,I))+ # SUMH(J,I)*(PFDH(J,I)-PFUMH(J,I)) # *TFSCFPB(JP,S0JI,SUMHF,FM2J) * *-----THE INDEX I IS RUNNING OVER THE NOMINAL ENERGIES, WHILE J IS * 1 = E, 2 = MU, 3 = TAU. (F+B) AND (F-B) ARE STORED AS: * 1->NRS +E, NRS+1->2*NRS -E, 2*NRS+1->3*NRS +MU, * 3*NRS+1->4*NRS -MU, 4*NRS+1->5*NRS +TAU, 5*NRS+1->6*NRS -TAU * *-----CONTRIBUTIONS TO THE F+B XSECT. * F(JJ*NRS+I)= (F1PC+F1MC)*SIN(ZTH(J))*2.D0*PI * *-----CONTRIBUTIONS TO THE F-B XSECT. * IF(ZTH(J).LT.PI/2.D0) THEN F((JJ+1)*NRS+I)= F(JJ*NRS+I) ELSE F((JJ+1)*NRS+I)= -F(JJ*NRS+I) ENDIF * ENDDO ENDDO * RETURN END * *-----FSJAC2--------------------------------------------------------- * INTEGRANDS FOR JACOBIAN AND GEOMETRIC (I.E. CUTS) * INTEGRATION (2-DIM INTEGRATION) * SUBROUTINE TFSJAC2(NDIM,Z,NFN,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM CHARACTER*1 OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3) PARAMETER(NFL=4) * COMMON/TCNRS/NRS COMMON/TMNL/IFMAX COMMON/TSUP/OMODES COMMON/TECM/RS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * DIMENSION ZTH(NL),RSS(MNRS) DIMENSION Z(NDIM),F(NFN),SGP(NL,MNRS),STVP(NL,MNRS), # BP(NL,MNRS),EPS(NL,MNRS),ORS(MNRS),TP(NL,MNRS), # TM(NL,MNRS),XI2(NL,MNRS),CHI4(NL,MNRS),AM(NL,MNRS), # BM(NL,MNRS),SGPM(NL,MNRS),SGMM(NL,MNRS), # FJVP(NL,MNRS),PFAP(NL,MNRS),AP(NL,MNRS), # PFBP(NL,MNRS),ONE(NL,MNRS),STVM(NL,MNRS), # FJVM(NL,MNRS),SGM(NL,MNRS),PFAM(NL,MNRS), # PFBM(NL,MNRS),TPCH(NL,MNRS),CPH(NL,MNRS), # PFCPH(NL,MNRS),SPMCH(NL,MNRS), # AKP(NL,MNRS),AKM(NL,MNRS),AHM(NL,MNRS), # AHP(NL,MNRS),AKPM1(NL,MNRS), # SPMCH0(NL,MNRS),UPH(NL,MNRS),DPH(NL,MNRS), # UPL(NL,MNRS),DPL(NL,MNRS),TPCL(NL,MNRS), # CPL(NL,MNRS),STPCL(NL,MNRS),STPCL0(NL,MNRS), # PFCPL(NL,MNRS),SPMCLR(NL,MNRS),UMH(NL,MNRS), # DMH(NL,MNRS),TMCH(NL,MNRS),CMH(NL,MNRS), # UML(NL,MNRS),DML(NL,MNRS),TMCL(NL,MNRS),CML(NL,MNRS), # STMCH(NL,MNRS),STMCL(NL,MNRS),STMCL0(NL,MNRS), # PFCMH(NL,MNRS),PFCML(NL,MNRS),SMMCH(NL,MNRS), # SMMCH0(NL,MNRS),SMMCLR(NL,MNRS),SPMCLNR(NL,MNRS), # SMMCLNR(NL,MNRS),STPCH(NL,MNRS), # TPCLNR(NL,MNRS),CPLNR(NL,MNRS),TMCLNR(NL,MNRS), # CMLNR(NL,MNRS),STPCLNR(NL,MNRS),STMCLNR(NL,MNRS), # PFCPLNR(NL,MNRS),PFCMLNR(NL,MNRS) DIMENSION CPMAX(NL),AAC(NL),BAC(NL),AACP(NL),AACM(NL), # BACP(NL),BACM(NL),CACP(NL),CACM(NL),CZ2(NL), # CZ2P(NL),CZ2M(NL),PIMAC(NL),FM2(NL),DMY(10,NL,MNRS), # DMYO(10,NL,MNRS),STRU(10,NL,MNRS),STRUO(10,NL,MNRS), # X1D(6,NL,MNRS),X2D(6,NL,MNRS),XSD(6,NL,MNRS) * ZERO= X02AKF() * FM2(1)= EM*EM FM2(2)= MM*MM FM2(3)= TLM*TLM * IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IFCURR= 1 ELSE IFCURR= IFMAX ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IFCURR= 1 ELSE IFCURR= IFMAX ENDIF ENDIF DO J=1,IFCURR IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN JP= 1 ELSE IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ENDIF * ZTH(J)= (THMAXR(JP)-THMINR(JP))*Z(2)+THMINR(JP) CPMAX(J)= COS(THMINPR(JP)) PIMAC(J)= PI-ACOLLR(JP) CZ2(J)= COS(ZTH(J)) AAC(J)= COS(ZTH(J)+ACOLLR(JP)) BAC(J)= COS(ZTH(J)-ACOLLR(JP)) CZ2P(J)= 1.D0+CZ2(J) CZ2M(J)= 1.D0-CZ2(J) AACP(J)= 1.D0+AAC(J) AACM(J)= 1.D0-AAC(J) BACP(J)= 1.D0+BAC(J) BACM(J)= 1.D0-BAC(J) CACP(J)= 1.D0+CPMAX(J) CACM(J)= 1.D0-CPMAX(J) * DO I=1,NRS ORS(I)= RS(I) RSS(I)= RS(I)*RS(I) ONE(J,I)= 1.D0 EPS(J,I)= S0CUT(JP,I)/RSS(I) * * 1/AKP AND AKM ARE COMPUTED * IF(ZTH(J).GT.PIMAC(J)) THEN AKM(J,I)= 0.D0 ELSE AKM(J,I)= SQRT(CZ2M(J)*AACP(J)/CZ2P(J)/AACM(J)) ENDIF * IF(ZTH(J).LT.ACOLLR(JP)) THEN AKP(J,I)= 0.D0 ELSE AKP(J,I)= SQRT(CZ2P(J)*BACM(J)/CZ2M(J)/BACP(J)) ENDIF * AHM(J,I)= SQRT(CZ2M(J)*CACM(J)/CZ2P(J)/CACP(J)) AHP(J,I)= SQRT(CZ2P(J)*CACM(J)/CZ2M(J)/CACP(J)) * AKM(J,I)= DMAX1(EPS(J,I),AKM(J,I),AHM(J,I)) AKPM1(J,I)= DMAX1(EPS(J,I),AKP(J,I),AHP(J,I)) AKP(J,I)= 1.D0/AKPM1(J,I) * * DIRECT SPACE (+) * XI2(J,I)= DMAX1(SQRT(EPS(J,I)/AKP(J,I)),EPS(J,I)) TP(J,I)= (1.D0-XI2(J,I))*Z(1)+XI2(J,I) AP(J,I)= DMAX1(TP(J,I),EPS(J,I)/TP(J,I)) BP(J,I)= DMIN1(1.D0,AKP(J,I)*TP(J,I)) * * DIRECT SPACE (-) * CHI4(J,I)= DMAX1(SQRT(AKM(J,I)*EPS(J,I)),EPS(J,I)) TM(J,I)= (1.D0-CHI4(J,I))*Z(1)+CHI4(J,I) AM(J,I)= DMAX1(EPS(J,I)/TM(J,I),TM(J,I)) BM(J,I)= DMIN1(1.D0,TM(J,I)/AKM(J,I)) * * COMPLEMENTARY SPACE (+) * UPH(J,I)= DMAX1(AKPM1(J,I),0.5D0) DPH(J,I)= DMAX1(EPS(J,I),0.5D0) TPCH(J,I)= (UPH(J,I)-DPH(J,I))*Z(1)+DPH(J,I) CPH(J,I)= DMAX1(AKP(J,I)*TPCH(J,I),EPS(J,I)/TPCH(J,I)) UPL(J,I)= DMIN1(AKPM1(J,I),0.5D0) DPL(J,I)= DMIN1(EPS(J,I),0.5D0) TPCL(J,I)= (UPL(J,I)-DPL(J,I))*Z(1)+DPL(J,I) TPCLNR(J,I)= LOG(UPL(J,I)/DPL(J,I))*Z(1)+LOG(DPL(J,I)) TPCLNR(J,I)= EXP(TPCLNR(J,I)) CPL(J,I)= DMAX1(AKP(J,I)*TPCL(J,I),EPS(J,I)/TPCL(J,I)) CPLNR(J,I)= DMAX1(AKP(J,I)*TPCLNR(J,I),EPS(J,I) # /TPCLNR(J,I)) * * COMPLEMENTARY SPACE (-) * UMH(J,I)= DMAX1(AKM(J,I),0.5D0) DMH(J,I)= DMAX1(EPS(J,I),0.5D0) TMCH(J,I)= (UMH(J,I)-DMH(J,I))*Z(1)+DMH(J,I) CMH(J,I)= DMAX1(1.D0/AKM(J,I)*TMCH(J,I),EPS(J,I) # /TMCH(J,I)) * UML(J,I)= DMIN1(AKM(J,I),0.5D0) DML(J,I)= DMIN1(EPS(J,I),0.5D0) TMCL(J,I)= (UML(J,I)-DML(J,I))*Z(1)+DML(J,I) TMCLNR(J,I)= LOG(UML(J,I)/DML(J,I))*Z(1)+LOG(DML(J,I)) TMCLNR(J,I)= EXP(TMCLNR(J,I)) CML(J,I)= DMAX1(1.D0/AKM(J,I)*TMCL(J,I),EPS(J,I) # /TMCL(J,I)) CMLNR(J,I)= DMAX1(1.D0/AKM(J,I)*TMCLNR(J,I),EPS(J,I) # /TMCLNR(J,I)) ENDDO ENDDO * IFM= IFCURR * LMX= 10 DO I=1,IFM DO J=1,NRS STRU(1,I,J)= TP(I,J) STRU(2,I,J)= TM(I,J) STRU(3,I,J)= TPCH(I,J) STRU(4,I,J)= TPCL(I,J) STRU(5,I,J)= TPCLNR(I,J) STRU(6,I,J)= DPL(I,J) STRU(7,I,J)= TMCH(I,J) STRU(8,I,J)= TMCL(I,J) STRU(9,I,J)= TMCLNR(I,J) STRU(10,I,J)= DML(I,J) ENDDO ENDDO CALL TSTRUCFUN(LMX,NRS,IFM,STRU,STRUO) DO I=1,IFM DO J=1,NRS STVP(I,J)= STRUO(1,I,J) STVM(I,J)= STRUO(2,I,J) STPCH(I,J)= STRUO(3,I,J) STPCL(I,J)= STRUO(4,I,J) STPCLNR(I,J)= STRUO(5,I,J) STPCL0(I,J)= STRUO(6,I,J) STMCH(I,J)= STRUO(7,I,J) STMCL(I,J)= STRUO(8,I,J) STMCLNR(I,J)= STRUO(9,I,J) STMCL0(I,J)= STRUO(10,I,J) ENDDO ENDDO * DO I=1,IFM DO J=1,NRS DMY(1,I,J)= AP(I,J) DMY(2,I,J)= BP(I,J) DMY(3,I,J)= CPH(I,J) DMY(4,I,J)= CPL(I,J) DMY(5,I,J)= CPLNR(I,J) DMY(6,I,J)= AM(I,J) DMY(7,I,J)= BM(I,J) DMY(8,I,J)= CMH(I,J) DMY(9,I,J)= CML(I,J) DMY(10,I,J)= CMLNR(I,J) ENDDO ENDDO LMX= 10 CALL TPDFUN(LMX,NRS,IFM,DMY,DMYO) DO I=1,IFM DO J=1,NRS PFAP(I,J)= DMYO(1,I,J) PFBP(I,J)= DMYO(2,I,J) PFCPH(I,J)= DMYO(3,I,J) PFCPL(I,J)= DMYO(4,I,J) PFCPLNR(I,J)= DMYO(5,I,J) PFAM(I,J)= DMYO(6,I,J) PFBM(I,J)= DMYO(7,I,J) PFCMH(I,J)= DMYO(8,I,J) PFCML(I,J)= DMYO(9,I,J) PFCMLNR(I,J)= DMYO(10,I,J) ENDDO ENDDO * CALL TBORNDIFF(NRS,IFM,ORS,TP,ONE,ZTH,SGP) CALL TBORNDIFF(NRS,IFM,ORS,ONE,TM,ZTH,SGM) * KMX= 6 DO I=1,IFM DO J=1,NRS X1D(1,I,J)= TP(I,J) X2D(1,I,J)= ONE(I,J) X1D(2,I,J)= ONE(I,J) X2D(2,I,J)= TM(I,J) X1D(3,I,J)= TPCH(I,J) X2D(3,I,J)= ONE(I,J) X1D(4,I,J)= UPH(I,J) X2D(4,I,J)= ONE(I,J) X1D(5,I,J)= TMCH(I,J) X2D(5,I,J)= ONE(I,J) X1D(6,I,J)= UMH(I,J) X2D(6,I,J)= ONE(I,J) ENDDO ENDDO CALL TBORNDIFFM(KMX,NRS,IFM,ORS,X1D,X2D,ZTH,XSD) DO I=1,IFM DO J=1,NRS SGPM(I,J)= XSD(1,I,J) SGMM(I,J)= XSD(2,I,J) SPMCH(I,J)= XSD(3,I,J) SPMCH0(I,J)= XSD(4,I,J) SMMCH(I,J)= XSD(5,I,J) SMMCH0(I,J)= XSD(6,I,J) ENDDO ENDDO * CALL TBRNDFFMR(NRS,IFM,ORS,TPCL,ONE,ZTH,SPMCLR) CALL TBRNDFFMR(NRS,IFM,ORS,TMCL,ONE,ZTH,SMMCLR) * CALL TBRNDFFMNR(NRS,IFM,ORS,TPCLNR,ONE,ZTH,SPMCLNR) CALL TBRNDFFMNR(NRS,IFM,ORS,TMCLNR,ONE,ZTH,SMMCLNR) * CALL TFJAC(NRS,IFM,TP,ONE,ZTH,FJVP) CALL TFJAC(NRS,IFM,ONE,TM,ZTH,FJVM) * DO J=1,IFCURR DO I=1,NRS IF(J.EQ.1) THEN JJ= 0 ELSE IF(J.EQ.2) THEN JJ= 2 ELSE IF(J.EQ.3) THEN JJ= 4 ENDIF IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN JP= 1 ELSE IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ENDIF * S0JI= S0CUT(JP,I) IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN FM2J= FM2(1) ELSE IF(OINDX.EQ.'MU') THEN FM2J= FM2(2) ELSE IF(OINDX.EQ.'TA') THEN FM2J= FM2(3) ENDIF ELSE FM2J= FM2(J) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN FM2J= FM2(2) ELSE IF(OINDX.EQ.'TA') THEN FM2J= FM2(3) ENDIF ELSE FM2J= FM2(J) ENDIF ENDIF * STP= TP(J,I)*RSS(I) STM= TM(J,I)*RSS(I) STPCHF= TPCH(J,I)*RSS(I) SUPH= UPH(J,I)*RSS(I) STPCLF= TPCL(J,I)*RSS(I) STPCLNRF= TPCLNR(J,I)*RSS(I) STMCHF= TMCH(J,I)*RSS(I) SUMH= UMH(J,I)*RSS(I) STMCLF= TMCL(J,I)*RSS(I) STMCLNRF= TMCLNR(J,I)*RSS(I) * * CONTRIBUTIONS TO THE F+B XSECT. * * DIRECT SPACE (+ AND -) * F2P= STVP(J,I)*(PFAP(J,I)-PFBP(J,I))*(SGPM(J,I) # -FJVP(J,I)*SGP(J,I))*TFSCFPB(JP,S0JI,STP,FM2J) # *(1.D0-XI2(J,I)) F2M= STVM(J,I)*(PFAM(J,I)-PFBM(J,I))*(SGMM(J,I) # -FJVM(J,I)*SGM(J,I))*TFSCFPB(JP,S0JI,STM,FM2J) # *(1.D0-CHI4(J,I)) * * COMPLEMENTARY SPACE (+) * F2PC= (UPH(J,I)-DPH(J,I))*STPCH(J,I)* # (PFCPH(J,I)*SPMCH(J,I)*TFSCFPB(JP,S0JI,STPCHF,FM2J) # -SPMCH0(J,I)*TFSCFPB(JP,S0JI,SUPH,FM2J)) F2PC= F2PC+LOG(UPL(J,I)/DPL(J,I)) # *TPCLNR(J,I)*SPMCLNR(J,I)* # (PFCPLNR(J,I)*STPCLNR(J,I) # *TFSCFPB(JP,S0JI,STPCLNRF,FM2J) # -STPCL0(J,I)) # +(UPL(J,I)-DPL(J,I))*SPMCLR(J,I)*PFCPL(J,I) # *STPCL(J,I)*TFSCFPB(JP,S0JI,STPCLF,FM2J) * * COMPLEMENTARY SPACE (-) * F2MC= (UMH(J,I)-DMH(J,I))*STMCH(J,I)* # (PFCMH(J,I)*SMMCH(J,I)*TFSCFPB(JP,S0JI,STMCHF,FM2J) # -SMMCH0(J,I)*TFSCFPB(JP,S0JI,SUMH,FM2J)) F2MC= F2MC+LOG(UML(J,I)/DML(J,I))*TMCLNR(J,I) # *SMMCLNR(J,I)* # (PFCMLNR(J,I)*STMCLNR(J,I) # *TFSCFPB(JP,S0JI,STMCLNRF,FM2J)-STMCL0(J,I)) # +(UML(J,I)-DML(J,I))*SMMCLR(J,I)*PFCML(J,I) # *STMCL(J,I)*TFSCFPB(JP,S0JI,STMCLF,FM2J) * *-----THE INDEX I IS RUNNING OVER THE NOMINAL ENERGIES, WHILE J IS * 1 = E, 2 = MU, 3 = TAU. (F+B) AND (F-B) ARE STORED AS: * 1->NRS +E, NRS+1->2*NRS -E, 2*NRS+1->3*NRS +MU, * 3*NRS+1->4*NRS -MU, 4*NRS+1->5*NRS +TAU, 5*NRS+1->6*NRS -TAU * *-----CONTRIBUTIONS TO THE F+B XSECT. * F(JJ*NRS+I)= (F2P+F2PC+F2M+F2MC)*SIN(ZTH(J))*2.D0*PI * *-----CONTRIBUTIONS TO THE F-B XSECT. * IF(ZTH(J).LT.PI/2.D0) THEN F((JJ+1)*NRS+I)= F(JJ*NRS+I) ELSE F((JJ+1)*NRS+I)= -F(JJ*NRS+I) ENDIF * ENDDO ENDDO * RETURN END * *-----FSJAC3---------------------------------------------------------- * INTEGRANDS FOR JACOBIAN INTEGRATION (3-DIM INTEGRATION) * SUBROUTINE TFSJAC3(NDIM,Z,NFN,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM CHARACTER*1 OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3) PARAMETER(NFL=4) * COMMON/TCNRS/NRS COMMON/TMNL/IFMAX COMMON/TSUP/OMODES COMMON/TECM/RS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * DIMENSION ZTH(NL),CZ2(NL),CZ2P(NL),CZ2M(NL),RSS(MNRS) DIMENSION Z(NDIM),F(NFN),STVP(NL,MNRS),BP(NL,MNRS), # EPS(NL,MNRS),BDMP(NL,MNRS),ORS(MNRS),TP(NL,MNRS), # TM(NL,MNRS),XI2(NL,MNRS),CHI4(NL,MNRS),AM(NL,MNRS), # BM(NL,MNRS),SGPM(NL,MNRS),SGMM(NL,MNRS), # FJVP(NL,MNRS),AP(NL,MNRS),BDMP0(NL,MNRS),ONE(NL,MNRS), # STVM(NL,MNRS),FJVM(NL,MNRS),BDP(NL,MNRS), # BDP0(NL,MNRS),TPC(NL,MNRS),TMC(NL,MNRS),CP(NL,MNRS), # CM(NL,MNRS),FJVP0(NL,MNRS),BDM0(NL,MNRS), # STVPC(NL,MNRS),STVMC(NL,MNRS),BDMM(NL,MNRS), # BDMM0(NL,MNRS),BDM(NL,MNRS),SGPMC(NL,MNRS), # SGMMC(NL,MNRS),AKP(NL,MNRS),AKM(NL,MNRS), # Z1P(NL,MNRS),Z2P(NL,MNRS),Z1M(NL,MNRS),Z2M(NL,MNRS), # STV1P(NL,MNRS),STV2P(NL,MNRS),STV1M(NL,MNRS), # STV2M(NL,MNRS),FJVM0(NL,MNRS), # AHM(NL,MNRS),AHP(NL,MNRS),AKPM1(NL,MNRS) DIMENSION CPMAX(NL),AAC(NL),BAC(NL),AACP(NL),AACM(NL),BACP(NL), # BACM(NL),CACP(NL),CACM(NL),PIMAC(NL),FM2(NL), # STRU(8,NL,MNRS),STRUO(8,NL,MNRS),X1D(8,NL,MNRS), # X2D(8,NL,MNRS),XSD(8,NL,MNRS) * ACOLMAX= 179.D0*PI/180.D0 THPMIN= 1.D0*PI/180.D0 * FM2(1)= EM*EM FM2(2)= MM*MM FM2(3)= TLM*TLM * IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IFCURR= 1 ELSE IFCURR= IFMAX ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IFCURR= 1 ELSE IFCURR= IFMAX ENDIF ENDIF DO J=1,IFCURR IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN JP= 1 ELSE IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ENDIF * ZTH(J)= (THMAXR(JP)-THMINR(JP))*Z(3)+THMINR(JP) CPMAX(J)= COS(THMINPR(JP)) PIMAC(J)= PI-ACOLLR(JP) CZ2(J)= COS(ZTH(J)) AAC(J)= COS(ZTH(J)+ACOLLR(JP)) BAC(J)= COS(ZTH(J)-ACOLLR(JP)) CZ2P(J)= 1.D0+CZ2(J) CZ2M(J)= 1.D0-CZ2(J) AACP(J)= 1.D0+AAC(J) AACM(J)= 1.D0-AAC(J) BACP(J)= 1.D0+BAC(J) BACM(J)= 1.D0-BAC(J) CACP(J)= 1.D0+CPMAX(J) CACM(J)= 1.D0-CPMAX(J) * DO I=1,NRS ORS(I)= RS(I) RSS(I)= RS(I)*RS(I) ONE(J,I)= 1.D0 EPS(J,I)= S0CUT(JP,I)/RSS(I) * * 1/AKP AND AKM ARE COMPUTED * IF(ZTH(J).GT.PIMAC(J)) THEN AKM(J,I)= 0.D0 ELSE AKM(J,I)= SQRT(CZ2M(J)*AACP(J)/CZ2P(J)/AACM(J)) ENDIF * IF(ZTH(J).LT.ACOLLR(JP)) THEN AKP(J,I)= 0.D0 ELSE AKP(J,I)= SQRT(CZ2P(J)*BACM(J)/CZ2M(J)/BACP(J)) ENDIF * AHM(J,I)= SQRT(CZ2M(J)*CACM(J)/CZ2P(J)/CACP(J)) AHP(J,I)= SQRT(CZ2P(J)*CACM(J)/CZ2M(J)/CACP(J)) * AKM(J,I)= DMAX1(EPS(J,I),AKM(J,I),AHM(J,I)) AKPM1(J,I)= DMAX1(EPS(J,I),AKP(J,I),AHP(J,I)) AKP(J,I)= 1.D0/AKPM1(J,I) * * DIRECT SPACE (+) * XI2(J,I)= DMAX1(SQRT(EPS(J,I)/AKP(J,I)),EPS(J,I)) TP(J,I)= (1.D0/AKP(J,I)-EPS(J,I))*Z(1)+EPS(J,I) CP(J,I)= DMAX1(AKP(J,I)*TP(J,I),EPS(J,I)/TP(J,I)) TPC(J,I)= (1.D0-CP(J,I))*Z(2)+CP(J,I) Z1P(J,I)= (1.D0-XI2(J,I))*Z(1)+XI2(J,I) AP(J,I)= DMAX1(Z1P(J,I),EPS(J,I)/Z1P(J,I)) BP(J,I)= DMIN1(1.D0,AKP(J,I)*Z1P(J,I)) Z2P(J,I)= (BP(J,I)-AP(J,I))*Z(2)+AP(J,I) * * DIRECT SPACE (-) * CHI4(J,I)= DMAX1(SQRT(AKM(J,I)*EPS(J,I)),EPS(J,I)) TM(J,I)= (AKM(J,I)-EPS(J,I))*Z(2)+EPS(J,I) CM(J,I)= DMAX1(EPS(J,I)/TM(J,I),TM(J,I)/AKM(J,I)) TMC(J,I)= (1.D0-CM(J,I))*Z(1)+CM(J,I) Z2M(J,I)= (1.D0-CHI4(J,I))*Z(2)+CHI4(J,I) AM(J,I)= DMAX1(EPS(J,I)/Z2M(J,I),Z2M(J,I)) BM(J,I)= DMIN1(1.D0,Z2M(J,I)/AKM(J,I)) Z1M(J,I)= (BM(J,I)-AM(J,I))*Z(1)+AM(J,I) ENDDO ENDDO * IFM= IFCURR * LMX= 8 DO I=1,IFM DO J=1,NRS STRU(1,I,J)= TP(I,J) STRU(2,I,J)= TPC(I,J) STRU(3,I,J)= TM(I,J) STRU(4,I,J)= TMC(I,J) STRU(5,I,J)= Z1P(I,J) STRU(6,I,J)= Z2P(I,J) STRU(7,I,J)= Z1M(I,J) STRU(8,I,J)= Z2M(I,J) ENDDO ENDDO CALL TSTRUCFUN(LMX,NRS,IFM,STRU,STRUO) DO I=1,IFM DO J=1,NRS STVP(I,J)= STRUO(1,I,J) STVPC(I,J)= STRUO(2,I,J) STVM(I,J)= STRUO(3,I,J) STVMC(I,J)= STRUO(4,I,J) STV1P(I,J)= STRUO(5,I,J) STV2P(I,J)= STRUO(6,I,J) STV1M(I,J)= STRUO(7,I,J) STV2M(I,J)= STRUO(8,I,J) ENDDO ENDDO * KMX= 8 DO I=1,IFM DO J=1,NRS X1D(1,I,J)= TP(I,J) X2D(1,I,J)= TPC(I,J) X1D(2,I,J)= TP(I,J) X2D(2,I,J)= ONE(I,J) X1D(3,I,J)= TMC(I,J) X2D(3,I,J)= TM(I,J) X1D(4,I,J)= ONE(I,J) X2D(4,I,J)= TM(I,J) X1D(5,I,J)= Z1P(I,J) X2D(5,I,J)= Z2P(I,J) X1D(6,I,J)= Z1P(I,J) X2D(6,I,J)= ONE(I,J) X1D(7,I,J)= Z1M(I,J) X2D(7,I,J)= Z2M(I,J) X1D(8,I,J)= ONE(I,J) X2D(8,I,J)= Z2M(I,J) ENDDO ENDDO CALL TBORNDIFFM(KMX,NRS,IFM,ORS,X1D,X2D,ZTH,XSD) DO I=1,IFM DO J=1,NRS SGPMC(I,J)= XSD(1,I,J) SGPM(I,J)= XSD(2,I,J) SGMMC(I,J)= XSD(3,I,J) SGMM(I,J)= XSD(4,I,J) BDMP(I,J)= XSD(5,I,J) BDMP0(I,J)= XSD(6,I,J) BDMM(I,J)= XSD(7,I,J) BDMM0(I,J)= XSD(8,I,J) ENDDO ENDDO * CALL TBORNDIFF(NRS,IFM,ORS,Z1P,Z2P,ZTH,BDP) CALL TBORNDIFF(NRS,IFM,ORS,Z1P,ONE,ZTH,BDP0) CALL TBORNDIFF(NRS,IFM,ORS,Z1M,Z2M,ZTH,BDM) CALL TBORNDIFF(NRS,IFM,ORS,ONE,Z2M,ZTH,BDM0) * CALL TFJAC(NRS,IFM,Z1P,Z2P,ZTH,FJVP) CALL TFJAC(NRS,IFM,Z1P,ONE,ZTH,FJVP0) CALL TFJAC(NRS,IFM,Z1M,Z2M,ZTH,FJVM) CALL TFJAC(NRS,IFM,ONE,Z2M,ZTH,FJVM0) * DO J=1,IFCURR DO I=1,NRS IF(J.EQ.1) THEN JJ= 0 ELSE IF(J.EQ.2) THEN JJ= 2 ELSE IF(J.EQ.3) THEN JJ= 4 ENDIF IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN JP= 1 ELSE IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN JP= 2 ELSE IF(OINDX.EQ.'TA') THEN JP= 3 ENDIF ELSE JP= J ENDIF ENDIF * S0JI= S0CUT(JP,I) IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN FM2J= FM2(1) ELSE IF(OINDX.EQ.'MU') THEN FM2J= FM2(2) ELSE IF(OINDX.EQ.'TA') THEN FM2J= FM2(3) ENDIF ELSE FM2J= FM2(J) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN FM2J= FM2(2) ELSE IF(OINDX.EQ.'TA') THEN FM2J= FM2(3) ENDIF ELSE FM2J= FM2(J) ENDIF ENDIF * SZ1Z2PG= Z1P(J,I)*Z2P(J,I)*RSS(I) SZ1PG= Z1P(J,I)*RSS(I) SZ1Z2MG= Z1M(J,I)*Z2M(J,I)*RSS(I) SZ2MG= Z2M(J,I)*RSS(I) STPTPC= TP(J,I)*TPC(J,I)*RSS(I) STP= TP(J,I)*RSS(I) STMTMC= TM(J,I)*TMC(J,I)*RSS(I) STM= TM(J,I)*RSS(I) * F3P= (1.D0-XI2(J,I))*(BP(J,I)-AP(J,I))*STV1P(J,I)* # STV2P(J,I)*((BDMP(J,I)-FJVP(J,I)*BDP(J,I))* # TFSCFPB(JP,S0JI,SZ1Z2PG,FM2J)- # (BDMP0(J,I)-FJVP0(J,I)*BDP0(J,I))* # TFSCFPB(JP,S0JI,SZ1PG,FM2J)) F3M= (1.D0-CHI4(J,I))*(BM(J,I)-AM(J,I))*STV1M(J,I)* # STV2M(J,I)*((BDMM(J,I)-FJVM(J,I)*BDM(J,I))* # TFSCFPB(JP,S0JI,SZ1Z2MG,FM2J)- # (BDMM0(J,I)-FJVM0(J,I)*BDM0(J,I))* # TFSCFPB(JP,S0JI,SZ2MG,FM2J)) F3PC= (1.D0/AKP(J,I)-EPS(J,I))*(1.D0-CP(J,I))* # STVP(J,I)*STVPC(J,I)*(SGPMC(J,I)* # TFSCFPB(JP,S0JI,STPTPC,FM2J)-SGPM(J,I)* # TFSCFPB(JP,S0JI,STP,FM2J)) F3MC= (AKM(J,I)-EPS(J,I))*(1.D0-CM(J,I))*STVMC(J,I)* # STVM(J,I)*(SGMMC(J,I)* # TFSCFPB(JP,S0JI,STMTMC,FM2J)-SGMM(J,I)* # TFSCFPB(JP,S0JI,STM,FM2J)) * *-----THE INDEX I IS RUNNING OVER THE NOMINAL ENERGIES, WHILE J IS * 1 = E, 2 = MU, 3 = TAU. (F+B) AND (F-B) ARE STORED AS: * 1->NRS +E, NRS+1->2*NRS -E, 2*NRS+1->3*NRS +MU, * 3*NRS+1->4*NRS -MU, 4*NRS+1->5*NRS +TAU, 5*NRS+1->6*NRS -TAU * *-----CONTRIBUTIONS TO THE F+B XSECT. * F(JJ*NRS+I)= (F3P+F3PC+F3M+F3MC)*SIN(ZTH(J))*2.D0*PI * *-----CONTRIBUTIONS TO THE F-B XSECT. * IF(ZTH(J).LT.PI/2.D0) THEN F((JJ+1)*NRS+I)= F(JJ*NRS+I) ELSE F((JJ+1)*NRS+I)= -F(JJ*NRS+I) ENDIF * ENDDO ENDDO * RETURN END * *-----STRUCFUN-------------------------------------------------------- *-----SUBROUTINE QED MUST BE CALLED BEFORE SUBROUTINE STRUCFUN * SUBROUTINE TSTRUCFUN(LMX,NRS,IFM,X,STRVEC) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*1 OHC,ORAD,OCHAN,OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3) PARAMETER(NFL=4) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TCHAN/OCHAN COMMON/TSUP/OMODES COMMON/TPARAM/PI,PIS,DELTA COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION STRVEC(LMX,NL,MNRS),X(LMX,NL,MNRS) * DO L=1,LMX DO I=1,NRS DO J=1,IFM IF(X(L,J,I).GE.1.D0) THEN STRVEC(L,J,I)= 0.D0 ELSE BETA2= BETA(I)*BETA(I) BETA3= BETA2*BETA(I) OMX= 1.D0-X(L,J,I) OPX= 1.D0+X(L,J,I) XS= X(L,J,I) XD= X(L,J,I)*X(L,J,I) RLX= LOG(X(L,J,I)) RLX2= RLX*RLX RLOMX= LOG(OMX) RLOMX2= RLOMX*RLOMX OMXEX= OMX**(-1.D0+BETA(I)/2.D0) SOFTS= SDELTAP(I)*BETA(I)/2.D0*OMXEX SOFTS3= SDELTAP3(I)*BETA(I)/2.D0*OMXEX HARD1= -BETA(I)*OPX/4.D0 HARD2= BETA2/32.D0*(-5.D0-XS-4.D0*RLX/OMX+ # OPX*(-4.D0*RLOMX+3.D0*RLX)) IF(OHC.EQ.'Y'.AND.(ORAD.EQ.'F'.OR.ORAD.EQ.'Y')) THEN EPS= -1.D-37 RLI2X= TRSPENCE(XS,EPS) HARD3= BETA(I)**3/384.D0*(OPX*(3.D0*PIS- # 6.D0*RLI2X-12.D0*RLOMX2)+1.D0/OMX* # (-1.5D0*(1.D0+8.D0*XS+3.D0*XD) # *RLX-6.D0*(XS+5.D0)*OMX* # RLOMX-12.D0*(1.D0+XD)*RLOMX*RLX # +0.5D0*(1.D0+7.D0*XD)*RLX2 # -0.25D0*(39.D0-24.D0*XS-15.D0*XD))) ELSE HARD3= 0.D0 ENDIF IF(OCHAN.EQ.'F') THEN IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN IF(J.EQ.1) THEN STRVEC(L,J,I)= SOFTS+HARD1+HARD2 ELSE STRVEC(L,J,I)= SOFTS3+HARD1+HARD2+HARD3 ENDIF ELSE IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN STRVEC(L,J,I)= SOFTS+HARD1+HARD2 ELSE STRVEC(L,J,I)= SOFTS3+HARD1+HARD2+HARD3 ENDIF ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN STRVEC(L,J,I)= SOFTS3+HARD1+HARD2+HARD3 ELSE IF(OCHAN.EQ.'F'.AND.J.EQ.1) THEN STRVEC(L,J,I)= SOFTS+HARD1+HARD2 ELSE STRVEC(L,J,I)= SOFTS3+HARD1+HARD2+HARD3 ENDIF ENDIF ENDIF ELSE STRVEC(L,J,I)= SOFTS3+HARD1+HARD2+HARD3 ENDIF ENDIF ENDDO ENDDO ENDDO * RETURN END * *-----PDFUN------------------------------------------------------------ * PRIMITIVE OF THE STRUCTURE FUNCTION * SUBROUTINE QED MUST BE CALLED BEFORE SUBROUTINE PDFUN * SUBROUTINE TPDFUN(LMX,NRS,IFM,Z,PDFVEC) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*1 OHC,ORAD,OCHAN,OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3) PARAMETER(NFL=4) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TSUP/OMODES COMMON/TCHAN/OCHAN COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION PDFVEC(LMX,NL,MNRS),Z(LMX,NL,MNRS) DO L=1,LMX DO I=1,NRS DO J=1,IFM BETA2= BETA(I)*BETA(I) BETA3= BETA2*BETA(I) Z2= Z(L,J,I)*Z(L,J,I) IF(Z(L,J,I).EQ.0.D0) THEN SOFTS= 1.D0 HARD1= -3.D0/8.D0 HARD2= -9.D0/128.D0+PIS/48.D0 IF(OHC.EQ.'Y'.AND.ORAD.EQ.'F') THEN HARD3= -9.D0/1024.D0+PIS/128.D0-RZ3/24.D0 ELSE HARD3= 0.D0 ENDIF ELSE IF(Z(L,J,I).GE.1.D0) THEN SOFTS= 0.D0 HARD1= 0.D0 HARD2= 0.D0 HARD3= 0.D0 ELSE EPSM= -1.D-37 ZA= Z(L,J,I) RLZ= LOG(ZA) RLZ2= RLZ*RLZ OMZ= 1.D0-ZA RLOMZ= LOG(OMZ) RLOMZ2= RLOMZ**2 CALL TPOLYL(ZA,OMZ,S11,S12,S13,S21,S22) SOFTS= OMZ**(BETA(I)/2.D0) HARD1= 0.25D0*(-1.5D0+ZA+Z2/2.D0) HARD2= 1.D0/32.D0*(-9.D0/4.D0+4.D0*PIS/6.D0 # +2.D0*(-3.D0+2.D0*ZA+Z2)*RLOMZ- # 4.D0*RLZ*RLOMZ-4.D0*S11-3.D0*(ZA+Z2/2.D0)* # RLZ+2.D0*ZA+Z2/4.D0) IF(OHC.EQ.'Y'.AND.(ORAD.EQ.'F'.OR.ORAD.EQ.'Y')) THEN HARD3= -27.D0/8.D0+3.D0*PIS-16.D0*RZ3+ZA*(7.D0/4.D0 # +13.D0/8.D0*ZA)-1.5D0*PIS*ZA*(2.D0+ZA) # +3.D0*RLOMZ*(-4.5D0+4.D0*ZA+0.5D0*Z2) # -6.D0*RLOMZ2*(3.D0-2.D0*ZA-Z2) # -ZA*RLZ*(5.5D0+ZA) # -RLZ*RLOMZ*(12.D0*ZA+6.D0*Z2+12.D0*RLOMZ) # +RLZ2*(3.5D0*ZA+7.D0/4.D0*Z2+4.D0*RLOMZ) # +S11*(6.D0*ZA+3.D0*Z2+8.D0*RLZ) # -8.D0*S21+24.D0*S12 HARD3= HARD3/64.D0/6.D0 ELSE HARD3= 0.D0 ENDIF ENDIF * IF(OCHAN.EQ.'F') THEN IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'N') THEN IF(J.EQ.1) THEN PDFVEC(L,J,I)= SDELTAP(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2 ELSE PDFVEC(L,J,I)= SDELTAP3(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2+BETA3*HARD3 ENDIF ELSE IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN PDFVEC(L,J,I)= SDELTAP(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2 ELSE PDFVEC(L,J,I)= SDELTAP3(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2+BETA3*HARD3 ENDIF ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN PDFVEC(L,J,I)= SDELTAP3(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2+BETA3*HARD3 ELSE IF(OCHAN.EQ.'F'.AND.J.EQ.1) THEN PDFVEC(L,J,I)= SDELTAP(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2 ELSE PDFVEC(L,J,I)= SDELTAP3(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2+BETA3*HARD3 ENDIF ENDIF ENDIF ELSE PDFVEC(L,J,I)= SDELTAP3(I)*SOFTS+BETA(I)*HARD1+ # BETA2*HARD2+BETA3*HARD3 ENDIF ENDDO ENDDO ENDDO * RETURN END * *-----BORNDIFF---------------------------------------------------- * UPDATED DECEMBER 98 WITH NLO. * SUBROUTINE TBORNDIFF(NRS,IFM,ORS,X1,X2,THETA,OSIGDIFF) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 MM2,NM2 * PARAMETER(MNRS=30,NL=3) * COMMON/TNAL/ODA COMMON/TICOUPLING/NF COMMON/TTCHANN/IT(NL) COMMON/TIMAG/PGGFI(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION OSIGDIFF(NL,MNRS),ORS(MNRS),X1(NL,MNRS), # X2(NL,MNRS),THETA(NL) * GW= GF*ZM2*XX(1,4) FPI= 4.D0*PI GRED= WT/SQRT(ZM2) CFACTZ= CSAL(5,1)*CSAL(5,1)+CSAL(5,2)*LOG(ABS(CSAL(5,3))/ZM2)+ # (CSAL(5,4)+ALSTZ*CSAL(5,5))*ZM2/TQM2 CFACTZ= 1.D0-(CFACTZ+ODA) AIPGGFZ= ALPHA/4.D0/PI*PGGFI(NRS) DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ SALZ= ALPHA*CFACTZ/DENAZ SALIZ= ALPHA*AIPGGFZ/DENAZ SAL2Z= SALZ*SALZ+SALIZ*SALIZ RSSZ= STR2+(SALZ/FPI-AEXPHZ)*XX(NRS,8)+ # ((SALZ*SALZ-XX(NRS,2)*XX(NRS,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(NRS,9) REVSZ= 4.D0*RSSZ-1.D0 AIVSZ= 4.D0*XX(NRS,6) RV2SZ= REVSZ*REVSZ-AIVSZ*AIVSZ REVS2Z= REVSZ*REVSZ VS2Z= REVSZ*REVSZ+AIVSZ*AIVSZ OPVS2Z= 1.D0+VS2Z EG2= GWEAK*RHOEFF(1) EG4= EG2*EG2 ERVE= -0.5D0+2.D0*ST2EFF(1) EVI= VIM(1) EAI= AIM(1) FI3= -0.5D0 ERVAE= ERVE*ERVE+0.25D0+EVI*EVI+EAI*EAI VEZZI= VIM(1) * DO J=1,NRS RS= ORS(J) DO I=1,IFM * *-----THE REDUCED INVARIANTS * EBEAM= RS/2.D0 XP= X1(I,J)+X2(I,J) XM= X1(I,J)-X2(I,J) EONE= EBEAM/2.D0*(XP*XP-XM*XM)/(XP-XM*COS(THETA(I))) S= X1(I,J)*X2(I,J)*RS*RS XRS= SQRT(S) T= -2.D0*X1(I,J)*EBEAM*EONE*(1.D0-COS(THETA(I))) XRT= SQRT(ABS(T)) S2= S*S IF(XRT.LT.10.D0) THEN JX= 1 ELSE IF(XRT.GT.10.D0.AND.XRT.LT.30.D0) THEN JX= 2 ELSE IF(XRT.GT.30.D0.AND.XRT.LT.50.D0) THEN JX= 3 ELSE IF(XRT.GT.50.D0.AND.XRT.LT.70.D0) THEN JX= 4 ELSE IF(XRT.GT.70.D0) THEN JX= 5 ENDIF A1= CTAL(JX,1) A2= CTAL(JX,2) A3= CTAL(JX,3) A4= CTAL(JX,4) A5= CTAL(JX,5) * *-----COMPUTES THE RUNNING ALPHA IN S-CHANNEL * IF(XRS.LT.10.D0) THEN JX= 1 ELSE IF(XRS.GT.10.D0.AND.XRS.LT.30.D0) THEN JX= 2 ELSE IF(XRS.GT.30.D0.AND.XRS.LT.50.D0) THEN JX= 3 ELSE IF(XRS.GT.50.D0.AND.XRS.LT.70.D0) THEN JX= 4 ELSE IF(XRS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(J) DENA= CFACT*CFACT+AIPGGF*AIPGGF SAL= ALPHA*CFACT/DENA SALI= ALPHA*AIPGGF/DENA SAL2= SAL*SAL+SALI*SALI * *-----COMPUTES AUXILIARY TERMS FOR S-CHANNEL * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE S-CHANNEL * RSS= STR2+(SAL/FPI-AEXPHZ)*XX(J,8)+ # ((SAL*SAL-XX(J,2)*XX(J,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(J,9) REVS= 4.D0*RSS-1.D0 AIVS= 4.D0*XX(J,6) RV2S= REVS*REVS-AIVS*AIVS REVS2= REVS*REVS VS2= REVS*REVS+AIVS*AIVS OPVS2= 1.D0+VS2 U= -S-T DP= (T*T+U*U)/S2 DM= (T*T-U*U)/S2 SAM= S-ZM2 SAM2= SAM*SAM DEN= SAM2+S2*GRED*GRED RCHIS= SAM/DEN AICHIS= -S/DEN*GRED CHIS2= S/DEN RCHISZ= 0.D0 AICHISZ= -ZM2/DEN*GRED CHIS2Z= ZM2/DEN RACCZ= AICHISZ*SALIZ ACCZI= AICHISZ*SALZ * *-----COMPUTES THE S CONTRIBUTIONS TO X-SECT * CS1= 128.D0*PIS*SAL2*DP*(1.D0+2.D0*XX(J,10))/S CS7= 32.D0*PI*GW*RCHIS*(SAL*(DP*RV2S-DM)+2.D0*XX(J,2)* # REVS*AIVS*DP+SAL*(DP*XX(J,17)+DM*XX(J,18))) CS10= 2.D0*GW*GW*CHIS2*(DP*OPVS2*OPVS2-4.D0*DM*REVS2+ # 2.D0*(DP*XX(J,21)+DM*XX(J,22)))- # 2.D0*GW*GW*CHIS2Z*(DP*OPVS2Z*OPVS2Z-4.D0*DM*REVS2Z+ # 2.D0*(DP*XX(NRS,21)+DM*XX(NRS,22))) CS11= 32.D0*PI*GW*AICHIS*(XX(J,2)*(DP*RV2S-DM) # -2.D0*SAL*REVS*AIVS*DP+SAL*(DP*XX(J,24)+ # DM*XX(J,25)))- # 32.D0*PI*GW*AICHISZ*(XX(NRS,2)*(DP*RV2SZ-DM) # -2.D0*SALZ*REVSZ*AIVSZ*DP+SALZ*(DP*XX(NRS,24)+ # DM*XX(NRS,25))) SCCS= CS1+CS7+CS10+CS11 * SVVZ= EG4/PI*CHIS2Z*ERVAE*(ERVE*ERVE+EVI*EVI) SAAZ= EG4/PI*CHIS2Z*ERVAE*(0.25D0+EAI*EAI) SVAZ= -2.D0*EG4/PI*CHIS2Z*( # ERVE*EAI*EVI-2.D0*ERVE*AIM(1)*VIM(1)*FI3+ # FI3*ERVE*ERVE-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+4.D0*EG2*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*ACCZI) SEVZ= -4.D0*EG2*(RACCZ*(VEZZI*VEZZI-ERVE*ERVE)+ # 2.D0*ACCZI*ERVE*VEZZI) SVVZ= SVVZ+SEVZ * IF(IT(I).EQ.0) THEN TCCS= 0.D0 ELSE * *-----COMPUTES ALPHA_(T) RUNNING IN T-CHANNEL * TAL= A1*A1+A2*LOG(ABS(A3/T))+(A4+ALSTZ*A5)* # ABS(T)/TQM2 TAL= ALPHA/(1.D0-(TAL+ODA)) TAL2= TAL*TAL * *-----COMPUTES AUXILIARY TERMS FOR T-CHANNEL * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE T-CHANNEL * RST= STR2+(TAL/FPI-AEXPHZ)*XX(J,8)+ # (TAL*TAL/FPI/FPI-AEXPHZ*AEXPHZ)*XX(J,9) VT= 4.D0*RST-1.D0 VT2= VT*VT S2= S*S T2= T*T U2= U*U FP= (S2+U2)/S2 FM= (S2-U2)/S2 SAMT= T-ZM2 CHIT= 1.D0/SAMT CHIT2= S/(SAMT*SAMT) * *-----COMPUTES THE T AND S-T CONTRIBUTIONS TO X-SECT * PIA= 32.D0*PI PIB= 4.D0*PIA*PI U2R= U2/S2 CS2= 2.D0*PIB*SAL*TAL*U2/S2/T*(1.D0+XX(J,10)+ # XX(J,11)) CS3= PIB*TAL2*(U2+S2)/S/T2*(1.D0+2.D0*XX(J,11)) CS4= PIA*GW*SAL*CHIT*U2R*(1.D0+VT2+XX(J,12)) CS5= PIA*GW*TAL*CHIT*S/T*(FP*VT2-FM+FP*XX(J,13)+ # FM*XX(J,14)) CS6= 2.D0*GW*GW*CHIT2*(FP*(1.D0+VT2)*(1.D0+VT2) # -4.D0*FM*VT2+2.D0*(FP*XX(J,15)+FM*XX(J,16))) CS8= PIA*GW*TAL*U2/S/T*RCHIS*(1.D0+RV2S+XX(J,19)) CS9= 4.D0*GW*GW*RCHIS*CHIT*S*U2R*((1.D0+VT2) # *(1.D0+RV2S)+4.D0*VT*REVS+XX(J,20)) CS12= GW*AICHIS*(PIA*TAL*U2/S/T*(-2.D0*REVS # *AIVS+2.D0*XX(J,23))+4.D0*GW*S*CHIT*U2R* # (-4.D0*AIVS*VT-2.D0*AIVS*REVS-2.D0*AIVS* # REVS*VT2+2.D0*XX(J,26))) TCCS= CS2+CS3+CS4+CS5+CS6+CS8+CS9+CS12 ENDIF * OSIGDIFF(I,J)= CONV*(SCCS+TCCS)/256.D0/PIS+ # CONV/8.D0/PI*((SVVZ+SAAZ)*DP- # SVAZ*DM) ENDDO ENDDO * RETURN END * *-----BORNDIFFM-------------------------------------------------------- * UPDATED DECEMBER 98 WITH NLO. * SUBROUTINE TBORNDIFFM(LMX,NRS,IFM,ORS,X1,X2,THETA,OSIGDIFF) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 MM2,NM2 * PARAMETER(MNRS=30,NL=3) * COMMON/TNAL/ODA COMMON/TICOUPLING/NF COMMON/TTCHANN/IT(NL) COMMON/TIMAG/PGGFI(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION OSIGDIFF(LMX,NL,MNRS),ORS(MNRS),X1(LMX,NL,MNRS), # X2(LMX,NL,MNRS),THETA(NL) * GW= GF*ZM2*XX(1,4) FPI= 4.D0*PI GRED= WT/SQRT(ZM2) * CFACTZ= CSAL(5,1)*CSAL(5,1)+CSAL(5,2)*LOG(ABS(CSAL(5,3))/ZM2)+ # (CSAL(5,4)+ALSTZ*CSAL(5,5))*ZM2/TQM2 CFACTZ= 1.D0-(CFACTZ+ODA) AIPGGFZ= ALPHA/4.D0/PI*PGGFI(NRS) DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ SALZ= ALPHA*CFACTZ/DENAZ SALIZ= ALPHA*AIPGGFZ/DENAZ SAL2Z= SALZ*SALZ+SALIZ*SALIZ RSSZ= STR2+(SALZ/FPI-AEXPHZ)*XX(NRs,8)+ # ((SALZ*SALZ-XX(NRS,2)*XX(NRS,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(NRS,9) REVSZ= 4.D0*RSSZ-1.D0 AIVSZ= 4.D0*XX(NRS,6) RV2SZ= REVSZ*REVSZ-AIVSZ*AIVSZ REVS2Z= REVSZ*REVSZ VS2Z= REVSZ*REVSZ+AIVSZ*AIVSZ OPVS2Z= 1.D0+VS2Z EG2= GWEAK*RHOEFF(1) EG4= EG2*EG2 ERVE= -0.5D0+2.D0*ST2EFF(1) EVI= VIM(1) EAI= AIM(1) FI3= -0.5D0 ERVAE= ERVE*ERVE+0.25D0+EVI*EVI+EAI*EAI VEZZI= VIM(1) * DO L=1,LMX DO J=1,NRS RS= ORS(J) DO I=1,IFM * *-----THE REDUCED INVARIANTS * S= X1(L,I,J)*X2(L,I,J)*RS*RS XRS= SQRT(S) T= -S/2.D0*(1.D0-COS(THETA(I))) XRT= SQRT(ABS(T)) S2= S*S IF(XRT.LT.10.D0) THEN JX= 1 ELSE IF(XRT.GT.10.D0.AND.XRT.LT.30.D0) THEN JX= 2 ELSE IF(XRT.GT.30.D0.AND.XRT.LT.50.D0) THEN JX= 3 ELSE IF(XRT.GT.50.D0.AND.XRT.LT.70.D0) THEN JX= 4 ELSE IF(XRT.GT.70.D0) THEN JX= 5 ENDIF A1= CTAL(JX,1) A2= CTAL(JX,2) A3= CTAL(JX,3) A4= CTAL(JX,4) A5= CTAL(JX,5) * *-----COMPUTES THE RUNNING ALPHA * IF(XRS.LT.10.D0) THEN JX= 1 ELSE IF(XRS.GT.10.D0.AND.XRS.LT.30.D0) THEN JX= 2 ELSE IF(XRS.GT.30.D0.AND.XRS.LT.50.D0) THEN JX= 3 ELSE IF(XRS.GT.50.D0.AND.XRS.LT.70.D0) THEN JX= 4 ELSE IF(XRS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(J) DENA= CFACT*CFACT+AIPGGF*AIPGGF SAL= ALPHA*CFACT/DENA SALI= ALPHA*AIPGGF/DENA SAL2= SAL*SAL+SALI*SALI * *-----COMPUTES AUXILIARY TERMS * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE S-CHANNEL * RSS= STR2+(SAL/FPI-AEXPHZ)*XX(J,8)+ # ((SAL*SAL-XX(J,2)*XX(J,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(J,9) REVS= 4.D0*RSS-1.D0 REVS2= REVS*REVS AIVS= 4.D0*XX(J,6) RV2S= REVS2-AIVS*AIVS VS2= REVS2+AIVS*AIVS OPVS2= 1.D0+VS2 U= -S-T DP= (T*T+U*U)/S2 DM= (T*T-U*U)/S2 SAM= S-ZM2 SAM2= SAM*SAM DEN= SAM2+S2*GRED*GRED RCHIS= SAM/DEN AICHIS= -S/DEN*GRED CHIS2= S/DEN RCHISZ= 0.D0 AICHISZ= -ZM2/DEN*GRED CHIS2Z= ZM2/DEN RACCZ= AICHISZ*SALIZ ACCZI= AICHISZ*SALZ * *-----COMPUTES THE S CONTRIBUTIONS TO X-SECT * CS1= 128.D0*PIS*SAL2*DP*(1.D0+2.D0*XX(J,10))/S CS7= 32.D0*PI*GW*RCHIS*(SAL*(DP*RV2S-DM)+2.D0*XX(J,2)* # REVS*AIVS*DP+SAL*(DP*XX(J,17)+DM*XX(J,18))) CS10= 2.D0*GW*GW*CHIS2*(DP*OPVS2*OPVS2-4.D0*DM*REVS2+ # 2.D0*(DP*XX(J,21)+DM*XX(J,22)))- # 2.D0*GW*GW*CHIS2Z*(DP*OPVS2Z*OPVS2Z-4.D0*DM*REVS2Z+ # 2.D0*(DP*XX(NRS,21)+DM*XX(NRS,22))) CS11= 32.D0*PI*GW*AICHIS*(XX(J,2)*(DP*RV2S-DM) # -2.D0*SAL*REVS*AIVS*DP+SAL*(DP*XX(J,24)+ # DM*XX(J,25)))- # 32.D0*PI*GW*AICHISZ*(XX(NRS,2)*(DP*RV2SZ-DM) # -2.D0*SALZ*REVSZ*AIVSZ*DP+SALZ*(DP*XX(NRS,24)+ # DM*XX(NRS,25))) SCCS= CS1+CS7+CS10+CS11 * SVVZ= EG4/PI*CHIS2Z*ERVAE*(ERVE*ERVE+EVI*EVI) SAAZ= EG4/PI*CHIS2Z*ERVAE*(0.25D0+EAI*EAI) SVAZ= -2.D0*EG4/PI*CHIS2Z*( # ERVE*EAI*EVI-2.D0*ERVE*AIM(1)*VIM(1)*FI3+ # FI3*ERVE*ERVE-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+4.D0*EG2*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*ACCZI) SEVZ= -4.D0*EG2*(RACCZ*(VEZZI*VEZZI-ERVE*ERVE)+ # 2.D0*ACCZI*ERVE*VEZZI) SVVZ= SVVZ+SEVZ * IF(IT(I).EQ.0) THEN TCCS= 0.D0 ELSE * *-----COMPUTES ALPHA_(T) RUNNING IN T-CHANNEL * TAL= A1*A1+A2*LOG(ABS(A3/T))+(A4+ALSTZ*A5)* # ABS(T)/TQM2 TAL= ALPHA/(1.D0-(TAL+ODA)) TAL2= TAL*TAL * *-----COMPUTES AUXILIARY TERMS FOR T-CHANNEL * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE T-CHANNEL * RST= STR2+(TAL/FPI-AEXPHZ)*XX(J,8)+ # (TAL*TAL/FPI/FPI-AEXPHZ*AEXPHZ)*XX(J,9) VT= 4.D0*RST-1.D0 VT2= VT*VT S2= S*S T2= T*T U2= U*U FP= (S2+U2)/S2 FM= (S2-U2)/S2 SAMT= T-ZM2 CHIT= 1.D0/SAMT CHIT2= S/(SAMT*SAMT) * *-----COMPUTES THE T AND S-T CONTRIBUTIONS TO X-SECT * CS2= 256.D0*PIS*SAL*TAL*U2/S2/T*(1.D0+XX(J,10)+ # XX(J,11)) CS3= 128.D0*PIS*TAL2*(U2+S2)/S/T2* # (1.D0+2.D0*XX(J,11)) CS4= 32.D0*PI*GW*SAL*CHIT*U2/S2*(1.D0+VT2+XX(J,12)) CS5= 32.D0*PI*GW*TAL*CHIT*S/T*(FP*VT2-FM+FP*XX(J,13)+ # FM*XX(J,14)) CS6= 2.D0*GW*GW*CHIT2*(FP*(1.D0+VT2)*(1.D0+VT2) # -4.D0*FM*VT2+2.D0*(FP*XX(J,15)+FM*XX(J,16))) CS8= 32.D0*PI*GW*TAL*U2/S/T*RCHIS*(1.D0+RV2S+XX(J,19)) CS9= 4.D0*GW*GW*RCHIS*CHIT*S*U2/S2*((1.D0+VT2) # *(1.D0+RV2S)+4.D0*VT*REVS+XX(J,20)) CS12= GW*AICHIS*(32.D0*PI*TAL*U2/S/T*(-2.D0*REVS # *AIVS+2.D0*XX(J,23))+4.D0*GW*S*CHIT*U2/S2* # (-4.D0*AIVS*VT-2.D0*AIVS*REVS-2.D0*AIVS* # REVS*VT2+2.D0* # XX(J,26))) TCCS= CS2+CS3+CS4+CS5+CS6+CS8+CS9+CS12 ENDIF * OSIGDIFF(L,I,J)= CONV*(SCCS+TCCS)/256.D0/PIS+ # CONV/8.D0/PI*((SVVZ+SAAZ)*DP- # SVAZ*DM) ENDDO ENDDO ENDDO * RETURN END * *-----BRNDINT-------------------------------------------------------- * UPDATED DECEMBER 98 WITH NLO. * SUBROUTINE TBRNDINT(NRS,IFM,ORS,THETA,OSIGDIFF) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 MM2,NM2 * PARAMETER(MNRS=30,NL=3) * COMMON/TNAL/ODA COMMON/TICOUPLING/NF COMMON/TTCHANN/IT(NL) COMMON/TIMAG/PGGFI(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION OSIGDIFF(NL,MNRS),ORS(MNRS),X1(NL,MNRS),X2(NL,MNRS), # THETA(NL) * GW= GF*ZM2*XX(1,4) FPI= 4.D0*PI GRED= WT/SQRT(ZM2) CFACTZ= CSAL(5,1)*CSAL(5,1)+CSAL(5,2)*LOG(ABS(CSAL(5,3))/ZM2)+ # (CSAL(5,4)+ALSTZ*CSAL(5,5))*ZM2/TQM2 CFACTZ= 1.D0-(CFACTZ+ODA) AIPGGFZ= ALPHA/4.D0/PI*PGGFI(NRS) DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ SALZ= ALPHA*CFACTZ/DENAZ SALIZ= ALPHA*AIPGGFZ/DENAZ SAL2Z= SALZ*SALZ+SALIZ*SALIZ RSSZ= STR2+(SALZ/FPI-AEXPHZ)*XX(NRS,8)+ # ((SALZ*SALZ-XX(NRS,2)*XX(NRS,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(NRS,9) REVSZ= 4.D0*RSSZ-1.D0 AIVSZ= 4.D0*XX(NRS,6) RV2SZ= REVSZ*REVSZ-AIVSZ*AIVSZ REVS2Z= REVSZ*REVSZ VS2Z= REVSZ*REVSZ+AIVSZ*AIVSZ OPVS2Z= 1.D0+VS2Z EG2= GWEAK*RHOEFF(1) EG4= EG2*EG2 ERVE= -0.5D0+2.D0*ST2EFF(1) EVI= VIM(1) EAI= AIM(1) FI3= -0.5D0 ERVAE= ERVE*ERVE+0.25D0+EVI*EVI+EAI*EAI VEZZI= VIM(1) * DO J=1,NRS RS= ORS(J) DO I=1,IFM * *-----THE REDUCED INVARIANTS * S= X1(I,J)*X2(I,J)*RS*RS XRS= SQRT(S) T= -S/2.D0*(1.D0-COS(THETA(I))) XRT= SQRT(ABS(T)) S2= S*S IF(XRT.LT.10.D0) THEN JX= 1 ELSE IF(XRT.GT.10.D0.AND.XRT.LT.30.D0) THEN JX= 2 ELSE IF(XRT.GT.30.D0.AND.XRT.LT.50.D0) THEN JX= 3 ELSE IF(XRT.GT.50.D0.AND.XRT.LT.70.D0) THEN JX= 4 ELSE IF(XRT.GT.70.D0) THEN JX= 5 ENDIF A1= CTAL(JX,1) A2= CTAL(JX,2) A3= CTAL(JX,3) A4= CTAL(JX,4) A5= CTAL(JX,5) * *-----COMPUTES THE RUNNING ALPHA * IF(XRS.LT.10.D0) THEN JX= 1 ELSE IF(XRS.GT.10.D0.AND.XRS.LT.30.D0) THEN JX= 2 ELSE IF(XRS.GT.30.D0.AND.XRS.LT.50.D0) THEN JX= 3 ELSE IF(XRS.GT.50.D0.AND.XRS.LT.70.D0) THEN JX= 4 ELSE IF(XRS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(J) DENA= CFACT*CFACT+AIPGGF*AIPGGF SAL= ALPHA*CFACT/DENA SALI= ALPHA*AIPGGF/DENA SAL2= SAL*SAL+SALI*SALI * *-----COMPUTES AUXILIARY TERMS * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE S-CHANNEL * RSS= STR2+(SAL/FPI-AEXPHZ)*XX(J,8)+ # ((SAL*SAL-XX(J,2)*XX(J,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(J,9) REVS= 4.D0*RSS-1.D0 REVS2= REVS*REVS AIVS= 4.D0*XX(J,6) RV2S= REVS2-AIVS*AIVS VS2= REVS2+AIVS*AIVS OPVS2= 1.D0+VS2 U= -S-T DP= (T*T+U*U)/S2 DM= (T*T-U*U)/S2 SAM= S-ZM2 SAM2= SAM*SAM DEN= SAM2+S2*GRED*GRED RCHIS= SAM/DEN AICHIS= -S/DEN*GRED CHIS2= S/DEN RCHISZ= 0.D0 AICHISZ= -ZM2/DEN*GRED CHIS2Z= ZM2/DEN RACCZ= AICHISZ*SALIZ ACCZI= AICHISZ*SALZ * *-----COMPUTES THE S CONTRIBUTIONS TO X-SECT * CS1= 128.D0*PIS*SAL2*DP*(1.D0+2.D0*XX(J,10))/S CS7= 32.D0*PI*GW*RCHIS*(SAL*(DP*RV2S-DM)+2.D0*XX(J,2)* # REVS*AIVS*DP+SAL*(DP*XX(J,17)+DM*XX(J,18))) CS10= 2.D0*GW*GW*CHIS2*(DP*OPVS2*OPVS2-4.D0*DM*REVS2+ # 2.D0*(DP*XX(J,21)+DM*XX(J,22)))- # 2.D0*GW*GW*CHIS2Z*(DP*OPVS2Z*OPVS2Z-4.D0*DM*REVS2Z+ # 2.D0*(DP*XX(NRS,21)+DM*XX(NRS,22))) CS11= 32.D0*PI*GW*AICHIS*(XX(J,2)*(DP*RV2S-DM) # -2.D0*SAL*REVS*AIVS*DP+SAL*(DP*XX(J,24)+ # DM*XX(J,25)))- # 32.D0*PI*GW*AICHISZ*(XX(NRS,2)*(DP*RV2SZ-DM) # -2.D0*SALZ*REVSZ*AIVSZ*DP+SALZ*(DP*XX(NRS,24)+ # DM*XX(NRS,25))) SCCS= CS1+CS7+CS10+CS11 * SVVZ= EG4/PI*CHIS2Z*ERVAE*(ERVE*ERVE+EVI*EVI) SAAZ= EG4/PI*CHIS2Z*ERVAE*(0.25D0+EAI*EAI) SVAZ= -2.D0*EG4/PI*CHIS2Z*( # ERVE*EAI*EVI-2.D0*ERVE*AIM(1)*VIM(1)*FI3+ # FI3*ERVE*ERVE-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+4.D0*EG2*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*ACCZI) SEVZ= -4.D0*EG2*(RACCZ*(VEZZI*VEZZI-ERVE*ERVE)+ # 2.D0*ACCZI*ERVE*VEZZI) SVVZ= SVVZ+SEVZ * IF(IT(I).EQ.0) THEN TCCS= 0.D0 ELSE * *-----COMPUTES ALPHA_(T) RUNNING IN T-CHANNEL * TAL= A1*A1+A2*LOG(ABS(A3/T))+(A4+ALSTZ*A5)* # ABS(T)/TQM2 TAL= ALPHA/(1.D0-(TAL+ODA)) TAL2= TAL*TAL * *-----COMPUTES AUXILIARY TERMS FOR T-CHANNEL * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE T-CHANNEL * RST= STR2+(TAL/FPI-AEXPHZ)*XX(J,8)+ # (TAL*TAL/FPI/FPI-AEXPHZ*AEXPHZ)*XX(J,9) VT= 4.D0*RST-1.D0 VT2= VT*VT S2= S*S T2= T*T U2= U*U FP= (S2+U2)/S2 FM= (S2-U2)/S2 SAMT= T-ZM2 CHIT= 1.D0/SAMT CHIT2= S/(SAMT*SAMT) * *-----COMPUTES THE T AND S-T CONTRIBUTIONS TO X-SECT * CS2= 256.D0*PIS*SAL*TAL*U2/S2/T*(1.D0+XX(J,10)+ # XX(J,11)) CS3= 128.D0*PIS*TAL2*(U2+S2)/S/T2*(1.D0+2.D0*XX(J,11)) CS4= 32.D0*PI*GW*SAL*CHIT*U2/S2*(1.D0+VT2+XX(J,12)) CS5= 32.D0*PI*GW*TAL*CHIT*S/T*(FP*VT2-FM+FP*XX(J,13)+ # FM*XX(J,14)) CS6= 2.D0*GW*GW*CHIT2*(FP*(1.D0+VT2)*(1.D0+VT2) # -4.D0*FM*VT2+2.D0*(FP*XX(J,15)+FM*XX(J,16))) CS8= 32.D0*PI*GW*TAL*U2/S/T*RCHIS*(1.D0+RV2S+XX(J,19)) CS9= 4.D0*GW*GW*RCHIS*CHIT*U2/S*((1.D0+VT2) # *(1.D0+RV2S)+4.D0*VT*REVS+XX(J,20)) CS12= GW*AICHIS*(32.D0*PI*TAL*U2/S/T*(-2.D0*REVS # *AIVS+2.D0*XX(J,23))+4.D0*GW*CHIT*U2/S*(-4.D0* # AIVS*VT-2.D0*AIVS*REVS-2.D0*AIVS*REVS*VT2+2.D0* # XX(J,26))) TCCS= CS2+CS3+CS4+CS5+CS6+CS8+CS9+CS12 ENDIF * OSIGDIFF(I,J)= CONV*(SCCS+TCCS)/256.D0/PIS+ # CONV/8.D0/PI*((SVVZ+SAAZ)*DP- # SVAZ*DM) ENDDO ENDDO * RETURN END * *-----BRNDFFMR-------------------------------------------------------- * UPDATED DECEMBER 98 WITH NLO. * SUBROUTINE TBRNDFFMR(NRS,IFM,ORS,X1,X2,THETA,OSIGDIFF) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 MM2,NM2 * PARAMETER(MNRS=30,NL=3) * COMMON/TNAL/ODA COMMON/TICOUPLING/NF COMMON/TTCHANN/IT(NL) COMMON/TIMAG/PGGFI(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION OSIGDIFF(NL,MNRS),ORS(MNRS),X1(NL,MNRS),X2(NL,MNRS), # THETA(NL) * GW= GF*ZM2*XX(1,4) FPI= 4.D0*PI GRED= WT/SQRT(ZM2) CFACTZ= CSAL(5,1)*CSAL(5,1)+CSAL(5,2)*LOG(ABS(CSAL(5,3))/ZM2)+ # (CSAL(5,4)+ALSTZ*CSAL(5,5))*ZM2/TQM2 CFACTZ= 1.D0-(CFACTZ+ODA) AIPGGFZ= ALPHA/4.D0/PI*PGGFI(NRS) DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ SALZ= ALPHA*CFACTZ/DENAZ SALIZ= ALPHA*AIPGGFZ/DENAZ SAL2Z= SALZ*SALZ+SALIZ*SALIZ RSSZ= STR2+(SALZ/FPI-AEXPHZ)*XX(NRS,8)+ # ((SALZ*SALZ-XX(NRS,2)*XX(NRS,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(NRS,9) REVSZ= 4.D0*RSSZ-1.D0 AIVSZ= 4.D0*XX(NRS,6) RV2SZ= REVSZ*REVSZ-AIVSZ*AIVSZ REVS2Z= REVSZ*REVSZ VS2Z= REVSZ*REVSZ+AIVSZ*AIVSZ OPVS2Z= 1.D0+VS2Z EG2= GWEAK*RHOEFF(1) EG4= EG2*EG2 ERVE= -0.5D0+2.D0*ST2EFF(1) EVI= VIM(1) EAI= AIM(1) FI3= -0.5D0 ERVAE= ERVE*ERVE+0.25D0+EVI*EVI+EAI*EAI VEZZI= VIM(1) * DO J=1,NRS RS= ORS(J) DO I=1,IFM * *-----THE REDUCED INVARIANTS * S= X1(I,J)*X2(I,J)*RS*RS XRS= SQRT(S) T= -S/2.D0*(1.D0-COS(THETA(I))) XRT= SQRT(ABS(T)) S2= S*S IF(XRT.LT.10.D0) THEN JX= 1 ELSE IF(XRT.GT.10.D0.AND.XRT.LT.30.D0) THEN JX= 2 ELSE IF(XRT.GT.30.D0.AND.XRT.LT.50.D0) THEN JX= 3 ELSE IF(XRT.GT.50.D0.AND.XRT.LT.70.D0) THEN JX= 4 ELSE IF(XRT.GT.70.D0) THEN JX= 5 ENDIF A1= CTAL(JX,1) A2= CTAL(JX,2) A3= CTAL(JX,3) A4= CTAL(JX,4) A5= CTAL(JX,5) * *-----COMPUTES THE RUNNING ALPHA * IF(XRS.LT.10.D0) THEN JX= 1 ELSE IF(XRS.GT.10.D0.AND.XRS.LT.30.D0) THEN JX= 2 ELSE IF(XRS.GT.30.D0.AND.XRS.LT.50.D0) THEN JX= 3 ELSE IF(XRS.GT.50.D0.AND.XRS.LT.70.D0) THEN JX= 4 ELSE IF(XRS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(J) DENA= CFACT*CFACT+AIPGGF*AIPGGF SAL= ALPHA*CFACT/DENA SALI= ALPHA*AIPGGF/DENA SAL2= SAL*SAL+SALI*SALI * *-----COMPUTES AUXILIARY TERMS * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE S-CHANNEL * RSS= STR2+(SAL/FPI-AEXPHZ)*XX(J,8)+ # ((SAL*SAL-XX(J,2)*XX(J,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(J,9) REVS= 4.D0*RSS-1.D0 REVS2= REVS*REVS AIVS= 4.D0*XX(J,6) RV2S= REVS2-AIVS*AIVS VS2= REVS2+AIVS*AIVS OPVS2= 1.D0+VS2 U= -S-T DP= (T*T+U*U)/S2 DM= (T*T-U*U)/S2 SAM= S-ZM2 SAM2= SAM*SAM DEN= SAM2+S2*GRED*GRED RCHIS= SAM/DEN AICHIS= -S/DEN*GRED CHIS2= S/DEN RCHISZ= 0.D0 AICHISZ= -ZM2/DEN*GRED CHIS2Z= ZM2/DEN RACCZ= AICHISZ*SALIZ ACCZI= AICHISZ*SALZ * *-----COMPUTES THE S CONTRIBUTIONS TO X-SECT * CS1= 0.D0 CS7= 32.D0*PI*GW*RCHIS*(SAL*(DP*RV2S-DM)+2.D0*XX(J,2)* # REVS*AIVS*DP+SAL*(DP*XX(J,17)+DM*XX(J,18))) CS10= 2.D0*GW*GW*CHIS2*(DP*OPVS2*OPVS2-4.D0*DM*REVS2+ # 2.D0*(DP*XX(J,21)+DM*XX(J,22)))- # 2.D0*GW*GW*CHIS2Z*(DP*OPVS2Z*OPVS2Z-4.D0*DM*REVS2Z+ # 2.D0*(DP*XX(NRS,21)+DM*XX(NRS,22))) CS11= 32.D0*PI*GW*AICHIS*(XX(J,2)*(DP*RV2S-DM) # -2.D0*SAL*REVS*AIVS*DP+SAL*(DP*XX(J,24)+ # DM*XX(J,25)))- # 32.D0*PI*GW*AICHISZ*(XX(NRS,2)*(DP*RV2SZ-DM) # -2.D0*SALZ*REVSZ*AIVSZ*DP+SALZ*(DP*XX(NRS,24)+ # DM*XX(NRS,25))) SCCS= CS1+CS7+CS10+CS11 * SVVZ= EG4/PI*CHIS2Z*ERVAE*(ERVE*ERVE+EVI*EVI) SAAZ= EG4/PI*CHIS2Z*ERVAE*(0.25D0+EAI*EAI) SVAZ= -2.D0*EG4/PI*CHIS2Z*( # ERVE*EAI*EVI-2.D0*ERVE*AIM(1)*VIM(1)*FI3+ # FI3*ERVE*ERVE-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+4.D0*EG2*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*ACCZI) SEVZ= -4.D0*EG2*(RACCZ*(VEZZI*VEZZI-ERVE*ERVE)+ # 2.D0*ACCZI*ERVE*VEZZI) SVVZ= SVVZ+SEVZ * IF(IT(I).EQ.0) THEN TCCS= 0.D0 ELSE * *-----COMPUTES ALPHA_(T) RUNNING IN T-CHANNEL * TAL= A1*A1+A2*LOG(ABS(A3/T))+(A4+ALSTZ*A5)* # ABS(T)/TQM2 TAL= ALPHA/(1.D0-(TAL+ODA)) TAL2= TAL*TAL * *-----COMPUTES AUXILIARY TERMS FOR T-CHANNEL * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE T-CHANNEL * RST= STR2+(TAL/FPI-AEXPHZ)*XX(J,8)+ # (TAL*TAL/FPI/FPI-AEXPHZ*AEXPHZ)*XX(J,9) VT= 4.D0*RST-1.D0 VT2= VT*VT S2= S*S T2= T*T U2= U*U FP= (S2+U2)/S2 FM= (S2-U2)/S2 SAMT= T-ZM2 CHIT= 1.D0/SAMT CHIT2= S/(SAMT*SAMT) * *-----COMPUTES THE T AND S-T CONTRIBUTIONS TO X-SECT * CS2= 0.D0 CS3= 0.D0 CS4= 32.D0*PI*GW*SAL*CHIT*U2/S2*(1.D0+VT2+XX(J,12)) CS5= 32.D0*PI*GW*TAL*CHIT*S/T*(FP*VT2-FM+FP*XX(J,13)+ # FM*XX(J,14)) CS6= 2.D0*GW*GW*CHIT2*(FP*(1.D0+VT2)*(1.D0+VT2) # -4.D0*FM*VT2+2.D0*(FP*XX(J,15)+FM*XX(J,16))) CS8= 32.D0*PI*GW*TAL*U2/S/T*RCHIS*(1.D0+RV2S+XX(J,19)) CS9= 4.D0*GW*GW*RCHIS*CHIT*U2/S*((1.D0+VT2) # *(1.D0+RV2S)+4.D0*VT*REVS+XX(J,20)) CS12= GW*AICHIS*(32.D0*PI*TAL*U2/S/T*(-2.D0*REVS # *AIVS+2.D0*XX(J,23))+4.D0*GW*S*CHIT*U2/S2*(-4.D0* # AIVS*VT-2.D0*AIVS*REVS-2.D0*AIVS*REVS*VT2+2.D0* # XX(J,26))) TCCS= CS2+CS3+CS4+CS5+CS6+CS8+CS9+CS12 ENDIF * OSIGDIFF(I,J)= CONV*(SCCS+TCCS)/256.D0/PIS+ # CONV/8.D0/PI*((SVVZ+SAAZ)*DP- # SVAZ*DM) ENDDO ENDDO * RETURN END * *-----BRNDFFMNR-------------------------------------------------------- * UPDATED DECEMBER 98 WITH NLO. * SUBROUTINE TBRNDFFMNR(NRS,IFM,ORS,X1,X2,THETA,OSIGDIFF) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 MM2,NM2 * PARAMETER(MNRS=30,NL=3) * COMMON/TNAL/ODA COMMON/TICOUPLING/NF COMMON/TTCHANN/IT(NL) COMMON/TIMAG/PGGFI(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION OSIGDIFF(NL,MNRS),ORS(MNRS),X1(NL,MNRS),X2(NL,MNRS), # THETA(NL) * GW= GF*ZM2*XX(1,4) FPI= 4.D0*PI GRED= WT/SQRT(ZM2) * DO J=1,NRS RS= ORS(J) DO I=1,IFM * *-----THE REDUCED INVARIANTS * S= X1(I,J)*X2(I,J)*RS*RS XRS= SQRT(S) T= -S/2.D0*(1.D0-COS(THETA(I))) XRT= SQRT(ABS(T)) S2= S*S IF(XRT.LT.10.D0) THEN JX= 1 ELSE IF(XRT.GT.10.D0.AND.XRT.LT.30.D0) THEN JX= 2 ELSE IF(XRT.GT.30.D0.AND.XRT.LT.50.D0) THEN JX= 3 ELSE IF(XRT.GT.50.D0.AND.XRT.LT.70.D0) THEN JX= 4 ELSE IF(XRT.GT.70.D0) THEN JX= 5 ENDIF A1= CTAL(JX,1) A2= CTAL(JX,2) A3= CTAL(JX,3) A4= CTAL(JX,4) A5= CTAL(JX,5) * *-----COMPUTES THE RUNNING ALPHA * IF(XRS.LT.10.D0) THEN JX= 1 ELSE IF(XRS.GT.10.D0.AND.XRS.LT.30.D0) THEN JX= 2 ELSE IF(XRS.GT.30.D0.AND.XRS.LT.50.D0) THEN JX= 3 ELSE IF(XRS.GT.50.D0.AND.XRS.LT.70.D0) THEN JX= 4 ELSE IF(XRS.GT.70.D0) THEN JX= 5 ENDIF * *-----COMPUTES THE RUNNING ALPHA * CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(NRS) DENA= CFACT*CFACT+AIPGGF*AIPGGF SAL= ALPHA*CFACT/DENA SALI= ALPHA*AIPGGF/DENA SAL2= SAL*SAL+SALI*SALI * *-----COMPUTES AUXILIARY TERMS * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE S-CHANNEL * RSS= STR2+(SAL/FPI-AEXPHZ)*XX(J,8)+ # ((SAL*SAL-XX(J,2)*XX(J,2))/FPI/FPI-AEXPHZ*AEXPHZ)* # XX(J,9) REVS= 4.D0*RSS-1.D0 REVS2= REVS*REVS AIVS= 4.D0*XX(J,6) RV2S= REVS2-AIVS*AIVS VS2= REVS2+AIVS*AIVS OPVS2= 1.D0+VS2 U= -S-T DP= (T*T+U*U)/S2 DM= (T*T-U*U)/S2 SAM= S-ZM2 SAM2= SAM*SAM DEN= SAM2+S2*GRED*GRED RCHIS= S*SAM/DEN AICHIS= -S2/DEN*GRED CHIS2= RCHIS*RCHIS+AICHIS*AICHIS * *-----COMPUTES THE S CONTRIBUTIONS TO X-SECT * CS1= 128.D0*PIS*SAL2*DP*(1.D0+2.D0*XX(J,10)) CS7= 0.D0 CS10= 0.D0 CS11= 0.D0 SCCS= CS1+CS7+CS10+CS11 * IF(IT(I).EQ.0) THEN TCCS= 0.D0 ELSE * *-----COMPUTES ALPHA_(T) RUNNING IN T-CHANNEL * TAL= A1*A1+A2*LOG(ABS(A3/T))+(A4+ALSTZ*A5)* # ABS(T)/TQM2 TAL= ALPHA/(1.D0-(TAL+ODA)) TAL2= TAL*TAL * *-----COMPUTES AUXILIARY TERMS FOR T-CHANNEL * *-----THE WEAK-MIXING ANGLE IS RUNNING IN THE T-CHANNEL * RST= STR2+(TAL/FPI-AEXPHZ)*XX(J,8)+ # (TAL*TAL/FPI/FPI-AEXPHZ*AEXPHZ)*XX(J,9) VT= 4.D0*RST-1.D0 VT2= VT*VT S2= S*S T2= T*T U2= U*U FP= (S2+U2)/S2 FM= (S2-U2)/S2 SAMT= T-ZM2 CHIT= S/SAMT CHIT2= CHIT*CHIT * *-----COMPUTES THE T AND S-T CONTRIBUTIONS TO X-SECT * CS2= 256.D0*PIS*SAL*TAL*U2/S/T*(1.D0+ # XX(J,10)+XX(J,11)) CS3= 128.D0*PIS*TAL2*(U2+S2)/T2*(1.D0+2.D0*XX(J,11)) CS4= 0.D0 CS5= 0.D0 CS6= 0.D0 CS8= 0.D0 CS9= 0.D0 CS12= 0.D0 TCCS= CS2+CS3+CS4+CS5+CS6+CS8+CS9+CS12 ENDIF * OSIGDIFF(I,J)= CONV*(SCCS+TCCS)/256.D0/PIS/S ENDDO ENDDO * RETURN END * *-----FJAC----------------------------------------------------------- * SUBROUTINE TFJAC(NRS,IFM,X1,X2,THETA,FJVEC) IMPLICIT REAL*8(A-H,O-Z) * PARAMETER(MNRS=30,NL=3) * DIMENSION X1(NL,MNRS),X2(NL,MNRS),FJVEC(NL,MNRS),THETA(NL) * DO I=1,NRS DO J=1,IFM STM= SIN(THETA(J)/2.D0) STM2= STM*STM CTM2= 1.D0-STM2 FJVEC(J,I)= X1(J,I)*X2(J,I)/(X1(J,I)*STM2+X2(J,I)*CTM2) # /(X1(J,I)*STM2+X2(J,I)*CTM2) ENDDO ENDDO * RETURN END * *-----BORNCUT----------------------------------------------------- * UPDATED DECEMBER 98 WITH NLO. * SUBROUTINE TBORNCUT(IC,NOBS,NRS,NOBSM,ORS,OSIGMA) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 MM2,NM2 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OBHABHA,OREST CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NL=3) * COMMON/TNAL/ODA COMMON/TSUP/OMODES COMMON/TICOUPLING/NF COMMON/TTCHANN/IT(NL) COMMON/TIMAG/PGGFI(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION OSIGMA(MNRS,NOBS),ORS(NOBS,MNRS),CST(NL,MNRS), # ASYM(NL,MNRS) * AMT= SQRT(TQM2) ZM= SQRT(ZM2) * *-----NOBSM = 2(E) OR 6(E+MU+TAU). IT IS ASSUMED THAT CUTS ARE THE SAME * FOR F+B AND F-B * SINCE NOBSM = 2 OR 6 AND ENERGIES ARE LOADED AS (F+B),(F-B),(F+B) * ETC... AND SO FAR E(F+B) = E(F-B) ONLY ORS(I,J), I=1,3,5 ARE * SELECTED * G= GF*ZM2*XX(1,4) * CFACTZ= CSAL(5,1)*CSAL(5,1)+CSAL(5,2)*LOG(ABS(CSAL(5,3))/ZM2)+ # (CSAL(5,4)+ALSTZ*CSAL(5,5))*ZM2/TQM2 CFACTZ= 1.D0-(CFACTZ+ODA) AIPGGFZ= ALPHA/4.D0/PI*PGGFI(NRS) DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ SALZ= ALPHA*CFACTZ/DENAZ SALIZ= ALPHA*AIPGGFZ/DENAZ SAL2Z= SALZ*SALZ+SALIZ*SALIZ REVSZ= 4.D0*XX(NRS,5)-1.D0 AIVSZ= 4.D0*XX(NRS,6) REVS2Z= REVSZ*REVSZ RV2SZ= REVSZ*REVSZ-AIVSZ*AIVSZ VS2Z= REVSZ*REVSZ+AIVSZ*AIVSZ OPVS2Z= 1.D0+VS2Z * DO J=1,NRS DO I=1,NOBSM,2 IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN II= 1 ELSE IF(OINDX.EQ.'MU') THEN II= 2 ELSE IF(OINDX.EQ.'TA') THEN II= 3 ENDIF ELSE IF(I.EQ.1) THEN II= I ELSE IF(I.EQ.3) THEN II= I-1 ELSE IF(I.EQ.5) THEN II= I-2 ENDIF ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN II= 2 ELSE IF(OINDX.EQ.'TA') THEN II= 3 ENDIF ELSE IF(I.EQ.1) THEN II= I ELSE IF(I.EQ.3) THEN II= I-1 ELSE IF(I.EQ.5) THEN II= I-2 ENDIF ENDIF ENDIF * RS= ORS(I,J) S= RS*RS S2= S*S IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN FM2= EM2 ERHO= RHOEFF(1) EST2= ST2EFF(1) EVI= VIM(1) EAI= AIM(1) ELSE IF(OINDX.EQ.'MU') THEN FM2= MM2 ERHO= RHOEFF(2) EST2= ST2EFF(2) EVI= VIM(2) EAI= AIM(2) ELSE IF(OINDX.EQ.'TA') THEN FM2= TLM2 ERHO= RHOEFF(3) EST2= ST2EFF(3) EVI= VIM(3) EAI= AIM(3) ENDIF ELSE IF(II.EQ.1) THEN FM2= EM2 ERHO= RHOEFF(1) EST2= ST2EFF(1) EVI= VIM(1) EAI= AIM(1) ELSE IF(II.EQ.2) THEN FM2= MM2 ERHO= RHOEFF(2) EST2= ST2EFF(2) EVI= VIM(2) EAI= AIM(2) ELSE IF(II.EQ.3) THEN FM2= TLM2 ERHO= RHOEFF(3) EST2= ST2EFF(3) EVI= VIM(3) EAI= AIM(3) ENDIF ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN FM2= MM2 ERHO= RHOEFF(2) EST2= ST2EFF(2) EVI= VIM(2) EAI= AIM(2) ELSE IF(OINDX.EQ.'TA') THEN FM2= TLM2 ERHO= RHOEFF(3) EST2= ST2EFF(3) EVI= VIM(3) EAI= AIM(3) ENDIF ELSE IF(II.EQ.1) THEN FM2= EM2 ERHO= RHOEFF(1) EST2= ST2EFF(1) EVI= VIM(1) EAI= AIM(1) ELSE IF(II.EQ.2) THEN FM2= MM2 ERHO= RHOEFF(2) EST2= ST2EFF(2) EVI= VIM(2) EAI= AIM(2) ELSE IF(II.EQ.3) THEN FM2= TLM2 ERHO= RHOEFF(3) EST2= ST2EFF(3) EVI= VIM(3) EAI= AIM(3) ENDIF ENDIF ENDIF * *-----COMPUTES THE RUNNING ALPHA IN S-CHANNEL * IF(RS.LT.10.D0) THEN JX= 1 ELSE IF(RS.GT.10.D0.AND.RS.LT.30.D0) THEN JX= 2 ELSE IF(RS.GT.30.D0.AND.RS.LT.50.D0) THEN JX= 3 ELSE IF(RS.GT.50.D0.AND.RS.LT.70.D0) THEN JX= 4 ELSE IF(RS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(J) DENA= CFACT*CFACT+AIPGGF*AIPGGF SAL= ALPHA*CFACT/DENA SALI= ALPHA*AIPGGF/DENA AS2= SAL*SAL+SALI*SALI * *-----COMPUTES AUXILIARY TERMS FOR S-CHANNEL * REVS= 4.D0*XX(J,5)-1.D0 AIVS= 4.D0*XX(J,6) REVS2= REVS*REVS RV2S= REVS*REVS-AIVS*AIVS VS2= REVS*REVS+AIVS*AIVS VS4= VS2*VS2 CMIN= COS(THMAXR(II)) CMAX= COS(THMINR(II)) CMIN2= CMIN*CMIN CMAX2= CMAX*CMAX CMIN3= CMIN2*CMIN CMAX3= CMAX2*CMAX DMXMN1= CMAX-CMIN DMXMN2= CMAX2-CMIN2 DMXMN3= CMAX3-CMIN3 SMXMN1= CMAX+CMIN SMXMN2= CMAX2+CMIN2 SMXMN3= CMAX3+CMIN3 * AMF2= FM2 RFM2= FM2/S RFM2Z= FM2/ZM2 FATTM= 1.D0-2.D0*RFM2 FATTMZ= 1.D0-2.D0*RFM2Z DPI= PI*(DMXMN1+DMXMN3/3.D0-4.D0/3.D0*RFM2*DMXMN3) DPIZ= PI*(DMXMN1+DMXMN3/3.D0-4.D0/3.D0*RFM2Z*DMXMN3) DPIG= DPI+4.D0*PI*RFM2*DMXMN1 DMI= -PI*DMXMN2*FATTM DMIZ= -PI*DMXMN2*FATTMZ DPIFB= PI*(SMXMN1+SMXMN3/3.D0-4.D0/3.D0*RFM2*SMXMN3) DPIFBZ= PI*(SMXMN1+SMXMN3/3.D0-4.D0/3.D0*RFM2Z*SMXMN3) DPIFBG= DPIFB+4.D0*PI*RFM2*SMXMN1 DMIFB= -PI*SMXMN2*FATTM DMIFBZ= -PI*SMXMN2*FATTMZ SAM= S-ZM*ZM SAM2= SAM*SAM GRED= WT/ZM DEN= SAM2+S*S*GRED*GRED RECHIS= S*SAM/DEN AIMCHIS= -S*S/DEN*GRED CHIS2= RECHIS*RECHIS+AIMCHIS*AIMCHIS OPVS2= 1.D0+VS2 * SRECHIS= SAM/DEN SAIMCHIS= -S/DEN*GRED SCHIS2= S/DEN SRECHISZ= 0.D0 SAIMCHISZ= -ZM2/DEN*GRED SCHIS2Z= ZM2/DEN * *-----COMPUTES THE S CONTRIBUTIONS TO X-SECT * ERVE= -0.5D0+2.D0*ST2EFF(1) ERVF= -0.5D0+2.D0*EST2 ERVAE= ERVE*ERVE+0.25D0+VIM(1)*VIM(1)+AIM(1)*AIM(1) ERVETVF= ERVE*ERVF VEZZI= VIM(1) VFZZI= EVI VETVFZZI= VEZZI*VFZZI * FI3= -0.5D0 ZWD= S/ZM*WT SMZM2= S-ZM2 DENS= SMZM2*SMZM2+ZWD*ZWD CHIZI= -ZM*WT/DENS CHI2Z= ZM2/DENS * RACCZ= SALIZ*CHIZI ACCZI= SALZ*CHIZI RARCZ= 0.D0 RAICZ= SALZ*CHIZI * EG2= GWEAK*SQRT(RHOEFF(1)*ERHO) EG4= EG2*EG2 SVVZ= EG4/PI*CHI2Z*ERVAE*(ERVF*ERVF+EVI*EVI) SAAZ= EG4/PI*CHI2Z*ERVAE*(0.25D0+EAI*EAI) SVAZ= -2.D0*EG4/PI*CHI2Z*( # ERVE*EAI*EVI-2.D0*ERVF*AIM(1)*VIM(1)*FI3+ # FI3*ERVETVF-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+4.D0*EG2*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*ACCZI) SEVZ= -4.D0*EG2*(RACCZ*(VETVFZZI-ERVETVF)+ # ACCZI*(ERVE*VFZZI+ERVF*VEZZI)) SVVZ= SVVZ+SEVZ * BETF= SQRT(1.D0-4.D0*RFM2) BETFS= BETF*BETF BETFC= BETFS*BETF * CSZ0= BETF*(2.D0-BETFS)*SVVZ+BETFC*SAAZ CSZ1= 2.D0*BETFS*SVAZ CSZ2= BETFC*(SVVZ+SAAZ) CSZ= CSZ0*DMXMN1+0.5D0*CSZ1*DMXMN2+CSZ2*DMXMN3/3.D0 CSZ= CONV*CSZ/8.D0 ASZ= CSZ0*SMXMN1+0.5D0*CSZ1*SMXMN2+CSZ2*SMXMN3/3.D0 ASZ= CONV*ASZ/8.D0 * CS1= 128.D0*PIS*AS2*DPIG*(1.D0+2.D0*XX(J,10))*FATTM/S CS7= 32.D0*PI*G*SRECHIS*(SAL*(DPI*RV2S-DMI)+ # 2.D0*XX(J,2)*REVS*AIVS*DPI+4.D0*RFM2* # (SAL*RV2S+2.D0*XX(J,2)*REVS*AIVS)*PI*DMXMN1+ # SAL*(DPI*XX(J,17)+DMI*XX(J,18)))*FATTM- # 32.D0*PI*G*SRECHISZ*(SALZ*(DPIZ*RV2SZ-DMIZ)+ # 2.D0*XX(NRS,2)*REVSZ*AIVSZ*DPIZ+4.D0*RFM2Z* # (SALZ*RV2SZ+2.D0*XX(NRS,2)*REVSZ*AIVSZ)* # PI*DMXMN1+SALZ*(DPIZ*XX(NRS,17)+DMIZ*XX(NRS,18)))* # FATTMZ CS10= 2.D0*G*G*SCHIS2*(DPI*OPVS2*OPVS2-4.D0*DMI*REVS2+ # 4.D0*RFM2*(VS4-1.D0)*PI*DMXMN1+ # 2.D0*(DPI*XX(J,21)+DMI*XX(J,22)))*FATTM- # 2.D0*G*G*SCHIS2Z*(DPIZ*OPVS2Z*OPVS2Z-4.D0*DMIZ* # REVS2Z+4.D0*RFM2Z*(VS2Z*VS2Z-1.D0)*PI*DMXMN1+ # 2.D0*(DPIZ*XX(NRS,21)+DMIZ*XX(NRS,22)))*FATTMZ CS11= 32.D0*PI*G*SAIMCHIS*(XX(J,2)*(DPI*RV2S-DMI)- # 2.D0*SAL*REVS*AIVS*DPI+4.D0*RFM2*(XX(J,2)*RV2S-2.D0* # SAL*REVS*AIVS)*PI*DMXMN1+SAL*(DPI*XX(J,24)+DMI* # XX(J,25)))*FATTM- # 32.D0*PI*G*SAIMCHISZ*(XX(NRS,2)*(DPIZ*RV2SZ-DMIZ)- # 2.D0*SALZ*REVSZ*AIVSZ*DPIZ+4.D0*RFM2Z*(XX(NRS,2)* # RV2SZ-2.D0*SALZ*REVSZ*AIVSZ)*PI*DMXMN1+ # SALZ*(DPIZ*XX(NRS,24)+DMIZ*XX(NRS,25)))*FATTMZ * * COMPUTES THE S CONTRIBUTIONS TO F-B X-SECT * AS1= 128.D0*PIS*AS2*DPIFBG*(1.D0+2.D0*XX(J,10))*FATTM/S AS7= 32.D0*PI*G*SRECHIS*(SAL*(DPIFB*RV2S-DMIFB)+ # 2.D0*XX(J,2)*REVS*AIVS*DPIFB+4.D0*RFM2*(SAL*RV2S+ # 2.D0*XX(J,2)*REVS*AIVS)*PI*SMXMN1+SAL*(DPIFB* # XX(J,17)+DMIFB*XX(J,18)))*FATTM-32.D0*PI*G*SRECHISZ* # (SALZ*(DPIFBZ*RV2SZ-DMIFBZ)+2.D0*XX(NRS,2)*REVSZ*AIVSZ* # DPIFBZ+4.D0*RFM2Z*(SALZ*RV2SZ+2.D0*XX(NRS,2)*REVSZ* # AIVSZ)*PI*SMXMN1+SALZ*(DPIFBZ*XX(NRS,17)+DMIFBZ* # XX(NRS,18)))*FATTMZ AS10= 2.D0*G*G*SCHIS2*(DPIFB*OPVS2*OPVS2-4.D0*DMIFB*REVS* # REVS+4.D0*RFM2*(VS4-1.D0)*PI*SMXMN1+ # 2.D0*(DPIFB*XX(J,21)+DMIFB*XX(J,22)))*FATTM- # 2.D0*G*G*SCHIS2Z*(DPIFBZ*OPVS2Z*OPVS2Z- # 4.D0*DMIFBZ*REVSZ*REVSZ+4.D0*RFM2Z*(VS2Z*VS2Z-1.D0)* # PI*SMXMN1+2.D0*(DPIFBZ*XX(NRS,21)+DMIFBZ* # XX(NRS,22)))*FATTMZ AS11= 32.D0*PI*G*SAIMCHIS*(XX(J,2)*(DPIFB*RV2S-DMIFB)- # 2.D0*SAL*REVS*AIVS*DPIFB+4.D0*RFM2*(XX(J,2)*RV2S- # 2.D0*SAL*REVS*AIVS)*PI*SMXMN1+SAL*(DPIFB*XX(J,24)+ # DMIFB*XX(J,25)))*FATTM- # 32.D0*PI*G*SAIMCHISZ*(XX(NRS,2)*(DPIFBZ*RV2SZ-DMIFBZ)- # 2.D0*SALZ*REVSZ*AIVSZ*DPIFBZ+4.D0*RFM2Z*(XX(NRS,2)* # RV2SZ-2.D0*SALZ*REVSZ*AIVSZ)*PI*SMXMN1+SALZ* # (DPIFBZ*XX(NRS,24)+DMIFBZ*XX(NRS,25)))*FATTMZ * SCCS= CS1+CS7+CS10+CS11 SCAS= AS1+AS7+AS10+AS11 * IF(IT(II).EQ.0) THEN TCCS= 0.D0 TCAS= 0.D0 ELSE * * INGREDIENTS FOR ALPHA_(T) RUNNING IN T-CHANNEL * A1= 0.74595047D-2 A2= -0.43344392D-4 A3= 0.73526544D-3 A4= -0.81220219D-6 * * COMPUTES AUXILIARY TERMS FOR T-CHANNEL * QEPS= -1.D-35 PI3= PIS*PI A12= A1*A1 A22= A2*A2 A42= A4*A4 A1T2= A1*A2 A1T4= A1*A4 A2T4= A2*A4 ZM4= ZM2*ZM2 ZM2M1= 1.D0/ZM2 G2= G*G VT= 4.D0*XX(J,7)-1.D0 V2T= VT*VT * W2= 512.D0*(1.D0+XX(J,10)+XX(J,11)) W3= 512.D0*(1.D0+2.D0*XX(J,11)) W4= 64.D0*(1.D0+V2T+XX(J,12)) W5P= 128.D0*(V2T+XX(J,13)) W5M= 128.D0*(XX(J,14)-1.D0) W6P= 8.D0*((1.D0+V2T)*(1.D0+V2T)+2.D0*XX(J,15)) W6M= 8.D0*(2.D0*XX(J,16)-4.D0*V2T) W8= 128.D0*(1.D0+RV2S+XX(J,19)) W9= 16.D0*((1.D0+V2T)*(1.D0+RV2S)+4.D0*VT*REVS+XX(J,20)) W12P= 32.D0*(-2.D0*REVS*AIVS+2.D0*XX(J,23)) W12M= 32.D0*(-4.D0*AIVS*VT-2.D0*AIVS*REVS-2.D0*AIVS*REVS*V2T # +2.D0*XX(J,26)) * SM1= 1.D0/S SM2= SM1*SM1 CM= COS(THMINR(II)) T0= -0.5D0*S TX= T0*(1.D0-CM) TM= T0*(1.D0+CM) T02= T0*T0 TX2= TX*TX TM2= TM*TM A3P= -1.D4*A3 A3P2= A3P*A3P A23P2= A2*A3P2 A3PM1= 1.D0/A3P T03= T0/A3P T032= T03*T03 TX3= TX/A3P TX32= TX3*TX3 TX3M1= 1.D0/TX3 TX3M2= TX3M1*TX3M1 TM3= TM/A3P TM32= TM3*TM3 TM3M1= 1.D0/TM3 TM3M2= TM3M1*TM3M1 TXC= TX2*TX TXM1= 1.D0/TX AMT2= AMT*AMT AMT2M1= 1.D0/AMT2 AMT2M2= AMT2M1*AMT2M1 TMC= TM2*TM TMM1= 1.D0/TM TXM2= TX-ZM2 TXM2M1= 1.D0/TXM2 TMM2= TM-ZM2 TMM2M1= 1.D0/TMM2 T0C= T02*T0 T03M1= 1.D0/T03 T0M1= 1.D0/T0 T03M2= T03M1*T03M1 T0M2= T0-ZM2 T0M2M1= 1.D0/T0M2 * ALNTX3= LOG(TX3) ALNTM3= LOG(TM3) ALNTXT0= LOG(TX/T0) ALNT0TM= LOG(T0/TM) ALN2TX3= ALNTX3*ALNTX3 ALN3TX3= ALN2TX3*ALNTX3 ALN2TM3= ALNTM3*ALNTM3 ALN3TM3= ALN2TM3*ALNTM3 ALNTX0Z= LOG((TX-ZM2)/(T0-ZM2)) ALNT0MZ= LOG((T0-ZM2)/(TM-ZM2)) ALN1TXM= LOG(1.D0-TX/ZM2) ALN1TMM= LOG(1.D0-TM/ZM2) ALN1TXM2= ALN1TXM*ALN1TXM ALN1TMM2= ALN1TMM*ALN1TMM ALNT03= LOG(T03) ALN2T03= ALNT03*ALNT03 ALN3T03= ALN2T03*ALNT03 ALN1T0M= LOG(1.D0-T0/ZM2) ALN1T0M2= ALN1T0M*ALN1T0M QEPS= -1.D-35 * QX= -TX/(ZM2-TX) ALI2TXM= TRSPENCE(QX,QEPS) * QX= -TM/(ZM2-TM) ALI2TMM= TRSPENCE(QX,QEPS) * QX= -T0/(ZM2-T0) ALI2T0M= TRSPENCE(QX,QEPS) * * COMPUTES THE T AND S-T CONTRIBUTIONS TO F+B XSECT. * CS2= PI3*SAL*W2 # * (SM2*A1*TX2-SM2*A1*TM2+0.5D0*SM2*A23P2*TX32 # -SM2*A23P2*TX32*ALNTX3-0.5D0*SM2*A23P2*TM32 # +SM2*A23P2*TM32*ALNTM3+2.D0/3.D0*SM2*A4*TXC*AMT2M1 # -2.D0/3.D0*SM2*A4*TMC*AMT2M1+ 4.D0*SM1*A1*TX # -4.D0*SM1*A1*TM+4.D0*SM1*A2*A3P*TX3 # -4.D0*SM1*A2*A3P*TX3*ALNTX3-4.D0*SM1*A2*A3P*TM3 # +4.D0*SM1*A2*A3P*TM3*ALNTM3+ 2.D0*SM1*A4*TX2*AMT2M1 # -2.D0*SM1*A4*TM2*AMT2M1+2.D0*A1*ALNTXT0+ 2.D0*A1*ALNT0TM # -A2*ALN2TX3+A2*ALN2TM3+2.D0*A4*TX*AMT2M1-2.D0*A4*TM*AMT2M1) * CS3=PI3*W3 # *(4.D0*S*A1T2*A3PM1*TX3M1+4.D0*S*A1T2*A3PM1*TX3M1*ALNTX3 # -4.D0*S*A1T2*A3PM1*TM3M1-4.D0*S*A1T2*A3PM1*TM3M1*ALNTM3 # +4.D0*S*A1T4*AMT2M1*ALNTXT0+4.D0*S*A1T4*AMT2M1*ALNT0TM # -2.D0*S*A12*TXM1 # +2.D0*S*A12*TMM1-2.D0*S*A2T4*AMT2M1*ALN2TX3 # +2.D0*S*A2T4*AMT2M1*ALN2TM3 # -2.D0*S*A22*A3PM1*TX3M2*ALN2TX3-4.D0*S*A22*A3PM1*TX3M1 # -4.D0*S*A22*A3PM1*TX3M1*ALNTX3+2.D0*S*A22*A3PM1*TM3M2*ALN2TM3 # +4.D0*S*A22*A3PM1*TM3M1+4.D0*S*A22*A3PM1*TM3M1*ALNTM3 # +2.D0*S*A42*TX*AMT2M2-2.D0*S*A42*TM*AMT2M2 # +2.D0*SM1*A1T2*A3P*TX3 # -2.D0*SM1*A1T2*A3P*TX3*ALNTX3-2.D0*SM1*A1T2*A3P*TM3 # +2.D0*SM1*A1T2*A3P*TM3*ALNTM3+SM1*A1T4*TX2*AMT2M1 # -SM1*A1T4*TM2*AMT2M1 # +SM1*A12*TX-SM1*A12*TM #+0.5D0*SM1*A2T4*A3P2*TX32*AMT2M1 # -SM1*A2T4*A3P2*TX32*AMT2M1*ALNTX3 # -0.5D0*SM1*A2T4*A3P2*TM32*AMT2M1 # +SM1*A2T4*A3P2*TM32*AMT2M1*ALNTM3+2.D0*SM1*A22*A3P*TX3 # +SM1*A22*A3P*TX3*ALN2TX3-2.D0*SM1*A22*A3P*TX3*ALNTX3 # -2.D0*SM1*A22*A3P*TM3-SM1*A22*A3P*TM3*ALN2TM3 # +2.D0*SM1*A22*A3P*TM3*ALNTM3+1.D0/3.D0*SM1*A42*TXC*AMT2M2 # -1.D0/3.D0*SM1*A42*TMC*AMT2M2 # -2.D0*A1T2*ALN2TX3+2.D0*A1T2*ALN2TM3 # +4.D0*A1T4*TX*AMT2M1 # -4.D0*A1T4*TM*AMT2M1+2.D0*A12*ALNTXT0+2.D0*A12*ALNT0TM # +4.D0*A2T4*A3P*TX3*AMT2M1 # -4.D0*A2T4*A3P*TX3*AMT2M1*ALNTX3-4.D0*A2T4*A3P*TM3*AMT2M1 # +4.D0*A2T4*A3P*TM3*AMT2M1*ALNTM3+2.D0/3.D0*A22*ALN3TX3 # -2.D0/3.D0*A22*ALN3TM3 # +A42*TX2*AMT2M2-A42*TM2*AMT2M2) * CS4= PIS*SAL*W4*G # * ( 2.D0*SM2*ZM4*ALNTX0Z+2.D0*SM2*ZM4*ALNT0MZ # +2.D0*SM2*TX*ZM2 # +SM2*TX2-2.D0*SM2*TM*ZM2-SM2*TM2 # +4.D0*SM1*ZM2*ALNTX0Z # +4.D0*SM1*ZM2*ALNT0MZ+4.D0*SM1*TX-4.D0*SM1*TM # +2.D0*ALNTX0Z+2.D0*ALNT0MZ ) * CS5= PIS*W5P*G # *( 2.D0*S*A1*ZM2M1*ALNTX0Z+2.D0*S*A1*ZM2M1*ALNT0MZ #-2.D0*S*A1*ZM2M1*ALNTXT0-2.D0*S*A1*ZM2M1*ALNT0TM # +S*A2*ZM2M1*ALN2TX3 # -2.D0*S*A2*ZM2M1*ALNTX3*ALN1TXM-S*A2*ZM2M1*ALN2TM3 # +2.D0*S*A2*ZM2M1*ALNTM3*ALN1TMM+S*A2*ZM2M1*ALN1TXM2 # +2.D0*S*A2*ZM2M1*ALI2TXM # -S*A2*ZM2M1*ALN1TMM2-2.D0*S*A2*ZM2M1*ALI2TMM # +2.D0*S*A4*AMT2M1*ALNTX0Z+2.D0*S*A4*AMT2M1*ALNT0MZ # +SM1*A1*ZM2*ALNTX0Z # +SM1*A1*ZM2*ALNT0MZ+SM1*A1*TX-SM1*A1*TM #-SM1*A2*ZM2*ALNTX3*ALN1TXM+SM1*A2*ZM2*ALNTM3*ALN1TMM # +0.5D0*SM1*A2*ZM2*ALN1TXM2+SM1*A2*ZM2*ALI2TXM # -0.5D0*SM1*A2*ZM2*ALN1TMM2 # -SM1*A2*ZM2*ALI2TMM+SM1*A2*A3P*TX3-SM1*A2*A3P*TX3*ALNTX3 # -SM1*A2*A3P*TM3+SM1*A2*A3P*TM3*ALNTM3 # +SM1*A4*AMT2M1*ZM4*ALNTX0Z+SM1*A4*AMT2M1*ZM4*ALNT0MZ #+SM1*A4*TX*AMT2M1*ZM2+0.5D0*SM1*A4*TX2*AMT2M1 #-SM1*A4*TM*AMT2M1*ZM2 # -0.5D0*SM1*A4*TM2*AMT2M1+2.D0*A1*ALNTX0Z+2.D0*A1*ALNT0MZ # -2.D0*A2*ALNTX3*ALN1TXM+2.D0*A2*ALNTM3*ALN1TMM #+A2*ALN1TXM2+2.D0*A2*ALI2TXM-A2*ALN1TMM2 #-2.D0*A2*ALI2TMM+2.D0*A4*AMT2M1*ZM2*ALNTX0Z #+2.D0*A4*AMT2M1*ZM2*ALNT0MZ # +2.D0*A4*TX*AMT2M1-2.D0*A4*TM*AMT2M1) CS5= CS5+PIS*W5M*G # *(-SM1*A1*ZM2*ALNTX0Z-SM1*A1*ZM2*ALNT0MZ-SM1*A1*TX # +SM1*A1*TM+SM1*A2*ZM2*ALNTX3*ALN1TXM #-SM1*A2*ZM2*ALNTM3 *ALN1TMM-0.5D0*SM1*A2*ZM2*ALN1TXM2 #-SM1*A2*ZM2*ALI2TXM+ 0.5D0*SM1*A2*ZM2*ALN1TMM2 #+SM1*A2*ZM2*ALI2TMM-SM1*A2*A3P*TX3+SM1*A2*A3P*TX3*ALNTX3 #+SM1*A2*A3P*TM3-SM1*A2*A3P*TM3*ALNTM3 #-SM1*A4*AMT2M1*ZM4*ALNTX0Z-SM1*A4*AMT2M1*ZM4*ALNT0MZ #-SM1*A4*TX*AMT2M1*ZM2-0.5D0*SM1*A4*TX2*AMT2M1 # +SM1*A4*TM*AMT2M1*ZM2+0.5D0*SM1*A4*TM2*AMT2M1 #-2.D0*A1*ALNTX0Z-2.D0*A1*ALNT0MZ+2.D0*A2*ALNTX3*ALN1TXM #-2.D0*A2*ALNTM3*ALN1TMM # -A2*ALN1TXM2-2.D0*A2*ALI2TXM+A2*ALN1TMM2+2.D0*A2*ALI2TMM # -2.D0*A4*AMT2M1*ZM2*ALNTX0Z-2.D0*A4*AMT2M1*ZM2*ALNT0MZ # -2.D0*A4*TX*AMT2M1+2.D0*A4*TM*AMT2M1 ) * CS6= PI*W6P*G2 # * (-2.D0*S*TXM2M1+2.D0*S*TMM2M1+2.D0*SM1*ZM2*ALNTX0Z # +2.D0*SM1*ZM2*ALNT0MZ-SM1*TXM2M1*ZM4+SM1*TMM2M1*ZM4 # +SM1*TX-SM1*TM+2.D0*ALNTX0Z+2.D0*ALNT0MZ # -2.D0*TXM2M1*ZM2+2.D0*TMM2M1*ZM2 ) # +PI*W6M*G2 # * (-2.D0*SM1*ZM2*ALNTX0Z-2.D0*SM1*ZM2*ALNT0MZ # +SM1*TXM2M1*ZM4-SM1*TMM2M1*ZM4-SM1*TX+SM1*TM # -2.D0*ALNTX0Z-2.D0*ALNT0MZ+2.D0*TXM2M1*ZM2 # -2.D0*TMM2M1*ZM2 ) * CS8= PIS*W8*G*RECHIS # *(0.5D0*SM2*A1*TX2-0.5D0*SM2*A1*TM2 # +1.D0/4.D0*SM2*A23P2*TX32 # -0.5D0*SM2*A23P2*TX32*ALNTX3 #-1.D0/4.D0*SM2*A23P2*TM32 # +0.5D0*SM2*A23P2*TM32*ALNTM3 #+1.D0/3.D0*SM2*A4*TXC*AMT2M1-1.D0/3.D0*SM2*A4*TMC*AMT2M1 #+2.D0*SM1*A1*TX-2.D0*SM1*A1*TM+2.D0*SM1*A2*A3P*TX3 #-2.D0*SM1*A2*A3P*TX3*ALNTX3-2.D0*SM1*A2*A3P*TM3 #+2.D0*SM1*A2*A3P*TM3*ALNTM3+SM1*A4*TX2*AMT2M1 #-SM1*A4*TM2*AMT2M1+A1*ALNTXT0+A1*ALNT0TM #-0.5D0*A2*ALN2TX3+0.5D0*A2*ALN2TM3+A4*TX*AMT2M1 #-A4*TM*AMT2M1) * CS9= PI*W9*G2*RECHIS # * ( SM2*ZM4*ALNTX0Z+SM2*ZM4*ALNT0MZ # +SM2*TX*ZM2+0.5D0*SM2*TX2-SM2*TM*ZM2 # -0.5D0*SM2*TM2+2.D0*SM1*ZM2*ALNTX0Z # +2.D0*SM1*ZM2*ALNT0MZ+2.D0*SM1*TX-2.D0*SM1*TM # +ALNTX0Z+ALNT0MZ ) * CS12= PI*W12M*G2*AIMCHIS # * ( 0.5D0*SM2*ZM4*ALNTX0Z+0.5D0*SM2*ZM4*ALNT0MZ # +0.5D0*SM2*TX*ZM2+0.25D0*SM2*TX2 # -0.5D0*SM2*TM*ZM2-0.25D0*SM2*TM2 # +SM1*ZM2*ALNTX0Z+SM1*ZM2*ALNT0MZ # +SM1*TX-SM1*TM+0.5D0*ALNTX0Z # +0.5D0*ALNT0MZ )+PIS*W12P*G*AIMCHIS # * ( 2.D0*SM2*A1*TX2-2.D0*SM2*A1*TM2+SM2*A23P2*TX32 # -2.D0*SM2*A23P2*TX32*ALNTX3 # -SM2*A23P2*TM32+2.D0*SM2*A23P2*TM32*ALNTM3 # +4.D0/3.D0*SM2*A4*TXC*AMT2M1-4.D0/3.D0*SM2*A4*TMC*AMT2M1 # +8.D0*SM1*A1*TX-8.D0*SM1*A1*TM+8.D0*SM1*A2*A3P*TX3 # -8.D0*SM1*A2*A3P*TX3*ALNTX3-8.D0*SM1*A2*A3P*TM3 # +8.D0*SM1*A2*A3P*TM3*ALNTM3+4.D0*SM1*A4*TX2*AMT2M1 # -4.D0*SM1*A4*TM2*AMT2M1+4.D0*A1*ALNTXT0 # +4.D0*A1*ALNT0TM-2.D0*A2*ALN2TX3+2.D0*A2*ALN2TM3 # +4.D0*A4*TX*AMT2M1-4.D0*A4*TM*AMT2M1 ) * * COMPUTES THE CONTRIBUTIONS TO THE F-B XSECT. * AS2= PI3*SAL*W2 # *(-2.D0*SM2*A1*T02+SM2*A1*TX2+SM2*A1*TM2 #-SM2*A23P2*T032+2.D0*SM2*A23P2*T032*ALNT03 #+0.5D0*SM2*A23P2*TX32 # -SM2*A23P2*TX32*ALNTX3+0.5D0*SM2*A23P2*TM32 #-SM2*A23P2*TM32*ALNTM3-4.D0/3.D0*SM2*A4*T0C*AMT2M1 #+2.D0/3.D0*SM2*A4*TXC*AMT2M1 #+2.D0/3.D0*SM2*A4*TMC*AMT2M1-8.D0*SM1*A1*T0+4.D0*SM1*A1*TX # +4.D0*SM1*A1*TM-8.D0*SM1*A2*A3P*T03 #+8.D0*SM1*A2*A3P*T03*ALNT03 # +4.D0*SM1*A2*A3P*TX3-4.D0*SM1*A2*A3P*TX3*ALNTX3 # +4.D0*SM1*A2*A3P*TM3 # -4.D0*SM1*A2*A3P*TM3*ALNTM3-4.D0*SM1*A4*T02*AMT2M1 # +2.D0*SM1*A4*TX2*AMT2M1+2.D0*SM1*A4*TM2*AMT2M1 # +2.D0*A1*ALNTXT0-2.D0*A1*ALNT0TM # +2.D0*A2*ALN2T03-A2*ALN2TX3-A2*ALN2TM3 # -4.D0*A4*T0*AMT2M1+2.D0*A4*TX*AMT2M1+2.D0*A4*TM*AMT2M1) * AS3= PI3*W3 # *(-8.D0*S*A1T2*A3PM1*T03M1-8.D0*S*A1T2*A3PM1*T03M1*ALNT03 # +4.D0*S*A1T2*A3PM1*TX3M1+4.D0*S*A1T2*A3PM1*TX3M1*ALNTX3 # +4.D0*S*A1T2*A3PM1*TM3M1+4.D0*S*A1T2*A3PM1*TM3M1*ALNTM3 # +4.D0*S*A1T4*AMT2M1*ALNTXT0-4.D0*S*A1T4*AMT2M1*ALNT0TM # +4.D0*S*A12*T0M1-2.D0*S*A12*TXM1-2.D0*S*A12*TMM1 #+ 4.D0*S*A2T4*AMT2M1*ALN2T03 # -2.D0*S*A2T4*AMT2M1*ALN2TX3-2.D0*S*A2T4*AMT2M1*ALN2TM3 # +4.D0*S*A22*A3PM1*T03M2*ALN2T03+8.D0*S*A22*A3PM1*T03M1 # +8.D0*S*A22*A3PM1*T03M1*ALNT03 # -2.D0*S*A22*A3PM1*TX3M2*ALN2TX3-4.D0*S*A22*A3PM1*TX3M1 # -4.D0*S*A22*A3PM1*TX3M1*ALNTX3-2.D0*S*A22*A3PM1*TM3M2*ALN2TM3 # -4.D0*S*A22*A3PM1*TM3M1-4.D0*S*A22*A3PM1*TM3M1*ALNTM3 # -4.D0*S*A42*T0*AMT2M2+2.D0*S*A42*TX*AMT2M2 # +2.D0*S*A42*TM*AMT2M2 # -4.D0*SM1*A1T2*A3P*T03+4.D0*SM1*A1T2*A3P*T03*ALNT03 # +2.D0*SM1*A1T2*A3P*TX3-2.D0*SM1*A1T2*A3P*TX3*ALNTX3 # +2.D0*SM1*A1T2*A3P*TM3 # -2.D0*SM1*A1T2*A3P*TM3*ALNTM3-2.D0*SM1*A1T4*T02*AMT2M1 # +SM1*A1T4*TX2*AMT2M1+SM1*A1T4*TM2*AMT2M1-2.D0*SM1*A12*T0 # +SM1*A12*TX+SM1*A12*TM-SM1*A2T4*A3P2*T032*AMT2M1 # +2.D0*SM1*A2T4*A3P2*T032*AMT2M1*ALNT03 # +0.5D0*SM1*A2T4*A3P2*TX32*AMT2M1 # -SM1*A2T4*A3P2*TX32*AMT2M1*ALNTX3 # +0.5D0*SM1*A2T4*A3P2*TM32*AMT2M1 # -SM1*A2T4*A3P2*TM32*AMT2M1*ALNTM3-4.D0*SM1*A22*A3P*T03 # -2.D0*SM1*A22*A3P*T03*ALN2T03+4.D0*SM1*A22*A3P*T03*ALNT03 # +2.D0*SM1*A22*A3P*TX3+SM1*A22*A3P*TX3*ALN2TX3 # -2.D0*SM1*A22*A3P*TX3*ALNTX3+2.D0*SM1*A22*A3P*TM3 # +SM1*A22*A3P*TM3*ALN2TM3 # -2.D0*SM1*A22*A3P*TM3*ALNTM3-2.D0/3.D0*SM1*A42*T0C*AMT2M2 # +1.D0/3.D0*SM1*A42*TXC*AMT2M2+1.D0/3.D0*SM1*A42*TMC*AMT2M2 # +4.D0*A1T2*ALN2T03-2.D0*A1T2*ALN2TX3-2.D0*A1T2*ALN2TM3 # -8.D0*A1T4*T0*AMT2M1 # +4.D0*A1T4*TX*AMT2M1+4.D0*A1T4*TM*AMT2M1 #+2.D0*A12*ALNTXT0 # -2.D0*A12*ALNT0TM-8.D0*A2T4*A3P*T03*AMT2M1 # +8.D0*A2T4*A3P*T03*AMT2M1*ALNT03 # +4.D0*A2T4*A3P*TX3*AMT2M1-4.D0*A2T4*A3P*TX3*AMT2M1*ALNTX3 # +4.D0*A2T4*A3P*TM3*AMT2M1-4.D0*A2T4*A3P*TM3*AMT2M1*ALNTM3 # +2.D0/3.D0*A22*ALN3TX3-4.D0/3.D0*A22*ALN3T03 # +2.D0/3.D0*A22*ALN3TM3-2.D0*A42*T02*AMT2M2+A42*TX2*AMT2M2 # +A42*TM2*AMT2M2) * AS4= PIS*SAL*W4*G # *(2.D0*SM2*ZM4*ALNTX0Z-2.D0*SM2*ZM4*ALNT0MZ # -4.D0*SM2*T0*ZM2 # -2.D0*SM2*T02+2.D0*SM2*TX*ZM2+SM2*TX2+2.D0*SM2*TM*ZM2 # +SM2*TM2+4.D0*SM1*ZM2*ALNTX0Z-4.D0*SM1*ZM2*ALNT0MZ # -8.D0*SM1*T0+4.D0*SM1*TX+4.D0*SM1*TM+2.D0*ALNTX0Z # -2.D0*ALNT0MZ) * AS5= PIS*W5P*G # * ( 2.D0*S*A1*ZM2M1*ALNTX0Z-2.D0*S*A1*ZM2M1*ALNT0MZ # -2.D0*S*A1*ZM2M1*ALNTXT0+2.D0*S*A1*ZM2M1*ALNT0TM # -2.D0*S*A2*ZM2M1*ALN2T03 # +S*A2*ZM2M1*ALN2TX3+4.D0*S*A2*ZM2M1*ALNT03*ALN1T0M # -2.D0*S*A2*ZM2M1*ALNTX3*ALN1TXM+S*A2*ZM2M1*ALN2TM3 # -2.D0*S*A2*ZM2M1*ALNTM3*ALN1TMM-2.D0*S*A2*ZM2M1*ALN1T0M2 # +S*A2*ZM2M1*ALN1TXM2 # -4.D0*S*A2*ZM2M1*ALI2T0M+2.D0*S*A2*ZM2M1*ALI2TXM # +S*A2*ZM2M1*ALN1TMM2+2.D0*S*A2*ZM2M1*ALI2TMM # +2.D0*S*A4*AMT2M1*ALNTX0Z # -2.D0*S*A4*AMT2M1*ALNT0MZ+SM1*A1*ZM2*ALNTX0Z # -SM1*A1*ZM2*ALNT0MZ # -2.D0*SM1*A1*T0+SM1*A1*TX+SM1*A1*TM # +2.D0*SM1*A2*ZM2*ALNT03*ALN1T0M-SM1*A2*ZM2*ALNTX3*ALN1TXM # -SM1*A2*ZM2*ALNTM3*ALN1TMM-SM1*A2*ZM2*ALN1T0M2 # +0.5D0*SM1*A2*ZM2*ALN1TXM2 # -2.D0*SM1*A2*ZM2*ALI2T0M+SM1*A2*ZM2*ALI2TXM # +0.5D0*SM1*A2*ZM2*ALN1TMM2+SM1*A2*ZM2*ALI2TMM # -2.D0*SM1*A2*A3P*T03 # +2.D0*SM1*A2*A3P*T03*ALNT03+SM1*A2*A3P*TX3 # -SM1*A2*A3P*TX3*ALNTX3 # +SM1*A2*A3P*TM3-SM1*A2*A3P*TM3*ALNTM3 # +SM1*A4*AMT2M1*ZM4*ALNTX0Z-SM1*A4*AMT2M1*ZM4*ALNT0MZ # -2.D0*SM1*A4*T0*AMT2M1*ZM2-SM1*A4*T02*AMT2M1 # +SM1*A4*TX*AMT2M1*ZM2+0.5D0*SM1*A4*TX2*AMT2M1 # +SM1*A4*TM*AMT2M1*ZM2+0.5D0*SM1*A4*TM2*AMT2M1 # +2.D0*A1*ALNTX0Z-2.D0*A1*ALNT0MZ+4.D0*A2*ALNT03*ALN1T0M # -2.D0*A2*ALNTX3*ALN1TXM-2.D0*A2*ALNTM3*ALN1TMM # -2.D0*A2*ALN1T0M2 # +A2*ALN1TXM2-4.D0*A2*ALI2T0M+2.D0*A2*ALI2TXM+A2*ALN1TMM2 # +2.D0*A2*ALI2TMM+2.D0*A4*AMT2M1*ZM2*ALNTX0Z # -2.D0*A4*AMT2M1*ZM2*ALNT0MZ # -4.D0*A4*T0*AMT2M1+2.D0*A4*TX*AMT2M1+2.D0*A4*TM*AMT2M1 ) AS5= AS5+PIS*W5M*G # *(-SM1*A1*ZM2*ALNTX0Z+SM1*A1*ZM2*ALNT0MZ+2.D0*SM1*A1*T0 # -SM1*A1*TX-SM1*A1*TM-2.D0*SM1*A2*ZM2*ALNT03*ALN1T0M # +SM1*A2*ZM2*ALNTX3*ALN1TXM+SM1*A2*ZM2*ALNTM3*ALN1TMM # +SM1*A2*ZM2*ALN1T0M2-0.5D0*SM1*A2*ZM2*ALN1TXM2 # +2.D0*SM1*A2*ZM2*ALI2T0M-SM1*A2*ZM2*ALI2TXM # -0.5D0*SM1*A2*ZM2*ALN1TMM2 # -SM1*A2*ZM2*ALI2TMM+2.D0*SM1*A2*A3P*T03 # -2.D0*SM1*A2*A3P*T03*ALNT03-SM1*A2*A3P*TX3 # +SM1*A2*A3P*TX3*ALNTX3-SM1*A2*A3P*TM3 # +SM1*A2*A3P*TM3*ALNTM3 # -SM1*A4*AMT2M1*ZM4*ALNTX0Z # +SM1*A4*AMT2M1*ZM4*ALNT0MZ+2.D0*SM1*A4*T0*AMT2M1*ZM2 # +SM1*A4*T02*AMT2M1-SM1*A4*TX*AMT2M1*ZM2 # -0.5D0*SM1*A4*TX2*AMT2M1-SM1*A4*TM*AMT2M1*ZM2 # -0.5D0*SM1*A4*TM2*AMT2M1 # -2.D0*A1*ALNTX0Z+2.D0*A1*ALNT0MZ-4.D0*A2*ALNT03*ALN1T0M # +2.D0*A2*ALNTX3*ALN1TXM+2.D0*A2*ALNTM3*ALN1TMM # +2.D0*A2*ALN1T0M2-A2*ALN1TXM2 # +4.D0*A2*ALI2T0M-2.D0*A2*ALI2TXM-A2*ALN1TMM2 # -2.D0*A2*ALI2TMM # -2.D0*A4*AMT2M1*ZM2*ALNTX0Z+2.D0*A4*AMT2M1*ZM2*ALNT0MZ # +4.D0*A4*T0*AMT2M1-2.D0*A4*TX*AMT2M1-2.D0*A4*TM*AMT2M1) * AS6= PI*W6P*G2 # *(4.D0*S*T0M2M1-2.D0*S*TXM2M1-2.D0*S*TMM2M1 # +2.D0*SM1*ZM2*ALNTX0Z # -2.D0*SM1*ZM2*ALNT0MZ+2.D0*SM1*T0M2M1*ZM4 # -SM1*TXM2M1*ZM4-SM1*TMM2M1*ZM4-2.D0*SM1*T0 # +SM1*TX+SM1*TM+2.D0*ALNTX0Z-2.D0*ALNT0MZ+4.D0*T0M2M1 # *ZM2-2.D0*TXM2M1*ZM2-2.D0*TMM2M1*ZM2 ) # +PI*W6M*G2 # * (-2.D0*SM1*ZM2*ALNTX0Z+2.D0*SM1*ZM2*ALNT0MZ # -2.D0*SM1*T0M2M1*ZM4+SM1*TXM2M1*ZM4 # +SM1*TMM2M1*ZM4+2.D0*SM1*T0 # -SM1*TX-SM1*TM-2.D0*ALNTX0Z+2.D0*ALNT0MZ # -4.D0*T0M2M1*ZM2+2.D0*TXM2M1*ZM2+2.D0*TMM2M1*ZM2) * AS8= PIS*W8*G*RECHIS # *(-SM2*A1*T02+0.5D0*SM2*A1*TX2 # +0.5D0*SM2*A1*TM2-0.5D0*SM2*A23P2*T032 # +SM2*A23P2*T032*ALNT03+0.25D0*SM2*A23P2*TX32 # -0.5D0*SM2*A23P2*TX32*ALNTX3+0.25D0*SM2*A23P2*TM32 # -0.5D0*SM2*A23P2*TM32*ALNTM3 # -2.D0/3.D0*SM2*A4*T0C*AMT2M1+1.D0/3.D0*SM2*A4*TXC*AMT2M1 # +1.D0/3.D0*SM2*A4*TMC*AMT2M1-4.D0*SM1*A1*T0 # +2.D0*SM1*A1*TX+2.D0*SM1*A1*TM-4.D0*SM1*A2*A3P*T03 # +4.D0*SM1*A2*A3P*T03*ALNT03+2.D0*SM1*A2*A3P*TX3 # -2.D0*SM1*A2*A3P*TX3*ALNTX3+2.D0*SM1*A2*A3P*TM3 # -2.D0*SM1*A2*A3P*TM3*ALNTM3-2.D0*SM1*A4*T02*AMT2M1 # +SM1*A4*TX2*AMT2M1+SM1*A4*TM2*AMT2M1+A1*ALNTXT0 # -A1*ALNT0TM+A2*ALN2T03 # -0.5D0*A2*ALN2TX3-0.5D0*A2*ALN2TM3 # -2.D0*A4*T0*AMT2M1+A4*TX*AMT2M1+A4*TM*AMT2M1) * AS9= PI*W9*G2*RECHIS # *( SM2*ZM4*ALNTX0Z-SM2*ZM4*ALNT0MZ # -2.D0*SM2*T0*ZM2-SM2*T02+SM2*TX*ZM2+0.5D0*SM2*TX2 # +SM2*TM*ZM2+0.5D0*SM2*TM2+2.D0*SM1*ZM2*ALNTX0Z # -2.D0*SM1*ZM2*ALNT0MZ-4.D0*SM1*T0+2.D0*SM1*TX # +2.D0*SM1*TM+ALNTX0Z-ALNT0MZ) * AS12= PI*W12M*G2*AIMCHIS # *(0.5D0*SM2*ZM4*ALNTX0Z-0.5D0*SM2*ZM4 # *ALNT0MZ-SM2*T0*ZM2-0.5D0*SM2*T02 # +0.5D0*SM2*TX*ZM2+0.25D0*SM2*TX2 # +0.5D0*SM2*TM*ZM2+0.25D0*SM2*TM2 # +SM1*ZM2*ALNTX0Z-SM1*ZM2*ALNT0MZ # -2.D0*SM1*T0+SM1*TX+SM1*TM # +0.5D0*ALNTX0Z-0.5D0*ALNT0MZ) # +PIS*W12P*G*AIMCHIS # * (-4.D0*SM2*A1*T02+2.D0*SM2*A1*TX2 # +2.D0*SM2*A1*TM2-2.D0*SM2*A23P2*T032 # +4.D0*SM2*A23P2*T032*ALNT03+SM2*A23P2*TX32 # -2.D0*SM2*A23P2*TX32*ALNTX3+SM2*A23P2*TM32 # -2.D0*SM2*A23P2*TM32*ALNTM3-8.D0/3.D0*SM2*A4*T0C*AMT2M1 # +4.D0/3.D0*SM2*A4*TXC*AMT2M1+4.D0/3.D0*SM2*A4*TMC*AMT2M1 # -16.D0*SM1*A1*T0+8.D0*SM1*A1*TX # +8.D0*SM1*A1*TM-16.D0*SM1*A2*A3P*T03 # +16.D0*SM1*A2*A3P*T03*ALNT03+8.D0*SM1*A2*A3P*TX3 # -8.D0*SM1*A2*A3P*TX3*ALNTX3+8.D0*SM1*A2*A3P*TM3 # -8.D0*SM1*A2*A3P*TM3*ALNTM3-8.D0*SM1*A4*T02*AMT2M1 # +4.D0*SM1*A4*TX2*AMT2M1+4.D0*SM1*A4*TM2*AMT2M1 # +4.D0*A1*ALNTXT0-4.D0*A1*ALNT0TM+4.D0*A2*ALN2T03 # -2.D0*A2*ALN2TX3-2.D0*A2*ALN2TM3-8.D0*A4*T0*AMT2M1 # +4.D0*A4*TX*AMT2M1+4.D0*A4*TM*AMT2M1) * TCCS= CS2+CS3+CS4+CS5+CS6+CS8+CS9+CS12 TCAS= AS2+AS3+AS4+AS5+AS6+AS8+AS9+AS12 * ENDIF * S0IJ= S0CUT(II,J) AFSCP= TFSCFPB(II,S0IJ,S,FM2) AFSCM= TFSCFMB(II,S0IJ,S,FM2) CONVP0= CONV/256.D0/PIS CONVP= CONV/256.D0/PIS/S CST(II,J)= (CONVP0*SCCS+CONVP*TCCS+CSZ)*AFSCP ASYM(II,J)= (CONVP0*SCAS+CONVP*TCAS+ASZ)*AFSCM ENDDO ENDDO * DO J=1,NRS IF(OMODES.EQ.'FITC') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN OSIGMA(J,1)= CST(1,J) OSIGMA(J,2)= ASYM(1,J) ELSE IF(OINDX.EQ.'MU') THEN OSIGMA(J,1)= CST(2,J) OSIGMA(J,2)= ASYM(2,J) ELSE IF(OINDX.EQ.'TA') THEN OSIGMA(J,1)= CST(3,J) OSIGMA(J,2)= ASYM(3,J) ENDIF ELSE OSIGMA(J,1)= CST(1,J) OSIGMA(J,2)= ASYM(1,J) OSIGMA(J,3)= CST(2,J) OSIGMA(J,4)= ASYM(2,J) OSIGMA(J,5)= CST(3,J) OSIGMA(J,6)= ASYM(3,J) ENDIF ELSE IF(OBHABHA.EQ.'R'.AND.OREST.EQ.'C') THEN IF(OINDX.EQ.'MU') THEN OSIGMA(J,1)= CST(2,J) OSIGMA(J,2)= ASYM(2,J) ELSE IF(OINDX.EQ.'TA') THEN OSIGMA(J,1)= CST(3,J) OSIGMA(J,2)= ASYM(3,J) ENDIF ELSE OSIGMA(J,1)= CST(1,J) OSIGMA(J,2)= ASYM(1,J) IF(OEXT.EQ.'C'.AND.IC.EQ.0) THEN OSIGMA(J,3)= CST(2,J) OSIGMA(J,4)= ASYM(2,J) OSIGMA(J,5)= CST(3,J) OSIGMA(J,6)= ASYM(3,J) ENDIF ENDIF ENDIF ENDDO * RETURN END * *-----FSCFPB--------------------------------------------------------- * FINAL STATE CORRECTION (INVARIANT MASS AND ACOLLINEARITY CUT) * FOR F+B CROSS-SECTIONS * FUNCTION TFSCFPB(I,S0,S,FM2) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1,OFS,OCN * PARAMETER (MNRS=30,NL=3) * COMMON/TFSO/OFS COMMON/THARDCR/DEL COMMON/TOHARDC/OCN COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * X= S0/S OMX= 1.D0-X X2= X*X IF(X.GE.1.D0) THEN TFSCFPB= 1.D-37 RETURN ENDIF * CM= COS(THMINR(I)) CM2= CM*CM CMC= CM2*CM CMR= CM2/(3.D0+CM2) CM3= 3.D0*CM+CMC AL= LOG(FM2/S) RLX= LOG(X) RLOMX= LOG(OMX) EPSM= -1.D-37 RLI2X= TRSPENCE(X,EPSM) * TRIA= -2.D0*CMR*OMX*OMX+(-(X+0.5D0*X2+2.D0* # RLOMX)*AL+X*(1.D0+0.5D0*X)*RLX-2.D0*RLOMX+2.D0*RLX* # RLOMX+2.D0*RLI2X-0.25D0*X2-3.D0*X+5.D0/4.D0) * * COMPUTES BELL * BELL= 0.D0 ACLIM= 179.D0*PI/180.D0 * IF(ACOLLR(I).GT.ACLIM) THEN ACOLLR(I)= ACLIM ENDIF * R= 2.D0/(1.D0+COS(ACOLLR(I))) R2= R*R OMR= 1.D0-R YT= 2.D0*R-1.D0-2.D0*SQRT(R2-R) * IF(YT.GT.X) THEN * OPX= 1.D0+X E= OPX/2.D0*(1.D0-SQRT(1.D0-4.D0*X*R/OPX/OPX)) EM1= 1.D0/E E2= E*E E3= E2*E XR= OPX/2.D0*(1.D0+SQRT(1.D0-4.D0*X*R/OPX/OPX)) XR2= XR*XR XR3= XR2*XR XRM1= 1.D0/XR RME= R-E RMEM1= 1.D0/RME RMXR= R-XR RMXRM1= 1.D0/RMXR YB= X YB2= YB*YB OMYB= 1.D0-YB RLNE= LOG(E) RLNOME= LOG(1.D0-E) RLNOMYB= LOG(OMYB) RLNRM1= LOG(R-1.D0) RLNEMYB= LOG(E-YB) RLNOMXR= LOG(1.D0-XR) RLNRME= LOG(RME) RLNXR= LOG(XR) RLNRMXR= LOG(RMXR) RLNXRMYB= LOG(XR-YB) EPSM= -1.D-37 * OME= 1.D0-E X= OME RLI2OME= TRSPENCE(X,EPSM) OMXR= 1.D0-XR RLI2OMXR= TRSPENCE(OMXR,EPSM) OMER= OME/OMR RLI2ER= TRSPENCE(OMER,EPSM) OMXRR= OMXR/OMR RLI2XRR= TRSPENCE(OMXRR,EPSM) OMEYB= OME/OMYB RLI2EYB= TRSPENCE(OMEYB,EPSM) OMXRYB= OMXR/OMYB RLI2XRYB= TRSPENCE(OMXRYB,EPSM) * BELL= (-0.5D0*E-3.D0/16.D0*E*YB+0.25D0*E/ # RME-0.125D0*E*R-1.D0/16.D0*E2-1.D0/16.D0*E2/ # RME-1.D0/16.D0*E3/RME-0.125D0*EM1*YB2+ # 3.D0/16.D0*YB*XR+0.125D0*YB2/XR-0.125D0/RME+ # 0.5D0*XR-0.25D0*XR/RMXR+0.125D0*XR*R+ # 1.D0/16.D0*XR2+1.D0/16.D0*XR2/RMXR+1.D0/16.D0*XR3/ # RMXR+0.125D0/RMXR) * BELL= BELL+CMR*(E-E/RME+0.5D0*E2/RME+0.5D0*EM1*YB2- # 0.5D0*YB2/XR+0.5D0/RME-XR+XR/RMXR-0.5D0*XR2/ # RMXR-0.5D0/RMXR)+RLNE*(-0.125D0*E-1.D0/ # 16.D0*E2 )+RLNRM1*(-0.125D0*E-1.D0/16.D0*E2+ # 0.125D0*XR+1.D0/16.D0*XR2)+RLNOME*(0.125D0* # YB+1.D0/16.D0*YB2)+RLNEMYB*(0.125D0*E+1.D0/ # 16.D0*E2 -0.125D0*YB-1.D0/16.D0*YB2)+0.25D0* # RLNOMYB*RLNOME-0.25D0*RLNOMYB*RLNOMXR * BELL= BELL+RLNRME*(0.25D0+0.125D0*E+1.D0/16.D0*E2- # 0.5D0*R-0.125D0*R2)+RLNRME*CMR*(-1.D0+R)+RLNXR* # (0.125D0*XR+1.D0/16.D0*XR2 )+RLNOMXR*(-0.125D0* # YB-1.D0/16.D0*YB2)+RLNRMXR*(-0.25D0-0.125D0*XR- # 1.D0/16.D0*XR2+0.5D0*R+0.125D0*R2)+RLNRMXR*CMR*(1.D0- # R)+RLNXRMYB*(0.125D0*YB+1.D0/16.D0*YB2-0.125D0* # XR-1.D0/16.D0*XR2)+0.25D0*RLI2OME-0.25D0* # RLI2OMXR-0.25D0*RLI2ER+0.25D0*(RLI2XRR- # RLI2EYB+RLI2XRYB) BELL= BELL*4.D0 * ENDIF * * COMPUTES CONE * IF(OCN.EQ.'Y'.AND.I.EQ.1) THEN EPSM= -1.D-37 PI2= PI*PI ENERGY= 0.5D0*SQRT(S) X= S0/S THRESH= X*ENERGY RHO2= DEL*DEL*ENERGY*ENERGY/FM2 EPS= 1.D0-THRESH/ENERGY OMEPS= 1.D0-EPS ZERO= X02AKF() * IF(EPS.LE.ZERO) THEN CONE= 1.D-35 ELSE ALD= LOG(1.D0+RHO2*OMEPS*OMEPS) ALEPS= LOG(EPS) ALOMEPS= LOG(OMEPS) RLI2EPS= TRSPENCE(EPS,EPSM) CONE= 2.D0*(-(ALD-1.D0))*ALEPS+2.D0*((0.25D0-(1.D0- # 0.5D0*EPS)*(1.D0-0.5D0*EPS))*ALD-PI2/3.D0+9.D0/ # 4.D0-2.5D0*EPS+0.25D0*EPS*EPS+2.D0*ALEPS*ALOMEPS+ # 2.D0*RLI2EPS) ENDIF ELSE CONE= 0.D0 ENDIF IF(OFS.EQ.'D') THEN AFSCL= 2.D0*(-AL-1.D0)*RLOMX AFSCR= TRIA-BELL+CONE-AFSCL TFSCFPB= EXP(API*AFSCL)*(1.D0+API*AFSCR-APIS*(AFSCL*AFSCR+ # 0.D0*(PI*PI/3.D0-9.D0/8.D0)*AL*AL)) ELSE IF(OFS.EQ.'Z') THEN AFSCL= 2.D0*(-AL-1.D0)*RLOMX SSOFT= -1.5D0*AL+PI*PI/3.D0-2.D0 AFSCR= TRIA-BELL+CONE-AFSCL-SSOFT TFSCFPB= EXP(API*AFSCL)*(1.D0+API*SSOFT)+API*AFSCR ENDIF * RETURN END * *------------------------------------------------------------------- * REAL*8 FUNCTION TWOC(NDIM,X) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM2,NM2 * PARAMETER (MNRS=30,NL=3) * COMMON/TIWOC/II COMMON/TNAL/ODA COMMON/TTWOC/SS,EE COMMON/TTYPI/JCOM,LCOM COMMON/TAFJTR/ALST,ALSTZ COMMON/TPARAM/PI,PIS,DELTA COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION X(NDIM) * S= SS I= II OMEE= 1.D0-EE RS= SQRT(S) IF(RS.LT.10.D0) THEN JX= 1 ELSE IF(RS.GT.10.D0.AND.RS.LT.30.D0) THEN JX= 2 ELSE IF(RS.GT.30.D0.AND.RS.LT.50.D0) THEN JX= 3 ELSE IF(RS.GT.50.D0.AND.RS.LT.70.D0) THEN JX= 4 ELSE IF(RS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) ALPHAR= ALPHA/CFACT CCEMR= 4.D0*PI*ALPHAR CCEM= 4.D0*PI*ALPHA CCEMRS= CCEMR*CCEMR CCW= 8.D0*GWEAK*RHO CCWS= CCW*CCW CVF= 0.5D0/S/(2.D0*PI)**5 * SMZM2= 1.D0-ZM2/S ZWD= WT/SQRT(ZM2) DENS= SMZM2*SMZM2+ZWD*ZWD PZR= SMZM2/DENS PZI= -ZWD/DENS PZM2= 1.D0/DENS VF= 4.D0*STH2-1.D0 VFP1= 4.D0*STH2 VFM1= 4.D0*STH2-2.D0 VP= VFP1*VFP1+VFM1*VFM1 VM= VFP1*VFP1-VFM1*VFM1 VPS= VP*VP VMS= VM*VM VPM= VFP1*VFM1 * R= 2.D0/(1.D0+COS(ACOLLR(I))) R2= R*R YT= 2.D0*R-1.D0-2.D0*SQRT(R2-R) CCUT= COS(THMINPR(I)) XR= OMEE/(R-EE)*R * J= JCOM L= LCOM IF(J.EQ.1) THEN CTM= COS(THMINR(I))*X(1) TMJAC= COS(THMINR(I)) ELSE IF(J.EQ.2) THEN CTM= COS(THMINR(I))*(X(1)-1.D0) TMJAC= COS(THMINR(I)) ENDIF X1= OMEE*X(2)+EE X1JAC= OMEE IF(YT.LT.(2.D0*EE-1.D0)) THEN X2= OMEE*X(3)+EE-1.D0+X1 X2JAC= OMEE ELSE IF(X1.LT.XR) THEN X2= X1*(R-1.D0)/(R-X1)*X(3)+X1*(1.D0-X1)/(R-X1) X2JAC= X1*(R-1.D0)/(R-X1) ELSE X2= OMEE*X(3)+EE-1.D0+X1 X2JAC= OMEE ENDIF ENDIF STM= SQRT(1.D0-CTM*CTM) CPSI= (2.D0*X2-X1-X1*X2)/X1/(1.D0-X2) SPSI= SQRT(1.D0-CPSI*CPSI) EM= 0.5D0*X1*RS EG= 0.5D0*(1.D0-X2)*RS EP= 0.5D0*(1.D0-X1+X2)*RS C10= (-EP-EM*CTM-EG*CTM*CPSI)/EG/STM/SPSI C20= (+EP-EM*CTM-EG*CTM*CPSI)/EG/STM/SPSI C1= (-EP*CCUT-EM*CTM-EG*CTM*CPSI)/EG/STM/SPSI C2= (+EP*CCUT-EM*CTM-EG*CTM*CPSI)/EG/STM/SPSI IF(C1.GT.C2) THEN TWOC= 0.D0 GO TO 1 ENDIF IF(L.EQ.1) THEN Z= (C20-C2)*X(4)+C2 ZJAC= C20-C2 ELSE IF(L.EQ.2) THEN Z= (C1-C10)*X(4)+C10 ZJAC= C1-C10 ENDIF IF((Z*Z).GT.1.D0) THEN TWOC= 0.D0 GO TO 1 ENDIF ZJAC= 2.D0*ZJAC/SQRT(1.D0-Z*Z) TAU= EM/RS*(CTM-1.D0) Y= EG/RS*(STM*SPSI*Z+CTM*CPSI-1.D0) TAUS= TAU*TAU YS= Y*Y X2MX1= X2-X1 X1MO= X1-1.D0 * AS= PZR*VP/X2MX1/X1MO*CCEMR*CCW*(-1./32. # *Y*TAU-1./64.*Y-1./32.*TAU-1./32.*TAUS) AS= AS+PZR*VP/X2MX1*CCEMR*CCW*(-1./64.-1./32.*Y-1./32.*TAU) AS= AS+PZR*VP/X1MO*CCEMR*CCW*(1./64.*X2*Y+1./64. # *X2*TAU+1./64.*X2-3./64.*Y*TAU-1./32.*Y-1./64.*YS # -1./32.*TAU-1./32.*TAUS) AS= AS+PZR*VP*CCEMR*CCW*(-1./64.-1./32.*Y-1./32.*TAU) AS= AS+PZR*VPM/X2MX1/X1MO*CCEMR*CCW*(1./16.* # Y*TAU+1./32.*YS+1./16.*TAUS) AS= AS+PZR*VPM/X2MX1*CCEMR*CCW*(1./32.*X1*TAU+1./ # 32.*Y*TAU+1./16.*TAUS) AS= AS+PZR*VPM/X1MO*CCEMR*CCW*(-1./32.+1./32.* # X2-1./16.*Y-1./16.*TAU) AS= AS+PZR*VPM*CCEMR*CCW*(-1./32.-1./32.*TAU) AS= AS+PZM2*VPS/X2MX1/X1MO*CCWS*(-1./4096.*Y+1./4096.*YS- # 1./2048.*TAU) AS= AS+PZM2*VPS/X2MX1*CCWS*(-1./4096.+1./4096.*X1*TAU+ # 1./4096.*Y*TAU-1./2048.*Y-1./2048.*TAU+1./2048.*TAUS) AS= AS+PZM2*VPS/X1MO*CCWS*(-1./4096.+1./4096.*X2*Y+ # 1./4096.*X2*TAU+1./2048.*X2-3./4096.*Y*TAU # -1./1024.*Y-1./4096.*YS-1./1024.*TAU-1./2048.*TAUS) AS= AS+PZM2*VPS*CCWS*(-1./2048.-1./2048.*Y-3./4096.*TAU) AS= AS+PZM2*VMS/X2MX1/X1MO*CCWS*(-1./1024.*Y*TAU-1./4096.* # Y-1./4096.*YS-1./2048.*TAU-1./1024.*TAUS) AS= AS+PZM2*VMS/X2MX1*CCWS*(-1./4096.-1./4096.*X1*TAU- # 1./4096.*Y*TAU-1./2048.*Y-1./2048.*TAU-1./2048.*TAUS) AS= AS+PZM2*VMS/X1MO*CCWS*(1./4096.+1./4096.*X2*Y+1./4096.* # X2*TAU-3./4096.*Y*TAU-1./4096.*YS-1./2048.*TAUS) AS= AS+PZM2*VMS*CCWS*(-1./2048.*Y-1./4096.*TAU) AS= AS+CCEMRS/X2MX1/X1MO*(-1./4.*Y+1./4.*YS-1./2.*TAU) AS= AS+CCEMRS/X2MX1*(-1./4.+1./4.*X1*TAU+1./4.*Y*TAU-1./2.* # Y-1./2.*TAU+1./2.*TAUS) AS= AS+CCEMRS/X1MO*(-1./4.+1./4.*X2*Y+1./4.*X2*TAU+1./2.*X2- # 3./4.*Y*TAU-Y-1./4.*YS-TAU-1./2.*TAUS) AS= AS+CCEMRS*(-1./2.-1./2.*Y-3./4.*TAU) * TWOC= PI*TMJAC*X1JAC*X2JAC*ZJAC*AS*CVF*CCEM*CONV * 1 RETURN END * *-----FSCFMB--------------------------------------------------------- * FINAL STATE CORRECTION (INVARIANT MASS AND ACOLLINEARITY CUT) * FOR F-B CROSS-SECTIONS * FUNCTION TFSCFMB(I,S0,S,FM2) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1,OFS,OCN * PARAMETER (MNRS=30,NL=3) * COMMON/TFSO/OFS COMMON/THARDCR/DEL COMMON/TOHARDC/OCN COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * X= S0/S OMX= 1.D0-X OPX= 1.D0+X IF(X.GE.1.D0) THEN TFSCFMB= 1.D-37 RETURN ENDIF * AL= LOG(FM2/S) RLX= LOG(X) RLOMX= LOG(OMX) EPSM= -1.D-37 RLI2X= TRSPENCE(X,EPSM) * TRIA= -(X+0.5D0*X*X+2.D0*RLOMX)*AL+2.D0*RLX*RLOMX- # 2.D0*RLOMX+2.D0*RLI2X-2.D0*X * * COMPUTES BELL * BELL= 0.D0 ACLIM= 179.D0*PI/180.D0 * IF(ACOLLR(I).GT.ACLIM) THEN ACOLLR(I)= ACLIM ENDIF * R= 2.D0/(1.D0+COS(ACOLLR(I))) R2= R*R OMR= 1.D0-R YT= 2.D0*R-1.D0-2.D0*SQRT(R2-R) * IF(YT.GT.X) THEN E= OPX/2.D0*(1.D0-SQRT(1.D0-4.D0*X*R/OPX/OPX)) EM1= 1.D0/E E2= E*E E3= E2*E XR= OPX/2.D0*(1.D0+SQRT(1.D0-4.D0*X*R/OPX/OPX)) XR2= XR*XR XR3= XR2*XR XRM1= 1.D0/XR RME= R-E RMEM1= 1.D0/RME RMXR= R-XR RMXRM1= 1.D0/RMXR YB= X YB2=YB*YB RLNE= LOG(E) RLNOME= LOG(1.D0-E) RLNOMYB= LOG(1.D0-YB) RLNRM1= LOG(R-1.D0) RLNEMYB= LOG(E-YB) RLNOMXR= LOG(1.D0-XR) RLNRME= LOG(RME) RLNXR= LOG(XR) RLNRMXR= LOG(R-XR) RLNXRMYB= LOG(XR-YB) EPSM= -1.D-37 OME= 1.D0-E RLI2OME= TRSPENCE(OME,EPSM) OMXR= 1.D0-XR RLI2OMXR= TRSPENCE(OMXR,EPSM) OMER= OME/OMR RLI2ER= TRSPENCE(OMER,EPSM) OMXRR= OMXR/OMR RLI2XRR= TRSPENCE(OMXRR,EPSM) OMEYB= OME/(1.D0-YB) RLI2EYB= TRSPENCE(OMEYB,EPSM) OMXRYB= OMXR/(1.D0-YB) RLI2XRYB= TRSPENCE(OMXRYB,EPSM) * BELL= -E+0.25D0*E*YB+0.5D0*E/RME-3.D0/4.D0*E2/ # RME+0.25D0*E3/RME-0.25D0*YB*XR+XR-0.5D0* # XR/RMXR+3.D0/4.D0*XR2/RMXR-0.25D0*XR3/ # RMXR+RLNE*(-0.5D0*E-0.25D0*E2-YB-0.5D0*YB2) * BELL= BELL+RLNRM1*(-0.5D0*E-0.25D0*E2 +0.5D0*XR+0.25D0* # XR2)+RLNOME*(0.5D0*YB+0.25D0*YB2)+RLNEMYB*(0.5D0* # E+0.25D0*E2-0.5D0*YB-0.25D0*YB2)+RLNOMYB*RLNOME- # RLNOMYB*RLNOMXR+RLNRME*(-0.5D0+0.5D0*E+0.25*E2-R)+ # RLNXR*(YB+0.5D0*YB2+0.5D0*XR+0.25D0*XR2) * BELL= BELL+RLNOMXR*(-0.5D0*YB-0.25D0*YB2)+RLNRMXR # *(0.5D0-0.5D0*XR-0.25D0*XR2+R)+RLNXRMYB*(0.5D0*YB+ # 0.25D0*YB2-0.5D0*XR-0.25D0*XR2)+RLI2OME-RLI2OMXR- # RLI2ER+RLI2XRR-RLI2EYB+RLI2XRYB * ENDIF * * COMPUTES CONE * IF(OCN.EQ.'Y'.AND.I.EQ.1) THEN EPSM= -1.D-37 PI2= PI*PI ENERGY= 0.5D0*SQRT(S) X= S0/S THRESH= X*ENERGY RHO2= DEL*DEL*ENERGY*ENERGY/FM2 EPS= 1.D0-THRESH/ENERGY OMEPS= 1.D0-EPS ZERO= X02AKF() * IF(EPS.LE.ZERO) THEN CONE= 1.D-35 ELSE ALD= LOG(1.D0+RHO2*OMEPS*OMEPS) ALEPS= LOG(EPS) ALOMEPS= LOG(OMEPS) RLI2EPS= TRSPENCE(EPS,EPSM) CONE= 2.D0*(-(ALD-1.D0))*ALEPS+2.D0*((0.25D0 # -(1.D0-0.5D0*EPS)*(1.D0-0.5D0*EPS))*ALD # -PI2/3.D0+9.D0/4.D0-2.5D0*EPS+0.25D0*EPS*EPS # +2.D0*ALEPS*ALOMEPS+2.D0*RLI2EPS) ENDIF ELSE CONE= 0.D0 ENDIF IF(OFS.EQ.'D') THEN AFSCL= 2.D0*(-AL-1.D0)*RLOMX AFSCR= TRIA-BELL+CONE-AFSCL TFSCFMB= EXP(API*AFSCL)*(1.D0+API*AFSCR-APIS*(AFSCL*AFSCR+ # 0.D0*(PI*PI/3.D0-9.D0/8.D0)*AL*AL)) ELSE IF(OFS.EQ.'Z') THEN AFSCL= 2.D0*(-AL-1.D0)*RLOMX SSOFT= -1.5D0*AL+PI*PI/3.D0-2.D0 AFSCR= TRIA-BELL+CONE-AFSCL-SSOFT TFSCFMB= EXP(API*AFSCL)*(1.D0+API*SSOFT)+API*AFSCR ENDIF * RETURN END * *-----WEAK----------------------------------------------------------------- * INITIALIZES THE INGREDIENTS NEEDED IN THE S-CHANNEL WEAK * CORRECTIONS (THOSE NOT IN CONVOLUTION) * SUBROUTINE TWEAK(MAXE,ORS,KO) IMPLICIT REAL*8 (A-H,I,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8,OWBOX,OIFAIL * PARAMETER(MNRS=30,NO=7) PARAMETER (NDIM=1,MNFN=4*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+ # MXCLS/IRCLS),LENWRK=10*LENWRK0) * COMMON/TESC/SE COMMON/TIBOX/NB COMMON/TBOX/OWBOX COMMON/TIFL/OIFAIL COMMON/TIPARBOX/MXE COMMON/TICOUPLING/NF COMMON/TRESUM/JRESUM COMMON/TIMAG/PGGFI(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TPARBOX/BSA(MNRS),BFI3(4),BBQF(4),BFM(4),BFMD(4), # RCHS(MNRS),AICHS(MNRS) COMMON/TCOBOX/CZZ(MNRS),CGZR(MNRS),CZW(MNRS),CGWR(MNRS), # CGZI(MNRS),CGWI(MNRS) COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR COMMON/TWEAKPAR/IPGGF(MNRS),IDSTH2(MNRS), # DELGG(MNRS,NO),DELZZP(MNRS,NO), # DELZZM(MNRS,NO),DELGZP1(MNRS,NO), # DELGZP2(MNRS,NO),DELGZP3(MNRS,NO), # DELGZP4(MNRS,NO),DELGZM1(MNRS,NO), # DELGZM2(MNRS,NO),DELGZM3(MNRS,NO), # DELGZM4(MNRS,NO),FBOX(MNRS,NO),BBOX(MNRS,NO) * DIMENSION ORS(MAXE) DIMENSION XL(NDIM),XU(NDIM),AESTBF(MNFN),FESTBF(MNFN), # WRKSTR(LENWRK),AESTBB(MNFN),FESTBB(MNFN) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFUBB * G2= GWEAK*RHO G4= G2*G2 * *-----STARTS THE COMPUTATION OF THE ELEMENTS NEEDED FOR *-----THE CROSS SECTIONS * *-----SELECTS SPECIFIED QUANTUM NUMBERS * DO JE= 1,MAXE RS= ORS(JE) QRS= RS*1.D15*1.Q-15 S= RS*RS QS= QRS*QRS S2= S*S SMZM2= S-ZM2 ZWD= S/ZM2*WT DENS= SMZM2*SMZM2+ZM2*ZWD*ZWD RCHI= S*SMZM2/DENS EI3= ZID SEI3= -1.D0 BQE= BQL TQE= 2.D0*BQE P2= -S QP2= -QS * IF(JRESUM.EQ.0) THEN CDSTH2= 0.D0 ELSE IF(JRESUM.EQ.1) THEN CDSTH2= SIGBNR/CMSTH2-(S3GZ+STH2*ZM2*PZ)/ZM2 ENDIF * *-----INITIALIZES THE E^+E^- VERTICES * V0E= EI3-TQE*STH2 V0E2= V0E*V0E FZ= DELZ-0.5D0 FW= DELW-0.5D0 * *-----ELECTRON WAVE-FUNCTION FACTORS * WVE= -1.D0/32.D0/CTH2*(4.D0*V0E2+1.D0)*FZ # -1.D0/8.D0*FW WAE= -1.D0/16.D0/CTH2*(1.D0-8.D0*EI3*BQE*STH2)*FZ # -1.D0/8.D0*FW * *-----COMPUTES THE IMAGINARY PARTS * CALL TALALS(QP2,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2,PGGFS,PGGFLS,PGGLQS,PGGBS,PGGNPS,PPGGS,PPGGNPS, # GGIS,GZIS,GGISS,GZISS,GGIWS,PGGHOS) CALL TVBSELF(QP2,S3GSF,S33SF,S3GSB,S33SB,SP3GS,SP33S, # S33IWS,S3GIWS) QP2Z= -QZM2 CALL TALALS(QP2Z,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2Z,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # GGIZ,GZIZ,GGIZQ,GZIZQ,GGIZS,PGGHOZ) PIFS= PGGFS-PGGF0+PGGHOS+PGGNPS PIBS= PGGBS-PGGB0 PIFSNS= PGGFS+PGGLQS PIBSNS= PGGBS AEXPH= AEXP/(1.D0-AEXP*PIFS) * IF(OU1.EQ.'N') THEN AX= AEXP TAX= 2.D0*AEXP ELSE IF(OU1.EQ.'Y') THEN AX= AEXPH TAX= 2.D0*AEXPH ENDIF * *-----FERMIONIC IM PARTS * FOS= 4.D0/S IF(S.GT.4.D0*EM2) THEN BE= SQRT(1.D0-FOS*EM2) XBE= BE*BE-3.D0 ELSE BE= 0.D0 XBE= 0.D0 ENDIF IF(S.GT.4.D0*MM2) THEN BM= SQRT(1.D0-FOS*MM2) XBM= BM*BM-3.D0 ELSE BM= 0.D0 XBM= 0.D0 ENDIF IF(S.GT.4.D0*TLM2) THEN BT= SQRT(1.D0-FOS*TLM2) XBT= BT*BT-3.D0 ELSE BT= 0.D0 XBT= 0.D0 ENDIF IF(S.GT.4.D0*UQM2) THEN BU= SQRT(1.D0-FOS*UQM2) XBU= BU*BU-3.D0 ELSE BU= 0.D0 XBU= 0.D0 ENDIF IF(S.GT.4.D0*DQM2) THEN BD= SQRT(1.D0-FOS*DQM2) XBD= BD*BD-3.D0 ELSE BD= 0.D0 XBD= 0.D0 ENDIF IF(S.GT.4.D0*CQM2) THEN BC= SQRT(1.D0-FOS*CQM2) XBC= BC*BC-3.D0 ELSE BC= 0.D0 XBC= 0.D0 ENDIF IF(S.GT.4.D0*SQM2) THEN BS= SQRT(1.D0-FOS*SQM2) XBS= BS*BS-3.D0 ELSE BS= 0.D0 XBS= 0.D0 ENDIF IF(S.GT.4.D0*BQM2) THEN BB= SQRT(1.D0-FOS*BQM2) XBB= BB*BB-3.D0 ELSE BB= 0.D0 XBB= 0.D0 ENDIF IF(S.GT.4.D0*TQM2) THEN BTQ= SQRT(1.D0-FOS*TQM2) XBTQ= BTQ*BTQ-3.D0 ELSE BTQ= 0.D0 XBTQ= 0.D0 ENDIF * *-----IF NEEDED BOSONIC TOO * IF(S.GT.4.D0*WM2) THEN BETAW= SQRT(1.D0-FOS*WM2) BETAW2= BETAW*BETAW IDSTH2B= PI*BETAW*(-4.D0+5.D0/6.D0*BETAW2- # 2.D0*WM2/S+STH2*(4.D0-BETAW2)) ELSE IDSTH2B= 0.D0 ENDIF * IPGGF(JE)= 2.D0/3.D0*PI*(BE*XBE+BM*XBM+BT*XBT+ # 4.D0/3.D0*(BU*XBU+BC*XBC+BTQ*XBTQ)+ # 1.D0/3.D0*(BD*XBD+BS*XBS+BB*XBB))+GGISS * IDSTH2(JE)= -PI/6.D0*(BE*XBE+BM*XBM+BT*XBT+2.D0*(BU*XBU+ # BC*XBC+BTQ*XBTQ)+BD*XBD+BS*XBS+BB*XBB)+ # 2.D0/3.D0*PI*STH2*(BE*XBE+BM*XBM+BT*XBT+ # 4.D0/3.D0*(BU*XBU+BC*XBC+BTQ*XBTQ)+ # 1.D0/3.D0*(BD*XBD+BS*XBS+BB*XBB))-GZISS/P2+ # STH2*GGISS * CFACT= 1.D0-AEXP*PIFS AIPGGF= AEXP*IPGGF(JE) DENA= CFACT*CFACT+AIPGGF*AIPGGF RALH= AEXP*CFACT/DENA IALH= AEXP*AIPGGF/DENA * CZZ(JE)= G2*GWEAK*AX/CSTH2 CGZR(JE)= 8.D0*GWEAK*AX*RALH*PIS/CSTH2 CGZI(JE)= 8.D0*GWEAK*AX*IALH*PIS/CSTH2 CZW(JE)= G2*GWEAK*AX/4.D0*CTTH2 CGWR(JE)= 2.D0*GWEAK*AX*RALH*PIS*CTTH2 CGWI(JE)= 2.D0*GWEAK*AX*IALH*PIS*CTTH2 * *-----COMPUTES CORRECTIONS TO THE Z^0 PROPAGATOR, W_Z FACTORS * S33S= S33SF+S33SB S3GS= S3GSF+S3GSB PS= PIFS+PIBS PSNS= PIFSNS+PIBSNS * DS= ABS(RS-SQRT(ZM2)) IF(DS.LT.0.5D0) THEN DPIZS= (SWW0B-S33BZ-S3GFZ-ZM2*SP33Z+ # 2.D0*STH2*(S3GZ+ZM2*SP3GZ)+STH4*ZM2*ZM2* # (PPGGZ+PPGGNPZ))/ZM2 ELSE DPIZS= (SWW0B-S33BZ+2.D0*STH2*S3GZ-S3GFZ+STH4*ZM2*PZ+ # ZM2/SMZM2*(S33S-2.D0*STH2*S3GS-STH4*S*PS- # S33Z+2.D0*STH2*S3GZ+STH4*ZM2*PZ))/ZM2 ENDIF * IF(S.GT.4.D0*WM2) THEN WZI= (S33IWS-2.D0*STH2*S3GIWS+STH4*P2*GGIWS)/SMZM2/CSTH2 ELSE WZI= 0.D0 ENDIF WZ= DPIZS/CSTH2 WG= PIBS WGBI= GGIWS WZMWG= WZ-WG * *-----AUXILIARY FUNCTIONS FOR VERTICES: ALL INTERNAL FERMION MASSES *-----ARE ASSUMED TO BE THE SAME * QZER= 0.Q0 AF1= QFS(1,1,QP2,QZER,QWM2,QZER) AF2= QFS(2,1,QP2,QWM2,QZER,QWM2) AF3= QFS(1,2,QP2,QZER,QWM2,QZER) AF4= QFS(2,2,QP2,QWM2,QZER,QWM2) AF5= QFS(1,1,QP2,QZER,QZM2,QZER) AF6= QFS(1,2,QP2,QZER,QZM2,QZER) * *-----COMPUTES THE RESIDUAL CORRECTIONS TO THE RUNNING OF SIN(THETA) * IF(JRESUM.EQ.0) THEN RDSTH2= CDSTH2+(S3GS+STH2*S*PSNS)/S ELSE IF(JRESUM.EQ.1) THEN RDSTH2= CDSTH2+(S3GS+STH2*S*PS)/S ENDIF * *-----COMPUTES THE Z^0 E^+E^- VERTEX * FA1= V0E2+3.D0/4.D0 FA2= 3.D0*V0E2+0.25D0 FA3= V0E2+0.25D0 * AUXRZE= EI3*(4.D0*AF1-2.D0*CTH2*AF2-CTH2*DELW) AUXIZE= 2.D0*EI3*(2.D0*AF3-CTH2*AF4) RVZE0= WVE*V0E+WAE*EI3-TSCTH2*V0E*FA1*AF5+AUXRZE RAZE0= WVE*EI3+WAE*V0E-TSCTH2*EI3*FA2*AF5+AUXRZE IVZE0= -TSCTH2*V0E*FA1*AF6+AUXIZE IAZE0= -TSCTH2*EI3*FA2*AF6+AUXIZE * *----COMPUTES THE GAMMA E^+E^- VERTEX (QE= -1 EXTRACTED) * AUXRGE= SEI3*AF2 AUXIGE= SEI3*AF4 * RVGE0= 2.D0*WVE-FSCTH2*FA3*AF5+AUXRGE+EI3*DELW RAGE0= 2.D0*WAE+FSCTH2*V0E*AF5+AUXRGE+EI3*DELW IVGE0= -FSCTH2*FA3*AF6+AUXIGE IAGE0= +FSCTH2*V0E*AF6+AUXIGE * RVGE= RVGE0/STH2 IVGE= IVGE0/STH2+0.5D0*WGBI RAGE= RAGE0/STH2 IAGE= IAGE0/STH2 RVZE= 2.D0*RVZE0/STH2+2.D0*RDSTH2 IVZE= 2.D0*IVZE0/STH2+2.D0*IDSTH2B-0.5D0*V0E*WZI RAZE= 2.D0*RAZE0/STH2 IAZE= 2.D0*IAZE0/STH2+0.25D0*WZI * *-----CORRECTION FACTORS FOR THE CROSS SECTIONS FOR ALL *-----FERMIONIC FINAL STATES * DO JCS= 1,7 * *-----MU * IF(JCS.EQ.1) THEN FI3= ZID BQF= BQL BQFD= 0.D0 FM= MM FMD= NM * *-----TAU * ELSE IF(JCS.EQ.2) THEN FI3= ZID BQF= BQL BQFD= 0.D0 FM= TLM FMD= NM * *-----UP * ELSE IF(JCS.EQ.3) THEN FI3= ZIU BQF= BQUQ BQFD= BQDQ FM= UQM FMD= DQM * *-----CHARM * ELSE IF(JCS.EQ.4) THEN FI3= ZIU BQF= BQUQ BQFD= BQDQ FM= CQM FMD= SQM * *-----DOWN * ELSE IF(JCS.EQ.5) THEN FI3= ZID BQF= BQDQ BQFD= BQUQ FM= DQM FMD= UQM * *-----STRANGE * ELSE IF(JCS.EQ.6) THEN FI3= ZID BQF= BQDQ BQFD= BQUQ FM= SQM FMD= CQM * *-----BOTTOM * ELSE IF(JCS.EQ.7) THEN FI3= ZID BQF= BQDQ BQFD= BQUQ FM= BQM FMD= SQRT(TQM2) ENDIF * SFI3= 2.D0*FI3 TQF= 2.D0*BQF BQF2= BQF*BQF * *-----INITIALIZES THE F-FB VERTICES * V0F= FI3-TQF*STH2 V0F2= V0F*V0F V0EF= V0E*V0F * IF(JCS.LT.7) THEN IF(JCS.EQ.1.OR.JCS.EQ.2) THEN WVF= WVE WAF= WAE ELSE * *-----FERMION WAVE-FUNCTION FACTORS (NOT B QUARK) * WVF= -1.D0/32.D0/CTH2*(4.D0*V0F2+1.D0)*FZ # -1.D0/8.D0*FW WAF= -1.D0/16.D0/CTH2*(1.D0-8.D0*FI3*BQF*STH2)*FZ # -1.D0/8.D0*FW ENDIF ELSE IF(JCS.EQ.7) THEN * *-----B QUARK WAVE-FUNCTION FACTORS * CALL TRBFF0(QTQM2,QWM2,QB00TW,QB10TW,QB210TW) B00TW= QB00TW B10TW= QB10TW B210TW= QB210TW * WVF= -1.D0/32.D0/CTH2*(4.D0*V0F2+1.D0)*FZ # -1.D0/8.D0*(-1.D0-(2.D0+TQM2/WM2)*B10TW) WAF= -1.D0/16.D0/CTH2*(1.D0-8.D0*FI3*BQF*STH2)*FZ # -1.D0/8.D0*(-1.D0-(2.D0+TQM2/WM2)*B10TW) ENDIF * *-----COMPUTES THE Z^0 FB-F VERTEX * *-----COMPUTES THE GAMMA FB-F VERTEX (QF FACTOR EXTRACTED) * FB1= V0F2+3.D0/4.D0 FB2= 3.D0*V0F2+0.25D0 FB3= V0F2+0.25D0 * *-----F NOT B * IF(JCS.LT.7) THEN AUXRZF= FI3*(4.D0*AF1-CTH2*(2.D0*AF2+DELW)) # +4.D0*AF1*BQFD*STH2 AUXIZF= 2.D0*FI3*(2.D0*AF3-CTH2*AF4)+4.D0*AF3*BQFD*STH2 * RVZF0= WVF*V0F+WAF*FI3-TSCTH2*V0F*FB1*AF5+AUXRZF RAZF0= WVF*FI3+WAF*V0F-TSCTH2*FI3*FB2*AF5+AUXRZF IVZF0= -TSCTH2*V0F*FB1*AF6+AUXIZF IAZF0= -TSCTH2*FI3*FB2*AF6+AUXIZF * AUXRGF= 4.D0*BQFD*AF1+SFI3*AF2 AUXIGF= 4.D0*BQFD*AF3+SFI3*AF4 * RVGF0= 2.D0*WVF-FSCTH2*FB3*AF5-(AUXRGF+FI3*DELW)/BQF RAGF0= 2.D0*WAF-2.D0*FI3*V0F*FSCTH2*AF5- # (AUXRGF+FI3*DELW)/BQF IVGF0= -FSCTH2*FB3*AF6-AUXIGF/BQF IAGF0= -2.D0*FI3*V0F*FSCTH2*AF6-AUXIGF/BQF * *-----F = B * ELSE IF(JCS.EQ.7) THEN * BF7= QF(3,1,QP2,QBQM,QTQM2,QWM2,QTQM2) BF8= QF(3,2,QP2,QBQM,QTQM2,QWM2,QTQM2) BF9= QF(4,1,QP2,QBQM,QWM2,QTQM2,QWM2) BF10= QF(4,2,QP2,QBQM,QWM2,QTQM2,QWM2) BF11= QF(5,1,QP2,QBQM,QTQM2,QWM2,QTQM2) BF12= QF(5,2,QP2,QBQM,QTQM2,QWM2,QTQM2) BF13= QF(6,1,QP2,QBQM,QTQM2,QWM2,QTQM2) BF14= QF(6,2,QP2,QBQM,QTQM2,QWM2,QTQM2) BF15= QF(7,1,QP2,QBQM,QTQM2,QWM2,QTQM2) BF16= QF(7,2,QP2,QBQM,QTQM2,QWM2,QTQM2) BF17= QF(8,1,QP2,QBQM,QWM2,QTQM2,QWM2) BF18= QF(8,2,QP2,QBQM,QWM2,QTQM2,QWM2) BF19= QF(9,1,QP2,QBQM,QWM2,QTQM2,QWM2) BF20= QF(9,2,QP2,QBQM,QWM2,QTQM2,QWM2) BF21= QF(10,1,QP2,QBQM,QWM2,QTQM2,QWM2) BF22= QF(10,2,QP2,QBQM,QWM2,QTQM2,QWM2) * AUXRZF= V0F*4.D0*BF13-1.D0/3.D0*STH2*BF15+CTH2*BF17 # -CMSTH2/4.D0*BF19+0.5D0*STH2*BF21 # -FI3*CTH2*DELW AUXIZF= V0F*4.D0*BF14-1.D0/3.D0*STH2*BF16+CTH2*BF18 # -CMSTH2/4.D0*BF20+0.5D0*STH2*BF22 * RVZF0= WVF*V0F+WAF*FI3-TSCTH2*V0F*FB1*AF5+AUXRZF RAZF0= WVF*FI3+WAF*V0F-TSCTH2*FI3*FB2*AF5+AUXRZF IVZF0= -TSCTH2*V0F*FB1*AF6+AUXIZF IAZF0= -TSCTH2*FI3*FB2*AF6+AUXIZF * AUXRGF= 4.D0*BQFD*AF1+SFI3*AF2-1.D0/3.D0*TQM2*BF11+ # BF7+BF9 AUXIGF= 4.D0*BQFD*AF3+SFI3*AF4-1.D0/3.D0*TQM2*BF12+ # BF8+BF10 * RVGF0= 2.D0*WVF-FSCTH2*FB3*AF5-(AUXRGF+FI3*DELW)/BQF RAGF0= 2.D0*WAF-2.D0*FI3*V0F*FSCTH2*AF5- # (AUXRGF+FI3*DELW)/BQF IVGF0= -FSCTH2*FB3*AF6-AUXIGF/BQF IAGF0= -2.D0*FI3*V0F*FSCTH2*AF6-AUXIGF/BQF ENDIF * RVGF= RVGF0/STH2 IVGF= IVGF0/STH2+0.5D0*WGBI RAGF= RAGF0/STH2 IAGF= IAGF0/STH2 RVZF= 2.D0*RVZF0/STH2-TQF*RDSTH2 IVZF= 2.D0*IVZF0/STH2-TQF*IDSTH2B-0.5D0*V0F*WZI RAZF= 2.D0*RAZF0/STH2 IAZF= 2.D0*IAZF0/STH2-0.5D0*FI3*WZI * *-----COMPUTES THE CORRECTION FACTORS FOR THE TOTAL CROSS SECTION *-----AND THE ASYMMETRY, BOXES EXCLUDED * V0P2= V0E2+V0F2 V0T2= V0E2*V0F2 RVGEF= RVGE+RVGF IVGEF= IVGE+IVGF VER1= V0E*RVZE+V0F*RVZF VER2= V0E*RVZF+V0F*RVZE FCTE= SFI3*V0E VER3= V0F*RAGF-FCTE*RAGE VER4= V0F*RAGE-FCTE*RAGF VER5= V0F*IAGE-FCTE*IAGF VER6= V0F*IAGF-FCTE*IAGE VER7= -RAZF+FI3*(WZMWG-RVGEF+2.D0*RAZE) VER8= V0E*IVZF+V0F*IVZE VER9= IAZF-FI3*(IVGEF+2.D0*IAZE) VER10= WZMWG-RVGEF VER11= WZ+2.D0*(RAZE-SFI3*RAZF) VER12= RAZF-SFI3*(RAZE+WZ) VER13= V0F2*RAZE-SFI3*V0E2*RAZF * *-----CORRECTIONS FOR GG * DELGG(JE,JCS)= TAX*(WG+RVGEF) * *-----CORRECTIONS FOR ZZ * DELZZP(JE,JCS)= TAX*(-VER11+4.D0*VER1-4.D0*(V0P2*WZ+ # 2.D0*VER13)+16.D0*(V0EF*VER2-V0T2*WZ)) DELZZM(JE,JCS)= 32.D0*AX*(FI3*VER2+V0EF*VER12) * *-----CORRECTIONS FOR ZG * DELGZP1(JE,JCS)= AX*(-2.D0*VER2+VER4) DELGZP2(JE,JCS)= AX*(2.D0*VER8+VER5) DELGZP3(JE,JCS)= AX*(-2.D0*VER2+VER4) DELGZP4(JE,JCS)= 2.D0*V0EF*VER10*AX * DELGZM1(JE,JCS)= VER7*AX DELGZM2(JE,JCS)= AX*(VER9-VER6) DELGZM3(JE,JCS)= -VER3*AX DELGZM4(JE,JCS)= -VER3*AX * PGGFI(JE)= IPGGF(JE) * ENDDO ENDDO * *-----CORRECTIONS FOR BOXES: SPECIAL NUMERATION * JCS=1,2,3,4 FOR F=L,UQ,DQ,BQ * IF(NB.EQ.1) THEN JCSM= 1 ELSE IF(NB.EQ.0) THEN JCSM= 3 ENDIF * IF(OWBOX.EQ.'N') THEN DO JE=1,MAXE DO JCS=JCSM,7 FBOX(JE,JCS)= 0.D0 BBOX(JE,JCS)= 0.D0 ENDDO ENDDO * *-----WEAK BOXES * ELSE IF(OWBOX.EQ.'Y') THEN MXE= MAXE IF(NB.EQ.1) THEN NFN= 4*MAXE BFI3(1)= ZID BBQF(1)= BQL BFM(1)= MM BFMD(1)= NM BFI3(2)= ZIU BBQF(2)= BQUQ BFM(2)= UQM BFMD(2)= DQM BFI3(3)= ZID BBQF(3)= BQDQ BFM(3)= DQM BFMD(3)= UQM BFI3(4)= ZID BBQF(4)= BQDQ BFM(4)= BQM BFMD(4)= SQRT(TQM2) ELSE IF(NB.EQ.0) THEN NFN= 3*MAXE BFI3(1)= ZIU BBQF(1)= BQUQ BFM(1)= UQM BFMD(1)= DQM BFI3(2)= ZID BBQF(2)= BQDQ BFM(2)= DQM BFMD(2)= UQM BFI3(3)= ZID BBQF(3)= BQDQ BFM(3)= BQM BFMD(3)= SQRT(TQM2) ENDIF * DO JE= 1,MAXE RS= ORS(JE) S= RS*RS BSA(JE)= S S2= S*S SMZM2= S-ZM2 ZWD= S/ZM2*WT DENS= SMZM2*SMZM2+ZM2*ZWD*ZWD RCHS(JE)= S*SMZM2/DENS AICHS(JE)= -S*SQRT(ZM2)*ZWD/DENS ENDDO DTR= PI/180.D0 THC= 0.0D0 THMIN= THC*DTR CM= COS(THMIN) * *-----ONE-DIM. FORWARD INTEGRATION OF BOXES * DO I= 1,NDIM XL(I)= 0.D0 XU(I)= CM ENDDO MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-2*SE 40 IF(OIFAIL.EQ.'Y') THEN JFAIL= -1 ELSE JFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBB,AEQ,REQ, # LENWRK,WRKSTR,FESTBF,AESTBF,JFAIL) * IF(OIFAIL.EQ.'Y'.AND.JFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY WEAK ' ENDIF IF(JFAIL.GT.0.AND.JFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * DO JE=1,MAXE IF(NB.EQ.1) THEN DO JCS=JCSM,7 IF(JCS.EQ.1) THEN FBOX(JE,1)= FESTBF(JE) ELSE IF(JCS.EQ.2) THEN FBOX(JE,2)= FESTBF(JE) ELSE IF(JCS.EQ.3) THEN FBOX(JE,3)= FESTBF(JE+MAXE) ELSE IF(JCS.EQ.4) THEN FBOX(JE,4)= FESTBF(JE+MAXE) ELSE IF(JCS.EQ.5) THEN FBOX(JE,5)= FESTBF(JE+2*MAXE) ELSE IF(JCS.EQ.6) THEN FBOX(JE,6)= FESTBF(JE+2*MAXE) ELSE IF(JCS.EQ.7) THEN FBOX(JE,7)= FESTBF(JE+3*MAXE) ENDIF ENDDO ELSE IF(NB.EQ.0) THEN DO JCS=JCSM,7 IF(JCS.EQ.3) THEN FBOX(JE,3)= FESTBF(JE) ELSE IF(JCS.EQ.4) THEN FBOX(JE,4)= FESTBF(JE) ELSE IF(JCS.EQ.5) THEN FBOX(JE,5)= FESTBF(JE+MAXE) ELSE IF(JCS.EQ.6) THEN FBOX(JE,6)= FESTBF(JE+MAXE) ELSE IF(JCS.EQ.7) THEN FBOX(JE,7)= FESTBF(JE+2*MAXE) ENDIF ENDDO ENDIF ENDDO * *-----ONE-DIM. BACKWARD INTEGRATION OF THE SOFT CONTRIBUTION * DO I= 1,NDIM XL(I)= -CM XU(I)= 0.D0 ENDDO * MULFAC= 2**NDIM MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-2*SE 50 IF(OIFAIL.EQ.'Y') THEN JFAIL= -1 ELSE JFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBB,AEQ,REQ, # LENWRK,WRKSTR,FESTBB,AESTBB,JFAIL) * IF(OIFAIL.EQ.'Y'.AND.JFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY WEAK ' ENDIF IF(JFAIL.GT.0.AND.JFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 50 ENDIF * DO JE=1,MAXE IF(NB.EQ.1) THEN DO JCS=JCSM,7 IF(JCS.EQ.1) THEN BBOX(JE,1)= FESTBB(JE) ELSE IF(JCS.EQ.2) THEN BBOX(JE,2)= FESTBB(JE) ELSE IF(JCS.EQ.3) THEN BBOX(JE,3)= FESTBB(JE+MAXE) ELSE IF(JCS.EQ.4) THEN BBOX(JE,4)= FESTBB(JE+MAXE) ELSE IF(JCS.EQ.5) THEN BBOX(JE,5)= FESTBB(JE+2*MAXE) ELSE IF(JCS.EQ.6) THEN BBOX(JE,6)= FESTBB(JE+2*MAXE) ELSE IF(JCS.EQ.7) THEN BBOX(JE,7)= FESTBB(JE+3*MAXE) ENDIF ENDDO ELSE IF(NB.EQ.0) THEN DO JCS=JCSM,7 IF(JCS.EQ.3) THEN BBOX(JE,3)= FESTBB(JE) ELSE IF(JCS.EQ.4) THEN BBOX(JE,4)= FESTBB(JE) ELSE IF(JCS.EQ.5) THEN BBOX(JE,5)= FESTBB(JE+MAXE) ELSE IF(JCS.EQ.6) THEN BBOX(JE,6)= FESTBB(JE+MAXE) ELSE IF(JCS.EQ.7) THEN BBOX(JE,7)= FESTBB(JE+2*MAXE) ENDIF ENDDO ENDIF ENDDO * ENDIF * RETURN END * *-----FUNSUBB--------------------------------------------------------- * SUBROUTINE TFUBB(NDIM,X,NFN,F) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 CHARACTER*1 OWBOX * PARAMETER(MNRS=30) * COMMON/TIBOX/NB COMMON/TBOX/OWBOX COMMON/TIPARBOX/MXE COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TPARBOX/BSA(MNRS),BFI3(4),BBQF(4),BFM(4),BFMD(4), # RCHS(MNRS),AICHS(MNRS) COMMON/TCOBOX/CZZ(MNRS),CGZR(MNRS),CZW(MNRS),CGWR(MNRS), # CGZI(MNRS),CGWI(MNRS) * DIMENSION X(NDIM),F(NFN) DIMENSION Q0S1T(2),Q1S1T(2,3),Q2S1T(2,7) DIMENSION Q0S2T(2),Q1S2T(2,3),Q2S2T(2,7) DIMENSION Q0S3T(2),Q1S3T(2,3),Q2S3T(2,7) DIMENSION Q0S4T(2),Q1S4T(2,3),Q2S4T(2,7) * DIMENSION Q0S1(2),Q1S1(2,3),Q2S1(2,7) DIMENSION Q0S2(2),Q1S2(2,3),Q2S2(2,7) DIMENSION Q0S3(2),Q1S3(2,3),Q2S3(2,7) DIMENSION Q0S4(2),Q1S4(2,3),Q2S4(2,7) * VE= -0.5D0+2.D0*STH2 VEP= STH2 VEM= -0.5D0+STH2 IF(NB.EQ.1) THEN JCSM= 4 ELSE IF(NB.EQ.0) THEN JCSM= 3 ENDIF DO JE=1,MXE DO JCS=1,JCSM K= MXE*(JCS-1)+JE QS= BSA(JE)*1.D15*1.Q-15 QFM= BFM(JCS)*1.D15*1.Q-15 QFM2= QFM*QFM QFMD= BFMD(JCS)*1.D15*1.Q-15 QFMD2= QFMD*QFMD QC= X(1)*1.D15*1.Q-15 QEB2= QS/4.Q0 QT= QEM2+QFM2-2.Q0*QEB2+2.Q0*SQRT(QEB2-QEM2)* # SQRT(QEB2-QFM2)*QC QU= 2.Q0*(QEM2+QFM2)-QS-QT QS2= QS*QS QT2= QT*QT QU2= QU*QU QT3= QT2*QT QU3= QU2*QU * *-----COMPUTES THE BOX CROSS SECTIONS * QP2S= -QS QP2T= -QT QP2U= -QU LFLAG= 1 JFLAG= 1 QPE2= -QEM2 QPF2= -QFM2 QZER= 0.Q0 IF(JCS.EQ.JCSM) THEN * *-----DIRECT Z0 * CALL TDFF(LFLAG,JFLAG,QPE2,QPF2,QP2S,QP2T, # QFM2,QZM2,QEM2,QZM2,Q0S1T,Q1S1T,Q2S1T) * *-----CROSSED Z0 * CALL TDFF(LFLAG,JFLAG,QPE2,QPF2,QP2S,QP2U, # QFM2,QZM2,QEM2,QZM2,Q0S3T,Q1S3T,Q2S3T) * *-----DIRECT W * IF(BBQF(JCS).LT.0.Q0) THEN CALL TDFF(LFLAG,JFLAG,QPE2,QPF2,QP2S,QP2T, # QFMD2,QWM2,QNM2,QWM2,Q0S2T,Q1S2T,Q2S2T) * *-----CROSSED W * ELSE IF(BBQF(JCS).GT.0.Q0) THEN CALL TDFF(LFLAG,JFLAG,QPE2,QPF2,QP2S,QP2U, # QFMD2,QWM2,QNM2,QWM2,Q0S4T,Q1S4T,Q2S4T) * ENDIF * ELSE * *-----DIRECT Z0 * CALL TDFFS(QP2S,QP2T,QFM2,QZM2,QZER,QZM2, # Q0S1T,Q1S1T,Q2S1T) * *-----CROSSED Z0 * CALL TDFFS(QP2S,QP2U,QFM2,QZM2,QZER,QZM2, # Q0S3T,Q1S3T,Q2S3T) * *-----DIRECT W * IF(BBQF(JCS).LT.0.Q0) THEN CALL TDFFS(QP2S,QP2T,QFMD2,QWM2,QZER,QWM2, # Q0S2T,Q1S2T,Q2S2T) * *-----CROSSED W * ELSE IF(BBQF(JCS).GT.0.Q0) THEN CALL TDFFS(QP2S,QP2U,QFMD2,QWM2,QZER,QWM2, # Q0S4T,Q1S4T,Q2S4T) * ENDIF * ENDIF * DO I=1,2 Q0S1(I)= Q0S1T(I) Q1S1(I,1)= Q1S1T(I,1) Q1S1(I,2)= Q1S1T(I,1)-Q1S1T(I,2)+Q1S1T(I,3) Q1S1(I,3)= Q1S1T(I,3) Q2S1(I,1)= Q2S1T(I,1) Q2S1(I,2)= Q2S1T(I,1)+Q2S1T(I,2)+Q2S1T(I,3)- # 2.Q0*(Q2S1T(I,4)-Q2S1T(I,5)+ # Q2S1T(I,6)) Q2S1(I,3)= Q2S1T(I,3) Q2S1(I,4)= Q2S1T(I,1)-Q2S1T(I,4)+Q2S1T(I,5) Q2S1(I,5)= Q2S1T(I,5) Q2S1(I,6)= Q2S1T(I,3)+Q2S1T(I,5)-Q2S1T(I,6) Q2S1(I,7)= Q2S1T(I,7) * IF(BBQF(JCS).LT.0.Q0) THEN Q0S2(I)= Q0S2T(I) Q1S2(I,1)= Q1S2T(I,1) Q1S2(I,2)= Q1S2T(I,1)-Q1S2T(I,2)+Q1S2T(I,3) Q1S2(I,3)= Q1S2T(I,3) Q2S2(I,1)= Q2S2T(I,1) Q2S2(I,2)= Q2S2T(I,1)+Q2S2T(I,2)+Q2S2T(I,3)- # 2.Q0*(Q2S2T(I,4)-Q2S2T(I,5)+ # Q2S2T(I,6)) Q2S2(I,3)= Q2S2T(I,3) Q2S2(I,4)= Q2S2T(I,1)-Q2S2T(I,4)+Q2S2T(I,5) Q2S2(I,5)= Q2S2T(I,5) Q2S2(I,6)= Q2S2T(I,3)+Q2S2T(I,5)-Q2S2T(I,6) Q2S2(I,7)= Q2S2T(I,7) ELSE IF(BBQF(JCS).GT.0.Q0) THEN Q0S4(I)= Q0S4T(I) Q1S4(I,1)= Q1S4T(I,1) Q1S4(I,2)= Q1S4T(I,1)-Q1S4T(I,2)+Q1S4T(I,3) Q1S4(I,3)= Q1S4T(I,3) Q2S4(I,1)= Q2S4T(I,1) Q2S4(I,2)= Q2S4T(I,1)+Q2S4T(I,2)+Q2S4T(I,3)- # 2.Q0*(Q2S4T(I,4)-Q2S4T(I,5)+ # Q2S4T(I,6)) Q2S4(I,3)= Q2S4T(I,3) Q2S4(I,4)= Q2S4T(I,1)-Q2S4T(I,4)+Q2S4T(I,5) Q2S4(I,5)= Q2S4T(I,5) Q2S4(I,6)= Q2S4T(I,3)+Q2S4T(I,5)-Q2S4T(I,6) Q2S4(I,7)= Q2S4T(I,7) ENDIF * Q0S3(I)= Q0S3T(I) Q1S3(I,1)= Q1S3T(I,1) Q1S3(I,2)= Q1S3T(I,1)-Q1S3T(I,2)+Q1S3T(I,3) Q1S3(I,3)= Q1S3T(I,3) Q2S3(I,1)= Q2S3T(I,1) Q2S3(I,2)= Q2S3T(I,1)+Q2S3T(I,2)+Q2S3T(I,3)- # 2.Q0*(Q2S3T(I,4)-Q2S3T(I,5)+ # Q2S3T(I,6)) Q2S3(I,3)= Q2S3T(I,3) Q2S3(I,4)= Q2S3T(I,1)-Q2S3T(I,4)+Q2S3T(I,5) Q2S3(I,5)= Q2S3T(I,5) Q2S3(I,6)= Q2S3T(I,3)+Q2S3T(I,5)-Q2S3T(I,6) Q2S3(I,7)= Q2S3T(I,7) * ENDDO * VF= BFI3(JCS)-2.D0*BBQF(JCS)*STH2 VFP= -BBQF(JCS)*STH2 VFM= BFI3(JCS)-BBQF(JCS)*STH2 * VMM= VEM*VFM VMP= VEM*VFP VPM= VEP*VFM VPP= VEP*VFP RKA= VPP*VPP*VPP+VMM*VMM*VMM RKB= VPM*VPM*VPM+VMP*VMP*VMP RLA= VPP*VPP+VMM*VMM RLB= VPM*VPM+VMP*VMP RH= VMM * FCGZR= -256.D0/BSA(JE)*CGZR(JE)*BBQF(JCS) FCGZI= -256.D0/BSA(JE)*CGZI(JE)*BBQF(JCS) * FCGWR= -256.D0/BSA(JE)*CGWR(JE)*BBQF(JCS) FCGWI= -256.D0/BSA(JE)*CGWI(JE)*BBQF(JCS) * FCZZ= 1024.D0/BSA(JE)*CZZ(JE) * FCZW= 1024.D0/BSA(JE)*CZW(JE) * CMD1= QT*(QU2*RLA+QT2*RLB) CMD2= QT3*RLB CMD3= QT*(QU2*RLA+2.D0*QT2*RLB) CMD4= QT*QU*(-QU*RLA+2.D0*QT*RLB) CMD5= 2.D0*QT2*QS*RLB CMD6= -2.D0*(QU2*RLA+4.D0*QT2*RLB) * CMC1= -QU*(QU2*RLA+QT2*RLB) CMC2= -QU3*RLA CMC3= -QU*(2.D0*QU2*RLA+QT2*RLB) CMC4= -QT*QU*(2.D0*QU*RLA-QT*RLB) CMC5= -2.D0*QU2*QS*RLA CMC6= 2.D0*(4.D0*QU2*RLA+QT2*RLB) * *-----GAMMA X ZZ(DIRECT) * DGDZR= CMD1*Q1S1(1,1)+CMD2*(Q1S1(1,2)-Q1S1(1,3))+ # CMD3*Q2S1(1,4)+CMD4*Q2S1(1,5)+ # CMD5*Q2S1(1,6)+CMD6*Q2S1(1,7) DGDZI= CMD1*Q1S1(2,1)+CMD2*(Q1S1(2,2)-Q1S1(2,3))+ # CMD3*Q2S1(2,4)+CMD4*Q2S1(2,5)+ # CMD5*Q2S1(2,6)+CMD6*Q2S1(2,7) DGDZ= FCGZR*DGDZR+FCGZI*DGDZI * *-----GAMMA X ZZ(CROSSED) * DGCZR= CMC1*Q1S3(1,1)+CMC2*(Q1S3(1,2)-Q1S3(1,3))+ # CMC3*Q2S3(1,4)+CMC4*Q2S3(1,5)+ # CMC5*Q2S3(1,6)+CMC6*Q2S3(1,7) DGCZI= CMC1*Q1S3(2,1)+CMC2*(Q1S3(2,2)-Q1S3(2,3))+ # CMC3*Q2S3(2,4)+CMC4*Q2S3(2,5)+ # CMC5*Q2S3(2,6)+CMC6*Q2S3(2,7) DGCZ= FCGZR*DGCZR+FCGZI*DGCZI * *-----GAMMA X WW * IF(BBQF(JCS).LT.0.Q0) THEN DGWR= QU2*(QT*(Q1S2(1,1)+Q2S2(1,4)-Q2S2(1,5))- # 2.D0*Q2S2(1,7)) DGWI= QU2*(QT*(Q1S2(2,1)+Q2S2(2,4)-Q2S2(2,5))- # 2.D0*Q2S2(2,7)) ELSE IF(BBQF(JCS).GT.0.Q0) THEN DGWR= QU3*(-Q1S4(1,1)-Q1S4(1,2)+Q1S4(1,3)- # 2.D0*Q2S4(1,4))+QU2*(-2.D0*QT*Q2S4(1,5)- # 2.D0*QS*Q2S4(1,6)+8.D0*Q2S4(1,7)) DGWI= QU3*(-Q1S4(2,1)-Q1S4(2,2)+Q1S4(2,3)- # 2.D0*Q2S4(2,4))+QU2*(-2.D0*QT*Q2S4(2,5)- # 2.D0*QS*Q2S4(2,6)+8.D0*Q2S4(2,7)) ENDIF DGW= FCGWR*DGWR+FCGWI*DGWI * CMDZ1= QT*(QU2*RKA+QT2*RKB) CMDZ2= QT3*RKB CMDZ3= QT*(QU2*RKA+2.D0*QT2*RKB) CMDZ4= QT*QU*(-QU*RKA+2.D0*QT*RKB) CMDZ5= 2.D0*QT2*QS*RKB CMDZ6= -2.D0*(QU2*RKA+4.D0*QT2*RKB) * CMCZ1= -QU*(QU2*RKA+QT2*RKB) CMCZ2= -QU3*RKA CMCZ3= -QU*(2.D0*QU2*RKA+QT2*RKB) CMCZ4= -QT*QU*(2.D0*QU*RKA-QT*RKB) CMCZ5= -2.D0*QU2*QS*RKA CMCZ6= 2.D0*(4.D0*QU2*RKA+QT2*RKB) * *-----Z X ZZ(DIRECT) * DZDZR= CMDZ1*Q1S1(1,1)+CMDZ2*(Q1S1(1,2)-Q1S1(1,3))+ # CMDZ3*Q2S1(1,4)+CMDZ4*Q2S1(1,5)+ # CMDZ5*Q2S1(1,6)+CMDZ6*Q2S1(1,7) DZDZI= CMDZ1*Q1S1(2,1)+CMDZ2*(Q1S1(2,2)-Q1S1(2,3))+ # CMDZ3*Q2S1(2,4)+CMDZ4*Q2S1(2,5)+ # CMDZ5*Q2S1(2,6)+CMDZ6*Q2S1(2,7) DZDZ= FCZZ*(RCHS(JE)*DZDZR+AICHS(JE)*DZDZI) * *-----Z X ZZ(CROSSED) * DZCZR= CMCZ1*Q1S3(1,1)+CMCZ2*(Q1S3(1,2)-Q1S3(1,3))+ # CMCZ3*Q2S3(1,4)+CMCZ4*Q2S3(1,5)+ # CMCZ5*Q2S3(1,6)+CMCZ6*Q2S3(1,7) DZCZI= CMCZ1*Q1S3(2,1)+CMCZ2*(Q1S3(2,2)-Q1S3(2,3))+ # CMCZ3*Q2S3(2,4)+CMCZ4*Q2S3(2,5)+ # CMCZ5*Q2S3(2,6)+CMCZ6*Q2S3(2,7) DZCZ= FCZZ*(RCHS(JE)*DZCZR+AICHS(JE)*DZCZI) * *-----Z X WW * IF(BBQF(JCS).LT.0.Q0) THEN DZWR= QU2*(QT*(Q1S2(1,1)+Q2S2(1,4)- # Q2S2(1,5))-2.D0*Q2S2(1,7)) DZWI= QU2*(QT*(Q1S2(2,1)+Q2S2(2,4)- # Q2S2(2,5))-2.D0*Q2S2(2,7)) ELSE IF(BBQF(JCS).GT.0.Q0) THEN DZWR= QU3*(-Q1S4(1,1)-Q1S4(1,2)+ # Q1S4(1,3)-2.D0*Q2S4(1,4))+QU2*(-2.D0*QT* # Q2S4(1,5)-2.D0*QS*Q2S4(1,6)+8.D0*Q2S4(1,7)) DZWI= QU3*(-Q1S4(2,1)-Q1S4(2,2)+ # Q1S4(2,3)-2.D0*Q2S4(2,4))+QU2*(-2.D0*QT* # Q2S4(2,5)-2.D0*QS*Q2S4(2,6)+8.D0*Q2S4(2,7)) ENDIF DZW= RH*FCZW*(RCHS(JE)*DZWR+AICHS(JE)*DZWI) * CONVF= 2.D0*PI*CONV/4.D0/64.D0/PIS/QS F(K)= CONVF*(DGDZ+DGCZ+DGW+DZDZ+DZCZ+DZW) * ENDDO ENDDO RETURN END * *-----WEAKT------------------------------------------------------------ *-----NO CROSS SECTION IS COMPUTED. ONLY WEAK CORRECTION FACTORS * ARE COMPUTED INCLUDING T-T AND S-T CHANNELS * *-----UPGRADED DECEMBER 98. COMPUTES CORRECTIONS AT NOMINAL ENERGIES. * SUBROUTINE TWEAKT(NRS,ORS,ANG) IMPLICIT REAL*8 (A-H,I,O,P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 * PARAMETER(MNRS=30) * COMMON/TRESUM/JRESUM COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TOUTIBA/XX(MNRS,26) COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TQFMASSES/QEM,QMM,QTM,QNM,QUQM,QDQM,QCQM,QSQM,QBQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * DIMENSION ORS(NRS) * DO J=1,MNRS DO JJ=1,26 XX(J,JJ)= 0.D0 ENDDO ENDDO * N1= 1 N2= 2 * P2Z= -ZM2 V= 4.D0*STH2-1.D0 V2= V*V OPV2= 1.D0+V2 * IF(JRESUM.EQ.0) THEN CDSTH2= 0.D0 ELSE IF(JRESUM.EQ.1) THEN CDSTH2= SIGBNR/CMSTH2-(S3GZ+STH2*ZM2*PZ)/ZM2 ENDIF * *-----INITIALIZES THE VERTICES * ZI3= -0.5D0 SI3= 2.D0*ZI3 TQL= 2.D0*BQL VL= ZI3-TQL*STH2 VL2= VL*VL FA1= 3.D0*VL2+0.25D0 FA2= VL2+0.75D0 FA3= VL2+0.25D0 DELW= DELTA-LOG(WM2) DELZ= DELTA-LOG(ZM2) * *-----FERMION WAVE-FUNCTION FACTORS * FZ= DELZ-0.5D0 FW= DELW-0.5D0 WV= -1.D0/32.D0/CTH2*(4.D0*VL2+1.D0)*FZ # -1.D0/8.D0*FW WA= -1.D0/16.D0/CTH2*(1.D0-8.D0*ZI3*BQL*STH2)*FZ # -1.D0/8.D0*FW * DO JE=1,NRS RS= ORS(JE) * S= RS*RS QS= S*1.D15*1.Q-15 S2= S*S SMZM2= S-ZM2 * *-----IM OF FERMIONIC PHOTON SELF ENERGY * FOS= 4.D0/S IF(S.GT.4.D0*EM2) THEN BE= SQRT(1.D0-FOS*EM2) YBE= BE*BE-3.D0 ELSE BE= 0.D0 YBE= 0.D0 ENDIF IF(S.GT.4.D0*MM2) THEN BM= SQRT(1.D0-FOS*MM2) YBM= BM*BM-3.D0 ELSE BM= 0.D0 YBM= 0.D0 ENDIF IF(S.GT.4.D0*TLM2) THEN BT= SQRT(1.D0-FOS*TLM2) YBT= BT*BT-3.D0 ELSE BT= 0.D0 YBT= 0.D0 ENDIF IF(S.GT.4.D0*UQM2) THEN BU= SQRT(1.D0-FOS*UQM2) YBU= BU*BU-3.D0 ELSE BU= 0.D0 YBU= 0.D0 ENDIF IF(S.GT.4.D0*DQM2) THEN BD= SQRT(1.D0-FOS*DQM2) YBD= BD*BD-3.D0 ELSE BD= 0.D0 YBD= 0.D0 ENDIF IF(S.GT.4.D0*CQM2) THEN BC= SQRT(1.D0-FOS*CQM2) YBC= BC*BC-3.D0 ELSE BC= 0.D0 YBC= 0.D0 ENDIF IF(S.GT.4.D0*SQM2) THEN BS= SQRT(1.D0-FOS*SQM2) YBS= BS*BS-3.D0 ELSE BS= 0.D0 YBS= 0.D0 ENDIF IF(S.GT.4.D0*BQM2) THEN BB= SQRT(1.D0-FOS*BQM2) YBB= BB*BB-3.D0 ELSE BB= 0.D0 YBB= 0.D0 ENDIF * *-----COMPUTES THE RUNNING ALPHA WITH S * P2S= -S QP2S= -QS CALL TALALS(QP2S,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2S,PGGFS,PGGFLS,PGGLQS,PGGBS,PGGNPS,PPGGS,PPGGNPS, # GGIS,GZIS,GGISS,GZISS,GGIWS,PGGHOS) CALL TVBSELF(QP2S,S3GFS,S33FS,S3GBS,S33BS,SP3GS,SP33S, # S33IWS,S3GIWS) PIFS= PGGFS-PGGF0+PGGHOS+PGGNPS PIBS= PGGBS-PGGB0 PIFSNS= PGGFS+PGGLQS PIBSNS= PGGBS QP2Z= -QZM2 CALL TALALS(QP2Z,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2Z,PGGFZ,PGGFLZ,PGGLQZ,PGGBZ,PGGNPZ,PPGGZ,PPGGNPZ, # GGIZ,GZIZ,GGIZS,GZIZS,GGIWZ,PGGHOZ) * IPGGF= 2.D0/3.D0*PI*(BE*YBE+BM*YBM+BT*YBT+ # 4.D0/3.D0*(BU*YBU+BC*YBC)+1.D0/3.D0*(BD*YBD+ # BS*YBS+BB*YBB))+GGISS * CFACT= 1.D0-AEXP*PIFS AIPGGF= AEXP*IPGGF DENA= CFACT*CFACT+AIPGGF*AIPGGF RALHS= ALPHA*CFACT/DENA IALHS= ALPHA*AIPGGF/DENA ALHS2= RALHS*RALHS+IALHS*IALHS AEXPHS= AEXP/(1.D0-AEXP*PIFS) * IF(OU1.EQ.'N') THEN AXS= AEXP ELSE IF(OU1.EQ.'Y') THEN AXS= AEXPHS ENDIF * *-----COMPUTES CORRECTIONS TO THE Z^0 PROPAGATOR, W_Z FACTORS, S CHANNEL * S33S= S33FS+S33BS S3GS= S3GFS+S3GBS PS= PIFS+PIBS PSNS= PIFSNS+PIBSNS * DS= ABS(RS-SQRT(ZM2)) IF(DS.LT.1.D-2) THEN DPIZS= (SWW0B-S33BZ-S3GFZ-ZM2*SP33Z+ # 2.D0*STH2*(S3GZ+ZM2*SP3GZ)+STH4*ZM2*ZM2* # (PPGGZ+PPGGNPZ))/ZM2 ELSE DPIZS= (SWW0B-S33BZ+2.D0*STH2*S3GZ-S3GFZ+STH4*ZM2*PZ+ # ZM2/SMZM2*(S33S-2.D0*STH2*S3GS-STH4*S*PS- # S33Z+2.D0*STH2*S3GZ+STH4*ZM2*PZ))/ZM2 ENDIF * WZS= DPIZS/CSTH2 * *-----COMPUTES THE RUNNING OF SIN(THETA) WITH S * AR= RALHS/FPI AI= IALHS/FPI * RSTH2S= STR2+(AR-AEXPHZ)*AUX1+ # (AR*AR-AI*AI-AEXPHZ*AEXPHZ)*AUX2 * *-----COMPUTES THE RESIDUAL CORRECTIONS TO THE RUNNING OF SIN(THETA) * IF(JRESUM.EQ.0) THEN RDSTH2S= CDSTH2+(S3GS+STH2*S*PSNS)/S ELSE IF(JRESUM.EQ.1) THEN RDSTH2S= CDSTH2+(S3GS+STH2*S*PS)/S ENDIF IDSTH2S= -PI/6.D0*(BE*YBE+BM*YBM+BT*YBT+2.D0*(BU*YBU+ # BC*YBC)+BD*YBD+BS*YBS+BB*YBB)+2.D0/3.D0*PI*STH2* # (BE*YBE+BM*YBM+BT*YBT+4.D0/3.D0*(BU*YBU+BC*YBC)+ # 1.D0/3.D0*(BD*YBD+BS*YBS+BB*YBB))-GZISS/P2S+ # STH2*GGISS IF(S.GT.4.D0*WM2) THEN BETAW= SQRT(1.D0-FOS*WM2) BETAW2= BETAW*BETAW IDSTH2S= IDSTH2S+PI*BETAW*(-4.D0+5.D0/6.D0*BETAW2- # 2.D0*WM2/S+STH2*(4.D0-BETAW2)) ENDIF ISTH2S= AI*(AUX1+2.D0*AR*AUX2)+AR*IDSTH2S RVS= 4.D0*RSTH2S-1.D0 IVS= 4.D0*ISTH2S RVS2= RVS*RVS IVS2= IVS*IVS VSM2= RVS2+IVS2 VS2= RVS2-IVS2 OPVS2= 1.D0+VS2 OPVSM2S= (1.D0+VSM2)*(1.D0+VSM2) * *-----COMPUTES THE Z^0 VERTEX * *-----S CHANNEL * QZER= 0.Q0 AUXRGS= SI3*QFS(N2,N1,QP2S,QWM2,QZER,QWM2) AUXIGS= SI3*QFS(N2,N2,QP2S,QWM2,QZER,QWM2) * AUXRZS= 4.D0*ZI3*QFS(N1,N1,QP2S,QZER,QWM2,QZER)-CTH2* # AUXRGS-CTH2*ZI3*DELW AUXIZS= 4.D0*ZI3*QFS(N1,N2,QP2S,QZER,QWM2,QZER)-CTH2* # AUXIGS * RAUXFS= QFS(N1,N1,QP2S,QZER,QZM2,QZER) IAUXFS= QFS(N1,N2,QP2S,QZER,QZM2,QZER) * RVZS0= WV*VL+WA*ZI3-2.D0/CTH2*VL*FA2*RAUXFS+AUXRZS RAZS0= WV*ZI3+WA*VL-SI3/CTH2*FA1*RAUXFS+AUXRZS IVZS0= -2.D0/CTH2*VL*FA2*IAUXFS+AUXIZS IAZS0= -SI3/CTH2*FA1*IAUXFS+AUXIZS * *----COMPUTES THE GAMMA VERTEX * *-----S CHANNEL * RVGS0= TQL*WV-4.D0/CTH2*BQL*FA3*RAUXFS-AUXRGS-ZI3*DELW RAGS0= TQL*WA+4.D0*BQL*VL/CTH2*RAUXFS-AUXRGS-ZI3*DELW IVGS0= -4.D0/CTH2*BQL*FA3*IAUXFS-AUXIGS IAGS0= +4.D0*BQL*VL/CTH2*IAUXFS-AUXIGS * *-----PROPAGATORS RESIDUAL CORRECTIONS AND ANGULAR FACTORS * ZW= S/ZM2*WT DENS= SMZM2*SMZM2+ZM2*ZW*ZW RCHIS= S*SMZM2/DENS ICHIS= -S*SQRT(ZM2)*ZW/DENS CHIS2= S2/DENS * RVGS= -RVGS0/STH2 RAGS= -RAGS0/STH2 IVGS= -IVGS0/STH2 IAGS= -IAGS0/STH2 RVZS= 4.D0*RVZS0/STH2+4.D0*RDSTH2S IAZS= 4.D0*IAZS0/STH2 IVZS= 4.D0*IVZS0/STH2 RAZS= 4.D0*RAZS0/STH2 * RAD= ANG/180.D0*PI Z= COS(RAD) T= 2.D0*(EM2-0.25D0*S)*(1.D0-Z) QT= T*1.D15*1.Q-15 U= 4.D0*EM2-S-T T2= T*T U2= U*U ZM2MT= ZM2-T * *-----COMPUTES THE RUNNING ALPHA WITH T * QP2T= -QT CALL TALALS(QP2T,QV1,QA1,QDF1,QV1P,QA1P,QV1I) CALL TPSELF(QP2T,PGGFT,PGGFLT,PGGLQT,PGGBT,PGGNPT,PPGGT,PPGGNPT, # GGIT,GZIT,GGITS,GZITS,GGIWT,PGGHOT) CALL TVBSELF(QP2T,S3GFT,S33FT,S3GBT,S33BT,SP3GT,SP33T, # S33IWT,S3GIWT) PIFT= PGGFT-PGGF0+PGGHOT+PGGNPT PIBT= PGGBT-PGGB0 PIFTNS= PGGFT+PGGLQT PIBTNS= PGGBT * ALHT= ALPHA/(1.D0-AEXP*PIFT) ALHT2= ALHT*ALHT AEXPHT= AEXP/(1.D0-AEXP*PIFT) * IF(OU1.EQ.'N') THEN AXT= AEXP ELSE IF(OU1.EQ.'Y') THEN AXT= AEXPHT ENDIF * *-----COMPUTES CORRECTIONS TO THE Z^0 PROPAGATOR, W_Z FACTORS, T CHANNEL * S33T= S33FT+S33BT S3GT= S3GFT+S3GBT PT= PIFT+PIBT PTNS= PIFTNS+PIBTNS * DPIZT= (SWW0B-S33BZ+2.D0*STH2*S3GZ-S3GFZ+STH4*ZM2*PZ- # ZM2/ZM2MT*(S33T-2.D0*STH2*S3GT-STH4*T*PT- # S33Z+2.D0*STH2*S3GZ+STH4*ZM2*PZ))/ZM2 * WZT= DPIZT/CSTH2 * *-----COMPUTES THE RUNNING OF SIN(THETA) WITH T * BR= ALHT/FPI STH2T= STR2+(BR-AEXPHZ)*AUX1+(BR*BR-AEXPHZ*AEXPHZ)*AUX2 * VT= 4.D0*STH2T-1.D0 VT2= VT*VT OPVT2= 1.D0+VT2 OPVT2S= OPVT2*OPVT2 * *-----COMPUTES THE RESIDUAL CORRECTIONS TO THE RUNNING OF SIN(THETA) * IF(JRESUM.EQ.0) THEN DSTH2T= CDSTH2+(S3GT+STH2*T*PTNS)/T ELSE IF(JRESUM.EQ.1) THEN DSTH2T= CDSTH2+(S3GT+STH2*T*PT)/T ENDIF * *-----COMPUTES THE Z^0 VERTEX * *-----T CHANNEL * AUXGT= SI3*QFS(N2,N1,QP2T,QWM2,QZER,QWM2) AUXRZT= 4.D0*ZI3*QFS(N1,N1,QP2T,QZER,QWM2,QZER)-CTH2* # AUXGT-CTH2*ZI3*DELW * AUXFT= QFS(N1,N1,QP2T,QZER,QZM2,QZER) * VZT0= WV*VL+WA*ZI3-2.D0/CTH2*VL*FA2*AUXFT+AUXRZT AZT0= WV*ZI3+WA*VL-SI3/CTH2*FA1*AUXFT+AUXRZT * *----COMPUTES THE GAMMA VERTEX * *-----T CHANNEL * VGT0= TQL*WV-4.D0/CTH2*BQL*FA3*AUXFT-AUXGT-ZI3*DELW AGT0= TQL*WA+4.D0*BQL*VL/CTH2*AUXFT-AUXGT-ZI3*DELW * *-----RESIDUAL CORRECTIONS AND ANGULAR FACTORS * VGT= -VGT0/STH2 AGT= -AGT0/STH2 VZT= 4.D0*VZT0/STH2+4.D0*DSTH2T AZT= 4.D0*AZT0/STH2 * OP3V2= 1.D0+3.D0*V2 TPV2= 3.D0+V2 WGS= PIBS WGT= PIBT WGMZS= WGS-WZS WGMZT= WGT-WZT WGSMZT= WGS-WZT WGTMZS= WGT-WZS * CGS= WGS+2.D0*RVGS CGT= WGT+2.D0*VGT CZSZSP= OPV2*(-OPV2*WZS+2.D0*(V*RVZS-RAZS)) CZSZSM= 4.D0*V*(V*(WZS+RAZS)-RVZS) CGSZTS= OPV2*(WGS+2.D0*RVGS) CGSZTT= -OPV2*WZT-2.D0*(AZT-V*(VZT-2.D0*AGT)) CZSGTRS= -OPV2*WZS+2.D0*(V*(RVZS-2.D0*AGT)-RAZS) CZSGTRT= OPV2*(WGT+2.D0*VGT) CZSGTI= IAZS-V*IVZS CZTZTP= OPV2*(-OPV2*WZT+2.D0*(V*VZT-AZT)) CZTZTM= 4.D0*V*(V*(WZT+AZT)-VZT) RACC= RALHS*RCHIS+IALHS*ICHIS IACC= RALHS*ICHIS-IALHS*RCHIS CZSGSRP= V*(2.D0*RVZS+V*(WGMZS+2.D0*RVGS))-2.D0*V*RAGS CZSGSRM= -WGMZS+2.D0*(RAZS-RVGS)+2.D0*V*RAGS CZSGSIP= -2.D0*V*(IVZS-V*IVGS)-2.D0*V*IAGS CZSGSIM= -2.D0*(IVGS+IAZS)+2.D0*V*IAGS CZSGSEP= V*(2.D0*(RVZS-RAGS)+V*(WGMZS+2.D0*RVGS)) CZSGSEM= 2.D0*(RAZS-RVGS-V*RAGS)-WGMZS CZSZTRS= -(1.D0+V2*(6.D0+V2))*WZS-2.D0*OP3V2*RAZS+ # 2.D0*V*TPV2*RVZS CZSZTRT= -(1.D0+V2*(6.D0+V2))*WZT-2.D0*OP3V2*AZT+ # 2.D0*V*TPV2*VZT CZSZTI= OP3V2*IAZS-V*TPV2*IVZS CGTZTP= V*(V*(WGMZT+2.D0*VGT)+2.D0*VZT)-2.D0*V*AGT CGTZTM= 2.D0*(AZT-VGT)-WGMZT+2.D0*V*AGT * *-----WRITE THE PARAMETERS FOR THE IBA * XX(JE,1)= RALHS XX(JE,2)= IALHS XX(JE,3)= ALHT XX(JE,4)= RHO XX(JE,5)= RSTH2S XX(JE,6)= ISTH2S XX(JE,7)= STH2T XX(JE,8)= AUX1 XX(JE,9)= AUX2 XX(JE,10)= AXS*CGS XX(JE,11)= AXT*CGT XX(JE,12)= AXS*CGSZTS+AXT*CGSZTT XX(JE,13)= AXT*CGTZTP XX(JE,14)= AXT*CGTZTM XX(JE,15)= AXT*CZTZTP XX(JE,16)= AXT*CZTZTM XX(JE,17)= AXS*CZSGSRP XX(JE,18)= AXS*CZSGSRM XX(JE,19)= AXS*CZSGTRS+AXT*CZSGTRT XX(JE,20)= AXS*CZSZTRS+AXT*CZSZTRT XX(JE,21)= AXS*CZSZSP XX(JE,22)= AXS*CZSZSM XX(JE,23)= AXS*CZSGTI XX(JE,24)= AXS*CZSGSIP XX(JE,25)= AXS*CZSGSIM XX(JE,26)= AXS*CZSZTI * ENDDO * RETURN END * *-----CORRQCD------------------------------------------------------------- *-----COMPUTES ALPHA_S(RUNNING) AND THE VARIOUS QCD CORRECTIONS * QCD CORRECTIONS * SUBROUTINE TCORRQCD(SCAL) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM,MM2,NM2 * COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML * SCAL2= SCAL*SCAL TQM= SQRT(TQM2) ALSR= TRALPHAS(RS0,SCAL,ALS,NF) AEXPS= ALSR/PI RVAR= 0.25D0*SCAL2/TQM2 PSC= RVAR*(-8.D0/135.D0*LOG(4.D0*RVAR)+176.D0/675.D0) RZ4= PIS*PIS/90.D0 * *-----POWER SUPPRESSED CORRECTIONS * A2= 1.40923D0+PSC VCORQ= AEXPS*(1.D0+AEXPS*(A2-12.76706D0*AEXPS)) CSI= SCAL/TQM/2.D0 CSI2= CSI*CSI CSI4= CSI2*CSI2 * AUXLN= LOG(SCAL/TQM) AUXLN2= LOG(TQM2/SCAL2) A3= -15.98773D0+AUXLN2*(-67.D0/18.D0+23.D0/12.D0*AUXLN2) ACORB= AEXPS*(1.D0+AEXPS*(A2-12.76706D0*AEXPS+2.D0*AUXLN- # 3.083D0+0.346D0*CSI2+0.211D0*CSI4+AEXPS*A3)) ACORD= ACORB ACORU= AEXPS*(1.D0+AEXPS*(A2-12.76706D0*AEXPS-2.D0*AUXLN+ # 3.083D0-0.346D0*CSI2-0.211D0*CSI4-AEXPS*A3)) * *-----COMPUTES THE RUNNING BOTTOM MASS * * *-----COMPUTES THE RUNNING CHARM MASS * IF(ALS.EQ.0.D0) THEN RBM= BQM RBM2= BQM2 RCM= CQM RCM2= CQM2 ELSE * SCAL1G= 1.D0 ALS1G= TRALPHAS(RS0,SCAL1G,ALS,NF)/PI ALSC4= TRALPHAS(RS0,CQM,ALS,NF)/PI ALSC42= ALSC4*ALSC4 ALS1G2= ALS1G*ALS1G ALSB= TRALPHAS(RS0,BQM,ALS,NF)/PI ALSB2= ALSB*ALSB ALSZ= TRALPHAS(RS0,SCAL,ALS,NF)/PI ALSZ2= ALSZ*ALSZ * *-----FIRST THE RUNNING OF THE S-QUARK MASS * UP TO C/B-THRESHOLD * FN= 3.D0 B03= (11.D0-2.D0/3.D0*FN)/4.D0 B13= (102.D0-38.D0/3.D0*FN)/16.D0 B23= (2857.D0/2.D0-5033.D0/18.D0*FN+325.D0/54.D0* # FN*FN)/64.D0 G03= 1.D0 G13= (202.D0/3.D0-20.D0/9.D0*FN)/16.D0 G23= (1249.D0-(2216.D0/27.D0+160.D0/3.D0*RZ3)*FN- # 140.D0/81.D0*FN*FN)/64.D0 REX3= G03/B03 B03S= B03*B03 B03C= B03S*B03 B13S= B13*B13 SM1G= 0.189D0 ALSDF= ALSC4-ALS1G CFM13= G13/B03-B13*G03/B03S CFM23= G23/B03-B13*G13/B03S-B23*G03/B03S+ # B13S*G03/B03C RSMC= SM1G*(ALSC4/ALS1G)**REX3*(1.D0+CFM13* # ALSDF+0.5D0*CFM13*CFM13*ALSDF*ALSDF+0.5D0*CFM23* # (ALSC42-ALS1G2)) * FN= 4.D0 B04= (11.D0-2.D0/3.D0*FN)/4.D0 B14= (102.D0-38.D0/3.D0*FN)/16.D0 B24= (2857.D0/2.D0-5033.D0/18.D0*FN+325.D0/54.D0* # FN*FN)/64.D0 G04= 1.D0 G14= (202.D0/3.D0-20.D0/9.D0*FN)/16.D0 G24= (1249.D0-(2216.D0/27.D0+160.D0/3.D0*RZ3)*FN- # 140.D0/81.D0*FN*FN)/64.D0 REX4= G04/B04 B04S= B04*B04 B04C= B04S*B04 B14S= B14*B14 ALSDF= ALSB-ALSC4 CFM14= G14/B04-B14*G04/B04S CFM24= G24/B04-B14*G14/B04S-B24*G04/B04S+ # B14S*G04/B04C RSMB= RSMC*(ALSB/ALSC4)**REX4*(1.D0+CFM14* # ALSDF+0.5D0*CFM14*CFM14*ALSDF*ALSDF+0.5D0*CFM24* # (ALSB2-ALSC42)) * *-----C QUARK MASS AT C-THRESHOLD * ZERO= 0.D0 X1= 0.5D0 X2= 2.0D0 XACC= 1.D-12 FN= 4.D0 CMM4= RRUNM(X1,X2,XACC,CQM,ALSC4,RSMC,ZERO,FN) * *-----C QUARK MASS AT B-THRESHOLD * CMB= CMM4*(ALSB/ALSC4)**REX4*(1.D0+CFM14* # (ALSB-ALSC4)+0.5D0*CFM14*CFM14* # (ALSB-ALSC4)**2+0.5D0*CFM24*(ALSB2-ALSC42)) * *--------RUNNING CHARM MASS * FN= 5.D0 B05= (11.D0-2.D0/3.D0*FN)/4.D0 B15= (102.D0-38.D0/3.D0*FN)/16.D0 B25= (2857.D0/2.D0-5033.D0/18.D0*FN+325.D0/54.D0* # FN*FN)/64.D0 G05= 1.D0 G15= (202.D0/3.D0-20.D0/9.D0*FN)/16.D0 G25= (1249.D0-(2216.D0/27.D0+160.D0/3.D0*RZ3)*FN- # 140.D0/81.D0*FN*FN)/64.D0 REX5= G05/B05 B05S= B05*B05 B05C= B05S*B05 B15S= B15*B15 CFM15= G15/B05-B15*G05/B05S CFM25= G25/B05-B15*G15/B05S-B25*G05/B05S+B15S*G05/B05C RCM= CMB*(ALSZ/ALSB)**REX5*(1.D0+CFM15* # (ALSZ-ALSB)+0.5D0*CFM15*CFM15* # (ALSZ-ALSB)**2+0.5D0*CFM25*(ALSZ2-ALSB2)) RCM2= RCM*RCM * *-----B QUARK MASS AT B-THRESHOLD * X1= 0.5D0 X2= 6.0D0 XACC= 1.D-12 FN= 5.D0 BMM5= RRUNM(X1,X2,XACC,BQM,ALSB,CMB,RSMB,FN) * *--------RUNNING BHARM MASS * ALSDF= ALSZ-ALSB RBM= BMM5*(ALSZ/ALSB)**REX5*(1.D0+CFM15* # ALSDF+0.5D0*CFM15*CFM15*ALSDF*ALSDF+0.5D0*CFM25* # (ALSZ2-ALSB2)) RBM2= RBM*RBM * ENDIF * *-----MASS CORRECTIONS (UP TO QUARTIC) * AV3= 89893.D0/54.D0-1645.D0/36.D0*PIS+820.D0/27.D0*RZ3- # 36575.D0/54.D0*RZ5 AA2= -(-2237.D0/8.D0+47.D0/6.D0*PIS+97.D0*RZ3)/6.D0 AA2= AA2-3.D0 AA3= -(-25024465.D0/7776.D0+15515.D0/108.D0*PIS+ # 27545.D0/12.D0*RZ3+25.D0*RZ4-995.D0*RZ5)/6.D0 FQCD1= 1.D0+AEXPS*(629.D0/6.D0+AV3*AEXPS)/12.D0 FQCD2= 1.D0+AEXPS*(11.D0/3.D0+(AA2+LOG(4.D0*CSI2)+ # AA3*AEXPS)*AEXPS) FQCD2C= 1.D0+AEXPS*(11.D0/3.D0+(AA2+LOG(4.D0*CSI2)+ # AA3*AEXPS)*AEXPS) FQCD2T= AEXPS*AEXPS*(8.D0/81.D0-1.D0/27.D0*LOG(SCAL/TQM)) * RLNC= LOG(RCM2/SCAL2) RLNB= LOG(RBM2/SCAL2) AA2C= 13.D0/3.D0-4.D0*RZ3-RLNC AA2B= 13.D0/3.D0-4.D0*RZ3-RLNB RCM4= RCM2*RCM2 RBM4= RBM2*RBM2 SCAL4= SCAL2*SCAL2 QCV1= RLNC/3.D0-2.D0/3.D0*PIS-8.D0/3.D0*RZ3+143.D0/18.D0 QCV2= -11.D0/2.D0*RLNC+27.D0*PIS+112.D0*RZ3-3173.D0/12.D0+12.D0 QBV1= RLNB/3.D0-2.D0/3.D0*PIS-8.D0/3.D0*RZ3+143.D0/18.D0 QBV2= -11.D0/2.D0*RLNB+27.D0*PIS+112.D0*RZ3-3173.D0/12.D0+12.D0 QCA1= -7.D0/3.D0*RLNC+2.D0/3.D0*PIS+16.D0/3.D0*RZ3-41.D0/6.D0 QCA2= 77.D0/2.D0*RLNC-27.D0*PIS-220.D0*RZ3+3533.D0/12.D0-12.D0 QBA1= -7.D0/3.D0*RLNB+2.D0/3.D0*PIS+16.D0/3.D0*RZ3-41.D0/6.D0 QBA2= 77.D0/2.D0*RLNB-27.D0*PIS-220.D0*RZ3+3533.D0/12.D0-12.D0 * VCMB= 12.D0*RBM2/SCAL2*AEXPS*FQCD1+RBM4/SCAL4*(-6.D0+AEXPS*( # -22.D0+AEXPS*(5.D0*QBV1+QBV2)))+AEXPS*AEXPS*(12.D0*RCM2* # RBM2+RCM4*AA2C+RBM4*AA2B)/SCAL4- # RBM4*RBM2/SCAL4/SCAL2*(8.D0+16.D0/27.D0*AEXPS*(6.D0* # RLNB+155.D0)) ACMB= -6.D0*RBM2/SCAL2*FQCD2-10.D0*RBM2/TQM2*FQCD2T+ # RBM4/SCAL4*(6.D0+AEXPS*(10.D0+AEXPS*(5.D0*QBA1+QBA2)))+ # AEXPS*AEXPS*(-12.D0*RCM2*RBM2+RCM4*AA2C+RBM4*AA2B)/SCAL4 VCMC= 12.D0*RCM2/SCAL2*AEXPS*FQCD1+RCM4/SCAL4*(-6.D0+AEXPS*( # -22.D0+AEXPS*(5.D0*QCV1+QCV2)))+AEXPS*AEXPS*(12.D0*RCM2* # RBM2+RCM4*AA2C+RBM4*AA2B)/SCAL4 ACMC= -6.D0*RCM2/SCAL2*FQCD2C-10.D0*RCM2/TQM2*FQCD2T+RCM4/SCAL4* # (6.D0+AEXPS*(10.D0+AEXPS*(5.D0*QCA1+QCA2)))+AEXPS*AEXPS*( # -12.D0*RCM2*RBM2+RCM4*AA2C+RBM4*AA2B)/SCAL4 * VCML= AEXPS*AEXPS*(RCM4*AA2C+RBM4*AA2B)/SCAL4 * CAMB= -4.D0*RBM2/SCAL2 CAMC= -4.D0*RCM2/SCAL2 * * CAQCDB= 4.D0/3.D0*ALSR*RBM/SCAL * CAQCDC= 4.D0/3.D0*ALSR*RCM/SCAL CAQCDB= 16.D0/3.D0*AEXPS*RBM/SCAL CAQCDC= 16.D0/3.D0*AEXPS*RCM/SCAL * ACMT= -6.D0*TLM2/SCAL2 ACMM= -6.D0*MM2/SCAL2 CAMT= -4.D0*TLM2/SCAL2 * ODQCD= (RBM2+RCM2)/SCAL2*AEXPS**3*(-560.D0/9.D0+ # 140.D0/3.D0*RZ3) * RETURN END * *-----RALPHAS-------------------------------------------------------------- *-----COMPUTES ALPHA_S(RS) FOR NF FLAVORS GIVEN ALS= ALPHA_S(RS0) * REAL*8 FUNCTION TRALPHAS(RS0,RS,ALS,NF) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM * COMMON/TPARAM/PI,PIS,DELTA COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM * DIMENSION B0(5),B1(5),B2(5) * *-----LIMITS FOR LAMBDA_5 ARE 1 MEV < LAMBDA_5 < 10 GEV * IF(ALS.EQ.0.D0) THEN TRALPHAS= 0.D0 ELSE X1= 0.001D0 * X2= 10.0D0 X2= 20.0D0 XACC= 1.D-12 QCDL= TQCDLAM(NF,ALS,RS0,X1,X2,XACC) PQCDL5= QCDL DO I=1,5 B0(I)= (11.D0-2.D0/3.D0*I)/4.D0 B1(I)= (102.D0-38.D0/3.D0*I)/16.D0 B2(I)= 0.5D0*(2857.D0-I*(5033.D0/9.D0- # 325.D0/27.D0*I))/64.D0 ENDDO * IF(RS.LT.BQM) THEN RAT= BQM/QCDL RL= 2.D0*LOG(RAT) RLL= LOG(RL) RB= LOG(B0(5)/B0(4)) FAC= B1(5)/B0(5)-B1(4)/B0(4) FACP= B2(5)/B0(5)-B2(4)/B0(4) FAC2= B1(5)*B1(5)/B0(5)/B0(5)-B1(4)*B1(4)/B0(4)/B0(4) RHS= (B0(5)-B0(4))*RL+FAC*RLL-B1(4)/B0(4)*RB+ # B1(5)/B0(5)/B0(5)*FAC*RLL/RL+1.D0/B0(5)/RL*( # FAC2-FACP-7.D0/72.D0) RHS= RHS/B0(4) RATL2= EXP(RHS) QCDL= QCDL/SQRT(RATL2) PQCDL4= QCDL NFE= NF-1 IF(RS.LT.CQM) THEN RAT= CQM/QCDL RL= 2.D0*LOG(RAT) RLL= LOG(RL) RB= LOG(B0(4)/B0(3)) FAC= B1(4)/B0(4)-B1(3)/B0(3) FACP= B2(4)/B0(4)-B2(3)/B0(3) FAC2= B1(4)*B1(4)/B0(4)/B0(4)-B1(3)*B1(3)/B0(3)/B0(3) RHS= (B0(4)-B0(3))*RL+FAC*RLL-B1(3)/B0(3)*RB+ # B1(4)/B0(4)/B0(4)*FAC*RLL/RL+1.D0/B0(4)/RL*( # FAC2-FACP-7.D0/72.D0) RHS= RHS/B0(3) RATL2= EXP(RHS) QCDL= QCDL/SQRT(RATL2) PQCDL3= QCDL NFE= NF-2 ENDIF ELSE NFE= NF ENDIF * QCDB0= 11.D0-2.D0/3.D0*NFE QCDB1= 102.D0-38.D0/3.D0*NFE QCDB2= 0.5D0*(2857.D0-5033.D0/9.D0*NFE+ # 325.D0/27.D0*NFE*NFE) QCDA= 2.D0*LOG(RS/QCDL) * TRALPHAS= 4.D0*PI/QCDB0/QCDA*(1.D0-QCDB1/QCDB0**2/QCDA* # LOG(QCDA)+(QCDB1/QCDB0**2/QCDA)**2*((LOG(QCDA)- # 0.5D0)**2+QCDB2*QCDB0/QCDB1**2-5.D0/4.D0)) * ENDIF RETURN END * *-----RRUNM-------------------------------------------------------- * COMPUTES THE RUNNING QUARK MASS AT THE POLE MASS * REAL*8 FUNCTION RRUNM(X1,X2,XACC,QM,ALS,RM1,RM2,FN) IMPLICIT REAL*8(A-H,O-Z) * PARAMETER (JMAX=50) * FMID= TQCDMASS(QM,ALS,RM1,RM2,FN,X2) F= TQCDMASS(QM,ALS,RM1,RM2,FN,X1) IF(F*FMID.GE.0.D0) THEN PRINT*,'ROOT MUST BE BRACKETED FOR BISECTION' PRINT 1,QM 1 FORMAT(/' ERROR DETECTED BY RRUNM ',/ # ' CURRENT VALUE OF QUARK MASS = ',E20.5) STOP ENDIF IF(F.LT.0.D0) THEN RRUNM= X1 DX= X2-X1 ELSE RRUNM= X2 DX= X1-X2 ENDIF DO J=1,JMAX DX= DX*0.5D0 XMID= RRUNM+DX FMID= TQCDMASS(QM,ALS,RM1,RM2,FN,XMID) IF(FMID.LE.0.D0) RRUNM= XMID IF(ABS(DX).LT.XACC.OR.FMID.EQ.0.D0) RETURN ENDDO PAUSE 'TOO MANY BISECTIONS' END * *-----QCDMASS------------------------------------------------------ * REAL*8 FUNCTION TQCDMASS(QM,ALS,RM1,RM2,FN,X) IMPLICIT REAL*8(A-H,O-Z) * COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 * RLN= 2.D0*LOG(QM/X) RLNS= RLN*RLN R1= RM1/X R2= RM2/X DELTA0= 3.D0/4.D0*RZ2-3.D0/8.D0 DELTA1= R1*(PIS/8.D0+R1*(-0.597D0+0.230D0*R1)) DELTA2= R2*(PIS/8.D0+R2*(-0.597D0+0.230D0*R2)) * RHS= 1.D0+ALS*(4.D0/3.D0+RLN+ALS*(3817.D0/288.D0-8.D0/3.D0+ # 2.D0/3.D0*(2.D0+LOG(2.D0))*RZ2-RZ3/6.D0-FN/3.D0*(RZ2+ # 71.D0/48.D0)+4.D0/3.D0*(DELTA0+DELTA1+DELTA2)+(173.D0/ # 24.D0-13.D0/36.D0*FN)*RLN+(15.D0/8.D0-FN/12.D0)*RLNS)) TQCDMASS= QM-X*RHS * RETURN END * *-----QCDLAM----------------------------------------------------------------- *-----COMPUTES LAMBA^NF_MSBAR FROM ALPHA_S(RS0) * REAL*8 FUNCTION TQCDLAM(NF,ALS,RS,X1,X2,XACC) IMPLICIT REAL*8(A-H,O-Z) * PARAMETER (JMAX=50) * FMID= TQCDSCALE(NF,ALS,RS,X2) F= TQCDSCALE(NF,ALS,RS,X1) IF(F*FMID.GE.0.D0) THEN PRINT*,'ROOT MUST BE BRACKETED FOR BISECTION' PRINT 1,ALS 1 FORMAT(/' ERROR DETECTED BY TQCDLAM ',/ # ' CURRENT VALUE OF ALPHA_S = ',E20.5) STOP ENDIF IF(F.LT.0.D0) THEN TQCDLAM= X1 DX= X2-X1 ELSE TQCDLAM= X2 DX= X1-X2 ENDIF DO J=1,JMAX DX= DX*0.5D0 XMID= TQCDLAM+DX FMID= TQCDSCALE(NF,ALS,RS,XMID) IF(FMID.LE.0.D0) TQCDLAM= XMID IF(ABS(DX).LT.XACC.OR.FMID.EQ.0.D0) RETURN ENDDO PAUSE 'TOO MANY BISECTIONS' END * *-----QCDSCALE------------------------------------------------------------- *-----COMPUTES LAMBA^NF_MSBAR FROM ALPHA_S(RS0) * REAL*8 FUNCTION TQCDSCALE(NF,ALS,RS,X) IMPLICIT REAL*8(A-H,O-Z) * COMMON/TPARAM/PI,PIS,DELTA * QCDB0= 11.D0-2.D0/3.D0*NF QCDB1= 102.D0-38.D0/3.D0*NF QCDB2= 0.5D0*(2857.D0-5033.D0/9.D0*NF+325.D0/27.D0*NF*NF) QCDA= 2.D0*LOG(RS/X) TQCDSCALE= ALS-(4.D0*PI/QCDB0/QCDA*(1.D0-QCDB1/QCDB0**2/QCDA* # LOG(QCDA)+(QCDB1/QCDB0**2/QCDA)**2*((LOG(QCDA)- # 0.5D0)**2+QCDB2*QCDB0/QCDB1**2-5.D0/4.D0))) * RETURN END * *-----WFF------------------------------------------------------------------ *-----FERMION WAVE-FUNCTION FACTORS (F NEQ. B, NON E.M.) * SUBROUTINE TWFF(STD2,QF,ZIF,WV,WA) IMPLICIT REAL*8(A-H,O-Z) * COMMON/TPARAM/PI,PIS,DELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 * CTD2= 1.D0-STD2 FZ= DELTA-LOG(ZM2)-0.5D0 FW= DELTA-LOG(WM2)-0.5D0 WV= -1.D0/32.D0*(4.D0*(ZIF-2.D0*QF*STD2)**2+1.D0)*FZ # -1.D0/8.D0*CTD2*FW WA= -1.D0/16.D0*(1.D0-8.D0*ZIF*QF*STD2)*FZ # -1.D0/8.D0*CTD2*FW * RETURN END * *-----QRF----------------------------------------------------------------- *-----VERTEX FORM FACTORS (REAL PART) * REAL*16 FUNCTION QRF(N,FM,RM12,RM22,RM32) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION C0(2),C1(2,2),C2(2,4) * JFLAG= 1 P12= -FM*FM P22= -FM*FM S= -QZM2 * CALL TCFF(JFLAG,P12,P22,S,RM12,RM22,RM32,C0,C1,C2) * IF(N.EQ.1) THEN QRF= -C2(1,4)/4.Q0+QZM2/8.Q0*(C1(1,1)+C2(1,3))+1.Q0/8.Q0 * ELSE IF(N.EQ.2) THEN QRF= -3.Q0*C2(1,4)+QZM2/2.Q0*(C0(1)+C1(1,1)+C2(1,3))+1.Q0/2.Q0 * ELSE IF(N.EQ.3) THEN QRF= -C2(1,4)/4.Q0+QZM2/8.Q0*(C1(1,1)+C2(1,3))+1.Q0/8.Q0- # RM12**2/RM22/16.Q0*C0(1) * ELSE IF(N.EQ.4) THEN QRF= RM12*(C0(1)-4.Q0/RM22*(-C2(1,4)/4.Q0+QZM2/8.Q0*(C1(1,2)+ # C2(1,3))+1.Q0/16.Q0)) * ELSE IF(N.EQ.5) THEN QRF= RM22/RM12*C2(1,4) * ELSE IF(N.EQ.6) THEN QRF= RM22*C0(1) * ENDIF * RETURN END * *-----QRF----------------------------------------------------------------- *-----VERTEX FORM FACTORS (REAL PART) * REAL*16 FUNCTION QRFS(N,RM12,RM22,RM32) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION C0(2),C1(2,2),C2(2,4) * S= -QZM2 * CALL TCFFS(S,RM12,RM22,RM32,C0,C1,C2) * IF(N.EQ.1) THEN QRFS= -C2(1,4)/4.Q0+QZM2/8.Q0*(C1(1,1)+C2(1,3))+1.Q0/8.Q0 * ELSE IF(N.EQ.2) THEN QRFS= -3.Q0*C2(1,4)+QZM2/2.Q0*(C0(1)+C1(1,1)+C2(1,3))+ # 1.Q0/2.Q0 * ENDIF * RETURN END * *-----QIF----------------------------------------------------------------- *-----VERTEX FORM FACTORS (REAL PART) * REAL*16 FUNCTION QIF(N,FM,RM12,RM22,RM32) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION C0(2),C1(2,2),C2(2,4) * JFLAG= 1 P12= -FM*FM P22= -FM*FM S= -QZM2 * CALL TCFF(JFLAG,P12,P22,S,RM12,RM22,RM32,C0,C1,C2) * IF(N.EQ.1) THEN QIF= -C2(2,4)/4.Q0+QZM2/8.Q0*(C1(2,1)+C2(2,3)) * ELSE IF(N.EQ.2) THEN QIF= -3.Q0*C2(2,4)+QZM2/2.Q0*(C0(2)+C1(2,1)+C2(2,3)) * ELSE IF(N.EQ.3) THEN QIF= -C2(2,4)/4.Q0+QZM2/8.Q0*(C1(2,1)+C2(2,3))- # RM12**2/RM22/16.Q0*C0(2) * ELSE IF(N.EQ.4) THEN QIF= RM12*(C0(2)-4.Q0/RM22*(-C2(2,4)/4.Q0+QZM2/8.Q0*(C1(2,2)+ # C2(2,3))+1.Q0/16.Q0)) * ELSE IF(N.EQ.5) THEN QIF= RM22/RM12*C2(2,4) * ELSE IF(N.EQ.6) THEN QIF= RM22*C0(2) * ENDIF * RETURN END * *-----QIFS--------------------------------------------------- * REAL*16 FUNCTION QIFS(N,RM12,RM22,RM32) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION C0(2),C1(2,2),C2(2,4) * S= -QZM2 * CALL TCFFS(S,RM12,RM22,RM32,C0,C1,C2) * IF(N.EQ.1) THEN QIFS= -C2(2,4)/4.Q0+QZM2/8.Q0*(C1(2,1)+C2(2,3)) * ELSE IF(N.EQ.2) THEN QIFS= -3.Q0*C2(2,4)+QZM2/2.Q0*(C0(2)+C1(2,1)+C2(2,3)) * ENDIF * RETURN END * *-----QF------------------------------------------------------------------ *-----VERTEX FORM FACTORS (REAL AND IMAGINARY PARTS) * REAL*16 FUNCTION QF(N,I,P2,FM,RM12,RM22,RM32) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION C0(2),C1(2,2),C2(2,4) * JFLAG= 1 P12= -FM*FM P22= -FM*FM * CALL TCFF(JFLAG,P12,P22,P2,RM12,RM22,RM32,C0,C1,C2) * IF(N.EQ.1) THEN QF= -C2(I,4)/4.Q0-P2/8.Q0*(C1(I,1)+C2(I,3))+(2.Q0-I)/8.Q0 * ELSE IF(N.EQ.2) THEN QF= -3.Q0*C2(I,4)-P2/2.Q0*(C0(I)+C1(I,1)+C2(I,3))+ # (2.Q0-I)/2.Q0 * ELSE IF(N.EQ.3) THEN QF= -1.Q0/6.Q0*RM12/RM22*(2.Q0*C2(I,4)-(2.Q0-I)/2.Q0+ # P2*(C1(I,2)+C2(I,3))+RM12*C0(I)) * ELSE IF(N.EQ.4) THEN QF= RM22/2.Q0*(C0(I)+1.Q0/RM12*C2(I,4)) * ELSE IF(N.EQ.5) THEN QF= C0(I) * ELSE IF(N.EQ.6) THEN QF= -0.25Q0*C2(I,4)-P2/8.Q0*(C1(I,1)+C2(I,3)) # -1.Q0/16.Q0*RM12*RM12/RM22*C0(I)+(2.Q0-I)/8.Q0 * ELSE IF(N.EQ.7) THEN QF= RM12*C0(I)+RM12/RM22*(C2(I,4)+0.5Q0*P2*( # C1(I,2)+C2(I,3))-(2.Q0-I)/4.Q0) * ELSE IF(N.EQ.8) THEN QF= -3.Q0*C2(I,4)-P2/2.Q0*(C0(I)+C1(I,1)+C2(I,3)) # +(2.Q0-I)/2.Q0 * ELSE IF(N.EQ.9) THEN QF= RM22/RM12*C2(I,4) * ELSE IF(N.EQ.10) THEN QF= RM22*C0(I) * ENDIF * RETURN END * *-----QFS----------------------------------------------------------------- * REAL*16 FUNCTION QFS(N,I,P2,RM12,RM22,RM32) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION C0(2),C1(2,2),C2(2,4) * CALL TCFFS(P2,RM12,RM22,RM32,C0,C1,C2) * IF(N.EQ.1) THEN QFS= -C2(I,4)/4.Q0-P2/8.Q0*(C1(I,1)+C2(I,3))+(2.Q0-I)/8.Q0 * ELSE IF(N.EQ.2) THEN QFS= -3.Q0*C2(I,4)-P2/2.Q0*(C0(I)+C1(I,1)+C2(I,3))+ # (2.Q0-I)/2.Q0 * ENDIF * RETURN END * *-----PSELF-------------------------------------------------------- * THE PHOTON TWO-POINT FUNCTION * SUBROUTINE TPSELF(P2X,OPGGF,OPGGFL,OPGGLQ,OPGGB,OPGGNP,OPPGG, # OPPGGNP,OIGG,OIGZ,OIGGS,OIGZS,OIGGW,OPGGHO) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) CHARACTER*1 OAL,OLHO * COMMON/TNAL/ODA COMMON/TLHO/OLHO COMMON/OST/OSTR2 COMMON/TCALEM/OAL COMMON/TALEM/OVNAL COMMON/TSSCAL/QSPSC COMMON/TQVARIA/QALPHA,QSLLC COMMON/TMIX/QALST,QALSTZ,QALSTS COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION B0W(2),B1W(2),B21W(2) DIMENSION AB0EE(2),AB1EE(2),AB21EE(2) DIMENSION AB0MM(2),AB1MM(2),AB21MM(2) DIMENSION AB0TAU(2),AB1TAU(2),AB21TAU(2) DIMENSION AB0UU(2),AB1UU(2),AB21UU(2) DIMENSION AB0DD(2),AB1DD(2),AB21DD(2) DIMENSION AB0CC(2),AB1CC(2),AB21CC(2) DIMENSION AB0SS(2),AB1SS(2),AB21SS(2) DIMENSION AB0BB(2),AB1BB(2),AB21BB(2) DIMENSION AB0TT(2),AB1TT(2),AB21TT(2) * DATA Z3/1.20205690315959428540Q0/ DATA Z5/1.03692775514336992633Q0/ * VNAL= OVNAL*1.D15*1.Q-15 OZM= SQRT(QZM2) Z2= QPIS/6.Q0 IF(OLHO.EQ.'N') THEN QFACT= QSLLC ELSE QFACT= 1.Q0 ENDIF * CALL TRBFFS(P2X,QWM2,QWM2,B0WW,B1WW,B21WW) CALL TRBFFS(P2X,QEM2,QEM2,B0EE,B1EE,B21EE) CALL TRBFFS(P2X,QMM2,QMM2,B0MM,B1MM,B21MM) CALL TRBFFS(P2X,QTM2,QTM2,B0TAU,B1TAU,B21TAU) CALL TRBFFS(P2X,QTQM2,QTQM2,B0TT,B1TT,B21TT) CALL TBFFS(P2X,QEM2,QEM2,AB0EE,AB1EE,AB21EE) CALL TBFFS(P2X,QMM2,QMM2,AB0MM,AB1MM,AB21MM) CALL TBFFS(P2X,QTM2,QTM2,AB0TAU,AB1TAU,AB21TAU) CALL TBFFS(P2X,QTQM2,QTQM2,AB0TT,AB1TT,AB21TT) * CALL TRBFFS(P2X,QUQM2,QUQM2,B0UU,B1UU,B21UU) CALL TRBFFS(P2X,QDQM2,QDQM2,B0DD,B1DD,B21DD) CALL TRBFFS(P2X,QCQM2,QCQM2,B0CC,B1CC,B21CC) CALL TRBFFS(P2X,QSQM2,QSQM2,B0SS,B1SS,B21SS) CALL TRBFFS(P2X,QBQM2,QBQM2,B0BB,B1BB,B21BB) * CALL TBFFS(P2X,QUQM2,QUQM2,AB0UU,AB1UU,AB21UU) CALL TBFFS(P2X,QDQM2,QDQM2,AB0DD,AB1DD,AB21DD) CALL TBFFS(P2X,QCQM2,QCQM2,AB0CC,AB1CC,AB21CC) CALL TBFFS(P2X,QSQM2,QSQM2,AB0SS,AB1SS,AB21SS) CALL TBFFS(P2X,QBQM2,QBQM2,AB0BB,AB1BB,AB21BB) * CALL TRBPFF(P2X,QWM2,QWM2,E0WW,E1WW,E21WW) CALL TRBPFF(P2X,QEM2,QEM2,E0EE,E1EE,E21EE) CALL TRBPFF(P2X,QMM2,QMM2,E0MM,E1MM,E21MM) CALL TRBPFF(P2X,QTM2,QTM2,E0TAU,E1TAU,E21TAU) CALL TRBPFF(P2X,QTQM2,QTQM2,E0TT,E1TT,E21TT) * BFE= 2.Q0*B21EE-B0EE BFM= 2.Q0*B21MM-B0MM BFTAU= 2.Q0*B21TAU-B0TAU * BFEI= 2.Q0*AB21EE(2)-AB0EE(2) BFMI= 2.Q0*AB21MM(2)-AB0MM(2) BFTAUI= 2.Q0*AB21TAU(2)-AB0TAU(2) BFLI= BFEI+BFMI+BFTAUI * BFT= 2.Q0*B21TT-B0TT BFTI= 2.Q0*AB21TT(2)-AB0TT(2) * BFU= 2.Q0*B21UU-B0UU BFD= 2.Q0*B21DD-B0DD BFC= 2.Q0*B21CC-B0CC BFS= 2.Q0*B21SS-B0SS BFB= 2.Q0*B21BB-B0BB BFUQ= BFU+BFC BFDQ= BFD+BFS+BFB * BFUI= 2.Q0*AB21UU(2)-AB0UU(2) BFDI= 2.Q0*AB21DD(2)-AB0DD(2) BFCI= 2.Q0*AB21CC(2)-AB0CC(2) BFSI= 2.Q0*AB21SS(2)-AB0SS(2) BFBI= 2.Q0*AB21BB(2)-AB0BB(2) BFUQI= BFUI+BFCI+BFTI BFDQI= BFDI+BFSI+BFBI * EFE= 2.Q0*E21EE-E0EE EFM= 2.Q0*E21MM-E0MM EFTAU= 2.Q0*E21TAU-E0TAU EFT= 2.Q0*E21TT-E0TT * QS2= QSPSC*QSPSC AEXPS= QALSTS/QPI AEXPSZ= QALSTZ/QPI RM= QTQM2/QS2 RL= LOG(RM) BX= -RL-4.Q0*Z3+55.Q0/12.Q0 RV= -0.25Q0*P2X/QTQM2 FLQI= 0.25Q0*QPI FB= -Z3+55.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QS2) FLQ= -Z3+55.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QZM2) * OPGGB= # -12.Q0*B21WW+7.Q0*B0WW+2.Q0/3.Q0 * OPGGF= # 4.Q0*(BFE+BFM+BFTAU)*QFACT+16.Q0/3.Q0*BFT+ # 64.Q0/9.Q0*AEXPS*QTQM2/P2X*(RV*BX+QV1) * OPGGFL= 4.Q0*(BFE+BFM+BFTAU)*QFACT * OPGGFI= * # 4.Q0*(BFEI+BFMI+BFTAUI)+16.Q0/3.Q0*BFTI # 4.Q0*(BFEI+BFMI+BFTAUI) * OPGGLQ= # 16.Q0/3.Q0*BFUQ+4.Q0/3.Q0*BFDQ- # 16.Q0/9.Q0*AEXPS*FB-160.Q0/9.Q0*AEXPSZ*FLQ OPGGLQI= # 16.Q0/3.Q0*BFUQI+4.Q0/3.Q0*BFDQI * OS3GFI= # P2X*(BFLI+2.Q0*BFUQI+BFDQI) * IF(P2X.LT.0.Q0) THEN OIGGS= 64.Q0/9.Q0*AEXPS*QTQM2/P2X*QV1I-44.Q0/9.Q0* # AEXPSZ*QPI OIGG= OIGGS+OPGGFI+OPGGLQI OIGZS= 8.Q0/3.Q0*AEXPS*QTQM2*QV1I-4.Q0/3.Q0*AEXPS* # P2X*FLQI-8.Q0*AEXPSZ*P2X*FLQI OIGZ= OIGZS+OS3GFI ELSE OIGG= 0.Q0 OIGZ= 0.Q0 OIGGS= 0.Q0 OIGZS= 0.Q0 ENDIF * IF(P2X.LT.(-4.Q0*QWM2)) THEN CALL TBFFS(P2X,QWM2,QWM2,B0W,B1W,B21W) OIGGW= # -12.Q0*B21W(2)+7.Q0*B0W(2) ELSE OIGGW= 0.Q0 ENDIF * OPPGG= # -(-12.Q0*E21WW+7.Q0*E0WW+4.Q0*(EFE+EFM+EFTAU)* # QFACT+16.Q0/3.Q0*EFT)+4.Q0/9.Q0*AEXPS/QTQM2/ # RV/RV*(RV*QV1P-QV1) * IF(OLHO.EQ.'N') THEN OPGGHO= 0.Q0 ELSE QLE= LOG(ABS(P2X)/QEM2) QLM= LOG(ABS(P2X)/QMM2) QLT= LOG(ABS(P2X)/QTM2) OPGGEHO1= -5.Q0/6.Q0+4.Q0*Z3+QLE OPGGMHO1= -5.Q0/6.Q0+4.Q0*Z3+QLM OPGGTHO1= -5.Q0/6.Q0+4.Q0*Z3+QLT OPGGHO2A= 121.Q0/48.Q0-(-5.Q0+8.Q0*LOG(2.Q0))*Z2+ # 99.Q0/16.Q0*Z3-10.Q0*Z5 OPGGEHO2A= OPGGHO2A-1.Q0/8.Q0*QLE OPGGMHO2A= OPGGHO2A-1.Q0/8.Q0*QLM OPGGTHO2A= OPGGHO2A-1.Q0/8.Q0*QLT OPGGHO2L= 116.Q0/27.Q0-4.Q0/3.Q0*Z2-38.Q0/9.Q0*Z3 OPGGEHO2L= 0.Q0 OPGGMHO2L= OPGGHO2L-14.Q0/9.Q0*QLM-(5.Q0/18.Q0- # 4.Q0/3.Q0*Z3)*QLE-1.Q0/6.Q0*(QLM*QLM-QPIS)+ # 1.Q0/3.Q0*(QLM*QLE-QPIS) OPGGTHO2L= OPGGHO2L-14.Q0/9.Q0*QLT-(5.Q0/18.Q0- # 4.Q0/3.Q0*Z3)*QLE-(5.Q0/18.Q0- # 4.Q0/3.Q0*Z3)*QLM-1.Q0/6.Q0*(QLT*QLT-QPIS)+ # 1.Q0/3.Q0*(QLT*QLE-QPIS)+1.Q0/3.Q0*(QLT*QLM- # QPIS) OPGGHO2F= 307.Q0/216.Q0+8.Q0/3.Q0*Z2-545.Q0/144.Q0*Z3 OPGGEHO2F= OPGGHO2F-(11.Q0/6.Q0-4.Q0/3.Q0*Z3)*QLE+ # 1.Q0/6.Q0*(QLE*QLE-QPIS) OPGGMHO2F= OPGGHO2F-(11.Q0/6.Q0-4.Q0/3.Q0*Z3)*QLM+ # 1.Q0/6.Q0*(QLM*QLM-QPIS) OPGGTHO2F= OPGGHO2F-(11.Q0/6.Q0-4.Q0/3.Q0*Z3)*QLT+ # 1.Q0/6.Q0*(QLT*QLT-QPIS) OPGGHO2H= 37.Q0/6.Q0-38.Q0/9.Q0*Z3 OPGGEHO2H= OPGGHO2H-(11.Q0/6.Q0-4.Q0/3.Q0*Z3)*QLM+ # 1.Q0/6.Q0*(QLM*QLM-QPIS)-(11.Q0/6.Q0- # 4.Q0/3.Q0*Z3)*QLT+1.Q0/6.Q0*(QLT*QLT-QPIS) OPGGMHO2H= OPGGHO2H-(11.Q0/6.Q0-4.Q0/3.Q0*Z3)*QLT+ # 1.Q0/6.Q0*(QLT*QLT-QPIS) OPGGTHO2H= 0.Q0 OPGGEHO= QALPHA/QPI*(OPGGEHO1+QALPHA/QPI*(OPGGEHO2A+ # OPGGEHO2L+OPGGEHO2F+OPGGEHO2H)) OPGGMHO= QALPHA/QPI*(OPGGMHO1+QALPHA/QPI*(OPGGMHO2A+ # OPGGMHO2L+OPGGMHO2F+OPGGMHO2H)) OPGGTHO= QALPHA/QPI*(OPGGTHO1+QALPHA/QPI*(OPGGTHO2A+ # OPGGTHO2L+OPGGTHO2F+OPGGTHO2H)) OPGGHO= OPGGEHO+OPGGMHO+OPGGTHO * OPGGEHO1L= QALPHA/QPI*OPGGEHO1 OPGGMHO1L= QALPHA/QPI*OPGGMHO1 OPGGTHO1L= QALPHA/QPI*OPGGTHO1 * OPGGEHO2L= QALPHA/QPI*QALPHA/QPI*(OPGGEHO2A+ # OPGGEHO2L+OPGGEHO2F+OPGGEHO2H) OPGGMHO2L= QALPHA/QPI*QALPHA/QPI*(OPGGMHO2A+ # OPGGMHO2L+OPGGMHO2F+OPGGMHO2H) OPGGTHO2L= QALPHA/QPI*QALPHA/QPI*(OPGGTHO2A+ # OPGGTHO2L+OPGGTHO2F+OPGGTHO2H) OPGGHO1L= OPGGEHO1L+OPGGMHO1L+OPGGTHO1L OPGGHO2L= OPGGEHO2L+OPGGMHO2L+OPGGTHO2L ENDIF * IF(OAL.EQ.'D') THEN B= 0.00299Q0 C= 1.Q0 AN= -B*LOG(1.Q0+C*QZM2)+0.028039809Q0 DA= AN-0.00165Q0 AP2X= ABS(P2X) PX= SQRT(AP2X) IF(PX.LT.0.3Q0) THEN A= 0.Q0 B= 0.00835Q0 C= 1.Q0 ELSE IF(PX.LT.3.Q0) THEN A= 0.Q0 B= 0.00238Q0 C= 3.927Q0 ELSE IF(PX.LT.100.Q0) THEN A= 0.00165Q0 B= 0.00299Q0 C= 1.Q0 ELSE IF(PX.GT.100.Q0) THEN A= 0.00221Q0 B= 0.00293Q0 C= 1.Q0 ENDIF A= A+DA ODA= 0.D0 IF(P2X.LT.0.Q0.AND. # ((AP2X.LT.1.6Q3).OR.(AP2X.GT.1.Q6))) THEN OPGGNP= 4.Q0*QPI/QALPHA*(A+B*LOG(1.Q0+C*AP2X)) OPPGGNP= -4.Q0*QPI/QALPHA*B/(1.Q0+QZM2) ELSE IF(P2X.LT.0.Q0) THEN OENER= SQRT(AP2X) ELSE IF(P2X.GT.0.Q0) THEN OENER= -SQRT(P2X) ENDIF CALL THADR5(OENER,OZM,OSTR2,ODERH,OERRDER,ODEG,OERRDEG) OPGGNP= 4.Q0*QPI/QALPHA*ODERH OPPGGNP= -4.Q0*QPI/QALPHA*B/(1.Q0+QZM2) ENDIF ELSE IF(OAL.EQ.'N') THEN B= 0.00299Q0 C= 1.Q0 AN= -B*LOG(1.Q0+C*QZM2)+VNAL DA= AN-0.00165Q0 AP2X= ABS(P2X) PX= SQRT(AP2X) IF(PX.LT.0.3Q0) THEN A= 0.Q0 B= 0.00835Q0 C= 1.Q0 ELSE IF(PX.LT.3.Q0) THEN A= 0.Q0 B= 0.00238Q0 C= 3.927Q0 ELSE IF(PX.LT.100.Q0) THEN A= 0.00165Q0 B= 0.00299Q0 C= 1.Q0 ELSE IF(PX.GT.100.Q0) THEN A= 0.00221Q0 B= 0.00293Q0 C= 1.Q0 ENDIF A= A+DA ODA= VNAL-0.028039809Q0 OPGGNP= 4.Q0*QPI/QALPHA*(A+B*LOG(1.Q0+C*AP2X)) OPPGGNP= -4.Q0*QPI/QALPHA*B/(1.Q0+QZM2) ENDIF * RETURN END * *-----VBSELF0----------------------------------------------------------- * VECTOR-BOSONS TWO-POINT FUNCTIONS AT ZERO MOMENTUM * SUBROUTINE TVBSELF0(OPGGF0,OPGGF0L,OPGGB0,OSWW0F,OSWW0B) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8,OLHO * COMMON/TLHO/OLHO COMMON/TSSCAL/QSPSC COMMON/TSUB/OSINT2,ODSWW COMMON/TQVARIA/QALPHA,QSLLC COMMON/TMIX/QALST,QALSTZ,QALSTS COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DATA Z3/1.20205690315959428540Q0/ * PM= 1.Q-10 PM2= PM*PM IF(OLHO.EQ.'N') THEN QFACT= QSLLC ELSE QFACT= 1.Q0 ENDIF * CALL TRBFF0(QWM2,QWM2,B0WW0,B1WW0,B21WW0) CALL TRBFF0(PM2,QWM2,B0PW0,B1PW0,B21PW0) CALL TRBFF0(QEM2,QEM2,B0EE0,B1EE0,B21EE0) CALL TRBFF0(QMM2,QMM2,B0MM0,B1MM0,B21MM0) CALL TRBFF0(QTM2,QTM2,B0TAU0,B1TAU0,B21TAU0) CALL TRBFF0(QTQM2,QTQM2,B0TT0,B1TT0,B21TT0) CALL TRBFF0(QZM2,QWM2,B0ZW0,B1ZW0,B21ZW0) CALL TRBFF0(QWM2,QHM2,B0WH0,B1WH0,B21WH0) * BFE= 2.Q0*B21EE0-B0EE0 BFM= 2.Q0*B21MM0-B0MM0 BFTAU= 2.Q0*B21TAU0-B0TAU0 BFT= 2.Q0*B21TT0-B0TT0 * QS2= QSPSC*QSPSC AEXPS= QALSTS/QPI RM= QTQM2/QS2 RL= LOG(RM) BX= -RL-4.Q0*Z3+55.Q0/12.Q0 BY= 3.Q0*RL*RL-11.Q0/2.Q0*RL+6.Q0*Z3+QPIS/2.Q0- # 11.Q0/8.Q0 F10= -3.Q0/2.Q0*Z3-QPIS/12.Q0+23.Q0/16.Q0 * OPGGB0= # -12.Q0*B21WW0+7.Q0*B0WW0+2.Q0/3.Q0 * OPGGF0= # 4.Q0*(BFE+BFM+BFTAU)*QFACT+16.Q0/3.Q0*BFT- # 16.Q0/9.Q0*AEXPS*(BX+4.Q0*Z3-5.Q0/6.Q0) * OPGGF0L= 4.Q0*(BFE+BFM+BFTAU)*QFACT * CALL TRBFF0(QNM2,QEM2,B0NE0,B1NE0,B21NE0) CALL TRBFF0(QNM2,QMM2,B0NM0,B1NM0,B21NM0) CALL TRBFF0(QNM2,QTM2,B0NT0,B1NT0,B21NT0) CALL TRBFF0(QUQM2,QDQM2,B0UD0,B1UD0,B21UD0) CALL TRBFF0(QCQM2,QSQM2,B0CS0,B1CS0,B21CS0) CALL TRBFF0(QTQM2,QBQM2,B0TB0,B1TB0,B21TB0) * OSWW0F= # QEM2*B1NE0+3.Q0*(QDQM2-QUQM2)*B1UD0-3.Q0*QUQM2* # B0UD0+QMM2*B1NM0+3.Q0*(QSQM2-QCQM2)*B1CS0- # 3.Q0*QCQM2*B0CS0+QTM2*B1NT0+3.Q0*QBQM2*B1TB0- # 3.Q0*QTQM2*(B0TB0+B1TB0)+4.Q0*AEXPS*QTQM2*( # 0.25D0*BY+F10) * OS0WW0B= # 9.Q0/2.Q0*(QZM2-QWM2)*B1ZW0+0.25Q0*(13.Q0*QZM2- # 21.Q0*QWM2)*B0ZW0+4.Q0*QWM2*B0WW0 * OSH= 0.5Q0*(QWM2-QHM2)*B1WH0+0.25Q0*(5.Q0*QWM2-QHM2)* # B0WH0 IF(OU3.EQ.'N') THEN OS0WW0B= OS0WW0B+OSH ELSE IF(OU3.EQ.'Y') THEN OSWW0F= OSWW0F+OSH ENDIF * OS1WW0= # 2.Q0*(QWM2-QZM2)*(2.Q0*B1ZW0+B0ZW0)-2.Q0*QWM2* # (2.Q0*B1PW0+B0PW0) * OSWW0B= OS0WW0B+OSINT2*OS1WW0+ODSWW * RETURN END * *-----RBFF0----------------------------------------------------------------- * THE SCALAR FORM FACTORS B0,B1,B21 AT ZERO MOMENTUM * SUBROUTINE TRBFF0(RM12,RM22,B0,B1,B21) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION ARG(2),CLN(2),FR(3) * IF(RM12.EQ.RM22) THEN FACT= QDELTA-LOG(RM12) B0= FACT B1= -0.5Q0*FACT B21= FACT/3.Q0 RETURN ELSE N= 3 YR= RM12/(RM12-RM22) OMYR= -RM22/(RM12-RM22) YI= -QEPS/(RM12-RM22) CALL TRCG(N,YR,YI,OMYR,FR) ARG(1)= OMYR ARG(2)= -YI CALL TCQLNX(ARG,CLN) F1R= FR(1)-CLN(1) F2R= 2.Q0*FR(2)-CLN(1) F3R= 3.Q0*FR(3)-CLN(1) FACT= QDELTA-LOG(RM22) B0= FACT-F1R B1= 0.5Q0*(-FACT+F2R) B21= 1.Q0/3.Q0*(FACT-F3R) RETURN ENDIF END * *-----VBSELF------------------------------------------------------------ * Z^0 TWO-POINT FUNCTIONS AT ARBITRARY MOMENTUM * SUBROUTINE TVBSELF(P2X,OS3GF,OS33F,OS3GB,OS33B,OSP3G,OSP33, # OS33IW,OS3GIW) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 * COMMON/TSSCAL/QSPSC COMMON/TQVARIA/QALPHA,QSLLC COMMON/TMIX/QALST,QALSTZ,QALSTS COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION B0W(2),B1W(2),B21W(2) * DATA Z3/1.20205690315959428540Q0/ * CALL TRBFFS(P2X,QWM2,QWM2,B0WW,B1WW,B21WW) CALL TRBFFS(P2X,QEM2,QEM2,B0EE,B1EE,B21EE) CALL TRBFFS(P2X,QUQM2,QUQM2,B0UU,B1UU,B21UU) CALL TRBFFS(P2X,QDQM2,QDQM2,B0DD,B1DD,B21DD) CALL TRBFFS(P2X,QMM2,QMM2,B0MM,B1MM,B21MM) CALL TRBFFS(P2X,QCQM2,QCQM2,B0CC,B1CC,B21CC) CALL TRBFFS(P2X,QSQM2,QSQM2,B0SS,B1SS,B21SS) CALL TRBFFS(P2X,QTM2,QTM2,B0TAU,B1TAU,B21TAU) CALL TRBFFS(P2X,QTQM2,QTQM2,B0TT,B1TT,B21TT) CALL TRBFFS(P2X,QBQM2,QBQM2,B0BB,B1BB,B21BB) CALL TRBFFS(P2X,QNM2,QNM2,B0NN,B1NN,B21NN) CALL TRBFFS(P2X,QZM2,QHM2,B0ZH,B1ZH,B21ZH) * CALL TRBFF0(QWM2,QWM2,B0WW0,B1WW0,B21WW0) * CALL TRBPFF(P2X,QWM2,QWM2,E0WW,E1WW,E21WW) CALL TRBPFF(P2X,QEM2,QEM2,E0EE,E1EE,E21EE) CALL TRBPFF(P2X,QUQM2,QUQM2,E0UU,E1UU,E21UU) CALL TRBPFF(P2X,QDQM2,QDQM2,E0DD,E1DD,E21DD) CALL TRBPFF(P2X,QMM2,QMM2,E0MM,E1MM,E21MM) CALL TRBPFF(P2X,QCQM2,QCQM2,E0CC,E1CC,E21CC) CALL TRBPFF(P2X,QSQM2,QSQM2,E0SS,E1SS,E21SS) CALL TRBPFF(P2X,QTM2,QTM2,E0TAU,E1TAU,E21TAU) CALL TRBPFF(P2X,QTQM2,QTQM2,E0TT,E1TT,E21TT) CALL TRBPFF(P2X,QBQM2,QBQM2,E0BB,E1BB,E21BB) CALL TRBPFF(P2X,QNM2,QNM2,E0NN,E1NN,E21NN) CALL TRBPFF(P2X,QZM2,QHM2,E0ZH,E1ZH,E21ZH) * BFE= 2.Q0*B21EE-B0EE BFM= 2.Q0*B21MM-B0MM BFTAU= 2.Q0*B21TAU-B0TAU BFU= 2.Q0*B21UU-B0UU BFD= 2.Q0*B21DD-B0DD BFC= 2.Q0*B21CC-B0CC BFS= 2.Q0*B21SS-B0SS BFT= 2.Q0*B21TT-B0TT BFB= 2.Q0*B21BB-B0BB BFN= 2.Q0*B21NN-B0NN BFL= BFE+BFM+BFTAU BFUQ= BFU+BFC+BFT BFDQ= BFD+BFS+BFB * EFE= 2.Q0*E21EE-E0EE EFM= 2.Q0*E21MM-E0MM EFTAU= 2.Q0*E21TAU-E0TAU EFU= 2.Q0*E21UU-E0UU EFD= 2.Q0*E21DD-E0DD EFC= 2.Q0*E21CC-E0CC EFS= 2.Q0*E21SS-E0SS EFT= 2.Q0*E21TT-E0TT EFB= 2.Q0*E21BB-E0BB EFN= 2.Q0*E21NN-E0NN EFL= EFE+EFM+EFTAU EFUQ= EFU+EFC+EFT EFDQ= EFD+EFS+EFB * QS2= QSPSC*QSPSC AEXPS= QALSTS/QPI AEXPSZ= QALSTZ/QPI RM= QTQM2/QS2 RL= LOG(RM) BX= -RL-4.Q0*Z3+55.Q0/12.Q0 BY= 3.Q0*RL*RL-11.Q0/2.Q0*RL+6.Q0*Z3+QPIS/2.Q0- # 11.Q0/8.Q0 RV= -0.25Q0*P2X/QTQM2 XV= -P2X/QTQM2 FB= -Z3+55.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QS2) FBP= -Z3+43.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QS2) FLQ= -Z3+55.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QZM2) FLQP= -Z3+43.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QZM2) * OS3GF= # P2X*(BFL+2.Q0*BFUQ+BFDQ)+8.Q0/3.Q0*AEXPS*QTQM2*( # RV*BX+QV1)-4.Q0/3.Q0*AEXPS*P2X*FB-8.Q0*AEXPSZ*P2X*FLQ * OS3GB= # P2X*(-10.Q0*B21WW+13.Q0/2.Q0*B0WW+2.Q0/3.Q0) # -2.Q0*QWM2*(B0WW-B0WW0) * PZZF= # +0.5Q0*(BFL+3.Q0*BFUQ+3.Q0*BFDQ+3.Q0*BFN) * PZZB= # -9.Q0*B21WW+25.Q0/4.Q0*B0WW+2.Q0/3.Q0 * PZZH= -B21ZH-B1ZH-0.25Q0*B0ZH IF(OU3.EQ.'N') THEN PZZB= PZZB+PZZH ELSE IF(OU3.EQ.'Y') THEN PZZF= PZZF+PZZH ENDIF * SIGZZF= # -0.5Q0*(QEM2*B0EE+3.Q0*QUQM2*B0UU+3.Q0*QDQM2* # B0DD+QMM2*B0MM+3.Q0*QCQM2*B0CC+3.Q0*QSQM2*B0SS+ # QTM2*B0TAU+3.Q0*QBQM2*B0BB)-3.Q0/2.Q0*QTQM2*B0TT * SIGZZB= # -2.Q0*QWM2*B0WW+4.Q0*QWM2*B0WW0 * SIGZZH= QZM2*(0.5Q0*B1ZH+5.Q0/4.Q0* # B0ZH)-0.5Q0*QHM2*(B1ZH+0.5Q0*B0ZH) IF(OU3.EQ.'N') THEN SIGZZB= SIGZZB+SIGZZH ELSE IF(OU3.EQ.'Y') THEN SIGZZF= SIGZZF+SIGZZH ENDIF * OS33F= P2X*PZZF+SIGZZF+AEXPS*QTQM2*(2.Q0*RV*BX+BY+QV1+QA1)- # 2.Q0*AEXPS*P2X*FB-8.Q0*AEXPSZ*P2X*FLQ * OS33B= P2X*PZZB+SIGZZB * OSP3G= # -10.Q0*B21WW+13.Q0/2.Q0*B0WW+2.Q0/3.Q0+ # BFL+2.Q0*BFUQ+BFDQ+P2X*(10.Q0*E21WW-13.Q0/2.Q0* # E0WW-EFL-2.Q0*EFUQ-EFDQ)+2.Q0*QWM2*E0WW- # AEXPS*(2.Q0/3.Q0*(BX+QV1P)+4.Q0/3.Q0*FBP)- # 8.Q0*AEXPSZ*FLQP * PZZ= PZZF+PZZB * PPZZ= # -9.Q0*E21WW+25.Q0/4.Q0*E0WW # +0.5Q0*(EFL+3.Q0*EFUQ+3.Q0*EFDQ+3.Q0*EFN) # -E21ZH-E1ZH-0.25Q0*E0ZH * SIGPZZ= # -2.Q0*QWM2*E0WW-0.5Q0*(QEM2*E0EE+3.Q0*QUQM2*E0UU # +3.Q0*QDQM2*E0DD+QMM2*E0MM+3.Q0*QCQM2*E0CC+3.Q0* # QSQM2*E0SS+QTM2*E0TAU+3.Q0*QBQM2*E0BB)-3.Q0/2.Q0* # QTQM2*E0TT+QZM2*(0.5Q0*E1ZH+5.Q0/4.Q0*E0ZH)-0.5Q0* # QHM2*(E1ZH+0.5Q0*E0ZH) * OSP33= -P2X*PPZZ+PZZ-SIGPZZ-AEXPS*(0.25Q0*(2.Q0*BX+QV1P+ # QA1P)+2.Q0*FBP)-8.Q0*AEXPSZ*FLQP * IF(P2X.LT.(-4.Q0*QWM2)) THEN CALL TBFFS(P2X,QWM2,QWM2,B0W,B1W,B21W) OS33IW= # P2X*(-9.Q0*B21W(2)+25.Q0/4.Q0*B0W(2))- # 2.Q0*QWM2*B0W(2) OS3GIW= # P2X*(-10.Q0*B21W(2)+13.Q0/2.Q0*B0W(2))- # 2.Q0*QWM2*B0W(2) ELSE OS33IW= 0.D0 OS3GIW= 0.D0 ENDIF * RETURN END * *-----WSELF------------------------------------------------------------ * W TWO-POINT FUNCTIONS AT ARBITRARY MOMENTUM * SUBROUTINE TWSELF(P2X,OSWW,OPWW) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) * COMMON/TSSCAL/QSPSC COMMON/TSUB/OSINT2,ODSWW COMMON/TQVARIA/QALPHA,QSLLC COMMON/TMIX/QALST,QALSTZ,QALSTS COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DATA Z3/1.20205690315959428540Q0/ * PM= 1.Q-10 PM2= PM*PM * CALL TRBFFS(P2X,QNM2,QEM2,B0NE,B1NE,B21NE) CALL TRBFFS(P2X,QNM2,QMM2,B0NM,B1NM,B21NM) CALL TRBFFS(P2X,QNM2,QTM2,B0NT,B1NT,B21NT) CALL TRBFFS(P2X,QUQM2,QDQM2,B0UD,B1UD,B21UD) CALL TRBFFS(P2X,QCQM2,QSQM2,B0CS,B1CS,B21CS) CALL TRBFFS(P2X,QTQM2,QBQM2,B0TB,B1TB,B21TB) CALL TRBFFS(P2X,QZM2,QWM2,B0ZW,B1ZW,B21ZW) CALL TRBFFS(P2X,QWM2,QHM2,B0WH,B1WH,B21WH) CALL TRBFFS(P2X,QPM2,QWM2,B0PW,B1PW,B21PW) * CALL TRBFF0(QWM2,QWM2,B0WW0,B1WW0,B21WW0) * QS2= QSPSC*QSPSC AEXPS= QALSTS/QPI AEXPSZ= QALSTZ/QPI RM= QTQM2/QS2 RL= LOG(RM) BX= -RL-4.Q0*Z3+55.Q0/12.Q0 BY= 3.Q0*RL*RL-11.Q0/2.Q0*RL+6.Q0*Z3+QPIS/2.Q0- # 11.Q0/8.Q0 RV= -0.25Q0*P2X/QTQM2 XV= -P2X/QTQM2 FB= -Z3+55.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QS2) FLQ= -Z3+55.Q0/48.Q0-0.25Q0*LOG(ABS(P2X)/QZM2) * SIG0WW= # 9.Q0/2.Q0*(QZM2-QWM2)*B1ZW+(13.Q0*QZM2-21.Q0*QWM2)/4.Q0* # B0ZW+0.5Q0*(QWM2-QHM2)*B1WH+0.25Q0*(5.Q0*QWM2-QHM2)*B0WH+ # QEM2*B1NE+QMM2*B1NM+QTM2*B1NT+3.Q0*((QDQM2-QUQM2)*B1UD- # QUQM2*B0UD+(QSQM2-QCQM2)*B1CS-QCQM2*B0CS+(QBQM2-QTQM2)* # B1TB-QTQM2*B0TB)+4.Q0*QWM2*B0WW0 * SIG1WW= # 2.Q0*(QWM2-QZM2)*(2.Q0*B1ZW+B0ZW)-2.Q0*QWM2*(2.Q0*B1PW+ # B0PW) * PI0WW= 2.Q0/3.Q0-9.Q0*B21ZW-9.Q0*B1ZW+7.Q0/4.Q0*B0ZW-B21WH-B1WH- # 0.25Q0*B0WH+2.Q0*(B21NE+B21NM+B21NT+B1NE+B1NM+B1NT+3.Q0*( # B21UD+B21CS+B21TB+B1UD+B1CS+B1TB)) * PI1WW= 8.Q0*B21ZW-2.Q0*B0ZW+8.Q0*B1ZW-8.Q0*B21PW-8.Q0*B1PW+ # 2.Q0*B0PW * OPWW= PI0WW+OSINT2*PI1WW-8.Q0*AEXPSZ*FLQ OSWW= SIG0WW+OSINT2*SIG1WW+4.Q0*AEXPS*QTQM2*(0.25Q0*(XV*BX+BY)+ # QF1) * RETURN END * *-----RSPENCE----------------------------------------------------- * GIVES THE REAL PART OF LI_2(Z) IN DOUBLE PRECISION. ACCURACY * IS ABOUT 8 DIGITS * REAL*8 FUNCTION TRSPENCE(XR,XI) IMPLICIT REAL*8(A,B,D-H,O-Z) IMPLICIT COMPLEX*16 (C) * COMMON/TPARAM/PI,PIS,DELTA * DATA B0/1.D0/,B1/-0.25D0/,B2/0.277777777777778D-1/, # B4/-0.277777777777778D-3/,B6/0.472411186696901D-5/ * C0= CMPLX(0.D0) PIS6= PIS/6.D0 CX= CMPLX(XR,XI) COMX= 1.D0-CX IF(XR.LT.0.D0) THEN CY= 1.D0-CX SIGN1= -1.D0 CLNX= LOG(CX) CLNOMX= LOG(COMX) CADD1= PIS6-CLNX*CLNOMX ELSE CY= CX SIGN1= 1.D0 CADD1= C0 ENDIF COMY= 1.D0-CY YM2= CONJG(CY)*CY YM= SQRT(YM2) IF(YM.GT.1.D0) THEN CZ= CONJG(CY)/YM2 SIGN2= -1.D0 COY= -CY CLNOY= LOG(COY) CADD2= -PIS6-0.5D0*CLNOY*CLNOY ELSE CZ= CY SIGN2= 1.D0 CADD2= C0 ENDIF COMZ= 1.D0-CZ ZR= DREAL(CZ) IF(ZR.GT.0.5D0) THEN CT= 1.D0-CZ COMT= 1.D0-CT SIGN3= -1.D0 CLNZ= LOG(CZ) CLNOMZ= LOG(COMZ) CADD3= PIS6-CLNZ*CLNOMZ ELSE CT= CZ COMT= 1.D0-CT SIGN3= 1.D0 CADD3= C0 ENDIF CPAR= LOG(COMT) CPAR2= CPAR*CPAR * CRES= -CPAR*(B0-CPAR*(B1-CPAR*(B2+CPAR2*(B4+B6*CPAR2)))) * CLI2= SIGN1*(SIGN2*(SIGN3*CRES+CADD3)+CADD2)+CADD1 * TRSPENCE= DREAL(CLI2) * RETURN END * *-----ELECTROWEAK LIBRARY QFORMFS * *------------------------------------------------------------------------ *-----QFORMFS-(WITH 4-POINT FUNCTIONS)----------------------------------- *------------------------------------------------------------------------ * *-----BFF-------------------------------------------------------- * COMPUTES THE ONE-LOOP TWO-POINT FORM FACTORS /I*PI^2 * B0,B1,B21 * !!! B22 MUST BE COMPUTED SEPARATELY !!! * INPUT PARAMETERS ARE P^2,M1^2,M2^2 * SUBROUTINE TBFF(P2,RM12,RM22,B0,B1,B21) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION CMP2(2),CLNMP2(2),B0(2),B1(2),B21(2) DIMENSION GFPR(3),GFMR(3),GFPI(3),GFMI(3) CMP2(1)= -P2 CMP2(2)= -QEPS * M1^2= M2^2 ---> 0 CALL TROOTS(P2,RM12,RM22,RPR,RPI,RMR,RMI,OMRPR,OMRMR) * CALL TCQLNX(CMP2,CLNMP2) N= 3 CALL TCG(N,RPR,RPI,OMRPR,GFPR,GFPI) CALL TCG(N,RMR,RMI,OMRMR,GFMR,GFMI) * AUXDEL= QDELTA-CLNMP2(1) B0(1)= AUXDEL-GFPR(1)-GFMR(1) B0(2)= -CLNMP2(2)-GFPI(1)-GFMI(1) B1(1)= -AUXDEL/2.Q0+GFPR(2)+GFMR(2) B1(2)= +CLNMP2(2)/2.Q0+GFPI(2)+GFMI(2) B21(1)= AUXDEL/3.Q0-GFPR(3)-GFMR(3) B21(2)= -CLNMP2(2)/3.Q0-GFPI(3)-GFMI(3) * RETURN END * *-----TBFFS---------------------------------------------------------- * SUBROUTINE TBFFS(P2,RM12,RM22,B0,B1,B21) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION GFR(3),GFI(3) DIMENSION GFPR(3),GFMR(3),GFPI(3),GFMI(3) DIMENSION CA(2,10),AAUX(2),AUX(2),ZP(2),CT(16),SN(16) DIMENSION ACMP2(2),CMP2(2),CLNMP2(2),B0(2),B1(2),B21(2) DIMENSION A(2,4),RA(16),Z(2),AOMZ(2),OMZ(2),AOZ(2),OZ(2), # CLNOMZ(2),CLNOZ(2) * DATA RA/-0.2Q+0,0.666666666666667Q-1, # -0.952380952380952Q-2,-0.396825396825397Q-3, # 0.317460317460317Q-3,-0.132275132275132Q-4, # -0.962000962000962Q-5,0.105218855218855Q-5, # 0.266488361726450Q-6,-0.488745528428000Q-7, # -0.675397500794000Q-8,0.190720263471000Q-8, # 0.153663007690000Q-9,-0.679697905790000Q-10, # -0.293683556000000Q-11,0.228836696000000Q-11/ * CMP2(1)= -P2 CMP2(2)= -QEPS * IF(RM12.EQ.RM22) THEN DISC2= (P2+4.Q0*RM12)*P2 ELSE DISC2= (RM22+2.Q0*(P2-RM12))*RM22+(P2+RM12)*(P2+RM12) ENDIF IF(DISC2.GT.0.Q0) THEN DISC= SQRT(DISC2) RPI= +QEPS/DISC RMI= -QEPS/DISC R1= 1.Q-10*ABS(P2) R2= 1.Q-10*RM12 * IF(RM22.LT.R1.OR.RM22.LT.R2) THEN AA= -P2 B= P2+RM12-RM22 C= RM22 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RMR= 1.Q0-C/Q RPR= 1.Q0-Q/AA OMRPR= Q/AA OMRMR= C/Q ELSE Q= -0.5Q0*(B-DISC) RMR= 1.Q0-Q/AA RPR= 1.Q0-C/Q OMRPR= C/Q OMRMR= Q/AA ENDIF ELSE AA= -P2 B= P2+RM22-RM12 C= RM12 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RPR= C/Q RMR= Q/AA OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ELSE Q= -0.5Q0*(B-DISC) RPR= Q/AA RMR= C/Q OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ENDIF ENDIF ELSE DISC= SQRT(-DISC2) AA= -P2 B= P2+RM22-RM12 RPR= -B/2.Q0/AA RMR= -B/2.Q0/AA OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR RPI= +DISC/2.Q0/AA RMI= -DISC/2.Q0/AA ENDIF * DO I= 1,2 ACMP2(I)= ABS(CMP2(I)) ENDDO ZM2= (CMP2(1))**2+(CMP2(2))**2 ZM= SQRT(ZM2) CLNMP2(1)= LOG(ZM) IF(CMP2(1).EQ.0.Q0) THEN IF(CMP2(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF CLNMP2(2)= TETA ELSE IF(CMP2(2).EQ.0.Q0) THEN IF(CMP2(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF CLNMP2(2)= TETA ELSE TNTETA= ACMP2(2)/ACMP2(1) TETA= ATAN(TNTETA) SR= CMP2(1)/ACMP2(1) SI= CMP2(2)/ACMP2(2) IF(SR.GT.0.Q0) THEN CLNMP2(2)= SI*TETA ELSE CLNMP2(2)= SI*(QPI-TETA) ENDIF ENDIF * N= 3 DO II=1,2 IF(II.EQ.1) THEN ZR= RPR OMZR= OMRPR ZI= RPI ELSE IF(II.EQ.2) THEN ZR= RMR OMZR= OMRMR ZI= RMI ENDIF Z(1)= ZR Z(2)= ZI OMZ(1)= OMZR OMZ(2)= -ZI IF(ZR.EQ.0.Q0.AND.ZI.EQ.0.Q0) THEN DO K=1,N GFR(K)= -1.Q0/K/K GFI(K)= 0.Q0 ENDDO ELSE IF(ZR.EQ.1.Q0.AND.ZI.EQ.0.Q0) THEN A(1,1)= -1.Q0 A(2,1)= QPI DO J=2,4 A(1,J)= ((J-1.Q0)*A(1,J-1)-1.Q0/J)/J A(2,J)= (J-1.Q0)/J*A(2,J-1) ENDDO DO K=1,N GFR(K)= A(1,K) GFI(K)= A(2,K) ENDDO ELSE ZMOD2= ZR*ZR+ZI*ZI ZMOD= SQRT(ZMOD2) DO IZ= 1,2 AOMZ(IZ)= ABS(OMZ(IZ)) ENDDO ZM2= (OMZ(1))**2+(OMZ(2))**2 ZM= SQRT(ZM2) CLNOMZ(1)= LOG(ZM) IF(OMZ(1).EQ.0.Q0) THEN IF(OMZ(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF CLNOMZ(2)= TETA ELSE IF(OMZ(2).EQ.0.Q0) THEN IF(OMZ(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF CLNOMZ(2)= TETA ELSE TNTETA= AOMZ(2)/AOMZ(1) TETA= ATAN(TNTETA) SR= OMZ(1)/AOMZ(1) SI= OMZ(2)/AOMZ(2) IF(SR.GT.0.Q0) THEN CLNOMZ(2)= SI*TETA ELSE CLNOMZ(2)= SI*(QPI-TETA) ENDIF ENDIF IF(ZMOD.LT.4.Q0) THEN OZ(1)= -Z(1) OZ(2)= -Z(2) DO IZ= 1,2 AOZ(IZ)= ABS(OZ(IZ)) ENDDO ZM2= (OZ(1))**2+(OZ(2))**2 ZM= SQRT(ZM2) CLNOZ(1)= LOG(ZM) IF(OZ(1).EQ.0.Q0) THEN IF(OZ(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF CLNOZ(2)= TETA ELSE IF(OZ(2).EQ.0.Q0) THEN IF(OZ(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF CLNOZ(2)= TETA ELSE TNTETA= AOZ(2)/AOZ(1) TETA= ATAN(TNTETA) SR= OZ(1)/AOZ(1) SI= OZ(2)/AOZ(2) IF(SR.GT.0.Q0) THEN CLNOZ(2)= SI*TETA ELSE CLNOZ(2)= SI*(QPI-TETA) ENDIF ENDIF CA(1,1)= OMZ(1)*CLNOMZ(1)-OMZ(2)*CLNOMZ(2)+ # Z(1)*CLNOZ(1)-Z(2)*CLNOZ(2)-1.Q0 CA(2,1)= OMZ(1)*CLNOMZ(2)+OMZ(2)*CLNOMZ(1)+ # Z(1)*CLNOZ(2)+Z(2)*CLNOZ(1) IF(N.EQ.1) THEN GFR(1)= CA(1,1) GFI(1)= CA(2,1) ELSE DO J= 2,N JM1= J-1 CA(1,J)= ((J-1.Q0)*(Z(1)*CA(1,JM1)-Z(2)* # CA(2,JM1))+OMZ(1)*CLNOMZ(1)-OMZ(2)* # CLNOMZ(2)-1.Q0/J)/J CA(2,J)= ((J-1.Q0)*(Z(1)*CA(2,JM1)+Z(2)* # CA(1,JM1))+OMZ(1)*CLNOMZ(2)+OMZ(2)* # CLNOMZ(1))/J ENDDO DO K=1,N GFR(K)= CA(1,K) GFI(K)= CA(2,K) ENDDO ENDIF ELSE AUX(1)= (-ZR*OMZR+ZI**2)/ZMOD2 AUX(2)= ZI/ZMOD2 DO IZ= 1,2 AAUX(IZ)= ABS(AUX(IZ)) ENDDO ZM2= (AUX(1))**2+(AUX(2))**2 ZM= SQRT(ZM2) ZP(1)= LOG(ZM) IF(AUX(1).EQ.0.Q0) THEN IF(AUX(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF ZP(2)= TETA ELSE IF(AUX(2).EQ.0.Q0) THEN IF(AUX(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF ZP(2)= TETA ELSE TNTETA= AAUX(2)/AAUX(1) TETA= ATAN(TNTETA) SR= AUX(1)/AAUX(1) SI= AUX(2)/AAUX(2) IF(SR.GT.0.Q0) THEN ZP(2)= SI*TETA ELSE ZP(2)= SI*(QPI-TETA) ENDIF ENDIF ZPM2= ZP(1)*ZP(1)+ZP(2)*ZP(2) ZPM= SQRT(ZPM2) CT(1)= ZP(1)/ZPM SN(1)= ZP(2)/ZPM DO K=2,16 CT(K)= CT(1)*CT(K-1)-SN(1)*SN(K-1) SN(K)= SN(1)*CT(K-1)+CT(1)*SN(K-1) ENDDO CA(1,4)= RA(16)*CT(16)*ZPM+RA(15)*CT(15) CA(2,4)= RA(16)*SN(16)*ZPM+RA(15)*SN(15) DO J=14,1,-1 CA(1,4)= CA(1,4)*ZPM+RA(J)*CT(J) CA(2,4)= CA(2,4)*ZPM+RA(J)*SN(J) ENDDO CA(1,4)= CA(1,4)*ZPM CA(2,4)= CA(2,4)*ZPM DO J= 3,1,-1 JP1= J+1 CA(1,J)= ((CA(1,JP1)+1.Q0/JP1)*Z(1)+CA(2,JP1)* # Z(2))/ZMOD2 CA(2,J)= (CA(2,JP1)*Z(1)-(CA(1,JP1)+1.Q0/JP1)* # Z(2))/ZMOD2 ENDDO DO K=1,N GFR(K)= (CA(1,K)+CLNOMZ(1))/K GFI(K)= (CA(2,K)+CLNOMZ(2))/K ENDDO ENDIF ENDIF IF(II.EQ.1) THEN DO JJ=1,N GFPR(JJ)= GFR(JJ) GFPI(JJ)= GFI(JJ) ENDDO ELSE IF(II.EQ.2) THEN DO JJ=1,N GFMR(JJ)= GFR(JJ) GFMI(JJ)= GFI(JJ) ENDDO ENDIF ENDDO * AUXDEL= QDELTA-CLNMP2(1) B0(1)= AUXDEL-GFPR(1)-GFMR(1) B0(2)= -CLNMP2(2)-GFPI(1)-GFMI(1) B1(1)= -AUXDEL/2.Q0+GFPR(2)+GFMR(2) B1(2)= +CLNMP2(2)/2.Q0+GFPI(2)+GFMI(2) B21(1)= AUXDEL/3.Q0-GFPR(3)-GFMR(3) B21(2)= -CLNMP2(2)/3.Q0-GFPI(3)-GFMI(3) * RETURN END * *-----RBFF---------------------------------------------------- * COMPUTES THE REAL PART OF THE ONE-LOOP TWO-POINT * FORM FACTORS /I*PI^2 * B0,B1,B21 * !!! B22 MUST BE COMPUTED SEPARATELY !!! * INPUT PARAMETERS ARE P^2,M1^2,M2^2 * SUBROUTINE TRBFF(P2,RM12,RM22,RB0,RB1,RB21) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION CMP2(2),CLNMP2(2),GFPR(3),GFMR(3) * CMP2(1)= -P2 CMP2(2)= -QEPS * * M1^2= M2^2 ---> 0 * CALL TROOTS(P2,RM12,RM22,RPR,RPI,RMR,RMI,OMRPR,OMRMR) CALL TCQLNX(CMP2,CLNMP2) N= 3 CALL TRCG(N,RPR,RPI,OMRPR,GFPR) CALL TRCG(N,RMR,RMI,OMRMR,GFMR) AUXDEL= QDELTA-CLNMP2(1) RB0= AUXDEL-GFPR(1)-GFMR(1) RB1= -AUXDEL/2.Q0+GFPR(2)+GFMR(2) RB21= AUXDEL/3.Q0-GFPR(3)-GFMR(3) * RETURN END * *-----TBFFS---------------------------------------------------------- * SUBROUTINE TRBFFS(P2,RM12,RM22,RB0,RB1,RB21) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION GFR(3) DIMENSION GFPR(3),GFMR(3) DIMENSION CA(2,10),AAUX(2),AUX(2),ZP(2),CT(16),SN(16) DIMENSION ACMP2(2),CMP2(2),CLNMP2(2),A(2,4),RA(16),Z(2), # AOMZ(2),OMZ(2),AOZ(2),OZ(2),CLNOMZ(2),CLNOZ(2) * DATA RA/-0.2Q+0,0.666666666666667Q-1, # -0.952380952380952Q-2,-0.396825396825397Q-3, # 0.317460317460317Q-3,-0.132275132275132Q-4, # -0.962000962000962Q-5,0.105218855218855Q-5, # 0.266488361726450Q-6,-0.488745528428000Q-7, # -0.675397500794000Q-8,0.190720263471000Q-8, # 0.153663007690000Q-9,-0.679697905790000Q-10, # -0.293683556000000Q-11,0.228836696000000Q-11/ * CMP2(1)= -P2 CMP2(2)= -QEPS * IF(RM12.EQ.RM22) THEN DISC2= (P2+4.Q0*RM12)*P2 ELSE DISC2= (RM22+2.Q0*(P2-RM12))*RM22+(P2+RM12)*(P2+RM12) ENDIF IF(DISC2.GT.0.Q0) THEN DISC= SQRT(DISC2) RPI= +QEPS/DISC RMI= -QEPS/DISC R1= 1.Q-10*ABS(P2) R2= 1.Q-10*RM12 * IF(RM22.LT.R1.OR.RM22.LT.R2) THEN AA= -P2 B= P2+RM12-RM22 C= RM22 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RMR= 1.Q0-C/Q RPR= 1.Q0-Q/AA OMRPR= Q/AA OMRMR= C/Q ELSE Q= -0.5Q0*(B-DISC) RMR= 1.Q0-Q/AA RPR= 1.Q0-C/Q OMRPR= C/Q OMRMR= Q/AA ENDIF ELSE AA= -P2 B= P2+RM22-RM12 C= RM12 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RPR= C/Q RMR= Q/AA OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ELSE Q= -0.5Q0*(B-DISC) RPR= Q/AA RMR= C/Q OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ENDIF ENDIF ELSE DISC= SQRT(-DISC2) AA= -P2 B= P2+RM22-RM12 RPR= -B/2.Q0/AA RMR= -B/2.Q0/AA OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR RPI= +DISC/2.Q0/AA RMI= -DISC/2.Q0/AA ENDIF * DO I= 1,2 ACMP2(I)= ABS(CMP2(I)) ENDDO ZM2= (CMP2(1))**2+(CMP2(2))**2 ZM= SQRT(ZM2) CLNMP2(1)= LOG(ZM) IF(CMP2(1).EQ.0.Q0) THEN IF(CMP2(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF CLNMP2(2)= TETA ELSE IF(CMP2(2).EQ.0.Q0) THEN IF(CMP2(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF CLNMP2(2)= TETA ELSE TNTETA= ACMP2(2)/ACMP2(1) TETA= ATAN(TNTETA) SR= CMP2(1)/ACMP2(1) SI= CMP2(2)/ACMP2(2) IF(SR.GT.0.Q0) THEN CLNMP2(2)= SI*TETA ELSE CLNMP2(2)= SI*(QPI-TETA) ENDIF ENDIF * N= 3 DO II=1,2 IF(II.EQ.1) THEN ZR= RPR OMZR= OMRPR ZI= RPI ELSE IF(II.EQ.2) THEN ZR= RMR OMZR= OMRMR ZI= RMI ENDIF Z(1)= ZR Z(2)= ZI OMZ(1)= OMZR OMZ(2)= -ZI IF(ZR.EQ.0.Q0.AND.ZI.EQ.0.Q0) THEN DO K=1,N GFR(K)= -1.Q0/K/K ENDDO ELSE IF(ZR.EQ.1.Q0.AND.ZI.EQ.0.Q0) THEN A(1,1)= -1.Q0 DO J=2,4 A(1,J)= ((J-1.Q0)*A(1,J-1)-1.Q0/J)/J ENDDO DO K=1,N GFR(K)= A(1,K) ENDDO ELSE ZMOD2= ZR*ZR+ZI*ZI ZMOD= SQRT(ZMOD2) DO IZ= 1,2 AOMZ(IZ)= ABS(OMZ(IZ)) ENDDO ZM2= (OMZ(1))**2+(OMZ(2))**2 ZM= SQRT(ZM2) CLNOMZ(1)= LOG(ZM) IF(OMZ(1).EQ.0.Q0) THEN IF(OMZ(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF CLNOMZ(2)= TETA ELSE IF(OMZ(2).EQ.0.Q0) THEN IF(OMZ(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF CLNOMZ(2)= TETA ELSE TNTETA= AOMZ(2)/AOMZ(1) TETA= ATAN(TNTETA) SR= OMZ(1)/AOMZ(1) SI= OMZ(2)/AOMZ(2) IF(SR.GT.0.Q0) THEN CLNOMZ(2)= SI*TETA ELSE CLNOMZ(2)= SI*(QPI-TETA) ENDIF ENDIF IF(ZMOD.LT.4.Q0) THEN OZ(1)= -Z(1) OZ(2)= -Z(2) DO IZ= 1,2 AOZ(IZ)= ABS(OZ(IZ)) ENDDO ZM2= (OZ(1))**2+(OZ(2))**2 ZM= SQRT(ZM2) CLNOZ(1)= LOG(ZM) IF(OZ(1).EQ.0.Q0) THEN IF(OZ(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF CLNOZ(2)= TETA ELSE IF(OZ(2).EQ.0.Q0) THEN IF(OZ(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF CLNOZ(2)= TETA ELSE TNTETA= AOZ(2)/AOZ(1) TETA= ATAN(TNTETA) SR= OZ(1)/AOZ(1) SI= OZ(2)/AOZ(2) IF(SR.GT.0.Q0) THEN CLNOZ(2)= SI*TETA ELSE CLNOZ(2)= SI*(QPI-TETA) ENDIF ENDIF CA(1,1)= OMZ(1)*CLNOMZ(1)-OMZ(2)*CLNOMZ(2)+ # Z(1)*CLNOZ(1)-Z(2)*CLNOZ(2)-1.Q0 CA(2,1)= OMZ(1)*CLNOMZ(2)+OMZ(2)*CLNOMZ(1)+ # Z(1)*CLNOZ(2)+Z(2)*CLNOZ(1) IF(N.EQ.1) THEN GFR(1)= CA(1,1) ELSE DO J= 2,N JM1= J-1 CA(1,J)= ((J-1.Q0)*(Z(1)*CA(1,JM1)-Z(2)* # CA(2,JM1))+OMZ(1)*CLNOMZ(1)-OMZ(2)* # CLNOMZ(2)-1.Q0/J)/J CA(2,J)= ((J-1.Q0)*(Z(1)*CA(2,JM1)+Z(2)* # CA(1,JM1))+OMZ(1)*CLNOMZ(2)+OMZ(2)* # CLNOMZ(1))/J ENDDO DO K=1,N GFR(K)= CA(1,K) ENDDO ENDIF ELSE AUX(1)= (-ZR*OMZR+ZI**2)/ZMOD2 AUX(2)= ZI/ZMOD2 DO IZ= 1,2 AAUX(IZ)= ABS(AUX(IZ)) ENDDO ZM2= (AUX(1))**2+(AUX(2))**2 ZM= SQRT(ZM2) ZP(1)= LOG(ZM) IF(AUX(1).EQ.0.Q0) THEN IF(AUX(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF ZP(2)= TETA ELSE IF(AUX(2).EQ.0.Q0) THEN IF(AUX(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF ZP(2)= TETA ELSE TNTETA= AAUX(2)/AAUX(1) TETA= ATAN(TNTETA) SR= AUX(1)/AAUX(1) SI= AUX(2)/AAUX(2) IF(SR.GT.0.Q0) THEN ZP(2)= SI*TETA ELSE ZP(2)= SI*(QPI-TETA) ENDIF ENDIF ZPM2= ZP(1)*ZP(1)+ZP(2)*ZP(2) ZPM= SQRT(ZPM2) CT(1)= ZP(1)/ZPM SN(1)= ZP(2)/ZPM DO K=2,16 CT(K)= CT(1)*CT(K-1)-SN(1)*SN(K-1) SN(K)= SN(1)*CT(K-1)+CT(1)*SN(K-1) ENDDO CA(1,4)= RA(16)*CT(16)*ZPM+RA(15)*CT(15) CA(2,4)= RA(16)*SN(16)*ZPM+RA(15)*SN(15) DO J=14,1,-1 CA(1,4)= CA(1,4)*ZPM+RA(J)*CT(J) CA(2,4)= CA(2,4)*ZPM+RA(J)*SN(J) ENDDO CA(1,4)= CA(1,4)*ZPM CA(2,4)= CA(2,4)*ZPM DO J= 3,1,-1 JP1= J+1 CA(1,J)= ((CA(1,JP1)+1.Q0/JP1)*Z(1)+CA(2,JP1)* # Z(2))/ZMOD2 CA(2,J)= (CA(2,JP1)*Z(1)-(CA(1,JP1)+1.Q0/JP1)* # Z(2))/ZMOD2 ENDDO DO K=1,N GFR(K)= (CA(1,K)+CLNOMZ(1))/K ENDDO ENDIF ENDIF IF(II.EQ.1) THEN DO JJ=1,N GFPR(JJ)= GFR(JJ) ENDDO ELSE IF(II.EQ.2) THEN DO JJ=1,N GFMR(JJ)= GFR(JJ) ENDDO ENDIF ENDDO * AUXDEL= QDELTA-CLNMP2(1) RB0= AUXDEL-GFPR(1)-GFMR(1) RB1= -AUXDEL/2.Q0+GFPR(2)+GFMR(2) RB21= AUXDEL/3.Q0-GFPR(3)-GFMR(3) * RETURN END * * *-----BPFF------------------------------------------------ * COMPUTES MINUS THE DERIVATIVE OF ONE-LOOP TWO-POINT * FORM FACTORS /I*PI^2 * B0P,B1P,B21P * INPUT PARAMETERS ARE P^2,M1^2,M2^2 * SUBROUTINE TBPFF(P2,RM12,RM22,B0P,B1P,B21P) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION B0P(2),B1P(2),B21P(2) DIMENSION GFPR(4),GFPI(4),GFMR(4),GFMI(4) * IF(RM12.EQ.RM22.AND.RM12.LT.1.Q-15) THEN B0P(1)= 1.Q0/P2 B0P(2)= 0.Q0 B1P(1)= -1.Q0/2.Q0/P2 B1P(2)= 0.Q0 B21P(1)= 1.Q0/3.Q0/P2 B21P(2)= 0.Q0 RETURN ELSE CALL TROOTS(P2,RM12,RM22,RPR,RPI,RMR,RMI,OMRPR,OMRMR) DRR= RPR-RMR DRI= RPI-RMI DRM2= DRR*DRR+DRI*DRI N= 4 CALL TCG(N,RPR,RPI,OMRPR,GFPR,GFPI) CALL TCG(N,RMR,RMI,OMRMR,GFMR,GFMI) EX0R= 2.Q0*(GFMR(2)-GFPR(2))-GFMR(1)+GFPR(1) EX0I= 2.Q0*(GFMI(2)-GFPI(2))-GFMI(1)+GFPI(1) EX1R= 2.Q0*(GFMR(2)-GFPR(2))-3.Q0*(GFMR(3)-GFPR(3)) EX1I= 2.Q0*(GFMI(2)-GFPI(2))-3.Q0*(GFMI(3)-GFPI(3)) EX2R= 4.Q0*(GFMR(4)-GFPR(4))-3.Q0*(GFMR(3)-GFPR(3)) EX2I= 4.Q0*(GFMI(4)-GFPI(4))-3.Q0*(GFMI(3)-GFPI(3)) B0P(1)= 1.Q0/DRM2/P2*(DRR*EX0R+DRI*EX0I) B0P(2)= 1.Q0/DRM2/P2*(DRR*EX0I-DRI*EX0R) B1P(1)= 1.Q0/DRM2/P2*(DRR*EX1R+DRI*EX1I) B1P(2)= 1.Q0/DRM2/P2*(DRR*EX1I-DRI*EX1R) B21P(1)= 1.Q0/DRM2/P2*(DRR*EX2R+DRI*EX2I) B21P(2)= 1.Q0/DRM2/P2*(DRR*EX2I-DRI*EX2R) RETURN ENDIF * END * *-----RBPFF---------------------------------------------- * COMPUTES MINUS THE DERIVATIVE OF THE REAL PART OF * ONE-LOOP TWO-POINT FORM FACTORS /I*PI^2 * B0P,B1P,B21P * INPUT PARAMETERS ARE P^2,M1^2,M2^2 * SUBROUTINE TRBPFF(P2,RM12,RM22,RB0P,RB1P,RB21P) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION GFPR(4),GFPI(4),GFMR(4),GFMI(4) * IF(RM12.EQ.RM22.AND.RM12.LT.1.Q-15) THEN RB0P= 1.Q0/P2 RB1P= -1.Q0/2.Q0/P2 RB21P= 1.Q0/3.Q0/P2 RETURN ELSE CALL TROOTS(P2,RM12,RM22,RPR,RPI,RMR,RMI,OMRPR,OMRMR) DRR= RPR-RMR DRI= RPI-RMI DRM2= DRR*DRR+DRI*DRI N= 4 CALL TCG(N,RPR,RPI,OMRPR,GFPR,GFPI) CALL TCG(N,RMR,RMI,OMRMR,GFMR,GFMI) EX0R= 2.Q0*(GFMR(2)-GFPR(2))-GFMR(1)+GFPR(1) EX0I= 2.Q0*(GFMI(2)-GFPI(2))-GFMI(1)+GFPI(1) EX1R= 2.Q0*(GFMR(2)-GFPR(2))-3.Q0*(GFMR(3)-GFPR(3)) EX1I= 2.Q0*(GFMI(2)-GFPI(2))-3.Q0*(GFMI(3)-GFPI(3)) EX2R= 4.Q0*(GFMR(4)-GFPR(4))-3.Q0*(GFMR(3)-GFPR(3)) EX2I= 4.Q0*(GFMI(4)-GFPI(4))-3.Q0*(GFMI(3)-GFPI(3)) RB0P= 1.Q0/DRM2/P2*(DRR*EX0R+DRI*EX0I) RB1P= 1.Q0/DRM2/P2*(DRR*EX1R+DRI*EX1I) RB21P= 1.Q0/DRM2/P2*(DRR*EX2R+DRI*EX2I) RETURN ENDIF * END * *-----CFF------------------------------------------------------- * COMPUTES THE ONE-LOOP THREE-POINT FORM FACTORS/I*PI^2 * C0,C11,C12,C21,C22,C23,C24 * ACCORDING TO THE CONVENTION * * (Q^2+M1^2)((Q+P1)^2+M2^2)((Q+P1+P2)^2+M3^2) * * INPUT PARAMETERS ARE P1^2,P2^2, S=P5^2=(P1+P2)^2 * M1^2,M2^2,M3^2 * * JFLAG = 1,2 SELECTS ONE OF THE ROOTS FOR ALPHA * ! NOW ALPHA CAN BE COMPLEX * SUBROUTINE TCFF(JFLAG,P12,P22,S,RM12,RM22,RM32,C0,C1,C2) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION C0(2),C1(2,2),C2(2,4) DIMENSION B0_12(2),B1_12(2),B21_12(2) DIMENSION B0_13(2),B1_13(2),B21_13(2) DIMENSION B0_23(2),B1_23(2),B21_23(2) DIMENSION R2_32(2,2),TMP2_32(2,2),TMP0(2),TMP24(2) DIMENSION XMI(2,2),R1(2,2),TMP1(2,2),R2_13(2,2),TMP2_13(2,2) * P1DP2= 0.5Q0*(S-P12-P22) DEN= -S*S/4.Q0*(1.Q0+((P12-P22)*(P12-P22)/S- # 2.Q0*(P12+P22))/S) DM12= RM12-RM22 DM13= RM12-RM32 DM23= RM22-RM32 RA= -P22 RB= -P12 RC= -2.Q0*P1DP2 RD= DM23+P22 RE= DM12+P12+2.Q0*P1DP2 RAA= -P22+DM23 RBB= P12+DM12 RCC= -2.Q0*P1DP2-P22+DM23 RDD= -P12+DM12 DISCP= +2.Q0*SQRT(ABS(DEN)) DISCM= -DISCP IF(DEN.LT.0.Q0) THEN CALL TALPHA(P12,P22,S,AP,AM,OMAP,OMAM) IF(JFLAG.EQ.1) THEN ALP= AP OMALP= OMAP DISC= DISCP ELSE IF(JFLAG.EQ.2) THEN ALP= AM OMALP= OMAM DISC= DISCM ELSE PRINT*,'JFLAG > 2' STOP ENDIF ALPI= 0.Q0 Y0R= -(RD+RE*ALP)/DISC Y0I= 0.Q0 Y1R= -(RAA+RBB*ALP)/DISC Y1I= Y0I OMY1R= (RCC+RDD*ALP)/DISC Y2R= Y0R/OMALP Y2I= Y0I/OMALP OMY2R= OMY1R/OMALP Y3R= -Y0R/ALP Y3I= -Y0I/ALP OMY3R= Y1R/ALP ELSE IF(DEN.GT.0) THEN ALP= (P12+P22-S)/2.Q0/P12 OMALP= (P12-P22+S)/2.Q0/P12 CALPI= SQRT(DEN)/P12 IF(JFLAG.EQ.1) THEN ALPI= -CALPI DISC= DISCP ELSE IF(JFLAG.EQ.2) THEN ALPI= CALPI DISC= DISCM ELSE PRINT*,'JFLAG > 2' STOP ENDIF Y0R= -RE*ALPI/DISC Y0I= (RD+RE*ALP)/DISC Y1R= -RBB*ALPI/DISC Y1I= (RAA+RBB*ALP)/DISC OMY1R= RDD*ALPI/DISC OMALPM2= OMALP*OMALP+ALPI*ALPI Y2R= (Y0R*OMALP-Y0I*ALPI)/OMALPM2 Y2I= (Y0R*ALPI+Y0I*OMALP)/OMALPM2 OMY2R= (OMY1R*OMALP+Y1I*ALPI)/OMALPM2 ALPM2= ALP*ALP+ALPI*ALPI Y3R= -(Y0R*ALP+Y0I*ALPI)/ALPM2 Y3I= -(-Y0R*ALPI+Y0I*ALP)/ALPM2 OMY3R= (Y1R*ALP+Y1I*ALPI)/ALPM2 ENDIF * CALL TROOTS(P12,RM22,RM12,RP1R,RP1I,RM1R,RM1I,OMRP1R,OMRM1R) CALL TROOTS(S,RM32,RM12,RP2R,RP2I,RM2R,RM2I,OMRP2R,OMRM2R) CALL TROOTS(P22,RM32,RM22,RP3R,RP3I,RM3R,RM3I,OMRP3R,OMRM3R) * A1= -P12 A2= -S A3= -P22 EB1R= -1.Q0-DM12/P12 EB1I= 0.Q0 EC1I= QEPS/P12 EB2R= -1.Q0-DM13/S EB2I= 0.Q0 EC2I= QEPS/S EB3R= -1.Q0-DM23/P22 EB3I= 0.Q0 EC3I= QEPS/P22 CALL TS2(Y1R,Y1I,OMY1R,A1,EB1R,EB1I,EC1I,RP1R,RP1I,RM1R,RM1I, # OMRP1R,OMRM1R,S21R,S21I) CALL TS2(Y2R,Y2I,OMY2R,A2,EB2R,EB2I,EC2I,RP2R,RP2I,RM2R,RM2I, # OMRP2R,OMRM2R,S22R,S22I) CALL TS2(Y3R,Y3I,OMY3R,A3,EB3R,EB3I,EC3I,RP3R,RP3I,RM3R,RM3I, # OMRP3R,OMRM3R,S23R,S23I) * * SCALAR 3-POINT FUNCTION C0 * IF(DEN.LT.0.Q0) THEN TMP0(1)= (S21R-S22R+S23R)/DISC TMP0(2)= (S21I-S22I+S23I)/DISC ELSE IF(DEN.GT.0.Q0) THEN TMP0(1)= (S21I-S22I+S23I)/DISC TMP0(2)= -(S21R-S22R+S23R)/DISC ENDIF * F1= DM12-P12 F2= DM23-S+P12 * CALL TBFFS(P12,RM12,RM22,B0_12,B1_12,B21_12) CALL TBFFS(S,RM12,RM32,B0_13,B1_13,B21_13) CALL TBFFS(P22,RM22,RM32,B0_23,B1_23,B21_23) * XMI(1,1)= P22/DEN XMI(1,2)= -P1DP2/DEN XMI(2,1)= XMI(1,2) XMI(2,2)= P12/DEN * * C1 FORM FACTORS * DO I= 1,2 R1(I,1)= 0.5Q0*(F1*TMP0(I)+B0_13(I)-B0_23(I)) R1(I,2)= 0.5Q0*(F2*TMP0(I)+B0_12(I)-B0_13(I)) ENDDO * CALL TMULTI2(TMP1,XMI,R1) * * C2 FORM FACTORS * TMP24(1)= 0.25Q0-0.5Q0*RM12*TMP0(1)+ # 0.25Q0*(B0_23(1)-F1*TMP1(1,1)-F2*TMP1(1,2)) TMP24(2)= -0.5Q0*RM12*TMP0(2)+ # 0.25Q0*(B0_23(2)-F1*TMP1(2,1)-F2*TMP1(2,2)) DO I= 1,2 R2_13(I,1)= 0.5Q0*(F1*TMP1(I,1)+B1_13(I)+B0_23(I))-TMP24(I) R2_13(I,2)= 0.5Q0*(F2*TMP1(I,1)+B1_12(I)-B1_13(I)) ENDDO CALL TMULTI2(TMP2_13,XMI,R2_13) DO I= 1,2 R2_32(I,1)= 0.5Q0*(F1*TMP1(I,2)+B1_13(I)-B1_23(I)) R2_32(I,2)= 0.5Q0*(F2*TMP1(I,2)-B1_13(I))-TMP24(I) ENDDO CALL TMULTI2(TMP2_32,XMI,R2_32) * DO I= 1,2 C0(I)= TMP0(I) C1(I,1)= TMP1(I,1) C1(I,2)= TMP1(I,2) C2(I,1)= TMP2_13(I,1) C2(I,2)= TMP2_32(I,2) C2(I,3)= TMP2_13(I,2) C2(I,4)= TMP24(I) ENDDO * RETURN END * *-----TCFFS-------------------------------------------------------- * SUBROUTINE TCFFS(S,RM12,RM22,RM32,C0,C1,C2) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION RES(2),ACA(2) DIMENSION CA(2),CLN1(2),CLN2(2) DIMENSION C0(2),C1(2,2),C2(2,4) DIMENSION B0_12(2),B1_12(2),B21_12(2) DIMENSION B0_13(2),B1_13(2),B21_13(2) DIMENSION B0_23(2),B1_23(2),B21_23(2) DIMENSION R2_32(2,2),TMP2_32(2,2),TMP0(2),TMP24(2) DIMENSION XMI(2,2),R1(2,2),TMP1(2,2),R2_13(2,2),TMP2_13(2,2) * IF(RM12.EQ.0.Q0.AND.RM32.EQ.0.Q0) THEN ARGR= 1.Q0-S/RM22 OMARGR= S/RM22 ARGI= -S/(RM22*RM22)*QEPS CALL TSPENCE(ARGR,ARGI,OMARGR,SPR,SPI) TMP0(1)= (QPIS/6.D0-SPR)/S TMP0(2)= -SPI/S ELSE IF(RM32.EQ.0) THEN A1R= 1.Q0-(RM12*RM22+QEPS*QEPS)/(RM22*RM22) A1I= (-RM12+RM22)/(RM22*RM22)*QEPS A2R= 1.Q0-((S+RM12)*RM22+QEPS*QEPS)/(RM22*RM22) A2I= (-(S+RM12)+RM22)/(RM22*RM22)*QEPS OMA1R= 1.Q0-A1R OMA2R= 1.Q0-A2R CALL TSPENCE(A1R,A1I,OMA1R,SP1R,SP1I) CALL TSPENCE(A2R,A2I,OMA2R,SP2R,SP2I) TMP0(1)= (SP1R-SP2R)/S TMP0(2)= (SP1I-SP2I)/S ELSE IF(RM22.EQ.0.Q0.AND.RM12.NE.RM32) THEN P2= S IF(RM12.EQ.RM22) THEN DISC2= (P2+4.Q0*RM12)*P2 ELSE DISC2= (RM22+2.Q0*(P2-RM12))*RM22+(P2+RM12)*(P2+RM12) ENDIF IF(DISC2.GT.0.Q0) THEN DISC= SQRT(DISC2) RPI= +QEPS/DISC RMI= -QEPS/DISC RR1= 1.Q-10*ABS(P2) RR2= 1.Q-10*RM12 * IF(RM22.LT.RR1.OR.RM22.LT.RR2) THEN A= -P2 B= P2+RM12-RM22 C= RM22 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RMR= 1.Q0-C/Q RPR= 1.Q0-Q/A OMRPR= Q/A OMRMR= C/Q ELSE Q= -0.5Q0*(B-DISC) RMR= 1.Q0-Q/A RPR= 1.Q0-C/Q OMRPR= C/Q OMRMR= Q/A ENDIF ELSE A= -P2 B= P2+RM22-RM12 C= RM12 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RPR= C/Q RMR= Q/A OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ELSE Q= -0.5Q0*(B-DISC) RPR= Q/A RMR= C/Q OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ENDIF ENDIF ELSE DISC= SQRT(-DISC2) A= -P2 B= P2+RM22-RM12 RPR= -B/2.Q0/A RMR= -B/2.Q0/A OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR RPI= +DISC/2.Q0/A RMI= -DISC/2.Q0/A ENDIF * RPMS= RPR*RPR+RPI*RPI A1R= (RPR*(RPR-1.Q0)+RPI*RPI)/RPMS A1I= RPI/RPMS RMMS= (RMR-1.Q0)*(RMR-1.Q0)+RMI*RMI A2R= (RMR*(RMR-1.Q0)+RMI*RMI)/RMMS A2I= -RMI/RMMS DO I=1,2 IF(I.EQ.1) THEN CA(1)= A1R CA(2)= A1I ELSE IF(I.EQ.2) THEN CA(1)= A2R CA(2)= A2I ENDIF DO J= 1,2 ACA(J)= ABS(CA(J)) ENDDO ZM2= (CA(1))**2+(CA(2))**2 ZM= SQRT(ZM2) RES(1)= LOG(ZM) IF(CA(1).EQ.0.Q0) THEN IF(CA(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF RES(2)= TETA ELSE IF(CA(2).EQ.0.Q0) THEN IF(CA(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF RES(2)= TETA ELSE TNTETA= ACA(2)/ACA(1) TETA= ATAN(TNTETA) SR= CA(1)/ACA(1) SI= CA(2)/ACA(2) IF(SR.GT.0.Q0) THEN RES(2)= SI*TETA ELSE RES(2)= SI*(QPI-TETA) ENDIF ENDIF IF(I.EQ.1) THEN CLN1(1)= RES(1) CLN1(2)= RES(2) ELSE IF(I.EQ.2) THEN CLN2(1)= RES(1) CLN2(2)= RES(2) ENDIF ENDDO TMP0(1)= (CLN1(1)*CLN2(1)-CLN1(2)*CLN2(2))/S TMP0(2)= (CLN1(1)*CLN2(2)+CLN1(2)*CLN2(1))/S ELSE IF(RM22.EQ.0.Q0.AND.RM12.EQ.RM32) THEN BQRS= 1.Q0+4.Q0*RM12/S BQIS= -4.Q0*QEPS/S BQM= SQRT(BQRS*BQRS+BQIS*BQIS) BQR= SQRT(0.5Q0*(BQM+BQRS)) IF((BQM-BQRS).GT.1.Q-90) THEN BQDF= BQM-BQRS ELSE BQDF= 0.5D0*BQIS*BQIS/BQRS ENDIF IF(BQIS.GT.0.Q0) THEN BQI= SQRT(0.5Q0*BQDF) ELSE BQI= -SQRT(0.5Q0*BQDF) ENDIF CAM= (BQR-1.Q0)*(BQR-1.Q0)+BQI*BQI CA(1)= (BQR*BQR-1.Q0+BQI*BQI)/CAM CA(2)= -2.Q0*BQI/CAM DO J= 1,2 ACA(J)= ABS(CA(J)) ENDDO ZM2= (CA(1))**2+(CA(2))**2 ZM= SQRT(ZM2) RES(1)= LOG(ZM) IF(CA(1).EQ.0.Q0) THEN IF(CA(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF RES(2)= TETA ELSE IF(CA(2).EQ.0.Q0) THEN IF(CA(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF RES(2)= TETA ELSE TNTETA= ACA(2)/ACA(1) TETA= ATAN(TNTETA) SR= CA(1)/ACA(1) SI= CA(2)/ACA(2) IF(SR.GT.0.Q0) THEN RES(2)= SI*TETA ELSE RES(2)= SI*(QPI-TETA) ENDIF ENDIF CLN1(1)= RES(1) CLN1(2)= RES(2) TMP0(1)= (CLN1(1)*CLN1(1)-CLN1(2)*CLN1(2))/S TMP0(2)= 2.Q0*CLN1(1)*CLN1(2)/S ELSE IF(RM22.NE.0.Q0.AND.RM12.EQ.RM32) THEN P2= S DISC2= (P2+4.Q0*RM12)*P2 IF(DISC2.GT.0.Q0) THEN DISC= SQRT(DISC2) X2I= +QEPS/DISC X1I= -QEPS/DISC RR1= ABS(RM32/P2) IF(RR1.LT.1.Q-10) THEN A= -P2 B= P2 C= RM32 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) X1R= 1.Q0-C/Q X2R= 1.Q0-Q/A ELSE Q= -0.5Q0*(B-DISC) X1R= 1.Q0-Q/A X2R= 1.Q0-C/Q ENDIF ELSE A= -P2 B= P2 C= RM12 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) X2R= C/Q X1R= Q/A ELSE Q= -0.5Q0*(B-DISC) X2R= Q/A X1R= C/Q ENDIF ENDIF ELSE DISC= SQRT(-DISC2) A= -P2 B= P2 X2R= -B/2.Q0/A X1R= -B/2.Q0/A X2I= +DISC/2.Q0/A X1I= -DISC/2.Q0/A ENDIF X0= 1.Q0+(RM12-RM22)/S X3R= RM32/(RM32-RM22) X3I= -QEPS/(RM32-RM22) XINV1R= (X0-X1R)/((X0-X1R)*(X0-X1R)+X1I*X1I) XINV1I= X1I/((X0-X1R)*(X0-X1R)+X1I*X1I) XINV2R= (X0-X2R)/((X0-X2R)*(X0-X2R)+X2I*X2I) XINV2I= X2I/((X0-X2R)*(X0-X2R)+X2I*X2I) XINV3R= (X0-X3R)/((X0-X3R)*(X0-X3R)+X3I*X3I) XINV3I= X3I/((X0-X3R)*(X0-X3R)+X3I*X3I) A1R= X0*XINV1R A1I= X0*XINV1I A2R= (X0-1.Q0)*XINV1R A2I= (X0-1.Q0)*XINV1I A3R= X0*XINV2R A3I= X0*XINV2I A4R= (X0-1.Q0)*XINV2R A4I= (X0-1.Q0)*XINV2I A5R= X0*XINV3R A5I= X0*XINV3I A6R= (X0-1.Q0)*XINV3R A6I= (X0-1.Q0)*XINV3I OMA1R= 1.Q0-A1R OMA2R= 1.Q0-A2R OMA3R= 1.Q0-A3R OMA4R= 1.Q0-A4R OMA5R= 1.Q0-A5R OMA6R= 1.Q0-A6R CALL TSPENCE(A1R,A1I,OMA1R,SP1R,SP1I) CALL TSPENCE(A2R,A2I,OMA2R,SP2R,SP2I) CALL TSPENCE(A3R,A3I,OMA3R,SP3R,SP3I) CALL TSPENCE(A4R,A4I,OMA4R,SP4R,SP4I) CALL TSPENCE(A5R,A5I,OMA5R,SP5R,SP5I) CALL TSPENCE(A6R,A6I,OMA6R,SP6R,SP6I) TMP0(1)= (SP2R-SP1R+SP4R-SP3R-SP6R+SP5R)/S TMP0(2)= (SP2I-SP1I+SP4I-SP3I-SP6I+SP5I)/S ENDIF * P1DP2= 0.5Q0*S DEN= -S*S/4.Q0 DM12= RM12-RM22 DM13= RM12-RM32 DM23= RM22-RM32 F1= DM12 F2= DM23-S P12= 1.Q-20 P22= 1.Q-20 * CALL TBFFS(P12,RM12,RM22,B0_12,B1_12,B21_12) CALL TBFFS(S,RM12,RM32,B0_13,B1_13,B21_13) CALL TBFFS(P22,RM22,RM32,B0_23,B1_23,B21_23) * XMI(1,1)= P22/DEN XMI(1,2)= -P1DP2/DEN XMI(2,1)= XMI(1,2) XMI(2,2)= P12/DEN * DO I= 1,2 R1(I,1)= 0.5Q0*(F1*TMP0(I)+B0_13(I)-B0_23(I)) R1(I,2)= 0.5Q0*(F2*TMP0(I)+B0_12(I)-B0_13(I)) ENDDO * DO J= 1,2 DO I= 1,2 TMP1(J,I)= XMI(I,1)*R1(J,1)+XMI(I,2)*R1(J,2) ENDDO ENDDO * TMP24(1)= 0.25Q0-0.5Q0*RM12*TMP0(1)+ # 0.25Q0*(B0_23(1)-F1*TMP1(1,1)-F2*TMP1(1,2)) TMP24(2)= -0.5Q0*RM12*TMP0(2)+ # 0.25Q0*(B0_23(2)-F1*TMP1(2,1)-F2*TMP1(2,2)) * DO I= 1,2 R2_13(I,1)= 0.5Q0*(F1*TMP1(I,1)+B1_13(I)+B0_23(I))-TMP24(I) R2_13(I,2)= 0.5Q0*(F2*TMP1(I,1)+B1_12(I)-B1_13(I)) ENDDO * DO J= 1,2 DO I= 1,2 TMP2_13(J,I)= XMI(I,1)*R2_13(J,1)+XMI(I,2)*R2_13(J,2) ENDDO ENDDO * DO I= 1,2 R2_32(I,1)= 0.5Q0*(F1*TMP1(I,2)+B1_13(I)-B1_23(I)) R2_32(I,2)= 0.5Q0*(F2*TMP1(I,2)-B1_13(I))-TMP24(I) ENDDO * DO J= 1,2 DO I= 1,2 TMP2_32(J,I)= XMI(I,1)*R2_32(J,1)+XMI(I,2)*R2_32(J,2) ENDDO ENDDO * DO I= 1,2 C0(I)= TMP0(I) C1(I,1)= TMP1(I,1) C1(I,2)= TMP1(I,2) C2(I,1)= TMP2_13(I,1) C2(I,2)= TMP2_32(I,2) C2(I,3)= TMP2_13(I,2) C2(I,4)= TMP24(I) ENDDO * RETURN END * *-----S2------------------------------------------------------- * SUBROUTINE TS2(Y0R,Y0I,OMY0R,A,EBR,EBI,ECI,RPR,RPI,RMR,RMI, # OMRPR,OMRMR,S2R,S2I) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA DIMENSION CARG(2),COMARG(2),CLN(2) * * RP AND RM ARE THE ROOTS OF A*X^2+B*X+C = 0 * EB= B/A AND EC= C/A ARE KEPT TO COMPUTE IM(RP*RM)= IM(EC) * AND IM{(Y0-RP)(Y0-RM)}= IM{Y0^2+EB*Y0+EC} * A1= A*ECI A2= A*(2.Q0*Y0R*Y0I+EBR*Y0I+EBI*Y0R+ECI) IF(A1.LT.0.Q0) THEN DEL= 1.Q-90 ELSE DEL= -1.Q-90 ENDIF IF(A2.LT.0.Q0) THEN DELP= 1.Q-90 ELSE DELP= -1.Q-90 ENDIF * * COMPUTES THE LOG WHICH OCCURS IN ASSOCIATION WITH ETA-FUNCTIONS * Y0M2= Y0R*Y0R+Y0I*Y0I CARG(1)= Y0R/Y0M2 CARG(2)= -Y0I/Y0M2 COMARG(1)= -(OMY0R*Y0R-Y0I*Y0I)/Y0M2 COMARG(2)= Y0I/Y0M2 CALL TCQLNOMX(CARG,COMARG,CLN) * * IN CALLING ETA ONLY THE SIGN OF THE ARGUMENTS IS RELEVANT * A11= -RPI A12= -RMI A1P= ECI A21= Y0I-RPI A22= Y0I-RMI A2P= 2.Q0*Y0R*Y0I+EBR*Y0I+EBI*Y0R+ECI A31= -DEL A32= DELP A3P= A*(DELP-DEL) CALL TRLOG(Y0R,Y0I,OMY0R,RPR,RPI,OMRPR,RFPR,RFPI) CALL TRLOG(Y0R,Y0I,OMY0R,RMR,RMI,OMRMR,RFMR,RFMI) ETA1= ETA(A11,A12,A1P) ETA2= ETA(A21,A22,A2P) ETA3= ETA(A31,A32,A3P) S2R= RFPR+RFMR-CLN(2)*(ETA1-ETA2-ETA3) S2I= RFPI+RFMI+CLN(1)*(ETA1-ETA2-ETA3) RETURN END * *-----S1------------------------------------------------------- * SUBROUTINE TS1(Y0R,Y0I,OMY0R,B,RR,RI,S1R,S1I) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA DIMENSION CARG(2),COMARG(2),CLN(2) * B1= -B*RI B2= B*(Y0I-RI) IF(B1.LT.0.Q0) THEN DEL= 1.Q-90 ELSE DEL= -1.Q-90 ENDIF IF(B2.LT.0.Q0) THEN DELP= 1.Q-90 ELSE DELP= -1.Q-90 ENDIF * * COMPUTES THE LOG WHICH OCCURS IN ASSOCIATION WITH ETA-FUNCTIONS * Y0I2= Y0I*Y0I Y0M2= Y0R*Y0R+Y0I2 SY0= Y0I/Y0M2 CARG(1)= Y0R/Y0M2 CARG(2)= -SY0 COMARG(1)= -(OMY0R*Y0R-Y0I2)/Y0M2 COMARG(2)= SY0 CALL TCQLNOMX(CARG,COMARG,CLN) * * IN CALLING ETA ONLY THE SIGN OF THE ARGUMENTS IS RELEVANT * A1= -DEL A2= DELP AP= B*(DELP-DEL) OMRR= 1.Q0-RR CALL TRLOG(Y0R,Y0I,OMY0R,RR,RI,OMRR,RFR,RFI) ETAS= ETA(A1,A2,AP) S1R= RFR+CLN(2)*ETAS S1I= RFI-CLN(1)*ETAS RETURN END * *-----RLOG------------------------------------------------------- * SUBROUTINE TRLOG(Z0R,Z0I,OMZ0R,Z1R,Z1I,OMZ1R,RFUNR,RFUNI) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION CA1(2),CA2(2),CA3(2),ADD(2) DIMENSION CLN1(2),CLN2(2),CLN3(2),CT(10),SN(10) * Z1M2= Z1R*Z1R+Z1I*Z1I Z1M= SQRT(Z1M2) Z0M2= Z0R*Z0R+Z0I*Z0I Z0M= SQRT(Z0M2) ZRT= Z1M/Z0M * * |Z1| << |Z0| * IF(ZRT.LT.1.Q-10) THEN CT(1)= (Z1R*Z0R+Z1I*Z0I)/Z1M/Z0M SN(1)= (Z0R*Z1I-Z1R*Z0I)/Z1M/Z0M DO K=2,10 CT(K)= CT(1)*CT(K-1)-SN(1)*SN(K-1) SN(K)= SN(1)*CT(K-1)+CT(1)*SN(K-1) ENDDO SUMR= CT(10) SUMI= SN(10) DO J=9,1,-1 SUMR= SUMR*ZRT+CT(J) SUMI= SUMI*ZRT+SN(J) ENDDO SUMR= SUMR*ZRT SUMI= SUMI*ZRT A1R= 1.Q0+SUMR A1I= SUMI A2R= (Z0I*Z0I-OMZ0R*Z0R)/Z0M2*A1R-Z0I/Z0M2*A1I A2I= (Z0I*Z0I-OMZ0R*Z0R)/Z0M2*A1I+Z0I/Z0M2*A1R OMA1R= -SUMR OMA2R= 1.Q0-A2R Z01R= Z0R-Z1R Z01I= Z0I-Z1I DEN= Z01R*Z01R+Z01I*Z01I ADD(1)= 0.Q0 ADD(2)= 0.Q0 SIGN= +1.Q0 ELSE * * IF Z0R AND/OR Z1R ARE ROOTS VERY NEAR TO 1 * Z0R-Z1R = (1-Z1R)-(1-Z0R) * AOMZ0R= ABS(OMZ0R) AOMZ1R= ABS(OMZ1R) AZ1I= ABS(Z1I) IF(AOMZ0R.LT.1.Q-10.OR.AOMZ1R.LT.1.Q-10) THEN Z01R= OMZ1R-OMZ0R ELSE Z01R= Z0R-Z1R ENDIF Z01I= Z0I-Z1I * * IF Z0 AND Z1R ARE ROOTS VERY NEAR TO 1 * AND |Z1I| << 1 , Z0I = 0 * IF(AOMZ0R.LT.1.Q-10.AND.AOMZ1R.LT.1.Q-10. # AND.AZ1I.LT.1.Q-10.AND.Z0I.EQ.0.Q0) THEN DEN= Z01R*Z01R+Z1I*Z1I A1R= Z01R/Z0R A1I= -Z1I/Z0R OMA1R= Z1R/Z0R CA3(1)= -A1R CA3(2)= -A1I CALL TCQLNX(CA3,CLN3) ADD(1)= -QPIS/6.Q0-0.5Q0*(CLN3(1)*CLN3(1)-CLN3(2)*CLN3(2)) ADD(2)= -CLN3(1)*CLN3(2) SIGN= -1.Q0 ELSE DEN= Z01R*Z01R+Z01I*Z01I A1R= (Z0R*Z01R+Z0I*Z01I)/DEN A1I= (-Z0R*Z01I+Z0I*Z01R)/DEN OMA1R= -(Z01I*Z1I+Z1R*Z01R)/DEN ADD(1)= 0.Q0 ADD(2)= 0.Q0 SIGN= +1.Q0 ENDIF A2R= -(OMZ0R*Z01R-Z0I*Z01I)/DEN A2I= (OMZ0R*Z01I+Z0I*Z01R)/DEN OMA2R= (OMZ1R*Z01R-Z01I*Z1I)/DEN ENDIF * * IN CALLING ETA ONLY THE SIGN OF THE ARGUMENTS IS RELEVANT * A1= -Z1I A2= -Z01I API= Z1R*Z0I-Z0R*Z1I APII= -Z0I*OMZ1R+Z1I*OMZ0R CALL TSPENCE(A1R,A1I,OMA1R,SP1R,SP1I) CALL TSPENCE(A2R,A2I,OMA2R,SP2R,SP2I) CA1(1)= A1R CA1(2)= A1I CA2(1)= A2R CA2(2)= A2I CALL TCQLNX(CA1,CLN1) CALL TCQLNX(CA2,CLN2) ETAI= ETA(A1,A2,API) ETAII= ETA(A1,A2,APII) RFUNR= SIGN*SP1R-SP2R-ETAI*CLN1(2)+ETAII*CLN2(2)+ADD(1) RFUNI= SIGN*SP1I-SP2I+ETAI*CLN1(1)-ETAII*CLN2(1)+ADD(2) RETURN END * *-----ETA----------------------------------------------------- * COMPUTES THE FUNTION ETA(A,B) * LN(AB)= LN(A)+LN(B)+ETA(A,B) * REAL*16 FUNCTION ETA(Z1I,Z2I,ZPI) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * * ONLY THE SIGN OF THE ARGUMENTS IS RELEVANT * IF(Z1I.LT.0.Q0.AND.Z2I.LT.0.Q0.AND.ZPI.GT.0.Q0) THEN ETA= 2.Q0*QPI RETURN ELSE IF(Z1I.GT.0.Q0.AND.Z2I.GT.0.Q0.AND.ZPI.LT.0.Q0) THEN ETA= -2.Q0*QPI RETURN ELSE ETA= 0.Q0 RETURN ENDIF END * *-----ETAQ----------------------------------------------------- * COMPUTES THE FUNTION ETA(A,1/B) * LN(A/B)= LN(A)-LN(B)+ETA(A,1/B) * REAL*16 FUNCTION ETAQ(Z1I,Z2I,ZQI) IMPLICIT REAL*16(A-H,O-Z) COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * IF(Z1I.LT.0.Q0.AND.Z2I.GT.0.Q0.AND.ZQI.GT.0.Q0) THEN ETAQ= 2.Q0*QPI RETURN ELSE IF(Z1I.GT.0.Q0.AND.Z2I.LT.0.Q0.AND.ZQI.LT.0.Q0) THEN ETAQ= -2.Q0*QPI RETURN ELSE ETAQ= 0.Q0 RETURN ENDIF END * *-----PHI---------------------------------------------------------------- * SUBROUTINE TPHI(OXR,OPHIR) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * XR= OXR*1.D15*1.Q-15 XI= -QEPS * IF(XR.LE.1.Q0) THEN YR= 1.Q0-2.Q0*XR SXR= SQRT(XR) YI= 2.Q0*SXR*SQRT(1.Q0-XR) YRC= 2.Q0*XR CALL TSPENCE(YR,YI,YRC,CLR,CLI) OPHIR= 4.Q0*SQRT(XR/(1.Q0-XR))*CLI ELSE RL= SQRT(1.Q0-1.Q0/XR) * ARGS= (RL-1.Q0)/(RL+1.Q0) * ARGL= -ARGS * ARGSC= 1.Q0-ARGS * CALL TSPENCE(ARGS,XI,ARGSC,CLR,CLI) * OPHIR= 1.Q0/RL*(QPIS/3.Q0+4.Q0*CLR+LOG(ARGL)*LOG(ARGL)) RLP= 0.5Q0*(1.Q0-RL) RLPC= 1.Q0-RLP CALL TSPENCE(RLP,XI,RLPC,CLR,CLI) OPHIR= 1.Q0/RL*(-4.Q0*CLR+2.Q0*LOG(RLP)*LOG(RLP)- # LOG(4.Q0*XR)*LOG(4.Q0*XR)+QPIS/3.Q0) ENDIF * RETURN END * *-----FA1 AND G------------------------------------------------------------ * SUBROUTINE TFANG(OAR,OFA0,OFA1,OG) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) EXTERNAL S09AAF * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * AR= OAR*1.D15*1.Q-15 AI= -QEPS ARC= 1.Q0-AR YR= 4.Q0/AR * CALL TSPENCE(ARC,AI,AR,CLR0,CLI0) OFA0= CLR0 * IF(AR.LE.4.Q0) THEN IFAIL= 1 OARG= 1.Q0/SQRT(YR) OPHI= 2.D0*S09AAF(OARG,IFAIL) PHI= OPHI*1.D15*1.Q-15 XR= 1.Q0/YR ZR= 1.D0-2.Q0*XR SZR= SQRT(XR) ZI= 2.Q0*SZR*SQRT(1.Q0-XR) ZRC= 2.Q0*XR CALL TSPENCE(ZR,ZI,ZRC,CLR1,CLI1) OFA1= -2.Q0/SQRT(YR-1.Q0)*CLI1 OG= SQRT(4.Q0-AR)*(QPI-PHI) ELSE RXI= (SQRT(1.Q0-YR)-1.Q0)/(SQRT(1.Q0-YR)+1.Q0) RXIC= 1.Q0-RXI CALL TSPENCE(RXI,AI,RXIC,CLR1,CLI1) OFA1= -1.Q0/SQRT(YR-1.Q0)*(QPIS/6.Q0+2.Q0*CLR1+0.5Q0* # LOG(-RXI)*LOG(-RXI)) OG= SQRT(AR-4.Q0)*LOG(-RXI) ENDIF * RETURN END * *-----G AND LAMBDA--------------------------------------------------- * SUBROUTINE TGLA(X,GFUN,BLFUN) IMPLICIT REAL*8(A-H,O-Z) * COMMON/TPARAM/PI,PIS,DELTA EXTERNAL S09AAF * IF(X.LE.4.D0) THEN IFAIL= 1 ARG= 0.5D0*SQRT(X) GFUN= SQRT(4.D0-X)*(PI-2.D0*S09AAF(ARG,IFAIL)) BLFUN= -0.5D0/SQRT(X)*GFUN+PI/2.D0*SQRT(4.D0/X-1.D0) ELSE ARGL= SQRT(1.D0-4.D0/X) GFUN= 2.D0*SQRT(X/4.D0-1.D0)*LOG((1.D0-ARGL)/(1.D0+ARGL)) BLFUN= -0.5D0/SQRT(X)*GFUN ENDIF * RETURN END * *------------------------------------------------------------------------- * SUBROUTINE TB0FUN(OX,OY,OZ,OB0) IMPLICIT REAL*16(A-H,P-Z) IMPLICIT REAL*8(O) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION CMP2(2),CLNMP2(2),GFPR(3),GFMR(3) * P2= OX*1.D15*1.Q-15 RM12= OY*1.D15*1.Q-15 RM22= OZ*1.D15*1.Q-15 * CMP2(1)= -P2 CMP2(2)= -QEPS CALL TROOTS(P2,RM12,RM22,RPR,RPI,RMR,RMI,ROMRPR,ROMRMR) CALL TCQLNX(CMP2,CLNMP2) N= 3 CALL TRCG(N,RPR,RPI,ROMRPR,GFPR) CALL TRCG(N,RMR,RMI,ROMRMR,GFMR) AUXDEL= LOG(QTQM2)-CLNMP2(1) OB0= AUXDEL-GFPR(1)-GFMR(1) * RETURN END * *-----SPENCE-------------------------------------------------------- * COMPUTES LI_2(X). ACCURACY IS ABOUT 16 DIGITS * SUBROUTINE TSPENCE(XR,XI,OMXR,CLI2R,CLI2I) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION B(0:14),BF(0:14) DIMENSION CLNX(2),CLNOMX(2),CLNOY(2),CLNZ(2),CLNOMZ(2) DIMENSION ADD1(2),ADD2(2),ADD3(2),PAR(2),RES(2),CT(15),SN(15) DIMENSION X(2),OMX(2),Y(2),OY(2),OMY(2),Z(2),OMZ(2),T(2),OMT(2) * X(1)= XR X(2)= XI OMX(1)= OMXR OMX(2)= -XI IF(XR.LT.0.Q0) THEN Y(1)= OMXR Y(2)= -XI SIGN1= -1.Q0 CALL TCQLNX(X,CLNX) CALL TCQLNOMX(X,OMX,CLNOMX) ADD1(1)= QPIS/6.Q0-CLNX(1)*CLNOMX(1)+CLNX(2)*CLNOMX(2) ADD1(2)= -CLNX(1)*CLNOMX(2)-CLNX(2)*CLNOMX(1) ELSE Y(1)= X(1) Y(2)= X(2) SIGN1= 1.Q0 ADD1(1)= 0.Q0 ADD1(2)= 0.Q0 ENDIF OMY(1)= 1.Q0-Y(1) OMY(2)= -Y(2) YM2= Y(1)*Y(1)+Y(2)*Y(2) YM= SQRT(YM2) IF(YM.GT.1.Q0) THEN Z(1)= Y(1)/YM2 Z(2)= -Y(2)/YM2 SIGN2= -1.Q0 OY(1)= -Y(1) OY(2)= -Y(2) CALL TCQLNX(OY,CLNOY) ADD2(1)= -QPIS/6.Q0-0.5Q0*((CLNOY(1))**2-(CLNOY(2))**2) ADD2(2)= -CLNOY(1)*CLNOY(2) ELSE Z(1)= Y(1) Z(2)= Y(2) SIGN2= 1.Q0 ADD2(1)= 0.Q0 ADD2(2)= 0.Q0 ENDIF OMZ(1)= 1.Q0-Z(1) OMZ(2)= -Z(2) ZR= Z(1) IF(ZR.GT.0.5Q0) THEN T(1)= 1.Q0-Z(1) T(2)= -Z(2) OMT(1)= 1.Q0-T(1) OMT(2)= -T(2) SIGN3= -1.Q0 CALL TCQLNX(Z,CLNZ) CALL TCQLNOMX(Z,OMZ,CLNOMZ) ADD3(1)= QPIS/6.Q0-CLNZ(1)*CLNOMZ(1)+CLNZ(2)*CLNOMZ(2) ADD3(2)= -CLNZ(1)*CLNOMZ(2)-CLNZ(2)*CLNOMZ(1) ELSE T(1)= Z(1) T(2)= Z(2) OMT(1)= 1.Q0-T(1) OMT(2)= -T(2) SIGN3= 1.Q0 ADD3(1)= 0.Q0 ADD3(2)= 0.Q0 ENDIF CALL TCQLNOMX(T,OMT,PAR) B(0)= 1.Q0 B(1)= -1.Q0/2.Q0 B(2)= 1.Q0/6.Q0 B(4)= -1.Q0/30.Q0 B(6)= 1.Q0/42.Q0 B(8)= -1.Q0/30.Q0 B(10)= 5.Q0/66.Q0 B(12)= -691.Q0/2730.Q0 B(14)= 7.Q0/6.Q0 FACT= 1.Q0 DO N=0,14 BF(N)= B(N)/FACT FACT= FACT*(N+2.Q0) ENDDO PARR= PAR(1) PARI= PAR(2) PARM2= PARR*PARR+PARI*PARI PARM= SQRT(PARM2) CT(1)= PARR/PARM SN(1)= PARI/PARM DO N=2,15 CT(N)= CT(1)*CT(N-1)-SN(1)*SN(N-1) SN(N)= SN(1)*CT(N-1)+CT(1)*SN(N-1) ENDDO * RES(1)= -((((((((BF(14)*CT(15)*PARM2+BF(12)*CT(13))*PARM2+ # BF(10)*CT(11))*PARM2+BF(8)*CT(9))*PARM2+ # BF(6)*CT(7))*PARM2+BF(4)*CT(5))*PARM2+ # BF(2)*CT(3))*(-PARM)+BF(1)*CT(2))*(-PARM)+ # BF(0)*CT(1))*PARM RES(2)= -((((((((BF(14)*SN(15)*PARM2+BF(12)*SN(13))*PARM2+ # BF(10)*SN(11))*PARM2+BF(8)*SN(9))*PARM2+ # BF(6)*SN(7))*PARM2+BF(4)*SN(5))*PARM2+ # BF(2)*SN(3))*(-PARM)+BF(1)*SN(2))*(-PARM)+ # BF(0)*SN(1))*PARM CLI2R= SIGN1*(SIGN2*(SIGN3*RES(1)+ADD3(1))+ADD2(1))+ADD1(1) CLI2I= SIGN1*(SIGN2*(SIGN3*RES(2)+ADD3(2))+ADD2(2))+ADD1(2) * RETURN END * *-----CQLNX--------------------------------------------- * COMPUTES LN(Z) * SUBROUTINE TCQLNX(ARG,RES) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION ARG(2),AARG(2),RES(2) * QPI= 3.141592653589793238462643Q0 DO I= 1,2 AARG(I)= ABS(ARG(I)) ENDDO ZM2= (ARG(1))**2+(ARG(2))**2 ZM= SQRT(ZM2) RES(1)= LOG(ZM) IF(ARG(1).EQ.0.Q0) THEN IF(ARG(2).GT.0.Q0) THEN TETA= QPI/2.Q0 ELSE TETA= -QPI/2.Q0 ENDIF RES(2)= TETA RETURN ELSE IF(ARG(2).EQ.0.Q0) THEN IF(ARG(1).GT.0.Q0) THEN TETA= 0.Q0 ELSE TETA= QPI ENDIF RES(2)= TETA RETURN ELSE TNTETA= AARG(2)/AARG(1) TETA= ATAN(TNTETA) SR= ARG(1)/AARG(1) SI= ARG(2)/AARG(2) IF(SR.GT.0.Q0) THEN RES(2)= SI*TETA ELSE RES(2)= SI*(QPI-TETA) ENDIF RETURN ENDIF END * *-----CQLNOMX--------------------------------------- * COMPUTES LN(1-X) * USUALLY |X| << 1 * SUBROUTINE TCQLNOMX(ARG,OMARG,RES) IMPLICIT REAL*16(A-H,O-Z) DIMENSION ARG(2),OMARG(2),RES(2),ARES(2),CT(10),SN(10) * ZR= ARG(1) ZI= ARG(2) ZM2= ZR*ZR+ZI*ZI ZM= SQRT(ZM2) IF(ZM.LT.1.Q-7) THEN CT(1)= ZR/ZM SN(1)= ZI/ZM DO N=2,10 CT(N)= CT(1)*CT(N-1)-SN(1)*SN(N-1) SN(N)= SN(1)*CT(N-1)+CT(1)*SN(N-1) ENDDO ARES(1)= CT(10)/10.Q0 ARES(2)= SN(10)/10.Q0 DO K=9,1,-1 ARES(1)= ARES(1)*ZM+CT(K)/K ARES(2)= ARES(2)*ZM+SN(K)/K ENDDO ARES(1)= -ARES(1)*ZM ARES(2)= -ARES(2)*ZM ELSE CALL TCQLNX(OMARG,ARES) ENDIF DO I= 1,2 RES(I)= ARES(I) ENDDO RETURN END * *-----CG------------------------------------------------ * COMPUTES THE FUNCTION G_N(X) * SUBROUTINE TCG(N,ZR,ZI,OMZR,GFR,GFI) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION GFR(N),GFI(N) DIMENSION CA(2,10),AUX(2),ZP(2),CT(16),SN(16) DIMENSION A(2,4),RA(16),Z(2),OMZ(2),OZ(2),CLNOMZ(2),CLNOZ(2) * DATA RA/-0.2Q+0,0.666666666666667Q-1, # -0.952380952380952Q-2,-0.396825396825397Q-3, # 0.317460317460317Q-3,-0.132275132275132Q-4, # -0.962000962000962Q-5,0.105218855218855Q-5, # 0.266488361726450Q-6,-0.488745528428000Q-7, # -0.675397500794000Q-8,0.190720263471000Q-8, # 0.153663007690000Q-9,-0.679697905790000Q-10, # -0.293683556000000Q-11,0.228836696000000Q-11/ * Z(1)= ZR Z(2)= ZI OMZ(1)= OMZR OMZ(2)= -ZI IF(ZR.EQ.0.Q0.AND.ZI.EQ.0.Q0) THEN DO K=1,N GFR(K)= -1.Q0/K/K GFI(K)= 0.Q0 ENDDO RETURN ELSE IF(ZR.EQ.1.Q0.AND.ZI.EQ.0.Q0) THEN A(1,1)= -1.Q0 A(2,1)= QPI DO J=2,4 A(1,J)= ((J-1.Q0)*A(1,J-1)-1.Q0/J)/J A(2,J)= (J-1.Q0)/J*A(2,J-1) ENDDO DO K=1,N GFR(K)= A(1,K) GFI(K)= A(2,K) ENDDO RETURN ELSE ZMOD2= ZR*ZR+ZI*ZI ZMOD= SQRT(ZMOD2) CALL TCQLNX(OMZ,CLNOMZ) * * |Z| < 4 * IF(ZMOD.LT.4.Q0) THEN OZ(1)= -Z(1) OZ(2)= -Z(2) CALL TCQLNX(OZ,CLNOZ) CA(1,1)= OMZ(1)*CLNOMZ(1)-OMZ(2)*CLNOMZ(2)+Z(1)*CLNOZ(1)- # Z(2)*CLNOZ(2)-1.Q0 CA(2,1)= OMZ(1)*CLNOMZ(2)+OMZ(2)*CLNOMZ(1)+Z(1)*CLNOZ(2)+ # Z(2)*CLNOZ(1) IF(N.EQ.1) THEN GFR(1)= CA(1,1) GFI(1)= CA(2,1) RETURN ELSE DO J= 2,N JM1= J-1 CA(1,J)= ((J-1.Q0)*(Z(1)*CA(1,JM1)-Z(2)*CA(2,JM1))+ # OMZ(1)*CLNOMZ(1)-OMZ(2)*CLNOMZ(2)-1.Q0/J)/J CA(2,J)= ((J-1.Q0)*(Z(1)*CA(2,JM1)+Z(2)*CA(1,JM1))+ # OMZ(1)*CLNOMZ(2)+OMZ(2)*CLNOMZ(1))/J ENDDO DO K=1,N GFR(K)= CA(1,K) GFI(K)= CA(2,K) ENDDO RETURN ENDIF * * |Z| > 4 * ELSE AUX(1)= (-ZR*OMZR+ZI**2)/ZMOD2 AUX(2)= ZI/ZMOD2 CALL TCQLNX(AUX,ZP) ZPM2= ZP(1)*ZP(1)+ZP(2)*ZP(2) ZPM= SQRT(ZPM2) CT(1)= ZP(1)/ZPM SN(1)= ZP(2)/ZPM DO K=2,16 CT(K)= CT(1)*CT(K-1)-SN(1)*SN(K-1) SN(K)= SN(1)*CT(K-1)+CT(1)*SN(K-1) ENDDO CA(1,4)= RA(16)*CT(16)*ZPM+RA(15)*CT(15) CA(2,4)= RA(16)*SN(16)*ZPM+RA(15)*SN(15) DO J=14,1,-1 CA(1,4)= CA(1,4)*ZPM+RA(J)*CT(J) CA(2,4)= CA(2,4)*ZPM+RA(J)*SN(J) ENDDO CA(1,4)= CA(1,4)*ZPM CA(2,4)= CA(2,4)*ZPM DO J= 3,1,-1 JP1= J+1 CA(1,J)= ((CA(1,JP1)+1.Q0/JP1)*Z(1)+CA(2,JP1)*Z(2))/ZMOD2 CA(2,J)= (CA(2,JP1)*Z(1)-(CA(1,JP1)+1.Q0/JP1)*Z(2))/ZMOD2 ENDDO DO K=1,N GFR(K)= (CA(1,K)+CLNOMZ(1))/K GFI(K)= (CA(2,K)+CLNOMZ(2))/K ENDDO RETURN ENDIF ENDIF * END * *-----RCG------------------------------------------------ * COMPUTES THE FUNCTION RE G_N(X) * SUBROUTINE TRCG(N,ZR,ZI,OMZR,GFR) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION GFR(N) DIMENSION CA(2,10),AUX(2),ZP(2),CT(16),SN(16) DIMENSION A(4),RA(16),Z(2),OMZ(2),OZ(2),CLNOMZ(2),CLNOZ(2) * DATA RA/-0.2Q+0,0.666666666666667Q-1, # -0.952380952380952Q-2,-0.396825396825397Q-3, # 0.317460317460317Q-3,-0.132275132275132Q-4, # -0.962000962000962Q-5,0.105218855218855Q-5, # 0.266488361726450Q-6,-0.488745528428000Q-7, # -0.675397500794000Q-8,0.190720263471000Q-8, # 0.153663007690000Q-9,-0.679697905790000Q-10, # -0.293683556000000Q-11,0.228836696000000Q-11/ * Z(1)= ZR Z(2)= ZI OMZ(1)= OMZR OMZ(2)= -ZI IF(ZR.EQ.0.Q0.AND.ZI.EQ.0.Q0) THEN DO K=1,N GFR(K)= -1.Q0/K/K ENDDO RETURN ELSE IF(ZR.EQ.1.Q0.AND.ZI.EQ.0.Q0) THEN A(1)= -1.Q0 DO J=2,4 A(J)= ((J-1.Q0)*A(J-1)-1.Q0/J)/J ENDDO DO K=1,N GFR(K)= A(K) ENDDO RETURN ELSE ZMOD2= ZR*ZR+ZI*ZI ZMOD= SQRT(ZMOD2) CALL TCQLNX(OMZ,CLNOMZ) * * |Z| < 4 * IF(ZMOD.LT.4.Q0) THEN OZ(1)= -Z(1) OZ(2)= -Z(2) CALL TCQLNX(OZ,CLNOZ) CA(1,1)= OMZ(1)*CLNOMZ(1)-OMZ(2)*CLNOMZ(2)+Z(1)*CLNOZ(1)- # Z(2)*CLNOZ(2)-1.Q0 CA(2,1)= OMZ(1)*CLNOMZ(2)+OMZ(2)*CLNOMZ(1)+Z(1)*CLNOZ(2)+ # Z(2)*CLNOZ(1) IF(N.EQ.1) THEN GFR(1)= CA(1,1) RETURN ELSE DO J= 2,N JM1= J-1 CA(1,J)= ((J-1.Q0)*(Z(1)*CA(1,JM1)-Z(2)*CA(2,JM1))+ # OMZ(1)*CLNOMZ(1)-OMZ(2)*CLNOMZ(2)-1.Q0/J)/J CA(2,J)= ((J-1.Q0)*(Z(1)*CA(2,JM1)+Z(2)*CA(1,JM1))+ # OMZ(1)*CLNOMZ(2)+OMZ(2)*CLNOMZ(1))/J ENDDO DO K=1,N GFR(K)= CA(1,K) ENDDO RETURN ENDIF * * |Z| > 4 * ELSE AUX(1)= (-ZR*OMZR+ZI**2)/ZMOD2 AUX(2)= ZI/ZMOD2 CALL TCQLNX(AUX,ZP) ZPM2= ZP(1)*ZP(1)+ZP(2)*ZP(2) ZPM= SQRT(ZPM2) CT(1)= ZP(1)/ZPM SN(1)= ZP(2)/ZPM DO K=2,16 CT(K)= CT(1)*CT(K-1)-SN(1)*SN(K-1) SN(K)= SN(1)*CT(K-1)+CT(1)*SN(K-1) ENDDO CA(1,4)= RA(16)*CT(16)*ZPM+RA(15)*CT(15) CA(2,4)= RA(16)*SN(16)*ZPM+RA(15)*SN(15) DO J=14,1,-1 CA(1,4)= CA(1,4)*ZPM+RA(J)*CT(J) CA(2,4)= CA(2,4)*ZPM+RA(J)*SN(J) ENDDO CA(1,4)= CA(1,4)*ZPM CA(2,4)= CA(2,4)*ZPM DO J= 3,1,-1 JP1= J+1 CA(1,J)= ((CA(1,JP1)+1.Q0/JP1)*Z(1)+CA(2,JP1)*Z(2))/ZMOD2 CA(2,J)= (CA(2,JP1)*Z(1)-(CA(1,JP1)+1.Q0/JP1)*Z(2))/ZMOD2 ENDDO DO K=1,N GFR(K)= (CA(1,K)+CLNOMZ(1))/K ENDDO RETURN ENDIF ENDIF * END * *-----MULTI2------------------------------------------- * COMPUTES E(I)= XMI(I,J)*D(J) * I,J=1,2 * SUBROUTINE TMULTI2(EA,XMI,DA) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION EA(2,2),DA(2,2),XMI(2,2) * DO J= 1,2 DO I= 1,2 EA(J,I)= XMI(I,1)*DA(J,1)+XMI(I,2)*DA(J,2) ENDDO ENDDO RETURN END * *-----MULTI3------------------------------------------- * COMPUTES E(I)= XMI(I,J)*D(J) * I,J=1,3 * SUBROUTINE TMULTI3(EA,XMI,DA) IMPLICIT REAL*16(A-H,O-Z) * DIMENSION EA(2,3),DA(2,3),XMI(3,3) * DO J= 1,2 DO I= 1,3 EA(J,I)= XMI(I,1)*DA(J,1)+XMI(I,2)*DA(J,2)+ # XMI(I,3)*DA(J,3) ENDDO ENDDO RETURN END * *-----ROOTS-------------------------------------------- * COMPUTES THE ROOTS OF THE QUADRATIC FORM * -P2*X^2+(P2+M2^2-M1^2)*X+M1^2 = 0 * WITH: * REAL MASSES M^2=M^2-I*EPS * SUBROUTINE TROOTS(P2,RM12,RM22,RPR,RPI,RMR,RMI,OMRPR,OMRMR) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * IF(RM12.EQ.RM22) THEN DISC2= (P2+4.Q0*RM12)*P2 ELSE DISC2= (RM22+2.Q0*(P2-RM12))*RM22+(P2+RM12)*(P2+RM12) ENDIF IF(DISC2.GT.0.Q0) THEN DISC= SQRT(DISC2) RPI= +QEPS/DISC RMI= -QEPS/DISC R1= 1.Q-10*ABS(P2) R2= 1.Q-10*RM12 * * ONE OF THE ROOTS VERY NEAR TO 1 * IF(RM22.LT.R1.OR.RM22.LT.R2) THEN A= -P2 B= P2+RM12-RM22 C= RM22 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RMR= 1.Q0-C/Q RPR= 1.Q0-Q/A OMRPR= Q/A OMRMR= C/Q ELSE Q= -0.5Q0*(B-DISC) RMR= 1.Q0-Q/A RPR= 1.Q0-C/Q OMRPR= C/Q OMRMR= Q/A ENDIF ELSE A= -P2 B= P2+RM22-RM12 C= RM12 IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+DISC) RPR= C/Q RMR= Q/A OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ELSE Q= -0.5Q0*(B-DISC) RPR= Q/A RMR= C/Q OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR ENDIF ENDIF ELSE DISC= SQRT(-DISC2) A= -P2 B= P2+RM22-RM12 RPR= -B/2.Q0/A RMR= -B/2.Q0/A OMRPR= 1.Q0-RPR OMRMR= 1.Q0-RMR RPI= +DISC/2.Q0/A RMI= -DISC/2.Q0/A ENDIF RETURN END * *-----ALPHA-------------------------------------------- * COMPUTES THE ROOTS OF * -P1^2*ALP^2+(P1^2+P2^2-S)*ALP-P2^2= 0 * SUBROUTINE TALPHA(P12,P22,S,ALP,ALM,OMALP,OMALM) IMPLICIT REAL*16(A-H,O-Z) * ARG= (P22-2.Q0*(P12+S))*P22+(S-P12)*(S-P12) RT= SQRT(ARG) S1= ABS(S/P12) S2= ABS(S/P22) * * ONE OF THE ROOTS VERY NEAR TO 1 * IF(S1.LT.1.Q-10.OR.S2.LT.1.Q-10) THEN B= P12-P22+S IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+RT) BEP= -S/Q BEM= -Q/P12 ELSE Q= -0.5Q0*(B-RT) BEP= -Q/P12 BEM= -S/Q ENDIF ALP= 1.Q0-BEM ALM= 1.Q0-BEP OMALP= BEM OMALM= BEP RETURN ELSE B= P12+P22-S IF(B.GT.0.Q0) THEN Q= -0.5Q0*(B+RT) ALP= -P22/Q ALM= -Q/P12 ELSE Q= -0.5Q0*(B-RT) ALP= -Q/P12 ALM= -P22/Q ENDIF OMALP= 1.Q0-ALP OMALM= 1.Q0-ALM RETURN ENDIF END * *-----ALALS-------------------------------------------------------- * THE O(ALPHA*ALPHA_S) CORRECTIONS TO SELF-ENERGIES ARE COMPUTED * SUBROUTINE TALALS(P2X,V1,A1,F1,V1P,A1P,V1I) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 * DIMENSION R(2),X(2),XO(2),UMX(2),A(2),B(2),B2(2),AB(2), # RMR(2),RUMR(2),RP(2),RM(2),F(2),H(2),G(2),RM2(2), # RM4(2),RI(2),R2I(2),XI(2),X2I(2),RAR(2),RRAR(2), # XP(2),UMR(2),TRMR(2),TRUMR(2),RPP(2) * DATA Z3/1.20205690315959428540Q0/ * *-----THIS SUBROUTINE USES THE WRONG METRIC, THUS THE SIGN OF P^2 * MUST BE CHANGED * Z2= QPIS/6.Q0 R(1)= -0.25Q0*P2X/QTQM2 R(2)= 0.25Q0*QEPS/QTQM2 X(1)= -P2X/QTQM2 X(2)= QEPS/QTQM2 DO I=1,2 XO(I)= -X(I) ENDDO UMX(1)= 1.Q0-X(1) UMX(2)= -X(2) UMR(1)= 1.Q0-R(1) UMR(2)= -R(2) * CALL TCQLNX(XO,A) CALL TCQLNOMX(X,UMX,B) B2(1)= B(1)*B(1)-B(2)*B(2) B2(2)= 2.Q0*B(1)*B(2) AB(1)= A(1)*B(1)-A(2)*B(2) AB(2)= A(1)*B(2)+A(2)*B(1) * IF(R(1).GT.0.Q0) THEN RMR(1)= 0.5Q0*R(2)/SQRT(R(1)) RMR(2)= -SQRT(R(1)) ELSE IF(R(1).LT.0.Q0) THEN RMR(1)= SQRT(-R(1)) RMR(2)= -0.5Q0*R(2)/SQRT(-R(1)) ENDIF IF(UMR(1).GT.0.Q0) THEN RUMR(1)= SQRT(UMR(1)) RUMR(2)= -0.5Q0*R(2)/SQRT(UMR(1)) ELSE IF(UMR(1).LT.0.Q0) THEN RUMR(1)= 0.5Q0*R(2)/SQRT(-UMR(1)) RUMR(2)= -SQRT(-UMR(1)) ENDIF DO I=1,2 RP(I)= RUMR(I)+RMR(I) RM(I)= RUMR(I)-RMR(I) ENDDO DO I=1,2 TRMR(I)= RP(I)-RM(I) TRUMR(I)= RP(I)+RM(I) ENDDO CALL TCQLNX(RP,F) CALL TCQLNX(TRUMR,H) CALL TCQLNX(TRMR,G) * RM2(1)= RM(1)*RM(1)-RM(2)*RM(2) RM2(2)= 2.Q0*RM(1)*RM(2) ARM= RM(1) ARM2= ARM*ARM ARM4= ARM2*ARM2 ZRM= RM(2)/RM(1) ZRM2= ZRM*ZRM ZRM4= ZRM2*ZRM2 BRM= RM(2) BRM2= BRM*BRM BRM4= BRM2*BRM2 URM= RM(1)/RM(2) URM2= URM*URM URM4= URM2*URM2 IF(ABS(ZRM).LT.1.Q0) THEN RM4(1)= ARM4*(1.Q0-6.Q0*ZRM2+ZRM4) ELSE IF(ABS(URM).LT.1.Q0) THEN RM4(1)= BRM4*(1.Q0-6.Q0*URM2+URM4) ENDIF RM4(2)= 4.Q0*RM(1)*RM(2)*RM2(1) R2= R(1)*R(1)+R(2)*R(2) RI(1)= R(1)/R2 RI(2)= -R(2)/R2 RR2= R(1)*R(1)-R(2)*R(2) R22= RR2*RR2+4.Q0*R(1)*R(1)*R(2)*R(2) R2I(1)= RR2/R22 R2I(2)= -2.Q0*R(1)*R(2)/R22 X2= X(1)*X(1)+X(2)*X(2) XI(1)= X(1)/X2 XI(2)= -X(2)/X2 XX2= X(1)*X(1)-X(2)*X(2) X22= XX2*XX2+4.Q0*X(1)*X(1)*X(2)*X(2) X2I(1)= XX2/X22 X2I(2)= -2.Q0*X(1)*X(2)/X22 * RAR(1)= 1.Q0-R(1)/R2 RAR(2)= R(2)/R2 IF(RAR(1).GT.0.Q0) THEN RRAR(1)= SQRT(RAR(1)) RRAR(2)= 0.5Q0*RAR(2)/SQRT(RAR(1)) ELSE IF(RAR(1).LT.0.Q0) THEN RRAR(1)= 0.5Q0*RAR(2)/SQRT(-RAR(1)) RRAR(2)= SQRT(-RAR(1)) ENDIF * XP2= (1.Q0-X(1))*(1.Q0-X(1))+X(2)*X(2) XP(1)= (1.Q0-X(1))/XP2 XP(2)= X(2)/XP2 RPP2= (1.Q0-R(1))*(1.Q0-R(1))+R(2)*R(2) RPP(1)= (1.Q0-R(1))/RPP2 RPP(2)= R(2)/RPP2 * AR1R= RM2(1) AR1I= RM2(2) UMAR1R= 1.Q0-RM2(1) AR2R= RM4(1) AR2I= RM4(2) UMAR2R= 1.Q0-RM4(1) AR3R= XP(1) AR3I= XP(2) UMAR3R= 1.Q0-XP(1) CALL TSPENCE(AR1R,AR1I,UMAR1R,CLI2SR,CLI2SI) CALL TSPENCE(AR2R,AR2I,UMAR2R,CLI2FR,CLI2FI) CALL TSPENCE(AR3R,AR3I,UMAR3R,CLI2XR,CLI2XI) CALL TCLI3(AR1R,AR1I,CLI3SR,CLI3SI) CALL TCLI3(AR2R,AR2I,CLI3FR,CLI3FI) CALL TCLI3(AR3R,AR3I,CLI3XR,CLI3XI) * COMB3R= 2.Q0*CLI3SR-CLI3FR COMB3I= 2.Q0*CLI3SI-CLI3FI COMB2R= CLI2SR-CLI2FR COMB2I= CLI2SI-CLI2FI F2R= F(1)*F(1)-F(2)*F(2) F2I= 2.Q0*F(1)*F(2) * R1P= R(1)+1.5Q0 AUX1R= -F(1)+G(1)/3.Q0+2.Q0/3.Q0*H(1) AUX1I= -F(2)+G(2)/3.Q0+2.Q0/3.Q0*H(2) AUX2R= -3.Q0*F(1)+2.Q0*G(1)+4.Q0*H(1) AUX2I= -3.Q0*F(2)+2.Q0*G(2)+4.Q0*H(2) AUX3R= COMB2R+F(1)*AUX2R-F(2)*AUX2I AUX3PR= -2.Q0*(R1P*F(1)-R(2)*F(2)) AUX3I= COMB2I+F(1)*AUX2I+F(2)*AUX2R AUX3PI= -2.Q0*(R1P*F(2)+R(2)*F(1)) AUX4R= COMB2R+F(1)*AUX2R-F(2)*AUX2I AUX4PR= -2.Q0*((R(1)-3.Q0+0.25Q0*RI(1))*F(1)- # (R(2)+0.25Q0*RI(2))*F(2)) AUX4I= COMB2I+F(1)*AUX2I+F(2)*AUX2R AUX4PI= -2.Q0*((R(1)-3.Q0+0.25Q0*RI(1))*F(2)+ # (R(2)+0.25Q0*RI(2))*F(1)) AUX5R= R(1)-1.Q0/6.Q0-7.Q0/48.Q0*RI(1) AUX5I= R(2)-7.Q0/48.Q0*RI(2) AUX6R= R(1)-11.Q0/12.Q0+5.Q0/48.Q0*RI(1)+1.Q0/32.Q0* # R2I(1) AUX6I= R(2)+5.Q0/48.Q0*RI(2)+1.Q0/32.Q0*R2I(2) * EX0VR= 4.Q0*(R(1)-0.25Q0*RI(1)) EX0VI= 4.Q0*(R(2)-0.25Q0*RI(2)) * EX0AR= 4.Q0*(R(1)-1.5Q0+0.5Q0*RI(1)) EX0AI= 4.Q0*(R(2)+0.5Q0*RI(2)) * EX0XR= X(1)-1.5Q0+0.5Q0*X2I(1) EX0XI= X(2)+0.5Q0*X2I(2) * EX1R= COMB3R+8.Q0/3.Q0*(F(1)*COMB2R-F(2)*COMB2I)+ # 4.Q0*(F2R*AUX1R-F2I*AUX1I) EX1I= COMB3I+8.Q0/3.Q0*(F(1)*COMB2I+F(2)*COMB2R)+ # 4.Q0*(F2R*AUX1I+F2I*AUX1R) * EX2R= 8.Q0/3.Q0*((R(1)+0.5Q0)*AUX3R-R(2)*AUX3I)+AUX3PR EX2I= 8.Q0/3.Q0*((R(1)+0.5Q0)*AUX3I+R(2)*AUX3R)+AUX3PI * EX3R= -8.Q0*(AUX5R*F2R-AUX5I*F2I)+13.Q0/6.Q0+Z3*RI(1) EX3I= -8.Q0*(AUX5R*F2I+AUX5I*F2R)+Z3*RI(2) * EX4R= 8.Q0/3.Q0*((R(1)-1.Q0)*AUX4R-R(2)*AUX4I)+AUX4PR EX4I= 8.Q0/3.Q0*((R(1)-1.Q0)*AUX4I+R(2)*AUX4R)+AUX4PI * EX5R= -8.Q0*(AUX6R*F2R-AUX6I*F2I)+ # 13.Q0/6.Q0-3.Q0*Z2+(0.25Q0-2.Q0*Z3)*RI(1) EX5I= -8.Q0*(AUX6R*F2I+AUX6I*F2R)+(0.25Q0-2.Q0*Z3)* # RI(2) * EX6R= CLI3XR+2.Q0/3.Q0*(B(1)*CLI2XR-B(2)*CLI2XI)-1.Q0/6.Q0* # (B2(1)*(A(1)-B(1))-B2(2)*(A(2)-B(2))) EX6I= CLI3XI+2.Q0/3.Q0*(B(1)*CLI2XI+B(2)*CLI2XR)-1.Q0/6.Q0* # (B2(1)*(A(2)-B(2))+B2(2)*(A(1)-B(1))) * EX7R= 1.Q0/3.Q0*((X(1)+0.5Q0-0.5Q0*XI(1))*(CLI2XR-AB(1))- # (X(2)-0.5Q0*XI(2))*(CLI2XI-AB(2)))+1.Q0/3.Q0*(B2(1)* # (X(1)-1.Q0/8.Q0-XI(1)+5.Q0/8.Q0*X2I(1))-B2(2)* # (X(2)-XI(2)+5.Q0/8.Q0*X2I(2)))-0.25Q0*(B(1)* # (X(1)-5.Q0/2.Q0+2.Q0/3.Q0*XI(1)+5.Q0/6.Q0*X2I(1))- # B(2)*(X(2)+2.Q0/3.Q0*XI(2)+5.Q0/6.Q0*X2I(2))) EX7I= 1.Q0/3.Q0*((X(1)+0.5Q0-0.5Q0*XI(1))*(CLI2XI-AB(2))+ # (X(2)-0.5Q0*XI(2))*(CLI2XR-AB(1)))+1.Q0/3.Q0*(B2(1)* # (X(2)-XI(2)+5.Q0/8.Q0*X2I(2))+B2(2)*(X(1)-1.Q0/8.Q0- # XI(1)+5.Q0/8.Q0*X2I(1)))-0.25Q0*(B(1)*(X(2)+2.Q0/3.Q0* # XI(2)+5.Q0/6.Q0*X2I(2))+B(2)*(X(1)-5.Q0/2.Q0+2.Q0/3.Q0* # XI(1)+5.Q0/6.Q0*X2I(1))) * EX8R= -3.Q0/4.Q0*Z2+13.Q0/12.Q0-5.Q0/24.Q0*XI(1)-0.5Q0*Z3*X2I(1) EX8I= -5.Q0/24.Q0*XI(2)-0.5Q0*Z3*X2I(2) * V1R= EX0VR*EX1R-EX0VI*EX1I+RRAR(1)*EX2R-RRAR(2)*EX2I+EX3R V1I= EX0VR*EX1I+EX0VI*EX1R+RRAR(1)*EX2I+RRAR(2)*EX2R+EX3I A1R= EX0AR*EX1R-EX0AI*EX1I+RRAR(1)*EX4R-RRAR(2)*EX4I+EX5R A1I= EX0AR*EX1I+EX0AI*EX1R+RRAR(1)*EX4I+RRAR(2)*EX4R+EX5I F1X= EX0XR*EX6R-EX0XI*EX6I+EX7R+EX8R F1XI= EX0XR*EX6I+EX0XI*EX6R+EX7I+EX8I * EX0VPR= 4.Q0*(1.Q0+0.25Q0*R2I(1)) EX0VPI= R2I(2) EX0APR= 4.Q0*(1.Q0-0.5Q0*R2I(1)) EX0API= -2.Q0*R2I(2) * BUX1R= -COMB2R-F(1)*AUX2R+F(2)*AUX2I BUX1I= -COMB2I-F(1)*AUX2I-F(2)*AUX2R BUX2R= 2.Q0/3.Q0*(RI(1)*BUX1R-RI(2)*BUX1I) BUX2I= 2.Q0/3.Q0*(RI(1)*BUX1I+RI(2)*BUX1R) BUX3R= BUX2R-(1.Q0-5.Q0/6.Q0*RI(1))*F(1)- # 5.Q0/6.Q0*RI(2)*F(2) BUX3I= BUX2I-(1.Q0-5.Q0/6.Q0*RI(1))*F(2)+ # 5.Q0/6.Q0*RI(2)*F(1) BUX4R= F2R*(4.Q0/3.Q0*RI(1)-11.Q0/6.Q0*R2I(1)- # 4.Q0*RPP(1))-F2I*(4.Q0/3.Q0*RI(2)-11.Q0/6.Q0* # R2I(2)-4.Q0*RPP(2))-1.Q0-1.5Q0*RI(1)-Z3*R2I(1) BUX4I= F2R*(4.Q0/3.Q0*RI(2)-11.Q0/6.Q0*R2I(2)- # 4.Q0*RPP(2))+F2I*(4.Q0/3.Q0*RI(1)-11.Q0/6.Q0* # R2I(1)-4.Q0*RPP(1))-1.5Q0*RI(2)-Z3*R2I(2) CUX2R= 4.Q0/3.Q0*(-RI(1)*BUX1R+RI(2)*BUX1I) CUX2I= 4.Q0/3.Q0*(-RI(1)*BUX1I-RI(2)*BUX1R) CUX3R= CUX2R-(1.Q0+13.Q0/6.Q0*RI(1)-0.5Q0*R2I(1))*F(1)+ # (13.Q0/6.Q0*RI(2)-0.5Q0*R2I(2))*F(2) CUX3I= CUX2I-(1.Q0+13.Q0/6.Q0*RI(1)-0.5Q0*R2I(1))*F(2)- # (13.Q0/6.Q0*RI(2)-0.5Q0*R2I(2))*F(1) CUX4R= F2R*RI(1)-F2I*RI(2) CUX4I= F2R*RI(2)+F2I*RI(1) CUX5R= CUX4R*(-20.Q0/3.Q0+13.Q0/6.Q0*RI(1)+0.5Q0*R2I(1))- # CUX4I*(13.Q0/6.Q0*RI(2)+0.5Q0*R2I(2))-1.Q0+3.Q0*RI(1)+ # (2.Q0*Z3-0.5Q0)*R2I(1) CUX5I= CUX4R*(13.Q0/6.Q0*RI(2)+0.5Q0*R2I(2))+ # CUX4I*(20.Q0/3.Q0+13.Q0/6.Q0*RI(1)+0.5Q0*R2I(1))+ # 3.Q0*RI(2)+(2.Q0*Z3-0.5Q0)*R2I(2) * V1PR= EX0VPR*EX1R-EX0VPI*EX1I+2.Q0*(RRAR(1)*BUX3R- # RRAR(2)*BUX3I)+BUX4R A1PR= EX0APR*EX1R-EX0API*EX1I+2.Q0*(RRAR(1)*CUX3R- # RRAR(2)*CUX3I)+CUX5R * V1= V1R A1= A1R F1= F1X V1P= V1PR A1P= A1PR * RETURN END * *-----CLI3----------------------------------------------------------- * COMPUTES LI_3(X) FOR COMPLEX X * SUBROUTINE TCLI3(XR,XI,CLI3R,CLI3I) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION B(0:14),BF(0:14) DIMENSION X(2),Y(2),ADDX(2),OX(2),CLNX(2),PAR(2),CT(15),SN(15), # RES(2),U1(2),U2(2),CLNY(2),OMY(2),CLNOMY(2),ADDY(2), # PAR1(2),PAR2(2),CT1(15),SN1(15),CT2(15),SN2(15), # RES1(2),RES2(2),T(2),RESA(2),RESB(2),CLNT(2), # RES3(2),RES4(2),CLNOMT(2),ADDT(2),ADDT2(2),OMT(2), # OMU1(2),OMU2(2) * DATA B/1.Q0,-0.75Q0,0.236111111111111111111111111111111Q0, # -3.472222222222222222222222222222222Q-2, # 6.481481481481481481481481481481482Q-4, # 4.861111111111111111111111111111111Q-4, # -2.393550012597631645250692869740488Q-5, # -1.062925170068027210884353741496599Q-5, # 7.794784580498866213151927437641723Q-7, # 2.526087595532039976484420928865373Q-7, # -2.359163915200471237027273583310139Q-8, # -6.168132746415574698402981231264060Q-9, # 6.824456748981078267312315451125495Q-10, # 1.524285616929084572552216019859487Q-10, # -1.916909414174054295837274763110831Q-11/ DATA Z3/1.20205690315959428540Q0/ * Z2= QPIS/6.Q0 DO N=0,14 BF(N)= B(N)/(N+1.Q0) ENDDO * X(1)= XR X(2)= XI * XM2= X(1)*X(1)+X(2)*X(2) XM= SQRT(XM2) * *-----THE MODULUS OF X IS CHECKED * XTST= XM-1.Q0 IF(XTST.LE.1.Q-33) THEN Y(1)= X(1) Y(2)= X(2) ADDX(1)= 0.Q0 ADDX(2)= 0.Q0 ELSE IF(XM.GT.1.Q-33) THEN Y(1)= X(1)/XM2 Y(2)= -X(2)/XM2 OX(1)= -X(1) OX(2)= -X(2) CALL TCQLNX(OX,CLNX) RLNX2= CLNX(1)*CLNX(1) AILNX2= CLNX(2)*CLNX(2) ADDX(1)= -CLNX(1)*(Z2+1.Q0/6.Q0*(RLNX2-3.Q0*AILNX2)) ADDX(2)= -CLNX(2)*(Z2+1.Q0/6.Q0*(3.Q0*RLNX2-AILNX2)) ENDIF * *-----ONCE X --> Y, |Y|<1 THE SIGN OF RE(Y) IS CHECKED * IF RE(Y)>0 A TRANSFORMATION IS REQUIRED FOR RE(Y)>1/2 * Y2R= Y(1)*Y(1)-Y(2)*Y(2) IF(Y(1).GE.0.Q0.OR.Y2R.LT.0.Q0) THEN YTST= Y(1)-0.5Q0 IF(YTST.LE.1.Q-33) THEN * *-----LI_3(Y) IS COMPUTED * OMY(1)= 1.Q0-Y(1) OMY(2)= -Y(2) CALL TCQLNOMX(Y,OMY,PAR) PR= -PAR(1) PI= -PAR(2) P2= PR*PR+PI*PI PM= SQRT(P2) CT(1)= PR/PM SN(1)= PI/PM DO N=2,15 CT(N)= CT(1)*CT(N-1)-SN(1)*SN(N-1) SN(N)= SN(1)*CT(N-1)+CT(1)*SN(N-1) ENDDO RES(1)= PM*(BF(0)*CT(1)+PM*(BF(1)*CT(2)+PM* # (BF(2)*CT(3)+PM*(BF(3)*CT(4)+PM* # (BF(4)*CT(5)+PM*(BF(5)*CT(6)+PM* # (BF(6)*CT(7)+PM*(BF(7)*CT(8)+PM* # (BF(8)*CT(9)+PM*(BF(9)*CT(10)+PM* # (BF(10)*CT(11)+PM*(BF(11)*CT(12)+PM* # (BF(12)*CT(13)+PM*(BF(13)*CT(14)+PM* # (BF(14)*CT(15)))))))))))))))) RES(2)= PM*(BF(0)*SN(1)+PM*(BF(1)*SN(2)+PM* # (BF(2)*SN(3)+PM*(BF(3)*SN(4)+PM* # (BF(4)*SN(5)+PM*(BF(5)*SN(6)+PM* # (BF(6)*SN(7)+PM*(BF(7)*SN(8)+PM* # (BF(8)*SN(9)+PM*(BF(9)*SN(10)+PM* # (BF(10)*SN(11)+PM*(BF(11)*SN(12)+PM* # (BF(12)*SN(13)+PM*(BF(13)*SN(14)+PM* # (BF(14)*SN(15)))))))))))))))) CLI3R= RES(1)+ADDX(1) CLI3I= RES(2)+ADDX(2) RETURN ELSE IF(YTST.GT.1.Q-33) THEN YM2= Y(1)*Y(1)+Y(2)*Y(2) U1(1)= 1.Q0-Y(1)/YM2 U1(2)= Y(2)/YM2 U2(1)= 1.Q0-Y(1) U2(2)= -Y(2) CALL TCQLNX(Y,CLNY) OMY(1)= 1.Q0-Y(1) OMY(2)= -Y(2) CALL TCQLNOMX(Y,OMY,CLNOMY) ADDY(1)= Z3+Z2*CLNY(1)+1.Q0/6.Q0*CLNY(1)* # (CLNY(1)*CLNY(1)-3.Q0*CLNY(2)*CLNY(2))- # 0.5Q0*CLNOMY(1)*(CLNY(1)*CLNY(1)-CLNY(2)* # CLNY(2))+CLNY(1)*CLNY(2)*CLNOMY(2) ADDY(2)= Z2*CLNY(2)+1.Q0/6.Q0*CLNY(2)*(3.Q0* # CLNY(1)*CLNY(1)-CLNY(2)*CLNY(2))-0.5Q0* # CLNOMY(2)*(CLNY(1)*CLNY(1)-CLNY(2)*CLNY(2))- # CLNY(1)*CLNOMY(1)*CLNY(2) * *-----LI_3(1-1/Y) IS COMPUTED * OMU1(1)= 1.Q0-U1(1) OMU1(2)= -U1(2) CALL TCQLNOMX(U1,OMU1,PAR1) PR1= -PAR1(1) PI1= -PAR1(2) P12= PR1*PR1+PI1*PI1 PM1= SQRT(P12) CT1(1)= PR1/PM1 SN1(1)= PI1/PM1 DO N=2,15 CT1(N)= CT1(1)*CT1(N-1)-SN1(1)*SN1(N-1) SN1(N)= SN1(1)*CT1(N-1)+CT1(1)*SN1(N-1) ENDDO RES1(1)= PM1*(BF(0)*CT1(1)+PM1*(BF(1)*CT1(2)+PM1* # (BF(2)*CT1(3)+PM1*(BF(3)*CT1(4)+PM1* # (BF(4)*CT1(5)+PM1*(BF(5)*CT1(6)+PM1* # (BF(6)*CT1(7)+PM1*(BF(7)*CT1(8)+PM1* # (BF(8)*CT1(9)+PM1*(BF(9)*CT1(10)+PM1* # (BF(10)*CT1(11)+PM1*(BF(11)*CT1(12)+PM1* # (BF(12)*CT1(13)+PM1*(BF(13)*CT1(14)+PM1* # (BF(14)*CT1(15)))))))))))))))) RES1(2)= PM1*(BF(0)*SN1(1)+PM1*(BF(1)*SN1(2)+PM1* # (BF(2)*SN1(3)+PM1*(BF(3)*SN1(4)+PM1* # (BF(4)*SN1(5)+PM1*(BF(5)*SN1(6)+PM1* # (BF(6)*SN1(7)+PM1*(BF(7)*SN1(8)+PM1* # (BF(8)*SN1(9)+PM1*(BF(9)*SN1(10)+PM1* # (BF(10)*SN1(11)+PM1*(BF(11)*SN1(12)+PM1* # (BF(12)*SN1(13)+PM1*(BF(13)*SN1(14)+PM1* # (BF(14)*SN1(15)))))))))))))))) * *-----LI_3(1-Y) IS COMPUTED * OMU2(1)= 1.Q0-U2(1) OMU2(2)= -U2(2) CALL TCQLNOMX(U2,OMU2,PAR2) PR2= -PAR2(1) PI2= -PAR2(2) P22= PR2*PR2+PI2*PI2 PM2= SQRT(P22) CT2(1)= PR2/PM2 SN2(1)= PI2/PM2 DO N=2,15 CT2(N)= CT2(1)*CT2(N-1)-SN2(1)*SN2(N-1) SN2(N)= SN2(1)*CT2(N-1)+CT2(1)*SN2(N-1) ENDDO RES2(1)= PM2*(BF(0)*CT2(1)+PM2*(BF(1)*CT2(2)+PM2* # (BF(2)*CT2(3)+PM2*(BF(3)*CT2(4)+PM2* # (BF(4)*CT2(5)+PM2*(BF(5)*CT2(6)+PM2* # (BF(6)*CT2(7)+PM2*(BF(7)*CT2(8)+PM2* # (BF(8)*CT2(9)+PM2*(BF(9)*CT2(10)+PM2* # (BF(10)*CT2(11)+PM2*(BF(11)*CT2(12)+PM2* # (BF(12)*CT2(13)+PM2*(BF(13)*CT2(14)+PM2* # (BF(14)*CT2(15)))))))))))))))) RES2(2)= PM2*(BF(0)*SN2(1)+PM2*(BF(1)*SN2(2)+PM2* # (BF(2)*SN2(3)+PM2*(BF(3)*SN2(4)+PM2* # (BF(4)*SN2(5)+PM2*(BF(5)*SN2(6)+PM2* # (BF(6)*SN2(7)+PM2*(BF(7)*SN2(8)+PM2* # (BF(8)*SN2(9)+PM2*(BF(9)*SN2(10)+PM2* # (BF(10)*SN2(11)+PM2*(BF(11)*SN2(12)+PM2* # (BF(12)*SN2(13)+PM2*(BF(13)*SN2(14)+PM2* # (BF(14)*SN2(15)))))))))))))))) CLI3R= -RES1(1)-RES2(1)+ADDX(1)+ADDY(1) CLI3I= -RES1(2)-RES2(2)+ADDX(2)+ADDY(2) RETURN ENDIF * *-----IF RE(Y)<0 A TRANSFORMATION IS REQUIRED IN TERMS OF T = -Y * AND OF T^2 * ELSE IF(Y(1).LT.0.Q0) THEN * *-----FIRST T * T(1)= -Y(1) T(2)= -Y(2) IF(T(1).LE.0.5Q0) THEN * *-----LI_3(T) IS COMPUTED * OMT(1)= 1.Q0-T(1) OMT(2)= -T(2) CALL TCQLNOMX(T,OMT,PAR) PR= -PAR(1) PI= -PAR(2) P2= PR*PR+PI*PI PM= SQRT(P2) CT(1)= PR/PM SN(1)= PI/PM DO N=2,15 CT(N)= CT(1)*CT(N-1)-SN(1)*SN(N-1) SN(N)= SN(1)*CT(N-1)+CT(1)*SN(N-1) ENDDO RESA(1)= PM*(BF(0)*CT(1)+PM*(BF(1)*CT(2)+PM* # (BF(2)*CT(3)+PM*(BF(3)*CT(4)+PM* # (BF(4)*CT(5)+PM*(BF(5)*CT(6)+PM* # (BF(6)*CT(7)+PM*(BF(7)*CT(8)+PM* # (BF(8)*CT(9)+PM*(BF(9)*CT(10)+PM* # (BF(10)*CT(11)+PM*(BF(11)*CT(12)+PM* # (BF(12)*CT(13)+PM*(BF(13)*CT(14)+PM* # (BF(14)*CT(15)))))))))))))))) RESA(2)= PM*(BF(0)*SN(1)+PM*(BF(1)*SN(2)+PM* # (BF(2)*SN(3)+PM*(BF(3)*SN(4)+PM* # (BF(4)*SN(5)+PM*(BF(5)*SN(6)+PM* # (BF(6)*SN(7)+PM*(BF(7)*SN(8)+PM* # (BF(8)*SN(9)+PM*(BF(9)*SN(10)+PM* # (BF(10)*SN(11)+PM*(BF(11)*SN(12)+PM* # (BF(12)*SN(13)+PM*(BF(13)*SN(14)+PM* # (BF(14)*SN(15)))))))))))))))) ELSE IF(T(1).GT.0.5Q0) THEN TM2= T(1)*T(1)+T(2)*T(2) U1(1)= 1.Q0-T(1)/TM2 U1(2)= T(2)/TM2 U2(1)= 1.Q0-T(1) U2(2)= -T(2) CALL TCQLNX(T,CLNT) OMT(1)= 1.Q0-T(1) OMT(2)= -T(2) CALL TCQLNOMX(T,OMT,CLNOMT) ADDT(1)= Z3+Z2*CLNT(1)+1.Q0/6.Q0*CLNT(1)* # (CLNT(1)*CLNT(1)-3.Q0*CLNT(2)*CLNT(2))- # 0.5Q0*CLNOMT(1)*(CLNT(1)*CLNT(1)-CLNT(2)* # CLNT(2))+CLNT(1)*CLNT(2)*CLNOMT(2) ADDT(2)= Z2*CLNT(2)+1.Q0/6.Q0*CLNT(2)*(3.Q0* # CLNT(1)*CLNT(1)-CLNT(2)*CLNT(2))-0.5Q0* # CLNOMT(2)*(CLNT(1)*CLNT(1)-CLNT(2)*CLNT(2))- # CLNT(1)*CLNOMT(1)*CLNT(2) * *-----LI3(1-1/T) IS COMPUTED * OMU1(1)= 1.Q0-U1(1) OMU1(2)= -U1(2) CALL TCQLNOMX(U1,OMU1,PAR1) PR1= -PAR1(1) PI1= -PAR1(2) P12= PR1*PR1+PI1*PI1 PM1= SQRT(P12) CT1(1)= PR1/PM1 SN1(1)= PI1/PM1 DO N=2,15 CT1(N)= CT1(1)*CT1(N-1)-SN1(1)*SN1(N-1) SN1(N)= SN1(1)*CT1(N-1)+CT1(1)*SN1(N-1) ENDDO RES1(1)= PM1*(BF(0)*CT1(1)+PM1*(BF(1)*CT1(2)+PM1* # (BF(2)*CT1(3)+PM1*(BF(3)*CT1(4)+PM1* # (BF(4)*CT1(5)+PM1*(BF(5)*CT1(6)+PM1* # (BF(6)*CT1(7)+PM1*(BF(7)*CT1(8)+PM1* # (BF(8)*CT1(9)+PM1*(BF(9)*CT1(10)+PM1* # (BF(10)*CT1(11)+PM1*(BF(11)*CT1(12)+PM1* # (BF(12)*CT1(13)+PM1*(BF(13)*CT1(14)+PM1* # (BF(14)*CT1(15)))))))))))))))) RES1(2)= PM1*(BF(0)*SN1(1)+PM1*(BF(1)*SN1(2)+PM1* # (BF(2)*SN1(3)+PM1*(BF(3)*SN1(4)+PM1* # (BF(4)*SN1(5)+PM1*(BF(5)*SN1(6)+PM1* # (BF(6)*SN1(7)+PM1*(BF(7)*SN1(8)+PM1* # (BF(8)*SN1(9)+PM1*(BF(9)*SN1(10)+PM1* # (BF(10)*SN1(11)+PM1*(BF(11)*SN1(12)+PM1* # (BF(12)*SN1(13)+PM1*(BF(13)*SN1(14)+PM1* # (BF(14)*SN1(15)))))))))))))))) * *-----LI3(1-T) IS COMPUTED * OMU2(1)= 1.Q0-U2(1) OMU2(2)= -U2(2) CALL TCQLNOMX(U2,OMU2,PAR2) PR2= -PAR2(1) PI2= -PAR2(2) P22= PR2*PR2+PI2*PI2 PM2= SQRT(P22) CT2(1)= PR2/PM2 SN2(1)= PI2/PM2 DO N=2,15 CT2(N)= CT2(1)*CT2(N-1)-SN2(1)*SN2(N-1) SN2(N)= SN2(1)*CT2(N-1)+CT2(1)*SN2(N-1) ENDDO RES2(1)= PM2*(BF(0)*CT2(1)+PM2*(BF(1)*CT2(2)+PM2* # (BF(2)*CT2(3)+PM2*(BF(3)*CT2(4)+PM2* # (BF(4)*CT2(5)+PM2*(BF(5)*CT2(6)+PM2* # (BF(6)*CT2(7)+PM2*(BF(7)*CT2(8)+PM2* # (BF(8)*CT2(9)+PM2*(BF(9)*CT2(10)+PM2* # (BF(10)*CT2(11)+PM2*(BF(11)*CT2(12)+PM2* # (BF(12)*CT2(13)+PM2*(BF(13)*CT2(14)+PM2* # (BF(14)*CT2(15)))))))))))))))) RES2(2)= PM2*(BF(0)*SN2(1)+PM2*(BF(1)*SN2(2)+PM2* # (BF(2)*SN2(3)+PM2*(BF(3)*SN2(4)+PM2* # (BF(4)*SN2(5)+PM2*(BF(5)*SN2(6)+PM2* # (BF(6)*SN2(7)+PM2*(BF(7)*SN2(8)+PM2* # (BF(8)*SN2(9)+PM2*(BF(9)*SN2(10)+PM2* # (BF(10)*SN2(11)+PM2*(BF(11)*SN2(12)+PM2* # (BF(12)*SN2(13)+PM2*(BF(13)*SN2(14)+PM2* # (BF(14)*SN2(15)))))))))))))))) RESA(1)= -RES1(1)-RES2(1)+ADDT(1) RESA(2)= -RES1(2)-RES2(2)+ADDT(2) ENDIF * *-----THEN T^2 * T(1)= Y(1)*Y(1)-Y(2)*Y(2) T(2)= 2.Q0*Y(1)*Y(2) IF(T(1).LE.0.5Q0) THEN * *-----LI_3(T^2) IS COMPUTED * OMT(1)= 1.Q0-T(1) OMT(2)= -T(2) CALL TCQLNOMX(T,OMT,PAR) PR= -PAR(1) PI= -PAR(2) P2= PR*PR+PI*PI PM= SQRT(P2) CT(1)= PR/PM SN(1)= PI/PM DO N=2,15 CT(N)= CT(1)*CT(N-1)-SN(1)*SN(N-1) SN(N)= SN(1)*CT(N-1)+CT(1)*SN(N-1) ENDDO RESB(1)= PM*(BF(0)*CT(1)+PM*(BF(1)*CT(2)+PM* # (BF(2)*CT(3)+PM*(BF(3)*CT(4)+PM* # (BF(4)*CT(5)+PM*(BF(5)*CT(6)+PM* # (BF(6)*CT(7)+PM*(BF(7)*CT(8)+PM* # (BF(8)*CT(9)+PM*(BF(9)*CT(10)+PM* # (BF(10)*CT(11)+PM*(BF(11)*CT(12)+PM* # (BF(12)*CT(13)+PM*(BF(13)*CT(14)+PM* # (BF(14)*CT(15)))))))))))))))) RESB(2)= PM*(BF(0)*SN(1)+PM*(BF(1)*SN(2)+PM* # (BF(2)*SN(3)+PM*(BF(3)*SN(4)+PM* # (BF(4)*SN(5)+PM*(BF(5)*SN(6)+PM* # (BF(6)*SN(7)+PM*(BF(7)*SN(8)+PM* # (BF(8)*SN(9)+PM*(BF(9)*SN(10)+PM* # (BF(10)*SN(11)+PM*(BF(11)*SN(12)+PM* # (BF(12)*SN(13)+PM*(BF(13)*SN(14)+PM* # (BF(14)*SN(15)))))))))))))))) ELSE IF(T(1).GT.0.5Q0) THEN TM2= T(1)*T(1)+T(2)*T(2) U1(1)= 1.Q0-T(1)/TM2 U1(2)= T(2)/TM2 U2(1)= 1.Q0-T(1) U2(2)= -T(2) CALL TCQLNX(T,CLNT) OMT(1)= 1.Q0-T(1) OMT(2)= -T(2) CALL TCQLNOMX(T,OMT,CLNOMT) ADDT2(1)= Z3+Z2*CLNT(1)+1.Q0/6.Q0*CLNT(1)* # (CLNT(1)*CLNT(1)-3.Q0*CLNT(2)*CLNT(2))- # 0.5Q0*CLNOMT(1)*(CLNT(1)*CLNT(1)-CLNT(2)* # CLNT(2))+CLNT(1)*CLNT(2)*CLNOMT(2) ADDT2(2)= Z2*CLNT(2)+1.Q0/6.Q0*CLNT(2)*(3.Q0* # CLNT(1)*CLNT(1)-CLNT(2)*CLNT(2))-0.5Q0* # CLNOMT(2)*(CLNT(1)*CLNT(1)-CLNT(2)*CLNT(2))- # CLNT(1)*CLNOMT(1)*CLNT(2) * *-----LI_3(1-1/T^2) IS COMPUTED * OMU1(1)= 1.Q0-U1(1) OMU1(2)= -U1(2) CALL TCQLNOMX(U1,OMU1,PAR1) PR1= -PAR1(1) PI1= -PAR1(2) P12= PR1*PR1+PI1*PI1 PM1= SQRT(P12) CT1(1)= PR1/PM1 SN1(1)= PI1/PM1 DO N=2,15 CT1(N)= CT1(1)*CT1(N-1)-SN1(1)*SN1(N-1) SN1(N)= SN1(1)*CT1(N-1)+CT1(1)*SN1(N-1) ENDDO RES3(1)= PM1*(BF(0)*CT1(1)+PM1*(BF(1)*CT1(2)+PM1* # (BF(2)*CT1(3)+PM1*(BF(3)*CT1(4)+PM1* # (BF(4)*CT1(5)+PM1*(BF(5)*CT1(6)+PM1* # (BF(6)*CT1(7)+PM1*(BF(7)*CT1(8)+PM1* # (BF(8)*CT1(9)+PM1*(BF(9)*CT1(10)+PM1* # (BF(10)*CT1(11)+PM1*(BF(11)*CT1(12)+PM1* # (BF(12)*CT1(13)+PM1*(BF(13)*CT1(14)+PM1* # (BF(14)*CT1(15)))))))))))))))) RES3(2)= PM1*(BF(0)*SN1(1)+PM1*(BF(1)*SN1(2)+PM1* # (BF(2)*SN1(3)+PM1*(BF(3)*SN1(4)+PM1* # (BF(4)*SN1(5)+PM1*(BF(5)*SN1(6)+PM1* # (BF(6)*SN1(7)+PM1*(BF(7)*SN1(8)+PM1* # (BF(8)*SN1(9)+PM1*(BF(9)*SN1(10)+PM1* # (BF(10)*SN1(11)+PM1*(BF(11)*SN1(12)+PM1* # (BF(12)*SN1(13)+PM1*(BF(13)*SN1(14)+PM1* # (BF(14)*SN1(15)))))))))))))))) * *-----LI_3(1-T^2) IS COMPUTED * OMU2(1)= 1.Q0-U2(1) OMU2(2)= -U2(2) CALL TCQLNOMX(U2,OMU2,PAR2) PR2= -PAR2(1) PI2= -PAR2(2) P22= PR2*PR2+PI2*PI2 PM2= SQRT(P22) CT2(1)= PR2/PM2 SN2(1)= PI2/PM2 DO N=2,15 CT2(N)= CT2(1)*CT2(N-1)-SN2(1)*SN2(N-1) SN2(N)= SN2(1)*CT2(N-1)+CT2(1)*SN2(N-1) ENDDO RES4(1)= PM2*(BF(0)*CT2(1)+PM2*(BF(1)*CT2(2)+PM2* # (BF(2)*CT2(3)+PM2*(BF(3)*CT2(4)+PM2* # (BF(4)*CT2(5)+PM2*(BF(5)*CT2(6)+PM2* # (BF(6)*CT2(7)+PM2*(BF(7)*CT2(8)+PM2* # (BF(8)*CT2(9)+PM2*(BF(9)*CT2(10)+PM2* # (BF(10)*CT2(11)+PM2*(BF(11)*CT2(12)+PM2* # (BF(12)*CT2(13)+PM2*(BF(13)*CT2(14)+PM2* # (BF(14)*CT2(15)))))))))))))))) RES4(2)= PM2*(BF(0)*SN2(1)+PM2*(BF(1)*SN2(2)+PM2* # (BF(2)*SN2(3)+PM2*(BF(3)*SN2(4)+PM2* # (BF(4)*SN2(5)+PM2*(BF(5)*SN2(6)+PM2* # (BF(6)*SN2(7)+PM2*(BF(7)*SN2(8)+PM2* # (BF(8)*SN2(9)+PM2*(BF(9)*SN2(10)+PM2* # (BF(10)*SN2(11)+PM2*(BF(11)*SN2(12)+PM2* # (BF(12)*SN2(13)+PM2*(BF(13)*SN2(14)+PM2* # (BF(14)*SN2(15)))))))))))))))) RESB(1)= -RES3(1)-RES4(1)+ADDT2(1) RESB(2)= -RES3(2)-RES4(2)+ADDT2(2) ENDIF CLI3R= -RESA(1)+0.25Q0*RESB(1)+ADDX(1) CLI3I= -RESA(2)+0.25Q0*RESB(2)+ADDX(2) RETURN ENDIF END * *-----PAIRS----------------------------------------------------- * SUBROUTINE TPAIRS(RSF,WT,PDEL,PDELH) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM,KM CHARACTER*1 OIFAIL * PARAMETER (NDIM=1,NFN=8,IRCLS=2**NDIM+2*NDIM*NDIM+ # 2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*NFN+(NDIM+NFN+2)*(1+ # MXCLS/IRCLS),LENWRK=10*LENWRK0) PARAMETER (MNRS=30,NFL=4) * DIMENSION XL(NDIM),XU(NDIM),AESTE(NFN),FESTE(NFN), # AESTMU(NFN),FESTMU(NFN),AESTHP(NFN), # FESTHP(NFN),WRKSTR(LENWRK) DIMENSION PEH(NFN),PMUH(NFN),PHH(NFN),PE(NFL),PMU(NFL), # PH(NFL),PTP(NFL),PEVH(NFL),PMUVH(NFL), # PHVH(NFL),PTPVH(NFL),PDEL(NFL),PDELH(NFL) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFUBE,TFUBMU,TFUBHP * COMMON/TCME/RS COMMON/TPC/ZPCUT COMMON/TIFL/OIFAIL COMMON/TICOUPLING/NF COMMON/THMASS/PIM,KM,DM,BM COMMON/TPARAM/PI,PIS,DELTA COMMON/TCLOGS/ALE,ALMU,ALPI COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TMOMENTSH/RINFH,R0H,R1H COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TMOMENTS/AL4,RINFL,R0L,R1L COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TDELTAS/DEI,DMUI,DPII,ZMN1,ZMN2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM * API2= API*API Z2= RZ2 Z3= RZ3 ZW= WT * ZMN1= ZPCUT ZMN2= 0.90D0 AME= EM AMU= MM AMP= PIM * *-----LEPTONIC MOMENTS:FOR ELECTRONS AND MUONS * AL4= LOG(4.D0) RINFL= 1.D0 R0L= AL4-5.D0/3.D0 R1L= AL4*(0.5D0*AL4-5.D0/3.D0)+28.D0/9.D0-Z2 * *-----HADRONIC MOMENTS * RINFH= 4.D0 R0H= -8.31D0 R1H= 13.1D0 * RS= RSF DEI= 1.D-3/RS DMUI= 1.D-3/RS DPII= 1.D-3/RS * ALE= LOG(RS*RS/AME/AME) ALEP= ALE-AL4 ALES= ALE*ALE ALMU= LOG(RS*RS/AMU/AMU) ALMUP= ALMU-AL4 ALMUS= ALMU*ALMU ALPI= LOG(RS*RS/AMP/AMP) ALPIP= ALPI-AL4 ALPIS= ALPI*ALPI ALIRE= LOG(2.D0*DEI) ALIRE2= ALIRE*ALIRE ALIRE3= ALIRE2*ALIRE ALIRMU= LOG(2.D0*DMUI) ALIRMU2= ALIRMU*ALIRMU ALIRMU3= ALIRMU2*ALIRMU ALIRMP= LOG(2.D0*DPII) ALIRMP2= ALIRMP*ALIRMP ALIRMP3= ALIRMP2*ALIRMP AXQ1= 7.D0/12.D0 AXQ2= 5.D0/8.D0 AXQ3= 4.D0/9.D0 AXQ4= 2.D0/3.D0 * *-----THE SOFT+VIRTUAL ELECTRON CONTRIBUTION * PES= (RINFL*(0.5D0*ALEP**2-Z2)+R0L*ALEP+R1L)*(AXQ4* # ALIRE+0.5D0)+(RINFL*ALEP+R0L)*(AXQ4*ALIRE2-AXQ1)+ # RINFL*(AXQ3*ALIRE3+AXQ4*Z3+AXQ2) PES= PES*API2 * *-----THE SOFT+VIRTUAL MUON CONTRIBUTION * PMUS= (RINFL*(0.5D0*ALMUP**2-Z2)+R0L*ALMUP+R1L)*(AXQ4* # ALIRMU+0.5D0)+(RINFL*ALMUP+R0L)*(AXQ4*ALIRMU2-AXQ1)+ # RINFL*(AXQ3*ALIRMU3+AXQ4*Z3+AXQ2) PMUS= PMUS*API2 * *-----THE SOFT+VIRTUAL HADRONIC CONTRIBUTION * PHS= (RINFH*(0.5D0*ALPIP**2-Z2)+R0H*ALPIP+R1H)*(AXQ4* # ALIRMP+0.5D0)+(RINFH*ALPIP+R0H)*(AXQ4*ALIRMP2-AXQ1)+ # RINFH*(AXQ3*ALIRMP3+AXQ4*Z3+AXQ2) PHS= PHS*API2 * *-----THE HARD ELECTRON CONTRIBUTION * DO I= 1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO * MULFAC= 10 * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 * REQ= 1.D-4 REQ= 1.D-5 10 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBE,AEQ,REQ, # LENWRK,WRKSTR,FESTE,AESTE,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY PAIRS ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 10 ENDIF * DO I1=1,NFN PEH(I1)= FESTE(I1) ENDDO * *-----THE HARD MUON CONTRIBUTION * DO I= 1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO * MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 * REQ= 1.D-4 REQ= 1.D-5 20 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBMU,AEQ,REQ, # LENWRK,WRKSTR,FESTMU,AESTMU,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY PAIRS ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 20 ENDIF * DO I1=1,NFN PMUH(I1)= FESTMU(I1) ENDDO * *-----THE HARD HADRONIC CONTRIBUTION * DO I= 1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO * MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 * REQ= 1.D-4 REQ= 1.D-5 30 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBHP,AEQ,REQ, # LENWRK,WRKSTR,FESTHP,AESTHP,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY PAIRS ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 30 ENDIF * DO I1=1,NFN PHH(I1)= FESTHP(I1) ENDDO * DO I1=1,NFL I3= I1+4 PE(I1)= PES+PEH(I1) PMU(I1)= PMUS+PMUH(I1) PH(I1)= PHS+PHH(I1) PEVH(I1)= PEH(I3) PMUVH(I1)= PMUH(I3) PHVH(I1)= PHH(I3) PTP(I1)= PE(I1)+PMU(I1)+PH(I1) PTPVH(I1)= PEVH(I1)+PMUVH(I1)+PHVH(I1) * PDEL(I1)= PTP(I1) PDELH(I1)= PTPVH(I1) ENDDO * RETURN END * *-----FUNSUBE--------------------------------------------------------- * SUBROUTINE TFUBE(NDIM,X,NFN,F) IMPLICIT REAL*8(A-H,O-Z) * PARAMETER(NFL=4) * DIMENSION X(NDIM),F(NFN),RADE(2) * COMMON/TCLOGS/ALE,ALMU,ALPI COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TMOMENTS/AL4,RINFL,R0L,R1L COMMON/TDELTAS/DEI,DMUI,DPII,ZMN1,ZMN2 * DO I=1,2 IF(I.EQ.1) THEN TJ= (1.D0-DEI)**2-ZMN2 Z= TJ*X(1)+ZMN2 OMZ= (1.D0-ZMN2)*(1.D0-X(1))+DEI*(2.D0-DEI)*X(1) ELSE TJ= ZMN2-ZMN1 Z= TJ*X(1)+ZMN1 OMZ= 1.D0-Z ENDIF ALZ= ALE+LOG(OMZ*OMZ/Z)-AL4 ALZ2= ALZ*ALZ ALES= ALE*ALE ZS= Z*Z OPZS= 1.D0+ZS PZ= OPZS/OMZ RLZ= LOG(Z) EPSM= -1.D-37 DLZ= TRSPENCE(OMZ,EPSM) RAD1= RINFL*(0.5D0*ALZ2-Z2)+R0L*ALZ+R1L RAD2= RINFL*(2.D0*ALZ-3.D0)+2.D0*R0L RAD3= ZS/OMZ*(0.5D0*RLZ*RLZ+DLZ)+RLZ * RADE(I)= PZ*RAD1-OMZ*RAD2-RINFL*RAD3 RADE(I)= API2/3.D0*RADE(I) DO JFL=1,NFL K= 4*(I-1)+JFL F(K)= TJ*RADE(I)*TBORNN(JFL,Z) ENDDO ENDDO * RETURN END * *-----FUNSUBMU------------------------------------------- * SUBROUTINE TFUBMU(NDIM,X,NFN,F) IMPLICIT REAL*8(A-H,O-Z) * PARAMETER(NFL=4) * DIMENSION X(NDIM),F(NFN),RADMU(2) * COMMON/TCLOGS/ALE,ALMU,ALPI COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TMOMENTS/AL4,RINFL,R0L,R1L COMMON/TDELTAS/DEI,DMUI,DPII,ZMN1,ZMN2 * DO I=1,2 IF(I.EQ.1) THEN TJ= (1.D0-DMUI)**2-ZMN2 Z= TJ*X(1)+ZMN2 OMZ= (1.D0-ZMN2)*(1.D0-X(1))+DMUI*(2.D0-DMUI)*X(1) ELSE TJ= ZMN2-ZMN1 Z= TJ*X(1)+ZMN1 OMZ= 1.D0-Z ENDIF ALZ= ALMU+LOG(OMZ*OMZ/Z)-AL4 ALZ2= ALZ*ALZ ZS= Z*Z OPZS= 1.D0+ZS PZ= OPZS/OMZ RLZ= LOG(Z) EPSM= -1.D-37 DLZ= TRSPENCE(OMZ,EPSM) RAD1= RINFL*(0.5D0*ALZ2-Z2)+R0L*ALZ+R1L RAD2= RINFL*(2.D0*ALZ-3.D0)+2.D0*R0L RAD3= ZS/OMZ*(0.5D0*RLZ*RLZ+DLZ)+RLZ * RADMU(I)= PZ*RAD1-OMZ*RAD2-RINFL*RAD3 RADMU(I)= API2/3.D0*RADMU(I) DO JFL=1,NFL K= 4*(I-1)+JFL F(K)= TJ*RADMU(I)*TBORNN(JFL,Z) ENDDO ENDDO * RETURN END * *-----FUNSUBHP------------------------------------------------- * SUBROUTINE TFUBHP(NDIM,X,NFN,F) IMPLICIT REAL*8(A-H,O-Z) * PARAMETER(NFL=4) * DIMENSION X(NDIM),F(NFN),RADH(2) * COMMON/TCLOGS/ALE,ALMU,ALPI COMMON/TMOMENTSH/RINFH,R0H,R1H COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TMOMENTS/AL4,RINFL,R0L,R1L COMMON/TDELTAS/DEI,DMUI,DPII,ZMN1,ZMN2 * DO I=1,2 IF(I.EQ.1) THEN TJ= (1.D0-DPII)**2-ZMN2 Z= TJ*X(1)+ZMN2 OMZ= (1.D0-ZMN2)*(1.D0-X(1))+DPII*(2.D0-DPII)*X(1) ELSE TJ= ZMN2-ZMN1 Z= TJ*X(1)+ZMN1 OMZ= 1.D0-Z ENDIF ALZ= ALPI+LOG(OMZ*OMZ/Z)-AL4 ALZ2= ALZ*ALZ ZS= Z*Z OPZS= 1.D0+ZS PZ= OPZS/OMZ RLZ= LOG(Z) EPSM= -1.D-37 DLZ= TRSPENCE(OMZ,EPSM) RAD1= RINFH*(0.5D0*ALZ2-Z2)+R0H*ALZ+R1H RAD2= RINFH*(2.D0*ALZ-3.D0)+2.D0*R0H RAD3= ZS/OMZ*(0.5D0*RLZ*RLZ+DLZ)+RLZ * RADH(I)= PZ*RAD1-OMZ*RAD2-RINFH*RAD3 RADH(I)= API2/3.D0*RADH(I) DO JFL=1,NFL K= 4*(I-1)+JFL F(K)= TJ*RADH(I)*TBORNN(JFL,Z) ENDDO ENDDO * RETURN END * *-----BORNN--------------------------------------------------------- * REAL*8 FUNCTION TBORNN(JFL,Z) IMPLICIT REAL*8 (A-H,I,O-P,R-Z) IMPLICIT REAL*16(Q) REAL*8 NM,MM,NM2,MM2 * COMMON/TCME/RS COMMON/TNAL/ODA COMMON/TPC/ZPCUT COMMON/TICOUPLING/NF COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * S= RS*RS * CF= ALPHA/(0.743635313782749D-2-0.410825034114194D-4* # LOG(0.315676857855315D1/S)+0.325766572488072D-6* # S/TQM2)-ODA CFS= ALPHA/(0.743635313782749D-2-0.410825034114194D-4* # LOG(0.315676857855315D1/Z/S)+0.325766572488072D-6* # Z*S/TQM2)-ODA ALH= ALPHA/CF ALHS= ALPHA/CFS ALH2= ALH*ALH ALHS2= ALHS*ALHS * DPT= 2.D0/3.D0 DMT= -1.D0/2.D0 G2= GWEAK*RHO G4= G2*G2 ZM= SQRT(ZM2) * IF(JFL.EQ.1) THEN FM= MM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= ACMM CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(2) ERHO= RHOEFF(2) EVI= VIM(2) EAI= AIM(2) ELSE IF(JFL.EQ.2) THEN FM= UQM FI3= ZIU BQF= BQUQ BQFD= BQDQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORU+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(4) ERHO= RHOEFF(4) EVI= VIM(4) EAI= AIM(4) ELSE IF(JFL.EQ.3) THEN FM= DQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORD+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(5) ERHO= RHOEFF(5) EVI= VIM(5) EAI= AIM(5) ELSE IF(JFL.EQ.4) THEN FM= BQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCMB ACORQ= ACORB+ODQCD ACM= ACMB CORAQCD= CAQCDB CORAM= CAMB ENDIF * BQF2= BQF*BQF TQF= 2.D0*BQF SMZM2= S-ZM2 SMZM2X= Z*S-ZM2 ZWD= S/ZM*ZW DENS= SMZM2*SMZM2+ZWD*ZWD RCHI= SMZM2/DENS ICHI= -ZWD/DENS ICHIZ= -ZM*ZW/DENS CHI2= S/DENS CHI2Z= ZM2/DENS ZWDX= Z*S/ZM*ZW DENSX= SMZM2X*SMZM2X+ZWDX*ZWDX RCHIX= SMZM2X/DENSX ICHIX= -ZWDX/DENSX CHI2X= Z*S/DENSX * RVE= -0.5D0+2.D0*STH2 ERVE= -0.5D0+2.D0*ST2EFF(1) RVF= FI3-TQF*STH2 ERVF= FI3-TQF*EST2 RVAE= RVE*RVE+0.25D0 RVETVF= RVE*RVF ERVETVF= ERVE*ERVF ERVAE= ERVE*ERVE+0.25D0 RARC= ALH*RCHI RARCX= ALHS*RCHIX * IF(JFL.EQ.4) THEN SVV= 64.D0*G4*CHI2/ALH2*RVAE*RVF*RVF*DPT SEE= 64.D0*4.D0*PIS*BQF2*DPT/S SEV= -64.D0*4.D0*PI*G2*BQF*RARC/ALH2*RVETVF*DPT SAA= 16.D0*G4*CHI2/ALH2*RVAE*DPT SVA= 128.D0*FI3*G2/ALH2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT * SVVX= 64.D0*G4*CHI2X/ALHS2*RVAE*RVF*RVF*DPT SEEX= 64.D0*4.D0*PIS*BQF2*DPT/(Z*S) SEVX= -64.D0*4.D0*PI*G2*BQF*RARCX/ALHS2*RVETVF*DPT SAAX= 16.D0*G4*CHI2X/ALHS2*RVAE*DPT SVAX= 128.D0*FI3*G2/ALHS2*(G2*CHI2X*RVETVF-PI*BQF*RARCX)*DMT ELSE EG2= GWEAK*SQRT(RHOEFF(1)*ERHO) EG4= EG2*EG2 SVVZ= 64.D0*EG4*CHI2Z/ALH2*ERVAE*(ERVF*ERVF+EVI*EVI)*DPT SAAZ= 64.D0*EG4*CHI2Z/ALH2*ERVAE*(0.25D0+EAI*EAI)*DPT SVAZ= 128.D0*FI3*EG4*CHI2Z/ALH2*ERVETVF*DMT SVV= SVVZ+64.D0*G4/ALH2*(CHI2-CHI2Z)*RVAE*RVF*RVF*DPT SEE= 256.D0*PIS*BQF2*DPT/S SEV= -64.D0*4.D0*PI*G2/ALH2*BQF*RARC*RVETVF*DPT SAA= SAAZ+16.D0*G4/ALH2*(CHI2-CHI2Z)*RVAE*DPT SVA= SVAZ+128.D0*FI3*G2/ALH2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT- # 128.D0*FI3*G4/ALH2*CHI2Z*RVETVF*DMT * SVVX= SVVZ+64.D0*G4/ALHS2*(CHI2X-CHI2Z)*RVAE*RVF*RVF*DPT SEEX= 256.D0*PIS*BQF2*DPT/(Z*S) SEVX= -64.D0*4.D0*PI*G2/ALHS2*BQF*RARCX*RVETVF*DPT SAAX= SAAZ+16.D0*G4/ALHS2*(CHI2X-CHI2Z)*RVAE*DPT SVAX= SVAZ+128.D0*FI3*G2/ALHS2*(G2*CHI2X*RVETVF-PI*BQF*RARCX)* # DMT-128.D0*FI3*G4/ALHS2*CHI2Z*RVETVF*DMT ENDIF SLO= SVV+SEE+SEV+SAA SVVT= SVV+SEE+SEV SLOX= SVVX+SEEX+SEVX+SAAX SVVTX= SVVX+SEEX+SEVX GSF= ALHS*ALHS/ALH/ALH * CQEDFPB= 3.D0*ALH/(4.D0*PI)*BQF2 CQEDFPBX= 3.D0*ALHS/(4.D0*PI)*BQF2 * SINGVV= -0.5D0-2.D0/3.D0*STH2 SINGEE= 1.D0/3.D0 SCAL= RS CALL TCORRQCD(SCAL) ALS3= (ALSR/PI)**3 IF(JFL.GT.1) THEN VCORVV= VCOR-0.41318D0*ALS3*SINGVV/RVF VCOREE= VCOR-0.41318D0*ALS3*SINGEE/BQF VCOREV= VCOR-0.41318D0*ALS3*0.5D0*(SINGVV/RVF+SINGEE/BQF) ELSE VCORVV= 0.D0 VCOREE= 0.D0 VCOREV= 0.D0 ENDIF W1S= SVV*VCORVV+SEE*VCOREE+SEV*VCOREV+SVVT*VCM+ # SAA*(ACORQ+ACM)+(1.D0+CQEDFPB)*SLO * SCALX= SQRT(Z)*RS CALL TCORRQCD(SCALX) ALSX3= (ALSR/PI)**3 IF(JFL.GT.1) THEN VCORVVX= VCOR-0.41318D0*ALSX3*SINGVV/RVF VCOREEX= VCOR-0.41318D0*ALSX3*SINGEE/BQF VCOREVX= VCOR-0.41318D0*ALSX3*0.5D0*(SINGVV/RVF+SINGEE/BQF) ELSE VCORVVX= 0.D0 VCOREEX= 0.D0 VCOREVX= 0.D0 ENDIF W1ZS= SVVX*VCORVVX+SEEX*VCOREEX+SEVX*VCOREVX+SVVTX*VCM+ # SAAX*(ACORQ+ACM)+(1.D0+CQEDFPBX)*SLOX * TBORNN= GSF*W1ZS/W1S * RETURN END * *-----IFINT----------------------------------------------------------- * SUBROUTINE TIFINT(K,KP,J,RS,TH,S0,ZW,DELTAF,DELTAB) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM2,NM2 CHARACTER*1 OF,OIFAIL * PARAMETER (MNRS=30,NL=3) * PARAMETER (NDIM=1,NDIMH=2,NFN=2,NFNH=2,IRCLS=2**NDIMH+ # 2*NDIMH*NDIMH+2*NDIMH+1,MNCLS=0,MXCLS=5000*IRCLS, # LENWRK0=6*NDIMH+9*NFN+(NDIMH+NFN+2)*(1+ # MXCLS/IRCLS),LENWRK=100*LENWRK0) * DIMENSION XL(NDIM),XU(NDIM),XLH(NDIMH),XUH(NDIMH), # AESTFB(NFN),FESTFB(NFN),WRKSTR(LENWRK), # AESTFBH(NFNH),FESTFBH(NFNH), # AESTFBHR(NFNH),FESTFBHR(NFNH) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFUBS,TFUBH,TFUBHR * COMMON/TOF/OF COMMON/TNAL/ODA COMMON/TAL/ALPHAR COMMON/TIFL/OIFAIL COMMON/TECUTS/EE0(NL) COMMON/TICOUPLING/NF COMMON/TIFIR/ACOL,E,FM2 COMMON/TAFJTR/ALST,ALSTZ COMMON/TPARAM/PI,PIS,DELTA COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEWPAR/WT,S,HSS,OMS0,CAE,CVE,CAF,CVF,OQF,FCC COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEXPCUTS/THMINR(NL),THMAXR(NL),THMINPR(NL),THMAXPR(NL), # S0CUT(NL,MNRS),ACOLLR(NL) * S= RS*RS WT= ZW ZM= SQRT(ZM2) HSS= 1.D-3 S2W= STH2 SW= SQRT(S2W) CW= SQRT(1.D0-S2W) SW2= 2.D0*SW*CW * CAE= -0.5D0/SW2 CVE= -CAE*(4.D0*S2W-1.D0) IF(K.EQ.1) THEN CAF= -0.5D0/SW2 CVF= -CAF*(4.D0*S2W-1.D0) OQF= -1.D0 FCC= 1.D0 ACOL= ACOLLR(J) E= S0 YT= (1.D0-SIN(ACOL/2.D0))/(1.D0+SIN(ACOL/2.D0)) OMS0= 1.D0-YT IF(J.EQ.1) THEN FM2= EM2 OF= 'E' ELSE IF(J.EQ.2) THEN FM2= MM2 OF= 'R' ELSE IF(J.EQ.3) THEN FM2= TLM2 OF= 'R' ENDIF ELSE IF(K.EQ.0) THEN OMS0= 1.D0-S0 IF(KP.EQ.1) THEN CAF= -0.5D0/SW2 CVF= -CAF*(4.D0*S2W-1.D0) OQF= -1.D0 FCC= 1.D0 ELSE IF(KP.EQ.0) THEN IF(J.LE.2) THEN CAF= -0.5D0/SW2 CVF= -CAF*(4.D0*S2W-1.D0) OQF= -1.D0 FCC= 1.D0 ELSE IF(J.EQ.3) THEN CAF= 0.5D0/SW2 CVF= -CAF*(8.D0/3.D0*S2W-1.D0) OQF= 2.D0/3.D0 FCC= 3.D0 ELSE IF(J.EQ.4) THEN CAF= -0.5D0/SW2 CVF= -CAF*(4.D0/3.D0*S2W-1.D0) OQF= -1.D0/3.D0 FCC= 3.D0 ENDIF ENDIF ELSE IF(K.EQ.2) THEN OMS0= 1.D0-S0 IF(J.LE.3) THEN CAF= -0.5D0/SW2 CVF= -CAF*(4.D0*S2W-1.D0) OQF= -1.D0 FCC= 1.D0 ELSE IF(J.EQ.4) THEN CAF= 0.5D0/SW2 CVF= -CAF*(8.D0/3.D0*S2W-1.D0) OQF= 2.D0/3.D0 FCC= 3.D0 ELSE IF(J.EQ.5) THEN CAF= -0.5D0/SW2 CVF= -CAF*(4.D0/3.D0*S2W-1.D0) OQF= -1.D0/3.D0 FCC= 3.D0 ENDIF ENDIF * IF(RS.LT.10.D0) THEN JX= 1 ELSE IF(RS.GT.10.D0.AND.RS.LT.30.D0) THEN JX= 2 ELSE IF(RS.GT.30.D0.AND.RS.LT.50.D0) THEN JX= 3 ELSE IF(RS.GT.50.D0.AND.RS.LT.70.D0) THEN JX= 4 ELSE IF(RS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) ALPHAR= ALPHA/CFACT * DTR= PI/180.D0 IF(TH.EQ.0.D0) THEN THC= 1.D-4 ELSE THC= TH ENDIF THMIN= THC*DTR CM= COS(THMIN) * *-----ONE-DIM. FORWARD/BACKWARD INTEGRATION OF THE SOFT CONTRIBUTION * DO I= 1,NDIM XL(I)= 0.D0 XU(I)= CM ENDDO * MULFAC= 2**NDIM * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-4 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBS,AEQ,REQ, # LENWRK,WRKSTR,FESTFB,AESTFB,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY IFINT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * FI= FESTFB(1) BI= FESTFB(2) * *-----TWO-DIM. FORWARD/BACKWARD INTEGRATION OF THE HARD CONTRIBUTION * XLH(1)= 0.D0 XUH(1)= 1.D0 XLH(2)= 0.D0 XUH(2)= CM * MULFAC= 2**NDIMH * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-4 60 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIMH,XLH,XUH,MINCLS,MAXCLS,NFNH,TFUBH,AEQ, # REQ,LENWRK,WRKSTR,FESTFBH,AESTFBH,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY IFINT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 60 ENDIF * FH= FESTFBH(1) BH= FESTFBH(2) * *-----TWO-DIM. FORWARD/BACKWARD INTEGRATION OF THE HARD CONTRIBUTION * WITH CUTS * IF(K.EQ.1) THEN XLH(1)= 0.D0 XUH(1)= 1.D0 XLH(2)= 0.D0 XUH(2)= CM * MULFAC= 2**NDIMH * MINCLS= MNCLS MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-2 70 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIMH,XLH,XUH,MINCLS,MAXCLS,NFNH,TFUBHR,AEQ, # REQ,LENWRK,WRKSTR,FESTFBHR,AESTFBHR,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY IFINT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 70 ENDIF * FH= FH+FESTFBHR(2) BH= BH+FESTFBHR(1) ENDIF * FT= FI+FH BT= BI+BH DELTAF= CONV*FT DELTAB= CONV*BT * RETURN END * *-----FUNSUBS------------------------------------------------------- *-----SOFT+VIRTUAL I-F STATE INTERFERENCE * SUBROUTINE TFUBS(NDIM,X,NFN,F) IMPLICIT REAL*8 (A-H,O,P,R-Z) IMPLICIT REAL*16(Q) * COMMON/TAL/ALPHAR COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEWPAR/WT,S,HSS,OMS0,CAE,CVE,CAF,CVF,OQF,FCC * DIMENSION X(NDIM),F(NFN) DIMENSION QA1(2),QL1(2),QA2(2),QL2(2),QA3(2),QL3(2), # QA4(2),QL4(2),QA8(2),QL8(2),QA9(2),QL9(2), # QA10(2),QL10(2),QA11(2),QL11(2),QA0(2),QL0(2), # QA6(2),QL6(2),QA13(2),QL13(2),QAS(2),QLS(2) * EPSM= -1.D-37 QCV= 1.D15*1.Q-15 * HSS2= HSS*HSS S2= S*S ZM= SQRT(ZM2) RZM= ZM/SQRT(S) RZM2= ZM2/S OMRZM2= 1.D0-RZM2 ALPHAR2= ALPHAR*ALPHAR WT2= WT*WT SMZM2= S-ZM2 WTR= S/ZM2*WT WTR2= WTR*WTR RGZ= WT/SQRT(S) Z2= SMZM2*SMZM2+ZM2*WTR2 PR2= S2/Z2 PRR= S*SMZM2/Z2 PRI= S*WTR*ZM/Z2 QEPS2= QEPS*QEPS QZM= ZM/SQRT(S)*QCV QZM2= ZM2/S*QCV QZM2M1= QZM2-1.Q0 QOMZM2= 1.Q0-QZM2 QGZ= WT/SQRT(S)*QCV QGZ2= WT2/S*QCV QGZM2= QGZ2*QZM2 QZPG2= QZM2+QGZ2 QGZM= QZM*QGZ QGOZM= QGZ/QZM QDEN= QOMZM2**2+QGZM2 AEXP= ALPHA/PI * DO IF=1,2 IF(IF.EQ.1) THEN C= X(1) ELSE IF(IF.EQ.2) THEN C= -X(1) ENDIF C2= C*C T= (1.D0-C)/2.D0 U= (1.D0+C)/2.D0 OMT= 1.D0-T OMU= 1.D0-U OMT2= OMT*OMT OMU2= OMU*OMU QT= T*QCV QU= U*QCV QZM2MT= QZM2-QT QZM2MU= QZM2-QU QHSS= HSS*QCV QHSS2= QHSS*QHSS BINT= 2.D0*LOG(T/U) EL= LOG(HSS) TLN= LOG(T) ULN= LOG(U) TLN2= TLN*TLN ULN2= ULN*ULN TSP= TRSPENCE(T,EPSM) USP= TRSPENCE(U,EPSM) XF= TLN2-2.D0*TSP-ULN2+2.D0*USP * QA0(1)= (QZM2-1.Q0+QHSS)/((QZM2-1.Q0+QHSS)**2+QGZM2) QA0(2)= QGZM/((QZM2-1.Q0+QHSS)**2+QGZM2) CALL TCQLNX(QA0,QL0) GIR= -2.D0*OQF*BINT*EL GIRIR= -OQF*BINT*(2.D0*EL+QL0(1)) GIRII= -OQF*BINT*QL0(2) GIRR= -2.D0*OQF*BINT*(EL+QL0(1)) * QAS(1)= QZM2 QAS(2)= QGZM CALL TCQLNX(QAS,QLS) QA1(1)= -QT/(1.Q0+QEPS2) QA1(2)= QT*QEPS/(1.Q0+QEPS2) CALL TCQLNX(QA1,QL1) QA2(1)= -QT*QOMZM2/QDEN QA2(2)= QT*QGZM/QDEN CALL TCQLNX(QA2,QL2) QA3(1)= 1.Q0-1.Q0/QZPG2 QA3(2)= -QGOZM/QZPG2 CALL TCQLNX(QA3,QL3) QA4(1)= (QZM2M1*QZM2MT+QGZM2)/(QZM2MT**2+QGZM2) QA4(2)= QGZM*(QT-1.Q0)/(QZM2MT**2+QGZM2) CALL TCQLNX(QA4,QL4) QA5R= 1.Q0/QZPG2 QA5I= QGOZM/QZPG2 QOMA5R= 1.Q0-QA5R CALL TSPENCE(QA5R,QA5I,QOMA5R,QS1R,QS1I) QA6R= QT/QZPG2 QA6I= QT*QGOZM/QZPG2 QOMA6R= 1.Q0-QA6R CALL TSPENCE(QA6R,QA6I,QOMA6R,QS2R,QS2I) QA6(1)= QA6R QA6(2)= QA6I CALL TCQLNX(QA6,QL6) QA7R= 1.Q0-QZM2/QT QA7I= QGZM/QT QOMA7R= QZM2/QT CALL TSPENCE(QA7R,QA7I,QOMA7R,QS3R,QS3I) * QA8(1)= -QU/(1.Q0+QEPS2) QA8(2)= QU*QEPS/(1.Q0+QEPS2) CALL TCQLNX(QA8,QL8) QA9(1)= -QU*QOMZM2/QDEN QA9(2)= QU*QGZM/QDEN CALL TCQLNX(QA9,QL9) QA10(1)= 1.Q0-1.Q0/QZPG2 QA10(2)= -QGOZM/QZPG2 CALL TCQLNX(QA10,QL10) QA11(1)= (QZM2M1*QZM2MU+QGZM2)/(QZM2MU**2+QGZM2) QA11(2)= QGZM*(QU-1.Q0)/(QZM2MU**2+QGZM2) CALL TCQLNX(QA11,QL11) QA12R= 1.Q0/QZPG2 QA12I= QGOZM/QZPG2 QOMA12R= 1.Q0-QA12R CALL TSPENCE(QA12R,QA12I,QOMA12R,QS4R,QS4I) QA13R= QU/QZPG2 QA13I= QU*QGOZM/QZPG2 QOMA13R= 1.Q0-QA13R CALL TSPENCE(QA13R,QA13I,QOMA13R,QS5R,QS5I) QA13(1)= QA13R QA13(2)= QA13I CALL TCQLNX(QA13,QL13) QA14R= 1.Q0-QZM2/QU QA14I= QGZM/QU QOMA14R= QZM2/QU CALL TSPENCE(QA14R,QA14I,QOMA14R,QS6R,QS6I) * GTR= 0.5D0/OMT*QL1(1)-0.25D0*(1.D0-2.D0*T)/OMT2* # (QL1(1)*QL1(1)-QL1(2)*QL1(2)+PIS) GUR= 0.5D0/OMU*QL8(1)-0.25D0*(1.D0-2.D0*U)/OMU2* # (QL8(1)*QL8(1)-QL8(2)*QL8(2)+PIS) GTI= 0.5D0/OMT*QL1(2)-0.25D0*(1.D0-2.D0*T)/OMT2* # 2.Q0*QL1(1)*QL1(2) GUI= 0.5D0/OMU*QL8(2)-0.25D0*(1.D0-2.D0*U)/OMU2* # 2.Q0*QL8(1)*QL8(2) ATR0= 1.D0/OMT*(QL2(1)+RZM2*QL3(1)+RZM*RGZ*QL3(2)+ # (1.D0-2.D0*T+RZM2)/OMT*(QL6(1)*QL4(1)-QL6(2)*QL4(2)+ # QS1R-QS2R)+RZM*RGZ/OMT*(QL6(1)*QL4(2)+QL6(2)*QL4(1)+ # QS1I-QS2I)) ATI0= 1.D0/OMT*(QL2(2)+RZM2*QL3(2)-RZM*RGZ*QL3(1)+ # (1.D0-2.D0*T+RZM2)/OMT*(QL6(1)*QL4(2)+QL6(2)*QL4(1)+ # QS1I-QS2I)-RZM*RGZ/OMT*(QL6(1)*QL4(1)-QL6(2)*QL4(2)+ # QS1R-QS2R)) ATR= OMRZM2*ATR0-RZM*RGZ*ATI0 ATI= OMRZM2*ATI0+RZM*RGZ*ATR0 AUR0= 1.D0/OMU*(QL9(1)+RZM2*QL10(1)+RZM*RGZ*QL10(2)+ # (1.D0-2.D0*U+RZM2)/OMU*(QL13(1)*QL11(1)-QL13(2)*QL11(2)+ # QS4R-QS5R)+RZM*RGZ/OMU*(QL13(1)*QL11(2)+QL13(2)*QL11(1)+ # QS4I-QS5I)) AUI0= 1.D0/OMU*(QL9(2)+RZM2*QL10(2)-RZM*RGZ*QL10(1)+ # (1.D0-2.D0*U+RZM2)/OMU*(QL13(1)*QL11(2)+QL13(2)*QL11(1)+ # QS4I-QS5I)-RZM*RGZ/OMU*(QL13(1)*QL11(1)-QL13(2)*QL11(2)+ # QS4R-QS5R)) AUR= OMRZM2*AUR0-RZM*RGZ*AUI0 AUI= OMRZM2*AUI0+RZM*RGZ*AUR0 VTR= ATR+2.D0*QS3R VUR= AUR+2.D0*QS6R VTI= ATI+2.D0*QS3I VUI= AUI+2.D0*QS6I * VGGR= GTR-GUR VGGI= GTI-GUI+PI*BINT AGGR= GTR+GUR AGGI= GTI+GUI VGZR= VTR-VUR+BINT*QLS(1) VGZI= VTI-VUI+BINT*QLS(2) AGZR= ATR+AUR AGZI= ATI+AUI * C11V= GIR-OQF*(XF+VGGR) GIR= -2.D0*OQF*BINT*EL C11A= -OQF*AGGR C12VR= GIRIR-OQF*(XF+0.5D0*(VGGR+VGZR)) C12VI= -GIRII-0.5D0*OQF*(VGGI-VGZI) C12AR= -0.5D0*OQF*(AGGR+AGZR) C12AI= -0.5D0*OQF*(AGGI-AGZI) C22V= GIRR-OQF*(XF+VGZR) C22A= -OQF*AGZR * OQFS= OQF*OQF CV2= CVE*CVF CA2= CAE*CAF CG2= (CVE*CVE+CAE*CAE)*(CVF*CVF+CAF*CAF) * G1= OQFS*C11V-2.D0*OQF*PRR*(CV2*C12VR+CA2*C12AR)+ # 2.D0*OQF*PRI*(CV2*C12VI+CA2*C12AI)+PR2*(CG2*C22V+ # 4.D0*CVE*CVF*CAE*CAF*C22A) * G3= OQFS*C11A-2.D0*OQF*PRR*(CA2*C12VR+CV2*C12AR)+ # 2.D0*OQF*PRI*(CA2*C12VI+CV2*C12AI)+PR2*(4.D0*CVE*CVF* # CAE*CAF*C22V+CG2*C22A) * F(IF)= 0.5D0*FCC*PI*AEXP*ALPHAR2/S*(G1*(1.D0+C2)+2.D0*G3*C) * ENDDO RETURN END * *-----FUNSUBH-------------------------------------------------------- *-----HARD I-F STATE INTERFERENCE SPECTRUM * SUBROUTINE TFUBH(NDIMH,X,NFNH,F) IMPLICIT REAL*8(A-H,O-Z) * DIMENSION X(NDIMH),F(NFNH) * COMMON/TAL/ALPHAR COMMON/TICOUPLING/NF COMMON/TPARAM/PI,PIS,DELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEWPAR/WT,S,HSS,OMS0,CAE,CVE,CAF,CVF,OQF,FCC * OQFS= OQF*OQF CP= CVE*CVF+CAE*CAF CM= CVE*CVF-CAE*CAF CP2= (CVE*CVE+CAE*CAE)*(CVF*CVF+CAF*CAF) CM2T= CP2-4.D0*CVE*CVF*CAE*CAF CM2U= CP2+4.D0*CVE*CVF*CAE*CAF ZM= SQRT(ZM2) RLL= LOG(HSS) RLU= LOG(OMS0) RJAC= RLU-RLL X1= EXP(RJAC*X(1)+RLL) SP= (1.D0-X1)*S WT2= WT*WT WTR= S/ZM2*WT WTR2= WTR*WTR WTRP= SP/ZM2*WT WTRP2= WTRP*WTRP SMZM2= S-ZM2 SPMZM2= SP-ZM2 Z2= SMZM2*SMZM2+ZM2*WTR2 Z2P= SPMZM2*SPMZM2+ZM2*WTRP2 CSSP= OQFS-OQF*(S*SMZM2/Z2+SP*SPMZM2/Z2P)*CM+ # (S*SP*(SMZM2*SPMZM2+ZM2*WTR*WTRP)*CM2T)/Z2/Z2P DSSP= OQFS-OQF*(S*SMZM2/Z2+SP*SPMZM2/Z2P)*CP+ # (S*SP*(SMZM2*SPMZM2+ZM2*WTR*WTRP)*CM2U)/Z2/Z2P ALPHAR2= ALPHAR*ALPHAR ALPHA3= ALPHAR2*ALPHA * DO IF=1,2 IF(IF.EQ.1) THEN C= X(2) ELSE IF(IF.EQ.2) THEN C= -X(2) ENDIF C2= C*C TTP2= 0.5D0*(1.D0+C2)-C UUP2= 0.5D0*(1.D0+C2)+C ANF= LOG((1.D0+C)/(1.D0-C)) DSH= 2.D0*OQF*FCC*ALPHA3/S*(CSSP*TTP2+DSSP*UUP2)* # (1.D0-0.5D0*X1)*ANF F(IF)= RJAC*DSH ENDDO * RETURN END * *------------------------------------------------------------------------- * SUBROUTINE TFUBHR(NDIMH,X,NFNH,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM2,NM2 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OF * DIMENSION X(NDIMH),F(NFNH) * COMMON/TOF/OF COMMON/TNAL/ODA COMMON/TAL/ALPHAR COMMON/TICOUPLING/NF COMMON/TIFIR/ACOL,E,FM2 COMMON/TAFJTR/ALST,ALSTZ COMMON/TPARAM/PI,PIS,DELTA COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEWPAR/WT,S,HSS,OMS0,CAE,CVE,CAF,CVF,OQF,FCC COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 * DIMENSION AMP(2,3),RJAC(3) * VG= SQRT(STH2) VGS= VG*VG VGQ= VGS*VGS V= -0.5D0+2.D0*STH2 VP= (V+0.5D0)/SQRT(CTH2) VM= (V-0.5D0)/SQRT(CTH2) VPM= VP*VM VPM2= VP*VP+VM*VM VPM4= VP**4+VM**4 VPMS= VPM*VPM VGSPM= VGS*VPM VGSPM2= VGS*VPM2 * R= 2.D0/(1.D0+COS(ACOL)) R2= R*R OMR= 1.D0-R YT= (1.D0-SIN(ACOL/2.D0))/(1.D0+SIN(ACOL/2.D0)) OME= 1.D0-E RLOME= LOG(OME) X2A= YT X2B= E X2C= E*OME/(R-E) RFM2= FM2/S GLCS= WT*WT/ZM2 GLC= SQRT(GLCS) RDZR= -(1.D0-ZM2/S)/((1.D0-ZM2/S)**2+GLCS) DZRI= GLC/((1.D0-ZM2/S)**2+GLCS) * DO IS=1,3 RJAC(IS)= 0.D0 DO IF=1,2 AMP(IF,IS)= 0.D0 ENDDO ENDDO * IF(OF.EQ.'E') THEN IF(OTHRE.EQ.'E') THEN ISST= 1 ELSE ISST= 2 ENDIF ELSE IF(OF.EQ.'R') THEN IF(OTHRMT.EQ.'E') THEN ISST= 1 ELSE ISST= 2 ENDIF ENDIF * DO IF=1,2 IF(IF.EQ.1) THEN CT= X(2) ELSE IF(IF.EQ.2) THEN CT= -X(2) ENDIF CT2= CT*CT OPCT= 1.D0+CT OMCT= 1.D0-CT ST2= 1.D0-CT2 ST= SQRT(ST2) EPS2= 4.D0*EM2/S*ST2 EPS= SQRT(EPS2) T0= -0.5D0*(1.D0-CT) T0S= T0*T0 T0C= T0S*T0 T0Q= T0C*T0 U0= -0.5D0*(1.D0+CT) U0S= U0*U0 U0C= U0S*U0 U0Q= U0C*U0 * DO IS=1,3,ISST IF(IS.EQ.1) THEN X2= (X2A-X2B)*X(1)+X2B RJAC(1)= X2A-X2B RLNR= LOG(RFM2/X2) RLNL= -LOG(RFM2/X2) ELSE IF(IS.EQ.2) THEN X2= (X2B-X2C)*X(1)+X2C RJAC(2)= X2B-X2C RLNR= LOG((E-X2)/OME) RLNL= -LOG((E-X2)/OME) ELSE IF(IS.EQ.3) THEN IF(ISST.EQ.1) THEN X2= (X2A-X2C)*X(1)+X2C OPX2= 1.D0+X2 RJAC(3)= X2A-X2C ELSE IF(ISST.EQ.2) THEN X2= (X2A-X2B)*X(1)+X2B OPX2= 1.D0+X2 RJAC(3)= X2A-X2B ENDIF ARG= X2*X2+2.D0*(1.D0-2.D0*R)*X2+1.D0 X1M= 0.5D0*(OPX2-SQRT(ARG)) X1P= 0.5D0*(OPX2+SQRT(ARG)) RLNR= LOG((1.D0-X1P)/(1.D0-X1M)) RLNL= LOG((X1P-X2)/(X1M-X2)) OMX1M= 1.D0-X1M OMX1P= 1.D0-X1P RLOMX1M= LOG(ABS(OMX1M)) RLOMX1P= LOG(ABS(OMX1P)) X1MMX2= X1M-X2 X1PMX2= X1P-X2 RLX1MMX2= LOG(ABS(X1MMX2)) RLX1PMX2= LOG(ABS(X1PMX2)) ABMX1M= AM*X1M+BM ABMX1P= AM*X1P+BM ABPX1M= AP*X1M+BP ABPX1P= AP*X1P+BP AABMX1M= ABS(ABMX1M) AABMX1P= ABS(ABMX1P) AABPX1M= ABS(ABPX1M) AABPX1P= ABS(ABPX1P) RLABMX1M= LOG(AABMX1M) RLABMX1P= LOG(AABMX1P) RLABPX1M= LOG(AABPX1M) RLABPX1P= LOG(AABPX1P) ENDIF * RS= SQRT(X2*S) IF(RS.LT.10.D0) THEN JX= 1 ELSE IF(RS.GT.10.D0.AND.RS.LT.30.D0) THEN JX= 2 ELSE IF(RS.GT.30.D0.AND.RS.LT.50.D0) THEN JX= 3 ELSE IF(RS.GT.50.D0.AND.RS.LT.70.D0) THEN JX= 4 ELSE IF(RS.GT.70.D0) THEN JX= 5 ENDIF SP= X2*S CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/SP)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*SP/TQM2 CFACT= 1.D0-(CFACT+ODA) ALPHARP= ALPHA/CFACT * X2S= X2*X2 X2T= X2S*X2 X2Q= X2T*X2 X2I= 1.D0/X2 OMX2= 1.D0-X2 RDZL= -(X2-ZM2/S)/((X2-ZM2/S)**2+X2S*GLCS) DZLI= X2*GLC/((X2-ZM2/S)**2+X2S*GLCS) RDZLR= RDZL*RDZR+DZLI*DZRI RLOMX2= LOG(OMX2) RLSF= LOG(RFM2*OMX2/X2) OMEX2= 1.D0-E+X2 EMX2= E-X2 RLEMX2= LOG(ABS(EMX2)) AM= OPCT+OMCT*X2 AMC= AM**3 AMF= AM**5 BM= -2.D0*X2 AP= OMCT+OPCT*X2 APC= AP**3 APF= AP**5 BP= -2.D0*X2 ABME= AM*E+BM ABPE= AP*E+BP AABME= ABS(ABME) AABPE= ABS(ABPE) RLABME= LOG(AABME) RLABPE= LOG(AABPE) ABMEE= AM*OMEX2+BM ABPEE= AP*OMEX2+BP AABMEE= ABS(ABMEE) AABPEE= ABS(ABPEE) RLABMEE= LOG(AABMEE) RLABPEE= LOG(AABPEE) ZSM= -BM/AM ZSP= -BP/AP Z0= 2.D0*X2*OMX2 Z0S= Z0*Z0 AMZ= AM/Z0 APZ= AP/Z0 AS= Z0*EPS/2.D0 RLAS= LOG(AS) ABM= AM+BM ABP= AP+BP AABM= ABS(ABM) AABP= ABS(ABP) RLABM= LOG(AABM) RLABP= LOG(AABP) ABXM= AM*X2+BM ABXP= AP*X2+BP AABXM= ABS(ABXM) AABXP= ABS(ABXP) RLABXM= LOG(AABXM) RLABXP= LOG(AABXP) ASM= 2.D0*AMZ/EPS ASP= 2.D0*APZ/EPS RLASM= LOG(ASM) RLASP= LOG(ASP) IF(IS.EQ.1) THEN R1UL= 1.D0-RFM2*OMX2/X2 R1LL= X2+RFM2*OMX2/X2 IF(R1UL.GT.ZSM) THEN SMU= +1.D0 ELSE SMU= -1.D0 ENDIF IF(R1LL.GT.ZSM) THEN SMD= +1.D0 ELSE SMD= -1.D0 ENDIF IF(R1UL.GT.ZSP) THEN SPU= +1.D0 ELSE SPU= -1.D0 ENDIF IF(R1LL.GT.ZSP) THEN SPD= +1.D0 ELSE SPD= -1.D0 ENDIF RKM0= -SMD*(RLASM+RLABXM)+SMU*(RLASM+RLABM) RKM0= RKM0/AM RKP0= -SPD*(RLASP+RLABXP)+SPU*(RLASP+RLABP) RKP0= RKP0/AP RKM1= ZSM*RKM0+Z0/AMC*AMZ*(AABM-AABXM) RKP1= ZSP*RKP0+Z0/APC*APZ*(AABP-AABXP) RKM2= ZSM*ZSM*RKM0 RKM2= RKM2+2.D0*Z0*ZSM/AMC*AMZ*(AABM-AABXM) RKP2= ZSP*ZSP*RKP0 RKP2= RKP2+2.D0*Z0*ZSP/APC*APZ*(AABP-AABXP) IF(X2.GT.ZSM) THEN RKM2= RKM2-Z0S/AMF/2.D0*(AMZ*AABXM)**2 ELSE RKM2= RKM2+Z0S/AMF/2.D0*(AMZ*AABXM)**2 ENDIF IF(1.D0.GT.ZSM) THEN RKM2= RKM2+Z0S/AMF/2.D0*(AMZ*AABM)**2 ELSE RKM2= RKM2-Z0S/AMF/2.D0*(AMZ*AABM)**2 ENDIF IF(X2.GT.ZSP) THEN RKP2= RKP2-Z0S/APF/2.D0*(APZ*AABXP)**2 ELSE RKP2= RKP2+Z0S/APF/2.D0*(APZ*AABXP)**2 ENDIF IF(1.D0.GT.ZSP) THEN RKP2= RKP2+Z0S/APF/2.D0*(APZ*AABP)**2 ELSE RKP2= RKP2-Z0S/APF/2.D0*(APZ*AABP)**2 ENDIF RHMR= -1.D0/ABM*(-SMD*(-RLAS+RLABXM+RLABM-RLOMX2)+ # SMU*(-RLAS+2.D0*RLABM-RLSF)) RHPR= -1.D0/ABP*(-SPD*(-RLAS+RLABXP+RLABP-RLOMX2)+ # SPU*(-RLAS+2.D0*RLABP-RLSF)) RHML= -1.D0/ABXM*(-SMD*(-RLAS+2.D0*RLABXM-RLSF)+ # SMU*(-RLAS+RLABM+RLABXM-RLOMX2)) RHPL= -1.D0/ABXP*(-SPD*(-RLAS+2.D0*RLABXP-RLSF)+ # SPU*(-RLAS+RLABP+RLABXP-RLOMX2)) SRF= OMX2 ELSE IF(IS.EQ.2) THEN IF(OMEX2.GT.ZSM) THEN SMU= +1.D0 ELSE SMU= -1.D0 ENDIF IF(E.GT.ZSM) THEN SMD= +1.D0 ELSE SMD= -1.D0 ENDIF IF(OMEX2.GT.ZSP) THEN SPU= +1.D0 ELSE SPU= -1.D0 ENDIF IF(E.GT.ZSP) THEN SPD= +1.D0 ELSE SPD= -1.D0 ENDIF RKM0= -SMD*(RLASM+RLABME)+SMU*(RLASM+RLABMEE) RKM0= RKM0/AM RKP0= -SPD*(RLASP+RLABPE)+SPU*(RLASP+RLABPEE) RKP0= RKP0/AP RKM1= ZSM*RKM0+Z0/AMC*AMZ*(AABMEE-AABME) RKP1= ZSP*RKP0+Z0/APC*APZ*(AABPEE-AABPE) RKM2= ZSM*ZSM*RKM0 RKM2= RKM2+2.D0*Z0*ZSM/AMC*AMZ*(AABMEE-AABME) RKP2= ZSP*ZSP*RKP0 RKP2= RKP2+2.D0*Z0*ZSP/APC*APZ*(AABPEE-AABPE) IF(E.GT.ZSM) THEN RKM2= RKM2-Z0S/AMF/2.D0*(AMZ*AABME)**2 ELSE RKM2= RKM2+Z0S/AMF/2.D0*(AMZ*AABME)**2 ENDIF IF(OMEX2.GT.ZSM) THEN RKM2= RKM2+Z0S/AMF/2.D0*(AMZ*AABMEE)**2 ELSE RKM2= RKM2-Z0S/AMF/2.D0*(AMZ*AABMEE)**2 ENDIF IF(E.GT.ZSP) THEN RKP2= RKP2-Z0S/APF/2.D0*(APZ*AABPE)**2 ELSE RKP2= RKP2+Z0S/APF/2.D0*(APZ*AABPE)**2 ENDIF IF(OMEX2.GT.ZSP) THEN RKP2= RKP2+Z0S/APF/2.D0*(APZ*AABPEE)**2 ELSE RKP2= RKP2-Z0S/APF/2.D0*(APZ*AABPEE)**2 ENDIF * RHMR= -1.D0/ABM*(-SMD*(-RLAS+RLABME+RLABM-RLOME)+ # SMU*(-RLAS+RLABMEE+RLABM-RLEMX2)) RHPR= -1.D0/ABP*(-SPD*(-RLAS+RLABPE+RLABP-RLOME)+ # SPU*(-RLAS+RLABPEE+RLABP-RLEMX2)) RHML= -1.D0/ABXM*(-SMD*(-RLAS+RLABME+RLABXM-RLEMX2)+ # SMU*(-RLAS+RLABMEE+RLABXM-RLOME)) RHPL= -1.D0/ABXP*(-SPD*(-RLAS+RLABPE+RLABXP-RLEMX2)+ # SPU*(-RLAS+RLABPEE+RLABXP-RLOME)) SRF= 1.D0-2.D0*E+X2 ELSE IF(IS.EQ.3) THEN IF(X1P.GT.ZSM) THEN SMU= +1.D0 ELSE SMU= -1.D0 ENDIF IF(X1M.GT.ZSM) THEN SMD= +1.D0 ELSE SMD= -1.D0 ENDIF IF(X1P.GT.ZSP) THEN SPU= +1.D0 ELSE SPU= -1.D0 ENDIF IF(X1M.GT.ZSP) THEN SPD= +1.D0 ELSE SPD= -1.D0 ENDIF RKM0= -SMD*(RLASM+RLABMX1M)+SMU*(RLASM+RLABMX1P) RKM0= RKM0/AM RKP0= -SPD*(RLASP+RLABPX1M)+SPU*(RLASP+RLABPX1P) RKP0= RKP0/AP RKM1= ZSM*RKM0+Z0/AMC*AMZ*(AABMX1P-AABMX1M) RKP1= ZSP*RKP0+Z0/APC*APZ*(AABPX1P-AABPX1M) RKM2= ZSM*ZSM*RKM0 RKM2= RKM2+2.D0*Z0*ZSM/AMC*AMZ*(AABMX1P-AABMX1M) RKP2= ZSP*ZSP*RKP0 RKP2= RKP2+2.D0*Z0*ZSP/APC*APZ*(AABPX1P-AABPX1M) IF(X1M.GT.ZSM) THEN RKM2= RKM2-Z0S/AMF/2.D0*(AMZ*AABMX1M)**2 ELSE RKM2= RKM2+Z0S/AMF/2.D0*(AMZ*AABMX1M)**2 ENDIF IF(X1P.GT.ZSM) THEN RKM2= RKM2+Z0S/AMF/2.D0*(AMZ*AABMX1P)**2 ELSE RKM2= RKM2-Z0S/AMF/2.D0*(AMZ*AABMX1P)**2 ENDIF IF(X1M.GT.ZSP) THEN RKP2= RKP2-Z0S/APF/2.D0*(APZ*AABPX1M)**2 ELSE RKP2= RKP2+Z0S/APF/2.D0*(APZ*AABPX1M)**2 ENDIF IF(X1P.GT.ZSP) THEN RKP2= RKP2+Z0S/APF/2.D0*(APZ*AABPX1P)**2 ELSE RKP2= RKP2-Z0S/APF/2.D0*(APZ*AABPX1P)**2 ENDIF RHMR= -1.D0/ABM*(-SMD*(-RLAS+RLABMX1M+RLABM-RLOMX1M)+ # SMU*(-RLAS+RLABMX1P+RLABM-RLOMX1P)) RHPR= -1.D0/ABP*(-SPD*(-RLAS+RLABPX1M+RLABP-RLOMX1M)+ # SPU*(-RLAS+RLABPX1P+RLABP-RLOMX1P)) RHML= -1.D0/ABXM*(-SMD*(-RLAS+RLABMX1M+RLABXM-RLX1MMX2)+ # SMU*(-RLAS+RLABMX1P+RLABXM-RLX1PMX2)) RHPL= -1.D0/ABXP*(-SPD*(-RLAS+RLABPX1M+RLABXP-RLX1MMX2)+ # SPU*(-RLAS+RLABPX1P+RLABXP-RLX1PMX2)) SRF= X1P-X1M ENDIF * RIM= VGQ*RHMR*(-128*X2I*U0S-256*X2I*U0C-128*U0-128*U0S) RIM= RIM+VGQ*RHML*(-128*X2S*U0-128*X2S*U0S+512*X2T* # U0+640*X2T*U0S+256*X2T*U0C+128*X2T) RIM= RIM+VGQ*RKM0*(-128*X2*U0-128*X2*U0S-128*X2I* # U0S-256*X2I*U0C+512*X2S*U0+640*X2S*U0S+256*X2S*U0C+ # 128*X2S-128*U0-128*U0S) RIM= RIM+VGQ*RKM1*(512*X2*U0+640*X2*U0S+256*X2*U0C+ # 128*X2-128*X2I*U0S-256*X2I*U0C-256*U0-256*U0S) RIM= RIM+VGQ*RKM2*(-256*X2I*U0S-256*X2I*U0C+256*U0 # +512*U0S+256*U0C) RIM= RIM+VPM4*RDZLR*RHMR*(-4*X2*U0-4*X2*U0S-4*U0S # -4*U0C) RIM= RIM+VPM4*RDZLR*RHML*(12*X2Q*U0+12*X2Q*U0S+4*X2Q* # U0C+4*X2Q) RIM= RIM+VPM4*RDZLR*RKM0*(-4*X2*U0-4*X2*U0S+12*X2T* # U0+12*X2T*U0S+4*X2T*U0C+4*X2T-4*U0S-4*U0C) RIM= RIM+VPM4*RDZLR*RKM1*(-4*X2*U0-4*X2*U0S+12*X2S* # U0+12*X2S*U0S+4*X2S*U0C+4*X2S-4*U0S-4*U0C) RIM= RIM+VPM4*RDZLR*RKM2*(4*X2*U0+8*X2*U0S+4*X2*U0C # -4*U0S-4*U0C) RIM= RIM+VPMS*RDZLR*RHMR*(-8*U0C) RIM= RIM+VPMS*RDZLR*RHML*(-8*X2T*U0-8*X2T*U0S+8*X2Q # *U0+16*X2Q*U0S+8*X2Q*U0C) RIM= RIM+VPMS*RDZLR*RKM0*(-8*X2S*U0-8*X2S*U0S+8*X2T # *U0+16*X2T*U0S+8*X2T*U0C-8*U0C) RIM= RIM+VPMS*RDZLR*RKM1*(-8*X2*U0-8*X2*U0S+8*X2S* # U0+16*X2S*U0S+8*X2S*U0C-8*U0C) RIM= RIM+VPMS*RDZLR*RKM2*(8*X2*U0+16*X2*U0S+8*X2*U0C # -8*U0S-8*U0C) RIM= RIM+VGSPM*RDZL*RHMR*(32*U0C) RIM= RIM+VGSPM*RDZL*RHML*(32*X2T*U0+32*X2T*U0S-32*X2Q # *U0-64*X2Q*U0S-32*X2Q*U0C) RIM= RIM+VGSPM*RDZL*RKM0*(32*X2S*U0+32*X2S*U0S-32*X2T # *U0-64*X2T*U0S-32*X2T*U0C+32*U0C) RIM= RIM+VGSPM*RDZL*RKM1*(32*X2*U0+32*X2*U0S-32*X2S* # U0-64*X2S*U0S-32*X2S*U0C+32*U0C) RIM= RIM+VGSPM*RDZL*RKM2*(-32*X2*U0-64*X2*U0S-32*X2 # *U0C+32*U0S+32*U0C) RIM= RIM+VGSPM*RDZR*RHMR*(32*X2I*U0C) RIM= RIM+VGSPM*RDZR*RHML*(32*X2S*U0+32*X2S*U0S-32*X2T # *U0-64*X2T*U0S-32*X2T*U0C) RIM= RIM+VGSPM*RDZR*RKM0*(32*X2*U0+32*X2*U0S+32*X2I* # U0C-32*X2S*U0-64*X2S*U0S-32*X2S*U0C) RIM= RIM+VGSPM*RDZR*RKM1*(-32*X2*U0-64*X2*U0S-32*X2 # *U0C+32*X2I*U0C+32*U0+32*U0S) RIM= RIM+VGSPM*RDZR*RKM2*(32*X2I*U0S+32*X2I*U0C-32*U0 # -64*U0S-32*U0C) RIM= RIM+VGSPM2*RDZL*RHMR*(16*X2*U0+16*X2*U0S+16*U0S # +16*U0C) RIM= RIM+VGSPM2*RDZL*RHML*(-48*X2Q*U0-48*X2Q*U0S-16 # *X2Q*U0C-16*X2Q) RIM= RIM+VGSPM2*RDZL*RKM0*(16*X2*U0+16*X2*U0S-48*X2T* # U0-48*X2T*U0S-16*X2T*U0C-16*X2T+16*U0S+16*U0C) RIM= RIM+VGSPM2*RDZL*RKM1*(16*X2*U0+16*X2*U0S-48*X2S* # U0-48*X2S*U0S-16*X2S*U0C-16*X2S+16*U0S+16*U0C) RIM= RIM+VGSPM2*RDZL*RKM2*(-16*X2*U0-32*X2*U0S-16* # X2*U0C+16*U0S+16*U0C) RIM= RIM+VGSPM2*RDZR*RHMR*(16*X2I*U0S+16*X2I*U0C+16* # U0+16*U0S) RIM= RIM+VGSPM2*RDZR*RHML*(-48*X2T*U0-48*X2T*U0S-16 # *X2T*U0C-16*X2T) RIM= RIM+VGSPM2*RDZR*RKM0*(16*X2I*U0S+16*X2I*U0C-48* # X2S*U0-48*X2S*U0S-16*X2S*U0C-16*X2S+16*U0+16*U0S) RIM= RIM+VGSPM2*RDZR*RKM1*(-48*X2*U0-48*X2*U0S-16* # X2*U0C-16*X2+16*X2I*U0S+16*X2I*U0C+16*U0+16*U0S) RIM= RIM+VGSPM2*RDZR*RKM2*(16*X2I*U0S+16*X2I*U0C-16* # U0-32*U0S-16*U0C) * RIP= VGQ*RHPR*(128*X2I*T0S+256*X2I*T0C+128*T0+128*T0S) RIP= RIP+VGQ*RHPL*(128*X2S*T0+128*X2S*T0S-512*X2T*T0 # -640*X2T*T0S-256*X2T*T0C-128*X2T) RIP= RIP+VGQ*RKP0*(128*X2*T0+128*X2*T0S+128*X2I*T0S # +256*X2I*T0C-512*X2S*T0-640*X2S*T0S-256*X2S*T0C-128 # *X2S+128*T0+128*T0S) RIP= RIP+VGQ*RKP1*(-512*X2*T0-640*X2*T0S-256*X2*T0C # -128*X2+128*X2I*T0S+256*X2I*T0C+256*T0+256*T0S) RIP= RIP+VGQ*RKP2*(256*X2I*T0S+256*X2I*T0C-256*T0- # 512*T0S-256*T0C) RIP= RIP+VPM4*RDZLR*RHPR*(4*T0C) RIP= RIP+VPM4*RDZLR*RHPL*(4*X2T*T0+4*X2T*T0S-4*X2Q*T0 # -8*X2Q*T0S-4*X2Q*T0C) RIP= RIP+VPM4*RDZLR*RKP0*(4*X2S*T0+4*X2S*T0S-4*X2T*T0 # -8*X2T*T0S-4*X2T*T0C+4*T0C) RIP= RIP+VPM4*RDZLR*RKP1*(4*X2*T0+4*X2*T0S-4*X2S*T0 # -8*X2S*T0S-4*X2S*T0C+4*T0C) RIP= RIP+VPM4*RDZLR*RKP2*(-4*X2*T0-8*X2*T0S-4*X2* # T0C+4*T0S+4*T0C) RIP= RIP+VPMS*RDZLR*RHPR*(8*X2*T0+8*X2*T0S+8*T0S+8* # T0C) RIP= RIP+VPMS*RDZLR*RHPL*(-24*X2Q*T0-24*X2Q*T0S-8* # X2Q*T0C-8*X2Q) RIP= RIP+VPMS*RDZLR*RKP0*(8*X2*T0+8*X2*T0S-24*X2T*T0 # -24*X2T*T0S-8*X2T*T0C-8*X2T+8*T0S+8*T0C) RIP= RIP+VPMS*RDZLR*RKP1*(8*X2*T0+8*X2*T0S-24*X2S*T0 # -24*X2S*T0S-8*X2S*T0C-8*X2S+8*T0S+8*T0C) RIP= RIP+VPMS*RDZLR*RKP2*(-8*X2*T0-16*X2*T0S-8*X2* # T0C+8*T0S+8*T0C) RIP= RIP+VGSPM*RDZL*RHPR*(-32*X2*T0-32*X2*T0S-32* # T0S-32*T0C) RIP= RIP+VGSPM*RDZL*RHPL*(96*X2Q*T0+96*X2Q*T0S+32*X2Q # *T0C+32*X2Q) RIP= RIP+VGSPM*RDZL*RKP0*(-32*X2*T0-32*X2*T0S+96* # X2T*T0+96*X2T*T0S+32*X2T*T0C+32*X2T-32*T0S-32*T0C) RIP= RIP+VGSPM*RDZL*RKP1*(-32*X2*T0-32*X2*T0S+96* # X2S*T0+96*X2S*T0S+32*X2S*T0C+32*X2S-32*T0S-32*T0C) RIP= RIP+VGSPM*RDZL*RKP2*(32*X2*T0+64*X2*T0S+32*X2* # T0C-32*T0S-32*T0C) RIP= RIP+VGSPM*RDZR*RHPR*(-32*X2I*T0S-32*X2I*T0C-32 # *T0-32*T0S) RIP= RIP+VGSPM*RDZR*RHPL*(96*X2T*T0+96*X2T*T0S+32*X2T # *T0C+32*X2T) RIP= RIP+VGSPM*RDZR*RKP0*(-32*X2I*T0S-32*X2I*T0C+96 # *X2S*T0+96*X2S*T0S+32*X2S*T0C+32*X2S-32*T0-32*T0S) RIP= RIP+VGSPM*RDZR*RKP1*(96*X2*T0+96*X2*T0S+32*X2* # T0C+32*X2-32*X2I*T0S-32*X2I*T0C-32*T0-32*T0S) RIP= RIP+VGSPM*RDZR*RKP2*(-32*X2I*T0S-32*X2I*T0C+32 # *T0+64*T0S+32*T0C) RIP= RIP+VGSPM2*RDZL*RHPR*(-16*T0C) RIP= RIP+VGSPM2*RDZL*RHPL*(-16*X2T*T0-16*X2T*T0S+16 # *X2Q*T0+32*X2Q*T0S+16*X2Q*T0C) RIP= RIP+VGSPM2*RDZL*RKP0*(-16*X2S*T0-16*X2S*T0S+16 # *X2T*T0+32*X2T*T0S+16*X2T*T0C-16*T0C) RIP= RIP+VGSPM2*RDZL*RKP1*(-16*X2*T0-16*X2*T0S+16* # X2S*T0+32*X2S*T0S+16*X2S*T0C-16*T0C) RIP= RIP+VGSPM2*RDZL*RKP2*(16*X2*T0+32*X2*T0S+16*X2* # T0C-16*T0S-16*T0C) RIP= RIP+VGSPM2*RDZR*RHPR*(-16*X2I*T0C) RIP= RIP+VGSPM2*RDZR*RHPL*(-16*X2S*T0-16*X2S*T0S+16 # *X2T*T0+32*X2T*T0S+16*X2T*T0C) RIP= RIP+VGSPM2*RDZR*RKP0*(-16*X2*T0-16*X2*T0S-16* # X2I*T0C+16*X2S*T0+32*X2S*T0S+16*X2S*T0C) RIP= RIP+VGSPM2*RDZR*RKP1*(16*X2*T0+32*X2*T0S+16*X2* # T0C-16*X2I*T0C-16*T0-16*T0S) RIP= RIP+VGSPM2*RDZR*RKP2*(-16*X2I*T0S-16*X2I*T0C+ # 16*T0+32*T0S+16*T0C) * RI0= VGQ*RLNR*(-128*X2I*T0-64*X2I) RI0= RI0+VGQ*RLNL*(-128*X2*T0-64*X2) RI0= RI0+VGQ*SRF*(-64-128*X2I*T0-64*X2I-128*T0) RI0= RI0+VPM4*RDZLR*RLNR*(-2*T0) RI0= RI0+VPM4*RDZLR*RLNL*(-2*X2S*T0) RI0= RI0+VPM4*RDZLR*SRF*(-2*X2*T0-2*T0) RI0= RI0+VPMS*RDZLR*RLNR*(-4-4*T0) RI0= RI0+VPMS*RDZLR*RLNL*(-4*X2S*T0-4*X2S) RI0= RI0+VPMS*RDZLR*SRF*(-4-4*X2*T0-4*X2-4*T0) RI0= RI0+VGSPM*RDZL*RLNR*(16+16*T0) RI0= RI0+VGSPM*RDZL*RLNL*(16*X2S*T0+16*X2S) RI0= RI0+VGSPM*RDZL*SRF*(16+16*X2*T0+16*X2+16*T0) RI0= RI0+VGSPM*RDZR*RLNR*(16*X2I*T0+16*X2I) RI0= RI0+VGSPM*RDZR*RLNL*(16*X2*T0+16*X2) RI0= RI0+VGSPM*RDZR*SRF*(16+16*X2I*T0+16*X2I+16*T0) RI0= RI0+VGSPM2*RDZL*RLNR*(8*T0) RI0= RI0+VGSPM2*RDZL*RLNL*(8*X2S*T0) RI0= RI0+VGSPM2*RDZL*SRF*(8*X2*T0+8*T0) RI0= RI0+VGSPM2*RDZR*RLNR*(8*X2I*T0) RI0= RI0+VGSPM2*RDZR*RLNL*(8*X2*T0) RI0= RI0+VGSPM2*RDZR*SRF*(8*X2I*T0+8*T0) * AMP(IF,IS)= -0.5D0*(RIM+RIP+RI0) ENDDO FACT= ALPHA*ALPHAR*ALPHARP/32.D0/STH4/S F(IF)= FACT*(RJAC(1)*AMP(IF,1)+RJAC(2)*AMP(IF,2)- # RJAC(3)*AMP(IF,3)) ENDDO * RETURN END * *-----DFF-------------------------------------------------------- * COMPUTES THE ONE-LOOP FOUR-POINT FORM FACTORS /I*PI^2 * D0,D11,...,D13,D21,...,D27 * ACCORDING TO THE CONVENTION * * (Q^2+M1^2)((Q+P1+P2)^2+M3^2)((Q+P1)^2+M2^2)((Q+P1+P2+P3)^2+M4^2) * * (P1+P2)^2=T (P2+P3)^2=S P2+P3 ---> P1+P4 * (T+M1^2+M3^2)^2 > 4*M1^2*M3^2 * INPUT PARAMETERS ARE S,T,M1^2,M2^2,M3^2,M4^2; PI2=P2^2=P3^2 * PF2=P1^2=P4^2 * IA1 = 1,2 SELECTS THE SIGN IN A1 * IAL = 1,2 SELECTS THE SIGN IN ALPHA * * !!! FOR THIS ROUTINE TO BE USED ALL MASSES MUST BE REAL !!! * SUBROUTINE TDFF(IA1,IAL,PI2,PF2,S,T,RM12,RM22,RM32,RM42, # D0,D1,D2) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION TMP0(2),TMP1(2,3),TMP27(2),TMP2_145(2,3) DIMENSION TMP2_426(2,3),TMP2_563(2,3) DIMENSION R3_563(2,3),R3_145(2,3),R3_426(2,3) DIMENSION C0_124(2),C1_124(2,2),C2_124(2,4) DIMENSION C0_123(2),C1_123(2,2),C2_123(2,4) DIMENSION C0_134(2),C1_134(2,2),C2_134(2,4) DIMENSION C0_234(2),C1_234(2,2),C2_234(2,4) DIMENSION XM3I(3,3),R2(2,3) DIMENSION D0(2),D1(2,3),D2(2,7) DIMENSION UC0(2),UC1(2,2),UC2(2,4) DIMENSION VC0(2),VC1(2,2),VC2(2,4) * KFLAG= 1 * P212= T P213= PF2 P214= PF2 P223= PI2 P224= PI2 P234= S RL12= T+RM12+RM32 RL34= S+RM22+RM42 PIM32= PI2+RM32 PFM12= PF2+RM12 RL13= PFM12+RM22 RL14= PFM12+RM42 RL23= PIM32+RM22 RL24= PIM32+RM42 * * A2 IS FIXED TO 1 * A2= 1.Q0 TM= -T CALL TALPHA(RM12,RM32,TM,AP,AM,OMAP,OMAM) * IF(IA1.EQ.1) THEN A1= AP*A2 ELSE IF(IA1.EQ.2) THEN A1= AM*A2 ELSE PRINT*,' IA1 > 2' ENDIF ANUM= RM32*A2*A2-RM12*A1*A1 A3= ANUM/(RL23*A2-RL13*A1) A4= ANUM/(RL24*A2-RL14*A1) * * TRASFORMED MOMENTA AND MASSES * Q213= (-RM12*A1+RL13*A3)*A1-RM22*A3*A3 Q214= (-RM12*A1+RL14*A4)*A1-RM42*A4*A4 Q223= Q213 Q224= Q214 Q234= (-RM42*A4+RL34*A3)*A4-RM22*A3*A3 CM12= RM12*A1*A1 CM22= RM32*A2*A2 CM32= RM22*A3*A3 CM42= RM42*A4*A4 RA= -Q234 RB= -Q223 RC= -Q224+Q223+Q234 RD= CM32-CM42+Q234 RE= CM22-CM32+Q224-Q234 RK= CM12-CM22 RAA= CM32-CM42-Q234 RBB= CM22-CM32+Q223 RCC= CM12-CM32+Q223 RDD= CM12-CM32+Q224-Q234 REE= CM32-CM42+Q223-Q224 RFF= CM22-CM32-Q223 RGG= CM12-CM32-Q223 RHH= CM22-CM42+Q224 RII= CM22-CM42+Q223-Q234 RLL= CM22-CM42-Q224 RMM= CM12-CM42+Q214 RNN= CM12-CM42+Q223-Q234 ROO= CM12-CM42-Q224 * DISC= (Q234-2.Q0*(Q224+Q223))*Q234+(Q224-Q223)*(Q224-Q223) * IF(DISC.LT.0.Q0) THEN IF(A1.LT.0.Q0.OR.A2.LT.0.Q0.OR.A3.LT.0.Q0. # OR.A4.LT.0.Q0) THEN PRINT*,' WHILE COMPUTING D0 ALPHA IS COMPLEX AND ' PRINT*,' THE A_I ARE NOT ALL POSITIVE ' STOP ELSE U12= -RB U22= -RA US= -(RA+RB+RC) UM12= RA+RB+RC+RD+RE+CM42 UM22= RA+RD+CM42 UM32= CM42 CALL TCFF(KFLAG,U12,U22,US,UM12,UM22,UM32,UC0,UC1,UC2) V12= -RB V22= -RA VS= -(RA+RB+RC) VM12= RA+RB+RC+RD+RE+RK+CM42 VM22= RA+RD+CM42 VM32= CM42 CALL TCFF(KFLAG,V12,V22,VS,VM12,VM22,VM32,VC0,VC1,VC2) TMP0(1)= A1*A2*A3*A4/RK*(UC0(1)-VC0(1)) TMP0(2)= A1*A2*A3*A4/RK*(UC0(2)-VC0(2)) ENDIF ELSE CALL TALPHA(Q223,Q234,Q224,AL1,AL2,OMAL1,OMAL2) IF(IAL.EQ.1) THEN ALP= AL1 OMALP= OMAL1 DEN= SQRT(DISC) ELSE IF(IAL.EQ.2) THEN ALP= AL2 OMALP= OMAL2 DEN= -SQRT(DISC) ELSE PRINT*,'IAL > 2' STOP ENDIF IF(ABS(OMALP).LT.1.Q-10) THEN OOALP= 1.Q0 DO K=1,10 OOALP= OOALP*OMALP+1.Q0 ENDDO Y0I= -(RHH-RE*OMALP)/DEN Y1I= -(RII-RBB*OMALP)/DEN OMY1I= (RLL-RFF*OMALP)/DEN Y0II= -(RMM-RDD*OMALP)/DEN Y1II= -(RNN-RCC*OMALP)/DEN OMY1II= (ROO-RGG*OMALP)/DEN ELSE OOALP= 1.Q0/ALP Y0I= -(RD+RE*ALP)/DEN Y1I= -(RAA+RBB*ALP)/DEN OMY1I= (REE+RFF*ALP)/DEN Y0II= -(RD+RDD*ALP)/DEN Y1II= -(RAA+RCC*ALP)/DEN OMY1II= (REE+RGG*ALP)/DEN ENDIF Y2I= Y0I/OMALP OMY2I= OMY1I/OMALP Y3I= -Y0I*OOALP OMY3I= Y1I*OOALP Y2II= Y0II/OMALP OMY2II= OMY1II/OMALP Y3II= -Y0II*OOALP OMY3II= Y1II*OOALP CALL TROOTS(Q223,CM32,CM22,RP1R,RP1I,RM1R,RM1I, # OMRP1R,OMRM1R) CALL TROOTS(Q224,CM42,CM22,RP2R,RP2I,RM2R,RM2I, # OMRP2R,OMRM2R) CALL TROOTS(Q234,CM42,CM32,RP3R,RP3I,RM3R,RM3I, # OMRP3R,OMRM3R) CALL TROOTS(Q214,CM42,CM12,RP4R,RP4I,RM4R,RM4I, # OMRP4R,OMRM4R) CALL TROOTS(Q213,CM32,CM12,RP5R,RP5I,RM5R,RM5I, # OMRP5R,OMRM5R) AA1= -Q223 AA2= -Q224 AA3= -Q234 AA4= -Q214 AA5= -Q213 YIM= 0.Q0 EB1R= -1.Q0+(CM32-CM22)/Q223 EB1I= 0.Q0 EC1I= QEPS/Q223 EB2R= -1.Q0+(CM42-CM22)/Q224 EB2I= 0.Q0 EC2I= QEPS/Q224 EB3R= -1.Q0+(CM42-CM32)/Q234 EB3I= 0.Q0 EC3I= QEPS/Q234 EB4R= -1.Q0+(CM42-CM12)/Q214 EB4I= 0.Q0 EC4I= QEPS/Q214 EB5R= -1.Q0+(CM32-CM12)/Q213 EB5I= 0.Q0 EC5I= QEPS/Q213 CALL TS2(Y1I,YIM,OMY1I,AA1,EB1R,EB1I,EC1I,RP1R,RP1I,RM1R,RM1I, # OMRP1R,OMRM1R,S2I1R,S2I1I) CALL TS2(Y2I,YIM,OMY2I,AA2,EB2R,EB2I,EC2I,RP2R,RP2I,RM2R,RM2I, # OMRP2R,OMRM2R,S2I2R,S2I2I) CALL TS2(Y3I,YIM,OMY3I,AA3,EB3R,EB3I,EC3I,RP3R,RP3I,RM3R,RM3I, # OMRP3R,OMRM3R,S2I3R,S2I3I) CALL TS2(Y1II,YIM,OMY1II,AA5,EB5R,EB5I,EC5I,RP5R,RP5I,RM5R,RM5I, # OMRP5R,OMRM5R,S2II1R,S2II1I) CALL TS2(Y2II,YIM,OMY2II,AA4,EB4R,EB4I,EC4I,RP4R,RP4I,RM4R,RM4I, # OMRP4R,OMRM4R,S2II2R,S2II2I) CALL TS2(Y3II,YIM,OMY3II,AA3,EB3R,EB3I,EC3I,RP3R,RP3I,RM3R,RM3I, # OMRP3R,OMRM3R,S2II3R,S2II3I) * * S2INFTY AND SEXTRA ARE CALLED ONLY IF SOME OF THE A'S * ARE NEGATIVE * IF(A2*A4.LT.0.Q0) THEN CALL TS2INFTY(Q224,CM42,CM22,Y2I,R124R,R124I) ELSE R124R= 0.Q0 R124I= 0.Q0 ENDIF * IF(A3*A4.LT.0.Q0) THEN CALL TS2INFTY(Q234,CM42,CM32,Y3I,R234R,R234I) ELSE R234R= 0.Q0 R234I= 0.Q0 ENDIF * IF(A2*A3.LT.0.Q0) THEN CALL TS2INFTY(Q223,CM32,CM22,Y1I,R323R,R323I) ELSE R323R= 0.Q0 R323I= 0.Q0 ENDIF * IF(A1*A4.LT.0.Q0) THEN CALL TS2INFTY(Q214,CM42,CM12,Y2II,R414R,R414I) ELSE R414R= 0.Q0 R414I= 0.Q0 ENDIF * IF(A3*A4.LT.0.Q0) THEN CALL TS2INFTY(Q234,CM42,CM32,Y3II,R534R,R534I) ELSE R534R= 0.Q0 R534I= 0.Q0 ENDIF * IF(A1*A3.LT.0.Q0) THEN CALL TS2INFTY(Q213,CM32,CM12,Y1II,R613R,R613I) ELSE R613R= 0.Q0 R613I= 0.Q0 ENDIF * IF(A1*A2.LT.0.Q0) THEN CALL TSEXTRA(A3,A4,Q234,Q224,Q223,SR,SI) ARGE= A1/A2-0.5Q0*RL12/RM12 IF(ARGE.GT.0.Q0) THEN SIGN= +1.Q0 ELSE SIGN= -1.Q0 ENDIF ELSE SR= 0.Q0 SI= 0.Q0 SIGN= 1.Q0 ENDIF * * SCALAR 4-POINT FUNCTION D0 * TMP0(1)= A1*A2*A3*A4/RK*((S2I1R-S2I2R+S2I3R- # S2II1R+S2II2R-S2II3R-R124R+R234R+ # R323R+R414R-R534R- # R613R)/DEN+SIGN*SR) TMP0(2)= A1*A2*A3*A4/RK*((S2I1I-S2I2I+S2I3I- # S2II1I+S2II2I-S2II3I-R124I+R234I+ # R323I+R414I-R534I- # R613I)/DEN+SIGN*SI) ENDIF * F1= RM12-RM32-T F2= RM32-RM22+T-PF2 F3= RM22-RM42 S11= T S22= PI2 S33= S S12= -0.5Q0*(T+PI2-PF2) S13= 0.0Q0 S23= -0.5Q0*S DENX= S11*S22*S33+2.Q0*S12*S23*S13- # S22*S13*S13-S11*S23*S23-S33*S12*S12 XM3I(1,1)= (S22*S33-S23*S23)/DENX XM3I(1,2)= (S13*S23-S33*S12)/DENX XM3I(1,3)= (S12*S23-S13*S22)/DENX XM3I(2,1)= XM3I(1,2) XM3I(2,2)= (S11*S33-S13*S13)/DENX XM3I(2,3)= (S13*S12-S11*S23)/DENX XM3I(3,1)= XM3I(1,3) XM3I(3,2)= XM3I(2,3) XM3I(3,3)= (S11*S22-S12*S12)/DENX * CALL TCFF(KFLAG,PF2,PF2,S,RM22,RM12,RM42, # C0_134,C1_134,C2_134) CALL TCFF(KFLAG,PI2,PI2,S,RM22,RM32,RM42, # C0_234,C1_234,C2_234) CALL TCFF(KFLAG,PF2,PI2,T,RM12,RM42,RM32, # C0_124,C1_124,C2_124) CALL TCFF(KFLAG,PF2,PI2,T,RM12,RM22,RM32, # C0_123,C1_123,C2_123) DO I=1,2 R2(I,1)= 0.5Q0*(F1*TMP0(I)+C0_134(I)-C0_234(I)) R2(I,2)= 0.5Q0*(F2*TMP0(I)+C0_124(I)-C0_134(I)) R2(I,3)= 0.5Q0*(F3*TMP0(I)+C0_123(I)-C0_124(I)) ENDDO * * D1 FORMF FACTORS * CALL TMULTI3(TMP1,XM3I,R2) DO I=1,2 * * D2 FORMF FACTORS * TMP27(I)= -RM12*TMP0(I)-0.5Q0*(F1*TMP1(I,1)+F2*TMP1(I,2)+ # F3*TMP1(I,3)-C0_234(I)) ENDDO DO I=1,2 R3_145(I,1)= 0.5Q0*(F1*TMP1(I,1)+C1_134(I,2)-C1_134(I,1)- # C0_134(I)+C0_234(I))-TMP27(I) R3_145(I,2)= 0.5Q0*(F2*TMP1(I,1)+C1_124(I,1)-C1_134(I,2)+ # C1_134(I,1)+C0_134(I)) R3_145(I,3)= 0.5Q0*(F3*TMP1(I,1)+C1_123(I,1)-C1_124(I,1)) ENDDO CALL TMULTI3(TMP2_145,XM3I,R3_145) DO I=1,2 R3_426(I,1)= 0.5Q0*(F1*TMP1(I,2)+C1_134(I,2)-C1_134(I,1)- # C0_134(I)+C1_234(I,1)-C1_234(I,2)+C0_234(I)) R3_426(I,2)= 0.5Q0*(F2*TMP1(I,2)+C1_124(I,1)-C1_124(I,2)- # C1_134(I,2)+C1_134(I,1)+C0_134(I))-TMP27(I) R3_426(I,3)= 0.5Q0*(F3*TMP1(I,2)+C1_123(I,1)-C1_123(I,2)- # C1_124(I,1)+C1_124(I,2)) ENDDO CALL TMULTI3(TMP2_426,XM3I,R3_426) DO I=1,2 R3_563(I,1)= 0.5Q0*(F1*TMP1(I,3)+C1_134(I,2)-C1_234(I,2)) R3_563(I,2)= 0.5Q0*(F2*TMP1(I,3)+C1_124(I,1)-C1_124(I,2)- # C1_134(I,2)) R3_563(I,3)= 0.5Q0*(F3*TMP1(I,3)-C1_124(I,1)+C1_124(I,2))- # TMP27(I) ENDDO CALL TMULTI3(TMP2_563,XM3I,R3_563) * DO I=1,2 D0(I)= TMP0(I) D1(I,1)= TMP1(I,1) D1(I,2)= TMP1(I,2) D1(I,3)= TMP1(I,3) D2(I,7)= TMP27(I) D2(I,1)= TMP2_145(I,1) D2(I,4)= TMP2_145(I,2) D2(I,5)= TMP2_145(I,3) D2(I,2)= TMP2_426(I,2) D2(I,6)= TMP2_426(I,3) D2(I,3)= TMP2_563(I,3) ENDDO RETURN END * *-----TDFFS-------------------------------------------- SUBROUTINE TDFFS(S,T,RM12,RM22,RM32,RM42,D0,D1,D2) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION XM3I(3,3),R2(2,3) DIMENSION D0(2),D1(2,3),D2(2,7) DIMENSION SPR(2,2,4),SPI(2,2,4) DIMENSION TMP2_426(2,3),TMP2_563(2,3) DIMENSION C0_124(2),C1_124(2,2),C2_124(2,4) DIMENSION C0_123(2),C1_123(2,2),C2_123(2,4) DIMENSION C0_134(2),C1_134(2,2),C2_134(2,4) DIMENSION C0_234(2),C1_234(2,2),C2_234(2,4) DIMENSION R3_563(2,3),R3_145(2,3),R3_426(2,3) DIMENSION ARGR(2,2,4),ARGI(2,2,4),OMARGR(2,2,4) DIMENSION TMP0(2),TMP1(2,3),TMP27(2),TMP2_145(2,3) DIMENSION XR(4),XI(4),XBR(2),XBI(2),XDFR(2,4),XDFI(2,4) * IF(RM22.NE.RM42) THEN PRINT*,' WRONG SETUP FOR TDFFS' STOP ENDIF BQRS= 1.Q0+4.Q0*RM42/S BQIS= -4.Q0*QEPS/S BQM= SQRT(BQRS*BQRS+BQIS*BQIS) BQR= SQRT(0.5Q0*(BQM+BQRS)) IF((BQM-BQRS).GT.1.Q-90) THEN BQDF= BQM-BQRS ELSE BQDF= 0.5D0*BQIS*BQIS/BQRS ENDIF IF(BQIS.GT.0.Q0) THEN BQI= SQRT(0.5Q0*BQDF) ELSE BQI= -SQRT(0.5Q0*BQDF) ENDIF XR(1)= 0.5Q0*(1.Q0-BQR) XI(1)= -0.5Q0*BQI XR(2)= 0.5Q0*(1.Q0+BQR) XI(2)= 0.5Q0*BQI XR(4)= (T+RM12)/(T+RM12-RM42) XI(4)= -QEPS/(T+RM12-RM42) BX= 4.D0*T/S*(T+RM12-RM42) BD= T+RM12 BDS= BD*BD D4R= 1.Q0+BX/(BDS*BDS)*(RM42*BDS+2.Q0*BD*QEPS*QEPS) D4I= BX/(BDS*BDS)*(2.Q0*RM42*BD-BDS)*QEPS D4M= SQRT(D4R*D4R+D4I*D4I) SD4R= SQRT(0.5Q0*(D4M+D4R)) IF((D4M-D4R).GT.1.Q-90) THEN D4DF= D4M-D4R ELSE D4DF= 0.5D0*D4I*D4I/D4R ENDIF IF(D4I.GT.0.Q0) THEN SD4I= SQRT(0.5Q0*D4DF) ELSE SD4I= -SQRT(0.5Q0*D4DF) ENDIF XBR(1)= 0.5Q0*(XR(4)*(1.Q0-SD4R)+XI(4)*SD4I) XBR(2)= 0.5Q0*(XR(4)*(1.Q0+SD4R)-XI(4)*SD4I) XBI(1)= 0.5Q0*(-XR(4)*SD4I+XI(4)*(1.Q0-SD4R)) XBI(2)= 0.5Q0*(XR(4)*SD4I+XI(4)*(1.Q0+SD4R)) XR(3)= RM12/(RM12-RM42) XI(3)= -QEPS/(RM12-RM42) DO I=1,2 DO J=1,4 XDFR(I,J)= (XBR(I)-XR(J))/((XBR(I)-XR(J))**2+ # (XBI(I)-XI(J))**2) XDFI(I,J)= -(XBI(I)-XI(J))/((XBR(I)-XR(J))**2+ # (XBI(I)-XI(J))**2) ENDDO ENDDO DO I=1,2 DO L=1,2 DO J=1,4 IF(L.EQ.1) THEN ARGR(I,L,J)= XBR(I)*XDFR(I,J)-XBI(I)*XDFI(I,J) ARGI(I,L,J)= XBR(I)*XDFI(I,J)+XBI(I)*XDFR(I,J) ELSE IF(L.EQ.2) THEN ARGR(I,L,J)= (XBR(I)-1.Q0)*XDFR(I,J)-XBI(I)*XDFI(I,J) ARGI(I,L,J)= (XBR(I)-1.Q0)*XDFI(I,J)+XBI(I)*XDFR(I,J) ENDIF OMARGR(I,L,J)= 1.Q0-ARGR(I,L,J) ADR= ARGR(I,L,J) OMADR= OMARGR(I,L,J) ADI= ARGI(I,L,J) CALL TSPENCE(ADR,ADI,OMADR,SDR,SDI) SPR(I,L,J)= SDR SPI(I,L,J)= SDI ENDDO ENDDO ENDDO SUMR= 0.Q0 SUMI= 0.Q0 DO I=1,4 IF(I.EQ.3) THEN SUMR= SUMR-SPR(1,1,I)+SPR(2,1,I)+SPR(1,2,I)-SPR(2,2,I) SUMI= SUMI-SPI(1,1,I)+SPI(2,1,I)+SPI(1,2,I)-SPI(2,2,I) ELSE SUMR= SUMR+SPR(1,1,I)-SPR(2,1,I)-SPR(1,2,I)+SPR(2,2,I) SUMI= SUMI+SPI(1,1,I)-SPI(2,1,I)-SPI(1,2,I)+SPI(2,2,I) ENDIF ENDDO PFCTR= (BD*SD4R+QEPS*SD4I)/S/BDS/(SD4R*SD4R+SD4I*SD4I) PFCTI= (-BD*SD4I+QEPS*SD4R)/S/BDS/(SD4R*SD4R+SD4I*SD4I) TMP0(1)= PFCTR*SUMR-PFCTI*SUMI TMP0(2)= PFCTR*SUMI+PFCTI*SUMR * F1= RM12-RM32-T F2= RM32-RM22+T F3= RM22-RM42 S11= T S22= 0.Q0 S33= S S12= -0.5Q0*T S13= 0.0Q0 S23= -0.5Q0*S DENX= S11*S22*S33+2.Q0*S12*S23*S13- # S22*S13*S13-S11*S23*S23-S33*S12*S12 XM3I(1,1)= (S22*S33-S23*S23)/DENX XM3I(1,2)= (S13*S23-S33*S12)/DENX XM3I(1,3)= (S12*S23-S13*S22)/DENX XM3I(2,1)= XM3I(1,2) XM3I(2,2)= (S11*S33-S13*S13)/DENX XM3I(2,3)= (S13*S12-S11*S23)/DENX XM3I(3,1)= XM3I(1,3) XM3I(3,2)= XM3I(2,3) XM3I(3,3)= (S11*S22-S12*S12)/DENX * CALL TCFFS(S,RM22,RM12,RM42,C0_134,C1_134,C2_134) CALL TCFFS(S,RM22,RM32,RM42,C0_234,C1_234,C2_234) CALL TCFFS(T,RM12,RM42,RM32,C0_124,C1_124,C2_124) CALL TCFFS(T,RM12,RM22,RM32,C0_123,C1_123,C2_123) DO I=1,2 R2(I,1)= 0.5Q0*(F1*TMP0(I)+C0_134(I)-C0_234(I)) R2(I,2)= 0.5Q0*(F2*TMP0(I)+C0_124(I)-C0_134(I)) R2(I,3)= 0.5Q0*(F3*TMP0(I)+C0_123(I)-C0_124(I)) ENDDO * DO J= 1,2 DO I= 1,3 TMP1(J,I)= XM3I(I,1)*R2(J,1)+XM3I(I,2)*R2(J,2)+ # XM3I(I,3)*R2(J,3) ENDDO ENDDO * DO I=1,2 TMP27(I)= -RM12*TMP0(I)-0.5Q0*(F1*TMP1(I,1)+F2*TMP1(I,2)+ # F3*TMP1(I,3)-C0_234(I)) ENDDO DO I=1,2 R3_145(I,1)= 0.5Q0*(F1*TMP1(I,1)+C1_134(I,2)-C1_134(I,1)- # C0_134(I)+C0_234(I))-TMP27(I) R3_145(I,2)= 0.5Q0*(F2*TMP1(I,1)+C1_124(I,1)-C1_134(I,2)+ # C1_134(I,1)+C0_134(I)) R3_145(I,3)= 0.5Q0*(F3*TMP1(I,1)+C1_123(I,1)-C1_124(I,1)) ENDDO * DO J= 1,2 DO I= 1,3 TMP2_145(J,I)= XM3I(I,1)*R3_145(J,1)+XM3I(I,2)* # R3_145(J,2)+XM3I(I,3)*R3_145(J,3) ENDDO ENDDO * DO I=1,2 R3_426(I,1)= 0.5Q0*(F1*TMP1(I,2)+C1_134(I,2)-C1_134(I,1)- # C0_134(I)+C1_234(I,1)-C1_234(I,2)+C0_234(I)) R3_426(I,2)= 0.5Q0*(F2*TMP1(I,2)+C1_124(I,1)-C1_124(I,2)- # C1_134(I,2)+C1_134(I,1)+C0_134(I))-TMP27(I) R3_426(I,3)= 0.5Q0*(F3*TMP1(I,2)+C1_123(I,1)-C1_123(I,2)- # C1_124(I,1)+C1_124(I,2)) ENDDO * DO J= 1,2 DO I= 1,3 TMP2_426(J,I)= XM3I(I,1)*R3_426(J,1)+XM3I(I,2)* # R3_426(J,2)+XM3I(I,3)*R3_426(J,3) ENDDO ENDDO * DO I=1,2 R3_563(I,1)= 0.5Q0*(F1*TMP1(I,3)+C1_134(I,2)-C1_234(I,2)) R3_563(I,2)= 0.5Q0*(F2*TMP1(I,3)+C1_124(I,1)-C1_124(I,2)- # C1_134(I,2)) R3_563(I,3)= 0.5Q0*(F3*TMP1(I,3)-C1_124(I,1)+C1_124(I,2))- # TMP27(I) ENDDO * DO J= 1,2 DO I= 1,3 TMP2_563(J,I)= XM3I(I,1)*R3_563(J,1)+XM3I(I,2)* # R3_563(J,2)+XM3I(I,3)*R3_563(J,3) ENDDO ENDDO * DO I=1,2 D0(I)= TMP0(I) D1(I,1)= TMP1(I,1) D1(I,2)= TMP1(I,2) D1(I,3)= TMP1(I,3) D2(I,7)= TMP27(I) D2(I,1)= TMP2_145(I,1) D2(I,4)= TMP2_145(I,2) D2(I,5)= TMP2_145(I,3) D2(I,2)= TMP2_426(I,2) D2(I,6)= TMP2_426(I,3) D2(I,3)= TMP2_563(I,3) ENDDO RETURN END * *-----S2INFTY------------------------------------------- * CALLED BY DFF IF SOME OF THE A'S * ARE NEGATIVE * SUBROUTINE TS2INFTY(Q2,RMI2,RMJ2,YK,S2R,S2I) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION ARGP(2),ARGM(2),CLNP(2),CLNM(2) * CALL TROOTS(Q2,RMI2,RMJ2,Y1R,Y1I,Y2R,Y2I,OMY1R,OMY2R) IF(Y1I.GT.0.D0) THEN YPR= Y1R YPI= Y1I YMR= Y2R YMI= Y2I ELSE IF(Y2I.GT.0.D0) THEN YPR= Y2R YPI= Y2I YMR= Y1R YMI= Y1I ENDIF ARGP(1)= YK-YPR ARGP(2)= -YPI ARGM(1)= YK-YMR ARGM(2)= -YMI CALL TCQLNX(ARGM,CLNM) CALL TCQLNX(ARGP,CLNP) S2R= -QPIS+QPI*(CLNM(2)-CLNP(2)) S2I= -QPI*(CLNM(1)-CLNP(1)) RETURN END * *-----SEXTRA------------------------------------------- * CALLED BY DFF IF A1 AND A2 HAVE * OPPOSITE SIGN * SUBROUTINE TSEXTRA(A3,A4,Q234,Q224,Q223,SR,SI) IMPLICIT REAL*16(A-H,O-Z) * COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA * DIMENSION OOX1(2),OOX2(2),OOY1(2),OOY2(2),OOZ1(2),OOZ2(2) DIMENSION OMOOX1(2),OMOOX2(2),OMOOY1(2),OMOOY2(2),OMOOZ1(2), # OMOOZ2(2) DIMENSION CLNX1(2),CLNX2(2),CLNY1(2),CLNY2(2),CLNZ1(2),CLNZ2(2) * AM12= -Q224 AM22= -Q223 CALL TROOTS(Q234,AM12,AM22,X1R,X1I,X2R,X2I,OMX1R,OMX2R) AM12= -Q234 AM22= -Q223 CALL TROOTS(Q224,AM12,AM22,Y1R,Y1I,Y2R,Y2I,OMY1R,OMY2R) AM12= -Q234 AM22= -Q224 CALL TROOTS(Q223,AM12,AM22,Z1R,Z1I,Z2R,Z2I,OMZ1R,OMZ2R) DX1= X1R*X1R+X1I*X1I DX2= X2R*X2R+X2I*X2I DY1= Y1R*Y1R+Y1I*Y1I DY2= Y2R*Y2R+Y2I*Y2I DZ1= Z1R*Z1R+Z1I*Z1I DZ2= Z2R*Z2R+Z2I*Z2I OOX1(1)= X1R/DX1 OOX1(2)= -X1I/DX1 OOX2(1)= X2R/DX2 OOX2(2)= -X2I/DX2 OOY1(1)= Y1R/DY1 OOY1(2)= -Y1I/DY1 OOY2(1)= Y2R/DY2 OOY2(2)= -Y2I/DY2 OOZ1(1)= Z1R/DZ1 OOZ1(2)= -Z1I/DZ1 OOZ2(1)= Z2R/DZ2 OOZ2(2)= -Z2I/DZ2 OMOOX1(1)= 1.Q0-X1R/DX1 OMOOX1(2)= X1I/DX1 OMOOX2(1)= 1.Q0-X2R/DX2 OMOOX2(2)= X2I/DX2 OMOOY1(1)= 1.Q0-Y1R/DY1 OMOOY1(2)= Y1I/DY1 OMOOY2(1)= 1.Q0-Y2R/DY2 OMOOY2(2)= Y2I/DY2 OMOOZ1(1)= 1.Q0-Z1R/DZ1 OMOOZ1(2)= Z1I/DZ1 OMOOZ2(1)= 1.Q0-Z2R/DZ2 OMOOZ2(2)= Z2I/DZ2 CALL TCQLNOMX(OOX1,OMOOX1,CLNX1) CALL TCQLNOMX(OOX2,OMOOX2,CLNX2) CALL TCQLNOMX(OOY1,OMOOY1,CLNY1) CALL TCQLNOMX(OOY2,OMOOY2,CLNY2) CALL TCQLNOMX(OOZ1,OMOOZ1,CLNZ1) CALL TCQLNOMX(OOZ2,OMOOZ2,CLNZ2) DENX= (X1R-X2R)**2+(X1I-X2I)**2 DENY= (Y1R-Y2R)**2+(Y1I-Y2I)**2 DENZ= (Z1R-Z2R)**2+(Z1I-Z2I)**2 CLNXR= CLNX1(1)-CLNX2(1) CLNXI= CLNX1(2)-CLNX2(2) CLNYR= CLNY1(1)-CLNY2(1) CLNYI= CLNY1(2)-CLNY2(2) CLNZR= CLNZ1(1)-CLNZ2(1) CLNZI= CLNZ1(2)-CLNZ2(2) XR= X1R-X2R XI= X1I-X2I YR= Y1R-Y2R YI= Y1I-Y2I ZR= Z1R-Z2R ZI= Z1I-Z2I CF= QPI/Q234 S234R= CF/DENX*(XR*CLNXI-XI*CLNXR) S234I= -CF/DENX*(XR*CLNXR+XI*CLNXI) S324R= CF/DENY*(YR*CLNYI-YI*CLNYR) S324I= -CF/DENY*(YR*CLNYR+YI*CLNYI) S423R= CF/DENZ*(ZR*CLNZI-ZI*CLNZR) S423I= -CF/DENZ*(ZR*CLNZR+ZI*CLNZI) ATEST= A3*A4 IF(ATEST.GT.0.Q0) THEN SR= S234R SI= S234I RETURN ELSE SR= -S324R-S423R SI= -S324I-S423I RETURN ENDIF * END * *--------------------------------------------------------------------- * SUBROUTINE TPOLINT(XA,YA,N,X,Y,DY) IMPLICIT REAL*8(A-H,O-Z) PARAMETER (NMAX=30) * DIMENSION XA(N),YA(N),C(NMAX),D(NMAX) * NS= 1 DIF= ABS(X-XA(1)) DO I=1,N DIFT= ABS(X-XA(I)) IF(DIFT.LT.DIF) THEN NS= I DIF= DIFT ENDIF C(I)= YA(I) D(I)= YA(I) ENDDO Y= YA(NS) NS= NS-1 DO M=1,N-1 DO I=1,N-M H0= XA(I)-X HP= XA(I+M)-X W= C(I+1)-D(I) DEN= H0-HP IF(DEN.EQ.0.D0) PAUSE DEN= W/DEN D(I)= HP*DEN C(I)= H0*DEN ENDDO IF(2*NS.LT.N-M) THEN DY= C(NS+1) ELSE DY= D(NS) NS= NS-1 ENDIF Y= Y+DY ENDDO RETURN END * *-------------------------------------------------------------------------- * SUBROUTINE THADR5(E,ZM,ST2,DER,ERRDER,DEG,ERRDEG) * ****************************************************************** * * * SUBROUTINE FOR THE EVALUATION OF THE LIGHT HADRON * * CONTRIBUTIONS TO DELTA_R AND DELTA_G * * USING FITS TO THE * * QED VACUUM POLARIZATION FROM E^+ E^- DATA * * * * F. JEGERLEHNER, PAUL SCHERRER INSTITUTE, CH-5232 VILLIGEN * * * * REFERENCE: F. JEGERLEHNER, Z. PHYS. C32 (1986) 195 * * H. BURKHARDT ET AL., Z. PHYS. C42 (1989) 497 * * S. EIDELMAN, F. JEGERLEHNER, Z. PHYS. C (1995) * * * ****************************************************************** * VERSION: 24/02/1995 *//////////////////////////////////////////////////////////////////////// * REFORTRANIZED BY GIAMPIERO 16/10/98 *//////////////////////////////////////////////////////////////////////// * * NOTATION: E ENERGY ( MOMENTUM TRANSFER ): E>0 TIMELIKE , E<0 SPACELIKE * ST2 IS SIN^2(THETA); ST2= 0.2322 IS THE REFERENCE VALUE * THE ROUTINE RETURNS THE HADRONIC CONTRIBUTION OF 5 FLAVORS (U,D,S,C,B) * TO DER= DELTA_R WITH HADRONIC ERROR ERRDER * AND DEG= DELTA_G WITH HADRONIC ERROR ERRDEG * THE EFFECTIVE VALUE OF THE FINE STRUCTURE CONSTANT ALPHAQED AT ENERGY * E IS ALPHAQED(E)= ALPHAQED(0)/(1-DELTA_R) ,SIMILARLY FOR THE SU(2) * COUPLING ALPHASU2(E)= ALPHASU2(0)/(1-DELTA_G), WHERE DELTA_R(G) IS THE * SUM OF LEPTONIC, HADRONIC CONTRIBUTIONS (TOP TO BE ADDED). * * THIS PROGRAM DOES NOT YET KNOW HOW TO COMPUTE DELTA R AND DELTA G FOR * ENERGIES IN THE RANGES |E|>1TEV AND 2M_PI < E < 40(13) GEV !!!!!!!!! * IMPLICIT REAL*8(A-H,O-Z) PARAMETER(NF=9,NS=4) * DIMENSION RES(NS) DIMENSION C(4,NF,NS),RL1(NF,NS) DIMENSION AE(NF,NS),EU(NF),EO(NF),RM1(NF) * DATA C/4.2069394D-02,2.9253566D-03,-6.7782454D-04,9.3214130D-06, # 2.8526291D-02,2.9520725D-03,-2.7906310D-03,6.4174528D-05, # 2.8668314D-03,0.3514608D0,0.5496359D0,1.9892334D-04, # 2.2694240D-03,8.073429D0,0.1636393D0,-3.3545541D-05, # 0.D0,0.D0,0.D0,0.D0, # 0.D0,0.D0,0.D0,0.D0, # 2.7266588D-02,2.9285045D-03,-4.7720564D-03,7.7295507D-04, # 2.8039809D-02,2.9373798D-03,-2.8432352D-03,-5.2537734D-04, # 4.2092260D-02,2.9233438D-03,-3.2966913D-04,3.4324117D-07, # 8.6415343D-02,6.0127582D-03,-6.7379221D-04,9.0877611D-06, # 5.8580618D-02,6.0678599D-03,-2.4153464D-03,6.1934326D-05, # 5.7231588D-03,0.3588257D0,0.5532265D0,6.0730567D-04, # 4.8065037D-03,8.255167D0,0.1599882D0,-1.8624817D-04, # 0.D0,0.D0,0.D0,0.D0, # 0.D0,0.D0,0.D0,0.D0, # 5.5985276D-02,6.0203830D-03,-5.0066952D-03,7.1363564D-04, # 5.7575710D-02,6.0372148D-03,-3.4556778D-03,-4.9574347D-04, # 8.6462371D-02,6.0088057D-03,-3.3235471D-04,5.9021050D-07, # 6.3289929D-04,3.3592437D-06,0.D0,0.D0, # 6.2759849D-04,-1.0816625D-06,5.050189D0,-9.6505374D-02, # 1.0147886D-04,1.819327D0,-0.1174904D0,-1.2404939D-04, # -7.1368617D-05,9.980347D-04,1.669151D0,3.5645600D-05, # 0.D0,0.D0,0.D0,0.D0, # 0.D0,0.D0,0.D0,0.D0, # 6.4947648D-04,4.9386853D-07,-55.22332D0,26.13011D0, # 6.4265809D-04,-2.8453374D-07,-23.38172D0,-6.251794D0, # 6.3369947D-04,-2.0898329D-07,0.D0,0.D0, # 1.2999176D-03,7.4505529D-06,0.D0,0.D0, # 1.2883141D-03,-1.3790827D-06,8.056159D0,-0.1536313D0, # 2.0489733D-04,2.065011D0,-0.6172962D0,-2.5603661D-04, # -1.5095409D-04,9.9847501D-04,1.636659D0,7.5892596D-05, # 0.D0,0.D0,0.D0,0.D0, # 0.D0,0.D0,0.D0,0.D0, # 1.3335156D-03,2.2939612D-07,-246.4966D0,114.9956D0, # 1.3196438D-03,2.8937683D-09,5449.778D0,930.3875D0, # 1.3016918D-03,-3.6027674D-07,0.D0,0.D0/ * DATA EU/-1.D3,-2.D2,-2.D1,-2.D0,0.25D0,2.D0,4.D1,8.D1,2.5D2/ DATA EO/-2.D2,-2.D1,-2.D0,0.25D0,2.D0,4.D1,8.D1,2.5D2,1.D3/ DATA RM1/-1.D3,-1.D2,-2.D1,-2.D0,0.D0,0.D0,8.D1,91.18880D0,1.D3/ * DO I=1,NF DO J=1,NS AE(I,J)= 0.D0 RL1(I,J)= 0.D0 ENDDO ENDDO * RM1(8)= ZM RL1(3,1)= 9.3055D-03 RL1(4,1)= 9.3055D-03 RL1(3,2)= 1.9954D-02 RL1(4,2)= 1.9954D-02 RL1(3,3)= 2.0243D-04 RL1(4,3)= 2.0243D-04 RL1(4,4)= 4.3408D-04 * AE(3,1)= 3.D0 AE(4,1)= 2.D0 AE(3,2)= 3.D0 AE(3,2)= 2.D0 AE(2,3)= 1.D0 AE(3,3)= 3.D0 AE(4,3)= 2.D0 AE(2,4)= 1.D0 AE(3,4)= 3.D0 AE(4,4)= 2.D0 * SE= 654.D0/643.D0 ! RESCALING ERROR TO PUBLISHED VERSION 1995 ST20= 0.2322D0 S= E*E DER= 0.D0 DEG= 0.D0 ERRDER= 0.D0 ERRDEG= 0.D0 IF((E.GT.1.E3).OR.(E.LT.-1.E3)) GOTO 100 IF((E.LT.4.E1).AND.(E.GT.0.25D0)) GOTO 100 I= 1 DO WHILE (E.GE.EO(I)) I= I+1 ENDDO IF(E.EQ.1.E3) I= 9 IF(E.EQ.0.D0 ) GOTO 100 S0= SIGN(1.D0,RM1(I))*RM1(I)**2 S = SIGN(1.D0,E)*E*E X1= S0/S XI= 1.D0/X1 X2= X1*X1 IF(AE(I,1).LE.0.D0) THEN DO J= 1,4 XLAR= XI+AE(I,J)*EXP(-XI) XLOG= LOG(XLAR) RES(J)= C(1,I,J)+C(2,I,J)*(XLOG+C(3,I,J)*(X1-1.D0)+ # C(4,I,J)*(X2-1.0)) ENDDO ELSE IF (AE(I,1).EQ.2.D0) THEN HX= XI*XI DO J= 1,2 FX= 1.D0-C(2,I,J)*S GX= C(3,I,J)*S/(C(3,I,J)-S) XX= LOG(ABS(FX))+C(2,I,J)*GX RES(J)= C(1,I,J)*XX-RL1(I,J)*GX+C(4,I,J)*HX ENDDO DO J= 3,4 U= ABS(S) GX= -C(3,I,J)*U/(C(3,I,J)+U) XX= XI**3/(SQRT(ABS(XI))**5+C(2,I,J)) RES(J)= C(1,I,J)*XX-RL1(I,J)*GX+C(4,I,J)*HX ENDDO ELSE IF (AE(I,1).EQ.3.0) THEN HX= XI DO J= 1,4 FX= 1.D0-C(2,I,J)*S GX= C(3,I,J)*S/(C(3,I,J)-S) XX= LOG(ABS(FX))+C(2,I,J)*GX RES(J)= C(1,I,J)*XX-RL1(I,J)*GX+C(4,I,J)*HX ENDDO ENDIF DER= RES(1) DEG= RES(2)*ST20/ST2 ERRDER= RES(3)*SE ERRDEG= RES(4)*SE 100 RETURN END * *-------------------------------------------------------------------------- * THIS IS A NEW BRANCH, INTRODUCED DECEMBER '98 DESIGNED TO * COMPUTE RO FROM PO (9-PARAM) *-------------------------------------------------------------------------- * SUBROUTINE TPO(APO) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM2,NM2 CHARACTER*2 ONPAR CHARACTER*3 OPO * COMMON/TOPO/OPO COMMON/TNP/ONPAR COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TSCALE/ZM,TQM,HM,CALS COMMON/TGFER/GZ,GE0,GE,GM,GT,GH COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 * DIMENSION APO(9) * ZM= APO(1) GZ= APO(2) SH= APO(3) RE= APO(4) IF(ONPAR.EQ.'FP') THEN RM= APO(4) RT= APO(4) ELSE IF(ONPAR.EQ.'NP') THEN RM= APO(5) RT= APO(6) ENDIF * ZM2= ZM*ZM ZM3= ZM2*ZM FAC= GF*ZM3/6.D0/PI FAE= 1.D0 IF(ONPAR.EQ.'FP') THEN FAM= 1.D0 FAT= 1.D0 ELSE IF(ONPAR.EQ.'NP') THEN FAM= 1.D0-6.D0*MM2/ZM2 FAT= 1.D0-6.D0*TLM2/ZM2 ENDIF * GE= ZM*GZ*SQRT(SH/12.D0/PI/RE/0.38937966D6) GH= ZM*GZ*SQRT(RE*SH/12.D0/PI/0.38937966D6) GM= GH/RM GT= GH/RT * QEDR= 1.D0+3.D0/4.D0*ALPHAH/PI GE0= GE/QEDR GM0= GM/QEDR GT0= GT/QEDR * IF(ONPAR.EQ.'FP') THEN AFBE= APO(5) AFBM= APO(5) AFBT= APO(5) ELSE IF(ONPAR.EQ.'NP') THEN AFBE= APO(7) AFBM= APO(8) AFBT= APO(9) ENDIF * *-----EXTRACTION OF E PARAMETERS * AE= SQRT(AFBE/3.D0) EVI= VIM(1) EAI= AIM(1) IF(OPO.EQ.'ICO') THEN RVE= 0.25D0-4.D0*AE*(AE*(0.25D0+EVI*EVI+EAI*EAI)-EVI*EAI) ELSE IF(OPO.EQ.'ORT') THEN RVE= 0.25D0-AE*AE ENDIF RVE= 0.5D0/AE*(-0.5D0+SQRT(RVE)) ST2E= 0.25D0+0.5D0*RVE RHOE= GE0/FAC/(RVE*RVE+0.25D0*FAE+EVI*EVI+EAI*EAI) * *-----EXTRACTION OF MU PARAMETERS * AM= AFBM/AE/3.D0 EVI= VIM(2) EAI= AIM(2) IF(OPO.EQ.'ICO') THEN RVM= 0.25D0-4.D0*AM*(AM*(0.25D0+EVI*EVI+EAI*EAI)-EVI*EAI) ELSE IF(OPO.EQ.'ORT') THEN RVM= 0.25D0-AM*AM ENDIF RVM= 0.5D0/AM*(-0.5D0+SQRT(RVM)) ST2M= 0.25D0+0.5D0*RVM RHOM= GM0/FAC/(RVM*RVM+0.25D0*FAM+EVI*EVI+EAI*EAI) * *-----EXTRACTION OF TAU PARAMETERS * AT= AFBT/AE/3.D0 EVI= VIM(3) EAI= AIM(3) IF(OPO.EQ.'ICO') THEN RVT= 0.25D0-4.D0*AT*(AT*(0.25D0+EVI*EVI+EAI*EAI)-EVI*EAI) ELSE IF(OPO.EQ.'ORT') THEN RVT= 0.25D0-AT*AT ENDIF RVT= 0.5D0/AT*(-0.5D0+SQRT(RVT)) ST2T= 0.25D0+0.5D0*RVT RHOT= GT0/FAC/(RVT*RVT+0.25D0*FAT+EVI*EVI+EAI*EAI) * ST2EFF(1)= ST2E ST2EFF(2)= ST2M ST2EFF(3)= ST2T RHOEFF(1)= RHOE RHOEFF(2)= RHOM RHOEFF(3)= RHOT * RETURN END * *--------------------------------------------------------------------- * SUBROUTINE TEWFIT(NRS,NFN,SIGF0,SIGF1,AEST0,AEST1) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,KM,NM * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OCUTS,ONP,ONIF,OPRAD, # OBHABHA,OREST,OFM,OPREC,ONIFH,OIFAIL CHARACTER*2 OCUT,OINDX CHARACTER*4 OMODES * PARAMETER(NDIM=1,NOBS=10,MNRS=30,MNFN=NOBS*MNRS,IRCLS=2**NDIM+ # 2*NDIM*NDIM+2*NDIM+1,MNCLS=0,MXCLS=500*IRCLS, # LENWRK0=6*NDIM+9*MNFN+(NDIM+MNFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0) PARAMETER(NFL=4,NPO=34) * COMMON/TK/IFK COMMON/TMF/OFM COMMON/TESC/SE COMMON/TP/OPREC COMMON/TMED/XMED COMMON/TSNOM/NBSM COMMON/TOPR/OPRAD COMMON/TIFL/OIFAIL COMMON/TSUP/OMODES COMMON/TFIXED/AX(4) COMMON/TECM/RS(MNRS) COMMON/TPAIR/ONP(MNRS) COMMON/TIFSR/ONIF(MNRS) COMMON/TNOM/NOBSS,NOBSM COMMON/TXVARF/SEPS(MNRS) COMMON/TCUT/OXCUT,OXCUTS COMMON/TIFSRH/ONIFH(MNRS) COMMON/TEPP/EDEL(MNRS,NFL) COMMON/TADJBASYM/AJNB,AJDB COMMON/THMASS/PIM,KM,DM,BM COMMON/TPARAM/PI,PIS,DELTA COMMON/TSCALE/ZM,TQM,HM,CALS COMMON/TGFER/GZ,GE0,GE,GM,GT,GH COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TS0F/SIGMA0(MNRS,NOBS),SIGMA1(MNRS,NOBS) COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TTH/SET(MNRS),AET(MNRS),SMUT(MNRS),AMUT(MNRS),STAUT(MNRS), # ATAUT(MNRS),SHADT(MNRS),ESET(MNRS),EAET(MNRS), # ESMUT(MNRS),EAMUT(MNRS),ESTAUT(MNRS),EATAUT(MNRS), # ESHADT(MNRS) * DIMENSION CFP(MNFN,NFL),XMAX(MNRS) DIMENSION SIG(MNFN),SIG0(MNFN),ARS(MNRS),RSP(MNRS) DIMENSION XL(NDIM),XU(NDIM),AEST0(NFN),SIGF0(NFN), # SIGF1(NFN),WRKSTR(LENWRK),AEST1(NFN) DIMENSION DELIFS(5,MNRS),DELIFA(5,MNRS),ADELIFF(5), # ADELIFB(5) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TFUBF0,TFUBF1 * *-----NOBS = # OF OBSERVABLES: 1 = SIG_T(E), 2 = SIG_T(MU), 3 = SIG_T(TAU) *----- 4 = SIG_FB(E), 5 = SIG_FB(MU), 6 = SIG_FB(TAU), *----- 7 = SIG_T(UQ), 8 = SIG_T(DQ), 9 = SIG_T(BQ), 10 = SIG_T(HAD) * *-----NRS = # OF ENERGIES * OPRAD= 'E' IF(OPREC.EQ.'H') THEN MNCLSA= 1000 ELSE MNCLSA= MNCLS ENDIF * NOBSM= 10 IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'HA') THEN NBSM= 4 ELSE NBSM= 2 ENDIF ELSE NBSM= NOBSM ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN NBSM= 4 ENDIF * ALPHAS= CALS WT= GZ * *-----QED CORRECTIONS ARE COMPUTED, INCLUDING PAIR PRODUCTION * CALL TQED(NRS,RS,RL,BETA,SDELTA,SDELTAP,WT,PCDEL,PCDELH, # AD1,ADD,SDELTA3,SDELTAP3) * *-----PART OF WEAK CORRECTIONS (THOSE NOT IN CONVOLUTION) ARE COMPUTED *-----AT THE WEAKLY CORRECTED PEAK OR ENERGY BY ENERGY * IF(OFM.EQ.'F') THEN IF(IFK.EQ.0) THEN KO= 0 MAXE= NRS CALL TWEAK(MAXE,RS,KO) ENDIF IFK= IFK+1 ELSE KO= 0 MAXE= NRS CALL TWEAK(MAXE,RS,KO) ENDIF * *-----THE BORN+WEAK CROSS SECTIONS AND ASYMMETRIES ARE COMPUTED * COMPLETE (ONLY WITH EXTRAPOLATED SET-UP) * *-----AT E_CM * DO J=1,NRS ARS(J)= RS(J) ENDDO CALL TOBSFIT(NRS,NOBSM,ARS,SIGMA0,RS) * DO I=1,NRS SEPS(I)= OXCUT ENDDO * DO J=1,NRS XMAX(J)= 1.D0-SEPS(J) ARS(J)= SQRT(SEPS(J))*RS(J) ENDDO CALL TOBSFIT(NRS,NOBSM,ARS,SIGMA1,RS) * *-----LIMITS OF X-INTEGRATION ARE ALWAYS RESCALED * DO I=1,NDIM XL(I)= 0.D0 XU(I)= 1.D0 ENDDO MULFAC= 2**NDIM * *-----STARTS THE 0<->XMED (SCALED) INTEGRATION * MINCLS= MNCLSA MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-5*SE 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBF0,AEQ,REQ, # LENWRK,WRKSTR,SIGF0,AEST0,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EWFIT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF * *-----STARTS THE XMED<->1-SEPS (SCALED) INTEGRATION * MINCLS= MNCLSA MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-5*SE 50 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDIM,XL,XU,MINCLS,MAXCLS,NFN,TFUBF1,AEQ,REQ, # LENWRK,WRKSTR,SIGF1,AEST1,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EWFIT ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 50 ENDIF * *-----THE CORRECTED OBSERVABLES * SMED= 1.D0-XMED DO I3=1,NBSM IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 5 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 3 ELSE IF(I3.EQ.2) THEN I2= 6 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+6 ENDIF ELSE I2= I3 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN I2= I3+6 ENDIF * DO I1=1,NRS I= NRS*(I3-1)+I1 PRDMX= TPRADF(I1,I2,XMAX(I1),SEPS(I1)) PRDMD= TPRADF(I1,I2,XMED,SMED) SIG0(I)= SIGMA0(I1,I2) SIG(I)= SIGF0(I)+SIGF1(I)+SIGMA0(I1,I2)*PRDMD+ # SIGMA1(I1,I2)*PRDMX*(1.D0-PRDMD/PRDMX) ENDDO ENDDO * *-----INCLUDES I-F STATE INTERFERENCE AT THE REQUESTED ENERGIES FOR *-----LEPTONS ONLY * ZERO= 0.D0 KFL= 2 KFLP= 0 DO I=1,NRS IF(ONIF(I).EQ.'Y') THEN IF(OMODES.EQ.'FITE'.AND.OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN CALL TIFINT(KFL,KFLP,1,RS(I),ZERO,SEPS(I),WT,ADELIFF(1), # ADELIFB(1)) ADELIFF(2)= 0.D0 ADELIFB(2)= 0.D0 ADELIFF(3)= 0.D0 ADELIFB(3)= 0.D0 ELSE IF(OINDX.EQ.'MU') THEN CALL TIFINT(KFL,KFLP,2,RS(I),ZERO,SEPS(I),WT,ADELIFF(2), # ADELIFB(2)) ADELIFF(1)= 0.D0 ADELIFB(1)= 0.D0 ADELIFF(3)= 0.D0 ADELIFB(3)= 0.D0 ELSE IF(OINDX.EQ.'TA') THEN CALL TIFINT(KFL,KFLP,3,RS(I),ZERO,SEPS(I),WT,ADELIFF(3), # ADELIFB(3)) ADELIFF(1)= 0.D0 ADELIFB(1)= 0.D0 ADELIFF(2)= 0.D0 ADELIFB(2)= 0.D0 ELSE IF(OINDX.EQ.'HA') THEN ADELIFF(1)= 0.D0 ADELIFB(1)= 0.D0 ADELIFF(2)= 0.D0 ADELIFB(2)= 0.D0 ADELIFF(3)= 0.D0 ADELIFB(3)= 0.D0 ENDIF DO J=1,3 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE DO J=1,3 CALL TIFINT(KFL,KFLP,J,RS(I),ZERO,SEPS(I),WT,ADELIFF(J), # ADELIFB(J)) DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE DO J=1,3 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF IF(ONIFH(I).EQ.'Y') THEN IF(OMODES.EQ.'FITE'.AND.OBHABHA.EQ.'R') THEN IF(OINDX.NE.'HA') THEN DO J=4,5 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE DO J=4,5 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'R') THEN DO J=4,5 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ELSE DO J=4,5 CALL TIFINT(KFL,KFLP,J,RS(I),ZERO,SEPS(I),WT,ADELIFF(J), # ADELIFB(J)) DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ELSE DO J=4,5 ADELIFF(J)= 0.D0 ADELIFB(J)= 0.D0 DELIFS(J,I)= ADELIFF(J)+ADELIFB(J) DELIFA(J,I)= ADELIFF(J)-ADELIFB(J) ENDDO ENDIF ENDDO * IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL'.OR.OINDX.EQ.'MU'.OR.OINDX.EQ.'TA') THEN K3MX= 0 ELSE IF(OINDX.EQ.'HA') THEN K3MX= 2 ENDIF ELSE K3MX= 8 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN K3MX= 2 ENDIF * IF(ONP(1).EQ.'I') THEN CALL TEPAIRS(NRS,NFL,WT) DO K1=1,4 DO K2=1,NRS DO K3=0,K3MX IF(ONP(K2).EQ.'I') THEN CFP(K3*NRS+K2,K1)= EDEL(K2,K1) ELSE CFP(K3*NRS+K2,K1)= 0.D0 ENDIF ENDDO ENDDO ENDDO ELSE DO K1=1,4 DO K2=1,NRS DO K3=0,K3MX IF(ONP(K2).EQ.'Y') THEN TEST= ABS(RS(K2)-ZM) IF(TEST.LE.3.D0) THEN CFP(K3*NRS+K2,K1)= PCDEL(K2,K1)+PCDELH(K2,K1) ELSE CFP(K3*NRS+K2,K1)= PCDEL(K2,K1)+SIG0(K3*NRS+K2)/ # SIG(K3*NRS+K2)*PCDELH(K2,K1) ENDIF ELSE CFP(K3*NRS+K2,K1)= 0.D0 ENDIF ENDDO ENDDO ENDDO ENDIF * *-----CORRECTED CROSS SECTIONS AND ASYMMETRIES * DO I1=1,NRS NRS1= NRS+I1 NRS2= 2*NRS+I1 NRS3= 3*NRS+I1 NRS4= 4*NRS+I1 NRS5= 5*NRS+I1 NRS6= 6*NRS+I1 NRS7= 7*NRS+I1 NRS8= 8*NRS+I1 NRS9= 9*NRS+I1 IF(ONP(I1).EQ.'Y') THEN DO J1=1,4 CFP(I1,J1)= SIG(I1)*CFP(I1,J1) CFP(NRS1,J1)= SIG(NRS1)*CFP(NRS1,J1) CFP(NRS2,J1)= SIG(NRS2)*CFP(NRS2,J1) CFP(NRS3,J1)= SIG(NRS3)*CFP(NRS3,J1) CFP(NRS4,J1)= SIG(NRS4)*CFP(NRS4,J1) CFP(NRS5,J1)= SIG(NRS5)*CFP(NRS5,J1) CFP(NRS6,J1)= SIG(NRS6)*CFP(NRS6,J1) CFP(NRS7,J1)= SIG(NRS7)*CFP(NRS7,J1) CFP(NRS8,J1)= SIG(NRS8)*CFP(NRS8,J1) CFP(NRS9,J1)= SIG(NRS9)*CFP(NRS9,J1) ENDDO ENDIF IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN SET(I1)= SIG(I1)+CFP(I1,1)+DELIFS(1,I1) AET(I1)= (SIG(NRS1)+DELIFA(1,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(1,I1)) ESET(I1)= 0.D0 EAET(I1)= 0.D0 ELSE IF(OINDX.EQ.'MU') THEN SMUT(I1)= SIG(I1)+CFP(I1,1)+DELIFS(2,I1) AMUT(I1)= (SIG(NRS1)+DELIFA(2,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(2,I1)) ESMUT(I1)= 0.D0 EAMUT(I1)= 0.D0 ELSE IF(OINDX.EQ.'TA') THEN STAUT(I1)= SIG(I1)+CFP(I1,1)+DELIFS(3,I1) ATAUT(I1)= (SIG(NRS1)+DELIFA(3,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(3,I1)) ESTAUT(I1)= 0.D0 EATAUT(I1)= 0.D0 ELSE IF(OINDX.EQ.'HA') THEN SHADT(I1)= SIG(NRS3)+2.D0*CFP(I1,2)+ # 2.D0*CFP(NRS1,3)+CFP(NRS2,4)+ # 2.D0*DELIFS(4,I1)+3.D0*DELIFS(5,I1) ESHADT(I1)= 0.D0 ENDIF ELSE SET(I1)= SIG(I1)+CFP(I1,1)+DELIFS(1,I1) SMUT(I1)= SIG(NRS1)+CFP(NRS1,1)+DELIFS(2,I1) STAUT(I1)= SIG(NRS2)+CFP(NRS2,1)+DELIFS(3,I1) AET(I1)= (SIG(NRS3)+DELIFA(1,I1))/ # (SIG(I1)+CFP(I1,1)+DELIFS(1,I1)) AMUT(I1)= (SIG(NRS4)+DELIFA(2,I1))/ # (SIG(NRS1)+CFP(NRS1,1)+DELIFS(2,I1)) ATAUT(I1)= (SIG(NRS5)+DELIFA(3,I1))/ # (SIG(NRS2)+CFP(NRS2,1)+DELIFS(3,I1)) SHADT(I1)= SIG(NRS9)+2.D0*CFP(NRS6,2)+ # 2.D0*CFP(NRS7,3)+CFP(NRS8,4)+ # 2.D0*DELIFS(4,I1)+3.D0*DELIFS(5,I1) ESET(I1)= 0.D0 ESMUT(I1)= 0.D0 ESTAUT(I1)= 0.D0 EAET(I1)= 0.D0 EAMUT(I1)= 0.D0 EATAUT(I1)= 0.D0 ESHADT(I1)= 0.D0 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN SHADT(I1)= SIG(NRS3)+2.D0*CFP(I1,2)+ # 2.D0*CFP(NRS1,3)+CFP(NRS2,4)+ # 2.D0*DELIFS(4,I1)+3.D0*DELIFS(5,I1) ESHADT(I1)= 0.D0 ENDIF ENDDO * RETURN END * *------------------------------------------------------------------- * SUBROUTINE TOBSFIT(NRS,NOBS,ORS,OSIGMA,OARS) IMPLICIT REAL*8 (A-H,I,O-P,R-Z) IMPLICIT REAL*16(Q) REAL*8 MM,NM,MM2,NM2 * CHARACTER*1 OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OCUTS,OBHABHA,OIMAG,OREST CHARACTER*2 OCUT,OCUTF,OINDX,ONPAR CHARACTER*3 OPO CHARACTER*4 OMODES * PARAMETER(MNRS=30,NO=8,MNOBS=10,NOO=7) * COMMON/TOPO/OPO COMMON/TNAL/ODA COMMON/TNP/ONPAR COMMON/TIXS/OIMAG COMMON/TPW/PW(10) COMMON/TSUP/OMODES COMMON/TCUTF/OXCUTF COMMON/TICOUPLING/NF COMMON/TAFBB/AFBBEFF COMMON/TIMAG/PGGFI(MNRS) COMMON/TONCE/CFACTZ,GGIZ COMMON/TCUT/OXCUT,OXCUTS COMMON/TOCUTF/OCUTF(MNRS) COMMON/TAFJTR/ALST,ALSTZ COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TCK/XSZ(6),XNFACT(6) COMMON/TGFER/GZ,GE0,GE,GM,GT,GH COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TCACUT/OCUT(MNRS),OCUTS(MNRS) COMMON/TQPARAM/QPI,QPIS,QEPS,QDELTA COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TTHU/OU0,OU1,OU2,OU3,OU4,OU5,OU6,OU7,OU8 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQMASSES2/QEM2,QMM2,QTM2,QNM2,QUQM2,QDQM2,QCQM2,QSQM2, # QBQM2,QTQM2,QZM2,QWM2,QHM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR * COMMON/TWEAKPAR/IPGGF(MNRS),IDSTH2(MNRS), # DELGG(MNRS,NOO),DELZZP(MNRS,NOO), # DELZZM(MNRS,NOO),DELGZP1(MNRS,NOO), # DELGZP2(MNRS,NOO),DELGZP3(MNRS,NOO), # DELGZP4(MNRS,NOO),DELGZM1(MNRS,NOO), # DELGZM2(MNRS,NOO),DELGZM3(MNRS,NOO), # DELGZM4(MNRS,NOO),FBOX(MNRS,NOO),BBOX(MNRS,NOO) * DIMENSION CST(MNRS,NO),CSFMB(MNRS,NO),OSIGMA(MNRS,MNOBS), # AGZ(MNRS,NO),AZZ(MNRS,NO),DSGG(MNRS,NO),DSZZ(MNRS,NO), # DSGZ(MNRS,NO),CSTMQCD(MNRS,NO),ORS(MNRS), # SVV(MNRS,NO),SAA(MNRS,NO),SVA(MNRS,NO),SVV4(MNRS,NO), # SEE(MNRS,NO),SEV(MNRS,NO),SLO(MNRS,NO),SVVT(MNRS,NO), # SAA4(MNRS,NO),SVA4(MNRS,NO),OARS(MNRS), # SVVMIX(MNRS,NO),SAAMIX(MNRS,NO),SVAMIX(MNRS,NO), # CQEDFPB(MNRS,NO),CKCORR(MNRS,NO), # DSZZH(MNRS,NO),SVVH(MNRS,NO),SAAH(MNRS,NO), # SVVMIXH(MNRS,NO),SAAMIXH(MNRS,NO),SLOH(MNRS,NO), # CSTMQCDH(MNRS,NO),CSTH(MNRS,NO),CKCORRH(MNRS,NO), # SVV4H(MNRS,NO),SAA4H(MNRS,NO),SVVTH(MNRS,NO) * DO J=1,MNRS DO K=1,NO CST(J,K)= 0.D0 CSFMB(J,K)= 0.D0 ENDDO ENDDO XSZE= 12.D0*PI*GE0*GE/ZM2/(GZ*GZ)*0.38937966D6 XSZM= 12.D0*PI*GE0*GM/ZM2/(GZ*GZ)*0.38937966D6 XSZT= 12.D0*PI*GE0*GT/ZM2/(GZ*GZ)*0.38937966D6 XSZH= 12.D0*PI*GE0*GH/ZM2/(GZ*GZ)*0.38937966D6 WT= GZ * ZM= SQRT(ZM2) QZM= ZM*1.D15*1.Q-15 QZM2= QZM*QZM EI3= ZID SEI3= -1.D0 BQE= BQL TQE= 2.D0*BQE DPT= 2.D0/3.D0 DMT= -1.D0/2.D0 G2= GWEAK*RHO G4= G2*G2 CONVF= 2.D0*PI*CONV/4.D0/64.D0/PIS * PGGFIZ= IPGGF(NRS) DSTH2IZ= IDSTH2(NRS) AIPGGFZ= AEXP*GGIZ DENAZ= CFACTZ*CFACTZ+AIPGGFZ*AIPGGFZ RALHZ= ALPHA*CFACTZ/DENAZ IF(OIMAG.EQ.'N') THEN IALHZ= 0.D0 ELSE IALHZ= ALPHA*AIPGGFZ/DENAZ ENDIF ARZ= RALHZ/FPI AIZ= IALHZ/FPI * CALL TCORRQCD(ZM) AEXPM= ALSR/PI * *-----ENERGY LOOP * DO J=1,NRS RSN= OARS(J) * *-----THE CORRECTED ENERGY IS ASSIGNED * RS= ORS(J) * *-----QCD & MASS CORRECTIONS * CALL TCORRQCD(RS) AEXPS= ALSR/PI * IF(OWEAK.EQ.'F') THEN * PGGFI= IPGGF(1) DSTH2I= IDSTH2(1) ELSE IF(OWEAK.EQ.'R') THEN * PGGFI= IPGGF(J) DSTH2I= IDSTH2(J) ENDIF S= RS*RS P2= -S S2= S*S SMZM2= S-ZM2 * *-----COMPUTES THE RUNNING ALPHA * IF(RS.LT.10.D0) THEN JX= 1 ELSE IF(RS.GT.10.D0.AND.RS.LT.30.D0) THEN JX= 2 ELSE IF(RS.GT.30.D0.AND.RS.LT.50.D0) THEN JX= 3 ELSE IF(RS.GT.50.D0.AND.RS.LT.70.D0) THEN JX= 4 ELSE IF(RS.GT.70.D0) THEN JX= 5 ENDIF CFACT= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/S)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*S/TQM2 CFACT= 1.D0-(CFACT+ODA) AIPGGF= ALPHA/4.D0/PI*PGGFI(J) DENA= CFACT*CFACT+AIPGGF*AIPGGF RALH= ALPHA*CFACT/DENA IF(OIMAG.EQ.'N') THEN IALH= 0.D0 ELSE IALH= ALPHA*AIPGGF/DENA ENDIF ALH2= RALH*RALH+IALH*IALH * *-----COMPUTES THE RUNNING SIN(THETA) * AR= RALH/FPI AI= IALH/FPI * RSTH2= STR2+(AR-AEXPHZ)*AUX1+ # (AR*AR-AI*AI-AEXPHZ*AEXPHZ)*AUX2 RSTH2Z= STR2+(ARZ-AEXPHZ)*AUX1+ # (ARZ*ARZ-AIZ*AIZ-AEXPHZ*AEXPHZ)*AUX2 * *-----COMPUTES THE IMAGINARY OF SIN(THETA) * IF(OIMAG.EQ.'N') THEN ISTH2= 0.D0 ISTH2Z= 0.D0 ELSE ISTH2= AI*(AUX1+2.D0*AR*AUX2)+AR*DSTH2I ISTH2Z= AIZ*(AUX1+2.D0*ARZ*AUX2)+ARZ*DSTH2IZ ENDIF * RVE= EI3-TQE*RSTH2 RVEZ= EI3-TQE*RSTH2Z ERVE= EI3-TQE*ST2EFF(1) IVE= -TQE*ISTH2 IVEZ= -TQE*ISTH2Z IVEZZ= VIM(1) VEM2= RVE*RVE+IVE*IVE VEM2Z= RVEZ*RVEZ+IVEZ*IVEZ * *-----PROPAGATORS RESIDUAL CORRECTIONS AND ANGULAR FACTORS * ZWD= S/ZM*WT DENS= SMZM2*SMZM2+ZWD*ZWD RCHI= SMZM2/DENS ICHI= -ZWD/DENS ICHIZ= -ZM*WT/DENS CHI2= S/DENS CHI2Z= ZM2/DENS CVFP= ZM2*WT*WT RACC= RALH*RCHI+IALH*ICHI IACC= RALH*ICHI-IALH*RCHI RARC= RALH*RCHI IAIC= IALH*ICHI RAIC= RALH*ICHI RACCZ= IALHZ*ICHIZ IACCZ= RALHZ*ICHIZ RARCZ= 0.D0 IAICZ= IALHZ*ICHIZ RAICZ= RALHZ*ICHIZ * *-----TYPE OF PARTICLE LOOP * 1 = E, 2 = MU, 3 = TAU, 4 = UP, 5 = C, 6 = D, 7 = S, 8 = B * IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN KMIN= 1 KMAX= 1 ELSE IF(OINDX.EQ.'MU') THEN KMIN= 2 KMAX= 2 ELSE IF(OINDX.EQ.'TA') THEN KMIN= 3 KMAX= 3 ELSE IF(OINDX.EQ.'HA') THEN KMIN= 4 KMAX= 8 ENDIF ELSE KMIN= 1 KMAX= 8 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN KMIN= 4 KMAX= 8 ENDIF * DO K=KMIN,KMAX IF(K.EQ.1) THEN KA= 1 ELSE KA= K-1 ENDIF * *-----CORRECTION FACTORS FOR THE CROSS SECTIONS FOR ALL *-----FERMIONIC FINAL STATES * *-----E * IF(K.EQ.1) THEN FM= EM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= -6.D0*EM2/S CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(1) ERHO= RHOEFF(1) EVI= VIM(1) EAI= AIM(1) * *-----MU * ELSE IF(K.EQ.2) THEN FM= MM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= ACMM CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(2) ERHO= RHOEFF(2) EVI= VIM(2) EAI= AIM(2) * *-----TAU * ELSE IF(K.EQ.3) THEN FM= TLM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= ACMT CORAQCD= 0.D0 CORAM= CAMT EST2= ST2EFF(3) ERHO= RHOEFF(3) EVI= VIM(3) EAI= AIM(3) * *-----UP * ELSE IF(K.EQ.4) THEN FM= UQM FI3= ZIU BQF= BQUQ BQFD= BQDQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORU+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(4) ERHO= RHOEFF(4) EVI= VIM(4) EAI= AIM(4) * *-----CHARM * ELSE IF(K.EQ.5) THEN FM= CQM FI3= ZIU BQF= BQUQ BQFD= BQDQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCMC ACORQ= ACORU+ODQCD ACM= ACMC CORAQCD= CAQCDC CORAM= CAMC EST2= ST2EFF(7) ERHO= RHOEFF(7) EVI= VIM(7) EAI= AIM(7) * *-----DOWN * ELSE IF(K.EQ.6) THEN FM= DQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORD+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(5) ERHO= RHOEFF(5) EVI= VIM(5) EAI= AIM(5) * *-----STRANGE * ELSE IF(K.EQ.7) THEN FM= SQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORD+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(6) ERHO= RHOEFF(6) EVI= VIM(6) EAI= AIM(6) * *-----BOTTOM * ELSE IF(K.EQ.8) THEN FM= BQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCMB ACORQ= ACORB+ODQCD ACM= ACMB CORAQCD= CAQCDB CORAM= CAMB ENDIF * CONVFC= CONVF*FNC RFM2= FM*FM/S SFI3= 2.D0*FI3 TQF= 2.D0*BQF BQF2= BQF*BQF * RVF= FI3-TQF*RSTH2 RVFZ= FI3-TQF*RSTH2Z ERVF= FI3-TQF*EST2 IVF= -TQF*ISTH2 IVFZ= -TQF*ISTH2Z IVFZZ= EVI VFM2= RVF*RVF+IVF*IVF VFM2Z= RVFZ*RVFZ+IVFZ*IVFZ * VMP2= VEM2+VFM2 VMP2Z= VEM2Z+VFM2Z VMT2= VEM2*VFM2 VMT2Z= VEM2Z*VFM2Z RVETVF= RVE*RVF RVETVFZ= RVEZ*RVFZ ERVETVF= ERVE*ERVF IVETVF= IVE*IVF IVETVFZ= IVEZ*IVFZ IVETVFZZ= IVEZZ*IVFZZ RVEIVF= RVE*IVF RVFIVE= RVF*IVE * IF(K.GE.4) THEN SINGVV= -0.5D0-2.D0/3.D0*RSTH2 SINGEE= 1.D0/3.D0 ALS3= (ALSR/PI)**3 VCORVV= VCOR-0.41318D0*ALS3*SINGVV/RVF VCOREE= VCOR-0.41318D0*ALS3*SINGEE/BQF VCOREV= VCOR-0.41318D0*ALS3*0.5D0*(SINGVV/RVF+SINGEE/BQF) ELSE VCORVV= 0.D0 VCOREE= 0.D0 VCOREV= 0.D0 ENDIF * *-----COMPUTES THE TOTAL AND THE FORW-BACK CROSS SECTIONS *-----BOXES EXCLUDED * RVAE= RVE*RVE+0.25D0 RVAEZ= RVEZ*RVEZ+0.25D0 ERVAE= ERVE*ERVE+0.25D0+VIM(1)*VIM(1)+AIM(1)*AIM(1) * IF(K.EQ.8) THEN SVV(J,K)= 64.D0*G4*CHI2*RVAE*RVF*RVF*DPT SVVH(J,K)= 64.D0*G4*(CHI2*RVAE*RVF*RVF- # CHI2Z*RVAEZ*RVFZ*RVFZ)*DPT SEE(J,K)= 64.D0*4.D0*PIS*BQF2*ALH2*DPT/S SEV(J,K)= -64.D0*4.D0*PI*G2*BQF*RARC*RVETVF*DPT SAA(J,K)= 16.D0*G4*CHI2*RVAE*DPT SAAH(J,K)= 16.D0*G4*(CHI2*RVAE-CHI2Z*RVAEZ)*DPT SVA(J,K)= 128.D0*FI3*G2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT ELSE EG2= GWEAK*SQRT(RHOEFF(1)*ERHO) EG4= EG2*EG2 SVVZ= 64.D0*EG4*CHI2Z*ERVAE*(ERVF*ERVF+EVI*EVI)*DPT SAAZ= 64.D0*EG4*CHI2Z*ERVAE*(0.25D0+EAI*EAI)*DPT SVAZ= 4.D0*EG4*CHI2Z*32.D0*DMT*( # ERVE*EAI*EVI-2.D0*ERVF*AIM(1)*VIM(1)*FI3+ # FI3*ERVETVF-2.D0*AIM(1)*VIM(1)*EAI*EVI) SVAZ= SVAZ+256.D0*PI*EG2*BQF*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*IACCZ)*DMT SEVZ= 256.D0*PI*BQF*EG2*(RACCZ*(IVETVFZZ-ERVETVF)+ # IACCZ*(ERVE*IVFZZ+ERVF*IVEZZ))*DPT SVV(J,K)= SVVZ+64.D0*G4*(CHI2*RVAE*RVF*RVF- # CHI2Z*RVAEZ*RVFZ*RVFZ)*DPT SVVH(J,K)= 64.D0*G4*(CHI2*RVAE*RVF*RVF- # CHI2Z*RVAEZ*RVFZ*RVFZ)*DPT SEE(J,K)= 256.D0*PIS*BQF2*ALH2*DPT/S SEV(J,K)= SEVZ+256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE))*DPT- # 256.D0*PI*G2*BQF*(RACCZ*(IVETVFZ-RVETVFZ)+ # IACCZ*(RVEZ*IVFZ+RVFZ*IVEZ))*DPT SAA(J,K)= SAAZ+16.D0*G4*(CHI2*RVAE-CHI2Z*RVAEZ)*DPT SAAH(J,K)= 16.D0*G4*(CHI2*RVAE-CHI2Z*RVAEZ)*DPT SVA(J,K)= SVAZ+128.D0*FI3*G2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT- # 128.D0*FI3*G4*CHI2Z*RVETVFZ*DMT ENDIF SLO(J,K)= SVV(J,K)+SEE(J,K)+SEV(J,K)+SAA(J,K) SLOH(J,K)= SVVH(J,K)+SEE(J,K)+SEV(J,K)+SAAH(J,K) SVVT(J,K)= SVV(J,K)+SEE(J,K)+SEV(J,K) SVVTH(J,K)= SVVH(J,K)+SEE(J,K)+SEV(J,K) * DSGG(J,K)= 256.D0*PIS*BQF2*ALH2*(1.D0+DELGG(J,KA))/S*DPT * IF(K.EQ.8) THEN DSZZ(J,K)= 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,KA))*DPT ELSE IF(K.GT.3.AND.K.LT.8) THEN DSZZ(J,K)= XSZ(KA)/CONVFC*CVFP/DENS+ # 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,KA))*DPT- # 4.D0*G4*CHI2Z*(1.D0+4.D0*(VMP2Z+4.D0*VMT2Z)+ # DELZZP(NRS,KA))*DPT ELSE IF(K.EQ.1) THEN DSZZ(J,K)= XSZE/CONVFC*CVFP/DENS+ # 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,KA))*DPT- # 4.D0*G4*CHI2Z*(1.D0+4.D0*(VMP2Z+4.D0*VMT2Z)+ # DELZZP(NRS,KA))*DPT ELSE IF(K.EQ.2) THEN DSZZ(J,K)= XSZM/CONVFC*CVFP/DENS+ # 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,KA))*DPT- # 4.D0*G4*CHI2Z*(1.D0+4.D0*(VMP2Z+4.D0*VMT2Z)+ # DELZZP(NRS,KA))*DPT ELSE IF(K.EQ.3) THEN DSZZ(J,K)= XSZT/CONVFC*CVFP/DENS+ # 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,KA))*DPT- # 4.D0*G4*CHI2Z*(1.D0+4.D0*(VMP2Z+4.D0*VMT2Z)+ # DELZZP(NRS,KA))*DPT ENDIF ENDIF IF(K.GT.3) THEN DSZZH(J,K)= XSZH/5.D0/CONVFC*CVFP/DENS+ # 4.D0*G4*CHI2*(1.D0+4.D0*(VMP2+4.D0*VMT2)+ # DELZZP(J,KA))*DPT- # 4.D0*G4*CHI2Z*(1.D0+4.D0*(VMP2Z+4.D0*VMT2Z)+ # DELZZP(NRS,KA))*DPT ELSE DSZZH(J,K)= 0.D0 ENDIF * IF(K.EQ.8) THEN AZZ(J,K)= 4.D0*G4*CHI2*(32.D0*FI3*RVETVF+DELZZM(J,KA))*DMT ELSE AZZZ= 4.D0*EG4*CHI2Z*32.D0*DMT*( # ERVE*EAI*EVI-2.D0*ERVF*AIM(1)*VIM(1)*FI3+ # FI3*ERVETVF-2.D0*AIM(1)*VIM(1)*EAI*EVI) AZZ(J,K)= AZZZ+ # 4.D0*G4*CHI2*(32.D0*FI3*RVETVF+DELZZM(J,KA))*DMT- # 4.D0*G4*CHI2Z*(32.D0*FI3*RVETVFZ+DELZZM(NRS,KA))* # DMT ENDIF * IF(K.EQ.8) THEN DSGZ(J,K)= 256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE)+0.5D0*(DELGZP1(J,KA)* # RARC+DELGZP2(J,KA)*RAIC+DELGZP3(J,KA)*IAIC+ # DELGZP4(J,KA)*RACC))*DPT ELSE DSGZZ= 256.D0*PI*BQF*EG2*(RACCZ*(IVETVFZZ-ERVETVF)+ # IACCZ*(ERVE*IVFZZ+ERVF*IVEZZ))*DPT* # (1.D0+0.5D0*DELGG(NRS,KA)) DSGZ(J,K)= DSGZZ+256.D0*PI*G2*BQF*(RACC*(IVETVF-RVETVF)+ # IACC*(RVE*IVF+RVF*IVE))*DPT+ # 128.D0*PI*G2*BQF*(DELGZP1(J,KA)* # RARC+DELGZP2(J,KA)*RAIC+DELGZP3(J,KA)*IAIC+ # DELGZP4(J,KA)*RACC)*DPT- # 256.D0*PI*G2*BQF*(RACCZ*(IVETVFZ-RVETVFZ)+ # IACCZ*(RVEZ*IVFZ+RVFZ*IVEZ))*DPT- # 128.D0*PI*G2*BQF*(DELGZP1(NRS,KA)* # RARCZ+DELGZP2(NRS,KA)*RAICZ+DELGZP3(NRS,KA)* # IAICZ+DELGZP4(NRS,KA)*RACCZ)*DPT ENDIF * IF(K.EQ.8) THEN AGZ(J,K)= -128.D0*PI*G2*BQF*FI3*RACC*DMT+128.D0*PI*G2*BQF*( # DELGZM1(J,KA)*RACC+DELGZM2(J,KA)*RAIC+ # DELGZM3(J,KA)*RARC+DELGZM4(J,KA)*IAIC)*DMT ELSE AGZZ= 256.D0*PI*EG2*BQF*(-(0.5D0*FI3+AIM(1)*EAI)*RACCZ+ # (0.5D0*EAI-AIM(1)*FI3)*IACCZ)* # (1.D0+0.5D0*DELGG(NRS,KA))*DMT * AGZ(J,K)= AGZZ- # 128.D0*PI*G2*BQF*FI3*RACC*DMT+ # 128.D0*PI*G2*BQF*FI3*RACCZ*DMT+ # 128.D0*PI*G2*BQF*(DELGZM1(J,KA)*RACC+DELGZM2(J,KA)* # RAIC+DELGZM3(J,KA)*RARC+DELGZM4(J,KA)*IAIC)*DMT- # 128.D0*PI*G2*BQF*( # DELGZM1(NRS,KA)*RACCZ+DELGZM2(NRS,KA)*RAICZ+ # DELGZM3(NRS,KA)*RARCZ+DELGZM4(NRS,KA)*IAICZ)*DMT ENDIF * IF(K.EQ.8) THEN XVAR= GWEAK/8.D0/PIS*TQM2/ZM2 XVAR2= XVAR*XVAR SVV4(J,K)= 64.D0*G4*CHI2*RVAE*XVAR2* # (2.D0*RVF*TCOR+1.D0)*DPT SAA4(J,K)= 64.D0*G4*CHI2*RVAE*XVAR2*(1.D0-TCOR)*DPT SVV4H(J,K)= 64.D0*G4*CHI2*RVAE*XVAR2* # (2.D0*RVF*TCOR+1.D0)*DPT- # 64.D0*G4*CHI2Z*RVAEZ*XVAR2* # (2.D0*RVFZ*TCOR+1.D0)*DPT SAA4H(J,K)= 64.D0*G4*CHI2*RVAE*XVAR2*(1.D0-TCOR)*DPT- # 64.D0*G4*CHI2Z*RVAEZ*XVAR2*(1.D0-TCOR)*DPT SVA4(J,K)= 128.D0*G4*CHI2*RVE*XVAR2*(1.D0-0.5D0* # (1.D0-2.D0*RVF)*TCOR)*DMT * CSTMQCD(J,K)= SVV(J,K)*VCORVV+SEE(J,K)*VCOREE+SEV(J,K)* # VCOREV+SVVT(J,K)*VCM+SAA(J,K)*(ACORQ+ACM)+ # 4.D0*G4*CHI2*DELZZP(J,KA)*DPT*ALSR/PI CSTMQCDH(J,K)= SVVH(J,K)*VCORVV+SEE(J,K)*VCOREE+SEV(J,K)* # VCOREV+SVVTH(J,K)*VCM+SAAH(J,K)*(ACORQ+ACM)+ # 4.D0*G4*CHI2*DELZZP(J,KA)*DPT*AEXPS- # 4.D0*G4*CHI2Z*DELZZP(NRS,KA)*DPT*AEXPM HVAR= GF/8.D0/PIS*TQM2*(-PIS/3.D0*ALST/PI) HVARS= -GF/24.D0*TQM2*ALST/PI SVVMIX(J,K)= 64.D0*G4*CHI2*RVAE*2.D0*RVF*HVAR*DPT SAAMIX(J,K)= -64.D0*G4*CHI2*RVAE*HVAR*DPT SVVMIXH(J,K)= 64.D0*G4*CHI2*RVAE*2.D0*RVF*HVAR*DPT- # 64.D0*G4*CHI2Z*RVAEZ*2.D0*RVFZ*HVAR*DPT SAAMIXH(J,K)= -64.D0*G4*CHI2*RVAE*HVAR*DPT+ # 64.D0*G4*CHI2Z*RVAEZ*HVAR*DPT SVAMIX(J,K)= 128.D0*G4*CHI2*RVE*HVARS*(RVF-0.5D0)*DMT CKCORR(J,K)= 0.D0 ELSE CSTMQCD(J,K)= SVV(J,K)*VCORVV+SEE(J,K)*VCOREE+SEV(J,K)* # VCOREV+SVVT(J,K)*VCM+SAA(J,K)*(ACORQ+ACM) CSTMQCDH(J,K)= SVVH(J,K)*VCORVV+SEE(J,K)*VCOREE+SEV(J,K)* # VCOREV+SVVTH(J,K)*VCM+SAAH(J,K)*(ACORQ+ACM) SVV4(J,K)= 0.D0 SAA4(J,K)= 0.D0 SVA4(J,K)= 0.D0 SVVMIX(J,K)= 0.D0 SAAMIX(J,K)= 0.D0 SVAMIX(J,K)= 0.D0 IF(K.GE.4) THEN CKCORR(J,K)= XNFACT(KA)/CONVFC*CVFP/DENS CKCORRH(J,K)= 0.D0 ELSE CKCORR(J,K)= 0.D0 ENDIF ENDIF * *-----QED FINAL STATE CORRECTIONS ARE EXACT ALSO FOR A CUT ON THE * FINAL STATE INVARIANT MASS * IF(K.LE.3) THEN CQEDFPB(J,K)= 3.D0*AR*BQF2 ELSE CQEDFPB(J,K)= AR*BQF2*(3.D0-AEXPS) ENDIF * CSTH(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZH(J,K)+ # CSTMQCDH(J,K)+CKCORRH(J,K)+CQEDFPB(J,K)*SLOH(J,K)+ # SVV4H(J,K)+SAA4H(J,K)+SVVMIXH(J,K)+SAAMIXH(J,K))+ # FNC*(FBOX(J,KA)+BBOX(J,KA)) IF(K.LE.3) THEN IF(ONPAR.EQ.'NP') THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCDH(J,K)+CKCORR(J,K)+CQEDFPB(J,K)*SLOH(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K))+ # FNC*(FBOX(J,KA)+BBOX(J,KA)) ELSE IF(ONPAR.EQ.'FP') THEN CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCD(J,K)+CKCORR(J,K)+CQEDFPB(J,K)*SLOH(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K))+ # FNC*(FBOX(J,KA)+BBOX(J,KA)) ENDIF ELSE CST(J,K)= CONVFC*(DSGG(J,K)+DSGZ(J,K)+DSZZ(J,K)+ # CSTMQCD(J,K)+CKCORR(J,K)+CQEDFPB(J,K)*SLO(J,K)+ # SVV4(J,K)+SAA4(J,K)+SVVMIX(J,K)+SAAMIX(J,K))+ # FNC*(FBOX(J,KA)+BBOX(J,KA)) ENDIF CSFMB(J,K)= CONVFC*(AGZ(J,K)+AZZ(J,K)+ # SVA(J,K)*(CORAQCD+CORAM)+SVA4(J,K)+ # SVAMIX(J,K))+FNC*(FBOX(J,KA)-BBOX(J,KA)) * ENDDO ENDDO * *-----OUTPUT IS: E,MU,TAU F+B / E,MU,TAU F-B / U+C F+B / D+S F+B / HAD F+B * DO J=1,NRS OSIGMA(J,1)= CST(J,1) OSIGMA(J,2)= CST(J,2) OSIGMA(J,3)= CST(J,3) OSIGMA(J,4)= CSFMB(J,1) OSIGMA(J,5)= CSFMB(J,2) OSIGMA(J,6)= CSFMB(J,3) OSIGMA(J,7)= CST(J,4)+CST(J,5) OSIGMA(J,8)= CST(J,6)+CST(J,7) OSIGMA(J,9)= CST(J,8) OSIGMA(J,10)= CSTH(J,4)+CSTH(J,5)+CSTH(J,6)+CSTH(J,7)+ # CSTH(J,8) ENDDO * RETURN END * *---------------------------------------------------------------------------- * SUBROUTINE TFUBF0(NDIM,ZZ,NFN,F) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OHC,ORAD,OBHABHA,OREST CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NO=10) PARAMETER(NFL=4,NL=3) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/TSNOM/NBSM COMMON/TSUP/OMODES COMMON/TICOUPLING/NF COMMON/TECM/RS(MNRS) COMMON/TNOM/NOBSS,NOBSM COMMON/TXVARF/SEPS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TS0F/SIGMA0(MNRS,NO),SIGMA1(MNRS,NO) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION ZZ(NDIM),F(NFN),SIGMA(MNRS,NO),RSH(MNRS),RAD(MNRS), # RADFB(MNRS) * IF(OHC.EQ.'Y') THEN A2L0= APIS A1L0= API X= XMED*ZZ(1) XL= LOG(X) OMXL= LOG(1.D0-X) * *-----REDUCED ENERGIES * DO J=1,NRS RSH(J)= SQRT(1.D0-X)*RS(J) ENDDO * CALL TOBSFIT(NRS,NOBSM,RSH,SIGMA,RS) * *-----THE HARD CONSTANTS * Z= 1.D0-X ZS= Z*Z OMZ= X OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZL= LOG(OMZ) ZL02= OMZL*OMZL OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) ZL20= ZL*ZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL-ZL20)+ # OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)*ZL11- # 25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)*RZ2+ # (1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/OMZ* # (1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) * DO J=1,NRS A2L2= APIS*RL(J)*RL(J) A2L1= APIS*RL(J) A1L1= API*RL(J) RLM1= RL(J)-1.D0 SP1= A2L2*(HR2-OPZ*(2.D0*OMZL+1.5D0)) SP2= A2L1*(HR1-OPZ*(-4.D0*OMZL-1.5D0+2.D0*RZ2-2.D0)) SP3= A2L0*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -A1L1*OPZ SP5= A1L0*OPZ RH= SP1+SP2+SP3+SP4+SP5 RH3= -27.D0/2.D0+15.D0/4.D0*OMZ+4.D0*(1.D0-0.5D0*OMZ) # *(PIS-6.D0*OMZL**2+3.D0*S11) # +3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0*OMZ) # +ZL**2*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ) # -6.D0*OMZL*(6.D0-OMZ) # +6.D0*OMZL*ZL*(6.D0-4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETA(J)**3/48.D0 RH1FB= BETA(J)/2.D0/X*(1.D0+ZS-2.D0*OPZS/4.D0/Z) # -API*(LOG(4.D0*Z/OPZS)) RH1FB= RH1FB*4.D0*Z/OPZS RH2S= 1.D0/8.D0*BETA(J)*BETA(J)*(OPZ* # (3.D0*OMXL-4.D0*XL)-4.D0/X*OMXL-6.D0+X) SOMX= SQRT(Z) RH2FB= X**3/2.D0/Z+X**2/SOMX*(ATAN(1.D0/SOMX)-ATAN(SOMX)) # -OPZ*LOG(Z)+2.D0*X RH2FB= RH2FB*(API/2.D0*RL(J))**2 RH2FB= RH2FB+RH2S RH2FB= RH2FB*4.D0*Z/OPZS YH0= 0.5D0*(1.D0+ZS) YHA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA(J) # +1.D0/8.D0*(4.D0*(1.D0+ZS)*(S11+OMZL*ZL) # -(1.D0+3.D0*ZS)*ZL20+2.D0*(3.D0+2.D0*Z+ZS)*ZL # +2.D0*OMZ*(3.D0-2.D0*Z)) YHA= API*YHA YHB= 1.D0/8.D0*BETA(J)*(-(1.D0+3.D0*ZS)*ZL-2.D0*OMZ2) YHB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ZL20+0.5D0*OMZ* # (1.D0-3.D0*Z)*ZL+OMZ2+(1.D0-ZS)*S11 YHB2= 1.D0/8.D0*BETA(J)**2*YHB2 * IF(ORAD.EQ.'A') THEN RAD(J)= SDELTA(J)*BETA(J)*X**(BETA(J)-1.D0)+RH ELSE IF(ORAD.EQ.'D') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= BETA(J)*X**(BETA(J)-1.D0)*FGL*EXP(AD1(J))* # ADD(J)+RH ELSE IF(ORAD.EQ.'E') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= 0.5D0*OPZ2*BETA(J)*X**(BETA(J)-1.D0)*FGL* # EXP(AD1(J))*ADD(J)+A2L2*HR2+A2L1*HR1+A2L0*HR0 ELSE IF(ORAD.EQ.'F') THEN RAD(J)= (SDELTA(J)+SDELTA3(J))*BETA(J)*X**(BETA(J)-1.D0) # +RH+RH3 ELSE IF(ORAD.EQ.'Y') THEN ARGE= (3.D0/4.D0-EGAM)*BETA(J)+API*(2.D0*RZ2-0.5D0) ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= BETA(J)*X**(BETA(J)-1.D0)*FGL # *(YH0+YHA+YHB+YHB2) ENDIF RADFB(J)= SDELTA(J)*BETA(J)*X**(BETA(J)-1.D0)+RH1FB+RH2FB ENDDO * DO I3=1,NBSM IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 5 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 3 ELSE IF(I3.EQ.2) THEN I2= 6 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+6 ENDIF ELSE I2= I3 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN I2= I3+6 ENDIF * DO I1=1,NRS I= NRS*(I3-1)+I1 IF((OEXT.EQ.'E'.AND. # (I2.EQ.4.OR.I2.EQ.5.OR.I2.EQ.6))) THEN F(I)= XMED*(SIGMA(I1,I2)-SIGMA0(I1,I2))*RADFB(I1) ELSE F(I)= XMED*(SIGMA(I1,I2)-SIGMA0(I1,I2))*RAD(I1) ENDIF ENDDO ENDDO * ELSE IF(OHC.EQ.'N') THEN X= XMED*ZZ(1) XL= LOG(X) OMXL= LOG(1.D0-X) * *-----REDUCED ENERGIES * DO J=1,NRS RSH(J)= SQRT(1.D0-X)*RS(J) ENDDO * CALL TOBSFIT(NRS,NOBSM,RSH,SIGMA,RS) * DO J=1,NRS RH1= -0.5D0*BETA(J)*(2.D0-X) RH2= 1.D0/8.D0*BETA(J)*BETA(J)*((2.D0-X)* # (3.D0*OMXL-4.D0*XL)-4.D0/X*OMXL-6.D0+X) * RAD(J)= SDELTA(J)*BETA(J)*X**(BETA(J)-1.D0)+ # RH1+RH2 ENDDO * DO I3=1,NBSM IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 5 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 3 ELSE IF(I3.EQ.2) THEN I2= 6 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+6 ENDIF ELSE I2= I3 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN I2= I3+6 ENDIF * DO I1=1,NRS I= NRS*(I3-1)+I1 F(I)= XMED*(SIGMA(I1,I2)-SIGMA0(I1,I2))* # RAD(I1) ENDDO ENDDO * ENDIF * RETURN END * *------------------------------------------------------------------------------ * SUBROUTINE TFUBF1(NDIM,ZZ,NFN,F) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*1 OHC,ORAD,OBHABHA,OREST CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT CHARACTER*2 OINDX CHARACTER*4 OMODES * PARAMETER(MNRS=30,NO=10) PARAMETER(NFL=4,NL=3) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TMED/XMED COMMON/TCNRS/NRS COMMON/TSNOM/NBSM COMMON/TSUP/OMODES COMMON/TICOUPLING/NF COMMON/TECM/RS(MNRS) COMMON/TNOM/NOBSS,NOBSM COMMON/TXVARF/SEPS(MNRS) COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TBHABHA/OBHABHA,OINDX,OREST COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TS0F/SIGMA0(MNRS,NO),SIGMA1(MNRS,NO) COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION ZZ(NDIM),F(NFN),SIGMA(MNRS,NO),X(MNRS), # XL(MNRS),OMXL(MNRS),RAD(MNRS),RSH(MNRS), # RADFB(MNRS) * OMXMED= 1.D0-XMED IF(OHC.EQ.'Y') THEN A2L0= APIS A1L0= API * *-----MUONS, TAUS AND QUARKS HAVE HERE THE SAME THRESHOLDS * DO J=1,NRS A2L2= APIS*RL(J)*RL(J) A2L1= APIS*RL(J) A1L1= API*RL(J) BETAH= 0.5D0*BETA(J) BETAS= 1.D0/8.D0*BETA(J)*BETA(J) BETAM1= BETA(J)-1.D0 SBETA= SDELTA(J)*BETA(J) SBETA3= SDELTA3(J)*BETA(J) X(J)= (OMXMED-SEPS(J))*ZZ(1)+XMED XL(J)= LOG(X(J)) OMXL(J)= LOG(1.D0-X(J)) * *-----THE HARD CONSTANTS * Z= 1.D0-X(J) ZS= Z*Z OMZ= X(J) OPZ= 1.D0+Z OPZS= OPZ*OPZ OMZ2= OMZ*OMZ OPZ2= 1.D0+Z*Z ZL= LOG(Z) OMZL= LOG(OMZ) ZL20= ZL*ZL ZL02= OMZL*OMZL ZL30= ZL20*ZL ZL11= ZL*OMZL ZL21= ZL20*OMZL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) ZPLA= ZL*S11 ZPLB= OMZL*S11 * HR2= -OPZ2/OMZ*ZL+0.5D0*OPZ*ZL+Z-1.D0 HR1= OPZ2/OMZ*(S11+ZL11+3.5D0*ZL-0.5D0*ZL20)+ # 0.25D0*OPZ*ZL20-ZL+3.5D0-3.D0*Z HR0= OPZ2/OMZ*(-ZL30/6.D0+0.5D0*ZPLA+0.5D0*ZL21- # 1.5D0*S11-1.5D0*ZL11+RZ2*ZL-17.D0/6.D0*ZL- # ZL20)+OPZ*(1.5D0*S21-2.D0*S12-ZPLB-0.5D0)- # 0.25D0*(1.D0-5.D0*Z)*ZL02+0.5D0*(1.D0-7.D0*Z)* # ZL11-25.D0/6.D0*Z*S11+(-1.D0+13.D0/3.D0*Z)* # RZ2+(1.5D0-Z)*OMZL+(11.D0+10.D0*Z)/6.D0*ZL+ # 2.D0/OMZ2*ZL20-25.D0/11.D0*Z*ZL20-2.D0/3.D0*Z/ # OMZ*(1.D0+2.D0/OMZ*ZL+ZL20/OMZ2) * RLM1= RL(J)-1.D0 SP1= A2L2*(HR2-OPZ*(2.D0*OMZL+1.5D0)) SP2= A2L1*(HR1-OPZ*(-4.D0*OMZL-1.5D0+ # 2.D0*RZ2-2.D0)) SP3= A2L0*(HR0-OPZ*(2.D0*OMZL-2.D0*RZ2+2.D0)) SP4= -A1L1*OPZ SP5= A1L0*OPZ RH= SP1+SP2+SP3+SP4+SP5 RH3= -27.D0/2.D0+15.D0/4.D0*OMZ+4.D0*(1.D0- # 0.5D0*OMZ)*(PIS-6.D0*OMZL**2+3.D0*S11)+ # 3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0*OMZ)+ # ZL20*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ)- # 6.D0*OMZL*(6.D0-OMZ)+6.D0*OMZL*ZL*(6.D0- # 4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETA(J)**3/48.D0 RH1FB= BETA(J)/2.D0/X(J)*(1.D0+ZS- # 2.D0*OPZS/4.D0/Z)-API*(LOG(4.D0*Z/OPZS)) RH1FB= RH1FB*4.D0*Z/OPZS RH2S= 1.D0/8.D0*BETA(J)*BETA(J)*(OPZ* # (3.D0*OMXL(J)-4.D0*XL(J))- # 4.D0/X(J)*OMXL(J)-6.D0+X(J)) SOMX= SQRT(Z) RH2FB= X(J)**3/2.D0/Z+X(J)**2/SOMX* # (ATAN(1.D0/SOMX)-ATAN(SOMX))- # OPZ*LOG(Z)+2.D0*X(J) RH2FB= RH2FB*(API/2.D0*RL(J))**2 RH2FB= RH2FB+RH2S RH2FB= RH2FB*4.D0*Z/OPZS YH0= 0.5D0*(1.D0+ZS) YHA= (3.D0/32.D0-3.D0/4.D0*RZ2+1.5D0*RZ3)*BETA(J) # +1.D0/8.D0*(4.D0*(1.D0+ZS)*(S11+OMZL*ZL) # -(1.D0+3.D0*ZS)*ZL20+2.D0*(3.D0+2.D0*Z+ZS)*ZL # +2.D0*OMZ*(3.D0-2.D0*Z)) YHA= API*YHA YHB= 1.D0/8.D0*BETA(J)*(-(1.D0+3.D0*ZS)*ZL # -2.D0*OMZ2) YHB2= 1.D0/12.D0*(1.D0+7.D0*ZS)*ZL20 # +0.5D0*OMZ*(1.D0-3.D0*Z)*ZL # +OMZ2+(1.D0-ZS)*S11 YHB2= 1.D0/8.D0*BETA(J)**2*YHB2 * IF(ORAD.EQ.'A') THEN RAD(J)= SBETA*X(J)**BETAM1+RH ELSE IF(ORAD.EQ.'D') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= BETA(J)*X(J)**(BETA(J)-1.D0)* # FGL*EXP(AD1(J))*ADD(J)+RH ELSE IF(ORAD.EQ.'E') THEN ARGE= -BETA(J)*EGAM ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= 0.5D0*OPZ2*BETA(J)*X(J)** # (BETA(J)-1.D0)*FGL*EXP(AD1(J))* # ADD(J)+A2L2*HR2+A2L1*HR1+A2L0*HR0 ELSE IF(ORAD.EQ.'F') THEN RAD(J)= (SBETA+SBETA3)*X(J)**BETAM1 # +RH+RH3 ELSE IF(ORAD.EQ.'Y') THEN ARGE= (3.D0/4.D0-EGAM)*BETA(J)+ # API*(2.D0*RZ2-0.5D0) ARGG= 1.D0+BETA(J) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB RAD(J)= BETA(J)*X(J)**(BETA(J)-1.D0)*FGL # *(YH0+YHA+YHB+YHB2) ENDIF RADFB(J)= SDELTA(J)*BETA(J)*X(J)**(BETA(J) # -1.D0)+RH1FB+RH2FB ENDDO * *-----REDUCED ENERGIES * DO J=1,NRS RSH(J)= SQRT(1.D0-((OMXMED-SEPS(J))*ZZ(1)+ # XMED))*RS(J) ENDDO * CALL TOBSFIT(NRS,NOBSM,RSH,SIGMA,RS) * DO I3=1,NBSM IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 5 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 3 ELSE IF(I3.EQ.2) THEN I2= 6 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+6 ENDIF ELSE I2= I3 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN I2= I3+6 ENDIF * DO I1=1,NRS I= NRS*(I3-1)+I1 IF((OEXT.EQ.'E'.AND. # (I2.EQ.4.OR.I2.EQ.5.OR.I2.EQ.6))) THEN F(I)= (OMXMED-SEPS(I1))*SIGMA1(I1,I2)* # (SIGMA(I1,I2)/SIGMA1(I1,I2)-1.D0)*RADFB(I1) ELSE F(I)= (OMXMED-SEPS(I1))*SIGMA1(I1,I2)* # (SIGMA(I1,I2)/SIGMA1(I1,I2)-1.D0)*RAD(I1) ENDIF ENDDO ENDDO * ELSE IF(OHC.EQ.'N') THEN DO J=1,NRS X(J)= (OMXMED-SEPS(J))*ZZ(1)+XMED XL(J)= LOG(X(J)) OMXL(J)= LOG(1.D0-X(J)) ENDDO * *-----REDUCED ENERGIES * DO J=1,NRS RSH(J)= SQRT(1.D0-X(J))*RS(J) ENDDO * CALL TOBSFIT(NRS,NOBSM,RSH,SIGMA,RS) * DO J=1,NRS BETAH= 0.5D0*BETA(J) BETAS= 1.D0/8.D0*BETA(J)*BETA(J) BETAM1= BETA(J)-1.D0 SBETA= SDELTA(J)*BETA(J) DO I=1,NOBSM RH1= -BETAH*(2.D0-X(J)) RH2= BETAS*((2.D0-X(J))*(3.D0*OMXL(J)- # 4.D0*XL(J))-4.D0/X(J)*OMXL(J)- # 6.D0+X(J)) * RAD(J)= SBETA*X(J)**BETAM1+RH1+RH2 ENDDO ENDDO * DO I3=1,NBSM IF(OMODES.EQ.'FITE') THEN IF(OBHABHA.EQ.'R') THEN IF(OINDX.EQ.'EL') THEN IF(I3.EQ.1) THEN I2= 1 ELSE IF(I3.EQ.2) THEN I2= 4 ENDIF ELSE IF(OINDX.EQ.'MU') THEN IF(I3.EQ.1) THEN I2= 2 ELSE IF(I3.EQ.2) THEN I2= 5 ENDIF ELSE IF(OINDX.EQ.'TA') THEN IF(I3.EQ.1) THEN I2= 3 ELSE IF(I3.EQ.2) THEN I2= 6 ENDIF ELSE IF(OINDX.EQ.'HA') THEN I2= I3+6 ENDIF ELSE I2= I3 ENDIF ELSE IF(OMODES.EQ.'FITC'.AND.OBHABHA.EQ.'N') THEN I2= I3+6 ENDIF * DO I1=1,NRS I= NRS*(I3-1)+I1 F(I)= (OMXMED-SEPS(I1))*SIGMA1(I1,I2)* # (SIGMA(I1,I2)/SIGMA1(I1,I2)-1.D0)*RAD(I1) ENDDO ENDDO * ENDIF * RETURN END * *------------------------------------------------------------------------------ * REAL*8 FUNCTION TPRADF(I,II,X,OMX) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*1 OHC,ORAD,OPRAD,OCHAN CHARACTER*1 OWEAK,OEXT,OTHRE,OTHRMT,OPREC,OIFAIL * EXTERNAL D01EAF,THYFS,THRADA * PARAMETER(NDM=1,NFN=1,IRCLS=2**NDM+2*NDM*NDM+2*NDM+1, # MNCLS=0,MXCLS=5000*IRCLS, # LENWRK0=6*NDM+9*NFN+(NDM+NFN+2)*(1+MXCLS/IRCLS), # LENWRK=10*LENWRK0) PARAMETER(MNRS=30) PARAMETER(NFL=4,NL=3) * DIMENSION YL(NDM),YU(NDM),YFSH(NFN),EYFSH(NFN),WRKSTR(LENWRK) * COMMON/THC/OHC COMMON/TOR/ORAD COMMON/TP/OPREC COMMON/TOPR/OPRAD COMMON/TIFL/OIFAIL COMMON/TCHAN/OCHAN COMMON/TXLM/XX,BETAI COMMON/TICOUPLING/NF COMMON/TSDRL/RLJ,SDELTAI COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TMONITOR/OWEAK,OEXT,OTHRE,OTHRMT COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) COMMON/TWA/WRKSTR * IF(OPREC.EQ.'H') THEN MNCLSA= 1000 ELSE MNCLSA= MNCLS ENDIF * IF(OHC.EQ.'Y') THEN BL= RL(I) BLM1= BL-1.D0 X2= X*X OMX2= OMX*OMX RLX= LOG(X) RLOMX= LOG(OMX) RLX2= RLX*RLX RLOMX2= RLOMX*RLOMX RLOMX3= RLOMX2*RLOMX CALL TPOLYL(X,OMX,S11,S12,S13,S21,S22) S112= S11*S11 * IF(OEXT.EQ.'E'.AND.OPRAD.EQ.'E'.AND. # (II.EQ.4.OR.II.EQ.5.OR.II.EQ.6)) THEN X2= X*X OMXL= LOG(OMX) SOMX= SQRT(OMX) EPS= -1.D-37 RLI2X= TRSPENCE(X,EPS) XL= LOG(X) ARGD= OMX/(2.D0-X) DLARGD= TRSPENCE(ARGD,EPS) DLOH= TRSPENCE(0.5D0,EPS) PRADFB1= BETA(I)/2.D0*(4.D0*(0.5D0-X-1.D0/(2.D0-X) # +1.5D0*LOG(2.D0/(2.D0-X)))) # -API*4.D0*(2.D0*LOG(2.D0)*(LOG(2.D0/(2.D0-X)) # +0.5D0-1.D0/(2.D0-X)) # -RLOMX*(-OMX/(2.D0-X)+LOG(2.D0-X)) # -1.5D0*((LOG(2.D0))**2-(LOG(2.D0-X))**2) # +X/(2.D0-X)*(LOG(2.D0-X)+1.D0) # +DLARGD-DLOH) PRAD2S= 1.D0/8.D0*BETA(I)*BETA(I)*(-2.5D0*X+0.25D0*X2- # 6.D0*OMXL+6.D0*X*OMXL-1.5D0*X2*OMXL+1.5D0*OMXL- # 8.D0*X*XL+2.D0*X2*XL+4.D0*RLI2X) PRADFB2= (API/2.D0*RL(I))**2* # (8.D0+20.D0/3.D0*X+X2-16.D0/(2.D0-X) # +48.D0*(PIS/16.D0-(ATAN(SOMX))**2) # +4.D0*(-2.D0/3.D0*(11.D0+X)*SOMX # -4.D0*SOMX/(2.D0-X)+12.D0*ATAN(SOMX)) # *(ATAN(SOMX)-ATAN(1.D0/SOMX) ) # -104.D0/3.D0*LOG(2.D0/(2.D0-X)) # -4.D0*LOG(OMX)*(LOG(2.D0-X)+X-1.D0) # +4.D0*(DLARGD-DLOH) # +2.D0*((LOG(2.D0-X))**2-(LOG(2.D0))**2)) PRADFB2= PRAD2S+PRADFB2 TPRADF= SDELTA(I)*X**BETA(I)+PRADFB1+PRADFB2 ELSE * BX2= RLOMX*OMX*(-1.5D0)+RLOMX*OMX2*(-0.75D0)+ # S11*(2.D0)+OMX*(2.5D0)+OMX2*(-0.125D0)- # 19.D0/8.D0 BX1= RLX*RLOMX*OMX+RLX*RLOMX*OMX2*(0.5D0)+ # RLX*S11*(-2.D0)-RLX*OMX+RLX*OMX2*(-0.25D0)+ # RLX*(1.25D0)+RLOMX*OMX*(6.D0)+ # RLOMX*OMX2*(17.D0/8.D0)+RLOMX2*OMX*(-0.75D0)+ # RLOMX2*OMX2*(-0.375D0)+S11*OMX BX1= BX1+S11*OMX2*(0.5D0)+S11*(-7.D0)+ # S21*(4.D0)+S12*(-2.D0)+OMX*(-33.D0/4.D0)+ # OMX2*(9.D0/16.D0)+123.D0/16.D0 BX0= RLOMX2*OMX2/X2*(1.D0/3.D0)+RLOMX*OMX/X* # (2.D0/3.D0)+RLOMX2*OMX/X*(-2.D0)+ # RLX*RLOMX*OMX*(-1.5D0)+RLX*RLOMX*OMX2+ # RLX*RLOMX2*OMX*(0.5D0)+RLX*RLOMX2*OMX2* # (0.25D0)+RLX*S11*OMX+RLX*S11*OMX2*(0.5D0)+ # RLX*S11*(1.5D0)+RLX*S12*(2.D0) BX0= BX0+RLX*OMX*(0.75D0)+RLX*OMX2*(0.625D0)+ # RLX*(-11.D0/8.D0)+RLX2*OMX*(0.25D0)+ # RLX2*OMX2*(-0.625D0)+RLX2*(0.375D0)+ # RLOMX*S11*OMX*(0.5D0)+RLOMX*S11*OMX2* # (0.25D0)+RLOMX*OMX*(-1.D0/12.D0+RZ2)+ # RLOMX*OMX2*(-685.D0/264.D0+0.5D0*RZ2) BX0= BX0+RLOMX2*OMX*(-2.D0)+RLOMX2*OMX2* # (45.D0/88.D0)+RLOMX3*OMX*(-1.D0/6.D0)+ # RLOMX3*OMX2*(-1.D0/12.D0)+S11*OMX* # (-1.25D0)+S11*OMX2*(4.D0/3.D0)+ # S11*(101.D0/12.D0-2.D0*RZ2)+S112*(-0.5D0)+ # S21*OMX*(-1.5D0)+S21*OMX2*(-0.75D0) BX0= BX0+S21*(-15.D0/4.D0)+S12*OMX*(2.D0)+ # S12*OMX2+S12*(-7.D0)+S13*(2.D0)+ # S22*(-2.D0)+OMX*(-35.D0/24.D0)+ # OMX2*(163.D0/132.D0-29.D0/12.D0*RZ2)+ # 49.D0/88.D0+29.D0/12.D0*RZ2 * IF(ORAD.EQ.'A') THEN PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0-2.D0*BLM1*BLM1*X* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*X*(2.D0-0.5D0*X)) TPRADF= SDELTA(I)*X**BETA(I)+PRAD1+PRAD2 * ELSE IF(ORAD.EQ.'D') THEN PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0+X*(-2.D0*BLM1*BLM1* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*(2.D0-0.5D0*X))) ARGE= -BETA(I)*EGAM ARGG= 1.D0+BETA(I) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB TPRADF= X**BETA(I)*FGL*EXP(AD1(I))*ADD(I)+PRAD1+PRAD2 ELSE IF(ORAD.EQ.'E') THEN PRAD2= APIS*((BX2*BL+BX1)*BL+BX0) BETAI= BETA(I) ARGE= -BETA(I)*EGAM ARGG= 1.D0+BETA(I) IFG= 1 GAMB= S14AAF(ARGG,IFG) FGL= EXP(ARGE)/GAMB TPRADF= X**BETAI*(1.D0-BETAI/(BETAI+1.D0)*X+0.5D0*BETAI/ # (BETAI+2.D0)*X*X)*FGL*EXP(AD1(I))*ADD(I)+PRAD2 ELSE IF(ORAD.EQ.'F') THEN PRAD1= -0.5D0*BETA(I)*X*(2.D0-0.5D0*X) PRAD2= APIS*((BX2*BL+BX1)*BL+BX0-2.D0*BLM1*BLM1*X* # (2.D0*(RLX-1.D0)-0.5D0*X*(RLX-0.5D0))-BLM1* # (1.5D0*BL+2.D0*RZ2-2.D0)*X*(2.D0-0.5D0*X)) S121= RZ3 S11OMX= -S11-RLX*RLOMX+RZ2 S12OMX= -S21+RLX*S11+0.5D0*RLOMX*RLX2+RZ3 PRAD3= (13.D0/8.D0-PIS)*X2+(4.D0*PIS-5.D0)*X # -9.D0/2.D0*PIS-24.D0*S121 # +6.D0*X*(X-4.D0)*RLX2 # +3.D0*X*(X/2.D0-5.D0)*RLX+7.D0*(X2/4.D0-X # +3.D0/4.D0)*RLOMX2 # +(-X2+15.D0/2.D0*X-13.D0/2.D0)*RLOMX # -12.D0*RLX2*RLOMX # +9.D0*X*(4.D0-X)*RLX*RLOMX # +(-3.D0*X2+12.D0*X+18.D0)*S11 # +27.D0*S11OMX+8.D0*S12+24.D0*S12OMX PRAD3= PRAD3*BETA(I)**3/48.D0 TPRADF= (SDELTA(I)+SDELTA3(I))*X**BETA(I)+ # PRAD1+PRAD2+PRAD3 * ELSE IF(ORAD.EQ.'Y') THEN XX= X BETAI= BETA(I) DO JJ=1,NDM YL(JJ)= 0.D0 YU(JJ)= 1.D0 ENDDO DO JJ=1,NFN YFSH(JJ)= 0.D0 EYFSH(JJ)= 0.D0 ENDDO MULFAC= 2**NDM MINCLS= MNCLSA MAXCLS= MXCLS AEQ= 0.D0 REQ= 1.D-8 40 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NDM,YL,YU,MINCLS,MAXCLS,NFN,THYFS,AEQ,REQ, # LENWRK,WRKSTR,YFSH,EYFSH,IFAIL) IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY TPRADF ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLS= -1 MAXCLS= MAXCLS*MULFAC GO TO 40 ENDIF TPRADF= YFSH(1) ENDIF ENDIF * ELSE IF(OHC.EQ.'N') THEN X2= X*X OMXL= LOG(OMX) EPS= -1.D-37 RLI2X= TRSPENCE(X,EPS) XL= LOG(X) * PRAD1= -0.5D0*BETA(I)*(2.D0*X-0.5D0*X2) PRAD2= 1.D0/8.D0*BETA(I)*BETA(I)*(-2.5D0*X+0.25D0*X2- # 6.D0*OMXL+6.D0*X*OMXL-1.5D0*X2*OMXL+1.5D0*OMXL- # 8.D0*X*XL+2.D0*X2*XL+4.D0*RLI2X) * TPRADF= SDELTA(I)*X**BETA(I)+PRAD1+PRAD2 * ENDIF * RETURN END * *-----EXPONENTIATED PAIRS FOR EXTRAPOLATED SETUP * SUBROUTINE TEPAIRS(NRS,NFL,WT) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM,KM CHARACTER*1 OIFAIL * PARAMETER(MNRS=30,MNFL=4) PARAMETER(NV=1,NFNM=12*MNRS,IRCLSV=2**NV+2*NV*NV+ # 2*NV+1,MNCLSV=0,MXCLSV=500*IRCLSV) PARAMETER(NS=1,IRCLSS=2**NS+2*NS*NS+ # 2*NS+1,MNCLSS=0,MXCLSS=500*IRCLSS) PARAMETER(NH=2,IRCLSH=2**NH+2*NH*NH+ # 2*NH+1,MNCLSH=0,MXCLSH=500*IRCLSH, # LENWRK0=6*NH+9*NFNM+(NH+NFNM+2)*(1+ # MXCLSH/IRCLSH),LENWRK=10*LENWRK0) * COMMON/TSEP/SEPA COMMON/TIFL/OIFAIL COMMON/TECM/RS(MNRS) COMMON/TEPP/EDEL(MNRS,MNFL) COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS * DIMENSION EDELE(MNRS,MNFL),EDELMU(MNRS,MNFL),EDELH(MNRS,MNFL) DIMENSION XLV(NV),XUV(NV),AESTV(NFNM),ESTV(NFNM),WRKSTR(LENWRK) DIMENSION XLS(NS),XUS(NS),AESTS(NFNM),ESTS(NFNM) DIMENSION XLH(NH),XUH(NH),AESTH(NFNM),ESTH(NFNM) COMMON/TWA/WRKSTR * EXTERNAL D01EAF,TPPV,TPPS,TPPH * DO L=1,MNFL DO I=1,MNRS EDEL(I,L)= 0.D0 ENDDO ENDDO API2= API*API Z2= RZ2 Z3= RZ3 ZW= WT NFN= 12*NRS * DO I=1,NV XLV(I)= 0.D0 XUV(I)= 1.D0 ENDDO * MULFAC= 10 * MINCLSV= MNCLSV MAXCLSV= MXCLSV AEQ= 0.D0 * REQ= 1.D-4 REQ= 1.D-2 1 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NV,XLV,XUV,MINCLSV,MAXCLSV,NFN,TPPV,AEQ,REQ, # LENWRK,WRKSTR,ESTV,AESTV,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EPAIRS ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLSV= -1 MAXCLSV= MAXCLSV*MULFAC GO TO 1 ENDIF * DO I=1,NS XLS(I)= 0.D0 XUS(I)= 1.D0 ENDDO * MINCLSS= MNCLSS MAXCLSS= MXCLSS AEQ= 0.D0 * REQ= 1.D-4 REQ= 1.D-2 2 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NS,XLS,XUS,MINCLSS,MAXCLSS,NFN,TPPS,AEQ,REQ, # LENWRK,WRKSTR,ESTS,AESTS,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EPAIRS ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLSS= -1 MAXCLSS= MAXCLSS*MULFAC GO TO 2 ENDIF * DO I= 1,NH XLH(I)= 0.D0 XUH(I)= 1.D0 ENDDO * MINCLSH= MNCLSH MAXCLSH= MXCLSH AEQ= 0.D0 REQ= 1.D-4 3 IF(OIFAIL.EQ.'Y') THEN IFAIL= -1 ELSE IFAIL= 1 ENDIF CALL D01EAF(NH,XLH,XUH,MINCLSH,MAXCLSH,NFN,TPPH,AEQ,REQ, # LENWRK,WRKSTR,ESTH,AESTH,IFAIL) * IF(OIFAIL.EQ.'Y'.AND.IFAIL.EQ.1) THEN PRINT*,' D01EAF CALLED BY EPAIRS ' ENDIF IF(IFAIL.GT.0.AND.IFAIL.LT.3) THEN MINCLSH= -1 MAXCLSH= MAXCLSH*MULFAC GO TO 3 ENDIF * DO L=1,NFL DO I=1,NRS DO J=1,3 K= 4*(3*(I-1)+J-1)+L IF(J.EQ.1) THEN EDELE(I,L)= ESTV(K)+ESTS(K)+ESTH(K) ELSE IF(J.EQ.2) THEN EDELMU(I,L)= ESTV(K)+ESTS(K)+ESTH(K) ELSE IF(J.EQ.3) THEN EDELH(I,L)= ESTV(K)+ESTS(K)+ESTH(K) ENDIF ENDDO ENDDO ENDDO * DO L=1,NFL DO I=1,NRS EDEL(I,L)= EDELE(I,L)+EDELMU(I,L)+EDELH(I,L) ENDDO ENDDO * RETURN END * *--------------------------------------------------------------------------- * SUBROUTINE TPPV(NDIM,X,NFN,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM,MM2,NM2,KM CHARACTER*1 ORISPP * PARAMETER(MNRS=30,NFL=4) * COMMON/TPC/ZPCUT COMMON/TCNRS/NRS COMMON/TECM/RS(MNRS) COMMON/TRISPP/ORISPP COMMON/TCUT/OXCUT,OXCUTS COMMON/TPARAM/PI,PIS,DELTA COMMON/THMASS/PIM,KM,DM,BM COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION X(NDIM),F(NFN) * PIM2= PIM*PIM RL2= LOG(2.D0) RL2S= RL2*RL2 RL2C= RL2S*RL2 RL4= LOG(4.D0) RL4S= RL4*RL4 RL4C= RL4S*RL4 * DO L=1,4 DO I=1,NRS S= RS(I)*RS(I) BLE= LOG(S/EM2) DO J=1,3 IF(J.EQ.1) THEN BL= LOG(S/EM2) DELHS= 8.D0*EM ELSE IF(J.EQ.2) THEN BL= LOG(S/MM2) DELHS= 8.D0*MM ELSE IF(J.EQ.3) THEN BL= LOG(S/PIM2) DELHS= 8.D0*PIM ENDIF BETAL= 2*API*(BL-1.D0) BETAE= 2*API*(BLE-1.D0) BETALS= BETAL*BETAL IF(J.LE.2) THEN RINFTY= 1.D0 R0= RL4-5.D0/3.D0 R1= 0.5D0*RL4S-5.D0/3.D0*RL4+28.D0/9.D0-RZ2 R2= 1.D0/6.D0*RL4C-5.D0/6.D0*RL4S+(28.D0/9.D0-RZ2)*RL4+ # 2.D0*RZ3+5.D0/3.D0*RZ2-164.D0/27.D0 ELSE RINFTY= 4.D0 R0= -8.31D0 R1= 13.1D0 R2= -15.6D0 ENDIF VIRTA= RINFTY*(5.D0/144.D0+RL2/12.D0-BL/72.D0)- # R0/24.D0 VIRTB= RINFTY*(-1.D0/8.D0-RL2/6.D0-RL2S/3.D0+ # RZ2/6.D0)+ # R0/3.D0*(RL2+1.D0/4.D0)-R1/6.D0 VIRTC= RINFTY*(5.D0/18.D0-2.D0/3.D0*RZ2*RL2+RL2/2.D0+ # RL2S/3.D0+4.D0/9.D0*RL2C-RZ2/6.D0)+ # R0*(-1.D0/4.D0-RL2/3.D0-2.D0/3.D0*RL2S+RZ2/3.D0)+ # R1*(1.D0/6.D0+2.D0/3.D0*RL2)-R2/3.D0 VIRT= BETALS*VIRTA+BETAL*API*VIRTB+APIS*VIRTC EPS= 1.D0-ZPCUT Z= 1.D0-EPS*X(1)**(1.D0/BETAE) XX= EPS*X(1)**(1.D0/BETAE) XXL= LOG(EPS)+LOG(X(1))/BETAE OMXXL= LOG(Z) RH1= -0.5D0*BETAE*(2.D0-XX) RH2= 1.D0/8.D0*BETAE*BETAE*((2.D0-XX)* # (3.D0*OMXXL-4.D0*XXL)-4.D0/XX*OMXXL-6.D0+XX) IF(ORISPP.EQ.'S') THEN RAD= SDELTA(I)+(RH1+RH2)/BETAE/XX**(BETAE-1.D0) ELSE IF(ORISPP.EQ.'T') THEN OMZ= XX OMZL= XXL ZL= OMXXL CALL TPOLYL(OMZ,Z,S11,S12,S13,S21,S22) RH3= -27.D0/2.D0+15.D0/4.D0*OMZ+4.D0*(1.D0-0.5D0*OMZ)*(PIS- # 6.D0*OMZL**2+3.D0*S11)+3.D0*ZL*(7.D0-6.D0/OMZ-1.5D0* # OMZ)+ZL**2*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ)-6.D0*OMZL* # (6.D0-OMZ)+6.D0*OMZL*ZL*(6.D0-4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETAE**3/48.D0 RAD= SDELTA(I)+SDELTA3(I)+(RH1+RH2+RH3)/BETAE/XX**(BETAE-1.D0) ENDIF K= 4*(3*(I-1)+J-1)+L F(K)= EPS**BETAE*RAD*VIRT*TBORNNN(L,I,Z) ENDDO ENDDO ENDDO * RETURN END * *--------------------------------------------------------------------------- * SUBROUTINE TPPS(NDIM,X,NFN,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM,MM2,NM2,KM * PARAMETER(MNRS=30) * COMMON/TSEP/SEPA COMMON/TCNRS/NRS COMMON/TECM/RS(MNRS) COMMON/TCUT/OXCUT,OXCUTS COMMON/THMASS/PIM,KM,DM,BM COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 * DIMENSION X(NDIM),F(NFN) * PIM2= PIM*PIM RL2= LOG(2.D0) RL2S= RL2*RL2 RL2C= RL2S*RL2 RL4= LOG(4.D0) RL4S= RL4*RL4 RL4C= RL4S*RL4 * DO L=1,4 DO I=1,NRS S= RS(I)*RS(I) DO J=1,3 IF(J.EQ.1) THEN BL= LOG(S/EM2) DELHS= SEPA*EM X0= 4.D0*EM/RS(I) ELSE IF(J.EQ.2) THEN BL= LOG(S/MM2) DELHS= SEPA*MM X0= 4.D0*MM/RS(I) ELSE IF(J.EQ.3) THEN BL= LOG(S/PIM2) DELHS= SEPA*PIM X0= 4.D0*PIM/RS(I) ENDIF BLE= LOG(S/EM2) BETA= 2*API*(BL-1.D0) BETAS= BETA*BETA BETAE= 2*API*(BLE-1.D0) IF(J.LE.2) THEN RINFTY= 1.D0 R0= RL4-5.D0/3.D0 R1= 0.5D0*RL4S-5.D0/3.D0*RL4+28.D0/9.D0-RZ2 R2= 1.D0/6.D0*RL4C-5.D0/6.D0*RL4S+(28.D0/9.D0-RZ2)*RL4+ # 2.D0*RZ3+5.D0/3.D0*RZ2-164.D0/27.D0 ELSE RINFTY= 4.D0 R0= -8.31D0 R1= 13.1D0 R2= -15.6D0 ENDIF EPS= 2.D0*DELHS/RS(I) RJAC= LOG(EPS/X0) Z= RJAC*X(1)+LOG(X0) Z= EXP(Z) Y= 1.D0-Z BXS= (RZ2-31.D0/36.D0)/(RZ2/8.D0+1.D0/16.D0*(R0/RINFTY)**2- # 1.D0/8.D0*R1/R0) BX= SQRT(BXS) CL= 0.5D0*BX*(BL+2.D0*LOG(Z)+R0/RINFTY) K= 4*(3*(I-1)+J-1)+L F(K)= APIS/6.D0*(Z-X0)**BETAE*(CL*CL+31.D0/9.D0-4.D0*RZ2)* # (8.D0*RINFTY/BXS-2.D0*Z+Z*Z+BETAE/3.D0*CL)* # RJAC*TBORNNN(L,I,Y) ENDDO ENDDO ENDDO * RETURN END * *--------------------------------------------------------------------------- * SUBROUTINE TPPH(NDIM,X,NFN,F) IMPLICIT REAL*8(A-H,O-Z) REAL*8 MM,NM,MM2,NM2,KM CHARACTER*1 ORISPP * PARAMETER(MNRS=30,NFL=4) * COMMON/TSEP/SEPA COMMON/TPC/ZPCUT COMMON/TCNRS/NRS COMMON/TECM/RS(MNRS) COMMON/TRISPP/ORISPP COMMON/TCUT/OXCUT,OXCUTS COMMON/THMASS/PIM,KM,DM,BM COMMON/TPARAM/PI,PIS,DELTA COMMON/TRZF/EGAM,RZ2,RZ3,RA4,RZ5 COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TEM/RL(MNRS),BETA(MNRS),SDELTA(MNRS),SDELTAP(MNRS), # PCDEL(MNRS,NFL),PCDELH(MNRS,NFL),AD1(MNRS),ADD(MNRS), # SDELTA3(MNRS),SDELTAP3(MNRS) * DIMENSION X(NDIM),F(NFN) * PIM2= PIM*PIM RL2= LOG(2.D0) RL2S= RL2*RL2 RL2C= RL2S*RL2 RL4= LOG(4.D0) RL4S= RL4*RL4 RL4C= RL4S*RL4 * DO L=1,4 DO I=1,NRS S= RS(I)*RS(I) BLE= LOG(S/EM2) DO J=1,3 IF(J.EQ.1) THEN BL= LOG(S/EM2) DELHS= SEPA*EM/RS(I) ELSE IF(J.EQ.2) THEN BL= LOG(S/MM2) DELHS= SEPA*MM/RS(I) ELSE IF(J.EQ.3) THEN BL= LOG(S/PIM2) DELHS= SEPA*PIM/RS(I) ENDIF BETAE= 2*API*(BLE-1.D0) BETAES= BETAE*BETAE IF(J.LE.2) THEN RINFTY= 1.D0 R0= RL4-5.D0/3.D0 R1= 0.5D0*RL4S-5.D0/3.D0*RL4+28.D0/9.D0-RZ2 R2= 1.D0/6.D0*RL4C-5.D0/6.D0*RL4S+(28.D0/9.D0-RZ2)*RL4+ # 2.D0*RZ3+5.D0/3.D0*RZ2-164.D0/27.D0 ELSE RINFTY= 4.D0 R0= -8.31D0 R1= 13.1D0 R2= -15.6D0 ENDIF ZL= ZPCUT ZU= (1.D0-DELHS)*(1.D0-DELHS) ZLL= -LOG(1.D0-ZL) ZUL= -LOG(1.D0-ZU) UL= DMIN1(ZLL,ZUL) UU= DMAX1(ZLL,ZUL) UJAC= UU-UL U= UJAC*X(1)+UL Z= 1.D0-EXP(-U) OMZ= EXP(-U) ZS= Z*Z OMZS= OMZ*OMZ VJAC= (1.D0-ZPCUT/Z)**BETAE V= VJAC*X(2) XX= 1.D0-V**(1.D0/BETAE) IF(J.EQ.1) THEN CL= LOG(S/4.D0/EM2*OMZS/Z) ELSE IF(J.EQ.2) THEN CL= LOG(S/4.D0/MM2*OMZS/Z) ELSE IF(J.EQ.3) THEN CL= LOG(S/4.D0/PIM2*OMZS/Z) ENDIF CLS= CL*CL ZLN= LOG(Z) ZLNS= ZLN*ZLN EPS= -1.D-37 RLI2Z= TRSPENCE(OMZ,EPS) HARD= (1.D0+ZS)*(RINFTY*(CLS/2.D0-RZ2)+R0*CL+R1)- # OMZS*(RINFTY*(2.D0*CL-3.D0)+2.D0*R0)- # RINFTY*ZS*(ZLNS/2.D0+RLI2Z)-RINFTY*OMZ*ZLN HARD= HARD/3.D0 ZZ= Z*XX Y= V**(1.D0/BETAE) YL= LOG(V)/BETAE OMYL= LOG(XX) RH1= -0.5D0*BETAE*(2.D0-Y) RH2= 1.D0/8.D0*BETAE*BETAE*((2.D0-Y)* # (3.D0*OMYL-4.D0*YL)-4.D0/Y*OMYL-6.D0+Y) IF(ORISPP.EQ.'S') THEN RAD= SDELTA(I)+(RH1+RH2)/BETAE/Y**(BETAE-1.D0) ELSE IF(ORISPP.EQ.'T') THEN OMZ= Y OMZL= YL ZLO= OMYL CALL TPOLYL(OMZ,Y,S11,S12,S13,S21,S22) RH3= -27.D0/2.D0+15.D0/4.D0*OMZ+4.D0*(1.D0-0.5D0*OMZ)* # (PIS-6.D0*OMZL**2+3.D0*S11)+3.D0*ZLO*(7.D0-6.D0/OMZ- # 1.5D0*OMZ)+ZLO**2*(-7.D0+4.D0/OMZ+7.D0/2.D0*OMZ)-6.D0* # OMZL*(6.D0-OMZ)+6.D0*OMZL*ZLO*(6.D0-4.D0/OMZ-3.D0*OMZ) RH3= RH3*BETAE**3/48.D0 RAD= SDELTA(I)+SDELTA3(I)+(RH1+RH2+RH3)/BETAE/Y**(BETAE-1.D0) ENDIF K= 4*(3*(I-1)+J-1)+L F(K)= APIS*RAD*UJAC*VJAC*HARD*TBORNNN(L,I,ZZ) ENDDO ENDDO ENDDO * RETURN END * *-------------------------------------------------------------------- * REAL*8 FUNCTION TBORNNN(JFL,JI,Z) IMPLICIT REAL*8 (A-H,I,O-P,R-Z) IMPLICIT REAL*16(Q) REAL*8 NM,MM,NM2,MM2 CHARACTER*2 OCUTF * PARAMETER(MNRS=30,NO=7) * COMMON/TNAL/ODA COMMON/TCUTF/OXCUTF COMMON/TECM/RS(MNRS) COMMON/TICOUPLING/NF COMMON/TAFJTR/ALST,ALSTZ COMMON/TOCUTF/OCUTF(MNRS) COMMON/TIPA/VIM(7),AIM(7) COMMON/TPARAM/PI,PIS,DELTA COMMON/TMISCE/Z2,Z3,ZW,API2 COMMON/TCK/XSZ(6),XNFACT(6) COMMON/TRAL/CSAL(5,5),CTAL(5,5) COMMON/TSHARE/AEXP,TAEXP,HOF,FPI COMMON/TQNUM/BQL,BQN,BQUQ,BQDQ,ZIU,ZID COMMON/TPAR/STH2,STH4,CTH2,ZM2,WM2,HM2 COMMON/TMIXC/QV1,QA1,QF1,QV1P,QA1P,QV1I COMMON/TEFFP/ALPHAH,ST2EFF(7),RHOEFF(7) COMMON/TFMASSES/EM,MM,TLM,NM,UQM,DQM,CQM,SQM,BQM COMMON/TCOUPLINGS/ALPHA,GF,ALS,RS0,CONV,API,APIS COMMON/TFMASSES2/EM2,MM2,TLM2,NM2,UQM2,DQM2,CQM2,SQM2,BQM2,TQM2 COMMON/TQCDCORR/VCORQ,ACORU,ACORD,ACORB,RBM2,RCM2,VCMB,ACMB,VCMC, # ACMC,ACMT,ALSR,CAQCDB,CAQCDC,CAMB,CAMC,CAMT,ACMM, # ODQCD,VCML COMMON/TSIND/SIGB,CMSTH2,S3GZ,PZ,GWEAK,RHO,DELZ,DELW,PGGF0, # PGGB0,SWW0B,S33BZ,S3GFZ,S33Z,PPGGZ,PPGGNPZ, # SP3GZ,SP33Z,AUX1,AUX2,TSCTH2,FSCTH2,CTTH2,WT, # CSTH2,TCOR,SIGBNR,AEXPHZ,STR2,STH2NR COMMON/TWEAKPAR/IPGGF(MNRS),IDSTH2(MNRS), # DELGG(MNRS,NO),DELZZP(MNRS,NO), # DELZZM(MNRS,NO),DELGZP1(MNRS,NO), # DELGZP2(MNRS,NO),DELGZP3(MNRS,NO), # DELGZP4(MNRS,NO),DELGZM1(MNRS,NO), # DELGZM2(MNRS,NO),DELGZM3(MNRS,NO), # DELGZM4(MNRS,NO),FBOX(MNRS,NO),BBOX(MNRS,NO) * S= RS(JI)*RS(JI) XRS= SQRT(Z)*RS(JI) XS= Z*S CALL TCORRQCD(XRS) AEXPS= ALSR/PI ALS3= (AEXPS)**3 * IF(XRS.LT.10.D0) THEN JX= 1 ELSE IF(XRS.GT.10.D0.AND.XRS.LT.30.D0) THEN JX= 2 ELSE IF(XRS.GT.30.D0.AND.XRS.LT.50.D0) THEN JX= 3 ELSE IF(XRS.GT.50.D0.AND.XRS.LT.70.D0) THEN JX= 4 ELSE IF(XRS.GT.70.D0) THEN JX= 5 ENDIF CFACTS= CSAL(JX,1)*CSAL(JX,1)+CSAL(JX,2)* # LOG(ABS(CSAL(JX,3))/XS)+(CSAL(JX,4)+ALSTZ* # CSAL(JX,5))*XS/TQM2 CFACTS= 1.D0-CFACTS ALHS= ALPHA/CFACTS ALHS2= ALHS*ALHS AR= ALHS/(4.D0*PI) * DPT= 2.D0/3.D0 DMT= -1.D0/2.D0 G2= GWEAK*RHO G4= G2*G2 ZM= SQRT(ZM2) * IF(JFL.EQ.1) THEN FM= MM FI3= ZID BQF= BQL BQFD= 0.D0 FNC= 1.D0 VCOR= 0.D0 VCM= 0.D0 ACORQ= 0.D0 ACM= ACMM CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(2) ERHO= RHOEFF(2) EVI= VIM(2) EAI= AIM(2) ELSE IF(JFL.EQ.2) THEN FM= UQM FI3= ZIU BQF= BQUQ BQFD= BQDQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORU+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(4) ERHO= RHOEFF(4) EVI= VIM(4) EAI= AIM(4) ELSE IF(JFL.EQ.3) THEN FM= DQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCML ACORQ= ACORD+ODQCD ACM= VCML CORAQCD= 0.D0 CORAM= 0.D0 EST2= ST2EFF(5) ERHO= RHOEFF(5) EVI= VIM(5) EAI= AIM(5) ELSE IF(JFL.EQ.4) THEN FM= BQM FI3= ZID BQF= BQDQ BQFD= BQUQ FNC= 3.D0 VCOR= VCORQ+ODQCD VCM= VCMB ACORQ= ACORB+ODQCD ACM= ACMB CORAQCD= CAQCDB CORAM= CAMB ENDIF * BQF2= BQF*BQF RFM2= FM*FM/XS TQF= 2.D0*BQF SMZM2= XS-ZM2 ZWD= XS/ZM*ZW DENS= SMZM2*SMZM2+ZWD*ZWD ICHIZ= -ZM*ZW/DENS CHI2Z= ZM2/DENS RCHI= SMZM2/DENS ICHI= -ZWD/DENS CHI2= XS/DENS CVFP= ZM2*WT*WT * RVE= -0.5D0+2.D0*STH2 ERVE= -0.5D0+2.D0*ST2EFF(1) RVF= FI3-TQF*STH2 ERVF= FI3-TQF*EST2 RVAE= RVE*RVE+0.25D0 RVETVF= RVE*RVF ERVETVF= ERVE*ERVF ERVAE= ERVE*ERVE+0.25D0 RARC= ALHS*RCHI * IF(JFL.EQ.4) THEN SVV= 64.D0*G4*CHI2*RVAE*RVF*RVF*DPT SEE= 64.D0*4.D0*ALHS2*PIS*BQF2*DPT/XS SEV= -64.D0*4.D0*PI*G2*BQF*RARC*RVETVF*DPT SAA= 16.D0*G4*CHI2*RVAE*DPT SVA= 128.D0*FI3*G2*(G2*CHI2*RVETVF-PI*BQF*RARC)*DMT ELSE EG2= GWEAK*SQRT(RHOEFF(1)*ERHO) EG4= EG2*EG2 SVVZ= 64.D0*EG4*CHI2Z*ERVAE*(ERVF*ERVF+EVI*EVI)*DPT SAAZ= 64.D0*EG4*CHI2Z*ERVAE*(0.25D0+EAI*EAI)*DPT SVAZ= 128.D0*FI3*EG4*CHI2Z*ERVETVF*DMT SVV= SVVZ+64.D0*G4*(CHI2-CHI2Z)*RVAE*RVF*RVF*DPT SEE= 256.D0*PIS*BQF2*ALHS2*DPT/XS SEV= -64.D0*4.D0*PI*G2*BQF*RARC*RVETVF*DPT SAA= SAAZ+16.D0*G4*(CHI2-CHI2Z)*RVAE*DPT SVA= SVAZ+128.D0*FI3*G2*(G2*CHI2*RVETVF-PI*BQF*RARC)* # DMT-128.D0*FI3*G4*CHI2Z*RVETVF*DMT ENDIF SLO= SVV+SEE+SEV+SAA SVVT= SVV+SEE+SEV * XCUT= OXCUTF/Z XCUT2= XCUT*XCUT IF(OCUTF(JI).EQ.'NC') THEN IF(JFL.EQ.1) THEN CQEDFPB= 3.D0*AR*BQF2 ELSE CQEDFPB= AR*BQF2*(3.D0-AEXPS) ENDIF ELSE IF(OCUTF(JI).EQ.'HC') THEN IF(JFL.EQ.1) THEN CQEDFPB= 3.D0*AR*BQF2 ELSE RLX= LOG(XCUT) IF(XCUT.GE.1.D0) THEN ADD= 1.D-10 ELSE ADD= 0.D0 ENDIF RLOMX= LOG(1.D0-XCUT+ADD) EPSM= -1.D-37 RLI2= TRSPENCE(XCUT,EPSM) CQEDFPB= 4.D0*AEXP*BQF2*(-(XCUT+0.5*XCUT2+2.D0*RLOMX)* # LOG(RFM2)+XCUT*(1.D0+0.5D0*XCUT)*RLX-2.D0*RLOMX+ # 2.D0*RLX*RLOMX+2.D0*RLI2+3.D0/4.D0*(1.D0-XCUT2)- # 2.D0*XCUT) ENDIF ELSE IF(OCUTF(JI).EQ.'FC') THEN RLX= LOG(XCUT) ADD= 1.D-10 RLOMX= LOG(1.D0-XCUT+ADD) EPSM= -1.D-37 RLI2= TRSPENCE(XCUT,EPSM) CQEDFPB= 4.D0*AEXP*BQF2*(-(XCUT+0.5*XCUT2+2.D0*RLOMX)* # LOG(RFM2)+XCUT*(1.D0+0.5D0*XCUT)*RLX-2.D0*RLOMX+ # 2.D0*RLX*RLOMX+2.D0*RLI2+3.D0/4.D0*(1.D0-XCUT2)- # 2.D0*XCUT) ENDIF * SINGVV= -0.5D0-2.D0/3.D0*STH2 SINGEE= 1.D0/3.D0 IF(JFL.GT.1) THEN VCORVV= VCOR-0.41318D0*ALS3*SINGVV/RVF VCOREE= VCOR-0.41318D0*ALS3*SINGEE/BQF VCOREV= VCOR-0.41318D0*ALS3*0.5D0*(SINGVV/RVF+SINGEE/BQF) ELSE VCORVV= 0.D0 VCOREE= 0.D0 VCOREV= 0.D0 ENDIF * CONVF= 2.D0*PI*CONV/4.D0/64.D0/PIS CONVFC= CONVF*FNC IF(JFL.EQ.4) THEN XVAR= GWEAK/8.D0/PIS*TQM2/ZM2 XVAR2= XVAR*XVAR SVV4= 64.D0*G4*CHI2*RVAE*XVAR2*(2.D0*RVF*TCOR+1.D0)*DPT SAA4= 64.D0*G4*CHI2*RVAE*XVAR2*(1.D0-TCOR)*DPT HVAR= GF/8.D0/PIS*TQM2*(-PIS/3.D0*ALST/PI) HVARS= -GF/24.D0*TQM2*ALST/PI SVVMIX= 64.D0*G4*CHI2*RVAE*2.D0*RVF*HVAR*DPT SAAMIX= -64.D0*G4*CHI2*RVAE*HVAR*DPT CKCORR= 0.D0 * W1= CONVFC*(SVV*VCORVV+SEE*VCOREE+SEV*VCOREV+SVVT*VCM+ # SAA*(ACORQ+ACM)+(1.D0+CQEDFPB)*SLO+ # 4.D0*G4*CHI2*DELZZP(JI,7)*DPT*ALSR/PI+ # SVV4+SAA4+SVVMIX+SAAMIX) ELSE IF(JFL.EQ.2) THEN CKCORR= XNFACT(3)/CONVFC*CVFP/DENS ELSE IF(JFL.EQ.3) THEN CKCORR= XNFACT(5)/CONVFC*CVFP/DENS ELSE IF(JFL.EQ.1) THEN CKCORR= 0.D0 ENDIF W1= CONVFC*(SVV*VCORVV+SEE*VCOREE+SEV*VCOREV+SVVT*VCM+ # SAA*(ACORQ+ACM)+(1.D0+CQEDFPB)*SLO+CKCORR) ENDIF * TBORNNN= W1 * RETURN END