* *-----WTOXSN32------------------------------------------------------------ * real*8 function wtoxsn32(ndim,x) implicit real*8 (a-h,o-z) character*1 om,opglu parameter(npos=512) * common/wtmod/om common/wtsfh/ip0 common/wtpqcd/opglu common/wthx/xshmx(npos) * dimension x(ndim) * if(om.eq.'e') then r24= wtoxsn(ndim,x) if(ndim.eq.6.or.ndim.eq.7) then rg= 0.d0 else if(ndim.eq.8.or.ndim.eq.9) then if(opglu.eq.'y') then rg= wtoxsng(ndim,x) else rg= 0.d0 endif endif wtoxsn32= r24+rg else if(om.eq.'g') then if(ip0.eq.1) then r24= wtoxsn(ndim,x) rg= 0.d0 else if(ip0.eq.2) then r24= 0.d0 rg= wtoxsng(ndim,x) endif wtoxsn32= r24+rg endif * return end * *-----WTOXSM43------------------------------------------------------------ * real*8 function wtoxsm43(ndim,x) implicit real*8 (a-h,o-z) character*1,om,opglu character*2,ofs * common/wtmod/om common/wtfs/ofs common/wtsfh/ip0 common/wtpqcd/opglu * dimension x(ndim) * if(om.eq.'e') then r35= wtoxs35(ndim,x) if(ofs.eq.'ll') then rg= 0.d0 else if(ofs.eq.'qq') then if(ndim.eq.7.or.ndim.eq.6) then rg= 0.d0 else if(ndim.eq.9.or.ndim.eq.8) then if(opglu.eq.'y') then rg= wtoxs35g(ndim,x) else rg= 0.d0 endif endif endif wtoxsm43= r35+rg else if(om.eq.'g') then if(ip0.eq.1) then r35= wtoxs35(ndim,x) rg= 0.d0 else if(ip0.eq.2) then r35= 0.d0 rg= wtoxs35g(ndim,x) endif wtoxsm43= r35+rg endif * return end * *-----WTOXSN----------------------------------------------------------- * real*8 function wtoxsn(ndim,x) implicit real*8 (a-h,o-z) * character*1,opeak,otrans,oqcd,om,osm character*4,otype * parameter(ninv=10,npos=512) * common/wtmod/om common/wtmp/zrm common/wtps/opeak common/wtkount/ik common/wtdis/dist common/wtsmod/osm common/wtistrf/isf common/wtaqcd/oqcd common/wtcqcd/iqcd common/wtlmsb/qcdl common/wtqcdz/alsz common/wtsf/ix0,it0 common/wtchi/hch(36) common/wtipt/ifz(44) common/wtshel/otrans common/wticuts/iac(4) common/wtisa/isaa,isab common/wttopt/ios,iosf common/wthx/xshmx(npos) common/wtochannel/otype common/wtparh/xaph(ninv) common/wttc/itc,itcc,itcn common/wtpmxh/xmxh(npos,9) common/wtncc/chf2,chfp2,conc(10) common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtee/qch,qch2,vqr,vql,hbe(24),hbo(24),hmp(24) common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmy common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw, # eta,feta,beta,g2,tfacth common/wtapar/ars,s,rwm,rwm2,rwg,rwmg,swg,swgs,opswgs,sth2,cth2, # hsth2,tsth2,scth2,asth2,tth2,rzm,rzm2,rzg,rzmg,szg, # szgs,opszgs,sth4,cth4,ve,vf,vfp,rbqm2,rszw,rszw2, # s0w,s0z common/wtsubreg/dsm,usm,dsp,usp,rl(6),rr(6),srl(6),sdsm,sdsp,vvl1, # vvl2,vvl3,ul,omul,suml common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6), # ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4), # sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24, # cg24,sg34,cg34,sct120,sct130,sct140,sct230, # sct240,sct340,sgam(4),cgam(4) * dimension x(ndim) dimension bt1(2),bt2(2) dimension tgn(16),tgnn(6) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension dpxs(2,2,2,12),epxs(2,2,2,12),cpxs(2,12),bpxs(2,12), # apxs(12) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) dimension har(4),hbr(4),hdr(4),her(4),hfr(4),hgr(4),hhr(8), # hir(8),hlr(4),hmr(4),hnr(4),hor(4),hpr(8),hqr(8), # hapr(4),hbpr(4),hc(8),hcp(8) dimension hai(4),hbi(4),hdi(4),hei(4),hfi(4),hgi(4),hhi(8), # hii(8),hli(4),hmi(4),hni(4),hoi(4),hpi(8),hqi(8), # hapi(4),hbpi(4) * data ec2/-0.4999999963d0/,ec4/0.0416666418d0/, # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, # ec10/-0.0000002605d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf * *-----the order of integration is: * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1 * * m_{+/-}^2 transformed for the resonating peaks * M_0^2,m_0^2 transformed for the resonating peaks * m^2 and t_1 transformed for the jacobian peaks * do ix=1,2 do it=1,2 do itt=1,2 do il=1,12 dpxs(ix,it,itt,il)= 0.d0 enddo enddo enddo enddo do it=1,2 do il=1,12 cpxs(it,il)= 0.d0 bpxs(it,il)= 0.d0 enddo enddo * if(ndim.eq.6) then if(itc.eq.1) then if(itcc.eq.1) then smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(itcc.eq.2) then smx= x(1) spx= x(2) sux= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(itcc.eq.3) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) twx= x(5) t1x= x(6) endif else if(itc.eq.4) then spx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) endif else if(ndim.eq.8) then if(itc.eq.1) then if(itcc.eq.1) then uvx= x(1) vvx= x(2) smx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(itcc.eq.2) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(itcc.eq.3) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) twx= x(7) t1x= x(8) endif else if(itc.eq.4) then uvx= x(1) vvx= x(2) spx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) else uvx= x(1) vvx= x(2) smx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) endif else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 em2= em*em vmu2= em2/s * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * if(itc.eq.3) then omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) omul= dmin1(omul,omuld) endif if(uvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * if(itc.eq.3) then vvlld= (dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) vvll= dmax1(vvll,vvlld) endif * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vkf.eq.0.d0) then if(vvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vvx.eq.1.d0) then veps= 0.d0 else veps= uvl*(1.d0-vvx)**hbeti endif avkf= 1.d0 else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti avkf= 1.d0-vkf**hbet endif vv= uv-veps vjc0= 1.d0-vvll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif endif * if(vv.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif svv= sqrt(vv) vzmg= rzmg*vv vvs= vv*vv xm= uv xp= vv/uv delsp= (xm-xp)*(xm-xp)+2.d0*(xm+xp) delsd= 2.d0-xm-xp delsr= 2.d0+delsp-delsd delsu= -2.d0-delsp+2.d0*delsd de4= 4.d0+2.d0*(delsp-delsd) dt4= 5.d0-2.d0*(1+xm)*delsd-2.d0*xm+2.d0*delsp xmop= xm/xp if(ndim.eq.7.or.ndim.eq.6) then xdf= 0.d0 else xdf= (ueps*(1.d0-ueps)-veps)/uv endif xdfs= xdf*xdf sh= vv*s smp0= s0z/vv rmu2= em2/sh rmu2s= rmu2*rmu2 rmu2c= rmu2s*rmu2 xmas= 1.d0+rmu2 vmas= vv+vmu2 * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * dsz0= 1.d0-rszm2 dsz= dsz0*dsz0+rszw2 rsz= dsz0/dsz aisz= -rszw/dsz * *-----Reduced structure functions are computed with arguments xp,xm * opxp= 1.d0+xp opxm= 1.d0+xm omxp= veps/uv omxm= ueps if(isf.eq.0) then stfp= 1.d0 stfm= 1.d0 else if(isf.gt.0) then if(omxp.eq.0) then stfp= d0gl else rcpx= 0.25d0*opxp*opxp rcpy= xp iflp= 1 rclp= s21baf(rcpx,rcpy,iflp) stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+ # feta*(-4.d0*opxp*log(omxp)+ # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp)) endif if(omxm.eq.0) then stfm= d0gl else rcmx= 0.25d0*opxm*opxm rcmy= xm iflm= 1 rclm= s21baf(rcmx,rcmy,iflm) stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ # feta*(-4.d0*opxm*log(omxm)+ # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm)) endif endif * stf= stfp*stfm * *-----if there is no upper cut on some FS IM, then the maximum is allowed * do j=1,6 if(rr(j).eq.1.d0) then rrr(j)= rr(j) else rrr(j)= rr(j)/vv endif rrl(j)= rl(j)/vv srrl(j)= srl(j)/svv enddo * *-----cuts become special near xp = xm * if(abs(xdf).gt.1.d-15) then ieq= 1 bxe= vv/(ueps*(1.d0-ueps)-veps) if(xdf.gt.0.d0) then enc= 1.d0 else if(xdf.lt.0.d0) then enc= xmop endif else ieq= 0 bxe= 1.d0 endif if(ieq.eq.0.and.xm.le.teq) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then sct12= sct120/vv sct13= sct130/vv sct14= sct140/vv sct23= sct230/vv sct24= sct240/vv sct34= sct340/vv else sct12= 0.d0 sct13= 0.d0 sct14= 0.d0 sct23= 0.d0 sct24= 0.d0 sct34= 0.d0 endif * *-----cuts on E * do j=1,4 if(ieq.eq.1) then bl(j)= 2.d0*rae(j)/xdf xbl(j)= 2.d0*rae(j)/xp else if(ieq.eq.0) then bl(j)= 2.d0*rae(j)/xm endif enddo * *-----cuts on SA * if(iac(3).ne.0) then do j=1,4 if(cgam(j).eq.0.d0) then ss(j)= 0.d0 else ss(j)= 1.d0+(1.d0-cgam(j))/cgam(j)*xmop ss(j)= 1.d0/ss(j) endif if(sgam(j).eq.0.d0) then cs(j)= 1.d0 else cs(j)= 1.d0+(1.d0-sgam(j))/sgam(j)*xmop cs(j)= 1.d0/cs(j) endif enddo endif * *-----initialization of sm = m_-^2 * zma1= dsm zma2= vv*sct12 zmb1= usm zmb2= (svv-sdsp)*(svv-sdsp) zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) if(ieq.eq.0) then zma3= vv*(bl(1)+bl(2)-1.d0) zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))* # (1.d0-0.5d0*(bl(3)+bl(4))) zmb5= vv*(1.d0-bl(3)) zmb6= vv*(1.d0-bl(4)) else if(ieq.eq.1) then zma3= vv*(-enc+xbl(1)+xbl(2)) zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))* # (1.d0+enc-xbl(3)-xbl(4)) zmb5= vv*(enc-xbl(3)) zmb6= vv*(enc-xbl(4)) endif xzma= dmax1(zma1,zma2,zma3) xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) * *-----limits on sm from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zma= xzma zmb= xzmb else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then szma= xzma szmb= xzmb else if(ss(3).gt.ss(1)) then szmb= xzmb adsp= dsp/vv axszma= dmax1(adsp,sct34) axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/ # (ss(3)-ss(1))) szma= dmax1(axszma,xzma) else if(ss(3).lt.ss(1)) then if(ss(3).lt.0.5d0) then szma= xzma axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 szmb= dmin1(axszmb,xzmb) else iz= 0 ifz(2)= ifz(2)+1 go to 1 endif endif else szma= xzma szmb= xzmb endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zma= szma zmb= szmb else if(cs(3).gt.cs(1)) then if(cs(3).gt.0.5d0) then zma= szma axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2 zmb= dmin1(axczmb,szmb) else iz= 0 ifz(3)= ifz(3)+1 go to 1 endif else if(cs(3).lt.cs(1)) then zmb= szmb adsp= dsp/vv axczma= dmax1(adsp,sct34) axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/ # (cs(3)-cs(1))) zma= dmax1(axczma,szma) endif else zma= szma zmb= szmb endif endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.gt.1)) then dzpa= dmax1(dsp,sct340) if(itc.eq.1) then dzmb= (dist/rs-sqrt(dzpa))*(dist/rs-sqrt(dzpa)) zmb= dmin1(zmb,dzmb) else if(itc.eq.2) then dzma= (dist/rs+sqrt(dzpa))*(dist/rs+sqrt(dzpa)) zma= dmax1(zma,dzma) dzmb= 0.25d0*(svv+dist/rs)*(svv+dist/rs) zmb= dmin1(zmb,dzmb) else if(itc.eq.3) then dzmb= (svv-dist/rs)*(svv-dist/rs) zmb= dmin1(zmb,dzmb) endif endif if(itc.eq.1.and.itcc.eq.3) then zmbd3= vv-0.5d0*dist*dist/s zmb= dmin1(zmb,zmbd3) endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * if(itc.eq.4) then bdistl= dist*dist/s-zma bdistu= zmb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif endif * if(itc.eq.4) then sm= (dist/rs/svv)**2 pmjac= 2.d0*dist/s/((vv*sm-rzm2)**2+ # (vv*sm*szg)**2) smjc= 1.d0 else * if(opeak.eq.'y') then zmas= zma-rzm2 zmbs= zmb-rzm2 atma= (zmas+szgs*zma)/rzmg atmb= (zmbs+szgs*zmb)/rzmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vzmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vzmg smjc0= (-atmb+atma)/vzmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vzmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vzmg smjc0= (-pi+atmb+atma)/vzmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vzmg atmb= atan(atmb) zmbt= atmb/vzmg smjc0= (-pih+atmb+atma)/vzmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vzmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vzmg smjc0= (pi-atmb-atma)/vzmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vzmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vzmg smjc0= (atmb-atma)/vzmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vzmg atmb= atan(atmb) zmbt= atmb/vzmg smjc0= (pih+atmb-atma)/vzmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/vzmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vzmg smjc0= (pih-atmb-atma)/vzmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/vzmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vzmg smjc0= (-pih+atmb-atma)/vzmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/vzmg atmb= atan(atmb) zmbt= atmb/vzmg smjc0= (atmb-atma)/vzmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= vzmg*zmv sm= smp0*(1.d0+szg*s07aaf(atnm,iftn)) if(iftn.ne.0) print 300 pmjac= 1.d0 smjc= vv*smjc0 * else if(opeak.eq.'n') then smjc0= zmb-zma sm= (smjc0*smx+zma)/vv pmjac= 1.d0/((vv*sm-rzm2)**2+(vv*sm*szg)**2) smjc= smjc0 endif endif * if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) * 300 format(/' Unsuccesful call to S07AAF ') * *-----initialization of sp = m_+^2 * zpa1= dsp zpb1= usp zpb2= vv*(1.d0-ssm)*(1.d0-ssm) * *-----limits on sp from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zpb= dmin1(zpb1,zpb2) zpa= zpa1 else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then azpb= dmin1(zpb1,zpb2) azpa= zpa1 else if(ss(3).gt.ss(1)) then zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpb= dmin1(zpb1,zpb2,zpb3) azpa= zpa1 else if(ss(3).lt.ss(1)) then azpb= dmin1(zpb1,zpb2) zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpa= dmax1(zpa1,zpa2) endif else azpa= zpa1 azpb= dmin1(zpb1,zpb2) endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zpa= azpa zpb= azpb else if(cs(3).gt.cs(1)) then zpb= azpb bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpa= dmax1(azpa,bzpa) else if(cs(3).lt.cs(1)) then zpa= azpa bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpb= dmin1(azpb,bzpb) endif else zpa= azpa zpb= azpb endif endif * if(ieq.eq.0) then zpel= vv*(-1.d0+bl(3)+bl(4)+sm) zpeu1= vv*(1.d0-bl(1)-bl(2)+sm) zpeu2= vv*(1.d0-bl(1)) zpeu3= vv*(1.d0-bl(2)) else if(ieq.eq.1) then zpel= vv*(sm-enc+xbl(3)+xbl(4)) zpeu1= vv*(sm+enc-xbl(1)-xbl(2)) zpeu2= vv*(enc-xbl(1)) zpeu3= vv*(enc-xbl(2)) endif zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) zpap= vv*sct34 zpa= dmax1(zpa,zpap) if(itc.eq.1.and.itcc.eq.3) then zpbd3= vv*(1.d0-sm)-0.5d0*dist*dist/s zpb= dmin1(zpb,zpbd3) endif * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.gt.1.and.itc.lt.3)) then bdistl= (dist/rs-svv*ssm)*(dist/rs-svv*ssm)-zpa bdistu= zpb-(dist/rs-svv*ssm)*(dist/rs-svv*ssm) if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif else if(itc.eq.3) then bdistl= dist*dist/s-zpa bdistu= zpb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.gt.1.and.itc.lt.3)) then sp= (dist/rs/svv-ssm)*(dist/rs/svv-ssm) ppjac= 2.d0*abs((dist/rs-svv*ssm))/ars/ # ((vv*sp-rzm2)**2+(vv*sp*szg)**2) spjc= 1.d0 else if(itc.eq.3) then sp= (dist/rs/svv)**2 ppjac= 2.d0*dist/s/((vv*sp-rzm2)**2+ # (vv*sp*szg)**2) spjc= 1.d0 else * if(opeak.eq.'y') then zpas= zpa-rzm2 zpbs= zpb-rzm2 atpa= (zpas+szgs*zpa)/rzmg atpb= (zpbs+szgs*zpb)/rzmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vzmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vzmg spjc0= (-atpb+atpa)/vzmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vzmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vzmg spjc0= (-pi+atpb+atpa)/vzmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vzmg atpb= atan(atpb) zpbt= atpb/vzmg spjc0= (-pih+atpb+atpa)/vzmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vzmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vzmg spjc0= (pi-atpb-atpa)/vzmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vzmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vzmg spjc0= (atpb-atpa)/vzmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vzmg atpb= atan(atpb) zpbt= atpb/vzmg spjc0= (pih+atpb-atpa)/vzmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/vzmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vzmg spjc0= (pih-atpb-atpa)/vzmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/vzmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vzmg spjc0= (-pih+atpb-atpa)/vzmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/vzmg atpb= atan(atpb) zpbt= atpb/vzmg spjc0= (atpb-atpa)/vzmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= vzmg*zpv sp= smp0*(1.d0+szg*s07aaf(atnp,iftn)) if(iftn.ne.0) print 300 ppjac= 1.d0 spjc= vv*spjc0 * else if(opeak.eq.'n') then spjc0= zpb-zpa sp= (spjc0*spx+zpa)/vv ppjac= 1.d0/((vv*sp-rzm2)**2+(vv*sp*szg)**2) spjc= spjc0 endif endif * if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spmm= sp-sm smmp= sm-sp * if(ios.eq.3) then scals= -vv*s rscals= svv*rs scalm= -vv*sm*s rscalm= svv*ssm*rs scalp= -vv*sp*s rscalp= svv*ssp*rs call wtopself(scalm,pggfm) call wtopself(scalp,pggfp) call wtopself(scals,pggfs) derml= 0.25d0*alpha/pi*pggfm derpl= 0.25d0*alpha/pi*pggfp dersl= 0.25d0*alpha/pi*pggfs eth= 40.d0/rs/vv if(rscalm.gt.40.d0) then call wtohadr5(rscalm,dermh,edermh) else call wtopselfnp(scalm,pggnpm) dermh= 0.25d0*alpha/pi*pggnpm endif if(rscalp.gt.40.d0) then call wtohadr5(rscalp,derph,ederph) else call wtopselfnp(scalp,pggnpp) derph= 0.25d0*alpha/pi*pggnpp endif if(rscals.gt.40.d0) then call wtohadr5(rscals,dersh,edersh) else call wtopselfnp(scals,pggnps) dersh= 0.25d0*alpha/pi*pggnps endif derm= derml+dermh derp= derpl+derph ders= dersl+dersh alpm= alpha/(1.d0-derm) alpp= alpha/(1.d0-derp) alps= alpha/(1.d0-ders) corrgm= 4*pi*alpm/g2/sth2 corrgp= 4*pi*alpp/g2/sth2 corrgs= 4*pi*alps/g2/sth2 else corrgm= 1.d0 corrgp= 1.d0 corrgs= 1.d0 endif * if(oqcd.eq.'y') then if(iqcd.lt.2) then qcdjac= (1.d0+0.5d0*alsz/pi*(fcun-1.d0))* # (1.d0+0.5d0*alsz/pi*(fcdn-1.d0))-1.d0 else nf= 5 scalp= sqrt(vv)*ssp*ars scalm= sqrt(vv)*ssm*ars alsp= wtorals(qcdl,scalp,nf) alsm= wtorals(qcdl,scalm,nf) qcdjac= (1.d0+0.5d0*alsp/pi*(fcun-1.d0))* # (1.d0+0.5d0*alsm/pi*(fcdn-1.d0))-1.d0 endif else qcdjac= 0.d0 endif * cbw= -1.d0+sp-sm ifcr= 0 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(bt1(2).ne.0.d0) then iz= 0 ifz(6)= ifz(6)+1 go to 1 endif * smtp= sm*sp ssmpp= ssm+ssp ssmmp= ssm-ssp asup= 1.d0-ssmpp*ssmpp asum= 1.d0-ssmmp*ssmmp if(asup.lt.0.d0.or.asum.lt.0.d0) then iz= 0 ifz(7)= ifz(7)+1 go to 1 endif rasup= sqrt(asup) rasum= sqrt(asum) * *-----initialization of su = M_0^2 * *-----limits on su from cuts on FS IM * sulim= rrl(4) suuim1= rrr(4) suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) suuim= dmin1(suuim1,suuim2) * *-----limits on su from Delta_- > 0 (as derived from consistency * on sd limits) * suud1= 0.25d0*(rasup+rasum)*(rasup+rasum) suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup) * sul= sulim sul= dmax1(sul,sct23) if(ieq.eq.0) then sul1= bl(2)+bl(3)-1.d0 suu1= 1.d0-sp-bl(1) suu2= 1.d0-sm-bl(4) suu3= (1.d0-0.5d0*(bl(1)+bl(4)))* # (1.d0-0.5d0*(bl(1)+bl(4))) else if(ieq.eq.1) then sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc suu1= enc-sp-xbl(1) suu2= enc-sm-xbl(4) suu3= (enc-0.5d0*(xbl(1)+xbl(4)))* # (enc-0.5d0*(xbl(1)+xbl(4))) endif sul= dmax1(sul,sul1) suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) sdlim= rrl(3) * if(itc.eq.1.and.itcc.eq.2) then dsdl= dmax1(sdlim,sct140) dsuu= (dist/svv/rs-sqrt(dsdl))*(dist/svv/rs-sqrt(dsdl)) suu= dmin1(suu,dsuu) endif if(itc.eq.1.and.itcc.eq.3) then suud3= 1.d0-sm-sp-0.5d0*dist*dist/vv/s suu= dmin1(suu,suud3) endif * *-----test on su * if(suu.le.sul) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif * sujc= suu-sul su= sujc*sux+sul if(su.lt.0.d0) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * sdlim= rrl(3) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim= dmin1(sduim1,sduim2) * *-----limits on sd from Delta_- > 0 * if(ssu.gt.rasup) then sdld= (ssu-rasup)*(ssu-rasup) else sdld= sdlim endif sdud1= (ssu+rasup)*(ssu+rasup) sdud2= (-ssu+rasum)*(-ssu+rasum) sdud= dmin1(sdud1,sdud2) * *-----limits on sd from cuts on SA. Here for maximum security. Rare * if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then if(ss(2).eq.ss(1)) then asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) else if(ss(1).gt.ss(2)) then sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdu= dmin1(sduim,sdud,sdusa) asdl= dmax1(sdlim,sdld) else if(ss(1).lt.ss(2)) then asdu= dmin1(sduim,sdud) sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdl= dmax1(sdlim,sdld,sdlsa) endif else asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) endif if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then if(cs(2).eq.cs(1)) then sdl= asdl sdu= asdu else if(cs(1).gt.cs(2)) then sdu= asdu sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdl= dmax1(asdl,sdlsb) else if(cs(1).lt.cs(2)) then sdl= asdl sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdu= dmin1(asdu,sdusb) endif else sdl= asdl sdu= asdu endif * if(ieq.eq.0) then sdenl= -1.d0+bl(1)+bl(4)+su sdenu1= 1.d0-sp-bl(2) sdenu2= 1.d0-sm-bl(3) sdenu3= 1.d0-bl(2)-bl(3)+su else if(ieq.eq.1) then sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) sdenu1= enc-sp-xbl(2) sdenu2= enc-sm-xbl(3) sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3) endif sdl= dmax1(sdl,sdenl) sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) sdl= dmax1(sdl,sct14) if(itc.eq.1.and.itcc.eq.3) then sdld3= 1.d0-sm-sp-su-dist*dist/vv/s sdl= dmax1(sdl,sdld3) sdud3= 1.d0-sm-sp-su-0.5d0*dist*dist/vv/s sdu= dmin1(sdu,sdud3) endif * *-----test on sd * if(sdu.le.sdl) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * if(itc.eq.1.and.itcc.eq.2) then bdistl= (dist/rs-svv*ssu)*(dist/rs-svv*ssu)-vv*sdl bdistu= vv*sdu-(dist/rs-svv*ssu)*(dist/rs-svv*ssu) if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif endif * if(itc.eq.1.and.itcc.eq.2) then sd= (dist/rs/svv-ssu)*(dist/rs/svv-ssu) sdjc= 2.d0*abs((dist/rs-svv*ssu))/vv/ars else sdjc= sdu-sdl sd= sdjc*sdx+sdl endif if(sd.lt.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * ssd= sqrt(sd) sdmu= sd-su sdmus= (1.d0+sdmu)*(1.d0+sdmu) * *-----initialization of sf = m^2 * *-----limits on sf from cuts on FS IM * sflim1= rrl(2) sfuim1= rrr(2) bsg= sm+sp+su+sd ombsg= 1.d0-bsg sflim2= ombsg-rrr(5) sfuim2= ombsg-rrl(5) sflim= dmax1(sflim1,sflim2) sfuim= dmin1(sfuim1,sfuim2) * *-----limits on sf from cuts on SA * tcuts= ss(1)-ss(2)+ss(3)-ss(4) tcutc= cs(1)-cs(2)+cs(3)-cs(4) if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfu= dmin1(sfuim,sfusa,sfusb) asfl= sflim else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa,sflsb) asfu= sfuim else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) endif else asfl= sflim asfu= sfuim endif * if(ieq.eq.0) then asfenl1= bl(1)-sm-sd asfenl2= bl(3)-sp-su asfenu1= 1.d0-bl(2)-sp-sd asfenu2= 1.d0-bl(4)-sm-su else if(ieq.eq.1) then asfenl1= 1.d0-enc-sm-sd+xbl(1) asfenl2= 1.d0-enc-sp-su+xbl(3) asfenu1= enc-sp-sd-xbl(2) asfenu2= enc-sm-su-xbl(4) endif asfl= dmax1(asfl,asfenl1,asfenl2) asfu= dmin1(asfu,asfenu1,asfenu2) aasfu= 1.d0-sm-sp-su-sd-sct24 asfl= dmax1(asfl,sct13) asfu= dmin1(asfu,aasfu) * if(iac(3).ne.0) then if(ss(4).ne.ss(3)) then if(ss(4).gt.ss(3)) then asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfl= dmax1(asfl,asfltw) else if (ss(4).lt.ss(3)) then asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfu= dmin1(asfu,asfutw) endif endif if(cs(1).ne.cs(2)) then if(cs(1).gt.cs(2)) then bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfl= dmax1(asfl,bsfltw) else if(cs(1).lt.cs(2)) then bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfu= dmin1(asfu,bsfutw) endif endif if(cs(4).ne.cs(3)) then if(cs(4).gt.cs(3)) then csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfu= dmin1(asfu,csfutw) else if(cs(4).lt.cs(3)) then csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfl= dmax1(asfl,csfltw) endif endif if(ss(1).ne.ss(2)) then if(ss(1).gt.ss(2)) then dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfu= dmin1(asfu,dsfutw) else if(ss(1).lt.ss(2)) then dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfl= dmax1(asfl,dsfltw) endif endif endif * *-----positivity of R^2 * scp= ssmpp*ssmpp scm= ssmmp*ssmmp snp= (ssu+ssd)*(ssu+ssd) snm= (ssu-ssd)*(ssu-ssd) rlp= ssu*ssd+ssp*ssm rlm= ssu*ssd-ssp*ssm bsgmo= bsg-1.d0 ombsg2= ombsg*ombsg rlps= rlp*rlp rlms= rlm*rlm edelp= ombsg2-4.d0*rlps edelm= ombsg2-4.d0*rlms edeld= 16.d0*ssu*ssd*ssp*ssm * *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2 * then Delta_+ > 0 * *-----control * cnt1= scp+snm cnt2= scm+snp if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif if(edelm.le.0.d0) then etest= edeld+edelp if(etest.gt.0.d0) then edelm= etest else iz= 0 ifz(11)= ifz(11)+1 go to 1 endif endif sedm= sqrt(edelm) ifcr= 0 call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) if(rr1(2).ne.0.d0) then iz= 0 ifz(12)= ifz(12)+1 go to 1 endif ifcr= 0 call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) * cnt3= scp+snp cnt4= scm+snm cbru= -1.d0 ccru= 0.5d0*bsg * *-----R^2 has two real roots and two complex conjugate roots * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then if(bsg.gt.0.5d0) then iel= 1 sflr(1)= rr1(1) sfur(1)= rr2(1) sflr(2)= rr1(1) sfur(2)= rr2(1) else iel= 2 ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sflr(2)= ru2 sfur(1)= ru1 sfur(2)= rr2(1) endif * *-----R^2 has four real roots * else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(bsg.gt.0.5d0) then sflr(1)= rr1(1) sflr(2)= rs2(1) sfur(1)= rs1(1) sfur(2)= rr2(1) else ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sfur(1)= dmin1(rs1(1),ru1) sflr(2)= dmax1(rs2(1),ru2) sfur(2)= rr2(1) endif endif * *-----the loop for transforming sf starts here * if(om.eq.'g') then itmn= it0 itmx= it0 else itmn= 1 itmx= 2 endif do it=itmn,itmx if(sflr(it).ge.asfl) then sfl= sflr(it) else sfl= asfl endif if(sfur(it).le.asfu) then sfu= sfur(it) else sfu= asfu endif * *-----test on sf * if(sfu.le.sfl) then iz= 0 ifz(13)= ifz(13)+1 go to 2 endif * if(itc.eq.1.and.itcc.eq.3) then ittm= 2 else ittm= 1 endif * do itt=1,ittm * if(itc.eq.1.and.itcc.eq.3) then distm= dist/svv/rs sbdist= 2.d0*(1.d0-sm-sp-su-sd)-distm*distm if(sbdist.le.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 5 endif if(itt.eq.1) then bdist= 0.25d0*(distm-sqrt(sbdist))* # (distm-sqrt(sbdist)) else if(itt.eq.2) then bdist= 0.25d0*(distm+sqrt(sbdist))* # (distm+sqrt(sbdist)) endif bdistl= bdist-sfl bdistu= sfu-bdist if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 5 endif sf= bdist ssf= sqrt(sf) pfjc= 2.d0/vv/rs*ssf*(distm-ssf)/sqrt(sbdist) sfjc0= sf*sf+(sm+sp+su+sd-1.d0)*sf+su*sd+sm*sp sfjc= 4.d0*sm*sp*su*sd-sfjc0*sfjc0 if(sfjc.le.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 5 else if(iel.eq.1) then sfjc= 0.5d0*pfjc/sqrt(sfjc) else if(iel.eq.2) then sfjc= pfjc/sqrt(sfjc) endif endif else * *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then er= rs1(1) es= abs(rs1(2)) er1= rr1(1) er2= rr2(1) ek2= edelm/edeld ek= sqrt(ek2) dog= -2.d0/sqrt(edeld) ecpl= (ombsg-2.d0*sfl)/sedm ecpu= (ombsg-2.d0*sfu)/sedm eql= ecpl*ecpl equ= ecpu*ecpu omecpl= 2.d0*(sfl-er1)/sedm es2pl= omecpl*(2.d0-omecpl) erl= 1.d0-ek2*es2pl espl= sqrt(es2pl) opecpu= 2.d0*(er2-sfu)/sedm es2pu= opecpu*(2.d0-opecpu) espu= sqrt(es2pu) eru= 1.d0-ek2*es2pu if(eql.eq.1) then sflt= 0.d0 else ifel= 1 sflt= -dog*espl*s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(14)= ifz(14)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 sfut= -dog*espu*s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(15)= ifz(15)+1 go to 2 endif endif if(iel.eq.1) then if(sfu.le.er) then efac= 0.5d0 sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(16)= ifz(16)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(sfl.ge.er) then efac= 0.5d0 sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(17)= ifz(17)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) else efac= 1.d0 qbar= 0.d0 rbar= 1.d0-ek2 ifel= 1 sfbar= -dog*s21bbf(qbar,rbar,one,ifel) if(ifel.ne.0) then iz= 0 ifz(18)= ifz(18)+1 go to 2 endif if(it.eq.1) then sft= (sfbar-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(19)= ifz(19)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfbar-sflt) else if(it.eq.2) then sft= (sfbar-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(20)= ifz(20)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sfbar-sfut) endif endif else if(iel.eq.2) then efac= 1.d0 if(it.eq.1) then sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(21)= ifz(21)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(it.eq.2) then sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(22)= ifz(22)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) endif endif else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(edelp.le.0.d0) then iz= 0 ifz(23)= ifz(23)+1 go to 2 endif sedp= sqrt(edelp) efac= 1.d0 es1= rs1(1) es2= rs2(1) er1= rr1(1) er2= rr2(1) ssed= sedm+sedp ek= (sedm-sedp)/ssed ek2= ek*ek dog= 2.d0/ssed if(it.eq.1) then es2pl= (er1-sfl)/(sfl-er2)/ek es2pu= (er1-sfu)/(sfu-er2)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu else if(it.eq.2) then es2pl= (sfl-es2)/(sfl-es1)/ek es2pu= (sfu-es2)/(sfu-es1)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu endif if(eql.eq.1.d0) then sflt= 0.d0 else ifel= 1 sflt= 2.d0*dog*sqrt(es2pl)* # s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(24)= ifz(24)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then equ= 0.d0 endif sfut= 2.d0*dog*sqrt(es2pu)* # s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(25)= ifz(25)+1 go to 2 endif endif sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= 0.5d0/dog*sft call s21caf(asf,ek2,elsn,elcn,edn,ifel) elsn2= elsn*elsn if(ifel.ne.0) then iz= 0 ifz(26)= ifz(26)+1 go to 2 endif if(it.eq.1) then sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2) else if(it.eq.2) then sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) endif sfjc= efac*(sfut-sflt) endif * endif * *-----auxiliary quantities * sdpf= sd+sf e3= sp+su+sf e4= 1.d0+spmm-e3 e3p4= 1.d0+spmm e1= sm+sdpf e2= 1.d0+smmp-e1 e1p2= 1.d0+smmp e1p3= e1+e3 e1m2= 2.d0*e1-1.d0+spmm ep12= xp*e1*e2 ep1= xp*e1 ep2= xp*e2 ep3= xp*e3 ep4= xp*e4 e1t2= e1*e2 e1t3= e1*e3 e1t4= e1*e4 e2t3= e2*e3 e2t4= e2*e4 e3t4= e3*e4 if((e1p3*e1p3-4.d0*sf).lt.0.d0) then iz= 0 ifz(27)= ifz(27)+1 go to 2 endif skl2= sqrt(e1p3*e1p3-4.d0*sf) if((sdmus-4.d0*sd).lt.0.d0) then iz= 0 ifz(28)= ifz(28)+1 go to 2 endif skl3= sdmus-4.d0*sd skl3= sqrt(skl3) * *-----initialization of t_w * *-----limits on tw from positivity and SA * twlp1= 0.d0 twlp2= smmp twlp3= spmm-1.d0 twlp= dmax1(twlp1,twlp2,twlp3) twup= 1.d0 * *-----limits on tw from cuts on SA * if(iac(3).ne.0) then skl2m= 0.5d0*(e1p3-skl2) skl2p= 0.5d0*(e1p3+skl2) skl3p= -0.5d0*(1.d0+sdmu-skl3) skl3m= -0.5d0*(1.d0+sdmu+skl3) twlsa1= 1.d0-cs(3)*e3-cs(4)*e4 twlsa2= ss(1)*e1+ss(2)*e2 twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m twusa1= 1.d0-ss(3)*e3-ss(4)*e4 twusa2= cs(1)*e1+cs(2)*e2 twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4, # twlsa5,twlsa6) atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, # twusa5,twusa6) else atwl= twlp atwu= twup endif * *-----limits on tw from E * if(ieq.eq.1) then atwle= 1.d0-bxe*e3p4+bl(3)+bl(4) atwue= bxe*e1p2-bl(1)-bl(2) if(xdf.gt.0.d0) then twle= atwle twue= atwue else if(xdf.lt.0.d0) then atwle1= bxe*e1-bl(1) atwle2= bxe*e2-bl(2) atwue1= 1.d0-bxe*e3+bl(3) atwue2= 1.d0-bxe*e4+bl(4) twle= dmax1(atwue,atwle1,atwle2) twue= dmin1(atwle,atwue1,atwue2) endif atwl= dmax1(atwl,twle) atwu= dmin1(atwu,twue) endif * *-----natural limits on tw * atwl= dmax1(atwl,bt1(1)) atwu= dmin1(atwu,bt2(1)) * *-----test on tw * if(atwu.le.atwl) then iz= 0 ifz(29)= ifz(29)+1 go to 2 endif * twjc= atwu-atwl tw= twjc*twx+atwl pn= tw+sp-1.d0 omtw= 1.d0-tw * *-----initialization of t1 * *-----limits on t1 from positivity+SA * t1lp1= 0.d0 t1lp2= pn+sdpf t1up1= tw t1up2= sm+sdpf t1lp= dmax1(t1lp1,t1lp2) t1up= dmin1(t1up1,t1up2) * *-----limits on t1 from cuts on SA * if(iac(3).ne.0) then t1lc1= ss(1)*e1 t1lc2= tw-cs(2)*e2 t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3 t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 t1uc1= cs(1)*e1 t1uc2= tw-ss(2)*e2 t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3)) t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3 t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4 t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6) t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6) at1l= dmax1(t1lp,t1lc) at1u= dmin1(t1up,t1uc) else at1l= t1lp at1u= t1up endif * *-----limits on t1 from E * if(ieq.eq.1) then at1le= tw-bxe*e2+bl(2) at1ue= bxe*e1-bl(1) if(xdf.gt.0.d0) then t1le= at1le t1ue= at1ue else t1le= at1ue t1ue= at1le endif at1l= dmax1(at1l,t1le) at1u= dmin1(at1u,t1ue) endif * *-----positivity of (R')^2 / reality of roots for t3 * rp0= e1p2*e1p2-4.d0*sm if(rp0.lt.0.d0) then iz= 0 ifz(30)= ifz(30)+1 go to 2 endif srp0= sqrt(rp0) rp0e= -rp0 rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 rp1e= 2.d0*rp1 rp2= -(e1*tw-sm)*(e1*tw-sm) ifct= 0 if(rp0e.ne.0.d0) then call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) t1l= dmax1(at1l,ret1(1)) t1u= dmin1(at1u,ret2(1)) else if(rp0e.eq.0.d0) then sret1= -rp2/rp1e if(rp1e.gt.0.d0) then t1l= dmax1(at1l,sret1) t1u= at1u else if(rp1e.lt.0.d0) then t1l= at1l t1u= dmin1(at1u,sret1) endif endif * *-----test on t1 * if(t1u.le.t1l) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif * sr= 1.d0-sm-sp-su-sd-sf * *-----transformation for jacobian * if(rp0e.eq.0.d0) then taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2) taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) t1jc= taut-taul t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e endif if(ret1(1).eq.t1l) then at1tl= -pih/srp0 else bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) ifas= 1 at1tl= -s09aaf(bt1tl,ifas)/srp0 if(ifas.ne.0) print 200 endif if(ret2(1).eq.t1u) then at1tu= pih/srp0 else bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) ifas= 1 at1tu= -s09aaf(bt1tu,ifas)/srp0 if(ifas.ne.0) print 200 endif if((at1tl+at1tu).eq.0.d0) then if(t1x.lt.1.d-3) then arc= pi*t1x arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc else if((1.d0-t1x).lt.1.d-3) then arc= pi*(1.d0-t1x) arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc else carc= cos(pi*t1x) t1= 0.5d0*(ret1(1)+ret2(1))+ # 0.5d0*(ret1(1)-ret2(1))*carc endif t1jc= pi/srp0 else t1tl= dmin1(at1tl,at1tu) t1tu= dmax1(at1tl,at1tu) t1jc= t1tu-t1tl t1t= t1jc*t1x+t1tl t1= (rp1+rpds*sin(srp0*t1t))/rp0 endif t1s= t1*t1 * 200 format(' Unsuccesful call to S09AAF ') * *-----test on t1 from FS A * if(ieq.eq.1.and.iac(4).ne.0.d0) then cnlct1= xp*(xm*sm-ep12*cg12)+xdf* # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1- # xdf*tw)+xdfs*cg12*t1s cnlst1= xp*(ep12*sg12-xm*sm)-xdf* # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ # xdf*tw)-xdfs*sg12*t1s if(cnlct1.lt.0.d0) then iz= 0 ifz(32)= ifz(32)+1 go to 2 else if(cnlst1.lt.0.d0) then iz= 0 ifz(33)= ifz(33)+1 go to 2 endif endif * *-----some vector components * t2= tw-t1 t2s= t2*t2 * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 * *-----equation for xi is solved * e1s= e1*e1 e2s= e2*e2 e3s= e3*e3 e12= e1t2-2.d0*sm e13= e1t3-2.d0*sf e23= e2t3-2.d0*su e12s= e12*e12 e13s= e13*e13 e23s= e23*e23 xia= e1s*e2s-e12s xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ # e2*e12*e13 xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13* # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 xib= 2.d0*xib if(xia.eq.0.d0) then if(xib.eq.0.d0) then iz= 0 ifz(34)= ifz(34)+1 go to 2 endif rtm(1)= -xic/xib rtp(1)= rtm(1) rtm(2)= 0.d0 rtp(2)= 0.d0 ixia= 0 else ixia= 1 ifc0= 0 call c02ajf(xia,xib,xic,rtm,rtp,ifc0) endif if(rtm(2).ne.0.d0) then iz= 0 ifz(35)= ifz(35)+1 go to 2 endif * * *-----xi^+ and xi^- are computed * xip= 0.5d0*(e3-rtp(1)) xim= 0.5d0*(e3-rtm(1)) * *-----each integral becomes a sum of two terms * *-----loop over ix starts here * if(om.eq.'g') then ixmn= ix0 ixmx= ix0 else ixmn= 1 ixmx= 2 endif do ix=ixmn,ixmx * *-----x15 is selected * if(ix.eq.1) then t3= xip else if(ix.eq.2) then t3= xim endif * *-----The two integrands are computed * *-----further auxiliary quantities * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 edn3= ep3-xdf*t3 t4= omtw-t3 edn4= ep4-xdf*t4 * *-----collections of all limits on t3 * *-----from energy (or natural limits) * if(ieq.eq.1) then at3l1= omtw-bxe*e4+bl(4) at3u1= bxe*e3-bl(3) if(xdf.gt.0.d0) then t3l1= at3l1 t3u1= at3u1 else if(xdf.lt.0.d0) then t3l1= at3u1 t3u1= at3l1 endif else t3l1= 0.d0 t3u1= e3 endif * *-----natural limits * t3l2= -t1+0.5d0*(e1p3-skl2) t3u2= -t1+0.5d0*(e1p3+skl2) * t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3) * *-----from positivity on SA * t3l4= 0.d0 t3l5= sm+su+sf-tw t3u4= sp+su+sf t3u5= omtw * *-----from SA * if(iac(3).ne.0) then t3l6= ss(3)*e3 t3u6= cs(3)*e3 t3l7= omtw-cs(4)*e4 t3u7= omtw-ss(4)*e4 t3l= dmax1(t3l1,t3l2,t3l3,t3l4, # t3l5,t3l6,t3l7) t3u= dmin1(t3u1,t3u2,t3u3,t3u4, # t3u5,t3u6,t3u7) else t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5) endif * *-----limits on t3 are imposed * tlimt3= (t3u-t3)*(t3-t3l) if(t3u.lt.t3l) then iz= 0 ifz(36)= ifz(36)+1 go to 4 else if(tlimt3.lt.0.d0) then iz= 0 ifz(36)= ifz(36)+1 go to 4 endif * *-----non linear limits on t3,t4 are imposed * if(iac(4).ne.0.and.ieq.eq.1) then tnl13c= -cg13*edn1*edn3+vv*sf tnl13s= sg13*edn1*edn3-vv*sf tnl23c= -cg23*edn2*edn3+vv*su tnl23s= sg23*edn2*edn3-vv*su tnl14c= -cg14*edn1*edn4+vv*sd tnl14s= sg14*edn1*edn4-vv*sd sres= 1.d0-e1-e3+sf tnl24c= -cg24*edn2*edn4+vv*sres tnl24s= sg24*edn2*edn4-vv*sres tnl34c= -cg34*edn3*edn4+vv*sp tnl34s= sg34*edn3*edn4-vv*sp if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or. # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then iz= 0 ifz(37)= ifz(37)+1 go to 4 endif endif * *-----non linear constraints from FS A in the case xp = xm * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(38)= ifz(38)+1 go to 4 endif endif * *-----all invariants * x13= t1 x14= t2 x15= t3 x16= t4 x23= e1-t1 x24= e2-t2 x25= e3-t3 x26= e4-t4 x34= sm x35= sf x36= sd x45= su x46= 1.d0-e1-e3+sf x56= sp * if(ios.eq.3) then scal25= vv*x25*s rscal25= -svv*sqrt(x25)*rs scal16= vv*x16*s rscal16= -svv*sqrt(x16)*rs call wtopself(scal25,pggf25) call wtopself(scal16,pggf16) der25l= 0.25d0*alpha/pi*pggf25 der16l= 0.25d0*alpha/pi*pggf16 eth= 40.d0/rs/vv if(abs(rscal25).gt.40.d0) then call wtohadr5(rscal25,der25h,eder25h) else call wtopselfnp(scal25,pggnp25) der25h= 0.25d0*alpha/pi*pggnp25 endif if(abs(rscal16).gt.40.d0) then call wtohadr5(rscal16,der16h,eder16h) else call wtopselfnp(scal16,pggnp16) der16h= 0.25d0*alpha/pi*pggnp16 endif der25= der25l+der25h der16= der16l+der16h alp25= alpha/(1.d0-der25) alp16= alpha/(1.d0-der16) corrg25= 4*pi*alp25/g2/sth2 corrg16= 4*pi*alp16/g2/sth2 else corrg25= 1.d0 corrg16= 1.d0 endif * *-----computes cross-section * *-----born matrix element is calculated at the reduced c.m. energy * *-----propagators for pair production diagrams * pfpb= e3-1.d0 pfp= e4-1.d0 pfb= e1-1.d0 pf= e2-1.d0 * *-----extra propagators * vrwm2= rwm2/vv x25w= x25+vrwm2 x16w= x16+vrwm2 ptww= x16w*x25w pnp= tw-sm * *-----The epsilons are computed in the order * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4), * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4), * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) * x13s= x13*x13 x14s= x14*x14 x15s= x15*x15 x16s= x16*x16 x23s= x23*x23 x24s= x24*x24 x25s= x25*x25 x26s= x26*x26 x34s= x34*x34 x35s= x35*x35 x36s= x36*x36 x45s= x45*x45 x46s= x46*x46 x56s= x56*x56 * *-----Few common combinations * p1= x13*x14 p2= x13*x16 p3= x13*x23 p4= x13*x25 p5= x13*x25s p6= x13s*x25s p7= x13*x26 p8= x13*x35 p9= x13*x45 p10= x13*x46 p11= x13*x56 p12= x14*x16 p13= x14*x23 p14= x14*x23s p15= x14*x25 p16= x14*x25s p17= x14*x26 p18= x14*x35 p19= x14*x35s p20= x14*x36 p21= x14*x45 p22= x14*x56 p23= x15*x23 p24= x15*x24 p25= x15*x26 p26= x15*x34 p27= x15*x36 p28= x15*x46 p29= x16*x23 p30= x16*x23 p31= x16*x25 p32= x16*x25s p33= x16*x34 p34= x16*x35 p35= x16*x56 p36= x23*x25 p37= x23*x26 p38= x23*x34 p39= x23*x35 p40= x23*x36 p41= x23*x45 p42= x23*x46 p43= x23*x56 p44= x23*x56s p45= x24*x25 p46= x24*x35 p47= x24*x36 p48= x24*x56 p49= x25*x26 p50= x25*x34 p51= x25*x35 p52= x25*x36 p53= x25*x45 p54= x25*x46 p55= x25*x56 p56= x26*x34 p57= x26*x35 p58= x26*x35s p59= x26s*x35 p60= x26*x36 p61= x26*x45 p62= x26s*x45 p63= x26*x56 p64= x34*x35 p65= x34*x36 p66= x34*x46 p67= x34*x56 p68= x34*x56s p69= x35*x36 p70= x35*x45 p71= x35*x46 p72= x35*x56 p73= x36*x45 p74= x36*x46 p75= x45*x56 p76= x46*x56 * u1= p1*x25 u2= p1*x56 u3= p3*x45 u4= x13*p48 u5= p4*x46 u6= p4*x56 u7= p7*x45 u8= x13*p73 u9= p12*x23 u10= p12*x25 u11= p12*x35 u12= p13*x35 u13= p13*x56 u14= p15*x26 u15= p15*x35 u16= p15*x36 u17= p15*x56 u18= p17*x35 u19= p18*x36 u20= p20*x45 u21= p23*x46 u22= p24*x36 u23= p25*x34 u24= p29*x45 u25= x16*p46 u26= p31*x34 u27= p31*x35 u28= p36*x46 u29= p49*x34 u30= p36*x36 u31= p36*x34 u32= p38*x56 u33= p50*x56 u34= p52*x45 u35= p54*x56 u36= p57*x45 u37= p57*x56 u38= p64*x56 u39= p37*x46 u40= p39*x56 u41= p52*x56 u42= p39*x45 * w1= p7-p29 w2= p9-p18 w3= p42-p56 w4= p11-p34 w5= p31-x56 w6= p4-x35 w7= p71-p73 w8= p67-p71 w9= p43-p57 w10= p54-p61 w11= p41-p50 w12= -x13+p18/x45 w13= p54/x45-x26 w14= -p16/x45+x25 w15= 1.d0-p15/x45 w16= x14+x16 w17= p11+p34 w18= p49+p57 w19= -p41-p50 w20= p22+p35 w21= p67+p71 w22= -p43+p52 w23= -p43-p57 w24= p11-p27 w25= p34-p52 w26= -p43-p52 w27= -p52-p57 w28= p67-p73 w29= -p67-p73 w30= p27-p34 w31= p52-p57 w32= -p61+p54 * ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s-x35s ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+ # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+ # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- # x15s*x34s ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+ # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- # x25s*x34s * e(1)= 1.d0 e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0* # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45- # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35- # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45 e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13* # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+ # x25*x34s * *-----sign of eps_1*eps_i * ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo * if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= ses2 s3= -ses1-ses2 s4= ses3 s5= ses1-ses3 s6= ses2+ses3 s7= ses4 s8= ses1-ses4 s9= ses2+ses4 s10= ses3-ses4 s11= ses5 s12= -ses1-ses5 s13= -ses2+ses5 s14= -ses3-ses5 s15= -ses4-ses5 else ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s-x36s ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+ # x16*x24*x46)-x14s*x26s-x16s*x24s-x46s ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ # x14*x16*x34*x36)-x13s*x46s-x14s*x36s- # x16s*x34s ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- # x26s*x34s e(1)= 1.d0 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23*x34- # x13s*x24*x26-x34*x36 e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13* # x24*x46-x14*x16*x23*x24+x14*(-x23* # x46+2.d0*x24*x36-x26*x34)-x16*x24* # x34+x14s*x23*x26+x34*x46 e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26* # x34)+x13*x16*x24*x34+x13*x34*x46+ # x14*x16*x23*x34+x14*x34*x36-x16* # x34s-x13s*x24*x46-x14s*x23*x36 e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36* # x24s)+x14*(-x23*x24*x36-x23*x26* # x34+x46*x23s)+x16*2.d0*x23*x24*x34- # x23*x34*x46-x24*x34*x36+x26*x34s ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= -ses1-ses2 s3= ses2 s4= -ses1-ses3 s5= ses3 s6= -ses2-ses3 s7= ses1-ses4 s8= ses4 s9= -ses2-ses4 s10= -ses3+ses4 s11= -ses1-ses5 s12= ses5 s13= ses2-ses5 s14= ses3+ses5 s15= ses4+ses5 else ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s- # x35s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s- # x36s ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+ # x16*x25*x56)-x15s*x26s-x16s*x25s- # x56s ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35* # x56+x15*x16*x35*x36)-x13s*x56s- # x15s*x36s-x16s*x35s ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35* # x56+x25*x26*x35*x36)-x23s*x56s- # x25s*x36s-x26s*x35s * e(1)= x13*x14*x23*x25+x13*x15*x23*x24+ # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- # x14*x15*x23s+x14*x23*x35+x15*x23* # x34-x13s*x24*x25-x34*x35 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23* # x34-x13s*x24*x26-x34*x36 e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+ # x13*(-x25*x46+x26*x45)+x14*x15*x23* # x26-x14*x16*x23*x25+x14*(x25*x36-x26* # x35)+x15*(-x23*x46+x24*x36)+x16*(x23* # x45-x24*x35)+x35*x46-x36*x45 e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ # x25*x34)+x13*(x35*x46-x36*x45)-x14* # x15*x23*x36+x14*x16*x23*x35+x15*x34* # x36-x16*x34*x35+x13s*(-x25*x46+x26* # x45) e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* # x36-x24*x26*x35)+x15*(-x23*x24*x36- # x23*x26*x34+x46*x23s)+x16*(x23*x24* # x35+x23*x25*x34-x45*x23s)-x23*x35* # x46+x23*x36*x45-x25*x34*x36+x26*x34* # x35 * ises= 0 do i=1,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= -ses1-ses2 s2= ses1 s3= ses2 s4= -ses1+ses3 s5= -ses2-ses3 s6= ses3 s7= -ses1+ses4 s8= -ses2-ses4 s9= ses4 s10= ses3-ses4 s11= ses1+ses5 s12= ses2-ses5 s13= ses5 s14= -ses3-ses5 s15= -ses4-ses5 else iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif endif * tgn(1)= x15*x24 tgn(2)= x34*x46 tgn(3)= x34/x46 tgn(4)= x24/x15 tgn(5)= x15/x25 tgn(6)= x15*x25 tgn(7)= x14*x25 tgn(8)= x14*x34 tgn(9)= x25*x46 tgn(10)= x25/x46 tgn(11)= x14/x34 tgn(12)= x45/x36 tgn(13)= x14*x24 tgn(14)= x24/x14 tgn(15)= x45*x36 tgn(16)= x14/x25 * if(otype.eq.'nc48'.or.otype.eq.'nc50') then if(x45.lt.1.d-4) then itr= 1 else itr= 0 endif else if(otype.eq.'nc19'.or. # otype.eq.'nc21') then if(otrans.eq.'n') then itr= 0 else if(otrans.eq.'y') then if(x45.lt.1.d-4) then itr= 1 else itr= 0 endif endif else itr= 0 endif * if(itr.eq.1) then tgnn(1)= x56/x15/x24/x35 tgnn(2)= x15/x24/x35/x56 tgnn(3)= 1.d0/x15/x24/x35/x56 tgnn(4)= x24/x15/x35/x56 tgnn(5)= x15*x24/x35/x56 tgnn(6)= 1.d0/x34/x35/x46/x56 itgnn= 0 do l=1,6 if(tgnn(l).le.0.d0) then itgnn= itgnn+1 endif enddo if(itgnn.ne.0) then iz= 0 ifz(40)= ifz(40)+1 go to 4 endif gnn1= sqrt(tgnn(1)) gnn2= sqrt(tgnn(2)) gnn3= sqrt(tgnn(3)) gnn4= sqrt(tgnn(4)) gnn5= sqrt(tgnn(5)) gnn6= sqrt(tgnn(6)) endif * itgn= 0 do l=1,16 if(tgn(l).le.0.d0) then itgn= itgn+1 endif enddo if(itgn.ne.0) then iz= 0 ifz(40)= ifz(40)+1 go to 4 endif * gpna= sqrt(tgn(1)) gpnb= sqrt(tgn(2)) gpnc= sqrt(tgn(3)) gpnd= sqrt(tgn(4)) gpne= sqrt(tgn(5)) gpnf= sqrt(tgn(6)) gpng= sqrt(tgn(7)) gmna= sqrt(tgn(8)) gmnb= sqrt(tgn(9)) gmnc= sqrt(tgn(10)) gmnd= sqrt(tgn(11)) gmne= sqrt(tgn(12)) gmnf= sqrt(tgn(13)) gmng= sqrt(tgn(14)) gmnh= sqrt(tgn(15)) gmni= sqrt(tgn(16)) * gn1= gpna/gpnb gn2= gpna*gpnc gn3= gpna/gpnc gn4= gpnd/gpnb gn5= 1.d0/gpna/gpnc gn6= 1.d0/gpnd/gpnc gn7= gpnd/gpnc gn8= gpnb/gpna gn9= gpnd*gpnc gn10= gpnb/gpnd gn11= gpna*gpnb gn12= gmnd/gmnb gn13= 1.d0/gmnc/gmna gn14= gmna/gmnb gn15= gmnd/gmnc gn16= 1.d0/gmnd/gmnc gn17= gmna*gmnb gn18= gmnc/gmnd gn19= gmnc/gmna gn20= gmna*gmnc gn21= gmnd*gmnb gn22= gmnd*gmnc gn23= gmnb/gmnd gn24= gmnb/gmna gn25= gpnc/gpnd gn26= 1.d0/gpna/gpnb gn27= gpnc/gpna gn28= 1.d0/gpnd/gpnb gn29= gpne/gmnh gn30= gmne/gpnf gn31= 1.d0/gpnf/gmne gn32= 1.d0/gpnf/gmnh gn33= gpne*gmne gn34= gpne/gmne gn35= gmnh/gpnf gn36= gmnh*gpne gn37= gpnb*gmni gn38= gpnc/gpng gn39= 1.d0/gpng/gpnb gn40= gmne/gmnf gn41= gmng*gmne gn42= 1.d0/gmnf/gmnh gn43= gmng/gmnh gn44= gmne/gmng gn45= 1.d0/gmng/gmnh gn46= gmnf/gmnh gn47= gmnf*gmne gn48= gmnh/gmnf gn49= 1.d0/gmng/gmne gn50= gmng*gmnh gn51= 1.d0/gmnf/gmne gn52= gmnh/gmng gn53= gmnf*gmnh gn54= gmnf/gmne gn55= 1.d0/gpnb*gmni gn56= 1.d0/gpnc/gpng gn57= gpnc*gmni gn58= 1.d0/gpnc*gmni gn59= gpnb/gpng gn60= gpnb*gpng gn61= gpnc/gmni gn62= 1.d0/gpnb/gmni gn63= gpnc*gpng gn64= 1.d0/gpnc*gpng gn65= 1.d0/gpnb*gpng gn66= gpnb/gmni gn67= 1.d0/gpnc/gmni gn68= gpne/gmne gn69= 1.d0/gpnf*gmnh gn70= 1.d0/gmne*gmng * *-----helicity a-b) * *-----Conversion diagram 1: common part * c1abrc= gn12*(u4-u7-u13-u16+u18-u22+u24-u25+p73)+gn13*(-u4-u5+ # u7-u21+u22+u24-u25+w7)+gn14*(p25+w5)+gn15*(w6+p23+w9+ # p52)+gn16*(-p25+p31+x56) c1abic= 4.d0*(s1*gn12*x56+s1*gn13*(-2.d0*x15+x56)+2.d0*s5*gn38* # (-x15+x56)-s6*gn14+s6*gn16+s7*gn13*x26+2.d0*s8*gn39*x24* # (x15-x56)-s8*gn13*x25+s9*gn12*x24-s10*gn12*x23+s11*gn12* # x16+s12*gn12*(-x15+2.d0*x56)-s13*gn15+s14*gn13*x13) * *-----Conversion diagram 2: common part * c2abrc= 2.d0*(-gn12*u16+gn14*p31+gn15*p4-2.d0*gn37*x25) c2abic= 8.d0*s8*gn12*x25 * *-----Pair production I: common part * p1abrc= 2.d0*(gn13*p4*(x24-x45)+gn15*x25*(-x23+x35)+gn16*x25* # (x15-1.d0)) p1abic= 8.d0*gn13*x25*(s1-s7) * *-----Pair production II: common part * p2abrc= gn12*(-u4+u7+u13-u16-u18+u22-u24+u25-p73)+gn13*(u4-u5-u7+ # u21-u22-u24+u25-w7)+gn14*(-p25+p31+x56)+gn15*(p4-p23-w9+ # p52+x35)+gn16*(p25+w5) p2abic= 4.d0*(s1*gn13*x56-s2*gn15+s5*gn12*x35-s6*gn16-s7*gn13* # x26+s8*gn12*x25-s8*gn13*x25+s10*gn12*x23-s11*gn12*x16- # s13*gn12*x14+s13*gn15-s14*gn13*x13) * *-----Pair production III: common part * p3abrc= gn12*(u4-u7-u13+u16+u18-u22+u24-u25+p73)+gn14*(p25-p31- # x56)+gn15*(-p4+p23-2.d0*p41+2.d0*p46-x35)+2.d0*gn37*x25 p3abic= 4.d0*(s2*gn15-s5*gn12*x35-s8*gn12*x25-s10*gn12*x23+s11* # gn12*x16-2.d0*s11*gn15+s13*gn12*x14) * *-----Pair production IV: common part * p4abrc= 2.d0*(gn13*x13*(-p41-p45+p46)+gn15*p36+gn16*(p23+x25- # x35)) p4abic= 8.d0*gn13*((x35-x25)*s1-x23*s7) * *-----helicity c-d) * *-----Conversion diagram 1: common part * c1cdrc= 2.d0*(gn1*x36*(x14-x45)+gn2*(-x16+x56)+gn3*(-x13+x35)) c1cdic= 8.d0*gn1*(s8-s15) * *-----Conversion diagram 2: common part * -F c2cdrc= 2.d0*(gn1*p20-gn2*x16+gn4*x36*w2-gn5*x23*w2-gn6*p13+gn8* # w6-gn9*w4+gn10) c2cdic= 8.d0*(s1*gn5*x35+s5*gn25-s8*gn4*x35+s11*gn5*x13+s12*gn28* # x14+s15*gn4*x13) * *-----Pair production I: common part * p1cdrc= 2.d0*(gn3*(x13-x35)+gn6*x23*(-x14+x45)+gn10*(1.d0-x25)) p1cdic= -8.d0*gn6*(s1+s11) * *-----Pair production II: common part) * p2cdrc= gn1*p47-gn2*x26-gn3*(x23+x36)+gn4*(-u4+u7+u13-u16- # u18-u24+u25+p73)+gn5*(-u5+u7-u13+u16-u18+u24+w7)+ # gn6*p42+gn7*(w6+w4)-gn8*w5+gn9*w5-gn10*x26 p2cdic= 4.d0*(-s2*gn5*x46+s2*gn7-s4*gn4*x36+s4*gn5*x36+ # s6*gn8-s6*gn9-2.d0*s7*gn5*x26-s8*gn4*x25+s8*gn5* # x25+s12*gn1-s12*gn6+s15*gn4-s15*gn5) * *-----Pair production III: common part * p3cdrc= -gn1*p47+gn2*x26+gn3*x23+gn4*(u4-u7-u13+u16+u18+u24- # u25-p73)+gn7*(-w6+2.d0*w2)-gn9*w5-2.d0*gn11 p3cdic= 4.d0*(-s2*gn7+s4*gn4*x36+s6*gn9-2.d0*s7*gn7+s8*gn4* # x25-s12*gn1-s15*gn4) * *-----Pair production IV: common part * p4cdrc= 2.d0*(-gn3*x13+gn5*x23*w2+gn6*p13-gn8*w6-gn10) p4cdic= 8.d0*(s1*gn6-s2*gn8-s7*gn5*x23) * *-----helicity e-f) * *-----Conversion diagram 1: common part-G * c1efrc= gn40*(u5-u7-u21+u23+u24-u26+w8)-gn41*w4+gn44*(w1-w9)+ # gn45*(-u5+u13-u18-u21+u23+u26-w8)+gn46*w4+gn48*x45+gn49* # p15-gn50*x15-gn52*(1.d0+x25)-gn54*x15 c1efic= 4.d0*(-s1*gn40*x56+s3*gn44+s4*gn48-s4*gn49-s5*gn40*x35+ # s7*gn45*x26+s9*gn41-s10*gn45*x23+s12*gn45*x15+s13*gn44- # s13*gn45*x14+s15*gn40) * *-----Conversion diagram 2: common part * c2efrc= gn44*(w1+2.d0*w3)+gn45*(-u5+u13-u18-u21+u23+u26-w8)+gn46* # w4-gn49*p15+gn52-2.d0*gn53+gn54*x15 c2efic= 4.d0*(s3*gn44+s4*gn49+s7*gn45*x26-s10*gn45*x23-2.d0* # s12*gn44+s12*gn45*x15-s13*gn45*x14) * *-----Pair production I: common part * p1efrc= 2.d0*(-gn48*x45-gn49*p15+gn50*x15+gn52*(1.d0+x25)+ # gn54*x15) p1efic= 8.d0*(gn49-gn48)*s4 * *-----Pair production II: common partr * p2efrc= 2.d0*(gn40*w3+gn41*w1-gn48*x46+gn50*x16+gn52*x26) p2efic= 8.d0*(s1*gn40*x26+s5*gn40*x23-s5*gn48) * *-----Pair production III: common part * p3efrc= 2.d0*(gn49*p15-gn52+2.d0*gn53-gn54*x15) p3efic= -8.d0*s4*gn49 * *-----Pair production IV: common part * p4efrc= 2.d0*(-gn40*w3-gn41*w1-gn48*x34+gn50*x13+gn52*x23) p4efic= 4.d0*(s1*gn42*(p67+2.d0*p71)-s1*gn43*x56-s2*gn42*p66-s2* # gn43*x46-s4*gn51*x34+2.d0*s5*gn42*p64-s5*gn43*x35-s6*gn43* # x34-s7*gn43*x26-s8*gn42*p50+2.d0*s8*gn43*x25-s9*gn43*x34- # s10*gn42*p38+s10*gn43*x23+s11*gn42*(p33+2.d0*x46)-s11* # gn43*x16+2.d0*s13*gn45*x34-2.d0*s13*gn46-2.d0*s14*gn42* # x34+s14*gn43*x13+s15*gn42*x34-2.d0*s15*gn43*x13+2.d0* # s15*gn45*x23) * *-----helicity g-h) * *-----Conversion diagram 1: common part * c1ghrc= 2.d0*(gn29*(-u5+u26)-gn30*w4-gn31*u17+gn32*(u1*x56-u10* # x35)+gn33*w1+gn34*p54+gn35*x56-gn36*x26) c1ghic= 8.d0*(-s2*gn30*x16-s6*gn30*x13+s6*gn35-s7*gn32*p31-s10* # gn31*x25+s10*gn32*p4) * *-----Conversion diagram 2: common part * c2ghrc= 2.d0*(gn29*x25*(-p10+p33)+gn31*u15+gn32*p15*w4-gn34* # p50-gn35*p4) c2ghic= 8.d0*(s7*gn31*x25-s8*gn29*x25+s9*gn32*p15) * *-----Pair production I: common part * p1ghrc= 2.d0*(gn31*p16-gn34*p45-gn35*x25+2.d0*gn36*x25) p1ghic= 8.d0*s4*gn31*x25 * *-----Pair production II: common part * p2ghrc= 2.d0*(gn30*w4-gn33*w1+gn35*w5+gn36*x26) p2ghic= 8.d0*(s2*gn30*x16+s6*gn30*x13-s6*gn35+s7*gn32*(p31- # 0.5d0*p49)-s8*gn29*x25+0.5d0*s8*gn32*x25s+s9*gn32*x25* # (x14-0.5d0*x24)+s10*gn32*x25*(-x13+0.5d0*x23)+0.5d0* # s11*gn32*p31-0.5d0*s12*gn29*x25+0.5d0*s13*gn32*p15- # 0.5d0*s14*gn32*p4) * *-----Pair production III: common part * p3ghrc= 2.d0*(-gn31*p16+gn34*p45+gn35*(p15+x25-x45)+gn36*x24) p3ghic= 8.d0*s4*(gn35-gn31*x25) * *-----Pair production IV: common part * p4ghrc= 2.d0*(-gn30*w4+gn33*w1+gn35*w6+gn36*x23) p4ghic= 8.d0*(-s2*gn30*x16+s2*gn35-s6*gn30*x13) * if(otype.eq.'nc19'.or.otype.eq.'nc21') then * *-----helicity d) * *-----Bremsstrahlung I: common partx * b1drc= 2.d0*(gn3*(x13-x35)+gn6*x23*(-x14+x45)+gn10*(1.d0-x25)) b1dic= 8.d0*(s1+s11)*gn6 * *-----Bremsstrahlung II: common part * b2drc= gn1*p47-gn2*x26-gn3*(x23+x36)+gn4*(-u4+u7+u13-u16-u18- # u24+u25+p73)+gn5*(-u5+u7-u13+u16-u18+u24+w7)+gn6*p42+ # gn7*(w6+w4)-gn8*w5+gn9*w5-gn10*x26 b2dic= 4.d0*(s2*gn5*(x14+x46)-s2*gn7-s3*gn26*p21-s4*gn26*p20+ # s5*gn4*x35-s5*gn5*x35+s5*gn26*p18+s7*gn4*x26+s7*gn5*x26+ # s7*gn26*p17-s8*gn26*p15+s9*gn4*x24-s9*gn7-s11*gn26*p12- # s12*gn1+s12*gn6+s12*gn28*x14-s14*gn4*x13+s14*gn5*x13) * *-----Bremsstrahlung III: common part * b3drc= 2.d0*(gn1*p20-gn2*x16+gn4*x36*w2-gn5*x23*w2-gn6*p13+gn8* # w6-gn9*w4+gn10) b3dic= 8.d0*(-s1*gn5*x35+s1*gn6-s8*gn1+s8*gn4*x35-s11*gn5*x13- # s15*gn4*x13) * *-----Bremsstrahlung IV: common part * b4drc= 2.d0*(gn1*p47-gn2*x26-gn3*x23+2.d0*gn11) b4dic= 4.d0*(-s1*gn4*x56+s3*gn4*x45-s4*gn4*x36-s6*gn9+s7*gn4* # x26+s9*gn4*x24-s11*gn4*x16-2.d0*s12*gn1-s13*gn4*x14) * *-----Multiperipheral: common part * rmdrc= gn3*x36+gn5*(u5-u7+u13-u16+u18-u24-w7)-gn6*p42+gn7* # (-2.d0*w2-w4)+gn8*w5+gn10*x26+2.d0*gn11 rmdic= 4.d0*(-s2*gn5*x46+s5*gn5*x35-s7*gn5*x26-2.d0*s7*gn7+s9* # gn7-s12*gn6-s14*gn5*x13) * *-----Two options accordind to x45 * if(itr.eq.0) then * *-----Fusion: common part * fdrc= 0.25d0*(gn1*(-2.d0*p20+p47)+gn2*(2.d0*x16-x26)+gn3*(2.d0* # x13-x23-2.d0*x35+x36)+gn4*(u4-u7-2.d0*u8-u13+u16+u18+ # 2.d0*u19+u24-u25-p73)+gn5*(2.d0*u3+u5-u7-2.d0*u12+u13- # u16+u18-u24-w7)+gn6*(2.d0*p41-p42)+gn7*(-w6-w4)+gn8* # (-2.d0*w6+w5)+gn9*(2.d0*w4-w5)+gn10*(-2.d0*x25+x26)+ # 4.d0*gn11) fdic= -2.d0*s1*gn6+s3*gn4*x45+s4*gn5*w12-s4*gn10/ # x45-s5*gn4*x35-s6*gn9+s7*gn3/x45-s7*gn4*(x26+2.d0*x36)+ # s7*gn5*(w15+x23+w13)+s7*gn7*(x35/x45- # x56/x45)-s7*gn8*x25/x45+2.d0*s8*gn1-2.d0*s9*gn9+s11*gn4* # x16-s11*gn5*w12+2.d0*s11*gn6+s11*gn10/x45-2.d0* # s12*gn1-2.d0*s12*gn6+s14*gn5*w12-s14*gn10/x45+ # s15*gn4 fphr= 1.d0 fphi= 0.d0 else * fdic= s1*gnn2*x56*(x23-x26)+s1*gnn3*x56*(-w6-p15+w5+x45)+s1* # gnn5*x56-s2*gnn2*w3+s2*gnn3*(u5-u7-u13+u16-u18+u24-u26+ # p67+w7)+s2*gnn4*(p11+p34)-s2*gnn5*x36+s4*gnn2*(p40-w3-p60+ # x36)+s4*gnn3*(-p4*x36+u5-u7-u13-u18+u24-u26+w5*x36+p67+ # p69+p71)+s4*gnn4*(p11+p34) fdic= fdic+ # s5*gnn2*x35*(-x23+x26-2.d0)+s5*gnn3*x35*(w6+p15-w5-x45)- # s5*gnn5*x35+s6*gnn2*(-w3+x34)+s6*gnn3*(x13*w10+x14*(-p43+ # p52-p57)+x16*w11+p67+w7)+s6*gnn4*(p11+p34-4.d0*x35)-s6* # gnn5*x36-2.d0*s7*gnn2*x26+2.d0*s8*gnn2*x25+s9*gnn4*(x25* # (-x13-x14+x16)-3.d0*x35+x45-x56)+s9*gnn5*(2.d0+x23+x24- # x26)-4.d0*s10*gnn4*x35 fdic= fdic- # 4.d0*s12*gnn2*x56+s13*gnn2*(-p13+p17)+s13*gnn3*(u1-u10- # p18-p21+p22+x14s*x25)+s13*gnn5*(-4.d0-x14)+2.d0*s14*gnn2* # (x13+2.d0*x35-2.d0*x36)+s15*gnn2*(-2.d0-x23+x26)+s15* # gnn3*(w6+p15-w5-x45)-s15*gnn5 fdic= fdic/2.d0 * fdrc= gnn2*(x13*(2.d0*u28-x23*p61-u29-p49*x46+p62)+x14*(-u30- # x23*p57-x23*p63+x23s*x56-p49*x36+p59)+x15*(x23*p56+u39- # x23s*x46-x26s*x34)+x16*(-u31-u28-x23*p61+x23s*x45+2.d0* # u29)+x23*(-p67-p73-p76)+x25*(2.d0*p65-4.d0*p71+2.d0* # p74)+x26*(p64+2.d0*p67+4.d0*p70-p71-p73)) fdrc= fdrc+ # gnn3*(x13*(-p13*p55-u14*x35+2.d0*u14*x56+p16*x36-p29*p53- # p31*p61+p32*x34+p32*x46+2.d0*p41*x56-u33-u34-u35+u36- # p61*x56+p4*p61-p5*x46)+x14*(2.d0*p29*p51-p29*p55-p31* # p57+p32*x36-3.d0*u40+p44+p51*x36-u41+3.d0*u37-p58)+ # x16*(u42-p41*x56-3.d0*x25*p64+2.d0*u33+3.d0*x25*p71-u34- # 2.d0*u36+p29*p53-p32*x34)+3.d0*u38-p68-x35*p73-3.d0* # p71*x56+x35s*x46+p73*x56) fdrc= fdrc+ # gnn4*(x13*(-u27-w5*x56+p72+u6)+x16*(-4.d0*p51-p72- # x35s+u27)+4.d0*p72)+gnn5*(x13*(-p43-p52+2.d0*p57-p63+ # 4.d0*x56)+x15*(p40+p60-4.d0*x36)+x16*(-p39+2.d0*p43- # p52-p57+4.d0*x35)-4.d0*p43+4.d0*p52+4.d0*p67+p69+4.d0* # w7-4.d0*p72-x36*x56) fdrc= fdrc/8.d0 * afphr= 0.5d0*gnn6*(p67+w7) afphi= 2.d0*s15*gnn6 omfphr= 1.d0-afphr tfphr= 1.d0-afphr*afphr if(afphi.lt.zrm) then sfphi= -1.d0 else if(afphi.gt.zrm) then sfphi= +1.d0 else if(abs(afphi).lt.zrm) then sfphi= 0.d0 endif if(tfphr.gt.0.d0.and.omfphr.gt.1.d-6) then fphi= sfphi*sqrt(1.d0-afphr*afphr) fphr= afphr else if(tfphr.gt.0.d0.and.omfphr.lt.1.d-6) then fphi= sfphi*sqrt(2.d0*omfphr)*(1.d0-0.25d0* # omfphr*(1.d0+omfphr/8.d0)) fphr= afphr else fphi= 0.d0 fphr= 1.d0 endif endif * *-----helicity f) * *-----Bremsstrahlung I: common part. * b1frc= 2.d0*(-gn48*x45-gn49*p15+gn50*x15+gn52*(1.d0+x25)+ # gn54*x15) b1fic= 8.d0*s4*(gn48-gn49) * *-----Bremsstrahlung II: common part * b2frc= 2.d0*(gn40*w3+gn41*w1-gn48*x46+gn50*x16+gn52*x26) b2fic= 8.d0*(-s1*gn40*x26-s5*gn40*x23+s5*gn48) * *-----Bremsstrahlung III: common part * b3frc= gn44*(w1+2.d0*w3)+gn45*(-u5+u13-u18-x15*p42+u23+u26-w8)+ # gn46*w4-gn49*p15+gn52-2.d0*gn53+gn54*x15 b3fic= 4.d0*(-s3*gn44-s4*gn49-s7*gn45*x26+s10*gn45*x23+2.d0*s12* # gn44-s12*gn45*x15+s13*gn45*x14) * *-----Bremsstrahlung IV: common part * b4frc= 2.d0*(gn40*w3+gn41*(p7-p30)-gn45*x25*w3+gn46*w9+gn48*x34- # gn49*p50-gn50*x13+gn54*x35) b4fic= 8.d0*(-s1*gn40*x26+s1*gn48-s5*gn40*x23-s11*gn45*x26+s11* # gn49+s14*gn45*x23) * *-----Multiperipheral: common part * rmfrc= 0.d0 rmfic= 0.d0 * *-----Fusion: common part * ffrc= 0.25d0*(gn44*(-w1-2.d0*w3)+gn45*(u5-u13+u18+u21-u23-u26- # 2.d0*u28+2.d0*u29+w8)+gn46*(-w4+2.d0*w9)+2.d0*gn48*(x34- # x45+x46)+gn49*(-p15-2.d0*p50)+2.d0*gn50*(-x13+x15-x16)+ # gn52*(1.d0+2.d0*(x25-x26))+2.d0*gn53+gn54*(x15+2.d0*x35)) ffic= s1*gn40*x56+2.d0*s1*gn48-s3*gn40*x45+s3*gn44+2.d0*s4*gn48- # s4*gn49+s5*gn40*x35-2.d0*s5*gn48-s7*gn40*x26+s7*gn45*x26- # s9*gn41+s10*gn40*x23-s10*gn45*x23-2.d0*s11*gn45*x26+2.d0* # s11*gn49+s12*gn40*x15-2.d0*s12*gn44+s12*gn45*x15-s13*gn45* # x14+2.d0*s14*gn45*x23-s15*gn40 * else if(otype.eq.'nc24'.or.otype.eq.'nc25'.or.otype.eq.'nc50'. # or.otype.eq.'nc33'.or.otype.eq.'nc32'.or. # otype.eq.'nc48') then b1frc= 0.d0 b1fic= 0.d0 b2frc= 0.d0 b2fic= 0.d0 b3frc= 0.d0 b3fic= 0.d0 b4frc= 0.d0 b4fic= 0.d0 rmfrc= 0.d0 rmfic= 0.d0 ffrc= 0.d0 ffic= 0.d0 b1drc= 0.d0 b1dic= 0.d0 b2drc= 0.d0 b2dic= 0.d0 b3drc= 0.d0 b3dic= 0.d0 b4drc= 0.d0 b4dic= 0.d0 rmdrc= 0.d0 rmdic= 0.d0 fdrc= 0.d0 fdic= 0.d0 endif * if(otype.eq.'nc48'.or.otype.eq.'nc50') then * *-----helicity i-j) * *-----Bremsstrahlung I: common part * eb1ijic= -8.d0*(gn49*s4+gn70*s4) eb1ijrc= 2.d0*(-gn49*p15-gn50+gn52+gn54*(x15-x25)+gn70*p24) * *-----Bremsstrahlung II: common part * eb2ijic= 4.d0*(gn45*s1*x56+gn41*s3+gn49*s4+gn70*s4+gn45*s5*x35+ # gn43*s7*x26-gn46*s9-gn43*s10*x23-gn43*s12*x15+gn45* # s13*x14+gn46*s13+gn45*s15) eb2ijrc= gn41*w1+gn43*(u4-u5+u21-u23-u25+u26-w8)+gn44*w1+gn45* # (-u5-u13+u18+u21-u23+u26+w8)+gn46*(w4-w9)+gn49*p15+gn50- # gn52+gn54*(-x15+x25)-gn70*p24 * *-----Bremsstrahlung III: common part * eb3ijic= 4.d0*(gn45*s1*x56-gn49*s4+gn45*s5*x35-gn46*s9+gn45*s13* # x14+gn45*s15-2.d0*gn46*s15) eb3ijrc= gn44*w1+gn45*(-u5-u13+u18+u21-u23+u26+w8)+gn46*(w4- # 2.d0*w8)-gn49*p15+gn52-2.d0*gn53+gn54*x15 * *-----Bremsstrahlung IV: common part * eb4ijic= 4.d0*(gn43*s1*x56-gn70*s4+gn43*s5*x35-gn43*s9*x24+gn46* # s13-gn43*s15+2.d0*gn46*s15) eb4ijrc= gn41*w1+gn43*(u4-u5+u21-u23-u25+u26-w8)+gn46*(-w9+2.d0* # w8)-gn50+2.d0*gn53-gn54*x25+gn70*p24 * *-----Multiperipheral I: common part * em1ijic= 4.d0*(-gn45*s1*x56-gn49*s4-gn45*s5*x35+gn46*s9-gn45* # s13*x14-gn45*s15+2.d0*gn46*s15) em1ijrc= -gn44*w1+gn45*(u5+u13-u18-u21+x15*p56-u26-w8)+gn46*(- # w4+2.d0*w8)-gn49*p15+gn52-2.d0*gn53+gn54*x15 * *-----Multiperipheral II: common part * em2ijic= 8.d0*(-gn70*s7-gn70*s10) em2ijrc= 2.d0*(gn50*(-x13-x16)+gn54*(-x35-x56)+gn70*(p26+p28)) * *-----helicity c-d) * *-----Bremsstrahlung I: common part * eb1cdic= 8.d0*(s1*gn6+s11*gn6) eb1cdrc= 2.d0*(gn3*(-x13+x35)+gn6*(p13-p41)+gn10*(-1.d0+x25)) * *-----Bremsstrahlung II: common part * eb2cdic= 4.d0*(s2*gn5*(x14+x46)-s2*gn7-s3*gn26*p21-s4*gn26*p20+ # s5*gn4*x35-s5*gn5*x35+s5*gn26*p18+s7*gn4*x26+s7*gn5* # x26+s7*gn26*p17-s8*gn26*p15+s9*gn4*x24-s9*gn7-s11*gn26* # p12-s12*gn1+s12*gn6+s12*gn28*x14-s14*gn4*x13+s14*gn5* # x13) eb2cdrc= -gn1*p47+gn2*x26+gn3*(x23+x36)+gn4*(u4-u7-u13+u16+u18+ # u24-u25-p73)+gn5*(u5-u7+u13-u16+u18-u24-w7)-gn6*p42+ # gn7*(-w6-w4)+gn8*w5-gn9*w5+gn10*x26 * *-----Bremsstrahlung III: common part * eb3cdic= 8.d0*(-s1*gn5*x35+s1*gn6-s8*gn1+s8*gn4*x35-s11*gn5* # x13-s15*gn4*x13) eb3cdrc= 2.d0*(-gn1*p20+gn2*x16+gn4*(-u8+u19)+gn5*(u3-u12)+ # gn6*p13-gn8*w6+gn9*w4-gn10) * *-----Bremsstrahlung IV: common part * eb4cdic= 4.d0*(-s1*gn4*x56+s3*gn4*x45-s4*gn4*x36-s6*gn9+s7*gn4* # x26+s9*gn4*x24-s11*gn4*x16-2.d0*s12*gn1-s13*gn4*x14) eb4cdrc= 2.d0*(-gn1*p47+gn2*x26+gn3*x23-2.d0*gn11) * *-----Multiperipheral I: common part * em1cdic= 4.d0*(-s2*gn5*x46+s5*gn5*x35-s7*gn5*x26-2.d0*s7*gn7+ # s9*gn7-s12*gn6-s14*gn5*x13) em1cdrc= -gn3*x36+gn5*(-u5+u7-u13+u16-u18+u24+w7)+gn6*p42+ # gn7*(2.d0*w2+w4)-gn8*w5-gn10*x26-2.d0*gn11 * *-----Multiperipheral II: common part * em2cdic= 8.d0*(-s7*gn4*x36+s8*gn1-s9*gn9) em2cdrc= 2.d0*(gn1*p20-gn2*x16-gn3*x13+gn4*(u8-u19)-gn9*w4) * *-----helicity l-m) * *-----Two options accordind to x45 * if(itr.eq.0) then * *-----Bremsstrahlung I: common part * eb1lmic= 8.d0*(s1*gn6-s4*gn8*x25/x45-s7*gn3/x45-s7*gn5* # w15+s7*gn7*x25/x45-s11*gn3/x45) eb1lmrc= 2.d0*(gn3*(-p18/x45+x23-p46/x45)+gn5*(-u1+w2+x14s* # p51/x45)+gn6*p13+gn7*(-p4+u15/x45)+gn8*w14- # gn10*p15/x45+gn11*(x15/x45+x25/x45)) * *-----Bremsstrahlung II: common part * eb2lmic= 4.d0*(-2.d0*s1*gn26*p61+s3*gn4*x45+s3*gn26*p21-s4*gn4* # x36+2.d0*s5*gn25-s5*gn26*p18-s6*gn27*x14+s7*gn4*x26+ # 2.d0*s7*gn5-s7*gn26*p17+s10*gn4*x23+s11*gn26*(p12-2.d0* # p17)+s12*gn1-s13*gn4*x14+s15*gn26*x14) eb2lmrc= gn1*(p20+p47)+gn2*(-2.d0*x16-x26)-gn3*x23+gn4*(-u2-u4+ # u7+u11+u13-u16-u18-u24+u25+p73)+gn5*(u1-2.d0*p9+p18)- # gn6*p13+gn7*w6-gn9*w5+gn25*p17+gn26*(x13*p17*x45-u9* # x45+u20+x14s*w9-x14s*p52)+gn27*(u10+2.d0*u14-p22- # 2.d0*p61) * *-----Bremsstrahlung III: common part * eb3lmic= 4.d0*(-s2*gn5*x14-s2*gn8+2.d0*s4*gn5*p18/x45+s4*gn27* # x36-s5*gn26*p18+s6*gn27*x34-2.d0*s7*gn3/x45+2.d0*s7* # gn7*x35/x45-2.d0*s7*gn8*x25/x45-s7*gn26*p17+2.d0*s8* # gn1-2.d0*s8*gn4*x35+s8*gn27*x25-s9*gn4*x14+2.d0*s11* # gn6*x14/x45+s12*gn25-s12*gn28*x14+s14*gn26*p1+2.d0* # s15*gn4*x13-s15*gn27) eb3lmrc= gn1*p20+gn2*(-2.d0*x16+x36)-2.d0*gn3*p18/x45+gn4*(-u2+ # 2.d0*u8+u11-2.d0*u19)+gn5*(-u1-p18+2.d0*x14s*p51/x45)+ # gn6*p13+gn7*(-2.d0*p8+2.d0*p19/x45)+gn8*(p4-2.d0* # u15/x45+x35)-gn9*w4+gn10*(-2.d0*p15/x45-x23+2.d0*p50/ # x45)+gn11*(2.d0*x15/x45-2.d0*x35/x45)+gn25*(p17-p56)+ # gn26*(x13*p17*x45-u9*x45+u20+x14s*w9-x14s*p52)+gn27* # (-u7+u10-u13+u16+u18-p22+u24-u26+p67-p73) * *-----Bremsstrahlung IV: common part * eb4lmic= 4.d0*(s1*gn4*x56-s1*gn27*x56+s4*gn8*(-2.d0*x25/x45+ # 2.d0*x35/x45)-s4*gn27*x36+s5*gn27*(2.d0*x25-x35)-s6* # gn9-s7*gn4*x26+s7*gn7*(2.d0*x25/x45-2.d0*x35/x45)+ # s8*gn4*(-x25+2.d0*x35)-s9*gn9-s13*gn4*x14+s13*gn27* # x14-2.d0*s14*gn2/x45+s14*gn4*x13+2.d0*s14*gn25*x34/ # x45-2.d0*s14*gn27+2.d0*s15*gn1*x24/x45-2.d0*s15*gn2/ # x45-2.d0*s15*gn4*x13+s15*gn27) eb4lmrc= gn1*p47+gn2*(-x26-x36)+gn3*(x23-2.d0*p46/x45)+gn4* # (-u4+u7-2.d0*u8+u13-u16-u18+2.d0*u19-u24+u25+p73)+ # gn7*(-p4+2.d0*p8+2.d0*u15/x45-2.d0*p19/x45-x35)+ # gn8*(-p4+2.d0*u15/x45+2.d0*w14-x35)+gn9* # (w4-w5)+gn10*(x23-2.d0*p50/x45)+gn11*(2.d0*x25/x45+ # 2.d0*x35/x45)+gn25*p56+gn27*(u7+u13+2.d0*u14-u16- # u18-u24+u26-2.d0*p61-p67+p73) * *-----Multiperipheral I: common part * em1lmic= 8.d0*(-s4*gn8*(1.d0+1.d0/x45*x56)+s7*gn7*(1.d0+1.d0/ # x45*x56)-s14*gn10/x45+s15*gn3/x45) em1lmrc= 2.d0*(gn3*(-p71/x45+x36)+gn7*(-w2-p11+p18/x45*x56)+ # gn8*(-p15+x45+x56*w15)+gn10*w13) * *-----Multiperipheral II: common part * em2lmic= 4.d0*(s3*gn26*p21-s3*gn27*x45+s4*gn26*p20-s4*gn27*x36- # 2.d0*s5*gn26*p9+2.d0*s7*gn4*(-x16+x36)-s7*gn27*x26+ # s8*gn26*p15-s9*gn4*x14+s10*gn27*x23+s11*gn26*p12-s12* # gn25+s13*gn27*x14+s14*gn26*p1) em2lmrc= -gn1*p20+gn2*(2.d0*x16-x36)+gn4*(u2-2.d0*u8-u11+2.d0* # u19)+gn5*(-u1+2.d0*p9-p18)+gn6*p13-gn8*w6+gn9*w4-gn10* # x23+gn25*(-p17+p56)+gn26*(-x13*p17*x45+u9*x45-u20- # x14s*w9+x14s*p52)+gn27*(u7-u10+u13-u16-u18+p22-u24+ # u26-p67+p73) else * *-----Bremsstrahlung I: common partr * eb1lmic= 4.d0*(-s1*gnn3*p55-s2*gnn2*x46-s4*gnn3*p52+s5*x35* # (gnn2+gnn3*x25)-s7*gnn2*x26-s9*(gnn4*x25+gnn5)+s12* # gnn2*x15+s13*gnn3*p15+s14*(gnn2*x13-2.d0*gnn3*x35)+s15* # gnn3*x25) eb1lmrc= gnn2*(x13*w10+x14*(w22-p57)-x15*w3+x16*w11-x25*w3+ # w21-p73)+gnn3*(p4*w10+p15*(w23+p52)+p31*w11+x25* # (w8-p73)+2.d0*u36)+gnn4*(x25*w17-2.d0*p72)+gnn5* # (w24+w25) * *-----Bremsstrahlung II: common part * eb2lmic= 4.d0*(s1*gnn2*x25*(-4.d0*x16-2.d0*x26)+2.d0*s2*gnn3* # (u10+u14-x16*x45-p61)+2.d0*s2*gnn5*x16+s3*gnn2*x45+s3* # gnn3*p53+s4*gnn2*(-2.d0*p29-2.d0*p37+x36)+s4*gnn3*x25* # (-2.d0*p2-2.d0*p7+x36)+2.d0*s5*gnn2*p36-2.d0*s6*gnn5* # x23+s7*gnn3*p49+s8*gnn2*x25+2.d0*s9*gnn3*(-p15+x45)+s9* # gnn5-s10*gnn3*p36-s11*gnn2*x16+s12*gnn2*x25-s13*gnn3* # p15+s14*gnn2*x13) eb2lmrc= gnn2*(-x13*w10+x14*(-w9-p52)+x15*w3-x16*w11+x25*w3+ # p67-w7)+gnn3*(x13*(x25*(2.d0*p22-w10)-2.d0*p75)+p15* # (p43+p57-p52)-p31*w11+x25*(-w8+p73)-2.d0*u36)+gnn4* # x25*w4+gnn5*(-p11+p27-p34-2.d0*p43+p52) * *-----Bremsstrahlung III: common part) * eb3lmic= 8.d0*x56*(s1*gnn2*x23-s2*(gnn3*x14+gnn4*x13)+s4*gnn3* # p3-s7*gnn3) eb3lmrc= 2.d0*(gnn2*(-u13+p14*x56-u32+p67)+gnn3*(-x13*p13*p55+ # u1*x56+u3*x56-p9*x56)+gnn4*(-x13*p72+x13s*p55)-gnn5* # x13*p43) * *-----Bremsstrahlung IV: common part * eb4lmic= 4.d0*(-s1*gnn2*p43+s1*gnn3*(u6-p55)-s2*gnn2*p42+s2* # gnn3*(-2.d0*u16+p54+2.d0*p73)+2.d0*s2*gnn5*x36+s3* # gnn2*p41+s3*gnn3*(2.d0*u15-p70)-2.d0*s3*gnn5*x35+s4* # gnn3*(p4*x36-p52-2.d0*p57-p69)+s5*gnn3*(-p4*x35+2.d0* # p51)+s7*gnn3*(p49+p57)+s9*gnn4*(p4-2.d0*x25)-s10*gnn2* # x23s-s10*gnn3*p39-2.d0*s11*gnn2*x36+s12*gnn2*(-x25+ # x35)+s13*gnn3*(-u1+p15-p18)+2.d0*s13*gnn5+s14*gnn2*p3+ # s14*gnn3*(-p4+2.d0*p8-2.d0*x35)+s15*gnn2*x23+s15* # gnn3*(-p4+x25)) eb4lmrc= gnn2*(x13*(2.d0*u28+x26*w19)+p13*(w27-p43)-p23*w3+ # p29*w11+x23*(w28+2.d0*p71)+x34*(2.d0*p52-p57))+gnn3* # (u1*(w9+p52)-x13*p31*w11+p4*(w29+2.d0*p71)+u7*( # +w6)-p6*x46+p18*(2.d0*p29*x25+w26+p57)+p34*w19+ # x35*(-w29-p71))+gnn4*(x13*(x25*(-p34+2.d0*x56)-x56* # w6)+x35*(p34-2.d0*x56))+gnn5*(x13*(-w22+2.d0*p57)+ # x23*(w30-2.d0*x56)-p69) * *-----Multiperipheral I: common part * em1lmic= 4.d0*(s1*(gnn2*p63-gnn3*p55*w16)+s2*gnn5*x46+s4*(gnn2* # p60-gnn3*p52*w16)+s5*(-gnn2*p57+gnn3*p51*w16-gnn5* # x35)+s8*gnn5*x25+s9*(-gnn4*x25*w16+gnn5*x26)+s10*gnn5* # x23-s11*gnn5*x16+s13*(gnn2*(-p17+2.d0*x46)+gnn3*p15* # w16-gnn5*x14)-2.d0*s14*gnn3*x35*w16+s15*(gnn2*x26+ # gnn3*x25*w16)) em1lmrc= gnn2*(x13*(-p49*x46+p62)+x14*(x23*(-p54+p63)+x25* # (p56-p60)+p59)+p25*w3+x16*(-p36*x46-p37*x45+2.d0* # p49*x34)+x46*(-2.d0*p43+2.d0*p52)+x26*(w8-p73))+ # gnn3*(p1*x25*w32+p2*x25*w32+p12*x25*(w11-p43+w31)+ # p15*(w8-p73)+x14*(2.d0*p57*x45+x25*(-p13*x56-p17* # x35+p15*x36))+p31*(w8-p73)+x16*(2.d0*p57*x45+p30*p53- # p32*x34))+gnn4*(p4*(p22+p35)+p18*(p31-2.d0*x56)+p34* # (-2.d0*x56+p31))+gnn5*(x13*(-p48-w32-p63)+x14*(p43- # 2.d0*p52+p57)+x15*(w3+p47+p60)+x16*(-w11-p46+w27)+ # p67+w7) * *-----Multiperipheral II: common partn * em2lmic= 4.d0*(s1*gnn2*x56+2.d0*s2*(gnn3*x36*(-p15+x45)+gnn5* # x36)+s3*(gnn3*x35*(2.d0*p15-x45)-2.d0*gnn5*x35)+s4* # (-gnn2*x36+gnn3*(2.d0*p11-p69))+s5*gnn2*x35+s7*gnn3* # p57-s9*gnn5-s10*gnn3*p39-2.d0*s11*gnn2*x36+s12*gnn2* # x35+s13*(gnn2*x14-gnn3*p18)+s15*gnn2) em2lmrc= gnn2*(x13*w10+x14*(-2.d0*p36*x36+p43+p52-p57)+x15* # (-p42+p56)+x16*w11+p39*x46+x34*(2.d0*p52-p57-x56)+w7)+ # gnn3*(p1*x25*(-2.d0*p57-2.d0*x56+2.d0*p52)+p4*(w7-p73)+ # p9*(p57+2.d0*x56)+p18*(2.d0*p29*x25-p43-p52+p57)+p34* # (-p41-p50)+x35*(p67-w7))-gnn4*x35*w4+gnn5*(x13*(-2.d0* # p52+2.d0*p57+x56)+x15*(2.d0*p40-x36)+x16*(-2.d0*p39+ # x35)-p69) endif * *-----helicity e-f) * *-----Bremsstrahlung I: common part * eb1efic= 8.d0*s4*(gn48-gn49) eb1efrc= 2.d0*(gn48*x45+gn49*p15-gn50*x15-gn52*(1.d0+x25)- # gn54*x15) * *-----Bremsstrahlung II: common part * eb2efic= 8.d0*(-s1*gn40*x26-s5*gn40*x23+s5*gn48) eb2efrc= 2.d0*(-gn40*w3-gn41*w1+gn48*x46-gn50*x16-gn52*x26) * *-----Bremsstrahlung III: common part * eb3efic= 4.d0*(-s3*gn44-s4*gn49-s7*gn45*x26+s10*gn45*x23+ # 2.d0*s12*gn44-s12*gn45*x15+s13*gn45*x14) eb3efrc= gn44*(-w1-2.d0*w3)+gn45*(u5-u13+u18+u21-u23-u26+w8)- # gn46*w4+gn49*p15-gn52+2.d0*gn53-gn54*x15 * *-----Bremsstrahlung IV: common part * eb4efic= 8.d0*(-s1*gn40*x26+s1*gn48-s5*gn40*x23-s11*gn45* # x26+s11*gn49+s14*gn45*x23) eb4efrc= 2.d0*(-gn40*w3-gn41*w1+gn45*(u28-u29)-gn46*w9-gn48* # x34+gn49*p50+gn50*x13-gn54*x35) * *-----Multiperipheral I: common part * em1efic= 4.d0*(s3*gn44-s4*gn49+s7*gn45*x26-s10*gn45*x23- # 2.d0*s12*gn44+s12*gn45*x15-s13*gn45*x14) em1efrc= gn44*(w1+2.d0*w3)+gn45*(-u5+u13-u18-u21+u23+u26-w8)+ # gn46*w4+gn49*p15-gn52+2.d0*gn53-gn54*x15 * *-----Multiperipheral II: common part * em2efic= 8.d0*(s1*gn48-s5*gn48) em2efrc= 2.d0*(gn48*(-x34-x46)+gn50*(x13+x16)+gn52*(x23+x26)) * else eb1ijrc= 0.d0 eb1ijic= 0.d0 eb2ijrc= 0.d0 eb2ijic= 0.d0 eb3ijrc= 0.d0 eb3ijic= 0.d0 eb4ijrc= 0.d0 eb4ijic= 0.d0 em1ijrc= 0.d0 em1ijic= 0.d0 em2ijrc= 0.d0 em2ijic= 0.d0 eb1cdrc= 0.d0 eb1cdic= 0.d0 eb2cdrc= 0.d0 eb2cdic= 0.d0 eb3cdrc= 0.d0 eb3cdic= 0.d0 eb4cdrc= 0.d0 eb4cdic= 0.d0 em1cdrc= 0.d0 em1cdic= 0.d0 em2cdrc= 0.d0 em2cdic= 0.d0 eb1lmrc= 0.d0 eb1lmic= 0.d0 eb2lmrc= 0.d0 eb2lmic= 0.d0 eb3lmrc= 0.d0 eb3lmic= 0.d0 eb4lmrc= 0.d0 eb4lmic= 0.d0 em1lmrc= 0.d0 em1lmic= 0.d0 em2lmrc= 0.d0 em2lmic= 0.d0 eb1efrc= 0.d0 eb1efic= 0.d0 eb2efrc= 0.d0 eb2efic= 0.d0 eb3efrc= 0.d0 eb3efic= 0.d0 eb4efrc= 0.d0 eb4efic= 0.d0 em1efrc= 0.d0 em1efic= 0.d0 em2efrc= 0.d0 em2efic= 0.d0 endif * *-----complete diagrams, epsilon real and imag parts separated: * *-----compensating single Z propagators * zpcfr= sp-rzm2/vv zmcfr= sm-rzm2/vv zpcfi= sp*szg zmcfi= sm*szg * *-----Compensating double Z propagator * ztcfr= zpcfr*zmcfr-sp*sm*szgs ztcfi= zpcfr*zmcfi+zmcfr*zpcfi * *-----All Conversion I/II gamma-gamma * cc1gg= -conc(1)/smtp/pn*corrgm*corrgp cc2gg= conc(1)/smtp/pnp*corrgm*corrgp * cc1ggr= cc1gg*ztcfr cc1ggi= cc1gg*ztcfi cc2ggr= cc2gg*ztcfr cc2ggi= cc2gg*ztcfi * c1aggr= cc1ggr*c1abrc c1aggre= -cc1ggi*c1abic c1aggie= cc1ggr*c1abic c1aggi= cc1ggi*c1abrc * c1bggr= -c1aggr c1bggre= c1aggre c1bggie= c1aggie c1bggi= -c1aggi * c1cggr= cc1ggr*c1cdrc c1cggre= -cc1ggi*c1cdic c1cggie= cc1ggr*c1cdic c1cggi= cc1ggi*c1cdrc * c1dggr= -c1cggr c1dggre= c1cggre c1dggie= c1cggie c1dggi= -c1cggi * c1eggr= cc1ggr*c1efrc c1eggre= -cc1ggi*c1efic c1eggie= cc1ggr*c1efic c1eggi= cc1ggi*c1efrc * c1fggr= -c1eggr c1fggre= c1eggre c1fggie= c1eggie c1fggi= -c1eggi * c1gggr= cc1ggr*c1ghrc c1gggre= -cc1ggi*c1ghic c1gggie= cc1ggr*c1ghic c1gggi= cc1ggi*c1ghrc * c1hggr= -c1gggr c1hggre= c1gggre c1hggie= c1gggie c1hggi= -c1gggi * c2aggr= cc2ggr*c2abrc c2aggre= -cc2ggi*c2abic c2aggie= cc2ggr*c2abic c2aggi= cc2ggi*c2abrc * c2bggr= -c2aggr c2bggre= c2aggre c2bggie= c2aggie c2bggi= -c2aggi * c2cggr= cc2ggr*c2cdrc c2cggre= -cc2ggi*c2cdic c2cggie= cc2ggr*c2cdic c2cggi= cc2ggi*c2cdrc * c2dggr= -c2cggr c2dggre= c2cggre c2dggie= c2cggie c2dggi= -c2cggi * c2eggr= cc2ggr*c2efrc c2eggre= -cc2ggi*c2efic c2eggie= cc2ggr*c2efic c2eggi= cc2ggi*c2efrc * c2fggr= -c2eggr c2fggre= c2eggre c2fggie= c2eggie c2fggi= -c2eggi * c2gggr= cc2ggr*c2ghrc c2gggre= -cc2ggi*c2ghic c2gggie= cc2ggr*c2ghic c2gggi= cc2ggi*c2ghrc * c2hggr= -c2gggr c2hggre= c2gggre c2hggie= c2gggie c2hggi= -c2gggi * *-----All Conversion I gamma-Z * cc1gz= conc(3)/sp/pn*corrgp * do i=1,4 har(i)= hch(i)*cc1gz*zpcfr hai(i)= hch(i)*cc1gz*zpcfi enddo * c1agzr= har(1)*c1abrc c1agzre= -hai(1)*c1abic c1agzie= har(1)*c1abic c1agzi= hai(1)*c1abrc * c1bgzr= -har(2)*c1abrc c1bgzre= -hai(2)*c1abic c1bgzie= har(2)*c1abic c1bgzi= -hai(2)*c1abrc * c1cgzr= har(3)*c1cdrc c1cgzre= -hai(3)*c1cdic c1cgzie= har(3)*c1cdic c1cgzi= hai(3)*c1cdrc * c1dgzr= -har(4)*c1cdrc c1dgzre= -hai(4)*c1cdic c1dgzie= har(4)*c1cdic c1dgzi= -hai(4)*c1cdrc * c1egzr= har(1)*c1efrc c1egzre= -hai(1)*c1efic c1egzie= har(1)*c1efic c1egzi= hai(1)*c1efrc * c1fgzr= -har(2)*c1efrc c1fgzre= -hai(2)*c1efic c1fgzie= har(2)*c1efic c1fgzi= -hai(2)*c1efrc * c1ggzr= har(3)*c1ghrc c1ggzre= -hai(3)*c1ghic c1ggzie= har(3)*c1ghic c1ggzi= hai(3)*c1ghrc * c1hgzr= -har(4)*c1ghrc c1hgzre= -hai(4)*c1ghic c1hgzie= har(4)*c1ghic c1hgzi= -hai(4)*c1ghrc * *-----All Conversion II gamma-Z * cc2gz= -conc(2)/sm/pnp*corrgm * do i=1,4 ip4= i+4 hbpr(i)= hch(ip4)*cc2gz*zmcfr hbpi(i)= hch(ip4)*cc2gz*zmcfi enddo * c2agzr= hbpr(1)*c2abrc c2agzre= -hbpi(1)*c2abic c2agzie= hbpr(1)*c2abic c2agzi= hbpi(1)*c2abrc * c2bgzr= -hbpr(2)*c2abrc c2bgzre= -hbpi(2)*c2abic c2bgzie= hbpr(2)*c2abic c2bgzi= -hbpi(2)*c2abrc * c2cgzr= hbpr(3)*c2cdrc c2cgzre= -hbpi(3)*c2cdic c2cgzie= hbpr(3)*c2cdic c2cgzi= hbpi(3)*c2cdrc * c2dgzr= -hbpr(4)*c2cdrc c2dgzre= -hbpi(4)*c2cdic c2dgzie= hbpr(4)*c2cdic c2dgzi= -hbpi(4)*c2cdrc * c2egzr= hbpr(3)*c2efrc c2egzre= -hbpi(3)*c2efic c2egzie= hbpr(3)*c2efic c2egzi= hbpi(3)*c2efrc * c2fgzr= -hbpr(4)*c2efrc c2fgzre= -hbpi(4)*c2efic c2fgzie= hbpr(4)*c2efic c2fgzi= -hbpi(4)*c2efrc * c2ggzr= hbpr(1)*c2ghrc c2ggzre= -hbpi(1)*c2ghic c2ggzie= hbpr(1)*c2ghic c2ggzi= hbpi(1)*c2ghrc * c2hgzr= -hbpr(2)*c2ghrc c2hgzre= -hbpi(2)*c2ghic c2hgzie= hbpr(2)*c2ghic c2hgzi= -hbpi(2)*c2ghrc * *-----All Conversion I Z-gamma * cc1zg= conc(2)/sm/pn*corrgm * do i=1,4 ip4= i+4 hapr(i)= hch(ip4)*cc1zg*zmcfr hapi(i)= hch(ip4)*cc1zg*zmcfi enddo * c1azgr= hapr(1)*c1abrc c1azgre= -hapi(1)*c1abic c1azgie= hapr(1)*c1abic c1azgi= hapi(1)*c1abrc * c1bzgr= -hapr(2)*c1abrc c1bzgre= -hapi(2)*c1abic c1bzgie= hapr(2)*c1abic c1bzgi= -hapi(2)*c1abrc * c1czgr= hapr(3)*c1cdrc c1czgre= -hapi(3)*c1cdic c1czgie= hapr(3)*c1cdic c1czgi= hapi(3)*c1cdrc * c1dzgr= -hapr(4)*c1cdrc c1dzgre= -hapi(4)*c1cdic c1dzgie= hapr(4)*c1cdic c1dzgi= -hapi(4)*c1cdrc * c1ezgr= hapr(3)*c1efrc c1ezgre= -hapi(3)*c1efic c1ezgie= hapr(3)*c1efic c1ezgi= hapi(3)*c1efrc * c1fzgr= -hapr(4)*c1efrc c1fzgre= -hapi(4)*c1efic c1fzgie= hapr(4)*c1efic c1fzgi= -hapi(4)*c1efrc * c1gzgr= hapr(1)*c1ghrc c1gzgre= -hapi(1)*c1ghic c1gzgie= hapr(1)*c1ghic c1gzgi= hapi(1)*c1ghrc * c1hzgr= -hapr(2)*c1ghrc c1hzgre= -hapi(2)*c1ghic c1hzgie= hapr(2)*c1ghic c1hzgi= -hapi(2)*c1ghrc * *-----All Conversion II Z-gamma * cc2zg= -conc(3)/sp/pnp*corrgp * do i=1,4 hbr(i)= hch(i)*cc2zg*zpcfr hbi(i)= hch(i)*cc2zg*zpcfi enddo * c2azgr= hbr(1)*c2abrc c2azgre= -hbi(1)*c2abic c2azgie= hbr(1)*c2abic c2azgi= hbi(1)*c2abrc * c2bzgr= -hbr(2)*c2abrc c2bzgre= -hbi(2)*c2abic c2bzgie= hbr(2)*c2abic c2bzgi= -hbi(2)*c2abrc * c2czgr= hbr(3)*c2cdrc c2czgre= -hbi(3)*c2cdic c2czgie= hbr(3)*c2cdic c2czgi= hbi(3)*c2cdrc * c2dzgr= -hbr(4)*c2cdrc c2dzgre= -hbi(4)*c2cdic c2dzgie= hbr(4)*c2cdic c2dzgi= -hbi(4)*c2cdrc * c2ezgr= hbr(1)*c2efrc c2ezgre= -hbi(1)*c2efic c2ezgie= hbr(1)*c2efic c2ezgi= hbi(1)*c2efrc * c2fzgr= -hbr(2)*c2efrc c2fzgre= -hbi(2)*c2efic c2fzgie= hbr(2)*c2efic c2fzgi= -hbi(2)*c2efrc * c2gzgr= hbr(3)*c2ghrc c2gzgre= -hbi(3)*c2ghic c2gzgie= hbr(3)*c2ghic c2gzgi= hbi(3)*c2ghrc * c2hzgr= -hbr(4)*c2ghrc c2hzgre= -hbi(4)*c2ghic c2hzgie= hbr(4)*c2ghic c2hzgi= -hbi(4)*c2ghrc c2hzgi= -hbi(4)*c2ghrc * *-----All Conversion I/II Z-Z * do i=1,8 ip8= i+8 hc(i)= -hch(ip8)*conc(5)/pn hcp(i)= hch(ip8)*conc(5)/pnp enddo * c1azzr= hc(1)*c1abrc c1azzie= hc(1)*c1abic * c1bzzr= -hc(2)*c1abrc c1bzzie= hc(2)*c1abic * c1czzr= hc(7)*c1cdrc c1czzie= hc(7)*c1cdic * c1dzzr= -hc(8)*c1cdrc c1dzzie= hc(8)*c1cdic * c1ezzr= hc(3)*c1efrc c1ezzie= hc(3)*c1efic * c1fzzr= -hc(4)*c1efrc c1fzzie= hc(4)*c1efic * c1gzzr= hc(5)*c1ghrc c1gzzie= hc(5)*c1ghic * c1hzzr= -hc(6)*c1ghrc c1hzzie= hc(6)*c1ghic * c2azzr= hcp(1)*c2abrc c2azzie= hcp(1)*c2abic * c2bzzr= -hcp(2)*c2abrc c2bzzie= hcp(2)*c2abic * c2czzr= hcp(7)*c2cdrc c2czzie= hcp(7)*c2cdic * c2dzzr= -hcp(8)*c2cdrc c2dzzie= hcp(8)*c2cdic * c2ezzr= hcp(3)*c2efrc c2ezzie= hcp(3)*c2efic * c2fzzr= -hcp(4)*c2efrc c2fzzie= hcp(4)*c2efic * c2gzzr= hcp(5)*c2ghrc c2gzzie= hcp(5)*c2ghic * c2hzzr= -hcp(6)*c2ghrc c2hzzie= hcp(6)*c2ghic * *-----All PP1-PP2 gamma-gamma * cp12gg= conc(6)/sm*corrgs*corrgm cp1ggr= -cp12gg/pfpb*ztcfr cp1ggi= -cp12gg/pfpb*ztcfi cp2ggr= cp12gg/pfp*ztcfr cp2ggi= cp12gg/pfp*ztcfi * p1aggr= cp1ggr*p1abrc p1aggre= -cp1ggi*p1abic p1aggie= cp1ggr*p1abic p1aggi= cp1ggi*p1abrc * p1bggr= -p1aggr p1bggre= p1aggre p1bggie= p1aggie p1bggi= -p1aggi * p1cggr= cp1ggr*p1cdrc p1cggre= -cp1ggi*p1cdic p1cggie= cp1ggr*p1cdic p1cggi= cp1ggi*p1cdrc * p1dggr= -p1cggr p1dggre= p1cggre p1dggie= p1cggie p1dggi= -p1cggi * p1eggr= cp1ggr*p1efrc p1eggre= -cp1ggi*p1efic p1eggie= cp1ggr*p1efic p1eggi= cp1ggi*p1efrc * p1fggr= -p1eggr p1fggre= p1eggre p1fggie= p1eggie p1fggi= -p1eggi * p1gggr= cp1ggr*p1ghrc p1gggre= -cp1ggi*p1ghic p1gggie= cp1ggr*p1ghic p1gggi= cp1ggi*p1ghrc * p1hggr= -p1gggr p1hggre= p1gggre p1hggie= p1gggie p1hggi= -p1gggi * p2aggr= cp2ggr*p2abrc p2aggre= -cp2ggi*p2abic p2aggie= cp2ggr*p2abic p2aggi= -cp2ggi*p2abrc * p2bggr= -p2aggr p2bggre= p2aggre p2bggie= p2aggie p2bggi= -p2aggi * p2cggr= cp2ggr*p2cdrc p2cggre= -cp2ggi*p2cdic p2cggie= cp2ggr*p2cdic p2cggi= cp2ggi*p2cdrc * p2dggr= -p2cggr p2dggre= p2cggre p2dggie= p2cggie p2dggi= -p2cggi * p2eggr= cp2ggr*p2efrc p2eggre= -cp2ggi*p2efic p2eggie= cp2ggr*p2efic p2eggi= cp2ggi*p2efrc * p2fggr= -p2eggr p2fggre= p2eggre p2fggie= p2eggie p2fggi= -p2eggi * p2gggr= cp2ggr*p2ghrc p2gggre= -cp2ggi*p2ghic p2gggie= cp2ggr*p2ghic p2gggi= cp2ggi*p2ghrc * p2hggr= -p2gggr p2hggre= p2gggre p2hggie= p2gggie p2hggi= -p2gggi * *-----All PP1 gamma-Z * cp1gz= -conc(3)/pfpb*corrgs * do i=1,4 ip16= i+16 hdr(i)= hch(ip16)*cp1gz*zpcfr hdi(i)= hch(ip16)*cp1gz*zpcfi enddo * p1agzr= hdr(3)*p1abrc p1agzre= -hdi(3)*p1abic p1agzie= hdr(3)*p1abic p1agzi= hdi(3)*p1abrc * p1bgzr= -hdr(4)*p1abrc p1bgzre= -hdi(4)*p1abic p1bgzie= hdr(4)*p1abic p1bgzi= -hdi(4)*p1abrc * p1cgzr= hdr(4)*p1cdrc p1cgzre= -hdi(4)*p1cdic p1cgzie= hdr(4)*p1cdic p1cgzi= hdi(4)*p1cdrc * p1dgzr= -hdr(3)*p1cdrc p1dgzre= -hdi(3)*p1cdic p1dgzie= hdr(3)*p1cdic p1dgzi= -hdi(3)*p1cdrc * p1egzr= hdr(2)*p1efrc p1egzre= -hdi(2)*p1efic p1egzie= hdr(2)*p1efic p1egzi= hdi(2)*p1efrc * p1fgzr= -hdr(1)*p1efrc p1fgzre= -hdi(1)*p1efic p1fgzie= hdr(1)*p1efic p1fgzi= -hdi(1)*p1efrc * p1ggzr= hdr(1)*p1ghrc p1ggzre= -hdi(1)*p1ghic p1ggzie= hdr(1)*p1ghic p1ggzi= hdi(1)*p1ghrc * p1hgzr= -hdr(2)*p1ghrc p1hgzre= -hdi(2)*p1ghic p1hgzie= hdr(2)*p1ghic p1hgzi= -hdi(2)*p1ghrc * * *-----All PP2 gamma-Z * cp2gz= conc(3)/pfp*corrgs * do i=1,4 ip16= i+16 her(i)= hch(ip16)*cp2gz*zpcfr hei(i)= hch(ip16)*cp2gz*zpcfi enddo * p2agzr= her(3)*p2abrc p2agzre= -hei(3)*p2abic p2agzie= her(3)*p2abic p2agzi= hei(3)*p2abrc * p2bgzr= -her(4)*p2abrc p2bgzre= -hei(4)*p2abic p2bgzie= her(4)*p2abic p2bgzi= -hei(4)*p2abrc * p2cgzr= her(4)*p2cdrc p2cgzre= -hei(4)*p2cdic p2cgzie= her(4)*p2cdic p2cgzi= hei(4)*p2cdrc * p2dgzr= -her(3)*p2cdrc p2dgzre= -hei(3)*p2cdic p2dgzie= her(3)*p2cdic p2dgzi= -hei(3)*p2cdrc * p2egzr= her(2)*p2efrc p2egzre= -hei(2)*p2efic p2egzie= her(2)*p2efic p2egzi= hei(2)*p2efrc * p2fgzr= -her(1)*p2efrc p2fgzre= -hei(1)*p2efic p2fgzie= her(1)*p2efic p2fgzi= -hei(1)*p2efrc * p2ggzr= her(1)*p2ghrc p2ggzre= -hei(1)*p2ghic p2ggzie= her(1)*p2ghic p2ggzi= hei(1)*p2ghrc * p2hgzr= -her(2)*p2ghrc p2hgzre= -hei(2)*p2ghic p2hgzie= her(2)*p2ghic p2hgzi= -hei(2)*p2ghrc * * *-----All PP1 Z-gamma * cp1zg= conc(4)/sm/pfpb*corrgm * do i=1,4 ip4= i+4 hfr(i)= hch(ip4)*cp1zg*ztcfr hfi(i)= hch(ip4)*cp1zg*ztcfi enddo * ap1azgr= hfr(1)*p1abrc ap1azgre= -hfi(1)*p1abic ap1azgie= hfr(1)*p1abic ap1azgi= hfi(1)*p1abrc p1azgr= ap1azgr*rsz-ap1azgi*aisz p1azgre= ap1azgre*rsz-ap1azgie*aisz p1azgie= ap1azgie*rsz+ap1azgre*aisz p1azgi= ap1azgi*rsz+ap1azgr*aisz * ap1bzgr= -hfr(2)*p1abrc ap1bzgre= -hfi(2)*p1abic ap1bzgie= hfr(2)*p1abic ap1bzgi= -hfi(2)*p1abrc p1bzgr= ap1bzgr*rsz-ap1bzgi*aisz p1bzgre= ap1bzgre*rsz-ap1bzgie*aisz p1bzgie= ap1bzgie*rsz+ap1bzgre*aisz p1bzgi= ap1bzgi*rsz+ap1bzgr*aisz * ap1czgr= hfr(3)*p1cdrc ap1czgre= -hfi(3)*p1cdic ap1czgie= hfr(3)*p1cdic ap1czgi= hfi(3)*p1cdrc p1czgr= ap1czgr*rsz-ap1czgi*aisz p1czgre= ap1czgre*rsz-ap1czgie*aisz p1czgie= ap1czgie*rsz+ap1czgre*aisz p1czgi= ap1czgi*rsz+ap1czgr*aisz * ap1dzgr= -hfr(4)*p1cdrc ap1dzgre= -hfi(4)*p1cdic ap1dzgie= hfr(4)*p1cdic ap1dzgi= -hfi(4)*p1cdrc p1dzgr= ap1dzgr*rsz-ap1dzgi*aisz p1dzgre= ap1dzgre*rsz-ap1dzgie*aisz p1dzgie= ap1dzgie*rsz+ap1dzgre*aisz p1dzgi= ap1dzgi*rsz+ap1dzgr*aisz * ap1ezgr= hfr(3)*p1efrc ap1ezgre= -hfi(3)*p1efic ap1ezgie= hfr(3)*p1efic ap1ezgi= hfi(3)*p1efrc p1ezgr= ap1ezgr*rsz-ap1ezgi*aisz p1ezgre= ap1ezgre*rsz-ap1ezgie*aisz p1ezgie= ap1ezgie*rsz+ap1ezgre*aisz p1ezgi= ap1ezgi*rsz+ap1ezgr*aisz * ap1fzgr= -hfr(4)*p1efrc ap1fzgre= -hfi(4)*p1efic ap1fzgie= hfr(4)*p1efic ap1fzgi= -hfi(4)*p1efrc p1fzgr= ap1fzgr*rsz-ap1fzgi*aisz p1fzgre= ap1fzgre*rsz-ap1fzgie*aisz p1fzgie= ap1fzgie*rsz+ap1fzgre*aisz p1fzgi= ap1fzgi*rsz+ap1fzgr*aisz * ap1gzgr= hfr(1)*p1ghrc ap1gzgre= -hfi(1)*p1ghic ap1gzgie= hfr(1)*p1ghic ap1gzgi= hfi(1)*p1ghrc p1gzgr= ap1gzgr*rsz-ap1gzgi*aisz p1gzgre= ap1gzgre*rsz-ap1gzgie*aisz p1gzgie= ap1gzgie*rsz+ap1gzgre*aisz p1gzgi= ap1gzgi*rsz+ap1gzgr*aisz * ap1hzgr= -hfr(2)*p1ghrc ap1hzgre= -hfi(2)*p1ghic ap1hzgie= hfr(2)*p1ghic ap1hzgi= -hfi(2)*p1ghrc p1hzgr= ap1hzgr*rsz-ap1hzgi*aisz p1hzgre= ap1hzgre*rsz-ap1hzgie*aisz p1hzgie= ap1hzgie*rsz+ap1hzgre*aisz p1hzgi= ap1hzgi*rsz+ap1hzgr*aisz * * *-----All PP2 Z-gamma * cp2zg= -conc(4)/sm/pfp*corrgm * do i=1,4 ip4= i+4 hgr(i)= hch(ip4)*cp2zg*ztcfr hgi(i)= hch(ip4)*cp2zg*ztcfi enddo * ap2azgr= hgr(1)*p2abrc ap2azgre= -hgi(1)*p2abic ap2azgie= hgr(1)*p2abic ap2azgi= hgi(1)*p2abrc p2azgr= ap2azgr*rsz-ap2azgi*aisz p2azgre= ap2azgre*rsz-ap2azgie*aisz p2azgie= ap2azgie*rsz+ap2azgre*aisz p2azgi= ap2azgi*rsz+ap2azgr*aisz * ap2bzgr= -hgr(2)*p2abrc ap2bzgre= -hgi(2)*p2abic ap2bzgie= hgr(2)*p2abic ap2bzgi= -hgi(2)*p2abrc p2bzgr= ap2bzgr*rsz-ap2bzgi*aisz p2bzgre= ap2bzgre*rsz-ap2bzgie*aisz p2bzgie= ap2bzgie*rsz+ap2bzgre*aisz p2bzgi= ap2bzgi*rsz+ap2bzgr*aisz * ap2czgr= hgr(3)*p2cdrc ap2czgre= -hgi(3)*p2cdic ap2czgie= hgr(3)*p2cdic ap2czgi= hgi(3)*p2cdrc p2czgr= ap2czgr*rsz-ap2czgi*aisz p2czgre= ap2czgre*rsz-ap2czgie*aisz p2czgie= ap2czgie*rsz+ap2czgre*aisz p2czgi= ap2czgi*rsz+ap2czgr*aisz * ap2dzgr= -hgr(4)*p2cdrc ap2dzgre= -hgi(4)*p2cdic ap2dzgie= hgr(4)*p2cdic ap2dzgi= -hgi(4)*p2cdrc p2dzgr= ap2dzgr*rsz-ap2dzgi*aisz p2dzgre= ap2dzgre*rsz-ap2dzgie*aisz p2dzgie= ap2dzgie*rsz+ap2dzgre*aisz p2dzgi= ap2dzgi*rsz+ap2dzgr*aisz * ap2ezgr= hgr(3)*p2efrc ap2ezgre= -hgi(3)*p2efic ap2ezgie= hgr(3)*p2efic ap2ezgi= hgi(3)*p2efrc p2ezgr= ap2ezgr*rsz-ap2ezgi*aisz p2ezgre= ap2ezgre*rsz-ap2ezgie*aisz p2ezgie= ap2ezgie*rsz+ap2ezgre*aisz p2ezgi= ap2ezgi*rsz+ap2ezgr*aisz * ap2fzgr= -hgr(4)*p2efrc ap2fzgre= -hgi(4)*p2efic ap2fzgie= hgr(4)*p2efic ap2fzgi= -hgi(4)*p2efrc p2fzgr= ap2fzgr*rsz-ap2fzgi*aisz p2fzgre= ap2fzgre*rsz-ap2fzgie*aisz p2fzgie= ap2fzgie*rsz+ap2fzgre*aisz p2fzgi= ap2fzgi*rsz+ap2fzgr*aisz * ap2gzgr= hgr(1)*p2ghrc ap2gzgre= -hgi(1)*p2ghic ap2gzgie= hgr(1)*p2ghic ap2gzgi= hgi(1)*p2ghrc p2gzgr= ap2gzgr*rsz-ap2gzgi*aisz p2gzgre= ap2gzgre*rsz-ap2gzgie*aisz p2gzgie= ap2gzgie*rsz+ap2gzgre*aisz p2gzgi= ap2gzgi*rsz+ap2gzgr*aisz * ap2hzgr= -hgr(2)*p2ghrc ap2hzgre= -hgi(2)*p2ghic ap2hzgie= hgr(2)*p2ghic ap2hzgi= -hgi(2)*p2ghrc p2hzgr= ap2hzgr*rsz-ap2hzgi*aisz p2hzgre= ap2hzgre*rsz-ap2hzgie*aisz p2hzgie= ap2hzgie*rsz+ap2hzgre*aisz p2hzgi= ap2hzgi*rsz+ap2hzgr*aisz * * *-----All PP1 Z-Z * cp1zz= conc(5)/pfpb * do i=1,8 ip20= i+20 hhr(i)= hch(ip20)*cp1zz*zpcfr hhi(i)= hch(ip20)*cp1zz*zpcfi enddo * ap1azzr= hhr(3)*p1abrc ap1azzre= -hhi(3)*p1abic ap1azzie= hhr(3)*p1abic ap1azzi= hhi(3)*p1abrc p1azzr= ap1azzr*rsz-ap1azzi*aisz p1azzre= ap1azzre*rsz-ap1azzie*aisz p1azzie= ap1azzie*rsz+ap1azzre*aisz p1azzi= ap1azzi*rsz+ap1azzr*aisz * ap1bzzr= -hhr(4)*p1abrc ap1bzzre= -hhi(4)*p1abic ap1bzzie= hhr(4)*p1abic ap1bzzi= -hhi(4)*p1abrc p1bzzr= ap1bzzr*rsz-ap1bzzi*aisz p1bzzre= ap1bzzre*rsz-ap1bzzie*aisz p1bzzie= ap1bzzie*rsz+ap1bzzre*aisz p1bzzi= ap1bzzi*rsz+ap1bzzr*aisz * ap1czzr= hhr(5)*p1cdrc ap1czzre= -hhi(5)*p1cdic ap1czzie= hhr(5)*p1cdic ap1czzi= hhi(5)*p1cdrc p1czzr= ap1czzr*rsz-ap1czzi*aisz p1czzre= ap1czzre*rsz-ap1czzie*aisz p1czzie= ap1czzie*rsz+ap1czzre*aisz p1czzi= ap1czzi*rsz+ap1czzr*aisz * ap1dzzr= -hhr(6)*p1cdrc ap1dzzre= -hhi(6)*p1cdic ap1dzzie= hhr(6)*p1cdic ap1dzzi= -hhi(6)*p1cdrc p1dzzr= ap1dzzr*rsz-ap1dzzi*aisz p1dzzre= ap1dzzre*rsz-ap1dzzie*aisz p1dzzie= ap1dzzie*rsz+ap1dzzre*aisz p1dzzi= ap1dzzi*rsz+ap1dzzr*aisz * ap1ezzr= hhr(8)*p1efrc ap1ezzre= -hhi(8)*p1efic ap1ezzie= hhr(8)*p1efic ap1ezzi= hhi(8)*p1efrc p1ezzr= ap1ezzr*rsz-ap1ezzi*aisz p1ezzre= ap1ezzre*rsz-ap1ezzie*aisz p1ezzie= ap1ezzie*rsz+ap1ezzre*aisz p1ezzi= ap1ezzi*rsz+ap1ezzr*aisz * ap1fzzr= -hhr(7)*p1efrc ap1fzzre= -hhi(7)*p1efic ap1fzzie= hhr(7)*p1efic ap1fzzi= -hhi(7)*p1efrc p1fzzr= ap1fzzr*rsz-ap1fzzi*aisz p1fzzre= ap1fzzre*rsz-ap1fzzie*aisz p1fzzie= ap1fzzie*rsz+ap1fzzre*aisz p1fzzi= ap1fzzi*rsz+ap1fzzr*aisz * ap1gzzr= hhr(1)*p1ghrc ap1gzzre= -hhi(1)*p1ghic ap1gzzie= hhr(1)*p1ghic ap1gzzi= hhi(1)*p1ghrc p1gzzr= ap1gzzr*rsz-ap1gzzi*aisz p1gzzre= ap1gzzre*rsz-ap1gzzie*aisz p1gzzie= ap1gzzie*rsz+ap1gzzre*aisz p1gzzi= ap1gzzi*rsz+ap1gzzr*aisz * ap1hzzr= -hhr(2)*p1ghrc ap1hzzre= -hhi(2)*p1ghic ap1hzzie= hhr(2)*p1ghic ap1hzzi= -hhi(2)*p1ghrc p1hzzr= ap1hzzr*rsz-ap1hzzi*aisz p1hzzre= ap1hzzre*rsz-ap1hzzie*aisz p1hzzie= ap1hzzie*rsz+ap1hzzre*aisz p1hzzi= ap1hzzi*rsz+ap1hzzr*aisz * * *-----All PP2 Z-Z * cp2zz= -conc(5)/pfp * do i=1,8 ip20= i+20 hir(i)= hch(ip20)*cp2zz*zpcfr hii(i)= hch(ip20)*cp2zz*zpcfi enddo * ap2azzr= hir(3)*p2abrc ap2azzre= -hii(3)*p2abic ap2azzie= hir(3)*p2abic ap2azzi= hii(3)*p2abrc p2azzr= ap2azzr*rsz-ap2azzi*aisz p2azzre= ap2azzre*rsz-ap2azzie*aisz p2azzie= ap2azzie*rsz+ap2azzre*aisz p2azzi= ap2azzi*rsz+ap2azzr*aisz * ap2bzzr= -hir(4)*p2abrc ap2bzzre= -hii(4)*p2abic ap2bzzie= hir(4)*p2abic ap2bzzi= -hii(4)*p2abrc p2bzzr= ap2bzzr*rsz-ap2bzzi*aisz p2bzzre= ap2bzzre*rsz-ap2bzzie*aisz p2bzzie= ap2bzzie*rsz+ap2bzzre*aisz p2bzzi= ap2bzzi*rsz+ap2bzzr*aisz * ap2czzr= hir(5)*p2cdrc ap2czzre= -hii(5)*p2cdic ap2czzie= hir(5)*p2cdic ap2czzi= hii(5)*p2cdrc p2czzr= ap2czzr*rsz-ap2czzi*aisz p2czzre= ap2czzre*rsz-ap2czzie*aisz p2czzie= ap2czzie*rsz+ap2czzre*aisz p2czzi= ap2czzi*rsz+ap2czzr*aisz * ap2dzzr= -hir(6)*p2cdrc ap2dzzre= -hii(6)*p2cdic ap2dzzie= hir(6)*p2cdic ap2dzzi= -hii(6)*p2cdrc p2dzzr= ap2dzzr*rsz-ap2dzzi*aisz p2dzzre= ap2dzzre*rsz-ap2dzzie*aisz p2dzzie= ap2dzzie*rsz+ap2dzzre*aisz p2dzzi= ap2dzzi*rsz+ap2dzzr*aisz * ap2ezzr= hir(8)*p2efrc ap2ezzre= -hii(8)*p2efic ap2ezzie= hir(8)*p2efic ap2ezzi= hii(8)*p2efrc p2ezzr= ap2ezzr*rsz-ap2ezzi*aisz p2ezzre= ap2ezzre*rsz-ap2ezzie*aisz p2ezzie= ap2ezzie*rsz+ap2ezzre*aisz p2ezzi= ap2ezzi*rsz+ap2ezzr*aisz * ap2fzzr= -hir(7)*p2efrc ap2fzzre= -hii(7)*p2efic ap2fzzie= hir(7)*p2efic ap2fzzi= -hii(7)*p2efrc p2fzzr= ap2fzzr*rsz-ap2fzzi*aisz p2fzzre= ap2fzzre*rsz-ap2fzzie*aisz p2fzzie= ap2fzzie*rsz+ap2fzzre*aisz p2fzzi= ap2fzzi*rsz+ap2fzzr*aisz * ap2gzzr= hir(1)*p2ghrc ap2gzzre= -hii(1)*p2ghic ap2gzzie= hir(1)*p2ghic ap2gzzi= hii(1)*p2ghrc p2gzzr= ap2gzzr*rsz-ap2gzzi*aisz p2gzzre= ap2gzzre*rsz-ap2gzzie*aisz p2gzzie= ap2gzzie*rsz+ap2gzzre*aisz p2gzzi= ap2gzzi*rsz+ap2gzzr*aisz * ap2hzzr= -hir(2)*p2ghrc ap2hzzre= -hii(2)*p2ghic ap2hzzie= hir(2)*p2ghic ap2hzzi= -hii(2)*p2ghrc p2hzzr= ap2hzzr*rsz-ap2hzzi*aisz p2hzzre= ap2hzzre*rsz-ap2hzzie*aisz p2hzzie= ap2hzzie*rsz+ap2hzzre*aisz p2hzzi= ap2hzzi*rsz+ap2hzzr*aisz * *-----All PP3-PP4 gamma-gamma * cp34gg= conc(7)/sp*corrgs*corrgp cp3ggr= cp34gg/pf*ztcfr cp3ggi= cp34gg/pf*ztcfi cp4ggr= -cp34gg/pfb*ztcfr cp4ggi= -cp34gg/pfb*ztcfi * p3aggr= cp3ggr*p3abrc p3aggre= -cp3ggi*p3abic p3aggie= cp3ggr*p3abic p3aggi= cp3ggi*p3abrc * p3bggr= -p3aggr p3bggre= p3aggre p3bggie= p3aggie p3bggi= -p3aggi * p3cggr= cp3ggr*p3cdrc p3cggre= -cp3ggi*p3cdic p3cggie= cp3ggr*p3cdic p3cggi= cp3ggi*p3cdrc * p3dggr= -p3cggr p3dggre= p3cggre p3dggie= p3cggie p3dggi= -p3cggi * p3eggr= cp3ggr*p3efrc p3eggre= -cp3ggi*p3efic p3eggie= cp3ggr*p3efic p3eggi= cp3ggi*p3efrc * p3fggr= -p3eggr p3fggre= p3eggre p3fggie= p3eggie p3fggi= -p3eggi * p3gggr= cp3ggr*p3ghrc p3gggre= -cp3ggi*p3ghic p3gggie= cp3ggr*p3ghic p3gggi= cp3ggi*p3ghrc * p3hggr= -p3gggr p3hggre= p3gggre p3hggie= p3gggie p3hggi= -p3gggi * p4aggr= cp4ggr*p4abrc p4aggre= -cp4ggi*p4abic p4aggie= cp4ggr*p4abic p4aggi= cp4ggi*p4abrc * p4bggr= -p4aggr p4bggre= p4aggre p4bggie= p4aggie p4bggi= -p4aggi * p4cggr= cp4ggr*p4cdrc p4cggre= -cp4ggi*p4cdic p4cggie= cp4ggr*p4cdic p4cggi= cp4ggi*p4cdrc * p4dggr= -p4cggr p4dggre= p4cggre p4dggie= p4cggie p4dggi= -p4cggi * p4eggr= cp4ggr*p4efrc p4eggre= -cp4ggi*p4efic p4eggie= cp4ggr*p4efic p4eggi= cp4ggi*p4efrc * p4fggr= -p4eggr p4fggre= p4eggre p4fggie= p4eggie p4fggi= -p4eggi * p4gggr= cp4ggr*p4ghrc p4gggre= -cp4ggi*p4ghic p4gggie= cp4ggr*p4ghic p4gggi= cp4ggi*p4ghrc * p4hggr= -p4gggr p4hggre= p4gggre p4hggie= p4gggie p4hggi= -p4gggi * *-----All PP3 gamma-Z * cp3gz= conc(2)/pf*corrgs * do i=1,4 ip16= i+16 hlr(i)= hch(ip16)*cp3gz*zmcfr hli(i)= hch(ip16)*cp3gz*zmcfi enddo * p3agzr= hlr(3)*p3abrc p3agzre= -hli(3)*p3abic p3agzie= hlr(3)*p3abic p3agzi= hli(3)*p3abrc * p3bgzr= -hlr(4)*p3abrc p3bgzre= -hli(4)*p3abic p3bgzie= hlr(4)*p3abic p3bgzi= -hli(4)*p3abrc * p3cgzr= hlr(4)*p3cdrc p3cgzre= -hli(4)*p3cdic p3cgzie= hlr(4)*p3cdic p3cgzi= hli(4)*p3cdrc * p3dgzr= -hlr(3)*p3cdrc p3dgzre= -hli(3)*p3cdic p3dgzie= hlr(3)*p3cdic p3dgzi= -hli(3)*p3cdrc * p3egzr= hlr(2)*p3efrc p3egzre= -hli(2)*p3efic p3egzie= hlr(2)*p3efic p3egzi= hli(2)*p3efrc * p3fgzr= -hlr(1)*p3efrc p3fgzre= -hli(1)*p3efic p3fgzie= hlr(1)*p3efic p3fgzi= -hli(1)*p3efrc * p3ggzr= hlr(1)*p3ghrc p3ggzre= -hli(1)*p3ghic p3ggzie= hlr(1)*p3ghic p3ggzi= hli(1)*p3ghrc * p3hgzr= -hlr(2)*p3ghrc p3hgzre= -hli(2)*p3ghic p3hgzie= hlr(2)*p3ghic p3hgzi= -hli(2)*p3ghrc * * *-----All PP4 gamma-Z * cp4gz= -conc(2)/pfb*corrgs * do i=1,4 ip16= i+16 hmr(i)= hch(ip16)*cp4gz*zmcfr hmi(i)= hch(ip16)*cp4gz*zmcfi enddo * p4agzr= hmr(3)*p4abrc p4agzre= -hmi(3)*p4abic p4agzie= hmr(3)*p4abic p4agzi= hmi(3)*p4abrc * p4bgzr= -hmr(4)*p4abrc p4bgzre= -hmi(4)*p4abic p4bgzie= hmr(4)*p4abic p4bgzi= -hmi(4)*p4abrc * p4cgzr= hmr(4)*p4cdrc p4cgzre= -hmi(4)*p4cdic p4cgzie= hmr(4)*p4cdic p4cgzi= hmi(4)*p4cdrc * p4dgzr= -hmr(3)*p4cdrc p4dgzre= -hmi(3)*p4cdic p4dgzie= hmr(3)*p4cdic p4dgzi= -hmi(3)*p4cdrc * p4egzr= hmr(2)*p4efrc p4egzre= -hmi(2)*p4efic p4egzie= hmr(2)*p4efic p4egzi= hmi(2)*p4efrc * p4fgzr= -hmr(1)*p4efrc p4fgzre= -hmi(1)*p4efic p4fgzie= hmr(1)*p4efic p4fgzi= -hmi(1)*p4efrc * p4ggzr= hmr(1)*p4ghrc p4ggzre= -hmi(1)*p4ghic p4ggzie= hmr(1)*p4ghic p4ggzi= hmi(1)*p4ghrc * p4hgzr= -hmr(2)*p4ghrc p4hgzre= -hmi(2)*p4ghic p4hgzie= hmr(2)*p4ghic p4hgzi= -hmi(2)*p4ghrc * * *-----All PP3 Z-gamma * cp3zg= -conc(4)/sp/pf*corrgp * do i=1,4 hnr(i)= hch(i)*cp3zg*ztcfr hni(i)= hch(i)*cp3zg*ztcfi enddo * ap3azgr= hnr(1)*p3abrc ap3azgre= -hni(1)*p3abic ap3azgie= hnr(1)*p3abic ap3azgi= hni(1)*p3abrc p3azgr= ap3azgr*rsz-ap3azgi*aisz p3azgre= ap3azgre*rsz-ap3azgie*aisz p3azgie= ap3azgie*rsz+ap3azgre*aisz p3azgi= ap3azgi*rsz+ap3azgr*aisz * ap3bzgr= -hnr(2)*p3abrc ap3bzgre= -hni(2)*p3abic ap3bzgie= hnr(2)*p3abic ap3bzgi= -hni(2)*p3abrc p3bzgr= ap3bzgr*rsz-ap3bzgi*aisz p3bzgre= ap3bzgre*rsz-ap3bzgie*aisz p3bzgie= ap3bzgie*rsz+ap3bzgre*aisz p3bzgi= ap3bzgi*rsz+ap3bzgr*aisz * ap3czgr= hnr(3)*p3cdrc ap3czgre= -hni(3)*p3cdic ap3czgie= hnr(3)*p3cdic ap3czgi= hni(3)*p3cdrc p3czgr= ap3czgr*rsz-ap3czgi*aisz p3czgre= ap3czgre*rsz-ap3czgie*aisz p3czgie= ap3czgie*rsz+ap3czgre*aisz p3czgi= ap3czgi*rsz+ap3czgr*aisz * ap3dzgr= -hnr(4)*p3cdrc ap3dzgre= -hni(4)*p3cdic ap3dzgie= hnr(4)*p3cdic ap3dzgi= -hni(4)*p3cdrc p3dzgr= ap3dzgr*rsz-ap3dzgi*aisz p3dzgre= ap3dzgre*rsz-ap3dzgie*aisz p3dzgie= ap3dzgie*rsz+ap3dzgre*aisz p3dzgi= ap3dzgi*rsz+ap3dzgr*aisz * ap3ezgr= hnr(1)*p3efrc ap3ezgre= -hni(1)*p3efic ap3ezgie= hnr(1)*p3efic ap3ezgi= hni(1)*p3efrc p3ezgr= ap3ezgr*rsz-ap3ezgi*aisz p3ezgre= ap3ezgre*rsz-ap3ezgie*aisz p3ezgie= ap3ezgie*rsz+ap3ezgre*aisz p3ezgi= ap3ezgi*rsz+ap3ezgr*aisz * ap3fzgr= -hnr(2)*p3efrc ap3fzgre= -hni(2)*p3efic ap3fzgie= hnr(2)*p3efic ap3fzgi= -hni(2)*p3efrc p3fzgr= ap3fzgr*rsz-ap3fzgi*aisz p3fzgre= ap3fzgre*rsz-ap3fzgie*aisz p3fzgie= ap3fzgie*rsz+ap3fzgre*aisz p3fzgi= ap3fzgi*rsz+ap3fzgr*aisz * ap3gzgr= hnr(3)*p3ghrc ap3gzgre= -hni(3)*p3ghic ap3gzgie= hnr(3)*p3ghic ap3gzgi= hni(3)*p3ghrc p3gzgr= ap3gzgr*rsz-ap3gzgi*aisz p3gzgre= ap3gzgre*rsz-ap3gzgie*aisz p3gzgie= ap3gzgie*rsz+ap3gzgre*aisz p3gzgi= ap3gzgi*rsz+ap3gzgr*aisz * ap3hzgr= -hnr(4)*p3ghrc ap3hzgre= -hni(4)*p3ghic ap3hzgie= hnr(4)*p3ghic ap3hzgi= -hni(4)*p3ghrc p3hzgr= ap3hzgr*rsz-ap3hzgi*aisz p3hzgre= ap3hzgre*rsz-ap3hzgie*aisz p3hzgie= ap3hzgie*rsz+ap3hzgre*aisz p3hzgi= ap3hzgi*rsz+ap3hzgr*aisz * *-----All PP4 Z-gamma * cp4zg= conc(4)/sp/pfb*corrgp * do i=1,4 hor(i)= hch(i)*cp4zg*ztcfr hoi(i)= hch(i)*cp4zg*ztcfi enddo * ap4azgr= hor(1)*p4abrc ap4azgre= -hoi(1)*p4abic ap4azgie= hor(1)*p4abic ap4azgi= hoi(1)*p4abrc p4azgr= ap4azgr*rsz-ap4azgi*aisz p4azgre= ap4azgre*rsz-ap4azgie*aisz p4azgie= ap4azgie*rsz+ap4azgre*aisz p4azgi= ap4azgi*rsz+ap4azgr*aisz * ap4bzgr= -hor(2)*p4abrc ap4bzgre= -hoi(2)*p4abic ap4bzgie= hor(2)*p4abic ap4bzgi= -hoi(2)*p4abrc p4bzgr= ap4bzgr*rsz-ap4bzgi*aisz p4bzgre= ap4bzgre*rsz-ap4bzgie*aisz p4bzgie= ap4bzgie*rsz+ap4bzgre*aisz p4bzgi= ap4bzgi*rsz+ap4bzgr*aisz * ap4czgr= hor(3)*p4cdrc ap4czgre= -hoi(3)*p4cdic ap4czgie= hor(3)*p4cdic ap4czgi= hoi(3)*p4cdrc p4czgr= ap4czgr*rsz-ap4czgi*aisz p4czgre= ap4czgre*rsz-ap4czgie*aisz p4czgie= ap4czgie*rsz+ap4czgre*aisz p4czgi= ap4czgi*rsz+ap4czgr*aisz * ap4dzgr= -hor(4)*p4cdrc ap4dzgre= -hoi(4)*p4cdic ap4dzgie= hor(4)*p4cdic ap4dzgi= -hoi(4)*p4cdrc p4dzgr= ap4dzgr*rsz-ap4dzgi*aisz p4dzgre= ap4dzgre*rsz-ap4dzgie*aisz p4dzgie= ap4dzgie*rsz+ap4dzgre*aisz p4dzgi= ap4dzgi*rsz+ap4dzgr*aisz * ap4ezgr= hor(1)*p4efrc ap4ezgre= -hoi(1)*p4efic ap4ezgie= hor(1)*p4efic ap4ezgi= hoi(1)*p4efrc p4ezgr= ap4ezgr*rsz-ap4ezgi*aisz p4ezgre= ap4ezgre*rsz-ap4ezgie*aisz p4ezgie= ap4ezgie*rsz+ap4ezgre*aisz p4ezgi= ap4ezgi*rsz+ap4ezgr*aisz * ap4fzgr= -hor(2)*p4efrc ap4fzgre= -hoi(2)*p4efic ap4fzgie= hor(2)*p4efic ap4fzgi= -hoi(2)*p4efrc p4fzgr= ap4fzgr*rsz-ap4fzgi*aisz p4fzgre= ap4fzgre*rsz-ap4fzgie*aisz p4fzgie= ap4fzgie*rsz+ap4fzgre*aisz p4fzgi= ap4fzgi*rsz+ap4fzgr*aisz * ap4gzgr= hor(3)*p4ghrc ap4gzgre= -hoi(3)*p4ghic ap4gzgie= hor(3)*p4ghic ap4gzgi= hoi(3)*p4ghrc p4gzgr= ap4gzgr*rsz-ap4gzgi*aisz p4gzgre= ap4gzgre*rsz-ap4gzgie*aisz p4gzgie= ap4gzgie*rsz+ap4gzgre*aisz p4gzgi= ap4gzgi*rsz+ap4gzgr*aisz * ap4hzgr= -hor(4)*p4ghrc ap4hzgre= -hoi(4)*p4ghic ap4hzgie= hor(4)*p4ghic ap4hzgi= -hoi(4)*p4ghrc p4hzgr= ap4hzgr*rsz-ap4hzgi*aisz p4hzgre= ap4hzgre*rsz-ap4hzgie*aisz p4hzgie= ap4hzgie*rsz+ap4hzgre*aisz p4hzgi= ap4hzgi*rsz+ap4hzgr*aisz * *-----All PP3 Z-Z * cp3zz= -conc(5)/pf * do i=1,8 ip28= i+28 hpr(i)= hch(ip28)*cp3zz*zmcfr hpi(i)= hch(ip28)*cp3zz*zmcfi enddo * ap3azzr= hpr(3)*p3abrc ap3azzre= -hpi(3)*p3abic ap3azzie= hpr(3)*p3abic ap3azzi= hpi(3)*p3abrc p3azzr= ap3azzr*rsz-ap3azzi*aisz p3azzre= ap3azzre*rsz-ap3azzie*aisz p3azzie= ap3azzie*rsz+ap3azzre*aisz p3azzi= ap3azzi*rsz+ap3azzr*aisz * ap3bzzr= -hpr(4)*p3abrc ap3bzzre= -hpi(4)*p3abic ap3bzzie= hpr(4)*p3abic ap3bzzi= -hpi(4)*p3abrc p3bzzr= ap3bzzr*rsz-ap3bzzi*aisz p3bzzre= ap3bzzre*rsz-ap3bzzie*aisz p3bzzie= ap3bzzie*rsz+ap3bzzre*aisz p3bzzi= ap3bzzi*rsz+ap3bzzr*aisz * ap3czzr= hpr(5)*p3cdrc ap3czzre= -hpi(5)*p3cdic ap3czzie= hpr(5)*p3cdic ap3czzi= hpi(5)*p3cdrc p3czzr= ap3czzr*rsz-ap3czzi*aisz p3czzre= ap3czzre*rsz-ap3czzie*aisz p3czzie= ap3czzie*rsz+ap3czzre*aisz p3czzi= ap3czzi*rsz+ap3czzr*aisz * ap3dzzr= -hpr(6)*p3cdrc ap3dzzre= -hpi(6)*p3cdic ap3dzzie= hpr(6)*p3cdic ap3dzzi= -hpi(6)*p3cdrc p3dzzr= ap3dzzr*rsz-ap3dzzi*aisz p3dzzre= ap3dzzre*rsz-ap3dzzie*aisz p3dzzie= ap3dzzie*rsz+ap3dzzre*aisz p3dzzi= ap3dzzi*rsz+ap3dzzr*aisz * ap3ezzr= hpr(7)*p3efrc ap3ezzre= -hpi(7)*p3efic ap3ezzie= hpr(7)*p3efic ap3ezzi= hpi(7)*p3efrc p3ezzr= ap3ezzr*rsz-ap3ezzi*aisz p3ezzre= ap3ezzre*rsz-ap3ezzie*aisz p3ezzie= ap3ezzie*rsz+ap3ezzre*aisz p3ezzi= ap3ezzi*rsz+ap3ezzr*aisz * ap3fzzr= -hpr(8)*p3efrc ap3fzzre= -hpi(8)*p3efic ap3fzzie= hpr(8)*p3efic ap3fzzi= -hpi(8)*p3efrc p3fzzr= ap3fzzr*rsz-ap3fzzi*aisz p3fzzre= ap3fzzre*rsz-ap3fzzie*aisz p3fzzie= ap3fzzie*rsz+ap3fzzre*aisz p3fzzi= ap3fzzi*rsz+ap3fzzr*aisz * ap3gzzr= hpr(1)*p3ghrc ap3gzzre= -hpi(1)*p3ghic ap3gzzie= hpr(1)*p3ghic ap3gzzi= hpi(1)*p3ghrc p3gzzr= ap3gzzr*rsz-ap3gzzi*aisz p3gzzre= ap3gzzre*rsz-ap3gzzie*aisz p3gzzie= ap3gzzie*rsz+ap3gzzre*aisz p3gzzi= ap3gzzi*rsz+ap3gzzr*aisz * ap3hzzr= -hpr(2)*p3ghrc ap3hzzre= -hpi(2)*p3ghic ap3hzzie= hpr(2)*p3ghic ap3hzzi= -hpi(2)*p3ghrc p3hzzr= ap3hzzr*rsz-ap3hzzi*aisz p3hzzre= ap3hzzre*rsz-ap3hzzie*aisz p3hzzie= ap3hzzie*rsz+ap3hzzre*aisz p3hzzi= ap3hzzi*rsz+ap3hzzr*aisz * *-----All PP4 Z-Z * cp4zz= conc(5)/pfb * do i=1,8 ip28= i+28 hqr(i)= hch(ip28)*cp4zz*zmcfr hqi(i)= hch(ip28)*cp4zz*zmcfi enddo * ap4azzr= hqr(3)*p4abrc ap4azzre= -hqi(3)*p4abic ap4azzie= hqr(3)*p4abic ap4azzi= hqi(3)*p4abrc p4azzr= ap4azzr*rsz-ap4azzi*aisz p4azzre= ap4azzre*rsz-ap4azzie*aisz p4azzie= ap4azzie*rsz+ap4azzre*aisz p4azzi= ap4azzi*rsz+ap4azzr*aisz * ap4bzzr= -hqr(4)*p4abrc ap4bzzre= -hqi(4)*p4abic ap4bzzie= hqr(4)*p4abic ap4bzzi= -hqi(4)*p4abrc p4bzzr= ap4bzzr*rsz-ap4bzzi*aisz p4bzzre= ap4bzzre*rsz-ap4bzzie*aisz p4bzzie= ap4bzzie*rsz+ap4bzzre*aisz p4bzzi= ap4bzzi*rsz+ap4bzzr*aisz * ap4czzr= hqr(5)*p4cdrc ap4czzre= -hqi(5)*p4cdic ap4czzie= hqr(5)*p4cdic ap4czzi= hqi(5)*p4cdrc p4czzr= ap4czzr*rsz-ap4czzi*aisz p4czzre= ap4czzre*rsz-ap4czzie*aisz p4czzie= ap4czzie*rsz+ap4czzre*aisz p4czzi= ap4czzi*rsz+ap4czzr*aisz * ap4dzzr= -hqr(6)*p4cdrc ap4dzzre= -hqi(6)*p4cdic ap4dzzie= hqr(6)*p4cdic ap4dzzi= -hqi(6)*p4cdrc p4dzzr= ap4dzzr*rsz-ap4dzzi*aisz p4dzzre= ap4dzzre*rsz-ap4dzzie*aisz p4dzzie= ap4dzzie*rsz+ap4dzzre*aisz p4dzzi= ap4dzzi*rsz+ap4dzzr*aisz * ap4ezzr= hqr(7)*p4efrc ap4ezzre= -hqi(7)*p4efic ap4ezzie= hqr(7)*p4efic ap4ezzi= hqi(7)*p4efrc p4ezzr= ap4ezzr*rsz-ap4ezzi*aisz p4ezzre= ap4ezzre*rsz-ap4ezzie*aisz p4ezzie= ap4ezzie*rsz+ap4ezzre*aisz p4ezzi= ap4ezzi*rsz+ap4ezzr*aisz * ap4fzzr= -hqr(8)*p4efrc ap4fzzre= -hqi(8)*p4efic ap4fzzie= hqr(8)*p4efic ap4fzzi= -hqi(8)*p4efrc p4fzzr= ap4fzzr*rsz-ap4fzzi*aisz p4fzzre= ap4fzzre*rsz-ap4fzzie*aisz p4fzzie= ap4fzzie*rsz+ap4fzzre*aisz p4fzzi= ap4fzzi*rsz+ap4fzzr*aisz * ap4gzzr= hqr(1)*p4ghrc ap4gzzre= -hqi(1)*p4ghic ap4gzzie= hqr(1)*p4ghic ap4gzzi= hqi(1)*p4ghrc p4gzzr= ap4gzzr*rsz-ap4gzzi*aisz p4gzzre= ap4gzzre*rsz-ap4gzzie*aisz p4gzzie= ap4gzzie*rsz+ap4gzzre*aisz p4gzzi= ap4gzzi*rsz+ap4gzzr*aisz * ap4hzzr= -hqr(2)*p4ghrc ap4hzzre= -hqi(2)*p4ghic ap4hzzie= hqr(2)*p4ghic ap4hzzi= -hqi(2)*p4ghrc p4hzzr= ap4hzzr*rsz-ap4hzzi*aisz p4hzzre= ap4hzzre*rsz-ap4hzzie*aisz p4hzzie= ap4hzzie*rsz+ap4hzzre*aisz p4hzzi= ap4hzzi*rsz+ap4hzzr*aisz * *-----complete diagrams, epsilon real and imag parts separated * for NC19 * if(otype.eq.'nc19'.or. # otype.eq.'nc21') then * *-----All B1-B2 * hbfl= 0.25d0*vfl hbfr= 0.25d0*vfr * cb1d= -hbfl*conc(8)/pfpb/x25w cb1f= -hbfr*conc(8)/pfpb/x25w cb2d= hbfl*conc(8)/pfp/x16w cb2f= hbfr*conc(8)/pfp/x16w * b1dr= cb1d*b1drc*zpcfr b1dre= -cb1d*b1dic*zpcfi b1die= cb1d*b1dic*zpcfr b1di= cb1d*b1drc*zpcfi * b1fr= cb1f*b1frc*zpcfr b1fre= -cb1f*b1fic*zpcfi b1fie= cb1f*b1fic*zpcfr b1fi= cb1f*b1frc*zpcfi * b2dr= cb2d*b2drc*zpcfr b2dre= -cb2d*b2dic*zpcfi b2die= cb2d*b2dic*zpcfr b2di= cb2d*b2drc*zpcfi * b2fr= cb2f*b2frc*zpcfr b2fre= -cb2f*b2fic*zpcfi b2fie= cb2f*b2fic*zpcfr b2fi= cb2f*b2frc*zpcfi * *-----All B3-B4 * hbig= 0.25d0 hbil= 0.25d0*vel*vfl hbir= 0.25d0*vel*vfr * cb3g= hbig*conc(9)/sm/pnp/x25w*corrgm cb3dz= -hbil*conc(8)/pnp/x25w cb3fz= -hbir*conc(8)/pnp/x25w * cb4g= hbig*conc(9)/sm/pn/x16w*corrgm cb4dz= -hbil*conc(8)/pn/x16w cb4fz= -hbir*conc(8)/pn/x16w * b3dgr= cb3g*b3drc*ztcfr b3dgre= -cb3g*b3dic*ztcfi b3dgie= cb3g*b3dic*ztcfr b3dgi= cb3g*b3drc*ztcfi * b3fgr= cb3g*b3frc*ztcfr b3fgre= -cb3g*b3fic*ztcfi b3fgie= cb3g*b3fic*ztcfr b3fgi= cb3g*b3frc*ztcfi * b3dzr= cb3dz*b3drc*zpcfr b3dzre= -cb3dz*b3dic*zpcfi b3dzie= cb3dz*b3dic*zpcfr b3dzi= cb3dz*b3drc*zpcfi * b3fzr= cb3fz*b3frc*zpcfr b3fzre= -cb3fz*b3fic*zpcfi b3fzie= cb3fz*b3fic*zpcfr b3fzi= cb3fz*b3frc*zpcfi * b4dgr= cb4g*b4drc*ztcfr b4dgre= -cb4g*b4dic*ztcfi b4dgie= cb4g*b4dic*ztcfr b4dgi= cb4g*b4drc*ztcfi * b4fgr= cb4g*b4frc*ztcfr b4fgre= -cb4g*b4fic*ztcfi b4fgie= cb4g*b4fic*ztcfr b4fgi= cb4g*b4frc*ztcfi * b4dzr= cb4dz*b4drc*zpcfr b4dzre= -cb4dz*b4dic*zpcfi b4dzie= cb4dz*b4dic*zpcfr b4dzi= cb4dz*b4drc*zpcfi * b4fzr= cb4fz*b4frc*zpcfr b4fzre= -cb4fz*b4fic*zpcfi b4fzie= cb4fz*b4fic*zpcfr b4fzi= cb4fz*b4frc*zpcfi * *-----All M * rtopm2= tqm*tqm/sh comp= -1.d0/ptww/(t2+t4-x46+rtopm2)/64.d0 * rmdr= comp*rmdrc*ztcfr rmdre= -comp*rmdic*ztcfi rmdie= comp*rmdic*ztcfr rmdi= comp*rmdrc*ztcfi * rmfr= 0.d0 rmfre= 0.d0 rmfie= 0.d0 rmfi= 0.d0 * *-----All F * cofd= -vfl/32.d0 coff= -vfr/32.d0 * cofgp= -conc(10)/sm/ptww*corrgm cofdp= cofd/ptww coffp= coff/ptww * afdgr= cofgp*fdrc*ztcfr afdgre= -cofgp*fdic*ztcfi afdgie= cofgp*fdic*ztcfr afdgi= cofgp*fdrc*ztcfi fdgr= fphr*afdgr-fphi*afdgie fdgre= fphr*afdgre-fphi*afdgi fdgie= fphr*afdgie+fphi*afdgr fdgi= fphr*afdgi+fphi*afdgre * ffgr= cofgp*ffrc*ztcfr ffgre= -cofgp*ffic*ztcfi ffgie= cofgp*ffic*ztcfr ffgi= cofgp*ffrc*ztcfi * afdzr= cofdp*fdrc*zpcfr afdzre= -cofdp*fdic*zpcfi afdzie= cofdp*fdic*zpcfr afdzi= cofdp*fdrc*zpcfi fdzr= fphr*afdzr-fphi*afdzie fdzre= fphr*afdzre-fphi*afdzi fdzie= fphr*afdzie+fphi*afdzr fdzi= fphr*afdzi+fphi*afdzre * ffzr= coffp*ffrc*zpcfr ffzre= -coffp*ffic*zpcfi ffzie= coffp*ffic*zpcfr ffzi= coffp*ffrc*zpcfi * else * b1dr= 0.d0 b1dre= 0.d0 b1die= 0.d0 b1di= 0.d0 b1fr= 0.d0 b1fre= 0.d0 b1fie= 0.d0 b1fi= 0.d0 b2dr= 0.d0 b2dre= 0.d0 b2die= 0.d0 b2di= 0.d0 b2fr= 0.d0 b2fre= 0.d0 b2fie= 0.d0 b2fi= 0.d0 b3dgr= 0.d0 b3dgre= 0.d0 b3dgie= 0.d0 b3dgi= 0.d0 b3fgr= 0.d0 b3fgre= 0.d0 b3fgie= 0.d0 b3fgi= 0.d0 b3dzr= 0.d0 b3dzre= 0.d0 b3dzie= 0.d0 b3dzi= 0.d0 b3fzr= 0.d0 b3fzre= 0.d0 b3fzie= 0.d0 b3fzi= 0.d0 b4dgr= 0.d0 b4dgre= 0.d0 b4dgie= 0.d0 b4dgi= 0.d0 b4fgr= 0.d0 b4fgre= 0.d0 b4fgie= 0.d0 b4fgi= 0.d0 b4dzr= 0.d0 b4dzre= 0.d0 b4dzie= 0.d0 b4dzi= 0.d0 b4fzr= 0.d0 b4fzre= 0.d0 b4fzie= 0.d0 b4fzi= 0.d0 rmdr= 0.d0 rmdre= 0.d0 rmdie= 0.d0 rmdi= 0.d0 rmfr= 0.d0 rmfre= 0.d0 rmfie= 0.d0 rmfi= 0.d0 fdgr= 0.d0 fdgre= 0.d0 fdgie= 0.d0 fdgi= 0.d0 ffgr= 0.d0 ffgre= 0.d0 ffgie= 0.d0 ffgi= 0.d0 fdzr= 0.d0 fdzre= 0.d0 fdzie= 0.d0 fdzi= 0.d0 ffzr= 0.d0 ffzre= 0.d0 ffzie= 0.d0 ffzi= 0.d0 * endif * *-----complete diagrams, epsilon real and imag parts separated * for NC48 * if(otype.eq.'nc48'.or.otype.eq.'nc50') then * eb1ijr= zmcfr*eb1ijrc eb1ijre= -zmcfi*eb1ijic eb1ijie= zmcfr*eb1ijic eb1iji= zmcfi*eb1ijrc eb2ijr= zmcfr*eb2ijrc eb2ijre= -zmcfi*eb2ijic eb2ijie= zmcfr*eb2ijic eb2iji= zmcfi*eb2ijrc eb3ijr= zmcfr*eb3ijrc eb3ijre= -zmcfi*eb3ijic eb3ijie= zmcfr*eb3ijic eb3iji= zmcfi*eb3ijrc eb4ijr= zmcfr*eb4ijrc eb4ijre= -zmcfi*eb4ijic eb4ijie= zmcfr*eb4ijic eb4iji= zmcfi*eb4ijrc * eb1lmr= zmcfr*eb1lmrc eb1lmre= -zmcfi*eb1lmic eb1lmie= zmcfr*eb1lmic eb1lmi= zmcfi*eb1lmrc eb2lmr= zmcfr*eb2lmrc eb2lmre= -zmcfi*eb2lmic eb2lmie= zmcfr*eb2lmic eb2lmi= zmcfi*eb2lmrc eb3lmr= zmcfr*eb3lmrc eb3lmre= -zmcfi*eb3lmic eb3lmie= zmcfr*eb3lmic eb3lmi= zmcfi*eb3lmrc eb4lmr= zmcfr*eb4lmrc eb4lmre= -zmcfi*eb4lmic eb4lmie= zmcfr*eb4lmic eb4lmi= zmcfi*eb4lmrc * eb1cdr= zmcfr*eb1cdrc eb1cdre= -zmcfi*eb1cdic eb1cdie= zmcfr*eb1cdic eb1cdi= zmcfi*eb1cdrc eb2cdr= zmcfr*eb2cdrc eb2cdre= -zmcfi*eb2cdic eb2cdie= zmcfr*eb2cdic eb2cdi= zmcfi*eb2cdrc eb3cdr= zmcfr*eb3cdrc eb3cdre= -zmcfi*eb3cdic eb3cdie= zmcfr*eb3cdic eb3cdi= zmcfi*eb3cdrc eb4cdr= zmcfr*eb4cdrc eb4cdre= -zmcfi*eb4cdic eb4cdie= zmcfr*eb4cdic eb4cdi= zmcfi*eb4cdrc * eb1efr= zmcfr*eb1efrc eb1efre= -zmcfi*eb1efic eb1efie= zmcfr*eb1efic eb1efi= zmcfi*eb1efrc eb2efr= zmcfr*eb2efrc eb2efre= -zmcfi*eb2efic eb2efie= zmcfr*eb2efic eb2efi= zmcfi*eb2efrc eb3efr= zmcfr*eb3efrc eb3efre= -zmcfi*eb3efic eb3efie= zmcfr*eb3efic eb3efi= zmcfi*eb3efrc eb4efr= zmcfr*eb4efrc eb4efre= -zmcfi*eb4efic eb4efie= zmcfr*eb4efic eb4efi= zmcfi*eb4efrc * x16z= x16+rzm2/vv x25z= x25+rzm2/vv sx25= sth2/x25*corrg25 sx16= sth2/x16*corrg16 sx16z= 0.25d0/x16z/cth2 sx25z= 0.25d0/x25z/cth2 sqch= qch*sth2 sqchm= sqch/sm*corrgm qsth2= 0.25d0/cth2 fcf1= pfp*pnp*pn fcf2= pfpb*pnp*pn fcf3= pfpb*pfp*pn fcf4= pfpb*pfp*pnp fcfa= pfpb*pfp*pnp*pn * *-----All B1 * eb1ir= -fcf1*(sx25*(-sqchm*eb1ijr+ # hbo(1)*qsth2*eb1ijrc)+sx25z* # (-hbo(2)*sqchm*eb1ijr+ # hbo(3)*qsth2*eb1ijrc)) eb1ire= fcf1*sqchm*(sx25+sx25z*hbo(2))* # eb1ijre eb1iie= -fcf1*(sx25*(-sqchm*eb1ijie+ # hbo(1)*qsth2*eb1ijic)+sx25z* # (-hbo(2)*sqchm*eb1ijie+ # hbo(3)*qsth2*eb1ijic)) eb1ii= fcf1*sqchm*(sx25+sx25z*hbo(2))* # eb1iji * eb1jr= -fcf1*(sx25*(sqchm*eb1ijr- # hbo(4)*qsth2*eb1ijrc)+sx25z* # (hbo(5)*sqchm*eb1ijr- # hbo(6)*qsth2*eb1ijrc)) eb1jre= fcf1*sqchm*(sx25+sx25z*hbo(5))* # eb1ijre eb1jie= -fcf1*(sx25*(-sqchm*eb1ijie+ # hbo(4)*qsth2*eb1ijic)+sx25z* # (-hbo(5)*sqchm*eb1ijie+ # hbo(6)*qsth2*eb1ijic)) eb1ji= -fcf1*sqchm*(sx25+sx25z*hbo(5))* # eb1iji * eb1lr= -fcf1*(sx25*(-sqchm*eb1lmr+ # hbo(7)*qsth2*eb1lmrc)+sx25z* # (-hbo(8)*sqchm*eb1lmr+ # hbo(9)*qsth2*eb1lmrc)) eb1lre= fcf1*sqchm*(sx25+sx25z*hbo(8))* # eb1lmre eb1lie= -fcf1*(sx25*(-sqchm*eb1lmie+ # hbo(7)*qsth2*eb1lmic)+sx25z* # (-hbo(8)*sqchm*eb1lmie+ # hbo(9)*qsth2*eb1lmic)) eb1li= fcf1*sqchm*(sx25+sx25z*hbo(8))* # eb1lmi * eb1mr= -fcf1*(sx25*(sqchm*eb1lmr- # hbo(10)*qsth2*eb1lmrc)+sx25z* # (hbo(11)*sqchm*eb1lmr- # hbo(12)*qsth2*eb1lmrc)) eb1mre= fcf1*sqchm*(sx25+sx25z*hbo(11))* # eb1lmre eb1mie= -fcf1*(sx25*(-sqchm*eb1lmie+ # hbo(10)*qsth2*eb1lmic)+sx25z* # (-hbo(11)*sqchm*eb1lmie+ # hbo(12)*qsth2*eb1lmic)) eb1mi= -fcf1*sqchm*(sx25+sx25z*hbo(11))* # eb1lmi * eb1cr= -fcf1*(sx25*(-sqchm*eb1cdr+ # hbo(13)*qsth2*eb1cdrc)+sx25z* # (-hbo(14)*sqchm*eb1cdr+ # hbo(15)*qsth2*eb1cdrc)) eb1cre= fcf1*sqchm*(sx25+sx25z*hbo(14))* # eb1cdre eb1cie= -fcf1*(sx25*(-sqchm*eb1cdie+ # hbo(13)*qsth2*eb1cdic)+sx25z* # (-hbo(14)*sqchm*eb1cdie+ # hbo(15)*qsth2*eb1cdic)) eb1ci= fcf1*sqchm*(sx25+sx25z*hbo(14))* # eb1cdi * eb1dr= -fcf1*(sx25*(sqchm*eb1cdr- # hbo(16)*qsth2*eb1cdrc)+sx25z* # (hbo(17)*sqchm*eb1cdr- # hbo(18)*qsth2*eb1cdrc)) eb1dre= fcf1*sqchm*(sx25+sx25z*hbo(17))* # eb1cdre eb1die= -fcf1*(sx25*(-sqchm*eb1cdie+ # hbo(16)*qsth2*eb1cdic)+sx25z* # (-hbo(17)*sqchm*eb1cdie+ # hbo(18)*qsth2*eb1cdic)) eb1di= -fcf1*sqchm*(sx25+sx25z*hbo(17))* # eb1cdi * eb1er= -fcf1*(sx25*(-sqchm*eb1efr+ # hbo(19)*qsth2*eb1efrc)+sx25z* # (-hbo(20)*sqchm*eb1efr+ # hbo(21)*qsth2*eb1efrc)) eb1ere= fcf1*sqchm*(sx25+sx25z*hbo(20))* # eb1efre eb1eie= -fcf1*(sx25*(-sqchm*eb1efie+ # hbo(19)*qsth2*eb1efic)+sx25z* # (-hbo(20)*sqchm*eb1efie+ # hbo(21)*qsth2*eb1efic)) eb1ei= fcf1*sqchm*(sx25+sx25z*hbo(20))* # eb1efi * eb1fr= -fcf1*(sx25*(sqchm*eb1efr- # hbo(22)*qsth2*eb1efrc)+sx25z* # (hbo(23)*sqchm*eb1efr- # hbo(24)*qsth2*eb1efrc)) eb1fre= fcf1*sqchm*(sx25+sx25z*hbo(23))* # eb1efre eb1fie= -fcf1*(sx25*(-sqchm*eb1efie+ # hbo(22)*qsth2*eb1efic)+sx25z* # (-hbo(23)*sqchm*eb1efie+ # hbo(24)*qsth2*eb1efic)) eb1fi= -fcf1*sqchm*(sx25+sx25z*hbo(23))* # eb1efi * *-----All B2 * eb2ir= -fcf2*(sx16*(-sqchm*eb2ijr+ # hbe(1)*qsth2*eb2ijrc)+sx16z* # (-hbe(2)*sqchm*eb2ijr+ # hbe(3)*qsth2*eb2ijrc)) eb2ire= fcf2*sqchm*(sx16+sx16z*hbe(2))* # eb2ijre eb2iie= -fcf2*(sx16*(-sqchm*eb2ijie+ # hbe(1)*qsth2*eb2ijic)+sx16z* # (-hbe(2)*sqchm*eb2ijie+ # hbe(3)*qsth2*eb2ijic)) eb2ii= fcf2*sqchm*(sx16+sx16z*hbe(2))* # eb2iji * eb2jr= -fcf2*(sx16*(sqchm*eb2ijr- # hbe(4)*qsth2*eb2ijrc)+sx16z* # (hbe(5)*sqchm*eb2ijr- # hbe(6)*qsth2*eb2ijrc)) eb2jre= fcf2*sqchm*(sx16+sx16z*hbe(5))* # eb2ijre eb2jie= -fcf2*(sx16*(-sqchm*eb2ijie+ # hbe(4)*qsth2*eb2ijic)+sx16z* # (-hbe(5)*sqchm*eb2ijie+ # hbe(6)*qsth2*eb2ijic)) eb2ji= -fcf2*sqchm*(sx16+sx16z*hbe(5))* # eb2iji * eb2lr= -fcf2*(sx16*(-sqchm*eb2lmr+ # hbe(7)*qsth2*eb2lmrc)+sx16z* # (-hbe(8)*sqchm*eb2lmr+ # hbe(9)*qsth2*eb2lmrc)) eb2lre= fcf2*sqchm*(sx16+sx16z*hbe(8))* # eb2lmre eb2lie= -fcf2*(sx16*(-sqchm*eb2lmie+ # hbe(7)*qsth2*eb2lmic)+sx16z* # (-hbe(8)*sqchm*eb2lmie+ # hbe(9)*qsth2*eb2lmic)) eb2li= fcf2*sqchm*(sx16+sx16z*hbe(8))* # eb2lmi * eb2mr= -fcf2*(sx16*(sqchm*eb2lmr- # hbe(10)*qsth2*eb2lmrc)+sx16z* # (hbe(11)*sqchm*eb2lmr- # hbe(12)*qsth2*eb2lmrc)) eb2mre= fcf2*sqchm*(sx16+sx16z*hbe(11))* # eb2lmre eb2mie= -fcf2*(sx16*(-sqchm*eb2lmie+ # hbe(10)*qsth2*eb2lmic)+sx16z* # (-hbe(11)*sqchm*eb2lmie+ # hbe(12)*qsth2*eb2lmic)) eb2mi= -fcf2*sqchm*(sx16+sx16z*hbe(11))* # eb2lmi * eb2cr= -fcf2*(sx16*(-sqchm*eb2cdr+ # hbe(13)*qsth2*eb2cdrc)+sx16z* # (-hbe(14)*sqchm*eb2cdr+ # hbe(15)*qsth2*eb2cdrc)) eb2cre= fcf2*sqchm*(sx16+sx16z*hbe(14))* # eb2cdre eb2cie= -fcf2*(sx16*(-sqchm*eb2cdie+ # hbe(13)*qsth2*eb2cdic)+sx16z* # (-hbe(14)*sqchm*eb2cdie+ # hbe(15)*qsth2*eb2cdic)) eb2ci= fcf2*sqchm*(sx16+sx16z*hbe(14))* # eb2cdi * eb2dr= -fcf2*(sx16*(sqchm*eb2cdr- # hbe(16)*qsth2*eb2cdrc)+sx16z* # (hbe(17)*sqchm*eb2cdr- # hbe(18)*qsth2*eb2cdrc)) eb2dre= fcf2*sqchm*(sx16+sx16z*hbe(17))* # eb2cdre eb2die= -fcf2*(sx16*(-sqchm*eb2cdie+ # hbe(16)*qsth2*eb2cdic)+sx16z* # (-hbe(17)*sqchm*eb2cdie+ # hbe(18)*qsth2*eb2cdic)) eb2di= -fcf2*sqchm*(sx16+sx16z*hbe(17))* # eb2cdi * eb2er= -fcf2*(sx16*(-sqchm*eb2efr+ # hbe(19)*qsth2*eb2efrc)+sx16z* # (-hbe(20)*sqchm*eb2efr+ # hbe(21)*qsth2*eb2efrc)) eb2ere= fcf2*sqchm*(sx16+sx16z*hbe(20))* # eb2efre eb2eie= -fcf2*(sx16*(-sqchm*eb2efie+ # hbe(19)*qsth2*eb2efic)+sx16z* # (-hbe(20)*sqchm*eb2efie+ # hbe(21)*qsth2*eb2efic)) eb2ei= fcf2*sqchm*(sx16+sx16z*hbe(20))* # eb2efi * eb2fr= -fcf2*(sx16*(sqchm*eb2efr- # hbe(22)*qsth2*eb2efrc)+sx16z* # (hbe(23)*sqchm*eb2efr- # hbe(24)*qsth2*eb2efrc)) eb2fre= fcf2*sqchm*(sx16+sx16z*hbe(23))* # eb2efre eb2fie= -fcf2*(sx16*(-sqchm*eb2efie+ # hbe(22)*qsth2*eb2efic)+sx16z* # (-hbe(23)*sqchm*eb2efie+ # hbe(24)*qsth2*eb2efic)) eb2fi= -fcf2*sqchm*(sx16+sx16z*hbe(23))* # eb2efi * *-----All B3 * eb3ir= -fcf3*(sx25*(-sqchm*eb3ijr+ # hbo(1)*qsth2*eb3ijrc)+sx25z* # (-hbo(2)*sqchm*eb3ijr+ # hbo(3)*qsth2*eb3ijrc)) eb3ire= fcf3*sqchm*(sx25+sx25z*hbo(2))* # eb3ijre eb3iie= -fcf3*(sx25*(-sqchm*eb3ijie+ # hbo(1)*qsth2*eb3ijic)+sx25z* # (-hbo(2)*sqchm*eb3ijie+ # hbo(3)*qsth2*eb3ijic)) eb3ii= fcf3*sqchm*(sx25+sx25z*hbo(2))* # eb3iji * eb3jr= -fcf3*(sx25*(sqchm*eb3ijr- # hbo(4)*qsth2*eb3ijrc)+sx25z* # (hbo(5)*sqchm*eb3ijr- # hbo(6)*qsth2*eb3ijrc)) eb3jre= fcf3*sqchm*(sx25+sx25z*hbo(5))* # eb3ijre eb3jie= -fcf3*(sx25*(-sqchm*eb3ijie+ # hbo(4)*qsth2*eb3ijic)+sx25z* # (-hbo(5)*sqchm*eb3ijie+ # hbo(6)*qsth2*eb3ijic)) eb3ji= -fcf3*sqchm*(sx25+sx25z*hbo(5))* # eb3iji * eb3lr= -fcf3*(sx25*(-sqchm*eb3lmr+ # hbo(7)*qsth2*eb3lmrc)+sx25z* # (-hbo(8)*sqchm*eb3lmr+ # hbo(9)*qsth2*eb3lmrc)) eb3lre= fcf3*sqchm*(sx25+sx25z*hbo(8))* # eb3lmre eb3lie= -fcf3*(sx25*(-sqchm*eb3lmie+ # hbo(7)*qsth2*eb3lmic)+sx25z* # (-hbo(8)*sqchm*eb3lmie+ # hbo(9)*qsth2*eb3lmic)) eb3li= fcf3*sqchm*(sx25+sx25z*hbo(8))* # eb3lmi * eb3mr= -fcf3*(sx25*(sqchm*eb3lmr- # hbo(10)*qsth2*eb3lmrc)+sx25z* # (hbo(11)*sqchm*eb3lmr- # hbo(12)*qsth2*eb3lmrc)) eb3mre= fcf3*sqchm*(sx25+sx25z*hbo(11))* # eb3lmre eb3mie= -fcf3*(sx25*(-sqchm*eb3lmie+ # hbo(10)*qsth2*eb3lmic)+sx25z* # (-hbo(11)*sqchm*eb3lmie+ # hbo(12)*qsth2*eb3lmic)) eb3mi= -fcf3*sqchm*(sx25+sx25z*hbo(11))* # eb3lmi * eb3cr= -fcf3*(sx25*(-sqchm*eb3cdr+ # hbo(13)*qsth2*eb3cdrc)+sx25z* # (-hbo(14)*sqchm*eb3cdr+ # hbo(15)*qsth2*eb3cdrc)) eb3cre= fcf3*sqchm*(sx25+sx25z*hbo(14))* # eb3cdre eb3cie= -fcf3*(sx25*(-sqchm*eb3cdie+ # hbo(13)*qsth2*eb3cdic)+sx25z* # (-hbo(14)*sqchm*eb3cdie+ # hbo(15)*qsth2*eb3cdic)) eb3ci= fcf3*sqchm*(sx25+sx25z*hbo(14))* # eb3cdi * eb3dr= -fcf3*(sx25*(sqchm*eb3cdr- # hbo(16)*qsth2*eb3cdrc)+sx25z* # (hbo(17)*sqchm*eb3cdr- # hbo(18)*qsth2*eb3cdrc)) eb3dre= fcf3*sqchm*(sx25+sx25z*hbo(17))* # eb3cdre eb3die= -fcf3*(sx25*(-sqchm*eb3cdie+ # hbo(16)*qsth2*eb3cdic)+sx25z* # (-hbo(17)*sqchm*eb3cdie+ # hbo(18)*qsth2*eb3cdic)) eb3di= -fcf3*sqchm*(sx25+sx25z*hbo(17))* # eb3cdi * eb3er= -fcf3*(sx25*(-sqchm*eb3efr+ # hbo(19)*qsth2*eb3efrc)+sx25z* # (-hbo(20)*sqchm*eb3efr+ # hbo(21)*qsth2*eb3efrc)) eb3ere= fcf3*sqchm*(sx25+sx25z*hbo(20))* # eb3efre eb3eie= -fcf3*(sx25*(-sqchm*eb3efie+ # hbo(19)*qsth2*eb3efic)+sx25z* # (-hbo(20)*sqchm*eb3efie+ # hbo(21)*qsth2*eb3efic)) eb3ei= fcf3*sqchm*(sx25+sx25z*hbo(20))* # eb3efi * eb3fr= -fcf3*(sx25*(sqchm*eb3efr- # hbo(22)*qsth2*eb3efrc)+sx25z* # (hbo(23)*sqchm*eb3efr- # hbo(24)*qsth2*eb3efrc)) eb3fre= fcf3*sqchm*(sx25+sx25z*hbo(23))* # eb3efre eb3fie= -fcf3*(sx25*(-sqchm*eb3efie+ # hbo(22)*qsth2*eb3efic)+sx25z* # (-hbo(23)*sqchm*eb3efie+ # hbo(24)*qsth2*eb3efic)) eb3fi= -fcf3*sqchm*(sx25+sx25z*hbo(23))* # eb3efi * *-----All B4 * eb4ir= -fcf4*(sx16*(-sqchm*eb4ijr+ # hbe(1)*qsth2*eb4ijrc)+sx16z* # (-hbe(2)*sqchm*eb4ijr+ # hbe(3)*qsth2*eb4ijrc)) eb4ire= fcf4*sqchm*(sx16+sx16z*hbe(2))* # eb4ijre eb4iie= -fcf4*(sx16*(-sqchm*eb4ijie+ # hbe(1)*qsth2*eb4ijic)+sx16z* # (-hbe(2)*sqchm*eb4ijie+ # hbe(3)*qsth2*eb4ijic)) eb4ii= fcf4*sqchm*(sx16+sx16z*hbe(2))* # eb4iji * eb4jr= -fcf4*(sx16*(sqchm*eb4ijr- # hbe(4)*qsth2*eb4ijrc)+sx16z* # (hbe(5)*sqchm*eb4ijr- # hbe(6)*qsth2*eb4ijrc)) eb4jre= fcf4*sqchm*(sx16+sx16z*hbe(5))* # eb4ijre eb4jie= -fcf4*(sx16*(-sqchm*eb4ijie+ # hbe(4)*qsth2*eb4ijic)+sx16z* # (-hbe(5)*sqchm*eb4ijie+ # hbe(6)*qsth2*eb4ijic)) eb4ji= -fcf4*sqchm*(sx16+sx16z*hbe(5))* # eb4iji * eb4lr= -fcf4*(sx16*(-sqchm*eb4lmr+ # hbe(7)*qsth2*eb4lmrc)+sx16z* # (-hbe(8)*sqchm*eb4lmr+ # hbe(9)*qsth2*eb4lmrc)) eb4lre= fcf4*sqchm*(sx16+sx16z*hbe(8))* # eb4lmre eb4lie= -fcf4*(sx16*(-sqchm*eb4lmie+ # hbe(7)*qsth2*eb4lmic)+sx16z* # (-hbe(8)*sqchm*eb4lmie+ # hbe(9)*qsth2*eb4lmic)) eb4li= fcf4*sqchm*(sx16+sx16z*hbe(8))* # eb4lmi * eb4mr= -fcf4*(sx16*(sqchm*eb4lmr- # hbe(10)*qsth2*eb4lmrc)+sx16z* # (hbe(11)*sqchm*eb4lmr- # hbe(12)*qsth2*eb4lmrc)) eb4mre= fcf4*sqchm*(sx16+sx16z*hbe(11))* # eb4lmre eb4mie= -fcf4*(sx16*(-sqchm*eb4lmie+ # hbe(10)*qsth2*eb4lmic)+sx16z* # (-hbe(11)*sqchm*eb4lmie+ # hbe(12)*qsth2*eb4lmic)) eb4mi= -fcf4*sqchm*(sx16+sx16z*hbe(11))* # eb4lmi * eb4cr= -fcf4*(sx16*(-sqchm*eb4cdr+ # hbe(13)*qsth2*eb4cdrc)+sx16z* # (-hbe(14)*sqchm*eb4cdr+ # hbe(15)*qsth2*eb4cdrc)) eb4cre= fcf4*sqchm*(sx16+sx16z*hbe(14))* # eb4cdre eb4cie= -fcf4*(sx16*(-sqchm*eb4cdie+ # hbe(13)*qsth2*eb4cdic)+sx16z* # (-hbe(14)*sqchm*eb4cdie+ # hbe(15)*qsth2*eb4cdic)) eb4ci= fcf4*sqchm*(sx16+sx16z*hbe(14))* # eb4cdi * eb4dr= -fcf4*(sx16*(sqchm*eb4cdr- # hbe(16)*qsth2*eb4cdrc)+sx16z* # (hbe(17)*sqchm*eb4cdr- # hbe(18)*qsth2*eb4cdrc)) eb4dre= fcf4*sqchm*(sx16+sx16z*hbe(17))* # eb4cdre eb4die= -fcf4*(sx16*(-sqchm*eb4cdie+ # hbe(16)*qsth2*eb4cdic)+sx16z* # (-hbe(17)*sqchm*eb4cdie+ # hbe(18)*qsth2*eb4cdic)) eb4di= -fcf4*sqchm*(sx16+sx16z*hbe(17))* # eb4cdi * eb4er= -fcf4*(sx16*(-sqchm*eb4efr+ # hbe(19)*qsth2*eb4efrc)+sx16z* # (-hbe(20)*sqchm*eb4efr+ # hbe(21)*qsth2*eb4efrc)) eb4ere= fcf4*sqchm*(sx16+sx16z*hbe(20))* # eb4efre eb4eie= -fcf4*(sx16*(-sqchm*eb4efie+ # hbe(19)*qsth2*eb4efic)+sx16z* # (-hbe(20)*sqchm*eb4efie+ # hbe(21)*qsth2*eb4efic)) eb4ei= fcf4*sqchm*(sx16+sx16z*hbe(20))* # eb4efi * eb4fr= -fcf4*(sx16*(sqchm*eb4efr- # hbe(22)*qsth2*eb4efrc)+sx16z* # (hbe(23)*sqchm*eb4efr- # hbe(24)*qsth2*eb4efrc)) eb4fre= fcf4*sqchm*(sx16+sx16z*hbe(23))* # eb4efre eb4fie= -fcf4*(sx16*(-sqchm*eb4efie+ # hbe(22)*qsth2*eb4efic)+sx16z* # (-hbe(23)*sqchm*eb4efie+ # hbe(24)*qsth2*eb4efic)) eb4fi= -fcf4*sqchm*(sx16+sx16z*hbe(23))* # eb4efi * ebiru= eb1ir+eb3ir ebiiu= eb1ii+eb3ii ebireu= eb1ire+eb3ire ebiieu= eb1iie+eb3iie ebird= -eb2ir+eb4ir ebiid= -eb2ii+eb4ii ebired= -eb2ire+eb4ire ebiied= -eb2iie+eb4iie * ebjru= eb1jr+eb3jr ebjiu= eb1ji+eb3ji ebjreu= eb1jre+eb3jre ebjieu= eb1jie+eb3jie ebjrd= -eb2jr+eb4jr ebjid= -eb2ji+eb4ji ebjred= -eb2jre+eb4jre ebjied= -eb2jie+eb4jie * eblru= eb1lr+eb3lr ebliu= eb1li+eb3li eblreu= eb1lre+eb3lre eblieu= eb1lie+eb3lie eblrd= -eb2lr+eb4lr eblid= -eb2li+eb4li eblred= -eb2lre+eb4lre eblied= -eb2lie+eb4lie * ebmru= eb1mr+eb3mr ebmiu= eb1mi+eb3mi ebmreu= eb1mre+eb3mre ebmieu= eb1mie+eb3mie ebmrd= -eb2mr+eb4mr ebmid= -eb2mi+eb4mi ebmred= -eb2mre+eb4mre ebmied= -eb2mie+eb4mie * ebcru= eb1cr+eb3cr ebciu= eb1ci+eb3ci ebcreu= eb1cre+eb3cre ebcieu= eb1cie+eb3cie ebcrd= -eb2cr+eb4cr ebcid= -eb2ci+eb4ci ebcred= -eb2cre+eb4cre ebcied= -eb2cie+eb4cie * ebdru= eb1dr+eb3dr ebdiu= eb1di+eb3di ebdreu= eb1dre+eb3dre ebdieu= eb1die+eb3die ebdrd= -eb2dr+eb4dr ebdid= -eb2di+eb4di ebdred= -eb2dre+eb4dre ebdied= -eb2die+eb4die * eberu= eb1er+eb3er ebeiu= eb1ei+eb3ei ebereu= eb1ere+eb3ere ebeieu= eb1eie+eb3eie eberd= -eb2er+eb4er ebeid= -eb2ei+eb4ei ebered= -eb2ere+eb4ere ebeied= -eb2eie+eb4eie * ebfru= eb1fr+eb3fr ebfiu= eb1fi+eb3fi ebfreu= eb1fre+eb3fre ebfieu= eb1fie+eb3fie ebfrd= -eb2fr+eb4fr ebfid= -eb2fi+eb4fi ebfred= -eb2fre+eb4fre ebfied= -eb2fie+eb4fie * ebir= (ebiru+ebird)/fcfa ebii= (ebiiu+ebiid)/fcfa ebire= (ebireu+ebired)/fcfa ebiie= (ebiieu+ebiied)/fcfa * ebjr= (ebjru+ebjrd)/fcfa ebji= (ebjiu+ebjid)/fcfa ebjre= (ebjreu+ebjred)/fcfa ebjie= (ebjieu+ebjied)/fcfa * eblr= (eblru+eblrd)/fcfa ebli= (ebliu+eblid)/fcfa eblre= (eblreu+eblred)/fcfa eblie= (eblieu+eblied)/fcfa * ebmr= (ebmru+ebmrd)/fcfa ebmi= (ebmiu+ebmid)/fcfa ebmre= (ebmreu+ebmred)/fcfa ebmie= (ebmieu+ebmied)/fcfa * ebcr= (ebcru+ebcrd)/fcfa ebci= (ebciu+ebcid)/fcfa ebcre= (ebcreu+ebcred)/fcfa ebcie= (ebcieu+ebcied)/fcfa * ebdr= (ebdru+ebdrd)/fcfa ebdi= (ebdiu+ebdid)/fcfa ebdre= (ebdreu+ebdred)/fcfa ebdie= (ebdieu+ebdied)/fcfa * eber= (eberu+eberd)/fcfa ebei= (ebeiu+ebeid)/fcfa ebere= (ebereu+ebered)/fcfa ebeie= (ebeieu+ebeied)/fcfa * ebfr= (ebfru+ebfrd)/fcfa ebfi= (ebfiu+ebfid)/fcfa ebfre= (ebfreu+ebfred)/fcfa ebfie= (ebfieu+ebfied)/fcfa * *-----All M1 * pem1= 1.d0/(t2+t4-x46) qch16= qch*sx16 qch25= qch*sx25 * em1ir= pem1*(qch16*(-qch25+hmp(1)*sx25z)+ # sx16z*(qch25*hmp(2)-hmp(3)*sx25z))* # em1ijrc em1iie= pem1*(qch16*(-qch25+hmp(1)*sx25z)+ # sx16z*(qch25*hmp(2)-hmp(3)*sx25z))* # em1ijic * em1jr= -pem1*(qch16*(-qch25+hmp(4)*sx25z)+ # sx16z*(qch25*hmp(5)-hmp(6)*sx25z))* # em1ijrc em1jie= pem1*(qch16*(-qch25+hmp(4)*sx25z)+ # sx16z*(qch25*hmp(5)-hmp(6)*sx25z))* # em1ijic * em1lr= pem1*(qch16*(-qch25+hmp(7)*sx25z)+ # sx16z*(qch25*hmp(8)-hmp(9)*sx25z))* # em1lmrc em1lie= pem1*(qch16*(-qch25+hmp(7)*sx25z)+ # sx16z*(qch25*hmp(8)-hmp(9)*sx25z))* # em1lmic * em1mr= -pem1*(qch16*(-qch25+hmp(10)*sx25z)+ # sx16z*(qch25*hmp(11)-hmp(12)*sx25z))* # em1lmrc em1mie= pem1*(qch16*(-qch25+hmp(10)*sx25z)+ # sx16z*(qch25*hmp(11)-hmp(12)*sx25z))* # em1lmic * em1cr= pem1*(qch16*(-qch25+hmp(13)*sx25z)+ # sx16z*(qch25*hmp(14)-hmp(15)*sx25z))* # em1cdrc em1cie= pem1*(qch16*(-qch25+hmp(13)*sx25z)+ # sx16z*(qch25*hmp(14)-hmp(15)*sx25z))* # em1cdic * em1dr= -pem1*(qch16*(-qch25+hmp(16)*sx25z)+ # sx16z*(qch25*hmp(17)-hmp(18)*sx25z))* # em1cdrc em1die= pem1*(qch16*(-qch25+hmp(16)*sx25z)+ # sx16z*(qch25*hmp(17)-hmp(18)*sx25z))* # em1cdic * em1er= pem1*(qch16*(-qch25+hmp(19)*sx25z)+ # sx16z*(qch25*hmp(20)-hmp(21)*sx25z))* # em1efrc em1eie= pem1*(qch16*(-qch25+hmp(19)*sx25z)+ # sx16z*(qch25*hmp(20)-hmp(21)*sx25z))* # em1efic * em1fr= -pem1*(qch16*(-qch25+hmp(22)*sx25z)+ # sx16z*(qch25*hmp(23)-hmp(24)*sx25z))* # em1efrc em1fie= pem1*(qch16*(-qch25+hmp(22)*sx25z)+ # sx16z*(qch25*hmp(23)-hmp(24)*sx25z))* # em1efic * *-----All M2 * pem2= 1.d0/(t1+t4-x36) * em2ir= pem2*(qch16*(-qch25+hmp(1)*sx25z)+ # sx16z*(qch25*hmp(2)-hmp(3)*sx25z))* # em2ijrc em2iie= pem2*(qch16*(-qch25+hmp(1)*sx25z)+ # sx16z*(qch25*hmp(2)-hmp(3)*sx25z))* # em2ijic * em2jr= -pem2*(qch16*(-qch25+hmp(4)*sx25z)+ # sx16z*(qch25*hmp(5)-hmp(6)*sx25z))* # em2ijrc em2jie= pem2*(qch16*(-qch25+hmp(4)*sx25z)+ # sx16z*(qch25*hmp(5)-hmp(6)*sx25z))* # em2ijic * em2lr= pem2*(qch16*(-qch25+hmp(7)*sx25z)+ # sx16z*(qch25*hmp(8)-hmp(9)*sx25z))* # em2lmrc em2lie= pem2*(qch16*(-qch25+hmp(7)*sx25z)+ # sx16z*(qch25*hmp(8)-hmp(9)*sx25z))* # em2lmic * em2mr= -pem2*(qch16*(-qch25+hmp(10)*sx25z)+ # sx16z*(qch25*hmp(11)-hmp(12)*sx25z))* # em2lmrc em2mie= pem2*(qch16*(-qch25+hmp(10)*sx25z)+ # sx16z*(qch25*hmp(11)-hmp(12)*sx25z))* # em2lmic * em2cr= pem2*(qch16*(-qch25+hmp(13)*sx25z)+ # sx16z*(qch25*hmp(14)-hmp(15)*sx25z))* # em2cdrc em2cie= pem2*(qch16*(-qch25+hmp(13)*sx25z)+ # sx16z*(qch25*hmp(14)-hmp(15)*sx25z))* # em2cdic * em2dr= -pem2*(qch16*(-qch25+hmp(16)*sx25z)+ # sx16z*(qch25*hmp(17)-hmp(18)*sx25z))* # em2cdrc em2die= pem2*(qch16*(-qch25+hmp(16)*sx25z)+ # sx16z*(qch25*hmp(17)-hmp(18)*sx25z))* # em2cdic * em2er= pem2*(qch16*(-qch25+hmp(19)*sx25z)+ # sx16z*(qch25*hmp(20)-hmp(21)*sx25z))* # em2efrc em2eie= pem2*(qch16*(-qch25+hmp(19)*sx25z)+ # sx16z*(qch25*hmp(20)-hmp(21)*sx25z))* # em2efic * em2fr= -pem2*(qch16*(-qch25+hmp(22)*sx25z)+ # sx16z*(qch25*hmp(23)-hmp(24)*sx25z))* # em2efrc em2fie= pem2*(qch16*(-qch25+hmp(22)*sx25z)+ # sx16z*(qch25*hmp(23)-hmp(24)*sx25z))* # em2efic * emir= em1ir-em2ir emiie= em1iie-em2iie * emjr= em1jr-em2jr emjie= em1jie-em2jie * emlr= em1lr-em2lr emlie= em1lie-em2lie * emmr= em1mr-em2mr emmie= em1mie-em2mie * emcr= em1cr-em2cr emcie= em1cie-em2cie * emdr= em1dr-em2dr emdie= em1die-em2die * emer= em1er-em2er emeie= em1eie-em2eie * emfr= em1fr-em2fr emfie= em1fie-em2fie * ehir= (zpcfr*ebir+ztcfr*emir-zpcfi*ebii)/16.d0 ehjr= (zpcfr*ebjr+ztcfr*emjr-zpcfi*ebji)/16.d0 ehlr= (zpcfr*eblr+ztcfr*emlr-zpcfi*ebli)/16.d0 ehmr= (zpcfr*ebmr+ztcfr*emmr-zpcfi*ebmi)/16.d0 ehcr= (zpcfr*ebcr+ztcfr*emcr-zpcfi*ebci)/16.d0 ehdr= (zpcfr*ebdr+ztcfr*emdr-zpcfi*ebdi)/16.d0 eher= (zpcfr*eber+ztcfr*emer-zpcfi*ebei)/16.d0 ehfr= (zpcfr*ebfr+ztcfr*emfr-zpcfi*ebfi)/16.d0 * ehire= (zpcfr*ebire-zpcfi*ebiie-ztcfi*emiie)/16.d0 ehjre= (zpcfr*ebjre-zpcfi*ebjie-ztcfi*emjie)/16.d0 ehlre= (zpcfr*eblre-zpcfi*eblie-ztcfi*emlie)/16.d0 ehmre= (zpcfr*ebmre-zpcfi*ebmie-ztcfi*emmie)/16.d0 ehcre= (zpcfr*ebcre-zpcfi*ebcie-ztcfi*emcie)/16.d0 ehdre= (zpcfr*ebdre-zpcfi*ebdie-ztcfi*emdie)/16.d0 ehere= (zpcfr*ebere-zpcfi*ebeie-ztcfi*emeie)/16.d0 ehfre= (zpcfr*ebfre-zpcfi*ebfie-ztcfi*emfie)/16.d0 * ehiie= (zpcfi*ebire+ztcfr*emiie+zpcfr*ebiie)/16.d0 ehjie= (zpcfi*ebjre+ztcfr*emjie+zpcfr*ebjie)/16.d0 ehlie= (zpcfi*eblre+ztcfr*emlie+zpcfr*eblie)/16.d0 ehmie= (zpcfi*ebmre+ztcfr*emmie+zpcfr*ebmie)/16.d0 ehcie= (zpcfi*ebcre+ztcfr*emcie+zpcfr*ebcie)/16.d0 ehdie= (zpcfi*ebdre+ztcfr*emdie+zpcfr*ebdie)/16.d0 eheie= (zpcfi*ebere+ztcfr*emeie+zpcfr*ebeie)/16.d0 ehfie= (zpcfi*ebfre+ztcfr*emfie+zpcfr*ebfie)/16.d0 * ehii= (zpcfi*ebir+ztcfi*emir+zpcfr*ebii)/16.d0 ehji= (zpcfi*ebjr+ztcfi*emjr+zpcfr*ebji)/16.d0 ehli= (zpcfi*eblr+ztcfi*emlr+zpcfr*ebli)/16.d0 ehmi= (zpcfi*ebmr+ztcfi*emmr+zpcfr*ebmi)/16.d0 ehci= (zpcfi*ebcr+ztcfi*emcr+zpcfr*ebci)/16.d0 ehdi= (zpcfi*ebdr+ztcfi*emdr+zpcfr*ebdi)/16.d0 ehei= (zpcfi*eber+ztcfi*emer+zpcfr*ebei)/16.d0 ehfi= (zpcfi*ebfr+ztcfi*emfr+zpcfr*ebfi)/16.d0 else ehir= 0.d0 ehjr= 0.d0 ehlr= 0.d0 ehmr= 0.d0 ehcr= 0.d0 ehdr= 0.d0 eher= 0.d0 ehfr= 0.d0 * ehire= 0.d0 ehjre= 0.d0 ehlre= 0.d0 ehmre= 0.d0 ehcre= 0.d0 ehdre= 0.d0 ehere= 0.d0 ehfre= 0.d0 * ehiie= 0.d0 ehjie= 0.d0 ehlie= 0.d0 ehmie= 0.d0 ehcie= 0.d0 ehdie= 0.d0 eheie= 0.d0 ehfie= 0.d0 * ehii= 0.d0 ehji= 0.d0 ehli= 0.d0 ehmi= 0.d0 ehci= 0.d0 ehdi= 0.d0 ehei= 0.d0 ehfi= 0.d0 endif * tdrar= c1azzr+c2azzr tdrbr= c1bzzr+c2bzzr tdrcr= c1czzr+c2czzr tdrdr= c1dzzr+c2dzzr tdrer= c1ezzr+c2ezzr tdrfr= c1fzzr+c2fzzr tdrgr= c1gzzr+c2gzzr tdrhr= c1hzzr+c2hzzr * tdraie= c1azzie+c2azzie tdrbie= c1bzzie+c2bzzie tdrcie= c1czzie+c2czzie tdrdie= c1dzzie+c2dzzie tdreie= c1ezzie+c2ezzie tdrfie= c1fzzie+c2fzzie tdrgie= c1gzzie+c2gzzie tdrhie= c1hzzie+c2hzzie * tcar= c1aggr+c1agzr+c1azgr+c1azzr+ # c2aggr+c2agzr+c2azgr+c2azzr tcare= c1aggre+c1agzre+c1azgre+ # c2aggre+c2agzre+c2azgre tcaie= c1aggie+c1agzie+c1azgie+c1azzie+ # c2aggie+c2agzie+c2azgie+c2azzie tcai= c1aggi+c1agzi+c1azgi+ # c2aggi+c2agzi+c2azgi * tcbr= c1bggr+c1bgzr+c1bzgr+c1bzzr+ # c2bggr+c2bgzr+c2bzgr+c2bzzr tcbre= c1bggre+c1bgzre+c1bzgre+ # c2bggre+c2bgzre+c2bzgre tcbie= c1bggie+c1bgzie+c1bzgie+c1bzzie+ # c2bggie+c2bgzie+c2bzgie+c2bzzie tcbi= c1bggi+c1bgzi+c1bzgi+ # c2bggi+c2bgzi+c2bzgi * tccr= c1cggr+c1cgzr+c1czgr+c1czzr+ # c2cggr+c2cgzr+c2czgr+c2czzr tccre= c1cggre+c1cgzre+c1czgre+ # c2cggre+c2cgzre+c2czgre tccie= c1cggie+c1cgzie+c1czgie+c1czzie+ # c2cggie+c2cgzie+c2czgie+c2czzie tcci= c1cggi+c1cgzi+c1czgi+ # c2cggi+c2cgzi+c2czgi * tcdr= c1dggr+c1dgzr+c1dzgr+c1dzzr+ # c2dggr+c2dgzr+c2dzgr+c2dzzr tcdre= c1dggre+c1dgzre+c1dzgre+ # c2dggre+c2dgzre+c2dzgre tcdie= c1dggie+c1dgzie+c1dzgie+c1dzzie+ # c2dggie+c2dgzie+c2dzgie+c2dzzie tcdi= c1dggi+c1dgzi+c1dzgi+ # c2dggi+c2dgzi+c2dzgi * tcer= c1eggr+c1egzr+c1ezgr+c1ezzr+ # c2eggr+c2egzr+c2ezgr+c2ezzr tcere= c1eggre+c1egzre+c1ezgre+ # c2eggre+c2egzre+c2ezgre tceie= c1eggie+c1egzie+c1ezgie+c1ezzie+ # c2eggie+c2egzie+c2ezgie+c2ezzie tcei= c1eggi+c1egzi+c1ezgi+ # c2eggi+c2egzi+c2ezgi * tcfr= c1fggr+c1fgzr+c1fzgr+c1fzzr+ # c2fggr+c2fgzr+c2fzgr+c2fzzr tcfre= c1fggre+c1fgzre+c1fzgre+ # c2fggre+c2fgzre+c2fzgre tcfie= c1fggie+c1fgzie+c1fzgie+c1fzzie+ # c2fggie+c2fgzie+c2fzgie+c2fzzie tcfi= c1fggi+c1fgzi+c1fzgi+ # c2fggi+c2fgzi+c2fzgi * tcgr= c1gggr+c1ggzr+c1gzgr+c1gzzr+ # c2gggr+c2ggzr+c2gzgr+c2gzzr tcgre= c1gggre+c1ggzre+c1gzgre+ # c2gggre+c2ggzre+c2gzgre tcgie= c1gggie+c1ggzie+c1gzgie+c1gzzie+ # c2gggie+c2ggzie+c2gzgie+c2gzzie tcgi= c1gggi+c1ggzi+c1gzgi+ # c2gggi+c2ggzi+c2gzgi * tchr= c1hggr+c1hgzr+c1hzgr+c1hzzr+ # c2hggr+c2hgzr+c2hzgr+c2hzzr tchre= c1hggre+c1hgzre+c1hzgre+ # c2hggre+c2hgzre+c2hzgre tchie= c1hggie+c1hgzie+c1hzgie+c1hzzie+ # c2hggie+c2hgzie+c2hzgie+c2hzzie tchi= c1hggi+c1hgzi+c1hzgi+ # c2hggi+c2hgzi+c2hzgi * tpar= p1aggr+p1agzr+p1azgr+p1azzr+ # p2aggr+p2agzr+p2azgr+p2azzr+ # p3aggr+p3agzr+p3azgr+p3azzr+ # p4aggr+p4agzr+p4azgr+p4azzr tpare= p1aggre+p1agzre+p1azgre+p1azzre+ # p2aggre+p2agzre+p2azgre+p2azzre+ # p3aggre+p3agzre+p3azgre+p3azzre+ # p4aggre+p4agzre+p4azgre+p4azzre tpaie= p1aggie+p1agzie+p1azgie+p1azzie+ # p2aggie+p2agzie+p2azgie+p2azzie+ # p3aggie+p3agzie+p3azgie+p3azzie+ # p4aggie+p4agzie+p4azgie+p4azzie tpai= p1aggi+p1agzi+p1azgi+p1azzi+ # p2aggi+p2agzi+p2azgi+p2azzi+ # p3aggi+p3agzi+p3azgi+p3azzi+ # p4aggi+p4agzi+p4azgi+p4azzi * tpbr= p1bggr+p1bgzr+p1bzgr+p1bzzr+ # p2bggr+p2bgzr+p2bzgr+p2bzzr+ # p3bggr+p3bgzr+p3bzgr+p3bzzr+ # p4bggr+p4bgzr+p4bzgr+p4bzzr tpbre= p1bggre+p1bgzre+p1bzgre+p1bzzre+ # p2bggre+p2bgzre+p2bzgre+p2bzzre+ # p3bggre+p3bgzre+p3bzgre+p3bzzre+ # p4bggre+p4bgzre+p4bzgre+p4bzzre tpbie= p1bggie+p1bgzie+p1bzgie+p1bzzie+ # p2bggie+p2bgzie+p2bzgie+p2bzzie+ # p3bggie+p3bgzie+p3bzgie+p3bzzie+ # p4bggie+p4bgzie+p4bzgie+p4bzzie tpbi= p1bggi+p1bgzi+p1bzgi+p1bzzi+ # p2bggi+p2bgzi+p2bzgi+p2bzzi+ # p3bggi+p3bgzi+p3bzgi+p3bzzi+ # p4bggi+p4bgzi+p4bzgi+p4bzzi * tpcr= p1cggr+p1cgzr+p1czgr+p1czzr+ # p2cggr+p2cgzr+p2czgr+p2czzr+ # p3cggr+p3cgzr+p3czgr+p3czzr+ # p4cggr+p4cgzr+p4czgr+p4czzr tpcre= p1cggre+p1cgzre+p1czgre+p1czzre+ # p2cggre+p2cgzre+p2czgre+p2czzre+ # p3cggre+p3cgzre+p3czgre+p3czzre+ # p4cggre+p4cgzre+p4czgre+p4czzre tpcie= p1cggie+p1cgzie+p1czgie+p1czzie+ # p2cggie+p2cgzie+p2czgie+p2czzie+ # p3cggie+p3cgzie+p3czgie+p3czzie+ # p4cggie+p4cgzie+p4czgie+p4czzie tpci= p1cggi+p1cgzi+p1czgi+p1czzi+ # p2cggi+p2cgzi+p2czgi+p2czzi+ # p3cggi+p3cgzi+p3czgi+p3czzi+ # p4cggi+p4cgzi+p4czgi+p4czzi * tpdr= p1dggr+p1dgzr+p1dzgr+p1dzzr+ # p2dggr+p2dgzr+p2dzgr+p2dzzr+ # p3dggr+p3dgzr+p3dzgr+p3dzzr+ # p4dggr+p4dgzr+p4dzgr+p4dzzr tpdre= p1dggre+p1dgzre+p1dzgre+p1dzzre+ # p2dggre+p2dgzre+p2dzgre+p2dzzre+ # p3dggre+p3dgzre+p3dzgre+p3dzzre+ # p4dggre+p4dgzre+p4dzgre+p4dzzre tpdie= p1dggie+p1dgzie+p1dzgie+p1dzzie+ # p2dggie+p2dgzie+p2dzgie+p2dzzie+ # p3dggie+p3dgzie+p3dzgie+p3dzzie+ # p4dggie+p4dgzie+p4dzgie+p4dzzie tpdi= p1dggi+p1dgzi+p1dzgi+p1dzzi+ # p2dggi+p2dgzi+p2dzgi+p2dzzi+ # p3dggi+p3dgzi+p3dzgi+p3dzzi+ # p4dggi+p4dgzi+p4dzgi+p4dzzi * tper= p1eggr+p1egzr+p1ezgr+p1ezzr+ # p2eggr+p2egzr+p2ezgr+p2ezzr+ # p3eggr+p3egzr+p3ezgr+p3ezzr+ # p4eggr+p4egzr+p4ezgr+p4ezzr tpere= p1eggre+p1egzre+p1ezgre+p1ezzre+ # p2eggre+p2egzre+p2ezgre+p2ezzre+ # p3eggre+p3egzre+p3ezgre+p3ezzre+ # p4eggre+p4egzre+p4ezgre+p4ezzre tpeie= p1eggie+p1egzie+p1ezgie+p1ezzie+ # p2eggie+p2egzie+p2ezgie+p2ezzie+ # p3eggie+p3egzie+p3ezgie+p3ezzie+ # p4eggie+p4egzie+p4ezgie+p4ezzie tpei= p1eggi+p1egzi+p1ezgi+p1ezzi+ # p2eggi+p2egzi+p2ezgi+p2ezzi+ # p3eggi+p3egzi+p3ezgi+p3ezzi+ # p4eggi+p4egzi+p4ezgi+p4ezzi * tpfr= p1fggr+p1fgzr+p1fzgr+p1fzzr+ # p2fggr+p2fgzr+p2fzgr+p2fzzr+ # p3fggr+p3fgzr+p3fzgr+p3fzzr+ # p4fggr+p4fgzr+p4fzgr+p4fzzr tpfre= p1fggre+p1fgzre+p1fzgre+p1fzzre+ # p2fggre+p2fgzre+p2fzgre+p2fzzre+ # p3fggre+p3fgzre+p3fzgre+p3fzzre+ # p4fggre+p4fgzre+p4fzgre+p4fzzre tpfie= p1fggie+p1fgzie+p1fzgie+p1fzzie+ # p2fggie+p2fgzie+p2fzgie+p2fzzie+ # p3fggie+p3fgzie+p3fzgie+p3fzzie+ # p4fggie+p4fgzie+p4fzgie+p4fzzie tpfi= p1fggi+p1fgzi+p1fzgi+p1fzzi+ # p2fggi+p2fgzi+p2fzgi+p2fzzi+ # p3fggi+p3fgzi+p3fzgi+p3fzzi+ # p4fggi+p4fgzi+p4fzgi+p4fzzi * tpgr= p1gggr+p1ggzr+p1gzgr+p1gzzr+ # p2gggr+p2ggzr+p2gzgr+p2gzzr+ # p3gggr+p3ggzr+p3gzgr+p3gzzr+ # p4gggr+p4ggzr+p4gzgr+p4gzzr tpgre= p1gggre+p1ggzre+p1gzgre+p1gzzre+ # p2gggre+p2ggzre+p2gzgre+p2gzzre+ # p3gggre+p3ggzre+p3gzgre+p3gzzre+ # p4gggre+p4ggzre+p4gzgre+p4gzzre tpgie= p1gggie+p1ggzie+p1gzgie+p1gzzie+ # p2gggie+p2ggzie+p2gzgie+p2gzzie+ # p3gggie+p3ggzie+p3gzgie+p3gzzie+ # p4gggie+p4ggzie+p4gzgie+p4gzzie tpgi= p1gggi+p1ggzi+p1gzgi+p1gzzi+ # p2gggi+p2ggzi+p2gzgi+p2gzzi+ # p3gggi+p3ggzi+p3gzgi+p3gzzi+ # p4gggi+p4ggzi+p4gzgi+p4gzzi * tphr= p1hggr+p1hgzr+p1hzgr+p1hzzr+ # p2hggr+p2hgzr+p2hzgr+p2hzzr+ # p3hggr+p3hgzr+p3hzgr+p3hzzr+ # p4hggr+p4hgzr+p4hzgr+p4hzzr tphre= p1hggre+p1hgzre+p1hzgre+p1hzzre+ # p2hggre+p2hgzre+p2hzgre+p2hzzre+ # p3hggre+p3hgzre+p3hzgre+p3hzzre+ # p4hggre+p4hgzre+p4hzgre+p4hzzre tphie= p1hggie+p1hgzie+p1hzgie+p1hzzie+ # p2hggie+p2hgzie+p2hzgie+p2hzzie+ # p3hggie+p3hgzie+p3hzgie+p3hzzie+ # p4hggie+p4hgzie+p4hzgie+p4hzzie tphi= p1hggi+p1hgzi+p1hzgi+p1hzzi+ # p2hggi+p2hgzi+p2hzgi+p2hzzi+ # p3hggi+p3hgzi+p3hzgi+p3hzzi+ # p4hggi+p4hgzi+p4hzgi+p4hzzi * dasr= tcar+tpar dasre= tcare+tpare dasie= tcaie+tpaie dasi= tcai+tpai * dbsr= tcbr+tpbr dbsre= tcbre+tpbre dbsie= tcbie+tpbie dbsi= tcbi+tpbi * dcsr= tccr+tpcr-ehcr dcsre= tccre+tpcre-ehcre dcsie= tccie+tpcie-ehcie dcsi= tcci+tpci-ehci * d19dr= b1dr+b2dr+b3dgr+b3dzr+b4dgr+ # b4dzr+rmdr+fdgr+fdzr d19dre= b1dre+b2dre+b3dgre+b3dzre+b4dgre+ # b4dzre+rmdre+fdgre+fdzre d19die= b1die+b2die+b3dgie+b3dzie+b4dgie+ # b4dzie+rmdie+fdgie+fdzie d19di= b1di+b2di+b3dgi+b3dzi+b4dgi+ # b4dzi+rmdi+fdgi+fdzi ddsr= tcdr+tpdr-d19dr-ehdr ddsre= tcdre+tpdre-d19dre-ehdre ddsie= tcdie+tpdie-d19die-ehdie ddsi= tcdi+tpdi-d19di-ehdi * desr= tcer+tper-eher desre= tcere+tpere-ehere desie= tceie+tpeie-eheie desi= tcei+tpei-ehei * d19fr= b1fr+b2fr+b3fgr+b3fzr+b4fgr+ # b4fzr+rmfr+ffgr+ffzr d19fre= b1fre+b2fre+b3fgre+b3fzre+b4fgre+ # b4fzre+rmfre+ffgre+ffzre d19fie= b1fie+b2fie+b3fgie+b3fzie+b4fgie+ # b4fzie+rmfie+ffgie+ffzie d19fi= b1fi+b2fi+b3fgi+b3fzi+b4fgi+ # b4fzi+rmfi+ffgi+ffzi dfsr= tcfr+tpfr-d19fr-ehfr dfsre= tcfre+tpfre-d19fre-ehfre dfsie= tcfie+tpfie-d19fie-ehfie dfsi= tcfi+tpfi-d19fi-ehfi * dgsr= tcgr+tpgr dgsre= tcgre+tpgre dgsie= tcgie+tpgie dgsi= tcgi+tpgi * dhsr= tchr+tphr dhsre= tchre+tphre dhsie= tchie+tphie dhsi= tchi+tphi * disr= ehir disre= ehire disie= ehiie disi= ehii * djsr= ehjr djsre= ehjre djsie= ehjie djsi= ehji * dlsr= ehlr dlsre= ehlre dlsie= ehlie dlsi= ehli * dmsr= ehmr dmsre= ehmre dmsie= ehmie dmsi= ehmi * ddras= tdrar*tdrar+tdraie*tdraie ddrbs= tdrbr*tdrbr+tdrbie*tdrbie ddrcs= tdrcr*tdrcr+tdrcie*tdrcie ddrds= tdrdr*tdrdr+tdrdie*tdrdie ddres= tdrer*tdrer+tdreie*tdreie ddrfs= tdrfr*tdrfr+tdrfie*tdrfie ddrgs= tdrgr*tdrgr+tdrgie*tdrgie ddrhs= tdrhr*tdrhr+tdrhie*tdrhie * das= dasr*dasr+dasre*dasre+ # dasi*dasi+dasie*dasie dbs= dbsr*dbsr+dbsre*dbsre+ # dbsi*dbsi+dbsie*dbsie dcs= dcsr*dcsr+dcsre*dcsre+ # dcsi*dcsi+dcsie*dcsie dds= ddsr*ddsr+ddsre*ddsre+ # ddsi*ddsi+ddsie*ddsie des= desr*desr+desre*desre+ # desi*desi+desie*desie dfs= dfsr*dfsr+dfsre*dfsre+ # dfsi*dfsi+dfsie*dfsie dgs= dgsr*dgsr+dgsre*dgsre+ # dgsi*dgsi+dgsie*dgsie dhs= dhsr*dhsr+dhsre*dhsre+ # dhsi*dhsi+dhsie*dhsie dis= disr*disr+disre*disre+ # disi*disi+disie*disie djs= djsr*djsr+djsre*djsre+ # djsi*djsi+djsie*djsie dls= dlsr*dlsr+dlsre*dlsre+ # dlsi*dlsi+dlsie*dlsie dms= dmsr*dmsr+dmsre*dmsre+ # dmsi*dmsi+dmsie*dmsie * if(oqcd.eq.'y'.and.iqcd.eq.0) then das= das+qcdjac*ddras dbs= dbs+qcdjac*ddrbs dcs= dcs+qcdjac*ddrcs dds= dds+qcdjac*ddrds des= des+qcdjac*ddres dfs= dfs+qcdjac*ddrfs dgs= dgs+qcdjac*ddrgs dhs= dhs+qcdjac*ddrhs endif * 4 if(iz.eq.0) then do i=1,12 dpxs(ix,it,itt,i)= 0.d0 enddo iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc*pmjac*ppjac*vv if(oqcd.eq.'y'.and.iqcd.gt.0) then tjac= tjac*(1.d0+qcdjac) endif tjacp= tjac*stf dpxs(ix,it,itt,1)= tjacp*das/s dpxs(ix,it,itt,2)= tjacp*dbs/s dpxs(ix,it,itt,3)= tjacp*dcs/s dpxs(ix,it,itt,4)= tjacp*dds/s dpxs(ix,it,itt,5)= tjacp*des/s dpxs(ix,it,itt,6)= tjacp*dfs/s dpxs(ix,it,itt,7)= tjacp*dgs/s dpxs(ix,it,itt,8)= tjacp*dhs/s if(otype.eq.'nc48'.or. # otype.eq.'nc50' ) then dpxs(ix,it,itt,9)= tjacp*dis/s dpxs(ix,it,itt,10)= tjacp*djs/s dpxs(ix,it,itt,11)= tjacp*dls/s dpxs(ix,it,itt,12)= tjacp*dms/s else dpxs(ix,it,itt,9)= 0.d0 dpxs(ix,it,itt,10)= 0.d0 dpxs(ix,it,itt,11)= 0.d0 dpxs(ix,it,itt,12)= 0.d0 endif endif * *-----end of ix loop * enddo * 5 if(iz.eq.0) then do i=1,12 do ix=1,2 epxs(ix,it,itt,i)= 0.d0 enddo enddo iz= 1 else do i=1,12 do ix=1,2 epxs(ix,it,itt,i)= dpxs(ix,it,itt,i) enddo enddo endif * *-----end of itt loop * enddo * do i=1,12 cpxs(it,i)= 0.d0 do itt=1,ittm cpxs(it,i)= cpxs(it,i)+epxs(1,it,itt,i)+ # epxs(2,it,itt,i) enddo enddo * 2 if(iz.eq.0) then do i=1,12 bpxs(it,i)= 0.d0 enddo iz= 1 else do i=1,12 bpxs(it,i)= cpxs(it,i) enddo endif * *-----end on it loop * enddo 1 if(iz.eq.0) then do i=1,12 apxs(i)= 0.d0 enddo iz= 1 else do i=1,12 apxs(i)= bpxs(1,i)+bpxs(2,i) enddo endif * apxst= 0.d0 do i=1,12 apxst= apxst+apxs(i) enddo if(apxst.lt.0.d0) then ifz(41)= ifz(41)+1 resf= 0.d0 else resf= apxst endif * wtoxsn= 256.d0*tfact*resf * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(wtoxsn.gt.xshmx(jp)) then xshmx(jp)= wtoxsn do l=1,9 xmxh(jp,l)= x(l) enddo endif endif xaph(1)= xm xaph(2)= xp xaph(3)= sm xaph(4)= sp xaph(5)= su xaph(6)= sd xaph(7)= sf xaph(8)= tw xaph(9)= t1 xaph(10)= t3 endif * return end * *-----WTOXSNG---------------------------------------------------------- * real*8 function wtoxsng(ndim,x) implicit real*8 (a-h,o-z) * character*1,oqcd,om,osm character*4,otype * parameter(ninv=10,npos=512) * common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wtkount/ik common/wtsmod/osm common/wtdis/dist common/wtistrf/isf common/wtcqcd/iqcd common/wtlmsb/qcdl common/wtaqcd/oqcd common/wtqcdz/alsz common/wtsf/ix0,it0 common/wtchi/hch(36) common/wtipt/ifz(44) common/wticuts/iac(4) common/wtisa/isaa,isab common/wthx/xshmx(npos) common/wtochannel/otype common/wtparh/xaph(ninv) common/wttc/itc,itcc,itcn common/wtpmxh/xmxh(npos,9) common/wtncc/chf2,chfp2,conc(10) common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmy common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw, # eta,feta,beta,g2,tfacth common/wtapar/ars,s,rwm,rwm2,rwg,rwmg,swg,swgs,opswgs,sth2,cth2, # hsth2,tsth2,scth2,asth2,tth2,rzm,rzm2,rzg,rzmg,szg, # szgs,opszgs,sth4,cth4,ve,vf,vfp,rbqm2,rszw,rszw2, # s0w,s0z common/wtsubreg/dsm,usm,dsp,usp,rl(6),rr(6),srl(6),sdsm,sdsp,vvl1, # vvl2,vvl3,ul,omul,suml common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6), # ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4), # sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24, # cg24,sg34,cg34,sct120,sct130,sct140,sct230, # sct240,sct340,sgam(4),cgam(4) * dimension tgn(16) dimension x(ndim) dimension bt1(2),bt2(2) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension dpxs(2,2,2,8),epxs(2,2,2,8),cpxs(2,8),bpxs(2,8), # apxs(8) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) dimension hfr(4),hgr(4),hnr(4),hor(4) * data ec2/-0.4999999963d0/,ec4/0.0416666418d0/, # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, # ec10/-0.0000002605d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf * *-----the order of integration is:5 * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1i * 6 * m_{+/-}^2 transformed for the resonating peaks * M_0^2,m_0^2 transformed for the resonating peaks * m^2 and t_1 transformed for the jacobian peaks * do ix=1,2 do it=1,2 do itt=1,2 do il=1,8 dpxs(ix,it,itt,il)= 0.d0 enddo enddo enddo enddo do it=1,2 do il=1,8 cpxs(it,il)= 0.d0 bpxs(it,il)= 0.d0 enddo enddo if(ndim.eq.6) then if(itc.eq.1) then if(itcc.eq.1) then smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(itcc.eq.2) then smx= x(1) spx= x(2) sux= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(itcc.eq.3) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) twx= x(5) t1x= x(6) endif else smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) endif else if(ndim.eq.8) then if(itc.eq.1) then if(itcc.eq.1) then uvx= x(1) vvx= x(2) smx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(itcc.eq.2) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(itcc.eq.3) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) twx= x(7) t1x= x(8) endif else uvx= x(1) vvx= x(2) smx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) endif else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * if(itc.eq.3) then omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) omul= dmin1(omul,omuld) endif if(uvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * if(itc.eq.3) then vvlld= (dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) vvll= dmax1(vvll,vvlld) endif * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vkf.eq.0.d0) then if(vvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vvx.eq.1.d0) then veps= 0.d0 else veps= uvl*(1.d0-vvx)**hbeti endif avkf= 1.d0 else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti avkf= 1.d0-vkf**hbet endif vv= uv-veps vjc0= 1.d0-vvll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif endif * if(vv.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif svv= sqrt(vv) vzmg= rzmg*vv vvs= vv*vv xm= uv xp= vv/uv xmop= xm/xp if(ndim.eq.7.or.ndim.eq.6) then xdf= 0.d0 else xdf= (ueps*(1.d0-ueps)-veps)/uv endif xdfs= xdf*xdf sh= vv*s * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * dsz0= 1.d0-rszm2 dsz= dsz0*dsz0+rszw2 rsz= dsz0/dsz aisz= -rszw/dsz * *-----Reduced structure functions are computed with arguments xp,xm * opxp= 1.d0+xp opxm= 1.d0+xm omxp= veps/uv omxm= ueps if(isf.eq.0) then stfp= 1.d0 stfm= 1.d0 else if(isf.gt.0) then if(omxp.eq.0) then stfp= d0gl else rcpx= 0.25d0*opxp*opxp rcpy= xp iflp= 1 rclp= s21baf(rcpx,rcpy,iflp) stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+ # feta*(-4.d0*opxp*log(omxp)+ # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp)) endif if(omxm.eq.0) then stfm= d0gl else rcmx= 0.25d0*opxm*opxm rcmy= xm iflm= 1 rclm= s21baf(rcmx,rcmy,iflm) stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ # feta*(-4.d0*opxm*log(omxm)+ # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm)) endif endif * stf= stfp*stfm * *-----if there is no upper cut on some FS IM, then the maximum is allowed * do j=1,6 if(rr(j).eq.1.d0) then rrr(j)= rr(j) else rrr(j)= rr(j)/vv endif rrl(j)= rl(j)/vv srrl(j)= srl(j)/svv enddo * *-----cuts become special near xp = xm * if(abs(xdf).gt.1.d-15) then ieq= 1 bxe= vv/(ueps*(1.d0-ueps)-veps) if(xdf.gt.0.d0) then enc= 1.d0 else if(xdf.lt.0.d0) then enc= xmop endif else ieq= 0 bxe= 1.d0 endif if(ieq.eq.0.and.xm.le.teq) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then sct12= sct120/vv sct13= sct130/vv sct14= sct140/vv sct23= sct230/vv sct24= sct240/vv sct34= sct340/vv else sct12= 0.d0 sct13= 0.d0 sct14= 0.d0 sct23= 0.d0 sct24= 0.d0 sct34= 0.d0 endif * *-----cuts on E * do j=1,4 if(ieq.eq.1) then bl(j)= 2.d0*rae(j)/xdf xbl(j)= 2.d0*rae(j)/xp else if(ieq.eq.0) then bl(j)= 2.d0*rae(j)/xm endif enddo * *-----cuts on SA * if(iac(3).ne.0) then do j=1,4 if(sgam(j).eq.1.d0) then ss(j)= 0.d0 else ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmop ss(j)= 1.d0/ss(j) endif if(cgam(j).eq.0.d0) then cs(j)= 1.d0 else cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop cs(j)= 1.d0/cs(j) endif enddo endif * *-----initialization of sm = m_-^2 * zma1= dsm zma2= vv*sct12 zmb1= usm zmb2= (svv-sdsp)*(svv-sdsp) zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) if(ieq.eq.0) then zma3= vv*(bl(1)+bl(2)-1.d0) zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))* # (1.d0-0.5d0*(bl(3)+bl(4))) zmb5= vv*(1.d0-bl(3)) zmb6= vv*(1.d0-bl(4)) else if(ieq.eq.1) then zma3= vv*(-enc+xbl(1)+xbl(2)) zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))* # (1.d0+enc-xbl(3)-xbl(4)) zmb5= vv*(enc-xbl(3)) zmb6= vv*(enc-xbl(4)) endif xzma= dmax1(zma1,zma2,zma3) xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) * *-----limits on sm from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zma= xzma zmb= xzmb else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then szma= xzma szmb= xzmb else if(ss(3).gt.ss(1)) then szmb= xzmb adsp= dsp/vv axszma= dmax1(adsp,sct34) axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/ # (ss(3)-ss(1))) szma= dmax1(axszma,xzma) else if(ss(3).lt.ss(1)) then if(ss(3).lt.0.5d0) then szma= xzma axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 szmb= dmin1(axszmb,xzmb) else iz= 0 ifz(2)= ifz(2)+1 go to 1 endif endif else szma= xzma szmb= xzmb endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zma= szma zmb= szmb else if(cs(3).gt.cs(1)) then if(cs(3).gt.0.5d0) then zma= szma axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2 zmb= dmin1(axczmb,szmb) else iz= 0 ifz(3)= ifz(3)+1 go to 1 endif else if(cs(3).lt.cs(1)) then zmb= szmb adsp= dsp/vv axczma= dmax1(adsp,sct34) axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/ # (cs(3)-cs(1))) zma= dmax1(axczma,szma) endif else zma= szma zmb= szmb endif endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.eq.2)) then dzpa= dmax1(dsp,sct340) if(itc.eq.1) then dzmb= (dist/rs-sqrt(dzpa))*(dist/rs-sqrt(dzpa)) zmb= dmin1(zmb,dzmb) else if(itc.eq.2) then dzma= (dist/rs+sqrt(dzpa))*(dist/rs+sqrt(dzpa)) zma= dmax1(zma,dzma) dzmb= 0.25d0*(svv+dist/rs)*(svv+dist/rs) zmb= dmin1(zmb,dzmb) else if(itc.eq.3) then dzmb= (svv-dist/rs)*(svv-dist/rs) zmb= dmin1(zmb,dzmb) endif endif if(itc.eq.1.and.itcc.eq.3) then zmbd3= vv-0.5d0*dist*dist/s zmb= dmin1(zmb,zmbd3) endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * smjc0= zmb-zma sm= (smjc0*smx+zma)/vv smjc= smjc0/vv if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) * 300 format(/' Unsuccesful call to S07AAF ') * *-----initialization of sp = m_+^2 * zpa1= dsp zpb1= usp zpb2= vv*(1.d0-ssm)*(1.d0-ssm) * *-----limits on sp from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zpb= dmin1(zpb1,zpb2) zpa= zpa1 else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then azpb= dmin1(zpb1,zpb2) azpa= zpa1 else if(ss(3).gt.ss(1)) then zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpb= dmin1(zpb1,zpb2,zpb3) azpa= zpa1 else if(ss(3).lt.ss(1)) then azpb= dmin1(zpb1,zpb2) zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpa= dmax1(zpa1,zpa2) endif else azpa= zpa1 azpb= dmin1(zpb1,zpb2) endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zpa= azpa zpb= azpb else if(cs(3).gt.cs(1)) then zpb= azpb bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpa= dmax1(azpa,bzpa) else if(cs(3).lt.cs(1)) then zpa= azpa bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpb= dmin1(azpb,bzpb) endif else zpa= azpa zpb= azpb endif endif * if(ieq.eq.0) then zpel= vv*(-1.d0+bl(3)+bl(4)+sm) zpeu1= vv*(1.d0-bl(1)-bl(2)+sm) zpeu2= vv*(1.d0-bl(1)) zpeu3= vv*(1.d0-bl(2)) else if(ieq.eq.1) then zpel= vv*(sm-enc+xbl(3)+xbl(4)) zpeu1= vv*(sm+enc-xbl(1)-xbl(2)) zpeu2= vv*(enc-xbl(1)) zpeu3= vv*(enc-xbl(2)) endif zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) zpap= vv*sct34 zpa= dmax1(zpa,zpap) if(itc.eq.1.and.itcc.eq.3) then zpbd3= vv*(1.d0-sm)-0.5d0*dist*dist/s zpb= dmin1(zpb,zpbd3) endif * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+10 go to 1 endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.gt.1.and.itc.lt.3)) then bdistl= (dist/rs-svv*ssm)*(dist/rs-svv*ssm)-zpa bdistu= zpb-(dist/rs-svv*ssm)*(dist/rs-svv*ssm) if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif else if(itc.eq.3) then bdistl= dist*dist/s-zpa bdistu= zpb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.gt.1.and.itc.lt.3)) then sp= (dist/rs/svv-ssm)*(dist/rs/svv-ssm) spjc= 2.d0*abs((dist/rs-svv*ssm))/vv/ars else if(itc.eq.3) then sp= (dist/rs/svv)**2 spjc= 2.d0*dist/vv/s else * spjc0= zpb-zpa sp= (spjc0*spx+zpa)/vv spjc= spjc0/vv endif * if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spmm= sp-sm smmp= sm-sp * if(oqcd.eq.'y') then if(iqcd.eq.1) then qcdjac= (1.d0+0.5d0*alsz/pi*(fcun-1.d0))* # (1.d0+0.5d0*alsz/pi*(fcdn-1.d0))-1.d0 fggp= pi*als/g2/chf/chfp/sth2 fggm= pi*als/g2/chf/chfp/sth2 else if(iqcd.eq.2) then nf= 5 scalp= sqrt(vv)*ssp*ars scalm= sqrt(vv)*ssm*ars alsp= wtorals(qcdl,scalp,nf) alsm= wtorals(qcdl,scalm,nf) qcdjac= (1.d0+0.5d0*alsp/pi*(fcun-1.d0))* # (1.d0+0.5d0*alsm/pi*(fcdn-1.d0))-1.d0 fggp= pi*alsp/g2/chf/chfp/sth2 fggm= pi*alsm/g2/chf/chfp/sth2 endif else fggp= pi*als/g2/chf/chfp/sth2 fggm= pi*als/g2/chf/chfp/sth2 qcdjac= 0.d0 endif * cbw= -1.d0+sp-sm ifcr= 0 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(bt1(2).ne.0.d0) then iz= 0 ifz(6)= ifz(6)+1 go to 1 endif * smtp= sm*sp ssmpp= ssm+ssp ssmmp= ssm-ssp asup= 1.d0-ssmpp*ssmpp asum= 1.d0-ssmmp*ssmmp if(asup.lt.0.d0.or.asum.lt.0.d0) then iz= 0 ifz(7)= ifz(7)+1 go to 1 endif rasup= sqrt(asup) rasum= sqrt(asum) * *-----initialization of su = M_0^2 * *-----limits on su from cuts on FS IM * sulim= rrl(4) suuim1= rrr(4) suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) suuim= dmin1(suuim1,suuim2) * *-----limits on su from Delta_- > 0 (as derived from consistency * on sd limits) * suud1= 0.25d0*(rasup+rasum)*(rasup+rasum) suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup) * sul= sulim sul= dmax1(sul,sct23) if(ieq.eq.0) then sul1= bl(2)+bl(3)-1.d0 suu1= 1.d0-sp-bl(1) suu2= 1.d0-sm-bl(4) suu3= (1.d0-0.5d0*(bl(1)+bl(4)))* # (1.d0-0.5d0*(bl(1)+bl(4))) else if(ieq.eq.1) then sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc suu1= enc-sp-xbl(1) suu2= enc-sm-xbl(4) suu3= (enc-0.5d0*(xbl(1)+xbl(4)))* # (enc-0.5d0*(xbl(1)+xbl(4))) endif sul= dmax1(sul,sul1) suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) sdlim= rrl(3) * if(itc.eq.1.and.itcc.eq.2) then dsdl= dmax1(sdlim,sct140) dsuu= (dist/svv/rs-sqrt(dsdl))*(dist/svv/rs-sqrt(dsdl)) suu= dmin1(suu,dsuu) endif if(itc.eq.1.and.itcc.eq.3) then suud3= 1.d0-sm-sp-0.5d0*dist*dist/vv/s suu= dmin1(suu,suud3) endif * *-----test on su * if(suu.le.sul) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif * sujc= suu-sul su= sujc*sux+sul if(su.lt.0.d0) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * sdlim= rrl(3) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim= dmin1(sduim1,sduim2) * *-----limits on sd from Delta_- > 0 * if(ssu.gt.rasup) then sdld= (ssu-rasup)*(ssu-rasup) else sdld= sdlim endif sdud1= (ssu+rasup)*(ssu+rasup) sdud2= (-ssu+rasum)*(-ssu+rasum) sdud= dmin1(sdud1,sdud2) * *-----limits on sd from cuts on SA. Here for maximum security. Rare * if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then if(ss(2).eq.ss(1)) then asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) else if(ss(1).gt.ss(2)) then sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdu= dmin1(sduim,sdud,sdusa) asdl= dmax1(sdlim,sdld) else if(ss(1).lt.ss(2)) then asdu= dmin1(sduim,sdud) sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdl= dmax1(sdlim,sdld,sdlsa) endif else asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) endif if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then if(cs(2).eq.cs(1)) then sdl= asdl sdu= asdu else if(cs(1).gt.cs(2)) then sdu= asdu sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdl= dmax1(asdl,sdlsb) else if(cs(1).lt.cs(2)) then sdl= asdl sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdu= dmin1(asdu,sdusb) endif else sdl= asdl sdu= asdu endif * if(ieq.eq.0) then sdenl= -1.d0+bl(1)+bl(4)+su sdenu1= 1.d0-sp-bl(2) sdenu2= 1.d0-sm-bl(3) sdenu3= 1.d0-bl(2)-bl(3)+su else if(ieq.eq.1) then sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) sdenu1= enc-sp-xbl(2) sdenu2= enc-sm-xbl(3) sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3) endif sdl= dmax1(sdl,sdenl) sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) sdl= dmax1(sdl,sct14) if(itc.eq.1.and.itcc.eq.3) then sdld3= 1.d0-sm-sp-su-dist*dist/vv/s sdl= dmax1(sdl,sdld3) sdud3= 1.d0-sm-sp-su-0.5d0*dist*dist/vv/s sdu= dmin1(sdu,sdud3) endif * *-----test on sd * if(sdu.le.sdl) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * if(itc.eq.1.and.itcc.eq.2) then bdistl= (dist/rs-svv*ssu)*(dist/rs-svv*ssu)-vv*sdl bdistu= vv*sdu-(dist/rs-svv*ssu)*(dist/rs-svv*ssu) if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif endif * if(itc.eq.1.and.itcc.eq.2) then sd= (dist/rs/svv-ssu)*(dist/rs/svv-ssu) sdjc= 2.d0*abs((dist/rs-svv*ssu))/vv/ars else sdjc= sdu-sdl sd= sdjc*sdx+sdl endif * if(sd.lt.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif ssd= sqrt(sd) sdmu= sd-su sdmus= (1.d0+sdmu)*(1.d0+sdmu) * *-----initialization of sf = m^2 * *-----limits on sf from cuts on FS IM * sflim1= rrl(2) sfuim1= rrr(2) bsg= sm+sp+su+sd ombsg= 1.d0-bsg sflim2= ombsg-rrr(5) sfuim2= ombsg-rrl(5) sflim= dmax1(sflim1,sflim2) sfuim= dmin1(sfuim1,sfuim2) * *-----limits on sf from cuts on SA * tcuts= ss(1)-ss(2)+ss(3)-ss(4) tcutc= cs(1)-cs(2)+cs(3)-cs(4) if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfu= dmin1(sfuim,sfusa,sfusb) asfl= sflim else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa,sflsb) asfu= sfuim else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) endif else asfl= sflim asfu= sfuim endif * if(ieq.eq.0) then asfenl1= bl(1)-sm-sd asfenl2= bl(3)-sp-su asfenu1= 1.d0-bl(2)-sp-sd asfenu2= 1.d0-bl(4)-sm-su else if(ieq.eq.1) then asfenl1= 1.d0-enc-sm-sd+xbl(1) asfenl2= 1.d0-enc-sp-su+xbl(3) asfenu1= enc-sp-sd-xbl(2) asfenu2= enc-sm-su-xbl(4) endif asfl= dmax1(asfl,asfenl1,asfenl2) asfu= dmin1(asfu,asfenu1,asfenu2) aasfu= 1.d0-sm-sp-su-sd-sct24 asfl= dmax1(asfl,sct13) asfu= dmin1(asfu,aasfu) * if(iac(3).ne.0) then if(ss(4).ne.ss(3)) then if(ss(4).gt.ss(3)) then asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfl= dmax1(asfl,asfltw) else if (ss(4).lt.ss(3)) then asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfu= dmin1(asfu,asfutw) endif endif if(cs(1).ne.cs(2)) then if(cs(1).gt.cs(2)) then bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfl= dmax1(asfl,bsfltw) else if(cs(1).lt.cs(2)) then bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfu= dmin1(asfu,bsfutw) endif endif if(cs(4).ne.cs(3)) then if(cs(4).gt.cs(3)) then csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfu= dmin1(asfu,csfutw) else if(cs(4).lt.cs(3)) then csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfl= dmax1(asfl,csfltw) endif endif if(ss(1).ne.ss(2)) then if(ss(1).gt.ss(2)) then dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfu= dmin1(asfu,dsfutw) else if(ss(1).lt.ss(2)) then dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfl= dmax1(asfl,dsfltw) endif endif endif * *-----positivity of R^2 * scp= ssmpp*ssmpp scm= ssmmp*ssmmp snp= (ssu+ssd)*(ssu+ssd) snm= (ssu-ssd)*(ssu-ssd) rlp= ssu*ssd+ssp*ssm rlm= ssu*ssd-ssp*ssm bsgmo= bsg-1.d0 ombsg2= ombsg*ombsg rlps= rlp*rlp rlms= rlm*rlm edelp= ombsg2-4.d0*rlps edelm= ombsg2-4.d0*rlms edeld= 16.d0*ssu*ssd*ssp*ssm * *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2 * then Delta_+ > 0 * *-----control * cnt1= scp+snm cnt2= scm+snp if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif if(edelm.le.0.d0) then etest= edeld+edelp if(etest.gt.0.d0) then edelm= etest else iz= 0 ifz(11)= ifz(11)+1 go to 1 endif endif sedm= sqrt(edelm) ifcr= 0 call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) if(rr1(2).ne.0.d0) then iz= 0 ifz(12)= ifz(12)+1 go to 1 endif ifcr= 0 call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) * cnt3= scp+snp cnt4= scm+snm cbru= -1.d0 ccru= 0.5d0*bsg * *-----R^2 has two real roots and two complex conjugate roots * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then if(bsg.gt.0.5d0) then iel= 1 sflr(1)= rr1(1) sfur(1)= rr2(1) sflr(2)= rr1(1) sfur(2)= rr2(1) else iel= 2 ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sflr(2)= ru2 sfur(1)= ru1 sfur(2)= rr2(1) endif * *-----R^2 has four real rootsz * else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(bsg.gt.0.5d0) then sflr(1)= rr1(1) sflr(2)= rs2(1) sfur(1)= rs1(1) sfur(2)= rr2(1) else ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sfur(1)= dmin1(rs1(1),ru1) sflr(2)= dmax1(rs2(1),ru2) sfur(2)= rr2(1) endif endif * *-----the loop for transforming sf starts here *- if(om.eq.'g') then itmn= it0 itmx= it0 else itmn= 1 itmx= 2 endif do it=itmn,itmx if(sflr(it).ge.asfl) then sfl= sflr(it) else sfl= asfl endif if(sfur(it).le.asfu) then sfu= sfur(it) else sfu= asfu endif * *-----test on sf * if(sfu.le.sfl) then iz= 0 ifz(13)= ifz(13)+1 go to 2 endif * if(itc.eq.1.and.itcc.eq.3) then ittm= 2 else ittm= 1 endif * do itt=1,ittm * if(itc.eq.1.and.itcc.eq.3) then distm= dist/svv/rs sbdist= 2.d0*(1.d0-sm-sp-su-sd)-distm*distm if(sbdist.le.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 5 endif if(itt.eq.1) then bdist= 0.25d0*(distm-sqrt(sbdist))* # (distm-sqrt(sbdist)) else if(itt.eq.2) then bdist= 0.25d0*(distm+sqrt(sbdist))* # (distm+sqrt(sbdist)) endif bdistl= bdist-sfl bdistu= sfu-bdist if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 5 endif sf= bdist ssf= sqrt(sf) pfjc= 2.d0/vv/rs*ssf*(distm-ssf)/sqrt(sbdist) sfjc0= sf*sf+(sm+sp+su+sd-1.d0)*sf+su*sd+sm*sp sfjc= 4.d0*sm*sp*su*sd-sfjc0*sfjc0 if(sfjc.le.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 5 else if(iel.eq.1) then sfjc= 0.5d0*pfjc/sqrt(sfjc) else if(iel.eq.2) then sfjc= pfjc/sqrt(sfjc) endif endif else * *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then er= rs1(1) es= abs(rs1(2)) er1= rr1(1) er2= rr2(1) ek2= edelm/edeld ek= sqrt(ek2) dog= -2.d0/sqrt(edeld) ecpl= (ombsg-2.d0*sfl)/sedm ecpu= (ombsg-2.d0*sfu)/sedm eql= ecpl*ecpl equ= ecpu*ecpu omecpl= 2.d0*(sfl-er1)/sedm es2pl= omecpl*(2.d0-omecpl) erl= 1.d0-ek2*es2pl espl= sqrt(es2pl) opecpu= 2.d0*(er2-sfu)/sedm es2pu= opecpu*(2.d0-opecpu) espu= sqrt(es2pu) eru= 1.d0-ek2*es2pu if(eql.eq.1) then sflt= 0.d0 else ifel= 1 sflt= -dog*espl*s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(14)= ifz(14)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 sfut= -dog*espu*s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(15)= ifz(15)+1 go to 2 endif endif if(iel.eq.1) then if(sfu.le.er) then efac= 0.5d0 sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(16)= ifz(16)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(sfl.ge.er) then efac= 0.5d0 sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(17)= ifz(17)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) else efac= 1.d0 qbar= 0.d0 rbar= 1.d0-ek2 ifel= 1 sfbar= -dog*s21bbf(qbar,rbar,one,ifel) if(ifel.ne.0) then iz= 0 ifz(18)= ifz(18)+1 go to 2 endif if(it.eq.1) then sft= (sfbar-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(19)= ifz(19)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfbar-sflt) else if(it.eq.2) then sft= (sfbar-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(20)= ifz(20)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sfbar-sfut) endif endif else if(iel.eq.2) then efac= 1.d0 if(it.eq.1) then sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(21)= ifz(21)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(it.eq.2) then sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(22)= ifz(22)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) endif endif else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(edelp.le.0.d0) then iz= 0 ifz(23)= ifz(23)+1 go to 2 endif sedp= sqrt(edelp) efac= 1.d0 es1= rs1(1) es2= rs2(1) er1= rr1(1) er2= rr2(1) ssed= sedm+sedp ek= (sedm-sedp)/ssed ek2= ek*ek dog= 2.d0/ssed if(it.eq.1) then es2pl= (er1-sfl)/(sfl-er2)/ek es2pu= (er1-sfu)/(sfu-er2)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu else if(it.eq.2) then es2pl= (sfl-es2)/(sfl-es1)/ek es2pu= (sfu-es2)/(sfu-es1)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu endif if(eql.eq.1.d0) then sflt= 0.d0 else sflt= 2.d0*dog*sqrt(es2pl)* # s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(24)= ifz(24)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then equ= 0.d0 endif sfut= 2.d0*dog*sqrt(es2pu)* # s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(25)= ifz(25)+1 go to 2 endif endif sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= 0.5d0/dog*sft call s21caf(asf,ek2,elsn,elcn,edn,ifel) elsn2= elsn*elsn if(ifel.ne.0) then iz= 0 ifz(26)= ifz(26)+1 go to 2 endif if(it.eq.1) then sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2) else if(it.eq.2) then sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) endif sfjc= efac*(sfut-sflt) endif * endif * *-----auxiliary quantities * sdpf= sd+sf e3= sp+su+sf e4= 1.d0+spmm-e3 e3p4= 1.d0+spmm e1= sm+sdpf e2= 1.d0+smmp-e1 e1p2= 1.d0+smmp e1p3= e1+e3 e1m2= 2.d0*e1-1.d0+spmm ep12= xp*e1*e2 ep1= xp*e1 ep2= xp*e2 ep3= xp*e3 ep4= xp*e4 e1t2= e1*e2 e1t3= e1*e3 e1t4= e1*e4 e2t3= e2*e3 e2t4= e2*e4 e3t4= e3*e4 if((e1p3*e1p3-4.d0*sf).lt.0.d0) then iz= 0 ifz(27)= ifz(27)+1 go to 2 endif skl2= sqrt(e1p3*e1p3-4.d0*sf) if((sdmus-4.d0*sd).lt.0.d0) then iz= 0 ifz(28)= ifz(28)+1 go to 2 endif skl3= sdmus-4.d0*sd skl3= sqrt(skl3) * *-----initialization of t_w * *-----limits on tw from positivity and SA * twlp1= 0.d0 twlp2= smmp twlp3= spmm-1.d0 twlp= dmax1(twlp1,twlp2,twlp3) twup= 1.d0 * *-----limits on tw from cuts on SA * if(iac(3).ne.0) then skl2m= 0.5d0*(e1p3-skl2) skl2p= 0.5d0*(e1p3+skl2) skl3p= -0.5d0*(1.d0+sdmu-skl3) skl3m= -0.5d0*(1.d0+sdmu+skl3) twlsa1= 1.d0-cs(3)*e3-cs(4)*e4 twlsa2= ss(1)*e1+ss(2)*e2 twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m twusa1= 1.d0-ss(3)*e3-ss(4)*e4 twusa2= cs(1)*e1+cs(2)*e2 twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4, # twlsa5,twlsa6) atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, # twusa5,twusa6) else atwl= twlp atwu= twup endif * *-----limits on tw from E * if(ieq.eq.1) then atwle= 1.d0-bxe*e3p4+bl(3)+bl(4) atwue= bxe*e1p2-bl(1)-bl(2) if(xdf.gt.0.d0) then twle= atwle twue= atwue else if(xdf.lt.0.d0) then atwle1= bxe*e1-bl(1) atwle2= bxe*e2-bl(2) atwue1= 1.d0-bxe*e3+bl(3) atwue2= 1.d0-bxe*e4+bl(4) twle= dmax1(atwue,atwle1,atwle2) twue= dmin1(atwle,atwue1,atwue2) endif atwl= dmax1(atwl,twle) atwu= dmin1(atwu,twue) endif * *-----natural limits on tw * atwl= dmax1(atwl,bt1(1)) atwu= dmin1(atwu,bt2(1)) * *-----test on tw * if(atwu.le.atwl) then iz= 0 ifz(29)= ifz(29)+1 go to 2 endif * twjc= atwu-atwl tw= twjc*twx+atwl pn= tw+sp-1.d0 omtw= 1.d0-tw * *-----initialization of t1 * *-----limits on t1 from positivity+SA * t1lp1= 0.d0 t1lp2= pn+sdpf t1up1= tw t1up2= sm+sdpf t1lp= dmax1(t1lp1,t1lp2) t1up= dmin1(t1up1,t1up2) * *-----limits on t1 from cuts on SA * if(iac(3).ne.0) then t1lc1= ss(1)*e1 t1lc2= tw-cs(2)*e2 t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3 t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 t1uc1= cs(1)*e1 t1uc2= tw-ss(2)*e2 t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3)) t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3 t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4 t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6) t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6) at1l= dmax1(t1lp,t1lc) at1u= dmin1(t1up,t1uc) else at1l= t1lp at1u= t1up endif * *-----limits on t1 from E * if(ieq.eq.1) then at1le= tw-bxe*e2+bl(2) at1ue= bxe*e1-bl(1) if(xdf.gt.0.d0) then t1le= at1le t1ue= at1ue else t1le= at1ue t1ue= at1le endif at1l= dmax1(at1l,t1le) at1u= dmin1(at1u,t1ue) endif * *-----positivity of (R')^2 / reality of roots for t3 * rp0= e1p2*e1p2-4.d0*sm if(rp0.lt.0.d0) then iz= 0 ifz(30)= ifz(30)+1 go to 2 endif srp0= sqrt(rp0) rp0e= -rp0 rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 rp1e= 2.d0*rp1 rp2= -(e1*tw-sm)*(e1*tw-sm) ifct= 0 if(rp0e.ne.0.d0) then call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) t1l= dmax1(at1l,ret1(1)) t1u= dmin1(at1u,ret2(1)) else if(rp0e.eq.0.d0) then sret1= -rp2/rp1e if(rp1e.gt.0.d0) then t1l= dmax1(at1l,sret1) t1u= at1u else if(rp1e.lt.0.d0) then t1l= at1l t1u= dmin1(at1u,sret1) endif endif * *-----test on t1 * if(t1u.le.t1l) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif * sr= 1.d0-sm-sp-su-sd-sf * *-----transformation for jacobian * if(rp0e.eq.0.d0) then taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2) taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) t1jc= taut-taul t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e endif if(ret1(1).eq.t1l) then at1tl= -pih/srp0 else bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) ifas= 1 at1tl= -s09aaf(bt1tl,ifas)/srp0 if(ifas.ne.0) print 200 endif if(ret2(1).eq.t1u) then at1tu= pih/srp0 else bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) ifas= 1 at1tu= -s09aaf(bt1tu,ifas)/srp0 if(ifas.ne.0) print 200 endif if((at1tl+at1tu).eq.0.d0) then if(t1x.lt.1.d-3) then arc= pi*t1x arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc else if((1.d0-t1x).lt.1.d-3) then arc= pi*(1.d0-t1x) arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc else carc= cos(pi*t1x) t1= 0.5d0*(ret1(1)+ret2(1))+ # 0.5d0*(ret1(1)-ret2(1))*carc endif t1jc= pi/srp0 else t1tl= dmin1(at1tl,at1tu) t1tu= dmax1(at1tl,at1tu) t1jc= t1tu-t1tl t1t= t1jc*t1x+t1tl t1= (rp1+rpds*sin(srp0*t1t))/rp0 endif t1s= t1*t1 * 200 format(' Unsuccesful call to S09AAF ') * *-----test on t1 from FS A * if(ieq.eq.1.and.iac(4).ne.0.d0) then cnlct1= xp*(xm*sm-ep12*cg12)+xdf* # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1- # xdf*tw)+xdfs*cg12*t1s cnlst1= xp*(ep12*sg12-xm*sm)-xdf* # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ # xdf*tw)-xdfs*sg12*t1s if(cnlct1.lt.0.d0) then iz= 0 ifz(32)= ifz(32)+1 go to 2 else if(cnlst1.lt.0.d0) then iz= 0 ifz(33)= ifz(33)+1 go to 2 endif endif * *-----some vector components * t2= tw-t1 t2s= t2*t2 * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 * *-----equation for xi is solved * e1s= e1*e1 e2s= e2*e2 e3s= e3*e3 e12= e1t2-2.d0*sm e13= e1t3-2.d0*sf e23= e2t3-2.d0*su e12s= e12*e12 e13s= e13*e13 e23s= e23*e23 xia= e1s*e2s-e12s xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ # e2*e12*e13 xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13* # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 xib= 2.d0*xib if(xia.eq.0.d0) then if(xib.eq.0.d0) then iz= 0 ifz(34)= ifz(34)+1 go to 2 endif rtm(1)= -xic/xib rtp(1)= rtm(1) rtm(2)= 0.d0 rtp(2)= 0.d0 ixia= 0 else ixia= 1 ifc0= 0 call c02ajf(xia,xib,xic,rtm,rtp,ifc0) endif if(rtm(2).ne.0.d0) then iz= 0 ifz(35)= ifz(35)+1 go to 2 endif * * *-----xi^+ and xi^- are computed * xip= 0.5d0*(e3-rtp(1)) xim= 0.5d0*(e3-rtm(1)) * *-----each integral becomes a sum of two terms * *-----loop over ix starts here * if(om.eq.'g') then ixmn= ix0 ixmx= ix0 else ixmn= 1 ixmx= 2 endif do ix=ixmn,ixmx * *-----x15 is selected * if(ix.eq.1) then t3= xip else if(ix.eq.2) then t3= xim endif * *-----The two integrands are computed * *-----further auxiliary quantities * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 edn3= ep3-xdf*t3 t4= omtw-t3 edn4= ep4-xdf*t4 * *-----collections of all limits on t3 * *-----from energy (or natural limits) * if(ieq.eq.1) then at3l1= omtw-bxe*e4+bl(4) at3u1= bxe*e3-bl(3) if(xdf.gt.0.d0) then t3l1= at3l1 t3u1= at3u1 else if(xdf.lt.0.d0) then t3l1= at3u1 t3u1= at3l1 endif else t3l1= 0.d0 t3u1= e3 endif * *-----natural limits * t3l2= -t1+0.5d0*(e1p3-skl2) t3u2= -t1+0.5d0*(e1p3+skl2) * t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3) * *-----from positivity on SA * t3l4= 0.d0 t3l5= sm+su+sf-tw t3u4= sp+su+sf t3u5= omtw * *-----from SA * if(iac(3).ne.0) then t3l6= ss(3)*e3 t3u6= cs(3)*e3 t3l7= omtw-cs(4)*e4 t3u7= omtw-ss(4)*e4 t3l= dmax1(t3l1,t3l2,t3l3,t3l4, # t3l5,t3l6,t3l7) t3u= dmin1(t3u1,t3u2,t3u3,t3u4, # t3u5,t3u6,t3u7) else t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5) endif * *-----limits on t3 are imposed * tlimt3= (t3u-t3)*(t3-t3l) if(t3u.lt.t3l) then iz= 0 ifz(36)= ifz(36)+1 go to 4 else if(tlimt3.lt.0.d0) then iz= 0 ifz(36)= ifz(36)+1 go to 4 endif * *-----non linear limits on t3,t4 are imposed * if(iac(4).ne.0.and.ieq.eq.1) then tnl13c= -cg13*edn1*edn3+vv*sf tnl13s= sg13*edn1*edn3-vv*sf tnl23c= -cg23*edn2*edn3+vv*su tnl23s= sg23*edn2*edn3-vv*su tnl14c= -cg14*edn1*edn4+vv*sd tnl14s= sg14*edn1*edn4-vv*sd sres= 1.d0-e1-e3+sf tnl24c= -cg24*edn2*edn4+vv*sres tnl24s= sg24*edn2*edn4-vv*sres tnl34c= -cg34*edn3*edn4+vv*sp tnl34s= sg34*edn3*edn4-vv*sp if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or. # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then iz= 0 ifz(37)= ifz(37)+1 go to 4 endif endif * *-----non linear constraints from FS A in the case xp = xm * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(38)= ifz(38)+1 go to 4 endif endif * *-----all invariants * x13= t1 x14= t2 x15= t3 x16= t4 x23= e1-t1 x24= e2-t2 x25= e3-t3 x26= e4-t4 x34= sm x35= sf x36= sd x45= su x46= 1.d0-e1-e3+sf x56= sp * *-----Control for the normalization of helicities * *-----computes cross-section * *-----born matrix element is calculated at the reduced c.m. energy * *-----propagators for pair production diagrams * pfp= e4-1.d0 pfb= e1-1.d0 pfpb= e3-1.d0 pf= e2-1.d0 * *-----extra propagators * vrwm2= rwm2/vv x25w= x25+vrwm2 x16w= x16+vrwm2 ptww= x16w*x25w pnp= tw-sm * *-----The epsilons are computed in the order * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4), * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4), * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) * x13s= x13*x13 x14s= x14*x14 x15s= x15*x15 x16s= x16*x16 x23s= x23*x23 x24s= x24*x24 x25s= x25*x25 x26s= x26*x26 x34s= x34*x34 x35s= x35*x35 x36s= x36*x36 x45s= x45*x45 x46s= x46*x46 x56s= x56*x56 * ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s-x35s ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+ # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+ # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- # x15s*x34s ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+ # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- # x25s*x34s * e(1)= 1.d0 e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0* # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45- # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35- # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45 e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13* # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+ # x25*x34s * *-----sign of eps_1*eps_i * ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo * if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= ses2 s3= -ses1-ses2 s4= ses3 s5= ses1-ses3 s6= ses2+ses3 s7= ses4 s8= ses1-ses4 s9= ses2+ses4 s10= ses3-ses4 s11= ses5 s12= -ses1-ses5 s13= -ses2+ses5 s14= -ses3-ses5 s15= -ses4-ses5 else ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s-x36s ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+ # x16*x24*x46)-x14s*x26s-x16s*x24s-x46s ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ # x14*x16*x34*x36)-x13s*x46s-x14s*x36s- # x16s*x34s ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- # x26s*x34s e(1)= 1.d0 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23*x34- # x13s*x24*x26-x34*x36 e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13* # x24*x46-x14*x16*x23*x24+x14*(-x23* # x46+2.d0*x24*x36-x26*x34)-x16*x24* # x34+x14s*x23*x26+x34*x46 e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26* # x34)+x13*x16*x24*x34+x13*x34*x46+ # x14*x16*x23*x34+x14*x34*x36-x16* # x34s-x13s*x24*x46-x14s*x23*x36 e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36* # x24s)+x14*(-x23*x24*x36-x23*x26* # x34+x46*x23s)+x16*2.d0*x23*x24*x34- # x23*x34*x46-x24*x34*x36+x26*x34s ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= -ses1-ses2 s3= ses2 s4= -ses1-ses3 s5= ses3 s6= -ses2-ses3 s7= ses1-ses4 s8= ses4 s9= -ses2-ses4 s10= -ses3+ses4 s11= -ses1-ses5 s12= ses5 s13= ses2-ses5 s14= ses3+ses5 s15= ses4+ses5 else ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s- # x35s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s- # x36s ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+ # x16*x25*x56)-x15s*x26s-x16s*x25s- # x56s ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35* # x56+x15*x16*x35*x36)-x13s*x56s- # x15s*x36s-x16s*x35s ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35* # x56+x25*x26*x35*x36)-x23s*x56s- # x25s*x36s-x26s*x35s * e(1)= x13*x14*x23*x25+x13*x15*x23*x24+ # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- # x14*x15*x23s+x14*x23*x35+x15*x23* # x34-x13s*x24*x25-x34*x35 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23* # x34-x13s*x24*x26-x34*x36 e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+ # x13*(-x25*x46+x26*x45)+x14*x15*x23* # x26-x14*x16*x23*x25+x14*(x25*x36-x26* # x35)+x15*(-x23*x46+x24*x36)+x16*(x23* # x45-x24*x35)+x35*x46-x36*x45 e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ # x25*x34)+x13*(x35*x46-x36*x45)-x14* # x15*x23*x36+x14*x16*x23*x35+x15*x34* # x36-x16*x34*x35+x13s*(-x25*x46+x26* # x45) e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* # x36-x24*x26*x35)+x15*(-x23*x24*x36- # x23*x26*x34+x46*x23s)+x16*(x23*x24* # x35+x23*x25*x34-x45*x23s)-x23*x35* # x46+x23*x36*x45-x25*x34*x36+x26*x34* # x35 * ises= 0 do i=1,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= -ses1-ses2 s2= ses1 s3= ses2 s4= -ses1+ses3 s5= -ses2-ses3 s6= ses3 s7= -ses1+ses4 s8= -ses2-ses4 s9= ses4 s10= ses3-ses4 s11= ses1+ses5 s12= ses2-ses5 s13= ses5 s14= -ses3-ses5 s15= -ses4-ses5 else iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif endif * tgn(1)= x15*x24 tgn(2)= x34*x46 tgn(3)= x34/x46 tgn(4)= x24/x15 tgn(5)= x15/x25 tgn(6)= x15*x25 tgn(7)= x14*x25 tgn(8)= x14*x34 tgn(9)= x25*x46 tgn(10)= x25/x46 tgn(11)= x14/x34 tgn(12)= x45/x36 tgn(13)= x14*x24 tgn(14)= x24/x14 tgn(15)= x45*x36 tgn(16)= x14/x25 * itgn= 0 do l=1,16 if(tgn(l).le.0.d0) then itgn= itgn+1 endif enddo if(itgn.ne.0) then iz= 0 ifz(40)= ifz(40)+1 go to 4 endif * gpna= sqrt(x15*x24) gpnb= sqrt(x34*x46) gpnc= sqrt(x34/x46) gpnd= sqrt(x24/x15) gpne= sqrt(x15/x25) gpnf= sqrt(x15*x25) gpng= sqrt(x14*x25) gmna= sqrt(x14*x34) gmnb= sqrt(x25*x46) gmnc= sqrt(x25/x46) gmnd= sqrt(x14/x34) gmne= sqrt(x45/x36) gmnf= sqrt(x14*x24) gmng= sqrt(x24/x14) gmnh= sqrt(x45*x36) gmni= sqrt(x14/x25) * gn1= gpna/gpnb gn2= gpna*gpnc gn3= gpna/gpnc gn4= gpnd/gpnb gn5= 1.d0/gpna/gpnc gn6= 1.d0/gpnd/gpnc gn7= gpnd/gpnc gn8= gpnb/gpna gn9= gpnd*gpnc gn10= gpnb/gpnd gn11= gpna*gpnb gn12= gmnd/gmnb gn13= 1.d0/gmnc/gmna gn14= gmna/gmnb gn15= gmnd/gmnc gn16= 1.d0/gmnd/gmnc gn17= gmna*gmnb gn18= gmnc/gmnd gn19= gmnc/gmna gn20= gmna*gmnc gn21= gmnd*gmnb gn22= gmnd*gmnc gn23= gmnb/gmnd gn24= gmnb/gmna gn25= gpnc/gpnd gn26= 1.d0/gpna/gpnb gn27= gpnc/gpna gn28= 1.d0/gpnd/gpnb gn29= gpne/gmnh gn30= gmne/gpnf gn31= 1.d0/gpnf/gmne gn32= 1.d0/gpnf/gmnh gn33= gpne*gmne gn34= gpne/gmne gn35= gmnh/gpnf gn36= gmnh*gpne gn37= gpnb*gmni gn38= gpnc/gpng gn39= 1.d0/gpng/gpnb gn40= gmne/gmnf gn41= gmng*gmne gn42= 1.d0/gmnf/gmnh gn43= gmng/gmnh gn44= gmne/gmng gn45= 1.d0/gmng/gmnh gn46= gmnf/gmnh gn47= gmnf*gmne gn48= gmnh/gmnf gn49= 1.d0/gmng/gmne gn50= gmng*gmnh gn51= 1.d0/gmnf/gmne gn52= gmnh/gmng gn53= gmnf*gmnh gn54= gmnf/gmne * *-----helicity a-b) * *-----Pair production I: common part * p1abrc= 32.d0*(gn13*x13*x25*(x24-x45)+gn15*x25* # (-x23+x35)+gn16*x25*(x15-1.d0)) p1abic= 128.d0*gn13*x25*(s1-s7) * *-----Pair production II: common part * p2abrc= 16.d0*(gn12*(-x13*x24*x56+x13*x26*x45+ # x14*x23*x56-x14*x25*x36-x14*x26*x35+x15* # x24*x36-x16*x23*x45+x16*x24*x35-x36*x45)+ # gn13*(x13*x24*x56-x13*x25*x46-x13*x26*x45+ # x15*x23*x46-x15*x24*x36-x16*x23*x45+x16* # x24*x35-x35*x46+x36*x45)+gn14*(-x15*x26+ # x16*x25+x56)+gn15*(x13*x25-x15*x23-x23*x56+ # x25*x36+x26*x35+x35)+gn16*(x15*x26+x16*x25- # x56)) p2abic= 64.d0*(s1*gn13*x56-s2*gn15+s5*gn12*x35-s6* # gn16-s7*gn13*x26+s8*gn12*x25-s8*gn13*x25+s10* # gn12*x23-s11*gn12*x16-s13*gn12*x14+s13*gn15- # s14*gn13*x13) * *-----Pair production III: common part * p3abrc= 16.d0*(gn12*(x13*x24*x56-x13*x26*x45-x14* # x23*x56+x14*x25*x36+x14*x26*x35-x15*x24* # x36+x16*x23*x45-x16*x24*x35+x36*x45)+gn14* # (x15*x26-x16*x25-x56)+gn15*(-x13*x25+x15* # x23-2.d0*x23*x45+2.d0*x24*x35-x35)+2.d0* # gn37*x25) p3abic= 64.d0*(s2*gn15-s5*gn12*x35-s8*gn12*x25- # s10*gn12*x23+s11*gn12*x16-2.d0*s11*gn15+ # s13*gn12*x14) * *-----Pair production IV: common part * p4abrc= 32.d0*(gn13*x13*(-x23*x45-x24*x25+ # x24*x35)+gn15*x23*x25+gn16*(x15*x23+ # x25-x35)) p4abic= 128.d0*gn13*((x35-x25)*s1-x23*s7) * *-----helicity c-d) * *-----Pair production I: common part * p1cdrc= 32.d0*(gn3*(x13-x35)+gn6*x23* # (-x14+x45)+gn10*(1.d0-x25)) p1cdic= -128.d0*gn6*(s1+s11) * *-----Pair production II: common part * p2cdrc= 16.d0*(gn1*x24*x36-gn2*x26-gn3* # (x23+x36)+gn4*(-x13*x24*x56+x13* # x26*x45+x14*x23*x56-x14*x25*x36- # x14*x26*x35-x16*x23*x45+x16*x24* # x35+x36*x45)+gn5*(-x13*x25*x46+ # x13*x26*x45-x14*x23*x56+x14*x25* # x36-x14*x26*x35+x16*x23*x45+x35* # x46-x36*x45)+gn6*(x23*x46)+gn7* # (x13*x25+x13*x56-x16*x35-x35)+ # gn8*(-x16*x25+x56)+gn9*(x16*x25- # x56)-gn10*x26) p2cdic= 64.d0*(-s2*gn5*x46+s2*gn7-s4* # gn4*x36+s4*gn5*x36+s6*gn8-s6*gn9- # 2.d0*s7*gn5*x26-s8*gn4*x25+s8*gn5* # x25+s12*gn1-s12*gn6+s15*gn4-s15* # gn5) * *-----Pair production III: common part * p3cdrc= 16.d0*(-gn1*x24*x36+gn2*x26+gn3* # x23+gn4*(x13*x24*x56-x13*x26*x45-x14* # x23*x56+x14*x25*x36+x14*x26*x35+x16* # x23*x45-x16*x24*x35-x36*x45)+gn7*(- # x13*x25+2.d0*x13*x45-2.d0*x14*x35+ # x35)+gn9*(-x16*x25+x56)-2.d0*gn11) p3cdic= 64.d0*(-s2*gn7+s4*gn4*x36+s6*gn9- # 2.d0*s7*gn7+s8*gn4*x25-s12*gn1-s15* # gn4) * *-----Pair production IV: common part * p4cdrc= 32.d0*(-gn3*x13+gn5*x23*(x13* # x45-x14*x35)+gn6*x14*x23+gn8*(- # x13*x25+x35)-gn10) p4cdic= 128.d0*(s1*gn6-s2*gn8-s7*gn5*x23) * *-----helicity e-f) * *-----Pair production I: common part * p1efrc= 32.d0*(-gn48*x45-gn49*x14*x25+ # gn50*x15+gn52*(1.d0+x25)+gn54*x15) p1efic= 128.d0*(gn49-gn48)*s4 * *-----Pair production II: common part * p2efrc= 32.d0*(gn40*(x23*x46-x26*x34)+ # gn41*(x13*x26-x16*x23)-gn48*x46+ # gn50*x16+gn52*x26) p2efic= 128.d0*(s1*gn40*x26+s5*gn40* # x23-s5*gn48) * *-----Pair production III: common part * p3efrc= 32.d0*(gn49*x14*x25-gn52+2.d0* # gn53-gn54*x15) p3efic= -128.d0*s4*gn49 * *-----Pair production IV: common part * p4efrc= 32.d0*(gn40*(-x23*x46+x26*x34)+ # gn41*(-x13*x26+x16*x23)-gn48*x34+ # gn50*x13+gn52*x23) p4efic= 64.d0*(s1*gn42*(x34*x56+2.d0* # x35*x46)-s1*gn43*x56-s2*gn42*x34* # x46-s2*gn43*x46-s4*gn51*x34+2.d0* # s5*gn42*x34*x35-s5*gn43*x35-s6* # gn43*x34-s7*gn43*x26-s8*gn42*x25* # x34+2.d0*s8*gn43*x25-s9*gn43* # x34-s10*gn42*x23*x34+s10*gn43* # x23+s11*gn42*(x16*x34+2.d0*x46)- # s11*gn43*x16+2.d0*s13*gn45*x34- # 2.d0*s13*gn46-2.d0*s14*gn42* # x34+s14*gn43*x13+s15*gn42*x34- # 2.d0*s15*gn43*x13+2.d0*s15*gn45* # x23) * *-----helicity g-h) * *-----Pair production I: common part * p1ghrc= 32.d0*(gn31*x14*x25s-gn34*x24*x25- # gn35*x25+2.d0*gn36*x25) p1ghic= 128.d0*s4*gn31*x25 * *-----Pair production II: common part * p2ghrc= 32.d0*(gn30*(x13*x56-x16*x35)+gn33* # (-x13*x26+x16*x23)+gn35*(x16*x25-x56)+ # gn36*x26) p2ghic= 128.d0*(s2*gn30*x16+s6*gn30*x13-s6* # gn35+s7*gn32*(x16*x25-0.5d0*x25*x26)- # s8*gn29*x25+0.5d0*s8*gn32*x25s+s9*gn32* # x25*(x14-0.5d0*x24)+s10*gn32*x25*(-x13+ # 0.5d0*x23)+0.5d0*s11*gn32*x16*x25-0.5d0* # s12*gn29*x25+0.5d0*s13*gn32*x14*x25- # 0.5d0*s14*gn32*x13*x25) * *-----Pair production III: common part * p3ghrc= 32.d0*(-gn31*x14*x25s+gn34*x24*x25+ # gn35*(x14*x25+x25-x45)+gn36*x24) p3ghic= 128.d0*s4*(gn35-gn31*x25) * *-----Pair production IV: common part * p4ghrc= 32.d0*(gn30*(-x13*x56+x16*x35)+ # gn33*(x13*x26-x16*x23)+gn35*(x13* # x25-x35)+gn36*x23) p4ghic= 128.d0*(-s2*gn30*x16+s2*gn35-s6* # gn30*x13) * *-----complete diagrams, epsilon real and imag parts separated: * * *-----compensating single gluon propagators * gpcfr= sp gmcfr= sm * *-----All PP1-PP2 gamma-gluon * cotggm= conc(6) cp1ggr= cotggm/pfpb*gpcfr*fggm cp2ggr= -cotggm/pfp*gpcfr*fggm * p1aggr= -cp1ggr*p1abrc p1aggie= -cp1ggr*p1abic * p1bggr= -p1aggr p1bggie= p1aggie * p1cggr= -cp1ggr*p1cdrc p1cggie= -cp1ggr*p1cdic * p1dggr= -p1cggr p1dggie= p1cggie * p1eggr= -cp1ggr*p1efrc p1eggie= -cp1ggr*p1efic * p1fggr= -p1eggr p1fggie= p1eggie * p1gggr= -cp1ggr*p1ghrc p1gggie= -cp1ggr*p1ghic * p1hggr= -p1gggr p1hggie= p1gggie * p2aggr= -cp2ggr*p2abrc p2aggie= -cp2ggr*p2abic * p2bggr= -p2aggr p2bggie= p2aggie * p2cggr= -cp2ggr*p2cdrc p2cggie= -cp2ggr*p2cdic * p2dggr= -p2cggr p2dggie= p2cggie * p2eggr= -cp2ggr*p2efrc p2eggie= -cp2ggr*p2efic * p2fggr= -p2eggr p2fggie= p2eggie * p2gggr= -cp2ggr*p2ghrc p2gggie= -cp2ggr*p2ghic * p2hggr= -p2gggr p2hggie= p2gggie * *-----All PP1 Z-gluon * cp1zg= conc(4)/pfpb * do i=1,4 hfr(i)= hch(i+4)*cp1zg*gpcfr*fggm enddo * ap1azgr= hfr(1)*p1abrc ap1azgie= hfr(1)*p1abic p1azgr= ap1azgr*rsz p1azgre= -ap1azgie*aisz p1azgie= ap1azgie*rsz p1azgi= ap1azgr*aisz * ap1bzgr= -hfr(2)*p1abrc ap1bzgie= hfr(2)*p1abic p1bzgr= ap1bzgr*rsz p1bzgre= -ap1bzgie*aisz p1bzgie= ap1bzgie*rsz p1bzgi= ap1bzgr*aisz * ap1czgr= hfr(3)*p1cdrc ap1czgie= hfr(3)*p1cdic p1czgr= ap1czgr*rsz p1czgre= -ap1czgie*aisz p1czgie= ap1czgie*rsz p1czgi= ap1czgr*aisz * ap1dzgr= -hfr(4)*p1cdrc ap1dzgie= hfr(4)*p1cdic p1dzgr= ap1dzgr*rsz p1dzgre= -ap1dzgie*aisz p1dzgie= ap1dzgie*rsz p1dzgi= ap1dzgr*aisz * ap1ezgr= hfr(3)*p1efrc ap1ezgie= hfr(3)*p1efic p1ezgr= ap1ezgr*rsz p1ezgre= -ap1ezgie*aisz p1ezgie= ap1ezgie*rsz p1ezgi= ap1ezgr*aisz * ap1fzgr= -hfr(4)*p1efrc ap1fzgie= hfr(4)*p1efic p1fzgr= ap1fzgr*rsz p1fzgre= -ap1fzgie*aisz p1fzgie= ap1fzgie*rsz p1fzgi= ap1fzgr*aisz * ap1gzgr= hfr(1)*p1ghrc ap1gzgie= hfr(1)*p1ghic p1gzgr= ap1gzgr*rsz p1gzgre= -ap1gzgie*aisz p1gzgie= ap1gzgie*rsz p1gzgi= ap1gzgr*aisz * ap1hzgr= -hfr(2)*p1ghrc ap1hzgie= hfr(2)*p1ghic p1hzgr= ap1hzgr*rsz p1hzgre= -ap1hzgie*aisz p1hzgie= ap1hzgie*rsz p1hzgi= ap1hzgr*aisz * *-----All PP2 Z-gluon * cp2zg= -conc(4)/pfp * do i=1,4 hgr(i)= hch(i+4)*cp2zg*gpcfr*fggm enddo * ap2azgr= hgr(1)*p2abrc ap2azgie= hgr(1)*p2abic p2azgr= ap2azgr*rsz p2azgre= -ap2azgie*aisz p2azgie= ap2azgie*rsz p2azgi= ap2azgr*aisz * ap2bzgr= -hgr(2)*p2abrc ap2bzgie= hgr(2)*p2abic p2bzgr= ap2bzgr*rsz p2bzgre= -ap2bzgie*aisz p2bzgie= ap2bzgie*rsz p2bzgi= ap2bzgr*aisz * ap2czgr= hgr(3)*p2cdrc ap2czgie= hgr(3)*p2cdic p2czgr= ap2czgr*rsz p2czgre= -ap2czgie*aisz p2czgie= ap2czgie*rsz p2czgi= ap2czgr*aisz * ap2dzgr= -hgr(4)*p2cdrc ap2dzgie= hgr(4)*p2cdic p2dzgr= ap2dzgr*rsz p2dzgre= -ap2dzgie*aisz p2dzgie= ap2dzgie*rsz p2dzgi= ap2dzgr*aisz * ap2ezgr= hgr(3)*p2efrc ap2ezgie= hgr(3)*p2efic p2ezgr= ap2ezgr*rsz p2ezgre= -ap2ezgie*aisz p2ezgie= ap2ezgie*rsz p2ezgi= ap2ezgr*aisz * ap2fzgr= -hgr(4)*p2efrc ap2fzgie= hgr(4)*p2efic p2fzgr= ap2fzgr*rsz p2fzgre= -ap2fzgie*aisz p2fzgie= ap2fzgie*rsz p2fzgi= ap2fzgr*aisz * ap2gzgr= hgr(1)*p2ghrc ap2gzgie= hgr(1)*p2ghic p2gzgr= ap2gzgr*rsz p2gzgre= -ap2gzgie*aisz p2gzgie= ap2gzgie*rsz p2gzgi= ap2gzgr*aisz * ap2hzgr= -hgr(2)*p2ghrc ap2hzgie= hgr(2)*p2ghic p2hzgr= ap2hzgr*rsz p2hzgre= -ap2hzgie*aisz p2hzgie= ap2hzgie*rsz p2hzgi= ap2hzgr*aisz * *-----All PP3-PP4 gamma-gluon * cp3ggr= conc(7)/pf*gmcfr*fggp cp4ggr= -conc(7)/pfb*gmcfr*fggp * p3aggr= cp3ggr*p3abrc p3aggie= cp3ggr*p3abic * p3bggr= -p3aggr p3bggie= p3aggie * p3cggr= cp3ggr*p3cdrc p3cggie= cp3ggr*p3cdic * p3dggr= -p3cggr p3dggie= p3cggie * p3eggr= cp3ggr*p3efrc p3eggie= cp3ggr*p3efic * p3fggr= -p3eggr p3fggie= p3eggie * p3gggr= cp3ggr*p3ghrc p3gggie= cp3ggr*p3ghic * p3hggr= -p3gggr p3hggie= p3gggie * p4aggr= cp4ggr*p4abrc p4aggie= cp4ggr*p4abic * p4bggr= -p4aggr p4bggie= p4aggie * p4cggr= cp4ggr*p4cdrc p4cggie= cp4ggr*p4cdic * p4dggr= -p4cggr p4dggie= p4cggie * p4eggr= cp4ggr*p4efrc p4eggie= cp4ggr*p4efic * p4fggr= -p4eggr p4fggie= p4eggie * p4gggr= cp4ggr*p4ghrc p4gggie= cp4ggr*p4ghic * p4hggr= -p4gggr p4hggie= p4gggie * *-----All PP3 Z-gluon * cp3zg= -conc(4)/pf * do i=1,4 hnr(i)= hch(i)*cp3zg*gmcfr*fggp enddo * ap3azgr= hnr(1)*p3abrc ap3azgie= hnr(1)*p3abic p3azgr= ap3azgr*rsz p3azgre= -ap3azgie*aisz p3azgie= ap3azgie*rsz p3azgi= ap3azgr*aisz * ap3bzgr= -hnr(2)*p3abrc ap3bzgie= hnr(2)*p3abic p3bzgr= ap3bzgr*rsz p3bzgre= -ap3bzgie*aisz p3bzgie= ap3bzgie*rsz p3bzgi= ap3bzgr*aisz * ap3czgr= hnr(3)*p3cdrc ap3czgie= hnr(3)*p3cdic p3czgr= ap3czgr*rsz p3czgre= -ap3czgie*aisz p3czgie= ap3czgie*rsz p3czgi= ap3czgr*aisz * ap3dzgr= -hnr(4)*p3cdrc ap3dzgie= hnr(4)*p3cdic p3dzgr= ap3dzgr*rsz p3dzgre= -ap3dzgie*aisz p3dzgie= ap3dzgie*rsz p3dzgi= ap3dzgr*aisz * ap3ezgr= hnr(1)*p3efrc ap3ezgie= hnr(1)*p3efic p3ezgr= ap3ezgr*rsz p3ezgre= -ap3ezgie*aisz p3ezgie= ap3ezgie*rsz p3ezgi= ap3ezgr*aisz * ap3fzgr= -hnr(2)*p3efrc ap3fzgie= hnr(2)*p3efic p3fzgr= ap3fzgr*rsz p3fzgre= -ap3fzgie*aisz p3fzgie= ap3fzgie*rsz p3fzgi= ap3fzgr*aisz * ap3gzgr= hnr(3)*p3ghrc ap3gzgie= hnr(3)*p3ghic p3gzgr= ap3gzgr*rsz p3gzgre= -ap3gzgie*aisz p3gzgie= ap3gzgie*rsz p3gzgi= ap3gzgr*aisz * ap3hzgr= -hnr(4)*p3ghrc ap3hzgie= hnr(4)*p3ghic p3hzgr= ap3hzgr*rsz p3hzgre= -ap3hzgie*aisz p3hzgie= ap3hzgie*rsz p3hzgi= ap3hzgr*aisz * *-----All PP4 Z-gluon * cp4zg= conc(4)/pfb * do i=1,4 hor(i)= hch(i)*cp4zg*gmcfr*fggp enddo * ap4azgr= hor(1)*p4abrc ap4azgie= hor(1)*p4abic p4azgr= ap4azgr*rsz p4azgre= -ap4azgie*aisz p4azgie= ap4azgie*rsz p4azgi= ap4azgr*aisz * ap4bzgr= -hor(2)*p4abrc ap4bzgie= hor(2)*p4abic p4bzgr= ap4bzgr*rsz p4bzgre= -ap4bzgie*aisz p4bzgie= ap4bzgie*rsz p4bzgi= ap4bzgr*aisz * ap4czgr= hor(3)*p4cdrc ap4czgie= hor(3)*p4cdic p4czgr= ap4czgr*rsz p4czgre= -ap4czgie*aisz p4czgie= ap4czgie*rsz p4czgi= ap4czgr*aisz * ap4dzgr= -hor(4)*p4cdrc ap4dzgie= hor(4)*p4cdic p4dzgr= ap4dzgr*rsz p4dzgre= -ap4dzgie*aisz p4dzgie= ap4dzgie*rsz p4dzgi= ap4dzgr*aisz * ap4ezgr= hor(1)*p4efrc ap4ezgie= hor(1)*p4efic p4ezgr= ap4ezgr*rsz p4ezgre= -ap4ezgie*aisz p4ezgie= ap4ezgie*rsz p4ezgi= ap4ezgr*aisz * ap4fzgr= -hor(2)*p4efrc ap4fzgie= hor(2)*p4efic p4fzgr= ap4fzgr*rsz p4fzgre= -ap4fzgie*aisz p4fzgie= ap4fzgie*rsz p4fzgi= ap4fzgr*aisz * ap4gzgr= hor(3)*p4ghrc ap4gzgie= hor(3)*p4ghic p4gzgr= ap4gzgr*rsz p4gzgre= -ap4gzgie*aisz p4gzgie= ap4gzgie*rsz p4gzgi= ap4gzgr*aisz * ap4hzgr= -hor(4)*p4ghrc ap4hzgie= hor(4)*p4ghic p4hzgr= ap4hzgr*rsz p4hzgre= -ap4hzgie*aisz p4hzgie= ap4hzgie*rsz p4hzgi= ap4hzgr*aisz * dasr= p1aggr+p1azgr+p2aggr+p2azgr+ # p3aggr+p3azgr+p4aggr+p4azgr dasi= p1azgi+p2azgi+p3azgi+p4azgi dasre= p1azgre+p2azgre+p3azgre+p4azgre dasie= p1aggie+p1azgie+p2aggie+p2azgie+ # p3aggie+p3azgie+p4aggie+p4azgie * dbsr= p1bggr+p1bzgr+p2bggr+p2bzgr+ # p3bggr+p3bzgr+p4bggr+p4bzgr dbsi= p1bzgi+p2bzgi+p3bzgi+p4bzgi dbsre= p1bzgre+p2bzgre+p3bzgre+p4bzgre dbsie= p1bggie+p1bzgie+p2bggie+p2bzgie+ # p3bggie+p3bzgie+p4bggie+p4bzgie * dcsr= p1cggr+p1czgr+p2cggr+p2czgr+ # p3cggr+p3czgr+p4cggr+p4czgr dcsi= p1czgi+p2czgi+p3czgi+p4czgi dcsre= p1czgre+p2czgre+p3czgre+p4czgre dcsie= p1cggie+p1czgie+p2cggie+p2czgie+ # p3cggie+p3czgie+p4cggie+p4czgie * desr= p1eggr+p1ezgr+p2eggr+p2ezgr+ # p3eggr+p3ezgr+p4eggr+p4ezgr desi= p1ezgi+p2ezgi+p3ezgi+p4ezgi desre= p1ezgre+p2ezgre+p3ezgre+p4ezgre desie= p1eggie+p1ezgie+p2eggie+p2ezgie+ # p3eggie+p3ezgie+p4eggie+p4ezgie * dgsr= p1gggr+p1gzgr+p2gggr+p2gzgr+ # p3gggr+p3gzgr+p4gggr+p4gzgr dgsi= p1gzgi+p2gzgi+p3gzgi+p4gzgi dgsre= p1gzgre+p2gzgre+p3gzgre+p4gzgre dgsie= p1gggie+p1gzgie+p2gggie+p2gzgie+ # p3gggie+p3gzgie+p4gggie+p4gzgie * dhsr= p1hggr+p1hzgr+p2hggr+p2hzgr+ # p3hggr+p3hzgr+p4hggr+p4hzgr dhsi= p1hzgi+p2hzgi+p3hzgi+p4hzgi dhsre= p1hzgre+p2hzgre+p3hzgre+p4hzgre dhsie= p1hggie+p1hzgie+p2hggie+p2hzgie+ # p3hggie+p3hzgie+p4hggie+p4hzgie * ddsr= p1dggr+p1dzgr+p2dggr+p2dzgr+ # p3dggr+p3dzgr+p4dggr+p4dzgr ddsi= p1dzgi+p2dzgi+p3dzgi+p4dzgi ddsre= p1dzgre+p2dzgre+p3dzgre+p4dzgre ddsie= p1dggie+p1dzgie+p2dggie+p2dzgie+ # p3dggie+p3dzgie+p4dggie+p4dzgie * dfsr= p1fggr+p1fzgr+p2fggr+p2fzgr+ # p3fggr+p3fzgr+p4fggr+p4fzgr dfsi= p1fzgi+p2fzgi+p3fzgi+p4fzgi dfsre= p1fzgre+p2fzgre+p3fzgre+p4fzgre dfsie= p1fggie+p1fzgie+p2fggie+p2fzgie+ # p3fggie+p3fzgie+p4fggie+p4fzgie * * das= dasr*dasr+dasre*dasre+ # dasi*dasi+dasie*dasie dbs= dbsr*dbsr+dbsre*dbsre+ # dbsi*dbsi+dbsie*dbsie dcs= dcsr*dcsr+dcsre*dcsre+ # dcsi*dcsi+dcsie*dcsie dds= ddsr*ddsr+ddsre*ddsre+ # ddsi*ddsi+ddsie*ddsie des= desr*desr+desre*desre+ # desi*desi+desie*desie dfs= dfsr*dfsr+dfsre*dfsre+ # dfsi*dfsi+dfsie*dfsie dgs= dgsr*dgsr+dgsre*dgsre+ # dgsi*dgsi+dgsie*dgsie dhs= dhsr*dhsr+dhsre*dhsre+ # dhsi*dhsi+dhsie*dhsie * 4 if(iz.eq.0) then do i=1,8 dpxs(ix,it,itt,i)= 0.d0 enddo iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc/smtp/smtp/vv if(oqcd.eq.'y') then tjac= tjac*(1.d0+qcdjac) endif dpxs(ix,it,itt,1)= tjac*stf*das/s dpxs(ix,it,itt,2)= tjac*stf*dbs/s dpxs(ix,it,itt,3)= tjac*stf*dcs/s dpxs(ix,it,itt,4)= tjac*stf*dds/s dpxs(ix,it,itt,5)= tjac*stf*des/s dpxs(ix,it,itt,6)= tjac*stf*dfs/s dpxs(ix,it,itt,7)= tjac*stf*dgs/s dpxs(ix,it,itt,8)= tjac*stf*dhs/s endif * *-----end of ix loop * enddo * 5 if(iz.eq.0) then do i=1,8 do ix=1,2 epxs(ix,it,itt,i)= 0.d0 enddo enddo iz= 1 else do i=1,8 do ix=1,2 epxs(ix,it,itt,i)= dpxs(ix,it,itt,i) enddo enddo endif * *-----end of itt loop * enddo * do i=1,8 cpxs(it,i)= 0.d0 do itt=1,ittm cpxs(it,i)= cpxs(it,i)+epxs(1,it,itt,i)+ # epxs(2,it,itt,i) enddo enddo * 2 if(iz.eq.0) then do i=1,8 bpxs(it,i)= 0.d0 enddo iz= 1 else do i=1,8 bpxs(it,i)= cpxs(it,i) enddo endif * *-----end on it loop * enddo * 1 if(iz.eq.0) then do i=1,8 apxs(i)= 0.d0 enddo iz= 1 else do i=1,8 apxs(i)= bpxs(1,i)+bpxs(2,i) enddo endif * apxst= 0.d0 do i=1,8 apxst= apxst+apxs(i) enddo if(apxst.lt.0.d0) then ifz(41)= ifz(41)+1 resf= 0.d0 else resf= apxst endif * wtoxsng= 32.d0/9.d0*tfact*resf * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(wtoxsng.gt.xshmx(jp)) then xshmx(jp)= wtoxsng do l=1,9 xmxh(jp,l)= x(l) enddo endif endif xaph(1)= xm xaph(2)= xp xaph(3)= sm xaph(4)= sp xaph(5)= su xaph(6)= sd xaph(7)= sf xaph(8)= tw xaph(9)= t1 xaph(10)= t3 endif * return end * *-----XS35----------------------------------------------------------- * real*8 function wtoxs35(ndim,x) implicit real*8 (a-h,o-z) * character*1,ocoul,opeak,oqcd,opeakn,om,osm,ockm character*2,ofs character*4,otype * parameter(ninv=10,npos=512) * common/wtmod/om common/wtmp/zrm common/wtfs/ofs common/wtii/iint common/wtqcd/als common/wtdis/dist common/wtsmod/osm common/wtps/opeak common/wtkount/ik common/wtckm/ockm common/wtistrf/isf common/wtcqcd/iqcd common/wtaqcd/oqcd common/wtlmsb/qcdl common/wtickm/ickm common/wtqcdz/alsz common/wtpsn/opeakn common/wtcoul/ocoul common/wtsf/ix0,it0 common/wtchi/hch(36) common/wtipt/ifz(44) common/wticuts/iac(4) common/wttopt/ios,iosf common/wtisa/isaa,isab common/wthx/xshmx(npos) common/wtochannel/otype common/wtvckm/vckm(3,3) common/wtparh/xaph(ninv) common/wttc/itc,itcc,itcn common/wtpmxh/xmxh(npos,9) common/wtncc/chf2,chfp2,conc(10) common/wtcclr/vupl,vupr,vdpl,vdpr common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtcchannel/chu,chup,chd,chdp,fcuc,fcdc common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmy common/wtacchannel/omchu,opchu,omchup,opchup,omchdp,opchdp, # omchd,opchd,hchup,hchu,hchdp,hchd common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw, # eta,feta,beta,g2,tfacth common/wtapar/ars,s,rwm,rwm2,rwg,rwmg,swg,swgs,opswgs,sth2,cth2, # hsth2,tsth2,scth2,asth2,tth2,rzm,rzm2,rzg,rzmg,szg, # szgs,opszgs,sth4,cth4,ve,vf,vfp,rbqm2,rszw,rszw2, # s0w,s0z common/wtsubreg/dsm,usm,dsp,usp,rl(6),rr(6),srl(6),sdsm,sdsp,vvl1, # vvl2,vvl3,ul,omul,suml common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6), # ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4), # sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24, # cg24,sg34,cg34,sct120,sct130,sct140,sct230, # sct240,sct340,sgam(4),cgam(4) * dimension x(ndim) dimension bt1(2),bt2(2) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension tgc(15),tgn(16),otgn(16) dimension dpxs(2,2,2,9),epxs(2,2,2,9),cpxs(2,9),bpxs(2,9), # apxs(9) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) dimension har(4),hbr(4),hdr(4),her(4),hfr(4),hgr(4),hhr(8), # hir(8),hlr(4),hmr(4),hnr(4),hor(4),hpr(8),hqr(8), # hapr(4),hbpr(4),hc(8),hcp(8) dimension hai(4),hbi(4),hdi(4),hei(4),hfi(4),hgi(4),hhi(8), # hii(8),hli(4),hmi(4),hni(4),hoi(4),hpi(8),hqi(8), # hapi(4),hbpi(4) * data ec2/-0.4999999963d0/,ec4/0.0416666418d0/, # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, # ec10/-0.0000002605d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf * *-----the order of integration is: * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1 * * m_{+/-}^2 transformed for the resonating peaks * M_0^2,m_0^2 transformed for the resonating peaks * m^2 and t_1 transformed for the jacobian peaks * do ix=1,2 do it=1,2 do itt=1,2 do il=1,9 dpxs(ix,it,itt,il)= 0.d0 enddo enddo enddo enddo do it=1,2 do il=1,9 cpxs(it,il)= 0.d0 bpxs(it,il)= 0.d0 enddo enddo * if(ndim.eq.6) then if(itc.eq.1) then if(itcc.eq.1) then smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(itcc.eq.2) then smx= x(1) spx= x(2) sux= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(itcc.eq.3) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) twx= x(5) t1x= x(6) endif else smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) endif else if(ndim.eq.8) then if(itc.eq.1) then if(itcc.eq.1) then uvx= x(1) vvx= x(2) smx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(itcc.eq.2) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(itcc.eq.3) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) twx= x(7) t1x= x(8) endif else uvx= x(1) vvx= x(2) smx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) endif else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.eq.0.d0) then veps= uvl*(1.d0-vvx)**hbeti else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti endif vv= uv-veps avkf= 1.d0-vkf**hbet vjc= (1.d0-vvll/uv)**hbet*avkf endif * svv= sqrt(vv) vwmg= rwmg*vv vzmg= rzmg*vv vvs= vv*vv xm= uv xp= vv/uv xmop= xm/xp if(ndim.eq.7.or.ndim.eq.6) then xdf= 0.d0 else xdf= (ueps*(1.d0-ueps)-veps)/uv endif xdfs= xdf*xdf sh= vv*s * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * dz0= 1.d0-rszm2 dz= dz0*dz0+rszw2 rsz= dz0/dz omrz= (-rszm2*dz0+rszw2)/dz aisz= -rszw/dz haisz= scth2*aisz * *-----Reduced structure functions are computed with arguments xp,xm * opxp= 1.d0+xp opxm= 1.d0+xm omxp= veps/uv omxm= ueps if(isf.eq.0) then stfp= 1.d0 stfm= 1.d0 else if(isf.gt.0) then if(omxp.eq.0) then stfp= d0gl else rcpx= 0.25d0*opxp*opxp rcpy= xp iflp= 1 rclp= s21baf(rcpx,rcpy,iflp) stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+ # feta*(-4.d0*opxp*log(omxp)+ # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp)) endif if(omxm.eq.0) then stfm= d0gl else rcmx= 0.25d0*opxm*opxm rcmy= xm iflm= 1 rclm= s21baf(rcmx,rcmy,iflm) stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ # feta*(-4.d0*opxm*log(omxm)+ # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm)) endif endif * stf= stfp*stfm * *-----if there is no upper cut on some FS IM, then the maximum is allowed * do j=1,6 if(rr(j).eq.1.d0) then rrr(j)= rr(j) else rrr(j)= rr(j)/vv endif rrl(j)= rl(j)/vv srrl(j)= srl(j)/svv enddo * *-----cuts become special near xp = xm * if(abs(xdf).gt.1.d-15) then ieq= 1 bxe= vv/(ueps*(1.d0-ueps)-veps) if(xdf.gt.0.d0) then enc= 1.d0 else if(xdf.lt.0.d0) then enc= xmop endif else ieq= 0 bxe= 1.d0 endif if(ieq.eq.0.and.xm.le.teq) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then sct12= sct120/vv sct13= sct130/vv sct14= sct140/vv sct23= sct230/vv sct24= sct240/vv sct34= sct340/vv else sct12= 0.d0 sct13= 0.d0 sct14= 0.d0 sct23= 0.d0 sct24= 0.d0 sct34= 0.d0 endif * *-----cuts on E * do j=1,4 if(ieq.eq.1) then bl(j)= 2.d0*rae(j)/xdf xbl(j)= 2.d0*rae(j)/xp else if(ieq.eq.0) then bl(j)= 2.d0*rae(j)/xm endif enddo * *-----cuts on SA * if(iac(3).ne.0) then do j=1,4 if(sgam(j).eq.1.d0) then ss(j)= 0.d0 else ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmop ss(j)= 1.d0/ss(j) endif if(cgam(j).eq.0.d0) then cs(j)= 1.d0 else cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop cs(j)= 1.d0/cs(j) endif enddo endif * *-----initialization of sm = m_-^2 * zma1= dsm zma2= vv*sct12 zmb1= usm zmb2= (svv-sdsp)*(svv-sdsp) zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) if(ieq.eq.0) then zma3= vv*(bl(1)+bl(2)-1.d0) zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))* # (1.d0-0.5d0*(bl(3)+bl(4))) zmb5= vv*(1.d0-bl(3)) zmb6= vv*(1.d0-bl(4)) else if(ieq.eq.1) then zma3= vv*(-enc+xbl(1)+xbl(2)) zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))* # (1.d0+enc-xbl(3)-xbl(4)) zmb5= vv*(enc-xbl(3)) zmb6= vv*(enc-xbl(4)) endif xzma= dmax1(zma1,zma2,zma3) xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) * *-----limits on sm from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zma= xzma zmb= xzmb else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then szma= xzma szmb= xzmb else if(ss(3).gt.ss(1)) then szmb= xzmb adsp= dsp/vv axszma= dmax1(adsp,sct34) axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/ # (ss(3)-ss(1))) szma= dmax1(axszma,xzma) else if(ss(3).lt.ss(1)) then if(ss(3).lt.0.5d0) then szma= xzma axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 szmb= dmin1(axszmb,xzmb) else iz= 0 ifz(2)= ifz(2)+1 go to 1 endif endif else szma= xzma szmb= xzmb endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zma= szma zmb= szmb else if(cs(3).gt.cs(1)) then if(cs(3).gt.0.5d0) then zma= szma axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2 zmb= dmin1(axczmb,szmb) else iz= 0 ifz(3)= ifz(3)+1 go to 1 endif else if(cs(3).lt.cs(1)) then zmb= szmb adsp= dsp/vv axczma= dmax1(adsp,sct34) axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/ # (cs(3)-cs(1))) zma= dmax1(axczma,szma) endif else zma= szma zmb= szmb endif endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.eq.2)) then dzpa= dmax1(dsp,sct340) if(itc.eq.1) then dzmb= (dist/rs-sqrt(dzpa))*(dist/rs-sqrt(dzpa)) zmb= dmin1(zmb,dzmb) else if(itc.eq.2) then dzma= (dist/rs+sqrt(dzpa))*(dist/rs+sqrt(dzpa)) zma= dmax1(zma,dzma) dzmb= 0.25d0*(svv+dist/rs)*(svv+dist/rs) zmb= dmin1(zmb,dzmb) endif endif if(itc.eq.1.and.itcc.eq.3) then zmbd3= vv-0.5d0*dist*dist/s zmb= dmin1(zmb,zmbd3) endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * if(opeak.eq.'y') then zmas= zma-rwm2 zmbs= zmb-rwm2 atma= (zmas+swgs*zma)/rwmg atmb= (zmbs+swgs*zmb)/rwmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vwmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vwmg smjc0= (-atmb+atma)/vwmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vwmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vwmg smjc0= (-pi+atmb+atma)/vwmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vwmg atmb= atan(atmb) zmbt= atmb/vwmg smjc0= (-pih+atmb+atma)/vwmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vwmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vwmg smjc0= (pi-atmb-atma)/vwmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vwmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vwmg smjc0= (atmb-atma)/vwmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vwmg atmb= atan(atmb) zmbt= atmb/vwmg smjc0= (pih+atmb-atma)/vwmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/vwmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vwmg smjc0= (pih-atmb-atma)/vwmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/vwmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vwmg smjc0= (-pih+atmb-atma)/vwmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/vwmg atmb= atan(atmb) zmbt= atmb/vwmg smjc0= (atmb-atma)/vwmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= vwmg*zmv sm= s0w/vv*(1.d0+swg*s07aaf(atnm,iftn)) if(iftn.ne.0) print 300 pmjac= 1.d0 smjc= vv*smjc0 * else if(opeak.eq.'n') then smjc0= zmb-zma sm= (smjc0*smx+zma)/vv pmjac= 1.d0/((vv*sm-rwm2)**2+(vv*sm*swg)**2) smjc= smjc0 endif if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) * 300 format(/' Unsuccesful call to S07AAF ') * *-----initialization of sp = m_+^2 * zpa1= dsp zpb1= usp zpb2= vv*(1.d0-ssm)*(1.d0-ssm) * *-----limits on sp from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zpb= dmin1(zpb1,zpb2) zpa= zpa1 else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then azpb= dmin1(zpb1,zpb2) azpa= zpa1 else if(ss(3).gt.ss(1)) then zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpb= dmin1(zpb1,zpb2,zpb3) azpa= zpa1 else if(ss(3).lt.ss(1)) then azpb= dmin1(zpb1,zpb2) zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpa= dmax1(zpa1,zpa2) endif else azpa= zpa1 azpb= dmin1(zpb1,zpb2) endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zpa= azpa zpb= azpb else if(cs(3).gt.cs(1)) then zpb= azpb bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpa= dmax1(azpa,bzpa) else if(cs(3).lt.cs(1)) then zpa= azpa bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpb= dmin1(azpb,bzpb) endif else zpa= azpa zpb= azpb endif endif * if(ieq.eq.0) then zpel= vv*(-1.d0+bl(3)+bl(4)+sm) zpeu1= vv*(1.d0-bl(1)-bl(2)+sm) zpeu2= vv*(1.d0-bl(1)) zpeu3= vv*(1.d0-bl(2)) else if(ieq.eq.1) then zpel= vv*(sm-enc+xbl(3)+xbl(4)) zpeu1= vv*(sm+enc-xbl(1)-xbl(2)) zpeu2= vv*(enc-xbl(1)) zpeu3= vv*(enc-xbl(2)) endif zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) zpap= vv*sct34 zpa= dmax1(zpa,zpap) if(itc.eq.1.and.itcc.eq.3) then zpbd3= vv*(1.d0-sm)-0.5d0*dist*dist/s zpb= dmin1(zpb,zpbd3) endif * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.eq.2)) then bdistl= (dist/rs-svv*ssm)*(dist/rs-svv*ssm)-zpa bdistu= zpb-(dist/rs-svv*ssm)*(dist/rs-svv*ssm) if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif endif * if((itc.eq.1.and.itcc.eq.1).or.(itc.eq.2)) then sp= (dist/rs/svv-ssm)*(dist/rs/svv-ssm) ppjac= 2.d0*abs((dist/rs-svv*ssm))/ars/ # ((vv*sp-rwm2)**2+(vv*sp*swg)**2) spjc= 1.d0 else * if(opeak.eq.'y') then zpas= zpa-rwm2 zpbs= zpb-rwm2 atpa= (zpas+swgs*zpa)/rwmg atpb= (zpbs+swgs*zpb)/rwmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vwmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vwmg spjc0= (-atpb+atpa)/vwmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vwmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vwmg spjc0= (-pi+atpb+atpa)/vwmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vwmg atpb= atan(atpb) zpbt= atpb/vwmg spjc0= (-pih+atpb+atpa)/vwmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vwmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vwmg spjc0= (pi-atpb-atpa)/vwmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vwmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vwmg spjc0= (atpb-atpa)/vwmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vwmg atpb= atan(atpb) zpbt= atpb/vwmg spjc0= (pih+atpb-atpa)/vwmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/vwmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vwmg spjc0= (pih-atpb-atpa)/vwmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/vwmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vwmg spjc0= (-pih+atpb-atpa)/vwmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/vwmg atpb= atan(atpb) zpbt= atpb/vwmg spjc0= (atpb-atpa)/vwmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= vwmg*zpv sp= s0w/vv*(1.d0+swg*s07aaf(atnp,iftn)) if(iftn.ne.0) print 300 ppjac= 1.d0 spjc= vv*spjc0 * else if(opeak.eq.'n') then spjc0= zpb-zpa sp= (spjc0*spx+zpa)/vv ppjac= 1.d0/((vv*sp-rwm2)**2+(vv*sp*swg)**2) spjc= spjc0 endif endif * if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spmm= sp-sm smmp= sm-sp * cbw= -1.d0+sp-sm ifcr= 0 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(bt1(2).ne.0.d0) then iz= 0 ifz(6)= ifz(6)+1 go to 1 endif * *-----Coul factors * if(ocoul.eq.'y') then betb= 1.d0-2.d0*(sp+sm)+(sp-sm)*(sp-sm) if(betb.le.0.d0) then iz= 0 ifz(7)= ifz(7)+1 go to 1 endif betb= sqrt(betb) bdel= abs(sp-sm) bmsr= 1.d0-4.d0*rwm2/vv bmsi= 4.d0*rwm*rwg/vv+1.d-20 abm= sqrt(bmsr*bmsr+bmsi*bmsi) bmr= sqrt(0.5d0*(abm+bmsr)) bmi= 0.5d0*bmsi/bmr acoulf= (bmr+bdel)*(bmr+bdel)+bmi*bmi-betb*betb acoulf= 0.5d0*acoulf/betb/bmi acoulf= atan(acoulf) coulf= 0.5d0*alw*pi/betb*(1.d0-2.d0/pi*acoulf) else coulf= 0.d0 endif ssmpp= ssm+ssp ssmmp= ssm-ssp asup= 1.d0-ssmpp*ssmpp asum= 1.d0-ssmmp*ssmmp if(asup.lt.0.d0.or.asum.lt.0.d0) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif rasup= sqrt(asup) rasum= sqrt(asum) * *-----initialization of su = M_0^2 * *-----limits on su from cuts on FS IM * sulim= rrl(4) suuim1= rrr(4) suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) suuim= dmin1(suuim1,suuim2) * *-----limits on su from Delta_- > 0 (as derived from consistency * on sd limits) * suud1= 0.25d0*(rasup+rasum)*(rasup+rasum) suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup) * sul= sulim sul= dmax1(sul,sct23) if(ieq.eq.0) then sul1= bl(2)+bl(3)-1.d0 suu1= 1.d0-sp-bl(1) suu2= 1.d0-sm-bl(4) suu3= (1.d0-0.5d0*(bl(1)+bl(4)))* # (1.d0-0.5d0*(bl(1)+bl(4))) else if(ieq.eq.1) then sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc suu1= enc-sp-xbl(1) suu2= enc-sm-xbl(4) suu3= (enc-0.5d0*(xbl(1)+xbl(4)))* # (enc-0.5d0*(xbl(1)+xbl(4))) endif sul= dmax1(sul,sul1) suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) * sdlim= rrl(3) if(itc.eq.1.and.itcc.eq.2) then dsdl= dmax1(sdlim,sct140) dsuu= (dist/svv/rs-sqrt(dsdl))*(dist/svv/rs-sqrt(dsdl)) suu= dmin1(suu,dsuu) endif if(itc.eq.1.and.itcc.eq.3) then suud3= 1.d0-sm-sp-0.5d0*dist*dist/vv/s suu= dmin1(suu,suud3) endif * *-----test on su * if(suu.le.sul) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * if(opeakn.eq.'y') then zuas= vv*sul-rzm2 zubs= vv*suu-rzm2 atua= (zuas+vv*szgs*sul)/rzmg atub= (zubs+vv*szgs*suu)/rzmg if(atua.gt.1.d0.and.atub.gt.1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vzmg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vzmg sujc0= (-atub+atua)/vzmg else if(atua.gt.1.d0.and.atub.lt.-1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vzmg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vzmg sujc0= (-pi+atub+atua)/vzmg else if(atua.gt.1.d0.and.abs(atub).lt.1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vzmg atub= atan(atub) zubt= atub/vzmg sujc0= (-pih+atub+atua)/vzmg else if(atua.lt.-1.d0.and.atub.gt.1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vzmg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vzmg sujc0= (pi-atub-atua)/vzmg else if(atua.lt.-1.d0.and.atub.lt.-1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vzmg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vzmg sujc0= (atub-atua)/vzmg else if(atua.lt.-1.d0.and.abs(atub).lt.1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vzmg atub= atan(atub) zubt= atub/vzmg sujc0= (pih+atub-atua)/vzmg else if(abs(atua).lt.1.d0.and.atub.gt.1.d0) then atua= atan(atua) zuat= atua/vzmg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vzmg sujc0= (pih-atub-atua)/vzmg else if(abs(atua).lt.1.d0.and.atub.lt.-1.d0) then atua= atan(atua) zuat= atua/vzmg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vzmg sujc0= (-pih+atub-atua)/vzmg else if(abs(atua).lt.1.d0.and.abs(atub).lt.1.d0) then atua= atan(atua) zuat= atua/vzmg atub= atan(atub) zubt= atub/vzmg sujc0= (atub-atua)/vzmg endif * zuv= sujc0*sux+zuat iftn= 1 atnu= vzmg*zuv su= s0z/vv*(1.d0+szg*s07aaf(atnu,iftn)) if(iftn.ne.0) print 300 pujac= 1.d0 * else if(opeakn.eq.'n') then sujc0= suu-sul su= sujc0*sux+sul pujac= 1.d0/((vv*su-rzm2)**2+(vv*su*szg)**2) endif sujc= vv*sujc0 if(su.lt.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * sdlim= rrl(3) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim= dmin1(sduim1,sduim2) * *-----limits on sd from Delta_- > 0 * if(ssu.gt.rasup) then sdld= (ssu-rasup)*(ssu-rasup) else sdld= sdlim endif sdud1= (ssu+rasup)*(ssu+rasup) sdud2= (-ssu+rasum)*(-ssu+rasum) sdud= dmin1(sdud1,sdud2) * *-----limits on sd from cuts on SA. Here for maximum security. Rare * if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then if(ss(2).eq.ss(1)) then asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) else if(ss(1).gt.ss(2)) then sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdu= dmin1(sduim,sdud,sdusa) asdl= dmax1(sdlim,sdld) else if(ss(1).lt.ss(2)) then asdu= dmin1(sduim,sdud) sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdl= dmax1(sdlim,sdld,sdlsa) endif else asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) endif if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then if(cs(2).eq.cs(1)) then sdl= asdl sdu= asdu else if(cs(1).gt.cs(2)) then sdu= asdu sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdl= dmax1(asdl,sdlsb) else if(cs(1).lt.cs(2)) then sdl= asdl sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdu= dmin1(asdu,sdusb) endif else sdl= asdl sdu= asdu endif * if(ieq.eq.0) then sdenl= -1.d0+bl(1)+bl(4)+su sdenu1= 1.d0-sp-bl(2) sdenu2= 1.d0-sm-bl(3) sdenu3= 1.d0-bl(2)-bl(3)+su else if(ieq.eq.1) then sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) sdenu1= enc-sp-xbl(2) sdenu2= enc-sm-xbl(3) sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3) endif sdl= dmax1(sdl,sdenl) sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) sdl= dmax1(sdl,sct14) if(itc.eq.1.and.itcc.eq.3) then sdld3= 1.d0-sm-sp-su-dist*dist/vv/s sdl= dmax1(sdl,sdld3) sdud3= 1.d0-sm-sp-su-0.5d0*dist*dist/vv/s sdu= dmin1(sdu,sdud3) endif * *-----test on sd * if(sdu.le.sdl) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif * if(itc.eq.1.and.itcc.eq.2) then bdistl= (dist/rs-svv*ssu)*(dist/rs-svv*ssu)-vv*sdl bdistu= vv*sdu-(dist/rs-svv*ssu)*(dist/rs-svv*ssu) if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif endif * if(itc.eq.1.and.itcc.eq.2) then sd= (dist/rs/svv-ssu)*(dist/rs/svv-ssu) pdjac= 2.d0*abs((dist/rs-svv*ssu))/ars/ # ((vv*sd-rzm2)**2+(vv*sd*szg)**2) sdjc= 1.d0 else if(opeakn.eq.'y') then zdas= vv*sdl-rzm2 zdbs= vv*sdu-rzm2 atda= (zdas+vv*szgs*sdl)/rzmg atdb= (zdbs+vv*szgs*sdu)/rzmg if(atda.gt.1.d0.and.atdb.gt.1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vzmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vzmg sdjc0= (-atdb+atda)/vzmg else if(atda.gt.1.d0.and.atdb.lt.-1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vzmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vzmg sdjc0= (-pi+atdb+atda)/vzmg else if(atda.gt.1.d0.and.abs(atdb).lt.1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vzmg atdb= atan(atdb) zdbt= atdb/vzmg sdjc0= (-pih+atdb+atda)/vzmg else if(atda.lt.-1.d0.and.atdb.gt.1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vzmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vzmg sdjc0= (pi-atdb-atda)/vzmg else if(atda.lt.-1.d0.and.atdb.lt.-1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vzmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vzmg sdjc0= (atdb-atda)/vzmg else if(atda.lt.-1.d0.and.abs(atdb).lt.1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vzmg atdb= atan(atdb) zdbt= atdb/vzmg sdjc0= (pih+atdb-atda)/vzmg else if(abs(atda).lt.1.d0.and.atdb.gt.1.d0) then atda= atan(atda) zdat= atda/vzmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vzmg sdjc0= (pih-atdb-atda)/vzmg else if(abs(atda).lt.1.d0.and.atdb.lt.-1.d0) then atda= atan(atda) zdat= atda/vzmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vzmg sdjc0= (-pih+atdb-atda)/vzmg else if(abs(atda).lt.1.d0.and.abs(atdb).lt.1.d0) then atda= atan(atda) zdat= atda/vzmg atdb= atan(atdb) zdbt= atdb/vzmg sdjc0= (atdb-atda)/vzmg endif * zdv= sdjc0*sdx+zdat iftn= 1 atnd= vzmg*zdv sd= s0z/vv*(1.d0+szg*s07aaf(atnd,iftn)) if(iftn.ne.0) print 300 pdjac= 1.d0 * else if(opeakn.eq.'n') then sdjc0= sdu-sdl sd= sdjc0*sdx+sdl pdjac= 1.d0/((vv*sd-rzm2)**2+(vv*sd*szg)**2) endif sdjc= vv*sdjc0 endif * if(sd.lt.0.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif ssd= sqrt(sd) sdmu= sd-su sdmus= (1.d0+sdmu)*(1.d0+sdmu) * if(ios.eq.3) then escals= -vv*s rescals= svv*rs escalu= -vv*su*s rescalu= svv*ssu*rs escald= -vv*sd*s rescald= svv*ssd*rs call wtopself(escalu,pggfu) call wtopself(escald,pggfd) call wtopself(escals,pggfs) derul= 0.25d0*alpha/pi*pggfu derdl= 0.25d0*alpha/pi*pggfd dersl= 0.25d0*alpha/pi*pggfs eth= 40.d0/rs/vv if(rescalu.gt.40.d0) then call wtohadr5(rescalu,deruh,ederuh) else call wtopselfnp(escalu,pggnpu) deruh= 0.25d0*alpha/pi*pggnpu endif if(rescald.gt.40.d0) then call wtohadr5(rescald,derdh,ederdh) else call wtopselfnp(escald,pggnpd) derdh= 0.25d0*alpha/pi*pggnpd endif if(rescals.gt.40.d0) then call wtohadr5(rescals,dersh,edersh) else call wtopselfnp(escals,pggnps) dersh= 0.25d0*alpha/pi*pggnps endif deru= derul+deruh derd= derdl+derdh ders= dersl+dersh alpu= alpha/(1.d0-deru) alpd= alpha/(1.d0-derd) alps= alpha/(1.d0-ders) corrgu= 4*pi*alpu/g2/sth2 corrgd= 4*pi*alpd/g2/sth2 corrgs= 4*pi*alps/g2/sth2 else corrgu= 1.d0 corrgd= 1.d0 corrgs= 1.d0 endif * if(oqcd.eq.'y') then if(iqcd.lt.2) then qcdjc= (1.d0+0.5d0*als/pi*(fcuc-1.d0))* # (1.d0+0.5d0*als/pi*(fcdc-1.d0))-1.d0 qcdjn= (1.d0+0.5d0*alsz/pi*(fcun-1.d0))* # (1.d0+0.5d0*alsz/pi*(fcdn-1.d0))-1.d0 else nf= 5 scalp= sqrt(vv)*ssp*ars scalm= sqrt(vv)*ssm*ars scalu= sqrt(vv)*ssu*ars scald= sqrt(vv)*ssd*ars alsp= wtorals(qcdl,scalp,nf) alsm= wtorals(qcdl,scalm,nf) alsu= wtorals(qcdl,scalu,nf) alsd= wtorals(qcdl,scald,nf) qcdjc= (1.d0+0.5d0*alsp/pi*(fcuc-1.d0))* # (1.d0+0.5d0*alsm/pi*(fcdc-1.d0))-1.d0 qcdjn= (1.d0+0.5d0*alsu/pi*(fcun-1.d0))* # (1.d0+0.5d0*alsd/pi*(fcdn-1.d0))-1.d0 endif else qcdjc= 0.d0 qcdjn= 0.d0 endif * *-----initialization of sf = m^2 * *-----limits on sf from cuts on FS IM * sflim1= rrl(2) sfuim1= rrr(2) bsg= sm+sp+su+sd ombsg= 1.d0-bsg sflim2= ombsg-rrr(5) sfuim2= ombsg-rrl(5) sflim= dmax1(sflim1,sflim2) sfuim= dmin1(sfuim1,sfuim2) * *-----limits on sf from cuts on SA * tcuts= ss(1)-ss(2)+ss(3)-ss(4) tcutc= cs(1)-cs(2)+cs(3)-cs(4) if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfu= dmin1(sfuim,sfusa,sfusb) asfl= sflim else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa,sflsb) asfu= sfuim else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) endif else asfl= sflim asfu= sfuim endif * if(ieq.eq.0) then asfenl1= bl(1)-sm-sd asfenl2= bl(3)-sp-su asfenu1= 1.d0-bl(2)-sp-sd asfenu2= 1.d0-bl(4)-sm-su else if(ieq.eq.1) then asfenl1= 1.d0-enc-sm-sd+xbl(1) asfenl2= 1.d0-enc-sp-su+xbl(3) asfenu1= enc-sp-sd-xbl(2) asfenu2= enc-sm-su-xbl(4) endif asfl= dmax1(asfl,asfenl1,asfenl2) asfu= dmin1(asfu,asfenu1,asfenu2) aasfu= 1.d0-sm-sp-su-sd-sct24 asfl= dmax1(asfl,sct13) asfu= dmin1(asfu,aasfu) * if(iac(3).ne.0) then if(ss(4).ne.ss(3)) then if(ss(4).gt.ss(3)) then asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfl= dmax1(asfl,asfltw) else if (ss(4).lt.ss(3)) then asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfu= dmin1(asfu,asfutw) endif endif if(cs(1).ne.cs(2)) then if(cs(1).gt.cs(2)) then bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfl= dmax1(asfl,bsfltw) else if(cs(1).lt.cs(2)) then bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfu= dmin1(asfu,bsfutw) endif endif if(cs(4).ne.cs(3)) then if(cs(4).gt.cs(3)) then csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfu= dmin1(asfu,csfutw) else if(cs(4).lt.cs(3)) then csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfl= dmax1(asfl,csfltw) endif endif if(ss(1).ne.ss(2)) then if(ss(1).gt.ss(2)) then dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfu= dmin1(asfu,dsfutw) else if(ss(1).lt.ss(2)) then dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfl= dmax1(asfl,dsfltw) endif endif endif * * *-----positivity of R^2 * scp= ssmpp*ssmpp scm= ssmmp*ssmmp snp= (ssu+ssd)*(ssu+ssd) snm= (ssu-ssd)*(ssu-ssd) rlp= ssu*ssd+ssp*ssm rlm= ssu*ssd-ssp*ssm bsgmo= bsg-1.d0 ombsg2= ombsg*ombsg rlps= rlp*rlp rlms= rlm*rlm edelp= ombsg2-4.d0*rlps edelm= ombsg2-4.d0*rlms edeld= 16.d0*ssu*ssd*ssp*ssm * *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2 * then Delta_+ > 0 * *-----control * cnt1= scp+snm cnt2= scm+snp if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then iz= 0 ifz(11)= ifz(11)+1 go to 1 endif if(edelm.le.0.d0) then etest= edeld+edelp if(etest.gt.0.d0) then edelm= etest else iz= 0 ifz(12)= ifz(12)+1 go to 1 endif endif sedm= sqrt(edelm) ifcr= 0 call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) if(rr1(2).ne.0.d0) then iz= 0 ifz(13)= ifz(13)+1 go to 1 endif ifcr= 0 call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) * cnt3= scp+snp cnt4= scm+snm cbru= -1.d0 ccru= 0.5d0*bsg * *-----R^2 has two real roots and two complex conjugate roots * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then if(bsg.gt.0.5d0) then iel= 1 sflr(1)= rr1(1) sfur(1)= rr2(1) sflr(2)= rr1(1) sfur(2)= rr2(1) else iel= 2 ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sflr(2)= ru2 sfur(1)= ru1 sfur(2)= rr2(1) endif * *-----R^2 has four real roots * else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(bsg.gt.0.5d0) then sflr(1)= rr1(1) sflr(2)= rs2(1) sfur(1)= rs1(1) sfur(2)= rr2(1) else ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sfur(1)= dmin1(rs1(1),ru1) sflr(2)= dmax1(rs2(1),ru2) sfur(2)= rr2(1) endif endif * *-----the loop for transforming sf starts here * do it=1,2 if(sflr(it).ge.asfl) then sfl= sflr(it) else sfl= asfl endif if(sfur(it).le.asfu) then sfu= sfur(it) else sfu= asfu endif * *-----test on sf * if(sfu.le.sfl) then iz= 0 ifz(14)= ifz(14)+1 go to 2 endif * if(itc.eq.1.and.itcc.eq.3) then ittm= 2 else ittm= 1 endif * do itt=1,ittm * if(itc.eq.1.and.itcc.eq.3) then distm= dist/svv/rs sbdist= 2.d0*(1.d0-sm-sp-su-sd)-distm*distm if(sbdist.le.0.d0) then iz= 0 ifz(14)= ifz(14)+1 go to 5 endif if(itt.eq.1) then bdist= 0.25d0*(distm-sqrt(sbdist))* # (distm-sqrt(sbdist)) else if(itt.eq.2) then bdist= 0.25d0*(distm+sqrt(sbdist))* # (distm+sqrt(sbdist)) endif bdistl= bdist-sfl bdistu= sfu-bdist if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(14)= ifz(14)+1 go to 5 endif sf= bdist ssf= sqrt(sf) pfjc= 2.d0/vv/rs*ssf*(distm-ssf)/sqrt(sbdist) sfjc0= sf*sf+(sm+sp+su+sd-1.d0)*sf+su*sd+sm*sp sfjc= 4.d0*sm*sp*su*sd-sfjc0*sfjc0 if(sfjc.le.0.d0) then iz= 0 ifz(14)= ifz(14)+1 go to 5 else if(iel.eq.1) then sfjc= 0.5d0*pfjc/sqrt(sfjc) else if(iel.eq.2) then sfjc= pfjc/sqrt(sfjc) endif endif else * *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then er= rs1(1) es= abs(rs1(2)) er1= rr1(1) er2= rr2(1) ek2= edelm/edeld ek= sqrt(ek2) dog= -2.d0/sqrt(edeld) ecpl= (ombsg-2.d0*sfl)/sedm ecpu= (ombsg-2.d0*sfu)/sedm eql= ecpl*ecpl equ= ecpu*ecpu omecpl= 2.d0*(sfl-er1)/sedm es2pl= omecpl*(2.d0-omecpl) erl= 1.d0-ek2*es2pl espl= sqrt(es2pl) opecpu= 2.d0*(er2-sfu)/sedm es2pu= opecpu*(2.d0-opecpu) espu= sqrt(es2pu) eru= 1.d0-ek2*es2pu if(eql.eq.1) then sflt= 0.d0 else ifel= 1 sflt= -dog*espl*s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(15)= ifz(15)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 sfut= -dog*espu*s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(16)= ifz(16)+1 go to 2 endif endif if(iel.eq.1) then if(sfu.le.er) then efac= 0.5d0 sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(17)= ifz(17)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(sfl.ge.er) then efac= 0.5d0 sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(18)= ifz(18)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) else efac= 1.d0 qbar= 0.d0 rbar= 1.d0-ek2 ifel= 1 sfbar= -dog*s21bbf(qbar,rbar,one,ifel) if(ifel.ne.0) then iz= 0 ifz(19)= ifz(19)+1 go to 2 endif if(it.eq.1) then sft= (sfbar-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(20)= ifz(20)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfbar-sflt) else if(it.eq.2) then sft= (sfbar-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(21)= ifz(21)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sfbar-sfut) endif endif else if(iel.eq.2) then efac= 1.d0 if(it.eq.1) then sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(22)= ifz(22)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(it.eq.2) then sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(23)= ifz(23)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) endif endif else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(edelp.le.0.d0) then iz= 0 ifz(24)= ifz(24)+1 go to 2 endif sedp= sqrt(edelp) efac= 1.d0 es1= rs1(1) es2= rs2(1) er1= rr1(1) er2= rr2(1) ssed= sedm+sedp ek= (sedm-sedp)/ssed ek2= ek*ek dog= 2.d0/ssed if(it.eq.1) then es2pl= (er1-sfl)/(sfl-er2)/ek es2pu= (er1-sfu)/(sfu-er2)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu else if(it.eq.2) then es2pl= (sfl-es2)/(sfl-es1)/ek es2pu= (sfu-es2)/(sfu-es1)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu endif if(eql.eq.1.d0) then sflt= 0.d0 else ifel= 1 sflt= 2.d0*dog*sqrt(es2pl)* # s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(25)= ifz(25)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then equ= 0.d0 endif sfut= 2.d0*dog*sqrt(es2pu)* # s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(26)= ifz(26)+1 go to 2 endif endif sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= 0.5d0/dog*sft call s21caf(asf,ek2,elsn,elcn,edn,ifel) elsn2= elsn*elsn if(ifel.ne.0) then iz= 0 ifz(27)= ifz(27)+1 go to 2 endif if(it.eq.1) then sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2) else if(it.eq.2) then sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) endif sfjc= efac*(sfut-sflt) endif * endif * *-----auxiliary quantities * sdpf= sd+sf e3= sp+su+sf e4= 1.d0+spmm-e3 e3p4= 1.d0+spmm e1= sm+sdpf e2= 1.d0+smmp-e1 e1p2= 1.d0+smmp e1p3= e1+e3 e1m2= 2.d0*e1-1.d0+spmm ep12= xp*e1*e2 ep1= xp*e1 ep2= xp*e2 ep3= xp*e3 ep4= xp*e4 e1t2= e1*e2 e1t3= e1*e3 e1t4= e1*e4 e2t3= e2*e3 e2t4= e2*e4 e3t4= e3*e4 if((e1p3*e1p3-4.d0*sf).lt.0.d0) then iz= 0 ifz(28)= ifz(28)+1 go to 2 endif skl2= sqrt(e1p3*e1p3-4.d0*sf) if((sdmus-4.d0*sd).lt.0.d0) then iz= 0 ifz(29)= ifz(29)+1 go to 2 endif skl3= sdmus-4.d0*sd skl3= sqrt(skl3) * *-----initialization of t_w * *-----limits on tw from positivity and SA * twlp1= 0.d0 twlp2= smmp twlp3= spmm-1.d0 twlp= dmax1(twlp1,twlp2,twlp3) twup= 1.d0 * *-----limits on tw from cuts on SA * if(iac(3).ne.0) then skl2m= 0.5d0*(e1p3-skl2) skl2p= 0.5d0*(e1p3+skl2) skl3p= -0.5d0*(1.d0+sdmu-skl3) skl3m= -0.5d0*(1.d0+sdmu+skl3) twlsa1= 1.d0-cs(3)*e3-cs(4)*e4 twlsa2= ss(1)*e1+ss(2)*e2 twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m twusa1= 1.d0-ss(3)*e3-ss(4)*e4 twusa2= cs(1)*e1+cs(2)*e2 twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4, # twlsa5,twlsa6) atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, # twusa5,twusa6) else atwl= twlp atwu= twup endif * * *-----limits on tw from E * if(ieq.eq.1) then atwle= 1.d0-bxe*e3p4+bl(3)+bl(4) atwue= bxe*e1p2-bl(1)-bl(2) if(xdf.gt.0.d0) then twle= atwle twue= atwue else if(xdf.lt.0.d0) then atwle1= bxe*e1-bl(1) atwle2= bxe*e2-bl(2) atwue1= 1.d0-bxe*e3+bl(3) atwue2= 1.d0-bxe*e4+bl(4) twle= dmax1(atwue,atwle1,atwle2) twue= dmin1(atwle,atwue1,atwue2) endif atwl= dmax1(atwl,twle) atwu= dmin1(atwu,twue) endif * *-----natural limits on tw * atwl= dmax1(atwl,bt1(1)) atwu= dmin1(atwu,bt2(1)) * *-----test on tw * if(atwu.le.atwl) then iz= 0 ifz(30)= ifz(30)+1 go to 2 endif * twjc= atwu-atwl tw= twjc*twx+atwl pn= tw+sp-1.d0 omtw= 1.d0-tw * *-----initialization of t1 * *-----limits on t1 from positivity+SA * t1lp1= 0.d0 t1lp2= pn+sdpf t1up1= tw t1up2= sm+sdpf t1lp= dmax1(t1lp1,t1lp2) t1up= dmin1(t1up1,t1up2) * *-----limits on t1 from cuts on SA * if(iac(3).ne.0) then t1lc1= ss(1)*e1 t1lc2= tw-cs(2)*e2 t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3 t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 t1uc1= cs(1)*e1 t1uc2= tw-ss(2)*e2 t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3)) t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3 t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4 t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6) t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6) at1l= dmax1(t1lp,t1lc) at1u= dmin1(t1up,t1uc) else at1l= t1lp at1u= t1up endif * * *-----limits on t1 from E * if(ieq.eq.1) then at1le= tw-bxe*e2+bl(2) at1ue= bxe*e1-bl(1) if(xdf.gt.0.d0) then t1le= at1le t1ue= at1ue else t1le= at1ue t1ue= at1le endif at1l= dmax1(at1l,t1le) at1u= dmin1(at1u,t1ue) endif * *-----positivity of (R')^2 / reality of roots for t3 * rp0= e1p2*e1p2-4.d0*sm if(rp0.lt.0.d0) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif srp0= sqrt(rp0) rp0e= -rp0 rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 rp1e= 2.d0*rp1 rp2= -(e1*tw-sm)*(e1*tw-sm) if(rp0e.eq.0.d0) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif ifct= 0 if(rp0e.ne.0.d0) then call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) t1l= dmax1(at1l,ret1(1)) t1u= dmin1(at1u,ret2(1)) else if(rp0e.eq.0.d0) then sret1= -rp2/rp1e if(rp1e.gt.0.d0) then t1l= dmax1(at1l,sret1) t1u= at1u else if(rp1e.lt.0.d0) then t1l= at1l t1u= dmin1(at1u,sret1) endif endif * *-----test on t1 * if(t1u.le.t1l) then iz= 0 ifz(32)= ifz(32)+1 go to 2 endif * *-----transformation for jacobian * if(rp0e.eq.0.d0) then taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2) taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) t1jc= taut-taul t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e endif if(ret1(1).eq.t1l) then at1tl= -pih/srp0 else bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) ifas= 1 at1tl= -s09aaf(bt1tl,ifas)/srp0 if(ifas.ne.0) print 200 endif if(ret2(1).eq.t1u) then at1tu= pih/srp0 else bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) ifas= 1 at1tu= -s09aaf(bt1tu,ifas)/srp0 if(ifas.ne.0) print 200 endif if((at1tl+at1tu).eq.0.d0) then if(t1x.lt.1.d-3) then arc= pi*t1x arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc else if((1.d0-t1x).lt.1.d-3) then arc= pi*(1.d0-t1x) arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc else carc= cos(pi*t1x) t1= 0.5d0*(ret1(1)+ret2(1))+ # 0.5d0*(ret1(1)-ret2(1))*carc endif t1jc= pi/srp0 else t1tl= dmin1(at1tl,at1tu) t1tu= dmax1(at1tl,at1tu) t1jc= t1tu-t1tl t1t= t1jc*t1x+t1tl t1= (rp1+rpds*sin(srp0*t1t))/rp0 endif t1s= t1*t1 * 200 format(' Unsuccesful call to S09AAF ') * *-----test on t1 from FS A * if(ieq.eq.1.and.iac(4).ne.0.d0) then cnlct1= xp*(xm*sm-ep12*cg12)+xdf* # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1- # xdf*tw)+xdfs*cg12*t1s cnlst1= xp*(ep12*sg12-xm*sm)-xdf* # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ # xdf*tw)-xdfs*sg12*t1s if(cnlct1.lt.0.d0) then iz= 0 ifz(33)= ifz(33)+1 go to 2 else if(cnlst1.lt.0.d0) then iz= 0 ifz(34)= ifz(34)+1 go to 2 endif endif * *-----some vector components * t2= tw-t1 * *-----equation for xi is solved * e1s= e1*e1 e2s= e2*e2 e3s= e3*e3 e12= e1t2-2.d0*sm e13= e1t3-2.d0*sf e23= e2t3-2.d0*su e12s= e12*e12 e13s= e13*e13 e23s= e23*e23 xia= e1s*e2s-e12s xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ # e2*e12*e13 xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13* # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 xib= 2.d0*xib if(xia.eq.0.d0) then if(xib.eq.0.d0) then iz= 0 ifz(35)= ifz(35)+1 go to 2 endif rtm(1)= -xic/xib rtp(1)= rtm(1) rtm(2)= 0.d0 rtp(2)= 0.d0 ixia= 0 else ixia= 1 ifc0= 0 call c02ajf(xia,xib,xic,rtm,rtp,ifc0) endif if(rtm(2).ne.0.d0) then iz= 0 ifz(36)= ifz(36)+1 go to 2 endif * *-----xi^+ and xi^- are computed * xip= 0.5d0*(e3-rtp(1)) xim= 0.5d0*(e3-rtm(1)) * *-----each integral becomes a sum of two terms * *-----loop over ix starts here * if(om.eq.'g') then ixmn= ix0 ixmx= ix0 else ixmn= 1 ixmx= 2 endif do ix=ixmn,ixmx * *-----q_3 is compared and x15 is selected * if(ix.eq.1) then t3= xip else if(ix.eq.2) then t3= xim endif * *-----The two integrands are computed * *-----further auxiliary quantities * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 edn3= ep3-xdf*t3 t4= omtw-t3 edn4= ep4-xdf*t4 * *-----collections of all limits on t3 * *-----from energy (or natural limits) * if(ieq.eq.1) then at3l1= omtw-bxe*e4+bl(4) at3u1= bxe*e3-bl(3) if(xdf.gt.0.d0) then t3l1= at3l1 t3u1= at3u1 else if(xdf.lt.0.d0) then t3l1= at3u1 t3u1= at3l1 endif else t3l1= 0.d0 t3u1= e3 endif * *-----natural limits * t3l2= -t1+0.5d0*(e1p3-skl2) t3u2= -t1+0.5d0*(e1p3+skl2) * t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3) * *-----from positivity on SA * t3l4= 0.d0 t3l5= sm+su+sf-tw t3u4= sp+su+sf t3u5= omtw * *-----from SA * if(iac(3).ne.0) then t3l6= ss(3)*e3 t3u6= cs(3)*e3 t3l7= omtw-cs(4)*e4 t3u7= omtw-ss(4)*e4 t3l= dmax1(t3l1,t3l2,t3l3,t3l4, # t3l5,t3l6,t3l7) t3u= dmin1(t3u1,t3u2,t3u3,t3u4, # t3u5,t3u6,t3u7) else t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5) endif * *-----limits on t3 are imposed * tlimt3= (t3u-t3)*(t3-t3l) if(t3u.lt.t3l) then iz= 0 ifz(37)= ifz(37)+1 go to 4 else if(tlimt3.lt.0.d0) then iz= 0 ifz(37)= ifz(37)+1 go to 4 endif * *-----non linear limits on t3,t4 are imposed * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif * * *-----non linear constraints from FS A in the case xp = xm * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif * *-----all invariants * x13= t1 x14= t2 x15= t3 x16= t4 x23= e1-t1 x24= e2-t2 x25= e3-t3 x26= e4-t4 x34= sm x35= sf x36= sd x45= su x46= 1.d0-e1-e3+sf x56= sp * *-----computes cross-section * *-----born matrix element is calculated at the reduced c.m. energy * *-----propagators for pair production diagrams * pfp= e4-1.d0 pfb= e1-1.d0 pfpb= e3-1.d0 pf= e2-1.d0 * *-----extra propagators * pp23= x23+rszm2 pp14= x14+rwm2/vv pp13= x13+rszm2 * *-----compensating single W propagators * wpcfr= sp-rwm2/vv wmcfr= sm-rwm2/vv wpcfi= sp*swg wmcfi= sm*swg * *-----Compensating double W propagator * wtcfr= wpcfr*wmcfr-sp*sm*swgs wtcfi= wpcfr*wmcfi+wmcfr*wpcfi * *-----The epsilons are computed in the order * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4), * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4), * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) * x13s= x13*x13 x14s= x14*x14 x15s= x15*x15 x16s= x16*x16 x23s= x23*x23 x24s= x24*x24 x25s= x25*x25 x26s= x26*x26 x34s= x34*x34 x35s= x35*x35 x36s= x36*x36 x45s= x45*x45 x46s= x46*x46 x56s= x56*x56 * ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s-x35s ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+ # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+ # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- # x15s*x34s ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+ # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- # x25s*x34s * e(1)= 1.d0 e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0* # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45- # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35- # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45 e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13* # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+ # x25*x34s * *-----sign of eps_1*eps_i * ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo * if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= ses2 s3= -ses1-ses2 s4= ses3 s5= ses1-ses3 s6= ses2+ses3 s7= ses4 s8= ses1-ses4 s9= ses2+ses4 s10= ses3-ses4 s11= ses5 s12= -ses1-ses5 s13= -ses2+ses5 s14= -ses3-ses5 s15= -ses4-ses5 else ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s-x36s ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+ # x16*x24*x46)-x14s*x26s-x16s*x24s-x46s ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ # x14*x16*x34*x36)-x13s*x46s-x14s*x36s- # x16s*x34s ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- # x26s*x34s e(1)= 1.d0 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23*x34- # x13s*x24*x26-x34*x36 e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13* # x24*x46-x14*x16*x23*x24+x14*(-x23* # x46+2.d0*x24*x36-x26*x34)-x16*x24* # x34+x14s*x23*x26+x34*x46 e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26* # x34)+x13*x16*x24*x34+x13*x34*x46+ # x14*x16*x23*x34+x14*x34*x36-x16* # x34s-x13s*x24*x46-x14s*x23*x36 e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36* # x24s)+x14*(-x23*x24*x36-x23*x26* # x34+x46*x23s)+x16*2.d0*x23*x24*x34- # x23*x34*x46-x24*x34*x36+x26*x34s ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= -ses1-ses2 s3= ses2 s4= -ses1-ses3 s5= ses3 s6= -ses2-ses3 s7= ses1-ses4 s8= ses4 s9= -ses2-ses4 s10= -ses3+ses4 s11= -ses1-ses5 s12= ses5 s13= ses2-ses5 s14= ses3+ses5 s15= ses4+ses5 else ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s- # x35s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s- # x36s ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+ # x16*x25*x56)-x15s*x26s-x16s*x25s- # x56s ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35* # x56+x15*x16*x35*x36)-x13s*x56s- # x15s*x36s-x16s*x35s ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35* # x56+x25*x26*x35*x36)-x23s*x56s- # x25s*x36s-x26s*x35s * e(1)= x13*x14*x23*x25+x13*x15*x23*x24+ # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- # x14*x15*x23s+x14*x23*x35+x15*x23* # x34-x13s*x24*x25-x34*x35 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23* # x34-x13s*x24*x26-x34*x36 e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+ # x13*(-x25*x46+x26*x45)+x14*x15*x23* # x26-x14*x16*x23*x25+x14*(x25*x36-x26* # x35)+x15*(-x23*x46+x24*x36)+x16*(x23* # x45-x24*x35)+x35*x46-x36*x45 e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ # x25*x34)+x13*(x35*x46-x36*x45)-x14* # x15*x23*x36+x14*x16*x23*x35+x15*x34* # x36-x16*x34*x35+x13s*(-x25*x46+x26* # x45) e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* # x36-x24*x26*x35)+x15*(-x23*x24*x36- # x23*x26*x34+x46*x23s)+x16*(x23*x24* # x35+x23*x25*x34-x45*x23s)-x23*x35* # x46+x23*x36*x45-x25*x34*x36+x26*x34* # x35 * ises= 0 do i=1,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= -ses1-ses2 s2= ses1 s3= ses2 s4= -ses1+ses3 s5= -ses2-ses3 s6= ses3 s7= -ses1+ses4 s8= -ses2-ses4 s9= ses4 s10= ses3-ses4 s11= ses1+ses5 s12= ses2-ses5 s13= ses5 s14= -ses3-ses5 s15= -ses4-ses5 else iz= 0 ifz(40)= ifz(40)+1 go to 4 endif endif endif * tgc(1)= x15*x24 tgc(2)= x34*x46 tgc(3)= x34/x46 tgc(4)= x24/x15 tgc(5)= x15/x25 tgc(6)= x15*x25 tgc(7)= x14*x34 tgc(8)= x25*x46 tgc(9)= x25/x46 tgc(10)= x14/x34 tgc(11)= x45/x36 tgc(12)= x14*x24 tgc(13)= x24/x14 tgc(14)= x45*x36 tgc(15)= x14/x25 * itgc= 0 do l=1,15 if(tgc(l).le.0.d0) then itgc= itgc+1 endif enddo if(itgc.ne.0) then iz= 0 ifz(41)= ifz(41)+1 go to 4 endif * gpna= sqrt(x15*x24) gpnb= sqrt(x34*x46) gpnc= sqrt(x34/x46) gpnd= sqrt(x24/x15) gpne= sqrt(x15/x25) gpnf= sqrt(x15*x25) gmna= sqrt(x14*x34) gmnb= sqrt(x25*x46) gmnc= sqrt(x25/x46) gmnd= sqrt(x14/x34) gmne= sqrt(x45/x36) gmnf= sqrt(x14*x24) gmng= sqrt(x24/x14) gmnh= sqrt(x45*x36) gmni= sqrt(x14/x25) * gc1= gpna/gpnb gc2= gpna*gpnc gc3= gpna/gpnc gc4= gpnd/gpnb gc5= 1.d0/gpna/gpnc gc6= 1.d0/gpnd/gpnc gc7= gpnd/gpnc gc8= gpnb/gpna gc9= gpnd*gpnc gc10= gpnb/gpnd gc11= gpna*gpnb gc12= gmnd/gmnb gc13= 1.d0/gmnc/gmna gc14= gmna/gmnb gc15= gmnd/gmnc gc16= 1.d0/gmnd/gmnc gc17= gmna*gmnb gc18= gmnc/gmnd gc19= gmnc/gmna gc20= gmna*gmnc gc21= gmnd*gmnb gc22= gmnd*gmnc gc23= gmnb/gmnd gc24= gmnb/gmna gc25= gpnc/gpnd gc26= 1.d0/gpna/gpnb gc27= gpnc/gpna gc28= 1.d0/gpnd/gpnb gc29= gpne/gmnh gc30= gmne/gpnf gc31= 1.d0/gpnf/gmne gc32= 1.d0/gpnf/gmnh gc33= gpne*gmne gc34= gpne/gmne gc35= gmnh/gpnf gc36= gmnh*gpne gc37= gpnb*gmni * otgn(1)= x15*x24 otgn(2)= x34*x46 otgn(3)= x34/x46 otgn(4)= x24/x15 otgn(5)= x15/x25 otgn(6)= x15*x25 otgn(7)= x14*x25 otgn(8)= x14*x34 otgn(9)= x25*x46 otgn(10)= x25/x46 otgn(11)= x14/x34 otgn(12)= x45/x36 otgn(13)= x14*x24 otgn(14)= x24/x14 otgn(15)= x45*x36 otgn(16)= x14/x25 * iotgn= 0 do l=1,16 if(otgn(l).le.0.d0) then iotgn= iotgn+1 endif enddo if(iotgn.ne.0) then iz= 0 ifz(42)= ifz(42)+1 go to 4 endif * ogpna= sqrt(otgn(1)) ogpnb= sqrt(otgn(2)) ogpnc= sqrt(otgn(3)) ogpnd= sqrt(otgn(4)) ogpne= sqrt(otgn(5)) ogpnf= sqrt(otgn(6)) ogpng= sqrt(otgn(7)) ogmna= sqrt(otgn(8)) ogmnb= sqrt(otgn(9)) ogmnc= sqrt(otgn(10)) ogmnd= sqrt(otgn(11)) ogmne= sqrt(otgn(12)) ogmnf= sqrt(otgn(13)) ogmng= sqrt(otgn(14)) ogmnh= sqrt(otgn(15)) ogmni= sqrt(otgn(16)) * ogn1= ogpna/ogpnb ogn2= ogpna*ogpnc ogn3= ogpna/ogpnc ogn4= ogpnd/ogpnb ogn5= 1.d0/ogpna/ogpnc ogn6= 1.d0/ogpnd/ogpnc ogn7= ogpnd/ogpnc ogn8= ogpnb/ogpna ogn9= ogpnd*ogpnc ogn10= ogpnb/ogpnd ogn11= ogpna*ogpnb ogn12= ogmnd/ogmnb ogn13= 1.d0/ogmnc/ogmna ogn14= ogmna/ogmnb ogn15= ogmnd/ogmnc ogn16= 1.d0/ogmnd/ogmnc ogn17= ogmna*ogmnb ogn18= ogmnc/ogmnd ogn19= ogmnc/ogmna ogn20= ogmna*ogmnc ogn21= ogmnd*ogmnb ogn22= ogmnd*ogmnc ogn23= ogmnb/ogmnd ogn24= ogmnb/ogmna ogn25= ogpnc/ogpnd ogn26= 1.d0/ogpna/ogpnb ogn27= ogpnc/ogpna ogn28= 1.d0/ogpnd/ogpnb ogn29= ogpne/ogmnh ogn30= ogmne/ogpnf ogn31= 1.d0/ogpnf/ogmne ogn32= 1.d0/ogpnf/ogmnh ogn33= ogpne*ogmne ogn34= ogpne/ogmne ogn35= ogmnh/ogpnf ogn36= ogmnh*ogpne ogn37= ogpnb*ogmni ogn38= ogpnc/ogpng ogn39= 1.d0/ogpng/ogpnb ogn40= ogmne/ogmnf ogn41= ogmng*ogmne ogn42= 1.d0/ogmnf/ogmnh ogn43= ogmng/ogmnh ogn44= ogmne/ogmng ogn45= 1.d0/ogmng/ogmnh ogn46= ogmnf/ogmnh ogn47= ogmnf*ogmne ogn48= ogmnh/ogmnf ogn49= 1.d0/ogmng/ogmne ogn50= ogmng*ogmnh ogn51= 1.d0/ogmnf/ogmne ogn52= ogmnh/ogmng ogn53= ogmnf*ogmnh ogn54= ogmnf/ogmne ogn55= 1.d0/ogpnb*ogmni ogn56= 1.d0/ogpnc/ogpng ogn57= ogpnc*ogmni ogn58= 1.d0/ogpnc*ogmni ogn59= ogpnb/ogpng ogn60= ogpnb*ogpng ogn61= ogpnc/ogmni ogn62= 1.d0/ogpnb/ogmni ogn63= ogpnc*ogpng ogn64= 1.d0/ogpnc*ogpng ogn65= 1.d0/ogpnb*ogpng ogn66= ogpnb/ogmni ogn67= 1.d0/ogpnc/ogmni ogn68= ogpne/ogmne ogn69= 1.d0/ogpnf*ogmnh ogn70= 1.d0/ogmne*ogmng * *-----CC diagrams * *-----helicity a) * *-----conversion diagram without t-channel propagator * dcr= 2.d0*(gc1*x36*(x45-x14)+ # gc2*(x16-x56)+gc3*(x13-x35)) dci= 8.d0*gc1*(s8-s15) * *-----annihilation diagrams: common part * daarc= 2.d0*gc1*x36*x45-2.d0*gc2*x56+ # gc3*(-x35+1.5d0*x36)+2.d0*gc4* # (x13*x36*x45-x14*x35*x36)+gc5* # (-x13*x23*x45-0.5d0*x13*x25*x46+ # 0.5d0*x13*x26*x45+x14*x23*x35- # 0.5d0*x14*x23*x56+0.5d0*x14*x25* # x36-0.5d0*x14*x26*x35+0.5d0*x16* # x23*x45+0.5d0*x35*x46-0.5d0*x36* # x45)+gc6*(-x23*x45-1.5d0*x23* # x46)+gc7*(x13*x45+0.5d0*x13*x56- # x14*x35-0.5d0*x16*x35)+gc8*(x13* # x25-0.5d0*x16*x25-x35+0.5d0*x56)+ # 2.d0*gc9*(-x13*x56+x16*x35)+ # gc10*(x25+1.5d0*x26)+3.d0*gc11 daaic= -8.d0*gc1*s15+8.d0*gc4*s7*x36+ # 2.d0*gc5*(s2*x46-s5*x35-2.d0*s7* # x23+s7*x26+s14*x13)-2.d0*gc6*(2.d0* # s11+3.d0*s12)+2.d0*gc7*(2.d0*s7-s9)- # 4.d0*gc8*s2+8.d0*gc9*s9 * *-----pair production I: common part * dpp1arc= -gc1*x24*x36+gc2*x26+gc3*(x23+x36)+ # gc4*(x13*(x24*x56-x26*x45)-x14*(x23* # x56-x25*x36-x26*x35)+x16*(x23*x45-x24* # x35)-x36*x45)+gc5*(x13*(x25*x46-x26* # x45)+x14*(x23*x56-x25*x36+x26*x35)-x16* # x23*x45-x35*x46+x36*x45)-gc6*x23*x46+ # gc7*(-x13*x25-x13*x56+x16*x35+x35)+ # gc8*(x16*x25-x56)+gc9*(-x16*x25+x56)+ # gc10*x26 dpp1aic= 4.d0*gc1*s12+4.d0*gc4*(-x25*s8-x36* # s4+s15)+4.d0*gc5*(x25*s8-2.d0*x26*s7+ # x36*s4-x46*s2-s15)-4.d0*gc6*s12+4.d0* # gc7*s2+4.d0*gc8*s6-4.d0*gc9*s6 * *-----pair production II: common part * dpp2arc= +2.d0*gc3*x13+2.d0*gc5*x23*(-x13* # x45+x14*x35)-2.d0*gc6*x14*x23+2.d0* # gc8*(x13*x25-x35)+2.d0*gc10 dpp2aic= 8.d0*(-gc5*x23*s7+gc6*s1-gc8*s2) * if(ockm.eq.'y') then if(ickm.eq.1) then dpp2arc= dpp2arc*vckm(1,1)*vckm(1,1) dpp2aic= dpp2aic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp2arc= dpp2arc*vckm(1,2)*vckm(1,2) dpp2aic= dpp2aic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp2arc= dpp2arc*vckm(1,3)*vckm(1,3) dpp2aic= dpp2aic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp2arc= dpp2arc*vckm(2,1)*vckm(2,1) dpp2aic= dpp2aic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp2arc= dpp2arc*vckm(2,2)*vckm(2,2) dpp2aic= dpp2aic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp2arc= dpp2arc*vckm(2,3)*vckm(2,3) dpp2aic= dpp2aic*vckm(2,3)*vckm(2,3) endif endif * *-----pair production III: common part * dpp3arc= 2.d0*gc3*(x35-x13)+2.d0*gc6*(x14* # x23-x23*x45)+2.d0*gc10*(-1.d0+x25) dpp3aic= -8.d0*gc6*(s1+s11) if(ockm.eq.'y') then if(ickm.eq.1) then dpp3arc= dpp3arc*vckm(1,1)*vckm(1,1) dpp3aic= dpp3aic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp3arc= dpp3arc*vckm(1,2)*vckm(1,2) dpp3aic= dpp3aic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp3arc= dpp3arc*vckm(1,3)*vckm(1,3) dpp3aic= dpp3aic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp3arc= dpp3arc*vckm(2,1)*vckm(2,1) dpp3aic= dpp3aic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp3arc= dpp3arc*vckm(2,2)*vckm(2,2) dpp3aic= dpp3aic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp3arc= dpp3arc*vckm(2,3)*vckm(2,3) dpp3aic= dpp3aic*vckm(2,3)*vckm(2,3) endif endif * *-----pair production IV: common part * dpp4arc= gc1*x24*x36-gc2*x26-gc3*x23+ # gc4*(x13*(-x24*x56+x26*x45)+ # x14*(x23*x56-x25*x36-x26*x35)- # x16*(x23*x45-x24*x35)+x36*x45)+ # gc7*(x13*x25-2.d0*x13*x45+2.d0* # x14*x35-x35)+gc9*(x16*x25-x56)+ # 2.d0*gc11 dpp4aic= -4.d0*gc1*s12+4.d0*gc4*(x25*s8+x36* # s4-s15)-4.d0*gc7*(s2+2.d0*s7)+4.d0* # gc9*s6 if(ockm.eq.'y') then if(ickm.eq.1) then dpp4arc= dpp4arc*vckm(1,1)*vckm(1,1) dpp4aic= dpp4aic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp4arc= dpp4arc*vckm(1,2)*vckm(1,2) dpp4aic= dpp4aic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp4arc= dpp4arc*vckm(1,3)*vckm(1,3) dpp4aic= dpp4aic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp4arc= dpp4arc*vckm(2,1)*vckm(2,1) dpp4aic= dpp4aic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp4arc= dpp4arc*vckm(2,2)*vckm(2,2) dpp4aic= dpp4aic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp4arc= dpp4arc*vckm(2,3)*vckm(2,3) dpp4aic= dpp4aic*vckm(2,3)*vckm(2,3) endif endif * *-----complete diagrams, epsilon real and imag parts separated: * *-----complete conversion diagram: * dcr= -0.25d0*dcr dci= -0.25d0*dci * *-----complete annihilation diagrams: * adap= 0.5d0*(sth2*omrz+0.5d0*rsz) daar= -adap*daarc daare= 0.5d0*asth2*aisz*daaic daaie= -adap*daaic daai= -0.5d0*asth2*aisz*daarc * *-----complete pair production I-IV: * hcpd1= 1.d0-tsth2*(omchdp+hchdp) hcpd2= 1.d0-tsth2*(omchd+hchd) hcpu3= -1.d0+tsth2*(opchup-hchup) hcpu4= -1.d0+tsth2*(opchu-hchu) * gcpd1= (1.d0-tsth2*opchdp-omrz*hcpd1)*scth2 gcpd2= (1.d0-tsth2*opchd-omrz*hcpd2)*scth2 gcpu3= (1.d0-tsth2*omchup+omrz*hcpu3)*scth2 gcpu4= (1.d0-tsth2*omchu+omrz*hcpu4)*scth2 * dpp1ar= gcpd1*dpp1arc dpp1are= -hcpd1*haisz*dpp1aic dpp1aie= gcpd1*dpp1aic dpp1ai= hcpd1*haisz*dpp1arc dpp2ar= -gcpd2*dpp2arc dpp2are= hcpd2*haisz*dpp2aic dpp2aie= -gcpd2*dpp2aic dpp2ai= -hcpd2*haisz*dpp2arc dpp3ar= gcpu3*dpp3arc dpp3are= hcpu3*haisz*dpp3aic dpp3aie= gcpu3*dpp3aic dpp3ai= -hcpu3*haisz*dpp3arc dpp4ar= -gcpu4*dpp4arc dpp4are= -hcpu4*haisz*dpp4aic dpp4aie= -gcpu4*dpp4aic dpp4ai= hcpu4*haisz*dpp4arc * * *-----compensating the missing W and the fermion propagators * d11ar= (dpp1ar*wpcfr-dpp1ai*wpcfi)/pfp+ # (dpp2ar*wmcfr-dpp2ai*wmcfi)/pfb+ # (dpp3ar*wpcfr-dpp3ai*wpcfi)/pfpb+ # (dpp4ar*wmcfr-dpp4ai*wmcfi)/pf d11are= (dpp1are*wpcfr-dpp1aie*wpcfi)/pfp+ # (dpp2are*wmcfr-dpp2aie*wmcfi)/pfb+ # (dpp3are*wpcfr-dpp3aie*wpcfi)/pfpb+ # (dpp4are*wmcfr-dpp4aie*wmcfi)/pf d11ai= (dpp1ar*wpcfi+dpp1ai*wpcfr)/pfp+ # (dpp2ar*wmcfi+dpp2ai*wmcfr)/pfb+ # (dpp3ar*wpcfi+dpp3ai*wpcfr)/pfpb+ # (dpp4ar*wmcfi+dpp4ai*wmcfr)/pf d11aie= (dpp1are*wpcfi+dpp1aie*wpcfr)/pfp+ # (dpp2are*wmcfi+dpp2aie*wmcfr)/pfb+ # (dpp3are*wpcfi+dpp3aie*wpcfr)/pfpb+ # (dpp4are*wmcfi+dpp4aie*wmcfr)/pf * pns= pn*pn darc= dcr/pn+daar-d11ar darec= daare-d11are daiec= dci/pn+daaie-d11aie daic= daai-d11ai * darc3= dcr/pn+daar darec3= daare daiec3= dci/pn+daaie daic3= daai * *-----helicity b) * if(iint.eq.2) then dabrc= 0.d0 dabic= 0.d0 dpp1brc= 0.d0 dpp1bic= 0.d0 dpp2brc= 0.d0 dpp2bic= 0.d0 dpp3brc= 0.d0 dpp3bic= 0.d0 dpp4brc= 0.d0 dpp4bic= 0.d0 else * *-----annihilation diagrams: common part * dabrc= 2.d0*gc12*(x23*x36*x45-x24*x35* # x36)+gc13*(-x13*x23*x45+x13*x24* # x35-0.5d0*x13*x24*x56+0.5d0*x13* # x26*x45-0.5d0*x15*x23*x46+0.5d0* # x15*x24*x36+0.5d0*x16*x23*x45- # 0.5d0*x16*x24*x35+0.5d0*x35*x46- # 0.5d0*x36*x45)+2.d0*gc14*(-x23* # x56+x26*x35)+gc15*(x23*x45+0.5d0* # x23*x56-x24*x35-0.5d0*x26*x35)+ # gc16*(x15*x23-0.5d0*x15*x26-x35+ # 0.5d0*x56)+3.d0*gc17-2.d0*gc20* # x56+gc21*(-x35+1.5d0*x36)+2.d0* # gc22*x36*x45+gc23*(x15+1.5d0* # x16)+gc24*(-x13*x45-1.5d0*x13* # x46) dabic= 8.d0*gc12*x36*s11+2.d0*gc13*(x16*s11- # 2.d0*x23*s7+x23*s10+2.d0*x35*s1+x35*s5- # x46*s2)+8.d0*gc14*s13+2.d0*gc15*(2.d0* # s11-s13)-8.d0*gc18*s10-8.d0*gc19*x45*s8+ # 2.d0*gc24*(2.d0*s7-3.d0*s8) * if(ockm.eq.'y') then if(ickm.eq.1) then dabrc= dabrc*vckm(1,1)*vckm(1,1) dabic= dabic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dabrc= dabrc*vckm(1,2)*vckm(1,2) dabic= dabic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dabrc= dabrc*vckm(1,3)*vckm(1,3) dabic= dabic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dabrc= dabrc*vckm(2,1)*vckm(2,1) dabic= dabic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dabrc= dabrc*vckm(2,2)*vckm(2,2) dabic= dabic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dabrc= dabrc*vckm(2,3)*vckm(2,3) dabic= dabic*vckm(2,3)*vckm(2,3) endif endif * *-----pair production I: common part * dpp1brc= gc12*(-x13*(x24*x56-x26*x45)+x14* # (x23*x56-x26*x35)+x15*x24*x36-x16* # (x23*x45-x24*x35)-x36*x45)+gc13* # (x13*(x24*x56-x26*x45)+x15*(x23* # x46-x24*x36)-x16*(x23*x45-x24*x35)- # x35*x46+x36*x45)+gc14*(-x15*x26+ # x56)+gc15*(-x15*x23-x23*x56+x26* # x35+x35)+gc16*(x15*x26-x56)+gc20* # x16+gc21*(x13+x36)+gc22*(-x14* # x36)+gc23*x16+gc24*(-x13*x46) dpp1bic= 4.d0*gc12*(-x14*s13-x16*s11+x23* # s10+x35*s5)+4.d0*gc13*(-x13*s14- # x26*s7+x56*s1)+4.d0*gc15*(-s2+s13)- # 4.d0*gc16*s6+4.d0*gc22*s8-4.d0* # gc24*s8 if(ockm.eq.'y') then if(ickm.eq.1) then dpp1brc= dpp1brc*vckm(1,1)*vckm(1,1) dpp1bic= dpp1bic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp1brc= dpp1brc*vckm(1,2)*vckm(1,2) dpp1bic= dpp1bic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp1brc= dpp1brc*vckm(1,3)*vckm(1,3) dpp1bic= dpp1bic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp1brc= dpp1brc*vckm(2,1)*vckm(2,1) dpp1bic= dpp1bic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp1brc= dpp1brc*vckm(2,2)*vckm(2,2) dpp1bic= dpp1bic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp1brc= dpp1brc*vckm(2,3)*vckm(2,3) dpp1bic= dpp1bic*vckm(2,3)*vckm(2,3) endif endif * *-----pair production II: common part * dpp2brc= 2.d0*gc13*x13*(-x23*x45+x24*x35)+ # 2.d0*gc16*(x15*x23-x35)+2.d0*gc21* # x23+2.d0*gc23-2.d0*gc24*x13*x24 dpp2bic= 8.d0*gc13*(-x23*s7+x35*s1)-8.d0* # gc24*s1 if(ockm.eq.'y') then if(ickm.eq.1) then dpp2brc= dpp2brc*vckm(1,1)*vckm(1,1) dpp2bic= dpp2bic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp2brc= dpp2brc*vckm(1,2)*vckm(1,2) dpp2bic= dpp2bic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp2brc= dpp2brc*vckm(1,3)*vckm(1,3) dpp2bic= dpp2bic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp2brc= dpp2brc*vckm(2,1)*vckm(2,1) dpp2bic= dpp2bic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp2brc= dpp2brc*vckm(2,2)*vckm(2,2) dpp2bic= dpp2bic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp2brc= dpp2brc*vckm(2,3)*vckm(2,3) dpp2bic= dpp2bic*vckm(2,3)*vckm(2,3) endif endif * *-----production III: common part * dpp3brc= 2.d0*gc21*(-x23+x35)+2.d0*gc23* # (-1.d0+x15)+2.d0*gc24*x13*(x24-x45) dpp3bic= 8.d0*gc24*(s1-s7) if(ockm.eq.'y') then if(ickm.eq.1) then dpp3brc= dpp3brc*vckm(1,1)*vckm(1,1) dpp3bic= dpp3bic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp3brc= dpp3brc*vckm(1,2)*vckm(1,2) dpp3bic= dpp3bic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp3brc= dpp3brc*vckm(1,3)*vckm(1,3) dpp3bic= dpp3bic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp3brc= dpp3brc*vckm(2,1)*vckm(2,1) dpp3bic= dpp3bic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp3brc= dpp3brc*vckm(2,2)*vckm(2,2) dpp3bic= dpp3bic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp3brc= dpp3brc*vckm(2,3)*vckm(2,3) dpp3bic= dpp3bic*vckm(2,3)*vckm(2,3) endif endif * *-----pair production IV: common par * dpp4brc= gc12*(x13*(x24*x56-x26*x45)-x14* # (x23*x56-x26*x35)-x15*x24*x36+x16* # (x23*x45-x24*x35)+x36*x45)+gc14* # (x15*x26-x56)+gc15*(x15*x23-2*x23* # x45+2.d0*x24*x35-x35)+2.d0*gc17- # gc20*x16-gc21*x13+gc22*x14*x36 dpp4bic= 4.d0*gc12*(x14*s13+x16*s11-x23*s10- # x35*s5)+4.d0*gc15*(s2-2.d0*s11)- # 4.d0*gc22*s8 * if(ockm.eq.'y') then if(ickm.eq.1) then dpp4brc= dpp4brc*vckm(1,1)*vckm(1,1) dpp4bic= dpp4bic*vckm(1,1)*vckm(1,1) else if(ickm.eq.2) then dpp4brc= dpp4brc*vckm(1,2)*vckm(1,2) dpp4bic= dpp4bic*vckm(1,2)*vckm(1,2) else if(ickm.eq.3) then dpp4brc= dpp4brc*vckm(1,3)*vckm(1,3) dpp4bic= dpp4bic*vckm(1,3)*vckm(1,3) else if(ickm.eq.4) then dpp4brc= dpp4brc*vckm(2,1)*vckm(2,1) dpp4bic= dpp4bic*vckm(2,1)*vckm(2,1) else if(ickm.eq.5) then dpp4brc= dpp4brc*vckm(2,2)*vckm(2,2) dpp4bic= dpp4bic*vckm(2,2)*vckm(2,2) else if(ickm.eq.6) then dpp4brc= dpp4brc*vckm(2,3)*vckm(2,3) dpp4bic= dpp4bic*vckm(2,3)*vckm(2,3) endif endif * endif * *-----complete diagrams, epsilon parts separated:1 * *-----complete annihilation diagrams:e * dabr= -hsth2*omrz*dabrc dabre= -hsth2*aisz*dabic dabie= -hsth2*omrz*dabic dabi= hsth2*aisz*dabrc * *-----complete pair production I-IV: * gcmd1= tth2*(-0.25d0-0.5d0*chdp+omrz*(0.25d0+ # chdp*hsth2)) gcmd2= tth2*(-0.25d0-0.5d0*chd+omrz*(0.25d0+ # chd*hsth2)) gcmu3= tth2*(-0.25d0+0.5d0*chup+omrz*(0.25d0- # chup*hsth2)) gcmu4= tth2*(-0.25d0+0.5d0*chu+omrz*(0.25d0- # chu*hsth2)) hcmd1= -tsth2*(1.d0+hchdp) hcmd2= -tsth2*(1.d0+hchd) hcmu3= tsth2*(1.d0-hchup) hcmu4= tsth2*(1.d0-hchu) * dpp1br= gcmd1*dpp1brc dpp1bre= -hcmd1*haisz*dpp1bic dpp1bie= gcmd1*dpp1bic dpp1bi= hcmd1*haisz*dpp1brc dpp2br= -gcmd2*dpp2brc dpp2bre= hcmd2*haisz*dpp2bic dpp2bie= -gcmd2*dpp2bic dpp2bi= -hcmd2*haisz*dpp2brc dpp3br= gcmu3*dpp3brc dpp3bre= hcmu3*haisz*dpp3bic dpp3bie= gcmu3*dpp3bic dpp3bi= -hcmu3*haisz*dpp3brc dpp4br= -gcmu4*dpp4brc dpp4bre= -hcmu4*haisz*dpp4bic dpp4bie= -gcmu4*dpp4bic dpp4bi= hcmu4*haisz*dpp4brc * *-----compensating the missing W and the fermion propagators * d11br= (dpp1br*wpcfr-dpp1bi*wpcfi)/pfp+ # (dpp2br*wmcfr-dpp2bi*wmcfi)/pfb+ # (dpp3br*wpcfr-dpp3bi*wpcfi)/pfpb+ # (dpp4br*wmcfr-dpp4bi*wmcfi)/pf d11bre= (dpp1bre*wpcfr-dpp1bie*wpcfi)/pfp+ # (dpp2bre*wmcfr-dpp2bie*wmcfi)/pfb+ # (dpp3bre*wpcfr-dpp3bie*wpcfi)/pfpb+ # (dpp4bre*wmcfr-dpp4bie*wmcfi)/pf d11bi= (dpp1br*wpcfi+dpp1bi*wpcfr)/pfp+ # (dpp2br*wmcfi+dpp2bi*wmcfr)/pfb+ # (dpp3br*wpcfi+dpp3bi*wpcfr)/pfpb+ # (dpp4br*wmcfi+dpp4bi*wmcfr)/pf d11bie= (dpp1bre*wpcfi+dpp1bie*wpcfr)/pfp+ # (dpp2bre*wmcfi+dpp2bie*wmcfr)/pfb+ # (dpp3bre*wpcfi+dpp3bie*wpcfr)/pfpb+ # (dpp4bre*wmcfi+dpp4bie*wmcfr)/pf * * *-----the square of h= b, inclusive of the compensating * nu propagator * dbrc= dabr-d11br dbrec= dabre-d11bre dbiec= dabie-d11bie dbic= dabi-d11bi * dbrc3= dabr dbrec3= dabre dbiec3= dabie dbic3= dabi * *-----NC diagrams * *-----Conversion for helicity sets * * pp pm q1 q2 q3 q4 ==> pp pm q1 q2 q3 q4 * * + - + - + - a + - + - + - b * - + - + - + b - + - + - + f * + - - + - + c + - - + - + g * - + + - + - d - + + - + - h * + - + - - + e + - + + - - i * - + - + + - f - + - - + + l * + - - + + - g + - - - + + m * - + + - - + h - + + + - - n * *-----Re-initialization of variables * y13= x13 y14= x16 y15= x15 y16= x14 y23= x23 y24= x26 y25= x25 y26= x24 y34= x36 y35= x35 y36= x34 y45= x56 y46= x46 y56= x45 y13s= y13*y13 y14s= y14*y14 y15s= y15*y15 y16s= y16*y16 y23s= y23*y23 y24s= y24*y24 y25s= y25*y25 y26s= y26*y26 y34s= y34*y34 y35s= y35*y35 y36s= y36*y36 y45s= y45*y45 y46s= y46*y46 y56s= y56*y56 * w1= s3 w2= s2 w3= s1 w4= -s6 w5= -s5 w6= -s4 w7= -s9 w8= -s8 w9= -s7 w10= -s10 w11= -s13 w12= -s12 w13= -s11 w14= -s14 w15= -s15 * ysm= sd ysd= sm ysp= su ysu= sp ytw= t1+t4 * ypfpb= e3-1.d0 ypfp= e2-1.d0 ypfb= e1-1.d0 ypf= e4-1.d0 * *-----compensating single Z propagators * zpcfr= ysp-rzm2/vv zmcfr= ysm-rzm2/vv zpcfi= ysp*szg zmcfi= ysm*szg * *-----Compensating double Z propagator * ztcfr= zpcfr*zmcfr-ysm*ysp*szgs ztcfi= zpcfr*zmcfi+zmcfr*zpcfi ysmtp= ysm*ysp ypnp= ytw-ysm ypn= ytw+ysp-1.d0 * tgn(1)= y15*y24 tgn(2)= y34*y46 tgn(3)= y34/y46 tgn(4)= y24/y15 tgn(5)= y15/y25 tgn(6)= y15*y25 tgn(7)= y14*y25 tgn(8)= y14*y34 tgn(9)= y25*y46 tgn(10)= y25/y46 tgn(11)= y14/y34 tgn(12)= y45/y36 tgn(13)= y14*y24 tgn(14)= y24/y14 tgn(15)= y45*y36 tgn(16)= y14/y25 * itgn= 0 do l=1,16 if(tgn(l).le.0.d0) then itgn= itgn+1 endif enddo if(itgn.ne.0) then iz= 0 ifz(43)= ifz(43)+1 go to 4 endif * ygpna= sqrt(tgn(1)) ygpnb= sqrt(tgn(2)) ygpnc= sqrt(tgn(3)) ygpnd= sqrt(tgn(4)) ygpne= sqrt(tgn(5)) ygpnf= sqrt(tgn(6)) ygpng= sqrt(tgn(7)) ygmna= sqrt(tgn(8)) ygmnb= sqrt(tgn(9)) ygmnc= sqrt(tgn(10)) ygmnd= sqrt(tgn(11)) ygmne= sqrt(tgn(12)) ygmnf= sqrt(tgn(13)) ygmng= sqrt(tgn(14)) ygmnh= sqrt(tgn(15)) ygmni= sqrt(tgn(16)) * gn1= ygpna/ygpnb gn2= ygpna*ygpnc gn3= ygpna/ygpnc gn4= ygpnd/ygpnb gn5= 1.d0/ygpna/ygpnc gn6= 1.d0/ygpnd/ygpnc gn7= ygpnd/ygpnc gn8= ygpnb/ygpna gn9= ygpnd*ygpnc gn10= ygpnb/ygpnd gn11= ygpna*ygpnb gn12= ygmnd/ygmnb gn13= 1.d0/ygmnc/ygmna gn14= ygmna/ygmnb gn15= ygmnd/ygmnc gn16= 1.d0/ygmnd/ygmnc gn17= ygmna*ygmnb gn18= ygmnc/ygmnd gn19= ygmnc/ygmna gn20= ygmna*ygmnc gn21= ygmnd*ygmnb gn22= ygmnd*ygmnc gn23= ygmnb/ygmnd gn24= ygmnb/ygmna gn25= ygpnc/ygpnd gn26= 1.d0/ygpna/ygpnb gn27= ygpnc/ygpna gn28= 1.d0/ygpnd/ygpnb gn29= ygpne/ygmnh gn30= ygmne/ygpnf gn31= 1.d0/ygpnf/ygmne gn32= 1.d0/ygpnf/ygmnh gn33= ygpne*ygmne gn34= ygpne/ygmne gn35= ygmnh/ygpnf gn36= ygmnh*ygpne gn37= ygpnb*ygmni gn38= ygpnc/ygpng gn39= 1.d0/ygpng/ygpnb gn40= ygmne/ygmnf gn41= ygmng*ygmne gn42= 1.d0/ygmnf/ygmnh gn43= ygmng/ygmnh gn44= ygmne/ygmng gn45= 1.d0/ygmng/ygmnh gn46= ygmnf/ygmnh gn47= ygmnf*ygmne gn48= ygmnh/ygmnf gn49= 1.d0/ygmng/ygmne gn50= ygmng*ygmnh gn51= 1.d0/ygmnf/ygmne gn52= ygmnh/ygmng gn53= ygmnf*ygmnh gn54= ygmnf/ygmne gn55= 1.d0/ygpnb*ygmni gn56= 1.d0/ygpnc/ygpng gn57= ygpnc*ygmni gn58= 1.d0/ygpnc*ygmni gn59= ygpnb/ygpng gn60= ygpnb*ygpng gn61= ygpnc/ygmni gn62= 1.d0/ygpnb/ygmni gn63= ygpnc*ygpng gn64= 1.d0/ygpnc*ygpng gn65= 1.d0/ygpnb*ygpng gn66= ygpnb/ygmni gn67= 1.d0/ygpnc/ygmni gn68= ygpne/ygmne gn69= 1.d0/ygpnf*ygmnh gn70= 1.d0/ygmne*ygmng * *-----NC helicity a-b) * *-----Conversion diagram 1: common part * if(iint.eq.1) then c1abrc= 0.d0 c1abic= 0.d0 else * c1abrc= 16.d0*(gn12*(y13*y24*y56-y13*y26*y45-y14* # y23*y56-y14*y25*y36+y14*y26*y35-y15*y24*y36+ # y16*y23*y45-y16*y24*y35+y36*y45)+gn13*(-y13* # y24*y56-y13*y25*y46+y13*y26*y45-y15*y23*y46+ # y15*y24*y36+y16*y23*y45-y16*y24*y35+y35*y46- # y36*y45)+gn14*(y15*y26+y16*y25-y56)+gn15*(y13* # y25+y15*y23+y23*y56+y25*y36-y26*y35-y35)+gn16* # (-y15*y26+y16*y25+y56)) c1abic= 64.d0*(w1*gn12*y56+w1*gn13*(-2.d0*y15+y56)+ # 2.d0*w5*gn38*(-y15+y56)-w6*gn14+w6*gn16+w7*gn13* # y26+2.d0*w8*gn39*y24*(y15-y56)-w8*gn13*y25+w9* # gn12*y24-w10*gn12*y23+w11*gn12*y16+w12*gn12*(-y15+ # 2.d0*y56)-w13*gn15+w14*gn13*y13) * endif xc1r= c1abrc xc1i= c1abic xc2r= 16.d0*(ogn55*(x13*x24*x56-x13*x26*x45-x14* # x23*x56-x14*x25*x36+x14*x26*x35-x15* # x24*x36+x16*x23*x45-x16*x24*x35+x36* # x45)+ogn57*(x15*x26+x16*x25-x56)+ogn58* # (x13*x25+x15*x23-2.d0*x23*x45+2.d0* # x24*x35-x35)-2.d0*ogn37*x25) xc2i= 64.d0*(s2*ogn58-s5*ogn55*x35+s8*ogn55*x25- # s10*ogn55*x23+s11*ogn55*x16-2.d0*s11* # ogn58+s13*ogn55*x14) if(iint.eq.1) then cmod= 1 else cmod= xc1r*xc1r+xc1i*xc1i endif phr= (xc2r*xc1r+xc2i*xc1i)/cmod phie= (-xc2r*xc1i+xc2i*xc1r)/cmod * *-----Conversion diagram 2: common part * if(iint.eq.1) then c2abrc= 0.d0 c2abic= 0.d0 else * c2abrc= 32.d0*(-gn12*y14*y25*y36+gn14*y16*y25+gn15*y13* # y25-2.d0*gn37*y25) c2abic= 128.d0*w8*gn12*y25 * endif * *-----Pair production I: common part * if(iint.eq.1) then p1abrc= 0.d0 p1abic= 0.d0 else * p1abrc= 32.d0*(gn13*y13*y25*(y24-y45)+gn15*y25* # (-y23+y35)+gn16*y25*(y15-1.d0)) p1abic= 128.d0*gn13*y25*(w1-w7) * endif * *-----Pair production II: common part * if(iint.eq.1) then p2abrc= 0.d0 p2abic= 0.d0 else * p2abrc= 16.d0*(gn12*(-y13*y24*y56+y13*y26*y45+ # y14*y23*y56-y14*y25*y36-y14*y26*y35+y15* # y24*y36-y16*y23*y45+y16*y24*y35-y36*y45)+ # gn13*(y13*y24*y56-y13*y25*y46-y13*y26*y45+ # y15*y23*y46-y15*y24*y36-y16*y23*y45+y16* # y24*y35-y35*y46+y36*y45)+gn14*(-y15*y26+ # y16*y25+y56)+gn15*(y13*y25-y15*y23-y23*y56+ # y25*y36+y26*y35+y35)+gn16*(y15*y26+y16*y25- # y56)) p2abic= 64.d0*(w1*gn13*y56-w2*gn15+w5*gn12*y35-w6* # gn16-w7*gn13*y26+w8*gn12*y25-w8*gn13*y25+w10* # gn12*y23-w11*gn12*y16-w13*gn12*y14+w13*gn15- # w14*gn13*y13) * endif * *-----Pair production III: common part * if(iint.eq.1) then p3abrc= 0.d0 p3abic= 0.d0 else * p3abrc= 16.d0*(gn12*(y13*y24*y56-y13*y26*y45-y14* # y23*y56+y14*y25*y36+y14*y26*y35-y15*y24* # y36+y16*y23*y45-y16*y24*y35+y36*y45)+gn14* # (y15*y26-y16*y25-y56)+gn15*(-y13*y25+y15* # y23-2.d0*y23*y45+2.d0*y24*y35-y35)+2.d0* # gn37*y25) p3abic= 64.d0*(w2*gn15-w5*gn12*y35-w8*gn12*y25- # w10*gn12*y23+w11*gn12*y16-2.d0*w11*gn15+ # w13*gn12*y14) * endif * *-----Pair production IV: common part * if(iint.eq.1) then p4abrc= 0.d0 p4abic= 0.d0 else * p4abrc= 32.d0*(gn13*y13*(-y23*y45-y24*y25+ # y24*y35)+gn15*y23*y25+gn16*(y15*y23+ # y25-y35)) p4abic= 128.d0*gn13*((y35-y25)*w1-y23*w7) * endif * *-----NC helicity c-d) * *-----Conversion diagram 1: common part * if(iint.eq.1) then c1cdrc= 0.d0 c1cdic= 0.d0 else * c1cdrc= 32.d0*(gn1*y36*(y14-y45)+gn2* # (-y16+y56)+gn3*(-y13+y35)) c1cdic= 128.d0*gn1*(w8-w15) * endif * *-----Conversion diagram 2: common part * if(iint.eq.1) then c2cdrc= 0.d0 c2cdic= 0.d0 else * c2cdrc= 32.d0*(gn1*y14*y36-gn2*y16+gn4* # y36*(y13*y45-y14*y35)+gn5*y23*(- # y13*y45+y14*y35)-gn6*y14*y23+gn8* # (y13*y25-y35)+gn9*(-y13*y56+y16*y35)+gn10) c2cdic= 128.d0*(w1*gn5*y35+w5*gn25-w8*gn4* # y35+w11*gn5*y13+w12*gn28*y14+w15*gn4*y13) * endif * *-----Pair production I: common part * if(iint.eq.1) then p1cdrc= 0.d0 p1cdic= 0.d0 else * p1cdrc= 32.d0*(gn3*(y13-y35)+gn6*y23* # (-y14+y45)+gn10*(1.d0-y25)) p1cdic= -128.d0*gn6*(w1+w11) * endif * *-----Pair production II: common part * if(iint.eq.1) then p2cdrc= 0.d0 p2cdic= 0.d0 else * p2cdrc= 16.d0*(gn1*y24*y36-gn2*y26-gn3* # (y23+y36)+gn4*(-y13*y24*y56+y13* # y26*y45+y14*y23*y56-y14*y25*y36- # y14*y26*y35-y16*y23*y45+y16*y24* # y35+y36*y45)+gn5*(-y13*y25*y46+ # y13*y26*y45-y14*y23*y56+y14*y25* # y36-y14*y26*y35+y16*y23*y45+y35* # y46-y36*y45)+gn6*(y23*y46)+gn7* # (y13*y25+y13*y56-y16*y35-y35)+ # gn8*(-y16*y25+y56)+gn9*(y16*y25- # y56)-gn10*y26) p2cdic= 64.d0*(-w2*gn5*y46+w2*gn7-w4* # gn4*y36+w4*gn5*y36+w6*gn8-w6*gn9- # 2.d0*w7*gn5*y26-w8*gn4*y25+w8*gn5* # y25+w12*gn1-w12*gn6+w15*gn4-w15* # gn5) * endif * *-----Pair production III: common part * if(iint.eq.1) then p3cdrc= 0.d0 p3cdic= 0.d0 else * p3cdrc= 16.d0*(-gn1*y24*y36+gn2*y26+gn3* # y23+gn4*(y13*y24*y56-y13*y26*y45-y14* # y23*y56+y14*y25*y36+y14*y26*y35+y16* # y23*y45-y16*y24*y35-y36*y45)+gn7*(- # y13*y25+2.d0*y13*y45-2.d0*y14*y35+ # y35)+gn9*(-y16*y25+y56)-2.d0*gn11) p3cdic= 64.d0*(-w2*gn7+w4*gn4*y36+w6*gn9- # 2.d0*w7*gn7+w8*gn4*y25-w12*gn1-w15* # gn4) * endif * *-----Pair production IV: common part * if(iint.eq.1) then p4cdrc= 0.d0 p4cdic= 0.d0 else * p4cdrc= 32.d0*(-gn3*y13+gn5*y23*(y13* # y45-y14*y35)+gn6*y14*y23+gn8*(- # y13*y25+y35)-gn10) p4cdic= 128.d0*(w1*gn6-w2*gn8-w7*gn5*y23) * endif * *-----NC helicity e-f) * *-----Conversion diagram 1: common part * if(iint.eq.1) then c1efrc= 0.d0 c1efic= 0.d0 else * c1efrc= 16.d0*(gn40*(y13*y25*y46-y13*y26* # y45-y15*y23*y46+y15*y26*y34+y16*y23* # y45-y16*y25*y34+y34*y56-y35*y46)+gn41* # (-y13*y56+y16*y35)+gn44*(y13*y26-y16* # y23-y23*y56+y26*y35)+gn45*(-y13*y25* # y46+y14*y23*y56-y14*y26*y35-y15*y23* # y46+y15*y26*y34+y16*y25*y34-y34*y56+ # y35*y46)+gn46*(y13*y56-y16*y35)+gn48* # y45+gn49*y14*y25-gn50*y15-gn52*(1.d0+ # y25)-gn54*y15) c1efic= 64.d0*(-w1*gn40*y56+w3*gn44+w4* # gn48-w4*gn49-w5*gn40*y35+w7*gn45* # y26+w9*gn41-w10*gn45*y23+w12*gn45* # y15+w13*gn44-w13*gn45*y14+w15*gn40) * endif * *-----Conversion diagram 2: common part * if(iint.eq.1) then c2efrc= 0.d0 c2efic= 0.d0 else * c2efrc= 16.d0*(gn44*(y13*y26-y16*y23+ # 2.d0*y23*y46-2.d0*y26*y34)+gn45* # (-y13*y25*y46+y14*y23*y56-y14*y26* # y35-y15*y23*y46+y15*y26*y34+y16*y25* # y34-y34*y56+y35*y46)+gn46*(y13*y56- # y16*y35)-gn49*y14*y25+gn52-2.d0*gn53+ # gn54*y15) c2efic= 64.d0*(w3*gn44+w4*gn49+w7*gn45*y26- # w10*gn45*y23-2.d0*w12*gn44+w12*gn45* # y15-w13*gn45*y14) * endif * *-----Pair production I: common part * if(iint.eq.1) then p1efrc= 0.d0 p1efic= 0.d0 else * p1efrc= 32.d0*(-gn48*y45-gn49*y14*y25+ # gn50*y15+gn52*(1.d0+y25)+gn54*y15) p1efic= 128.d0*(gn49-gn48)*w4 * endif * *-----Pair production II: common part * if(iint.eq.1) then p2efrc= 0.d0 p2efic= 0.d0 else * p2efrc= 32.d0*(gn40*(y23*y46-y26*y34)+ # gn41*(y13*y26-y16*y23)-gn48*y46+ # gn50*y16+gn52*y26) p2efic= 128.d0*(w1*gn40*y26+w5*gn40* # y23-w5*gn48) * endif * *-----Pair production III: common part * if(iint.eq.1) then p3efrc= 0.d0 p3efic= 0.d0 else * p3efrc= 32.d0*(gn49*y14*y25-gn52+2.d0* # gn53-gn54*y15) p3efic= -128.d0*w4*gn49 * endif * *-----Pair production IV: common part * if(iint.eq.1) then p4efrc= 0.d0 p4efic= 0.d0 else * p4efrc= 32.d0*(gn40*(-y23*y46+y26*y34)+ # gn41*(-y13*y26+y16*y23)-gn48*y34+ # gn50*y13+gn52*y23) p4efic= 64.d0*(w1*gn42*(y34*y56+2.d0* # y35*y46)-w1*gn43*y56-w2*gn42*y34* # y46-w2*gn43*y46-w4*gn51*y34+2.d0* # w5*gn42*y34*y35-w5*gn43*y35-w6* # gn43*y34-w7*gn43*y26-w8*gn42*y25* # y34+2.d0*w8*gn43*y25-w9*gn43* # y34-w10*gn42*y23*y34+w10*gn43* # y23+w11*gn42*(y16*y34+2.d0*y46)- # w11*gn43*y16+2.d0*w13*gn45*y34- # 2.d0*w13*gn46-2.d0*w14*gn42* # y34+w14*gn43*y13+w15*gn42*y34- # 2.d0*w15*gn43*y13+2.d0*w15*gn45* # y23) * endif * *-----NC helicity g-h) * *-----Conversion diagram 1: common part * if(iint.eq.1) then c1ghrc= 0.d0 c1ghic= 0.d0 else * c1ghrc= 32.d0*(gn29*(-y13*y25*y46+y16* # y25*y34)+gn30*(-y13*y56+y16*y35)- # gn31*y14*y25*y56+gn32*(y13*y14* # y25*y56-y14*y16*y25*y35)+gn33*(y13* # y26-y16*y23)+gn34*y25*y46+gn35*y56- # gn36*y26) c1ghic= 128.d0*(-w2*gn30*y16-w6*gn30*y13+ # w6*gn35-w7*gn32*y16*y25-w10*gn31*y25+ # w10*gn32*y13*y25) * endif * *-----Conversion diagram 2: common part * if(iint.eq.1) then c2ghrc= 0.d0 c2ghic= 0.d0 else * c2ghrc= 32.d0*(gn29*y25*(-y13*y46+y16*y34)+ # gn31*y14*y25*y35+gn32*y14*y25*(y13* # y56-y16*y35)-gn34*y25*y34-gn35*y13*y25) c2ghic= 128.d0*(w7*gn31*y25-w8*gn29*y25+w9* # gn32*y14*y25) * endif * *-----Pair production I: common part * if(iint.eq.1) then p1ghrc= 0.d0 p1ghic= 0.d0 else * p1ghrc= 32.d0*(gn31*y14*y25s-gn34*y24*y25- # gn35*y25+2.d0*gn36*y25) p1ghic= 128.d0*w4*gn31*y25 endif * *-----Pair production II: common part * if(iint.eq.1) then p2ghrc= 0.d0 p2ghic= 0.d0 else p2ghrc= 32.d0*(gn30*(y13*y56-y16*y35)+gn33* # (-y13*y26+y16*y23)+gn35*(y16*y25-y56)+ # gn36*y26) p2ghic= 128.d0*(w2*gn30*y16+w6*gn30*y13-w6* # gn35+w7*gn32*(y16*y25-0.5d0*y25*y26)- # w8*gn29*y25+0.5d0*w8*gn32*y25s+w9*gn32* # y25*(y14-0.5d0*y24)+w10*gn32*y25*(-y13+ # 0.5d0*y23)+0.5d0*w11*gn32*y16*y25-0.5d0* # w12*gn29*y25+0.5d0*w13*gn32*y14*y25- # 0.5d0*w14*gn32*y13*y25) endif * *-----Pair production III: common part * if(iint.eq.1) then p3ghrc= 0.d0 p3ghic= 0.d0 else p3ghrc= 32.d0*(-gn31*y14*y25s+gn34*y24*y25+ # gn35*(y14*y25+y25-y45)+gn36*y24) p3ghic= 128.d0*w4*(gn35-gn31*y25) endif * *-----Pair production IV: common part * if(iint.eq.1) then p4ghrc= 0.d0 p4ghic= 0.d0 else p4ghrc= 32.d0*(gn30*(-y13*y56+y16*y35)+ # gn33*(y13*y26-y16*y23)+gn35*(y13* # y25-y35)+gn36*y23) p4ghic= 128.d0*(-w2*gn30*y16+w2*gn35-w6* # gn30*y13) endif * * *-----All Conversion I/II gamma-gamma * cc1gg= -conc(1)/ysmtp/ypn*corrgu*corrgd cc2gg= conc(1)/ysmtp/ypnp*corrgu*corrgd * cc1ggr= cc1gg*ztcfr cc1ggi= cc1gg*ztcfi cc2ggr= cc2gg*ztcfr cc2ggi= cc2gg*ztcfi * c1aggr= cc1ggr*c1abrc c1aggre= -cc1ggi*c1abic c1aggie= cc1ggr*c1abic c1aggi= cc1ggi*c1abrc * c1bggr= -c1aggr c1bggre= c1aggre c1bggie= c1aggie c1bggi= -c1aggi * c1cggr= cc1ggr*c1cdrc c1cggre= -cc1ggi*c1cdic c1cggie= cc1ggr*c1cdic c1cggi= cc1ggi*c1cdrc * c1dggr= -c1cggr c1dggre= c1cggre c1dggie= c1cggie c1dggi= -c1cggi * c1eggr= cc1ggr*c1efrc c1eggre= -cc1ggi*c1efic c1eggie= cc1ggr*c1efic c1eggi= cc1ggi*c1efrc * c1fggr= -c1eggr c1fggre= c1eggre c1fggie= c1eggie c1fggi= -c1eggi * c1gggr= cc1ggr*c1ghrc c1gggre= -cc1ggi*c1ghic c1gggie= cc1ggr*c1ghic c1gggi= cc1ggi*c1ghrc * c1hggr= -c1gggr c1hggre= c1gggre c1hggie= c1gggie c1hggi= -c1gggi * c2aggr= cc2ggr*c2abrc c2aggre= -cc2ggi*c2abic c2aggie= cc2ggr*c2abic c2aggi= cc2ggi*c2abrc * c2bggr= -c2aggr c2bggre= c2aggre c2bggie= c2aggie c2bggi= -c2aggi * c2cggr= cc2ggr*c2cdrc c2cggre= -cc2ggi*c2cdic c2cggie= cc2ggr*c2cdic c2cggi= cc2ggi*c2cdrc * c2dggr= -c2cggr c2dggre= c2cggre c2dggie= c2cggie c2dggi= -c2cggi * c2eggr= cc2ggr*c2efrc c2eggre= -cc2ggi*c2efic c2eggie= cc2ggr*c2efic c2eggi= cc2ggi*c2efrc * c2fggr= -c2eggr c2fggre= c2eggre c2fggie= c2eggie c2fggi= -c2eggi * c2gggr= cc2ggr*c2ghrc c2gggre= -cc2ggi*c2ghic c2gggie= cc2ggr*c2ghic c2gggi= cc2ggi*c2ghrc * c2hggr= -c2gggr c2hggre= c2gggre c2hggie= c2gggie c2hggi= -c2gggi * *-----All Conversion I gamma-Z * cc1gz= -conc(3)/ysp/ypn*corrgu * do i=1,4 har(i)= hch(i)*cc1gz*zpcfr hai(i)= hch(i)*cc1gz*zpcfi enddo * c1agzr= -har(1)*c1abrc c1agzre= hai(1)*c1abic c1agzie= -har(1)*c1abic c1agzi= -hai(1)*c1abrc * c1bgzr= har(2)*c1abrc c1bgzre= hai(2)*c1abic c1bgzie= -har(2)*c1abic c1bgzi= hai(2)*c1abrc * c1cgzr= -har(3)*c1cdrc c1cgzre= hai(3)*c1cdic c1cgzie= -har(3)*c1cdic c1cgzi= -hai(3)*c1cdrc * c1dgzr= har(4)*c1cdrc c1dgzre= hai(4)*c1cdic c1dgzie= -har(4)*c1cdic c1dgzi= hai(4)*c1cdrc * c1egzr= -har(1)*c1efrc c1egzre= hai(1)*c1efic c1egzie= -har(1)*c1efic c1egzi= -hai(1)*c1efrc * c1fgzr= har(2)*c1efrc c1fgzre= hai(2)*c1efic c1fgzie= -har(2)*c1efic c1fgzi= hai(2)*c1efrc * c1ggzr= -har(3)*c1ghrc c1ggzre= hai(3)*c1ghic c1ggzie= -har(3)*c1ghic c1ggzi= -hai(3)*c1ghrc * c1hgzr= har(4)*c1ghrc c1hgzre= hai(4)*c1ghic c1hgzie= -har(4)*c1ghic c1hgzi= hai(4)*c1ghrc * *-----All Conversion II gamma-Z * cc2gz= conc(2)/ysm/ypnp*corrgd * do i=1,4 ip4= i+4 hbpr(i)= hch(ip4)*cc2gz*zmcfr hbpi(i)= hch(ip4)*cc2gz*zmcfi enddo * c2agzr= -hbpr(1)*c2abrc c2agzre= hbpi(1)*c2abic c2agzie= -hbpr(1)*c2abic c2agzi= -hbpi(1)*c2abrc * c2bgzr= hbpr(2)*c2abrc c2bgzre= hbpi(2)*c2abic c2bgzie= -hbpr(2)*c2abic c2bgzi= hbpi(2)*c2abrc * c2cgzr= -hbpr(3)*c2cdrc c2cgzre= hbpi(3)*c2cdic c2cgzie= -hbpr(3)*c2cdic c2cgzi= -hbpi(3)*c2cdrc * c2dgzr= hbpr(4)*c2cdrc c2dgzre= hbpi(4)*c2cdic c2dgzie= -hbpr(4)*c2cdic c2dgzi= hbpi(4)*c2cdrc * c2egzr= -hbpr(3)*c2efrc c2egzre= hbpi(3)*c2efic c2egzie= -hbpr(3)*c2efic c2egzi= -hbpi(3)*c2efrc * c2fgzr= hbpr(4)*c2efrc c2fgzre= hbpi(4)*c2efic c2fgzie= -hbpr(4)*c2efic c2fgzi= hbpi(4)*c2efrc * c2ggzr= -hbpr(1)*c2ghrc c2ggzre= hbpi(1)*c2ghic c2ggzie= -hbpr(1)*c2ghic c2ggzi= -hbpi(1)*c2ghrc * c2hgzr= hbpr(2)*c2ghrc c2hgzre= hbpi(2)*c2ghic c2hgzie= -hbpr(2)*c2ghic c2hgzi= hbpi(2)*c2ghrc * *-----All Conversion I Z-gamma * cc1zg= -conc(2)/ysm/ypn*corrgd * do i=1,4 ip4= i+4 hapr(i)= hch(ip4)*cc1zg*zmcfr hapi(i)= hch(ip4)*cc1zg*zmcfi enddo * c1azgr= -hapr(1)*c1abrc c1azgre= hapi(1)*c1abic c1azgie= -hapr(1)*c1abic c1azgi= -hapi(1)*c1abrc * c1bzgr= hapr(2)*c1abrc c1bzgre= hapi(2)*c1abic c1bzgie= -hapr(2)*c1abic c1bzgi= hapi(2)*c1abrc * c1czgr= -hapr(3)*c1cdrc c1czgre= hapi(3)*c1cdic c1czgie= -hapr(3)*c1cdic c1czgi= -hapi(3)*c1cdrc * c1dzgr= hapr(4)*c1cdrc c1dzgre= hapi(4)*c1cdic c1dzgie= -hapr(4)*c1cdic c1dzgi= hapi(4)*c1cdrc * c1ezgr= -hapr(3)*c1efrc c1ezgre= hapi(3)*c1efic c1ezgie= -hapr(3)*c1efic c1ezgi= -hapi(3)*c1efrc * c1fzgr= hapr(4)*c1efrc c1fzgre= hapi(4)*c1efic c1fzgie= -hapr(4)*c1efic c1fzgi= hapi(4)*c1efrc * c1gzgr= -hapr(1)*c1ghrc c1gzgre= hapi(1)*c1ghic c1gzgie= -hapr(1)*c1ghic c1gzgi= -hapi(1)*c1ghrc * c1hzgr= hapr(2)*c1ghrc c1hzgre= hapi(2)*c1ghic c1hzgie= -hapr(2)*c1ghic c1hzgi= hapi(2)*c1ghrc * *-----All Conversion II Z-gamma * cc2zg= conc(3)/ysp/ypnp*corrgu * do i=1,4 hbr(i)= hch(i)*cc2zg*zpcfr hbi(i)= hch(i)*cc2zg*zpcfi enddo * c2azgr= -hbr(1)*c2abrc c2azgre= hbi(1)*c2abic c2azgie= -hbr(1)*c2abic c2azgi= -hbi(1)*c2abrc * c2bzgr= hbr(2)*c2abrc c2bzgre= hbi(2)*c2abic c2bzgie= -hbr(2)*c2abic c2bzgi= hbi(2)*c2abrc * c2czgr= -hbr(3)*c2cdrc c2czgre= hbi(3)*c2cdic c2czgie= -hbr(3)*c2cdic c2czgi= -hbi(3)*c2cdrc * c2dzgr= hbr(4)*c2cdrc c2dzgre= hbi(4)*c2cdic c2dzgie= -hbr(4)*c2cdic c2dzgi= hbi(4)*c2cdrc * c2ezgr= -hbr(1)*c2efrc c2ezgre= hbi(1)*c2efic c2ezgie= -hbr(1)*c2efic c2ezgi= -hbi(1)*c2efrc * c2fzgr= hbr(2)*c2efrc c2fzgre= hbi(2)*c2efic c2fzgie= -hbr(2)*c2efic c2fzgi= hbi(2)*c2efrc * c2gzgr= -hbr(3)*c2ghrc c2gzgre= hbi(3)*c2ghic c2gzgie= -hbr(3)*c2ghic c2gzgi= -hbi(3)*c2ghrc * c2hzgr= hbr(4)*c2ghrc c2hzgre= hbi(4)*c2ghic c2hzgie= -hbr(4)*c2ghic c2hzgi= hbi(4)*c2ghrc * *-----All Conversion I/II Z-Z * do i=1,8 ip8= i+8 hc(i)= -hch(ip8)*conc(5)/ypn hcp(i)= hch(ip8)*conc(5)/ypnp enddo * c1azzr= hc(1)*c1abrc c1azzie= hc(1)*c1abic * c1bzzr= -hc(2)*c1abrc c1bzzie= hc(2)*c1abic * c1czzr= hc(7)*c1cdrc c1czzie= hc(7)*c1cdic * c1dzzr= -hc(8)*c1cdrc c1dzzie= hc(8)*c1cdic * c1ezzr= hc(3)*c1efrc c1ezzie= hc(3)*c1efic * c1fzzr= -hc(4)*c1efrc c1fzzie= hc(4)*c1efic * c1gzzr= hc(5)*c1ghrc c1gzzie= hc(5)*c1ghic * c1hzzr= -hc(6)*c1ghrc c1hzzie= hc(6)*c1ghic * c2azzr= hcp(1)*c2abrc c2azzie= hcp(1)*c2abic * c2bzzr= -hcp(2)*c2abrc c2bzzie= hcp(2)*c2abic * c2czzr= hcp(7)*c2cdrc c2czzie= hcp(7)*c2cdic * c2dzzr= -hcp(8)*c2cdrc c2dzzie= hcp(8)*c2cdic * c2ezzr= hcp(3)*c2efrc c2ezzie= hcp(3)*c2efic * c2fzzr= -hcp(4)*c2efrc c2fzzie= hcp(4)*c2efic * c2gzzr= hcp(5)*c2ghrc c2gzzie= hcp(5)*c2ghic * c2hzzr= -hcp(6)*c2ghrc c2hzzie= hcp(6)*c2ghic * *-----All PP1-PP2 gamma-gamma * cp12gg= conc(6)/ysm*corrgs*corrgd cp1ggr= cp12gg/ypfpb*ztcfr cp2ggr= -cp12gg/ypfp*ztcfr cp1ggi= cp12gg/ypfpb*ztcfi cp2ggi= -cp12gg/ypfp*ztcfi * p1aggr= -cp1ggr*p1abrc p1aggre= cp1ggi*p1abic p1aggie= -cp1ggr*p1abic p1aggi= -cp1ggi*p1abrc * p1bggr= -p1aggr p1bggre= p1aggre p1bggie= p1aggie p1bggi= -p1aggi * p1cggr= -cp1ggr*p1cdrc p1cggre= cp1ggi*p1cdic p1cggie= -cp1ggr*p1cdic p1cggi= -cp1ggi*p1cdrc * p1dggr= -p1cggr p1dggre= p1cggre p1dggie= p1cggie p1dggi= -p1cggi * p1eggr= -cp1ggr*p1efrc p1eggre= cp1ggi*p1efic p1eggie= -cp1ggr*p1efic p1eggi= -cp1ggi*p1efrc * p1fggr= -p1eggr p1fggre= p1eggre p1fggie= p1eggie p1fggi= -p1eggi * p1gggr= -cp1ggr*p1ghrc p1gggre= cp1ggi*p1ghic p1gggie= -cp1ggr*p1ghic p1gggi= -cp1ggi*p1ghrc * p1hggr= -p1gggr p1hggre= p1gggre p1hggie= p1gggie p1hggi= -p1gggi * p2aggr= -cp2ggr*p2abrc p2aggre= cp2ggi*p2abic p2aggie= -cp2ggr*p2abic p2aggi= -cp2ggi*p2abrc * p2bggr= -p2aggr p2bggre= p2aggre p2bggie= p2aggie p2bggi= -p2aggi * p2cggr= -cp2ggr*p2cdrc p2cggre= cp2ggi*p2cdic p2cggie= -cp2ggr*p2cdic p2cggi= -cp2ggi*p2cdrc * p2dggr= -p2cggr p2dggre= p2cggre p2dggie= p2cggie p2dggi= -p2cggi * p2eggr= -cp2ggr*p2efrc p2eggre= cp2ggi*p2efic p2eggie= -cp2ggr*p2efic p2eggi= -cp2ggi*p2efrc * p2fggr= -p2eggr p2fggre= p2eggre p2fggie= p2eggie p2fggi= -p2eggi * p2gggr= -cp2ggr*p2ghrc p2gggre= cp2ggi*p2ghic p2gggie= -cp2ggr*p2ghic p2gggi= -cp2ggi*p2ghrc * p2hggr= -p2gggr p2hggre= p2gggre p2hggie= p2gggie p2hggi= -p2gggi * *-----All PP1 gamma-Z * cp1gz= -conc(3)/ypfpb*corrgs * do i=1,4 ip16= i+16 hdr(i)= hch(ip16)*cp1gz*zpcfr hdi(i)= hch(ip16)*cp1gz*zpcfi enddo * p1agzr= hdr(3)*p1abrc p1agzre= -hdi(3)*p1abic p1agzie= hdr(3)*p1abic p1agzi= hdi(3)*p1abrc * p1bgzr= -hdr(4)*p1abrc p1bgzre= -hdi(4)*p1abic p1bgzie= hdr(4)*p1abic p1bgzi= -hdi(4)*p1abrc * p1cgzr= hdr(4)*p1cdrc p1cgzre= -hdi(4)*p1cdic p1cgzie= hdr(4)*p1cdic p1cgzi= hdi(4)*p1cdrc * p1dgzr= -hdr(3)*p1cdrc p1dgzre= -hdi(3)*p1cdic p1dgzie= hdr(3)*p1cdic p1dgzi= -hdi(3)*p1cdrc * p1egzr= hdr(2)*p1efrc p1egzre= -hdi(2)*p1efic p1egzie= hdr(2)*p1efic p1egzi= hdi(2)*p1efrc * p1fgzr= -hdr(1)*p1efrc p1fgzre= -hdi(1)*p1efic p1fgzie= hdr(1)*p1efic p1fgzi= -hdi(1)*p1efrc * p1ggzr= hdr(1)*p1ghrc p1ggzre= -hdi(1)*p1ghic p1ggzie= hdr(1)*p1ghic p1ggzi= hdi(1)*p1ghrc * p1hgzr= -hdr(2)*p1ghrc p1hgzre= -hdi(2)*p1ghic p1hgzie= hdr(2)*p1ghic p1hgzi= -hdi(2)*p1ghrc * * *-----All PP2 gamma-Z * cp2gz= conc(3)/ypfp*corrgs * do i=1,4 ip16= i+16 her(i)= hch(ip16)*cp2gz*zpcfr hei(i)= hch(ip16)*cp2gz*zpcfi enddo * p2agzr= her(3)*p2abrc p2agzre= -hei(3)*p2abic p2agzie= her(3)*p2abic p2agzi= hei(3)*p2abrc * p2bgzr= -her(4)*p2abrc p2bgzre= -hei(4)*p2abic p2bgzie= her(4)*p2abic p2bgzi= -hei(4)*p2abrc * p2cgzr= her(4)*p2cdrc p2cgzre= -hei(4)*p2cdic p2cgzie= her(4)*p2cdic p2cgzi= hei(4)*p2cdrc * p2dgzr= -her(3)*p2cdrc p2dgzre= -hei(3)*p2cdic p2dgzie= her(3)*p2cdic p2dgzi= -hei(3)*p2cdrc * p2egzr= her(2)*p2efrc p2egzre= -hei(2)*p2efic p2egzie= her(2)*p2efic p2egzi= hei(2)*p2efrc * p2fgzr= -her(1)*p2efrc p2fgzre= -hei(1)*p2efic p2fgzie= her(1)*p2efic p2fgzi= -hei(1)*p2efrc * p2ggzr= her(1)*p2ghrc p2ggzre= -hei(1)*p2ghic p2ggzie= her(1)*p2ghic p2ggzi= hei(1)*p2ghrc * p2hgzr= -her(2)*p2ghrc p2hgzre= -hei(2)*p2ghic p2hgzie= her(2)*p2ghic p2hgzi= -hei(2)*p2ghrc * * *-----All PP1 Z-gamma * cp1zg= conc(4)/ysm/ypfpb*corrgd * do i=1,4 ip4= i+4 hfr(i)= hch(ip4)*cp1zg*ztcfr hfi(i)= hch(ip4)*cp1zg*ztcfi enddo * ap1azgr= hfr(1)*p1abrc ap1azgre= -hfi(1)*p1abic ap1azgie= hfr(1)*p1abic ap1azgi= hfi(1)*p1abrc p1azgr= ap1azgr*rsz-ap1azgi*aisz p1azgre= ap1azgre*rsz-ap1azgie*aisz p1azgie= ap1azgie*rsz+ap1azgre*aisz p1azgi= ap1azgi*rsz+ap1azgr*aisz * ap1bzgr= -hfr(2)*p1abrc ap1bzgre= -hfi(2)*p1abic ap1bzgie= hfr(2)*p1abic ap1bzgi= -hfi(2)*p1abrc p1bzgr= ap1bzgr*rsz-ap1bzgi*aisz p1bzgre= ap1bzgre*rsz-ap1bzgie*aisz p1bzgie= ap1bzgie*rsz+ap1bzgre*aisz p1bzgi= ap1bzgi*rsz+ap1bzgr*aisz * ap1czgr= hfr(3)*p1cdrc ap1czgre= -hfi(3)*p1cdic ap1czgie= hfr(3)*p1cdic ap1czgi= hfi(3)*p1cdrc p1czgr= ap1czgr*rsz-ap1czgi*aisz p1czgre= ap1czgre*rsz-ap1czgie*aisz p1czgie= ap1czgie*rsz+ap1czgre*aisz p1czgi= ap1czgi*rsz+ap1czgr*aisz * ap1dzgr= -hfr(4)*p1cdrc ap1dzgre= -hfi(4)*p1cdic ap1dzgie= hfr(4)*p1cdic ap1dzgi= -hfi(4)*p1cdrc p1dzgr= ap1dzgr*rsz-ap1dzgi*aisz p1dzgre= ap1dzgre*rsz-ap1dzgie*aisz p1dzgie= ap1dzgie*rsz+ap1dzgre*aisz p1dzgi= ap1dzgi*rsz+ap1dzgr*aisz * ap1ezgr= hfr(3)*p1efrc ap1ezgre= -hfi(3)*p1efic ap1ezgie= hfr(3)*p1efic ap1ezgi= hfi(3)*p1efrc p1ezgr= ap1ezgr*rsz-ap1ezgi*aisz p1ezgre= ap1ezgre*rsz-ap1ezgie*aisz p1ezgie= ap1ezgie*rsz+ap1ezgre*aisz p1ezgi= ap1ezgi*rsz+ap1ezgr*aisz * ap1fzgr= -hfr(4)*p1efrc ap1fzgre= -hfi(4)*p1efic ap1fzgie= hfr(4)*p1efic ap1fzgi= -hfi(4)*p1efrc p1fzgr= ap1fzgr*rsz-ap1fzgi*aisz p1fzgre= ap1fzgre*rsz-ap1fzgie*aisz p1fzgie= ap1fzgie*rsz+ap1fzgre*aisz p1fzgi= ap1fzgi*rsz+ap1fzgr*aisz * ap1gzgr= hfr(1)*p1ghrc ap1gzgre= -hfi(1)*p1ghic ap1gzgie= hfr(1)*p1ghic ap1gzgi= hfi(1)*p1ghrc p1gzgr= ap1gzgr*rsz-ap1gzgi*aisz p1gzgre= ap1gzgre*rsz-ap1gzgie*aisz p1gzgie= ap1gzgie*rsz+ap1gzgre*aisz p1gzgi= ap1gzgi*rsz+ap1gzgr*aisz * ap1hzgr= -hfr(2)*p1ghrc ap1hzgre= -hfi(2)*p1ghic ap1hzgie= hfr(2)*p1ghic ap1hzgi= -hfi(2)*p1ghrc p1hzgr= ap1hzgr*rsz-ap1hzgi*aisz p1hzgre= ap1hzgre*rsz-ap1hzgie*aisz p1hzgie= ap1hzgie*rsz+ap1hzgre*aisz p1hzgi= ap1hzgi*rsz+ap1hzgr*aisz * *-----All PP2 Z-gamma * cp2zg= -conc(4)/ysm/ypfp*corrgd * do i=1,4 ip4= i+4 hgr(i)= hch(ip4)*cp2zg*ztcfr hgi(i)= hch(ip4)*cp2zg*ztcfi enddo * ap2azgr= hgr(1)*p2abrc ap2azgre= -hgi(1)*p2abic ap2azgie= hgr(1)*p2abic ap2azgi= hgi(1)*p2abrc p2azgr= ap2azgr*rsz-ap2azgi*aisz p2azgre= ap2azgre*rsz-ap2azgie*aisz p2azgie= ap2azgie*rsz+ap2azgre*aisz p2azgi= ap2azgi*rsz+ap2azgr*aisz * ap2bzgr= -hgr(2)*p2abrc ap2bzgre= -hgi(2)*p2abic ap2bzgie= hgr(2)*p2abic ap2bzgi= -hgi(2)*p2abrc p2bzgr= ap2bzgr*rsz-ap2bzgi*aisz p2bzgre= ap2bzgre*rsz-ap2bzgie*aisz p2bzgie= ap2bzgie*rsz+ap2bzgre*aisz p2bzgi= ap2bzgi*rsz+ap2bzgr*aisz * ap2czgr= hgr(3)*p2cdrc ap2czgre= -hgi(3)*p2cdic ap2czgie= hgr(3)*p2cdic ap2czgi= hgi(3)*p2cdrc p2czgr= ap2czgr*rsz-ap2czgi*aisz p2czgre= ap2czgre*rsz-ap2czgie*aisz p2czgie= ap2czgie*rsz+ap2czgre*aisz p2czgi= ap2czgi*rsz+ap2czgr*aisz * ap2dzgr= -hgr(4)*p2cdrc ap2dzgre= -hgi(4)*p2cdic ap2dzgie= hgr(4)*p2cdic ap2dzgi= -hgi(4)*p2cdrc p2dzgr= ap2dzgr*rsz-ap2dzgi*aisz p2dzgre= ap2dzgre*rsz-ap2dzgie*aisz p2dzgie= ap2dzgie*rsz+ap2dzgre*aisz p2dzgi= ap2dzgi*rsz+ap2dzgr*aisz * ap2ezgr= hgr(3)*p2efrc ap2ezgre= -hgi(3)*p2efic ap2ezgie= hgr(3)*p2efic ap2ezgi= hgi(3)*p2efrc p2ezgr= ap2ezgr*rsz-ap2ezgi*aisz p2ezgre= ap2ezgre*rsz-ap2ezgie*aisz p2ezgie= ap2ezgie*rsz+ap2ezgre*aisz p2ezgi= ap2ezgi*rsz+ap2ezgr*aisz * ap2fzgr= -hgr(4)*p2efrc ap2fzgre= -hgi(4)*p2efic ap2fzgie= hgr(4)*p2efic ap2fzgi= -hgi(4)*p2efrc p2fzgr= ap2fzgr*rsz-ap2fzgi*aisz p2fzgre= ap2fzgre*rsz-ap2fzgie*aisz p2fzgie= ap2fzgie*rsz+ap2fzgre*aisz p2fzgi= ap2fzgi*rsz+ap2fzgr*aisz * ap2gzgr= hgr(1)*p2ghrc ap2gzgre= -hgi(1)*p2ghic ap2gzgie= hgr(1)*p2ghic ap2gzgi= hgi(1)*p2ghrc p2gzgr= ap2gzgr*rsz-ap2gzgi*aisz p2gzgre= ap2gzgre*rsz-ap2gzgie*aisz p2gzgie= ap2gzgie*rsz+ap2gzgre*aisz p2gzgi= ap2gzgi*rsz+ap2gzgr*aisz * ap2hzgr= -hgr(2)*p2ghrc ap2hzgre= -hgi(2)*p2ghic ap2hzgie= hgr(2)*p2ghic ap2hzgi= -hgi(2)*p2ghrc p2hzgr= ap2hzgr*rsz-ap2hzgi*aisz p2hzgre= ap2hzgre*rsz-ap2hzgie*aisz p2hzgie= ap2hzgie*rsz+ap2hzgre*aisz p2hzgi= ap2hzgi*rsz+ap2hzgr*aisz * * *-----All PP1 Z-Z * cp1zz= conc(5)/ypfpb * do i=1,8 ip20= i+20 hhr(i)= hch(ip20)*cp1zz*zpcfr hhi(i)= hch(ip20)*cp1zz*zpcfi enddo * ap1azzr= hhr(3)*p1abrc ap1azzre= -hhi(3)*p1abic ap1azzie= hhr(3)*p1abic ap1azzi= hhi(3)*p1abrc p1azzr= ap1azzr*rsz-ap1azzi*aisz p1azzre= ap1azzre*rsz-ap1azzie*aisz p1azzie= ap1azzie*rsz+ap1azzre*aisz p1azzi= ap1azzi*rsz+ap1azzr*aisz * ap1bzzr= -hhr(4)*p1abrc ap1bzzre= -hhi(4)*p1abic ap1bzzie= hhr(4)*p1abic ap1bzzi= -hhi(4)*p1abrc p1bzzr= ap1bzzr*rsz-ap1bzzi*aisz p1bzzre= ap1bzzre*rsz-ap1bzzie*aisz p1bzzie= ap1bzzie*rsz+ap1bzzre*aisz p1bzzi= ap1bzzi*rsz+ap1bzzr*aisz * ap1czzr= hhr(5)*p1cdrc ap1czzre= -hhi(5)*p1cdic ap1czzie= hhr(5)*p1cdic ap1czzi= hhi(5)*p1cdrc p1czzr= ap1czzr*rsz-ap1czzi*aisz p1czzre= ap1czzre*rsz-ap1czzie*aisz p1czzie= ap1czzie*rsz+ap1czzre*aisz p1czzi= ap1czzi*rsz+ap1czzr*aisz * ap1dzzr= -hhr(6)*p1cdrc ap1dzzre= -hhi(6)*p1cdic ap1dzzie= hhr(6)*p1cdic ap1dzzi= -hhi(6)*p1cdrc p1dzzr= ap1dzzr*rsz-ap1dzzi*aisz p1dzzre= ap1dzzre*rsz-ap1dzzie*aisz p1dzzie= ap1dzzie*rsz+ap1dzzre*aisz p1dzzi= ap1dzzi*rsz+ap1dzzr*aisz * ap1ezzr= hhr(8)*p1efrc ap1ezzre= -hhi(8)*p1efic ap1ezzie= hhr(8)*p1efic ap1ezzi= hhi(8)*p1efrc p1ezzr= ap1ezzr*rsz-ap1ezzi*aisz p1ezzre= ap1ezzre*rsz-ap1ezzie*aisz p1ezzie= ap1ezzie*rsz+ap1ezzre*aisz p1ezzi= ap1ezzi*rsz+ap1ezzr*aisz * ap1fzzr= -hhr(7)*p1efrc ap1fzzre= -hhi(7)*p1efic ap1fzzie= hhr(7)*p1efic ap1fzzi= -hhi(7)*p1efrc p1fzzr= ap1fzzr*rsz-ap1fzzi*aisz p1fzzre= ap1fzzre*rsz-ap1fzzie*aisz p1fzzie= ap1fzzie*rsz+ap1fzzre*aisz p1fzzi= ap1fzzi*rsz+ap1fzzr*aisz * ap1gzzr= hhr(1)*p1ghrc ap1gzzre= -hhi(1)*p1ghic ap1gzzie= hhr(1)*p1ghic ap1gzzi= hhi(1)*p1ghrc p1gzzr= ap1gzzr*rsz-ap1gzzi*aisz p1gzzre= ap1gzzre*rsz-ap1gzzie*aisz p1gzzie= ap1gzzie*rsz+ap1gzzre*aisz p1gzzi= ap1gzzi*rsz+ap1gzzr*aisz * ap1hzzr= -hhr(2)*p1ghrc ap1hzzre= -hhi(2)*p1ghic ap1hzzie= hhr(2)*p1ghic ap1hzzi= -hhi(2)*p1ghrc p1hzzr= ap1hzzr*rsz-ap1hzzi*aisz p1hzzre= ap1hzzre*rsz-ap1hzzie*aisz p1hzzie= ap1hzzie*rsz+ap1hzzre*aisz p1hzzi= ap1hzzi*rsz+ap1hzzr*aisz * * *-----All PP2 Z-Z * cp2zz= -conc(5)/ypfp * do i=1,8 ip20= i+20 hir(i)= hch(ip20)*cp2zz*zpcfr hii(i)= hch(ip20)*cp2zz*zpcfi enddo * ap2azzr= hir(3)*p2abrc ap2azzre= -hii(3)*p2abic ap2azzie= hir(3)*p2abic ap2azzi= hii(3)*p2abrc p2azzr= ap2azzr*rsz-ap2azzi*aisz p2azzre= ap2azzre*rsz-ap2azzie*aisz p2azzie= ap2azzie*rsz+ap2azzre*aisz p2azzi= ap2azzi*rsz+ap2azzr*aisz * ap2bzzr= -hir(4)*p2abrc ap2bzzre= -hii(4)*p2abic ap2bzzie= hir(4)*p2abic ap2bzzi= -hii(4)*p2abrc p2bzzr= ap2bzzr*rsz-ap2bzzi*aisz p2bzzre= ap2bzzre*rsz-ap2bzzie*aisz p2bzzie= ap2bzzie*rsz+ap2bzzre*aisz p2bzzi= ap2bzzi*rsz+ap2bzzr*aisz * ap2czzr= hir(5)*p2cdrc ap2czzre= -hii(5)*p2cdic ap2czzie= hir(5)*p2cdic ap2czzi= hii(5)*p2cdrc p2czzr= ap2czzr*rsz-ap2czzi*aisz p2czzre= ap2czzre*rsz-ap2czzie*aisz p2czzie= ap2czzie*rsz+ap2czzre*aisz p2czzi= ap2czzi*rsz+ap2czzr*aisz * ap2dzzr= -hir(6)*p2cdrc ap2dzzre= -hii(6)*p2cdic ap2dzzie= hir(6)*p2cdic ap2dzzi= -hii(6)*p2cdrc p2dzzr= ap2dzzr*rsz-ap2dzzi*aisz p2dzzre= ap2dzzre*rsz-ap2dzzie*aisz p2dzzie= ap2dzzie*rsz+ap2dzzre*aisz p2dzzi= ap2dzzi*rsz+ap2dzzr*aisz * ap2ezzr= hir(8)*p2efrc ap2ezzre= -hii(8)*p2efic ap2ezzie= hir(8)*p2efic ap2ezzi= hii(8)*p2efrc p2ezzr= ap2ezzr*rsz-ap2ezzi*aisz p2ezzre= ap2ezzre*rsz-ap2ezzie*aisz p2ezzie= ap2ezzie*rsz+ap2ezzre*aisz p2ezzi= ap2ezzi*rsz+ap2ezzr*aisz * ap2fzzr= -hir(7)*p2efrc ap2fzzre= -hii(7)*p2efic ap2fzzie= hir(7)*p2efic ap2fzzi= -hii(7)*p2efrc p2fzzr= ap2fzzr*rsz-ap2fzzi*aisz p2fzzre= ap2fzzre*rsz-ap2fzzie*aisz p2fzzie= ap2fzzie*rsz+ap2fzzre*aisz p2fzzi= ap2fzzi*rsz+ap2fzzr*aisz * ap2gzzr= hir(1)*p2ghrc ap2gzzre= -hii(1)*p2ghic ap2gzzie= hir(1)*p2ghic ap2gzzi= hii(1)*p2ghrc p2gzzr= ap2gzzr*rsz-ap2gzzi*aisz p2gzzre= ap2gzzre*rsz-ap2gzzie*aisz p2gzzie= ap2gzzie*rsz+ap2gzzre*aisz p2gzzi= ap2gzzi*rsz+ap2gzzr*aisz * ap2hzzr= -hir(2)*p2ghrc ap2hzzre= -hii(2)*p2ghic ap2hzzie= hir(2)*p2ghic ap2hzzi= -hii(2)*p2ghrc p2hzzr= ap2hzzr*rsz-ap2hzzi*aisz p2hzzre= ap2hzzre*rsz-ap2hzzie*aisz p2hzzie= ap2hzzie*rsz+ap2hzzre*aisz p2hzzi= ap2hzzi*rsz+ap2hzzr*aisz * * *-----All PP3-PP4 gamma-gamma * cp34gg= conc(7)/ysp*corrgs*corrgu cp3ggr= cp34gg/ypf*ztcfr cp4ggr= -cp34gg/ypfb*ztcfr cp3ggi= cp34gg/ypf*ztcfi cp4ggi= -cp34gg/ypfb*ztcfi * p3aggr= cp3ggr*p3abrc p3aggre= -cp3ggi*p3abic p3aggie= cp3ggr*p3abic p3aggi= cp3ggi*p3abrc * p3bggr= -p3aggr p3bggre= p3aggre p3bggie= p3aggie p3bggi= -p3aggi * p3cggr= cp3ggr*p3cdrc p3cggre= -cp3ggi*p3cdic p3cggie= cp3ggr*p3cdic p3cggi= cp3ggi*p3cdrc * p3dggr= -p3cggr p3dggre= p3cggre p3dggie= p3cggie p3dggi= -p3cggi * p3eggr= cp3ggr*p3efrc p3eggre= -cp3ggi*p3efic p3eggie= cp3ggr*p3efic p3eggi= cp3ggi*p3efrc * p3fggr= -p3eggr p3fggre= p3eggre p3fggie= p3eggie p3fggi= -p3eggi * p3gggr= cp3ggr*p3ghrc p3gggre= -cp3ggi*p3ghic p3gggie= cp3ggr*p3ghic p3gggi= cp3ggi*p3ghrc * p3hggr= -p3gggr p3hggre= p3gggre p3hggie= p3gggie p3hggi= -p3gggi * p4aggr= cp4ggr*p4abrc p4aggre= -cp4ggi*p4abic p4aggie= cp4ggr*p4abic p4aggi= cp4ggi*p4abrc * p4bggr= -p4aggr p4bggre= p4aggre p4bggie= p4aggie p4bggi= -p4aggi * p4cggr= cp4ggr*p4cdrc p4cggre= -cp4ggi*p4cdic p4cggie= cp4ggr*p4cdic p4cggi= cp4ggi*p4cdrc * p4dggr= -p4cggr p4dggre= p4cggre p4dggie= p4cggie p4dggi= -p4cggi * p4eggr= cp4ggr*p4efrc p4eggre= -cp4ggi*p4efic p4eggie= cp4ggr*p4efic p4eggi= cp4ggi*p4efrc * p4fggr= -p4eggr p4fggre= p4eggre p4fggie= p4eggie p4fggi= -p4eggi * p4gggr= cp4ggr*p4ghrc p4gggre= -cp4ggi*p4ghic p4gggie= cp4ggr*p4ghic p4gggi= cp4ggi*p4ghrc * p4hggr= -p4gggr p4hggre= p4gggre p4hggie= p4gggie p4hggi= -p4gggi * *-----All PP3 gamma-Z * cp3gz= conc(2)/ypf*corrgs * do i=1,4 ip16= i+16 hlr(i)= hch(ip16)*cp3gz*zmcfr hli(i)= hch(ip16)*cp3gz*zmcfi enddo * p3agzr= hlr(3)*p3abrc p3agzre= -hli(3)*p3abic p3agzie= hlr(3)*p3abic p3agzi= hli(3)*p3abrc * p3bgzr= -hlr(4)*p3abrc p3bgzre= -hli(4)*p3abic p3bgzie= hlr(4)*p3abic p3bgzi= -hli(4)*p3abrc * p3cgzr= hlr(4)*p3cdrc p3cgzre= -hli(4)*p3cdic p3cgzie= hlr(4)*p3cdic p3cgzi= hli(4)*p3cdrc * p3dgzr= -hlr(3)*p3cdrc p3dgzre= -hli(3)*p3cdic p3dgzie= hlr(3)*p3cdic p3dgzi= -hli(3)*p3cdrc * p3egzr= hlr(2)*p3efrc p3egzre= -hli(2)*p3efic p3egzie= hlr(2)*p3efic p3egzi= hli(2)*p3efrc * p3fgzr= -hlr(1)*p3efrc p3fgzre= -hli(1)*p3efic p3fgzie= hlr(1)*p3efic p3fgzi= -hli(1)*p3efrc * p3ggzr= hlr(1)*p3ghrc p3ggzre= -hli(1)*p3ghic p3ggzie= hlr(1)*p3ghic p3ggzi= hli(1)*p3ghrc * p3hgzr= -hlr(2)*p3ghrc p3hgzre= -hli(2)*p3ghic p3hgzie= hlr(2)*p3ghic p3hgzi= -hli(2)*p3ghrc * * *-----All PP4 gamma-Z * cp4gz= -conc(2)/ypfb*corrgs * do i=1,4 ip16= i+16 hmr(i)= hch(ip16)*cp4gz*zmcfr hmi(i)= hch(ip16)*cp4gz*zmcfi enddo * p4agzr= hmr(3)*p4abrc p4agzre= -hmi(3)*p4abic p4agzie= hmr(3)*p4abic p4agzi= hmi(3)*p4abrc * p4bgzr= -hmr(4)*p4abrc p4bgzre= -hmi(4)*p4abic p4bgzie= hmr(4)*p4abic p4bgzi= -hmi(4)*p4abrc * p4cgzr= hmr(4)*p4cdrc p4cgzre= -hmi(4)*p4cdic p4cgzie= hmr(4)*p4cdic p4cgzi= hmi(4)*p4cdrc * p4dgzr= -hmr(3)*p4cdrc p4dgzre= -hmi(3)*p4cdic p4dgzie= hmr(3)*p4cdic p4dgzi= -hmi(3)*p4cdrc * p4egzr= hmr(2)*p4efrc p4egzre= -hmi(2)*p4efic p4egzie= hmr(2)*p4efic p4egzi= hmi(2)*p4efrc * p4fgzr= -hmr(1)*p4efrc p4fgzre= -hmi(1)*p4efic p4fgzie= hmr(1)*p4efic p4fgzi= -hmi(1)*p4efrc * p4ggzr= hmr(1)*p4ghrc p4ggzre= -hmi(1)*p4ghic p4ggzie= hmr(1)*p4ghic p4ggzi= hmi(1)*p4ghrc * p4hgzr= -hmr(2)*p4ghrc p4hgzre= -hmi(2)*p4ghic p4hgzie= hmr(2)*p4ghic p4hgzi= -hmi(2)*p4ghrc * * *-----All PP3 Z-gamma * cp3zg= -conc(4)/ysp/ypf*corrgu * do i=1,4 hnr(i)= hch(i)*cp3zg*ztcfr hni(i)= hch(i)*cp3zg*ztcfi enddo * ap3azgr= hnr(1)*p3abrc ap3azgre= -hni(1)*p3abic ap3azgie= hnr(1)*p3abic ap3azgi= hni(1)*p3abrc p3azgr= ap3azgr*rsz-ap3azgi*aisz p3azgre= ap3azgre*rsz-ap3azgie*aisz p3azgie= ap3azgie*rsz+ap3azgre*aisz p3azgi= ap3azgi*rsz+ap3azgr*aisz * ap3bzgr= -hnr(2)*p3abrc ap3bzgre= -hni(2)*p3abic ap3bzgie= hnr(2)*p3abic ap3bzgi= -hni(2)*p3abrc p3bzgr= ap3bzgr*rsz-ap3bzgi*aisz p3bzgre= ap3bzgre*rsz-ap3bzgie*aisz p3bzgie= ap3bzgie*rsz+ap3bzgre*aisz p3bzgi= ap3bzgi*rsz+ap3bzgr*aisz * ap3czgr= hnr(3)*p3cdrc ap3czgre= -hni(3)*p3cdic ap3czgie= hnr(3)*p3cdic ap3czgi= hni(3)*p3cdrc p3czgr= ap3czgr*rsz-ap3czgi*aisz p3czgre= ap3czgre*rsz-ap3czgie*aisz p3czgie= ap3czgie*rsz+ap3czgre*aisz p3czgi= ap3czgi*rsz+ap3czgr*aisz * ap3dzgr= -hnr(4)*p3cdrc ap3dzgre= -hni(4)*p3cdic ap3dzgie= hnr(4)*p3cdic ap3dzgi= -hni(4)*p3cdrc p3dzgr= ap3dzgr*rsz-ap3dzgi*aisz p3dzgre= ap3dzgre*rsz-ap3dzgie*aisz p3dzgie= ap3dzgie*rsz+ap3dzgre*aisz p3dzgi= ap3dzgi*rsz+ap3dzgr*aisz * ap3ezgr= hnr(1)*p3efrc ap3ezgre= -hni(1)*p3efic ap3ezgie= hnr(1)*p3efic ap3ezgi= hni(1)*p3efrc p3ezgr= ap3ezgr*rsz-ap3ezgi*aisz p3ezgre= ap3ezgre*rsz-ap3ezgie*aisz p3ezgie= ap3ezgie*rsz+ap3ezgre*aisz p3ezgi= ap3ezgi*rsz+ap3ezgr*aisz * ap3fzgr= -hnr(2)*p3efrc ap3fzgre= -hni(2)*p3efic ap3fzgie= hnr(2)*p3efic ap3fzgi= -hni(2)*p3efrc p3fzgr= ap3fzgr*rsz-ap3fzgi*aisz p3fzgre= ap3fzgre*rsz-ap3fzgie*aisz p3fzgie= ap3fzgie*rsz+ap3fzgre*aisz p3fzgi= ap3fzgi*rsz+ap3fzgr*aisz * ap3gzgr= hnr(3)*p3ghrc ap3gzgre= -hni(3)*p3ghic ap3gzgie= hnr(3)*p3ghic ap3gzgi= hni(3)*p3ghrc p3gzgr= ap3gzgr*rsz-ap3gzgi*aisz p3gzgre= ap3gzgre*rsz-ap3gzgie*aisz p3gzgie= ap3gzgie*rsz+ap3gzgre*aisz p3gzgi= ap3gzgi*rsz+ap3gzgr*aisz * ap3hzgr= -hnr(4)*p3ghrc ap3hzgre= -hni(4)*p3ghic ap3hzgie= hnr(4)*p3ghic ap3hzgi= -hni(4)*p3ghrc p3hzgr= ap3hzgr*rsz-ap3hzgi*aisz p3hzgre= ap3hzgre*rsz-ap3hzgie*aisz p3hzgie= ap3hzgie*rsz+ap3hzgre*aisz p3hzgi= ap3hzgi*rsz+ap3hzgr*aisz * *-----All PP4 Z-gamma * cp4zg= conc(4)/ysp/ypfb*corrgu * do i=1,4 hor(i)= hch(i)*cp4zg*ztcfr hoi(i)= hch(i)*cp4zg*ztcfi enddo * ap4azgr= hor(1)*p4abrc ap4azgre= -hoi(1)*p4abic ap4azgie= hor(1)*p4abic ap4azgi= hoi(1)*p4abrc p4azgr= ap4azgr*rsz-ap4azgi*aisz p4azgre= ap4azgre*rsz-ap4azgie*aisz p4azgie= ap4azgie*rsz+ap4azgre*aisz p4azgi= ap4azgi*rsz+ap4azgr*aisz * ap4bzgr= -hor(2)*p4abrc ap4bzgre= -hoi(2)*p4abic ap4bzgie= hor(2)*p4abic ap4bzgi= -hoi(2)*p4abrc p4bzgr= ap4bzgr*rsz-ap4bzgi*aisz p4bzgre= ap4bzgre*rsz-ap4bzgie*aisz p4bzgie= ap4bzgie*rsz+ap4bzgre*aisz p4bzgi= ap4bzgi*rsz+ap4bzgr*aisz * ap4czgr= hor(3)*p4cdrc ap4czgre= -hoi(3)*p4cdic ap4czgie= hor(3)*p4cdic ap4czgi= hoi(3)*p4cdrc p4czgr= ap4czgr*rsz-ap4czgi*aisz p4czgre= ap4czgre*rsz-ap4czgie*aisz p4czgie= ap4czgie*rsz+ap4czgre*aisz p4czgi= ap4czgi*rsz+ap4czgr*aisz * ap4dzgr= -hor(4)*p4cdrc ap4dzgre= -hoi(4)*p4cdic ap4dzgie= hor(4)*p4cdic ap4dzgi= -hoi(4)*p4cdrc p4dzgr= ap4dzgr*rsz-ap4dzgi*aisz p4dzgre= ap4dzgre*rsz-ap4dzgie*aisz p4dzgie= ap4dzgie*rsz+ap4dzgre*aisz p4dzgi= ap4dzgi*rsz+ap4dzgr*aisz * ap4ezgr= hor(1)*p4efrc ap4ezgre= -hoi(1)*p4efic ap4ezgie= hor(1)*p4efic ap4ezgi= hoi(1)*p4efrc p4ezgr= ap4ezgr*rsz-ap4ezgi*aisz p4ezgre= ap4ezgre*rsz-ap4ezgie*aisz p4ezgie= ap4ezgie*rsz+ap4ezgre*aisz p4ezgi= ap4ezgi*rsz+ap4ezgr*aisz * ap4fzgr= -hor(2)*p4efrc ap4fzgre= -hoi(2)*p4efic ap4fzgie= hor(2)*p4efic ap4fzgi= -hoi(2)*p4efrc p4fzgr= ap4fzgr*rsz-ap4fzgi*aisz p4fzgre= ap4fzgre*rsz-ap4fzgie*aisz p4fzgie= ap4fzgie*rsz+ap4fzgre*aisz p4fzgi= ap4fzgi*rsz+ap4fzgr*aisz * ap4gzgr= hor(3)*p4ghrc ap4gzgre= -hoi(3)*p4ghic ap4gzgie= hor(3)*p4ghic ap4gzgi= hoi(3)*p4ghrc p4gzgr= ap4gzgr*rsz-ap4gzgi*aisz p4gzgre= ap4gzgre*rsz-ap4gzgie*aisz p4gzgie= ap4gzgie*rsz+ap4gzgre*aisz p4gzgi= ap4gzgi*rsz+ap4gzgr*aisz * ap4hzgr= -hor(4)*p4ghrc ap4hzgre= -hoi(4)*p4ghic ap4hzgie= hor(4)*p4ghic ap4hzgi= -hoi(4)*p4ghrc p4hzgr= ap4hzgr*rsz-ap4hzgi*aisz p4hzgre= ap4hzgre*rsz-ap4hzgie*aisz p4hzgie= ap4hzgie*rsz+ap4hzgre*aisz p4hzgi= ap4hzgi*rsz+ap4hzgr*aisz * *-----All PP3 Z-Z * cp3zz= -conc(5)/ypf * do i=1,8 ip28= i+28 hpr(i)= hch(ip28)*cp3zz*zmcfr hpi(i)= hch(ip28)*cp3zz*zmcfi enddo * ap3azzr= hpr(3)*p3abrc ap3azzre= -hpi(3)*p3abic ap3azzie= hpr(3)*p3abic ap3azzi= hpi(3)*p3abrc p3azzr= ap3azzr*rsz-ap3azzi*aisz p3azzre= ap3azzre*rsz-ap3azzie*aisz p3azzie= ap3azzie*rsz+ap3azzre*aisz p3azzi= ap3azzi*rsz+ap3azzr*aisz * ap3bzzr= -hpr(4)*p3abrc ap3bzzre= -hpi(4)*p3abic ap3bzzie= hpr(4)*p3abic ap3bzzi= -hpi(4)*p3abrc p3bzzr= ap3bzzr*rsz-ap3bzzi*aisz p3bzzre= ap3bzzre*rsz-ap3bzzie*aisz p3bzzie= ap3bzzie*rsz+ap3bzzre*aisz p3bzzi= ap3bzzi*rsz+ap3bzzr*aisz * ap3czzr= hpr(5)*p3cdrc ap3czzre= -hpi(5)*p3cdic ap3czzie= hpr(5)*p3cdic ap3czzi= hpi(5)*p3cdrc p3czzr= ap3czzr*rsz-ap3czzi*aisz p3czzre= ap3czzre*rsz-ap3czzie*aisz p3czzie= ap3czzie*rsz+ap3czzre*aisz p3czzi= ap3czzi*rsz+ap3czzr*aisz * ap3dzzr= -hpr(6)*p3cdrc ap3dzzre= -hpi(6)*p3cdic ap3dzzie= hpr(6)*p3cdic ap3dzzi= -hpi(6)*p3cdrc p3dzzr= ap3dzzr*rsz-ap3dzzi*aisz p3dzzre= ap3dzzre*rsz-ap3dzzie*aisz p3dzzie= ap3dzzie*rsz+ap3dzzre*aisz p3dzzi= ap3dzzi*rsz+ap3dzzr*aisz * ap3ezzr= hpr(7)*p3efrc ap3ezzre= -hpi(7)*p3efic ap3ezzie= hpr(7)*p3efic ap3ezzi= hpi(7)*p3efrc p3ezzr= ap3ezzr*rsz-ap3ezzi*aisz p3ezzre= ap3ezzre*rsz-ap3ezzie*aisz p3ezzie= ap3ezzie*rsz+ap3ezzre*aisz p3ezzi= ap3ezzi*rsz+ap3ezzr*aisz * ap3fzzr= -hpr(8)*p3efrc ap3fzzre= -hpi(8)*p3efic ap3fzzie= hpr(8)*p3efic ap3fzzi= -hpi(8)*p3efrc p3fzzr= ap3fzzr*rsz-ap3fzzi*aisz p3fzzre= ap3fzzre*rsz-ap3fzzie*aisz p3fzzie= ap3fzzie*rsz+ap3fzzre*aisz p3fzzi= ap3fzzi*rsz+ap3fzzr*aisz * ap3gzzr= hpr(1)*p3ghrc ap3gzzre= -hpi(1)*p3ghic ap3gzzie= hpr(1)*p3ghic ap3gzzi= hpi(1)*p3ghrc p3gzzr= ap3gzzr*rsz-ap3gzzi*aisz p3gzzre= ap3gzzre*rsz-ap3gzzie*aisz p3gzzie= ap3gzzie*rsz+ap3gzzre*aisz p3gzzi= ap3gzzi*rsz+ap3gzzr*aisz * ap3hzzr= -hpr(2)*p3ghrc ap3hzzre= -hpi(2)*p3ghic ap3hzzie= hpr(2)*p3ghic ap3hzzi= -hpi(2)*p3ghrc p3hzzr= ap3hzzr*rsz-ap3hzzi*aisz p3hzzre= ap3hzzre*rsz-ap3hzzie*aisz p3hzzie= ap3hzzie*rsz+ap3hzzre*aisz p3hzzi= ap3hzzi*rsz+ap3hzzr*aisz * * *-----All PP4 Z-Z * cp4zz= conc(5)/ypfb * do i=1,8 ip28= i+28 hqr(i)= hch(ip28)*cp4zz*zmcfr hqi(i)= hch(ip28)*cp4zz*zmcfi enddo * ap4azzr= hqr(3)*p4abrc ap4azzre= -hqi(3)*p4abic ap4azzie= hqr(3)*p4abic ap4azzi= hqi(3)*p4abrc p4azzr= ap4azzr*rsz-ap4azzi*aisz p4azzre= ap4azzre*rsz-ap4azzie*aisz p4azzie= ap4azzie*rsz+ap4azzre*aisz p4azzi= ap4azzi*rsz+ap4azzr*aisz * ap4bzzr= -hqr(4)*p4abrc ap4bzzre= -hqi(4)*p4abic ap4bzzie= hqr(4)*p4abic ap4bzzi= -hqi(4)*p4abrc p4bzzr= ap4bzzr*rsz-ap4bzzi*aisz p4bzzre= ap4bzzre*rsz-ap4bzzie*aisz p4bzzie= ap4bzzie*rsz+ap4bzzre*aisz p4bzzi= ap4bzzi*rsz+ap4bzzr*aisz * ap4czzr= hqr(5)*p4cdrc ap4czzre= -hqi(5)*p4cdic ap4czzie= hqr(5)*p4cdic ap4czzi= hqi(5)*p4cdrc p4czzr= ap4czzr*rsz-ap4czzi*aisz p4czzre= ap4czzre*rsz-ap4czzie*aisz p4czzie= ap4czzie*rsz+ap4czzre*aisz p4czzi= ap4czzi*rsz+ap4czzr*aisz * ap4dzzr= -hqr(6)*p4cdrc ap4dzzre= -hqi(6)*p4cdic ap4dzzie= hqr(6)*p4cdic ap4dzzi= -hqi(6)*p4cdrc p4dzzr= ap4dzzr*rsz-ap4dzzi*aisz p4dzzre= ap4dzzre*rsz-ap4dzzie*aisz p4dzzie= ap4dzzie*rsz+ap4dzzre*aisz p4dzzi= ap4dzzi*rsz+ap4dzzr*aisz * ap4ezzr= hqr(7)*p4efrc ap4ezzre= -hqi(7)*p4efic ap4ezzie= hqr(7)*p4efic ap4ezzi= hqi(7)*p4efrc p4ezzr= ap4ezzr*rsz-ap4ezzi*aisz p4ezzre= ap4ezzre*rsz-ap4ezzie*aisz p4ezzie= ap4ezzie*rsz+ap4ezzre*aisz p4ezzi= ap4ezzi*rsz+ap4ezzr*aisz * ap4fzzr= -hqr(8)*p4efrc ap4fzzre= -hqi(8)*p4efic ap4fzzie= hqr(8)*p4efic ap4fzzi= -hqi(8)*p4efrc p4fzzr= ap4fzzr*rsz-ap4fzzi*aisz p4fzzre= ap4fzzre*rsz-ap4fzzie*aisz p4fzzie= ap4fzzie*rsz+ap4fzzre*aisz p4fzzi= ap4fzzi*rsz+ap4fzzr*aisz * ap4gzzr= hqr(1)*p4ghrc ap4gzzre= -hqi(1)*p4ghic ap4gzzie= hqr(1)*p4ghic ap4gzzi= hqi(1)*p4ghrc p4gzzr= ap4gzzr*rsz-ap4gzzi*aisz p4gzzre= ap4gzzre*rsz-ap4gzzie*aisz p4gzzie= ap4gzzie*rsz+ap4gzzre*aisz p4gzzi= ap4gzzi*rsz+ap4gzzr*aisz * ap4hzzr= -hqr(2)*p4ghrc ap4hzzre= -hqi(2)*p4ghic ap4hzzie= hqr(2)*p4ghic ap4hzzi= -hqi(2)*p4ghrc p4hzzr= ap4hzzr*rsz-ap4hzzi*aisz p4hzzre= ap4hzzre*rsz-ap4hzzie*aisz p4hzzie= ap4hzzie*rsz+ap4hzzre*aisz p4hzzi= ap4hzzi*rsz+ap4hzzr*aisz * if(oqcd.eq.'y'.and.iqcd.eq.0) then darndr= c1azzr+c2azzr daiendr= c1azzie+c2azzie endif darn= (c1aggr+c1agzr+c1azgr+c1azzr+ # c2aggr+c2agzr+c2azgr+c2azzr+ # p1aggr+p1agzr+p1azgr+p1azzr+ # p2aggr+p2agzr+p2azgr+p2azzr+ # p3aggr+p3agzr+p3azgr+p3azzr+ # p4aggr+p4agzr+p4azgr+p4azzr) daren= (c1aggre+c1agzre+c1azgre+ # c2aggre+c2agzre+c2azgre+ # p1aggre+p1agzre+p1azgre+p1azzre+ # p2aggre+p2agzre+p2azgre+p2azzre+ # p3aggre+p3agzre+p3azgre+p3azzre+ # p4aggre+p4agzre+p4azgre+p4azzre) dain= (c1aggi+c1agzi+c1azgi+ # c2aggi+c2agzi+c2azgi+ # p1aggi+p1agzi+p1azgi+p1azzi+ # p2aggi+p2agzi+p2azgi+p2azzi+ # p3aggi+p3agzi+p3azgi+p3azzi+ # p4aggi+p4agzi+p4azgi+p4azzi) daien= (c1aggie+c1agzie+c1azgie+c1azzie+ # c2aggie+c2agzie+c2azgie+c2azzie+ # p1aggie+p1agzie+p1azgie+p1azzie+ # p2aggie+p2agzie+p2azgie+p2azzie+ # p3aggie+p3agzie+p3azgie+p3azzie+ # p4aggie+p4agzie+p4azgie+p4azzie) * if(oqcd.eq.'y'.and.iqcd.eq.0) then dbrndr= c1bzzr+c2bzzr dbiendr= c1bzzie+c2bzzie endif dbrn= (c1bggr+c1bgzr+c1bzgr+c1bzzr+ # c2bggr+c2bgzr+c2bzgr+c2bzzr+ # p1bggr+p1bgzr+p1bzgr+p1bzzr+ # p2bggr+p2bgzr+p2bzgr+p2bzzr+ # p3bggr+p3bgzr+p3bzgr+p3bzzr+ # p4bggr+p4bgzr+p4bzgr+p4bzzr) dbren= (c1bggre+c1bgzre+c1bzgre+ # c2bggre+c2bgzre+c2bzgre+ # p1bggre+p1bgzre+p1bzgre+p1bzzre+ # p2bggre+p2bgzre+p2bzgre+p2bzzre+ # p3bggre+p3bgzre+p3bzgre+p3bzzre+ # p4bggre+p4bgzre+p4bzgre+p4bzzre) dbin= (c1bggi+c1bgzi+c1bzgi+ # c2bggi+c2bgzi+c2bzgi+ # p1bggi+p1bgzi+p1bzgi+p1bzzi+ # p2bggi+p2bgzi+p2bzgi+p2bzzi+ # p3bggi+p3bgzi+p3bzgi+p3bzzi+ # p4bggi+p4bgzi+p4bzgi+p4bzzi) dbien= (c1bggie+c1bgzie+c1bzgie+c1bzzie+ # c2bggie+c2bgzie+c2bzgie+c2bzzie+ # p1bggie+p1bgzie+p1bzgie+p1bzzie+ # p2bggie+p2bgzie+p2bzgie+p2bzzie+ # p3bggie+p3bgzie+p3bzgie+p3bzzie+ # p4bggie+p4bgzie+p4bzgie+p4bzzie) * if(oqcd.eq.'y'.and.iqcd.eq.0) then dcrndr= c1czzr+c2czzr dciendr= c1czzie+c2czzie endif dcrn= (c1cggr+c1cgzr+c1czgr+c1czzr+ # c2cggr+c2cgzr+c2czgr+c2czzr+ # p1cggr+p1cgzr+p1czgr+p1czzr+ # p2cggr+p2cgzr+p2czgr+p2czzr+ # p3cggr+p3cgzr+p3czgr+p3czzr+ # p4cggr+p4cgzr+p4czgr+p4czzr) dcren= (c1cggre+c1cgzre+c1czgre+ # c2cggre+c2cgzre+c2czgre+ # p1cggre+p1cgzre+p1czgre+p1czzre+ # p2cggre+p2cgzre+p2czgre+p2czzre+ # p3cggre+p3cgzre+p3czgre+p3czzre+ # p4cggre+p4cgzre+p4czgre+p4czzre) dcin= (c1cggi+c1cgzi+c1czgi+ # c2cggi+c2cgzi+c2czgi+ # p1cggi+p1cgzi+p1czgi+p1czzi+ # p2cggi+p2cgzi+p2czgi+p2czzi+ # p3cggi+p3cgzi+p3czgi+p3czzi+ # p4cggi+p4cgzi+p4czgi+p4czzi) dcien= (c1cggie+c1cgzie+c1czgie+c1czzie+ # c2cggie+c2cgzie+c2czgie+c2czzie+ # p1cggie+p1cgzie+p1czgie+p1czzie+ # p2cggie+p2cgzie+p2czgie+p2czzie+ # p3cggie+p3cgzie+p3czgie+p3czzie+ # p4cggie+p4cgzie+p4czgie+p4czzie) * if(oqcd.eq.'y'.and.iqcd.eq.0) then derndr= c1ezzr+c2ezzr deiendr= c1ezzie+c2ezzie endif dern= (c1eggr+c1egzr+c1ezgr+c1ezzr+ # c2eggr+c2egzr+c2ezgr+c2ezzr+ # p1eggr+p1egzr+p1ezgr+p1ezzr+ # p2eggr+p2egzr+p2ezgr+p2ezzr+ # p3eggr+p3egzr+p3ezgr+p3ezzr+ # p4eggr+p4egzr+p4ezgr+p4ezzr) deren= (c1eggre+c1egzre+c1ezgre+ # c2eggre+c2egzre+c2ezgre+ # p1eggre+p1egzre+p1ezgre+p1ezzre+ # p2eggre+p2egzre+p2ezgre+p2ezzre+ # p3eggre+p3egzre+p3ezgre+p3ezzre+ # p4eggre+p4egzre+p4ezgre+p4ezzre) dein= (c1eggi+c1egzi+c1ezgi+ # c2eggi+c2egzi+c2ezgi+ # p1eggi+p1egzi+p1ezgi+p1ezzi+ # p2eggi+p2egzi+p2ezgi+p2ezzi+ # p3eggi+p3egzi+p3ezgi+p3ezzi+ # p4eggi+p4egzi+p4ezgi+p4ezzi) deien= (c1eggie+c1egzie+c1ezgie+c1ezzie+ # c2eggie+c2egzie+c2ezgie+c2ezzie+ # p1eggie+p1egzie+p1ezgie+p1ezzie+ # p2eggie+p2egzie+p2ezgie+p2ezzie+ # p3eggie+p3egzie+p3ezgie+p3ezzie+ # p4eggie+p4egzie+p4ezgie+p4ezzie) * if(oqcd.eq.'y'.and.iqcd.eq.0) then dgrndr= c1gzzr+c2gzzr dgiendr= c1gzzie+c2gzzie endif dgrn= (c1gggr+c1ggzr+c1gzgr+c1gzzr+ # c2gggr+c2ggzr+c2gzgr+c2gzzr+ # p1gggr+p1ggzr+p1gzgr+p1gzzr+ # p2gggr+p2ggzr+p2gzgr+p2gzzr+ # p3gggr+p3ggzr+p3gzgr+p3gzzr+ # p4gggr+p4ggzr+p4gzgr+p4gzzr) dgren= (c1gggre+c1ggzre+c1gzgre+ # c2gggre+c2ggzre+c2gzgre+ # p1gggre+p1ggzre+p1gzgre+p1gzzre+ # p2gggre+p2ggzre+p2gzgre+p2gzzre+ # p3gggre+p3ggzre+p3gzgre+p3gzzre+ # p4gggre+p4ggzre+p4gzgre+p4gzzre) dgin= (c1gggi+c1ggzi+c1gzgi+ # c2gggi+c2ggzi+c2gzgi+ # p1gggi+p1ggzi+p1gzgi+p1gzzi+ # p2gggi+p2ggzi+p2gzgi+p2gzzi+ # p3gggi+p3ggzi+p3gzgi+p3gzzi+ # p4gggi+p4ggzi+p4gzgi+p4gzzi) dgien= (c1gggie+c1ggzie+c1gzgie+c1gzzie+ # c2gggie+c2ggzie+c2gzgie+c2gzzie+ # p1gggie+p1ggzie+p1gzgie+p1gzzie+ # p2gggie+p2ggzie+p2gzgie+p2gzzie+ # p3gggie+p3ggzie+p3gzgie+p3gzzie+ # p4gggie+p4ggzie+p4gzgie+p4gzzie) * if(oqcd.eq.'y'.and.iqcd.eq.0) then dhrndr= c1hzzr+c2hzzr dhiendr= c1hzzie+c2hzzie endif dhrn= (c1hggr+c1hgzr+c1hzgr+c1hzzr+ # c2hggr+c2hgzr+c2hzgr+c2hzzr+ # p1hggr+p1hgzr+p1hzgr+p1hzzr+ # p2hggr+p2hgzr+p2hzgr+p2hzzr+ # p3hggr+p3hgzr+p3hzgr+p3hzzr+ # p4hggr+p4hgzr+p4hzgr+p4hzzr) dhren= (c1hggre+c1hgzre+c1hzgre+ # c2hggre+c2hgzre+c2hzgre+ # p1hggre+p1hgzre+p1hzgre+p1hzzre+ # p2hggre+p2hgzre+p2hzgre+p2hzzre+ # p3hggre+p3hgzre+p3hzgre+p3hzzre+ # p4hggre+p4hgzre+p4hzgre+p4hzzre) dhin= (c1hggi+c1hgzi+c1hzgi+ # c2hggi+c2hgzi+c2hzgi+ # p1hggi+p1hgzi+p1hzgi+p1hzzi+ # p2hggi+p2hgzi+p2hzgi+p2hzzi+ # p3hggi+p3hgzi+p3hzgi+p3hzzi+ # p4hggi+p4hgzi+p4hzgi+p4hzzi) dhien= (c1hggie+c1hgzie+c1hzgie+c1hzzie+ # c2hggie+c2hgzie+c2hzgie+c2hzzie+ # p1hggie+p1hgzie+p1hzgie+p1hzzie+ # p2hggie+p2hgzie+p2hzgie+p2hzzie+ # p3hggie+p3hgzie+p3hzgie+p3hzzie+ # p4hggie+p4hgzie+p4hzgie+p4hzzie) * if(oqcd.eq.'y'.and.iqcd.eq.0) then ddrndr= c1dzzr+c2dzzr ddiendr= c1dzzie+c2dzzie endif ddrn= (c1dggr+c1dgzr+c1dzgr+c1dzzr+ # c2dggr+c2dgzr+c2dzgr+c2dzzr+ # p1dggr+p1dgzr+p1dzgr+p1dzzr+ # p2dggr+p2dgzr+p2dzgr+p2dzzr+ # p3dggr+p3dgzr+p3dzgr+p3dzzr+ # p4dggr+p4dgzr+p4dzgr+p4dzzr) ddren= (c1dggre+c1dgzre+c1dzgre+ # c2dggre+c2dgzre+c2dzgre+ # p1dggre+p1dgzre+p1dzgre+p1dzzre+ # p2dggre+p2dgzre+p2dzgre+p2dzzre+ # p3dggre+p3dgzre+p3dzgre+p3dzzre+ # p4dggre+p4dgzre+p4dzgre+p4dzzre) ddin= (c1dggi+c1dgzi+c1dzgi+ # c2dggi+c2dgzi+c2dzgi+ # p1dggi+p1dgzi+p1dzgi+p1dzzi+ # p2dggi+p2dgzi+p2dzgi+p2dzzi+ # p3dggi+p3dgzi+p3dzgi+p3dzzi+ # p4dggi+p4dgzi+p4dzgi+p4dzzi) ddien= (c1dggie+c1dgzie+c1dzgie+c1dzzie+ # c2dggie+c2dgzie+c2dzgie+c2dzzie+ # p1dggie+p1dgzie+p1dzgie+p1dzzie+ # p2dggie+p2dgzie+p2dzgie+p2dzzie+ # p3dggie+p3dgzie+p3dzgie+p3dzzie+ # p4dggie+p4dgzie+p4dzgie+p4dzzie) * * if(oqcd.eq.'y'.and.iqcd.eq.0) then dfrndr= c1fzzr+c2fzzr dfiendr= c1fzzie+c2fzzie endif dfrn= (c1fggr+c1fgzr+c1fzgr+c1fzzr+ # c2fggr+c2fgzr+c2fzgr+c2fzzr+ # p1fggr+p1fgzr+p1fzgr+p1fzzr+ # p2fggr+p2fgzr+p2fzgr+p2fzzr+ # p3fggr+p3fgzr+p3fzgr+p3fzzr+ # p4fggr+p4fgzr+p4fzgr+p4fzzr) dfren= (c1fggre+c1fgzre+c1fzgre+ # c2fggre+c2fgzre+c2fzgre+ # p1fggre+p1fgzre+p1fzgre+p1fzzre+ # p2fggre+p2fgzre+p2fzgre+p2fzzre+ # p3fggre+p3fgzre+p3fzgre+p3fzzre+ # p4fggre+p4fgzre+p4fzgre+p4fzzre) dfin= (c1fggi+c1fgzi+c1fzgi+ # c2fggi+c2fgzi+c2fzgi+ # p1fggi+p1fgzi+p1fzgi+p1fzzi+ # p2fggi+p2fgzi+p2fzgi+p2fzzi+ # p3fggi+p3fgzi+p3fzgi+p3fzzi+ # p4fggi+p4fgzi+p4fzgi+p4fzzi) dfien= (c1fggie+c1fgzie+c1fzgie+c1fzzie+ # c2fggie+c2fgzie+c2fzgie+c2fzzie+ # p1fggie+p1fgzie+p1fzgie+p1fzzie+ # p2fggie+p2fgzie+p2fzgie+p2fzzie+ # p3fggie+p3fgzie+p3fzgie+p3fzzie+ # p4fggie+p4fgzie+p4fzgie+p4fzzie) * *-----CC and NC diagrams are comensated with double Z and W propagators * adarn= phr*darn-phie*daien adaren= phr*daren-phie*dain adaien= phr*daien+phie*darn adain= phr*dain+phie*daren if(oqcd.eq.'y'.and.iqcd.eq.0) then adarndr= phr*darndr-phie*daiendr adaiendr= phr*daiendr+phie*darndr dbr240= wtcfr*adarndr dbre240= -wtcfi*adaiendr dbie240= wtcfr*adaiendr dbi240= wtcfi*adarndr endif * dar3= ztcfr*darc3-ztcfi*daic3 dare3= ztcfr*darec3-ztcfi*daiec3 daie3= ztcfr*daiec3+ztcfi*darec3 dai3= ztcfr*daic3+ztcfi*darc3 * dbr3= ztcfr*dbrc3-ztcfi*dbic3 dbre3= ztcfr*dbrec3-ztcfi*dbiec3 dbie3= ztcfr*dbiec3+ztcfi*dbrec3 dbi3= ztcfr*dbic3+ztcfi*dbrc3 * dbr11= ztcfr*dbrc-ztcfi*dbic dbre11= ztcfr*dbrec-ztcfi*dbiec dbie11= ztcfr*dbiec+ztcfi*dbrec dbi11= ztcfr*dbic+ztcfi*dbrc * dbr24= wtcfr*adarn-wtcfi*adain dbre24= wtcfr*adaren-wtcfi*adaien dbie24= wtcfr*adaien+wtcfi*adaren dbi24= wtcfr*adain+wtcfi*adarn * dar= ztcfr*darc-ztcfi*daic dare= ztcfr*darec-ztcfi*daiec daie= ztcfr*daiec+ztcfi*darec dai= ztcfr*daic+ztcfi*darc * dbr= ztcfr*dbrc-ztcfi*dbic- # wtcfr*adarn+wtcfi*adain dbre= ztcfr*dbrec-ztcfi*dbiec- # wtcfr*adaren+wtcfi*adaien dbie= ztcfr*dbiec+ztcfi*dbrec- # wtcfr*adaien-wtcfi*adaren dbi= ztcfr*dbic+ztcfi*dbrc- # wtcfr*adain-wtcfi*adarn * dfr= wtcfr*dbrn-wtcfi*dbin dfre= wtcfr*dbren-wtcfi*dbien dfie= wtcfr*dbien+wtcfi*dbren dfi= wtcfr*dbin+wtcfi*dbrn if(oqcd.eq.'y'.and.iqcd.eq.0) then dfrdr= wtcfr*dbrndr dfredr= -wtcfi*dbiendr dfiedr= wtcfr*dbiendr dfidr= wtcfi*dbrndr endif * dgr= wtcfr*dcrn-wtcfi*dcin dgre= wtcfr*dcren-wtcfi*dcien dgie= wtcfr*dcien+wtcfi*dcren dgi= wtcfr*dcin+wtcfi*dcrn if(oqcd.eq.'y'.and.iqcd.eq.0) then dgrdr= wtcfr*dcrndr dgredr= -wtcfi*dciendr dgiedr= wtcfr*dciendr dgidr= wtcfi*dcrndr endif * dhr= wtcfr*ddrn-wtcfi*ddin dhre= wtcfr*ddren-wtcfi*ddien dhie= wtcfr*ddien+wtcfi*ddren dhi= wtcfr*ddin+wtcfi*ddrn if(oqcd.eq.'y'.and.iqcd.eq.0) then dhrdr= wtcfr*ddrndr dhredr= -wtcfi*ddiendr dhiedr= wtcfr*ddiendr dhidr= wtcfi*ddrndr endif * dir= wtcfr*dern-wtcfi*dein dire= wtcfr*deren-wtcfi*deien diie= wtcfr*deien+wtcfi*deren dii= wtcfr*dein+wtcfi*dern if(oqcd.eq.'y'.and.iqcd.eq.0) then dirdr= wtcfr*derndr diredr= -wtcfi*deiendr diiedr= wtcfr*deiendr diidr= wtcfi*derndr endif * dlr= wtcfr*dfrn-wtcfi*dfin dlre= wtcfr*dfren-wtcfi*dfien dlie= wtcfr*dfien+wtcfi*dfren dli= wtcfr*dfin+wtcfi*dfrn if(oqcd.eq.'y'.and.iqcd.eq.0) then dlrdr= wtcfr*dfrndr dlredr= -wtcfi*dfiendr dliedr= wtcfr*dfiendr dlidr= wtcfi*dfrndr endif * dmr= wtcfr*dgrn-wtcfi*dgin dmre= wtcfr*dgren-wtcfi*dgien dmie= wtcfr*dgien+wtcfi*dgren dmi= wtcfr*dgin+wtcfi*dgrn if(oqcd.eq.'y'.and.iqcd.eq.0) then dmrdr= wtcfr*dgrndr dmredr= -wtcfi*dgiendr dmiedr= wtcfr*dgiendr dmidr= wtcfi*dgrndr endif * dnr= wtcfr*dhrn-wtcfi*dhin dnre= wtcfr*dhren-wtcfi*dhien dnie= wtcfr*dhien+wtcfi*dhren dni= wtcfr*dhin+wtcfi*dhrn if(oqcd.eq.'y'.and.iqcd.eq.0) then dnrdr= wtcfr*dhrndr dnredr= -wtcfi*dhiendr dniedr= wtcfr*dhiendr dnidr= wtcfi*dhrndr endif * das0= dar3*dar3+daie3*daie3+ # dare3*dare3+dai3*dai3 dbs0= dbr3*dbr3+dbie3*dbie3+ # dbre3*dbre3+dbi3*dbi3 dbs240= dbr240*dbr240+dbie240*dbie240+ # dbre240*dbre240+dbi240*dbi240 dascs= coulf*(dar3*dar3+daie3*daie3+ # dare3*dare3+dai3*dai3) dbscs= coulf*(dbr3*dbr3+dbie3*dbie3+ # dbre3*dbre3+dbi3*dbi3) if(ofs.eq.'ll') then das= dar*dar+dare*dare+daie*daie+dai*dai dbs= dbr*dbr+dbre*dbre+dbie*dbie+dbi*dbi dfs= dfr*dfr+dfre*dfre+dfie*dfie+dfi*dfi dgs= dgr*dgr+dgre*dgre+dgie*dgie+dgi*dgi dhs= dhr*dhr+dhre*dhre+dhie*dhie+dhi*dhi dis= dir*dir+dire*dire+diie*diie+dii*dii dls= dlr*dlr+dlre*dlre+dlie*dlie+dli*dli dms= dmr*dmr+dmre*dmre+dmie*dmie+dmi*dmi dns= dnr*dnr+dnre*dnre+dnie*dnie+dni*dni * das= das+dascs dbs= dbs+dbscs else if(ofs.eq.'qq') then if((oqcd.eq.'y'.and.iqcd.gt.0).or. # oqcd.eq.'n') then das= 9.d0*(dar*dar+dare*dare+ # daie*daie+dai*dai+dascs)*(1.d0+qcdjc) dbs= 9.d0*(dbr11*dbr11+dbre11*dbre11+ # dbie11*dbie11+dbi11*dbi11+dbscs)* # (1.d0+qcdjc)+ # 9.d0*(dbr24*dbr24+dbre24*dbre24+ # dbie24*dbie24+dbi24*dbi24)* # (1.d0+qcdjn)- # 6.d0*(dbr11*dbr24+dbre11*dbre24+ # dbie11*dbie24+dbi11*dbi24) dfs= 9.d0*(dfr*dfr+dfre*dfre+ # dfie*dfie+dfi*dfi)*(1.d0+qcdjn) dgs= 9.d0*(dgr*dgr+dgre*dgre+ # dgie*dgie+dgi*dgi)*(1.d0+qcdjn) dhs= 9.d0*(dhr*dhr+dhre*dhre+ # dhie*dhie+dhi*dhi)*(1.d0+qcdjn) dis= 9.d0*(dir*dir+dire*dire+ # diie*diie+dii*dii)*(1.d0+qcdjn) dls= 9.d0*(dlr*dlr+dlre*dlre+ # dlie*dlie+dli*dli)*(1.d0+qcdjn) dms= 9.d0*(dmr*dmr+dmre*dmre+ # dmie*dmie+dmi*dmi)*(1.d0+qcdjn) dns= 9.d0*(dnr*dnr+dnre*dnre+ # dnie*dnie+dni*dni)*(1.d0+qcdjn) else if(oqcd.eq.'y'.and.iqcd.eq.0) then das= 9.d0*(dar*dar+dare*dare+ # daie*daie+dai*dai+dascs)+ # 9.0d0*das0*(1.d0+coulf)*qcdjc dbs= 9.d0*(dbr11*dbr11+dbre11*dbre11+ # dbie11*dbie11+dbi11*dbi11+dbscs)+ # 9.d0*(dbr24*dbr24+dbre24*dbre24+ # dbie24*dbie24+dbi24*dbi24+dbscs)- # 6.d0*(dbr11*dbr24+dbre11*dbre24+ # dbie11*dbie24+dbi11*dbi24)+ # 9.d0*dbs0*(1.d0+coulf)*qcdjc+ # 9.d0*dbs240*qcdjn dfs= 9.d0*(dfr*dfr+dfre*dfre+ # dfie*dfie+dfi*dfi)+ # 9.d0*(dfrdr*dfrdr+dfredr*dfredr+ # dfiedr*dfiedr+dfidr*dfidr)*qcdjn dgs= 9.d0*(dgr*dgr+dgre*dgre+ # dgie*dgie+dgi*dgi)+ # 9.d0*(dgrdr*dgrdr+dgredr*dgredr+ # dgiedr*dgiedr+dgidr*dgidr)*qcdjn dhs= 9.d0*(dhr*dhr+dhre*dhre+ # dhie*dhie+dhi*dhi)+ # 9.d0*(dhrdr*dhrdr+dhredr*dhredr+ # dhiedr*dhiedr+dhidr*dhidr)*qcdjn dis= 9.d0*(dir*dir+dire*dire+ # diie*diie+dii*dii)+ # 9.d0*(dirdr*dirdr+diredr*diredr+ # diiedr*diiedr+diidr*diidr)*qcdjn dls= 9.d0*(dlr*dlr+dlre*dlre+ # dlie*dlie+dli*dli)+ # 9.d0*(dlrdr*dlrdr+dlredr*dlredr+ # dliedr*dliedr+dlidr*dlidr)*qcdjn dms= 9.d0*(dmr*dmr+dmre*dmre+ # dmie*dmie+dmi*dmi)+ # 9.d0*(dmrdr*dmrdr+dmredr*dmredr+ # dmiedr*dmiedr+dmidr*dmidr)*qcdjn dns= 9.d0*(dnr*dnr+dnre*dnre+ # dnie*dnie+dni*dni)+ # 9.d0*(dnrdr*dnrdr+dnredr*dnredr+ # dniedr*dniedr+dnidr*dnidr)*qcdjn endif endif * 4 if(iz.eq.0) then do il=1,9 dpxs(ix,it,itt,il)= 0.d0 enddo iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc*vv**3 tjacp= tjac*pmjac*ppjac*pujac*pdjac* # stf/s dpxs(ix,it,itt,1)= tjacp*das dpxs(ix,it,itt,2)= tjacp*dbs dpxs(ix,it,itt,3)= tjacp*dfs dpxs(ix,it,itt,4)= tjacp*dgs dpxs(ix,it,itt,5)= tjacp*dhs dpxs(ix,it,itt,6)= tjacp*dis dpxs(ix,it,itt,7)= tjacp*dls dpxs(ix,it,itt,8)= tjacp*dms dpxs(ix,it,itt,9)= tjacp*dns endif * *-----end of ix loop * enddo * 5 if(iz.eq.0) then do i=1,9 do ix=1,2 epxs(ix,it,itt,i)= 0.d0 enddo enddo iz= 1 else do i=1,9 do ix=1,2 epxs(ix,it,itt,i)= dpxs(ix,it,itt,i) enddo enddo endif * *-----end of itt loop * enddo * do i=1,9 cpxs(it,i)= 0.d0 do itt=1,ittm cpxs(it,i)= cpxs(it,i)+epxs(1,it,itt,i)+ # epxs(2,it,itt,i) enddo enddo * 2 if(iz.eq.0) then do il=1,9 bpxs(it,il)= 0.d0 enddo iz= 1 else do il=1,9 bpxs(it,il)= cpxs(it,il) enddo endif * *---end on it loop * enddo * 1 if(iz.eq.0) then do il=1,9 apxs(il)= 0.d0 enddo iz= 1 else do il=1,9 apxs(il)= bpxs(1,il)+bpxs(2,il) enddo endif * tapxs= 0.d0 do il=1,9 tapxs= tapxs+apxs(il) enddo if(tapxs.lt.0.d0) then ifz(44)= ifz(44)+1 resf= 0.d0 else resf= tapxs endif * wtoxs35= tfact*resf * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(wtoxs35.gt.xshmx(jp)) then xshmx(jp)= wtoxs35 do l=1,9 xmxh(jp,l)= x(l) enddo endif endif xaph(1)= xm xaph(2)= xp xaph(3)= sm xaph(4)= sp xaph(5)= su xaph(6)= sd xaph(7)= sf xaph(8)= tw xaph(9)= t1 xaph(10)= t3 endif * return end