* *-----WTOXSH64--------------------------------------------------------- * real*8 function wtoxsh64(ndim,x) implicit real*8 (a-h,o-z) character*1 om,osm,ostop,oqcd,omssm character*4 otype * parameter(ninv=10,npos=512,ifmax=10000) * common/wtihl/ih common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wthiggs/hm common/wtsmod/osm common/wtim/ostop common/wtkount/ik common/wtdis/dist common/wtqcdz/alsz common/wtaqcd/oqcd common/wtbme/bfact common/wtistrf/isf common/wtsf/ix0,it0 common/wtmssmo/omssm common/wtchi/hch(36) common/wtipt/ifz(44) common/wtnf/ifl(npos) common/wticuts/iac(4) common/wtisa/isaa,isab common/wtochannel/otype common/wthx/xshmx(npos) common/wtparh/xaph(ninv) common/wttc/itc,itcc,itcn common/wtpmxh/xmxh(npos,9) common/wtstor/stry(npos,ifmax) common/wtmssmi/am,tbeta,rmu,scalm,bat,bab common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn 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/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) common/wtmssm/ams,shm,shms,bhm,bhms,sbeta,cbeta,salpha,calpha, # sbma,cbma,rshm,rshm2,rshg,rshmg,sshg,sshgs, # opsshgs,rbhm,rbhm2,rbhg,rbhmg,sbhg,sbhgs,opsbhgs, # ram,ram2,rag,ramg,sag,sags,opsags * dimension hb(4) dimension tgn(50) dimension x(ndim) dimension bt1(2),bt2(2) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension dpxs(2,2),cpxs(2),bpxs(2) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) * data ec2/-0.4999999963d0/,ec4/0.0416666418d0/, # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, # ec10/-0.0000002605d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf * *-----the order of integration is: * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1 * * m_{+/-}^2 transformed for the resonating peaks * M_0^2,m_0^2 transformed for the resonating peaks * m^2 and t_1 transformed for the jacobian peaks * s0h= rhm2/opshgs if(omssm.eq.'y') then s0sh= rshm2/opsshgs endif * do ix=1,2 do it=1,2 dpxs(ix,it)= 0.d0 enddo enddo do it=1,2 cpxs(it)= 0.d0 bpxs(it)= 0.d0 enddo * if(ndim.eq.6) then smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.8) 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(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * if(itc.eq.3) then omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) omul= dmin1(omul,omuld) endif if(uvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * if(itc.eq.3) then vvlld= (dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) vvll= dmax1(vvll,vvlld) endif * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vkf.eq.0.d0) then if(vvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vvx.eq.1.d0) then veps= 0.d0 else veps= uvl*(1.d0-vvx)**hbeti endif avkf= 1.d0 else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti avkf= 1.d0-vkf**hbet endif vv= uv-veps vjc0= 1.d0-vvll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif endif * if(vv.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif svv= sqrt(vv) vzmg= rzmg*vv vhmg= rhmg*vv vshmg= rshmg*vv vvs= vv*vv xm= uv xp= vv/uv xmop= xm/xp if(ndim.eq.7.or.ndim.eq.6) then xdf= 0.d0 else xdf= (ueps*(1.d0-ueps)-veps)/uv endif xdfs= xdf*xdf sh= vv*s * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * dsz0= 1.d0-rszm2 dsz= dsz0*dsz0+rszw2 rsz= dsz0/dsz aisz= -rszw/dsz * *-----Reduced structure functions are computed with arguments xp,xm * opxp= 1.d0+xp opxm= 1.d0+xm omxp= veps/uv omxm= ueps if(isf.eq.0) then stfp= 1.d0 stfm= 1.d0 else if(isf.gt.0) then if(omxp.eq.0) then stfp= d0gl else rcpx= 0.25d0*opxp*opxp rcpy= xp iflp= 1 rclp= s21baf(rcpx,rcpy,iflp) stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+ # feta*(-4.d0*opxp*log(omxp)+ # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp)) endif if(omxm.eq.0) then stfm= d0gl else rcmx= 0.25d0*opxm*opxm rcmy= xm iflm= 1 rclm= s21baf(rcmx,rcmy,iflm) stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ # feta*(-4.d0*opxm*log(omxm)+ # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm)) endif endif * stf= stfp*stfm * *-----if there is no upper cut on some FS IM, then the maximum is allowed * do j=1,6 if(rr(j).eq.1.d0) then rrr(j)= rr(j) else rrr(j)= rr(j)/vv endif rrl(j)= rl(j)/vv srrl(j)= srl(j)/svv enddo * *-----cuts become special near xp = xm * if(abs(xdf).gt.1.d-15) then ieq= 1 bxe= vv/(ueps*(1.d0-ueps)-veps) if(xdf.gt.0.d0) then enc= 1.d0 else if(xdf.lt.0.d0) then enc= xmop endif else ieq= 0 bxe= 1.d0 endif if(ieq.eq.0.and.xm.le.teq) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then sct12= sct120/vv sct13= sct130/vv sct14= sct140/vv sct23= sct230/vv sct24= sct240/vv sct34= sct340/vv else sct12= 0.d0 sct13= 0.d0 sct14= 0.d0 sct23= 0.d0 sct24= 0.d0 sct34= 0.d0 endif * *-----cuts on E * do j=1,4 if(ieq.eq.1) then bl(j)= 2.d0*rae(j)/xdf xbl(j)= 2.d0*rae(j)/xp else if(ieq.eq.0) then bl(j)= 2.d0*rae(j)/xm endif enddo * *-----cuts on SA * if(iac(3).ne.0) then do j=1,4 if(sgam(j).eq.1.d0) then ss(j)= 0.d0 else ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmop ss(j)= 1.d0/ss(j) endif if(cgam(j).eq.0.d0) then cs(j)= 1.d0 else cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop cs(j)= 1.d0/cs(j) endif enddo endif * *-----initialization of sm = m_-^2 * zma1= dsm zma2= vv*sct12 zmb1= usm zmb2= (svv-sdsp)*(svv-sdsp) zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) if(ieq.eq.0) then zma3= vv*(bl(1)+bl(2)-1.d0) zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))* # (1.d0-0.5d0*(bl(3)+bl(4))) zmb5= vv*(1.d0-bl(3)) zmb6= vv*(1.d0-bl(4)) else if(ieq.eq.1) then zma3= vv*(-enc+xbl(1)+xbl(2)) zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))* # (1.d0+enc-xbl(3)-xbl(4)) zmb5= vv*(enc-xbl(3)) zmb6= vv*(enc-xbl(4)) endif xzma= dmax1(zma1,zma2,zma3) xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) * *-----limits on sm from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zma= xzma zmb= xzmb else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then szma= xzma szmb= xzmb else if(ss(3).gt.ss(1)) then szmb= xzmb adsp= dsp/vv axszma= dmax1(adsp,sct34) axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/ # (ss(3)-ss(1))) szma= dmax1(axszma,xzma) else if(ss(3).lt.ss(1)) then if(ss(3).lt.0.5d0) then szma= xzma axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 szmb= dmin1(axszmb,xzmb) else iz= 0 ifz(2)= ifz(2)+1 go to 1 endif endif else szma= xzma szmb= xzmb endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zma= szma zmb= szmb else if(cs(3).gt.cs(1)) then if(cs(3).gt.0.5d0) then zma= szma axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2 zmb= dmin1(axczmb,szmb) else iz= 0 ifz(3)= ifz(3)+1 go to 1 endif else if(cs(3).lt.cs(1)) then zmb= szmb adsp= dsp/vv axczma= dmax1(adsp,sct34) axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/ # (cs(3)-cs(1))) zma= dmax1(axczma,szma) endif else zma= szma zmb= szmb endif endif if(itc.eq.3) then dzmb= (svv-dist/rs)*(svv-dist/rs) zmb= dmin1(zmb,dzmb) endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * if(ih.eq.1.or.ih.eq.3) then if(omssm.eq.'n') then rmm2= rhm2 rmmg= rhmg smgs= shgs vmmg= vhmg smg= shg s0m= s0h else if(omssm.eq.'y') then rmm2= rshm2 rmmg= rshmg smgs= sshgs vmmg= vshmg smg= sshg s0m= s0sh endif else if(ih.eq.2.or.ih.eq.4) then rmm2= rzm2 rmmg= rzmg smgs= szgs vmmg= vzmg smg= szg s0m= s0z endif zmas= zma-rmm2 zmbs= zmb-rmm2 atma= (zmas+smgs*zma)/rmmg atmb= (zmbs+smgs*zmb)/rmmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (-atmb+atma)/vmmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (-pi+atmb+atma)/vmmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (-pih+atmb+atma)/vmmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (pi-atmb-atma)/vmmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (atmb-atma)/vmmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (pih+atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (pih-atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (-pih+atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (atmb-atma)/vmmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= vmmg*zmv sm= s0m/vv*(1.d0+smg*s07aaf(atnm,iftn)) if(iftn.ne.0) print 300 if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) smjc= vv*smjc0 * 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 zpen= vv*(1.d0-bl(1)-bl(2)+sm) zmen= vv*(-1.d0+bl(3)+bl(4)+sm) zpa= dmax1(zpa,zmen) zpb= dmin1(zpb,zpen) 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)) zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) endif zpap= vv*sct34 zpa= dmax1(zpa,zpap) * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * if(itc.eq.3) then bdistl= dist*dist/s-zpa bdistu= zpb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif endif * if(ih.eq.2.or.ih.eq.4) then if(omssm.eq.'n') then rpm2= rhm2 rpmg= rhmg spgs= shgs vpmg= vhmg spg= shg s0p= s0h else if(omssm.eq.'y') then rpm2= rshm2 rpmg= rshmg spgs= sshgs vpmg= vshmg spg= sshg s0p= s0sh endif else if(ih.eq.1.or.ih.eq.3) then rpm2= rzm2 rpmg= rzmg spgs= szgs vpmg= vzmg spg= szg s0p= s0z endif if(itc.eq.3) then sp= (dist/rs/svv)**2 spjc= 2.d0*dist/s/((vv*sp-rpm2)**2+ # (vv*sp*spg)**2) else zpas= zpa-rpm2 zpbs= zpb-rpm2 atpa= (zpas+spgs*zpa)/rpmg atpb= (zpbs+spgs*zpb)/rpmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (-atpb+atpa)/vpmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (-pi+atpb+atpa)/vpmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (-pih+atpb+atpa)/vpmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (pi-atpb-atpa)/vpmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (atpb-atpa)/vpmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (pih+atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (pih-atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (-pih+atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (atpb-atpa)/vpmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= vpmg*zpv sp= s0p/vv*(1.d0+spg*s07aaf(atnp,iftn)) if(iftn.ne.0) print 300 spjc= vv*spjc0 endif * if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spmm= sp-sm smmp= sm-sp * cbw= -1.d0+sp-sm ifcr= 0 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(bt1(2).ne.0.d0) then iz= 0 ifz(6)= ifz(6)+1 go to 1 endif * smtp= sm*sp ssmpp= ssm+ssp ssmmp= ssm-ssp asup= 1.d0-ssmpp*ssmpp asum= 1.d0-ssmmp*ssmmp if(asup.lt.0.d0.or.asum.lt.0.d0) then iz= 0 ifz(7)= ifz(7)+1 go to 1 endif rasup= sqrt(asup) rasum= sqrt(asum) * *-----initialization of su = M_0^2 * *-----limits on su from cuts on FS IM * sulim= rrl(4) suuim1= rrr(4) suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) suuim= dmin1(suuim1,suuim2) * *-----limits on su from Delta_- > 0 (as derived from consistency * on sd limits) * suud1= 0.25d0*(rasup+rasum)*(rasup+rasum) suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup) * sul= sulim sul= dmax1(sul,sct23) if(ieq.eq.0) then sul1= bl(2)+bl(3)-1.d0 suu1= 1.d0-sp-bl(1) suu2= 1.d0-sm-bl(4) suu3= (1.d0-0.5d0*(bl(1)+bl(4)))* # (1.d0-0.5d0*(bl(1)+bl(4))) else if(ieq.eq.1) then sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc suu1= enc-sp-xbl(1) suu2= enc-sm-xbl(4) suu3= (enc-0.5d0*(xbl(1)+xbl(4)))* # (enc-0.5d0*(xbl(1)+xbl(4))) endif sul= dmax1(sul,sul1) suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) * *-----test on su * if(suu.le.sul) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif * if(ih.eq.1.or.ih.eq.4) then if(omssm.eq.'n') then rum2= rhm2 rumg= rhmg sugs= shgs vumg= vhmg sug= shg s0u= s0h else if(omssm.eq.'y') then rum2= rshm2 rumg= rshmg sugs= sshgs vumg= vshmg sug= sshg s0u= s0sh endif else if(ih.eq.2.or.ih.eq.3) then rum2= rzm2 rumg= rzmg sugs= szgs vumg= vzmg sug= szg s0u= s0z endif zuas= vv*sul-rum2 zubs= vv*suu-rum2 atua= (zuas+vv*sugs*sul)/rumg atub= (zubs+vv*sugs*suu)/rumg if(atua.gt.1.d0.and.atub.gt.1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vumg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vumg sujc0= (-atub+atua)/vumg else if(atua.gt.1.d0.and.atub.lt.-1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vumg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vumg sujc0= (-pi+atub+atua)/vumg else if(atua.gt.1.d0.and.abs(atub).lt.1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vumg atub= atan(atub) zubt= atub/vumg sujc0= (-pih+atub+atua)/vumg else if(atua.lt.-1.d0.and.atub.gt.1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vumg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vumg sujc0= (pi-atub-atua)/vumg else if(atua.lt.-1.d0.and.atub.lt.-1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vumg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vumg sujc0= (atub-atua)/vumg else if(atua.lt.-1.d0.and.abs(atub).lt.1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vumg atub= atan(atub) zubt= atub/vumg sujc0= (pih+atub-atua)/vumg else if(abs(atua).lt.1.d0.and.atub.gt.1.d0) then atua= atan(atua) zuat= atua/vumg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vumg sujc0= (pih-atub-atua)/vumg else if(abs(atua).lt.1.d0.and.atub.lt.-1.d0) then atua= atan(atua) zuat= atua/vumg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vumg sujc0= (-pih+atub-atua)/vumg else if(abs(atua).lt.1.d0.and.abs(atub).lt.1.d0) then atua= atan(atua) zuat= atua/vumg atub= atan(atub) zubt= atub/vumg sujc0= (atub-atua)/vumg endif * zuv= sujc0*sux+zuat iftn= 1 atnu= vumg*zuv su= s0u/vv*(1.d0+sug*s07aaf(atnu,iftn)) if(iftn.ne.0) print 300 * sujc= vv*sujc0 if(su.lt.0.d0) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * sdlim1= rrl(3) sdlim2= 1.d0-rrr(2)-rrr(5)-sm-sp-su sdlim= dmax1(sdlim1,sdlim2) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim3= 1.d0-rrl(2)-rrl(5)-sm-sp-su sduim= dmin1(sduim1,sduim2,sduim3) * *-----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) * *-----test on sd * if(sdu.le.sdl) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * if(ih.eq.2.or.ih.eq.3) then if(omssm.eq.'n') then rdm2= rhm2 rdmg= rhmg sdgs= shgs vdmg= vhmg sdg= shg s0d= s0h else if(omssm.eq.'y') then rdm2= rshm2 rdmg= rshmg sdgs= sshgs vdmg= vshmg sdg= sshg s0d= s0sh endif else if(ih.eq.1.or.ih.eq.4) then rdm2= rzm2 rdmg= rzmg sdgs= szgs vdmg= vzmg sdg= szg s0d= s0z endif zdas= vv*sdl-rdm2 zdbs= vv*sdu-rdm2 atda= (zdas+vv*sdgs*sdl)/rdmg atdb= (zdbs+vv*sdgs*sdu)/rdmg if(atda.gt.1.d0.and.atdb.gt.1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vdmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vdmg sdjc0= (-atdb+atda)/vdmg else if(atda.gt.1.d0.and.atdb.lt.-1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vdmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vdmg sdjc0= (-pi+atdb+atda)/vdmg else if(atda.gt.1.d0.and.abs(atdb).lt.1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vdmg atdb= atan(atdb) zdbt= atdb/vdmg sdjc0= (-pih+atdb+atda)/vdmg else if(atda.lt.-1.d0.and.atdb.gt.1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vdmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vdmg sdjc0= (pi-atdb-atda)/vdmg else if(atda.lt.-1.d0.and.atdb.lt.-1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vdmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vdmg sdjc0= (atdb-atda)/vdmg else if(atda.lt.-1.d0.and.abs(atdb).lt.1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vdmg atdb= atan(atdb) zdbt= atdb/vdmg sdjc0= (pih+atdb-atda)/vdmg else if(abs(atda).lt.1.d0.and.atdb.gt.1.d0) then atda= atan(atda) zdat= atda/vdmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vdmg sdjc0= (pih-atdb-atda)/vdmg else if(abs(atda).lt.1.d0.and.atdb.lt.-1.d0) then atda= atan(atda) zdat= atda/vdmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vdmg sdjc0= (-pih+atdb-atda)/vdmg else if(abs(atda).lt.1.d0.and.abs(atdb).lt.1.d0) then atda= atan(atda) zdat= atda/vdmg atdb= atan(atdb) zdbt= atdb/vdmg sdjc0= (atdb-atda)/vdmg endif * zdv= sdjc0*sdx+zdat iftn= 1 atnd= vdmg*zdv sd= s0d/vv*(1.d0+sdg*s07aaf(atnd,iftn)) if(iftn.ne.0) print 300 sdjc= vv*sdjc0 * if(sd.lt.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif ssd= sqrt(sd) sdmu= sd-su sdmus= (1.d0+sdmu)*(1.d0+sdmu) * *-----initialization of sf = m^2 * *-----limits on sf from cuts on FS IM * sflim1= rrl(2) sfuim1= rrr(2) bsg= sm+sp+su+sd ombsg= 1.d0-bsg sflim2= ombsg-rrr(5) sfuim2= ombsg-rrl(5) sflim= dmax1(sflim1,sflim2) sfuim= dmin1(sfuim1,sfuim2) * *-----limits on sf from cuts on SA * tcuts= ss(1)-ss(2)+ss(3)-ss(4) tcutc= cs(1)-cs(2)+cs(3)-cs(4) if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfu= dmin1(sfuim,sfusa,sfusb) asfl= sflim else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa,sflsb) asfu= sfuim else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) endif else asfl= sflim asfu= sfuim endif * if(ieq.eq.0) then asfenl1= bl(1)-sm-sd asfenl2= bl(3)-sp-su asfenu1= 1.d0-bl(2)-sp-sd asfenu2= 1.d0-bl(4)-sm-su else if(ieq.eq.1) then asfenl1= 1.d0-enc-sm-sd+xbl(1) asfenl2= 1.d0-enc-sp-su+xbl(3) asfenu1= enc-sp-sd-xbl(2) asfenu2= enc-sm-su-xbl(4) endif asfl= dmax1(asfl,asfenl1,asfenl2) asfu= dmin1(asfu,asfenu1,asfenu2) aasfu= 1.d0-sm-sp-su-sd-sct24 asfl= dmax1(asfl,sct13) asfu= dmin1(asfu,aasfu) * if(iac(3).ne.0) then if(ss(4).ne.ss(3)) then if(ss(4).gt.ss(3)) then asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfl= dmax1(asfl,asfltw) else if (ss(4).lt.ss(3)) then asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfu= dmin1(asfu,asfutw) endif endif if(cs(1).ne.cs(2)) then if(cs(1).gt.cs(2)) then bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfl= dmax1(asfl,bsfltw) else if(cs(1).lt.cs(2)) then bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfu= dmin1(asfu,bsfutw) endif endif if(cs(4).ne.cs(3)) then if(cs(4).gt.cs(3)) then csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfu= dmin1(asfu,csfutw) else if(cs(4).lt.cs(3)) then csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfl= dmax1(asfl,csfltw) endif endif if(ss(1).ne.ss(2)) then if(ss(1).gt.ss(2)) then dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfu= dmin1(asfu,dsfutw) else if(ss(1).lt.ss(2)) then dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfl= dmax1(asfl,dsfltw) endif endif endif * *-----positivity of R^2 * scp= ssmpp*ssmpp scm= ssmmp*ssmmp snp= (ssu+ssd)*(ssu+ssd) snm= (ssu-ssd)*(ssu-ssd) rlp= ssu*ssd+ssp*ssm rlm= ssu*ssd-ssp*ssm bsgmo= bsg-1.d0 ombsg2= ombsg*ombsg rlps= rlp*rlp rlms= rlm*rlm edelp= ombsg2-4.d0*rlps edelm= ombsg2-4.d0*rlms edeld= 16.d0*ssu*ssd*ssp*ssm * *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2 * then Delta_+ > 0 *-----control * cnt1= scp+snm cnt2= scm+snp if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif if(edelm.le.0.d0) then etest= edeld+edelp if(etest.gt.0.d0) then edelm= etest else iz= 0 ifz(11)= ifz(11)+1 go to 1 endif endif sedm= sqrt(edelm) ifcr= 0 call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) if(rr1(2).ne.0.d0) then iz= 0 ifz(12)= ifz(12)+1 go to 1 endif ifcr= 0 call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) * cnt3= scp+snp cnt4= scm+snm cbru= -1.d0 ccru= 0.5d0*bsg * *-----R^2 has two real roots and two complex conjugate roots * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then if(bsg.gt.0.5d0) then iel= 1 sflr(1)= rr1(1) sfur(1)= rr2(1) sflr(2)= rr1(1) sfur(2)= rr2(1) else iel= 2 ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sflr(2)= ru2 sfur(1)= ru1 sfur(2)= rr2(1) endif * *-----R^2 has four real roots * else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(bsg.gt.0.5d0) then sflr(1)= rr1(1) sflr(2)= rs2(1) sfur(1)= rs1(1) sfur(2)= rr2(1) else ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sfur(1)= dmin1(rs1(1),ru1) sflr(2)= dmax1(rs2(1),ru2) sfur(2)= rr2(1) endif endif * *-----the loop for transforming sf starts here * if(om.eq.'g') then itmn= it0 itmx= it0 else itmn= 1 itmx= 2 endif do it=itmn,itmx if(sflr(it).ge.asfl) then sfl= sflr(it) else sfl= asfl endif if(sfur(it).le.asfu) then sfu= sfur(it) else sfu= asfu endif * *-----test on sf * if(sfu.le.sfl) then iz= 0 ifz(13)= ifz(13)+1 go to 2 endif * *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then er= rs1(1) es= abs(rs1(2)) er1= rr1(1) er2= rr2(1) ek2= edelm/edeld ek= sqrt(ek2) dog= -2.d0/sqrt(edeld) ecpl= (ombsg-2.d0*sfl)/sedm ecpu= (ombsg-2.d0*sfu)/sedm eql= ecpl*ecpl equ= ecpu*ecpu omecpl= 2.d0*(sfl-er1)/sedm es2pl= omecpl*(2.d0-omecpl) erl= 1.d0-ek2*es2pl espl= sqrt(es2pl) opecpu= 2.d0*(er2-sfu)/sedm es2pu= opecpu*(2.d0-opecpu) espu= sqrt(es2pu) eru= 1.d0-ek2*es2pu if(eql.eq.1) then sflt= 0.d0 else ifel= 1 sflt= -dog*espl*s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(14)= ifz(14)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 sfut= -dog*espu*s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(15)= ifz(15)+1 go to 2 endif endif if(iel.eq.1) then if(sfu.le.er) then efac= 0.5d0 sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(16)= ifz(16)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(sfl.ge.er) then efac= 0.5d0 sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(17)= ifz(17)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) else efac= 1.d0 qbar= 0.d0 rbar= 1.d0-ek2 ifel= 1 sfbar= -dog*s21bbf(qbar,rbar,one,ifel) if(ifel.ne.0) then iz= 0 ifz(18)= ifz(18)+1 go to 2 endif if(it.eq.1) then sft= (sfbar-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(19)= ifz(19)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfbar-sflt) else if(it.eq.2) then sft= (sfbar-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(20)= ifz(20)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sfbar-sfut) endif endif else if(iel.eq.2) then efac= 1.d0 if(it.eq.1) then sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(21)= ifz(21)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(it.eq.2) then sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(22)= ifz(22)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) endif endif else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(edelp.le.0.d0) then iz= 0 ifz(23)= ifz(23)+1 go to 2 endif sedp= sqrt(edelp) efac= 1.d0 es1= rs1(1) es2= rs2(1) er1= rr1(1) er2= rr2(1) ssed= sedm+sedp ek= (sedm-sedp)/ssed ek2= ek*ek dog= 2.d0/ssed if(it.eq.1) then es2pl= (er1-sfl)/(sfl-er2)/ek es2pu= (er1-sfu)/(sfu-er2)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu else if(it.eq.2) then es2pl= (sfl-es2)/(sfl-es1)/ek es2pu= (sfu-es2)/(sfu-es1)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu endif if(eql.eq.1.d0) then sflt= 0.d0 else ifel= 1 sflt= 2.d0*dog*sqrt(es2pl)* # s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(24)= ifz(24)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then equ= 0.d0 endif sfut= 2.d0*dog*sqrt(es2pu)* # s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(25)= ifz(25)+1 go to 2 endif endif sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= 0.5d0/dog*sft call s21caf(asf,ek2,elsn,elcn,edn,ifel) elsn2= elsn*elsn if(ifel.ne.0) then iz= 0 ifz(26)= ifz(26)+1 go to 2 endif if(it.eq.1) then sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2) else if(it.eq.2) then sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) endif sfjc= efac*(sfut-sflt) endif * *-----auxiliary quantities * sdpf= sd+sf e3= sp+su+sf e4= 1.d0+spmm-e3 e3p4= 1.d0+spmm e1= sm+sdpf e2= 1.d0+smmp-e1 e1p2= 1.d0+smmp e1p3= e1+e3 e1m2= 2.d0*e1-1.d0+spmm ep12= xp*e1*e2 ep1= xp*e1 ep2= xp*e2 ep3= xp*e3 ep4= xp*e4 e1t2= e1*e2 e1t3= e1*e3 e1t4= e1*e4 e2t3= e2*e3 e2t4= e2*e4 e3t4= e3*e4 if((e1p3*e1p3-4.d0*sf).lt.0.d0) then iz= 0 ifz(27)= ifz(27)+1 go to 2 endif skl2= sqrt(e1p3*e1p3-4.d0*sf) if((sdmus-4.d0*sd).lt.0.d0) then iz= 0 ifz(28)= ifz(28)+1 go to 2 endif skl3= sdmus-4.d0*sd skl3= sqrt(skl3) * *-----initialization of t_w * *-----limits on tw from positivity and SA * twlp1= 0.d0 twlp2= smmp twlp3= spmm-1.d0 twlp= dmax1(twlp1,twlp2,twlp3) twup= 1.d0 * *-----limits on tw from cuts on SA * if(iac(3).ne.0) then skl2m= 0.5d0*(e1p3-skl2) skl2p= 0.5d0*(e1p3+skl2) skl3p= -0.5d0*(1.d0+sdmu-skl3) skl3m= -0.5d0*(1.d0+sdmu+skl3) twlsa1= 1.d0-cs(3)*e3-cs(4)*e4 twlsa2= ss(1)*e1+ss(2)*e2 twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m twusa1= 1.d0-ss(3)*e3-ss(4)*e4 twusa2= cs(1)*e1+cs(2)*e2 twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4, # twlsa5,twlsa6) atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, # twusa5,twusa6) else atwl= twlp atwu= twup endif * *-----limits on tw from E * if(ieq.eq.1) then atwle= 1.d0-bxe*e3p4+bl(3)+bl(4) atwue= bxe*e1p2-bl(1)-bl(2) if(xdf.gt.0.d0) then twle= atwle twue= atwue else if(xdf.lt.0.d0) then atwle1= bxe*e1-bl(1) atwle2= bxe*e2-bl(2) atwue1= 1.d0-bxe*e3+bl(3) atwue2= 1.d0-bxe*e4+bl(4) twle= dmax1(atwue,atwle1,atwle2) twue= dmin1(atwle,atwue1,atwue2) endif atwl= dmax1(atwl,twle) atwu= dmin1(atwu,twue) endif * *-----natural limits on tw * atwl= dmax1(atwl,bt1(1)) atwu= dmin1(atwu,bt2(1)) * *-----test on tw * if(atwu.le.atwl) then iz= 0 ifz(29)= ifz(29)+1 go to 2 endif * twjc= atwu-atwl tw= twjc*twx+atwl pn= tw+sp-1.d0 omtw= 1.d0-tw * *-----initialization of t1 * *-----limits on t1 from positivity+SA * t1lp1= 0.d0 t1lp2= pn+sdpf t1up1= tw t1up2= sm+sdpf t1lp= dmax1(t1lp1,t1lp2) t1up= dmin1(t1up1,t1up2) * *-----limits on t1 from cuts on SA * if(iac(3).ne.0) then t1lc1= ss(1)*e1 t1lc2= tw-cs(2)*e2 t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3 t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 t1uc1= cs(1)*e1 t1uc2= tw-ss(2)*e2 t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3)) t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3 t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4 t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6) t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6) at1l= dmax1(t1lp,t1lc) at1u= dmin1(t1up,t1uc) else at1l= t1lp at1u= t1up endif * *-----limits on t1 from E * if(ieq.eq.1) then at1le= tw-bxe*e2+bl(2) at1ue= bxe*e1-bl(1) if(xdf.gt.0.d0) then t1le= at1le t1ue= at1ue else t1le= at1ue t1ue= at1le endif at1l= dmax1(at1l,t1le) at1u= dmin1(at1u,t1ue) endif * *-----positivity of (R')^2 / reality of roots for t3 * rp0= e1p2*e1p2-4.d0*sm if(rp0.lt.0.d0) then iz= 0 ifz(30)= ifz(30)+1 go to 2 endif srp0= sqrt(rp0) rp0e= -rp0 rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 rp1e= 2.d0*rp1 rp2= -(e1*tw-sm)*(e1*tw-sm) if(rp0e.eq.0.d0) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif ifct= 0 if(rp0e.ne.0.d0) then call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) t1l= dmax1(at1l,ret1(1)) t1u= dmin1(at1u,ret2(1)) else if(rp0e.eq.0.d0) then sret1= -rp2/rp1e if(rp1e.gt.0.d0) then t1l= dmax1(at1l,sret1) t1u= at1u else if(rp1e.lt.0.d0) then t1l= at1l t1u= dmin1(at1u,sret1) endif endif * *-----test on t1 * if(t1u.le.t1l) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif * *-----transformation for jacobian * if(rp0e.eq.0.d0) then taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2) taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) t1jc= taut-taul t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e endif if(ret1(1).eq.t1l) then at1tl= -pih/srp0 else bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) ifas= 1 at1tl= -s09aaf(bt1tl,ifas)/srp0 if(ifas.ne.0) print 200 endif if(ret2(1).eq.t1u) then at1tu= pih/srp0 else bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) ifas= 1 at1tu= -s09aaf(bt1tu,ifas)/srp0 if(ifas.ne.0) print 200 endif if((at1tl+at1tu).eq.0.d0) then if(t1x.lt.1.d-3) then arc= pi*t1x arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc else if((1.d0-t1x).lt.1.d-3) then arc= pi*(1.d0-t1x) arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc else carc= cos(pi*t1x) t1= 0.5d0*(ret1(1)+ret2(1))+ # 0.5d0*(ret1(1)-ret2(1))*carc endif t1jc= pi/srp0 else t1tl= dmin1(at1tl,at1tu) t1tu= dmax1(at1tl,at1tu) t1jc= t1tu-t1tl t1t= t1jc*t1x+t1tl t1= (rp1+rpds*sin(srp0*t1t))/rp0 endif t1s= t1*t1 * 200 format(' Unsuccesful call to S09AAF ') * *-----test on t1 from FS A * if(ieq.eq.1.and.iac(4).ne.0.d0) then cnlct1= xp*(xm*sm-ep12*cg12)+xdf* # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1- # xdf*tw)+xdfs*cg12*t1s cnlst1= xp*(ep12*sg12-xm*sm)-xdf* # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ # xdf*tw)-xdfs*sg12*t1s if(cnlct1.lt.0.d0) then iz= 0 ifz(32)= ifz(32)+1 go to 2 else if(cnlst1.lt.0.d0) then iz= 0 ifz(33)= ifz(33)+1 go to 2 endif endif * *-----some vector components * t2= tw-t1 * *-----equation for xi is solved * e1s= e1*e1 e2s= e2*e2 e3s= e3*e3 e12= e1t2-2.d0*sm e13= e1t3-2.d0*sf e23= e2t3-2.d0*su e12s= e12*e12 e13s= e13*e13 e23s= e23*e23 xia= e1s*e2s-e12s xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ # e2*e12*e13 xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13* # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 xib= 2.d0*xib if(xia.eq.0.d0) then if(xib.eq.0.d0) then iz= 0 ifz(34)= ifz(34)+1 go to 2 endif rtm(1)= -xic/xib rtp(1)= rtm(1) rtm(2)= 0.d0 rtp(2)= 0.d0 ixia= 0 else ixia= 1 ifc0= 0 call c02ajf(xia,xib,xic,rtm,rtp,ifc0) endif if(rtm(2).ne.0.d0) then iz= 0 ifz(35)= ifz(35)+1 go to 2 endif * *-----xi^+ and xi^- are computed * xip= 0.5d0*(e3-rtp(1)) xim= 0.5d0*(e3-rtm(1)) * *-----each integral becomes a sum of two terms * *-----loop over ix starts here * if(om.eq.'g') then ixmn= ix0 ixmx= ix0 else ixmn= 1 ixmx= 2 endif do ix=ixmn,ixmx * *-----q_3 is compared and x15 is selected * if(ix.eq.1) then t3= xip else if(ix.eq.2) then t3= xim endif * *-----The two integrands are computed * *-----further auxiliary quantities * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 edn3= ep3-xdf*t3 t4= omtw-t3 edn4= ep4-xdf*t4 * *-----collections of all limits on t3 * *-----from energy (or natural limits) * if(ieq.eq.1) then at3l1= omtw-bxe*e4+bl(4) at3u1= bxe*e3-bl(3) if(xdf.gt.0.d0) then t3l1= at3l1 t3u1= at3u1 else if(xdf.lt.0.d0) then t3l1= at3u1 t3u1= at3l1 endif else t3l1= 0.d0 t3u1= e3 endif * *-----natural limits * t3l2= -t1+0.5d0*(e1p3-skl2) t3u2= -t1+0.5d0*(e1p3+skl2) * t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3) * *-----from positivity on SA * t3l4= 0.d0 t3l5= sm+su+sf-tw t3u4= sp+su+sf t3u5= omtw * *-----from SA * if(iac(3).ne.0) then t3l6= ss(3)*e3 t3u6= cs(3)*e3 t3l7= omtw-cs(4)*e4 t3u7= omtw-ss(4)*e4 t3l= dmax1(t3l1,t3l2,t3l3,t3l4, # t3l5,t3l6,t3l7) t3u= dmin1(t3u1,t3u2,t3u3,t3u4, # t3u5,t3u6,t3u7) else t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5) endif * *-----limits on t3 are imposed * tlimt3= (t3u-t3)*(t3-t3l) if(t3u.lt.t3l) then iz= 0 ifz(36)= ifz(36)+1 go to 4 else if(tlimt3.lt.0.d0) then iz= 0 ifz(36)= ifz(36)+1 go to 4 endif * *-----non linear limits on t3,t4 are imposed * if(iac(4).ne.0.and.ieq.eq.1) then tnl13c= -cg13*edn1*edn3+vv*sf tnl13s= sg13*edn1*edn3-vv*sf tnl23c= -cg23*edn2*edn3+vv*su tnl23s= sg23*edn2*edn3-vv*su tnl14c= -cg14*edn1*edn4+vv*sd tnl14s= sg14*edn1*edn4-vv*sd sres= 1.d0-e1-e3+sf tnl24c= -cg24*edn2*edn4+vv*sres tnl24s= sg24*edn2*edn4-vv*sres tnl34c= -cg34*edn3*edn4+vv*sp tnl34s= sg34*edn3*edn4-vv*sp if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or. # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then iz= 0 ifz(37)= ifz(37)+1 go to 4 endif endif * *-----non linear constraints from FS A in the case xp = xm * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(38)= ifz(38)+1 go to 4 endif endif * *-----all invariants * x13= t1 x14= t2 x15= t3 x16= t4 x23= e1-t1 x24= e2-t2 x25= e3-t3 x26= e4-t4 x34= sm x35= sf x36= sd x45= su x46= 1.d0-e1-e3+sf x56= sp * *-----computes cross-section * *-----born matrix element is calculated at the reduced c.m. energy * *-----The epsilons are computed in the order * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4), * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4), * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) * x13s= x13*x13 x14s= x14*x14 x15s= x15*x15 x16s= x16*x16 x23s= x23*x23 x24s= x24*x24 x25s= x25*x25 x26s= x26*x26 x34s= x34*x34 x35s= x35*x35 x36s= x36*x36 x45s= x45*x45 x46s= x46*x46 x56s= x56*x56 * ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s-x35s ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+ # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+ # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- # x15s*x34s ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+ # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- # x25s*x34s * e(1)= 1.d0 e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0* # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45- # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35- # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45 e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13* # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+ # x25*x34s * *-----sign of eps_1*eps_i * ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo * if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= ses2 s3= -ses1-ses2 s4= ses3 s5= ses1-ses3 s6= ses2+ses3 s7= ses4 s8= ses1-ses4 s9= ses2+ses4 s10= ses3-ses4 s11= ses5 s12= -ses1-ses5 s13= -ses2+ses5 s14= -ses3-ses5 s15= -ses4-ses5 else ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s-x36s ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+ # x16*x24*x46)-x14s*x26s-x16s*x24s-x46s ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ # x14*x16*x34*x36)-x13s*x46s-x14s*x36s- # x16s*x34s ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- # x26s*x34s e(1)= 1.d0 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23*x34- # x13s*x24*x26-x34*x36 e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13* # x24*x46-x14*x16*x23*x24+x14*(-x23* # x46+2.d0*x24*x36-x26*x34)-x16*x24* # x34+x14s*x23*x26+x34*x46 e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26* # x34)+x13*x16*x24*x34+x13*x34*x46+ # x14*x16*x23*x34+x14*x34*x36-x16* # x34s-x13s*x24*x46-x14s*x23*x36 e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36* # x24s)+x14*(-x23*x24*x36-x23*x26* # x34+x46*x23s)+x16*2.d0*x23*x24*x34- # x23*x34*x46-x24*x34*x36+x26*x34s ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= -ses1-ses2 s3= ses2 s4= -ses1-ses3 s5= ses3 s6= -ses2-ses3 s7= ses1-ses4 s8= ses4 s9= -ses2-ses4 s10= -ses3+ses4 s11= -ses1-ses5 s12= ses5 s13= ses2-ses5 s14= ses3+ses5 s15= ses4+ses5 else ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s- # x35s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s- # x36s ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+ # x16*x25*x56)-x15s*x26s-x16s*x25s- # x56s ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35* # x56+x15*x16*x35*x36)-x13s*x56s- # x15s*x36s-x16s*x35s ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35* # x56+x25*x26*x35*x36)-x23s*x56s- # x25s*x36s-x26s*x35s * e(1)= x13*x14*x23*x25+x13*x15*x23*x24+ # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- # x14*x15*x23s+x14*x23*x35+x15*x23* # x34-x13s*x24*x25-x34*x35 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23* # x34-x13s*x24*x26-x34*x36 e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+ # x13*(-x25*x46+x26*x45)+x14*x15*x23* # x26-x14*x16*x23*x25+x14*(x25*x36-x26* # x35)+x15*(-x23*x46+x24*x36)+x16*(x23* # x45-x24*x35)+x35*x46-x36*x45 e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ # x25*x34)+x13*(x35*x46-x36*x45)-x14* # x15*x23*x36+x14*x16*x23*x35+x15*x34* # x36-x16*x34*x35+x13s*(-x25*x46+x26* # x45) e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* # x36-x24*x26*x35)+x15*(-x23*x24*x36- # x23*x26*x34+x46*x23s)+x16*(x23*x24* # x35+x23*x25*x34-x45*x23s)-x23*x35* # x46+x23*x36*x45-x25*x34*x36+x26*x34* # x35 * ises= 0 do i=1,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= -ses1-ses2 s2= ses1 s3= ses2 s4= -ses1+ses3 s5= -ses2-ses3 s6= ses3 s7= -ses1+ses4 s8= -ses2-ses4 s9= ses4 s10= ses3-ses4 s11= ses1+ses5 s12= ses2-ses5 s13= ses5 s14= -ses3-ses5 s15= -ses4-ses5 else iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif endif * tgn(1)= x14/x25/x36 tgn(2)= x14*x25*x36 tgn(3)= x24/x15/x36 tgn(4)= x15*x24*x36 tgn(5)= x14/x24/x34/x45*x46 tgn(6)= x14/x24/x34*x45/x46 tgn(7)= x14/x24*x34/x45*x46 tgn(8)= x14/x24*x34*x45/x46 tgn(9)= x14*x24/x34/x45*x46 tgn(10)= x14*x24/x34*x45/x46 tgn(11)= x45*x46/x15/x25/x34 tgn(12)= x45/x15/x25/x34/x46 tgn(13)= x34*x45/x15/x25/x46 tgn(14)= x25*x46/x15/x34/x45 tgn(15)= x25*x45/x15/x34/x46 tgn(16)= x15/x25/x34*x45/x46 tgn(17)= x25/x15/x34*x45*x46 tgn(18)= x25*x34*x45/x46/x15 tgn(19)= x15/x25/x34*x45*x46 tgn(20)= x15/x25*x34*x45/x46 tgn(21)= x15*x25*x34/x45*x46 tgn(22)= x34/x15/x25/x45/x46 tgn(23)= x15/x25*x34/x45*x46 tgn(24)= x34/x14/x24*x45/x46 tgn(25)= x14/x24*x34/x45/x46 tgn(26)= x24/x14*x34*x45/x46 tgn(27)= x14*x24*x34/x45/x46 tgn(28)= x34/x14/x24*x45*x46 tgn(29)= x15/x24/x36 tgn(30)= 1.d0/x14/x25/x36 tgn(31)= x14/x25*x36 tgn(32)= 1.d0/x15/x24/x36 tgn(33)= 1.d0/x14/x15/x24/x25 tgn(34)= 1.d0/x14*x25/x36 tgn(35)= x15*x24/x36 tgn(36)= x14*x25/x36 tgn(37)= 1.d0/x14*x15*x24/x25 tgn(38)= x14/x15/x24*x25 tgn(39)= 1.d0/x24/x25*x34/x36/x45/x46 tgn(40)= x24/x25*x34/x36/x45/x46 tgn(41)= 1.d0/x24*x25*x34/x36/x45*x46 tgn(42)= 1.d0/x14/x24*x34/x45*x46 tgn(43)= 1.d0/x14*x24*x34/x45*x46 tgn(44)= 1.d0/x24/x25*x34/x36*x45/x46 tgn(45)= x36/x15/x24 tgn(46)= x45*x46/x14/x24/x34 tgn(47)= x45*x46/x14*x24/x34 tgn(48)= x25*x34/x15/x45/x46 tgn(49)= x24*x45/x14/x34/x46 tgn(50)= x14*x45*x46/x24/x34 * itgn= 0 do l=1,50 if(tgn(l).le.0.d0) then itgn= itgn+1 endif enddo if(itgn.ne.0) then iz= 0 ifz(40)= ifz(40)+1 go to 4 endif * gh1= sqrt(tgn(1)) gh2= sqrt(tgn(2)) gh3= sqrt(tgn(3)) gh4= sqrt(tgn(4)) gh5= sqrt(tgn(5)) gh6= sqrt(tgn(6)) gh7= sqrt(tgn(7)) gh8= sqrt(tgn(8)) gh9= sqrt(tgn(9)) gh10= sqrt(tgn(10)) gh11= sqrt(tgn(11)) gh12= sqrt(tgn(12)) gh13= sqrt(tgn(13)) gh14= sqrt(tgn(14)) gh15= sqrt(tgn(15)) gh16= sqrt(tgn(16)) gh17= sqrt(tgn(17)) gh18= sqrt(tgn(18)) gh19= sqrt(tgn(19)) gh20= sqrt(tgn(20)) gh21= sqrt(tgn(21)) gh22= sqrt(tgn(22)) gh23= sqrt(tgn(23)) gh24= sqrt(tgn(24)) gh25= sqrt(tgn(25)) gh26= sqrt(tgn(26)) gh27= sqrt(tgn(27)) gh28= sqrt(tgn(28)) gh29= sqrt(tgn(29)) gh30= sqrt(tgn(30)) gh31= sqrt(tgn(31)) gh32= sqrt(tgn(32)) gh33= sqrt(tgn(33)) gh34= sqrt(tgn(34)) gh35= sqrt(tgn(35)) gh36= sqrt(tgn(36)) gh37= sqrt(tgn(37)) gh38= sqrt(tgn(38)) gh39= sqrt(tgn(39)) gh40= sqrt(tgn(40)) gh41= sqrt(tgn(41)) gh42= sqrt(tgn(42)) gh43= sqrt(tgn(43)) gh44= sqrt(tgn(44)) gh45= sqrt(tgn(45)) gh46= sqrt(tgn(46)) gh47= sqrt(tgn(47)) gh48= sqrt(tgn(48)) gh49= sqrt(tgn(49)) gh50= sqrt(tgn(50)) * vj= sqrt(vv**3) hb(1)= vj*ver*vfr hb(2)= vj*ver*vfl hb(3)= vj*vel*vfr hb(4)= vj*vel*vfl * *-----Compensating propagators * hpmcfr= sm-rhm2/vv hpmcfi= sm*shg zpmcfr= sm-rzm2/vv zpmcfi= sm*szg hppcfr= sp-rhm2/vv hppcfi= sp*shg zppcfr= sp-rzm2/vv zppcfi= sp*szg hpucfr= su-rhm2/vv hpucfi= su*shg zpucfr= su-rzm2/vv zpucfi= su*szg hpdcfr= sd-rhm2/vv hpdcfi= sd*shg zpdcfr= sd-rzm2/vv zpdcfi= sd*szg if(omssm.eq.'n') then addmr= 1.d0 addmi= 0.d0 addpr= 1.d0 addpi= 0.d0 addur= 1.d0 addui= 0.d0 adddr= 1.d0 adddi= 0.d0 else if(omssm.eq.'y') then alpha1= -salpha/cbeta*sbma alpha2= calpha/cbeta*cbma alpha21= alpha2/alpha1 propm= (sm-rbhm2/vv)*(sm-rbhm2/vv)+(sm*sbhg)**2 propu= (su-rbhm2/vv)*(su-rbhm2/vv)+(su*sbhg)**2 propd= (sd-rbhm2/vv)*(sd-rbhm2/vv)+(sd*sbhg)**2 propp= (sp-rbhm2/vv)*(sp-rbhm2/vv)+(sp*sbhg)**2 addmr= 1.d0+alpha21/propm*((sm-rshm2/vv)*(sm-rbhm2/vv)+ # sm*sm*sbhg*sshg) addmi= alpha21/propm*sm*((sm-rshm2/vv)*sbhg-(sm-rbhm2/vv)*sshg) addpr= 1.d0+alpha21/propp*((sp-rshm2/vv)*(sp-rbhm2/vv)+ # sp*sp*sbhg*sshg) addpi= alpha21/propp*sp*((sp-rshm2/vv)*sbhg-(sp-rbhm2/vv)*sshg) addur= 1.d0+alpha21/propu*((su-rshm2/vv)*(su-rbhm2/vv)+ # su*su*sbhg*sshg) addui= alpha21/propu*su*((su-rshm2/vv)*sbhg-(su-rbhm2/vv)*sshg) adddr= 1.d0+alpha21/propd*((sd-rshm2/vv)*(sd-rbhm2/vv)+ # sd*sd*sbhg*sshg) adddi= alpha21/propd*sd*((sd-rshm2/vv)*sbhg-(sd-rbhm2/vv)*sshg) endif * *-----Higgs Bremsstrahlung diagram: * dth= 0.d0 * *-----Integrals d1-d2 helicity h1-2) * if(ih.eq.1) then * h1b12r= 4.d0*(-gh18*x16-gh21+gh48*x14*x56) h1b12i= 16.d0*s10*gh48 h2b12r= 2.d0*(gh11*x35+gh12*(-x13*x24*x56+x13*x26*x45+x14* # x23*x56-x14*x26*x35-x16*x23*x45+x16*x24*x35-x36*x45)+ # gh13*x56+gh15*x14*x36+gh16*x24*x36-gh17*x13-gh18*x16- # gh19*x23-gh20*x26) h2b12i= 8.d0*(-s1*gh12*x56+s6*gh13-s9*gh12*x24+s10*gh12*x23- # s11*gh12*x16-s12*gh16) h1b1r= 0.25d0*hb(2)*h1b12r h1b1i= 0.25d0*hb(2)*h1b12i h1b2r= 0.25d0*hb(3)*h1b12r h1b2i= -0.25d0*hb(3)*h1b12i h2b1r= 0.25d0*hb(2)*h2b12r h2b1i= 0.25d0*hb(2)*h2b12i h2b2r= 0.25d0*hb(3)*h2b12r h2b2i= -0.25d0*hb(3)*h2b12i * d1b1r= rsz*h1b1r d1b1re= -aisz*h1b1i d1b1ie= rsz*h1b1i d1b1i= aisz*h1b1r d1b2r= rsz*h1b2r d1b2re= -aisz*h1b2i d1b2ie= rsz*h1b2i d1b2i= aisz*h1b2r d2b1r= rsz*h2b1r d2b1re= -aisz*h2b1i d2b1ie= rsz*h2b1i d2b1i= aisz*h2b1r d2b2r= rsz*h2b2r d2b2re= -aisz*h2b2i d2b2ie= rsz*h2b2i d2b2i= aisz*h2b2r * cd1b1r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b1r cd1b1re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b1i cd1b1ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b1i cd1b1i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b1r cd1b2r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b2r cd1b2re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b2i cd1b2ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b2i cd1b2i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b2r cd2b1r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b1r cd2b1re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b1i cd2b1ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b1i cd2b1i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b1r cd2b2r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b2r cd2b2re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b2i cd2b2ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b2i cd2b2i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b2r * bd1b1r= addmr*cd1b1r-addmi*cd1b1i bd1b1re= addmr*cd1b1re-addmi*cd1b1ie bd1b1ie= addmr*cd1b1ie+addmi*cd1b1re bd1b1i= addmr*cd1b1i+addmi*cd1b1r bd1b2r= addmr*cd1b2r-addmi*cd1b2i bd1b2re= addmr*cd1b2re-addmi*cd1b2ie bd1b2ie= addmr*cd1b2ie+addmi*cd1b2re bd1b2i= addmr*cd1b2i+addmi*cd1b2r bd2b1r= addur*cd2b1r-addui*cd2b1i bd2b1re= addur*cd2b1re-addui*cd2b1ie bd2b1ie= addur*cd2b1ie+addui*cd2b1re bd2b1i= addur*cd2b1i+addui*cd2b1r bd2b2r= addur*cd2b2r-addui*cd2b2i bd2b2re= addur*cd2b2re-addui*cd2b2ie bd2b2ie= addur*cd2b2ie+addui*cd2b2re bd2b2i= addur*cd2b2i+addui*cd2b2r * *-----helicity h3-4) * h1b34r= 4.d0*(gh7*x25+gh26*x16-gh27*x56-gh28) h1b34i= 16.d0*(-s5*gh24+s14*gh25) h2b34r= 4.d0*(-gh10*x36+gh26*x16-gh28+gh50*x23) h2b34i= 16.d0*(s1*gh46-s8*gh49) h1b3r= 0.25d0*hb(1)*h1b34r h1b3i= 0.25d0*hb(1)*h1b34i h1b4r= 0.25d0*hb(4)*h1b34r h1b4i= -0.25d0*hb(4)*h1b34i h2b3r= 0.25d0*hb(1)*h2b34r h2b3i= 0.25d0*hb(1)*h2b34i h2b4r= 0.25d0*hb(4)*h2b34r h2b4i= -0.25d0*hb(4)*h2b34i * d1b3r= rsz*h1b3r d1b3re= -aisz*h1b3i d1b3ie= rsz*h1b3i d1b3i= aisz*h1b3r d1b4r= rsz*h1b4r d1b4re= -aisz*h1b4i d1b4ie= rsz*h1b4i d1b4i= aisz*h1b4r d2b3r= rsz*h2b3r d2b3re= -aisz*h2b3i d2b3ie= rsz*h2b3i d2b3i= aisz*h2b3r d2b4r= rsz*h2b4r d2b4re= -aisz*h2b4i d2b4ie= rsz*h2b4i d2b4i= aisz*h2b4r * cd1b3r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b3r cd1b3re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b3i cd1b3ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b3i cd1b3i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b3r cd1b4r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b4r cd1b4re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b4i cd1b4ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b4i cd1b4i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b4r cd2b3r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b3r cd2b3re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b3i cd2b3ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b3i cd2b3i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b3r cd2b4r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b4r cd2b4re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b4i cd2b4ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b4i cd2b4i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b4r * bd1b3r= addmr*cd1b3r-addmi*cd1b3i bd1b3re= addmr*cd1b3re-addmi*cd1b3ie bd1b3ie= addmr*cd1b3ie+addmi*cd1b3re bd1b3i= addmr*cd1b3i+addmi*cd1b3r bd1b4r= addmr*cd1b4r-addmi*cd1b4i bd1b4re= addmr*cd1b4re-addmi*cd1b4ie bd1b4ie= addmr*cd1b4ie+addmi*cd1b4re bd1b4i= addmr*cd1b4i+addmi*cd1b4r bd2b3r= addur*cd2b3r-addui*cd2b3i bd2b3re= addur*cd2b3re-addui*cd2b3ie bd2b3ie= addur*cd2b3ie+addui*cd2b3re bd2b3i= addur*cd2b3i+addui*cd2b3r bd2b4r= addur*cd2b4r-addui*cd2b4i bd2b4re= addur*cd2b4re-addui*cd2b4ie bd2b4ie= addur*cd2b4ie+addui*cd2b4re bd2b4i= addur*cd2b4i+addui*cd2b4r * dth= 9.d0*(bd1b1r+bd2b1r)*(bd1b1r+bd2b1r)- # 6.d0*bd1b1r*bd2b1r+ # 9.d0*(bd1b1re+bd2b1re)*(bd1b1re+bd2b1re)- # 6.d0*bd1b1re*bd2b1re+ # 9.d0*(bd1b1ie+bd2b1ie)*(bd1b1ie+bd2b1ie)- # 6.d0*bd1b1ie*bd2b1ie+ # 9.d0*(bd1b1i+bd2b1i)*(bd1b1i+bd2b1i)- # 6.d0*bd1b1i*bd2b1i+ # 9.d0*(bd1b2r+bd2b2r)*(bd1b2r+bd2b2r)- # 6.d0*bd1b2r*bd2b2r+ # 9.d0*(bd1b2re+bd2b2re)*(bd1b2re+bd2b2re)- # 6.d0*bd1b2re*bd2b2re+ # 9.d0*(bd1b2ie+bd2b2ie)*(bd1b2ie+bd2b2ie)- # 6.d0*bd1b2ie*bd2b2ie+ # 9.d0*(bd1b2i+bd2b2i)*(bd1b2i+bd2b2i)- # 6.d0*bd1b2i*bd2b2i+ # 9.d0*(bd1b3r+bd2b3r)*(bd1b3r+bd2b3r)- # 6.d0*bd1b3r*bd2b3r+ # 9.d0*(bd1b3re+bd2b3re)*(bd1b3re+bd2b3re)- # 6.d0*bd1b3re*bd2b3re+ # 9.d0*(bd1b3ie+bd2b3ie)*(bd1b3ie+bd2b3ie)- # 6.d0*bd1b3ie*bd2b3ie+ # 9.d0*(bd1b3i+bd2b3i)*(bd1b3i+bd2b3i)- # 6.d0*bd1b3i*bd2b3i+ # 9.d0*(bd1b4r+bd2b4r)*(bd1b4r+bd2b4r)- # 6.d0*bd1b4r*bd2b4r+ # 9.d0*(bd1b4re+bd2b4re)*(bd1b4re+bd2b4re)- # 6.d0*bd1b4re*bd2b4re+ # 9.d0*(bd1b4ie+bd2b4ie)*(bd1b4ie+bd2b4ie)- # 6.d0*bd1b4ie*bd2b4ie+ # 9.d0*(bd1b4i+bd2b4i)*(bd1b4i+bd2b4i)- # 6.d0*bd1b4i*bd2b4i * *-----Integrals d3-d4 helicity h5-6) * else if(ih.eq.2) then * h3b56r= -8.d0*gh2 h3b56i= 0.d0 h4b56r= 4.d0*(gh1*(-x23*x56+x26*x35)-gh2) h4b56i= 16.d0*s13*gh1 h3b5r= 0.25d0*hb(2)*h3b56r h3b5i= 0.25d0*hb(2)*h3b56i h3b6r= 0.25d0*hb(3)*h3b56r h3b6i= -0.25d0*hb(3)*h3b56i h4b5r= 0.25d0*hb(2)*h4b56r h4b5i= 0.25d0*hb(2)*h4b56i h4b6r= 0.25d0*hb(3)*h4b56r h4b6i= -0.25d0*hb(3)*h4b56i * d3b5r= rsz*h3b5r d3b5re= -aisz*h3b5i d3b5ie= rsz*h3b5i d3b5i= aisz*h3b5r d3b6r= rsz*h3b6r d3b6re= -aisz*h3b6i d3b6ie= rsz*h3b6i d3b6i= aisz*h3b6r d4b5r= rsz*h4b5r d4b5re= -aisz*h4b5i d4b5ie= rsz*h4b5i d4b5i= aisz*h4b5r d4b6r= rsz*h4b6r d4b6re= -aisz*h4b6i d4b6ie= rsz*h4b6i d4b6i= aisz*h4b6r * cd3b5r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b5r cd3b5re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b5i cd3b5ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b5i cd3b5i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b5r cd3b6r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b6r cd3b6re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b6i cd3b6ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b6i cd3b6i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b6r cd4b5r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b5r cd4b5re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b5i cd4b5ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b5i cd4b5i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b5r cd4b6r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b6r cd4b6re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b6i cd4b6ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b6i cd4b6i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b6r * bd3b5r= adddr*cd3b5r-adddi*cd3b5i bd3b5re= adddr*cd3b5re-adddi*cd3b5ie bd3b5ie= adddr*cd3b5ie+adddi*cd3b5re bd3b5i= adddr*cd3b5i+adddi*cd3b5r bd3b6r= adddr*cd3b6r-adddi*cd3b6i bd3b6re= adddr*cd3b6re-adddi*cd3b6ie bd3b6ie= adddr*cd3b6ie+adddi*cd3b6re bd3b6i= adddr*cd3b6i+adddi*cd3b6r bd4b5r= addpr*cd4b5r-addpi*cd4b5i bd4b5re= addpr*cd4b5re-addpi*cd4b5ie bd4b5ie= addpr*cd4b5ie+addpi*cd4b5re bd4b5i= addpr*cd4b5i+addpi*cd4b5r bd4b6r= addpr*cd4b6r-addpi*cd4b6i bd4b6re= addpr*cd4b6re-addpi*cd4b6ie bd4b6ie= addpr*cd4b6ie+addpi*cd4b6re bd4b6i= addpr*cd4b6i+addpi*cd4b6r * *-----helicity h7-8) * h3b78r= -8.d0*gh4 h3b78i= 0.d0 h4b78r= 4.d0*(gh3*(-x13*x56+x16*x35)-gh4) h4b78i= -16.d0*s9*gh3 h3b7r= 0.25d0*hb(1)*h3b78r h3b7i= 0.25d0*hb(1)*h3b78i h3b8r= 0.25d0*hb(4)*h3b78r h3b8i= -0.25d0*hb(4)*h3b78i h4b7r= 0.25d0*hb(1)*h4b78r h4b7i= 0.25d0*hb(1)*h4b78i h4b8r= 0.25d0*hb(4)*h4b78r h4b8i= -0.25d0*hb(4)*h4b78i * d3b7r= rsz*h3b7r d3b7re= -aisz*h3b7i d3b7ie= rsz*h3b7i d3b7i= aisz*h3b7r d3b8r= rsz*h3b8r d3b8re= -aisz*h3b8i d3b8ie= rsz*h3b8i d3b8i= aisz*h3b8r d4b7r= rsz*h4b7r d4b7re= -aisz*h4b7i d4b7ie= rsz*h4b7i d4b7i= aisz*h4b7r d4b8r= rsz*h4b8r d4b8re= -aisz*h4b8i d4b8ie= rsz*h4b8i d4b8i= aisz*h4b8r * cd3b7r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b7r cd3b7re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b7i cd3b7ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b7i cd3b7i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b7r cd3b8r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b8r cd3b8re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b8i cd3b8ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d3b8i cd3b8i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d3b8r cd4b7r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b7r cd4b7re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b7i cd4b7ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b7i cd4b7i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b7r cd4b8r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b8r cd4b8re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b8i cd4b8ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d4b8i cd4b8i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d4b8r * bd3b7r= adddr*cd3b7r-adddi*cd3b7i bd3b7re= adddr*cd3b7re-adddi*cd3b7ie bd3b7ie= adddr*cd3b7ie+adddi*cd3b7re bd3b7i= adddr*cd3b7i+adddi*cd3b7r bd3b8r= adddr*cd3b8r-adddi*cd3b8i bd3b8re= adddr*cd3b8re-adddi*cd3b8ie bd3b8ie= adddr*cd3b8ie+adddi*cd3b8re bd3b8i= adddr*cd3b8i+adddi*cd3b8r bd4b7r= addpr*cd4b7r-addpi*cd4b7i bd4b7re= addpr*cd4b7re-addpi*cd4b7ie bd4b7ie= addpr*cd4b7ie+addpi*cd4b7re bd4b7i= addpr*cd4b7i+addpi*cd4b7r bd4b8r= addpr*cd4b8r-addpi*cd4b8i bd4b8re= addpr*cd4b8re-addpi*cd4b8ie bd4b8ie= addpr*cd4b8ie+addpi*cd4b8re bd4b8i= addpr*cd4b8i+addpi*cd4b8r * dth= 9.d0*(bd3b5r+bd4b5r)*(bd3b5r+bd4b5r)- # 6.d0*bd3b5r*bd4b5r+ # 9.d0*(bd3b5re+bd4b5re)*(bd3b5re+bd4b5re)- # 6.d0*bd3b5re*bd4b5re+ # 9.d0*(bd3b5ie+bd4b5ie)*(bd3b5ie+bd4b5ie)- # 6.d0*bd3b5ie*bd4b5ie+ # 9.d0*(bd3b5i+bd4b5i)*(bd3b5i+bd4b5i)- # 6.d0*bd3b5i*bd4b5i+ # 9.d0*(bd3b6r+bd4b6r)*(bd3b6r+bd4b6r)- # 6.d0*bd3b6r*bd4b6r+ # 9.d0*(bd3b6re+bd4b6re)*(bd3b6re+bd4b6re)- # 6.d0*bd3b6re*bd4b6re+ # 9.d0*(bd3b6ie+bd4b6ie)*(bd3b6ie+bd4b6ie)- # 6.d0*bd3b6ie*bd4b6ie+ # 9.d0*(bd3b6i+bd4b6i)*(bd3b6i+bd4b6i)- # 6.d0*bd3b6i*bd4b6i+ # 9.d0*(bd3b7r+bd4b7r)*(bd3b7r+bd4b7r)- # 6.d0*bd3b7r*bd4b7r+ # 9.d0*(bd3b7re+bd4b7re)*(bd3b7re+bd4b7re)- # 6.d0*bd3b7re*bd4b7re+ # 9.d0*(bd3b7ie+bd4b7ie)*(bd3b7ie+bd4b7ie)- # 6.d0*bd3b7ie*bd4b7ie+ # 9.d0*(bd3b7i+bd4b7i)*(bd3b7i+bd4b7i)- # 6.d0*bd3b7i*bd4b7i+ # 9.d0*(bd3b8r+bd4b8r)*(bd3b8r+bd4b8r)- # 6.d0*bd3b8r*bd4b8r+ # 9.d0*(bd3b8re+bd4b8re)*(bd3b8re+bd4b8re)- # 6.d0*bd3b8re*bd4b8re+ # 9.d0*(bd3b8ie+bd4b8ie)*(bd3b8ie+bd4b8ie)- # 6.d0*bd3b8ie*bd4b8ie+ # 9.d0*(bd3b8i+bd4b8i)*(bd3b8i+bd4b8i)- # 6.d0*bd3b8i*bd4b8i * *-----Integrals d1-d3 helicity h9-h10) * else if(ih.eq.3) then * h1b910r= 4.d0*(-gh4+gh29*(x23*x46-x26*x34)) h1b910i= -16.d0*s12*gh29 h3b910r= -8.d0*gh4 h3b910i= 0.d0 h1b9r= 0.25d0*hb(1)*h1b910r h1b9i= 0.25d0*hb(1)*h1b910i h1b10r= 0.25d0*hb(4)*h1b910r h1b10i= -0.25d0*hb(4)*h1b910i h3b9r= 0.25d0*hb(1)*h3b910r h3b9i= 0.25d0*hb(1)*h3b910i h3b10r= 0.25d0*hb(4)*h3b910r h3b10i= -0.25d0*hb(4)*h3b910i * d1b9r= rsz*h1b9r d1b9re= -aisz*h1b9i d1b9ie= rsz*h1b9i d1b9i= aisz*h1b9r d1b10r= rsz*h1b10r d1b10re= -aisz*h1b10i d1b10ie= rsz*h1b10i d1b10i= aisz*h1b10r d3b9r= rsz*h3b9r d3b9re= -aisz*h3b9i d3b9ie= rsz*h3b9i d3b9i= aisz*h3b9r d3b10r= rsz*h3b10r d3b10re= -aisz*h3b10i d3b10ie= rsz*h3b10i d3b10i= aisz*h3b10r * cd1b9r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b9r cd1b9re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b9i cd1b9ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b9i cd1b9i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b9r cd1b10r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b10r cd1b10re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b10i cd1b10ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b10i cd1b10i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b10r cd3b9r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b9r cd3b9re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b9i cd3b9ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b9i cd3b9i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b9r cd3b10r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b10r cd3b10re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b10i cd3b10ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b10i cd3b10i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b10r * bd1b9r= addmr*cd1b9r-addmi*cd1b9i bd1b9re= addmr*cd1b9re-addmi*cd1b9ie bd1b9ie= addmr*cd1b9ie+addmi*cd1b9re bd1b9i= addmr*cd1b9i+addmi*cd1b9r bd1b10r= addmr*cd1b10r-addmi*cd1b10i bd1b10re= addmr*cd1b10re-addmi*cd1b10ie bd1b10ie= addmr*cd1b10ie+addmi*cd1b10re bd1b10i= addmr*cd1b10i+addmi*cd1b10r bd3b9r= adddr*cd3b9r-adddi*cd3b9i bd3b9re= adddr*cd3b9re-adddi*cd3b9ie bd3b9ie= adddr*cd3b9ie+adddi*cd3b9re bd3b9i= adddr*cd3b9i+adddi*cd3b9r bd3b10r= adddr*cd3b10r-adddi*cd3b10i bd3b10re= adddr*cd3b10re-adddi*cd3b10ie bd3b10ie= adddr*cd3b10ie+adddi*cd3b10re bd3b10i= adddr*cd3b10i+adddi*cd3b10r * *-----helicity h11-h12) * h1b1112r= 4.d0*(-gh2+gh34*(x13*x46-x16*x34)) h1b1112i= 16.d0*s8*gh34 h3b1112r= -8.d0*gh2 h3b1112i= 0.d0 h1b11r= 0.25d0*hb(2)*h1b1112r h1b11i= 0.25d0*hb(2)*h1b1112i h1b12r= 0.25d0*hb(3)*h1b1112r h1b12i= -0.25d0*hb(3)*h1b1112i h3b11r= 0.25d0*hb(2)*h3b1112r h3b11i= 0.25d0*hb(2)*h3b1112i h3b12r= 0.25d0*hb(3)*h3b1112r h3b12i= -0.25d0*hb(3)*h3b1112i * d1b11r= rsz*h1b11r d1b11re= -aisz*h1b11i d1b11ie= rsz*h1b11i d1b11i= aisz*h1b11r d1b12r= rsz*h1b12r d1b12re= -aisz*h1b12i d1b12ie= rsz*h1b12i d1b12i= aisz*h1b12r d3b11r= rsz*h3b11r d3b11re= -aisz*h3b11i d3b11ie= rsz*h3b11i d3b11i= aisz*h3b11r d3b12r= rsz*h3b12r d3b12re= -aisz*h3b12i d3b12ie= rsz*h3b12i d3b12i= aisz*h3b12r * cd1b11r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b11r cd1b11re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b11i cd1b11ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b11i cd1b11i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b11r cd1b12r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b12r cd1b12re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b12i cd1b12ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b12i cd1b12i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b12r cd3b11r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b11r cd3b11re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b11i cd3b11ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b11i cd3b11i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b11r cd3b12r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b12r cd3b12re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b12i cd3b12ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b12i cd3b12i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b12r * bd1b11r= addmr*cd1b11r-addmi*cd1b11i bd1b11re= addmr*cd1b11re-addmi*cd1b11ie bd1b11ie= addmr*cd1b11ie+addmi*cd1b11re bd1b11i= addmr*cd1b11i+addmi*cd1b11r bd1b12r= addmr*cd1b12r-addmi*cd1b12i bd1b12re= addmr*cd1b12re-addmi*cd1b12ie bd1b12ie= addmr*cd1b12ie+addmi*cd1b12re bd1b12i= addmr*cd1b12i+addmi*cd1b12r bd3b11r= adddr*cd3b11r-adddi*cd3b11i bd3b11re= adddr*cd3b11re-adddi*cd3b11ie bd3b11ie= adddr*cd3b11ie+adddi*cd3b11re bd3b11i= adddr*cd3b11i+adddi*cd3b11r bd3b12r= adddr*cd3b12r-adddi*cd3b12i bd3b12re= adddr*cd3b12re-adddi*cd3b12ie bd3b12ie= adddr*cd3b12ie+adddi*cd3b12re bd3b12i= adddr*cd3b12i+adddi*cd3b12r * dth= 9.d0*(bd1b9r+bd3b9r)*(bd1b9r+bd3b9r)- # 6.d0*bd1b9r*bd3b9r+ # 9.d0*(bd1b9re+bd3b9re)*(bd1b9re+bd3b9re)- # 6.d0*bd1b9re*bd3b9re+ # 9.d0*(bd1b9ie+bd3b9ie)*(bd1b9ie+bd3b9ie)- # 6.d0*bd1b9ie*bd3b9ie+ # 9.d0*(bd1b9i+bd3b9i)*(bd1b9i+bd3b9i)- # 6.d0*bd1b9i*bd3b9i+ # 9.d0*(bd1b10r+bd3b10r)*(bd1b10r+bd3b10r)- # 6.d0*bd1b10r*bd3b10r+ # 9.d0*(bd1b10re+bd3b10re)*(bd1b10re+bd3b10re)- # 6.d0*bd1b10re*bd3b10re+ # 9.d0*(bd1b10ie+bd3b10ie)*(bd1b10ie+bd3b10ie)- # 6.d0*bd1b10ie*bd3b10ie+ # 9.d0*(bd1b10i+bd3b10i)*(bd1b10i+bd3b10i)- # 6.d0*bd1b10i*bd3b10i+ # 9.d0*(bd1b11r+bd3b11r)*(bd1b11r+bd3b11r)- # 6.d0*bd1b11r*bd3b11r+ # 9.d0*(bd1b11re+bd3b11re)*(bd1b11re+bd3b11re)- # 6.d0*bd1b11re*bd3b11re+ # 9.d0*(bd1b11ie+bd3b11ie)*(bd1b11ie+bd3b11ie)- # 6.d0*bd1b11ie*bd3b11ie+ # 9.d0*(bd1b11i+bd3b11i)*(bd1b11i+bd3b11i)- # 6.d0*bd1b11i*bd3b11i+ # 9.d0*(bd1b12r+bd3b12r)*(bd1b12r+bd3b12r)- # 6.d0*bd1b12r*bd3b12r+ # 9.d0*(bd1b12re+bd3b12re)*(bd1b12re+bd3b12re)- # 6.d0*bd1b12re*bd3b12re+ # 9.d0*(bd1b12ie+bd3b12ie)*(bd1b12ie+bd3b12ie)- # 6.d0*bd1b12ie*bd3b12ie+ # 9.d0*(bd1b12i+bd3b12i)*(bd1b12i+bd3b12i)- # 6.d0*bd1b12i*bd3b12i * * *-----Integrals d2-d4 helicity h13-h14) * else if(ih.eq.4) then * h2b1314r= 4.d0*(-gh8*x26+gh10*x36+gh28-gh47*x13) h2b1314i= -16.d0*(s1*gh46+s12*gh6) h4b1314r= 4.d0*(gh7*x25-gh8*x26-gh9*x35+gh10*x36) h4b1314i= 16.d0*(s11*gh5-s12*gh6) h2b13r= 0.25d0*hb(2)*h2b1314r h2b13i= 0.25d0*hb(2)*h2b1314i h2b14r= 0.25d0*hb(3)*h2b1314r h2b14i= -0.25d0*hb(3)*h2b1314i h4b13r= 0.25d0*hb(2)*h4b1314r h4b13i= 0.25d0*hb(2)*h4b1314i h4b14r= 0.25d0*hb(3)*h4b1314r h4b14i= -0.25d0*hb(3)*h4b1314i * d2b13r= rsz*h2b13r d2b13re= -aisz*h2b13i d2b13ie= rsz*h2b13i d2b13i= aisz*h2b13r d2b14r= rsz*h2b14r d2b14re= -aisz*h2b14i d2b14ie= rsz*h2b14i d2b14i= aisz*h2b14r d4b13r= rsz*h4b13r d4b13re= -aisz*h4b13i d4b13ie= rsz*h4b13i d4b13i= aisz*h4b13r d4b14r= rsz*h4b14r d4b14re= -aisz*h4b14i d4b14ie= rsz*h4b14i d4b14i= aisz*h4b14r * cd2b13r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b13r cd2b13re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b13i cd2b13ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b13i cd2b13i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b13r cd2b14r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b14r cd2b14re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b14i cd2b14ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b14i cd2b14i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b14r cd4b13r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b13r cd4b13re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b13i cd4b13ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b13i cd4b13i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b13r cd4b14r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b14r cd4b14re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b14i cd4b14ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b14i cd4b14i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b14r * bd2b13r= addur*cd2b13r-addui*cd2b13i bd2b13re= addur*cd2b13re-addui*cd2b13ie bd2b13ie= addur*cd2b13ie+addui*cd2b13re bd2b13i= addur*cd2b13i+addui*cd2b13r bd2b14r= addur*cd2b14r-addui*cd2b14i bd2b14re= addur*cd2b14re-addui*cd2b14ie bd2b14ie= addur*cd2b14ie+addui*cd2b14re bd2b14i= addur*cd2b14i+addui*cd2b14r bd4b13r= addpr*cd4b13r-addpi*cd4b13i bd4b13re= addpr*cd4b13re-addpi*cd4b13ie bd4b13ie= addpr*cd4b13ie+addpi*cd4b13re bd4b13i= addpr*cd4b13i+addpi*cd4b14r bd4b14r= addpr*cd4b14r-addpi*cd4b14i bd4b14re= addpr*cd4b14re-addpi*cd4b14ie bd4b14ie= addpr*cd4b14ie+addpi*cd4b14re bd4b14i= addpr*cd4b14i+addpi*cd4b14r * *-----helicity h15-h16) * h2b1516r= 2.d0*(-gh11*x35+gh12*(-x13*x24*x56+x13*x26*x45+x14* # x23*x56-x14*x26*x35-x16*x23*x45+x16*x24*x35+x36*x45)- # gh13*x56-gh15*x14*x36-gh16*x24*x36+gh17*x13+gh18*x16+ # gh19*x23+gh20*x26) h2b1516i= 8.d0*(s1*gh12*x56-s6*gh13-s7*gh12*x26-s8*gh15- # s13*gh12*x14+s14*gh12*x13) h4b1516r= 2.d0*(-gh11*x35+gh12*(-x13*x24*x56+x13*x26*x45+x14* # x23*x56-x14*x26*x35-x16*x23*x45+x16*x24*x35+x36*x45)- # gh13*x56+2.d0*gh14*x14*x35-gh15*x14*x36-gh16*x24*x36- # gh17*x13+gh18*x16+gh19*x23+gh20*x26-2.d0*gh21) h4b1516i= 8.d0*(s2*gh11-s4*gh12*x36-s6*gh13+2.d0*s7*gh14- # s8*gh15-s12*gh16+s15*gh12) h2b15r= 0.25d0*hb(1)*h2b1516r h2b15i= 0.25d0*hb(1)*h2b1516i h2b16r= 0.25d0*hb(4)*h2b1516r h2b16i= -0.25d0*hb(4)*h2b1516i h4b15r= 0.25d0*hb(1)*h4b1516r h4b15i= 0.25d0*hb(1)*h4b1516i h4b16r= 0.25d0*hb(4)*h4b1516r h4b16i= -0.25d0*hb(4)*h4b1516i * d2b15r= rsz*h2b15r d2b15re= -aisz*h2b15i d2b15ie= rsz*h2b15i d2b15i= aisz*h2b15r d2b16r= rsz*h2b16r d2b16re= -aisz*h2b16i d2b16ie= rsz*h2b16i d2b16i= aisz*h2b16r d4b15r= rsz*h4b15r d4b15re= -aisz*h4b15i d4b15ie= rsz*h4b15i d4b15i= aisz*h4b15r d4b16r= rsz*h4b16r d4b16re= -aisz*h4b16i d4b16ie= rsz*h4b16i d4b16i= aisz*h4b16r * cd2b15r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b15r cd2b15re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b15i cd2b15ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b15i cd2b15i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b15r cd2b16r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b16r cd2b16re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b16i cd2b16ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b16i cd2b16i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b16r cd4b15r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b15r cd4b15re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b15i cd4b15ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b15i cd4b15i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b15r cd4b16r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b16r cd4b16re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b16i cd4b16ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b16i cd4b16i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b16r * bd2b15r= addur*cd2b15r-addui*cd2b15i bd2b15re= addur*cd2b15re-addui*cd2b15ie bd2b15ie= addur*cd2b15ie+addui*cd2b15re bd2b15i= addur*cd2b15i+addui*cd2b15r bd2b16r= addur*cd2b16r-addui*cd2b16i bd2b16re= addur*cd2b16re-addui*cd2b16ie bd2b16ie= addur*cd2b16ie+addui*cd2b16re bd2b16i= addur*cd2b16i+addui*cd2b16r bd4b15r= addpr*cd4b15r-addpi*cd4b15i bd4b15re= addpr*cd4b15re-addpi*cd4b15ie bd4b15ie= addpr*cd4b15ie+addpi*cd4b15re bd4b15i= addpr*cd4b13i+addpi*cd4b16r bd4b16r= addpr*cd4b16r-addpi*cd4b16i bd4b16re= addpr*cd4b16re-addpi*cd4b16ie bd4b16ie= addpr*cd4b16ie+addpi*cd4b16re bd4b16i= addpr*cd4b16i+addpi*cd4b16r * dth= 9.d0*(bd2b13r+bd4b13r)*(bd2b13r+bd4b13r)- # 6.d0*bd2b13r*bd4b13r+ # 9.d0*(bd2b13re+bd4b13re)*(bd2b13re+bd4b13re)- # 6.d0*bd2b13re*bd4b13re+ # 9.d0*(bd2b13ie+bd4b13ie)*(bd2b13ie+bd4b13ie)- # 6.d0*bd2b13ie*bd4b13ie+ # 9.d0*(bd2b13i+bd4b13i)*(bd2b13i+bd4b13i)- # 6.d0*bd2b13i*bd4b13i+ # 9.d0*(bd2b14r+bd4b14r)*(bd2b14r+bd4b14r)- # 6.d0*bd2b14r*bd4b14r+ # 9.d0*(bd2b14re+bd4b14re)*(bd2b14re+bd4b14re)- # 6.d0*bd2b14re*bd4b14re+ # 9.d0*(bd2b14ie+bd4b14ie)*(bd2b14ie+bd4b14ie)- # 6.d0*bd2b14ie*bd4b14ie+ # 9.d0*(bd2b14i+bd4b14i)*(bd2b14i+bd4b14i)- # 6.d0*bd2b14i*bd4b14i+ # 9.d0*(bd2b15r+bd4b15r)*(bd2b15r+bd4b15r)- # 6.d0*bd2b15r*bd4b15r+ # 9.d0*(bd2b15re+bd4b15re)*(bd2b15re+bd4b15re)- # 6.d0*bd2b15re*bd4b15re+ # 9.d0*(bd2b15ie+bd4b15ie)*(bd2b15ie+bd4b15ie)- # 6.d0*bd2b15ie*bd4b15ie+ # 9.d0*(bd2b15i+bd4b15i)*(bd2b15i+bd4b15i)- # 6.d0*bd2b15i*bd4b15i+ # 9.d0*(bd2b16r+bd4b16r)*(bd2b16r+bd4b16r)- # 6.d0*bd2b16r*bd4b16r+ # 9.d0*(bd2b16re+bd4b16re)*(bd2b16re+bd4b16re)- # 6.d0*bd2b16re*bd4b16re+ # 9.d0*(bd2b16ie+bd4b16ie)*(bd2b16ie+bd4b16ie)- # 6.d0*bd2b16ie*bd4b16ie+ # 9.d0*(bd2b16i+bd4b16i)*(bd2b16i+bd4b16i)- # 6.d0*bd2b16i*bd4b16i * endif * *-----Total * if(omssm.eq.'n') then hcfs= 1.d0 else if(omssm.eq.'y') then hcfs= (sbma*salpha/cbeta)**2 endif hcf= rbqm2/vv/64.d0/cth4**2*hcfs dth= hcf*dth * 4 if(iz.eq.0) then dpxs(ix,it)= 0.d0 iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc dpxs(ix,it)= 0.25d0*tjac*stf*dth/s endif * *-----end of ix loop * enddo * cpxs(it)= dpxs(1,it)+dpxs(2,it) * 2 if(iz.eq.0) then bpxs(it)= 0.d0 iz= 1 else bpxs(it)= cpxs(it) endif * *-----end on it loop * enddo * 1 if(iz.eq.0) then apxs= 0.d0 iz= 1 else apxs= bpxs(1)+bpxs(2) endif * if(apxs.lt.0.d0) then ifz(41)= ifz(41)+1 resf= 0.d0 else resf= apxs endif * if(oqcd.eq.'y') then nf= 5 alsh= wtoralphas(wm,hm,als,nf) fqcd= 1.d0+alsh/pi*(17.d0/3.d0+(35.94d0-1.36d0*nf)*alsh/pi) fqcd= fqcd*(1.d0+0.5d0*alsz/pi*(fcdn-1.d0)) else fqcd= 1.d0 endif * wtoxsh64= tfact*resf*bfact*fqcd * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(ostop.eq.'s') then ifp= ifl(jp) if(wtoxsh64.ne.0.d0.and.ifp.lt.5000) then stry(jp,ifp)= wtoxsh64 if(wtoxsh64.gt.xshmx(jp)) then xshmx(jp)= wtoxsh64 endif ifl(jp)= ifl(jp)+1 else if(wtoxsh64.ne.0.d0.and.ifp.gt.5000) then if(wtoxsh64.gt.xshmx(jp)) then stry(jp,ifp)= wtoxsh64 ifl(jp)= ifl(jp)+1 endif endif else if(wtoxsh64.gt.xshmx(jp)) then xshmx(jp)= wtoxsh64 do l=1,9 xmxh(jp,l)= x(l) enddo endif endif endif xaph(1)= xm xaph(2)= xp xaph(3)= sm xaph(4)= sp xaph(5)= su xaph(6)= sd xaph(7)= sf xaph(8)= tw xaph(9)= t1 xaph(10)= t3 endif * return end * *-----WTOXSA64---------------------------------------------------------2 * real*8 function wtoxsa64(ndim,x) implicit real*8 (a-h,o-z) character*1 om,osm,ostop,oqcd,omssm character*4 otype * parameter(ninv=10,npos=512,ifmax=10000) * common/wtihl/ih common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wthiggs/hm common/wtsmod/osm common/wtim/ostop common/wtkount/ik common/wtdis/dist common/wtqcdz/alsz common/wtaqcd/oqcd common/wtbme/bfact common/wtistrf/isf common/wtsf/ix0,it0 common/wtchi/hch(36) common/wtipt/ifz(44) common/wtmssmo/omssm common/wtnf/ifl(npos) common/wticuts/iac(4) common/wtisa/isaa,isab common/wtochannel/otype common/wthx/xshmx(npos) common/wtparh/xaph(ninv) common/wttc/itc,itcc,itcn common/wtpmxh/xmxh(npos,9) common/wtstor/stry(npos,ifmax) common/wtmssmi/am,tbeta,rmu,scalm,bat,bab common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn 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/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) common/wtmssm/ams,shm,shms,bhm,bhms,sbeta,cbeta,salpha,calpha, # sbma,cbma,rshm,rshm2,rshg,rshmg,sshg,sshgs, # opsshgs,rbhm,rbhm2,rbhg,rbhmg,sbhg,sbhgs,opsbhgs, # ram,ram2,rag,ramg,sag,sags,opsags * dimension hb(4) dimension tgn(58) dimension x(ndim) dimension bt1(2),bt2(2) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension dpxs(2,2),cpxs(2),bpxs(2) dimension dthr(12),dthre(12),dthie(12),dthi(12) dimension d1hr(12),d1hre(12),d1hie(12),d1hi(12) dimension d2hr(12),d2hre(12),d2hie(12),d2hi(12) dimension d3hr(12),d3hre(12),d3hie(12),d3hi(12) dimension d4hr(12),d4hre(12),d4hie(12),d4hi(12) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) dimension cd1hr(12),cd1hre(12),cd1hie(12),cd1hi(12) dimension cd2hr(12),cd2hre(12),cd2hie(12),cd2hi(12) dimension cd3hr(12),cd3hre(12),cd3hie(12),cd3hi(12) dimension cd4hr(12),cd4hre(12),cd4hie(12),cd4hi(12) dimension bd1hr(12),bd1hre(12),bd1hie(12),bd1hi(12) dimension bd2hr(12),bd2hre(12),bd2hie(12),bd2hi(12) dimension bd3hr(12),bd3hre(12),bd3hie(12),bd3hi(12) dimension bd4hr(12),bd4hre(12),bd4hie(12),bd4hi(12) dimension ad1hr(12),ad1hre(12),ad1hie(12),ad1hi(12) dimension ad2hr(12),ad2hre(12),ad2hie(12),ad2hi(12) dimension ad3hr(12),ad3hre(12),ad3hie(12),ad3hi(12) dimension ad4hr(12),ad4hre(12),ad4hie(12),ad4hi(12) * data ec2/-0.4999999963d0/,ec4/0.0416666418d0/, # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, # ec10/-0.0000002605d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf * *-----the order of integration is: * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1 * * m_{+/-}^2 transformed for the resonating peaks * M_0^2,m_0^2 transformed for the resonating peaks * m^2 and t_1 transformed for the jacobian peaks * s0sh= rshm2/opsshgs s0a= ram2/opsags * do ix=1,2 do it=1,2 dpxs(ix,it)= 0.d0 enddo enddo do it=1,2 cpxs(it)= 0.d0 bpxs(it)= 0.d0 enddo * if(ndim.eq.6) then smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.8) 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(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 wm2= wm*wm * * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * if(itc.eq.3) then omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) omul= dmin1(omul,omuld) endif if(uvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * if(itc.eq.3) then vvlld= (dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) vvll= dmax1(vvll,vvlld) endif * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vkf.eq.0.d0) then if(vvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vvx.eq.1.d0) then veps= 0.d0 else veps= uvl*(1.d0-vvx)**hbeti endif avkf= 1.d0 else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti avkf= 1.d0-vkf**hbet endif vv= uv-veps vjc0= 1.d0-vvll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif endif * if(vv.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif svv= sqrt(vv) vamg= ramg*vv vshmg= rshmg*vv vbhmg= rbhmg*vv vvs= vv*vv xm= uv xp= vv/uv xmop= xm/xp if(ndim.eq.7.or.ndim.eq.6) then xdf= 0.d0 else xdf= (ueps*(1.d0-ueps)-veps)/uv endif xdfs= xdf*xdf sh= vv*s * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * dsz0= 1.d0-rszm2 dsz= dsz0*dsz0+rszw2 rsz= dsz0/dsz aisz= -rszw/dsz * *-----Reduced structure functions are computed with arguments xp,xm * opxp= 1.d0+xp opxm= 1.d0+xm omxp= veps/uv omxm= ueps if(isf.eq.0) then stfp= 1.d0 stfm= 1.d0 else if(isf.gt.0) then if(omxp.eq.0) then stfp= d0gl else rcpx= 0.25d0*opxp*opxp rcpy= xp iflp= 1 rclp= s21baf(rcpx,rcpy,iflp) stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+ # feta*(-4.d0*opxp*log(omxp)+ # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp)) endif if(omxm.eq.0) then stfm= d0gl else rcmx= 0.25d0*opxm*opxm rcmy= xm iflm= 1 rclm= s21baf(rcmx,rcmy,iflm) stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ # feta*(-4.d0*opxm*log(omxm)+ # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm)) endif endif * stf= stfp*stfm * * *-----if there is no upper cut on some FS IM, then the maximum is allowed * do j=1,6 if(rr(j).eq.1.d0) then rrr(j)= rr(j) else rrr(j)= rr(j)/vv endif rrl(j)= rl(j)/vv srrl(j)= srl(j)/svv enddo * *-----cuts become special near xp = xm * if(abs(xdf).gt.1.d-15) then ieq= 1 bxe= vv/(ueps*(1.d0-ueps)-veps) if(xdf.gt.0.d0) then enc= 1.d0 else if(xdf.lt.0.d0) then enc= xmop endif else ieq= 0 bxe= 1.d0 endif if(ieq.eq.0.and.xm.le.teq) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then sct12= sct120/vv sct13= sct130/vv sct14= sct140/vv sct23= sct230/vv sct24= sct240/vv sct34= sct340/vv else sct12= 0.d0 sct13= 0.d0 sct14= 0.d0 sct23= 0.d0 sct24= 0.d0 sct34= 0.d0 endif * *-----cuts on E * do j=1,4 if(ieq.eq.1) then bl(j)= 2.d0*rae(j)/xdf xbl(j)= 2.d0*rae(j)/xp else if(ieq.eq.0) then bl(j)= 2.d0*rae(j)/xm endif enddo * *-----cuts on SA * if(iac(3).ne.0) then do j=1,4 if(sgam(j).eq.1.d0) then ss(j)= 0.d0 else ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmop ss(j)= 1.d0/ss(j) endif if(cgam(j).eq.0.d0) then cs(j)= 1.d0 else cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop cs(j)= 1.d0/cs(j) endif enddo endif * *-----initialization of sm = m_-^2 * zma1= dsm zma2= vv*sct12 zmb1= usm zmb2= (svv-sdsp)*(svv-sdsp) zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) if(ieq.eq.0) then zma3= vv*(bl(1)+bl(2)-1.d0) zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))* # (1.d0-0.5d0*(bl(3)+bl(4))) zmb5= vv*(1.d0-bl(3)) zmb6= vv*(1.d0-bl(4)) else if(ieq.eq.1) then zma3= vv*(-enc+xbl(1)+xbl(2)) zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))* # (1.d0+enc-xbl(3)-xbl(4)) zmb5= vv*(enc-xbl(3)) zmb6= vv*(enc-xbl(4)) endif xzma= dmax1(zma1,zma2,zma3) xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) * *-----limits on sm from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zma= xzma zmb= xzmb else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then szma= xzma szmb= xzmb else if(ss(3).gt.ss(1)) then szmb= xzmb adsp= dsp/vv axszma= dmax1(adsp,sct34) axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/ # (ss(3)-ss(1))) szma= dmax1(axszma,xzma) else if(ss(3).lt.ss(1)) then if(ss(3).lt.0.5d0) then szma= xzma axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 szmb= dmin1(axszmb,xzmb) else iz= 0 ifz(2)= ifz(2)+1 go to 1 endif endif else szma= xzma szmb= xzmb endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zma= szma zmb= szmb else if(cs(3).gt.cs(1)) then if(cs(3).gt.0.5d0) then zma= szma axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2 zmb= dmin1(axczmb,szmb) else iz= 0 ifz(3)= ifz(3)+1 go to 1 endif else if(cs(3).lt.cs(1)) then zmb= szmb adsp= dsp/vv axczma= dmax1(adsp,sct34) axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/ # (cs(3)-cs(1))) zma= dmax1(axczma,szma) endif else zma= szma zmb= szmb endif endif if(itc.eq.3) then dzmb= (svv-dist/rs)*(svv-dist/rs) zmb= dmin1(zmb,dzmb) endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * if(ih.eq.1.or.ih.eq.2) then rmm2= ram2 rmmg= ramg smgs= sags vmmg= vamg smg= sag s0m= s0a else if(ih.eq.3.or.ih.eq.4) then rmm2= rshm2 rmmg= rshmg smgs= sshgs vmmg= vshmg smg= sshg s0m= s0sh endif zmas= zma-rmm2 zmbs= zmb-rmm2 atma= (zmas+smgs*zma)/rmmg atmb= (zmbs+smgs*zmb)/rmmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (-atmb+atma)/vmmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (-pi+atmb+atma)/vmmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (-pih+atmb+atma)/vmmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (pi-atmb-atma)/vmmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (atmb-atma)/vmmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (pih+atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (pih-atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (-pih+atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (atmb-atma)/vmmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= vmmg*zmv sm= s0m/vv*(1.d0+smg*s07aaf(atnm,iftn)) if(iftn.ne.0) print 300 if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) smjc= vv*smjc0 * 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 zpen= vv*(1.d0-bl(1)-bl(2)+sm) zmen= vv*(-1.d0+bl(3)+bl(4)+sm) zpa= dmax1(zpa,zmen) zpb= dmin1(zpb,zpen) 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)) zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) endif zpap= vv*sct34 zpa= dmax1(zpa,zpap) * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * if(itc.eq.3) then bdistl= dist*dist/s-zpa bdistu= zpb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif endif * if(ih.eq.1.or.ih.eq.2) then rpm2= rshm2 rpmg= rshmg spgs= sshgs vpmg= vshmg spg= sshg s0p= s0sh else if(ih.eq.3.or.ih.eq.4) then rpm2= ram2 rpmg= ramg spgs= sags vpmg= vamg spg= sag s0p= s0a endif if(itc.eq.3) then sp= (dist/rs/svv)**2 spjc= 2.d0*dist/s/((vv*sp-rpm2)**2+ # (vv*sp*spg)**2) else zpas= zpa-rpm2 zpbs= zpb-rpm2 atpa= (zpas+spgs*zpa)/rpmg atpb= (zpbs+spgs*zpb)/rpmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (-atpb+atpa)/vpmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (-pi+atpb+atpa)/vpmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (-pih+atpb+atpa)/vpmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (pi-atpb-atpa)/vpmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (atpb-atpa)/vpmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (pih+atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (pih-atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (-pih+atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (atpb-atpa)/vpmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= vpmg*zpv sp= s0p/vv*(1.d0+spg*s07aaf(atnp,iftn)) if(iftn.ne.0) print 300 spjc= vv*spjc0 endif * if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spmm= sp-sm smmp= sm-sp * cbw= -1.d0+sp-sm ifcr= 0 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(bt1(2).ne.0.d0) then iz= 0 ifz(6)= ifz(6)+1 go to 1 endif * smtp= sm*sp ssmpp= ssm+ssp ssmmp= ssm-ssp asup= 1.d0-ssmpp*ssmpp asum= 1.d0-ssmmp*ssmmp if(asup.lt.0.d0.or.asum.lt.0.d0) then iz= 0 ifz(7)= ifz(7)+1 go to 1 endif rasup= sqrt(asup) rasum= sqrt(asum) * *-----initialization of su = M_0^2 * *-----limits on su from cuts on FS IMt * 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) * *-----test on su * if(suu.le.sul) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif * if(ih.eq.1.or.ih.eq.3) then rum2= rshm2 rumg= rshmg sugs= sshgs vumg= vshmg sug= sshg s0u= s0sh else if(ih.eq.2.or.ih.eq.4) then rum2= ram2 rumg= ramg sugs= sags vumg= vamg sug= sag s0u= s0a endif zuas= vv*sul-rum2 zubs= vv*suu-rum2 atua= (zuas+vv*sugs*sul)/rumg atub= (zubs+vv*sugs*suu)/rumg if(atua.gt.1.d0.and.atub.gt.1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vumg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vumg sujc0= (-atub+atua)/vumg else if(atua.gt.1.d0.and.atub.lt.-1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vumg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vumg sujc0= (-pi+atub+atua)/vumg else if(atua.gt.1.d0.and.abs(atub).lt.1.d0) then atua= 1.d0/atua atua= atan(atua) zuat= (pih-atua)/vumg atub= atan(atub) zubt= atub/vumg sujc0= (-pih+atub+atua)/vumg else if(atua.lt.-1.d0.and.atub.gt.1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vumg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vumg sujc0= (pi-atub-atua)/vumg else if(atua.lt.-1.d0.and.atub.lt.-1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vumg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vumg sujc0= (atub-atua)/vumg else if(atua.lt.-1.d0.and.abs(atub).lt.1.d0) then atua= -1.d0/atua atua= atan(atua) zuat= (-pih+atua)/vumg atub= atan(atub) zubt= atub/vumg sujc0= (pih+atub-atua)/vumg else if(abs(atua).lt.1.d0.and.atub.gt.1.d0) then atua= atan(atua) zuat= atua/vumg atub= 1.d0/atub atub= atan(atub) zubt= (pih-atub)/vumg sujc0= (pih-atub-atua)/vumg else if(abs(atua).lt.1.d0.and.atub.lt.-1.d0) then atua= atan(atua) zuat= atua/vumg atub= -1.d0/atub atub= atan(atub) zubt= (-pih+atub)/vumg sujc0= (-pih+atub-atua)/vumg else if(abs(atua).lt.1.d0.and.abs(atub).lt.1.d0) then atua= atan(atua) zuat= atua/vumg atub= atan(atub) zubt= atub/vumg sujc0= (atub-atua)/vumg endif * zuv= sujc0*sux+zuat iftn= 1 atnu= vumg*zuv su= s0u/vv*(1.d0+sug*s07aaf(atnu,iftn)) if(iftn.ne.0) print 300 * sujc= vv*sujc0 if(su.lt.0.d0) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * sdlim1= rrl(3) sdlim2= 1.d0-rrr(2)-rrr(5)-sm-sp-su sdlim= dmax1(sdlim1,sdlim2) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim3= 1.d0-rrl(2)-rrl(5)-sm-sp-su sduim= dmin1(sduim1,sduim2,sduim3) * *-----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) * *-----test on sd * if(sdu.le.sdl) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * if(ih.eq.1.or.ih.eq.3) then rdm2= ram2 rdmg= ramg sdgs= sags vdmg= vamg sdg= sag s0d= s0a else if(ih.eq.2.or.ih.eq.4) then rdm2= rshm2 rdmg= rshmg sdgs= sshgs vdmg= vshmg sdg= sshg s0d= s0sh endif zdas= vv*sdl-rdm2 zdbs= vv*sdu-rdm2 atda= (zdas+vv*sdgs*sdl)/rdmg atdb= (zdbs+vv*sdgs*sdu)/rdmg if(atda.gt.1.d0.and.atdb.gt.1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vdmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vdmg sdjc0= (-atdb+atda)/vdmg else if(atda.gt.1.d0.and.atdb.lt.-1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vdmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vdmg sdjc0= (-pi+atdb+atda)/vdmg else if(atda.gt.1.d0.and.abs(atdb).lt.1.d0) then atda= 1.d0/atda atda= atan(atda) zdat= (pih-atda)/vdmg atdb= atan(atdb) zdbt= atdb/vdmg sdjc0= (-pih+atdb+atda)/vdmg else if(atda.lt.-1.d0.and.atdb.gt.1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vdmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vdmg sdjc0= (pi-atdb-atda)/vdmg else if(atda.lt.-1.d0.and.atdb.lt.-1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vdmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vdmg sdjc0= (atdb-atda)/vdmg else if(atda.lt.-1.d0.and.abs(atdb).lt.1.d0) then atda= -1.d0/atda atda= atan(atda) zdat= (-pih+atda)/vdmg atdb= atan(atdb) zdbt= atdb/vdmg sdjc0= (pih+atdb-atda)/vdmg else if(abs(atda).lt.1.d0.and.atdb.gt.1.d0) then atda= atan(atda) zdat= atda/vdmg atdb= 1.d0/atdb atdb= atan(atdb) zdbt= (pih-atdb)/vdmg sdjc0= (pih-atdb-atda)/vdmg else if(abs(atda).lt.1.d0.and.atdb.lt.-1.d0) then atda= atan(atda) zdat= atda/vdmg atdb= -1.d0/atdb atdb= atan(atdb) zdbt= (-pih+atdb)/vdmg sdjc0= (-pih+atdb-atda)/vdmg else if(abs(atda).lt.1.d0.and.abs(atdb).lt.1.d0) then atda= atan(atda) zdat= atda/vdmg atdb= atan(atdb) zdbt= atdb/vdmg sdjc0= (atdb-atda)/vdmg endif * zdv= sdjc0*sdx+zdat iftn= 1 atnd= vdmg*zdv sd= s0d/vv*(1.d0+sdg*s07aaf(atnd,iftn)) if(iftn.ne.0) print 300 sdjc= vv*sdjc0 * if(sd.lt.0.d0) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif ssd= sqrt(sd) sdmu= sd-su sdmus= (1.d0+sdmu)*(1.d0+sdmu) * *-----initialization of sf = m^2 * *-----limits on sf from cuts on FS IM * sflim1= rrl(2) sfuim1= rrr(2) bsg= sm+sp+su+sd ombsg= 1.d0-bsg sflim2= ombsg-rrr(5) sfuim2= ombsg-rrl(5) sflim= dmax1(sflim1,sflim2) sfuim= dmin1(sfuim1,sfuim2) * *-----limits on sf from cuts on SA * tcuts= ss(1)-ss(2)+ss(3)-ss(4) tcutc= cs(1)-cs(2)+cs(3)-cs(4) if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfu= dmin1(sfuim,sfusa,sfusb) asfl= sflim else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa,sflsb) asfu= sfuim else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd- # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- # (ss(1)-ss(4))*sm)/tcuts sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd- # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- # (cs(1)-cs(4))*sm)/tcutc asfl= dmax1(sflim,sflsa) asfu= dmin1(sfuim,sfusa) endif else asfl= sflim asfu= sfuim endif * if(ieq.eq.0) then asfenl1= bl(1)-sm-sd asfenl2= bl(3)-sp-su asfenu1= 1.d0-bl(2)-sp-sd asfenu2= 1.d0-bl(4)-sm-su else if(ieq.eq.1) then asfenl1= 1.d0-enc-sm-sd+xbl(1) asfenl2= 1.d0-enc-sp-su+xbl(3) asfenu1= enc-sp-sd-xbl(2) asfenu2= enc-sm-su-xbl(4) endif asfl= dmax1(asfl,asfenl1,asfenl2) asfu= dmin1(asfu,asfenu1,asfenu2) aasfu= 1.d0-sm-sp-su-sd-sct24 asfl= dmax1(asfl,sct13) asfu= dmin1(asfu,aasfu) * if(iac(3).ne.0) then if(ss(4).ne.ss(3)) then if(ss(4).gt.ss(3)) then asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfl= dmax1(asfl,asfltw) else if (ss(4).lt.ss(3)) then asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) asfu= dmin1(asfu,asfutw) endif endif if(cs(1).ne.cs(2)) then if(cs(1).gt.cs(2)) then bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfl= dmax1(asfl,bsfltw) else if(cs(1).lt.cs(2)) then bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfu= dmin1(asfu,bsfutw) endif endif if(cs(4).ne.cs(3)) then if(cs(4).gt.cs(3)) then csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfu= dmin1(asfu,csfutw) else if(cs(4).lt.cs(3)) then csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfl= dmax1(asfl,csfltw) endif endif if(ss(1).ne.ss(2)) then if(ss(1).gt.ss(2)) then dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfu= dmin1(asfu,dsfutw) else if(ss(1).lt.ss(2)) then dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfl= dmax1(asfl,dsfltw) endif endif endif * *-----positivity of R^2 * scp= ssmpp*ssmpp scm= ssmmp*ssmmp snp= (ssu+ssd)*(ssu+ssd) snm= (ssu-ssd)*(ssu-ssd) rlp= ssu*ssd+ssp*ssm rlm= ssu*ssd-ssp*ssm bsgmo= bsg-1.d0 ombsg2= ombsg*ombsg rlps= rlp*rlp rlms= rlm*rlm edelp= ombsg2-4.d0*rlps edelm= ombsg2-4.d0*rlms edeld= 16.d0*ssu*ssd*ssp*ssm * *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2 * then Delta_+ > 0 * *-----control * cnt1= scp+snm cnt2= scm+snp if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif if(edelm.le.0.d0) then etest= edeld+edelp if(etest.gt.0.d0) then edelm= etest else iz= 0 ifz(11)= ifz(11)+1 go to 1 endif endif sedm= sqrt(edelm) ifcr= 0 call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) if(rr1(2).ne.0.d0) then iz= 0 ifz(12)= ifz(12)+1 go to 1 endif ifcr= 0 call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) * cnt3= scp+snp cnt4= scm+snm cbru= -1.d0 ccru= 0.5d0*bsg * *-----R^2 has two real roots and two complex conjugate roots * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then if(bsg.gt.0.5d0) then iel= 1 sflr(1)= rr1(1) sfur(1)= rr2(1) sflr(2)= rr1(1) sfur(2)= rr2(1) else iel= 2 ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sflr(2)= ru2 sfur(1)= ru1 sfur(2)= rr2(1) endif * *-----R^2 has four real roots * else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(bsg.gt.0.5d0) then sflr(1)= rr1(1) sflr(2)= rs2(1) sfur(1)= rs1(1) sfur(2)= rr2(1) else ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sfur(1)= dmin1(rs1(1),ru1) sflr(2)= dmax1(rs2(1),ru2) sfur(2)= rr2(1) endif endif * *-----the loop for transforming sf starts here * if(om.eq.'g') then itmn= it0 itmx= it0 else itmn= 1 itmx= 2 endif do it=itmn,itmx if(sflr(it).ge.asfl) then sfl= sflr(it) else sfl= asfl endif if(sfur(it).le.asfu) then sfu= sfur(it) else sfu= asfu endif * *-----test on sf * if(sfu.le.sfl) then iz= 0 ifz(13)= ifz(13)+1 go to 2 endif * *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then er= rs1(1) es= abs(rs1(2)) er1= rr1(1) er2= rr2(1) ek2= edelm/edeld ek= sqrt(ek2) dog= -2.d0/sqrt(edeld) ecpl= (ombsg-2.d0*sfl)/sedm ecpu= (ombsg-2.d0*sfu)/sedm eql= ecpl*ecpl equ= ecpu*ecpu omecpl= 2.d0*(sfl-er1)/sedm es2pl= omecpl*(2.d0-omecpl) erl= 1.d0-ek2*es2pl espl= sqrt(es2pl) opecpu= 2.d0*(er2-sfu)/sedm es2pu= opecpu*(2.d0-opecpu) espu= sqrt(es2pu) eru= 1.d0-ek2*es2pu if(eql.eq.1) then sflt= 0.d0 else ifel= 1 sflt= -dog*espl*s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(14)= ifz(14)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 sfut= -dog*espu*s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(15)= ifz(15)+1 go to 2 endif endif if(iel.eq.1) then if(sfu.le.er) then efac= 0.5d0 sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(16)= ifz(16)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(sfl.ge.er) then efac= 0.5d0 sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(17)= ifz(17)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) else efac= 1.d0 qbar= 0.d0 rbar= 1.d0-ek2 ifel= 1 sfbar= -dog*s21bbf(qbar,rbar,one,ifel) if(ifel.ne.0) then iz= 0 ifz(18)= ifz(18)+1 go to 2 endif if(it.eq.1) then sft= (sfbar-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(19)= ifz(19)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfbar-sflt) else if(it.eq.2) then sft= (sfbar-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(20)= ifz(20)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sfbar-sfut) endif endif else if(iel.eq.2) then efac= 1.d0 if(it.eq.1) then sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(21)= ifz(21)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(it.eq.2) then sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(22)= ifz(22)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) endif endif else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(edelp.le.0.d0) then iz= 0 ifz(23)= ifz(23)+1 go to 2 endif sedp= sqrt(edelp) efac= 1.d0 es1= rs1(1) es2= rs2(1) er1= rr1(1) er2= rr2(1) ssed= sedm+sedp ek= (sedm-sedp)/ssed ek2= ek*ek dog= 2.d0/ssed if(it.eq.1) then es2pl= (er1-sfl)/(sfl-er2)/ek es2pu= (er1-sfu)/(sfu-er2)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu else if(it.eq.2) then es2pl= (sfl-es2)/(sfl-es1)/ek es2pu= (sfu-es2)/(sfu-es1)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu endif if(eql.eq.1.d0) then sflt= 0.d0 else ifel= 1 sflt= 2.d0*dog*sqrt(es2pl)* # s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(24)= ifz(24)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then equ= 0.d0 endif sfut= 2.d0*dog*sqrt(es2pu)* # s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(25)= ifz(25)+1 go to 2 endif endif sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= 0.5d0/dog*sft call s21caf(asf,ek2,elsn,elcn,edn,ifel) elsn2= elsn*elsn if(ifel.ne.0) then iz= 0 ifz(26)= ifz(26)+1 go to 2 endif if(it.eq.1) then sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2) else if(it.eq.2) then sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) endif sfjc= efac*(sfut-sflt) endif * *-----auxiliary quantities * sdpf= sd+sf e3= sp+su+sf e4= 1.d0+spmm-e3 e3p4= 1.d0+spmm e1= sm+sdpf e2= 1.d0+smmp-e1 e1p2= 1.d0+smmp e1p3= e1+e3 e1m2= 2.d0*e1-1.d0+spmm ep12= xp*e1*e2 ep1= xp*e1 ep2= xp*e2 ep3= xp*e3 ep4= xp*e4 e1t2= e1*e2 e1t3= e1*e3 e1t4= e1*e4 e2t3= e2*e3 e2t4= e2*e4 e3t4= e3*e4 if((e1p3*e1p3-4.d0*sf).lt.0.d0) then iz= 0 ifz(27)= ifz(27)+1 go to 2 endif skl2= sqrt(e1p3*e1p3-4.d0*sf) if((sdmus-4.d0*sd).lt.0.d0) then iz= 0 ifz(28)= ifz(28)+1 go to 2 endif skl3= sdmus-4.d0*sd skl3= sqrt(skl3) * *-----initialization of t_w * *-----limits on tw from positivity and SA * twlp1= 0.d0 twlp2= smmp twlp3= spmm-1.d0 twlp= dmax1(twlp1,twlp2,twlp3) twup= 1.d0 * *-----limits on tw from cuts on SA * if(iac(3).ne.0) then skl2m= 0.5d0*(e1p3-skl2) skl2p= 0.5d0*(e1p3+skl2) skl3p= -0.5d0*(1.d0+sdmu-skl3) skl3m= -0.5d0*(1.d0+sdmu+skl3) twlsa1= 1.d0-cs(3)*e3-cs(4)*e4 twlsa2= ss(1)*e1+ss(2)*e2 twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m twusa1= 1.d0-ss(3)*e3-ss(4)*e4 twusa2= cs(1)*e1+cs(2)*e2 twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4, # twlsa5,twlsa6) atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, # twusa5,twusa6) else atwl= twlp atwu= twup endif * *-----limits on tw from E * if(ieq.eq.1) then atwle= 1.d0-bxe*e3p4+bl(3)+bl(4) atwue= bxe*e1p2-bl(1)-bl(2) if(xdf.gt.0.d0) then twle= atwle twue= atwue else if(xdf.lt.0.d0) then atwle1= bxe*e1-bl(1) atwle2= bxe*e2-bl(2) atwue1= 1.d0-bxe*e3+bl(3) atwue2= 1.d0-bxe*e4+bl(4) twle= dmax1(atwue,atwle1,atwle2) twue= dmin1(atwle,atwue1,atwue2) endif atwl= dmax1(atwl,twle) atwu= dmin1(atwu,twue) endif * *-----natural limits on tw * atwl= dmax1(atwl,bt1(1)) atwu= dmin1(atwu,bt2(1)) * *-----test on tw * if(atwu.le.atwl) then iz= 0 ifz(29)= ifz(29)+1 go to 2 endif * twjc= atwu-atwl tw= twjc*twx+atwl pn= tw+sp-1.d0 omtw= 1.d0-tw * *-----initialization of t1 * *-----limits on t1 from positivity+SA * t1lp1= 0.d0 t1lp2= pn+sdpf t1up1= tw t1up2= sm+sdpf t1lp= dmax1(t1lp1,t1lp2) t1up= dmin1(t1up1,t1up2) * *-----limits on t1 from cuts on SA * if(iac(3).ne.0) then t1lc1= ss(1)*e1 t1lc2= tw-cs(2)*e2 t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3 t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 t1uc1= cs(1)*e1 t1uc2= tw-ss(2)*e2 t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3)) t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3 t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4 t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6) t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6) at1l= dmax1(t1lp,t1lc) at1u= dmin1(t1up,t1uc) else at1l= t1lp at1u= t1up endif * *-----limits on t1 from E * if(ieq.eq.1) then at1le= tw-bxe*e2+bl(2) at1ue= bxe*e1-bl(1) if(xdf.gt.0.d0) then t1le= at1le t1ue= at1ue else t1le= at1ue t1ue= at1le endif at1l= dmax1(at1l,t1le) at1u= dmin1(at1u,t1ue) endif * *-----positivity of (R')^2 / reality of roots for t3 * rp0= e1p2*e1p2-4.d0*sm if(rp0.lt.0.d0) then iz= 0 ifz(30)= ifz(30)+1 go to 2 endif srp0= sqrt(rp0) rp0e= -rp0 rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 rp1e= 2.d0*rp1 rp2= -(e1*tw-sm)*(e1*tw-sm) if(rp0e.eq.0.d0) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif ifct= 0 if(rp0e.ne.0.d0) then call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) t1l= dmax1(at1l,ret1(1)) t1u= dmin1(at1u,ret2(1)) else if(rp0e.eq.0.d0) then sret1= -rp2/rp1e if(rp1e.gt.0.d0) then t1l= dmax1(at1l,sret1) t1u= at1u else if(rp1e.lt.0.d0) then t1l= at1l t1u= dmin1(at1u,sret1) endif endif * *-----test on t1 * if(t1u.le.t1l) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif * *-----transformation for jacobian * if(rp0e.eq.0.d0) then taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2) taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) t1jc= taut-taul t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e endif if(ret1(1).eq.t1l) then at1tl= -pih/srp0 else bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) ifas= 1 at1tl= -s09aaf(bt1tl,ifas)/srp0 if(ifas.ne.0) print 200 endif if(ret2(1).eq.t1u) then at1tu= pih/srp0 else bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) ifas= 1 at1tu= -s09aaf(bt1tu,ifas)/srp0 if(ifas.ne.0) print 200 endif if((at1tl+at1tu).eq.0.d0) then if(t1x.lt.1.d-3) then arc= pi*t1x arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc else if((1.d0-t1x).lt.1.d-3) then arc= pi*(1.d0-t1x) arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc else carc= cos(pi*t1x) t1= 0.5d0*(ret1(1)+ret2(1))+ # 0.5d0*(ret1(1)-ret2(1))*carc endif t1jc= pi/srp0 else t1tl= dmin1(at1tl,at1tu) t1tu= dmax1(at1tl,at1tu) t1jc= t1tu-t1tl t1t= t1jc*t1x+t1tl t1= (rp1+rpds*sin(srp0*t1t))/rp0 endif t1s= t1*t1 * 200 format(' Unsuccesful call to S09AAF ') * *-----test on t1 from FS A * if(ieq.eq.1.and.iac(4).ne.0.d0) then cnlct1= xp*(xm*sm-ep12*cg12)+xdf* # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1- # xdf*tw)+xdfs*cg12*t1s cnlst1= xp*(ep12*sg12-xm*sm)-xdf* # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ # xdf*tw)-xdfs*sg12*t1s if(cnlct1.lt.0.d0) then iz= 0 ifz(32)= ifz(32)+1 go to 2 else if(cnlst1.lt.0.d0) then iz= 0 ifz(33)= ifz(33)+1 go to 2 endif endif * *-----some vector components * t2= tw-t1 * *-----equation for xi is solved * e1s= e1*e1 e2s= e2*e2 e3s= e3*e3 e12= e1t2-2.d0*sm e13= e1t3-2.d0*sf e23= e2t3-2.d0*su e12s= e12*e12 e13s= e13*e13 e23s= e23*e23 xia= e1s*e2s-e12s xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ # e2*e12*e13 xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13* # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 xib= 2.d0*xib if(xia.eq.0.d0) then if(xib.eq.0.d0) then iz= 0 ifz(34)= ifz(34)+1 go to 2 endif rtm(1)= -xic/xib rtp(1)= rtm(1) rtm(2)= 0.d0 rtp(2)= 0.d0 ixia= 0 else ixia= 1 ifc0= 0 call c02ajf(xia,xib,xic,rtm,rtp,ifc0) endif if(rtm(2).ne.0.d0) then iz= 0 ifz(35)= ifz(35)+1 go to 2 endif * *-----xi^+ and xi^- are computed * xip= 0.5d0*(e3-rtp(1)) xim= 0.5d0*(e3-rtm(1)) * *-----each integral becomes a sum of two terms * *-----loop over ix starts here * if(om.eq.'g') then ixmn= ix0 ixmx= ix0 else ixmn= 1 ixmx= 2 endif do ix=ixmn,ixmx * *-----q_3 is compared and x15 is selected * if(ix.eq.1) then t3= xip else if(ix.eq.2) then t3= xim endif * *-----The two integrands are computed * *-----further auxiliary quantities * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 edn3= ep3-xdf*t3 t4= omtw-t3 edn4= ep4-xdf*t4 * *-----collections of all limits on t3 * *-----from energy (or natural limits) * if(ieq.eq.1) then at3l1= omtw-bxe*e4+bl(4) at3u1= bxe*e3-bl(3) if(xdf.gt.0.d0) then t3l1= at3l1 t3u1= at3u1 else if(xdf.lt.0.d0) then t3l1= at3u1 t3u1= at3l1 endif else t3l1= 0.d0 t3u1= e3 endif * *-----natural limits * t3l2= -t1+0.5d0*(e1p3-skl2) t3u2= -t1+0.5d0*(e1p3+skl2) * t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3) * *-----from positivity on SA * t3l4= 0.d0 t3l5= sm+su+sf-tw t3u4= sp+su+sf t3u5= omtw * *-----from SA * if(iac(3).ne.0) then t3l6= ss(3)*e3 t3u6= cs(3)*e3 t3l7= omtw-cs(4)*e4 t3u7= omtw-ss(4)*e4 t3l= dmax1(t3l1,t3l2,t3l3,t3l4, # t3l5,t3l6,t3l7) t3u= dmin1(t3u1,t3u2,t3u3,t3u4, # t3u5,t3u6,t3u7) else t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5) endif * *-----limits on t3 are imposed * tlimt3= (t3u-t3)*(t3-t3l) if(t3u.lt.t3l) then iz= 0 ifz(36)= ifz(36)+1 go to 4 else if(tlimt3.lt.0.d0) then iz= 0 ifz(36)= ifz(36)+1 go to 4 endif * *-----non linear limits on t3,t4 are imposed * if(iac(4).ne.0.and.ieq.eq.1) then tnl13c= -cg13*edn1*edn3+vv*sf tnl13s= sg13*edn1*edn3-vv*sf tnl23c= -cg23*edn2*edn3+vv*su tnl23s= sg23*edn2*edn3-vv*su tnl14c= -cg14*edn1*edn4+vv*sd tnl14s= sg14*edn1*edn4-vv*sd sres= 1.d0-e1-e3+sf tnl24c= -cg24*edn2*edn4+vv*sres tnl24s= sg24*edn2*edn4-vv*sres tnl34c= -cg34*edn3*edn4+vv*sp tnl34s= sg34*edn3*edn4-vv*sp if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or. # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then iz= 0 ifz(37)= ifz(37)+1 go to 4 endif endif * *-----non linear constraints from FS A in the case xp = xm * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(38)= ifz(38)+1 go to 4 endif endif * *-----all invariants * x13= t1 x14= t2 x15= t3 x16= t4 x23= e1-t1 x24= e2-t2 x25= e3-t3 x26= e4-t4 x34= sm x35= sf x36= sd x45= su x46= 1.d0-e1-e3+sf x56= sp * *-----computes cross-section * *-----born matrix element is calculated at the reduced c.m. energy * *-----The epsilons are computed in the order * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4), * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4), * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) * x13s= x13*x13 x14s= x14*x14 x15s= x15*x15 x16s= x16*x16 x23s= x23*x23 x24s= x24*x24 x25s= x25*x25 x26s= x26*x26 x34s= x34*x34 x35s= x35*x35 x36s= x36*x36 x45s= x45*x45 x46s= x46*x46 x56s= x56*x56 * ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s-x35s ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+ # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+ # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- # x15s*x34s ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+ # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- # x25s*x34s * e(1)= 1.d0 e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0* # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45- # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35- # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45 e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13* # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+ # x25*x34s * *-----sign of eps_1*eps_i * ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo * if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= ses2 s3= -ses1-ses2 s4= ses3 s5= ses1-ses3 s6= ses2+ses3 s7= ses4 s8= ses1-ses4 s9= ses2+ses4 s10= ses3-ses4 s11= ses5 s12= -ses1-ses5 s13= -ses2+ses5 s14= -ses3-ses5 s15= -ses4-ses5 else ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s-x36s ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+ # x16*x24*x46)-x14s*x26s-x16s*x24s-x46s ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ # x14*x16*x34*x36)-x13s*x46s-x14s*x36s- # x16s*x34s ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- # x26s*x34s e(1)= 1.d0 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23*x34- # x13s*x24*x26-x34*x36 e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13* # x24*x46-x14*x16*x23*x24+x14*(-x23* # x46+2.d0*x24*x36-x26*x34)-x16*x24* # x34+x14s*x23*x26+x34*x46 e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26* # x34)+x13*x16*x24*x34+x13*x34*x46+ # x14*x16*x23*x34+x14*x34*x36-x16* # x34s-x13s*x24*x46-x14s*x23*x36 e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36* # x24s)+x14*(-x23*x24*x36-x23*x26* # x34+x46*x23s)+x16*2.d0*x23*x24*x34- # x23*x34*x46-x24*x34*x36+x26*x34s ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= -ses1-ses2 s3= ses2 s4= -ses1-ses3 s5= ses3 s6= -ses2-ses3 s7= ses1-ses4 s8= ses4 s9= -ses2-ses4 s10= -ses3+ses4 s11= -ses1-ses5 s12= ses5 s13= ses2-ses5 s14= ses3+ses5 s15= ses4+ses5 else ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s- # x35s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s- # x36s ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+ # x16*x25*x56)-x15s*x26s-x16s*x25s- # x56s ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35* # x56+x15*x16*x35*x36)-x13s*x56s- # x15s*x36s-x16s*x35s ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35* # x56+x25*x26*x35*x36)-x23s*x56s- # x25s*x36s-x26s*x35s * e(1)= x13*x14*x23*x25+x13*x15*x23*x24+ # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- # x14*x15*x23s+x14*x23*x35+x15*x23* # x34-x13s*x24*x25-x34*x35 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23* # x34-x13s*x24*x26-x34*x36 e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+ # x13*(-x25*x46+x26*x45)+x14*x15*x23* # x26-x14*x16*x23*x25+x14*(x25*x36-x26* # x35)+x15*(-x23*x46+x24*x36)+x16*(x23* # x45-x24*x35)+x35*x46-x36*x45 e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ # x25*x34)+x13*(x35*x46-x36*x45)-x14* # x15*x23*x36+x14*x16*x23*x35+x15*x34* # x36-x16*x34*x35+x13s*(-x25*x46+x26* # x45) e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* # x36-x24*x26*x35)+x15*(-x23*x24*x36- # x23*x26*x34+x46*x23s)+x16*(x23*x24* # x35+x23*x25*x34-x45*x23s)-x23*x35* # x46+x23*x36*x45-x25*x34*x36+x26*x34* # x35 * ises= 0 do i=1,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= -ses1-ses2 s2= ses1 s3= ses2 s4= -ses1+ses3 s5= -ses2-ses3 s6= ses3 s7= -ses1+ses4 s8= -ses2-ses4 s9= ses4 s10= ses3-ses4 s11= ses1+ses5 s12= ses2-ses5 s13= ses5 s14= -ses3-ses5 s15= -ses4-ses5 else iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif endif * xaa= 1.d0/x15/x25 xab= x25/x15 xac= 1.d0/xab xad= 1.d0/xaa xba= x45/x36 xbb= x36*x45 xbc= x36/x45 xbd= 1.d0/x14/x24 xca= x14/x24 xcb= 1.d0/xca xcc= 1.d0/xbd xcd= 1.d0/x15/x24 xda= x15/x24 xdb= 1.d0/xda xdc= 1.d0/xcd xdd= 1.d0/x34/x46 xef= x34/x46 xeg= x46/x34 xeh= 1.d0/xdd xfe= 1.d0/x14/x25 xff= x14/x25 xfg= x25/x14 xfh= 1.d0/xfe tgn(1)= xaa*xba tgn(2)= xaa*xbb tgn(3)= xaa*xbc tgn(4)= xaa/xbb tgn(5)= xab*xba tgn(6)= xac/xbb tgn(7)= xab/xbb tgn(8)= xad/xbb tgn(9)= xab*xbb tgn(10)= xab*xbc tgn(11)= xac*xba tgn(12)= xac*xbc tgn(13)= xac*xbb tgn(14)= xad*xbb tgn(15)= xbd*xba tgn(16)= xbd*xbb tgn(17)= xbd*xbc tgn(18)= xbd/xbb tgn(19)= xcb*xba tgn(20)= xca/xbb tgn(21)= xcb/xbb tgn(22)= xbd/xbb tgn(23)= xcb*xbb tgn(24)= xcb*xbc tgn(25)= xca*xba tgn(26)= xca*xbc tgn(27)= xca*xbb tgn(28)= xbd*xbb tgn(29)= xcd*xeg tgn(30)= xcd*xeh tgn(31)= xcd*xef tgn(32)= xcd*xdd tgn(33)= xdb*xeg tgn(34)= xda*xdd tgn(35)= xdb*xdd tgn(36)= xdc*xdd tgn(37)= xdb*xeh tgn(38)= xdb*xef tgn(39)= xda*xeg tgn(40)= xda*xef tgn(41)= xda*xeh tgn(42)= xdc*xeh tgn(43)= xdc*xef tgn(44)= xfe*xeg tgn(45)= xfe*xeh tgn(46)= xfe*xef tgn(47)= xfe*xdd tgn(48)= xfg*xeg tgn(49)= xff*xdd tgn(50)= xfg*xdd tgn(51)= xfh*xdd tgn(52)= xfg*xeh tgn(53)= xfg*xef tgn(54)= xff*xeg tgn(55)= xff*xef tgn(56)= xff*xeh tgn(57)= xfh*xeh tgn(58)= xfh*xef itgn= 0 do l=1,58 if(tgn(l).le.0.d0) then itgn= itgn+1 endif enddo if(itgn.ne.0) then iz= 0 ifz(40)= ifz(40)+1 go to 4 endif * gh1= sqrt(tgn(1)) gh2= sqrt(tgn(2)) gh3= sqrt(tgn(3)) gh4= sqrt(tgn(4)) gh5= sqrt(tgn(5)) gh6= sqrt(tgn(6)) gh7= sqrt(tgn(7)) gh8= sqrt(tgn(8)) gh9= sqrt(tgn(9)) gh10= sqrt(tgn(10)) gh11= sqrt(tgn(11)) gh12= sqrt(tgn(12)) gh13= sqrt(tgn(13)) gh14= sqrt(tgn(14)) gh15= sqrt(tgn(15)) gh16= sqrt(tgn(16)) gh17= sqrt(tgn(17)) gh18= sqrt(tgn(18)) gh19= sqrt(tgn(19)) gh20= sqrt(tgn(20)) gh21= sqrt(tgn(22)) gh22= sqrt(tgn(22)) gh23= sqrt(tgn(23)) gh24= sqrt(tgn(24)) gh25= sqrt(tgn(25)) gh26= sqrt(tgn(26)) gh27= sqrt(tgn(27)) gh28= sqrt(tgn(28)) gh29= sqrt(tgn(29)) gh30= sqrt(tgn(30)) gh31= sqrt(tgn(31)) gh32= sqrt(tgn(32)) gh33= sqrt(tgn(33)) gh34= sqrt(tgn(34)) gh35= sqrt(tgn(35)) gh36= sqrt(tgn(36)) gh37= sqrt(tgn(37)) gh38= sqrt(tgn(38)) gh39= sqrt(tgn(39)) gh40= sqrt(tgn(40)) gh41= sqrt(tgn(41)) gh42= sqrt(tgn(42)) gh43= sqrt(tgn(43)) gh44= sqrt(tgn(44)) gh45= sqrt(tgn(45)) gh46= sqrt(tgn(46)) gh47= sqrt(tgn(47)) gh48= sqrt(tgn(48)) gh49= sqrt(tgn(49)) gh50= sqrt(tgn(50)) gh51= sqrt(tgn(51)) gh52= sqrt(tgn(52)) gh53= sqrt(tgn(53)) gh54= sqrt(tgn(54)) gh55= sqrt(tgn(55)) gh56= sqrt(tgn(56)) gh57= sqrt(tgn(57)) gh58= sqrt(tgn(58)) * vj= sqrt(vv**3) hb(1)= vj*ver hb(2)= vj*vel * *-----Compensating propagators * cpc1r= (sp-rshm2/vv)*(sm-ram2/vv)-sm*sp*sshg*sag cpc1i= (sp-rshm2/vv)*sm*sag+(sm-ram2/vv)*sp*sshg cpc2r= (sm-rshm2/vv)*(sp-ram2/vv)-sm*sp*sshg*sag cpc2i= (sm-rshm2/vv)*sp*sag+(sp-ram2/vv)*sm*sshg cpd1r= (su-rshm2/vv)*(sd-ram2/vv)-su*sd*sshg*sag cpd1i= (su-rshm2/vv)*sd*sag+(sd-ram2/vv)*su*sshg cpd2r= (sd-rshm2/vv)*(su-ram2/vv)-su*sd*sshg*sag cpd2i= (sd-rshm2/vv)*su*sag+(su-ram2/vv)*sd*sshg * cpc1s= cpc1r*cpc1r+cpc1i*cpc1i cpc2s= cpc2r*cpc2r+cpc2i*cpc2i cpd1s= cpd1r*cpd1r+cpd1i*cpd1i cpd2s= cpd2r*cpd2r+cpd2i*cpd2i pref= (cpc1s+cpc2s)*(cpd1s+cpd2s) pref= 1.d0/pref * cfc12r= cpc1r*cpc2r-cpc1i*cpc2i cfc12i= cpc1r*cpc2i+cpc1i*cpc2r cfd12r= cpd1r*cpd2r-cpd1i*cpd2i cfd12i= cpd1r*cpd2i+cpd1i*cpd2r cfc12d1r= cfc12r*cpd1r-cfc12i*cpd1i cfc12d1i= cfc12r*cpd1i+cfc12i*cpd1r cfc12d2r= cfc12r*cpd2r-cfc12i*cpd2i cfc12d2i= cfc12r*cpd2i+cfc12i*cpd2r * cfd12c1r= cfd12r*cpc1r-cfd12i*cpc1i cfd12c1i= cfd12r*cpc1i+cfd12i*cpc1r cfd12c2r= cfd12r*cpc2r-cfd12i*cpc2i cfd12c2i= cfd12r*cpc2i+cfd12i*cpc2r * *-----Diagrams: * *-----helicity h1-2) * d12h12r= gh1*(-0.5d0*x13*x24*x56+0.5d0*x13*x26*x35+0.5d0* # x13*x26*x45-0.5d0*x13*x26*x56+0.5d0*x14*x23*x56- # 0.5d0*x14*x26*x35-0.5d0*x16*x23*x35-0.5d0*x16*x23* # x45+0.5d0*x16*x23*x56+0.5d0*x16*x24*x35+0.5d0*x34* # x56-0.5d0*x35*x46)+gh2*(0.5d0*x35+0.5d0*x45-0.5d0* # x56)+gh4*(-0.5d0*x13*x24*x35*x56+0.5d0*x13*x24*x56s+ # 0.5d0*x14*x23*x35*x56-0.5d0*x14*x23*x56s+0.5d0*x14* # x26*x35*x56-0.5d0*x14*x26*x35s-0.5d0*x16*x24*x35*x56+ # 0.5d0*x16*x24*x35s+0.5d0*x34*x35*x56-0.5d0*x34*x56s+ # 0.5d0*x35*x46*x56-0.5d0*x35s*x46)+gh5*(-0.5d0*x13* # x46+0.5d0*x16*x34)+gh6*(-x23*x34*x56+0.5d0*x23*x35* # x46+0.5d0*x23*x46*x56+0.5d0*x26*x34*x35+0.5d0*x26* # x34*x56-x26*x35*x46)+gh7*(0.5d0*x13*x35*x46-0.5d0* # x13*x46*x56-x14*x34*x56+x14*x35*x46-0.5d0*x16*x34* # x35+0.5d0*x16*x34*x56)+gh8*(x34*x56-x35*x46)+gh9* # (-x13-0.5d0*x14)+gh10*(0.5d0*x14*x35+0.5d0*x14*x56)+ # gh11*(0.5d0*x23*x46-0.5d0*x26*x34)+gh12*(-0.5d0* # x24*x35-0.5d0*x24*x56)+gh13*(-0.5d0*x24+x26)+gh14 d12h12i= s1*gh1*(2.d0*x56)+s2*gh2*(-4.d0)+ # s3*gh1*(2.d0*x35-2.d0*x56)+s4*gh3*(2.d0*x35+ # 2.d0*x56)+s6*gh1*(2.d0*x34)+s7*gh1*(-2.d0*x26)+ # s7*gh4*(-2.d0*x26*x35+2.d0*x26*x56)+s8*gh5*(2.d0)+ # s10*gh4*(2.d0*x23*x35-2.d0*x23*x56)+s12*gh6*(2.d0* # x35-2.d0*x56)+s13*gh1*(-2.d0*x14)+s13*gh4*(-2.d0* # x14*x35+2.d0*x14*x56)+s14*gh1*(2.d0*x13)+s15*gh6* # (-4.d0*x23+4.d0*x26)+s15*gh7*(-4.d0*x14)+s15*gh8* # (4.d0) * d1hr(1)= hb(1)*d12h12r d1hi(1)= hb(1)*d12h12i d1hr(2)= hb(2)*d12h12r d1hi(2)= -hb(2)*d12h12i d2hr(1)= -hb(1)*d12h12r d2hi(1)= -hb(1)*d12h12i d2hr(2)= -hb(2)*d12h12r d2hi(2)= hb(2)*d12h12i * d34h12r= gh2*(x35-x45+x56)+gh9*(-x13+x14-x16)+ # gh13*(-x23+x24-x26)+2.d0*gh14 d34h12i= -4.d0*s2*gh2+4.d0*s4*gh2+4.d0*s6*gh2 * d3hr(1)= hb(1)*d34h12r d3hi(1)= hb(1)*d34h12i d3hr(2)= hb(2)*d34h12r d3hi(2)= -hb(2)*d34h12i d4hr(1)= -hb(1)*d34h12r d4hi(1)= -hb(1)*d34h12i d4hr(2)= -hb(2)*d34h12r d4hi(2)= hb(2)*d34h12i * *-----helicity h3-4) * d12h34r= gh15*(-0.5d0*x13*x25*x46-0.5d0*x13*x26*x34+0.5d0* # x13*x26*x45+0.5d0*x13*x26*x46+0.5d0*x15*x23*x46- # 0.5d0*x15*x26*x34+0.5d0*x16*x23*x34-0.5d0*x16*x23* # x45-0.5d0*x16*x23*x46+0.5d0*x16*x25*x34+0.5d0*x34* # x56-0.5d0*x35*x46)+gh16*(-0.5d0*x34+0.5d0*x45+0.5d0* # x46)+gh18*(0.5d0*x13*x25*x34*x46-0.5d0*x13*x25*x46s- # 0.5d0*x15*x23*x34*x46+0.5d0*x15*x23*x46s-0.5d0*x15* # x26*x34*x46+0.5d0*x15*x26*x34s+0.5d0*x16*x25*x34*x46- # 0.5d0*x16*x25*x34s+0.5d0*x34*x35*x46+0.5d0*x34*x46* # x56-0.5d0*x34s*x56-0.5d0*x35*x46s)+gh19*(-0.5d0* # x13*x56+0.5d0*x16*x35)+gh20*(0.5d0*x23*x34*x56- # 0.5d0*x23*x46*x56-x25*x34*x56+x25*x35*x46-0.5d0* # x26*x34*x35+0.5d0*x26*x35*x46)+gh21*(0.5d0*x13* # x34*x56-x13*x35*x46+0.5d0*x13*x46*x56+0.5d0*x16* # x34*x35-x16*x34*x56+0.5d0*x16*x35*x46)+gh22*(x34* # x56-x35*x46)+gh23*(x13-0.5d0*x15)+gh24*(-0.5d0* # x15*x34-0.5d0*x15*x46)+gh25*(0.5d0*x23*x56-0.5d0* # x26*x35)+gh26*(0.5d0*x25*x34+0.5d0*x25*x46)+gh27* # (-0.5d0*x25-x26)+gh28 d12h34i= s1*gh15*(-2.d0*x56)+s3*gh15*(2.d0*x34+2.d0*x46)+ # s4*gh17*(-2.d0*x34)+s5*gh18*(-2.d0*x35*x46)+ # s6*gh15*(-2.d0*x34)+s6*gh18*(2.d0*x34*x46)+ # s7*gh15*(2.d0*x26)+s7*gh18*(-2.d0*x26*x46)+ # s8*gh15*(-2.d0*x25+4.d0*x26)+s8*gh18*(2.d0* # x25*x34)+s9*gh21*(-2.d0*x34)+s11*gh18*(-2.d0* # x16*x34-2.d0*x16*x46)+s13*gh25*(2.d0)+s14*gh15* # (-2.d0*x13)+s14*gh18*(2.d0*x13*x34+4.d0*x16*x34)+ # s15*gh18*(-2.d0*x46)+s15*gh20*(4.d0*x25)+s15* # gh21*(-4.d0*x13)+s15*gh22*(-4.d0) * d1hr(3)= hb(1)*d12h34r d1hi(3)= hb(1)*d12h34i d1hr(4)= hb(2)*d12h34r d1hi(4)= -hb(2)*d12h34i d2hr(3)= -hb(1)*d12h34r d2hi(3)= -hb(1)*d12h34i d2hr(4)= -hb(2)*d12h34r d2hi(4)= hb(2)*d12h34i * d34h34r= gh16*(-x34+x45-x46)+gh23*(x13-x15+x16)+ # gh27*(x23-x25+x26)-2.d0*gh28 d34h34i= 4.d0*s1*gh16+4.d0*s4*gh16-4.d0*s5*gh16 * d3hr(3)= hb(1)*d34h34r d3hi(3)= hb(1)*d34h34i d3hr(4)= hb(2)*d34h34r d3hi(4)= -hb(2)*d34h34i d4hr(3)= -hb(1)*d34h34r d4hi(3)= -hb(1)*d34h34i d4hr(4)= -hb(2)*d34h34r d4hi(4)= hb(2)*d34h34i * *-----helicity h5-6) * d12h56r= gh30*(0.5d0*x13*x25-x16*x25-0.5d0*x35+x56)+ # gh31*(-0.5d0*x13*x26*x45+0.5d0*x14*x23*x56- # 0.5d0*x14*x25*x36+0.5d0*x14*x26*x35-x14*x26*x56- # 0.5d0*x16*x23*x45+0.5d0*x16*x25*x34+x16*x26*x45- # 0.5d0*x34*x56+0.5d0*x36*x45)+gh38*(0.5d0*x13* # x56+x14*x56-0.5d0*x16*x35-x16*x45)+gh40*(-0.5d0* # x26*x34+x26*x45)+gh41*(0.5d0*x23-x25)+gh42+gh43* # (0.5d0*x36-x56) d12h56i= s2*gh30*(2.d0)+s5*gh31*(-2.d0*x35+4*x56)+ # s7*gh31*(2.d0*x26)+s9*gh38*(2.d0)+s10* # gh38*(4.d0)+s12*gh40*(-2.d0)+s14*gh31* # (2.d0*x13-4.d0*x16)+s14*gh40*(-4.d0) * d1hr(5)= hb(1)*d12h56r d1hi(5)= hb(1)*d12h56i d1hr(6)= hb(2)*d12h56r d1hi(6)= -hb(2)*d12h56i d2hr(5)= -hb(1)*d12h56r d2hi(5)= -hb(1)*d12h56i d2hr(6)= -hb(2)*d12h56r d2hi(6)= hb(2)*d12h56i d3hr(5)= 0.d0 d3hi(5)= 0.d0 d3hr(6)= 0.d0 d3hi(6)= 0.d0 d4hr(5)= 0.d0 d4hi(5)= 0.d0 d4hr(6)= 0.d0 d4hi(6)= 0.d0 * *-----helicity h7-8) * d34h78r= gh16*(-x34+x45-x46)+gh23*(x13-x15+x16)+ # gh27*(x23-x25+x26)-2.d0*gh28 d34h78i= 4.d0*s1*gh16+4.d0*s4*gh16-4.d0*s5*gh16 * d3hr(7)= hb(1)*d34h78r d3hi(7)= hb(1)*d34h78i d3hr(8)= hb(2)*d34h78r d3hi(8)= -hb(2)*d34h78i d4hr(7)= -hb(1)*d34h78r d4hi(7)= -hb(1)*d34h78i d4hr(8)= -hb(2)*d34h78r d4hi(8)= hb(2)*d34h78i d1hr(7)= 0.d0 d1hi(7)= 0.d0 d1hr(8)= 0.d0 d1hi(8)= 0.d0 d2hr(7)= 0.d0 d2hi(7)= 0.d0 d2hr(8)= 0.d0 d2hi(8)= 0.d0 * *-----helicity h9-10) * d12h910r= gh45*(0.5d0*x15*x23-x15*x26-0.5d0*x35+x56)+ # gh46*(0.5d0*x13*x24*x56-0.5d0*x13*x26*x45- # 0.5d0*x15*x24*x36+0.5d0*x15*x26*x34-0.5d0*x16* # x23*x45+0.5d0*x16*x24*x35-x16*x24*x56+x16*x26*x45- # 0.5d0*x34*x56+0.5d0*x36*x45)+gh52*(0.5d0*x13-x15)+ # gh53*(-0.5d0*x16*x34+x16*x45)+gh55*(0.5d0*x23* # x56+x24*x56-0.5d0*x26*x35-x26*x45)+gh57+gh58* # (0.5d0*x36-x56) d12h910i= s1*gh46*(2.d0*x56)+s2*gh45*(2.d0)+s3*gh46* # (-2.d0*x45)+s5*gh46*(4.d0*x56)+s10*gh46*(-2.d0* # x23+4.d0*x26)+s10*gh53*(4.d0)+s14*gh46*(-2.d0* # x13)+s14*gh55*(-4.d0)+s15*gh46*(2.d0) * d1hr(9)= hb(1)*d12h910r d1hi(9)= hb(1)*d12h910i d1hr(10)= hb(2)*d12h910r d1hi(10)= -hb(2)*d12h910i d2hr(9)= -hb(1)*d12h910r d2hi(9)= -hb(1)*d12h910i d2hr(10)= -hb(2)*d12h910r d2hi(10)= hb(2)*d12h910i d3hr(9)= 0.d0 d3hi(9)= 0.d0 d3hr(10)= 0.d0 d3hi(10)= 0.d0 d4hr(9)= 0.d0 d4hi(9)= 0.d0 d4hr(10)= 0.d0 d4hi(10)= 0.d0 * *-----helicity h11-12) * d34h1112r= gh2*(x35-x45+x56)+gh9*(-x13+x14-x16)+ # gh13*(-x23+x24-x26)+2.d0*gh14 d34h1112i= -4.d0*s2*gh2+4.d0*s4*gh2+4.d0*s6*gh2 * d3hr(11)= hb(1)*d34h1112r d3hi(11)= hb(1)*d34h1112i d3hr(12)= hb(2)*d34h1112r d3hi(12)= -hb(2)*d34h1112i d4hr(11)= -hb(1)*d34h1112r d4hi(11)= -hb(1)*d34h1112i d4hr(12)= -hb(2)*d34h1112r d4hi(12)= hb(2)*d34h1112i d1hr(11)= 0.d0 d1hi(11)= 0.d0 d1hr(12)= 0.d0 d1hi(12)= 0.d0 d2hr(11)= 0.d0 d2hi(11)= 0.d0 d2hr(12)= 0.d0 d2hi(12)= 0.d0 * do i=1,12 ad1hr(i)= rsz*d1hr(i) ad1hre(i)= -aisz*d1hi(i) ad1hie(i)= rsz*d1hi(i) ad1hi(i)= aisz*d1hr(i) ad2hr(i)= rsz*d2hr(i) ad2hre(i)= -aisz*d2hi(i) ad2hie(i)= rsz*d2hi(i) ad2hi(i)= aisz*d2hr(i) ad3hr(i)= rsz*d3hr(i) ad3hre(i)= -aisz*d3hi(i) ad3hie(i)= rsz*d3hi(i) ad3hi(i)= aisz*d3hr(i) ad4hr(i)= rsz*d4hr(i) ad4hre(i)= -aisz*d4hi(i) ad4hie(i)= rsz*d4hi(i) ad4hi(i)= aisz*d4hr(i) enddo * alpha1= -sbma*salpha/cbeta*tbeta alpha2= cbma*calpha/cbeta*tbeta alpha21= alpha2/alpha1 propm= (sm-rbhm2/vv)*(sm-rbhm2/vv)+(sm*sbhg)**2 propu= (su-rbhm2/vv)*(su-rbhm2/vv)+(su*sbhg)**2 propd= (sd-rbhm2/vv)*(sd-rbhm2/vv)+(sd*sbhg)**2 propp= (sp-rbhm2/vv)*(sp-rbhm2/vv)+(sp*sbhg)**2 addmr= 1.d0+alpha21/propm*((sm-rshm2/vv)*(sm-rbhm2/vv)+ # sm*sm*sbhg*sshg) addmi= alpha21/propm*sm*((sm-rshm2/vv)*sbhg-(sm-rbhm2/vv)*sshg) addpr= 1.d0+alpha21/propp*((sp-rshm2/vv)*(sp-rbhm2/vv)+ # sp*sp*sbhg*sshg) addpi= alpha21/propp*sp*((sp-rshm2/vv)*sbhg-(sp-rbhm2/vv)*sshg) addur= 1.d0+alpha21/propu*((su-rshm2/vv)*(su-rbhm2/vv)+ # su*su*sbhg*sshg) addui= alpha21/propu*su*((su-rshm2/vv)*sbhg-(su-rbhm2/vv)*sshg) adddr= 1.d0+alpha21/propd*((sd-rshm2/vv)*(sd-rbhm2/vv)+ # sd*sd*sbhg*sshg) adddi= alpha21/propd*sd*((sd-rshm2/vv)*sbhg-(sd-rbhm2/vv)*sshg) * do i=1,12 bd1hr(i)= addpr*ad1hr(i)-addpi*ad1hi(i) bd1hre(i)= addpr*ad1hre(i)-addpi*ad1hie(i) bd1hie(i)= addpr*ad1hie(i)+addpi*ad1hre(i) bd1hi(i)= addpr*ad1hi(i)+addpi*ad1hr(i) bd2hr(i)= addmr*ad2hr(i)-addmi*ad2hi(i) bd2hre(i)= addmr*ad2hre(i)-addmi*ad2hie(i) bd2hie(i)= addmr*ad2hie(i)+addmi*ad2hre(i) bd2hi(i)= addmr*ad2hi(i)+addmi*ad2hr(i) bd3hr(i)= adddr*ad3hr(i)-adddi*ad3hi(i) bd3hre(i)= adddr*ad3hre(i)-adddi*ad3hie(i) bd3hie(i)= adddr*ad3hie(i)+adddi*ad3hre(i) bd3hi(i)= adddr*ad3hi(i)+adddi*ad3hr(i) bd4hr(i)= addur*ad4hr(i)-addui*ad4hi(i) bd4hre(i)= addur*ad4hre(i)-addui*ad4hie(i) bd4hie(i)= addur*ad4hie(i)+addui*ad4hre(i) bd4hi(i)= addur*ad4hi(i)+addui*ad4hr(i) enddo * do i=1,12 cd1hr(i)= cfd12c2r*bd1hr(i)-cfd12c2i*bd1hi(i) cd1hre(i)= cfd12c2r*bd1hre(i)-cfd12c2i*bd1hie(i) cd1hie(i)= cfd12c2r*bd1hie(i)+cfd12c2i*bd1hre(i) cd1hi(i)= cfd12c2r*bd1hi(i)+cfd12c2i*bd1hr(i) cd2hr(i)= cfd12c1r*bd2hr(i)-cfd12c1i*bd2hi(i) cd2hre(i)= cfd12c1r*bd2hre(i)-cfd12c1i*bd2hie(i) cd2hie(i)= cfd12c1r*bd2hie(i)+cfd12c1i*bd2hre(i) cd2hi(i)= cfd12c1r*bd2hi(i)+cfd12c1i*bd2hr(i) cd3hr(i)= cfc12d2r*bd3hr(i)-cfc12d2i*bd3hi(i) cd3hre(i)= cfc12d2r*bd3hre(i)-cfc12d2i*bd3hie(i) cd3hie(i)= cfc12d2r*bd3hie(i)+cfc12d2i*bd3hre(i) cd3hi(i)= cfc12d2r*bd3hi(i)+cfc12d2i*bd3hr(i) cd4hr(i)= cfc12d1r*bd4hr(i)-cfc12d1i*bd4hi(i) cd4hre(i)= cfc12d1r*bd4hre(i)-cfc12d1i*bd4hie(i) cd4hie(i)= cfc12d1r*bd4hie(i)+cfc12d1i*bd4hre(i) cd4hi(i)= cfc12d1r*bd4hi(i)+cfc12d1i*bd4hr(i) enddo * *-----Total * hcf= rbqm2*s/wm2/16.d0/cth2*tbeta*salpha/cbeta*cbma hcfs= hcf*hcf do i=1,12 dthr(i)= 9.d0*(cd1hr(i)*cd1hr(i)+cd2hr(i)*cd2hr(i)+ # cd3hr(i)*cd3hr(i)+cd4hr(i)*cd4hr(i)+ # 2.d0*(cd1hr(i)*cd2hr(i)+cd3hr(i)*cd4hr(i)))+ # 6.d0*(cd1hr(i)+cd2hr(i))*(cd3hr(i)+cd4hr(i)) dthre(i)= 9.d0*(cd1hre(i)*cd1hre(i)+cd2hre(i)*cd2hre(i)+ # cd3hre(i)*cd3hre(i)+cd4hre(i)*cd4hre(i)+ # 2.d0*(cd1hre(i)*cd2hre(i)+cd3hre(i)*cd4hre(i)))+ # 6.d0*(cd1hre(i)+cd2hre(i))*(cd3hre(i)+cd4hre(i)) dthie(i)= 9.d0*(cd1hie(i)*cd1hie(i)+cd2hie(i)*cd2hie(i)+ # cd3hie(i)*cd3hie(i)+cd4hie(i)*cd4hie(i)+ # 2.d0*(cd1hie(i)*cd2hie(i)+cd3hie(i)*cd4hie(i)))+ # 6.d0*(cd1hie(i)+cd2hie(i))*(cd3hie(i)+cd4hie(i)) dthi(i)= 9.d0*(cd1hi(i)*cd1hi(i)+cd2hi(i)*cd2hi(i)+ # cd3hi(i)*cd3hi(i)+cd4hi(i)*cd4hi(i)+ # 2.d0*(cd1hi(i)*cd2hi(i)+cd3hi(i)*cd4hi(i)))+ # 6.d0*(cd1hi(i)+cd2hi(i))*(cd3hi(i)+cd4hi(i)) enddo dth= 0.d0 do i=1,12 dth= dth+dthr(i)+dthre(i)+dthie(i)+dthi(i) enddo dth= hcf*dth * 4 if(iz.eq.0) then dpxs(ix,it)= 0.d0 iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc*pref dpxs(ix,it)= 0.25d0*tjac*stf*dth/s endif * *-----end of ix loop * enddo * cpxs(it)= dpxs(1,it)+dpxs(2,it) * 2 if(iz.eq.0) then bpxs(it)= 0.d0 iz= 1 else bpxs(it)= cpxs(it) endif * *-----end on it loop * enddo * 1 if(iz.eq.0) then apxs= 0.d0 iz= 1 else apxs= bpxs(1)+bpxs(2) endif * if(apxs.lt.0.d0) then ifz(41)= ifz(41)+1 resf= 0.d0 else resf= apxs endif * if(oqcd.eq.'y') then nf= 5 alssh= wtoralphas(wm,shm,als,nf) alsa= wtoralphas(wm,am,als,nf) fqcd= 1.d0+17.d0/3.d0*(alssh+alsa)/pi else fqcd= 1.d0 endif * wtoxsa64= tfact*resf*bfact*fqcd * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(ostop.eq.'s') then ifp= ifl(jp) if(wtoxsa64.ne.0.d0.and.ifp.lt.5000) then stry(jp,ifp)= wtoxsa64 if(wtoxsa64.gt.xshmx(jp)) then xshmx(jp)= wtoxsa64 endif ifl(jp)= ifl(jp)+1 else if(wtoxsa64.ne.0.d0.and.ifp.gt.5000) then if(wtoxsa64.gt.xshmx(jp)) then stry(jp,ifp)= wtoxsa64 ifl(jp)= ifl(jp)+1 endif endif else if(wtoxsa64.gt.xshmx(jp)) then xshmx(jp)= wtoxsa64 do l=1,9 xmxh(jp,l)= x(l) enddo endif endif endif xaph(1)= xm xaph(2)= xp xaph(3)= sm xaph(4)= sp xaph(5)= su xaph(6)= sd xaph(7)= sf xaph(8)= tw xaph(9)= t1 xaph(10)= t3 endif * return end * *-----WTOXSC12--------------------------------------------------------- * real*8 function wtoxsc12(ndim,x) implicit real*8 (a-h,o-z) character*1 om,osm,ostop,oqcd,omssm character*4 otype * parameter(ninv=10,npos=512,ifmax=10000) * common/wtihl/ih common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wthiggs/hm common/wtsmod/osm common/wtim/ostop common/wtkount/ik common/wtdis/dist common/wtqcdz/alsz common/wtaqcd/oqcd common/wtbme/bfact common/wtistrf/isf common/wtsf/ix0,it0 common/wtchi/hch(36) common/wtipt/ifz(44) common/wtmssmo/omssm common/wtnf/ifl(npos) common/wticuts/iac(4) common/wtisa/isaa,isab common/wtochannel/otype common/wthx/xshmx(npos) common/wtparh/xaph(ninv) common/wtrmss/chcm2,chsm2 common/wttc/itc,itcc,itcn common/wtpmxh/xmxh(npos,9) common/wtmssmi/am,tbeta,rmu,scalm,bat,bab common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn 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/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) common/wtmssm/ams,shm,shms,bhm,bhms,sbeta,cbeta,salpha,calpha, # sbma,cbma,rshm,rshm2,rshg,rshmg,sshg,sshgs, # opsshgs,rbhm,rbhm2,rbhg,rbhmg,sbhg,sbhgs,opsbhgs, # ram,ram2,rag,ramg,sag,sags,opsags common/wtmssmc/chms,chm,rchm,rchm2,rchg,rchmg,schg,schgs,opschgs * dimension hb(4) dimension tgn(58) dimension x(ndim) dimension bt1(2),bt2(2) dimension rru1(2),rru2(2) dimension sfur(2),sflr(2) dimension ret1(2),ret2(2) dimension ee(5),e(5),sg(5) dimension rrr(6),rrl(6),srrl(6) dimension bl(4),xbl(4),ss(4),cs(4) dimension dpxs(2,2),cpxs(2),bpxs(2) dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2) * data ec2/-0.4999999963d0/,ec4/0.0416666418d0/, # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, # ec10/-0.0000002605d0/ * external c02ajf,s09aaf,s07aaf external s21bbf,s21caf * *-----the order of integration is: * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1 * * m_{+/-}^2 transformed for the resonating peaks * M_0^2,m_0^2 transformed for the resonating peaks * m^2 and t_1 transformed for the jacobian peaks * do ix=1,2 do it=1,2 dpxs(ix,it)= 0.d0 enddo enddo do it=1,2 cpxs(it)= 0.d0 bpxs(it)= 0.d0 enddo * if(ndim.eq.6) then smx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.8) 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(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 wm2= wm*wm * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * if(itc.eq.3) then omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) omul= dmin1(omul,omuld) endif if(uvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * if(itc.eq.3) then vvlld= (dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) vvll= dmax1(vvll,vvlld) endif * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vkf.eq.0.d0) then if(vvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vvx.eq.1.d0) then veps= 0.d0 else veps= uvl*(1.d0-vvx)**hbeti endif avkf= 1.d0 else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti avkf= 1.d0-vkf**hbet endif vv= uv-veps vjc0= 1.d0-vvll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif endif * if(vv.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif svv= sqrt(vv) vchmg= rchmg*vv vvs= vv*vv xm= uv xp= vv/uv xmop= xm/xp if(ndim.eq.7.or.ndim.eq.6) then xdf= 0.d0 else xdf= (ueps*(1.d0-ueps)-veps)/uv endif xdfs= xdf*xdf sh= vv*s * *-----Z parameters * rszm2= zm*zm/sh * *-----Z propagator (real part and imaginary part) * dsz0= 1.d0-rszm2 dsz= dsz0*dsz0+rszw2 rsz= dsz0/dsz aisz= -rszw/dsz * *-----Reduced structure functions are computed with arguments xp,xm * opxp= 1.d0+xp opxm= 1.d0+xm omxp= veps/uv omxm= ueps if(isf.eq.0) then stfp= 1.d0 stfm= 1.d0 else if(isf.gt.0) then if(omxp.eq.0) then stfp= d0gl else rcpx= 0.25d0*opxp*opxp rcpy= xp iflp= 1 rclp= s21baf(rcpx,rcpy,iflp) stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+ # feta*(-4.d0*opxp*log(omxp)+ # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp)) endif if(omxm.eq.0) then stfm= d0gl else rcmx= 0.25d0*opxm*opxm rcmy= xm iflm= 1 rclm= s21baf(rcmx,rcmy,iflm) stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ # feta*(-4.d0*opxm*log(omxm)+ # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm)) endif endif * stf= stfp*stfm * *-----if there is no upper cut on some FS IM, then the maximum is allowed * do j=1,6 if(rr(j).eq.1.d0) then rrr(j)= rr(j) else rrr(j)= rr(j)/vv endif rrl(j)= rl(j)/vv srrl(j)= srl(j)/svv enddo * *-----cuts become special near xp = xm * if(abs(xdf).gt.1.d-15) then ieq= 1 bxe= vv/(ueps*(1.d0-ueps)-veps) if(xdf.gt.0.d0) then enc= 1.d0 else if(xdf.lt.0.d0) then enc= xmop endif else ieq= 0 bxe= 1.d0 endif if(ieq.eq.0.and.xm.le.teq) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif * if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then sct12= sct120/vv sct13= sct130/vv sct14= sct140/vv sct23= sct230/vv sct24= sct240/vv sct34= sct340/vv else sct12= 0.d0 sct13= 0.d0 sct14= 0.d0 sct23= 0.d0 sct24= 0.d0 sct34= 0.d0 endif * *-----cuts on E * do j=1,4 if(ieq.eq.1) then bl(j)= 2.d0*rae(j)/xdf xbl(j)= 2.d0*rae(j)/xp else if(ieq.eq.0) then bl(j)= 2.d0*rae(j)/xm endif enddo * *-----cuts on SA * if(iac(3).ne.0) then do j=1,4 if(sgam(j).eq.1.d0) then ss(j)= 0.d0 else ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmop ss(j)= 1.d0/ss(j) endif if(cgam(j).eq.0.d0) then cs(j)= 1.d0 else cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop cs(j)= 1.d0/cs(j) endif enddo endif * *-----initialization of sm = m_-^2 * zma1= dsm zma2= vv*sct12 zmb1= usm zmb2= (svv-sdsp)*(svv-sdsp) zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) if(ieq.eq.0) then zma3= vv*(bl(1)+bl(2)-1.d0) zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))* # (1.d0-0.5d0*(bl(3)+bl(4))) zmb5= vv*(1.d0-bl(3)) zmb6= vv*(1.d0-bl(4)) else if(ieq.eq.1) then zma3= vv*(-enc+xbl(1)+xbl(2)) zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))* # (1.d0+enc-xbl(3)-xbl(4)) zmb5= vv*(enc-xbl(3)) zmb6= vv*(enc-xbl(4)) endif xzma= dmax1(zma1,zma2,zma3) xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) * *-----limits on sm from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zma= xzma zmb= xzmb else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then szma= xzma szmb= xzmb else if(ss(3).gt.ss(1)) then szmb= xzmb adsp= dsp/vv axszma= dmax1(adsp,sct34) axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/ # (ss(3)-ss(1))) szma= dmax1(axszma,xzma) else if(ss(3).lt.ss(1)) then if(ss(3).lt.0.5d0) then szma= xzma axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 szmb= dmin1(axszmb,xzmb) else iz= 0 ifz(2)= ifz(2)+1 go to 1 endif endif else szma= xzma szmb= xzmb endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zma= szma zmb= szmb else if(cs(3).gt.cs(1)) then if(cs(3).gt.0.5d0) then zma= szma axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2 zmb= dmin1(axczmb,szmb) else iz= 0 ifz(3)= ifz(3)+1 go to 1 endif else if(cs(3).lt.cs(1)) then zmb= szmb adsp= dsp/vv axczma= dmax1(adsp,sct34) axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/ # (cs(3)-cs(1))) zma= dmax1(axczma,szma) endif else zma= szma zmb= szmb endif endif if(itc.eq.3) then dzmb= (svv-dist/rs)*(svv-dist/rs) zmb= dmin1(zmb,dzmb) endif * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * rmm2= rchm2 rmmg= rchmg smgs= schgs vmmg= vchmg smg= schg s0m= rchm2/opschgs * zmas= zma-rmm2 zmbs= zmb-rmm2 atma= (zmas+smgs*zma)/rmmg atmb= (zmbs+smgs*zmb)/rmmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (-atmb+atma)/vmmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (-pi+atmb+atma)/vmmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (-pih+atmb+atma)/vmmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (pi-atmb-atma)/vmmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (atmb-atma)/vmmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (pih+atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vmmg smjc0= (pih-atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vmmg smjc0= (-pih+atmb-atma)/vmmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/vmmg atmb= atan(atmb) zmbt= atmb/vmmg smjc0= (atmb-atma)/vmmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= vmmg*zmv sm= s0m/vv*(1.d0+smg*s07aaf(atnm,iftn)) if(iftn.ne.0) print 300 if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) smjc= vv*smjc0 * 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 zpen= vv*(1.d0-bl(1)-bl(2)+sm) zmen= vv*(-1.d0+bl(3)+bl(4)+sm) zpa= dmax1(zpa,zmen) zpb= dmin1(zpb,zpen) 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)) zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) endif zpap= vv*sct34 zpa= dmax1(zpa,zpap) * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * if(itc.eq.3) then bdistl= dist*dist/s-zpa bdistu= zpb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif endif * rpm2= rchm2 rpmg= rchmg spgs= schgs vpmg= vchmg spg= schg s0p= rchm2/opschgs * if(itc.eq.3) then sp= (dist/rs/svv)**2 spjc= 2.d0*dist/s/((vv*sp-rpm2)**2+ # (vv*sp*spg)**2) else zpas= zpa-rpm2 zpbs= zpb-rpm2 atpa= (zpas+spgs*zpa)/rpmg atpb= (zpbs+spgs*zpb)/rpmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (-atpb+atpa)/vpmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (-pi+atpb+atpa)/vpmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (-pih+atpb+atpa)/vpmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (pi-atpb-atpa)/vpmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (atpb-atpa)/vpmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (pih+atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vpmg spjc0= (pih-atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vpmg spjc0= (-pih+atpb-atpa)/vpmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/vpmg atpb= atan(atpb) zpbt= atpb/vpmg spjc0= (atpb-atpa)/vpmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= vpmg*zpv sp= s0p/vv*(1.d0+spg*s07aaf(atnp,iftn)) if(iftn.ne.0) print 300 spjc= vv*spjc0 endif * if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spmm= sp-sm smmp= sm-sp * cbw= -1.d0+sp-sm ifcr= 0 call c02ajf(one,cbw,sm,bt1,bt2,ifcr) if(bt1(2).ne.0.d0) then iz= 0 ifz(6)= ifz(6)+1 go to 1 endif * smtp= sm*sp ssmpp= ssm+ssp ssmmp= ssm-ssp asup= 1.d0-ssmpp*ssmpp asum= 1.d0-ssmmp*ssmmp if(asup.lt.0.d0.or.asum.lt.0.d0) then iz= 0 ifz(7)= ifz(7)+1 go to 1 endif rasup= sqrt(asup) rasum= sqrt(asum) * *-----initialization of su = M_0^2 * *-----limits on su from cuts on FS IM * sulim= rrl(4) suuim1= rrr(4) suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) suuim= dmin1(suuim1,suuim2) * *-----limits on su from Delta_- > 0 (as derived from consistency * on sd limits) * suud1= 0.25d0*(rasup+rasum)*(rasup+rasum) suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup) * sul= sulim sul= dmax1(sul,sct23) if(ieq.eq.0) then sul1= bl(2)+bl(3)-1.d0 suu1= 1.d0-sp-bl(1) suu2= 1.d0-sm-bl(4) suu3= (1.d0-0.5d0*(bl(1)+bl(4)))* # (1.d0-0.5d0*(bl(1)+bl(4))) else if(ieq.eq.1) then sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc suu1= enc-sp-xbl(1) suu2= enc-sm-xbl(4) suu3= (enc-0.5d0*(xbl(1)+xbl(4)))* # (enc-0.5d0*(xbl(1)+xbl(4))) endif sul= dmax1(sul,sul1) suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) * *-----test on su * if(suu.le.sul) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif * sujc= suu-sul su= sujc*sux+sul if(su.lt.0.d0) then iz= 0 ifz(8)= ifz(8)+1 go to 1 endif ssu= sqrt(su) * *-----initialization of sd = m_0^2 * *-----limits on sd from cuts on FS IM * sdlim1= rrl(3) sdlim2= 1.d0-rrr(2)-rrr(5)-sm-sp-su sdlim= dmax1(sdlim1,sdlim2) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim3= 1.d0-rrl(2)-rrl(5)-sm-sp-su sduim= dmin1(sduim1,sduim2,sduim3) * *-----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) * *-----test on sd * if(sdu.le.sdl) then iz= 0 ifz(9)= ifz(9)+1 go to 1 endif * sdjc= sdu-sdl sd= sdjc*sdx+sdl * 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(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfl= dmax1(asfl,bsfltw) else if(cs(1).lt.cs(2)) then bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ # cs(2)-bt1(1))/(cs(1)-cs(2)) asfu= dmin1(asfu,bsfutw) endif endif if(cs(4).ne.cs(3)) then if(cs(4).gt.cs(3)) then csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfu= dmin1(asfu,csfutw) else if(cs(4).lt.cs(3)) then csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- # cs(4)*su+cs(4))/(cs(4)-cs(3)) asfl= dmax1(asfl,csfltw) endif endif if(ss(1).ne.ss(2)) then if(ss(1).gt.ss(2)) then dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfu= dmin1(asfu,dsfutw) else if(ss(1).lt.ss(2)) then dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+ # ss(2)*sd-ss(2))/(ss(1)-ss(2)) asfl= dmax1(asfl,dsfltw) endif endif endif * *-----positivity of R^2 * scp= ssmpp*ssmpp scm= ssmmp*ssmmp snp= (ssu+ssd)*(ssu+ssd) snm= (ssu-ssd)*(ssu-ssd) rlp= ssu*ssd+ssp*ssm rlm= ssu*ssd-ssp*ssm bsgmo= bsg-1.d0 ombsg2= ombsg*ombsg rlps= rlp*rlp rlms= rlm*rlm edelp= ombsg2-4.d0*rlps edelm= ombsg2-4.d0*rlms edeld= 16.d0*ssu*ssd*ssp*ssm * *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2 * then Delta_+ > 0 * *-----control * cnt1= scp+snm cnt2= scm+snp if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then iz= 0 ifz(10)= ifz(10)+1 go to 1 endif if(edelm.le.0.d0) then etest= edeld+edelp if(etest.gt.0.d0) then edelm= etest else iz= 0 ifz(11)= ifz(11)+1 go to 1 endif endif sedm= sqrt(edelm) ifcr= 0 call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) if(rr1(2).ne.0.d0) then iz= 0 ifz(12)= ifz(12)+1 go to 1 endif ifcr= 0 call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) * cnt3= scp+snp cnt4= scm+snm cbru= -1.d0 ccru= 0.5d0*bsg * *-----R^2 has two real roots and two complex conjugate roots * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then if(bsg.gt.0.5d0) then iel= 1 sflr(1)= rr1(1) sfur(1)= rr2(1) sflr(2)= rr1(1) sfur(2)= rr2(1) else iel= 2 ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sflr(2)= ru2 sfur(1)= ru1 sfur(2)= rr2(1) endif * *-----R^2 has four real roots * else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(bsg.gt.0.5d0) then sflr(1)= rr1(1) sflr(2)= rs2(1) sfur(1)= rs1(1) sfur(2)= rr2(1) else ifcr= 0 call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) ru1= rru1(1)*rru1(1) ru2= rru2(1)*rru2(1) sflr(1)= rr1(1) sfur(1)= dmin1(rs1(1),ru1) sflr(2)= dmax1(rs2(1),ru2) sfur(2)= rr2(1) endif endif * *-----the loop for transforming sf starts here * if(om.eq.'g') then itmn= it0 itmx= it0 else itmn= 1 itmx= 2 endif do it=itmn,itmx if(sflr(it).ge.asfl) then sfl= sflr(it) else sfl= asfl endif if(sfur(it).le.asfu) then sfu= sfur(it) else sfu= asfu endif * *-----test on sf * if(sfu.le.sfl) then iz= 0 ifz(13)= ifz(13)+1 go to 2 endif * *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 * if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then er= rs1(1) es= abs(rs1(2)) er1= rr1(1) er2= rr2(1) ek2= edelm/edeld ek= sqrt(ek2) dog= -2.d0/sqrt(edeld) ecpl= (ombsg-2.d0*sfl)/sedm ecpu= (ombsg-2.d0*sfu)/sedm eql= ecpl*ecpl equ= ecpu*ecpu omecpl= 2.d0*(sfl-er1)/sedm es2pl= omecpl*(2.d0-omecpl) erl= 1.d0-ek2*es2pl espl= sqrt(es2pl) opecpu= 2.d0*(er2-sfu)/sedm es2pu= opecpu*(2.d0-opecpu) espu= sqrt(es2pu) eru= 1.d0-ek2*es2pu if(eql.eq.1) then sflt= 0.d0 else ifel= 1 sflt= -dog*espl*s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(14)= ifz(14)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 sfut= -dog*espu*s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(15)= ifz(15)+1 go to 2 endif endif if(iel.eq.1) then if(sfu.le.er) then efac= 0.5d0 sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(16)= ifz(16)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(sfl.ge.er) then efac= 0.5d0 sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(17)= ifz(17)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) else efac= 1.d0 qbar= 0.d0 rbar= 1.d0-ek2 ifel= 1 sfbar= -dog*s21bbf(qbar,rbar,one,ifel) if(ifel.ne.0) then iz= 0 ifz(18)= ifz(18)+1 go to 2 endif if(it.eq.1) then sft= (sfbar-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(19)= ifz(19)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfbar-sflt) else if(it.eq.2) then sft= (sfbar-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(20)= ifz(20)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sfbar-sfut) endif endif else if(iel.eq.2) then efac= 1.d0 if(it.eq.1) then sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(21)= ifz(21)+1 go to 2 endif sf= 0.5d0*(ombsg-sedm*elcn) sfjc= efac*(sfut-sflt) else if(it.eq.2) then sft= (sflt-sfut)*sfx+sfut ifel= 1 asf= -sft/dog call s21caf(asf,ek2,elsn,elcn,edn,ifel) if(ifel.ne.0) then iz= 0 ifz(22)= ifz(22)+1 go to 2 endif sf= 0.5d0*(ombsg+sedm*elcn) sfjc= efac*(sflt-sfut) endif endif else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then if(edelp.le.0.d0) then iz= 0 ifz(23)= ifz(23)+1 go to 2 endif sedp= sqrt(edelp) efac= 1.d0 es1= rs1(1) es2= rs2(1) er1= rr1(1) er2= rr2(1) ssed= sedm+sedp ek= (sedm-sedp)/ssed ek2= ek*ek dog= 2.d0/ssed if(it.eq.1) then es2pl= (er1-sfl)/(sfl-er2)/ek es2pu= (er1-sfu)/(sfu-er2)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu else if(it.eq.2) then es2pl= (sfl-es2)/(sfl-es1)/ek es2pu= (sfu-es2)/(sfu-es1)/ek eql= 1.d0-es2pl equ= 1.d0-es2pu erl= 1.d0-ek2*es2pl eru= 1.d0-ek2*es2pu endif if(eql.eq.1.d0) then sflt= 0.d0 else ifel= 1 sflt= 2.d0*dog*sqrt(es2pl)* # s21bbf(eql,erl,one,ifel) if(ifel.ne.0) then iz= 0 ifz(24)= ifz(24)+1 go to 2 endif endif if(equ.eq.1.d0) then sfut= 0.d0 else ifel= 1 if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then equ= 0.d0 endif sfut= 2.d0*dog*sqrt(es2pu)* # s21bbf(equ,eru,one,ifel) if(ifel.ne.0) then iz= 0 ifz(25)= ifz(25)+1 go to 2 endif endif sft= (sfut-sflt)*sfx+sflt ifel= 1 asf= 0.5d0/dog*sft call s21caf(asf,ek2,elsn,elcn,edn,ifel) elsn2= elsn*elsn if(ifel.ne.0) then iz= 0 ifz(26)= ifz(26)+1 go to 2 endif if(it.eq.1) then sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2) else if(it.eq.2) then sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) endif sfjc= efac*(sfut-sflt) endif * *-----auxiliary quantities * sdpf= sd+sf e3= sp+su+sf e4= 1.d0+spmm-e3 e3p4= 1.d0+spmm e1= sm+sdpf e2= 1.d0+smmp-e1 e1p2= 1.d0+smmp e1p3= e1+e3 e1m2= 2.d0*e1-1.d0+spmm ep12= xp*e1*e2 ep1= xp*e1 ep2= xp*e2 ep3= xp*e3 ep4= xp*e4 e1t2= e1*e2 e1t3= e1*e3 e1t4= e1*e4 e2t3= e2*e3 e2t4= e2*e4 e3t4= e3*e4 if((e1p3*e1p3-4.d0*sf).lt.0.d0) then iz= 0 ifz(27)= ifz(27)+1 go to 2 endif skl2= sqrt(e1p3*e1p3-4.d0*sf) if((sdmus-4.d0*sd).lt.0.d0) then iz= 0 ifz(28)= ifz(28)+1 go to 2 endif skl3= sdmus-4.d0*sd skl3= sqrt(skl3) * *-----initialization of t_w * *-----limits on tw from positivity and SA * twlp1= 0.d0 twlp2= smmp twlp3= spmm-1.d0 twlp= dmax1(twlp1,twlp2,twlp3) twup= 1.d0 * *-----limits on tw from cuts on SA * if(iac(3).ne.0) then skl2m= 0.5d0*(e1p3-skl2) skl2p= 0.5d0*(e1p3+skl2) skl3p= -0.5d0*(1.d0+sdmu-skl3) skl3m= -0.5d0*(1.d0+sdmu+skl3) twlsa1= 1.d0-cs(3)*e3-cs(4)*e4 twlsa2= ss(1)*e1+ss(2)*e2 twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m twusa1= 1.d0-ss(3)*e3-ss(4)*e4 twusa2= cs(1)*e1+cs(2)*e2 twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4, # twlsa5,twlsa6) atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4, # twusa5,twusa6) else atwl= twlp atwu= twup endif * *-----limits on tw from E * if(ieq.eq.1) then atwle= 1.d0-bxe*e3p4+bl(3)+bl(4) atwue= bxe*e1p2-bl(1)-bl(2) if(xdf.gt.0.d0) then twle= atwle twue= atwue else if(xdf.lt.0.d0) then atwle1= bxe*e1-bl(1) atwle2= bxe*e2-bl(2) atwue1= 1.d0-bxe*e3+bl(3) atwue2= 1.d0-bxe*e4+bl(4) twle= dmax1(atwue,atwle1,atwle2) twue= dmin1(atwle,atwue1,atwue2) endif atwl= dmax1(atwl,twle) atwu= dmin1(atwu,twue) endif * *-----natural limits on tw * atwl= dmax1(atwl,bt1(1)) atwu= dmin1(atwu,bt2(1)) * *-----test on tw * if(atwu.le.atwl) then iz= 0 ifz(29)= ifz(29)+1 go to 2 endif * twjc= atwu-atwl tw= twjc*twx+atwl pn= tw+sp-1.d0 omtw= 1.d0-tw * *-----initialization of t1 * *-----limits on t1 from positivity+SA * t1lp1= 0.d0 t1lp2= pn+sdpf t1up1= tw t1up2= sm+sdpf t1lp= dmax1(t1lp1,t1lp2) t1up= dmin1(t1up1,t1up2) * *-----limits on t1 from cuts on SA * if(iac(3).ne.0) then t1lc1= ss(1)*e1 t1lc2= tw-cs(2)*e2 t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3) t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3 t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 t1uc1= cs(1)*e1 t1uc2= tw-ss(2)*e2 t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3)) t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3 t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4 t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6) t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6) at1l= dmax1(t1lp,t1lc) at1u= dmin1(t1up,t1uc) else at1l= t1lp at1u= t1up endif * *-----limits on t1 from E * if(ieq.eq.1) then at1le= tw-bxe*e2+bl(2) at1ue= bxe*e1-bl(1) if(xdf.gt.0.d0) then t1le= at1le t1ue= at1ue else t1le= at1ue t1ue= at1le endif at1l= dmax1(at1l,t1le) at1u= dmin1(at1u,t1ue) endif * *-----positivity of (R')^2 / reality of roots for t3 * rp0= e1p2*e1p2-4.d0*sm if(rp0.lt.0.d0) then iz= 0 ifz(30)= ifz(30)+1 go to 2 endif srp0= sqrt(rp0) rp0e= -rp0 rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 rp1e= 2.d0*rp1 rp2= -(e1*tw-sm)*(e1*tw-sm) if(rp0e.eq.0.d0) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif ifct= 0 if(rp0e.ne.0.d0) then call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) t1l= dmax1(at1l,ret1(1)) t1u= dmin1(at1u,ret2(1)) else if(rp0e.eq.0.d0) then sret1= -rp2/rp1e if(rp1e.gt.0.d0) then t1l= dmax1(at1l,sret1) t1u= at1u else if(rp1e.lt.0.d0) then t1l= at1l t1u= dmin1(at1u,sret1) endif endif * *-----test on t1 * if(t1u.le.t1l) then iz= 0 ifz(31)= ifz(31)+1 go to 2 endif * *-----transformation for jacobian * if(rp0e.eq.0.d0) then taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2) taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) t1jc= taut-taul t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e endif if(ret1(1).eq.t1l) then at1tl= -pih/srp0 else bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) ifas= 1 at1tl= -s09aaf(bt1tl,ifas)/srp0 if(ifas.ne.0) print 200 endif if(ret2(1).eq.t1u) then at1tu= pih/srp0 else bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u) ifas= 1 at1tu= -s09aaf(bt1tu,ifas)/srp0 if(ifas.ne.0) print 200 endif if((at1tl+at1tu).eq.0.d0) then if(t1x.lt.1.d-3) then arc= pi*t1x arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc else if((1.d0-t1x).lt.1.d-3) then arc= pi*(1.d0-t1x) arc2= arc*arc exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+ # arc2*(ec8+arc2*ec10)))) t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc else carc= cos(pi*t1x) t1= 0.5d0*(ret1(1)+ret2(1))+ # 0.5d0*(ret1(1)-ret2(1))*carc endif t1jc= pi/srp0 else t1tl= dmin1(at1tl,at1tu) t1tu= dmax1(at1tl,at1tu) t1jc= t1tu-t1tl t1t= t1jc*t1x+t1tl t1= (rp1+rpds*sin(srp0*t1t))/rp0 endif t1s= t1*t1 * 200 format(' Unsuccesful call to S09AAF ') * *-----test on t1 from FS A * if(ieq.eq.1.and.iac(4).ne.0.d0) then cnlct1= xp*(xm*sm-ep12*cg12)+xdf* # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1- # xdf*tw)+xdfs*cg12*t1s cnlst1= xp*(ep12*sg12-xm*sm)-xdf* # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ # xdf*tw)-xdfs*sg12*t1s if(cnlct1.lt.0.d0) then iz= 0 ifz(32)= ifz(32)+1 go to 2 else if(cnlst1.lt.0.d0) then iz= 0 ifz(33)= ifz(33)+1 go to 2 endif endif * *-----some vector components * t2= tw-t1 * *-----equation for xi is solved * e1s= e1*e1 e2s= e2*e2 e3s= e3*e3 e12= e1t2-2.d0*sm e13= e1t3-2.d0*sf e23= e2t3-2.d0*su e12s= e12*e12 e13s= e13*e13 e23s= e23*e23 xia= e1s*e2s-e12s xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ # e2*e12*e13 xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0* # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1* # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s* # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13* # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23 xib= 2.d0*xib if(xia.eq.0.d0) then if(xib.eq.0.d0) then iz= 0 ifz(34)= ifz(34)+1 go to 2 endif rtm(1)= -xic/xib rtp(1)= rtm(1) rtm(2)= 0.d0 rtp(2)= 0.d0 ixia= 0 else ixia= 1 ifc0= 0 call c02ajf(xia,xib,xic,rtm,rtp,ifc0) endif if(rtm(2).ne.0.d0) then iz= 0 ifz(35)= ifz(35)+1 go to 2 endif * *-----xi^+ and xi^- are computed * xip= 0.5d0*(e3-rtp(1)) xim= 0.5d0*(e3-rtm(1)) * *-----each integral becomes a sum of two terms * *-----loop over ix starts here * if(om.eq.'g') then ixmn= ix0 ixmx= ix0 else ixmn= 1 ixmx= 2 endif do ix=ixmn,ixmx * *-----q_3 is compared and x15 is selected * if(ix.eq.1) then t3= xip else if(ix.eq.2) then t3= xim endif * *-----The two integrands are computed * *-----further auxiliary quantities * edn1= ep1-xdf*t1 edn2= ep2-xdf*t2 edn3= ep3-xdf*t3 t4= omtw-t3 edn4= ep4-xdf*t4 * *-----collections of all limits on t3 * *-----from energy (or natural limits) * if(ieq.eq.1) then at3l1= omtw-bxe*e4+bl(4) at3u1= bxe*e3-bl(3) if(xdf.gt.0.d0) then t3l1= at3l1 t3u1= at3u1 else if(xdf.lt.0.d0) then t3l1= at3u1 t3u1= at3l1 endif else t3l1= 0.d0 t3u1= e3 endif * *-----natural limits * t3l2= -t1+0.5d0*(e1p3-skl2) t3u2= -t1+0.5d0*(e1p3+skl2) * t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3) t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3) * *-----from positivity on SA * t3l4= 0.d0 t3l5= sm+su+sf-tw t3u4= sp+su+sf t3u5= omtw * *-----from SA * if(iac(3).ne.0) then t3l6= ss(3)*e3 t3u6= cs(3)*e3 t3l7= omtw-cs(4)*e4 t3u7= omtw-ss(4)*e4 t3l= dmax1(t3l1,t3l2,t3l3,t3l4, # t3l5,t3l6,t3l7) t3u= dmin1(t3u1,t3u2,t3u3,t3u4, # t3u5,t3u6,t3u7) else t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5) endif * *-----limits on t3 are imposed * tlimt3= (t3u-t3)*(t3-t3l) if(t3u.lt.t3l) then iz= 0 ifz(36)= ifz(36)+1 go to 4 else if(tlimt3.lt.0.d0) then iz= 0 ifz(36)= ifz(36)+1 go to 4 endif * *-----non linear limits on t3,t4 are imposed * if(iac(4).ne.0.and.ieq.eq.1) then tnl13c= -cg13*edn1*edn3+vv*sf tnl13s= sg13*edn1*edn3-vv*sf tnl23c= -cg23*edn2*edn3+vv*su tnl23s= sg23*edn2*edn3-vv*su tnl14c= -cg14*edn1*edn4+vv*sd tnl14s= sg14*edn1*edn4-vv*sd sres= 1.d0-e1-e3+sf tnl24c= -cg24*edn2*edn4+vv*sres tnl24s= sg24*edn2*edn4-vv*sres tnl34c= -cg34*edn3*edn4+vv*sp tnl34s= sg34*edn3*edn4-vv*sp if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or. # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then iz= 0 ifz(37)= ifz(37)+1 go to 4 endif endif * *-----non linear constraints from FS A in the case xp = xm * if(iac(4).ne.0.d0.and.ieq.eq.0) then smr= 1.d0-sm-sp-su-sd-sf spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr) spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. # spc14.lt.0.d0.or.spc23.lt.0.d0.or. # spc24.lt.0.d0.or.spc34.lt.0.d0) then iz= 0 ifz(38)= ifz(38)+1 go to 4 endif endif * *-----all invariants * x13= t1 x14= t2 x15= t3 x16= t4 x23= e1-t1 x24= e2-t2 x25= e3-t3 x26= e4-t4 x34= sm x35= sf x36= sd x45= su x46= 1.d0-e1-e3+sf x56= sp * *-----computes cross-section * *-----born matrix element is calculated at the reduced c.m. energy * *-----The epsilons are computed in the order * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4), * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4), * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4), * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) * x13s= x13*x13 x14s= x14*x14 x15s= x15*x15 x16s= x16*x16 x23s= x23*x23 x24s= x24*x24 x25s= x25*x25 x26s= x26*x26 x34s= x34*x34 x35s= x35*x35 x36s= x36*x36 x45s= x45*x45 x46s= x46*x46 x56s= x56*x56 * ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s-x35s ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+ # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+ # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- # x15s*x34s ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+ # x24*x25*x34*x35)-x23s*x45s-x24s*x35s- # x25s*x34s * e(1)= 1.d0 e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0* # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14* # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35 e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45- # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35- # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45 e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13* # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+ # x25*x34s * *-----sign of eps_1*eps_i * ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo * if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= ses2 s3= -ses1-ses2 s4= ses3 s5= ses1-ses3 s6= ses2+ses3 s7= ses4 s8= ses1-ses4 s9= ses2+ses4 s10= ses3-ses4 s11= ses5 s12= -ses1-ses5 s13= -ses2+ses5 s14= -ses3-ses5 s15= -ses4-ses5 else ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s-x36s ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+ # x16*x24*x46)-x14s*x26s-x16s*x24s-x46s ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ # x14*x16*x34*x36)-x13s*x46s-x14s*x36s- # x16s*x34s ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- # x26s*x34s e(1)= 1.d0 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23*x34- # x13s*x24*x26-x34*x36 e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13* # x24*x46-x14*x16*x23*x24+x14*(-x23* # x46+2.d0*x24*x36-x26*x34)-x16*x24* # x34+x14s*x23*x26+x34*x46 e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26* # x34)+x13*x16*x24*x34+x13*x34*x46+ # x14*x16*x23*x34+x14*x34*x36-x16* # x34s-x13s*x24*x46-x14s*x23*x36 e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36* # x24s)+x14*(-x23*x24*x36-x23*x26* # x34+x46*x23s)+x16*2.d0*x23*x24*x34- # x23*x34*x46-x24*x34*x36+x26*x34s ises= 0 sg(1)= 0.25d0 if(ee(1).lt.0.d0) then ises= ises+1 endif do i=2,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= ses1 s2= -ses1-ses2 s3= ses2 s4= -ses1-ses3 s5= ses3 s6= -ses2-ses3 s7= ses1-ses4 s8= ses4 s9= -ses2-ses4 s10= -ses3+ses4 s11= -ses1-ses5 s12= ses5 s13= ses2-ses5 s14= ses3+ses5 s15= ses4+ses5 else ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+ # x15*x23*x35)-x13s*x25s-x15s*x23s- # x35s ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ # x16*x23*x36)-x13s*x26s-x16s*x23s- # x36s ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+ # x16*x25*x56)-x15s*x26s-x16s*x25s- # x56s ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35* # x56+x15*x16*x35*x36)-x13s*x56s- # x15s*x36s-x16s*x35s ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35* # x56+x25*x26*x35*x36)-x23s*x56s- # x25s*x36s-x26s*x35s * e(1)= x13*x14*x23*x25+x13*x15*x23*x24+ # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- # x14*x15*x23s+x14*x23*x35+x15*x23* # x34-x13s*x24*x25-x34*x35 e(2)= x13*x14*x23*x26+x13*x16*x23*x24+ # x13*(-2.d0*x23*x46+x24*x36+x26*x34)- # x14*x16*x23s+x14*x23*x36+x16*x23* # x34-x13s*x24*x26-x34*x36 e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+ # x13*(-x25*x46+x26*x45)+x14*x15*x23* # x26-x14*x16*x23*x25+x14*(x25*x36-x26* # x35)+x15*(-x23*x46+x24*x36)+x16*(x23* # x45-x24*x35)+x35*x46-x36*x45 e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15* # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ # x25*x34)+x13*(x35*x46-x36*x45)-x14* # x15*x23*x36+x14*x16*x23*x35+x15*x34* # x36-x16*x34*x35+x13s*(-x25*x46+x26* # x45) e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25* # x36-x24*x26*x35)+x15*(-x23*x24*x36- # x23*x26*x34+x46*x23s)+x16*(x23*x24* # x35+x23*x25*x34-x45*x23s)-x23*x35* # x46+x23*x36*x45-x25*x34*x36+x26*x34* # x35 * ises= 0 do i=1,5 if(abs(e(i)).lt.zrm) then ises= ises+1 else if(e(i).gt.zrm) then sg(i)= 0.25d0 else if(e(i).lt.-zrm) then sg(i)= -0.25d0 endif if(ee(i).lt.0.d0) then ises= ises+1 endif enddo if(ises.eq.0) then ses1= sg(1)*sqrt(ee(1)) ses2= sg(2)*sqrt(ee(2)) ses3= sg(3)*sqrt(ee(3)) ses4= sg(4)*sqrt(ee(4)) ses5= sg(5)*sqrt(ee(5)) s1= -ses1-ses2 s2= ses1 s3= ses2 s4= -ses1+ses3 s5= -ses2-ses3 s6= ses3 s7= -ses1+ses4 s8= -ses2-ses4 s9= ses4 s10= ses3-ses4 s11= ses1+ses5 s12= ses2-ses5 s13= ses5 s14= -ses3-ses5 s15= -ses4-ses5 else iz= 0 ifz(39)= ifz(39)+1 go to 4 endif endif endif * xaa= 1.d0/x15/x25 xab= x25/x15 xac= 1.d0/xab xad= 1.d0/xaa xba= x45/x36 xbb= x36*x45 xbc= x36/x45 xbd= 1.d0/x14/x24 xca= x14/x24 xcb= 1.d0/xca xcc= 1.d0/xbd xcd= 1.d0/x15/x24 xda= x15/x24 xdb= 1.d0/xda xdc= 1.d0/xcd xdd= 1.d0/x34/x46 xef= x34/x46 xeg= x46/x34 xeh= 1.d0/xdd xfe= 1.d0/x14/x25 xff= x14/x25 xfg= x25/x14 xfh= 1.d0/xfe * tgn(1)= xaa*xba tgn(2)= xaa*xbb tgn(3)= xaa*xbc tgn(4)= xaa/xbb tgn(5)= xab*xba tgn(6)= xac/xbb tgn(7)= xab/xbb tgn(8)= xad/xbb tgn(9)= xab*xbb tgn(10)= xab*xbc tgn(11)= xac*xba tgn(12)= xac*xbc tgn(13)= xac*xbb tgn(14)= xad*xbb tgn(15)= xbd*xba tgn(16)= xbd*xbb tgn(17)= xbd*xbc tgn(18)= xbd/xbb tgn(19)= xcb*xba tgn(20)= xca/xbb tgn(21)= xcb/xbb tgn(22)= xbd/xbb tgn(23)= xcb*xbb tgn(24)= xcb*xbc tgn(25)= xca*xba tgn(26)= xca*xbc tgn(27)= xca*xbb tgn(28)= xbd*xbb tgn(29)= xcd*xeg tgn(30)= xcd*xeh tgn(31)= xcd*xef tgn(32)= xcd*xdd tgn(33)= xdb*xeg tgn(34)= xda*xdd tgn(35)= xdb*xdd tgn(36)= xdc*xdd tgn(37)= xdb*xeh tgn(38)= xdb*xef tgn(39)= xda*xeg tgn(40)= xda*xef tgn(41)= xda*xeh tgn(42)= xdc*xeh tgn(43)= xdc*xef tgn(44)= xfe*xeg tgn(45)= xfe*xeh tgn(46)= xfe*xef tgn(47)= xfe*xdd tgn(48)= xfg*xeg tgn(49)= xff*xdd tgn(50)= xfg*xdd tgn(51)= xfh*xdd tgn(52)= xfg*xeh tgn(53)= xfg*xef tgn(54)= xff*xeg tgn(55)= xff*xef tgn(56)= xff*xeh tgn(57)= xfh*xeh tgn(58)= xfh*xef itgn= 0 do l=1,58 if(tgn(l).le.0.d0) then itgn= itgn+1 endif enddo if(itgn.ne.0) then iz= 0 ifz(40)= ifz(40)+1 go to 4 endif * gh1= sqrt(tgn(1)) gh2= sqrt(tgn(2)) gh3= sqrt(tgn(3)) gh4= sqrt(tgn(4)) gh5= sqrt(tgn(5)) gh6= sqrt(tgn(6)) gh7= sqrt(tgn(7)) gh8= sqrt(tgn(8)) gh9= sqrt(tgn(9)) gh10= sqrt(tgn(10)) gh11= sqrt(tgn(11)) gh12= sqrt(tgn(12)) gh13= sqrt(tgn(13)) gh14= sqrt(tgn(14)) gh15= sqrt(tgn(15)) gh16= sqrt(tgn(16)) gh17= sqrt(tgn(17)) gh18= sqrt(tgn(18)) gh19= sqrt(tgn(19)) gh20= sqrt(tgn(20)) gh21= sqrt(tgn(22)) gh22= sqrt(tgn(22)) gh23= sqrt(tgn(23)) gh24= sqrt(tgn(24)) gh25= sqrt(tgn(25)) gh26= sqrt(tgn(26)) gh27= sqrt(tgn(27)) gh28= sqrt(tgn(28)) gh29= sqrt(tgn(29)) gh30= sqrt(tgn(30)) gh31= sqrt(tgn(31)) gh32= sqrt(tgn(32)) gh33= sqrt(tgn(33)) gh34= sqrt(tgn(34)) gh35= sqrt(tgn(35)) gh36= sqrt(tgn(36)) gh37= sqrt(tgn(37)) gh38= sqrt(tgn(38)) gh39= sqrt(tgn(39)) gh40= sqrt(tgn(40)) gh41= sqrt(tgn(41)) gh42= sqrt(tgn(42)) gh43= sqrt(tgn(43)) gh44= sqrt(tgn(44)) gh45= sqrt(tgn(45)) gh46= sqrt(tgn(46)) gh47= sqrt(tgn(47)) gh48= sqrt(tgn(48)) gh49= sqrt(tgn(49)) gh50= sqrt(tgn(50)) gh51= sqrt(tgn(51)) gh52= sqrt(tgn(52)) gh53= sqrt(tgn(53)) gh54= sqrt(tgn(54)) gh55= sqrt(tgn(55)) gh56= sqrt(tgn(56)) gh57= sqrt(tgn(57)) gh58= sqrt(tgn(58)) * hb(1)= 0.5d0*tm*sqrt(chcm2)/wm/wm hb(2)= -0.5d0*tm*sqrt(chsm2)*tbeta*tbeta/wm/wm * *-----Diagrams: * *-----helicity h1) * ch1r= gh1*(2.d0*x13*x24*x56-2.d0*x13*x26*x35-2.d0*x13*x26* # x45+2.d0*x13*x26*x56-2.d0*x14*x23*x56+2.d0*x14*x26* # x35+2.d0*x16*x23*x35+2.d0*x16*x23*x45-2.d0*x16*x23* # x56-2.d0*x16*x24*x35-2.d0*x34*x56+2.d0*x35*x46) ch1r= ch1r+gh2*(-2.d0*x35-2.d0*x45+2.d0*x56)+gh4*(2.d0* # x13*x24*x35*x56-2.d0*x13*x24*x56s-2.d0*x14*x23*x35* # x56+2.d0*x14*x23*x56s-2.d0*x14*x26*x35*x56+2.d0*x14* # x26*x35s+2.d0*x16*x24*x35*x56-2.d0*x16*x24*x35s-2.d0* # x34*x35*x56+2.d0*x34*x56s-2.d0*x35*x46*x56+2.d0*x35s*x46) ch1r= ch1r+gh5*(2.d0*x13*x46-2.d0*x16*x34)+gh6*(4.d0*x23*x34* # x56-2.d0*x23*x35*x46-2.d0*x23*x46*x56-2.d0*x26*x34*x35- # 2.d0*x26*x34*x56+4.d0*x26*x35*x46)+gh7*(-2.d0*x13*x35* # x46+2.d0*x13*x46*x56+4.d0*x14*x34*x56-4.d0*x14*x35*x46+ # 2.d0*x16*x34*x35-2.d0*x16*x34*x56)+gh8*(-4.d0*x34*x56+ # 4.d0*x35*x46)+gh9*(4.d0*x13+2.d0*x14)+gh10*(-2.d0*x14* # x35-2.d0*x14*x56)+gh11*(-2.d0*x23*x46+2.d0*x26*x34)+ # gh12*(2.d0*x24*x35+2.d0*x24*x56)+gh13*(2.d0*x24-4.d0* # x26)+gh14*(-4.d0) ch1i= s1*gh1*(8.d0*x56)+s2*gh2*(-16.d0)+s3*gh1*(8.d0*x35- # 8.d0*x56)+s4*gh3*(8.d0*x35+8.d0*x56)+s6*gh1*(8.d0* # x34)+s7*gh1*(-8.d0*x26)+s7*gh4*(-8.d0*x26*x35+8.d0* # x26*x56)+s8*gh5*(8.d0)+s10*gh4*(8.d0*x23*x35-8.d0* # x23*x56)+s12*gh6*(8.d0*x35-8.d0*x56)+s13*gh1*(-8.d0* # x14)+s13*gh4*(-8.d0*x14*x35+8.d0*x14*x56)+s14*gh1* # (8.d0*x13)+s15*gh6*(-16.d0*x23+16.d0*x26)+s15*gh7* # (-16.d0*x14)+s15*gh8*(16.d0) * h1r= hb(1)*(0.25d0*(2.d0*cth2-1.d0)*ver/cth2*rsz-sth2)*ch1r h1ie= hb(1)*(0.25d0*(2.d0*cth2-1.d0)*ver/cth2*rsz-sth2)*ch1i h1re= -0.25d0*hb(1)*(2.d0*cth2-1.d0)*ver/cth2*aisz*ch1i h1i= 0.25d0*hb(1)*(2.d0*cth2-1.d0)*ver/cth2*aisz*ch1r * *-----helicity h2) * ch2r= gh15*(2.d0*x13*x25*x46+2.d0*x13*x26*x34-2.d0*x13*x26* # x45-2.d0*x13*x26*x46-2.d0*x15*x23*x46+2.d0*x15*x26* # x34-2.d0*x16*x23*x34+2.d0*x16*x23*x45+2.d0*x16*x23* # x46-2.d0*x16*x25*x34-2.d0*x34*x56+2.d0*x35*x46)+gh16* # (2.d0*x34-2.d0*x45-2.d0*x46) ch2r= ch2r+gh18*(-2.d0*x13*x25*x34*x46+2.d0*x13*x25*x46s+ # 2.d0*x15*x23*x34*x46-2.d0*x15*x23*x46s+2.d0*x15*x26* # x34*x46-2.d0*x15*x26*x34s-2.d0*x16*x25*x34*x46+2.d0* # x16*x25*x34s-2.d0*x34*x35*x46-2.d0*x34*x46*x56+2.d0* # x34s*x56+2.d0*x35*x46s)+gh19*(2.d0*x13*x56-2.d0*x16* # x35)+gh20*(-2.d0*x23*x34*x56+2.d0*x23*x46*x56+4.d0* # x25*x34*x56-4.d0*x25*x35*x46+2.d0*x26*x34*x35-2.d0* # x26*x35*x46)+gh21*(-2.d0*x13*x34*x56+4.d0*x13*x35*x46- # 2.d0*x13*x46*x56-2.d0*x16*x34*x35+4.d0*x16*x34*x56- # 2.d0*x16*x35*x46)+gh22*(-4.d0*x34*x56+4.d0*x35*x46) ch2r= ch2r+gh23*(-4.d0*x13+2.d0*x15)+gh24*(2.d0*x15*x34+ # 2.d0*x15*x46)+gh25*(-2.d0*x23*x56+2.d0*x26*x35)+ # gh26*(-2.d0*x25*x34-2.d0*x25*x46)+gh27*(2.d0*x25+ # 4.d0*x26)+gh28*(-4.d0) ch2i= s1*gh15*(8.d0*x56)+s3*gh15*(-8.d0*x34-8.d0*x46)+ # s4*gh17*(8.d0*x34)+s5*gh18*(8.d0*x35*x46)+s6*gh15* # (8.d0*x34)+s6*gh18*(-8.d0*x34*x46)+s7*gh15*(-8.d0* # x26)+s7*gh18*(8.d0*x26*x46)+s8*gh15*(8.d0*x25-16.d0* # x26)+s8*gh18*(-8.d0*x25*x34)+s9*gh21*(8.d0*x34)+s11* # gh18*(8.d0*x16*x34+8.d0*x16*x46)+s13*gh25*(-8.d0)+ # s14*gh15*(8.d0*x13)+s14*gh18*(-8.d0*x13*x34-16.d0* # x16*x34)+s15*gh18*(8.d0*x46)+s15*gh20*(-16.d0*x25)+ # s15*gh21*(16.d0*x13)+s15*gh22*(16.d0) * h2r= hb(1)*(0.25d0*(2.d0*cth2-1.d0)*vel/cth2*rsz-sth2)*ch2r h2ie= hb(1)*(0.25d0*(2.d0*cth2-1.d0)*vel/cth2*rsz-sth2)*ch2i h2re= -0.25d0*hb(1)*(2.d0*cth2-1.d0)*vel/cth2*aisz*ch2i h2i= 0.25d0*hb(1)*(2.d0*cth2-1.d0)*vel/cth2*aisz*ch2r * *-----helicity h3) * ch3r= gh30*(-2.d0*x13*x25+4.d0*x16*x25+2.d0*x35-4.d0*x56)+ # gh31*(2.d0*x13*x26*x45-2.d0*x14*x23*x56+2.d0*x14*x25* # x36-2.d0*x14*x26*x35+4.d0*x14*x26*x56+2.d0*x16*x23* # x45-2.d0*x16*x25*x34-4.d0*x16*x26*x45+2.d0*x34*x56- # 2.d0*x36*x45)+gh38*(-2.d0*x13*x56-4*x14*x56+2.d0* # x16*x35+4.d0*x16*x45)+gh40*(2.d0*x26*x34-4.d0*x26* # x45)+gh41*(-2.d0*x23+4*x25)+gh42*(-4.d0)+gh43* # (-2.d0*x36+4.d0*x56) ch3i= s2*gh30*(8.d0)+s5*gh31*(-8.d0*x35+16.d0*x56)+s7* # gh31*(8.d0*x26)+s9*gh38*(8.d0)+s10*gh38*(16.d0)+ # s12*gh40*(-8.d0)+s14*gh31*(8.d0*x13-16.d0*x16)+ # s14*gh40*(-16.d0) * h3r= hb(2)*(0.25d0*(2.d0*cth2-1.d0)*ver/cth2*rsz-sth2)*ch3r h3ie= hb(2)*(0.25d0*(2.d0*cth2-1.d0)*ver/cth2*rsz-sth2)*ch3i h3re= -0.25d0*hb(2)*(2.d0*cth2-1.d0)*ver/cth2*aisz*ch3i h3i= 0.25d0*hb(2)*(2.d0*cth2-1.d0)*ver/cth2*aisz*ch3r * *-----helicity h4) * ch4i= s1*gh46*(-8.d0*x56)+s2*gh45*(-8.d0)+s3*gh46* # (8.d0*x45)+s5*gh46*(-16.d0*x56)+s10*gh46* # (8.d0*x23-16.d0*x26)+s10*gh53*(-16.d0)+s14* # gh46*(8.d0*x13)+s14*gh55*(16.d0)+s15*gh46*(-8.d0) ch4r= gh45*(-2.d0*x15*x23+4.d0*x15*x26+2.d0*x35-4.d0*x56)+ # gh46*(-2.d0*x13*x24*x56+2.d0*x13*x26*x45+2.d0*x15* # x24*x36-2.d0*x15*x26*x34+2.d0*x16*x23*x45-2.d0*x16* # x24*x35+4.d0*x16*x24*x56-4.d0*x16*x26*x45+2.d0*x34* # x56-2.d0*x36*x45)+gh52*(-2.d0*x13+4.d0*x15)+gh53* # (2.d0*x16*x34-4.d0*x16*x45)+gh55*(-2.d0*x23*x56- # 4.d0*x24*x56+2.d0*x26*x35+4.d0*x26*x45)+gh57* # (-4.d0)+gh58*(-2.d0*x36+4.d0*x56) * h4r= hb(2)*(0.25d0*(2.d0*cth2-1.d0)*vel/cth2*rsz-sth2)*ch4r h4ie= hb(2)*(0.25d0*(2.d0*cth2-1.d0)*vel/cth2*rsz-sth2)*ch4i h4re= -0.25d0*hb(2)*(2.d0*cth2-1.d0)*vel/cth2*aisz*ch4i h4i= 0.25d0*hb(2)*(2.d0*cth2-1.d0)*vel/cth2*aisz*ch4r * *-----Total * hcf= -1.d0/8.d0 hcfs= hcf*hcf dth= h1r*h1r+h1re*h1re+h1ie*h1ie+h1i*h1i+ # h2r*h2r+h2re*h2re+h2ie*h2ie+h2i*h2i+ # h3r*h3r+h3re*h3re+h3ie*h3ie+h3i*h3i+ # h4r*h4r+h4re*h4re+h4ie*h4ie+h4i*h4i dth= hcf*dth * 4 if(iz.eq.0) then dpxs(ix,it)= 0.d0 iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc dpxs(ix,it)= tjac*stf*dth/s endif * *-----end of ix loop * enddo * cpxs(it)= dpxs(1,it)+dpxs(2,it) * 2 if(iz.eq.0) then bpxs(it)= 0.d0 iz= 1 else bpxs(it)= cpxs(it) endif * *-----end on it loop * enddo * 1 if(iz.eq.0) then apxs= 0.d0 iz= 1 else apxs= bpxs(1)+bpxs(2) endif * if(apxs.lt.0.d0) then ifz(41)= ifz(41)+1 resf= 0.d0 else resf= apxs endif * if(oqcd.eq.'y') then nf= 5 alsch= wtoralphas(wm,chm,als,nf) fqcd= 1.d0+34.d0/3.d0*alsch/pi else fqcd= 1.d0 endif * wtoxsc12= tfact*resf*fqcd * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(wtoxsc12.gt.xshmx(jp)) then xshmx(jp)= wtoxsc12 do l=1,9 xmxh(jp,l)= x(l) enddo endif endif xaph(1)= xm xaph(2)= xp xaph(3)= sm xaph(4)= sp xaph(5)= su xaph(6)= sd xaph(7)= sf xaph(8)= tw xaph(9)= t1 xaph(10)= t3 endif * return end