* *-----WTOXSC----------------------------------------------------------- * real*8 function wtoxsc(ndim,x) implicit real*8 (a-h,o-z) * character*1,ocoul,opeak,oqcd,ofl,ofsr,obin,om,osm,oww,ozz, # opeaka,rio,opeakas,ockm,omdist character*4,otype * parameter(ninv=10,npos=512) * common/wtai/rio common/wtgd/idt common/wtcw/oww common/wtcz/ozz common/wtmod/om common/wtmp/zrm common/wtcb/obin common/wtfls/ofl common/wtqcd/als common/wtnpr/ipr common/wtsmod/osm common/wtdis/dist common/wtps/opeak common/wtkount/ik common/wtfsr/ofsr common/wtopa/delc common/wtckm/ockm common/wtsfls/sofl common/wtap/opeaka common/wtaqcd/oqcd common/wtistrf/isf common/wtcqcd/iqcd common/wtlmsb/qcdl common/wtickm/ickm common/wtomd/omdist common/wtsf/ix0,it0 common/wtcoul/ocoul common/wtshel/otrans common/wtipt/ifz(51) common/wticuts/iac(4) common/wtmd/arrinv(10) common/wtisa/isaa,isab common/wtcx/xscmx(npos) common/wthx/xshmx(npos) common/wtochannel/otype common/wtparc/xap(ninv) common/wtvckm/vckm(3,3) common/wtpmx/xmx(npos,9) common/wtparh/xaph(ninv) common/wtparam/eps,ddelta common/wttc/itc,itcc,itcn common/wtdis2/distm,distp common/wtpmxh/xmxh(npos,9) common/wtlb/abp,bbp,abm,bbm common/wtcclr/vupl,vupr,vdpl,vdpr common/wtalqed/arezm,aizm,aresz,aisz common/wtcmplx/sw(2),sz(2),rsw(2),rsz(2) common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtcchannel/chu,chup,chd,chdp,fcuc,fcdc common/wthapar/rhm,rhm2,rhg,rhmg,shg,shgs,opshgs 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/wtacc/acg1g,aclg,ackg,acg4g,acktg,acltg,acg5g, # acg1z,aclz,ackz,acg4z,acktz,acltz,acg5z common/wtfmass2/em2,amm2,tm2,rnm2,uqm2,dqm2,cqm2,sqm2,bqm2, # tqm2,dmy2 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 co(2) dimension x(ndim) dimension fsr(2,2) dimension bt1(2),bt2(2) dimension bvv1(2),bvv2(2) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension emu(4,2),emut(4) dimension ctmu(2),ctmu2(2) dimension bvvv1(2),bvvv2(2) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension tgn(15),tgg(24),tgv(48),tgh(9) dimension t1mu(2),t2mu(2),t3mu(2),t4mu(2) dimension ca3(2,6),ca2(2,4),ca1(2,2),ca0(2) dimension cb3(2,6),cb2(2,4),cb1(2,2),cb0(2) dimension c03(2,6),c02(2,4),c01(2,2),c00(2) dimension cp3(2,6),cp2(2,4),cp1(2,2),cp0(2) dimension cm3(2,6),cm2(2,4),cm1(2,2),cm0(2) dimension cc3(2,6),cc2(2,4),cc1(2,2),cc0(2) dimension eca3(2,6),eca2(2,4),eca1(2,2),eca0(2) dimension ecb3(2,6),ecb2(2,4),ecb1(2,2),ecb0(2) dimension ec03(2,6),ec02(2,4),ec01(2,2),ec00(2) dimension ecp3(2,6),ecp2(2,4),ecp1(2,2),ecp0(2) dimension ecm3(2,6),ecm2(2,4),ecm1(2,2),ecm0(2) dimension ecc3(2,6),ecc2(2,4),ecc1(2,2),ecc0(2) dimension p3qw(2),p3qm(2),p3qp(2),fzw(2),fzm(2),fzp(2), # p3qs(2),fzs(2),fzsw(2),p3qsw(2) dimension dpxs(2,2,2,3),epxs(2,2,2,3),cpxs(2,3),bpxs(2,3), # apxs(3) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) dimension efsr1(2,2),efsr2(2,2),efsr3(2,2),efsr4(2,2) dimension fw(2),fws(2),pggfs(2),pgglqs(2),p3qsz(2),fzsz(2), # fwsz(2),pggfsz(2),pgglqsz(2),fwsm(2),fwsp(2), # fwsw(2),p3q14(2),fz14(2),fw14(2),p3q23(2),fz23(2), # fw23(2),pggf23(2),pgglq23(2),pggfzm(2),pgglqzm(2) dimension f1(2),f2(2),f3(2),f4(2),ft1(2),ft2(2),ft3(2),ft4(2), # ft5(2),ft6(2),ftz1(2),ftz2(2),ftz3(2),ftz4(2),ftz5(2), # ftz6(2) dimension h1(2),h2(2),h3(2),h4(2),ht1(2),ht2(2),ht3(2),ht4(2), # ht5(2),ht6(2),htz1(2),htz2(2),htz3(2),htz4(2),htz5(2), # htz6(2) * data exc2/-0.4999999963d0/,exc4/0.0416666418d0/, # exc6/-0.0013888397d0/,exc8/0.0000247609d0/, # exc10/-0.0000002605d0/ data alphaf/131.2146d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf,s09abf * *-----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,3 dpxs(ix,it,itt,il)= 0.d0 enddo enddo enddo enddo do it=1,2 do il=1,3 cpxs(it,il)= 0.d0 bpxs(it,il)= 0.d0 enddo enddo * if(ndim.eq.2) then uvx= x(1) vvx= x(2) else if(ndim.eq.6) then if(itc.eq.10) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) else if(itc.eq.7) 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.10) 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) else if(itc.eq.7) 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.9) 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(itc.eq.12) 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) endif else if(ndim.eq.7) then if(itc.eq.11) then uvx= x(1) vvx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) endif 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 * if(omdist.eq.'y') then itc= 13 endif * ik= ik+1 rs= ars one= 1.d0 if(rio.eq.'a') then co(1)= 1.d0 else if(rio.eq.'i') then co(1)= 0.d0 endif co(2)= 0.d0 apis= 16.d0*pis swis= sw(2)*sw(2) srwis= rsw(2)*rsw(2) srzis= rsz(2)*rsz(2) aswi= abs(rsw(2)) wm2= wm*wm zm2= zm*zm ccz= gf*zm2/pis ccw= gf*wm2/pis if(oww.eq.'i') then frwm2= rwm2-rwg*rwg else if(oww.eq.'f') then frwm2= rwm2 endif if(ozz.eq.'i') then frzm2= rzm2-rzg*rzg else if(ozz.eq.'f') then frzm2= rzm2 endif rwmgs= rwmg*rwmg if(rio.eq.'a') then ali= alphai else if(rio.eq.'i') then ali= alphaf endif opeakas= 'l' * opeakas= 'i' * *-----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.2) then ul0= 1.d0-omul qp2s= arrinv(8) qp4s= arrinv(10) sp2s= arrinv(2)+arrinv(4)+arrinv(5) sp4s= arrinv(1)+arrinv(3)+arrinv(5) * ul1= 2.d0*(qp2s+sp2s) ul2= 2.d0*(qp4s+sp4s) sa1= (arrinv(1)+arrinv(4)+arrinv(5))/arrinv(7) sa3= (arrinv(2)+arrinv(3)+arrinv(5))/arrinv(9) samin= dmin1(sa1,sa3) v01= sqrt(2.d0*arrinv(1))+sqrt(2.d0*arrinv(2)) v01= v01*v01 v02= sqrt(2.d0*arrinv(3))+sqrt(2.d0*arrinv(4)) v02= v02*v02 v03= sqrt(2.d0*arrinv(5))+sqrt(2.d0*arrinv(6)) v03= v03*v03 v00= dmax1(v01,v02,v03) ul3= v00/samin ul4= 2.d0/samin*(sp2s+samin*qp2s) ul5= 2.d0/samin*(sp4s+samin*qp4s) ul6= 2.d0*(sp2s+samin*qp2s)/(samin+2.d0*qp2s) ul7= 2.d0*(sp4s+samin*qp4s)/(samin+2.d0*qp4s) ul8= v00 ai1= arrinv(1) ai2= arrinv(2) ai3= arrinv(3) ai4= arrinv(4) ai5= arrinv(5) ai6= arrinv(6) ai7= arrinv(7) ai8= arrinv(8) ai45= ai4+ai5 ai245= ai2+ai45 ai1s= ai1*ai1 ai2s= ai2*ai2 ai3s= ai3*ai3 ai4s= ai4*ai4 ai5s= ai5*ai5 ai5c= ai5s*ai5 ai5f= ai5c*ai5 ul9= 2.d0*(ai7*ai245/ai45+ai8) * ulo= dmax1(ul0,ul1,ul2,ul3,ul4,ul5,ul6,ul7,ul8,ul9) omulo= 1.d0-ulo if(omulo.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * ueps= omulo*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omulo**hbet uvs= uv*uv * 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 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 * svl1= v00 svl2= 2.d0*(sp2s-qp2s*uv)/(uv-2.d0*qp2s)*uv svl3= 2.d0*(sp4s-qp4s*uv)/(uv-2.d0*qp4s)*uv svl4= 2.d0*sp2s/(uv-2.d0*qp2s)*uv svl5= 2.d0*sp4s/(uv-2.d0*qp4s)*uv * ifvv= 1 * cojca= ai7*ai7 * cojcb= 2.d0*uv*ai1*ai7 cojcb= cojcb+ai1*ai7*ai8*(-4.d0) cojcb= cojcb+ai7*ai8*(4.d0*ai45) cojcb= cojcb+ai7*ai7*(4.d0*ai245) cojcb= -cojcb * cojcc= uv*ai1*ai7*(-4.d0*ai245) cojcc= cojcc+uv*ai1*ai8*(4.d0*ai45) cojcc= cojcc+uv*ai1*ai1*ai8*(4.d0) cojcc= cojcc-uvs*ai1*ai1 cojcc= cojcc+ai1*ai7*ai8*(-8.d0*ai245) cojcc= cojcc+ai1*ai8*ai8*(-8.d0*ai45) cojcc= cojcc+ai1*ai1*ai8*ai8*(-4.d0) cojcc= cojcc+ai7*ai8*(-8.d0*ai45*ai245) cojcc= cojcc+ai7*ai7*(-4.d0*ai245*ai245) cojcc= cojcc+ai8*ai8*(-4.d0*ai45*ai45) cojcc= -cojcc * call c02ajf(cojca,cojcb,cojcc,bvv1,bvv2,ifvv) if(ifvv.ne.0.or.bvv1(2).ne.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * ifvvv= 1 * csfjca= 0.125d0*ai5s * csfjcb= 0.5d0*ai5*(ai1*ai2+ai3*ai4) csfjcb= csfjcb+0.5d0*ai5s*(ai1+ai2+ai3+ai4) csfjcb= csfjcb+0.5d0*ai5c csfjcb= -csfjcb * csfjcc= ai5*(-ai1*ai2*ai3-ai1*ai2*ai4-ai1*ai3*ai4-ai1*ai2s- # ai2*ai3*ai4-ai2*ai1s-ai3*ai4s-ai4*ai3s) csfjcc= csfjcc+ai5s*(-2.d0*ai1*ai2-ai1*ai3-ai1*ai4-ai2* # ai3-ai2*ai4-2.d0*ai3*ai4-0.5d0*ai1s-0.5d0*ai2s- # 0.5d0*ai3s-0.5d0*ai4s) csfjcc= csfjcc+ai5c*(-ai1-ai2-ai3-ai4) csfjcc= csfjcc-0.5d0*+ai5f csfjcc= csfjcc+ai1*ai2*ai3*ai4-0.5d0*ai1s*ai2s-0.5d0*ai3s* # ai4s csfjcc= -csfjcc * call c02ajf(csfjca,csfjcb,csfjcc,bvvv1,bvvv2,ifvvv) if(ifvvv.ne.0.or.bvvv1(2).ne.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * svl6= bvv1(1) svl7= bvvv1(1) * svu1= samin*uv svu2= bvv2(1) svu3= bvvv2(1) * vvlll= dmax1(vvll,svl1,svl2,svl3,svl4, # svl5,svl6,svl7) vvuu= dmin1(vvu,svu1,svu2,svu3) * uvl= uv-vvlll * vkf= (uv-vvuu)/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-vvlll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif * else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * 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) * 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 * rit= itcn*1.d0 if(itc.ne.1) then ajc= 1.d0 else ajc= ((ueps*(1.d0-ueps)+veps)/uv)**itcn endif * if(vv.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif svv= sqrt(vv) if(ofl.eq.'c') then vwmg= aswi*vv else vwmg= rwmg*vv endif 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 rmu2= em2/sh rmu2s= rmu2*rmu2 rmu2c= rmu2s*rmu2 rswrv= rsw(1)/vv rswiv= rsw(2)/vv rszrv= rsz(1)/vv rsziv= rsz(2)/vv * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * if(ofl.eq.'c') then call wtopolez0(pggf0,fw0) p2r= -zm2 p2i= 0.d0 call wtopoleg(p2r,p2i,pggfzm,pgglqzm,pggnpzm) arezm= ali-0.25d0*(pggfzm(1)-pggf0+pggnpzm)/pi aizm= -0.25d0*(pggfzm(2)+pgglqzm(2))/pi frszm2= rszrv dz0= 1.d0-frszm2 dz= dz0*dz0+srzis/vvs rz0= dz0/dz aimz0= rsziv/dz trzg= 0.d0 trgz= 0.d0 trgg= 0.d0 p2r= -wm2 p2i= 0.d0 call wtopole(p2r,p2i,p3qw,fzw,fw) p2r= -sh p2i= 0.d0 call wtopole(p2r,p2i,p3qs,fzs,fws) xgs0= 1.d0/8.d0/gf/wm2 xgsr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+ # p3qw(1)-p3qs(1)) xgsi= -0.5d0*ccw*p3qs(2) agrs= xgs0*xgsr agis= xgs0*xgsi gms= agrs*agrs+agis*agis grs= agrs/gms gis= -agis/gms call wtopoleg(p2r,p2i,pggfs,pgglqs,pggnps) ares= arezm+0.25d0*(pggfzm(1)+pgglqzm(1)- # pggfs(1)-pgglqs(1))/pi ais= aizm+0.25d0*(pggfzm(2)+pgglqzm(2)- # pggfs(2)-pgglqs(2))/pi ems= ares*ares+ais*ais ers= 4.d0*pi*ares/ems eis= -4.d0*pi*ais/ems strrs= ers*agrs-eis*agis stris= ers*agis+eis*agrs tstrrs= 2.d0*strrs tstris= 2.d0*stris * p2r= -sw(1) p2i= -sw(2) call wtopole(p2r,p2i,p3qsw,fzsw,fwsw) xgsw0= 1.d0/8.d0/gf/wm2 xgswr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+ # p3qw(1)-p3qsw(1)) xgswi= -0.5d0*ccw*p3qsw(2) agrsw= xgsw0*xgswr agisw= xgsw0*xgswi agmsw= agrsw*agrsw+agisw*agisw grsw= agrsw/agmsw gisw= -agisw/agmsw * p2r= -sz(1) p2i= -sz(2) call wtopole(p2r,p2i,p3qsz,fzsz,fwsz) xgsz0= 1.d0/8.d0/gf/wm2 xgszr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+ # p3qw(1)-p3qsz(1)) xgszi= -0.5d0*ccw*p3qsz(2) agrsz= xgsz0*xgszr agisz= xgsz0*xgszi agmsz= agrsz*agrsz+agisz*agisz grsz= agrsz/agmsz gisz= -agisz/agmsz * call wtopoleg(p2r,p2i,pggfsz,pgglqsz,pggnpsz) aresz= arezm+0.25d0*(pggfzm(1)+pgglqzm(1)- # pggfsz(1)-pgglqsz(1))/pi aisz= aizm+0.25d0*(pggfzm(2)+pgglqzm(2)- # pggfsz(2)-pgglqsz(2))/pi ermz= aresz*aresz+aisz*aisz ersz= 4.d0*pi*aresz/ermz eisz= -4.d0*pi*aisz/ermz gmsz= grsz*grsz+gisz*gisz strrsz= ersz*agrsz-eisz*agisz strisz= ersz*agisz+eisz*agrsz ctrrs= 1.d0-strrs ctris= -stris ctrrsz= 1.d0-strrsz ctrisz= -strisz ctrms= ctrrs*ctrrs+ctris*ctris ctrrsi= ctrrs/ctrms ctrisi= -ctris/ctrms ttrrs= strrs*ctrrsi-stris*ctrisi ttris= strrs*ctrisi+stris*ctrrsi prsr= sh-sz(1) prsi= -sz(2) prsm= prsr*prsr+prsi*prsi prsri= prsr/prsm prsii= -prsi/prsm ratgr= grs*agrsz-gis*agisz ratgi= grs*agisz+gis*agrsz ratcr= ctrrsz*ctrrsi-ctrisz*ctrisi ratci= ctrrsz*ctrisi+ctrisz*ctrrsi ratgcr= grs*ctrrsi-gis*ctrisi ratgci= grs*ctrisi+gis*ctrrsi ratr= 1.d0-ratgr*ratcr+ratgi*ratci rati= -ratgr*ratci-ratgi*ratcr arhrs= sh-sz(1)+ratr*sz(1)-rati*sz(2)+(ratgcr*(fzs(1)- # fzsz(1))-ratgci*(fzs(2)-fzsz(2)))/apis arhis= -sz(2)+ratr*sz(2)+rati*sz(1)+(ratgcr*(fzs(2)- # fzsz(2))+ratgci*(fzs(1)-fzsz(1)))/apis brhrs= arhrs*prsri-arhis*prsii brhis= arhrs*prsii+arhis*prsri brhms= brhrs*brhrs+brhis*brhis rhrs= brhrs/brhms rhis= -brhis/brhms rz= rz0*rhrs-aimz0*rhis aimz= rz0*rhis+aimz0*rhrs omrz= 1.d0-rz else if(ofl.eq.'a') then trzg= 0.d0 trgz= 0.d0 trgg= 0.d0 if(ozz.eq.'r') then dz0= 1.d0-rszm2 dz= dz0*dz0+rszw2 rz= dz0/dz omrz= (-rszm2*dz0+rszw2)/dz aimz= -rszw/dz haimz= scth2*aimz else frszm2= frzm2/vv dz0= 1.d0-frszm2 dz= dz0*dz0+rzmg*rzmg/vvs rz= dz0/dz omrz= (-frszm2*dz0+rzmg*rzmg/vvs)/dz aimz= -rzmg/vv/dz haimz= scth2*aimz endif grs= 1.d0 gis= 0.d0 strrs= sth2 stris= 0.d0 ctrrs= 1.d0-strrs ctris= -stris tstrrs= 2.d0*strrs tstris= 2.d0*stris ctrms= ctrrs*ctrrs+ctris*ctris ctrrsi= ctrrs/ctrms ctrisi= -ctris/ctrms ttrrs= strrs*ctrrsi-stris*ctrisi ttris= strrs*ctrisi+stris*ctrrsi rhrs= 1.d0 rhis= 0.d0 else trzg= 0.d0 trgz= 0.d0 trgg= 0.d0 if(ozz.eq.'r') then dz0= 1.d0-rszm2 dz= dz0*dz0+rszw2 rz= dz0/dz omrz= (-rszm2*dz0+rszw2)/dz aimz= -rszw/dz haimz= scth2*aimz else frszm2= frzm2/vv dz0= 1.d0-frszm2 dz= dz0*dz0+rzmg*rzmg/vvs rz= dz0/dz omrz= (-frszm2*dz0+rzmg*rzmg/vvs)/dz aimz= -rzmg/vv/dz haimz= scth2*aimz endif endif * *-----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(obin.eq.'p') then dzmb= bbp*bbp zmb= dmin1(zmb,dzmb) else if(obin.eq.'m'.and.abm.gt.0.d0) then dzma= abm*abm zma= dmax1(zma,dzma) endif * if(itc.ge.7.and.itc.lt.10) then dzpa= dmax1(dsp,sct340) if(itc.eq.7.and.itcc.eq.1) then dzmb= (dist/rs-sqrt(dzpa))*(dist/rs-sqrt(dzpa)) zmb= dmin1(zmb,dzmb) else if(itc.eq.8) 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.9) then dzmb= (svv-dist/rs)*(svv-dist/rs) zmb= dmin1(zmb,dzmb) endif endif if(itc.eq.7.and.itcc.eq.3) then zmbd3= vv-0.5d0*dist*dist/s zmb= dmin1(zmb,zmbd3) endif if(itc.eq.11) then zmbd3= vv-0.5d0*distp*distp/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.ge.11) then if(itc.eq.11) then bdistl= distm*distm/s-zma bdistu= zmb-distm*distm/s else if(itc.eq.12) then bdistl= dist*dist/s-zma bdistu= zmb-dist*dist/s else if(itc.eq.13) then bdistl= 2.d0*arrinv(1)-zma bdistu= zmb-arrinv(1) endif if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif if(itc.eq.11) then sm= (distm/rs/svv)**2 if(oww.eq.'r') then pmjac= 2.d0*distm/s/((vv*sm-rwm2)**2+ # (vv*sm*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then pmjac= 2.d0*distm/s/((vv*sm-frwm2)**2+ # rwmgs) endif else if(itc.eq.12) then sm= (dist/rs/svv)**2 if(oww.eq.'r') then pmjac= 2.d0*dist/s/((vv*sm-rwm2)**2+ # (vv*sm*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then pmjac= 2.d0*dist/s/((vv*sm-frwm2)**2+ # rwmgs) endif else if(itc.eq.13) then sm= 2.d0*arrinv(1)/vv if(oww.eq.'r') then pmjac= 2.d0/s/((vv*sm-rwm2)**2+(vv*sm*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then pmjac= 2.d0/s/((vv*sm-frwm2)**2+rwmgs) endif endif smjc= 1.d0 else if(opeak.eq.'y') then if(ofl.eq.'c') then zmas= zma-rsw(1) zmbs= zmb-rsw(1) atma= zmas/aswi atmb= zmbs/aswi else if(oww.eq.'r') then zmas= zma-rwm2 zmbs= zmb-rwm2 atma= (zmas+swgs*zma)/rwmg atmb= (zmbs+swgs*zmb)/rwmg else if(oww.eq.'f'.or.oww.eq.'i') then zmas= zma-frwm2 zmbs= zmb-frwm2 atma= zmas/rwmg atmb= zmbs/rwmg endif endif 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 if(ofl.eq.'c') then sm= (rsw(1)+aswi*s07aaf(atnm,iftn))/vv else if(oww.eq.'r') then sm= s0w/vv*(1.d0+swg*s07aaf(atnm,iftn)) else if(oww.eq.'f'.or.oww.eq.'i') then sm= (frwm2+rwmg*s07aaf(atnm,iftn))/vv endif endif 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 if(ofl.eq.'c') then pmjac= 1.d0/((vv*sm-rsw(1))**2+srwis) else if(oww.eq.'r') then pmjac= 1.d0/((vv*sm-rwm2)**2+(vv*sm*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then pmjac= 1.d0/((vv*sm-frwm2)**2+rwmgs) endif endif smjc= smjc0 endif * endif if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) smh= sm*sh * 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(obin.eq.'p') then tstm= sqrt(vv*sm) if(tstm.lt.abp) then dzpa= (abp-tstm)*(abp-tstm) dzpb= (bbp-tstm)*(bbp-tstm) zpa= dmax1(zpa,dzpa) zpb= dmin1(zpb,dzpb) else dzpb= (bbp-tstm)*(bbp-tstm) zpb= dmin1(zpb,dzpb) endif else if(obin.eq.'m') then tstm= sqrt(vv*sm) if(tstm.gt.bbm) then dzpa= (tstm-bbm)*(tstm-bbm) dzpb= (tstm-abm)*(tstm-abm) zpa= dmax1(zpa,dzpa) zpb= dmin1(zpb,dzpb) else dzpb= (tstm-abm)*(tstm-abm) zpb= dmin1(zpb,dzpb) endif endif if(itc.eq.7.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.7.and.itcc.eq.1).or.(itc.gt.7.and.itc.lt.9)) 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.9) 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 else if(itc.eq.11) then bdistl= distp*distp/s-zpa bdistu= zpb-distp*distp/s 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.13) then bdistl= 2.d0*arrinv(2)-zpa bdistu= zpb-2.d0*arrinv(2) 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.7.and.itcc.eq.1).or.(itc.gt.7.and.itc.lt.9)) then sp= (dist/rs/svv-ssm)*(dist/rs/svv-ssm) if(oww.eq.'r') then ppjac= 2.d0*abs((dist/rs-svv*ssm))/ars/ # ((vv*sp-rwm2)**2+(vv*sp*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then ppjac= 2.d0*abs((dist/rs-svv*ssm))/ars/ # ((vv*sp-frwm2)**2+rwmgs) endif spjc= 1.d0 else if(itc.eq.9) then sp= (dist/rs/svv)**2 if(oww.eq.'r') then ppjac= 2.d0*dist/s/((vv*sp-rwm2)**2+ # (vv*sp*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then ppjac= 2.d0*dist/s/((vv*sp-frwm2)**2+ # rwmgs) endif spjc= 1.d0 else if(itc.eq.11) then sp= (distp/rs/svv)**2 if(oww.eq.'r') then ppjac= 2.d0*distp/s/((vv*sp-rwm2)**2+ # (vv*sp*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then ppjac= 2.d0*distp/s/((vv*sp-frwm2)**2+ # rwmgs) endif spjc= 1.d0 else if(itc.eq.13) then sp= 2.d0*arrinv(2)/vv if(oww.eq.'r') then ppjac= 2.d0/s/((vv*sp-rwm2)**2+(vv*sp*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then ppjac= 2.d0/s/((vv*sp-frwm2)**2+rwmgs) endif spjc= 1.d0 else if(opeak.eq.'y') then if(ofl.eq.'c') then zpas= zpa-rsw(1) zpbs= zpb-rsw(1) atpa= zpas/aswi atpb= zpbs/aswi else if(oww.eq.'r') then zpas= zpa-rwm2 zpbs= zpb-rwm2 atpa= (zpas+swgs*zpa)/rwmg atpb= (zpbs+swgs*zpb)/rwmg else if(oww.eq.'f'.or.oww.eq.'i') then zpas= zpa-frwm2 zpbs= zpb-frwm2 atpa= zpas/rwmg atpb= zpbs/rwmg endif endif 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 if(ofl.eq.'c') then sp= (rsw(1)+aswi*s07aaf(atnp,iftn))/vv else if(oww.eq.'r') then sp= s0w/vv*(1.d0+swg*s07aaf(atnp,iftn)) else if(oww.eq.'f'.or.oww.eq.'i') then sp= (frwm2+rwmg*s07aaf(atnp,iftn))/vv endif endif 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 if(ofl.eq.'c') then ppjac= 1.d0/((vv*sp-rsw(1))**2+srwis) else if(oww.eq.'r') then ppjac= 1.d0/((vv*sp-rwm2)**2+(vv*sp*swg)**2) else if(oww.eq.'f'.or.oww.eq.'i') then ppjac= 1.d0/((vv*sp-frwm2)**2+rwmgs) endif endif spjc= spjc0 endif endif if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) sph= sp*sh spmm= sp-sm smmp= sm-sp * *-----Fermion Loop, running couplings & scalar form-factors * if(ofl.eq.'c') then p2mr= -smh p2mi= 0.d0 call wtopole(p2mr,p2mi,p3qm,fzm,fwsm) xgm0= 1.d0/8.d0/gf/wm2 xgmr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+p3qw(1)-p3qm(1)) xgmi= -0.5d0*ccw*p3qm(2) agrm= xgm0*xgmr agim= xgm0*xgmi agmm= agrm*agrm+agim*agim grm= agrm/agmm gim= -agim/agmm p2pr= -sph p2pi= 0.d0 call wtopole(p2pr,p2pi,p3qp,fzp,fwsp) xgp0= 1.d0/8.d0/gf/wm2 xgpr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+p3qw(1)-p3qp(1)) xgpi= -0.5d0*ccw*p3qp(2) agrp= xgp0*xgpr agip= xgp0*xgpi agmp= agrp*agrp+agip*agip grp= agrp/agmp gip= -agip/agmp pmr= smh-sw(1) ppr= sph-sw(1) pmir= pmr/(pmr*pmr+swis) pmii= sw(2)/(pmr*pmr+swis) ppir= ppr/(ppr*ppr+swis) ppii= sw(2)/(ppr*ppr+swis) xrhrm= fwsm(1)-fwsw(1)+sw(1)*(p3qsw(1)-p3qm(1))- # sw(2)*(p3qsw(2)-p3qm(2)) xrhim= fwsm(2)-fwsw(2)+sw(1)*(p3qsw(2)-p3qm(2))+ # sw(2)*(p3qsw(1)-p3qm(1)) arhrm= 1.d0+1.d0/apis*( # pmir*(grm*xrhrm-gim*xrhim)-pmii*(grm*xrhim+gim*xrhrm)) arhim= 1.d0/apis*( # pmii*(grm*xrhrm-gim*xrhim)+pmir*(grm*xrhim+gim*xrhrm)) arhmm= arhrm*arhrm+arhim*arhim rhrm= arhrm/arhmm rhim= -arhim/arhmm xrhrp= fwsp(1)-fwsw(1)+sw(1)*(p3qsw(1)-p3qp(1))- # sw(2)*(p3qsw(2)-p3qp(2)) xrhip= fwsp(2)-fwsw(2)+sw(1)*(p3qsw(2)-p3qp(2))+ # sw(2)*(p3qsw(1)-p3qp(1)) arhrp= 1.d0+1.d0/apis*( # ppir*(grp*xrhrp-gip*xrhip)-ppii*(grp*xrhip+gip*xrhrp)) arhip= 1.d0/apis*( # ppii*(grp*xrhrp-gip*xrhip)+ppir*(grp*xrhip+gip*xrhrp)) arhmp= arhrp*arhrp+arhip*arhip rhrp= arhrp/arhmp rhip= -arhip/arhmp else if(ofl.eq.'a') then grm= g2 gim= 0.d0 grp= g2 gip= 0.d0 rhrm= 1.d0 rhim= 0.d0 rhrp= 1.d0 rhip= 0.d0 endif * if(ofl.eq.'c') then jfl= 0 p1s= -smh p2s= -sph ps= -sh rm12= rnm2 rm22= rnm2 rm32= rnm2 call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, # c00,c01,c02,c03) if(jfl.eq.-1) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif jfl= 0 p1s= -smh p2s= -sph ps= -sh rm12= rnm2 rm22= tqm2 rm32= rnm2 call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, # ca0,ca1,ca2,ca3) if(jfl.eq.-1) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif jfl= 0 p1s= -smh p2s= -sph ps= -sh rm12= tqm2 rm22= rnm2 rm32= tqm2 call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, # cb0,cb1,cb2,cb3) if(jfl.eq.-1) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * det= -4.d0/((-1.d0+sm+sp)*(-1.d0+sm+sp)-4.d0*sm*sp) if(abs(det).gt.1.d9) then idt= idt+1 endif * do i=1,2 do j=1,6 cp3(i,j)= ca3(i,j)+2.d0*cb3(i,j) cm3(i,j)= ca3(i,j)-2.d0*cb3(i,j) cc3(i,j)= cp3(i,j)-3.d0*c03(i,j) enddo do j=1,4 cp2(i,j)= ca2(i,j)+2.d0*cb2(i,j) cm2(i,j)= ca2(i,j)-2.d0*cb2(i,j) cc2(i,j)= cp2(i,j)-3.d0*c02(i,j) enddo do j=1,2 cp1(i,j)= ca1(i,j)+2.d0*cb1(i,j) cm1(i,j)= ca1(i,j)-2.d0*cb1(i,j) cc1(i,j)= cp1(i,j)-3.d0*c01(i,j) enddo cp0(i)= ca0(i)+2.d0*cb0(i) cm0(i)= ca0(i)-2.d0*cb0(i) cc0(i)= cp0(i)-3.d0*c00(i) enddo * do i=1,2 * f1(i)= 16.d0*sph*(c03(i,2)+c03(i,3)-2.d0*c03(i,4)) f1(i)= f1(i)+16.d0*smh*(-c03(i,1)+2.d0*c03(i,3)-c03(i,4) # -c02(i,1)-c02(i,2)+2.d0*c02(i,3)) f1(i)= f1(i)+16.d0*sh*(-c03(i,3)+c03(i,4)+c02(i,2)+c01(i,2)) f1(i)= f1(i)+32.d0*(c03(i,5)-c03(i,6)-c02(i,4)) f1(i)= f1(i)+32.d0/3.d0*co(i) * f2(i)= 8.d0*sph*(c03(i,2)-c03(i,3)+2.d0*c02(i,2)- # 2.d0*c02(i,3)) f2(i)= f2(i)+8.d0*smh*(c03(i,1)-c03(i,4)+c02(i,1)-c02(i,2)) f2(i)= f2(i)+8.d0*sh*(c03(i,3)+c03(i,4)+c02(i,2)+2.d0* # c02(i,3)+c01(i,2)) f2(i)= f2(i)-16.d0*(c03(i,5)+c03(i,6)+c02(i,4)) * f3(i)= 8.d0*sph*(-3.d0*c03(i,2)-3.d0*c03(i,3)+6.d0*c03(i,4) # +2.d0*c02(i,2)-2.d0*c02(i,3)) f3(i)= f3(i)+8.d0*smh*(3.d0*c03(i,1)-6.d0*c03(i,3)+3.d0* # c03(i,4)+5.d0*c02(i,1)+3.d0*c02(i,2)-8.d0*c02(i,3)+2.d0* # c01(i,1)-2.d0*c01(i,2)) f3(i)= f3(i)+8.d0*sh*(3.d0*c03(i,3)-3.d0*c03(i,4)-3.d0*c02(i,2) # +2.d0*c02(i,3)-c01(i,2)) f3(i)= f3(i)+16.d0*(-3.d0*c03(i,5)+3.d0*c03(i,6)-c02(i,4)) * f4(i)= 64.d0*(c03(i,3)-c03(i,4)-c02(i,2)+c02(i,3)) f4(i)= sh*f4(i) * ft1(i)= 2.d0*tqm2*(-cp1(i,1)+cp1(i,2)-cp0(i) # +cm1(i,1)-cm1(i,2)+cm0(i)) ft1(i)= ft1(i)+4.d0*sph*(cc3(i,2)+cc3(i,3)-2.d0*cc3(i,4)) ft1(i)= ft1(i)+4.d0*smh*(-cc3(i,1)+2.d0*cc3(i,3)-cc3(i,4) # -cc2(i,1)-cc2(i,2)+2.d0*cc2(i,3)) ft1(i)= ft1(i)+4.d0*sh*(-cc3(i,3)+cc3(i,4)+cc2(i,2)+ # cc1(i,2)) ft1(i)= ft1(i)+8.d0*(cc3(i,5)-cc3(i,6)-cc2(i,4)) * ft2(i)= tqm2*(-cp1(i,1)-cp1(i,2)-cp0(i)+ # cm1(i,1)+cm1(i,2)+cm0(i)) ft2(i)= ft2(i)+2.d0*sph*(cc3(i,2)-cc3(i,3)+2.d0*cc2(i,2)- # 2.d0*cc2(i,3)) ft2(i)= ft2(i)+2.d0*smh*(cc3(i,1)-cc3(i,4)+cc2(i,1)- # cc2(i,2)) ft2(i)= ft2(i)+2.d0*sh*(cc3(i,3)+cc3(i,4)+cc2(i,2)+2.d0* # cc2(i,3)+cc1(i,2)) ft2(i)= ft2(i)+4.d0*(-cc3(i,5)-cc3(i,6)-cc2(i,4)) * ft3(i)= tqm2*(cp1(i,1)-cp1(i,2)+cp0(i)-cm1(i,1) # +cm1(i,2)-cm0(i)) ft3(i)= ft3(i)+sph*(-6*cc3(i,2)-6*cc3(i,3)+12*cc3(i,4) # +4*cc2(i,2)-4*cc2(i,3)) ft3(i)= ft3(i)+smh*(6*cc3(i,1)-12*cc3(i,3)+6*cc3(i,4) # +10*cc2(i,1)+6*cc2(i,2)-16*cc2(i,3)+4*cc1(i,1)-4* # cc1(i,2)) ft3(i)= ft3(i)+sh*(6.d0*(cc3(i,3)-cc3(i,4)-cc2(i,2))+4.d0* # cc2(i,3)-2.d0*cc1(i,2)) ft3(i)= ft3(i)+4.d0*(-3.d0*cc3(i,5)+3.d0*cc3(i,6)-cc2(i,4)) * ft4(i)= 16.d0*(cc3(i,3)-cc3(i,4)-cc2(i,2)+cc2(i,3)) ft4(i)= sh*ft4(i) * if(rio.eq.'i') then ft5(i)= 0.d0 ft6(i)= 0.d0 else if(rio.eq.'a') then * ft5(i)= 2.d0*tqm2*(cp1(i,1)-cp1(i,2)+cp0(i)- # cm1(i,1)+cm1(i,2)-cm0(i)) ft5(i)= ft5(i)+sph*(-4./3.*cp3(i,2)-4./3.*cp3(i,3)+8./ # 3.*cp3(i,4)-4*cm3(i,2)-4*cm3(i,3)+8*cm3(i,4)+4./3.* # cc3(i,2)+4./3.*cc3(i,3)-8./3.*cc3(i,4)) ft5(i)= ft5(i)+smh*(4./3.*cp3(i,1)-8./3.*cp3(i,3)+4./3. # *cp3(i,4)+4./3.*cp2(i,1)+4./3.*cp2(i,2)-8./3.*cp2(i,3) # +4*cm3(i,1)-8*cm3(i,3)+4*cm3(i,4)+4*cm2(i,1)+4*cm2(i,2) # -8*cm2(i,3)-4./3.*cc3(i,1)+8./3.*cc3(i,3)-4./3.* # cc3(i,4)-4./3.*cc2(i,1)-4./3.*cc2(i,2)+8./3.*cc2(i,3)) ft5(i)= ft5(i)+sh*(4./3.*cp3(i,3)-4./3.*cp3(i,4)-4./3.* # cp2(i,2)+8./3.*cp2(i,3)+4./3.*cp1(i,2)+4*cm3(i,3)-4* # cm3(i,4)-4*cm2(i,2)+8*cm2(i,3)+4*cm1(i,2)-4./3.*cc3(i,3) # +4./3.*cc3(i,4)+4./3.*cc2(i,2)-8./3.*cc2(i,3)-4./3.*cc1(i,2)) ft5(i)= ft5(i)+(-8*cp3(i,5)+8*cp3(i,6)-8./3.*cp2(i,4) # -24*cm3(i,5)+24*cm3(i,6)-8*cm2(i,4)+8*cc3(i,5)-8* # cc3(i,6)+8./3.*cc2(i,4)) * ft6(i)= 2.d0*tqm2*(-cp1(i,1)-cp1(i,2)-cp0(i) # +cm1(i,1)+cm1(i,2)+cm0(i)) ft6(i)= ft6(i)+sph*(-4./3.*cp3(i,2)+4./3.*cp3(i,3)-4* # cm3(i,2)+4*cm3(i,3)+4./3.*cc3(i,2)-4./3.*cc3(i,3)) ft6(i)= ft6(i)+smh*(-4./3.*cp3(i,1)+4./3.*cp3(i,4)-4* # cp2(i,1)+4./3.*cp2(i,2)+8./3.*cp2(i,3)-8./3.*cp1(i,1) # +8./3.*cp1(i,2)-4*cm3(i,1)+4*cm3(i,4)-12*cm2(i,1)+4 # *cm2(i,2)+8*cm2(i,3)-8*cm1(i,1)+8*cm1(i,2)+4./3.*cc3(i,1) # -4./3.*cc3(i,4)+4*cc2(i,1)-4./3.*cc2(i,2)-8./3.* # cc2(i,3)+8./3.*cc1(i,1)-8./3.*cc1(i,2)) ft6(i)= ft6(i)+sh*(-4./3.*cp3(i,3)-4./3.*cp3(i,4)-4./3. # *cp2(i,2)-8./3.*cp2(i,3)-4./3.*cp1(i,2)-4*cm3(i,3)-4* # cm3(i,4)-4*cm2(i,2)-8*cm2(i,3)-4*cm1(i,2)+4./3.*cc3(i,3) # +4./3.*cc3(i,4)+4./3.*cc2(i,2)+8./3.*cc2(i,3)+4./3. # *cc1(i,2)) ft6(i)= ft6(i)+(8*cp3(i,5)+8*cp3(i,6)+8*cp2(i,4)+24* # cm3(i,5)+24*cm3(i,6)+24*cm2(i,4)-8*cc3(i,5)-8*cc3(i,6) # -8*cc2(i,4)) * endif * ftz1(i)= 4.d0*tqm2*(cp1(i,1)-cp1(i,2)+cp0(i)- # cm1(i,1)+cm1(i,2)-cm0(i)) ftz1(i)= ftz1(i)+sph*(cp3(i,2)+cp3(i,3)-2*cp3(i,4)+3* # cm3(i,2)+3*cm3(i,3)-6*cm3(i,4)) ftz1(i)= ftz1(i)+smh*(-cp3(i,1)+2*cp3(i,3)-cp3(i,4)- # cp2(i,1)-cp2(i,2)+2*cp2(i,3)-3*cm3(i,1)+6*cm3(i,3)- # 3*cm3(i,4)-3*cm2(i,1)-3*cm2(i,2)+6*cm2(i,3)) ftz1(i)= ftz1(i)+sh*(-cp3(i,3)+cp3(i,4)+cp2(i,2)+cp1(i, # 2)-3*cm3(i,3)+3*cm3(i,4)+3*cm2(i,2)+3*cm1(i,2)) ftz1(i)= ftz1(i)+(2*cp3(i,5)-2*cp3(i,6)-2*cp2(i,4)+6* # cm3(i,5)-6*cm3(i,6)-6*cm2(i,4)) * ftz2(i)= 2.d0*tqm2*(cp1(i,1)+cp1(i,2)+cp0(i)- # cm1(i,1)-cm1(i,2)-cm0(i)) ftz2(i)= ftz2(i)+sph*(1./2.*cp3(i,2)-1./2.*cp3(i,3)+ # cp2(i,2)-cp2(i,3)+3./2.*cm3(i,2)-3./2.*cm3(i,3)+3*cm2(i,2) # -3*cm2(i,3)) ftz2(i)= ftz2(i)+smh*(1./2.*cp3(i,1)-1./2.*cp3(i,4)+1./2. # *cp2(i,1)-1./2.*cp2(i,2)+3./2.*cm3(i,1)-3./2.*cm3(i,4) # +3./2.*cm2(i,1)-3./2.*cm2(i,2)) ftz2(i)= ftz2(i)+sh*(1./2.*cp3(i,3)+1./2.*cp3(i,4)+1./2.* # cp2(i,2)+cp2(i,3)+1./2.*cp1(i,2)+3./2.*cm3(i,3)+3./2. # *cm3(i,4)+3./2.*cm2(i,2)+3*cm2(i,3)+3./2.*cm1(i,2)) ftz2(i)= ftz2(i)+(-cp3(i,5)-cp3(i,6)-cp2(i,4)-3*cm3(i,5) # -3*cm3(i,6)-3*cm2(i,4)) * ftz3(i)= 2.d0*tqm2*(-cp1(i,1)+cp1(i,2)-cp0(i) # +cm1(i,1)-cm1(i,2)+cm0(i)) ftz3(i)= ftz3(i)+sph*(-3./2.*cp3(i,2)-3./2.*cp3(i,3)+3* # cp3(i,4)+cp2(i,2)-cp2(i,3)-9./2.*cm3(i,2)-9./2.*cm3(i,3) # +9*cm3(i,4)+3*cm2(i,2)-3*cm2(i,3)) ftz3(i)= ftz3(i)+smh*(3./2.*cp3(i,1)-3*cp3(i,3)+3./2.* # cp3(i,4)+5./2.*cp2(i,1)+3./2.*cp2(i,2)-4*cp2(i,3)+ # cp1(i,1)-cp1(i,2)+9./2.*cm3(i,1)-9*cm3(i,3)+9./2.* # cm3(i,4)+15./2.*cm2(i,1)+9./2.*cm2(i,2)-12*cm2(i,3)+3 # *cm1(i,1)-3*cm1(i,2)) ftz3(i)= ftz3(i)+sh*(3./2.*cp3(i,3)-3./2.*cp3(i,4)-3./2.* # cp2(i,2)+cp2(i,3)-1./2.*cp1(i,2)+9./2.*cm3(i,3)-9./2. # *cm3(i,4)-9./2.*cm2(i,2)+3*cm2(i,3)-3./2.*cm1(i,2)) ftz3(i)= ftz3(i)+(-3*cp3(i,5)+3*cp3(i,6)-cp2(i,4)-9* # cm3(i,5)+9*cm3(i,6)-3*cm2(i,4)) * ftz4(i)= 4*cp3(i,3)-4*cp3(i,4)-4*cp2(i,2)+4* # cp2(i,3)+12*cm3(i,3)-12*cm3(i,4)-12*cm2(i,2)+12*cm2(i,3) ftz4(i)= sh*ftz4(i) * if(rio.eq.'i') then ftz5(i)= 0.d0 ftz6(i)= 0.d0 else if(rio.eq.'a') then * ftz5(i)= 4.d0*tqm2*(-cp1(i,1)+cp1(i,2)-cp0(i) # +cm1(i,1)-cm1(i,2)+cm0(i)) ftz5(i)= ftz5(i)+sph*(-1./3.*cp3(i,2)-1./3.*cp3(i,3)+2./ # 3.*cp3(i,4)-cm3(i,2)-cm3(i,3)+2*cm3(i,4)-8./3.*cc3(i,2) # -8./3.*cc3(i,3)+16./3.*cc3(i,4)) ftz5(i)= ftz5(i)+smh*(1./3.*cp3(i,1)-2./3.*cp3(i,3)+1./3. # *cp3(i,4)+1./3.*cp2(i,1)+1./3.*cp2(i,2)-2./3.*cp2(i,3) # +cm3(i,1)-2*cm3(i,3)+cm3(i,4)+cm2(i,1)+cm2(i,2)-2 # *cm2(i,3)+8./3.*cc3(i,1)-16./3.*cc3(i,3)+8./3.*cc3(i,4) # +8./3.*cc2(i,1)+8./3.*cc2(i,2)-16./3.*cc2(i,3)) ftz5(i)= ftz5(i)+sh*(1./3.*cp3(i,3)-1./3.*cp3(i,4)-1./3.* # cp2(i,2)+2./3.*cp2(i,3)+1./3.*cp1(i,2)+cm3(i,3)-cm3(i,4) # -cm2(i,2)+2*cm2(i,3)+cm1(i,2)+8./3.*cc3(i,3)-8./ # 3.*cc3(i,4)-8./3.*cc2(i,2)+16./3.*cc2(i,3)+8./3.*cc1(i,2)) ftz5(i)= ftz5(i)+(-2*cp3(i,5)+2*cp3(i,6)-2./3.*cp2(i,4) # -6*cm3(i,5)+6*cm3(i,6)-2*cm2(i,4)-16*cc3(i,5)+16* # cc3(i,6)-16./3.*cc2(i,4)) * ftz6(i)= 4.d0*tqm2*(cp1(i,1)+cp1(i,2)+cp0(i)- # cm1(i,1)-cm1(i,2)-cm0(i)) ftz6(i)= ftz6(i)+sph*(-1./3.*cp3(i,2)+1./3.*cp3(i,3)- # cm3(i,2)+cm3(i,3)-8./3.*cc3(i,2)+8./3.*cc3(i,3)) ftz6(i)= ftz6(i)+smh*(-1./3.*cp3(i,1)+1./3.*cp3(i,4)- # cp2(i,1)+1./3.*cp2(i,2)+2./3.*cp2(i,3)-2./3.*cp1(i,1) # +2./3.*cp1(i,2)-cm3(i,1)+cm3(i,4)-3*cm2(i,1)+cm2(i,2) # +2*cm2(i,3)-2*cm1(i,1)+2*cm1(i,2)-8./3.*cc3(i,1)+ # 8./3.*cc3(i,4)-8*cc2(i,1)+8./3.*cc2(i,2)+16./3.*cc2(i,3) # -16./3.*cc1(i,1)+16./3.*cc1(i,2)) ftz6(i)= ftz6(i)+sh*(-1./3.*cp3(i,3)-1./3.*cp3(i,4)-1./3. # *cp2(i,2)-2./3.*cp2(i,3)-1./3.*cp1(i,2)-cm3(i,3)-cm3(i,4) # -cm2(i,2)-2*cm2(i,3)-cm1(i,2)-8./3.*cc3(i,3)-8./ # 3.*cc3(i,4)-8./3.*cc2(i,2)-16./3.*cc2(i,3)-8./3.*cc1(i,2)) ftz6(i)= ftz6(i)+(2*cp3(i,5)+2*cp3(i,6)+2*cp2(i,4)+6* # cm3(i,5)+6*cm3(i,6)+6*cm2(i,4)+16*cc3(i,5)+16*cc3(i,6) # +16*cc2(i,4)) * endif * enddo *///////////////////////////////////////////////////////////////////// endif * if(ofl.eq.'c'.or.ofl.eq.'a') then astrrs= 0.5d0-strrs saimz= stris*aimz arz= astrrs*rz aaimz= astrrs*aimz raimz= strrs*aimz srz= stris*rz if(ofl.eq.'c') then cvg1r= 3.d0*f1(1)+ft1(1)-8.d0*p3qs(1) cvg2r= 3.d0*f2(1)+ft2(1) cvg3r= 3.d0*f3(1)+ft3(1) cvg4r= 3.d0*f4(1)+ft4(1) cvg5r= ft5(1) cvg6r= ft6(1) cvg1i= 3.d0*f1(2)+ft1(2)-8.d0*p3qs(2) cvg2i= 3.d0*f2(2)+ft2(2) cvg3i= 3.d0*f3(2)+ft3(2) cvg4i= 3.d0*f4(2)+ft4(2) cvg5i= ft5(2) cvg6i= ft6(2) cvz1r= ftz1(1)*ctrrsi-ftz1(2)*ctrisi cvz1i= ftz1(1)*ctrisi+ftz1(2)*ctrrsi cvz2r= ftz2(1)*ctrrsi-ftz2(2)*ctrisi cvz2i= ftz2(1)*ctrisi+ftz2(2)*ctrrsi cvz3r= ftz3(1)*ctrrsi-ftz3(2)*ctrisi cvz3i= ftz3(1)*ctrisi+ftz3(2)*ctrrsi cvz4r= ftz4(1)*ctrrsi-ftz4(2)*ctrisi cvz4i= ftz4(1)*ctrisi+ftz4(2)*ctrrsi cvz5r= ftz5(1)*ctrrsi-ftz5(2)*ctrisi cvz5i= ftz5(1)*ctrisi+ftz5(2)*ctrrsi cvz6r= ftz6(1)*ctrrsi-ftz6(2)*ctrisi cvz6i= ftz6(1)*ctrisi+ftz6(2)*ctrrsi * cvc1r= cvg1r+0.5d0*cvz1r cvc1i= cvg1i+0.5d0*cvz1i cvc2r= cvg2r+0.5d0*cvz2r cvc2i= cvg2i+0.5d0*cvz2i cvc3r= cvg3r+0.5d0*cvz3r cvc3i= cvg3i+0.5d0*cvz3i cvc4r= cvg4r+0.5d0*cvz4r cvc4i= cvg4i+0.5d0*cvz4i cvc5r= cvg5r+0.5d0*cvz5r cvc5i= cvg5i+0.5d0*cvz5i cvc6r= cvg6r+0.5d0*cvz6r cvc6i= cvg6i+0.5d0*cvz6i * else if(ofl.eq.'a') then cvg1r= acg1g+0.5d0*sh/wm2*aclg cvg2r= 0.5d0*(acg1g+ackg)+0.5d0*(1.d0-sh/wm2)*aclg cvg3r= 0.d0 cvg4r= sh/wm2*aclg cvg5r= 0.d0 cvg6r= -acg5g cvg1i= 0.d0 cvg2i= 0.d0 cvg3i= 0.5d0*acg4g cvg4i= 0.d0 cvg5i= -(acktg-acltg) cvg6i= 0.d0 * cvc1r= acg1z+0.5d0*sh/wm2*aclz cvc2r= 0.5d0*(acg1z+ackz)+0.5d0*(1.d0-sh/wm2)*aclz cvc3r= 0.d0 cvc4r= sh/wm2*aclz cvc5r= 0.d0 cvc6r= -acg5z cvc1i= 0.d0 cvc2i= 0.d0 cvc3i= 0.5d0*acg4z cvc4i= 0.d0 cvc5i= -(acktz-acltz) cvc6i= 0.d0 endif * cv1ar= -0.5d0*(strrs*cvg1r-stris*cvg1i)-0.5d0* # arz*cvc1r-0.5d0*srz*cvc1i+0.5d0* # aaimz*cvc1i-0.5d0*saimz*cvc1r cv1ai= -0.5d0*(strrs*cvg1i+stris*cvg1r)-0.5d0* # arz*cvc1i+0.5d0*srz*cvc1r-0.5d0* # aaimz*cvc1r-0.5d0*saimz*cvc1i cv2ar= -0.5d0*(strrs*cvg2r-stris*cvg2i)-0.5d0* # arz*cvc2r-0.5d0*srz*cvc2i+0.5d0* # aaimz*cvc2i-0.5d0*saimz*cvc2r cv2ai= -0.5d0*(strrs*cvg2i+stris*cvg2r)-0.5d0* # arz*cvc2i+0.5d0*srz*cvc2r-0.5d0* # aaimz*cvc2r-0.5d0*saimz*cvc2i cv3ar= -0.5d0*(strrs*cvg3r-stris*cvg3i)-0.5d0* # arz*cvc3r-0.5d0*srz*cvc3i+0.5d0* # aaimz*cvc3i-0.5d0*saimz*cvc3r cv3ai= -0.5d0*(strrs*cvg3i+stris*cvg3r)-0.5d0* # arz*cvc3i+0.5d0*srz*cvc3r-0.5d0* # aaimz*cvc3r-0.5d0*saimz*cvc3i cv4ar= -0.5d0*(strrs*cvg4r-stris*cvg4i)-0.5d0* # arz*cvc4r-0.5d0*srz*cvc4i+0.5d0* # aaimz*cvc4i-0.5d0*saimz*cvc4r cv4ai= -0.5d0*(strrs*cvg4i+stris*cvg4r)-0.5d0* # arz*cvc4i+0.5d0*srz*cvc4r-0.5d0* # aaimz*cvc4r-0.5d0*saimz*cvc4i cv5ar= -0.5d0*(strrs*cvg5r-stris*cvg5i)-0.5d0* # arz*cvc5r-0.5d0*srz*cvc5i+0.5d0* # aaimz*cvc5i-0.5d0*saimz*cvc5r cv5ai= -0.5d0*(strrs*cvg5i+stris*cvg5r)-0.5d0* # arz*cvc5i+0.5d0*srz*cvc5r-0.5d0* # aaimz*cvc5r-0.5d0*saimz*cvc5i cv6ar= -0.5d0*(strrs*cvg6r-stris*cvg6i)-0.5d0* # arz*cvc6r-0.5d0*srz*cvc6i+0.5d0* # aaimz*cvc6i-0.5d0*saimz*cvc6r cv6ai= -0.5d0*(strrs*cvg6i+stris*cvg6r)-0.5d0* # arz*cvc6i+0.5d0*srz*cvc6r-0.5d0* # aaimz*cvc6r-0.5d0*saimz*cvc6i cv1br= -0.5d0*(strrs*(cvg1r-rz*cvc1r)- # stris*(cvg1i-rz*cvc1i))-0.5d0* # raimz*cvc1i-0.5d0*saimz*cvc1r cv1bi= -0.5d0*(stris*(cvg1r-rz*cvc1r)+ # strrs*(cvg1i-rz*cvc1i))+0.5d0*( # raimz*cvc1r-saimz*cvc1i) cv2br= -0.5d0*(strrs*(cvg2r-rz*cvc2r)- # stris*(cvg2i-rz*cvc2i))-0.5d0* # raimz*cvc2i-0.5d0*saimz*cvc2r cv2bi= -0.5d0*(stris*(cvg2r-rz*cvc2r)+ # strrs*(cvg2i-rz*cvc2i))+0.5d0*( # raimz*cvc2r-saimz*cvc2i) cv3br= -0.5d0*(strrs*(cvg3r-rz*cvc3r)- # stris*(cvg3i-rz*cvc3i))-0.5d0* # raimz*cvc3i-0.5d0*saimz*cvc3r cv3bi= -0.5d0*(stris*(cvg3r-rz*cvc3r)+ # strrs*(cvg3i-rz*cvc3i))+0.5d0*( # raimz*cvc3r-saimz*cvc3i) cv4br= -0.5d0*(strrs*(cvg4r-rz*cvc4r)- # stris*(cvg4i-rz*cvc4i))-0.5d0* # raimz*cvc4i-0.5d0*saimz*cvc4r cv4bi= -0.5d0*(stris*(cvg4r-rz*cvc4r)+ # strrs*(cvg4i-rz*cvc4i))+0.5d0*( # raimz*cvc4r-saimz*cvc4i) cv5br= -0.5d0*(strrs*(cvg5r-rz*cvc5r)- # stris*(cvg5i-rz*cvc5i))-0.5d0* # raimz*cvc5i-0.5d0*saimz*cvc5r cv5bi= -0.5d0*(stris*(cvg5r-rz*cvc5r)+ # strrs*(cvg5i-rz*cvc5i))+0.5d0*( # raimz*cvc5r-saimz*cvc5i) cv6br= -0.5d0*(strrs*(cvg6r-rz*cvc6r)- # stris*(cvg6i-rz*cvc6i))-0.5d0* # raimz*cvc6i-0.5d0*saimz*cvc6r cv6bi= -0.5d0*(stris*(cvg6r-rz*cvc6r)+ # strrs*(cvg6i-rz*cvc6i))+0.5d0*( # raimz*cvc6r-saimz*cvc6i) * endif * endif * if(oqcd.eq.'y') then if(iqcd.lt.2) then qcdjac= (1.d0+0.5d0*als/pi*(fcuc-1.d0))* # (1.d0+0.5d0*als/pi*(fcdc-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*(fcuc-1.d0))* # (1.d0+0.5d0*alsm/pi*(fcdc-1.d0))-1.d0 endif else qcdjac= 0.d0 endif * cbw= -1.d0+sp-sm ifcr= 1 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(ifcr.ne.0.or.bt1(2).ne.0.d0) then iz= 0 ifz(7)= ifz(7)+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(8)= ifz(8)+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(9)= ifz(9)+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.7.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.7.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(10)= ifz(10)+1 go to 1 endif * if(itc.eq.13) then bdistl= 2.d0*arrinv(3)/vv-sul bdistu= suu-2.d0*arrinv(3)/vv if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif su= 2.d0*arrinv(3)/vv sujc= 2.d0/sh else sujc= suu-sul su= sujc*sux+sul endif if(su.lt.0.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * 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.7.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(11)= ifz(11)+1 go to 1 endif * if(itc.eq.7.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(11)= ifz(11)+1 go to 1 endif endif * if(itc.eq.7.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 if(itc.eq.13) then bdistl= 2.d0*arrinv(4)/vv-sdl bdistu= sdu-2.d0*arrinv(4)/vv if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(11)= ifz(11)+1 go to 1 endif sd= 2.d0*arrinv(4)/vv sdjc= 2.d0/sh else sdjc= sdu-sdl sd= sdjc*sdx+sdl endif * if(sd.lt.0.d0) then iz= 0 ifz(11)= ifz(11)+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( O O O O O O O O O O O O O O O if(ifel.ne.0) thenc O iz= 0t& O ifz(16)= ifz(16)+1 O go to 2) O endif O endifz" O if(equ.eq.1.d0) then O sfut= 0.d0  O else O ifel= 19 O sfut= -dog*espu*s21bbf(equ,eru,one,ifel) # O if(ifel.ne.0) thens O iz= 01& O ifz(17)= ifz(17)+1 O go to 2r O endif O endif) O if(iel.eq.1) thenv# O if(sfu.le.er) thenv O efac= 0.5d0r- O sft= (sfut-sflt)*sfx+sflt. O ifel= 1 ! O asf= -sft/dogi; O call s21caf(asf,ek2,elsn,elcn,edn,ifel) & O if(ifel.ne.0) then O iz= 0) O ifz(18)= ifz(18)+1  O go to 2 O endif+/ O sf= 0.5d0*(ombsg-sedm*elcn)h* O sfjc= efac*(sfut-sflt)) O else if(sfl.ge.er) then5 O efac= 0.5d0 - O sft= (sflt-sfut)*sfx+sfut  O ifel= 1 ! O asf= -sft/dog ; O call s21caf(asf,ek2,elsn,elcn,edn,ifel) O & O if(ifel.ne.0) then O iz= 0) O ifz(19)= ifz(19)+1d O go to 2 O endif(/ O sf= 0.5d0*(ombsg+sedm*elcn) * O sfjc= efac*(sflt-sfut) O else O efac= 1.d0 O qbar= 0.d0" O rbar= 1.d0-ek2 O ifel= 1 : O sfbar= -dog*s21bbf(qbar,rbar,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(20)= ifz(20)+1  O go to 2 O endif=$ O if(it.eq.1) then1 O sft= (sfbar-sflt)*sfx+sflt* O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) thenm O iz= 0 , O ifz(21)= ifz(21)+1! O go to 2d O endif2 O sf= 0.5d0*(ombsg-sedm*elcn). O sfjc= efac*(sfbar-sflt)* O else if(it.eq.2) then1 O sft= (sfbar-sfut)*sfx+sfut  O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) then* O iz= 0 O , O ifz(22)= ifz(22)+1! O go to 2d O endif2 O sf= 0.5d0*(ombsg+sedm*elcn). O sfjc= efac*(sfbar-sfut) O endif O endifv$ O else if(iel.eq.2) then O efac= 1.d0" O if(it.eq.1) then. O sft= (sfut-sflt)*sfx+sflt O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) thend O iz= 0d* O ifz(23)= ifz(23)+1 O go to 2v O endif0 O sf= 0.5d0*(ombsg-sedm*elcn)+ O sfjc= efac*(sfut-sflt)-' O else if(it.eq.2) then*. O sft= (sflt-sfut)*sfx+sfut O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) then# O iz= 0i* O ifz(24)= ifz(24)+1 O go to 2  O endif0 O sf= 0.5d0*(ombsg+sedm*elcn)+ O sfjc= efac*(sflt-sfut)t O endifb O endif/6 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then$ O if(edelp.le.0.d0) then O iz= 0# O ifz(25)= ifz(25)+1  O go to 2 O endif2 O sedp= sqrt(edelp)2 O efac= 1.d0 O es1= rs1(1)s O es2= rs2(1)i O er1= rr1(1)) O er2= rr2(1)  O ssed= sedm+sedp " O ek= (sedm-sedp)/ssed O ek2= ek*ek O dog= 2.d0/ssed O if(it.eq.1) then. O es2pl= (er1-sfl)/(sfl-er2)/ek. O es2pu= (er1-sfu)/(sfu-er2)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu# O else if(it.eq.2) then,. O es2pl= (sfl-es2)/(sfl-es1)/ek. O es2pu= (sfu-es2)/(sfu-es1)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu O endifs% O if(eql.eq.1.d0) then O  O sflt= 0.d0 O else O  O ifel= 14/ O sflt= 2.d0*dog*sqrt(es2pl)*(2 O # s21bbf(eql,erl,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(26)= ifz(26)+1  O go to 2 O endif. O endif% O if(equ.eq.1.d0) then( O sfut= 0.d0 O elses O ifel= 1 ? O if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then( O equ= 0.d0 O endifs/ O sfut= 2.d0*dog*sqrt(es2pu)*s2 O # s21bbf(equ,eru,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(27)= ifz(27)+1  O go to 2 O endif  O endif* O sft= (sfut-sflt)*sfx+sflt O ifel= 1# O asf= 0.5d0/dog*sft-8 O call s21caf(asf,ek2,elsn,elcn,edn,ifel)! O elsn2= elsn*elsn-# O if(ifel.ne.0) then  O iz= 0 & O ifz(28)= ifz(28)+1 O go to 2d O endif! O if(it.eq.1) then(: O sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)& O else if(it.eq.2) then: O sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) O endif' O sfjc= efac*(sfut-sflt)* O endif O *  O endif O *t O *-----auxiliary quantities x O *f O sdpf= sd+sf O e3= sp+su+sf O  O e4= 1.d0+spmm-e3  O e3p4= 1.d0+spmm O e1= sm+sdpf O e2= 1.d0+smmp-e1e( O e1p2= 1.d0+smmp $ O e1p3= e1+e3 0 O e1m2= 2.d0*e1-1.d0+spmm  O ep12= xp*e1*e2. O ep1= xp*e1f O ep2= xp*e2l O ep3= xp*e3  O ep4= xp*e4 O  O e1t2= e1*e2 O e1t3= e1*e3 O e1t4= e1*e4 O e2t3= e2*e3 O e2t4= e2*e4 O e3t4= e3*e4/ O if((e1p3*e1p3-4.d0*sf).lt.0.d0) then- O iz= 0! O ifz(29)= ifz(29)+1  O go to 2 O endif( O skl2= sqrt(e1p3*e1p3-4.d0*sf)+ O if((sdmus-4.d0*sd).lt.0.d0) thena O iz= 0! O ifz(30)= ifz(30)+1  O go to 2 O endif O skl3= sdmus-4.d0*sd O skl3= sqrt(skl3)) O *. O *-----initialization of t_wt O *-) O *-----limits on tw from positivity and SA  O *  O twlp1= 0.d0 O twlp2= smmp O twlp3= spmm-1.d0u) O twlp= dmax1(twlp1,twlp2,twlp3)i O twup= 1.d0 O  O * " O *-----limits on tw from cuts on SA O *  O if(iac(3).ne.0) then)& O skl2m= 0.5d0*(e1 -skl2)& O skl2p= 0.5d0*(e1p3+skl2), O skl3p= -0.5d0*(1.d0+sdmu-skl3), O skl3m= -0.5d0*(1.d0+sdmu+skl3), O twlsa1= 1.d0-cs(3)*e3-cs(4)*e4' O twlsa2= ss(1)*e1+ss(2)*e2 8 O twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m4 O twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m4 O twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p8 O twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m, O twusa1= 1.d0-ss(3)*e3-ss(4)*e4' O twusa2= cs(1)*e1+cs(2)*e2 O 8 O twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m4 O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,1( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, O ( O # twusa5,twusa6) O elset O atwl= twlp O atwu= twup O endif O *1 O *-----limits on tw from Ed O *1 O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2) " O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1)b% O atwle2= bxe*e2-bl(2) * O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2)m1 O twue= dmin1(atwle,atwue1,atwue2)> O endifn$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *t O *-----natural limits on tw O * # O atwl= dmax1(atwl,bt1(1))2# O atwu= dmin1(atwu,bt2(1)) O  O *  O *-----test on tw O *h O if(atwu.le.atwl) then O iz= 00 O ifz(31)= ifz(31)+1 O go to 2  O endif O if(itc.eq.13) then 8 O bdistl= 2.d0*(arrinv(7)+arrinv(8))/uv-atwl8 O bdistu= atwu-2.d0*(arrinv(7)+arrinv(8))/uv7 O if(bdistl.le.0.d0.or.bdistu.le.0.d0) then  O iz= 0# O ifz(31)= ifz(31)+1  O go to 2 O endifs/ O tw= 2.d0*(arrinv(7)+arrinv(8))/uv O  O twjc= 2.d0*xp/sh O else  O twjc= atwu-atwl O  O tw= twjc*twx+atwl  O endif O pn= tw+sp-1.d0d O omtw= 1.d0-tw O *  O *-----initialization of t1 O *u% O *-----limits on t1 from positivity+SAr O *t O t1lp1= 0.d0 O t1lp2= pn+sdpf  O t1up1= tw O t1up2= sm+sdpf # O t1lp= dmax1(t1lp1,t1lp2) # O t1up= dmin1(t1up1,t1up2)2 O *r" O *-----limits on t1 from cuts on SA O *= O if(iac(3).ne.0) then  O t1lc1= ss(1)*e1r O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3))f5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) / O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3r4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1f O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))p5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3=4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else( O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E= O *u O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1)=" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif O $ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O * O 4 O *-----positivity of (R')^2 / reality of roots for t3 O * ! O rp0= e1p2*e1p2-4.d0*sm3 O if(rp0.le.0.d0) then  O iz= 0f O ifz(31)= ifz(31)+1 O go to 2 O  O endif O srp0= sqrt(rp0) O rp0e= -rp0 , O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1d& O rp2= -(e1*tw-sm)*(e1*tw-sm) O ifct= 14 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) O if(ifct.eq.1) then  O sret1= ret1(1)# O if(rp1e.gt.0.d0) then ' O t1l= dmax1(at1l,sret1)  O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1)/ O endif 5 O else if(ifct.gt.1.or.ret1(2).ne.0.d0) then  O iz= 0) O ifz(32)= ifz(32)+1 O go to 2  O else / O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1)) O endif O *  O *-----test on t1 O *  O if(t1u.le.t1l) then O iz= 0 O ifz(33)= ifz(33)+1 O go to 2  O endif O *s" O sr= 1.d0-sm-sp-su-sd-sf2 O desp= 1.d0-2.d0*(xm+xp)-(xm-xp)*(xm-xp)8 O desd= -1.d0+3.d0*(xm+xp)+2.d0*(xm-xp)*(xm-xp)! O desu= -desp+1.d0-xm-xp ! O desr= -desu+1.d0-xm-xp . O dt1= xp*(5.d0-2.d0*xm+2.d0*xp)-1.d02 O de1= dt1-1.d0+xm*(5.d0+2.d0*xm-2.d0*xp) O xmas= 1.d0+rmu2 O if(itc.eq.10) thent6 O t1= ep1*(1.d0-dist)/(xm+xp+(xm-xp)*dist)- O if(t1.lt.t1l.or.t1.gt.t1u) thens O iz= 0# O ifz(34)= ifz(34)+1  O go to 2 O endif O 6 O t1jc= 2.d0*vv*e1/(xm+xp+(xm-xp)*dist)**2( O ojc= t1*(rp0e*t1+rp1e)+rp2" O t1jc= t1jc/sqrt(ojc)" O else if(itc.eq.13) then# O t1= 2.d0*arrinv(7)/uvj- O if(t1.lt.t1l.or.t1.gt.t1u) thenc O iz= 0# O ifz(34)= ifz(34)+1. O go to 2 O endif- O t1jc= 2.d0*xp/sh( O ojc= t1*(rp0e*t1+rp1e)+rp2" O t1jc= t1jc/sqrt(ojc) O else  O *( O *-----Angular peak withg O *o$ O if(opeaka.eq.'y') then) O if(opeakas.eq.'i') then=& O taul= 1.d0/(e1-t1l)& O tauu= 1.d0/(e1-t1u)* O taumx= dmax1(taul,tauu)* O taumn= dmin1(taul,tauu)% O t1jc0= taumx-taumn 0 O t1= e1-1.d0/(t1jc0*t1x+taumn)- O ojc= t1*(rp0e*t1+rp1e)+rp2 ' O if(ojc.le.0.d0) then  O iz= 0j( O ifz(36)= ifz(36)+1 O go to 2/ O endif( O t1jc= t1jc0/sqrt(ojc). O else if(opeakas.eq.'l') then O taul0= e1-t1l O tauu0= e1-t1u: O if(taul0.le.0.d0.or.tauu0.le.0.d0) then O iz= 0 ( O ifz(36)= ifz(36)+1 O go to 2e O endif$ O taul= -log(taul0)$ O tauu= -log(tauu0)* O taumx= dmax1(taul,tauu)* O taumn= dmin1(taul,tauu)% O t1jc0= taumx-taumn ) O t1exp= t1jc0*t1x+taumn & O t1= e1-exp(-t1exp) - O ojc= t1*(rp0e*t1+rp1e)+rp2l' O if(ojc.le.0.d0) then0 O iz= 0 ( O ifz(36)= ifz(36)+1 O go to 2  O endif3 O t1jc= t1jc0/sqrt(ojc)*exp(t1exp)s O endif ) O else if(opeaka.eq.'f') then  O t1jc0= t1u-t1lr" O t1= t1jc0*t1x+t1l+ O ojc= t1*(rp0e*t1+rp1e)+rp2 % O if(ojc.le.0.d0) then  O iz= 0 O & O ifz(37)= ifz(37)+1 O go to 2. O endif& O t1jc= t1jc0/sqrt(ojc)+ O else if(opeaka.eq.'n') then = O *o! O *-----transformation for jacobian  O * # O if(rp0e.eq.0.d0) then 3 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)z3 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-taul< O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e O endif % O if(ret1(1).eq.t1l) thenf! O at1tl= -pih/srp0  O else3 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l)  O ifas= 10 O at1tl= -s09aaf(bt1tl,ifas)/srp0( O if(ifas.ne.0) print 200 O endifz% O if(ret2(1).eq.t1u) then O at1tu= pih/srp0 O else4 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) O ifas= 10 O at1tu= -s09aaf(bt1tu,ifas)/srp0( O if(ifas.ne.0) print 200 O endifs, O if((at1tl+at1tu).eq.0.d0) then& O if(t1x.lt.1.d-3) then O arc= pi*t1xn! O arc2= arc*arc : O exc= arc2*(exc2+arc2*(exc4+arc2*(exc6+2 O # arc2*(exc8+arc2*exc10)))); O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc 2 O else if((1.d0-t1x).lt.1.d-3) then& O arc= pi*(1.d0-t1x)! O arc2= arc*arc.: O exc= arc2*(exc2+arc2*(exc4+arc2*(exc6+2 O # arc2*(exc8+arc2*exc10)))); O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc  O elseh% O carc= cos(pi*t1x) 0 O t1= 0.5d0*(ret1(1)+ret2(1))+4 O # 0.5d0*(ret1(1)-ret2(1))*carc O endif O t1jc= pi/srp0 O else) O t1tl= dmin1(at1tl,at1tu) ) O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tl# O t1t= t1jc*t1x+t1tl 1 O t1= (rp1+rpds*sin(srp0*t1t))/rp0  O endif  O endif O endif1 O 200 format(' Unsuccesful call to S09AAF ')  O t1s= t1*t1  O *  O *-----test on t1 from FS A O *)/ O if(ieq.eq.1.and.iac(4).ne.0.d0) then O 2 O cnlct1= xp*(xm*sm-ep12*cg12)+xp*xdf*9 O # e1*cg12*tw+xdf*cg12*t1*(xp*(e2-e1)- + O # xdf*tw)+xdfs*cg12*t1ss3 O cnlst1= xp*(ep12*sg12-xm*sm)-xp*xdf*s7 O # e1*sg12*tw+xdf*sg12*t1*(xp*e1m2+e, O # xdf*tw)-xdfs*sg12*t1s& O if(cnlct1.lt.0.d0) then O iz= 0o$ O ifz(38)= ifz(38)+1 O go to 20+ O else if(cnlst1.lt.0.d0) then  O iz= 0 O $ O ifz(39)= ifz(39)+1 O go to 2  O endif O endif O *  O *-----some vector components O *i O t2= tw-t1  O t2s= t2*t2 O *f O edn1= ep1-xdf*t1 O edn2= ep2-xdf*t2 O * - O if(otype.eq.'cc20'.and.ofl.eq.'c') then2 O *f O x23h= (e1-t1)*sh) O p223r= x23h O p223i= 0.d02 O call wtopole(p223r,p223i,p3q23,fz23,fw23) O xg230= 1.d0/8.d0/gf/wm20 O xg23r= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+! O # p3qw(1)-p3q23(1))m# O xg23i= -0.5d0*ccw*p3q23(2)s O agr23= xg230*xg23r  O agi23= xg230*xg23it& O if(abs(agi23).gt.1.d-20) then# O print*,' g(t) complex 'e O stop O endif O gr23= 1.d0/agr23 : O call wtopoleg(p223r,p223i,pggf23,pgglq23,pggnp23)7 O are23= ali-0.25d0*(pggf23(1)-pggf0+pggnp23)/pi 0 O ai23= -0.25d0*(pggf23(2)+pgglq23(2))/pi% O if(abs(ai23).gt.1.d-20) then ' O print*,' alpha(t) complex '5 O stop O endif O er23= 4.d0*pi/are23 O str23= er23*agr23 O ctr23= 1.d0-str23 O pr23r= x23h+sz(1) O pr23i= sz(2) O ' O pr23m= pr23r*pr23r+pr23i*pr23i  O pr23ri= pr23r/pr23m O pr23ii= -pr23i/pr23m  O ratgr= gr23*agrsz O ratgi= gr23*agisz O ratcr= ctrrsz/ctr23 O ratci= ctrisz/ctr23 O ratgc= gr23/ctr23+ O ratr= 1.d0-ratgr*ratcr+ratgi*ratci ' O rati= -ratgr*ratci-ratgi*ratcrsA O arhr23= x23h+sz(1)-ratr*sz(1)+rati*sz(2)-ratgc*(fz23(1)-k O # fzsz(1))/apis< O arhi23= sz(2)-ratr*sz(2)-rati*sz(1)-ratgc*(fz23(2)- O # fzsz(2))/apis, O brhr23= arhr23*pr23ri-arhi23*pr23ii, O brhi23= arhr23*pr23ii+arhi23*pr23ri, O brhm23= brhr23*brhr23+brhi23*brhi23 O rhr23= brhr23/brhm23  O rhi23= -brhi23/brhm23 O *i O x14h= t2*sh O p214r= x14h O p214i= 0.d02 O call wtopole(p214r,p214i,p3q14,fz14,fw14) O xg140= 1.d0/8.d0/gf/wm20 O xg14r= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+! O # p3qw(1)-p3q14(1))e# O xg14i= -0.5d0*ccw*p3q14(2)i O agr14= xg140*xg14rq O agi14= xg140*xg14i & O if(abs(agi14).gt.1.d-20) then# O print*,' g(t) complex '  O stop O endif O gr14= 1.d0/agr14  O p14r= x14h+sw(1)e& O pr14ri= p14r/(p14r*p14r+swis)( O pr14ii= -sw(2)/(p14r*p14r+swis) O rat14r= 1.d0-gr14*agrsw O rat14i= -gr14*agisw; O arhr14= x14h+sw(1)-rat14r*sw(1)+rat14i*sw(2)-gr14* ' O # (fw14(1)-fwsw(1))/apis 6 O arhi14= sw(2)-rat14r*sw(2)-rat14i*sw(1)-gr14*' O # (fw14(2)-fwsw(2))/apis , O brhr14= arhr14*pr14ri-arhi14*pr14ii, O brhi14= arhr14*pr14ii+arhi14*pr14ri, O brh14m= brhr14*brhr14+brhi14*brhi14 O rhr14= brhr14/brh14m  O rhi14= -brhi14/brh14m O *e O endif  O * - O if(otype.eq.'cc20'.and.ofl.eq.'c') then  O jfl= 1  O p1s= t2*sh  O p2s= -sph O ps= (e1-t1)*sh  O rm12= rnm2i O rm22= rnm2e O rm32= rnm2 3 O call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, O ) O # ec00,ec01,ec02,ec03)  O jfl= 12 O p1s= t2*shn O p2s= -sph O ps= (e1-t1)*sh- O rm12= rnm2( O rm22= tqm2  O rm32= rnm2 3 O call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, ) O # eca0,eca1,eca2,eca3)  O jfl= 1( O p1s= t2*sh  O p2s= -sph O ps= (e1-t1)*sh* O rm12= tqm2  O rm22= rnm2h O rm32= tqm2 3 O call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, ) O # ecb0,ecb1,ecb2,ecb3)u O *f O do i=1,2d O do j=1,6. O ecp3(i,j)= eca3(i,j)+2.d0*ecb3(i,j). O ecm3(i,j)= eca3(i,j)-2.d0*ecb3(i,j). O ecc3(i,j)= ecp3(i,j)-3.d0*ec03(i,j) O enddo = O do j=1,4. O ecp2(i,j)= eca2(i,j)+2.d0*ecb2(i,j). O ecm2(i,j)= eca2(i,j)-2.d0*ecb2(i,j). O ecc2(i,j)= ecp2(i,j)-3.d0*ec02(i,j) O enddo = O do j=1,2. O ecp1(i,j)= eca1(i,j)+2.d0*ecb1(i,j). O ecm1(i,j)= eca1(i,j)-2.d0*ecb1(i,j). O ecc1(i,j)= ecp1(i,j)-3.d0*ec01(i,j) O enddo ' O ecp0(i)= eca0(i)+2.d0*ecb0(i) O ' O ecm0(i)= eca0(i)-2.d0*ecb0(i)p' O ecc0(i)= ecp0(i)-3.d0*ec00(i)  O enddo O xg= (e1-t1)*sh9 O xw= t2*sh O *  O do i=1,2d O * O 7 O h1(i)= xg*(16*ec03(i,3)-16*ec03(i,4)-16*ec02(i,2)s O # -16*ec01(i,2))= O h1(i)= h1(i)+xw*(16*ec03(i,1)-32*ec03(i,3)+16*ec03(i,4) O 0 O # +16*ec02(i,1)+16*ec02(i,2)-32*ec02(i,3))? O h1(i)= h1(i)+sph*(16*ec03(i,2)+16*ec03(i,3)-32*ec03(i,4))n; O h1(i)= h1(i)+(32*ec03(i,5)-32*ec03(i,6)-32*ec02(i,4))a# O h1(i)= h1(i)+32.d0/3.d0*co(i)  O * 8 O h2(i)= xg*(-24*ec03(i,3)+24*ec03(i,4)+24*ec02(i,2)" O # -16*ec02(i,3)+8*ec01(i,2))> O h2(i)= h2(i)+xw*(-24*ec03(i,1)+48*ec03(i,3)-24*ec03(i,4)= O # -40*ec02(i,1)-24*ec02(i,2)+64*ec02(i,3)-16*ec01(i,1)+( O # 16*ec01(i,2)) ? O h2(i)= h2(i)+sph*(-24*ec03(i,2)-24*ec03(i,3)+48*ec03(i,4)u# O # +16*ec02(i,2)-16*ec02(i,3))1< O h2(i)= h2(i)+(-48*ec03(i,5)+48*ec03(i,6)-16*ec02(i,4)) O * 5 O h3(i)= xg*(-8*ec03(i,3)-8*ec03(i,4)-8*ec02(i,2)s" O # -16*ec02(i,3)-8*ec01(i,2)); O h3(i)= h3(i)+xw*(-8*ec03(i,1)+8*ec03(i,4)-8*ec02(i,1)  O # +8*ec02(i,2))2@ O h3(i)= h3(i)+sph*(8*ec03(i,2)-8*ec03(i,3)+16*ec02(i,2)-16* O # ec02(i,3))< O h3(i)= h3(i)+(-16*ec03(i,5)-16*ec03(i,6)-16*ec02(i,4)) O * @ O h4(i)= 64*ec03(i,3)-64*ec03(i,4)-64*ec02(i,2)+64*ec02(i,3) O h4(i)= sh*h4(i)  O *w6 O ht1(i)= tqm2*(-2*ecp1(i,1)+2*ecp1(i,2)-2*ecp0(i)+ O # +2*ecm1(i,1)-2*ecm1(i,2)+2*ecm0(i)) < O ht1(i)= ht1(i)+xg*(4*ecc3(i,3)-4*ecc3(i,4)-4*ecc2(i,2) O # -4*ecc1(i,2)),< O ht1(i)= ht1(i)+xw*(4*ecc3(i,1)-8*ecc3(i,3)+4*ecc3(i,4)- O # +4*ecc2(i,1)+4*ecc2(i,2)-8*ecc2(i,3))2> O ht1(i)= ht1(i)+sph*(4*ecc3(i,2)+4*ecc3(i,3)-8*ecc3(i,4)): O ht1(i)= ht1(i)+(8*ecc3(i,5)-8*ecc3(i,6)-8*ecc2(i,4)) O *p9 O ht2(i)= tqm2*(ecp1(i,1)-ecp1(i,2)+ecp0(i)-ecm1(i,1)  O # +ecm1(i,2)-ecm0(i)) = O ht2(i)= ht2(i)+xg*(-6*ecc3(i,3)+6*ecc3(i,4)+6*ecc2(i,2)=! O # -4*ecc2(i,3)+2*ecc1(i,2)) > O ht2(i)= ht2(i)+xw*(-6*ecc3(i,1)+12*ecc3(i,3)-6*ecc3(i,4)= O # -10*ecc2(i,1)-6*ecc2(i,2)+16*ecc2(i,3)-4*ecc1(i,1)+4*  O # ecc1(i,2))? O ht2(i)= ht2(i)+sph*(-6*ecc3(i,2)-6*ecc3(i,3)+12*ecc3(i,4) ! O # +4*ecc2(i,2)-4*ecc2(i,3)) O = O ht2(i)= ht2(i)+(-12*ecc3(i,5)+12*ecc3(i,6)-4*ecc2(i,4))l O *d1 O ht3(i)= tqm2*(-ecp1(i,1)-ecp1(i,2)-ecp0(i)+d$ O # ecm1(i,1)+ecm1(i,2)+ecm0(i))= O ht3(i)= ht3(i)+xg*(-2*ecc3(i,3)-2*ecc3(i,4)-2*ecc2(i,2) ! O # -4*ecc2(i,3)-2*ecc1(i,2))e= O ht3(i)= ht3(i)+xw*(-2*ecc3(i,1)+2*ecc3(i,4)-2*ecc2(i,1)1 O # +2*ecc2(i,2)) @ O ht3(i)= ht3(i)+sph*(2*ecc3(i,2)-2*ecc3(i,3)+4*ecc2(i,2)-4* O # ecc2(i,3)); O ht3(i)= ht3(i)+(-4*ecc3(i,5)-4*ecc3(i,6)-4*ecc2(i,4))  O * A O ht4(i)= 16*ecc3(i,3)-16*ecc3(i,4)-16*ecc2(i,2)+16*ecc2(i,3) O  O ht4(i)= sh*ht4(i)0 O *r O if(rio.eq.'i') then O  O ht5(i)= 0.d0t O ht6(i)= 0.d0n O else if(rio.eq.'a') then O *e7 O ht5(i)= tqm2*(-2*ecp1(i,1)-2*ecp1(i,2)-2*ecp0(i)+ * O # 2*ecm1(i,1)+2*ecm1(i,2)+2*ecm0(i))> O ht5(i)= ht5(i)+xg*(4./3.*ecp3(i,3)+4./3.*ecp3(i,4)-4./3.A O # *ecp2(i,2)+16./3.*ecp2(i,3)+4./3.*ecp1(i,1)+4*ecm3(i,3)+4 > O # *ecm3(i,4)-4*ecm2(i,2)+16*ecm2(i,3)+4*ecm1(i,1)-4./3.*B O # ecc3(i,3)-4./3.*ecc3(i,4)+4./3.*ecc2(i,2)-16./3.*ecc2(i,3) O # -4./3.*ecc1(i,1))t; O ht5(i)= ht5(i)+xw*(4./3.*ecp3(i,1)-4./3.*ecp3(i,4)+4* O B O # ecp2(i,1)+4./3.*ecp2(i,2)-16./3.*ecp2(i,3)+4./3.*ecp1(i,1)? O # -4./3.*ecp1(i,2)+4*ecm3(i,1)-4*ecm3(i,4)+12*ecm2(i,1)+41> O # *ecm2(i,2)-16*ecm2(i,3)+4*ecm1(i,1)-4*ecm1(i,2)-4./3.*B O # ecc3(i,1)+4./3.*ecc3(i,4)-4*ecc2(i,1)-4./3.*ecc2(i,2)+16./5 O # 3.*ecc2(i,3)-4./3.*ecc1(i,1)+4./3.*ecc1(i,2))*@ O ht5(i)= ht5(i)+sph*(-4./3.*ecp3(i,2)+4./3.*ecp3(i,3)-8./3.B O # *ecp2(i,2)+8./3.*ecp2(i,3)+4./3.*ecp1(i,1)-4./3.*ecp1(i,2)D O # -4*ecm3(i,2)+4*ecm3(i,3)-8*ecm2(i,2)+8*ecm2(i,3)+4*ecm1(i,1); O # -4*ecm1(i,2)+4./3.*ecc3(i,2)-4./3.*ecc3(i,3)+8./3.* B O # ecc2(i,2)-8./3.*ecc2(i,3)-4./3.*ecc1(i,1)+4./3.*ecc1(i,2))= O ht5(i)= ht5(i)+(8*ecp3(i,5)+8*ecp3(i,6)+8*ecp2(i,4)+24*sC O # ecm3(i,5)+24*ecm3(i,6)+24*ecm2(i,4)-8*ecc3(i,5)-8*ecc3(i,6)  O # -8*ecc2(i,4))3 O *l5 O ht6(i)= tqm2*(2*ecp1(i,1)-2*ecp1(i,2)+2*ecp0(i),+ O # -2*ecm1(i,1)+2*ecm1(i,2)-2*ecm0(i)) < O ht6(i)= ht6(i)+xg*(-4./3.*ecp3(i,3)+4./3.*ecp3(i,4)-4.A O # /3.*ecp2(i,2)+4./3.*ecp1(i,1)-8./3.*ecp1(i,2)-4*ecm3(i,3) ? O # +4*ecm3(i,4)-4*ecm2(i,2)+4*ecm1(i,1)-8*ecm1(i,2)+4./3.* A O # ecc3(i,3)-4./3.*ecc3(i,4)+4./3.*ecc2(i,2)-4./3.*ecc1(i,1)q O # +8./3.*ecc1(i,2))l< O ht6(i)= ht6(i)+xw*(-4./3.*ecp3(i,1)+8./3.*ecp3(i,3)-4.E O # /3.*ecp3(i,4)-4./3.*ecp2(i,1)+4./3.*ecp2(i,2)-4./3.*ecp1(i,1) = O # +4./3.*ecp1(i,2)-4*ecm3(i,1)+8*ecm3(i,3)-4*ecm3(i,4)-1> O # 4*ecm2(i,1)+4*ecm2(i,2)-4*ecm1(i,1)+4*ecm1(i,2)+4./3.*A O # ecc3(i,1)-8./3.*ecc3(i,3)+4./3.*ecc3(i,4)+4./3.*ecc2(i,1) O 9 O # -4./3.*ecc2(i,2)+4./3.*ecc1(i,1)-4./3.*ecc1(i,2))o@ O ht6(i)= ht6(i)+sph*(-4./3.*ecp3(i,2)-4./3.*ecp3(i,3)+8./3.B O # *ecp3(i,4)-8./3.*ecp2(i,2)+8./3.*ecp2(i,3)+4./3.*ecp1(i,1)? O # -4./3.*ecp1(i,2)-4*ecm3(i,2)-4*ecm3(i,3)+8*ecm3(i,4)-8*sE O # ecm2(i,2)+8*ecm2(i,3)+4*ecm1(i,1)-4*ecm1(i,2)+4./3.*ecc3(i,2)m> O # +4./3.*ecc3(i,3)-8./3.*ecc3(i,4)+8./3.*ecc2(i,2)-8./3.3 O # *ecc2(i,3)-4./3.*ecc1(i,1)+4./3.*ecc1(i,2)) > O ht6(i)= ht6(i)+(-8*ecp3(i,5)+8*ecp3(i,6)-8./3.*ecp2(i,4)= O # -24*ecm3(i,5)+24*ecm3(i,6)-8*ecm2(i,4)+8*ecc3(i,5)-8*d" O # ecc3(i,6)+8./3.*ecc2(i,4)) O *t O endif  O * 6 O htz1(i)= tqm2*(4*ecp1(i,1)-4*ecp1(i,2)+4*ecp0(i)+ O # -4*ecm1(i,1)+4*ecm1(i,2)-4*ecm0(i)) B O htz1(i)= htz1(i)+xg*(ecp3(i,3)-ecp3(i,4)-ecp2(i,2)-ecp1(i,2)9 O # +3*ecm3( 3)-3*ecm3(i,4)-3*ecm2(i,2)-3*ecm1(i,2)) ; O htz1(i)= htz1(i)+xw*(ecp3(i,1)-2*ecp3(i,3)+ecp3(i,4)+ O @ O # ecp2(i,1)+ecp2(i,2)-2*ecp2(i,3)+3*ecm3(i,1)-6*ecm3(i,3)+8 O # 3*ecm3(i,4)+3*ecm2(i,1)+3*ecm2(i,2)-6*ecm2(i,3))G O htz1(i)= htz1(i)+sph*(ecp3(i,2)+ecp3(i,3)-2*ecp3(i,4)+3*ecm3(i,2) ! O # +3*ecm3(i,3)-6*ecm3(i,4)) > O htz1(i)= htz1(i)+(2*ecp3(i,5)-2*ecp3(i,6)-2*ecp2(i,4)+6** O # ecm3(i,5)-6*ecm3(i,6)-6*ecm2(i,4)) O *-8 O htz2(i)= tqm2*(-2*ecp1(i,1)+2*ecp1(i,2)-2*ecp0(i)+* O # 2*ecm1(i,1)-2*ecm1(i,2)+2*ecm0(i))> O htz2(i)= htz2(i)+xg*(-3./2.*ecp3(i,3)+3./2.*ecp3(i,4)+3.B O # /2.*ecp2(i,2)-ecp2(i,3)+1./2.*ecp1(i,2)-9./2.*ecm3(i,3)+9.B O # /2.*ecm3(i,4)+9./2.*ecm2(i,2)-3*ecm2(i,3)+3./2.*ecm1(i,2))= O htz2(i)= htz2(i)+xw*(-3./2.*ecp3(i,1)+3*ecp3(i,3)-3./2. ? O # *ecp3(i,4)-5./2.*ecp2(i,1)-3./2.*ecp2(i,2)+4*ecp2(i,3)-t> O # ecp1(i,1)+ecp1(i,2)-9./2.*ecm3(i,1)+9*ecm3(i,3)-9./2.*A O # ecm3(i,4)-15./2.*ecm2(i,1)-9./2.*ecm2(i,2)+12*ecm2(i,3)-3  O # *ecm1(i,1)+3*ecm1(i,2))v? O htz2(i)= htz2(i)+sph*(-3./2.*ecp3(i,2)-3./2.*ecp3(i,3)+3*)E O # ecp3(i,4)+ecp2(i,2)-ecp2(i,3)-9./2.*ecm3(i,2)-9./2.*ecm3(i,3) - O # +9*ecm3(i,4)+3*ecm2(i,2)-3*ecm2(i,3)) = O htz2(i)= htz2(i)+(-3*ecp3(i,5)+3*ecp3(i,6)-ecp2(i,4)-9*=* O # ecm3(i,5)+9*ecm3(i,6)-3*ecm2(i,4)) O * 6 O htz3(i)= tqm2*(2*ecp1(i,1)+2*ecp1(i,2)+2*ecp0(i)+ O # -2*ecm1(i,1)-2*ecm1(i,2)-2*ecm0(i))*> O htz3(i)= htz3(i)+xg*(-1./2.*ecp3(i,3)-1./2.*ecp3(i,4)-1.B O # /2.*ecp2(i,2)-ecp2(i,3)-1./2.*ecp1(i,2)-3./2.*ecm3(i,3)-3.B O # /2.*ecm3(i,4)-3./2.*ecm2(i,2)-3*ecm2(i,3)-3./2.*ecm1(i,2))> O htz3(i)= htz3(i)+xw*(-1./2.*ecp3(i,1)+1./2.*ecp3(i,4)-1.C O # /2.*ecp2(i,1)+1./2.*ecp2(i,2)-3./2.*ecm3(i,1)+3./2.*ecm3(i, + O # 4)-3./2.*ecm2(i,1)+3./2.*ecm2(i,2))aE O htz3(i)= htz3(i)+sph*(1./2.*ecp3(i,2)-1./2.*ecp3(i,3)+ecp2(i,2) > O # -ecp2(i,3)+3./2.*ecm3(i,2)-3./2.*ecm3(i,3)+3*ecm2(i,2) O # -3*ecm2(i,3)) B O htz3(i)= htz3(i)+(-ecp3(i,5)-ecp3(i,6)-ecp2(i,4)-3*ecm3(i,5)! O # -3*ecm3(i,6)-3*ecm2(i,4))  O * 5 O htz4(i)= 4*ecp3(i,3)-4*ecp3(i,4)-4*ecp2(i,2)+4* O E O # ecp2(i,3)+12*ecm3(i,3)-12*ecm3(i,4)-12*ecm2(i,2)+12*ecm2(i,3)0 O htz4(i)= sh*htz4(i)  O *u O if(rio.eq.'i') then  O htz5(i)= 0.d0 O htz6(i)= 0.d0 O else if(rio.eq.'a') then O * 6 O htz5(i)= tqm2*(4*ecp1(i,1)+4*ecp1(i,2)+4*ecp0(i)+ O # -4*ecm1(i,1)-4*ecm1(i,2)-4*ecm0(i)) @ O htz5(i)= htz5(i)+xg*(1./3.*ecp3(i,3)+1./3.*ecp3(i,4)-1./3.F O # *ecp2(i,2)+4./3.*ecp2(i,3)+1./3.*ecp1(i,1)+ecm3(i,3)+ecm3(i,4)< O # -ecm2(i,2)+4*ecm2(i,3)+ecm1(i,1)+8./3.*ecc3(i,3)+8./F O # 3.*ecc3(i,4)-8./3.*ecc2(i,2)+32./3.*ecc2(i,3)+8./3.*ecc1(i,1)): O htz5(i)= htz5(i)+xw*(1./3.*ecp3(i,1)-1./3.*ecp3(i,4)F O # +ecp2(i,1)+1./3.*ecp2(i,2)-4./3.*ecp2(i,3)+1./3.*ecp1(i,1)-1./@ O # 3.*ecp1(i,2)+ecm3(i,1)-ecm3(i,4)+3*ecm2(i,1)+ecm2(i,2)-4F O # *ecm2(i,3)+ecm1(i,1)-ecm1(i,2)+8./3.*ecc3(i,1)-8./3.*ecc3(i,4)< O # +8*ecc2(i,1)+8./3.*ecc2(i,2)-32./3.*ecc2(i,3)+8./3.*" O # ecc1(i,1)-8./3.*ecc1(i,2))B O htz5(i)= htz5(i)+sph*(-1./3.*ecp3(i,2)+1./3.*ecp3(i,3)-2./3.B O # *ecp2(i,2)+2./3.*ecp2(i,3)+1./3.*ecp1(i,1)-1./3.*ecp1(i,2)> O # -ecm3(i,2)+ecm3(i,3)-2*ecm2(i,2)+2*ecm2(i,3)+ecm1(i,1)C O # -ecm1(i,2)-8./3.*ecc3(i,2)+8./3.*ecc3(i,3)-16./3.*ecc2(i,2) : O # +16./3.*ecc2(i,3)+8./3.*ecc1(i,1)-8./3.*ecc1(i,2))> O htz5(i)= htz5(i)+(2*ecp3(i,5)+2*ecp3(i,6)+2*ecp2(i,4)+6*C O # ecm3(i,5)+6*ecm3(i,6)+6*ecm2(i,4)+16*ecc3(i,5)+16*ecc3(i,6)( O # +16*ecc2(i,4)) O * 7 O htz6(i)= tqm2*(-4*ecp1(i,1)+4*ecp1(i,2)-4*ecp0(i) + O # +4*ecm1(i,1)-4*ecm1(i,2)+4*ecm0(i))*> O htz6(i)= htz6(i)+xg*(-1./3.*ecp3(i,3)+1./3.*ecp3(i,4)-1.@ O # /3.*ecp2(i,2)+1./3.*ecp1(i,1)-2./3.*ecp1(i,2)-ecm3(i,3)+A O # ecm3(i,4)-ecm2(i,2)+ecm1(i,1)-2*ecm1(i,2)-8./3.*ecc3(i,3))@ O # +8./3.*ecc3(i,4)-8./3.*ecc2(i,2)+8./3.*ecc1(i,1)-16./3.* O # ecc1(i,2))> O htz6(i)= htz6(i)+xw*(-1./3.*ecp3(i,1)+2./3.*ecp3(i,3)-1.E O # /3.*ecp3(i,4)-1./3.*ecp2(i,1)+1./3.*ecp2(i,2)-1./3.*ecp1(i,1) O B O # +1./3.*ecp1(i,2)-ecm3(i,1)+2*ecm3(i,3)-ecm3(i,4)-ecm2(i,1); O # +ecm2(i,2)-ecm1(i,1)+ecm1(i,2)-8./3.*ecc3(i,1)+16./aD O # 3.*ecc3(i,3)-8./3.*ecc3(i,4)-8./3.*ecc2(i,1)+8./3.*ecc2(i,2)) O # -8./3.*ecc1(i,1)+8./3.*ecc1(i,2)))B O htz6(i)= htz6(i)+sph*(-1./3.*ecp3(i,2)-1./3.*ecp3(i,3)+2./3.B O # *ecp3(i,4)-2./3.*ecp2(i,2)+2./3.*ecp2(i,3)+1./3.*ecp1(i,1)D O # -1./3.*ecp1(i,2)-ecm3(i,2)-ecm3(i,3)+2*ecm3(i,4)-2*ecm2(i,2)< O # +2*ecm2(i,3)+ecm1(i,1)-ecm1(i,2)-8./3.*ecc3(i,2)-8./G O # 3.*ecc3(i,3)+16./3.*ecc3(i,4)-16./3.*ecc2(i,2)+16./3.*ecc2(i,3)d) O # +8./3.*ecc1(i,1)-8./3.*ecc1(i,2))-@ O htz6(i)= htz6(i)+(-2*ecp3(i,5)+2*ecp3(i,6)-2./3.*ecp2(i,4)= O # -6*ecm3(i,5)+6*ecm3(i,6)-2*ecm2(i,4)-16*ecc3(i,5)+16*c# O # ecc3(i,6)-16./3.*ecc2(i,4))  O * O endif- O *d O enddo O endif  O *  O *-----equation for xi is solved  O *a O if(itc.ne.13) then  O e1s= e1*e1 O e2s= e2*e2 O e3s= e3*e3 O e12= e1t2-2.d0*sm O  O e13= e1t3-2.d0*sf  O e23= e2t3-2.d0*su  O e12s= e12*e12  O e13s= e13*e131 O e23s= e23*e23t O xia= e1s*e2s-e12st> O xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23-= O # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+f O # e2*e12*e13u> O xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1*? O # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* O = O # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* ? O # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* = O # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*g< O # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 O xib= 2.d0*xib  O ifc0= 1g3 O call c02ajf(xia,xib,xic,rtm,rtp,ifc0) O if(ifc0.eq.0) then O ixia= 1% O else if(ifc0.eq.1) then  O rtp(1)= rtm(1)  O rtp(2)= rtm(2)  O ixia= 0% O else if(ifc0.gt.1) then  O iz= 0# O ifz(40)= ifz(40)+1s O go to 2 O endif2% O if(rtm(2).ne.0.d0) then  O iz= 0# O ifz(41)= ifz(41)+1. O go to 2 O endif  O * O *-----xi^+ and xi^- are computed O * $ O xip= 0.5d0*(e3-rtp(1))$ O xim= 0.5d0*(e3-rtm(1)) O endif O * . O *-----each integral becomes a sum of two terms O *3 O *-----loop over ix starts here O *0 O if(itc.eq.13) thena O ixmn= 1  O ixmx= 1g elsei O if(om.eq.'g') then O ixmn= ix0 O ixmx= ix0 O else O ixmn= 1 O ixmx= 2 O endif2 O endif O *l O do ix=ixmn,ixmx3 O *l) O *-----q_3 is compared and x15 is selected  O * % O if(ix.eq.1) theni* O if(itc.eq.13) then0 O t3= 2.d0*arrinv(9)/vv O else" O t3= xip O endif * O else if(ix.eq.2) then O t3= ximm O endif O * % O *-----The two integrands are computedi O *-" O *-----further auxiliary quantities O *z O t4= omtw-t3 O edn3= ep3-xdf*t3  O edn4= ep4-xdf*t4  O *r% O *-----collections of all limits on t3a O **% O *-----from energy (or natural limits)g O *a O if(ieq.eq.1) then* O at3l1= omtw-bxe*e4+bl(4)% O at3u1= bxe*e3-bl(3) O & O if(xdf.gt.0.d0) then O t3l1= at3l1 O t3u1= at3u1+ O else if(xdf.lt.0.d0) then2 O t3l1= at3u1 O t3u1= at3l1 O endif  O else  O t3l1= 0.d0 O t3u1= e3 O endif O *p O *-----natural limits O * . O t3l2= -t1+0.5d0*(e1p3-skl2). O t3u2= -t1+0.5d0*(e1p3+skl2) O *c7 O t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) O 7 O t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)4 O *g O *-----from positivity on SAg O *  O t3l4= 0.d0-$ O t3l5= sm+su+sf-tw! O t3u4= sp+su+sf  O t3u5= omtw1 O * O *-----from SAx O *+' O if(iac(3).ne.0) thens# O t3l6= ss(3)*e31# O t3u6= cs(3)*e3a( O t3l7= omtw-cs(4)*e4( O t3u7= omtw-ss(4)*e44 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,/ O # t3l5,t3l6,t3l7))4 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,/ O # t3u5,t3u6,t3u7)  O elseh9 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) 9 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)m O endif O *  O *-----limits on t3 are imposed O * , O tlimt3= (t3u-t3)*(t3-t3l)& O if(t3u.lt.t3l) then O iz= 0=( O ifz(42)= ifz(42)+1 O go to 42/ O else if(tlimt3.lt.0.d0) then3 O iz= 0 ( O ifz(42)= ifz(42)+1 O go to 4= O endif O * O , O *-----non linear limits on t3,t4 are imposed O * 4 O if(iac(4).ne.0.and.ieq.eq.1) then3 O tnl13c= -cg13*edn1*edn3+vv*sfp2 O tnl13s= sg13*edn1*edn3-vv*sf3 O tnl23c= -cg23*edn2*edn3+vv*su 2 O tnl23s= sg23*edn2*edn3-vv*su3 O tnl14c= -cg14*edn1*edn4+vv*sd 2 O tnl14s= sg14*edn1*edn4-vv*sd* O sres= 1.d0-e1-e3+sf 5 O tnl24c= -cg24*edn2*edn4+vv*sresc4 O tnl24s= sg24*edn2*edn4-vv*sres3 O tnl34c= -cg34*edn3*edn4+vv*sp(2 O tnl34s= sg34*edn3*edn4-vv*sp= O if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or.d= O # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or.0= O # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. = O # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. ? O # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) thena O iz= 0+ O ifz(43)= ifz(43)+1 O O go to 4+ O endif  O endif O *0: O *-----non linear constraints from FS A in the case xp = xm O *)7 O if(iac(4).ne.0.d0.and.ieq.eq.0) then*. O smr= 1.d0-sm-sp-su-sd-sf; O spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) ; O spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) ; O spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd)(; O spc23= (-cg23*e2t3+su)*(sg23*e2t3-su)i= O spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr)(; O spc34= (-cg3 O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O ndif3 O wtcfi= wpcfr*wmcfi+wmcfr*wpcfie O *(, O *-----The epsilons are computed in the order9 O * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), 9 O * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4),i9 O * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4),i9 O * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4),28 O * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) O *," O x13s= x13*x13" O x14s= x14*x14" O x15s= x15*x15" O x16s= x16*x16" O x23s= x23*x23" O x24s= x24*x24" O x25s= x25*x25" O x26s= x26*x26" O x34s= x34*x34" O x35s= x35*x35" O x36s= x36*x36" O x45s= x45*x45" O x46s= x46*x46" O x56s= x56*x56( O if(ofl.ne.'n') then& O x45i= 1.d0/x45& O x56i= 1.d0/x56# O p1= x13*x14,# O p2= x13*x16 # O p3= x13*x23/# O p4= x13*x25 $ O p5= x13*x25s% O p6= x13s*x25s,# O p7= x13*x26p# O p8= x13*x35)# O p9= x13*x45($ O p10= x13*x46$ O p11= x13*x56$ O p12= x14*x16$ O p13= x14*x23% O p14= x14*x23s#$ O p15= x14*x25% O p16= x14*x25se$ O p17= x14*x26$ O p18= x14*x35% O p19= x14*x35se$ O p20= x14*x36$ O p21= x14*x45$ O p22= x14*x56$ O p23= x15*x23$ O p24= x15*x24$ O p25= x15*x26$ O p26= x15*x34$ O p27= x15*x36$ O p28= x15*x46$ O p29= x16*x23$ O p30= x16*x23$ O p31= x16*x25% O p32= x16*x25s2$ O p33= x16*x34$ O p34= x16*x35$ O p35= x16*x56$ O p36= x23*x25$ O p37= x23*x26$ O p38= x23*x34$ O p39= x23*x35$ O p40= x23*x36$ O p41= x23*x45$ O p42= x23*x46$ O p43= x23*x56% O p44= x23*x56ss$ O p45= x24*x25$ O p46= x24*x35$ O p47= x24*x36$ O p48= x24*x56$ O p49= x25*x26$ O p50= x25*x34$ O p51= x25*x35$ O p52= x25*x36$ O p53= x25*x45$ O p54= x25*x46$ O p55= x25*x56$ O p56= x26*x34$ O p57= x26*x35% O p58= x26*x35s % O p59= x26s*x354$ O p60= x26*x36$ O p61= x26*x45% O p62= x26s*x45 $ O p63= x26*x56$ O p64= x34*x35$ O p65= x34*x36$ O p66= x34*x46$ O p67= x34*x56% O p68= x34*x56s O $ O p69= x35*x36$ O p70= x35*x45$ O p71= x35*x46$ O p72= x35*x56$ O p73= x36*x45$ O p74= x36*x46$ O p75= x45*x56$ O p76= x46*x56$ O p77= x15*x25$ O p78= x16*x24$ O p79= x16*x26 O *9O O u1= p1*x25 " O u2= p1*x56" O u3= p3*x45# O u4= x13*p48 " O u5= p4*x46" O u6= p4*x56" O u7= p7*x45# O u8= x13*p73 # O u9= p12*x23e$ O u10= p12*x25$ O u11= p12*x35$ O u12= p13*x35$ O u13= p13*x56$ O u14= p15*x26$ O u15= p15*x35$ O u16= p15*x36$ O u17= p15*x56$ O u18= p17*x35$ O u19= p18*x36$ O u20= p20*x45$ O u21= p23*x46$ O u22= p24*x36$ O u23= p25*x34$ O u24= p29*x45$ O u25= x16*p46$ O u26= p31*x34$ O u27= p31*x35$ O u28= p36*x46$ O u29= p49*x34$ O u30= p36*x36$ O u31= p36*x34$ O u32= p38*x56$ O u33= p50*x56$ O u34= p52*x45$ O u35= p54*x56$ O u36= p57*x45$ O u37= p57*x56$ O u38= p64*x56$ O u39= p37*x46$ O u40= p39*x56$ O u41= p52*x56$ O u42= p39*x45# O u43= p9*x36 $ O u44= p11*x24$ O u45= p34*x24 O endifG O * > O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+A O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sd> O ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+A O # x15*x23*x35)-x13s*x25s-x15s*x23s-x35st> O ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+A O # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s B O ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+A O # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- O % O # x15s*x34s B O ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+A O # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- % O # x25s*x34s G O * d O e(1)= 1.d0 F O e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*E O # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* C O # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 E O e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-vF O # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-D O # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45F O e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*G O # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14*lF O # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 G O e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14*aC O # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15*fD O # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+$ O # x25*x34s O *d O *-----sign of eps_1*eps_in O *a O ises= 0" O sg(1)= 0.25d0+ O if(ee(1).lt.0.d0) then $ O ises= ises+1 O endif O do i=2,5 2 O if(abs(e(i)).lt.zrm) then( O ises= ises+12 O else if(e(i).gt.zrm) then) O sg(i)= 0.25d0 3 O else if(e(i).lt.-zrm) thenr* O sg(i)= -0.25d0 O endif/ O if(ee(i).lt.0.d0) then ( O ises= ises+1 O endif O enddo O *#' O if(ises.eq.0) then./ O ses1= sg(1)*sqrt(ee(1)) / O ses2= sg(2)*sqrt(ee(2)) / O ses3= sg(3)*sqrt(ee(3)) / O ses4= sg(4)*sqrt(ee(4))l/ O ses5= sg(5)*sqrt(ee(5)) O s1= ses1 O s2= ses2& O s3= -ses1-ses2 O s4= ses3% O s5= ses1-ses3 % O s6= ses2+ses3 O O s7= ses4% O s8= ses1-ses4 % O s9= ses2+ses4x& O s10= ses3-ses4! O s11= ses5 ' O s12= -ses1-ses5n' O s13= -ses2+ses5 ' O s14= -ses3-ses51' O s15= -ses4-ses53 O elselA O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+.D O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sA O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ D O # x16*x23*x36)-x13s*x26s-x16s*x23s-x36sA O ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+pD O # x16*x24*x46)-x14s*x26s-x16s*x24s-x46sE O ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+(D O # x14*x16*x34*x36)-x13s*x46s-x14s*x36s-( O # x16s*x34sE O ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+(E O # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- O ) O # x26s*x34sh" O e(1)= 1.d0> O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+B O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-C O # x14*x16*x23s+x14*x23*x36+x16*x23*x34-12 O # x13s*x24*x26-x34*x36@ O e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*@ O # x24*x46-x14*x16*x23*x24+x14*(-x23*@ O # x46+2.d0*x24*x36-x26*x34)-x16*x24*6 O # x34+x14s*x23*x26+x34*x46@ O e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*? O # x34)+x13*x16*x24*x34+x13*x34*x46+ > O # x14*x16*x23*x34+x14*x34*x36-x16*= O # x34s-x13s*x24*x46-x14s*x23*x36 1@ O e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*> O # x24s)+x14*(-x23*x24*x36-x23*x26*A O # x34+x46*x23s)+x16*2.d0*x23*x24*x34- > O # x23*x34*x46-x24*x34*x36+x26*x34s O ises= 0x% O sg(1)= 0.25d01. O if(ee(1).lt.0.d0) then' O ises= ises+1 O  O endifh O do i=2,55 O if(abs(e(i)).lt.zrm) then + O ises= ises+1z5 O else if(e(i).gt.zrm) thenr, O sg(i)= 0.25d06 O else if(e(i).lt.-zrm) then- O sg(i)= -0.25d0 ! O endif O 2 O if(ee(i).lt.0.d0) then+ O ises= ises+1s! O endifr O enddo * O if(ises.eq.0) then2 O ses1= sg(1)*sqrt(ee(1))2 O ses2= sg(2)*sqrt(ee(2))2 O ses3= sg(3)*sqrt(ee(3))2 O ses4= sg(4)*sqrt(ee(4))2 O ses5= sg(5)*sqrt(ee(5))# O s1= ses1h) O s2= -ses1-ses2-# O s3= ses2g) O s4= -ses1-ses3p# O s5= ses3-) O s6= -ses2-ses32( O s7= ses1-ses4# O s8= ses4s) O s9= -ses2-ses4n* O s10= -ses3+ses4* O s11= -ses1-ses5$ O s12= ses5) O s13= ses2-ses5c) O s14= ses3+ses5 ) O s15= ses4+ses5  O elseD O ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+C O # x15*x23*x35)-x13s*x25s-x15s*x23s-f& O # x35sD O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+C O # x16*x23*x36)-x13s*x26s-x16s*x23s- & O # x36sD O ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+C O # x16*x25*x56)-x15s*x26s-x16s*x25s- & O # x56sD O ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*A O # x56+x15*x16*x35*x36)-x13s*x56s- O 5 O # x15s*x36s-x16s*x35seD O ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*A O # x56+x25*x26*x35*x36)-x23s*x56s- 5 O # x25s*x36s-x26s*x35smG O * cA O e(1)= x13*x14*x23*x25+x13*x15*x23*x24+lE O # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- B O # x14*x15*x23s+x14*x23*x35+x15*x23*9 O # x34-x13s*x24*x25-x34*x35=A O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ E O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- B O # x14*x16*x23s+x14*x23*x36+x16*x23*9 O # x34-x13s*x24*x26-x34*x36wB O e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+D O # x13*(-x25*x46+x26*x45)+x14*x15*x23*F O # x26-x14*x16*x23*x25+x14*(x25*x36-x26*F O # x35)+x15*(-x23*x46+x24*x36)+x16*(x23*= O # x45-x24*x35)+x35*x46-x36*x45 C O e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* E O # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ D O # x25*x34)+x13*(x35*x46-x36*x45)-x14*E O # x15*x23*x36+x14*x16*x23*x35+x15*x34* D O # x36-x16*x34*x35+x13s*(-x25*x46+x26*% O # x45) G O e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* D O # x36-x24*x26*x35)+x15*(-x23*x24*x36-D O # x23*x26*x34+x46*x23s)+x16*(x23*x24*C O # x35+x23*x25*x34-x45*x23s)-x23*x35*=E O # x46+x23*x36*x45-x25*x34*x36+x26*x34* $ O # x35 O * " O ises= 0# O do i=1,5 O 8 O if(abs(e(i)).lt.zrm) then. O ises= ises+18 O else if(e(i).gt.zrm) then/ O sg(i)= 0.25d0 9 O else if(e(i).lt.-zrm) thenw0 O sg(i)= -0.25d0$ O endif5 O if(ee(i).lt.0.d0) then . O ises= ises+1$ O endif O enddo- O if(ises.eq.0) then 5 O ses1= sg(1)*sqrt(ee(1)) 5 O ses2= sg(2)*sqrt(ee(2)) 5 O ses3= sg(3)*sqrt(ee(3)) 5 O ses4= sg(4)*sqrt(ee(4)) 5 O ses5= sg(5)*sqrt(ee(5))-, O s1= -ses1-ses2& O s2= ses1& O s3= ses2, O s4= -ses1+ses3, O s5= -ses2-ses3& O s6= ses3, O s7= -ses1+ses4, O s8= -ses2-ses4& O s9= ses4, O s10= ses3-ses4, O s11= ses1+ses5, O s12= ses2-ses5' O s13= ses5 - O s14= -ses3-ses56- O s15= -ses4-ses5 O  O else5# O iz= 0 O 0 O ifz(48)= ifz(48)+1% O go to 4 O endif O endif  O endif O *5$ O tgn(1)= x15*x24$ O tgn(2)= x34*x46$ O tgn(3)= x34/x46$ O tgn(4)= x24/x15$ O tgn(5)= x15/x25$ O tgn(6)= x15*x25$ O tgn(7)= x14*x34$ O tgn(8)= x25*x46$ O tgn(9)= x25/x46% O tgn(10)= x14/x344% O tgn(11)= x45/x366% O tgn(12)= x14*x24 O % O tgn(13)= x24/x14 % O tgn(14)= x45*x36 % O tgn(15)= x14/x25  O *  O itgn= 0 O do l=1,150 O if(tgn(l).le.0.d0) then( O itgn= itgn+1 O endif O enddo' O if(itgn.ne.0) then4 O iz= 02* O ifz(49)= ifz(49)+1 O go to 4= O endif O * ( O gpna= sqrt(x15*x24)( O gpnb= sqrt(x34*x46)( O gpnc= sqrt(x34/x46)( O gpnd= sqrt(x24/x15)( O gpne= sqrt(x15/x25)( O gpnf= sqrt(x15*x25)( O gmna= sqrt(x14*x34)( O gmnb= sqrt(x25*x46)( O gmnc= sqrt(x25/x46)( O gmnd= sqrt(x14/x34)( O gmne= sqrt(x45/x36)( O gmnf= sqrt(x14*x24)( O gmng= sqrt(x24/x14)( O gmnh= sqrt(x45*x36)( O gmni= sqrt(x14/x25) O *=# O gn1= gpna/gpnb=# O gn2= gpna*gpnc=# O gn3= gpna/gpnc4# O gn4= gpnd/gpnb4( O gn5= 1.d0/gpna/gpnc( O gn6= 1.d0/gpnd/gpnc# O gn7= gpnd/gpncx# O gn8= gpnb/gpnax# O gn9= gpnd*gpncx$ O gn10= gpnb/gpnd$ O gn11= gpna*gpnb$ O gn12= gmnd/gmnb) O gn13= 1.d0/gmnc/gmna $ O gn14= gmna/gmnb$ O gn15= gmnd/gmnc) O gn16= 1.d0/gmnd/gmnc $ O gn17= gmna*gmnb$ O gn18= gmnc/gmnd$ O gn19= gmnc/gmna$ O gn20= gmna*gmnc$ O gn21= gmnd*gmnb$ O gn22= gmnd*gmnc$ O gn23= gmnb/gmnd$ O gn24= gmnb/gmna$ O gn25= gpnc/gpnd) O gn26= 1.d0/gpna/gpnb $ O gn27= gpnc/gpna) O gn28= 1.d0/gpnd/gpnb $ O gn29= gpne/gmnh$ O gn30= gmne/gpnf) O gn31= 1.d0/gpnf/gmne ) O gn32= 1.d0/gpnf/gmnh $ O gn33= gpne*gmne$ O gn34= gpne/gmne$ O gn35= gmnh/gpnf$ O gn36= gmnh*gpne$ O gn37= gpnb*gmni O *  O *-----helicity a)  O * 5 O *-----conversion diagram without t-channel propagator G O * 7 O if(ofl.eq.'c'.or.ofl.eq.'a') then 0 O flpr= grp*rhrp-gip*rhip0 O flpi= grp*rhip+gip*rhrp0 O flmr= grm*rhrm-gim*rhim0 O flmi= grm*rhim+gim*rhrm1 O flr= flpr*flmr-flpi*flmi51 O fli= flpr*flmi+flpi*flmr 7 O adcr= 2.d0*(gn1*x36*(x45-x14)+5; O # gn2*(x16-x56)+gn3*(x13-x35)) 1 O adcie= 8.d0*gn1*(s8-s15)7" O g4= g2*g2) O dcr= adcr*flr/g45) O dci= adcr*fli/g4 + O dcie= adcie*flr/g4 , O dcre= -adcie*fli/g4 O else" O g4= g2*g26 O dcr= 2.d0*(gn1*x36*(x45-x14)+: O # gn2*(x16-x56)+gn3*(x13-x35))0 O dcie= 8.d0*gn1*(s8-s15)" O dci= 0.d0# O dcre= 0.d0  O endif  O * G O *-----annihilation diagrams: common part  O * ; O daarc= 2.d0*gn1*x36*x45-2.d0*gn2*x56+ ; O # gn3*(-x35+1.5d0*x36)+2.d0*gn4*=; O # (x13*x36*x45-x14*x35*x36)+gn5* = O # (-x13*x23*x45-0.5d0*x13*x25*x46+ ; O # 0.5d0*x13*x26*x45+x14*x23*x35-4= O # 0.5d0*x14*x23*x56+0.5d0*x14*x25* = O # x36-0.5d0*x14*x26*x35+0.5d0*x16* = O # x23*x45+0.5d0*x35*x46-0.5d0*x36* : O # x45)+gn6*(-x23*x45-1.5d0*x23*= O # x46)+gn7*(x13*x45+0.5d0*x13*x56-x= O # x14*x35-0.5d0*x16*x35)+gn8*(x13**> O # x25-0.5d0*x16*x25-x35+0.5d0*x56)+9 O # 2.d0*gn9*(-x13*x56+x16*x35)++; O # gn10*(x25+1.5d0*x26)+3.d0*gn112; O daaic= -8.d0*gn1*s15+8.d0*gn4*s7*x36+*= O # 2.d0*gn5*(s2*x46-s5*x35-2.d0*s7*3@ O # x23+s7*x26+s14*x13)-2.d0*gn6*(2.d0*A O # s11+3.d0*s12)+2.d0*gn7*(2.d0*s7-s9)-44 O # 4.d0*gn8*s2+8.d0*gn9*s9 O *s) O *-----The Fermion loop scheme starts here2 O *x' O if(ofl.eq.'c'.or.ofl.eq.'a') then  O *  O tgv(1)= x15*x24/x34/x46d O tgv(2)= x15*x24*x34/x46d O tgv(3)= x15*x24*x46/x34x O tgv(4)= x24/x15/x46/x34x O tgv(5)= x46/x15/x24/x34  O tgv(6)= x15*x46/x24/x34- O tgv(7)= x24*x46/x15/x34 " O tgv(8)= 1.d0/x15/x24*x34*x46" O tgv(9)= 1.d0/x15*x24*x34/x46 O tgv(10)= x15/x24*x34*x46 O tgv(11)= x15/x24*x34/x46 O tgv(12)= x15*x24*x34*x46# O tgv(13)= 1.d0/x15/x24/x34/x46 # O tgv(14)= 1.d0/x15/x24*x34/x462# O tgv(15)= 1.d0/x14/x25*x34/x46  O tgv(16)= x14/x25/x34/x46 O tgv(17)= x46/x14/x25/x34 O tgv(18)= x14*x34/x25/x46 O tgv(19)= x14*x46/x25/x34 O tgv(20)= x34*x46/x14/x25 O tgv(21)= x14*x34*x46*x25 O tgv(22)= x34*x25/x14/x46 O tgv(23)= x25/x14/x34/x46 O tgv(24)= x14*x34*x25/x46 O tgv(25)= x14*x25*x46/x34 O tgv(26)= x14*x25/x34/x46 O tgv(27)= x25*x34*x46/x14 O tgv(28)= x25*x46/x34/x14# O tgv(29)= 1.d0/x14/x24/x36*x45*# O tgv(30)= 1.d0/x14*x24/x36*x45 O # O tgv(31)= 1.d0/x14/x24/x36/x45 # O tgv(32)= 1.d0/x14*x24/x36/x45  O tgv(33)= x14/x24/x36*x45 O tgv(34)= x14/x24/x36/x45 O tgv(35)= x14*x24/x36/x45 O tgv(36)= x15/x24/x34/x46 O tgv(37)= x14*x24/x36*x45 O tgv(38)= x15/x25/x36/x45# O tgv(39)= 1.d0/x15/x25/x36*x451# O tgv(40)= 1.d0/x15/x25*x36/x45i# O tgv(41)= 1.d0/x15/x25/x36/x45  O tgv(42)= x15/x25/x36*x45 O tgv(43)= x15/x25*x36/x45# O tgv(44)= 1.d0/x15/x25*x36*x45  O tgv(45)= x15/x25*x36*x45 O tgv(46)= x14/x25*x34*x46# O tgv(47)= 1.d0/x15*x24*x34*x46 # O tgv(48)= 1.d0/x14/x25/x34/x461 O * itgv= 0  O do l=1,48 ! O if(tgv(l).le.0.d0) then  O itgv= itgv+1t O endif O enddoe O if(itgv.ne.0) then O iz= 0 O ifz(49)= ifz(49)+1  O go to 4 O endif  O *3 O gv1= sqrt(tgv(1))  O gv2= sqrt(tgv(2)) l O gv3= sqrt(tgv(3))  O gv4= sqrt(tgv(4))  O gv5= sqrt(tgv(5))  O gv6= sqrt(tgv(6))  O gv7= sqrt(tgv(7)) O  O gv8= sqrt(tgv(8)) 3 O gv9= sqrt(tgv(9)) e O gv10= sqrt(tgv(10))  O gv11= sqrt(tgv(11))  O gv12= sqrt(tgv(12))  O gv13= sqrt(tgv(13))  O gv14= sqrt(tgv(14))  O gv15= sqrt(tgv(15)) O  O gv16= sqrt(tgv(16))  O gv17= sqrt(tgv(17)) e O gv18= sqrt(tgv(18))  O gv19= sqrt(tgv(19))  O gv20= sqrt(tgv(20))  O gv21= sqrt(tgv(21)) O  O gv22= sqrt(tgv(22))  O gv23= sqrt(tgv(23)) 3 O gv24= sqrt(tgv(24)) # O gv25= sqrt(tgv(25)) x O gv26= sqrt(tgv(26))  O gv27= sqrt(tgv(27)) x O gv28= sqrt(tgv(28))  O 29= sqrt(tgv(29)) 3 O gv30= sqrt(tgv(30))  O gv31= sqrt(tgv(31)) * O gv32= sqrt(tgv(32))  O gv33= sqrt(tgv(33)) x O gv34= sqrt(tgv(34)) O  O gv35= sqrt(tgv(35)) d O gv36= sqrt(tgv(36)) 6 O gv37= sqrt(tgv(37))  O gv38= sqrt(tgv(38)) x O gv39= sqrt(tgv(39))  O gv40= sqrt(tgv(40))  O gv41= sqrt(tgv(41)) x O gv42= sqrt(tgv(42))  O gv43= sqrt(tgv(43)) x O gv44= sqrt(tgv(44))  O gv45= sqrt(tgv(45))  O gv46= sqrt(tgv(46)) O  O gv47= sqrt(tgv(47)) * O gv48= sqrt(tgv(48))  O * ' O if(ofl.eq.'c'.or.ofl.eq.'a') thenx O *x1 O tar4= gv1*x45i*(p20*p22+2*p20*p48+p47*p48)*1 O tar4= tar4+gv1*(-p12*x36-4*p17*x36-p20*x15 ) O # -2*p45*x36-p47*x16-2*p47*x26+p73 2 O # +u2-u7-u11-u13-3*u16+u18-u22+u24+u44-u45)- O tar4= tar4+gv2*x45i*(-2*p12*x56-2*p35** O # x24-p48*x26) / O tar4= tar4+gv2*(2*x15*x16+2*x16s+2*x26s-4# O # x56+p25+3*p31+2*p49+3*p79) - O tar4= tar4+gv3*x45i*(-p20*x15-p43*x24- ( O # p45*x36+2*p46*x26-p71+u2-u5+u11* O # -3*u13+3*u18+u21-u22+u28+u44+u45)0 O tar4= tar4+gv3*(-x35+x36+p4+p7+p23+2*p36). O tar4= tar4+gv4*x45i*(p12*p18*x56+2*p12*. O # p46*x56-2*p17*p18*x56-p17*p46*x56-u2*) O # p22-2*u2*p48+2*u13*p22+u13*p48-2** O # *u17*p20-u17*p47-u44*p48+u45*p48)' O tar4= tar4+gv4*(p1*p35+2*p1*p63+-& O # p2*p48-p2*p61+p7*p48-p12*p34-) O # 3*p12*p43+p12*p52+p12*p57+2*p20*#, O # x56-p29*p48-p34*p78+p47*x56-p73*x16 O # +u24*x16)+ O tar4= tar4+gv5*x45i*(p15*p71+p16*p20 : O # +p18*p22-u1*p54+u2*p15-2*u11*p15-u13*p15-u15*p17), O tar4= tar4+gv5*(p1*p31+p1*p49+p12*p36 O # -2*u2+u11-u16) * O tar4= tar4+gv6*x45i*(-p1*p54-2*p13*5 O # p22+p13*p28+p13*p54+p15*p20+p17*p18-p18*x46) O , O tar4= tar4+gv6*(p1*x26+p13*x15+2*p13* O # x25-p18+p20+u1)- O tar4= tar4+gv7*x45i*(3*p1*p55+2*p4*p48 ' O # -p5*x46-3*p12*p51-p13*p55-p15* - O # p57+p16*x36-p31*p46-p46*x56+p51*x46) * O tar4= tar4+gv7*(p2*x25+p4*x26-2*p11 O # +p29*x25+p34-p52)( O tar4= tar4+gv8*x45i*(u10*x25-u17)# O tar4= tar4+gv8*(2*x56-2*p31) - O tar4= tar4+gv9*x45i*(2*p15*p63-p31*p48  O # +p48*x56)) O tar4= tar4+gv9*(p31*x16-p35-2*p63) 2 O tar4= tar4+gv10*x45i*(-p17*x15+p22+u10-u14)+ O tar4= tar4+gv10*(-2*x16-2*x25-2*x26) % O tar4= tar4+gv11*x45i*(p17*p22) . O tar4= tar4+gv11*(-2*x16*x45+p12*x26-p17 O # *x15+2*p17*x26+p22+u10)- O tar4= tar4+gv12*x45i*(x56-p25+p31-p49)(, O tar4= tar4+gv13*x45i*(p13*p22*p22-p15 O # *p20*p22-p17*p18*p22)+ O tar4= tar4+gv13*(-p1*p61*x16-p12*p73 ' O # -2*p12*u13+p12*u16+p12*u24+p20= O # *p22+u2*p17+u11*p17) , O tar4= tar4+gv14*x45i*(p12*u17-p22*p22 O # +2*u17*p17)* O tar4= tar4+gv14*(p12*x56-p12*p31-2*% O # p12*p49-2*p17*x56+2*p61*x16) ' O tar4= tar4+gv36*(-p1*p61+p12*p41 0 O # -p13*p22-p15*p20+p17*p18-2*p17*p20+u20)% O tar4= tar4+gv47*x45i*(p32-p55)  O *  O tar2= gv1*(-4*p73)  O tar2= tar2+gv2*(4*x56)e O tar2= tar2+gv3*(-4*x36)$ O tar2= tar2+gv4*(-4*u19+4*u43)# O tar2= tar2+gv6*(4*p41+4*p42) " O tar2= tar2+gv7*(4*p9-4*p18)$ O tar2= tar2+gv9*(-4*p11+4*p34)% O tar2= tar2+gv10*(-4*x25-4*x26)  O tar2= tar2+gv12*(4) O *s O tar3= gv1*(4*p73) O tar3= tar3+gv2*(-4*x56) O tar3= tar3+gv3*(4*x36).$ O tar3= tar3+gv4*(-4*u19+4*u43)$ O tar3= tar3+gv6*(-4*p41-4*p42)" O tar3= tar3+gv7*(4*p9-4*p18)$ O tar3= tar3+gv9*(-4*p11+4*p34)$ O tar3= tar3+gv10*(4*x25+4*x26) O tar3= tar3+gv12*(4) O *# O tar5= gv1*(2*p73) O tar5= tar5+gv2*(-2*x56)" O tar5= tar5+gv3*(-2*x35-x36)# O tar5= tar5+gv4*(2*u19-2*u43)e% O tar5= tar5+gv5*(-p71+p73+u5-u7* O # +u13-u16+u18-u24) " O tar5= tar5+gv5*(2*u3-2*u12) O tar5= tar5+gv6*(p42) O tar5= tar5+gv7*(-p11+p34) O tar5= tar5+gv8*(-x56+p31)" O tar5= tar5+gv8*(2*x35-2*p4)# O tar5= tar5+gv9*(2*p11-2*p34)2 O tar5= tar5+gv10*(-x26)  O tar5= tar5+gv12*(4) O *2 O tar6= gv1*(2*p73) O tar6= tar6+gv2*(-2*x56)" O tar6= tar6+gv3*(-2*x35-x36)$ O tar6= tar6+gv4*(-2*u19+2*u43)% O tar6= tar6+gv5*(-p71+p73+u5-u7  O # +u13-u16+u18-u24)(# O tar6= tar6+gv5*(-2*u3+2*u12)  O tar6= tar6+gv6*(p42)x O tar6= tar6+gv7*(-p11+p34) O tar6= tar6+gv8*(-x56+p31)# O tar6= tar6+gv8*(-2*x35+2*p4) $ O tar6= tar6+gv9*(-2*p11+2*p34) O tar6= tar6+gv10*(-x26)  O tar6= tar6+gv12*(-4)* O ** O tai4= s1*gv4*(-4*p35)% O tai4= tai4+s1*gv5*x45i*(4*u17)+& O tai4= tai4+s1*gv6*x45i*(-4*p22) O tai4= tai4+s2*gv3*(4)* O tai4= tai4+s2*gv5*x45i*(-4*p22*x14) O tai4= tai4+s2*gv5*(4*p12) O tai4= tai4+s2*gv6*(4*x14)& O tai4= tai4+s2*gv7*x45i*(-4*p22) O tai4= tai4+s3*gv3*(4)' O tai4= tai4+s3*gv4*(-4*p22-4*p48) O tai4= tai4+s3*gv7*(4*x25)) O tai4= tai4+s4*gv4*x45i*(4*p47*x56) % O tai4= tai4+s4*gv4*(-4*x16*x36)3+ O tai4= tai4+s4*gv7*x45i*(8*p34-4*p52)4& O tai4= tai4+s4*gv8*x45i*(-8*p31), O tai4= tai4+s4*gv10*x45i*(8*x16+8*x26)! O tai4= tai4+s4*gv11*(8*x16) + O tai4= tai4+s4*gv14*x45i*(-8*p17*x56)x" O tai4= tai4+s4*gv36*(-4*p20)! O tai4= tai4+s5*gv1*(-4*x35)x& O tai4= tai4+s5*gv2*x45i*(-8*x56)& O tai4= tai4+s5*gv3*x45i*(-4*x35)) O tai4= tai4+s5*gv4*x45i*(8*p18*x56) O ! O tai4= tai4+s5*gv4*(-4*p34)3& O tai4= tai4+s5*gv10*x45i*(8*x25)' O tai4= tai4+s5*gv11*(8*x25-8*x26)6* O tai4= tai4+s5*gv13*x45i*(4*p18*p22)" O tai4= tai4+s5*gv13*(-4*u11)' O tai4= tai4+s5*gv14*(8*x56+8*p31) * O tai4= tai4+s6*gv5*x45i*(-8*p18*x14) O tai4= tai4+s6*gv5*(8*p1)x& O tai4= tai4+s6*gv8*x45i*(-4*p15)& O tai4= tai4+s6*gv9*x45i*(-4*p22) O tai4= tai4+s6*gv9*(8*x26)' O tai4= tai4+s6*gv10*x45i*(-4*x14) ! O tai4= tai4+s6*gv11*(4*x14)(" O tai4= tai4+s6*gv12*x45i*(4)& O tai4= tai4+s7*gv3*x45i*(-4*x26)3 O tai4= tai4+s7*gv4*x45i*(8*p17*x56+4*p48*x26) % O tai4= tai4+s7*gv6*x45i*(4*p17)2% O tai4= tai4+s7*gv7*x45i*(4*p49)s* O tai4= tai4+s7*gv13*x45i*(4*p17*p22)& O tai4= tai4+s7*gv13*(-4*p12*x26)& O tai4= tai4+s8*gv1*(4*x25+8*x26)! O tai4= tai4+s8*gv4*(-8*x56)d% O tai4= tai4+s8*gv6*x45i*(4*p15) ! O tai4= tai4+s8*gv36*(4*p15) 3 O tai4= tai4+s9*gv4*x45i*(4*p22*x14+4*p22*x24) O ' O tai4= tai4+s9*gv4*(-4*p12-4*p78)t& O tai4= tai4+s9*gv7*x45i*(-4*p15)" O tai4= tai4+s10*gv1*(-4*x23)- O tai4= tai4+s10*gv2*x45i*(-8*x16-8*x26) + O tai4= tai4+s10*gv4*x45i*(-4*p43*x24))* O tai4= tai4+s10*gv5*x45i*(4*p13*x25)& O tai4= tai4+s10*gv7*x45i*(4*p36)' O tai4= tai4+s10*gv9*x45i*(-8*p49) ! O tai4= tai4+s11*gv1*(4*x16) O , O tai4= tai4+s11*gv3*x45i*(4*x16+8*x25)+ O tai4= tai4+s11*gv4*x45i*(-4*p12*x56) & O tai4= tai4+s11*gv5*x45i*(4*u10)- O tai4= tai4+s12*gv1*x45i*(-4*p22-4*p48) & O tai4= tai4+s12*gv3*x45i*(4*x25)& O tai4= tai4+s12*gv6*x45i*(4*p15), O tai4= tai4+s12*gv36*x45i*(-4*p22*x14)2 O tai4= tai4+s12*gv36*(4*x14*x15+4*p12+8*p15)! O tai4= tai4+s13*gv1*(4*x14) * O tai4= tai4+s13*gv4*x45i*(4*p22*x24)! O tai4= tai4+s13*gv4*(4*p12)s( O tai4= tai4+s13*gv6*x45i*(-4*x14s)' O tai4= tai4+s13*gv7*x45i*(-4*p15)=' O tai4= tai4+s14*gv2*x45i*(-8*x25) & O tai4= tai4+s14*gv4*x45i*(-4*u2)% O tai4= tai4+s14*gv6*x45i*(4*p1) # O tai4= tai4+s14*gv10*x45i*(8) + O tai4= tai4+s14*gv13*x45i*(-4*p1*p22) % O tai4= tai4+s14*gv13*(4*p1*x16) ( O tai4= tai4+s14*gv14*x45i*(-8*p22)# O tai4= tai4+s14*gv14*(-8*x16) 6 O tai4= tai4+s15*gv1*x45i*(8*x24*x26+8*p17+8*p45)# O tai4= tai4+s15*gv3*x45i*(-4)t& O tai4= tai4+s15*gv4*x45i*(4*p22)! O tai4= tai4+s15*gv4*(4*x16)t+ O tai4= tai4+s15*gv36*x45i*(8*p17*x14)x# O tai4= tai4+s15*gv36*(-4*x14)x O *x O tai2= s7*gv4*(16*x36) O tai2= tai2+s7*gv7*(16)  O tai2= tai2+s9*gv9*(16)  O tai2= tai2+s11*gv6*(16) O tai2= tai2+s12*gv6*(16) O tai2= tai2+s15*gv1*(16) O ** O tai3= s7*gv4*(16*x36) O tai3= tai3+s7*gv7*(16)  O tai3= tai3+s9*gv9*(16)  O tai3= tai3+s11*gv6*(-16)  O tai3= tai3+s12*gv6*(-16)  O tai3= tai3+s15*gv1*(-16)  O *  O tai5= s1*gv14*(-4*x56). O tai5= tai5+s2*gv8*(-4) ! O tai5= tai5+s3*gv14*(4*x45)  O tai5= tai5+s4*gv8*(-4) " O tai5= tai5+s4*gv14*(-4*x56)" O tai5= tai5+s5*gv14*(-4*x56)! O tai5= tai5+s5*gv14*(4*x45)  O tai5= tai5+s6*gv8*(-4) " O tai5= tai5+s6*gv14*(-4*x45) O tai5= tai5+s7*gv4*(4*x56)! O tai5= tai5+s7*gv4*(-4*x36)r O tai5= tai5+s7*gv5*(4*x25)% O tai5= tai5+s7*gv7*x45i*(4*x35) & O tai5= tai5+s7*gv8*x45i*(-8*x25)% O tai5= tai5+s7*gv9*x45i*(4*x56) " O tai5= tai5+s7*gv13*(-4*p61)! O tai5= tai5+s7*gv14*(4*x26) O tai5= tai5+s8*gv4*(4*x56)! O tai5= tai5+s8*gv4*(-4*x35)( O tai5= tai5+s8*gv5*(4*x25)" O tai5= tai5+s8*gv13*(-4*p61)! O tai5= tai5+s8*gv13*(4*p41)  O tai5= tai5+s9*gv9*(4)( O tai5= tai5+s10*gv4*(-4*x35+4*x36)' O tai5= tai5+s10*gv7*x45i*(-4*x35) O & O tai5= tai5+s10*gv8*x45i*(8*x25)' O tai5= tai5+s10*gv9*x45i*(-4*x56)) O tai5= tai5+s10*gv9*(4) " O tai5= tai5+s10*gv13*(4*p41)# O tai5= tai5+s10*gv14*(-4*x26)3' O tai5= tai5+s11*gv5*x45i*(-4*p18)p! O tai5= tai5+s11*gv5*(4*x13) # O tai5= tai5+s11*gv10*x45i*(8)g( O tai5= tai5+s11*gv14*x45i*(-4*p22) O tai5= tai5+s12*gv11*(-4) # O tai5= tai5+s13*gv14*(-4*x14) & O tai5= tai5+s14*gv5*x45i*(4*p18)" O tai5= tai5+s14*gv5*(-4*x13)$ O tai5= tai5+s14*gv10*x45i*(-8) O tai5= tai5+s14*gv11*(-4) ' O tai5= tai5+s14*gv14*x45i*(4*p22) # O tai5= tai5+s14*gv14*(-4*x14)  O tai5= tai5+s15*gv1*(-4)" O tai5= tai5+s15*gv2*x45i*(4)" O tai5= tai5+s15*gv3*x45i*(4)" O tai5= tai5+s15*gv4*(-4*x16)! O tai5= tai5+s15*gv4*(4*x13)n' O tai5= tai5+s15*gv5*x45i*(-4*p15)m/ O tai5= tai5+s15*gv13*(-4*x45+4*p15+4*p17) # O tai5= tai5+s15*gv13*(-4*p13) ( O tai5= tai5+s15*gv14*x45i*(-4*p15) O tai5= tai5+s15*gv14*(4) O *  O tai6= s1*gv14*(4*x56) O tai6= tai6+s2*gv8*(4)" O tai6= tai6+s3*gv14*(-4*x45) O tai6= tai6+s4*gv8*(4)" O tai6= tai6+s4*gv14*(-4*x56)" O tai6= tai6+s5*gv14*(-4*x56)" O tai6= tai6+s5*gv14*(-4*x45) O tai6= tai6+s6*gv8*(-4)f" O tai6= tai6+s6*gv14*(-4*x45) O tai6= tai6+s7*gv4*(4*x56) O tai6= tai6+s7*gv4*(4*x36) O tai6= tai6+s7*gv5*(4*x25)& O tai6= tai6+s7*gv7*x45i*(-4*x35)% O tai6= tai6+s7*gv8*x45i*(8*x25) & O tai6= tai6+s7*gv9*x45i*(-4*x56)" O tai6= tai6+s7*gv13*(-4*p61)" O tai6= tai6+s7*gv14*(-4*x26) O tai6= tai6+s8*gv4*(4*x56) O tai6= tai6+s8*gv4*(4*x35) O tai6= tai6+s8*gv5*(4*x25)" O tai6= tai6+s8*gv13*(-4*p61)" O tai6= tai6+s8*gv13*(-4*p41) O tai6= tai6+s9*gv9*(-4)p( O tai6= tai6+s10*gv4*(-4*x35+4*x36)' O tai6= tai6+s10*gv7*x45i*(-4*x35) & O tai6= tai6+s10*gv8*x45i*(8*x25)' O tai6= tai6+s10*gv9*x45i*(-4*x56)i O tai6= tai6+s10*gv9*(-4)" O tai6= tai6+s10*gv13*(4*p41)# O tai6= tai6+s10*gv14*(-4*x26)(& O tai6= tai6+s11*gv5*x45i*(4*p18)" O tai6= tai6+s11*gv5*(-4*x13)$ O tai6= tai6+s11*gv10*x45i*(-8)' O tai6= tai6+s11*gv14*x45i*(4*p22)g O tai6= tai6+s12*gv11*(4)" O tai6= tai6+s13*gv14*(4*x14)& O tai6= tai6+s14*gv5*x45i*(4*p18)" O tai6= tai6+s14*gv5*(-4*x13)$ O tai6= tai6+s14*gv10*x45i*(-8) O tai6= tai6+s14*gv11*(-4) ' O tai6= tai6+s14*gv14*x45i*(4*p22) " O tai6= tai6+s14*gv14*(4*x14) O tai6= tai6+s15*gv1*(-4)# O tai6= tai6+s15*gv2*x45i*(-4))" O tai6= tai6+s15*gv3*x45i*(4)" O tai6= tai6+s15*gv4*(-4*x16)" O tai6= tai6+s15*gv4*(-4*x13)' O tai6= tai6+s15*gv5*x45i*(-4*p15)n/ O tai6= tai6+s15*gv13*(-4*x45+4*p15+4*p17)t" O tai6= tai6+s15*gv13*(4*p13)' O tai6= tai6+s15*gv14*x45i*(4*p15)3 O tai6= tai6+s15*gv14*(-4)  O *  O if(ofl.eq.'c') then3 O adaavr= -(cv2ar*tar2+cv3ar*tar3+cv4ar*tar4+31 O # cv5ar*tar5+cv6ar*tar6)/256.d0/pis 4 O adaavie= -(cv2ar*tai2+cv3ar*tai3+cv4ar*tai4+1 O # cv5ar*tai5+cv6ar*tai6)/256.d0/pis#3 O adaavi= -(cv2ai*tar2+cv3ai*tar3+cv4ai*tar4+51 O # cv5ai*tar5+cv6ai*tar6)/256.d0/pisx3 O adaavre= (cv2ai*tai2+cv3ai*tai3+cv4ai*tai4+02 O # cv5ai*tai5+cv6ai*tai6)/256.d0/pis O else if(ofl.eq.'a') then O 8 O adaavr= 0.5d0*(cv2ar*tar2+cv3ar*tar3+cv4ar*tar4+& O # cv5ar*tar5+cv6ar*tar6)9 O adaavie= 0.5d0*(cv2ar*tai2+cv3ar*tai3+cv4ar*tai4+x& O # cv5ar*tai5+cv6ar*tai6)8 O adaavi= 0.5d0*(cv2ai*tar2+cv3ai*tar3+cv4ai*tar4+& O # cv5ai*tar5+cv6ai*tar6): O adaavre= -0.5d0*(cv2ai*tai2+cv3ai*tai3+cv4ai*tai4+' O # cv5ai*tai5+cv6ai*tai6) O endif O *s O endif2 O endif  O * . O if(otype.eq.'cc03') then& O dpp1arc= 0.d0& O dpp1aic= 0.d0& O dpp2arc= 0.d0& O dpp2aic= 0.d0& O dpp3arc= 0.d0& O dpp3aic= 0.d0& O dpp4arc= 0.d0& O dpp4aic= 0.d0 O *x: O else if(otype.eq.'cc11'.or.otype.eq.= O # 'cc12'.or.otype.eq.'cc20') then/ O * G O *-----pair production I: common part O  O * C O dpp1arc= -gn1*x24*x36+gn2*x26+gn3*(x23+x36)+(D O # gn4*(x13*(x24*x56-x26*x45)-x14*(x23*F O # x56-x25*x36-x26*x35)+x16*(x23*x45-x24*D O # x35)-x36*x45)+gn5*(x13*(x25*x46-x26*G O # x45)+x14*(x23*x56-x25*x36+x26*x35)-x16*6E O # x23*x45-x35*x46+x36*x45)-gn6*x23*x46+6C O # gn7*(-x13*x25-x13*x56+x16*x35+x35)+ E O # gn8*(x16*x25-x56)+gn9*(-x16*x25+x56)+7( O # gn10*x26C O dpp1aic= 4.d0*gn1*s12+4.d0*gn4*(-x25*s8-x36*1E O # s4+s15)+4.d0*gn5*(x25*s8-2.d0*x26*s7+dE O # x36*s4-x46*s2-s15)-4.d0*gn6*s12+4.d0*x> O # gn7*s2+4.d0*gn8*s6-4.d0*gn9*s6 O *xG O *-----pair production II: common part  O * A O dpp2arc= +2.d0*gn3*x13+2.d0*gn5*x23*(-x13*iC O # x45+x14*x35)-2.d0*gn6*x14*x23+2.d0*5; O # gn8*(x13*x25-x35)+2.d0*gn10*@ O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O x25+x35)-gn10) O O @ O db1aic= 128.d0*(s1*gn5*x35-s1*gn6+s7*gn4*< O # x36-s8*gn4*x35+s9*gn9+s11*gn5*. O # x13+s15*gn4*x13) O *i$ O *-----Bremssthralung II: common part O **; O db2arc= 16.d0*(-gn1*x24*x36+gn2*x26+ O < O # gn3*x23+gn4*(x13*x24*x56-x13*? O # x26*x45-x14*x23*x56+x14*x25*x36+ ? O # x14*x26*x35+x16*x23*x45-x16*x24*i? O # x35-x36*x45)+gn7*(-x13*x25+2.d0* = O # x13*x45-2.d0*x14*x35+x35)+gn9*i8 O # (-x16*x25+x56)-2.d0*gn11)< O db2aic= 64.d0*(s3*gn4*x45-s5*gn4*x35-9 O # s6*gn9-s7*gn4*x26+2.d0*s7* 7 O # gn7+s11*gn4*x16+s15*gn4)v O *x% O *-----Bremssthralung III: common part* O *3< O db3arc= 32.d0*(gn1*x36*(x14-x45)+gn2*9 O # (-x16+x56)+gn3*(-x13+x35))4; O db3aic= 128.d0*(-s1*gn6-s5*gn25-s12*40 O # gn28*x14+s15*gn1) O *i$ O *-----Multiperipheral I: common part O *i= O dm1arc= 32.d0*(gn1*x36*(-x14+x45)+gn2*4; O # (x16-x56)+gn6*x23*(x14-x45)+70 O # gn10*(-1.d0+x25)); O dm1aic= 128.d0*(s5*gn25-s11*gn6+s12*t/ O # gn28*x14-s15*gn1)1 O *3% O *-----Multiperipheral II: common part  O *t; O dm2arc= 16.d0*(gn3*x36+gn5*(x13*x25* < O # x46-x13*x26*x45+x14*x23*x56- ; O # x14*x25*x36+x14*x26*x35-x16*8< O # x23*x45-x35*x46+x36*x45)-gn6*: O # x23*x46+gn7*(-2.d0*x13*x45-= O # x13*x56+2.d0*x14*x35+x16*x35)+ : O # gn8*(x16*x25-x56)+gn10*x26+) O # 2.d0*gn11) 9 O dm2aic= 64.d0*(-s2*gn5*x46+s5*gn5**9 O # x35-s7*gn5*x26-2.d0*s7*gn7+t9 O # s9*gn7-s12*gn6-s14*gn5*x13)x O *  O *-----Fusion common: part* O **9 O dfarc= 4.d0*gn1*x36*(x14-x24-x45)++; O # 4.d0*gn2*(-x16+x26+x56)+2.d0*i< O # gn3*(2.d0*(x23+x35)+x36)+2.d0*9 O # gn5*(-2.d0*x13*x23*x45-x13*(; O # x25*x46+x13*x26*x45+2.d0*x14*i: O # x23*x35-x14*x23*x56+x14*x25*: O # x36-x14*x26*x35+x16*x23*x45+< O # x35*x46-x36*x45)-2.d0*gn6*x23*; O # (2.d0*x14+x46)+2.d0*gn7*(x13*i< O # x56-x16*x35+2.d0*x13*x45-2.d0*: O # x14*x35)+2.d0*gn8*(2.d0*x13*= O # x25-x16*x25-2.d0*x35+x56)+2.d0*v7 O # gn10*(2.d0+x26)-4.d0*gn11 < O dfaic= 8.d0*(-s1*gn4*x56+2.d0*s1*gn6-; O # s4*gn4*x36+s4*gn5*x23-s4*gn8*1< O # x25/x45+s4*gn9/x45*x56+s6*gn9+= O # s7*gn4*(x26-x36)-s7*gn5*x23+s7*)> O # gn8*x25/x45-s7*gn9/x45*x56+2.d0*< O # s7*gn7-2.d0*s8*gn1+s8*gn4*x25-* O # 2.d0*s9*gn9-> O # s10*gn4*x36+s10*gn5*x23-s10*gn8*? O # x25/x45+s10*gn9/x45*x56-2.d0*s11*+? O # gn6+s12*gn1-s12*gn6-s12*gn25+s12*+= O # gn26*(-x13*x45-x14*x25+x14*x35-i< O # x14*x56+x16*x45+x45)+2.d0*s12*? O # gn28*x45+s13*gn4*x14+s14*gn2/x45- ; O # s14*gn4*x13+s14*gn10/x45+s14* O ; O # gn25*(2.d0-x34/x45)+s14*gn27**@ O # (1.d0-x13-x14*x25/x45+x14*x35/x45-/ O # x14/x45*x56+x16))5 O * O  O * 8 O if(ofl.eq.'c'.or.ofl.eq.'a') then O **/ O etar4= gv1*(-2*p40*x45-p45*x36+2*p46*x36) , O etar4= etar4+gv2*(2*p43+p49-2*p57-p69). O etar4= etar4+gv3*x45i*(-p39*x46+p46*x36) O etar4= etar4+gv3*(p36)+ O etar4= etar4+gv4*(p4*p48-p4*p61+4*p4* O ( O # p73+2*p7*p73-2*p8*p73-2*p11*p47-( O # p13*p55+p15*p57+2*p15*p60-4*p15*+ O # p69+p16*x36-2*p17*p69+2*p19*x36+p29t( O # *p53-2*p29*p73-p31*p46-2*p31*p47- O # +2*p34*p47+2*p47*x56-2*p60*x45+2*p73**/ O # x36+2*u13*x36-2*u16*x36+2*u19*x36-u34-2  O # *u43*x36)v+ O etar4= etar4+gv5*x45i*(2*p13*p51*x46)(- O etar4= etar4+gv5*(-2*p3*p53-2*p3*p54+2* # O # p3*p73+2*p13*p51-2*p13*p69) , O etar4= etar4+gv7*x45i*(-p4*p71+p8*p48-( O # p13*p72-p15*p69-p34*p46+p71*x35+ O # u18*x35). O etar4= etar4+gv7*(-2*p4*x26+4*p4*x36-p5-, O # p7*x35+2*p29*x25+p29*x35-2*p43+p51+2 O # *p57-3*p69) / O etar4= etar4+gv8*x45i*(p5*x46-p13*p55-p15+) O # *p57+p16*x36-p32*x34-p51*x46+u33)1/ O etar4= etar4+gv8*(x35s+p4*x26-p4*x35-2*p4 ) O # *x36+2*p5+p29*x25-2*p51-p52+2*p69)t3 O etar4= etar4+gv9*(-2*x36*x56+p8*x56+2*p11*x36*, O # +2*p31*x36-p32-p34*x35-2*p34*x36+p55 O # -4*u6+4*u27)' O etar4= etar4+gv10*x45i*(-u28+u29)* O etar4= etar4+gv10*(-p39)! O etar4= etar4+gv11*(p56*x35) , O etar4= etar4+gv12*x45i*(2*p43-p52-p57)1 O etar4= etar4+gv13*(-2*p13*p69*x45+2*u3*p73) - O etar4= etar4+gv14*(-2*p3*p75+2*p4*p67-2v& O # *p4*p73+p7*p70+p13*p72+p15*p69- O # +p29*p70-p31*p64+p69*x45-u18*x35-u38)r, O etar4= etar4+gv47*x45i*(-p72-u6+2*u27) O *a O etarpmp= gv1*(-4*p20)#" O etarpmp= etarpmp+gv2*(4*x16). O etarpmp= etarpmp+gv3*(4*x13-2*x35-2*x36)( O etarpmp= etarpmp+gv6*(2*p41+2*p42)( O etarpmp= etarpmp+gv7*(-4*p9+4*p18)* O etarpmp= etarpmp+gv10*(-2*x25-2*x26) O etarpmp= etarpmp+gv12*(-4) O * ! O etarppm= gv1*(-4*p20+4*p73)a( O etarppm= etarppm+gv2*(4*x16-4*x56)( O etarppm= etarppm+gv3*(4*x13-2*x35). O etarppm= etarppm+gv5*(-2*p71+2*p73+2*u5-% O # 2*u7+2*u13-2*u16+2*u18-2*u24)a# O etarppm= etarppm+gv6*(-2*p41)i4 O etarppm= etarppm+gv7*(-4*p9-2*p11+4*p18+2*p34)) O etarppm= etarppm+gv8*(-2*x56+2*p31)4# O etarppm= etarppm+gv10*(2*x25)+ O etarppm= etarppm+gv12*(-4) O *  O etarpmm= gv1*(4*p20)# O etarpmm= etarpmm+gv2*(-4*x16)'# O etarpmm= etarpmm+gv3*(-4*x13)a' O etarpmm= etarpmm+gv7*(4*p9-4*p18)c O etarpmm= etarpmm+gv12*(4)d O *a O etarpp= gv1*(2*p73) ! O etarpp= etarpp+gv2*(-2*x56) % O etarpp= etarpp+gv3*(-2*x35+x36) 8 O etarpp= etarpp+gv5*(p71-p73-u5+u7-u13+u16-u18+u24) O etarpp= etarpp+gv6*(-p42)d" O etarpp= etarpp+gv7*(p11-p34)" O etarpp= etarpp+gv8*(x56-p31) O etarpp= etarpp+gv10*(x26)  O *c O etarmm= gv1*(-2*p20) O etarmm= etarmm+gv2*(2*x16) O etarmm= etarmm+gv6*(2*p13)% O etarmm= etarmm+gv7*(2*p9-2*p18)  O etarmm= etarmm+gv (-2) O etarmm= etarmm+gv12*(-2) O * $ O etai4= s4*gv4*x45i*(4*p47*x56)4 O etai4= etai4+s4*gv4*(4*x36s-4*p52-4*p60+4*p69)& O etai4= etai4+s4*gv5*x45i*(4*u28)' O etai4= etai4+s4*gv5*(4*p36-4*p40)x3 O etai4= etai4+s4*gv7*x45i*(-4*p43-4*p52+4*p57)): O etai4= etai4+s4*gv8*x45i*(-4*x25s-4*p49+4*p51+4*p52)1 O etai4= etai4+s4*gv9*x45i*(-4*x36*x56+4*p55) ' O etai4= etai4+s4*gv13*(-4*p40*x45)2( O etai4= etai4+s4*gv14*x45i*(-4*u33). O etai4= etai4+s4*gv14*(4*p43+4*p52-4*p57)+ O etai4= etai4+s7*gv4*x45i*(-4*p47*x56)x5 O etai4= etai4+s7*gv4*(-4*x36s+4*p52+4*p60-4*p69)n' O etai4= etai4+s7*gv5*x45i*(-4*u28) ( O etai4= etai4+s7*gv5*(-4*p36+4*p40)2 O etai4= etai4+s7*gv7*x45i*(4*p43+4*p52-4*p57)9 O etai4= etai4+s7*gv8*x45i*(4*x25s+4*p49-4*p51-4*p52)n0 O etai4= etai4+s7*gv9*x45i*(4*x36*x56-4*p55)& O etai4= etai4+s7*gv13*(4*p40*x45)' O etai4= etai4+s7*gv14*x45i*(4*u33) / O etai4= etai4+s7*gv14*(-4*p43-4*p52+4*p57) # O etai4= etai4+s11*gv1*(-4*x36)*' O etai4= etai4+s11*gv3*x45i*(4*x25) . O etai4= etai4+s11*gv5*x45i*(-4*p16+4*u15)' O etai4= etai4+s11*gv5*(4*x25-4*p4)g) O etai4= etai4+s11*gv10*x45i*(-4*x25)o# O etai4= etai4+s11*gv11*(4*x36) 6 O etai4= etai4+s11*gv13*(-4*p73+4*u16-4*u19+4*u43)# O etai4= etai4+s12*gv1*(-4*x36) ' O etai4= etai4+s12*gv3*x45i*(4*x25)). O etai4= etai4+s12*gv5*x45i*(-4*p16+4*u15)' O etai4= etai4+s12*gv5*(4*x25-4*p4)r) O etai4= etai4+s12*gv10*x45i*(-4*x25) # O etai4= etai4+s12*gv11*(4*x36) 6 O etai4= etai4+s12*gv13*(-4*p73+4*u16-4*u19+4*u43) O etai4= etai4+s13*gv2*(-4)4( O etai4= etai4+s13*gv3*x45i*(-4*x24)- O etai4= etai4+s13*gv7*x45i*(4*p15-4*p18) % O etai4= etai4+s13*gv7*(-4+4*x13)4# O etai4= etai4+s13*gv11*(4*x34) $ O etai4= etai4+s13*gv12*x45i*(4)5 O etai4= etai4+s13*gv14*(-4*x45+4*p9+4*p15-4*p18)9' O etai4= etai4+s14*gv1*x45i*(4*p47) ( O etai4= etai4+s14*gv2*x45i*(-8*x36). O etai4= etai4+s14*gv4*x45i*(-4*u16+4*u19)- O etai4= etai4+s14*gv4*(-4*x13*x36+4*x36)7( O etai4= etai4+s14*gv11*x45i*(4*p65). O etai4= etai4+s14*gv14*x45i*(4*u16-4*u19)- O etai4= etai4+s14*gv14*(4*x13*x36-4*x36)o' O etai4= etai4+s15*gv1*x45i*(4*p45) ( O etai4= etai4+s15*gv2*x45i*(-8*x25). O etai4= etai4+s15*gv4*x45i*(-4*p16+4*u15)' O etai4= etai4+s15*gv4*(4*x25-4*p4) ( O etai4= etai4+s15*gv11*x45i*(4*p50). O etai4= etai4+s15*gv14*x45i*(4*p16-4*u15)) O etai4= etai4+s15*gv14*(-4*x25+4*p4)d O * O  O etaipmp= s7*gv7*(-16)r" O etaipmp= etaipmp+s8*gv1*(16)" O etaipmp= etaipmp+s11*gv6*(8)" O etaipmp= etaipmp+s12*gv6*(8) O *  O etaippm= s7*gv7*(-16) " O etaippm= etaippm+s8*gv1*(16)& O etaippm= etaippm+s10*gv4*(8*x36)' O etaippm= etaippm+s10*gv5*(-8*x23) + O etaippm= etaippm+s10*gv8*x45i*(8*x25) O , O etaippm= etaippm+s10*gv9*x45i*(-8*x56)" O etaippm= etaippm+s11*gv6*(8)2 O etaippm= etaippm+s12*gv13*(-8*x16*x45+8*p22)) O etaippm= etaippm+s12*gv36*(-16*x45) ) O etaippm= etaippm+s14*gv10*x45i*(-8) % O etaippm= etaippm+s14*gv11*(-16)3, O etaippm= etaippm+s14*gv14*x45i*(8*p22)( O etaippm= etaippm+s14*gv14*(-8*x16) O *  O etaipmm= s7*gv7*(16)# O etaipmm= etaipmm+s8*gv1*(-16)5 O *2 O etaipp= s1*gv5*(4*x56)) O etaipp= etaipp+s4*gv5*x45i*(-2*p71)(( O etaipp= etaipp+s4*gv8*x45i*(2*x56)% O etaipp= etaipp+s4*gv13*(-2*p73) $ O etaipp= etaipp+s4*gv14*(2*x56)# O etaipp= etaipp+s5*gv5*(4*x35) * O etaipp= etaipp+s5*gv13*(2*p70-2*p73) O etaipp= etaipp+s6*gv8*(-4)# O etaipp= etaipp+s7*gv4*(2*x56) ) O etaipp= etaipp+s7*gv5*x45i*(-2*p54) $ O etaipp= etaipp+s7*gv5*(-4*x25)( O etaipp= etaipp+s7*gv7*x45i*(2*x56)$ O etaipp= etaipp+s7*gv13*(2*p61)* O etaipp= etaipp+s8*gv13*(2*p53+2*p61)# O etaipp= etaipp+s9*gv4*(4*x45) + O etaipp= etaipp+s10*gv4*(-2*x35-2*x36)i$ O etaipp= etaipp+s10*gv5*(4*x23)+ O etaipp= etaipp+s10*gv14*(2*x25+2*x26)0) O etaipp= etaipp+s11*gv5*x45i*(2*p22) $ O etaipp= etaipp+s11*gv5*(2*x16)* O etaipp= etaipp+s11*gv6*x45i*(-2*x46) O etaipp= etaipp+s11*gv6*(2)0 O etaipp= etaipp+s11*gv13*(-2*x16*x45+2*p22)* O etaipp= etaipp+s14*gv5*x45i*(-4*p18)& O etaipp= etaipp+s14*gv10*x45i*(4), O etaipp= etaipp+s14*gv13*(-2*p18+2*p20)! O etaipp= etaipp+s15*gv1*(-4)5, O etaipp= etaipp+s15*gv13*(-2*p15-2*p17) O *  O etaimm= s1*gv5*(4*x45) O etaimm= etaimm+s1*gv6*(-4) O etaimm= etaimm+s4*gv8*(6) % O etaimm= etaimm+s4*gv10*x45i*(2)z$ O etaimm= etaimm+s4*gv13*(2*p20)* O etaimm= etaimm+s4*gv14*x45i*(-2*p22) O etaimm= etaimm+s5*gv11*(2)% O etaimm= etaimm+s5*gv13*(-2*p18)*% O etaimm= etaimm+s5*gv14*(-2*x45) % O etaimm= etaimm+s7*gv3*x45i*(-2)y) O etaimm= etaimm+s7*gv4*x45i*(-2*p22) ( O etaimm= etaimm+s7*gv5*x45i*(4*p15) O etaimm= etaimm+s7*gv7*(2) % O etaimm= etaimm+s7*gv13*(-2*p17)z O etaimm= etaimm+s8*gv1*(6) # O etaimm= etaimm+s8*gv4*(2*x45)y% O etaimm= etaimm+s8*gv13*(-2*p15)0$ O etaimm= etaimm+s9*gv4*(-4*x14)) O etaimm= etaimm+s10*gv4*x45i*(2*p18)*+ O etaimm= etaimm+s10*gv14*x45i*(-2*p15) $ O etaimm= etaimm+s11*gv5*(4*x14)) O etaimm= etaimm+s11*gv6*x45i*(2*x14) / O etaimm= etaimm+s11*gv13*x45i*(-2*p22*x14)i% O etaimm= etaimm+s11*gv13*(2*p12)i+ O etaimm= etaimm+s14*gv11*x45i*(-2*x14) . O etaimm= etaimm+s14*gv13*x45i*(2*p18*x14)% O etaimm= etaimm+s14*gv14*(2*x14)i* O etaimm= etaimm+s15*gv1*x45i*(-2*x14)% O etaimm= etaimm+s15*gv4*(-2*x14) . O etaimm= etaimm+s15*gv13*x45i*(2*p15*x14) O *6 O if(ofl.eq.'c') then < O dfavr= -(ecv4ar*etar4+(ecv1ar-ecv2ar+ecv3ar)*etarpmp+. O # (ecv1ar+ecv2ar-ecv3ar)*etarppm+> O # (ecv1ar-ecv2ar-ecv3ar)*etarpmm+(ecv5ar+ecv6ar)*7 O # etarpp+(ecv5ar-ecv6ar)*etarmm)/32.d0/pis = O dfavie= -(ecv4ar*etai4+(ecv1ar-ecv2ar+ecv3ar)*etaipmp+(. O # (ecv1ar+ecv2ar-ecv3ar)*etaippm+> O # (ecv1ar-ecv2ar-ecv3ar)*etaipmm+(ecv5ar+ecv6ar)*7 O # etaipp+(ecv5ar-ecv6ar)*etaimm)/32.d0/pis3< O dfavi= -(ecv4ai*etar4+(ecv1ai-ecv2ai+ecv3ai)*etarpmp+. O # (ecv1ai+ecv2ai-ecv3ai)*etarppm+> O # (ecv1ai-ecv2ai-ecv3ai)*etarpmm+(ecv5ai+ecv6ai)*7 O # etarpp+(ecv5ai-ecv6ai)*etarmm)/32.d0/pisg< O dfavre= (ecv4ai*etai4+(ecv1ai-ecv2ai+ecv3ai)*etaipmp+. O # (ecv1ai+ecv2ai-ecv3ai)*etaippm+> O # (ecv1ai-ecv2ai-ecv3ai)*etaipmm+(ecv5ai+ecv6ai)*7 O # etaipp+(ecv5ai-ecv6ai)*etaimm)/32.d0/pisv O else if(ofl.eq.'a') then; O dfavr= (ecv4ar*etar4+(ecv1ar-ecv2ar+ecv3ar)*etarpmp+5- O # (ecv1ar+ecv2ar-ecv3ar)*etarppm+x= O # (ecv1ar-ecv2ar-ecv3ar)*etarpmm+(ecv5ar+ecv6ar)*32 O # etarpp+(ecv5ar-ecv6ar)*etarmm)*4.d0< O dfavie= (ecv4ar*etai4+(ecv1ar-ecv2ar+ecv3ar)*etaipmp+. O # (ecv1ar+ecv2ar-ecv3ar)*etaippm+> O # (ecv1ar-ecv2ar-ecv3ar)*etaipmm+(ecv5ar+ecv6ar)*2 O # etaipp+(ecv5ar-ecv6ar)*etaimm)*4.d0; O dfavi= (ecv4ai*etar4+(ecv1ai-ecv2ai+ecv3ai)*etarpmp+ - O # (ecv1ai+ecv2ai-ecv3ai)*etarppm+ = O # (ecv1ai-ecv2ai-ecv3ai)*etarpmm+(ecv5ai+ecv6ai)*22 O # etarpp+(ecv5ai-ecv6ai)*etarmm)*4.d0= O dfavre= -(ecv4ai*etai4+(ecv1ai-ecv2ai+ecv3ai)*etaipmp+ . O # (ecv1ai+ecv2ai-ecv3ai)*etaippm+> O # (ecv1ai-ecv2ai-ecv3ai)*etaipmm+(ecv5ai+ecv6ai)*2 O # etaipp+(ecv5ai-ecv6ai)*etaimm)/4.d0 O endif+ O * O # O endif O O * O if(ofl.eq.'y') then! O dfagirc= F O # gi1*(x56i*c4*(-p60*x45+p69*x45+0.5d0*F O # p73*x36-u34)+(-p47-2.d0*p73)*(c1-c2)+: O # c3*(p47-2.d0*p73)+c4*p47)) O dfagirc= dfagirc+rF O # gi2*((x26+2.d0*x56)*(c1-c2)+c3*(-x26+> O # 2.d0*x56)+c4*(x25-0.5d0*x36))) O dfagirc= dfagirc+tD O # gi3*(x456i*c4*x46*(-0.5d0*p52+p57)+H O # 0.5d0*x45i*c4*(-p42+p47)+0.5d0*x56i*c4*G O # (x36s-3.d0*p52+2.d0*(p57-p60+p69))+c1* G O # (x23+2.d0*x35+x36)+c2*(-x23+x36)+c3*(- 1 O # x23-x36)-c4*x23) ) O dfagirc= dfagirc+ F O # gi4*(0.5d0*x56i*c4*p34*p73+cpmm*(p73+F O # u7+u13-u16-u18+2.d0*u19-u24-2.d0*u43-> O # u44+u45)+c4*(-u19+0.5d0*u43))) O dfagirc= dfagirc+1G O # gi5*(0.5d0*x456i*c4*(-p5*x46s-p15*p57* E O # x46+p16*p74+p51*x46s)-0.5d0*x45i*c4* F O # p13*p54+0.5d0*x56i*c4*(p4*p61+p4*p73+F O # p4*p74-p5*x46-p7*p73-p15*p57+p16*x36+E O # p17*p69+p29*p53+p29*p54-p29*p73+p51*dH O # x46-p52*x46-p69*x45-p69*x46+p73*x36+u5*F O # x26-u16*x36-u34)+cpmp*(p71-p73-u5+u7-E O # u13+u16-u18+u24)+0.5d0*c4*p13*(-x25+)& O # x36))) O dfagirc= dfagirc+ E O # gi6*(0.5d0*x456i*c4*u28*x46+x56i*c4* F O # (p36*x45-1.5d0*p40*x45-0.5d0*p40*x46+F O # 1.5d0*u28)-c1*p42+(c2-c3)*(-2.d0*p41-& O # p42))) O dfagirc= dfagirc+ D O # gi7*(-0.5d0*x456i*c4*p31*p71+0.5d0*G O # x45i*c4*(-p71+2.d0*u5+u13-u16-u18-u44+xF O # u45)+0.5d0*x56i*c4*(p34*x36-u27)+(c1-F O # c2)*(-x35+p4+p11-p34)+c3*(x35-p4+p11-H O # p34)+0.5d0*c4*(-x13*x36+x36+p4+p7-p29))) O dfagirc= dfagirc+dG O # gi8*(0.5d0*x456i*c4*p32*x46+x45i*c4*(--H O # 0.5d0*p54+u14)+x56i*c4*(-p31*x26+0.5d0*G O # p31*x36-0.5d0*p32+u27)+(x56-p31)*cpmp+*; O # 0.5d0*c4*(x25-x35-x36-p4))s) O dfagirc= dfagirc+ H O # gi9*(cpmm*(-x56+2.d0*p11+p31-2.d0*p34)+5 O # 0.5d0*c4*(-p11+p34)) O ) O dfagirc= dfagirc+6G O # gi10*(-0.5d0*x456i*c4*p49*x46+x56i*c4* E O # (-x25s-1.5d0*p49+p51+p52+0.5d0*p60)+ E O # c1*x26+(c2-c3)*(2.d0*x25+x26)+0.5d0*p( O # c4*x23)) O dfagirc= dfagirc+ G O # gi11*c4*(x56i*(0.5d0*p60*x45+u34-u36)+ 3 O # p41-p50-0.5d0*p56) ) O dfagirc= dfagirc- O 7 O # 0.5d0*gi12*x45i*c4*x26-) O dfagirc= dfagirc+dG O # 0.5d0*gi13*c4*(x56i*(p17*p69*x45+p73*(1: O # p73-u7-u16-u24))+p13*p73)) O dfagirc= dfagirc+5G O # gi14*c4*(x56i*(0.5d0*p31*p73-p34*p61)+#H O # 0.5d0*(p67-2.d0*p73+u7-u13+u16+u18+u24-& O # u26))) O dfagirc= dfagirc- G O # gi15*x56i*c4*p40*x45s+0.5d0*gi24*x45i* - O # c4*(x56-p31)# O * O dfagiic=F O # 4.d0*(-s1*gi4*x56+s6*gi9+s7*gi4*(x26-G O # 2.d0*x36)+s8*gi4*x25-2.d0*s9*gi9)*cpmm ) O dfagiic= dfagiic+2G O # 2.d0*s10*gi4*(c4*(x45i*p47+x56i*(x36s- = O # p52-p60+p69))-2.d0*x36*cpmp)#) O dfagiic= dfagiic+3G O # 2.d0*s10*gi5*(c4*(x456i*u28+x56i*(p36- 5 O # p40))+2.d0*x23*cpmp).) O dfagiic= dfagiic+.H O # 2.d0*s10*gi7*c4*(x456i*(-p52+p57)-x45i*% O # x23)4) O dfagiic= dfagiic+ G O # 2.d0*s10*gi8*x45i*(x56i*c4*(-x25s-p49+ 8 O # p51+p52)-2.d0*x25*cpmp)) O dfagiic= dfagiic+ O G O # 2.d0*s10*gi9*(2.d0*x45i*x56*cpmp+x45i* . O # c4*(x25-x36))) O dfagiic= dfagiic+nF O # 2.d0*s10*c4*(-gi13*x56i*p40*x45-gi14*G O # x45i*p50+gi14*x56i*(p52-p57)+gi14*x23) ) O dfagiic= dfagiic+xG O # 2.d0*s11*(gi5*c4*(-x45i*p15+x56i*p31)+ E O # gi6*(x456i*c4*p54+x56i*c4*(2.d0*x25- F O # x36)-4.d0*c1)+gi13*c4*(-x56i*p73*x16+< O # p20)-2.d0*gi15*x56i*c4*p73)) O dfagiic= dfagiic+4G O # 2.d0*s12*(gi5*c4*(-x45i*p15+x56i*p31)+ E O # gi6*(x456i*c4*p54+x56i*c4*(2.d0*x25-pH O # x36)-2.d0*cppm)+gi13*(-x56i*c4*p73*x16+F O # 2.d0*cpmp*(x16*x45-p22)+c4*p20)+gi15*C O # (-2.d0*x56i*c4*p73+4.d0*x45*cpmp))p) O dfagiic= dfagiic+*H O # 2.d0*s13*(gi3*x56i*c4*(-x45i*x46-2.d0)+D O # 2.d0*gi4*x14*cpmm+gi7*c4*(x45i*x14-G O # x56i*x16)-gi10*x56i*c4-2.d0*gi11*x56i*uD O # c4*x45+gi14*c4*(-x56i*x16*x45+x14))) O dfagiic= dfagiic+3D O # 2.d0*s14*(2.d0*gi1*x56i*c4*x36+gi3*E O # x456i*c4*x36+gi4*(-x45i*c4*p20+x56i*tB O # c4*x16*x36-2.d0*x13*cpmm)+gi10*(-H O # x456i*c4*x36+2.d0*x45i*cpmp)+2.d0*gi11*F O # (-x56i*c4*x36+2.d0*cpmp)+gi14*(-2.d0*G O # x45i*cpmp*p22+x45i*c4*p20-x56i*c4*x16*24 O # x36+2.d0*x16*cpmp))) O dfagiic= dfagiic+4D O # 2.d0*s15*c4*(2.d0*gi1*x56i*x25+gi3*E O # x456i*x25-gi4*x45i*p15+gi4*x56i*p31- O H O # gi10*x456i*x25-2.d0*gi11*x56i*x25+gi14*5 O # (x45i*p15-x56i*p31))p= O else if(ofl.eq.'n'.or.ofl.eq.'e') then % O dfagirc= 0.d0 O % O dfagiic= 0.d0* O endif O endifp O *g? O *-----complete diagrams, epsilon real and imag parts separated:  O *r" O *-----complete conversion diagram: O *t& O dcr= -0.25d0*dcr& O dci= -0.25d0*dci( O dcie= -0.25d0*dcie( O dcre= -0.25d0*dcre O *e% O *-----complete annihilation diagrams:= O *a6 O adap= 0.5d0*(sth2*omrz+0.5d0*rz)7 O if(ofl.eq.'c'.or.ofl.eq.'a') then , O adapgr= 0.5d0*strrs, O adapgi= 0.5d0*stris8 O adapzr= 0.5d0*(astrrs*rz+saimz)8 O adapzi= 0.5d0*(astrrs*aimz-srz)- O adaavr1= daarc*cv1ara- O adaavi1= daarc*cv1ai(/ O adaavre1= -daaic*cv1aic. O adaavie1= daaic*cv1ar= O daavr1= (adaavr1*grs-adaavi1*gis)/g2t= O daavi1= (adaavr1*gis+adaavi1*grs)/g27@ O daavre1= (adaavre1*grs-adaavie1*gis)/g2@ O daavie1= (adaavre1*gis+adaavie1*grs)/g2: O daavr= (adaavr*grs-adaavi*gis)/g2: O daavi= (adaavr*gis+adaavi*grs)/g2= O daavre= (adaavre*grs-adaavie*gis)/g2r= O daavie= (adaavre*gis+adaavie*grs)/g2 6 O adaar= -(adapgr+adapzr)*daarc6 O adaai= -(adapgi+adapzi)*daarc7 O adaaie= -(adapgr+adapzr)*daaic 6 O adaare= (adapgi+adapzi)*daaic. O vrt= -1.d0/128.d0/pis, O if(ofl.eq.'c') then@ O cadaar= adaar/g4+(daavr1*vrt+daavr)/g2@ O cadaai= adaai/g4+(daavi1*vrt+daavi)/g2D O cadaare= adaare/g4+(daavre1*vrt+daavre)/g2D O cadaaie= adaaie/g4+(daavie1*vrt+daavie)/g21 O else if(ofl.eq.'a') then+9 O cadaar= (adaar+daavr1+daavr)/g4 O 9 O cadaai= (adaai+daavi1+daavi)/g4 O = O cadaare= (adaare+daavre1+daavre)/g4e= O cadaaie= (adaaie+daavie1+daavie)/g43 O endif4 O daar= cadaar*flr-cadaai*fli4 O daai= cadaai*flr+cadaar*fli7 O daare= cadaare*flr-cadaaie*flia7 O daaie= cadaare*fli+cadaaie*flri O else* O daar= -adap*daarc6 O daare= 0.5d0*asth2*aimz*daaic+ O daaie= -adap*daaic56 O daai= -0.5d0*asth2*aimz*daarc O endif5. O if(otype.eq.'cc03') then$ O d11ar= 0.d0% O d11are= 0.d0*$ O d11ai= 0.d0% O d11aie= 0.d0a O *s: O else if(otype.eq.'cc11'.or.otype.eq.= O # 'cc12'.or.otype.eq.'cc20') thene O *4D O *-----complete pair production I-IV:  O *a8 O if(ofl.eq.'c'.or.ofl.eq.'a') then+ O hchdpr= tstrrs*chdp4+ O hchdpi= tstris*chdp4) O hchdr= tstrrs*chd4) O hchdi= tstris*chd4+ O hchupr= tstrrs*chup4+ O hchupi= tstris*chups) O hchur= tstrrs*chua) O hchui= tstris*chu4 O *5= O ahcpd1r= 1.d0-tstrrs*(omchdp+hchdpr)+1. O # tstris*hchdpi9 O ahcpd1i= -tstris*(omchdp+hchdpr)-s. O # tstrrs*hchdpi; O ahcpd2r= 1.d0-tstrrs*(omchd+hchdr)+ - O # tstris*hchdie7 O ahcpd2i= -tstris*(omchd+hchdr)- - O # tstrrs*hchdie> O ahcpu3r= -1.d0+tstrrs*(opchup-hchupr)+. O # tstris*hchupi8 O ahcpu3i= tstris*(opchup-hchupr)-. O # tstrrs*hchupi< O ahcpu4r= -1.d0+tstrrs*(opchu-hchur)+- O # tstris*hchui 6 O ahcpu4i= tstris*(opchu-hchur)-- O # tstrrs*hchuim O *4@ O bgcpd1r= 1.d0-tstrrs*opchdp-omrz*ahcpd1r< O bgcpd1i= -tstris*opchdp-omrz*ahcpd1i? O bgcpd2r= 1.d0-tstrrs*opchd-omrz*ahcpd2r*; O bgcpd2i= -tstris*opchd-omrz*ahcpd2i @ O bgcpu3r= 1.d0-tstrrs*omchup+omrz*ahcpu3r< O bgcpu3i= -tstris*omchup+omrz*ahcpu3i? O bgcpu4r= 1.d0-tstrrs*omchu+omrz*ahcpu4r ; O bgcpu4i= -tstris*omchu+omrz*ahcpu4i* O *iA O agcpd1r= (bgcpd1r*ctrrsi-bgcpd1i*ctrisi)-iF O # aimz*(ahcpd1r*ctrisi+ahcpd1i*ctrrsi) A O agcpd1i= (bgcpd1r*ctrisi+bgcpd1i*ctrrsi)+5F O # aimz*(ahcpd1r*ctrrsi-ahcpd1i*ctrisi) A O agcpd2r= (bgcpd2r*ctrrsi-bgcpd2i*ctrisi)- F O # aimz*(ahcpd2r*ctrisi+ahcpd2i*ctrrsi) A O agcpd2i= (bgcpd2r*ctrisi+bgcpd2i*ctrrsi)+pF O # aimz*(ahcpd2r*ctrrsi-ahcpd2i*ctrisi) A O agcpu3r= (bgcpu3r*ctrrsi-bgcpu3i*ctrisi)+4F O # aimz*(ahcpu3r*ctrisi+ahcpu3i*ctrrsi) A O agcpu3i= (bgcpu3r*ctrisi+bgcpu3i*ctrrsi)- O F O # aimz*(ahcpu3r*ctrrsi-ahcpu3i*ctrisi) A O agcpu4r= (bgcpu4r*ctrrsi-bgcpu4i*ctrisi)+ F O # aimz*(ahcpu4r*ctrisi+ahcpu4i*ctrrsi) A O agcpu4i= (bgcpu4r*ctrisi+bgcpu4i*ctrrsi)-vF O # aimz*(ahcpu4r*ctrrsi-ahcpu4i*ctrisi)  O *sA O gcpd1r= (agcpd1r*grs-agcpd1i*gis)/8.d0/g2 A O gcpd1i= (agcpd1r*gis+agcpd1i*grs)/8.d0/g2 A O gcpd2r= (agcpd2r*grs-agcpd2i*gis)/8.d0/g2vA O gcpd2i= (agcpd2r*gis+agcpd2i*grs)/8.d0/g2sA O gcpu3r= (agcpu3r*grs-agcpu3i*gis)/8.d0/g2mA O gcpu3i= (agcpu3r*gis+agcpu3i*grs)/8.d0/g2(A O gcpu4r= (agcpu4r*grs-agcpu4i*gis)/8.d0/g2mA O gcpu4i= (agcpu4r*gis+agcpu4i*grs)/8.d0/g2x O *i/ O adpp1ar= gcpd1r*dpp1arct1 O adpp1are= -gcpd1i*dpp1aic 0 O adpp1aie= gcpd1r*dpp1aic/ O adpp1ai= gcpd1i*dpp1arcg0 O adpp2ar= -gcpd2r*dpp2arc0 O adpp2are= gcpd2i*dpp2aic1 O adpp2aie= -gcpd2r*dpp2aic 0 O adpp2ai= -gcpd2i*dpp2arc/ O adpp3ar= gcpu3r*dpp3arc 1 O adpp3are= -gcpu3i*dpp3aicc0 O adpp3aie= gcpu3r*dpp3aic/ O adpp3ai= gcpu3i*dpp3arcv0 O adpp4ar= -gcpu4r*dpp4arc0 O adpp4are= gcpu4i*dpp4aic1 O adpp4aie= -gcpu4r*dpp4aic 0 O adpp4ai= -gcpu4i*dpp4arc> O dpp1ar= (adpp1ar*flmr-adpp1ai*flmi)/g2> O dpp1ai= (adpp1ai*flmr+adpp1ar*flmi)/g2A O dpp1are= (adpp1are*flmr-adpp1aie*flmi)/g2eA O dpp1aie= (adpp1are*flmi+adpp1aie*flmr)/g21> O dpp3ar= (adpp3ar*flmr-adpp3ai*flmi)/g2> O dpp3ai= (adpp3ai*flmr+adpp3ar*flmi)/g2A O dpp3are= (adpp3are*flmr-adpp3aie*flmi)/g2vA O dpp3aie= (adpp3are*flmi+adpp3aie*flmr)/g2a> O dpp2ar= (adpp2ar*flpr-adpp2ai*flpi)/g2> O dpp2ai= (adpp2ai*flpr+adpp2ar*flpi)/g2A O dpp2are= (adpp2are*flpr-adpp2aie*flpi)/g2 A O dpp2aie= (adpp2are*flpi+adpp2aie*flpr)/g2 > O dpp4ar= (adpp4ar*flpr-adpp4ai*flpi)/g2> O dpp4ai= (adpp4ai*flpr+adpp4ar*flpi)/g2A O dpp4are= (adpp4are*flpr-adpp4aie*flpi)/g2iA O dpp4aie= (adpp4are*flpi+adpp4aie*flpr)/g2 O  O elsee8 O hcpd1= 1.d0-tsth2*(omchdp+hchdp)6 O hcpd2= 1.d0-tsth2*(omchd+hchd)9 O hcpu3= -1.d0+tsth2*(opchup-hchup)e7 O hcpu4= -1.d0+tsth2*(opchu-hchu)3 O **C O gcpd1= (1.d0-tsth2*opchdp-omrz*hcpd1)*scth2mB O gcpd2= (1.d0-tsth2*opchd-omrz*hcpd2)*scth2C O gcpu3= (1.d0-tsth2*omchup+omrz*hcpu3)*scth2gB O gcpu4= (1.d0-tsth2*omchu+omrz*hcpu4)*scth2 O *+- O dpp1ar= gcpd1*dpp1arc6C O dpp1are= -hcpd1*haimz*dpp1aic p. O dpp1aie= gcpd1*dpp1aicA O dpp1ai= hcpd1*haimz*dpp1arc 5. O dpp2ar= -gcpd2*dpp2arcB O dpp2are= hcpd2*haimz*dpp2aic / O dpp2aie= -gcpd2*dpp2aic3B O dpp2ai= -hcpd2*haimz*dpp2arc - O dpp3ar= gcpu3*dpp3arc C O dpp3are= -hcpu3*haimz*dpp3aic . O dpp3aie= gcpu3*dpp3aicA O dpp3ai= hcpu3*haimz*dpp3arc x. O dpp4ar= -gcpu4*dpp4arcB O dpp4are= hcpu4*haimz*dpp4aic / O dpp4aie= -gcpu4*dpp4aic-B O dpp4ai= -hcpu4*haimz*dpp4arc  O endif O * < O *-----compensating the missing W and the fermion propagators O * > O d11ar= (dpp1ar*wpcfr-dpp1ai*wpcfi)/pfp+> O # (dpp2ar*wmcfr-dpp2ai*wmcfi)/pfb+? O # (dpp3ar*wpcfr-dpp3ai*wpcfi)/pfpb+ < O # (dpp4ar*wmcfr-dpp4ai*wmcfi)/pfA O d11are= (dpp1are*wpcfr-dpp1aie*wpcfi)/pfp+pA O # (dpp2are*wmcfr-dpp2aie*wmcfi)/pfb+pB O # (dpp3are*wpcfr-dpp3aie*wpcfi)/pfpb+? O # (dpp4are*wmcfr-dpp4aie*wmcfi)/pf+> O d11ai= (dpp1ar*wpcfi+dpp1ai*wpcfr)/pfp+> O # (dpp2ar*wmcfi+dpp2ai*wmcfr)/pfb+? O # (dpp3ar*wpcfi+dpp3ai*wpcfr)/pfpb+ < O # (dpp4ar*wmcfi+dpp4ai*wmcfr)/pfA O d11aie= (dpp1are*wpcfi+dpp1aie*wpcfr)/pfp+ A O # (dpp2are*wmcfi+dpp2aie*wmcfr)/pfb+rB O # (dpp3are*wpcfi+dpp3aie*wpcfr)/pfpb+? O # (dpp4are*wmcfi+dpp4aie*wmcfr)/pfd O endif#. O if(otype.ne.'cc20') then$ O d20ar= 0.d0% O d20are= 0.d0x$ O d20ai= 0.d0% O d20aie= 0.d073 O else if(otype.eq.'cc20') then  O *# O *-----complete CC20 diagrams O *.9 O db1ar= -3.125d-2/pfb*cob1a*db1arc 9 O db1aie= -3.125d-2/pfb*cob1a*db1aic * O if(ofl.eq.'c') then= O db2ar= 1.5625d-2*x23/pf*pp14r*db2arc5= O db2aie= 1.5625d-2*x23/pf*pp14r*db2aic # O db2ai= 0.d0m$ O db2are= 0.d0 O else5+ O if(oww.eq.'r') thenf= O db2ar= 1.5625d-2*x23/pf/pp14*db2arc*= O db2aie= 1.5625d-2*x23/pf/pp14*db2aicx$ O db2ai= 0.d0% O db2are= 0.d0c> O else if(oww.eq.'f'.o oww.eq.'i') then> O db2ar= 1.5625d-2*x23/pf*pp14r*db2arc> O db2aie= 1.5625d-2*x23/pf*pp14r*db2aic> O db2ai= 1.5625d-2*x23/pf*pp14i*db2arc? O db2are= -1.5625d-2*x23/pf*pp14i*db2aic0 O endif  O endif* O if(ofl.eq.'c') then? O db3ar= x23*vel23/128.d0/ctr23/pn*pp23r* % O # db3arc @ O db3aie= x23*vel23/128.d0/ctr23/pn*pp23r*& O # db3aic/ O dbar= db1ar+db2ar+db3ar03 O dbaie= db1aie+db2aie+db3aie # O dbai= db2aif% O dbare= db2are  O else4A O db3ar= x23*vel/128.d0/cth2/pn/x23z*db3arc#B O db3aie= x23*vel/128.d0/cth2/pn/x23z*db3aic/ O dbar= db1ar+db2ar+db3ar#3 O dbaie= db1aie+db2aie+db3aies# O dbai= db2ai % O dbare= db2are  O endif* O if(ofl.eq.'c') then@ O dm1ar= 3.125d-2*pp14r/pm23*com1a*dm1arc@ O dm1aie= 3.125d-2*pp14r/pm23*com1a*dm1aic@ O dm2ar= 3.125d-2*pp14r/pm24*com2a*dm2arc@ O dm2aie= 3.125d-2*pp14r/pm24*com2a*dm2aic# O dm1ai= 0.d01$ O dm1are= 0.d0# O dm2ai= 0.d0 $ O dm2are= 0.d0 O else + O if(oww.eq.'r') then @ O dm1ar= 3.125d-2/pp14/pm23*com1a*dm1arc@ O dm1aie= 3.125d-2/pp14/pm23*com1a*dm1aic@ O dm2ar= 3.125d-2/pp14/pm24*com2a*dm2arc@ O dm2aie= 3.125d-2/pp14/pm24*com2a*dm2aic$ O dm1ai= 0.d0% O dm1are= 0.d0 O $ O dm2ai= 0.d0% O dm2are= 0.d0 > O else if(oww.eq.'f'.or.oww.eq.'i') thenA O dm1ar= 3.125d-2*pp14r/pm23*com1a*dm1arc A O dm1aie= 3.125d-2*pp14r/pm23*com1a*dm1aic A O dm2ar= 3.125d-2*pp14r/pm24*com2a*dm2arc A O dm2aie= 3.125d-2*pp14r/pm24*com2a*dm2aic A O dm1ai= 3.125d-2*pp14i/pm23*com1a*dm1arc1B O dm1are= -3.125d-2*pp14i/pm23*com1a*dm1aicA O dm2ai= 3.125d-2*pp14i/pm24*com2a*dm2arccB O dm2are= -3.125d-2*pp14i/pm24*com2a*dm2aic O endifd O endif( O dmar= dm1ar+dm2ar+ O dmaie= dm1aie+dm2aiep( O dmai= dm1ai+dm2ai+ O dmare= dm1are+dm2area* O if(ofl.eq.'c') then= O dfar= 1.25d-1*(pp14rb*cofad*dfarc-c6 O # 0.5d0*g2*pp14r*dfavr)= O dfaie= 1.25d-1*(pp14rb*cofad*dfaic- 7 O # 0.5d0*g2*pp14r*dfavie) 9 O dfare= -6.25d-2*pp14r*g2*dfavre 7 O dfai= -6.25d-2*pp14r*g2*dfavia/ O else if(ofl.eq.'a') thena+ O if(oww.eq.'r') then ; O dfar= 1.25d-1/pp14*(cofad*dfarc-p. O # 0.5d0*dfavr)< O dfaie= 1.25d-1/pp14*(cofad*dfaic-/ O # 0.5d0*dfavie) O 6 O dfare= -6.25d-2/pp14*dfavre4 O dfai= -6.25d-2/pp14*dfavi> O else if(oww.eq.'f'.or.oww.eq.'i') then= O dfar= 1.25d-1*pp14r*(cofad*dfarc-e. O # 0.5d0*dfavr)= O dfaie= 1.25d-1*pp14r*(cofad*dfaic- / O # 0.5d0*dfavie) = O dfare= -1.25d-1*pp14i*cofad*dfaic- 6 O # 6.25d-2*pp14r*dfavre; O dfai= 1.25d-1*pp14i*cofad*dfarc-a4 O # 6.25d-2*pp14r*dfavi O endif  O else4+ O if(oww.eq.'r') then : O dfar= 1.25d-1/pp14*cofad*dfarc: O dfaie= 1.25d-1/pp14*cofad*dfaic> O else if(oww.eq.'f'.or.oww.eq.'i') then; O dfar= 1.25d-1*pp14r*cofad*dfarc*; O dfaie= 1.25d-1*pp14r*cofad*dfaich O endif  O endif* O if(ofl.eq.'y') thenA O dfai= 6.25d-2/pp14*cofad*gifact*dfagirc=C O dfare= -6.25d-2/pp14*cofad*gifact*dfagiic(/ O else if(ofl.eq.'e') then 1 O gfct= swg*x56/(x56+x14)t= O dfai= 1.25d-1/pp14*cofad*gfct*dfarc ? O dfare= -1.25d-1/pp14*cofad*gfct*dfaic / O else if(ofl.eq.'n') then ; O if(oww.eq.'f'.or.oww.eq.'i') then O < O dfai= 1.25d-1*pp14i*cofad*dfarc> O dfare= -1.25d-1*pp14i*cofad*dfaic O else' O dfai= 0.d0h( O dfare= 0.d0 O endif3 O endif O *3, O *-----compensating the missing W propagators O * ) O d20asrr= dbar+dfar , O d20asrie= dbaie+dfaie) O d20asri= dbai+dfaip, O d20asrre= dbare+dfare* O if(ofl.eq.'c') then> O d20ar= (d20asrr*flpr-d20asri*flpi)/g2+4 O # wpcfr*dmar-wpcfi*dmaiA O d20are= (d20asrre*flpr-d20asrie*flpi)/g2-a7 O # wpcfi*dmaie+wpcfr*dmare1A O d20aie= (d20asrre*flpi+d20asrie*flpr)/g2+ 7 O # wpcfr*dmaie+wpcfi*dmare > O d20ai= (d20asri*flpr+d20asrr*flpi)/g2+5 O # wpcfi*dmar+wpcfr*dmai  O else-< O d20ar= d20asrr+wpcfr*dmar-wpcfi*dmai@ O d20are= d20asrre-wpcfi*dmaie+wpcfr*dmare@ O d20aie= d20asrie+wpcfr*dmaie+wpcfi*dmare= O d20ai= d20asri+wpcfi*dmar+wpcfr*dmai p O endif O * 6 O cd20ar= wmcfr*d20ar-wmcfi*d20ai9 O cd20are= wmcfr*d20are-wmcfi*d20aier9 O cd20aie= wmcfr*d20aie+wmcfi*d20arei6 O cd20ai= wmcfr*d20ai+wmcfi*d20ar O *p O endif  O * = O if(opeaka.eq.'n'.or.opeaka.eq.'f') then 2 O dtar= daar-d11ar-cd20ar/x236 O dtare= daare-d11are-cd20are/x236 O dtaie= daaie-d11aie-cd20aie/x232 O dtai= daai-d11ai-cd20ai/x23! O pns= pn*pn 8 O das= (dcr/pn+dtar)*(dcr/pn+dtar)+< O # (dcie/pn+dtaie)*(dcie/pn+dtaie)+< O # (dcre/pn+dtare)*(dcre/pn+dtare)+7 O # (dci/pn+dtai)*(dci/pn+dtai)p O *c9 O das0= (dcr/pn+daar)*(dcr/pn+daar)+c< O # (dcie/pn+daaie)*(dcie/pn+daaie)+< O # (dcre/pn+daare)*(dcre/pn+daare)+7 O # (dci/pn+daai)*(dci/pn+daai)i1 O else if(opeaka.eq.'y') then 4 O dtar= x23*(daar-d11ar)-cd20ar8 O dtare= x23*(daare-d11are)-cd20are8 O dtaie= x23*(daaie-d11aie)-cd20aie4 O dtai= x23*(daai-d11ai)-cd20ai! O pns= pn*pn2@ O das= (x23*dcr/pn+dtar)*(x23*dcr/pn+dtar)+D O # (x23*dcie/pn+dtaie)*(x23*dcie/pn+dtaie)+D O # (x23*dcre/pn+dtare)*(x23*dcre/pn+dtare)+? O # (x23*dci/pn+dtai)*(x23*dci/pn+dtai)i O *19 O das0= (dcr/pn+daar)*(dcr/pn+daar)+r= O # (dcie/pn+daaie)*(dcie/pn+daaie)+i= O # (dcre/pn+daare)*(dcre/pn+daare)+.8 O # (dci/pn+daai)*(dci/pn+daai)) O das0= x23*x23*das0  O endif ) O das= das+coulf*das0p8 O if(oqcd.eq.'y'.and.iqcd.eq.0) then: O das= das+qcdjac*das0*(1.d0+coulf) O endif3 O *  O *-----helicity b)  O *  O *bG O *-----annihilation diagrams: common part G O * #< O dabrc= 2.d0*gn12*(x23*x36*x45-x24*x35*= O # x36)+gn13*(-x13*x23*x45+x13*x24* = O # x35-0.5d0*x13*x24*x56+0.5d0*x13* = O # x26*x45-0.5d0*x15*x23*x46+0.5d0* ; O # x15*x24*x36+0.5d0*x16*x23*x45-'= O # 0.5d0*x16*x24*x35+0.5d0*x35*x46-o< O # 0.5d0*x36*x45)+2.d0*gn14*(-x23*> O # x56+x26*x35)+gn15*(x23*x45+0.5d0*< O # x23*x56-x24*x35-0.5d0*x26*x35)+= O # gn16*(x15*x23-0.5d0*x15*x26-x35+ < O # 0.5d0*x56)+3.d0*gn17-2.d0*gn20*< O # x56+gn21*(-x35+1.5d0*x36)+2.d0*: O # gn22*x36*x45+gn23*(x15+1.5d0*; O # x16)+gn24*(-x13*x45-1.5d0*x13*m! O # x46)iB O dabic= 8.d0*gn12*x36*s11+2.d0*gn13*(x16*s11-D O # 2.d0*x23*s7+x23*s10+2.d0*x35*s1+x35*s5-C O # x46*s2)+8.d0*gn14*s13+2.d0*gn15*(2.d0* E O # s11-s13)-8.d0*gn18*s10-8.d0*gn19*x45*s8+.8 O # 2.d0*gn24*(2.d0*s7-3.d0*s8) O *  O * ) O *-----The Fermion loop scheme starts here  O * ' O if(ofl.eq.'c'.or.ofl.eq.'a') then/ O *3" O tbr4= gv15*(p24*p49-p24*p79+1 O # p31*p78-p32*x24-p35*x24+p45*x56-2*p49*x45  O # +2*p61*x16)d+ O tbr4= tbr4+gv16*(p2*p48-p2*p61-p4*p48 / O # +p4*p61-p12*p43-p12*p52+p12*p57+p13*p55c6 O # -2*p15*p27-p15*p57-2*p15*p60-p16*x36-2*p17*p27. O # +2*p20*x56-3*p24*p52-2*p24*p60-p29*p480 O # -p29*p53+p31*p46-p31*p47-p34*p78+p36*p484 O # -p45*p52-p45*p57-2*p45*p60+2*p47*x56-p73*x16% O # +u22*x16+u24*x16+u34+u45*x26)c+ O tbr4= tbr4+gv17*(p2*p45+2*p4*x24*x26+2( O # 2*p4*p24+p5*x24+2*p7*p24+p23*p45# O # -p23*p78-p45*x35-2*u44+u45)52 O tbr4= tbr4+gv18*(p25*x16+3*p25*x25+2*p25*x26( O # +2*p31*x15+p31*x16+2*p31*x26+p32+ O # -p35+2*p49*x25+2*p49*x26-p55-2*p63).+ O tbr4= tbr4+gv19*(p2*x25+2*p4*x15+2*p4i+ O # *x26+p5+2*p7*x15-2*p11-p23*x16+p23*  O # x25+p34-p51)+ O tbr4= tbr4+gv20*(2*x56-2*p25-2*p31-2*  O # p49-2*p77)) O tbr4= tbr4+gv48*(p2*p48*x24-p2*p61* - O # x24-p4*p48*x24+p4*p61*x24+p24*p47*x16 , O # +p31*p46*x24+p45*p73-p47*x16*x45-u22% O # *p45-u24*p45+u24*p78-u45*p78)  O * & O tbr2= gv16*(4*p40*x45-4*p46*x36) O tbr2= tbr2+gv16*(-4*u34)% O tbr2= tbr2+gv17*(4*p4*x45+4*u5) O $ O tbr2= tbr2+gv18*(-4*p43+4*p57) O tbr2= tbr2+gv18*(4*p55)1# O tbr2= tbr2+gv19*(4*p41-4*p46)( O tbr2= tbr2+gv19*(-4*p52)$ O tbr2= tbr2+gv20*(-4*p31-4*p77) O tbr2= tbr2+gv46*(4*x25)* O *x& O tbr3= gv16*(4*p40*x45-4*p46*x36) O tbr3= tbr3+gv16* *u34) & O tbr3= tbr3+gv17*(-4*p4*x45-4*u5)$ O tbr3= tbr3+gv18*(-4*p43+4*p57) O tbr3= tbr3+gv18*(-4*p55)# O tbr3= tbr3+gv19*(4*p41-4*p46)4 O tbr3= tbr3+gv19*(4*p52)## O tbr3= tbr3+gv20*(4*p31+4*p77)* O tbr3= tbr3+gv46*(4*x25)  O *# O tbr5= gv16*(2*u34), O tbr5= tbr5+gv16*(-2*p40*x45+2*p46*x36)% O tbr5= tbr5+gv17*(-p71+p73+u5-u7  O # +u21-u22-u24+u44+u45)r& O tbr5= tbr5+gv17*(-2*p8*x24+2*u3) O tbr5= tbr5+gv18*(-2*p55)# O tbr5= tbr5+gv18*(2*p43-2*p57) O * O tbr5= tbr5+gv19*(-p43-2*p51-p52+p57)$ O tbr5= tbr5+gv20*(-x56+p25-p31)# O tbr5= tbr5+gv20*(2*x35-2*p23)  O tbr5= tbr5+gv46*(4*x25)r O *  O tbr6= gv16*(2*u34)+ O tbr6= tbr6+gv16*(2*p40*x45-2*p46*x36)d% O tbr6= tbr6+gv17*(-p71+p73+u5-u72 O # +u21-u22-u24+u44+u45)n% O tbr6= tbr6+gv17*(2*p8*x24-2*u3)  O tbr6= tbr6+gv18*(-2*p55)$ O tbr6= tbr6+gv18*(-2*p43+2*p57)* O tbr6= tbr6+gv19*(-p43-2*p51-p52+p57)$ O tbr6= tbr6+gv20*(-x56+p25-p31)$ O tbr6= tbr6+gv20*(-2*x35+2*p23) O tbr6= tbr6+gv46*(-4*x25) O *0 O tbi4= s1*gv16*(4*p35) . O tbi4= tbi4+s1*gv48*(4*p35*x24-4*p45*x56)! O tbi4= tbi4+s2*gv19*(-4*x25)1' O tbi4= tbi4+s4*gv15*(-8*p49+8*p79)a O tbi4= tbi4+s4*gv16*(4*p52)+ O tbi4= tbi4+s5*gv15*(8*x56-8*p25-8*p31  O # -8*p49-8*p77)e' O tbi4= tbi4+s6*gv15*(-4*p45+4*p78)d' O tbi4= tbi4+s6*gv18*(-4*x16+4*x25) ! O tbi4= tbi4+s7*gv16*(-4*p79)r. O tbi4= tbi4+s7*gv48*(4*p45*x26-4*p78*x26), O tbi4= tbi4+s8*gv16*(4*x25s-8*x56+8*p25 O # +4*p31+8*p49+8*p77) * O tbi4= tbi4+s8*gv48*(8*p24*x25+8*p24*0 O # x26+4*p31*x24+4*p45*x25+8*p45*x26-8*p48)! O tbi4= tbi4+s12*gv16*(4*p77)v. O tbi4= tbi4+s13*gv16*(-4*p12+4*p45-4*p78) O tbi4= tbi4+s14*gv16*(4*p2)- O tbi4= tbi4+s14*gv48*(4*p2*x24-4*p4*x24)i" O tbi4= tbi4+s15*gv16*(-4*x25) O *  O tbi2= s8*gv17*(16*x25)! O tbi2= tbi2+s8*gv48*(16*p53)i" O tbi2= tbi2+s10*gv15*(16*x25)" O tbi2= tbi2+s11*gv16*(16*x36) O tbi2= tbi2+s11*gv19*(16) O tbi2= tbi2+s13*gv18*(16) O * O  O tbi3= s8*gv17*(-16*x25)1" O tbi3= tbi3+s8*gv48*(-16*p53)# O tbi3= tbi3+s10*gv15*(-16*x25) " O tbi3= tbi3+s11*gv16*(16*x36) O tbi3= tbi3+s11*gv19*(16) O tbi3= tbi3+s13*gv18*(16) O *1 O tbi5= s1*gv15*(-4*x56) O tbi5= tbi5+s2*gv20*(-4)( O tbi5= tbi5+s3*gv15*(4*x45)! O tbi5= tbi5+s4*gv15*(-4*x56)( O tbi5= tbi5+s4*gv20*(-4) ! O tbi5= tbi5+s5*gv15*(-4*x56)) O tbi5= tbi5+s5*gv15*(4*x45)! O tbi5= tbi5+s6*gv15*(-4*x45)  O tbi5= tbi5+s6*gv20*(-4) O tbi5= tbi5+s7*gv15*(4*x26) O tbi5= tbi5+s7*gv17*(4*x25)& O tbi5= tbi5+s7*gv48*(4*p48-4*p61) O tbi5= tbi5+s8*gv17*(4*x25)& O tbi5= tbi5+s8*gv48*(4*p48-4*p61)& O tbi5= tbi5+s8*gv48*(4*p41-4*p46) O tbi5= tbi5+s9*gv15*(4*x24)" O tbi5= tbi5+s10*gv15*(-4*x26)! O tbi5= tbi5+s10*gv15*(4*x24)a' O tbi5= tbi5+s10*gv48*(4*p41-4*p46) " O tbi5= tbi5+s11*gv16*(-4*x36)! O tbi5= tbi5+s11*gv17*(4*x13) " O tbi5= tbi5+s12*gv15*(-4*x15) O tbi5= tbi5+s13*gv18*(-4)" O tbi5= tbi5+s14*gv15*(-4*x15)! O tbi5= tbi5+s14*gv16*(4*x36)5" O tbi5= tbi5+s14*gv17*(-4*x13) O tbi5= tbi5+s14*gv18*(-4) O tbi5= tbi5+s15*gv15*(4) " O tbi5= tbi5+s15*gv16*(-4*x25)( O tbi5= tbi5+s15*gv48*(-4*x45+4*p24) O *  O tbi6= s1*gv15*(4*x56)* O tbi6= tbi6+s2*gv20*(4)! O tbi6= tbi6+s3*gv15*(-4*x45)d! O tbi6= tbi6+s4*gv15*(-4*x56)  O tbi6= tbi6+s4*gv20*(4)! O tbi6= tbi6+s5*gv15*(-4*x56) ! O tbi6= tbi6+s5*gv15*(-4*x45)e! O tbi6= tbi6+s6*gv15*(-4*x45)i O tbi6= tbi6+s6*gv20*(-4) ! O tbi6= tbi6+s7*gv15*(-4*x26) O tbi6= tbi6+s7*gv17*(4*x25)& O tbi6= tbi6+s7*gv48*(4*p48-4*p61) O tbi6= tbi6+s8*gv17*(4*x25)& O tbi6= tbi6+s8*gv48*(4*p48-4*p61)' O tbi6= tbi6+s8*gv48*(-4*p41+4*p46) ! O tbi6= tbi6+s9*gv15*(-4*x24) " O tbi6= tbi6+s10*gv15*(-4*x26)" O tbi6= tbi6+s10*gv15*(-4*x24)' O tbi6= tbi6+s10*gv48*(4*p41-4*p46)t! O tbi6= tbi6+s11*gv16*(4*x36) " O tbi6= tbi6+s11*gv17*(-4*x13)! O tbi6= tbi6+s12*gv15*(4*x15)m O tbi6= tbi6+s13*gv18*(4) " O tbi6= tbi6+s14*gv15*(-4*x15)! O tbi6= tbi6+s14*gv16*(4*x36)s" O tbi6= tbi6+s14*gv17*(-4*x13) O tbi6= tbi6+s14*gv18*(4) O  O tbi6= tbi6+s15*gv15*(-4)" O tbi6= tbi6+s15*gv16*(-4*x25)( O tbi6= tbi6+s15*gv48*(-4*x45+4*p24) O *  O if(ofl.eq.'c') then=2 O adabvr= -(cv2br*tbr2+cv3br*tbr3+cv4br*tbr4+0 O # cv5br*tbr5+cv6br*tbr6)/256.d0/pis3 O adabvie= -(cv2br*tbi2+cv3br*tbi3+cv4br*tbi4+ 0 O # cv5br*tbi5+cv6br*tbi6)/256.d0/pis2 O adabvi= -(cv2bi*tbr2+cv3bi*tbr3+cv4bi*tbr4+0 O # cv5bi*tbr5+cv6bi*tbr6)/256.d0/pis2 O adabvre= (cv2bi*tbi2+cv3bi*tbi3+cv4bi*tbi4+0 O # cv5bi*tbi5+cv6bi*tbi6)/256.d0/pis O else if(ofl.eq.'a') then7 O adabvr= 0.5d0*(cv2br*tbr2+cv3br*tbr3+cv4br*tbr4+c% O # cv5br*tbr5+cv6br*tbr6)18 O adabvie= 0.5d0*(cv2br*tbi2+cv3br*tbi3+cv4br*tbi4+& O # cv5br*tbi5+cv6br*tbi6)7 O adabvi= 0.5d0*(cv2bi*tbr2+cv3bi*tbr3+cv4bi*tbr4+h% O # cv5bi*tbr5+cv6bi*tbr6)=9 O adabvre= -0.5d0*(cv2bi*tbi2+cv3bi*tbi3+cv4bi*tbi4+3& O # cv5bi*tbi5+cv6bi*tbi6) O endif O endif= O *s. O if(otype.eq.'cc03') then& O dpp1brc= 0.d0& O dpp1bic= 0.d0& O dpp2brc= 0.d0& O dpp2bic= 0.d0& O dpp3brc= 0.d0& O dpp3bic= 0.d0& O dpp4brc= 0.d0& O dpp4bic= 0.d0 O *#: O else if(otype.eq.'cc11'.or.otype.eq.= O # 'cc12'.or.otype.eq.'cc20') thenc O *sG O *-----pair production I: common pbrt i O * O A O dpp1brc= gn12*(-x13*(x24*x56-x26*x45)+x14* O B O # (x23*x56-x26*x35)+x15*x24*x36-x16*@ O # (x23*x45-x24*x35)-x36*x45)+gn13*@ O # (x13*(x24*x56-x26*x45)+x15*(x23*C O # x46-x24*x36)-x16*(x23*x45-x24*x35)-c@ O # x35*x46+x36*x45)+gn14*(-x15*x26+@ O # x56)+gn15*(-x15*x23-x23*x56+x26*A O # x35+x35)+gn16*(x15*x26-x56)+gn20*r> O # x16+gn21*(x13+x36)+gn22*(-x14*= O # x36)+gn23*x16+gn24*(-x13*x46)*@ O dpp1bic= 4.d0*gn12*(-x14*s13-x16*s11+x23*@ O # s10+x35*s5)+4.d0*gn13*(-x13*s14-C O # x26*s7+x56*s1)+4.d0*gn15*(-s2+s13)-d? O # 4.d0*gn16*s6+4.d0*gn22*s8-4.d0*c' O # gn24*s8 O  O * H O *-----pair production II: common part  O * A O dpp2brc= 2.d0*gn13*x13*(-x23*x45+x24*x35)+ B O # 2.d0*gn16*(x15*x23-x35)+2.d0*gn21*? O # x23+2.d0*gn23-2.d0*gn24*x13*x24r@ O dpp2bic= 8.d0*gn13*(-x23*s7+x35*s1)-8.d0*' O # gn24*s1  O * D O *-----production III: common part  O *p? O dpp3brc= 2.d0*gn21*(-x23+x35)+2.d0*gn23* C O # (-1.d0+x15)+2.d0*gn24*x13*(x24-x45) 1 O dpp3bic= 8.d0*gn24*(s1-s7)d O *aI O *-----pair production IV: common part  O * @ O dpp4brc= gn12*(x13*(x24*x56-x26*x45)-x14*B O # (x23*x56-x26*x35)-x15*x24*x36+x16*@ O # (x23*x45-x24*x35)+x36*x45)+gn14*B O # (x15*x26-x56)+gn15*(x15*x23-2*x23*@ O # x45+2.d0*x24*x35-x35)+2.d0*gn17-> O # gn20*x16-gn21*x13+gn22*x14*x36C O dpp4bic= 4.d0*gn12*(x14*s13+x16*s11-x23*s10--@ O # x35*s5)+4.d0*gn15*(s2-2.d0*s11)-, O # 4.d0*gn22*s8 O endif  O * 1 O *-----complete diagrams, epsilon parts separated:  O * % O *-----complete annihilation diagrams:h O * O 7 O if(ofl.eq.'c'.or.ofl.eq.'a') thena8 O adbpr= 0.5d0*(strrs*omrz+saimz)9 O adbpi= 0.5d0*(-raimz+stris*omrz) O 8 O bdbpr= (adbpr*grs-adbpi*gis)/g28 O bdbpi= (adbpr*gis+adbpi*grs)/g2: O dabvr= (adabvr*grs-adabvi*gis)/g2: O dabvi= (adabvr*gis+adabvi*grs)/g2= O dabvre= (adabvre*grs-adabvie*gis)/g2 = O dabvie= (adabvre*gis+adabvie*grs)/g2 , O adabr= -adbpr*dabrc, O adabre= adbpi*dabic, O adabi= -adbpi*dabrc- O adabie= -adbpr*dabic.- O adabvr1= dabrc*cv1br - O adabvi1= dabrc*cv1bi / O adabvre1= -dabic*cv1bif. O adabvie1= dabic*cv1br= O dabvr1= (adabvr1*grs-adabvi1*gis)/g2 O = O dabvi1= (adabvr1*gis+adabvi1*grs)/g2r@ O dabvre1= (adabvre1*grs-adabvie1*gis)/g2@ O dabvie1= (adabvre1*gis+adabvie1*grs)/g2. O vrt= -1.d0/128.d0/pis, O if(ofl.eq.'c') then@ O cadabr= adabr/g4+(dabvr1*vrt+dabvr)/g2@ O cadabi= adabi/g4+(dabvi1*vrt+dabvi)/g2D O cadabre= adabre/g4+(dabvre1*vrt+dabvre)/g2D O cadabie= adabie/g4+(dabvie1*vrt+dabvie)/g21 O else if(ofl.eq.'a') then 9 O cadabr= (adabr+dabvr1+dabvr)/g4=9 O cadabi= (adabi+dabvi1+dabvi)/g4 = O cadabre= (adabre+dabvre1+dabvre)/g4-= O cadabie= (adabie+dabvie1+dabvie)/g4  O endif4 O dabr= cadabr*flr-cadabi*fli4 O dabi= cadabi*flr+cadabr*fli7 O dabre= cadabre*flr-cadabie*fli 7 O dabie= cadabre*fli+cadabie*flri O else0 O dabr= -hsth2*omrz*dabrc1 O dabre= -hsth2*aimz*dabic21 O dabie= -hsth2*omrz*dabicf/ O dabi= hsth2*aimz*dabrcr O endif . O if(otype.eq.'cc03') then0 O d11br= 0.d0 1 O d11bre= 0.d0 0 O d11bi= 0.d0 1 O d11bie= 0.d0 d O *-: O else if(otype.eq.'cc11'.or.otype.eq.E O # 'cc12'.or.otype.eq.'cc20') then w O *iD O *-----complete pair production I-IV:  O * 8 O if(ofl.eq.'c'.or.ofl.eq.'a') then* O hchdpr= strrs*chdp* O hchdpi= stris*chdp( O hchdr= strrs*chd( O hchdi= stris*chd* O hchupr= strrs*chup* O hchupi= stris*chup( O hchur= strrs*chu( O hchui= stris*chu, O achdpr= 0.5d0+hchdpr* O achdr= 0.5d0+hchdr, O achupr= 0.5d0-hchupr* O achur= 0.5d0-hchur@ O agcmd1r= ttrrs*(-0.5d0-chdp+omrz*achdpr+A O # aimz*hchdpi)-ttris*(omrz*hchdpi-a- O # aimz*achdpr) A O agcmd1i= ttrrs*(omrz*hchdpi-aimz*achdpr)+i@ O # ttris*(-0.5d0-chdp+omrz*achdpr+- O # aimz*hchdpi) > O agcmd2r= ttrrs*(-0.5d0-chd+omrz*achdr+? O # aimz*hchdi)-ttris*(omrz*hchdi-d, O # aimz*achdr)? O agcmd2i= ttrrs*(omrz*hchdi-aimz*achdr)+3> O # ttris*(-0.5d0-chd+omrz*achdr+, O # aimz*hchdi)@ O agcmu3r= ttrrs*(-0.5d0+chup+omrz*achupr-B O # aimz*hchupi)-ttris*(-omrz*hchupi-- O # aimz*achupr)+B O agcmu3i= ttrrs*(-omrz*hchupi-aimz*achupr)+@ O # ttris*(-0.5d0+chup+omrz*achupr-- O # aimz*hchupi)+> O agcmu4r= ttrrs*(-0.5d0+chu+omrz*achur-@ O # aimz*hchui)-ttris*(-omrz*hchui-, O # aimz*achur)@ O agcmu4i= ttrrs*(-omrz*hchui-aimz*achur)+> O # ttris*(-0.5d0+chu+omrz*achur-, O # aimz*hchui) O * A O gcmd1r= (agcmd1r*grs-agcmd1i*gis)/2.d0/g2.A O gcmd1i= (agcmd1r*gis+agcmd1i*grs)/2.d0/g2cA O gcmd2r= (agcmd2r*grs-agcmd2i*gis)/2.d0/g2yA O gcmd2i= (agcmd2r*gis+agcmd2i*grs)/2.d0/g2 A O gcmu3r= (agcmu3r*grs-agcmu3i*gis)/2.d0/g2 A O gcmu3i= (agcmu3r*gis+agcmu3i*grs)/2.d0/g22A O gcmu4r= (agcmu4r*grs-agcmu4i*gis)/2.d0/g23A O gcmu4i= (agcmu4r*gis+agcmu4i*grs)/2.d0/g20 O *0/ O adpp1br= gcmd1r*dpp1brc01 O adpp1bre= -gcmd1i*dpp1bicx0 O adpp1bie= gcmd1r*dpp1bic/ O adpp1bi= gcmd1i*dpp1brc 0 O adpp2br= -gcmd2r*dpp2brc0 O adpp2bre= gcmd2i*dpp2bic1 O adpp2bie= -gcmd2r*dpp2bicx0 O adpp2bi= -gcmd2i*dpp2brc/ O adpp3br= gcmu3r*dpp3brc 1 O adpp3bre= -gcmu3i*dpp3bicg0 O adpp3bie= gcmu3r*dpp3bic/ O adpp3bi= gcmu3i*dpp3brc20 O adpp4br= -gcmu4r*dpp4brc0 O adpp4bre= gcmu4i*dpp4bic1 O adpp4bie= -gcmu4r*dpp4bici0 O adpp4bi= -gcmu4i*dpp4brc> O dpp1br= (adpp1br*flmr-adpp1bi*flmi)/g2> O dpp1bi= (adpp1bi*flmr+adpp1br*flmi)/g2A O dpp1bre= (adpp1bre*flmr-adpp1bie*flmi)/g24A O dpp1bie= (adpp1bre*flmi+adpp1bie*flmr)/g2 > O dpp3br= (adpp3br*flmr-adpp3bi*flmi)/g2> O dpp3bi= (adpp3bi*flmr+adpp3br*flmi)/g2A O dpp3bre= (adpp3bre*flmr-adpp3bie*flmi)/g2 A O dpp3bie= (adpp3bre*flmi+adpp3bie*flmr)/g2 > O dpp2br= (adpp2br*flpr-adpp2bi*flpi)/g2> O dpp2bi= (adpp2bi*flpr+adpp2br*flpi)/g2A O dpp2bre= (adpp2bre*flpr-adpp2bie*flpi)/g2 O A O dpp2bie= (adpp2bre*flpi+adpp2bie*flpr)/g2x> O dpp4br= (adpp4br*flpr-adpp4bi*flpi)/g2> O dpp4bi= (adpp4bi*flpr+adpp4br*flpi)/g2A O dpp4bre= (adpp4bre*flpr-adpp4bie*flpi)/g2pA O dpp4bie= (adpp4bre*flpi+adpp4bie*flpr)/g29 O else E O gcmd1= tth2*(-0.25d0-0.5d0*chdp+omrz*(0.25d0+p2 O # chdp*hsth2)) D O gcmd2= tth2*(-0.25d0-0.5d0*chd+omrz*(0.25d0+1 O # chd*hsth2)) pE O gcmu3= tth2*(-0.25d0+0.5d0*chup+omrz*(0.25d0- 2 O # chup*hsth2)) D O gcmu4= tth2*(-0.25d0+0.5d0*chu+omrz*(0.25d0-1 O # chu*hsth2)) 12 O hcmd1= -tsth2*(1.d0+hchdp)1 O hcmd2= -tsth2*(1.d0+hchd)21 O hcmu3= tsth2*(1.d0-hchup))0 O hcmu4= tsth2*(1.d0-hchu) O *6- O dpp1br= gcmd1*dpp1brc4C O dpp1bre= -hcmd1*haimz*dpp1bic *. O dpp1bie= gcmd1*dpp1bicA O dpp1bi= hcmd1*haimz*dpp1brc #. O dpp2br= -gcmd2*dpp2brcB O dpp2bre= hcmd2*haimz*dpp2bic / O dpp2bie= -gcmd2*dpp2bicgB O dpp2bi= -hcmd2*haimz*dpp2brc - O dpp3br= gcmu3*dpp3brc*C O dpp3bre= -hcmu3*haimz*dpp3bic *. O dpp3bie= gcmu3*dpp3bicA O dpp3bi= hcmu3*haimz*dpp3brc g. O dpp4br= -gcmu4*dpp4brcB O dpp4bre= hcmu4*haimz*dpp4bic / O dpp4bie= -gcmu4*dpp4bic B O dpp4bi= -hcmu4*haimz*dpp4brc  O endif O * < O *-----compensating the missing W and the fermion propagators O *3> O d11br= (dpp1br*wpcfr-dpp1bi*wpcfi)/pfp+> O # (dpp2br*wmcfr-dpp2bi*wmcfi)/pfb+? O # (dpp3br*wpcfr-dpp3bi*wpcfi)/pfpb+ < O # (dpp4br*wmcfr-dpp4bi*wmcfi)/pfA O d11bre= (dpp1bre*wpcfr-dpp1bie*wpcfi)/pfp+8A O # (dpp2bre*wmcfr-dpp2bie*wmcfi)/pfb+ B O # (dpp3bre*wpcfr-dpp3bie*wpcfi)/pfpb+? O # (dpp4bre*wmcfr-dpp4bie*wmcfi)/pf*> O d11bi= (dpp1br*wpcfi+dpp1bi*wpcfr)/pfp+> O # (dpp2br*wmcfi+dpp2bi*wmcfr)/pfb+? O # (dpp3br*wpcfi+dpp3bi*wpcfr)/pfpb+b< O # (dpp4br*wmcfi+dpp4bi*wmcfr)/pfA O d11bie= (dpp1bre*wpcfi+dpp1bie*wpcfr)/pfp+bA O # (dpp2bre*wmcfi+dpp2bie*wmcfr)/pfb+ B O # (dpp3bre*wpcfi+dpp3bie*wpcfr)/pfpb+? O # (dpp4bre*wmcfi+dpp4bie*wmcfr)/pf O  O endif) O * O 5 O dbs= (dabr-d11br)*(dabr-d11br)+v9 O # (dabre-d11bre)*(dabre-d11bre)+b9 O # (dabie-d11bie)*(dabie-d11bie)+ O 4 O # (dabi-d11bi)*(dabi-d11bi)3 O dbs0= (dabr*dabr+dabre*dabre+53 O # dabie*dabie+dabi*dabi)x, O if(opeaka.eq.'y') then' O dbs= x23*x23*dbsb) O dbs0= x23*x23*dbs05 O endifs< O dbs= dbs+coulf*(dabr*dabr+dabre*dabre+1 O # dabie*dabie+dabi*dabi)-8 O if(oqcd.eq.'y'.and.iqcd.eq.0) then: O dbs= dbs+qcdjac*dbs0*(1.d0+coulf) O endif( O *2. O if(otype.ne.'cc20') then" O des= 0.d03 O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O m= eteipmm+s6*gv38*(-8*x34) ( O eteipmm= eteipmm+s7*gv41*(-16*p54)& O eteipmm= eteipmm+s8*gv38*(8*x25)( O eteipmm= eteipmm+s10*gv41*(16*p50)( O eteipmm= eteipmm+s11*gv38*(16*x46)( O eteipmm= eteipmm+s12*gv38*(-8*x15)) O eteipmm= eteipmm+s14*gv38*(-16*x34) # O eteipmm= eteipmm+s15*gv38*(8)  O *  O eteipp= s2*gv39*(2*x56) $ O eteipp= eteipp+s3*gv39*(2*x56)$ O eteipp= eteipp+s4*gv40*(4*x56)$ O eteipp= eteipp+s6*gv39*(2*x35)+ O eteipp= eteipp+s6*gv41*(-2*p67+2*p71)0 O eteipp= eteipp+s6*gv44*(4)% O eteipp= eteipp+s7*gv41*(-4*p55) % O eteipp= eteipp+s9*gv39*(-6*x25) * O eteipp= eteipp+s9*gv41*(2*p48-2*p54)% O eteipp= eteipp+s10*gv40*(4*x25)a% O eteipp= eteipp+s10*gv41*(4*p51)#& O eteipp= eteipp+s11*gv38*(-2*x56)& O eteipp= eteipp+s12*gv38*(-2*x56)% O eteipp= eteipp+s13*gv38*(2*x46) & O eteipp= eteipp+s13*gv39*(-2*x16)% O eteipp= eteipp+s14*gv38*(2*x35) , O eteipp= eteipp+s14*gv41*(-2*p11+2*p34)" O eteipp= eteipp+s14*gv43*(-4)% O eteipp= eteipp+s15*gv38*(2*x25)a+ O eteipp= eteipp+s15*gv41*(2*x56-2*p31)  O *  O eteimm= s2*gv38*(2*x46) % O eteimm= eteimm+s2*gv39*(-2*x46)z% O eteimm= eteimm+s2*gv41*(-2*p22) $ O eteimm= eteimm+s3*gv39*(2*x45)! O eteimm= eteimm+s3*gv42*(-2) ! O eteimm= eteimm+s4*gv43*(-8) $ O eteimm= eteimm+s6*gv38*(2*x34)% O eteimm= eteimm+s6*gv39*(-2*x34) % O eteimm= eteimm+s6*gv41*(-2*p18) * O eteimm= eteimm+s7*gv41*(4*p31-4*p54)% O eteimm= eteimm+s8*gv38*(-4*x25)s% O eteimm= eteimm+s8*gv39*(-4*x25) % O eteimm= eteimm+s9*gv38*(-2*x24)u$ O eteimm= eteimm+s9*gv39*(2*x24)$ O eteimm= eteimm+s9*gv41*(6*p15)+ O eteimm= eteimm+s10*gv41*(-4*p4+4*p50)c& O eteimm= eteimm+s11*gv38*(-2*x16)% O eteimm= eteimm+s11*gv39*(2*x16) & O eteimm= eteimm+s11*gv41*(-2*p22)% O eteimm= eteimm+s12*gv38*(2*x15)o" O eteimm= eteimm+s12*gv42*(-2)& O eteimm= eteimm+s13*gv38*(-2*x14)& O eteimm= eteimm+s13*gv39*(-2*x14)% O eteimm= eteimm+s14*gv38*(2*x13) & O eteimm= eteimm+s14*gv39*(-2*x13)% O eteimm= eteimm+s14*gv41*(2*p18)i" O eteimm= eteimm+s15*gv38*(-2)! O eteimm= eteimm+s15*gv39*(2)a% O eteimm= eteimm+s15*gv41*(2*p15)  O *  O if(ofl.eq.'c') thend< O dfevr= -(ecv4er*eter4+(ecv1er-ecv2er+ecv3er)*eterpmp+. O # (ecv1er+ecv2er-ecv3er)*eterppm+> O # (ecv1er-ecv2er-ecv3er)*eterpmm+(ecv5er+ecv6er)*7 O # eterpp+(ecv5er-ecv6er)*etermm)/32.d0/pis3= O dfevie= -(ecv4er*etei4+(ecv1er-ecv2er+ecv3er)*eteipmp+0/ O # (ecv1er+ecv2er-ecv3er)*eteippm+*? O # (ecv1er-ecv2er-ecv3er)*eteipmm+(ecv5er+ecv6er)* 8 O # eteipp+(ecv5er-ecv6er)*eteimm)/32.d0/pis< O dfevi= -(ecv4ei*eter4+(ecv1ei-ecv2ei+ecv3ei)*eterpmp+. O # (ecv1ei+ecv2ei-ecv3ei)*eterppm+> O # (ecv1ei-ecv2ei-ecv3ei)*eterpmm+(ecv5ei+ecv6ei)*7 O # eterpp+(ecv5ei-ecv6ei)*etermm)/32.d0/pisd< O dfevre= (ecv4ei*etei4+(ecv1ei-ecv2ei+ecv3ei)*eteipmp+. O # (ecv1ei+ecv2ei-ecv3ei)*eteippm+> O # (ecv1ei-ecv2ei-ecv3ei)*eteipmm+(ecv5ei+ecv6ei)*7 O # eteipp+(ecv5ei-ecv6ei)*eteimm)/32.d0/pis  O else if(ofl.eq.'a') then; O dfevr= (ecv4er*eter4+(ecv1er-ecv2er+ecv3er)*eterpmp+ - O # (ecv1er+ecv2er-ecv3er)*eterppm+ = O # (ecv1er-ecv2er-ecv3er)*eterpmm+(ecv5er+ecv6er)*p1 O # eterpp+(ecv5er-ecv6er)*etermm)*4.d0 < O dfevie= (ecv4er*etei4+(ecv1er-ecv2er+ecv3er)*eteipmp+. O # (ecv1er+ecv2er-ecv3er)*eteippm+> O # (ecv1er-ecv2er-ecv3er)*eteipmm+(ecv5er+ecv6er)*2 O # eteipp+(ecv5er-ecv6er)*eteimm)*4.d0; O dfevi= (ecv4ei*eter4+(ecv1ei-ecv2ei+ecv3ei)*eterpmp+3- O # (ecv1ei+ecv2ei-ecv3ei)*eterppm+ = O # (ecv1ei-ecv2ei-ecv3ei)*eterpmm+(ecv5ei+ecv6ei)* 1 O # eterpp+(ecv5ei-ecv6ei)*etermm)*4.d0 = O dfevre= -(ecv4ei*etei4+(ecv1ei-ecv2ei+ecv3ei)*eteipmp+ / O # (ecv1ei+ecv2ei-ecv3ei)*eteippm+b? O # (ecv1ei-ecv2ei-ecv3ei)*eteipmm+(ecv5ei+ecv6ei)*b3 O # eteipp+(ecv5ei-ecv6ei)*eteimm)*4.d0b O endifb O *f O endif O * * O if(ofl.eq.'y') thenN O dfegirc= E O # gi16*(x56i*c4*p49*p71+c1*(-2.d0*p51* F O # x46+u28-u29+2.d0*u33)+(-u28+u29)*(c2+8 O # c3)-0.5d0*c4*(u28+u29))) O dfegirc= dfegirc+ 8 O # gi17*w1*(cpmm-0.5d0*c4)) O dfegirc= dfegirc+ E O # gi18*((c1-c2)*(w2-2.d0*u17)+c3*(-w2-uD O # 2.d0*u17)+0.5d0*c4*(-w2+p67-p71+u5-C O # u13-2.d0*u14+u16+u18-u26-u44+u45))0) O dfegirc= dfegirc+ E O # gi19*(cpmm-0.5d0*c4)*(p4*p48-p5*x46-*E O # p13*p55+p15*p57-p31*p46+p32*x34+p51* ) O # x46-u33))) O dfegirc= dfegirc+0; O # gi20*c4*(x56i*p49*x35-p36) ) O dfegirc= dfegirc+*F O # gi21*(x56i*c4*x46*(p49-p51-p52)+c1*(-G O # p45+2.d0*(p46+p48))+c2*(p45-2.d0*(p46+ E O # p54))+c3*(p45-2.d0*(p46-p54))+0.5d0*r6 O # c4*(p42+p45+p47-p56))) O dfegirc= dfegirc+ D O # gi22*(x56i*c4*(p31*x26+p32-p34*x26-F O # u27)+(c1-c2)*(-x25+2.d0*p4+2.d0*p31)+F O # c3*(x25-2.d0*p4+2.d0*p31)+0.5d0*c4*(-1 O # x25-x36+p7+p29))*) O dfegirc= dfegirc+ D O # gi23*(x56i*c4*(x25s+2.d0*(p49-p51)-F O # p52-p57)+2.d0*c1*(-x23+x25-x26)+2.d0*E O # c2*(x23-2.d0*x25)+2.d0*c3*(x23+2.d0* O - O # x25)+c4*x23)  O *- O dfegiic=F O # 4.d0*(p54*s2*gi19-x25*s4*gi18+p50*s6*E O # gi19+2.d0*x25*s7*gi18-x25s*s8*gi19)*i% O # cpmm ) O dfegiic= dfegiic+ D O # 2.d0*s10*gi18*(x56i*c4*(x25s+2.d0*(H O # p49-p51)-p52-p57)+4.d0*x25*cpmp+c4*x23)) O dfegiic= dfegiic+pD O # 2.d0*s10*gi19*c4*(x56i*p49*x35-p36)) O dfegiic= dfegiic-*3 O # 8.d0*s11*gi21*cpmmi) O dfegiic= dfegiic+ 7 O # 4.d0*x25*s12*gi16*cpmm ) O dfegiic= dfegiic+pF O # 2.d0*s13*c4*x56i*(-gi16*p54-gi17*p31-F O # 2.d0*gi20*x25-gi21*x46-gi22*x16-2.d0*& O # gi23)) O dfegiic= dfegiic+ @ O # 2.d0*s13*c4*(gi18*x14+gi19*p15)) O dfegiic= dfegiic-i1 O # 8.d0*s14*gi21*c1 ) O dfegiic= dfegiic+1G O # 4.d0*x25*s15*(-2.d0*gi16*c1+gi19*cpmm)#= O else if(ofl.eq.'n'.or.ofl.eq.'e') then % O dfegirc= 0.d0b% O dfegiic= 0.d0a O endif O * 9 O db1er= -3.125d-2/pfb*cob1e*db1erc 9 O db1eie= -3.125d-2/pfb*cob1e*db1eic** O if(ofl.eq.'c') then? O db3er= x23*ver23/128.d0/ctr23/pn*pp23r*s% O # db3erc @ O db3eie= x23*ver23/128.d0/ctr23/pn*pp23r*& O # db3eic O else+A O db3er= x23*ver/128.d0/cth2/pn/x23z*db3erc B O db3eie= x23*ver/128.d0/cth2/pn/x23z*db3eic O endif( O dber= db1er+db3er+ O dbeie= db1eie+db3eiem" O dbere= 0.d0! O dbei= 0.d0x* O if(ofl.eq.'c') then@ O dm1er= 3.125d-2*pp14r/pm23*com1e*dm1erc@ O dm1eie= 3.125d-2*pp14r/pm23*com1e*dm1eic@ O dm2er= 3.125d-2*pp14r/pm24*com2e*dm2erc@ O dm2eie= 3.125d-2*pp14r/pm24*com2e*dm2eic# O dm1ei= 0.d0 $ O dm1ere= 0.d0# O dm2ei= 0.d0 $ O dm2ere= 0.d0 O else + O if(oww.eq.'r') then#@ O dm1er= 3.125d-2/pp14/pm23*com1e*dm1erc@ O dm1eie= 3.125d-2/pp14/pm23*com1e*dm1eic@ O dm2er= 3.125d-2/pp14/pm24*com2e*dm2erc@ O dm2eie= 3.125d-2/pp14/pm24*com2e*dm2eic$ O dm1ei= 0.d0% O dm1ere= 0.d0s$ O dm2ei= 0.d0% O dm2ere= 0.d0#> O else if(oww.eq.'f'.or.oww.eq.'i') thenA O dm1er= 3.125d-2*pp14r/pm23*com1e*dm1erc A O dm1eie= 3.125d-2*pp14r/pm23*com1e*dm1eicrA O dm2er= 3.125d-2*pp14r/pm24*com2e*dm2erc3A O dm2eie= 3.125d-2*pp14r/pm24*com2e*dm2eicgA O dm1ei= 3.125d-2*pp14i/pm23*com1e*dm1erc O B O dm1ere= -3.125d-2*pp14i/pm23*com1e*dm1eicA O dm2ei= 3.125d-2*pp14i/pm24*com2e*dm2erc B O dm2ere= -3.125d-2*pp14i/pm24*com2e*dm2eic O endif+ O endif( O dmer= dm1er+dm2er+ O dmeie= dm1eie+dm2eien( O dmei= dm1ei+dm2ei+ O dmere= dm1ere+dm2ere * O if(ofl.eq.'c') then< O dfer= 1.25d-1*(pp14rb*cofce*dferc-5 O # 0.5d0*g2*pp14r*dfevr) = O dfeie= 1.25d-1*(pp14rb*cofce*dfeic- 6 O # 0.5d0*g2*pp14r*dfevie)9 O dfere= -6.25d-2*pp14r*g2*dfevre37 O dfei= -6.25d-2*pp14r*g2*dfevi / O else if(ofl.eq.'a') then + O if(oww.eq.'r') then < O dfer= 1.25d-1/pp14*(cofce*dferc-. O # 0.5d0*dfevr)< O dfeie= 1.25d-1/pp14*(cofce*dfeic-/ O # 0.5d0*dfevie) 6 O dfere= -6.25d-2/pp14*dfevre4 O dfei= -6.25d-2/pp14*dfevi> O else if(oww.eq.'f'.or.oww.eq.'i') then< O dfer= 1.25d-1*pp14r*(cofce*dferc-. O # 0.5d0*dfevr)= O dfeie= 1.25d-1*pp14r*(cofce*dfeic- / O # 0.5d0*dfevie)#= O dfere= -1.25d-1*pp14i*cofce*dfeic-#6 O # 6.25d-2*pp14r*dfevre; O dfei= 1.25d-1*pp14i*cofce*dferc-*4 O # 6.25d-2*pp14r*dfevi O endif  O else*+ O if(oww.eq.'r') then2: O dfer= 1.25d-1/pp14*cofce*dferc: O dfeie= 1.25d-1/pp14*cofce*dfeic> O else if(oww.eq.'f'.or.oww.eq.'i') then; O dfer= 1.25d-1*pp14r*cofce*dferc*; O dfeie= 1.25d-1*pp14r*cofce*dfeicn O endif  O endif* O if(ofl.eq.'y') thenA O dfei= 6.25d-2/pp14*cofce*gifact*dfegirc C O dfere= -6.25d-2/pp14*cofce*gifact*dfegiic / O else if(ofl.eq.'e') then 1 O gfct= swg*x56/(x56+x14) = O dfei= 1.25d-1/pp14*cofce*gfct*dfercr? O dfere= -1.25d-1/pp14*cofce*gfct*dfeic / O else if(ofl.eq.'n') then#; O if(oww.eq.'f'.or.oww.eq.'i') then*= O dfei= 1.25d-1*pp14i*cofce*dferc O > O dfere= -1.25d-1*pp14i*cofce*dfeic O else' O dfei= 0.d0 ( O dfere= 0.d0 O endif# O endif O *7) O d20esrr= dber+dfer , O d20esrie= dbeie+dfeie) O d20esri= dbei+dfei4, O d20esrre= dbere+dfere* O if(ofl.eq.'c') then> O d20er= (d20esrr*flpr-d20esri*flpi)/g2+4 O # wpcfr*dmer-wpcfi*dmeiA O d20ere= (d20esrre*flpr-d20esrie*flpi)/g2- O 7 O # wpcfi*dmeie+wpcfr*dmere A O d20eie= (d20esrre*flpi+d20esrie*flpr)/g2+u7 O # wpcfr*dmeie+wpcfi*dmere4> O d20ei= (d20esri*flpr+d20esrr*flpi)/g2+5 O # wpcfi*dmer+wpcfr*dmei O  O else2< O d20er= d20esrr+wpcfr*dmer-wpcfi*dmei@ O d20ere= d20esrre-wpcfi*dmeie+wpcfr*dmere@ O d20eie= d20esrie+wpcfr*dmeie+wpcfi*dmere= O d20ei= d20esri+wpcfi*dmer+wpcfr*dmei O  O endif O *76 O cd20er= wmcfr*d20er-wmcfi*d20ei9 O cd20ere= wmcfr*d20ere-wmcfi*d20eie 9 O cd20eie= wmcfr*d20eie+wmcfi*d20eret6 O cd20ei= wmcfr*d20ei+wmcfi*d20er O *2: O des= cd20er*cd20er+cd20ere*cd20ere+9 O # cd20eie*cd20eie+cd20ei*cd20ei2> O if(opeaka.eq.'n'.or.opeaka.eq.'f') then( O des= des/x23/x23 O endif O endif4 O **% O 4 if(iz.eq.0) then1/ O dpxs(ix,it,itt,1)= 0.d0 / O dpxs(ix,it,itt,2)= 0.d0 / O dpxs(ix,it,itt,3)= 0.d02 O iz= 14 O isz= 0 O else  O isz= 1: O tjac= ujc*vjc*smjc*spjc*sujc*sdjc*7 O # sfjc*twjc*t1jc*vv*ajc*fov*: O if(oqcd.eq.'y'.and.iqcd.gt.0) thenF O tjacp= tjac*pmjac*ppjac*(1.d0+qcdjac)*stf/s O else8 O tjacp= tjac*pmjac*ppjac*stf/s O endif-, O if(ockm.eq.'y') then6 O if(ipr.eq.2.or.ipr.eq.5) then- O if(ickm.eq.1) then > O tjacp= tjacp*vckm(1,1)*vckm(1,1)2 O else if(ickm.eq.2) then> O tjacp= tjacp*vckm(1,2)*vckm(1,2)2 O else if(ickm.eq.3) then> O tjacp= tjacp*vckm(1,3)*vckm(1,3)2 O else if(ickm.eq.4) then> O tjacp= tjacp*vckm(2,1)*vckm(2,1)2 O else if(ickm.eq.5) then> O tjacp= tjacp*vckm(2,2)*vckm(2,2)2 O else if(ickm.eq.6) then> O tjacp= tjacp*vckm(2,3)*vckm(2,3) O endif/ O else if(ipr.eq.3) then - O if(ickm.eq.1) then ? O tjacp= tjacp*vckm(1,1)*vckm(1,1)*08 O # vckm(2,2)*vckm(2,2)2 O else if(ickm.eq.2) then? O tjacp= tjacp*vckm(1,1)*vckm(1,1)*48 O # vckm(2,1)*vckm(2,1)2 O else if(ickm.eq.3) then? O tjacp= tjacp*vckm(1,1)*vckm(1,1)*t8 O # vckm(2,3)*vckm(2,3)2 O else if(ickm.eq.4) then? O tjacp= tjacp*vckm(1,2)*vckm(1,2)*e8 O # vckm(2,2)*vckm(2,2)2 O else if(ickm.eq.5) then? O tjacp= tjacp*vckm(1,2)*vckm(1,2)*58 O # vckm(2,1)*vckm(2,1)2 O else if(ickm.eq.6) then? O tjacp= tjacp*vckm(1,2)*vckm(1,2)*t8 O # vckm(2,3)*vckm(2,3)2 O else if(ickm.eq.7) then? O tjacp= tjacp*vckm(1,3)*vckm(1,3)*48 O # vckm(2,2)*vckm(2,2)2 O else if(ickm.eq.8) then? O tjacp= tjacp*vckm(1,3)*vckm(1,3)* 8 O # vckm(2,1)*vckm(2,1)2 O else if(ickm.eq.9) then? O tjacp= tjacp*vckm(1,3)*vckm(1,3)*i8 O # vckm(2,3)*vckm(2,3)3 O else if(ickm.eq.10) thent? O tjacp= tjacp*vckm(1,1)*vckm(1,1)*48 O # vckm(1,2)*vckm(1,2)3 O else if(ickm.eq.11) then)? O tjacp= tjacp*vckm(1,1)*vckm(1,1)**8 O # vckm(1,3)*vckm(1,3)3 O else if(ickm.eq.12) thenm? O tjacp= tjacp*vckm(1,2)*vckm(1,2)*u8 O # vckm(1,3)*vckm(1,3)3 O else if(ickm.eq.13) then*? O tjacp= tjacp*vckm(2,1)*vckm(2,1)* 8 O # vckm(2,2)*vckm(2,2)3 O else if(ickm.eq.14) then ? O tjacp= tjacp*vckm(2,1)*vckm(2,1)*18 O # vckm(2,3)*vckm(2,3)3 O else if(ickm.eq.15) then3? O tjacp= tjacp*vckm(2,2)*vckm(2,2)* 8 O # vckm(2,3)*vckm(2,3) O endif O endif O endife4 O dpxs(ix,it,itt,1)= tjacp*das4 O dpxs(ix,it,itt,2)= tjacp*dbs0 O if(otype.eq.'cc20') then7 O dpxs(ix,it,itt,3)= tjacp*dese O else2 O dpxs(ix,it,itt,3)= 0.d0 O endif  O endif O *e+ O *-----Final state QED radiation is includedp O *c0 O if(isz.eq.1.and.ofsr.eq.'y') then$ O efsr1(ix,it)= edn1$ O efsr2(ix,it)= edn2$ O efsr3(ix,it)= edn3$ O efsr4(ix,it)= edn4 O elsee$ O efsr1(ix,it)= 0.d0$ O efsr2(ix,it)= 0.d0$ O efsr3(ix,it)= 0.d0$ O efsr4(ix,it)= 0.d0 O endif O *e. O if(isz.eq.1.and.ofsr.eq.'y') then! O if(ipr.eq.1) then22 O xv1= 2.d0*ae(1)/rs/efsr1(ix,it) O xv2= 0.d0 O xv3= 0.d02 O xv4= 2.d0*ae(4)/rs/efsr4(ix,it)& O else if(ipr.eq.2) then2 O xv1= 2.d0*ae(1)/rs/efsr1(ix,it) O xv2= 0.d02 O xv3= 2.d0*ae(3)/rs/efsr3(ix,it)2 O xv4= 2.d0*ae(4)/rs/efsr4(ix,it)& O else if(ipr.eq.3) then2 O xv1= 2.d0*ae(1)/rs/efsr1(ix,it)2 O xv2= 2.d0*ae(2)/rs/efsr2(ix,it)2 O xv3= 2.d0*ae(3)/rs/efsr3(ix,it)2 O xv4= 2.d0*ae(4)/rs/efsr4(ix,it) O endife1 O if(xv1.ge.1.d0.or.xv2.ge.1.d0.or.43 O # xv3.ge.1.d0.or.xv4.ge.1.d0) thenv# O fsr(ix,it)= 1.d0e O else' O rcom= delc*pi/180.d0e$ O if(ipr.eq.1) then6 O rmu= 0.5d0*rcom*efsr1(ix,it)/rmm6 O rtau= 0.5d0*rcom*efsr4(ix,it)/tm, O rmu0= efsr1(ix,it)/rmm, O rtau0= efsr4(ix,it)/tm) O else if(ipr.eq.2) then 6 O rmu= 0.5d0*rcom*efsr1(ix,it)/rmm6 O ruq= 0.5d0*rcom*efsr3(ix,it)/uqm6 O rdq= 0.5d0*rcom*efsr4(ix,it)/dqm, O rmu0= efsr1(ix,it)/rmm, O ruq0= efsr3(ix,it)/uqm, O rdq0= efsr4(ix,it)/dqm) O else if(ipr.eq.3) then 6 O ruq= 0.5d0*rcom*efsr1(ix,it)/uqm6 O rdq= 0.5d0*rcom*efsr2(ix,it)/dqm6 O rsq= 0.5d0*rcom*efsr3(ix,it)/sqm6 O rcq= 0.5d0*rcom*efsr4(ix,it)/cqm, O ruq0= efsr1(ix,it)/uqm, O rdq0= efsr2(ix,it)/dqm, O rsq0= efsr3(ix,it)/sqm, O rcq0= efsr4(ix,it)/cqm O endif$ O if(ipr.eq.1) then% O omxv1= 1.d0-xv1x% O omxv4= 1.d0-xv4r, O rsp1= wtorfsr(xv1,rmu)- O rsp4= wtorfsr(xv4,rtau) ' O rlno1= log(omxv1)8' O rlno4= log(omxv4) $ O rln1= log(xv1)$ O rln4= log(xv4)5 O aln1= log(1.d0+rmu*rmu*xv1*xv1) 7 O aln4= log(1.d0+rtau*rtau*xv4*xv4)2# O rmus= rmu*rmu & O ormus= 1.d0+rmus# O rxmu= rmu*xv1 & O rtaus= rtau*rtau( O ortaus= 1.d0+rtaus% O rxtau= rtau*xv4 > O fsrmu= -rlno1*(aln1-rmus/ormus)+(0.25d0*; O # (ormus*ormus-2.d0)/rmus/ormus- ? O # (1.d0-0.5d0*omxv1)**2)*aln1-(2.d0+ B O # rmus)/rmu/ormus*atan(rxmu)+9.d0/4.d0-D O # 5.d0/2.d0*omxv1+0.25d0*omxv1*omxv1+rsp1A O fsrtau= -rlno4*(aln4-rtaus/ortaus)+(0.25d0*8@ O # (ortaus*ortaus-2.d0)/rtaus/ortaus-@ O # (1.d0-0.5d0*omxv4)**2)*aln4-(2.d0+B O # rtaus)/rtau/ortaus*atan(rxtau)+9.d0/@ O # 4.d0-5.d0/2.d0*omxv4+0.25d0*omxv4*( O # omxv4+rsp49 O soft= -rlno1*(1.d0-2.d0*log(rmu0))- 8 O # rlno4*(1.d0-2.d0*log(rtau0))( O hard= fsrmu+fsrtauD O fsr(ix,it)= exp(alpha/pi*soft)*(1.d0+alpha/pi*# O # hard) ) O else if(ipr.eq.2) thenm% O omxv1= 1.d0-xv1e% O omxv3= 1.d0-xv3 % O omxv4= 1.d0-xv4 O , O rsp1= wtorfsr(xv1,rmu), O rsp3= wtorfsr(xv3,ruq), O rsp4= wtorfsr(xv4,rdq)' O rlno1= log(omxv1) ' O rlno3= log(omxv3) O ' O rlno4= log(omxv4)i$ O rln1= log(xv1)$ O rln3= log(xv3)$ O rln4= log(xv4)5 O aln1= log(1.d0+rmu*rmu*xv1*xv1)#5 O aln3= log(1.d0+ruq*ruq*xv3*xv3)e5 O aln4= log(1.d0+rdq*rdq*xv4*xv4) # O rmus= rmu*rmu & O ormus= 1.d0+rmus# O rxmu= rmu*xv1b# O ruqs= ruq*ruq1& O oruqs= 1.d0+ruqs# O rxuq= ruq*xv3 O # O rdqs= rdq*rdqr& O ordqs= 1.d0+rdqs# O rxdq= rdq*xv4 > O fsrmu= -rlno1*(aln1-rmus/ormus)+(0.25d0*; O # (ormus*ormus-2.d0)/rmus/ormus- O ? O # (1.d0-0.5d0*omxv1)**2)*aln1-(2.d0+ B O # rmus)/rmu/ormus*atan(rxmu)+9.d0/4.d0-D O # 5.d0/2.d0*omxv1+0.25d0*omxv1*omxv1+rsp1> O fsruq= -rlno3*(aln3-ruqs/oruqs)+(0.25d0*; O # (oruqs*oruqs-2.d0)/ruqs/oruqs- ? O # (1.d0-0.5d0*omxv3)**2)*aln3-(2.d0+mB O # ruqs)/ruq/oruqs*atan(rxuq)+9.d0/4.d0-D O # 5.d0/2.d0*omxv3+0.25d0*omxv3*omxv3+rsp3> O fsrdq= -rlno4*(aln4-rdqs/ordqs)+(0.25d0*; O # (ordqs*ordqs-2.d0)/rdqs/ordqs-m? O # (1.d0-0.5d0*omxv4)**2)*aln4-(2.d0+ B O # rdqs)/rdq/ordqs*atan(rxdq)+9.d0/4.d0-D O # 5.d0/2.d0*omxv4+0.25d0*omxv4*omxv4+rsp4C O soft= -rlno1*(1.d0-2.d0*log(rmu0))-4.d0/9.d0* B O # rlno3*(1.d0-2.d0*log(ruq0))-1.d0/9.d0*7 O # rlno4*(1.d0-2.d0*log(rdq0)) O A O hard= fsrmu+4.d0/9.d0*fsruq+1.d0/9.d0*fsrdq D O fsr(ix,it)= exp(alpha/pi*soft)*(1.d0+alpha/pi*$ O # hard)) O else if(ipr.eq.3) then#% O omxv1= 1.d0-xv1q% O omxv2= 1.d0-xv2 % O omxv3= 1.d0-xv3c% O omxv4= 1.d0-xv4d, O rsp1= wtorfsr(xv1,ruq), O rsp2= wtorfsr(xv2,rdq), O rsp3= wtorfsr(xv3,rsq), O rsp4= wtorfsr(xv4,rcq)' O rlno1= log(omxv1)/' O rlno2= log(omxv2) ' O rlno3= log(omxv3)e' O rlno4= log(omxv4)5$ O rln1= log(xv1)$ O rln2= log(xv2)$ O rln3= log(xv3)$ O rln4= log(xv4)5 O aln1= log(1.d0+ruq*ruq*xv1*xv1) 5 O aln2= log(1.d0+rdq*rdq*xv2*xv2) 5 O aln3= log(1.d0+rsq*rsq*xv3*xv3) 5 O aln4= log(1.d0+rcq*rcq*xv4*xv4)h# O ruqs= ruq*ruq.& O oruqs= 1.d0+ruqs# O rxuq= ruq*xv1e# O rdqs= rdq*rdq=& O ordqs= 1.d0+rdqs# O rxdq= rdq*xv2r# O rsqs= rsq*rsqf& O orsqs= 1.d0+rsqs# O rxsq= rsq*xv3r# O rcqs= rcq*rcqs& O orcqs= 1.d0+rcqs# O rxcq= rcq*xv4 > O fsruq= -rlno1*(aln1-ruqs/oruqs)+(0.25d0*; O # (oruqs*oruqs-2.d0)/ruqs/oruqs- ? O # (1.d0-0.5d0*omxv1)**2)*aln1-(2.d0+ B O # ruqs)/ruq/oruqs*atan(rxuq)+9.d0/4.d0-D O # 5.d0/2.d0*omxv1+0.25d0*omxv1*omxv1+rsp1> O fsrdq= -rlno2*(aln2-rdqs/ordqs)+(0.25d0*; O # (ordqs*ordqs-2.d0)/rdqs/ordqs-#? O # (1.d0-0.5d0*omxv2)**2)*aln2-(2.d0+ B O # rdqs)/rdq/ordqs*atan(rxdq)+9.d0/4.d0-D O # 5.d0/2.d0*omxv2+0.25d0*omxv2*omxv2+rsp2> O fsrsq= -rlno3*(aln3-rsqs/orsqs)+(0.25d0*; O # (orsqs*orsqs-2.d0)/rsqs/orsqs-d? O # (1.d0-0.5d0*omxv3)**2)*aln3-(2.d0+ B O # rsqs)/rsq/orsqs*atan(rxsq)+9.d0/4.d0-D O # 5.d0/2.d0*o