* *-----WTOXSNH26----------------------------------------------------------- * real*8 function wtoxsnh26(ndim,x) implicit real*8 (a-h,o-z) character*1 oud,om,of parameter(npos=512) * common/wtfcd/of common/wtmod/om common/wtud/oud common/wtsfh/ip0 common/wtqcdz/alsz common/wthx/xshmx(npos) common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * of= 'l' * if(om.eq.'e') then sign1= wtoxsh24(ndim,x) sign2= wtoxsh26(ndim,x) back= wtoxsn(ndim,x) wtoxsnh26= sign1+sign2+back else if(om.eq.'g') then if(ip0.eq.1) then sign1= wtoxsh24(ndim,x) else if(ip0.gt.1) then sign1= 0.d0 endif if(ip0.eq.2) then sign2= wtoxsh26(ndim,x) else if(ip0.ne.2) then sign2= 0.d0 endif if(ip0.eq.3) then back= wtoxsn(ndim,x) else if(ip0.ne.3) then back= 0.d0 endif wtoxsnh26= sign1+sign2+back endif * return end * *-----WTOXSNH24----------------------------------------------------------- * real*8 function wtoxsnh24(ndim,x) implicit real*8 (a-h,o-z) character*1 oud,om,of parameter(npos=512) * common/wtfcd/of common/wtmod/om common/wtud/oud common/wtsfh/ip0 common/wtqcdz/alsz common/wthx/xshmx(npos) common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * of= 'l' * if(om.eq.'e') then if(oud.eq.'l') then sign= wtoxsh24(ndim,x) back= wtoxsn(ndim,x) wtoxsnh24= sign+back else if(oud.eq.'n') then sign= wtoxsh19(ndim,x) back= wtoxsn(ndim,x) wtoxsnh24= sign+back endif else if(om.eq.'g') then if(oud.eq.'l') then if(ip0.eq.2) then sign= 0.d0 else if(ip0.eq.1) then sign= wtoxsh24(ndim,x) endif if(ip0.eq.1) then back= 0.d0 else if(ip0.eq.2) then back= wtoxsn(ndim,x) endif wtoxsnh24= sign+back else if(oud.eq.'n') then if(ip0.eq.2) then sign= 0.d0 else sign= wtoxsh19(ndim,x) endif if(ip0.eq.1) then back= 0.d0 else back= wtoxsn(ndim,x) endif wtoxsnh24= sign+back endif endif * return end * *-----WTOXSNH19----------------------------------------------------------- * real*8 function wtoxsnh19(ndim,x) implicit real*8 (a-h,o-z) character*1 om parameter(npos=512) * common/wtmod/om common/wtsfh/ip0 common/wthx/xshmx(npos) common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * if(om.eq.'e') then sign= wtoxsh19(ndim,x) back= wtoxsn(ndim,x) else if(om.eq.'g') then if(ip0.eq.2) then sign= 0.d0 else if(ip0.eq.1) then sign= wtoxsh19(ndim,x) endif if(ip0.eq.1) then back= 0.d0 else if(ip0.eq.2) then back= wtoxsn(ndim,x) endif endif * wtoxsnh19= sign+back * return end * *-----WTOXSNH49----------------------------------------------------------- * real*8 function wtoxsnh49(ndim,x) implicit real*8 (a-h,o-z) character*1 om parameter(npos=512) * common/wtmod/om common/wtsfh/ip0 common/wthx/xshmx(npos) common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * if(om.eq.'e') then sign= wtoxsh49(ndim,x) back= wtoxsn(ndim,x) else if(om.eq.'g') then if(ip0.eq.2) then sign= 0.d0 else if(ip0.eq.1) then sign= wtoxsh49(ndim,x) endif if(ip0.eq.1) then back= 0.d0 else if(ip0.eq.2) then back= wtoxsn(ndim,x) endif endif * wtoxsnh49= sign+back * return end * *-----WTOXSNH32----------------------------------------------------------- * real*8 function wtoxsnh32(ndim,x) implicit real*8 (a-h,o-z) character*1 om,of parameter(npos=512) * common/wtfcd/of common/wtmod/om common/wtsfh/ip0 common/wthx/xshmx(npos) common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * of= 'q' * if(om.eq.'e') then sign= wtoxsh24(ndim,x) back= wtoxsn(ndim,x) backg= wtoxsng(ndim,x) wtoxsnh32= sign+back+backg else if(om.eq.'g') then if(ip0.eq.1) then sign= wtoxsh24(ndim,x) back= 0.d0 backg= 0.d0 else if(ip0.eq.2) then sign= 0.d0 back= wtoxsn(ndim,x) backg= 0.d0 else if(ip0.eq.3) then sign= 0.d0 back= 0.d0 backg= wtoxsng(ndim,x) endif wtoxsnh32= sign+back+backg endif * return end * *-----WTOXSNH64----------------------------------------------------------- * real*8 function wtoxsnh64(ndim,x) implicit real*8 (a-h,o-z) character*1 om parameter(npos=512) * common/wtihl/ih common/wtmod/om common/wtsfh/ip0 common/wthx/xshmx(npos) common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * if(om.eq.'e') then sign= 0.d0 do i=1,4 ih= i sign= sign+wtoxsh64(ndim,x) enddo back= wtoxsn64(ndim,x) wtoxsnh64= sign+back else if(om.eq.'g') then if(ip0.le.4) then ih= ip0 endif if(ip0.eq.1) then sign1= wtoxsh64(ndim,x) sign2= 0.d0 sign3= 0.d0 sign4= 0.d0 back= 0.d0 else if(ip0.eq.2) then sign1= 0.d0 sign2= wtoxsh64(ndim,x) sign3= 0.d0 sign4= 0.d0 back= 0.d0 else if(ip0.eq.3) then sign1= 0.d0 sign2= 0.d0 sign3= wtoxsh64(ndim,x) sign4= 0.d0 back= 0.d0 else if(ip0.eq.4) then sign1= 0.d0 sign2= 0.d0 sign3= 0.d0 sign4= wtoxsh64(ndim,x) back= 0.d0 else if(ip0.eq.5) then sign1= 0.d0 sign2= 0.d0 sign3= 0.d0 sign4= 0.d0 back= wtoxsn64(ndim,x) endif wtoxsnh64= sign1+sign2+sign3+sign4+back endif * return end * *-----WTOXSNSH64----------------------------------------------------------- * real*8 function wtoxsnsh64(ndim,x) implicit real*8 (a-h,o-z) character*1 om parameter(npos=512) * common/wtihl/ih common/wtmod/om common/wtsfh/ip0 common/wthx/xshmx(npos) common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim),sgn(8) * if(om.eq.'e') then sign= 0.d0 do i=1,4 ih= i sign= sign+wtoxsh64(ndim,x) enddo do i=1,4 ih= i sign= sign+wtoxsa64(ndim,x) enddo back= wtoxsn64(ndim,x) wtoxsnsh64= sign+back else if(om.eq.'g') then if(ip0.le.4) then ih= ip0 else if(ip0.gt.4.and.ip0.le.8) then ih= ip0-4 endif do i=1,8 sgn(i)= 0.d0 enddo if(ip0.le.4) then sgn(ip0)= wtoxsh64(ndim,x) back= 0.d0 else if(ip0.gt.4.and.ip0.le.8) then sgn(ip0)= wtoxsa64(ndim,x) back= 0.d0 else if(ip0.eq.9) then back= wtoxsn64(ndim,x) endif tots= 0.d0 do i=1,8 tots= tots+sgn(i) enddo wtoxsnsh64= tots+back endif * return end * *-----WTOXSSC----------------------------------------------------------- * real*8 function wtoxssc(ndim,x) implicit real*8 (a-h,o-z) character*1 om parameter(npos=512) * common/wtmod/om common/wtsfh/ip0 common/wthx/xshmx(npos) common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * dimension x(ndim) * if(om.eq.'e') then sign= wtoxsc12(ndim,x) back= wtoxsc(ndim,x) else if(om.eq.'g') then if(ip0.eq.2) then sign= 0.d0 else if(ip0.eq.1) then sign= wtoxsc12(ndim,x) endif if(ip0.eq.1) then back= 0.d0 else if(ip0.eq.2) then back= wtoxsc(ndim,x) endif endif * wtoxssc= sign+back * return end * *-----WTOXSH24----------------------------------------------------------- * real*8 function wtoxsh24(ndim,x) implicit real*8 (a-h,o-z) character*1 om,osm,oqcd,of,omssm * parameter(ninv=10,npos=512) * common/wtfcd/of common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wthiggs/hm common/wtsmod/osm 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/wticuts/iac(4) common/wtisa/isaa,isab common/wthx/xshmx(npos) common/wtparh/xaph(ninv) 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 * dimension tgn(21) 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 * *-----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 * *-----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 * zmas= zma-rzm2 zmbs= zmb-rzm2 atma= (zmas+szgs*zma)/rzmg atmb= (zmbs+szgs*zmb)/rzmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vzmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vzmg smjc0= (-atmb+atma)/vzmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vzmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vzmg smjc0= (-pi+atmb+atma)/vzmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/vzmg atmb= atan(atmb) zmbt= atmb/vzmg smjc0= (-pih+atmb+atma)/vzmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vzmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vzmg smjc0= (pi-atmb-atma)/vzmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vzmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vzmg smjc0= (atmb-atma)/vzmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/vzmg atmb= atan(atmb) zmbt= atmb/vzmg smjc0= (pih+atmb-atma)/vzmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/vzmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/vzmg smjc0= (pih-atmb-atma)/vzmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/vzmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/vzmg smjc0= (-pih+atmb-atma)/vzmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/vzmg atmb= atan(atmb) zmbt= atmb/vzmg smjc0= (atmb-atma)/vzmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= vzmg*zmv sm= s0z/vv*(1.d0+szg*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(omssm.eq.'n') then xrhm2= rhm2 xshg= shg xshgs= shgs xrhmg= rhmg xvhmg= vhmg xopshgs= opshgs else if(omssm.eq.'y') then xrhm2= rshm2 xshg= sshg xshgs= sshgs xrhmg= rshmg xvhmg= vshmg xopshgs= opsshgs endif if(itc.eq.3) then sp= (dist/rs/svv)**2 spjc= 2.d0*dist/s/((vv*sp-xrhm2)**2+ # (vv*sp*xshg)**2) else zpas= zpa-xrhm2 zpbs= zpb-xrhm2 atpa= (zpas+xshgs*zpa)/xrhmg atpb= (zpbs+xshgs*zpb)/xrhmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/xvhmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/xvhmg spjc0= (-atpb+atpa)/xvhmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/xvhmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/xvhmg spjc0= (-pi+atpb+atpa)/xvhmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/xvhmg atpb= atan(atpb) zpbt= atpb/vhmg spjc0= (-pih+atpb+atpa)/xvhmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/xvhmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/xvhmg spjc0= (pi-atpb-atpa)/xvhmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/xvhmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/xvhmg spjc0= (atpb-atpa)/xvhmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/xvhmg atpb= atan(atpb) zpbt= atpb/vhmg spjc0= (pih+atpb-atpa)/xvhmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/xvhmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/xvhmg spjc0= (pih-atpb-atpa)/xvhmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/xvhmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/xvhmg spjc0= (-pih+atpb-atpa)/xvhmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/xvhmg atpb= atan(atpb) zpbt= atpb/xvhmg spjc0= (atpb-atpa)/xvhmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= xvhmg*zpv sp= xrhm2/xopshgs/vv*(1.d0+xshg*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 * sdlim= rrl(3) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim= dmin1(sduim1,sduim2) * *-----limits on sd from Delta_- > 0 * if(ssu.gt.rasup) then sdld= (ssu-rasup)*(ssu-rasup) else sdld= sdlim endif sdud1= (ssu+rasup)*(ssu+rasup) sdud2= (-ssu+rasum)*(-ssu+rasum) sdud= dmin1(sdud1,sdud2) * *-----limits on sd from cuts on SA. Here for maximum security. Rare * if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then if(ss(2).eq.ss(1)) then asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) else if(ss(1).gt.ss(2)) then sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdu= dmin1(sduim,sdud,sdusa) asdl= dmax1(sdlim,sdld) else if(ss(1).lt.ss(2)) then asdu= dmin1(sduim,sdud) sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdl= dmax1(sdlim,sdld,sdlsa) endif else asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) endif if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then if(cs(2).eq.cs(1)) then sdl= asdl sdu= asdu else if(cs(1).gt.cs(2)) then sdu= asdu sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdl= dmax1(asdl,sdlsb) else if(cs(1).lt.cs(2)) then sdl= asdl sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdu= dmin1(asdu,sdusb) endif else sdl= asdl sdu= asdu endif * if(ieq.eq.0) then sdenl= -1.d0+bl(1)+bl(4)+su sdenu1= 1.d0-sp-bl(2) sdenu2= 1.d0-sm-bl(3) sdenu3= 1.d0-bl(2)-bl(3)+su else if(ieq.eq.1) then sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) sdenu1= enc-sp-xbl(2) sdenu2= enc-sm-xbl(3) sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3) endif sdl= dmax1(sdl,sdenl) sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) sdl= dmax1(sdl,sct14) * *-----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(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= sc O O O O O if(it.eq.1) then. O es2pl= (er1-sfl)/(sfl-er2)/ek. O es2pu= (er1-sfu)/(sfu-er2)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu# O else if(it.eq.2) then . O es2pl= (sfl-es2)/(sfl-es1)/ek. O es2pu= (sfu-es2)/(sfu-es1)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu O endifd% O if(eql.eq.1.d0) then. O sflt= 0.d0 O else  O ifel= 1m/ O sflt= 2.d0*dog*sqrt(es2pl)*u2 O # s21bbf(eql,erl,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(24)= ifz(24)+1c O go to 2 O endif  O endif% O if(equ.eq.1.d0) thend O sfut= 0.d0 O else  O ifel= 1 ? O if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) thens O equ= 0.d0 O endifd/ O sfut= 2.d0*dog*sqrt(es2pu)* 2 O # s21bbf(equ,eru,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(25)= ifz(25)+1  O go to 2 O endifl O endif* O sft= (sfut-sflt)*sfx+sflt O ifel= 1# O asf= 0.5d0/dog*sft 8 O call s21caf(asf,ek2,elsn,elcn,edn,ifel)! O elsn2= elsn*elsna# O if(ifel.ne.0) then1 O iz= 0 & O ifz(26)= ifz(26)+1 O go to 21 O endif! O if(it.eq.1) then-: O sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)& O else if(it.eq.2) then: O sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) O endif' O sfjc= efac*(sfut-sflt)1 O endif O *  O *-----auxiliary quantities  O *s O sdpf= sd+sf O e3= sp+su+sf1 O e4= 1.d0+spmm-e3d O e3p4= 1.d0+spmm O e1= sm+sdpf O e2= 1.d0+smmp-e1-( O e1p2= 1.d0+smmp $ O e1p3= e1+e3 0 O e1m2= 2.d0*e1-1.d0+spmm  O ep12= xp*e1*e2d O ep1= xp*e1- O ep2= xp*e2  O ep3= xp*e3 O  O ep4= xp*e4  O e1t2= e1*e2 O e1t3= e1*e3 O e1t4= e1*e4 O e2t3= e2*e3 O e2t4= e2*e4 O e3t4= e3*e4/ O if((e1p3*e1p3-4.d0*sf).lt.0.d0) then  O iz= 0! O ifz(27)= ifz(27)+1  O go to 2 O endif( O skl2= sqrt(e1p3*e1p3-4.d0*sf)+ O if((sdmus-4.d0*sd).lt.0.d0) theni O iz= 0! O ifz(28)= ifz(28)+1 O  O go to 2 O endif O skl3= sdmus-4.d0*sd O skl3= sqrt(skl3)m O *f O *-----initialization of t_wu O *,) O *-----limits on tw from positivity and SAo O *A O twlp1= 0.d0 O twlp2= smmp O twlp3= spmm-1.d0() O twlp= dmax1(twlp1,twlp2,twlp3)a O twup= 1.d0 O  O * " O *-----limits on tw from cuts on SA O *) O if(iac(3).ne.0) thenc& O skl2m= 0.5d0*(e1p3-skl2)& O skl2p= 0.5d0*(e1p3+skl2), O skl3p= -0.5d0*(1.d0+sdmu-skl3), O skl3m= -0.5d0*(1.d0+sdmu+skl3), O twlsa1= 1.d0-cs(3)*e3-cs(4)*e4' O twlsa2= ss(1)*e1+ss(2)*e2 8 O twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m4 O twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m4 O twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p8 O twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m, O twusa1= 1.d0-ss(3)*e3-ss(4)*e4' O twusa2= cs(1)*e1+cs(2)*e2t8 O twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m4 O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,u( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,4( O # twusa5,twusa6) O elses O atwl= twlp O atwu= twup O endif O *# O *-----limits on tw from Es O *c O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2)s" O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1))% O atwle2= bxe*e2-bl(2)-* O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2) 1 O twue= dmin1(atwle,atwue1,atwue2)s O endif)$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *  O *-----natural limits on tw O * O # O atwl= dmax1(atwl,bt1(1))f# O atwu= dmin1(atwu,bt2(1))  O *3 O *-----test on tw O *f O if(atwu.le.atwl) then O iz= 0- O ifz(29)= ifz(29)+1 O go to 2e O endif O *  O twjc= atwu-atwl O tw= twjc*twx+atwl O pn= tw+sp-1.d0f O omtw= 1.d0-tw O *  O *-----initialization of t1 O *a% O *-----limits on t1 from positivity+SAu O *f O t1lp1= 0.d0 O t1lp2= pn+sdpf  O t1up1= tw O t1up2= sm+sdpfn# O t1lp= dmax1(t1lp1,t1lp2)e# O t1up= dmin1(t1up1,t1up2)h O * O " O *-----limits on t1 from cuts on SA O *  O if(iac(3).ne.0) then) O t1lc1= ss(1)*e1 O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) 5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)*/ O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3s4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1 O O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))t5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3f4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else  O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E  O *  O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1))" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif($ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O **4 O *-----positivity of (R')^2 / reality of roots for t3 O *s! O rp0= e1p2*e1p2-4.d0*sms O if(rp0.lt.0.d0) thens O iz= 0 O ifz(30)= ifz(30)+1 O go to 2  O endif O srp0= sqrt(rp0) O rp0e= -rp0l, O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1 & O rp2= -(e1*tw-sm)*(e1*tw-sm) O ifct= 0 O if(rp0e.ne.0.d0) then7 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) / O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) O & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1))% O else if(rp0e.eq.0.d0) then0 O sret1= -rp2/rp1e# O if(rp1e.gt.0.d0) thenp' O t1l= dmax1(at1l,sret1)_ O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1). O endif  O endif O *  O *-----test on t1 O *+ O if(t1u.le.t1l) then O iz= 0. O ifz(31)= ifz(31)+1 O go to 2s O endif O * ! O *-----transformation for jacobian- O * O if(rp0e.eq.0.d0) then0 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)0 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-taul,9 O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e  O endif" O if(ret1(1).eq.t1l) then O at1tl= -pih/srp0 O elsec0 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) O ifas= 1 - O at1tl= -s09aaf(bt1tl,ifas)/srp0*% O if(ifas.ne.0) print 200a O endif" O if(ret2(1).eq.t1u) then O at1tu= pih/srp0  O else51 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)r O ifas= 1r- O at1tu= -s09aaf(bt1tu,ifas)/srp0 % O if(ifas.ne.0) print 200m O endif) O if((at1tl+at1tu).eq.0.d0) thenc# O if(t1x.lt.1.d-3) then O  O arc= pi*t1x O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10))))f8 O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc/ O else if((1.d0-t1x).lt.1.d-3) then.# O arc= pi*(1.d0-t1x)5 O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc O else" O carc= cos(pi*t1x)- O t1= 0.5d0*(ret1(1)+ret2(1))+ 1 O # 0.5d0*(ret1(1)-ret2(1))*carc1 O endif  O t1jc= pi/srp0) O elser& O t1tl= dmin1(at1tl,at1tu)& O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tl. O t1t= t1jc*t1x+t1tl. O t1= (rp1+rpds*sin(srp0*t1t))/rp0 O endif O t1s= t1*t1o O *=1 O 200 format(' Unsuccesful call to S09AAF ')  O *  O *-----test on t1 from FS A O * / O if(ieq.eq.1.and.iac(4).ne.0.d0) thend/ O cnlct1= xp*(xm*sm-ep12*cg12)+xdf* 7 O # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1-=+ O # xdf*tw)+xdfs*cg12*t1sf/ O cnlst1= xp*(ep12*sg12-xm*sm)-xdf* 7 O # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ + O # xdf*tw)-xdfs*sg12*t1sr% O if(cnlct1.lt.0.d0) then  O iz= 0# O ifz(32)= ifz(32)+1. O go to 2* O else if(cnlst1.lt.0.d0) then O iz= 0# O ifz(33)= ifz(33)+1  O go to 2 O endife O endif O *o O *-----some vector components O *  O t2= tw-t1f O *s O *-----equation for xi is solved2 O ** O e1s= e1*e1  O e2s= e2*e2  O e3s= e3*e3  O e12= e1t2-2.d0*sm O e13= e1t3-2.d0*sf O e23= e2t3-2.d0*su O e12s= e12*e12 O e13s= e13*e13 O e23s= e23*e23 O xia= e1s*e2s-e12s= O xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- < O # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ O # e2*e12*e13= O xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* > O # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0*< O # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1*> O # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s*< O # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*; O # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23e O xib= 2.d0*xib! O if(xia.eq.0.d0) then1$ O if(xib.eq.0.d0) then O iz= 0% O ifz(34)= ifz(34)+1  O go to 2 O endif O rtm(1)= -xic/xib O rtp(1)= rtm(1) O rtm(2)= 0.d0 O rtp(2)= 0.d0 O ixia= 0d O else  O ixia= 1s O ifc0= 0 5 O call c02ajf(xia,xib,xic,rtm,rtp,ifc0)  O endif$ O if(rtm(2).ne.0.d0) then O iz= 0e" O ifz(35)= ifz(35)+1 O go to 2  O endif O * O *-----xi^+ and xi^- are computed O * # O xip= 0.5d0*(e3-rtp(1)) # O xim= 0.5d0*(e3-rtm(1))  O * . O *-----each integral becomes a sum of two terms O *  O *-----loop over ix starts here O *  O if(om.eq.'g') then O ixmn= ix0 O ixmx= ix0 O else O ixmn= 1 O ixmx= 2 O endif  O do ix=ixmn,ixmxe O *,) O *-----q_3 is compared and x15 is selected0 O *h" O if(ix.eq.1) then O t3= xip' O else if(ix.eq.2) then2 O t3= xim O endif. O **% O *-----The two integrands are computed  O *c" O *-----further auxiliary quantities O *l O edn1= ep1-xdf*t10 O edn2= ep2-xdf*t2 O  O edn3= ep3-xdf*t32 O t4= omtw-t3 O edn4= ep4-xdf*t4o O *2% O *-----collections of all limits on t3  O * % O *-----from energy (or natural limits)  O * O if(ieq.eq.1) then* O at3l1= omtw-bxe*e4+bl(4)% O at3u1= bxe*e3-bl(3) & O if(xdf.gt.0.d0) then O t3l1= at3l1 O t3u1= at3u1+ O else if(xdf.lt.0.d0) then O O t3l1= at3u1 O t3u1= at3l1 O endifl O else  O t3l1= 0.d0 O t3u1= e3 O endif O *  O *-----natural limits O * . O t3l2= -t1+0.5d0*(e1p3-skl2). O t3u2= -t1+0.5d0*(e1p3+skl2) O * 7 O t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3)i7 O t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)x O *u O *-----from positivity on SAe O *1 O t3l4= 0.d0s$ O t3l5= sm+su+sf-tw! O t3u4= sp+su+sf  O t3u5= omtw. O *t *-----from SA  O * ' O if(iac(3).ne.0) then # O t3l6= ss(3)*e3 # O t3u6= cs(3)*e3 ( O t3l7= omtw-cs(4)*e4( O t3u7= omtw-ss(4)*e44 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,/ O # t3l5,t3l6,t3l7)i4 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,/ O # t3u5,t3u6,t3u7)  O elset9 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5)s9 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)e O endif O *  O *-----limits on t3 are imposed O * , O tlimt3= (t3u-t3)*(t3-t3l)& O if(t3u.lt.t3l) then O iz= 0 ( O ifz(36)= ifz(36)+1 O go to 4e/ O else if(tlimt3.lt.0.d0) then. O iz= 0 ( O ifz(36)= ifz(36)+1 O go to 4  O endif O * , O *-----non linear limits on t3,t4 are imposed O * 4 O if(iac(4).ne.0.and.ieq.eq.1) then3 O tnl13c= -cg13*edn1*edn3+vv*sf O 2 O tnl13s= sg13*edn1*edn3-vv*sf3 O tnl23c= -cg23*edn2*edn3+vv*sue2 O tnl23s= sg23*edn2*edn3-vv*su3 O tnl14c= -cg14*edn1*edn4+vv*sd 2 O tnl14s= sg14*edn1*edn4-vv*sd* O sres= 1.d0-e1-e3+sf 5 O tnl24c= -cg24*edn2*edn4+vv*sres 4 O tnl24s= sg24*edn2*edn4-vv*sres3 O tnl34c= -cg34*edn3*edn4+vv*sp 2 O tnl34s= sg34*edn3*edn4-vv*sp= O if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. = O # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or. = O # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. = O # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or.2 # 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 * itgn= 0 do l=1,21 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)) * *-----Higgs Bremsstrahlung diagram: * *-----helicity h1-2) * hb12r= 4.d0*gh1*(-x23*x56+x26*x35)-4.d0*gh2 hb12i= 16.d0*s13*gh1 hb1r= 4.d0*hch(1)*hb12r hb1i= 4.d0*hch(1)*hb12i hb2r= 4.d0*hch(2)*hb12r hb2i= -4.d0*hch(2)*hb12i * *-----helicity h3-4) * hb34r= 4.d0*gh3*(-x13*x56+x16*x35)-4.d0*gh4 hb34i= -16.d0*s9*gh3 hb3r= 4.d0*hch(3)*hb34r hb3i= 4.d0*hch(3)*hb34i hb4r= 4.d0*hch(4)*hb34r hb4i= -4.d0*hch(4)*hb34i * *-----helicity h5-6) * hb56r= 4.d0*(gh7*x25-gh8*x26-gh9*x35+gh10*x36) hb56i= 16.d0*(s11*gh5-s12*gh6) hb5r= 4.d0*hch(1)*hb56r hb5i= 4.d0*hch(1)*hb56i hb6r= 4.d0*hch(2)*hb56r hb6i= -4.d0*hch(2)*hb56i * *-----helicity h7-8) * hb78r= -2.d0*gh11*x35+2.d0*gh12*(-x13*x24*x56+ # x13*x26*x45+x14*x23*x56-x14*x26*x35-x16* # x23*x45+x16*x24*x35+x36*x45)-2.d0*gh13*x56+ # 4.d0*gh14*x14*x35-2.d0*gh15*x14*x36-2.d0* # gh16*x24*x36-2.d0*gh17*x13+2.d0*gh18*x16+ # 2.d0*gh19*x23+2.d0*gh20*x26-4.d0*gh21 hb78i= 8.d0*(s2*gh11-s4*gh12*x36-s6*gh13+2.d0*s7*gh14- # s8*gh15-s12*gh16+s15*gh12) hb7r= 4.d0*hch(3)*hb78r hb7i= 4.d0*hch(3)*hb78i hb8r= 4.d0*hch(4)*hb78r hb8i= -4.d0*hch(4)*hb78i * *-----complete diagrams: * if(omssm.eq.'n') then hcf0= 1.d0 else if(omssm.eq.'y') then hcf0= -salpha/cbeta*sbma alpha1= -salpha/cbeta*sbma alpha2= calpha/cbeta*cbma alpha21= alpha2/alpha1 propp= (sp-rbhm2/vv)*(sp-rbhm2/vv)+(sp*sbhg)**2 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) endif hcf0s= hcf0*hcf0 hcf= rbqm2/vv/64.d0/cth4**2/dsz*hcf0s * *-----Total * if(omssm.eq.'n') then chb1r= hb1r chb1re= 0.d0 chb1ie= hb1i chb1i= 0.d0 chb2r= hb2r chb2re= 0.d0 chb2ie= hb2i chb2i= 0.d0 chb3r= hb3r chb3re= 0.d0 chb3ie= hb3i chb3i= 0.d0 chb4r= hb4r chb4re= 0.d0 chb4ie= hb4i chb4i= 0.d0 chb5r= hb5r chb5re= 0.d0 chb5ie= hb5i chb5i= 0.d0 chb6r= hb6r chb6re= 0.d0 chb6ie= hb6i chb6i= 0.d0 chb7r= hb7r chb7re= 0.d0 chb7ie= hb7i chb7i= 0.d0 chb8r= hb8r chb8re= 0.d0 chb8ie= hb8i chb8i= 0.d0 else if(omssm.eq.'y') then chb1r= addpr*hb1r chb1re= -addpi*hb1i chb1ie= addpr*hb1i chb1i= addpi*hb1r chb2r= addpr*hb2r chb2re= -addpi*hb2i chb2ie= addpr*hb2i chb2i= addpi*hb2r chb3r= addpr*hb3r chb3re= -addpi*hb3i chb3ie= addpr*hb3i chb3i= addpi*hb3r chb4r= addpr*hb4r chb4re= -addpi*hb4i chb4ie= addpr*hb4i chb4i= addpi*hb4r chb5r= addpr*hb5r chb5re= -addpi*hb5i chb5ie= addpr*hb5i chb5i= addpi*hb5r chb6r= addpr*hb6r chb6re= -addpi*hb6i chb6ie= addpr*hb6i chb6i= addpi*hb6r chb7r= addpr*hb7r chb7re= -addpi*hb7i chb7ie= addpr*hb7i chb7i= addpi*hb7r chb8r= addpr*hb8r chb8re= -addpi*hb8i chb8ie= addpr*hb8i chb8i= addpi*hb8r endif * dthr= chb1r*chb1r+chb2r*chb2r+chb3r*chb3r+chb4r*chb4r+ # chb5r*chb5r+chb6r*chb6r+chb7r*chb7r+chb8r*chb8r dthre= chb1re*chb1re+chb2re*chb2re+chb3re*chb3re+chb4re*chb4re+ # chb5re*chb5re+chb6re*chb6re+chb7re*chb7re+chb8re*chb8re dthie= chb1ie*chb1ie+chb2ie*chb2ie+chb3ie*chb3ie+chb4ie*chb4ie+ # chb5ie*chb5ie+chb6ie*chb6ie+chb7ie*chb7ie+chb8ie*chb8ie dthi= chb1i*chb1i+chb2i*chb2i+chb3i*chb3i+chb4i*chb4i+ # chb5i*chb5i+chb6i*chb6i+chb7i*chb7i+chb8i*chb8i dth= hcf*(dthr+dthre+dthie+dthi) * 4 if(iz.eq.0) then dpxs(ix,it)= 0.d0 iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc*vv 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 if(omssm.eq.'n') then xhm= hm else if(omssm.eq.'y') then xhm= shm endif alsh= wtoralphas(wm,xhm,als,nf) if(omssm.eq.'n') then fqcd= 1.d0+alsh/pi*(17.d0/3.d0+(35.94d0-1.36d0*nf)* # alsh/pi) else if(omssm.eq.'y') then fqcd= 1.d0+17.d0/3.d0*alsh/pi endif if(of.eq.'q') then fqcd= fqcd*(1.d0+0.5d0*alsz/pi*(fcdn-1.d0)) endif else fqcd= 1.d0 endif * wtoxsh24= tfact*resf*bfact*fqcd * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(wtoxsh24.gt.xshmx(jp)) then xshmx(jp)= wtoxsh24 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 * *-----WTOXSH26----------------------------------------------------------- * real*8 function wtoxsh26(ndim,x) implicit real*8 (a-h,o-z) character*1 om,osm,oqcd,of,omssm * parameter(ninv=10,npos=512) * common/wtfcd/of common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wthiggs/hm common/wtsmod/osm common/wtkount/ik common/wtdis/dist common/wtqcdz/alsz common/wtaqcd/oqcd common/wtbme/bfact common/wtistrf/isf common/wtsf/ix0,it0 common/wtipt/ifz(44) common/wtmssmo/omssm common/wticuts/iac(4) common/wtisa/isaa,isab common/wthx/xshmx(npos) common/wtparh/xaph(ninv) 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,o O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O bl(j)= 2.d0*rae(j)/xdf # O xbl(j)= 2.d0*rae(j)/xp O else if(ieq.eq.0) then" O bl(j)= 2.d0*rae(j)/xm O endif O enddog O *= O *-----cuts on SA O *- O if(iac(3).ne.0) then O do j=1,4 % O if(sgam(j).eq.1.d0) then  O ss(j)= 0.d0e O else 7 O ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmopb! O ss(j)= 1.d0/ss(j)0 O endif% O if(cgam(j).eq.0.d0) then  O cs(j)= 1.d0i O elsei7 O cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop ! O cs(j)= 1.d0/cs(j)- O endif O enddo O endif4 O **" O *-----initialization of sm = m_-^2 O *  O zma1= dsm* O zma2= vv*sct12 O zmb1= usm O ! O zmb2= (svv-sdsp)*(svv-sdsp) 4 O zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) O if(ieq.eq.0) then $ O zma3= vv*(bl(1)+bl(2)-1.d0)- O zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))*9) O # (1.d0-0.5d0*(bl(3)+bl(4)))- O zmb5= vv*(1.d0-bl(3)) O zmb6= vv*(1.d0-bl(4)) O else if(ieq.eq.1) then& O zma3= vv*(-enc+xbl(1)+xbl(2))2 O zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))*' O # (1.d0+enc-xbl(3)-xbl(4))h O zmb5= vv*(enc-xbl(3)) O zmb6= vv*(enc-xbl(4)) O endifx! O xzma= dmax1(zma1,zma2,zma3)x0 O xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) O *gC O *-----limits on sm from cuts on SA. Here for maximum security. Rare  O *  O if(iac(3).eq.0) then O zma= xzma O zmb= xzmb O else h4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) then  O szma= xzmae O szmb= xzmbb( O else if(ss(3).gt.ss(1)) then O szmb= xzmb O  O adsp= dsp/vvi( O axszma= dmax1(adsp,sct34)5 O axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/e% O # (ss(3)-ss(1)))-' O szma= dmax1(axszma,xzma)p( O else if(ss(3).lt.ss(1)) then& O if(ss(3).lt.0.5d0) then O szma= xzma= O axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2o* O szmb= dmin1(axszmb,xzmb) O else) O iz= 0/" O ifz(2)= ifz(2)+1 O go to 1s O endif O endif0 else= O szma= xzma O szmb= xzmb O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) thenx O zma= szma O zmb= szmb( O else if(cs(3).gt.cs(1)) then& O if(cs(3).gt.0.5d0) then O zma= szma = O axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2r) O zmb= dmin1(axczmb,szmb)h O else  O iz= 0r" O ifz(3)= ifz(3)+1 O go to 1i O endif( O else if(cs(3).lt.cs(1)) then O zmb= szmb  O adsp= dsp/vv+ O axczma= dmax1(adsp,sct34) 8 O axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/( O # (cs(3)-cs(1)))) O zma= dmax1(axczma,szma)n O endifd else  O zma= szma O  O zmb= szmbh O endif O endifb O if(itc.eq.3) then** O dzmb= (svv-dist/rs)*(svv-dist/rs) O zmb= dmin1(zmb,dzmb)c O endifb O * O  O *-----test on sm O ** O if(zmb.le.zma) thenp O iz= 0 O ifz(4)= ifz(4)+1  O go to 1 O endifc O *r O zmas= zma-ram2 O zmbs= zmb-ram2 O atma= (zmas+sags*zma)/ramg O atmb= (zmbs+sags*zmb)/ramg, O if(atma.gt.1.d0.and.atmb.gt.1.d0) then O atma= 1.d0/atma O atma= atan(atma)* O zmat= (pih-atma)/vamg O atmb= 1.d0/atmb O atmb= atan(atmb)r O zmbt= (pih-atmb)/vamg! O smjc0= (-atmb+atma)/vamg 2 O else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then O atma= 1.d0/atma O atma= atan(atma)* O zmat= (pih-atma)/vamg O atmb= -1.d0/atmbh O atmb= atan(atmb)* O zmbt= (-pih+atmb)/vamgr$ O smjc0= (-pi+atmb+atma)/vamg6 O else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then O atma= 1.d0/atma O atma= atan(atma)* O zmat= (pih-atma)/vamg O atmb= atan(atmb)b O zmbt= atmb/vamg% O smjc0= (-pih+atmb+atma)/vamgi2 O else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then O atma= -1.d0/atma+ O atma= atan(atma)+ O zmat= (-pih+atma)/vamg* O atmb= 1.d0/atmb O atmb= atan(atmb)  O zmbt= (pih-atmb)/vamg# O smjc0= (pi-atmb-atma)/vamgt3 O else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) thene O atma= -1.d0/atma  O atma= atan(atma) O  O zmat= (-pih+atma)/vamg  O atmb= -1.d0/atmb  O atmb= atan(atmb)  O zmbt= (-pih+atmb)/vamg O smjc0= (atmb-atma)/vamg7 O else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then* O atma= -1.d0/atma  O atma= atan(atma)  O zmat= (-pih+atma)/vamg  O atmb= atan(atmb)  O zmbt= atmb/vamg$ O smjc0= (pih+atmb-atma)/vamg6 O else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then O atma= atan(atma)  O zmat= atma/vamg O atmb= 1.d0/atmb O atmb= atan(atmb)  O zmbt= (pih-atmb)/vamg$ O smjc0= (pih-atmb-atma)/vamg7 O else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then  O atma= atan(atma)x O zmat= atma/vamg O atmb= -1.d0/atmbx O atmb= atan(atmb)i O zmbt= (-pih+atmb)/vamg=% O smjc0= (-pih+atmb-atma)/vamg ; O else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then5 O atma= atan(atma)  O zmat= atma/vamg O atmb= atan(atmb). O zmbt= atmb/vamg O smjc0= (atmb-atma)/vamg O endifa O *m O zmv= smjc0*smx+zmatm iftn= 1n O atnm= vamg*zmv O s0a= ram2/opsags- O sm= s0a/vv*(1.d0+sag*s07aaf(atnm,iftn))) O if(iftn.ne.0) print 300) O if(sm.lt.0.d0) then. O iz= 0 O ifz(4)= ifz(4)+1  O go to 1 O endif  O ssm= sqrt(sm)0 O smjc= vv*smjc0 O *)- O 300 format(/' Unsuccesful call to S07AAF ')1 O *x" O *-----initialization of sp = m_+^2 O *c O zpa1= dspx O zpb1= usp.$ O zpb2= vv*(1.d0-ssm)*(1.d0-ssm) O *nC O *-----limits on sp from cuts on SA. Here for maximum security. Rarej O *  O if(iac(3).eq.0) then O zpb= dmin1(zpb1,zpb2) O zpa= zpa1 O else p4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) then O % O azpb= dmin1(zpb1,zpb2)  O azpa= zpa1 ( O else if(ss(3).gt.ss(1)) then= O zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1)))1* O azpb= dmin1(zpb1,zpb2,zpb3) O azpa= zpa1 ( O else if(ss(3).lt.ss(1)) then% O azpb= dmin1(zpb1,zpb2) O = O zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1)))a% O azpa= dmax1(zpa1,zpa2), O endif else1 O azpa= zpa1" O azpb= dmin1(zpb1,zpb2) O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) then  O zpa= azpa O zpb= azpb( O else if(cs(3).gt.cs(1)) then O zpb= azpb= O bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) $ O zpa= dmax1(azpa,bzpa)( O else if(cs(3).lt.cs(1)) then O zpa= azpa= O bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1)))h$ O zpb= dmin1(azpb,bzpb) O endif else  O zpa= azpax O zpb= azpbo O endif O endifl O *a O if(ieq.eq.0) thenl' O zpen= vv*(1.d0-bl(1)-bl(2)+sm)o( O zmen= vv*(-1.d0+bl(3)+bl(4)+sm) O zpa= dmax1(zpa,zmen)m O zpb= dmin1(zpb,zpen)  O else if(ieq.eq.1) then( O zpel= vv*(sm-enc+xbl(3)+xbl(4))) O zpeu1= vv*(sm+enc-xbl(1)-xbl(2))m O zpeu2= vv*(enc-xbl(1))h O zpeu3= vv*(enc-xbl(2))c O zpa dmax1(zpa,zpel)t* O zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) O endif2 O zpap= vv*sct34 O zpa= dmax1(zpa,zpap) O *  O *-----test on sp O *s O if(zpb.le.zpa) thens O iz= 0 O ifz(5)= ifz(5)+1h O go to 1 O endif O  O *  O if(itc.eq.3) then O bdistl= dist*dist/s-zpa O bdistu= zpb-dist*dist/s2 O if(bdistl.le.0.d0.or.bdistu.le.0.d0) then O iz= 0( O ifz(5)= ifz(5)+1 O go to 1  O endif O endif4 O *e O if(itc.eq.3) then) O sp= (dist/rs/svv)**2,- O spjc= 2.d0*dist/s/((vv*sp-rshm2)**2+ O # (vv*sp*sshg)**2) O else O zpas= zpa-rshm2 O zpbs= zpb-rshm2% O atpa= (zpas+sshgs*zpa)/rshmgb% O atpb= (zpbs+sshgs*zpb)/rshmg / O if(atpa.gt.1.d0.and.atpb.gt.1.d0) thens O atpa= 1.d0/atpa  O atpa= atan(atpa)" O zpat= (pih-atpa)/vshmg O atpb= 1.d0/atpb, O atpb= atan(atpb)" O zpbt= (pih-atpb)/vshmg% O spjc0= (-atpb+atpa)/vshmg 5 O else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) thenf O atpa= 1.d0/atpa2 O atpa= atan(atpa)" O zpat= (pih-atpa)/vshmg O atpb= -1.d0/atpb O atpb= atan(atpb)# O zpbt= (-pih+atpb)/vshmgp( O spjc0= (-pi+atpb+atpa)/vshmg9 O else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then0 O atpa= 1.d0/atpa# O atpa= atan(atpa)" O zpat= (pih-atpa)/vshmg O atpb= atan(atpb) O zpbt= atpb/vshmg) O spjc0= (-pih+atpb+atpa)/vshmgr5 O else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then, O atpa= -1.d0/atpa O atpa= atan(atpa)# O zpat= (-pih+atpa)/vshmg^ O atpb= 1.d0/atpbe O atpb= atan(atpb)" O zpbt= (pih-atpb)/vshmg' O spjc0= (pi-atpb-atpa)/vshmgt6 O else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then O atpa= -1.d0/atpa O atpa= atan(atpa)# O zpat= (-pih+atpa)/vshmg O  O atpb= -1.d0/atpb O atpb= atan(atpb)# O zpbt= (-pih+atpb)/vshmg $ O spjc0= (atpb-atpa)/vshmg: O else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then O atpa= -1.d0/atpa O atpa= atan(atpa)# O zpat= (-pih+atpa)/vshmg) O atpb= atan(atpb) O zpbt= atpb/vshmg( O spjc0= (pih+atpb-atpa)/vshmg9 O else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then  O atpa= atan(atpa) O zpat= atpa/vshmg O atpb= 1.d0/atpbm O atpb= atan(atpb)" O zpbt= (pih-atpb)/vshmg( O spjc0= (pih-atpb-atpa)/vshmg: O else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then O atpa= atan(atpa) O zpat= atpa/vshmg O atpb= -1.d0/atpb O atpb= atan(atpb)# O zpbt= (-pih+atpb)/vshmg ) O spjc0= (-pih+atpb-atpa)/vshmgr> O else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then O atpa= atan(atpa) O zpat= atpa/vshmg O atpb= atan(atpb) O zpbt= atpb/vshmg$ O spjc0= (atpb-atpa)/vshmg O endif O *i O zpv= spjc0*spx+zpat O iftn= 1 O atnp= vshmg*zpv; O sp= rshm2/opsshgs/vv*(1.d0+sshg*s07aaf(atnp,iftn)) O if(iftn.ne.0) print 300 O spjc= vv*spjc0 O endif  O *n O if(sp.lt.0.d0) thend O iz= 0 O ifz(5)= ifz(5)+1  O go to 1 O endif  O ssp= sqrt(sp)  O spmm= sp-sme O smmp= sm-sp= O *u O cbw= -1.d0+sp-sm ifcr= 0-* O call c02ajf(one,cbw,sm,bt1,bt2,ifcr) O if(bt1(2).ne.0.d0) thenv O iz= 0 O ifz(6)= ifz(6)+1  O go to 1 O endif. O *t O smtp= sm*spv O ssmpp= ssm+ssp O ssmmp= ssm-ssp O asup= 1.d0-ssmpp*ssmpp O asum= 1.d0-ssmmp*ssmmp+ O if(asup.lt.0.d0.or.asum.lt.0.d0) then O  O iz= 0 O ifz(7)= ifz(7)+1m O go to 1 O endifl O rasup= sqrt(asup)t O rasum= sqrt(asum)  O *l" O *-----initialization of su = M_0^2 O *m% O *-----limits on su from cuts on FS IM  O *  O sulim= rrl(4)  O suuim1= rrr(4)5 O suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) 2! O suuim= dmin1(suuim1,suuim2)  O *v@ O *-----limits on su from Delta_- > 0 (as derived from consistency O * on sd limits)l O *v/ O suud1= 0.25d0*(rasup+rasum)*(rasup+rasum)i- O suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup)  O *  O sul= sulim O sul= dmax1(sul,sct23)  O if(ieq.eq.0) thenh O sul1= bl(2)+bl(3)-1.d0h O suu1= 1.d0-sp-bl(1) O suu2= 1.d0-sm-bl(4)* O suu3= (1.d0-0.5d0*(bl(1)+bl(4)))** O # (1.d0-0.5d0*(bl(1)+bl(4))) O else if(ieq.eq.1) then* O sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc O suu1= enc-sp-xbl(1) O suu2= enc-sm-xbl(4)+ O suu3= (enc-0.5d0*(xbl(1)+xbl(4)))*e* O # (enc-0.5d0*(xbl(1)+xbl(4))) O endif  O sul= dmax1(sul,sul1)2 O suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) O *  O *-----test on su O *  O if(suu.le.sul) then  O iz= 0 O ifz(8)= ifz(8)+1  O go to 1 O endif  O *d O sujc= suu-sul O  O su= sujc*sux+sul O if(su.lt.0.d0) then  O iz= 0 O ifz(8)= ifz(8)+1  O go to 1 O endif  O ssu= sqrt(su)  O * " O *-----initialization of sd = m_0^2 O * O % O *-----limits on sd from cuts on FS IM O  O *  O sdlim= rrl(3)v O sduim1= rrr(3)# O sduim2= (1.d0-ssu)*(1.d0-ssu))! O sduim= dmin1(sduim1,sduim2)l O * O # O *-----limits on sd from Delta_- > 0/ O * O  O if(ssu.gt.rasup) then*& O sdld= (ssu-rasup)*(ssu-rasup) O else O sdld= sdlim O endifr$ O sdud1= (ssu+rasup)*(ssu+rasup)& O sdud2= (-ssu+rasum)*(-ssu+rasum) O sdud= dmin1(sdud1,sdud2) O *eC O *-----limits on sd from cuts on SA. Here for maximum security. Rarep O * A O if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then e O if(ss(2).eq.ss(1)) then# O asdu= dmin1(sduim,sdud) # O asdl= dmax1(sdlim,sdld) % O else if(ss(1).gt.ss(2)) thenp6 O sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))) O asdu= dmin1(sduim,sdud,sdusa) # O asdl= dmax1(sdlim,sdld)y% O else if(ss(1).lt.ss(2)) then*# O asdu= dmin1(sduim,sdud) 6 O sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))) O asdl= dmax1(sdlim,sdld,sdlsa)e O endif O else O asdu= dmin1(sduim,sdud) O asdl= dmax1(sdlim,sdld) O endifmA O if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then b O if(cs(2).eq.cs(1)) then O sdl= asdl* O sdu= asdu % O else if(cs(1).gt.cs(2)) then O  O sdu= asduo6 O sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))" O sdl= dmax1(asdl,sdlsb)% O else if(cs(1).lt.cs(2)) thene O sdl= asdlm6 O sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))" O sdu= dmin1(asdu,sdusb) O endif O else O sdl= asdl O sdu= asdu O endifr O *) O if(ieq.eq.0) thenl$ O sdenl= -1.d0+bl(1)+bl(4)+su O sdenu1= 1.d0-sp-bl(2) O sdenu2= 1.d0-sm-bl(3)$ O sdenu3= 1.d0-bl(2)-bl(3)+su O else if(ieq.eq.1) then. O sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) O sdenu1= enc-sp-xbl(2) O sdenu2= enc-sm-xbl(3)/ O sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3)q O endif  O sdl= dmax1(sdl,sdenl) * O sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) O sdl= dmax1(sdl,sct14)1 O *  O *-----test on sd O *  O if(sdu.le.sdl) thenq O iz= 0 O ifz(9)= ifz(9)+1  O go to 1 O endif  O *  O sdjc= sdu-sdl O  O sd= sdjc*sdx+sdl O if(sd.lt.0.d0) thenv O iz= 0 O ifz(9)= ifz(9)+1t O go to 1 O endif  O ssd= sqrt(sd)  O sdmu= sd-su $ O sdmus= (1.d0+sdmu)*(1.d0+sdmu) O * O O *-----initialization of sf = m^2 O * % O *-----limits on sf from cuts on FS IM- O *s O sflim1= rrl(2) O sfuim1= rrr(2) O bsg= sm+sp+su+sd O ombsg= 1.d0-bsgd O sflim2= ombsg-rrr(5) O sfuim2= ombsg-rrl(5)! O sflim= dm (sflim1,sflim2)(! O sfuim= dmin1(sfuim1,sfuim2)  O * " O *-----limits on sf from cuts on SA O * $ O tcuts= ss(1)-ss(2)+ss(3)-ss(4)$ O tcutc= cs(1)-cs(2)+cs(3)-cs(4)> O if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then1 O if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) thenb6 O sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc 6 O sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- + O # (ss(1)-ss(4))*sm)/tcuts n$ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa)6 O else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then6 O sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-b+ O # (ss(1)-ss(4))*sm)/tcuts 6 O sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-(+ O # (cs(1)-cs(4))*sm)/tcutc )* O asfu= dmin1(sfuim,sfusa,sfusb)# O asfl= sflim 06 O else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-3+ O # (ss(1)-ss(4))*sm)/tcuts 6 O sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc )* O asfl= dmax1(sflim,sflsa,sflsb)# O asfu= sfuim s6 O else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-1+ O # (ss(1)-ss(4))*sm)/tcuts m6 O sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc $ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa) O endif O else O asfl= sflim O asfu= sfuim O endifx O *) O if(ieq.eq.0) then  O asfenl1= bl(1)-sm-sd  O asfenl2= bl(3)-sp-su " O asfenu1= 1.d0-bl(2)-sp-sd" O asfenu2= 1.d0-bl(4)-sm-su O else if(ieq.eq.1) then' O asfenl1= 1.d0-enc-sm-sd+xbl(1)f' O asfenl2= 1.d0-enc-sp-su+xbl(3)." O asfenu1= enc-sp-sd-xbl(2)" O asfenu2= enc-sm-su-xbl(4) O endif ' O asfl= dmax1(asfl,asfenl1,asfenl2)3' O asfu= dmin1(asfu,asfenu1,asfenu2).# O aasfu= 1.d0-sm-sp-su-sd-sct24= O asfl= dmax1(asfl,sct13)b O asfu= dmin1(asfu,aasfu)) O ** O if(iac(3).ne.0) then O if(ss(4).ne.ss(3)) then O if(ss(4).gt.ss(3)) thenr5 O asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ 7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)).# O asfl= dmax1(asfl,asfltw)=% O else if (ss(4).lt.ss(3)) then O 5 O asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ 7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) # O asfu= dmin1(asfu,asfutw) endif= O endif O if(cs(1).ne.cs(2)) then O if(cs(1).gt.cs(2)) then O 9 O bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ . O # cs(2)-bt1(1))/(cs(1)-cs(2))# O asfl= dmax1(asfl,bsfltw)($ O else if(cs(1).lt.cs(2)) then9 O bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ / O # cs(2)-bt1(1))/(cs(1)-cs(2)) # O asfu= dmin1(asfu,bsfutw) endif2 O endif O if(cs(4).ne.cs(3)) then O if(cs(4).gt.cs(3)) thena; O csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- O 0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfu= dmin1(asfu,csfutw) $ O else if(cs(4).lt.cs(3)) then; O csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- 0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfl= dmax1(asfl,csfltw)a endif O endif O if(ss(1).ne.ss(2)) then O if(ss(1).gt.ss(2)) thenb6 O dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfu= dmin1(asfu,dsfutw)m$ O else if(ss(1).lt.ss(2)) then6 O dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfl= dmax1(asfl,dsfltw)( endifn O endif O endif  O *a O *-----positivity of R^2  O *m O scp= ssmpp*ssmpp  O scm= ssmmp*ssmmp $ O snp= (ssu+ssd)*(ssu+ssd) $ O snm= (ssu-ssd)*(ssu-ssd)  O rlp= ssu*ssd+ssp*ssm O rlm= ssu*ssd-ssp*ssm O bsgmo= bsg-1.d01 O ombsg2= ombsg*ombsg- O rlps= rlp*rlpa O rlms= rlm*rlm  O edelp= ombsg2-4.d0*rlps  O edelm= ombsg2-4.d0*rlms " O edeld= 16.d0*ssu*ssd*ssp*ssm O *p7 O *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2l O * then Delta_+ > 0 O *( *-----controlt O ** O cnt1= scp+snm0 O cnt2= scm+snp=+ O if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then  O iz= 0 O ifz(10)= ifz(10)+1a O go to 1 O endifa O if(edelm.le.0.d0) then O etest= edeld+edelp. O if(etest.gt.0.d0) thent O edelm= etest elsea O iz= 0  O ifz(11)= ifz(11)+1 O go to 1g O endif O endift O sedm= sqrt(edelm)b ifcr= 0.. O call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) O if(rr1(2).ne.0.d0) then O  O iz= 0 O ifz(12)= ifz(12)+1a O go to 1 O endifa ifcr= 0 . O call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) O *b O cnt3= scp+snpb O cnt4= scm+snm5 O cbru= -1.d0a O ccru= 0.5d0*bsg= O *m< O *-----R^2 has two real roots and two complex conjugate roots O * + O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) thenm O if(bsg.gt.0.5d0) then O iel= 1 O sflr(1)= rr1(1)m O sfur(1)= rr2(1). O sflr(2)= rr1(1)  O sfur(2)= rr2(1) O else0 O iel= 2 O ifcr= 045 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr)= O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1)n O sflr(2)= ru2 O sfur(1)= ru1 O sfur(2)= rr2(1)v O endif O *s O *-----R^2 has four real roots  O *s1 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then  O if(bsg.gt.0.5d0) then O sflr(1)= rr1(1)  O sflr(2)= rs2(1)  O sfur(1)= rs1(1)( O sfur(2)= rr2(1) elses O ifcr= 0 5 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1)-& O sfur(1)= dmin1(rs1(1),ru1)& O sflr(2)= dmax1(rs2(1),ru2) O sfur(2)= rr2(1)t O endif O endifa O *=. O *-----the loop for transforming sf starts here O *d O if(om.eq.'g') then O itmn= it0 O itmx= it0 O else O itmn= 1 O itmx= 2 O endifp O do it=itmn,itmxm$ O if(sflr(it).ge.asfl) then O sfl= sflr(it)) O else O  O sfl= asfls O endif$ O if(sfur(it).le.asfu) then O sfu= sfur(it)s O elsen O sfu= asfub O endif O *= O *-----test on sf O *s O if(sfu.le.sfl) then O iz= 0b O ifz(13)= ifz(13)+1 O go to 2  O endif O * F O *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 O *b0 O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then O er= rs1(1) O es= abs(rs1(2))  O er1= rr1(1)a O er2= rr2(1) O  O ek2= edelm/edeld O ek= sqrt(ek2)-$ O dog= -2.d0/sqrt(edeld)) O ecpl= (ombsg-2.d0*sfl)/sedmn) O ecpu= (ombsg-2.d0*sfu)/sedmz O eql= ecpl*ecpl O equ= ecpu*ecpu) O omecpl= 2.d0*(sfl-er1)/sedm() O es2pl= omecpl*(2.d0-omecpl) ! O erl= 1.d0-ek2*es2pl  O espl= sqrt(es2pl))) O opecpu= 2.d0*(er2-sfu)/sedm ) O es2pu= opecpu*(2.d0-opecpu) O  O espu= sqrt(es2pu) ! O eru= 1.d0-ek2*es2pu5 O if(eql.eq.1) theni O sflt= 0.d0e O else O ifel= 19 O sflt= -dog*espl*s21bbf(eql,erl,one,ifel)s# O if(ifel.ne.0) then O  O iz= 01& O ifz(14)= ifz(14)+1 O go to 2c O endif O endif O " O if(equ.eq.1.d0) then O sfut= 0.d0v O else O ifel= 19 O sfut= -dog*espu*s21bbf(equ,eru,one,ifel)s# O if(ifel.ne.0) thenh O iz= 0(& O ifz(15)= ifz(15)+1 O go to 2  O endif O endif  O if(iel.eq.1) thenb# O if(sfu.le.er) thena O efac= 0.5d0)- O sft= (sfut-sflt)*sfx+sflt O  O ifel= 1.! O asf= -sft/dog ; O call s21caf(asf,ek2,elsn,elcn,edn,ifel) & O if(ifel.ne.0) then O iz= 0) O ifz(16)= ifz(16)+1/ O go to 2 O endife/ O sf= 0.5d0*(ombsg-sedm*elcn) O * O sfjc= efac*(sfut-sflt)) O else if(sfl.ge.er) then) O efac= 0.5d0p- O sft= (sflt-sfut)*sfx+sfutp O ifel= 1 O ! O asf= -sft/doga; O call s21caf(asf,ek2,elsn,elcn,edn,ifel) & O if(ifel.ne.0) then O iz= 0) O ifz(17)= ifz(17)+1) O go to 2 O endifi/ O sf= 0.5d0*(ombsg+sedm*elcn)0* O sfjc= efac*(sflt-sfut) O else O efac= 1.d0 O qbar= 0.d0" O rbar= 1.d0-ek2 O ifel= 1p: O sfbar= -dog*s21bbf(qbar,rbar,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(18)= ifz(18)+1n O go to 2 O endift$ O if(it.eq.1) then1 O sft= (sfbar-sflt)*sfx+sflt  O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) then O  O iz= 0g, O ifz(19)= ifz(19)+1! O go to 2d O endif2 O sf= 0.5d0*(ombsg-sedm*elcn). O sfjc= efac*(sfbar-sflt)* O else if(it.eq.2) then1 O sft= (sfbar-sfut)*sfx+sfut  O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) thenh O iz= 0), O ifz(20)= ifz(20)+1! O go to 2  O endif2 O sf= 0.5d0*(ombsg+sedm*elcn). O sfjc= efac*(sfbar-sfut) O endif O endife$ O else if(iel.eq.2) then O efac= 1.d0" O if(it.eq.1) then. O sft= (sfut-sflt)*sfx+sflt O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) then1 O iz= 0 * O ifz(21)= ifz(21)+1 O go to 2m O endif0 O sf= 0.5d0*(ombsg-sedm*elcn)+ O sfjc= efac*(sfut-sflt) O ' O else if(it.eq.2) thenu. O sft= (sflt-sfut)*sfx+sfut O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) then  O iz= 0s* O ifz(22)= ifz(22)+1 O go to 2i O endif0 O sf= 0.5d0*(ombsg+sedm*elcn)+ O sfjc= efac*(sflt-sfut)r O endifl O endifs6 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then$ O if(edelp.le.0.d0) then O iz= 0# O ifz(23)= ifz(23)+15 O go to 2 O endif* O sedp= sqrt(edelp). O efac= 1.d0 O es1= rs1(1)c O es2= rs2(1)( O er1= rr1(1)b O er2= rr2(1). O ssed= sedm+sedp " O ek= (sedm-sedp)/ssed O ek2= ek*ek O dog= 2.d0/ssed O if(it.eq.1) then. O es2pl= (er1-sfl)/(sfl-er2)/ek. O es2pu= (er1-sfu)/(sfu-er2)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu# O else if(it.eq.2) then . O es2pl= (sfl-es2)/(sfl-es1)/ek. O es2pu= (sfu-es2)/(sfu-es1)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu O endifd% O if(eql.eq.1.d0) then. O sflt= 0.d0 O else  O ifel= 1m/ O sflt= 2.d0*dog*sqrt(es2pl)*u2 O # s21bbf(eql,erl,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(24)= ifz(24)+1c O go to 2 O endif  O endif% O if(equ.eq.1.d0) thend O sfut= 0.d0 O else  O ifel= 1 ? O if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) thens O equ= 0.d0 O endifd/ O sfut= 2.d0*dog*sqrt(es2pu)* 2 O # s21bbf(equ,eru,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(25)= ifz(25)+1  O go to 2 O endifl O endif* O sft= (sfut-sflt)*sfx+sflt O ifel= 1# O asf= 0.5d0/dog*sft 8 O call s21caf(asf,ek2,elsn,elcn,edn,ifel)! O elsn2= elsn*elsna# O if(ifel.ne.0) then1 O iz= 0 & O ifz(26)= ifz(26)+1 O go to 2e O endif! O if(it.eq.1) then-: O sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)& O else if(it.eq.2) then: O sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) O endif' O sfjc= efac*(sfut-sflt)1 O endif O *  O *-----auxiliary quantities  O *s O sdpf= sd+sf O e3= sp+su+sf1 O e4= 1.d0+spmm-e3d O e3p4= 1.d0+spmm O e1= sm+sdpf O e2= 1.d0+smmp-e1-( O e1p2= 1.d0+smmp $ O e1p3= e1+e3 0 O e1m2= 2.d0*e1-1.d0+spmm  O ep12= xp*e1*e2d O ep1= xp*e1- O ep2= xp*e2  O ep3= xp*e3 O  O ep4= xp*e4  O e1t2= e1*e2 O e1t3= e1*e3 O e1t4= e1*e4 O e2t3= e2*e3 O e2t4= e2*e4 O e3t4= e3*e4/ O if((e1p3*e1p3-4.d0*sf).lt.0.d0) then  O iz= 0! O ifz(27)= ifz(27)+1  O go to 2 O endif( O skl2= sqrt(e1p3*e1p3-4.d0*sf)+ O if((sdmus-4.d0*sd).lt.0.d0) theni O iz= 0! O ifz(28)= ifz(28)+1 O  O go to 2 O endif O skl3= sdmus-4.d0*sd O skl3= sqrt(skl3)m O *f O *-----initialization of t_wu O *,) O *-----limits on tw from positivity and SAo O *A O twlp1= 0.d0 O twlp2= smmp O twlp3= spmm-1.d0() O twlp= dmax1(twlp1,twlp2,twlp3)a O twup= 1.d0 O  O * " O *-----limits on tw from cuts on SA O *) O if(iac(3).ne.0) thenc& O skl2m= 0.5d0*(e1p3-skl2)& O skl2p= 0.5d0*(e1p3+skl2), O skl3p= -0.5d0*(1.d0+sdmu-skl3), O skl3m= -0.5d0*(1.d0+sdmu+skl3), O twlsa1= 1.d0-cs(3)*e3-cs(4)*e4' O twlsa2= ss(1)*e1+ss(2)*e2 8 O twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m4 O twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m4 O twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p8 O twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m, O twusa1= 1.d0-ss(3)*e3-ss(4)*e4' O twusa2= cs(1)*e1+cs(2)*e2t8 O twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m4 O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,u( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,4( O # twusa5,twusa6) O elses O atwl= twlp O atwu= twup O endif O *# O *-----limits on tw from Es O *c O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2)s" O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1))% O atwle2= bxe*e2-bl(2)-* O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2) 1 O twue= dmin1(atwle,atwue1,atwue2)s O endif)$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *  O *-----natural limits on tw O * O # O atwl= dmax1(atwl,bt1(1))f# O atwu= dmin1(atwu,bt2(1))  O *3 O *-----test on tw O *f O if(atwu.le.atwl) then O iz= 0- O ifz(29)= ifz(29)+1 O go to 2e O endif O *  O twjc= atwu-atwl O tw= twjc*twx+atwl O pn= tw+sp-1.d0f O omtw= 1.d0-tw O *  O *-----initialization of t1 O *a% O *-----limits on t1 from positivity+SAu O *f O t1lp1= 0.d0 O t1lp2= pn+sdpf= O t1up1= tw O t1up2= sm+sdpfn# O t1lp= dmax1(t1lp1,t1lp2)e# O t1up= dmin1(t1up1,t1up2)h O * O " O *-----limits on t1 from cuts on SA O *  O if(iac(3).ne.0) then) O t1lc1= ss(1)*e1 O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) 5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)*/ O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3s4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1 O O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))t5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3f4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else  O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E  O *  O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1))" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif($ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O **4 O *-----positivity of (R')^2 / reality of roots for t3 O *s! O rp0= e1p2*e1p2-4.d0*sms O if(rp0.lt.0.d0) thens O iz= 0 O ifz(30)= ifz(30)+1 O go to 2  O endif O srp0= sqrt(rp0) O rp0e= -rp0l, O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1 & O rp2= -(e1*tw-sm)*(e1*tw m) O ifct= 0 O if(rp0e.ne.0.d0) then7 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct) / O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) O & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1))% O else if(rp0e.eq.0.d0) then0 O sret1= -rp2/rp1e# O if(rp1e.gt.0.d0) thenp' O t1l= dmax1(at1l,sret1)_ O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1). O endif  O endif O *  O *-----test on t1 O *+ O if(t1u.le.t1l) then O iz= 0. O ifz(31)= ifz(31)+1 O go to 2s O endif O * ! O *-----transformation for jacobiana O * O if(rp0e.eq.0.d0) then0 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)0 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-taul,9 O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e  O endif" O if(ret1(1).eq.t1l) then O at1tl= -pih/srp0 O elsec0 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) O ifas= 1 - O at1tl= -s09aaf(bt1tl,ifas)/srp0*% O if(ifas.ne.0) print 200a O endif" O if(ret2(1).eq.t1u) then O at1tu= pih/srp0  O else51 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)r O ifas= 1r- O at1tu= -s09aaf(bt1tu,ifas)/srp0 % O if(ifas.ne.0) print 2000 O endif) O if((at1tl+at1tu).eq.0.d0) thenc# O if(t1x.lt.1.d-3) then O  O arc= pi*t1x O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10))))f8 O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc/ O else if((1.d0-t1x).lt.1.d-3) then.# O arc= pi*(1.d0-t1x)5 O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc O else" O carc= cos(pi*t1x)- O t1= 0.5d0*(ret1(1)+ret2(1))+ 1 O # 0.5d0*(ret1(1)-ret2(1))*carc1 O endif  O t1jc= pi/srp0) O elser& O t1tl= dmin1(at1tl,at1tu)& O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tl. O t1t= t1jc*t1x+t1tl. O t1= (rp1+rpds*sin(srp0*t1t))/rp0 O endif O t1s= t1*t1o O *=1 O 200 format(' Unsuccesful call to S09AAF ')  O *  O *-----test on t1 from FS A O * / O if(ieq.eq.1.and.iac(4).ne.0.d0) thend/ O cnlct1= xp*(xm*sm-ep12*cg12)+xdf* 7 O # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1-=+ O # xdf*tw)+xdfs*cg12*t1sf/ O cnlst1= xp*(ep12*sg12-xm*sm)-xdf* 7 O # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+ + O # xdf*tw)-xdfs*sg12*t1sr% O if(cnlct1.lt.0.d0) then  O iz= 0# O ifz(32)= ifz(32)+1. O go to 2* O else if(cnlst1.lt.0.d0) then O iz= 0# O ifz(33)= ifz(33)+1  O go to 2 O endife O endif O *o O *-----some vector components O *  O t2= tw-t1f O *s O *-----equation for xi is solved2 O ** O e1s= e1*e1  O e2s= e2*e2  O e3s= e3*e3  O e12= e1t2-2.d0*sm O e13= e1 O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O 5*x24*x25+x14*x25*x45+A O # x15*x24*x45)-x14s*x25s-x15s*x24s-x45ssB O ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+A O # x14*x15*x34*x35)-x13s*x45s-x14s*x35s- % O # x15s*x34s1B O ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+A O # x24*x25*x34*x35)-x23s*x45s-x24s*x35s-(% O # x25s*x34s5G O * 3 O e(1)= 1.d0 F O e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*E O # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14*wC O # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x352E O e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-pF O # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-D O # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45F O e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*G O # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14* F O # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 G O e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14*sC O # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15*mD O # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+$ O # x25*x34s O *  O *-----sign of eps_1*eps_i  O *u O ises= 0" O sg(1)= 0.25d0+ O if(ee(1).lt.0.d0) then=$ O ises= ises+1 O endif O do i=2,5.2 O if(abs(e(i)).lt.zrm) then( O ises= ises+12 O else if(e(i).gt.zrm) then) O sg(i)= 0.25d0-3 O else if(e(i).lt.-zrm) then * O sg(i)= -0.25d0 O endif/ O if(ee(i).lt.0.d0) thenw( O ises= ises+1 O endif O enddo O *t' O if(ises.eq.0) then / O ses1= sg(1)*sqrt(ee(1))(/ O ses2= sg(2)*sqrt(ee(2))-/ O ses3= sg(3)*sqrt(ee(3))h/ O ses4= sg(4)*sqrt(ee(4))i/ O ses5= sg(5)*sqrt(ee(5))f O s1= ses1 O s2= ses2& O s3= -ses1-ses2 O s4= ses3% O s5= ses1-ses3i% O s6= ses2+ses3 O O s7= ses4% O s8= ses1-ses4p% O s9= ses2+ses4e& O s10= ses3-ses4! O s11= ses5 ' O s12= -ses1-ses5 O ' O s13= -ses2+ses5 ' O s14= -ses3-ses5c' O s15= -ses4-ses5  O else4A O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+)D O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sA O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+ D O # x16*x23*x36)-x13s*x26s-x16s*x23s-x36sA O ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+0D O # x16*x24*x46)-x14s*x26s-x16s*x24s-x46sE O ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+ O D O # x14*x16*x34*x36)-x13s*x46s-x14s*x36s-( O # x16s*x34sE O ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+ O E O # x24*x26*x34*x36)-x23s*x46s-x24s*x36s- ) O # x26s*x34s " O e(1)= 1.d0> O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+B O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-C O # x14*x16*x23s+x14*x23*x36+x16*x23*x34-a2 O # x13s*x24*x26-x34*x36@ O e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*@ O # x24*x46-x14*x16*x23*x24+x14*(-x23*@ O # x46+2.d0*x24*x36-x26*x34)-x16*x24*6 O # x34+x14s*x23*x26+x34*x46@ O e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*? O # x34)+x13*x16*x24*x34+x13*x34*x46+*> O # x14*x16*x23*x34+x14*x34*x36-x16*= O # x34s-x13s*x24*x46-x14s*x23*x36 @ O e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*> O # x24s)+x14*(-x23*x24*x36-x23*x26*A O # x34+x46*x23s)+x16*2.d0*x23*x24*x34- > O # x23*x34*x46-x24*x34*x36+x26*x34s O ises= 0)% O sg(1)= 0.25d0l. O if(ee(1).lt.0.d0) then' O ises= ises+1  O endif O do i=2,55 O if(abs(e(i)).lt.zrm) then O + O ises= ises+1 5 O else if(e(i).gt.zrm) then , O sg(i)= 0.25d06 O else if(e(i).lt.-zrm) then- O sg(i)= -0.25d0*! O endifr2 O if(ee(i).lt.0.d0) then+ O ises= ises+1a! O endif O  O enddoh* O if(ises.eq.0) then2 O ses1= sg(1)*sqrt(ee(1))2 O ses2= sg(2)*sqrt(ee(2))2 O ses3= sg(3)*sqrt(ee(3))2 O ses4= sg(4)*sqrt(ee(4))2 O ses5= sg(5)*sqrt(ee(5))# O s1= ses1-) O s2= -ses1-ses2 # O s3= ses2f) O s4= -ses1-ses3e# O s5= ses3 ) O s6= -ses2-ses3 ( O s7= ses1-ses4# O s8= ses4 ) O s9= -ses2-ses4(* O s10= -ses3+ses4* O s11= -ses1-ses5$ O s12= ses5) O s13= ses2-ses5.) O s14= ses3+ses5t) O s15= ses4+ses5  O elseD O ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+C O # x15*x23*x35)-x13s*x25s-x15s*x23s-l& O # x35sD O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+C O # x16*x23*x36)-x13s*x26s-x16s*x23s-c& O # x36sD O ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+C O # x16*x25*x56)-x15s*x26s-x16s*x25s- & O # x56sD O ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*A O # x56+x15*x16*x35*x36)-x13s*x56s- O 5 O # x15s*x36s-x16s*x35s D O ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*A O # x56+x25*x26*x35*x36)-x23s*x56s-c5 O # x25s*x36s-x26s*x35sfG O * A O e(1)= x13*x14*x23*x25+x13*x15*x23*x24+tE O # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- B O # x14*x15*x23s+x14*x23*x35+x15*x23*9 O # x34-x13s*x24*x25-x34*x35 O A O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+oE O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-aB O # x14*x16*x23s+x14*x23*x36+x16*x23*9 O # x34-x13s*x24*x26-x34*x362B O e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+D O # x13*(-x25*x46+x26*x45)+x14*x15*x23*F O # x26-x14*x16*x23*x25+x14*(x25*x36-x26*F O # x35)+x15*(-x23*x46+x24*x36)+x16*(x23*= O # x45-x24*x35)+x35*x46-x36*x45 O C O e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15*#E O # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ D O # x25*x34)+x13*(x35*x46-x36*x45)-x14*E O # x15*x23*x36+x14*x16*x23*x35+x15*x34*.D O # x36-x16*x34*x35+x13s*(-x25*x46+x26*% O # x45)bG O e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25*.D O # x36-x24*x26*x35)+x15*(-x23*x24*x36-D O # x23*x26*x34+x46*x23s)+x16*(x23*x24*C O # x35+x23*x25*x34-x45*x23s)-x23*x35* E O # x46+x23*x36*x45-x25*x34*x36+x26*x34* O $ O # x35 O * " O ises= 0# O do i=1,5,8 O if(abs(e(i)).lt.zrm) then. O ises= ises+18 O else if(e(i).gt.zrm) then/ O sg(i)= 0.25d0 O 9 O else if(e(i).lt.-zrm) then 0 O sg(i)= -0.25d0$ O endif5 O if(ee(i).lt.0.d0) then . O ises= ises+1$ O endif O enddo- O if(ises.eq.0) thens5 O ses1= sg(1)*sqrt(ee(1))f5 O ses2= sg(2)*sqrt(ee(2)) 5 O ses3= sg(3)*sqrt(ee(3))=5 O ses4= sg(4)*sqrt(ee(4))r5 O ses5= sg(5)*sqrt(ee(5))i, O s1= -ses1-ses2& O s2= ses1& O s3= ses2, O s4= -ses1+ses3, O s5= -ses2-ses3& O s6= ses3, O s7= -ses1+ses4, O s8= -ses2-ses4& O s9= ses4, O s10= ses3-ses4, O s11= ses1+ses5, O s12= ses2-ses5' O s13= ses5 O - O s14= -ses3-ses5 - O s15= -ses4-ses5  O else # O iz= 0-0 O ifz(39)= ifz(39)+1% O go to 4 O endif O endif1 O endif O * & O xaa= 1.d0/x15/x25! O xab= x25/x15t" O xac= 1.d0/xab" O xad= 1.d0/xaa! O xba= x45/x36=! O xbb= x36*x45=! O xbc= x36/x45 & O xbd= 1.d0/x14/x24! O xca= x14/x24 O " O xcb= 1.d0/xca" O xcc= 1.d0/xbd& O xcd= 1.d0/x15/x24! O xda= x15/x24 " O xdb= 1.d0/xda" O xdc= 1.d0/xcd& O xdd= 1.d0/x34/x46! O xef= x34/x46 ! O xeg= x46/x34 " O xeh= 1.d0/xdd& O xfe= 1.d0/x14/x25! O xff= x14/x25m! O xfg= x25/x14 " O xfh= 1.d0/xfe O *o$ O tgn(1)= xaa*xba$ O tgn(2)= xaa*xbb$ O tgn(3)= xaa*xbc% O tgn(4)= xaa/xbb $ O tgn(5)= xab*xba% O tgn(6)= xac/xbb % O tgn(7)= xab/xbb .% O tgn(8)= xad/xbb % O tgn(9)= xab*xbb & O tgn(10)= xab*xbc & O tgn(11)= xac*xba & O tgn(12)= xac*xbc & O tgn(13)= xac*xbb & O tgn(14)= xad*xbb & O tgn(15)= xbd*xba % O tgn(16)= xbd*xbb & O tgn(17)= xbd*xbc ' O tgn(18)= xbd/xbb & O tgn(19)= xcb*xba ' O tgn(20)= xca/xbb ' O tgn(21)= xcb/xbb *& O tgn(22)= xbd/xbb & O tgn(23)= xcb*xbb & O tgn(24)= xcb*xbc & O tgn(25)= xca*xba & O tgn(26)= xca*xbc & O tgn(27)= xca*xbb & O tgn(28)= xbd*xbb & O tgn(29)= xcd*xeg & O tgn(30)= xcd*xeh & O tgn(31)= xcd*xef ' O tgn(32)= xcd*xdd .& O tgn(33)= xdb*xeg ' O tgn(34)= xda*xdd ' O tgn(35)= xdb*xdd l& O tgn(36)= xdc*xdd & O tgn(37)= xdb*xeh & O tgn(38)= xdb*xef & O tgn(39)= xda*xeg & O tgn(40)= xda*xef & O tgn(41)= xda*xeh & O tgn(42)= xdc*xeh & O tgn(43)= xdc*xef & O tgn(44)= xfe*xeg & O tgn(45)= xfe*xeh & O tgn(46)= xfe*xef ' O tgn(47)= xfe*xdd s& O tgn(48)= xfg*xeg ' O tgn(49)= xff*xdd O ' O tgn(50)= xfg*xdd s& O tgn(51)= xfh*xdd & O tgn(52)= xfg*xeh & O tgn(53)= xfg*xef & O tgn(54)= xff*xeg & O tgn(55)= xff*xef % O tgn(56)= xff*xeh & O tgn(57)= xfh*xeh & O tgn(58)= xfh*xef  O *  O itgn= 0 O do l=1,580 O if(tgn(l).le.0.d0) then( O itgn= itgn+1 O endif O enddo' O if(itgn.ne.0) then  O iz= 0 * O ifz(40)= ifz(40)+1 O go to 4  O endif O * O & O gh1= sqrt(tgn(1))& O gh2= sqrt(tgn(2))& O gh3= sqrt(tgn(3))& O gh4= sqrt(tgn(4))& O gh5= sqrt(tgn(5))& O gh6= sqrt(tgn(6))& O gh7= sqrt(tgn(7))& O gh8= sqrt(tgn(8))& O gh9= sqrt(tgn(9))( O gh10= sqrt(tgn(10))( O gh11= sqrt(tgn(11))( O gh12= sqrt(tgn(12))( O gh13= sqrt(tgn(13))( O gh14= sqrt(tgn(14))( O gh15= sqrt(tgn(15))( O gh16= sqrt(tgn(16))( O gh17= sqrt(tgn(17))( O gh18= sqrt(tgn(18))( O gh19= sqrt(tgn(19))( O gh20= sqrt(tgn(20))( O gh21= sqrt(tgn(22))( O gh22= sqrt(tgn(22))( O gh23= sqrt(tgn(23))( O gh24= sqrt(tgn(24))( O gh25= sqrt(tgn(25))( O gh26= sqrt(tgn(26))( O gh27= sqrt(tgn(27))( O gh28= sqrt(tgn(28))( O gh29= sqrt(tgn(29))( O gh30= sqrt(tgn(30))( O gh31= sqrt(tgn(31))( O gh32= sqrt(tgn(32))( O gh33= sqrt(tgn(33))( O gh34= sqrt(tgn(34))( O gh35= sqrt(tgn(35))( O gh36= sqrt(tgn(36))( O gh37= sqrt(tgn(37))( O gh38= sqrt(tgn(38))( O gh39= sqrt(tgn(39))( O gh40= sqrt(tgn(40))( O gh41= sqrt(tgn(41))( O gh42= sqrt(tgn(42))( O gh43= sqrt(tgn(43))( O gh44= sqrt(tgn(44))( O gh45= sqrt(tgn(45))( O gh46= sqrt(tgn(46))( O gh47= sqrt(tgn(47))( O gh48= sqrt(tgn(48))( O gh49= sqrt(tgn(49))( O gh50= sqrt(tgn(50))( O gh51= sqrt(tgn(51))( O gh52= sqrt(tgn(52))( O gh53= sqrt(tgn(53))( O gh54= sqrt(tgn(54))( O gh55= sqrt(tgn(55))( O gh56= sqrt(tgn(56))( O gh57= sqrt(tgn(57))( O gh58= sqrt(tgn(58)) O *e# O *-----Higgs Bremsstrahlung diagram:3G O * * O *-----helicity h1-2) O * = O hb12r= gh1*(-0.5d0*x13*x24*x56+0.5d0*x13*x26*x35+0.5d0* = O # x13*x26*x45-0.5d0*x13*x26*x56+0.5d0*x14*x23*x56- ? O # 0.5d0*x14*x26*x35-0.5d0*x16*x23*x35-0.5d0*x16*x23*x? O # x45+0.5d0*x16*x23*x56+0.5d0*x16*x24*x35+0.5d0*x34*4? O # x56-0.5d0*x35*x46)+gh2*(0.5d0*x35+0.5d0*x45-0.5d0*xA O # x56)+gh4*(-0.5d0*x13*x24*x35*x56+0.5d0*x13*x24*x56s+5@ O 0.5d0*x14*x23*x35*x56-0.5d0*x14*x23*x56s+0.5d0*x14*B O # x26*x35*x56-0.5d0*x14*x26*x35s-0.5d0*x16*x24*x35*x56+A O # 0.5d0*x16*x24*x35s+0.5d0*x34*x35*x56-0.5d0*x34*x56s+ ? O # 0.5d0*x35*x46*x56-0.5d0*x35s*x46)+gh5*(-0.5d0*x13*d@ O # x46+0.5d0*x16*x34)+gh6*(-x23*x34*x56+0.5d0*x23*x35*? O # x46+0.5d0*x23*x46*x56+0.5d0*x26*x34*x35+0.5d0*x26* ? O # x34*x56-x26*x35*x46)+gh7*(0.5d0*x13*x35*x46-0.5d0*s? O # x13*x46*x56-x14*x34*x56+x14*x35*x46-0.5d0*x16*x34* > O # x35+0.5d0*x16*x34*x56)+gh8*(x34*x56-x35*x46)+gh9*A O # (-x13-0.5d0*x14)+gh10*(0.5d0*x14*x35+0.5d0*x14*x56)+ O = O # gh11*(0.5d0*x23*x46-0.5d0*x26*x34)+gh12*(-0.5d0*i> O # x24*x35-0.5d0*x24*x56)+gh13*(-0.5d0*x24+x26)+gh14+ O hb12i= s1*gh1*(2.d0*x56)+s2*gh2*(-4)+ 9 O # s3*gh1*(2.d0*x35-2.d0*x56)+s4*gh3*(2.d0*x35+ < O # 2.d0*x56)+s6*gh1*(2.d0*x34)+s7*gh1*(-2.d0*x26)+? O # s7*gh4*(-2.d0*x26*x35+2.d0*x26*x56)+s8*gh5*(2.d0)+g? O # s10*gh4*(2.d0*x23*x35-2.d0*x23*x56)+s12*gh6*(2.d0*i> O # x35-2.d0*x56)+s13*gh1*(-2.d0*x14)+s13*gh4*(-2.d0*> O # x14*x35+2.d0*x14*x56)+s14*gh1*(2.d0*x13)+s15*gh6*> O # (-4.d0*x23+4.d0*x26)+s15*gh7*(-4.d0*x14)+s15*gh8* O # (4.d0)  O hb1r= vel*hb12r  O hb1i= vel*hb12i  O hb2r= ver*hb12r  O hb2i= -ver*hb12iG O * s O *-----helicity h3-4) O * > O hb34r= gh15*(-0.5d0*x13*x25*x46-0.5d0*x13*x26*x34+0.5d0*= O # x13*x26*x45+0.5d0*x13*x26*x46+0.5d0*x15*x23*x46-e? O # 0.5d0*x15*x26*x34+0.5d0*x16*x23*x34-0.5d0*x16*x23* ? O # x45-0.5d0*x16*x23*x46+0.5d0*x16*x25*x34+0.5d0*x34* A O # x56-0.5d0*x35*x46)+gh16*(-0.5d0*x34+0.5d0*x45+0.5d0* A O # x46)+gh18*(0.5d0*x13*x25*x34*x46-0.5d0*x13*x25*x46s- @ O # 0.5d0*x15*x23*x34*x46+0.5d0*x15*x23*x46s-0.5d0*x15*B O # x26*x34*x46+0.5d0*x15*x26*x34s+0.5d0*x16*x25*x34*x46-@ O # 0.5d0*x16*x25*x34s+0.5d0*x34*x35*x46+0.5d0*x34*x46*= O # x56-0.5d0*x34s*x56-0.5d0*x35*x46s)+gh19*(-0.5d0*4< O # x13*x56+0.5d0*x16*x35)+gh20*(0.5d0*x23*x34*x56-= O # 0.5d0*x23*x46*x56-x25*x34*x56+x25*x35*x46-0.5d0*1< O # x26*x34*x35+0.5d0*x26*x35*x46)+gh21*(0.5d0*x13*= O # x34*x56-x13*x35*x46+0.5d0*x13*x46*x56+0.5d0*x16*4> O # x34*x35-x16*x34*x56+0.5d0*x16*x35*x46)+gh22*(x34*< O # x56-x35*x46)+gh23*(x13-0.5d0*x15)+gh24*(-0.5d0*> O # x15*x34-0.5d0*x15*x46)+gh25*(0.5d0*x23*x56-0.5d0*> O # x26*x35)+gh26*(0.5d0*x25*x34+0.5d0*x25*x46)+gh27*" O # (-0.5d0*x25-x26)+gh28= O hb34i= s1*gh15*(-2.d0*x56)+s3*gh15*(2.d0*x34+2.d0*x46)+39 O # s4*gh17*(-2.d0*x34)+s5*gh18*(-2.d0*x35*x46)+ O 8 O # s6*gh15*(-2.d0*x34)+s6*gh18*(2.d0*x34*x46)+8 O # s7*gh15*(2.d0*x26)+s7*gh18*(-2.d0*x26*x46)+8 O # s8*gh15*(-2.d0*x25+4.d0*x26)+s8*gh18*(2.d0*: O # x25*x34)+s9*gh21*(-2.d0*x34)+s11*gh18*(-2.d0*< O # x16*x34-2.d0*x16*x46)+s13*gh25*(2.d0)+s14*gh15*> O # (-2.d0*x13)+s14*gh18*(2.d0*x13*x34+4.d0*x16*x34)+: O # s15*gh18*(-2.d0*x46)+s15*gh20*(4.d0*x25)+s15*. O # gh21*(-4.d0*x13)+s15*gh22*(-4.d0) O hb3r= vel*hb34r2 O hb3i= vel*hb34i  O hb4r= ver*hb34r( O hb4i= -ver*hb34iG O * * O *-----helicity h5-6) O * 8 O hb56r= gh30*(0.5d0*x13*x25-x16*x25-0.5d0*x35+x56)+8 O # gh31*(-0.5d0*x13*x26*x45+0.5d0*x14*x23*x56-= O # 0.5d0*x14*x25*x36+0.5d0*x14*x26*x35-x14*x26*x56-2= O # 0.5d0*x16*x23*x45+0.5d0*x16*x25*x34+x16*x26*x45- : O # 0.5d0*x34*x56+0.5d0*x36*x45)+gh38*(0.5d0*x13*= O # x56+x14*x56-0.5d0*x16*x35-x16*x45)+gh40*(-0.5d0* = O # x26*x34+x26*x45)+gh41*(0.5d0*x23-x25)+gh42+gh43*e O # (0.5d0*x36-x56)6 O hb56i= s2*gh30*(2.d0)+s5*gh31*(-2.d0*x35+4*x56)+3 O # s7*gh31*(2.d0*x26)+s9*gh38*(2.d0)+s10* 3 O # gh38*(4.d0)+s12*gh40*(-2.d0)+s14*gh31* 1 O # (2.d0*x13-4.d0*x16)+s14*gh40*(-4.d0)  O hb5r= vel*hb56r  O hb5i= vel*hb56i. O hb6r= ver*hb56r  O hb6i= -ver*hb56iG O * d O *-----helicity h7-8) O * 8 O hb78r= gh45*(0.5d0*x15*x23-x15*x26-0.5d0*x35+x56)+7 O # gh46*(0.5d0*x13*x24*x56-0.5d0*x13*x26*x45-r; O # 0.5d0*x15*x24*x36+0.5d0*x15*x26*x34-0.5d0*x16* O ? O # x23*x45+0.5d0*x16*x24*x35-x16*x24*x56+x16*x26*x45- ? O # 0.5d0*x34*x56+0.5d0*x36*x45)+gh52*(0.5d0*x13-x15)+s; O # gh53*(-0.5d0*x16*x34+x16*x45)+gh55*(0.5d0*x23* : O # x56+x24*x56-0.5d0*x26*x35-x26*x45)+gh57+gh58* O # (0.5d0*x36-x56)7 O hb78i= s1*gh46*(2.d0*x56)+s2*gh45*(2.d0)+s3*gh46*2< O # (-2.d0*x45)+s5*gh46*(4.d0*x56)+s10*gh46*(-2.d0*; O # x23+4.d0*x26)+s10*gh53*(4.d0)+s14*gh46*(-2.d0*22 O # x13)+s14*gh55*(-4.d0)+s15*gh46*(2.d0) O hb7r= vel*hb78r  O hb7i= vel*hb78i  O hb8r= ver*hb78rs O hb8i= -vel*hb78i O *  O *-----complete diagrams: O * 6 O alpha1= 1.d0/256.d0/cth4*tbeta*salpha/cbeta*cbma6 O alpha2= 1.d0/256.d0/cth4*tbeta*calpha/cbeta*sbma O alpha21= alpha2/alpha13 O hcf= rbqm2*s/wm2*tm2/wm2/vv*alpha1*alpha1/dsz 5 O propp= (sp-rbhm2/vv)*(sp-rbhm2/vv)+(sp*sbhg)**2l= O addpr= 1.d0+alpha21/propp*((sp-rshm2/vv)*(sp-rbhm2/vv)+  O # sp*sp*sbhg*sshg)2@ O addpi= alpha21/propp*sp*((sp-rshm2/vv)*sbhg-(sp-rbhm2/vv)* O # sshg) O chb1r= addpr*hb1r  O chb1re= -addpi*hb1i  O chb1ie= addpr*hb1i O chb1i= addpi*hb1r5 O chb2r= addpr*hb2r  O chb2re= -addpi*hb2i5 O chb2ie= addpr*hb2i O chb2i= addpi*hb2r  O chb3r= addpr*hb3r  O chb3re= -addpi*hb3i1 O chb3ie= addpr*hb3i O chb3i= addpi*hb3r  O chb4r= addpr*hb4r) O chb4re= -addpi*hb4i  O chb4ie= addpr*hb4i O chb4i= addpi*hb4r  O chb5r= addpr*hb5r. O chb5re= -addpi*hb5i* O chb5ie= addpr*hb5i O chb5i= addpi*hb5r* O chb6r= addpr*hb6r  O chb6re= -addpi*hb6i  O chb6ie= addpr*hb6i O chb6i= addpi*hb6r  O chb7r= addpr*hb7r  O chb7re= -addpi*hb7i  O chb7ie= addpr*hb7i O chb7i= addpi*hb7r3 O chb8r= addpr*hb8r  O chb8re= -addpi*hb8i2 O chb8ie= addpr*hb8i O chb8i= addpi*hb8r  O * O *-----Total3 O *1< O dthr= chb1r*chb1r+chb2r*chb2r+chb3r*chb3r+chb4r*chb4r+; O # chb5r*chb5r+chb6r*chb6r+chb7r*chb7r+chb8r*chb8r3E O dthre= chb1re*chb1re+chb2re*chb2re+chb3re*chb3re+chb4re*chb4re+*C O # chb5re*chb5re+chb6re*chb6re+chb7re*chb7re+chb8re*chb8re+E O dthie= chb1ie*chb1ie+chb2ie*chb2ie+chb3ie*chb3ie+chb4ie*chb4ie+-C O # chb5ie*chb5ie+chb6ie*chb6ie+chb7ie*chb7ie+chb8ie*chb8ie2< O dthi= chb1i*chb1i+chb2i*chb2i+chb3i*chb3i+chb4i*chb4i+; O # chb5i*chb5i+chb6i*chb6i+chb7i*chb7i+chb8i*chb8ix& O dth= hcf*(dthr+dthre+dthie+dthi) O * % O 4 if(iz.eq.0) then3) O dpxs(ix,it)= 0.d0  O iz= 1 O  O else : O tjac= ujc*vjc*smjc*spjc*sujc*sdjc*/ O # sfjc*twjc*t1jc*vvx3 O dpxs(ix,it)= tjac*stf*dth/sx O endif O *  O *-----end of ix loop O *  O enddo O * 0 O cpxs(it)= dpxs(1,it)+dpxs(2,it) O *2 O 2 if(iz.eq.0) then O bpxs(it)= 0.d0 O iz= 16 O else.$ O bpxs(it)= cpxs(it) O endif O *2 O *-----end on it loop O *  O enddo3 O *6 O 1 if(iz.eq.0) then O apxs= 0.d0  O iz= 1 O else" O apxs= bpxs(1)+bpxs(2) O endif6 O *5 O if(apxs.lt.0.d0) then# O ifz(41)= ifz(41)+15 O resf= 0.d0 O else O resf= apxs O endifd O *= O if(oqcd.eq.'y') then O nf= 5) O alssh= wtoralphas(wm,shm,als,nf) ' O alsa= wtoralphas(wm,am,als,nf) . O fqcd= 1.d0+17.d0/3.d0*(alssh+alsa)/pi O else O fqcd= 1.d00 O endif  O * % O wtoxsh26= tfact*resf*bfact*fqcdr O *t O if(om.eq.'g') then O if(osm.eq.'n') then O jp= iwtopos(ndim,x)d* O if(wtoxsh26.gt.xshmx(jp)) then" O xshmx(jp)= wtoxsh26 O do l=1,91# O xmxh(jp,l)= x(l)f O enddo O endif  O endif O xaph(1)= xm O xaph(2)= xp O xaph(3)= sm O xaph(4)= sp O xaph(5)= su O xaph(6)= sd O xaph(7)= sf O xaph(8)= tw O xaph(9)= t1 O xaph(10)= t3 O endif* O *t O return O end  O * I O *-----WTOXSH19------------------------------------------------------------ O *2& O real*8 function wtoxsh19(n m,x) O implicit real*8 (a-h,o-z)3' O character*1 oud,om,osm,oqcd,omssm  O *s! O parameter(ninv=10,npos=512)  O *5 O common/wtmod/om  O common/wtmp/zrm  O common/wtud/oud  O common/wtqcd/als O common/wthiggs/hm  O common/wtsmod/osm  O common/wtdis/dist  O common/wtkount/ik  O common/wtaqcd/oqcd O common/wtbme/bfact O common/wtistrf/isf O common/wtsf/ix0,it0  O common/wtchi/hch(36) O common/wtipt/ifz(44) O common/wtmssmo/omssm O common/wticuts/iac(4)  O common/wtisa/isaa,isab O common/wthx/xshmx(npos)  O common/wtparh/xaph(ninv)F O common/wttc/itc,itcc,itcn O common/wtpmxh/xmxh(npos,9)/ O common/wtmssmi/am,tbeta,rmu,scalm,bat,bab 2 O common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr3 O common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn 6 O common/wthapar/rhm,rhm2,rhg,rhmg,shg,shgs,opshgs? O common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi4> O common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmyD O common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw,) O # eta,feta,beta,g2,tfacthxF O common/wtapar/ars,s,rwm,rwm2,rwg,rwmg,swg,swgs,opswgs,sth2,cth2,E O # hsth2,tsth2,scth2,asth2,tth2,rzm,rzm2,rzg,rzmg,szg, C O # szgs,opszgs,sth4,cth4,ve,vf,vfp,rbqm2,rszw,rszw2,  O # s0w,s0z H O common/wtsubreg/dsm,usm,dsp,usp,rl(6),rr(6),srl(6),sdsm,sdsp,vvl1,* O # vvl2,vvl3,ul,omul,sumlF O common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6),A O # ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4), ? O # sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24,x= O # cg24,sg34,cg34,sct120,sct130,sct140,sct230, / O # sct240,sct340,sgam(4),cgam(4)=D O common/wtmssm/ams,shm,shms,bhm,bhms,sbeta,cbeta,salpha,calpha,? O # sbma,cbma,rshm,rshm2,rshg,rshmg,sshg,sshgs, E O # opsshgs,rbhm,rbhm2,rbhg,rbhmg,sbhg,sbhgs,opsbhgs, 5 O # ram,ram2,rag,ramg,sag,sags,opsags  O *  O dimension tgn(31)  O dimension x(ndim)  O dimension bt1(2),bt2(2)t O dimension rru1(2),rru2(2)  O dimension sfur(2),sflr(2)  O dimension ret1(2),ret2(2) O dimension ee(5),e(5),sg(5)% O dimension rrr(6),rrl(6),srrl(6) ( O dimension bl(4),xbl(4),ss(4),cs(4)) O dimension dpxs(2,2),cpxs(2),bpxs(2) O 9 O dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2)  O *t4 O data ec2/-0.4999999963d0/,ec4/0.0416666418d0/,4 O # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, O # ec10/-0.0000002605d0/ O * # O external c02ajf,s09aaf,s07aaf  O external s21bbf,s21caf O * O " O *-----the order of integration is:5 O * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1  O * 6 O * m_{+/-}^2 transformed for the resonating peaks6 O * M_0^2,m_0^2 transformed for the resonating peaks4 O * m^2 and t_1 transformed for the jacobian peaks O *) O do ix=1,2  O do it=1,2! O dpxs(ix,it)= 0.d0  O enddo O enddo  O do it=1,2e O cpxs(it)= 0.d0n O bpxs(it)= 0.d0 O enddo3 O *  O if(ndim.eq.6) then O spx= x(1) O sux= x(2) O sdx= x(3) O sfx= x(4) O twx= x(5) O t1x= x(6) O else if(ndim.eq.8) then  O uvx= x(1) O vvx= x(2) O spx= x(3) O sux= x(4) O sdx= x(5) O sfx= x(6) O twx= x(7) O t1x= x(8) O else if(ndim.eq.7) then  O smx= x(1) O spx= x(2) O sux= x(3) O sdx= x(4) O sfx= x(5) O twx= x(6) O t1x= x(7) O else if(ndim.eq.9) then  O uvx= x(1) O vvx= x(2) O smx= x(3) O spx= x(4) O sux= x(5) O sdx= x(6) O sfx= x(7) O twx= x(8) O t1x= x(9) O endif O  O *  O ik= ik+1 rs= arse O one= 1.d0  O if(oud.eq.'l') then  O fkill= 1.d0 O else if(oud.eq.'n') then O fkill= 0.d0 O endif  O * ( O *-----if a point is not allowed then the O * result is set to zero  O *e O iz= 1  O * % O if(ndim.eq.6.or.ndim.eq.7) then  O ueps= 0.d0 O  O uv= 1.d0  O uvs= uv*uv1 O ujc= 1.d0 O veps= 0.d0  O vv= 1.d0f O vjc= 1.d0* O else if(ndim.eq.8.or.ndim.eq.9) then O *g, O *-----independent invariants are initialized O * first u and v variable O *g O if(uvx.gt.1.d0) then  O iz= 0n O ifz(1)= ifz(1)+1 O go to 1  O endif% O ueps= omul*(1.d0-uvx)**hbetig O uv= 1.d0-ueps O ujc= omul**hbet O uvs= uv*uv  O *  O *-----limits for v O * O  O *-----from equal cuts on SAr O *g+ O if(iac(3).eq.1.and.isab.eq.1) then2' O vvl4= ombsa(1)/opbsa(1)*uvs3+ O vvl= dmax1(vvl1,vvl2,vvl3,vvl4) O else & O vvl= dmax1(vvl1,vvl2,vvl3) O endif O *g O *-----from E O *  O vve= uv*(2.d0*suml-uv)  O vvll= dmax1(vvl,vve)g O *8 O vvu1= uv + O if(iac(3).eq.1.and.isaa.eq.1) then ' O vvu2= omasa(1)/opasa(1)*uvs ! O vvu= dmin1(vvu1,vvu2) elser O vvu= uv  O endif O uvl= uv-vvll  O *  O vkf= (uv-vvu)/uvl O if(vkf.lt.0.d0) thenr O iz= 0  O ifz(1)= ifz(1)+1 O go to 1 " O else if(vkf.eq.0.d0) then O if(vvx.gt.1.d0) then O iz= 0 O ifz(1)= ifz(1)+1  O go to 1% O else if(vvx.eq.1.d0) then) O veps= 0.d0= O else) O veps= uvl*(1.d0-vvx)**hbeti  O endif3 O avkf= 1.d0 elseg8 O veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti O avkf= 1.d0-vkf**hbet O endif O vv= uv-veps O vjc0= 1.d0-vvll/uv  O if(vjc0.le.0.d0) then O iz= 04 O ifz(1)= ifz(1)+1 O go to 1g else O vjc= vjc0**hbet*avkf O endif O endifr O *g O if(vv.lt.0.d0) then  O iz= 0 O ifz(1)= ifz(1)+1g O go to 1 O endif  O svv= sqrt(vv)g O vzmg= rzmg*vv  O vhmg= rhmg*vv( O vshmg= rshmg*vv  O vvs= vv*vv O xm= uv O xp= vv/uv s O xmop= xm/xp % O if(ndim.eq.7.or.ndim.eq.6) then  O xdf= 0.d0 O else( O xdf= (ueps*(1.d0-ueps)-veps)/uv O endif  O xdfs= xdf*xdfr O sh= vv*s O *  O *-----Z parameters O *( O rszm2= zm*zm/sh  O * 1 O *-----Z propagator (real part and imaginary part)s O *( O dsz0= 1.d0-rszm2 O dsz= dsz0*dsz0+rszw2 O rsz= dsz0/dszg O aisz= -rszw/dsz O  O *-C O *-----Reduced structure functions are computed with arguments xp,xm  O *  O opxp= 1.d0+xp  O opxm= 1.d0+xmi O omxp= veps/uv  O omxm= ueps O if(isf.eq.0) then6 O stfp= 1.d0  O stfm= 1.d00 O else if(isf.gt.0) then O if(omxp.eq.0) then6 O stfp= d0gl else O " O rcpx= 0.25d0*opxp*opxp O rcpy= xp O iflp= 1x( O rclp= s21baf(rcpx,rcpy,iflp)3 O stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+5- O # feta*(-4.d0*opxp*log(omxp)+x7 O # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp))6 O endif O if(omxm.eq.0) then* O stfm= d0gl else." O rcmx= 0.25d0*opxm*opxm O rcmy= xm O iflm= 1)( O rclm= s21baf(rcmx,rcmy,iflm)3 O stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ - O # feta*(-4.d0*opxm*log(omxm)+07 O # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm))x O endif O endifx O *x O stf= stfp*stfm O *5I O *-----if there is no upper cut on some FS IM, then the maximum is allowedx O *+ O do j=1,6 O if(rr(j).eq.1.d0) then O rrr(j)= rr(j) O else O rrr(j)= rr(j)/vv2 O endif# O rrl(j)= rl(j)/vv O srrl(j)= srl(j)/svv O enddo* O **& O *-----cuts become special near xp = xm O *h! O if(abs(xdf).gt.1.d-15) thenx O ieq= 1 ( O bxe= vv/(ueps*(1.d0-ueps)-veps) O if(xdf.gt.0.d0) then. O enc= 1.d0)" O else if(xdf.lt.0.d0) then O enc= xmop2 O endif O else O ieq= 0* O bxe= 1.d0 O endif(% O if(ieq.eq.0.and.xm.le.teq) then5 O iz= 0 O ifz(1)= ifz(1)+1  O go to 1 O endif- O *07 O if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then2 O sct12= sct120/vv O  O sct13= sct130/vv  O sct14= sct140/vv  O sct23= sct230/vv  O sct24= sct240/vv  O sct34= sct340/vv- O else O sct12= 0.d0 O sct13= 0.d0 O sct14= 0.d0 O sct23= 0.d0 O sct24= 0.d0 O sct34= 0.d0 O endif5 O * 0 O *-----cuts on E0 O *6 O do j=1,4 O if(ieq.eq.1) then5# O bl(j)= 2.d0*rae(j)/xdf # O xbl(j)= 2.d0*rae(j)/xp4 O else if(ieq.eq.0) then" O bl(j)= 2.d0*rae(j)/xm O endif O O enddo0 O *0 O *-----cuts on SA O *0 O if(iac(3).ne.0) then O do j=1,4x% O if(sgam(j).eq.1.d0) then* O ss(j)= 0.d0x O else37 O ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmopd! O ss(j)= 1.d0/ss(j)  O endif% O if(cgam(j).eq.0.d0) then# O cs(j)= 1.d0x O else07 O cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop(! O cs(j)= 1.d0/cs(j)3 O endif O enddo O endif  O *x" O *-----initialization of sm = m_-^2 O *h O zma1= dsm  O zma2= vv*sct12 O zmb1= usmg! O zmb2= (svv-sdsp)*(svv-sdsp)04 O zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) O if(ieq.eq.0) then*$ O zma3= vv*(bl(1)+bl(2)-1.d0)- O zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))*2) O # (1.d0-0.5d0*(bl(3)+bl(4)))  O zmb5= vv*(1.d0-bl(3)) O zmb6= vv*(1.d0-bl(4)) O else if(ieq.eq.1) then& O zma3= vv*(-enc+xbl(1)+xbl(2))2 O zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))*' O # (1.d0+enc-xbl(3)-xbl(4))* O zmb5= vv*(enc-xbl(3)) O zmb6= vv*(enc-xbl(4)) O endif6! O xzma= dmax1(zma1,zma2,zma3)s0 O xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) O **C O *-----limits on sm from cuts on SA. Here for maximum security. Rarex O *+ O if(iac(3).eq.0) then O zma= xzma O zmb= xzmb O else 4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) then  O szma= xzma  O szmb= xzmb-( O else if(ss(3).gt.ss(1)) then O szmb= xzmb5 O adsp= dsp/vv.( O axszma= dmax1(adsp,sct34)5 O axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/2% O # (ss(3)-ss(1)))x' O szma= dmax1(axszma,xzma)5( O else if(ss(3).lt.ss(1)) then& O if(ss(3).lt.0.5d0) then O szma= xzma= O axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2 * O szmb= dmin1(axszmb,xzmb) O else. O iz= 0 " O ifz(2)= ifz(2)+1 O go to 14 O endif O endif else4 O szma= xzma O szmb= xzmb O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) then  O zma= szma O zmb= szmb( O else if(cs(3).gt.cs(1)) then& O if(cs(3).gt.0.5d0) then O zma= szma0= O axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**26) O zmb= dmin1(axczmb,szmb)0 O elsex O iz= 0 " O ifz(3)= ifz(3)+1 O go to 1# O endif( O else if(cs(3).lt.cs(1)) then O zmb= szmb5 O adsp= dsp/vv+ O axczma= dmax1(adsp,sct34)08 O axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/( O # (cs(3)-cs(1)))) O zma= dmax1(axczma,szma)4 O endif elseh O zma= szmad O zmb= szmb8 O endif O endif  O *  O *-----test on sm O *  O if(zmb.le.zma) then- O iz= 0 O ifz(4)= ifz(4)+10 O go to 1 O endif* O *a O if(itc.eq.4) thend O bdistl= dist*dist/s-zma O bdistu= zmb-dist*dist/s2 O if(bdistl.le.0.d0.or.bdistu.le.0.d0) then O iz= 0v O ifz(4)= ifz(4)+1 O go to 1l O endif O endifp O *h O if(omssm.eq.'n') thens O xrhm2= rhm2 O xshg= shg O xshgs= shgs O xrhmg= rhmg O xvhmg= vhmg O xopshgs= opshgs O else if(omssm.eq.'y') then O xrhm2= rshm2a O xshg= sshg2 O xshgs= sshgsh O xrhmg= rshmg  O xvhmg= vshmg  O xopshgs= opsshgs O endifr O *3 O if(itc.eq.4) thenh O sm= (dist/rs/svv)**2 O - O smjc= 2.d0*dist/s/((vv*sm-xrhm2)**2+4 O # (vv*sm*xshg)**2) O else O *p O zmas= zma-xrhm2 O zmbs= zmb-xrhm2% O atma= (zmas+xshgs*zma)/xrhmg % O atmb= (zmbs+xshgs*zmb)/xrhmgi/ O if(atma.gt.1.d0.and.atmb.gt.1.d0) thena O atma= 1.d0/atmap O atma= atan(atma)" O zmat= (pih-atma)/xvhmg O atmb= 1.d0/atmbh O atmb= atan(atmb)" O zmbt= (pih-atmb)/xvhmg% O smjc0= (-atmb+atma)/xvhmgh5 O else if(atma.gt.1.d0.and.atmb.lt.-1.d0) theno O atma= 1.d0/atmah O atma= atan(atma)" O zmat= (pih-atma)/xvhmg O atmb= -1.d0/atmb O atmb= atan(atmb)# O zmbt= (-pih+atmb)/xvhmgr( O smjc0= (-pi+atmb+atma)/xvhmg9 O else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then* O atma= 1.d0/atmah O atma= atan(atma)" O zmat= (pih-atm O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O suu1= enc-sp-xbl(1) O suu2= enc-sm-xbl(4)+ O suu3= (enc-0.5d0*(xbl(1)+xbl(4)))*** O # (enc-0.5d0*(xbl(1)+xbl(4))) O endif. O sul= dmax1(sul,sul1)2 O suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) O *  O *-----test on su O *r O if(suu.le.sul) then  O iz= 0 O ifz(8)= ifz(8)+1v O go to 1 O endif  O * O  O sujc= suu-sul  O su= sujc*sux+sul O if(su.lt.0.d0) thent O iz= 0 O ifz(8)= ifz(8)+1  O go to 1 O endif/ O ssu= sqrt(su)  O *d" O *-----initialization of sd = m_0^2 O *-% O *-----limits on sd from cuts on FS IM  O *  O sdlim= rrl(3)( O sduim1= rrr(3)# O sduim2= (1.d0-ssu)*(1.d0-ssu) O ! O sduim= dmin1(sduim1,sduim2)s O *d# O *-----limits on sd from Delta_- > 0 O  O *- O if(ssu.gt.rasup) then & O sdld= (ssu-rasup)*(ssu-rasup) O else O sdld= sdlim O endif $ O sdud1= (ssu+rasup)*(ssu+rasup)& O sdud2= (-ssu+rasum)*(-ssu+rasum) O sdud= dmin1(sdud1,sdud2) O *lC O *-----limits on sd from cuts on SA. Here for maximum security. Rare  O *lA O if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then c O if(ss(2).eq.ss(1)) then# O asdu= dmin1(sduim,sdud) O # O asdl= dmax1(sdlim,sdld)*% O else if(ss(1).gt.ss(2)) then(6 O sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))) O asdu= dmin1(sduim,sdud,sdusa) # O asdl= dmax1(sdlim,sdld) % O else if(ss(1).lt.ss(2)) then # O asdu= dmin1(sduim,sdud) 6 O sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))) O asdl= dmax1(sdlim,sdld,sdlsa)b O endif O else O asdu= dmin1(sduim,sdud) O asdl= dmax1(sdlim,sdld) O endifmA O if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then = O if(cs(2).eq.cs(1)) then O sdl= asdl  O sdu= asdu % O else if(cs(1).gt.cs(2)) then  O sdu= asdu O 6 O sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))" O sdl= dmax1(asdl,sdlsb)% O else if(cs(1).lt.cs(2)) then  O sdl= asdl 6 O sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))" O sdu= dmin1(asdu,sdusb) O endif O else O sdl= asdl O sdu= asdu O endift O *d O if(ieq.eq.0) then=$ O sdenl= -1.d0+bl(1)+bl(4)+su O sdenu1= 1.d0-sp-bl(2) O sdenu2= 1.d0-sm-bl(3)$ O sdenu3= 1.d0-bl(2)-bl(3)+su O else if(ieq.eq.1) then. O sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) O sdenu1= enc-sp-xbl(2) O sdenu2= enc-sm-xbl(3)/ O sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3) O endif1 O sdl= dmax1(sdl,sdenl)0* O sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) O sdl= dmax1(sdl,sct14)t O *  O *-----test on sd O *s O if(sdu.le.sdl) thene O iz= 0 O ifz(9)= ifz(9)+10 O go to 1 O endif  O *t O sdjc= sdu-sdlt O sd= sdjc*sdx+sdl O if(sd.lt.0.d0) then  O iz= 0 O ifz(9)= ifz(9)+14 O go to 1 O endif O  O ssd= sqrt(sd). O sdmu= sd-su $ O sdmus= (1.d0+sdmu)*(1.d0+sdmu) O * O *-----initialization of sf = m^2 O * % O *-----limits on sf from cuts on FS IM O  O *  O sflim1= rrl(2) O sfuim1= rrr(2) O bsg= sm+sp+su+sd O ombsg= 1.d0-bsg  O sflim2= ombsg-rrr(5) O sfuim2= ombsg-rrl(5)! O sflim= dmax1(sflim1,sflim2) ! O sfuim= dmin1(sfuim1,sfuim2)g O *j" O *-----limits on sf from cuts on SA O *s$ O tcuts= ss(1)-ss(2)+ss(3)-ss(4)$ O tcutc= cs(1)-cs(2)+cs(3)-cs(4)> O if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then1 O if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) thens6 O sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- O + O # (cs(1)-cs(4))*sm)/tcutc 6 O sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-i+ O # (ss(1)-ss(4))*sm)/tcuts )$ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa)6 O else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then6 O sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-z+ O # (ss(1)-ss(4))*sm)/tcuts 6 O sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-i+ O # (cs(1)-cs(4))*sm)/tcutc * O asfu= dmin1(sfuim,sfusa,sfusb)# O asfl= sflim A6 O else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-)+ O # (ss(1)-ss(4))*sm)/tcuts O 6 O sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc * O asfl= dmax1(sflim,sflsa,sflsb)# O asfu= sfuim s6 O else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-5+ O # (ss(1)-ss(4))*sm)/tcuts 6 O sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc $ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa) O endif O else O asfl= sflim O asfu= sfuim O endif O  O *  O if(ieq.eq.0) thens O asfenl1= bl(1)-sm-sd) O asfenl2= bl(3)-sp-su." O asfenu1= 1.d0-bl(2)-sp-sd" O asfenu2= 1.d0-bl(4)-sm-su O else if(ieq.eq.1) then' O asfenl1= 1.d0-enc-sm-sd+xbl(1)h' O asfenl2= 1.d0-enc-sp-su+xbl(3) " O asfenu1= enc-sp-sd-xbl(2)" O asfenu2= enc-sm-su-xbl(4) O endifa' O asfl= dmax1(asfl,asfenl1,asfenl2) ' O asfu= dmin1(asfu,asfenu1,asfenu2)(# O aasfu= 1.d0-sm-sp-su-sd-sct24  O asfl= dmax1(asfl,sct13)  O asfu= dmin1(asfu,aasfu)h O * O  O if(iac(3).ne.0) then O if(ss(4).ne.ss(3)) then O if(ss(4).gt.ss(3)) then(5 O asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+07 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) O # O asfl= dmax1(asfl,asfltw)z% O else if (ss(4).lt.ss(3)) thenh5 O asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ 7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3))f# O asfu= dmin1(asfu,asfutw) endifi O endif O if(cs(1).ne.cs(2)) then O if(cs(1).gt.cs(2)) then 9 O bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ O . O # cs(2)-bt1(1))/(cs(1)-cs(2))# O asfl= dmax1(asfl,bsfltw)f$ O else if(cs(1).lt.cs(2)) then9 O bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+e/ O # cs(2)-bt1(1))/(cs(1)-cs(2)) # O asfu= dmin1(asfu,bsfutw)g endifg O endif O if(cs(4).ne.cs(3)) then O if(cs(4).gt.cs(3)) thenh; O csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- 0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfu= dmin1(asfu,csfutw)3$ O else if(cs(4).lt.cs(3)) then; O csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm-20 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfl= dmax1(asfl,csfltw) endifx O endif O if(ss(1).ne.ss(2)) then O if(ss(1).gt.ss(2)) thenr6 O dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfu= dmin1(asfu,dsfutw))$ O else if(ss(1).lt.ss(2)) then6 O dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfl= dmax1(asfl,dsfltw)b endifo O endif O endifm O * O  O *-----positivity of R^2m O * O  O scp= ssmpp*ssmpp  O scm= ssmmp*ssmmp $ O snp= (ssu+ssd)*(ssu+ssd) $ O snm= (ssu-ssd)*(ssu-ssd)  O rlp= ssu*ssd+ssp*ssm O rlm= ssu*ssd-ssp*ssm O bsgmo= bsg-1.d0t O ombsg2= ombsg*ombsg  O rlps= rlp*rlp O  O rlms= rlm*rlmn O edelp= ombsg2-4.d0*rlpsa O edelm= ombsg2-4.d0*rlmst" O edeld= 16.d0*ssu*ssd*ssp*ssm O * O 7 O *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2  O * then Delta_+ > 0 O *t *-----control  O *  O cnt1= scp+snma O cnt2= scm+snpt+ O if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then  O iz= 0 O ifz(10)= ifz(10)+1t O go to 1 O endift O if(edelm.le.0.d0) then O etest= edeld+edelp* O if(etest.gt.0.d0) thena O edelm= etest else  O iz= 0  O ifz(11)= ifz(11)+1 O go to 1v O endif O endif/ O sedm= sqrt(edelm)t ifcr= 0 . O call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) O if(rr1(2).ne.0.d0) thene O iz= 0 O ifz(12)= ifz(12)+1h O go to 1 O endifa ifcr= 0t. O call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) O *- O cnt3= scp+snpt O cnt4= scm+snm  O cbru= -1.d0  O ccru= 0.5d0*bsgt O *a< O *-----R^2 has two real roots and two complex conjugate roots O *t+ O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then  O if(bsg.gt.0.5d0) then O iel= 1 O sflr(1)= rr1(1)  O sfur(1)= rr2(1)h O sflr(2)= rr1(1)t O sfur(2)= rr2(1) else. O iel= 2 O ifcr= 0 5 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1)  O sflr(2)= ru2 O sfur(1)= ru1 O sfur(2)= rr2(1)m O endif O *  O *-----R^2 has four real roots  O * 1 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then O  O if(bsg.gt.0.5d0) then O sflr(1)= rr1(1)x O sflr(2)= rs2(1)  O sfur(1)= rs1(1)  O sfur(2)= rr2(1)x else  O ifcr= 0v5 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr)) O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1)0& O sfur(1)= dmin1(rs1(1),ru1)& O sflr(2)= dmax1(rs2(1),ru2) O sfur(2)= rr2(1)c O endif O endif O  O *-. O *-----the loop for transforming sf starts here O * O  O if(om.eq.'g') then O itmn= it0 O itmx= it0 O else O itmn= 1 O itmx= 2 O endifr O do it=itmn,itmx.$ O if(sflr(it).ge.asfl) then O sfl= sflr(it)  O else  O sfl= asfl( O endif$ O if(sfur(it).le.asfu) then O sfu= sfur(it)z O else  O sfu= asfu  O endif O *. O *-----test on sf O *  O if(sfu.le.sfl) then O iz= 0) O ifz(13)= ifz(13)+1 O go to 2  O endif O * F O *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 O * 0 O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then O er= rs1(1) O es= abs(rs1(2))  O er1= rr1(1)e O er2= rr2(1)1 O ek2= edelm/edeld O ek= sqrt(ek2) $ O dog= -2.d0/sqrt(edeld)) O ecpl= (ombsg-2.d0*sfl)/sedms) O ecpu= (ombsg-2.d0*sfu)/sedmz O eql= ecpl*ecpl O equ= ecpu*ecpu) O omecpl= 2.d0*(sfl-er1)/sedms) O es2pl= omecpl*(2.d0-omecpl) ! O erl= 1.d0-ek2*es2pl  O espl= sqrt(es2pl)h) O opecpu= 2.d0*(er2-sfu)/sedm ) O es2pu= opecpu*(2.d0-opecpu)1 O espu= sqrt(es2pu)z! O eru= 1.d0-ek2*es2pu  O if(eql.eq.1) then O  O sflt= 0.d0  O else O ifel= 19 O sflt= -dog*espl*s21bbf(eql,erl,one,ifel)z# O if(ifel.ne.0) then  O iz= 0 O & O ifz(14)= ifz(14)+1 O go to 2  O endif O endifz" O if(equ.eq.1.d0) then O sfut= 0.d0  O else O ifel= 19 O sfut= -dog*espu*s21bbf(equ,eru,one,ifel)z# O if(ifel.ne.0) then  O iz= 0s& O ifz(15)= ifz(15)+1 O go to 2  O endif O endif  O if(iel.eq.1) thenz# O if(sfu.le.er) then  O efac= 0.5d0 - O sft= (sfut-sflt)*sfx+sflt. O ifel= 1a! O asf= -sft/dog(; O call s21caf(asf,ek2,elsn,elcn,edn,ifel)t& O if(ifel.ne.0 then O iz= 0) O ifz(16)= ifz(16)+1( O go to 2 O endift/ O sf= 0.5d0*(ombsg-sedm*elcn)i* O sfjc= efac*(sfut-sflt)) O else if(sfl.ge.er) thenp O efac= 0.5d0-- O sft= (sflt-sfut)*sfx+sfuta O ifel= 1 ! O asf= -sft/dogp; O call s21caf(asf,ek2,elsn,elcn,edn,ifel)=& O if(ifel.ne.0) then O iz= 0) O ifz(17)= ifz(17)+1t O go to 2 O endif=/ O sf= 0.5d0*(ombsg+sedm*elcn) * O sfjc= efac*(sflt-sfut) O else O efac= 1.d0 O qbar= 0.d0" O rbar= 1.d0-ek2 O ifel= 1a: O sfbar= -dog*s21bbf(qbar,rbar,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(18)= ifz(18)+1  O go to 2 O endif.$ O if(it.eq.1) then1 O sft= (sfbar-sflt)*sfx+sfltp O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) then= O iz= 0/, O ifz(19)= ifz(19)+1! O go to 2t O endif2 O sf= 0.5d0*(ombsg-sedm*elcn). O sfjc= efac*(sfbar-sflt)* O else if(it.eq.2) then1 O sft= (sfbar-sfut)*sfx+sfutz O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) theng O iz= 0 , O ifz(20)= ifz(20)+1! O go to 2p O endif2 O sf= 0.5d0*(ombsg+sedm*elcn). O sfjc= efac*(sfbar-sfut) O endif O endif $ O else if(iel.eq.2) then O efac= 1.d0" O if(it.eq.1) then. O sft= (sfut-sflt)*sfx+sflt O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) then1 O iz= 0 * O ifz(21)= ifz(21)+1 O go to 2m O endif0 O sf= 0.5d0*(ombsg-sedm*elcn)+ O sfjc= efac*(sfut-sflt) O ' O else if(it.eq.2) thenu. O sft= (sflt-sfut)*sfx+sfut O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) then  O iz= 0s* O ifz(22)= ifz(22)+1 O go to 2i O endif0 O sf= 0.5d0*(ombsg+sedm*elcn)+ O sfjc= efac*(sflt-sfut)r O endifl O endifs6 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then$ O if(edelp.le.0.d0) then O iz= 0# O ifz(23)= ifz(23)+15 O go to 2 O endif* O sedp= sqrt(edelp). O efac= 1.d0 O es1= rs1(1)c O es2= rs2(1)( O er1= rr1(1)b O er2= rr2(1). O ssed= sedm+sedp " O ek= (sedm-sedp)/ssed O ek2= ek*ek O dog= 2.d0/ssed O if(it.eq.1) then. O es2pl= (er1-sfl)/(sfl-er2)/ek. O es2pu= (er1-sfu)/(sfu-er2)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu# O else if(it.eq.2) then . O es2pl= (sfl-es2)/(sfl-es1)/ek. O es2pu= (sfu-es2)/(sfu-es1)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu O endifd% O if(eql.eq.1.d0) then. O sflt= 0.d0 O else  O ifel= 1m/ O sflt= 2.d0*dog*sqrt(es2pl)*u2 O # s21bbf(eql,erl,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(24)= ifz(24)+1c O go to 2 O endif  O endif% O if(equ.eq.1.d0) thend O sfut= 0.d0 O else  O ifel= 1 ? O if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) thens O equ= 0.d0 O endifd/ O sfut= 2.d0*dog*sqrt(es2pu)* 2 O # s21bbf(equ,eru,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(25)= ifz(25)+1  O go to 2 O endifl O endif* O sft= (sfut-sflt)*sfx+sflt O ifel= 1# O asf= 0.5d0/dog*sft 8 O call s21caf(asf,ek2,elsn,elcn,edn,ifel)! O elsn2= elsn*elsna# O if(ifel.ne.0) then1 O iz= 0 & O ifz(26)= ifz(26)+1 O go to 2  O endif! O if(it.eq.1) then-: O sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)& O else if(it.eq.2) then: O sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) O endif' O sfjc= efac*(sfut-sflt)1 O endif O *  O *-----auxiliary quantities  O *s O sdpf= sd+sf O e3= sp+su+sf1 O e4= 1.d0+spmm-e3d O e3p4= 1.d0+spmm O e1= sm+sdpf O e2= 1.d0+smmp-e1-( O e1p2= 1.d0+smmp $ O e1p3= e1+e3 0 O e1m2= 2.d0*e1-1.d0+spmm  O ep12= xp*e1*e2d O ep1= xp*e1- O ep2= xp*e2  O ep3= xp*e3 O  O ep4= xp*e4  O e1t2= e1*e2 O e1t3= e1*e3 O e1t4= e1*e4 O e2t3= e2*e3 O e2t4= e2*e4 O e3t4= e3*e4/ O if((e1p3*e1p3-4.d0*sf).lt.0.d0) then  O iz= 0! O ifz(27)= ifz(27)+1  O go to 2 O endif( O skl2= sqrt(e1p3*e1p3-4.d0*sf)+ O if((sdmus-4.d0*sd).lt.0.d0) theni O iz= 0! O ifz(28)= ifz(28)+1 O  O go to 2 O endif O skl3= sdmus-4.d0*sd O skl3= sqrt(skl3)m O *f O *-----initialization of t_wu O *,) O *-----limits on tw from positivity and SAo O *A O twlp1= 0.d0 O twlp2= smmp O twlp3= spmm-1.d0() O twlp= dmax1(twlp1,twlp2,twlp3)a O twup= 1.d0 O  O * " O *-----limits on tw from cuts on SA O *) O if(iac(3).ne.0) thenc& O skl2m= 0.5d0*(e1p3-skl2)& O skl2p= 0.5d0*(e1p3+skl2), O skl3p= -0.5d0*(1.d0+sdmu-skl3), O skl3m= -0.5d0*(1.d0+sdmu+skl3), O twlsa1= 1.d0-cs(3)*e3-cs(4)*e4' O twlsa2= ss(1)*e1+ss(2)*e2 8 O twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m4 O twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m4 O twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p8 O twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m, O twusa1= 1.d0-ss(3)*e3-ss(4)*e4' O twusa2= cs(1)*e1+cs(2)*e2t8 O twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m4 O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,u( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,4( O # twusa5,twusa6) O elses O atwl= twlp O atwu= twup O endif O *# O *-----limits on tw from Es O *c O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2)s" O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1))% O atwle2= bxe*e2-bl(2)-* O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2) 1 O twue= dmin1(atwle,atwue1,atwue2)s O endif)$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *  O *-----natural limits on tw O * O # O atwl= dmax1(atwl,bt1(1))f# O atwu= dmin1(atwu,bt2(1))  O *3 O *-----test on tw O *f O if(atwu.le.atwl) then O iz= 0- O ifz(29)= ifz(29)+1 O go to 2e O endif O *  O twjc= atwu-atwl O tw= twjc*twx+atwl O pn= tw+sp-1.d0f O omtw= 1.d0-tw O *  O *-----initialization of t1 O *a% O *-----limits on t1 from positivity+SAu O *f O t1lp1= 0.d0 O t1lp2= pn+sdpf  O t1up1= tw O t1up2= sm+sdpfn# O t1lp= dmax1(t1lp1,t1lp2)e# O t1up= dmin1(t1up1,t1up2)h O * O " O *-----limits on t1 from cuts on SA O *  O if(iac(3).ne.0) then) O t1lc1= ss(1)*e1 O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) 5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)*/ O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3s4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1 O O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))t5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3f4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else  O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E  O *  O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1))" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif($ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O **4 O *-----positivity of (R')^2 / reality of roots for t3 O *s! O rp0= e1p2*e1p2-4.d0*sms O if(rp0.lt.0.d0) thens O iz= 0 O ifz(30)= ifz(30)+1 O go to 2  O endif O srp0= sqrt(rp0) O rp0e= -rp0l, O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1 & O rp2= -(e1*tw-sm)*(e1*tw-sm) O if(rp0e.eq.0.d0) then O iz= 0+ O ifz(31)= ifz(31)+1 O go to 2l O endif O ifct= 0 O if(rp0e.ne.0.d0) then7 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct)l/ O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1))% O else if(rp0e.eq.0.d0) then  O sret1= -rp2/rp1e# O if(rp1e.gt.0.d0) then+' O t1l= dmax1(at1l,sret1). O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1) O  O endif+ O endif O *t O *-----test on t1 O *  O if(t1u.le.t1l) then O iz= 0z O ifz(31)= ifz(31)+1 O go to 2v O endif O * ! O *-----transformation for jacobian O  O * O if(rp0e.eq.0.d0) then0 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)0 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-tauli9 O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e2 O endif" O if(ret1(1).eq.t1l) then O at1tl= -pih/srp0 O else O 0 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) O ifas= 1f- O at1tl= -s09aaf(bt1tl,ifas)/srp0i% O if(ifas.ne.0) print 2001 O endif" O if(ret2(1).eq.t1u) then O at1tu= pih/srp01 O else 1 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)2 O ifas= 1 O - O at1tu= -s09aaf(bt1tu,ifas)/srp0,% O if(ifas.ne.0) print 200) O endif) O if((at1tl+at1tu).eq.0.d0) then1# O if(t1x.lt.1.d-3) then  O arc= pi*t1x O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc/ O else if((1.d0-t1x).lt.1.d-3) then1# O arc= pi*(1.d0-t1x)  O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc O else" O carc= cos(pi*t1x)- O t1= 0.5d0*(ret1(1)+ret2(1))+11 O # 0.5d0*(ret1(1)-ret2(1))*carcp O endifs O t1jc= pi/srp0q O else & O t1tl= dmin1(at1tl,at1tu)& O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tln O t1t= t1jc*t1x+t1tl. O t1= (rp1+rpds*sin(srp0*t1t))/rp0 O endif O t1s= t1*t1  O * 1 O 200 format(' Unsuccesful call to S09AAF ')  O *  O *-----test on t1 from FS A O * / O if(ieq.eq.1.and.iac(4).ne.0.d0) thenf/ O cnlct1= xp*(xm*sm-ep12*cg12)+xdf*s7 O # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1-z+ O # xdf*tw)+xdfs*cg12*t1sd/ O cnlst1= xp*(ep12*sg12-xm*sm)-xdf*D7 O # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+.+ O # xdf*tw)-xdfs*sg12*t1ss% O if(cnlct1.lt.0.d0) then  O iz= 0# O ifz(32)= ifz(32)+1  O go to 2* O else if(cnlst1.lt.0.d0) then O iz= 0# O ifz(33)= ifz(33)+1d O go to 2 O endif O  O endif O *p O *-----some vector components O *c O t2= tw-t1c O *  O *-----equation for xi is solved  O *s O e1s= e1*e1  O e2s= e2*e2- O e3s= e3*e3  O e12= e1t2-2.d0*sm O e13= e1t3-2.d0*sf O e23= e2t3-2.d0*su O e12s= e12*e12 O e13s= e13*e13 O e23s= e23*e23 O xia= e1s*e2s-e12s= O xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- < O # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ O # e2*e12*e13= O xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* > O # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0*< O # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1*> O # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s*< O # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*; O # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23  O xib= 2.d0*xib! O if(xia.eq.0.d0) then $ O if(xib.eq.0.d0) then O iz= 0% O ifz(34)= ifz(34)+1e O go to 2 O endif O rtm(1)= -xic/xib O rtp(1)= rtm(1) O rtm(2)= 0.d0 O rtp(2)= 0.d0 O ixia= 0  O elses O ixia= 1t O ifc0= 0i5 O call c02ajf(xia,xib,xic,rtm,rtp,ifc0)  O endif$ O if(rtm(2).ne.0.d0) then O iz= 0 " O ifz(35)= ifz(35)+1 O go to 2 O  O endif O *c O *-----xi^+ and xi^- are computed O * # O xip= 0.5d0*(e3-rtp(1)) # O xim= 0.5d0*(e3-rtm(1))  O * . O *-----each integral becomes a sum of two terms O *l O *-----loop over ix starts here O */ O if(om.eq.'g') then O ixmn= ix0 O ixmx= ix0 O else O ixmn= 1 O ixmx= 2 O endif  O do ix=ixmn,ixmx  O * ) O *-----q_3 is compared and x15 is selected  O *n" O if(ix.eq.1) then O t3= xip' O else if(ix.eq.2) then  O t3= xim O endif  O * % O *-----The two integrands are computed  O *r" O *-----further auxiliary quantities O *a O edn1= ep1-xdf*t1* O edn2= ep2-xdf*t2  O edn3= ep3-xdf*t3 O  O t4= omtw-t3 O edn4= ep4-xdf*t4  O *(% O *-----collections of all limits on t3 O  O * % O *-----from energy (or natural limits)  O * O if(ieq.eq.1) then* O at3l1= omtw-bxe*e4+bl(4)% O at3u1= bxe*e3-bl(3) & O if(xdf.gt.0.d0) then O t3l1= at3l1 O t3u1= at3u1+ O else if(xdf.lt.0.d0) then O t3l1= at3u1 O t3u1= at3l1 O endif  O elsee O t3l1= 0.d0 O t3u1= e3 O endif O *j O *-----natural limits O * . O t3l2= -t1+0.5d0*(e1p3-skl2). O t3u2= -t1+0.5d0*(e1p3+skl2) O * 7 O t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3)d7 O t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)e O *i O *-----from positivity on SAi O *f O t3l4= 0.d0 $ O t3l5= sm+su+sf-tw! O t3u4= sp+su+sf  O t3u5= omtw  O * *-----from SAd O * O ' O if(iac(3).ne.0) thene# O t3l6= ss(3)*e3=# O t3u6= cs(3)*e3 ( O t3l7= omtw-cs(4)*e4( O t3u7= omtw-ss(4)*e44 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,/ O # t3l5,t3l6,t3l7) O 4 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,/ O # t3u5,t3u6,t3u7)e O else 9 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) 9 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)  O endif O * O  O *-----limits on t3 are imposed O * , O tlimt3= (t3u-t3)*(t3-t3l)& O if(t3u.lt.t3l) then O iz= 0u( O ifz(36)= ifz(36)+1 O go to 4e/ O else if(tlimt3.lt.0.d0) then  O iz= 0e( O ifz(36)= ifz(36)+1 O go to 4  O endif O * , O *-----non linear limits on t3,t4 are imposed O * 4 O if(iac(4).ne.0.and.ieq.eq.1) then3 O tnl13c= -cg13*edn1*edn3+vv*sf 2 O tnl13s= sg13*edn1*edn3-vv*sf3 O tnl23c= -cg23*edn2*edn3+vv*su.2 O tnl23s= sg23*edn2*edn3-vv*su3 O tnl14c= -cg14*edn1*edn4+vv*sdz2 O tnl14s= sg14*edn1*edn4-vv*sd* O sres= 1.d0-e1-e3+sf 5 O tnl24c= -cg24*edn2*edn4+vv*sresc4 O tnl24s= sg24*edn2*edn4-vv*sres3 O tnl34c= -cg34*edn3*edn4+vv*spe2 O tnl34s= sg34*edn3*edn4-vv*sp= O if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. = O # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or.k= O # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. = O # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. ? O # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then O  O iz= 0+ O ifz(37)= ifz(37)+1e O go to 4+ O endif . O endif O *u: O *-----non linear constraints from FS A in the case xp = xm O * 7 O if(iac(4).ne.0.d0.and.ieq.eq.0) then . O smr= 1.d0-sm-sp-su-sd-sf; O spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm)l; O spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf)#; O spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) ; O spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) = O spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr)o; O spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) M O if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. N O # spc14.lt.0.d0.or.spc23.lt.0.d0.or. = O # spc24.lt.0.d0.or.spc34.lt.0.d0) then  O iz= 0+ O ifz(38)= ifz(38)+1 O go to 4 O endif  O endif O *  O *-----all invariants O *  O x13= t1 O x14= t2 O x15= t3 O x16= t4 O x23= e1-t1- O x24= e2-t2i O x25= e3-t3d O x26= e4-t4  O x34= sm O x35= sf O x36= sd O x45= su' O x46= 1.d0-e1-e3+sf( O x56= sp O *  O *-----computes cross-section O *fB O *-----born matrix element is calculated at the reduced c.m. energy O *l, O *-----The epsilons are computed in the order9 O * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4),s9 O * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), 9 O * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4),i9 O * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4),=8 O * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) O *d" O x13s= x13*x13" O x14s= x14*x14" O x15s= x15*x15" O x16s= x16*x16" O x23s= x23*x23" O x24s= x24*x24" O x25s= x25*x25" O x26s= x26*x26" O x34s= x34*x34" O x35s= x35*x35" O x36s= x36*x36" O x45s= x45*x45" O x46s= x46*x46" O x56s= x56*x56G O * > O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+A O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s > O ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+A O # x15*x23*x35)-x13s*x25s-x15s*x23s-x35ss> O ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+A O # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s B O ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+A O # x14*x15*x34*x35)-x13s*x45s-x14s*x35s-o% O # x15s*x34s(B O ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+A O # x24*x25*x34*x35)-x23s*x45s-x24s*x35s-d% O # x25s*x34s1G O *  O e(1)= 1.d0 F O e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*E O # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14*4C O # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35sE O e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-2F O # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-D O # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45F O e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*G O # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14*sF O # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 G O e(5)= x13*(-x23*x24*x45-x24*x25*x34+x *x24s)+x14* C O # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* D O # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+$ O # x25*x34s O *  O *-----sign of eps_1*eps_ib O *) O ises= 0" O sg(1)= 0.25d0+ O if(ee(1).lt.0.d0) thena$ O ises= ises+1 O endif O do i=2,5w2 O if(abs(e(i)).lt.zrm) then( O ises= ises+12 O else if(e(i).gt.zrm) then) O sg(i)= 0.25d0,3 O else if(e(i).lt.-zrm) thent* O sg(i)= -0.25d0 O endif/ O if(ee(i).lt.0.d0) then ( O ises= ises+1 O endif O enddo O *)' O if(ises.eq.0) theni/ O ses1= sg(1)*sqrt(ee(1)) / O ses2= sg(2)*sqrt(ee(2))e/ O ses3= sg(3)*sqrt(ee(3))l/ O ses4= sg(4)*sqrt(ee(4))+/ O ses5= sg(5)*sqrt(ee(5))t O s1= ses1 O s2= ses2& O s3= -ses1-ses2 O s4= ses3% O s5= ses1-ses3l% O s6= ses2+ses3= O s7= ses4% O s8= ses1-ses4 % O s9= ses2+ses4 & O s10= ses3-ses4! O s11= ses5(' O s12= -ses1-ses5 ' O s13= -ses2+ses5m' O s14= -ses3-ses53' O s15= -ses4-ses55 O else4A O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ O D O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sA O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+=D O # x16*x23*x36)-x13s*x26s-x16s*x23s-x36sA O ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+cD O # x16*x24*x46)-x14s*x26s-x16s*x24s-x46sE O ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+pD O # x14*x16*x34*x36)-x13s*x46s-x14s*x36s-( O # x16s*x34sE O ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+tE O # x24*x26*x34*x36)-x23s*x46s-x24s*x36s-f) O # x26s*x34se" O e(1)= 1.d0> O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+B O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-C O # x14*x16*x23s+x14*x23*x36+x16*x23*x34--2 O # x13s*x24*x26-x34*x36@ O e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*@ O # x24*x46-x14*x16*x23*x24+x14*(-x23*@ O # x46+2.d0*x24*x36-x26*x34)-x16*x24*6 O # x34+x14s*x23*x26+x34*x46@ O e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*? O # x34)+x13*x16*x24*x34+x13*x34*x46+ > O # x14*x16*x23*x34+x14*x34*x36-x16*= O # x34s-x13s*x24*x46-x14s*x23*x36 @ O e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*> O # x24s)+x14*(-x23*x24*x36-x23*x26*A O # x34+x46*x23s)+x16*2.d0*x23*x24*x34- > O # x23*x34*x46-x24*x34*x36+x26*x34s O ises= 0)% O sg(1)= 0.25d0l. O if(ee(1).lt.0.d0) then' O ises= ises+1  O endif O do i=2,55 O if(abs(e(i)).lt.zrm) then O + O ises= ises+1 5 O else if(e(i).gt.zrm) then , O sg(i)= 0.25d06 O else if(e(i).lt.-zrm) then- O sg(i)= -0.25d0*! O endifr2 O if(ee(i).lt.0.d0) then+ O ises= ises+1a! O endif O  O enddoh* O if(ises.eq.0) then2 O ses1= sg(1)*sqrt(ee(1))2 O ses2= sg(2)*sqrt(ee(2))2 O ses3= sg(3)*sqrt(ee(3))2 O ses4= sg(4)*sqrt(ee(4))2 O ses5= sg(5)*sqrt(ee(5))# O s1= ses1-) O s2= -ses1-ses2 # O s3= ses2f) O s4= -ses1-ses3e# O s5= ses3 ) O s6= -ses2-ses3 ( O s7= ses1-ses4# O s8= ses4 ) O s9= -ses2-ses4(* O s10= -ses3+ses4* O s11= -ses1-ses5$ O s12= ses5) O s13= ses2-ses5.) O s14= ses3+ses5t) O s15= ses4+ses5  O elseD O ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+C O # x15*x23*x35)-x13s*x25s-x15s*x23s-l& O # x35sD O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+C O # x16*x23*x36)-x13s*x26s-x16s*x23s-c& O # x36sD O ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+C O # x16*x25*x56)-x15s*x26s-x16s*x25s- & O # x56sD O ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*A O # x56+x15*x16*x35*x36)-x13s*x56s- O 5 O # x15s*x36s-x16s*x35s D O ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*A O # x56+x25*x26*x35*x36)-x23s*x56s-c5 O # x25s*x36s-x26s*x35sfG O * A O e(1)= x13*x14*x23*x25+x13*x15*x23*x24+tE O # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- B O # x14*x15*x23s+x14*x23*x35+x15*x23*9 O # x34-x13s*x24*x25-x34*x35 O A O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+pE O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-aB O # x14*x16*x23s+x14*x23*x36+x16*x23*9 O # x34-x13s*x24*x26-x34*x362B O e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+D O # x13*(-x25*x46+x26*x45)+x14*x15*x23*F O # x26-x14*x16*x23*x25+x14*(x25*x36-x26*F O # x35)+x15*(-x23*x46+x24*x36)+x16*(x23*= O # x45-x24*x35)+x35*x46-x36*x45 O C O e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15*#E O # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ D O # x25*x34)+x13*(x35*x46-x36*x45)-x14*E O # x15*x23*x36+x14*x16*x23*x35+x15*x34*.D O # x36-x16*x34*x35+x13s*(-x25*x46+x26*% O # x45)bG O e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25*.D O # x36-x24*x26*x35)+x15*(-x23*x24*x36-D O # x23*x26*x34+x46*x23s)+x16*(x23*x24*C O # x35+x23*x25*x34-x45*x23s)-x23*x35* E O # x46+x23*x36*x45-x25*x34*x36+x26*x34* O $ O # x35 O * " O ises= 0# O do i=1,5,8 O if(abs(e(i)).lt.zrm) then. O ises= ises+18 O else if(e(i).gt.zrm) then/ O sg(i)= 0.25d0 O 9 O else if(e(i).lt.-zrm) then 0 O sg(i)= -0.25d0$ O endif5 O if(ee(i).lt.0.d0) then . O ises= ises+1$ O endif O enddo- O if(ises.eq.0) thens5 O ses1= sg(1)*sqrt(ee(1))f5 O ses2= sg(2)*sqrt(ee(2)) 5 O ses3= sg(3)*sqrt(ee(3))=5 O ses4= sg(4)*sqrt(ee(4))r5 O ses5= sg(5)*sqrt(ee(5))i, O s1= -ses1-ses2& O s2= ses1& O s3= ses2, O s4= -ses1+ses3, O s5= -ses2-ses3& O s6= ses3, O s7= -ses1+ses4, O s8= -ses2-ses4& O s9= ses4, O s10= ses3-ses4, O s11= ses1+ses5, O s12= ses2-ses5' O s13= ses5 O - O s14= -ses3-ses5 - O s15= -ses4-ses5  O else # O iz= 0-0 O ifz(39)= ifz(39)+1% O go to 4 O endif O endif1 O endif O * ( O tgn(1)= x14/x25/x36) O tgn(2)= x14*x25*x36 O ) O tgn(3)= x24/x15/x36 ) O tgn(4)= x15*x24*x36 1 O tgn(5)= x14/x24/x34/x45*x46 1 O tgn(6)= x14/x24/x34*x45/x46(1 O tgn(7)= x14/x24*x34/x45*x46=1 O tgn(8)= x14/x24*x34*x45/x46 1 O tgn(9)= x14*x24/x34/x45*x46t2 O tgn(10)= x14*x24/x34*x45/x462 O tgn(11)= x45*x46/x15/x25/x342 O tgn(12)= x45/x15/x25/x34/x462 O tgn(13)= x34*x45/x15/x25/x462 O tgn(14)= x25*x46/x15/x34/x452 O tgn(15)= x25*x45/x15/x34/x462 O tgn(16)= x15/x25/x34*x45/x462 O tgn(17)= x25/x15/x34*x45*x462 O tgn(18)= x25*x34*x45/x46/x152 O tgn(19)= x15/x25/x34*x45*x462 O tgn(20)= x15/x25*x34*x45/x462 O tgn(21)= x15*x25*x34/x45*x461 O tgn(22)= x34/x15/x25/x45/x46.1 O tgn(23)= x15/x25*x34/x45*x46 1 O tgn(24)= x34/x14/x24*x45/x46 1 O tgn(25)= x14/x24*x34/x45/x46-1 O tgn(26)= x24/x14*x34*x45/x46 1 O tgn(27)= x14*x24*x34/x45/x46 1 O tgn(28)= x34/x14/x24*x45*x46+) O tgn(29)= x15/x24/x36e. O tgn(30)= 1.d0/x14/x25/x36) O tgn(31)= x14/x25*x36  O *2 O itgn= 0 O do l=1,310 O if(tgn(l).le.0.d0) then( O itgn= itgn+1 O endif O enddo' O if(itgn.ne.0) thenn O iz= 0 * O ifz(40)= ifz(40)+1 O go to 43 O endif O * & O gh1= sqrt(tgn(1))& O gh2= sqrt(tgn(2))& O gh3= sqrt(tgn(3))& O gh4= sqrt(tgn(4))& O gh5= sqrt(tgn(5))& O gh6= sqrt(tgn(6))& O gh7= sqrt(tgn(7))& O gh8= sqrt(tgn(8))& O gh9= sqrt(tgn(9))( O gh10= sqrt(tgn(10))( O gh11= sqrt(tgn(11))( O gh12= sqrt(tgn(12))( O gh13= sqrt(tgn(13))( O gh14= sqrt(tgn(14))( O gh15= sqrt(tgn(15))( O gh16= sqrt(tgn(16))( O gh17= sqrt(tgn(17))( O gh18= sqrt(tgn(18))( O gh19= sqrt(tgn(19))( O gh20= sqrt(tgn(20))( O gh21= sqrt(tgn(21))( O gh22= sqrt(tgn(22))( O gh23= sqrt(tgn(23))( O gh24= sqrt(tgn(24))( O gh25= sqrt(tgn(25))( O gh26= sqrt(tgn(26))( O gh27= sqrt(tgn(27))( O gh28= sqrt(tgn(28))( O gh29= sqrt(tgn(29))( O gh30= sqrt(tgn(30))( O gh31= sqrt(tgn(31)) O *  O *-----Helicity he1-2)  O * # O *-----Higgs Bremsstrahlung diagram:  O * - O hb12r= 4.d0*(gh7*x25+gh26*x16-gh27*x56-  O # gh28)& O hb12i= 16.d0*(-s5*gh24+s14*gh25) O hb1r= 4.d0*hch(7)*hb12r1 O hb1i= 4.d0*hch(7)*hb12i O  O hb2r= 4.d0*hch(8)*hb12r  O hb2i= -4.d0*hch(8)*hb12i O *  O *-----Higgs Fusion diagram:  O * 2 O hf2r= 4.d0*(-gh7*x25-gh26*x16+gh27*x56+gh28)% O hf2i= 16.d0*(-s5*gh24+s14*gh25)  O *  O *-----Helicity he3-4) * *-----Higgs Bremsstrahlung diagram: * hb34r= 4.d0*(-gh4+gh29*(x23*x46-x26*x34)) hb34i= -16.d0*s12*gh29 hb3r= 4.d0*hch(7)*hb34r hb3i= 4.d0*hch(7)*hb34i hb4r= 4.d0*hch(8)*hb34r hb4i= -4.d0*hch(8)*hb34i * *-----Higgs Fusion diagram: * hf4r= 4.d0*(gh4+gh29*(-x23*x46+x26*x34)) hf4i= -16.d0*s12*gh29 * *-----Helicity he5-6) * *-----Higgs Bremsstrahlung diagram: * hb56r= 4.d0*(-gh13*x16*x25+gh22*x14*x25*x56- # gh23*x25) hb56i= 16.d0*s10*gh22*x25 hb5r= 4.d0*hch(5)*hb56r hb5i= 4.d0*hch(5)*hb56i hb6r= 4.d0*hch(6)*hb56r hb6i= -4.d0*hch(6)*hb56i * *-----Helicity he7-8) * *-----Higgs Bremsstrahlung diagram: * hb78r= 4.d0*(gh30*(x13*x25*x46-x16*x25*x34)- # gh31*x25) hb78i= 16.d0*s8*gh30*x25 hb7r= 4.d0*hch(5)*hb78r hb7i= 4.d0*hch(5)*hb78i hb8r= 4.d0*hch(6)*hb78r hb8i= -4.d0*hch(6)*hb78i * *-----compensating single Z propagator * wpcfr= sp-rzm2/vv wpcfi= sp*szg * *-----extra propagators * vrwm2= rwm2/vv x25w= x25+vrwm2 x16w= x16+vrwm2 * *-----complete diagrams: * if(omssm.eq.'y') then alpha1= -sbma*salpha/cbeta alpha2= cbma*calpha/cbeta alpha21= alpha2/alpha1 propm= (sm-rbhm2/vv)*(sm-rbhm2/vv)+(sm*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) else if(omssm.eq.'n') then alpha1= 1.d0 addmr= 1.d0 addmi= 0.d0 endif hbcf= sqrt(rbqm2/vv)/8.d0/cth4*alpha1 hfcf= fkill*sqrt(rbqm2/vv)/16.d0/x16w/x25w*alpha1 * chb1r= hbcf*rsz*hb1r chb1re= -hbcf*aisz*hb1i chb1ie= hbcf*rsz*hb1i chb1i= hbcf*aisz*hb1r * chb2r= hbcf*rsz*hb2r chb2re= -hbcf*aisz*hb2i chb2ie= hbcf*rsz*hb2i chb2i= hbcf*aisz*hb2r * chb3r= hbcf*rsz*hb3r chb3re= -hbcf*aisz*hb3i chb3ie= hbcf*rsz*hb3i chb3i= hbcf*aisz*hb3r * chb4r= hbcf*rsz*hb4r chb4re= -hbcf*aisz*hb4i chb4ie= hbcf*rsz*hb4i chb4i= hbcf*aisz*hb4r * chb5r= hbcf*rsz*hb5r chb5re= -hbcf*aisz*hb5i chb5ie= hbcf*rsz*hb5i chb5i= hbcf*aisz*hb5r * chb6r= hbcf*rsz*hb6r chb6re= -hbcf*aisz*hb6i chb6ie= hbcf*rsz*hb6i chb6i= hbcf*aisz*hb6r * chb7r= hbcf*rsz*hb7r chb7re= -hbcf*aisz*hb7i chb7ie= hbcf*rsz*hb7i chb7i= hbcf*aisz*hb7r * chb8r= hbcf*rsz*hb8r chb8re= -hbcf*aisz*hb8i chb8ie= hbcf*rsz*hb8i chb8i= hbcf*aisz*hb8r * chf2r= hfcf*wpcfr*hf2r chf2re= -hfcf*wpcfi*hf2i chf2ie= hfcf*wpcfr*hf2i chf2i= hfcf*wpcfi*hf2r * chf4r= hfcf*wpcfr*hf4r chf4re= -hfcf*wpcfi*hf4i chf4ie= hfcf*wpcfr*hf4i chf4i= hfcf*wpcfi*hf4r * cchb1r= addmr*chb1r-addmi*chb1i cchb1re= addmr*chb1re-addmi*chb1ie cchb1ie= addmr*chb1ie+addmi*chb1re cchb1i= addmr*chb1i+addmi*chb1r cchb2r= addmr*chb2r-addmi*chb2i cchb2re= addmr*chb2re-addmi*chb2ie cchb2ie= addmr*chb2ie+addmi*chb2re cchb2i= addmr*chb2i+addmi*chb2r cchb3r= addmr*chb3r-addmi*chb3i cchb3re= addmr*chb3re-addmi*chb3ie cchb3ie= addmr*chb3ie+addmi*chb3re cchb3i= addmr*chb3i+addmi*chb3r cchb4r= addmr*chb4r-addmi*chb4i cchb4re= addmr*chb4re-addmi*chb4ie cchb4ie= addmr*chb4ie+addmi*chb4re cchb4i= addmr*chb4i+addmi*chb4r cchb5r= addmr*chb5r-addmi*chb5i cchb5re= addmr*chb5re-addmi*chb5ie cchb5ie= addmr*chb5ie+addmi*chb5re cchb5i= addmr*chb5i+addmi*chb5r cchb6r= addmr*chb6r-addmi*chb6i cchb6re= addmr*chb6re-addmi*chb6ie cchb6ie= addmr*chb6ie+addmi*chb6re cchb6i= addmr*chb6i+addmi*chb6r cchb7r= addmr*chb7r-addmi*chb7i cchb7re= addmr*chb7re-addmi*chb7ie cchb7ie= addmr*chb7ie+addmi*chb7re cchb7i= addmr*chb7i+addmi*chb7r cchb8r= addmr*chb8r-addmi*chb8i cchb8re= addmr*chb8re-addmi*chb8ie cchb8ie= addmr*chb8ie+addmi*chb8re cchb8i= addmr*chb8i+addmi*chb8r cchf2r= addmr*chf2r-addmi*chf2i cchf2re= addmr*chf2re-addmi*chf2ie cchf2ie= addmr*chf2ie+addmi*chf2re cchf2i= addmr*chf2i+addmi*chf2r cchf4r= addmr*chf4r-addmi*chf4i cchf4re= addmr*chf4re-addmi*chf4ie cchf4ie= addmr*chf4ie+addmi*chf4re cchf4i= addmr*chf4i+addmi*chf4r * *-----Total * dthr= cchb1r*cchb1r+(cchb2r-cchf2r)*(cchb2r-cchf2r)+ # cchb3r*cchb3r+(cchb4r-cchf4r)*(cchb4r-cchf4r)+ # cchb5r*cchb5r+cchb6r*cchb6r+cchb7r*cchb7r+cchb8r*cchb8r dthie= cchb1ie*cchb1ie+(cchb2ie-cchf2ie)*(cchb2ie-cchf2ie)+ # cchb3ie*cchb3ie+(cchb4ie-cchf4ie)*(cchb4ie-cchf4ie)+ # cchb5ie*cchb5ie+cchb6ie*cchb6ie+cchb7ie*cchb7ie+ # cchb8ie*cchb8ie dthre= cchb1re*cchb1re+(cchb2re-cchf2re)*(cchb2re-cchf2re)+ # cchb3re*cchb3re+(cchb4re-cchf4re)*(cchb4re-cchf4re)+ # cchb5re*cchb5re+cchb6re*cchb6re+cchb7re*cchb7re+ # cchb8re*cchb8re dthi= cchb1i*cchb1i+(cchb2i-cchf2i)*(cchb2i-cchf2i)+ # cchb3i*cchb3i+(cchb4i-cchf4i)*(cchb4i-cchf4i)+ # cchb5i*cchb5i+cchb6i*cchb6i+cchb7i*cchb7i+cchb8i*cchb8i dth= dthr+dthie+dthre+dthi * 4 if(iz.eq.0) then dpxs(ix,it)= 0.d0 iz= 1 else tjac= ujc*vjc*smjc*spjc*sujc*sdjc* # sfjc*twjc*t1jc*vv 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 if(omssm.eq.'n') then xhm= hm else if(omssm.eq.'y') then xhm= shm endif alsh= wtoralphas(wm,xhm,als,nf) if(omssm.eq.'n') then fqcd= 1.d0+alsh/pi*(17.d0/3.d0+(35.94d0-1.36d0*nf)* # alsh/pi) else if(omssm.eq.'y') then fqcd= 1.d0+17.d0/3.d0*alsh/pi endif else fqcd= 1.d0 endif * wtoxsh19= tfact*resf*bfact*fqcd * if(om.eq.'g') then if(osm.eq.'n') then jp= iwtopos(ndim,x) if(wtoxsh19.gt.xshmx(jp)) then xshmx(jp)= wtoxsh19 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 * *-----WTOXSH49----------------------------------------------------------- * real*8 function wtoxsh49(ndim,x) implicit real*8 (a-h,o-z) character*1 om,osm,oqcd,omssm * parameter(ninv=10,npos=512) * common/wtmod/om common/wtmp/zrm common/wtqcd/als common/wthiggs/hm common/wtsmod/osm common/wtdis/dist common/wtkount/ik 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/wticuts/iac(4) common/wtisa/isaa,isab common/wthx/xshmx(npos) common/wtparh/xaph(ninv) 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 * dimension tgn(45) 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 spx= x(1) sux= x(2) sdx= x(3) sfx= x(4) twx= x(5) t1x= x(6) else if(ndim.eq.8) then uvx= x(1) vvx= x(2) spx= x(3) sux= x(4) sdx= x(5) sfx= x(6) twx= x(7) t1x= x(8) else if(ndim.eq.7) then smx= x(1) spx= x(2) sux= x(3) sdx= x(4) sfx= x(5) twx= x(6) t1x= x(7) else if(ndim.eq.9) then uvx= x(1) vvx= x(2) smx= x(3) spx= x(4) sux= x(5) sdx= x(6) sfx= x(7) twx= x(8) t1x= x(9) endif * ik= ik+1 rs= ars one= 1.d0 * *-----if a point is not allowed then the * result is set to zero * iz= 1 * if(ndim.eq.6.or.ndim.eq.7) then ueps= 0.d0 uv= 1.d0 uvs= uv*uv ujc= 1.d0 veps= 0.d0 vv= 1.d0 vjc= 1.d0 else if(ndim.eq.8.or.ndim.eq.9) then * *-----independent invariants are initialized * first u and v variable * if(uvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 endif ueps= omul*(1.d0-uvx)**hbeti uv= 1.d0-ueps ujc= omul**hbet uvs= uv*uv * *-----limits for v * *-----from equal cuts on SA * if(iac(3).eq.1.and.isab.eq.1) then vvl4= ombsa(1)/opbsa(1)*uvs vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else vvl= dmax1(vvl1,vvl2,vvl3) endif * *-----from E * vve= uv*(2.d0*suml-uv) vvll= dmax1(vvl,vve) * vvu1= uv if(iac(3).eq.1.and.isaa.eq.1) then vvu2= omasa(1)/opasa(1)*uvs vvu= dmin1(vvu1,vvu2) else vvu= uv endif uvl= uv-vvll * vkf= (uv-vvu)/uvl if(vkf.lt.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vkf.eq.0.d0) then if(vvx.gt.1.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else if(vvx.eq.1.d0) then veps= 0.d0 else veps= uvl*(1.d0-vvx)**hbeti endif avkf= 1.d0 else veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti avkf= 1.d0-vkf**hbet endif vv= uv-veps vjc0= 1.d0-vvll/uv if(vjc0.le.0.d0) then iz= 0 ifz(1)= ifz(1)+1 go to 1 else vjc= vjc0**hbet*avkf endif endif * 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 * *-----test on sm * if(zmb.le.zma) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif * if(itc.eq.4) then bdistl= dist*dist/s-zma bdistu= zmb-dist*dist/s if(bdistl.le.0.d0.or.bdistu.le.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif endif * if(omssm.eq.'n') then xrhm2= rhm2 xshg= shg xshgs= shgs xrhmg= rhmg xvhmg= vhmg xopshgs= opshgs else if(omssm.eq.'y') then xrhm2= rshm2 xshg= sshg xshgs= sshgs xrhmg= rshmg xvhmg= vshmg xopshgs= opsshgs endif if(itc.eq.4) then sm= (dist/rs/svv)**2 smjc= 2.d0*dist/s/((vv*sm-xrhm2)**2+ # (vv*sm*xshg)**2) else * zmas= zma-xrhm2 zmbs= zmb-xrhm2 atma= (zmas+xshgs*zma)/xrhmg atmb= (zmbs+xshgs*zmb)/xrhmg if(atma.gt.1.d0.and.atmb.gt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/xvhmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/xvhmg smjc0= (-atmb+atma)/xvhmg else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/xvhmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/xvhmg smjc0= (-pi+atmb+atma)/xvhmg else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then atma= 1.d0/atma atma= atan(atma) zmat= (pih-atma)/xvhmg atmb= atan(atmb) zmbt= atmb/xvhmg smjc0= (-pih+atmb+atma)/xvhmg else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/xvhmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/xvhmg smjc0= (pi-atmb-atma)/xvhmg else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/xvhmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/xvhmg smjc0= (atmb-atma)/xvhmg else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then atma= -1.d0/atma atma= atan(atma) zmat= (-pih+atma)/xvhmg atmb= atan(atmb) zmbt= atmb/xvhmg smjc0= (pih+atmb-atma)/xvhmg else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then atma= atan(atma) zmat= atma/xvhmg atmb= 1.d0/atmb atmb= atan(atmb) zmbt= (pih-atmb)/xvhmg smjc0= (pih-atmb-atma)/xvhmg else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then atma= atan(atma) zmat= atma/xvhmg atmb= -1.d0/atmb atmb= atan(atmb) zmbt= (-pih+atmb)/xvhmg smjc0= (-pih+atmb-atma)/xvhmg else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then atma= atan(atma) zmat= atma/xvhmg atmb= atan(atmb) zmbt= atmb/xvhmg smjc0= (atmb-atma)/xvhmg endif * zmv= smjc0*smx+zmat iftn= 1 atnm= xvhmg*zmv sm= xrhm2/xopshgs/vv*(1.d0+xshg*s07aaf(atnm,iftn)) if(iftn.ne.0) print 300 smjc= vv*smjc0 endif * if(sm.lt.0.d0) then iz= 0 ifz(4)= ifz(4)+1 go to 1 endif ssm= sqrt(sm) * 300 format(/' Unsuccesful call to S07AAF ') * *-----initialization of sp = m_+^2 * zpa1= dsp zpb1= usp zpb2= vv*(1.d0-ssm)*(1.d0-ssm) * *-----limits on sp from cuts on SA. Here for maximum security. Rare * if(iac(3).eq.0) then zpb= dmin1(zpb1,zpb2) zpa= zpa1 else if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then if(ss(3).eq.ss(1)) then azpb= dmin1(zpb1,zpb2) azpa= zpa1 else if(ss(3).gt.ss(1)) then zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpb= dmin1(zpb1,zpb2,zpb3) azpa= zpa1 else if(ss(3).lt.ss(1)) then azpb= dmin1(zpb1,zpb2) zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) azpa= dmax1(zpa1,zpa2) endif else azpa= zpa1 azpb= dmin1(zpb1,zpb2) endif if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then if(cs(3).eq.cs(1)) then zpa= azpa zpb= azpb else if(cs(3).gt.cs(1)) then zpb= azpb bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpa= dmax1(azpa,bzpa) else if(cs(3).lt.cs(1)) then zpa= azpa bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))) zpb= dmin1(azpb,bzpb) endif else zpa= azpa zpb= azpb endif endif * if(ieq.eq.0) then zpel= vv*(-1.d0+bl(3)+bl(4)+sm) zpeu1= vv*(1.d0-bl(1)-bl(2)+sm) zpeu2= vv*(1.d0-bl(1)) zpeu3= vv*(1.d0-bl(2)) else if(ieq.eq.1) then zpel= vv*(sm-enc+xbl(3)+xbl(4)) zpeu1= vv*(sm+enc-xbl(1)-xbl(2)) zpeu2= vv*(enc-xbl(1)) zpeu3= vv*(enc-xbl(2)) endif zpa= dmax1(zpa,zpel) zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) zpap= vv*sct34 zpa= dmax1(zpa,zpap) * *-----test on sp * if(zpb.le.zpa) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif * zpas= zpa-rzm2 zpbs= zpb-rzm2 atpa= (zpas+szgs*zpa)/rzmg atpb= (zpbs+szgs*zpb)/rzmg if(atpa.gt.1.d0.and.atpb.gt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vzmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vzmg spjc0= (-atpb+atpa)/vzmg else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vzmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vzmg spjc0= (-pi+atpb+atpa)/vzmg else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then atpa= 1.d0/atpa atpa= atan(atpa) zpat= (pih-atpa)/vzmg atpb= atan(atpb) zpbt= atpb/vzmg spjc0= (-pih+atpb+atpa)/vzmg else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vzmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vzmg spjc0= (pi-atpb-atpa)/vzmg else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vzmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vzmg spjc0= (atpb-atpa)/vzmg else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then atpa= -1.d0/atpa atpa= atan(atpa) zpat= (-pih+atpa)/vzmg atpb= atan(atpb) zpbt= atpb/vzmg spjc0= (pih+atpb-atpa)/vzmg else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then atpa= atan(atpa) zpat= atpa/vzmg atpb= 1.d0/atpb atpb= atan(atpb) zpbt= (pih-atpb)/vzmg spjc0= (pih-atpb-atpa)/vzmg else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then atpa= atan(atpa) zpat= atpa/vzmg atpb= -1.d0/atpb atpb= atan(atpb) zpbt= (-pih+atpb)/vzmg spjc0= (-pih+atpb-atpa)/vzmg else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then atpa= atan(atpa) zpat= atpa/vzmg atpb= atan(atpb) zpbt= atpb/vzmg spjc0= (atpb-atpa)/vzmg endif * zpv= spjc0*spx+zpat iftn= 1 atnp= vzmg*zpv sp= s0z/vv*(1.d0+szg*s07aaf(atnp,iftn)) if(iftn.ne.0) print 300 if(sp.lt.0.d0) then iz= 0 ifz(5)= ifz(5)+1 go to 1 endif ssp= sqrt(sp) spjc= vv*spjc0 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 * sdlim= rrl(3) sduim1= rrr(3) sduim2= (1.d0-ssu)*(1.d0-ssu) sduim= dmin1(sduim1,sduim2) * *-----limits on sd from Delta_- > 0 * if(ssu.gt.rasup) then sdld= (ssu-rasup)*(ssu-rasup) else sdld= sdlim endif sdud1= (ssu+rasup)*(ssu+rasup) sdud2= (-ssu+rasum)*(-ssu+rasum) sdud= dmin1(sdud1,sdud2) * *-----limits on sd from cuts on SA. Here for maximum security. Rare * if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then if(ss(2).eq.ss(1)) then asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) else if(ss(1).gt.ss(2)) then sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdu= dmin1(sduim,sdud,sdusa) asdl= dmax1(sdlim,sdld) else if(ss(1).lt.ss(2)) then asdu= dmin1(sduim,sdud) sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2)) asdl= dmax1(sdlim,sdld,sdlsa) endif else asdu= dmin1(sduim,sdud) asdl= dmax1(sdlim,sdld) endif if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then if(cs(2).eq.cs(1)) then sdl= asdl sdu= asdu else if(cs(1).gt.cs(2)) then sdu= asdu sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdl= dmax1(asdl,sdlsb) else if(cs(1).lt.cs(2)) then sdl= asdl sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2)) sdu= dmin1(asdu,sdusb) endif else sdl= asdl sdu= asdu endif * if(ieq.eq.0) then sdenl= -1.d0+bl(1)+bl(4)+su sdenu1= 1.d0-sp-bl(2) sdenu2= 1.d0-sm-bl(3) sdenu3= 1.d0-bl(2)-bl(3)+su else if(ieq.eq.1) then sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) sdenu1= enc-sp-xbl(2) sdenu2= enc-sm-xbl(3) sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3) endif sdl= dmax1(sdl,sdenl) sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) sdl= dmax1(sdl,sct14) * *-----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(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) the O pl$ O eru= 1.d0-ek2*es2pu# O else if(it.eq.2) then . O es2pl= (sfl-es2)/(sfl-es1)/ek. O es2pu= (sfu-es2)/(sfu-es1)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu O endifd% O if(eql.eq.1.d0) then. O sflt= 0.d0 O else  O ifel= 1m/ O sflt= 2.d0*dog*sqrt(es2pl)*u2 O # s21bbf(eql,erl,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(24)= ifz(24)+1c O go to 2 O endif  O endif% O if(equ.eq.1.d0) thend O sfut= 0.d0 O else  O ifel= 1 ? O if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) thens O equ= 0.d0 O endifd/ O sfut= 2.d0*dog*sqrt(es2pu)* 2 O # s21bbf(equ,eru,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(25)= ifz(25)+1  O go to 2 O endifl O endif* O sft= (sfut-sflt)*sfx+sflt O ifel= 1# O asf= 0.5d0/dog*sft 8 O call s21caf(asf,ek2,elsn,elcn,edn,ifel)! O elsn2= elsn*elsna# O if(ifel.ne.0) then1 O iz= 0 & O ifz(26)= ifz(26)+1 O go to 2  O endif! O if(it.eq.1) then-: O sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)& O else if(it.eq.2) then: O sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) O endif' O sfjc= efac*(sfut-sflt)1 O endif O *  O *-----auxiliary quantities  O *s O sdpf= sd+sf O e3= sp+su+sf1 O e4= 1.d0+spmm-e3d O e3p4= 1.d0+spmm O e1= sm+sdpf O e2= 1.d0+smmp-e1-( O e1p2= 1.d0+smmp $ O e1p3= e1+e3 0 O e1m2= 2.d0*e1-1.d0+spmm  O ep12= xp*e1*e2d O ep1= xp*e1- O ep2= xp*e2  O ep3= xp*e3 O  O ep4= xp*e4  O e1t2= e1*e2 O e1t3= e1*e3 O e1t4= e1*e4 O e2t3= e2*e3 O e2t4= e2*e4 O e3t4= e3*e4/ O if((e1p3*e1p3-4.d0*sf).lt.0.d0) then  O iz= 0! O ifz(27)= ifz(27)+1  O go to 2 O endif( O skl2= sqrt(e1p3*e1p3-4.d0*sf)+ O if((sdmus-4.d0*sd).lt.0.d0) theni O iz= 0! O ifz(28)= ifz(28)+1 O  O go to 2 O endif O skl3= sdmus-4.d0*sd O skl3= sqrt(skl3)m O *f O *-----initialization of t_wu O *,) O *-----limits on tw from positivity and SAo O *A O twlp1= 0.d0 O twlp2= smmp O twlp3= spmm-1.d0() O twlp= dmax1(twlp1,twlp2,twlp3)a O twup= 1.d0 O  O * " O *-----limits on tw from cuts on SA O *) O if(iac(3).ne.0) thenc& O skl2m= 0.5d0*(e1p3-skl2)& O skl2p= 0.5d0*(e1p3+skl2), O skl3p= -0.5d0*(1.d0+sdmu-skl3), O skl3m= -0.5d0*(1.d0+sdmu+skl3), O twlsa1= 1.d0-cs(3)*e3-cs(4)*e4' O twlsa2= ss(1)*e1+ss(2)*e2 8 O twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m4 O twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m4 O twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p8 O twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m, O twusa1= 1.d0-ss(3)*e3-ss(4)*e4' O twusa2= cs(1)*e1+cs(2)*e2t8 O twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m4 O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,u( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,4( O # twusa5,twusa6) O elses O atwl= twlp O atwu= twup O endif O *# O *-----limits on tw from Es O *c O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2)s" O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1))% O atwle2= bxe*e2-bl(2)-* O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2) 1 O twue= dmin1(atwle,atwue1,atwue2)s O endif)$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *  O *-----natural limits on tw O * O # O atwl= dmax1(atwl,bt1(1))f# O atwu= dmin1(atwu,bt2(1))  O *3 O *-----test on tw O *f O if(atwu.le.atwl) then O iz= 0- O ifz(29)= ifz(29)+1 O go to 2e O endif O *  O twjc= atwu-atwl O tw= twjc*twx+atwl O pn= tw+sp-1.d0f O omtw= 1.d0-tw O *  O *-----initialization of t1 O *a% O *-----limits on t1 from positivity+SAu O *f O t1lp1= 0.d0 O t1lp2= pn+sdpfo O t1up1= tw O t1up2= sm+sdpfn# O t1lp= dmax1(t1lp1,t1lp2)e# O t1up= dmin1(t1up1,t1up2)h O * O " O *-----limits on t1 from cuts on SA O *  O if(iac(3).ne.0) then) O t1lc1= ss(1)*e1 O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) 5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)*/ O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3s4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1 O O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))t5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3f4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else  O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E  O *  O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1))" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif($ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O **4 O *-----positivity of (R')^2 / reality of roots for t3 O *s! O rp0= e1p2*e1p2-4.d0*sms O if(rp0.lt.0.d0) thens O iz= 0 O ifz(30)= ifz(30)+1 O go to 2  O endif O srp0= sqrt(rp0) O rp0e= -rp0l, O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1 & O rp2= -(e1*tw-sm)*(e1*tw-sm) O if(rp0e.eq.0.d0) then O iz= 0+ O ifz(31)= ifz(31)+1 O go to 2l O endif O ifct= 0 O if(rp0e.ne.0.d0) then7 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct)l/ O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1))% O else if(rp0e.eq.0.d0) then  O sret1= -rp2/rp1e# O if(rp1e.gt.0.d0) then+' O t1l= dmax1(at1l,sret1). O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1) O  O endif+ O endif O *t O *-----test on t1 O *  O if(t1u.le.t1l) then O iz= 0z O ifz(31)= ifz(31)+1 O go to 2v O endif O * ! O *-----transformation for jacobian O  O * O if(rp0e.eq.0.d0) then0 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)0 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-tauli9 O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e2 O endif" O if(ret1(1).eq.t1l) then O at1tl= -pih/srp0 O else O 0 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) O ifas= 1f- O at1tl= -s09aaf(bt1tl,ifas)/srp0i% O if(ifas.ne.0) print 2001 O endif" O if(ret2(1).eq.t1u) then O at1tu= pih/srp01 O else 1 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)2 O ifas= 1 O - O at1tu= -s09aaf(bt1tu,ifas)/srp0,% O if(ifas.ne.0) print 200) O endif) O if((at1tl+at1tu).eq.0.d0) then1# O if(t1x.lt.1.d-3) then  O arc= pi*t1x O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc/ O else if((1.d0-t1x).lt.1.d-3) then1# O arc= pi*(1.d0-t1x)  O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc O else" O carc= cos(pi*t1x)- O t1= 0.5d0*(ret1(1)+ret2(1))+11 O # 0.5d0*(ret1(1)-ret2(1))*carcp O endifs O t1jc= pi/srp0q O else & O t1tl= dmin1(at1tl,at1tu)& O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tln O t1t= t1jc*t1x+t1tl. O t1= (rp1+rpds*sin(srp0*t1t))/rp0 O endif O t1s= t1*t1  O * 1 O 200 format(' Unsuccesful call to S09AAF ')  O *  O *-----test on t1 from FS A O * / O if(ieq.eq.1.and.iac(4).ne.0.d0) thenf/ O cnlct1= xp*(xm*sm-ep12*cg12)+xdf*s7 O # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1-z+ O # xdf*tw)+xdfs*cg12*t1sd/ O cnlst1= xp*(ep12*sg12-xm*sm)-xdf*D7 O # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+.+ O # xdf*tw)-xdfs*sg12*t1ss% O if(cnlct1.lt.0.d0) then  O iz= 0# O ifz(32)= ifz(32)+1  O go to 2* O else if(cnlst1.lt.0.d0) then O iz= 0# O ifz(33)= ifz(33)+1d O go to 2 O endif O  O endif O *p O *-----some vector components O *c O t2= tw-t1c O *  O *-----equation for xi is solved  O *s O e1s= e1*e1  O e2s= e2*e2- O e3s= e3*e3  O e12= e1t2-2.d0*sm O e13= e1t3-2.d0*sf O e23= e2t3-2.d0*su O e12s= e12*e12 O e13s= e13*e13 O e23s= e23*e23 O xia= e1s*e2s-e12s= O xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- < O # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ O # e2*e12*e13= O xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* > O # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0*< O # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1*> O # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s*< O # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*; O # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23  O xib= 2.d0*xib! O if(xia.eq.0.d0) then $ O if(xib.eq.0.d0) then O iz= 0% O ifz(34)= ifz(34)+1e O go to 2 O endif O rtm(1)= -xic/xib O rtp(1)= rtm(1) O rtm(2)= 0.d0 O rtp(2)= 0.d0 O ixia= 0  O elses O ixia= 1t O ifc0= 0i5 O call c02ajf(xia,xib,xic,rtm,rtp,ifc0)  O endif$ O if(rtm(2).ne.0.d0) then O iz= 0 " O ifz(35)= ifz(35)+1 O go to 2 O  O endif O *c O *-----xi^+ and xi^- are computed O * # O xip= 0.5d0*(e3-rtp(1)) # O xim= 0.5d0*(e3-rtm(1))  O * . O *-----each integral becomes a sum of two terms O *l O *-----loop over ix starts here O */ O if(om.eq.'g') then O ixmn= ix0 O ixmx= ix0 O else O ixmn= 1 O ixmx= 2 O endif  O do ixmn,ixmx  O * ) O *-----q_3 is compared and x15 is selected  O *n" O if(ix.eq.1) then O t3= xip' O else if(ix.eq.2) then  O t3= xim O endif  O * % O *-----The two integrands are computed  O *r" O *-----further auxiliary quantities O *a O edn1= ep1-xdf*t1* O edn2= ep2-xdf*t2  O edn3= ep3-xdf*t3 O  O t4= omtw-t3 O edn4= ep4-xdf*t4  O *(% O *-----collections of all limits on t3 O  O * % O *-----from energy (or natural limits)  O * O if(ieq.eq.1) then* O at3l1= omtw-bxe*e4+bl(4)% O at3u1= bxe*e3-bl(3) & O if(xdf.gt.0.d0) then O t3l1= at3l1 O t3u1= at3u1+ O else if(xdf.lt.0.d0) then O t3l1= at3u1 O t3u1= at3l1 O endif  O elsee O t3l1= 0.d0 O t3u1= e3 O endif O *j O *-----natural limits O * . O t3l2= -t1+0.5d0*(e1p3-skl2). O t3u2= -t1+0.5d0*(e1p3+skl2) O * 7 O t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3)d7 O t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)e O *i O *-----from positivity on SAi O *f O t3l4= 0.d0 $ O t3l5= sm+su+sf-tw! O t3u4= sp+su+sf  O t3u5= omtw  O * *-----from SAd O * O ' O if(iac(3).ne.0) thene# O t3l6= ss(3)*e3=# O t3u6= cs(3)*e3 ( O t3l7= omtw-cs(4)*e4( O t3u7= omtw-ss(4)*e44 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,/ O # t3l5,t3l6,t3l7) O 4 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,/ O # t3u5,t3u6,t3u7)e O else 9 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) 9 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)  O endif O * O  O *-----limits on t3 are imposed O * , O tlimt3= (t3u-t3)*(t3-t3l)& O if(t3u.lt.t3l) then O iz= 0u( O ifz(36)= ifz(36)+1 O go to 4e/ O else if(tlimt3.lt.0.d0) then  O iz= 0e( O ifz(36)= ifz(36)+1 O go to 4  O endif O * , O *-----non linear limits on t3,t4 are imposed O * 4 O if(iac(4).ne.0.and.ieq.eq.1) then3 O tnl13c= -cg13*edn1*edn3+vv*sf 2 O tnl13s= sg13*edn1*edn3-vv*sf3 O tnl23c= -cg23*edn2*edn3+vv*su.2 O tnl23s= sg23*edn2*edn3-vv*su3 O tnl14c= -cg14*edn1*edn4+vv*sdz2 O tnl14s= sg14*edn1*edn4-vv*sd* O sres= 1.d0-e1-e3+sf 5 O tnl24c= -cg24*edn2*edn4+vv*sresc4 O tnl24s= sg24*edn2*edn4-vv*sres3 O tnl34c= -cg34*edn3*edn4+vv*spe2 O tnl34s= sg34*edn3*edn4-vv*sp= O if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. = O # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or.k= O # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. = O # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. ? O # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then O  O iz= 0+ O ifz(37)= ifz(37)+1e O go to 4+ O endif . O endif O *u: O *-----non linear constraints from FS A in the case xp = xm O * 7 O if(iac(4).ne.0.d0.and.ieq.eq.0) then . O smr= 1.d0-sm-sp-su-sd-sf; O spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm)l; O spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf)#; O spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) ; O spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) = O spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr)o; O spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) M O if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. N O # spc14.lt.0.d0.or.spc23.lt.0.d0.or. = O # spc24.lt.0.d0.or.spc34.lt.0.d0) then  O iz= 0+ O ifz(38)= ifz(38)+1 O go to 4 O endif  O endif O *  O *-----all invariants O *  O x13= t1 O x14= t2 O x15= t3 O x16= t4 O x23= e1-t1- O x24= e2-t2i O x25= e3-t3d O x26= e4-t4  O x34= sm O x35= sf O x36= sd O x45= su' O x46= 1.d0-e1-e3+sf( O x56= sp O *  O *-----computes cross-section O *fB O *-----born matrix element is calculated at the reduced c.m. energy O *l, O *-----The epsilons are computed in the order9 O * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4),s9 O * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), 9 O * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4),i9 O * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4),=8 O * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) O *d" O x13s= x13*x13" O x14s= x14*x14" O x15s= x15*x15" O x16s= x16*x16" O x23s= x23*x23" O x24s= x24*x24" O x25s= x25*x25" O x26s= x26*x26" O x34s= x34*x34" O x35s= x35*x35" O x36s= x36*x36" O x45s= x45*x45" O x46s= x46*x46" O x56s= x56*x56G O * > O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+A O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s > O ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+A O # x15*x23*x35)-x13s*x25s-x15s*x23s-x35ss> O ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+A O # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s B O ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+A O # x14*x15*x34*x35)-x13s*x45s-x14s*x35s-o% O # x15s*x34s(B O ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+A O # x24*x25*x34*x35)-x23s*x45s-x24s*x35s-d% O # x25s*x34s1G O *  O e(1)= 1.d0 F O e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*E O # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14*4C O # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35sE O e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-2F O # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-D O # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45F O e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*G O # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14*sF O # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 G O e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* C O # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* D O # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+$ O # x25*x34s O *  O *-----sign of eps_1*eps_ib O *) O ises= 0" O sg(1)= 0.25d0+ O if(ee(1).lt.0.d0) thena$ O ises= ises+1 O endif O do i=2,5w2 O if(abs(e(i)).lt.zrm) then( O ises= ises+12 O else if(e(i).gt.zrm) then) O sg(i)= 0.25d0,3 O else if(e(i).lt.-zrm) thent* O sg(i)= -0.25d0 O endif/ O if(ee(i).lt.0.d0) then ( O ises= ises+1 O endif O enddo O *)' O if(ises.eq.0) theni/ O ses1= sg(1)*sqrt(ee(1)) / O ses2= sg(2)*sqrt(ee(2))e/ O ses3= sg(3)*sqrt(ee(3))l/ O ses4= sg(4)*sqrt(ee(4))+/ O ses5= sg(5)*sqrt(ee(5))t O s1= ses1 O s2= ses2& O s3= -ses1-ses2 O s4= ses3% O s5= ses1-ses3l% O s6= ses2+ses3= O s7= ses4% O s8= ses1-ses4 % O s9= ses2+ses4 & O s10= ses3-ses4! O s11= ses5(' O s12= -ses1-ses5 ' O s13= -ses2+ses5m' O s14= -ses3-ses53' O s15= -ses4-ses55 O else4A O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ O D O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sA O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+=D O # x16*x23*x36)-x13s*x26s-x16s*x23s-x36sA O ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+cD O # x16*x24*x46)-x14s*x26s-x16s*x24s-x46sE O ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+pD O # x14*x16*x34*x36)-x13s*x46s-x14s*x36s-( O # x16s*x34sE O ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+tE O # x24*x26*x34*x36)-x23s*x46s-x24s*x36s-f) O # x26s*x34se" O e(1)= 1.d0> O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+B O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-C O # x14*x16*x23s+x14*x23*x36+x16*x23*x34--2 O # x13s*x24*x26-x34*x36@ O e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*@ O # x24*x46-x14*x16*x23*x24+x14*(-x23*@ O # x46+2.d0*x24*x36-x26*x34)-x16*x24*6 O # x34+x14s*x23*x26+x34*x46@ O e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*? O # x34)+x13*x16*x24*x34+x13*x34*x46+ > O # x14*x16*x23*x34+x14*x34*x36-x16*= O # x34s-x13s*x24*x46-x14s*x23*x36 @ O e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*> O # x24s)+x14*(-x23*x24*x36-x23*x26*A O # x34+x46*x23s)+x16*2.d0*x23*x24*x34- > O # x23*x34*x46-x24*x34*x36+x26*x34s O ises= 0)% O sg(1)= 0.25d0l. O if(ee(1).lt.0.d0) then' O ises= ises+1  O endif O do i=2,55 O if(abs(e(i)).lt.zrm) then O + O ises= ises+1 5 O else if(e(i).gt.zrm) then , O sg(i)= 0.25d06 O else if(e(i).lt.-zrm) then- O sg(i)= -0.25d0*! O endifr2 O if(ee(i).lt.0.d0) then+ O ises= ises+1a! O endif O  O enddoh* O if(ises.eq.0) then2 O ses1= sg(1)*sqrt(ee(1))2 O ses2= sg(2)*sqrt(ee(2))2 O ses3= sg(3)*sqrt(ee(3))2 O ses4= sg(4)*sqrt(ee(4))2 O ses5= sg(5)*sqrt(ee(5))# O s1= ses1-) O s2= -ses1-ses2 # O s3= ses2f) O s4= -ses1-ses3e# O s5= ses3 ) O s6= -ses2-ses3 ( O s7= ses1-ses4# O s8= ses4 ) O s9= -ses2-ses4(* O s10= -ses3+ses4* O s11= -ses1-ses5$ O s12= ses5) O s13= ses2-ses5.) O s14= ses3+ses5t) O s15= ses4+ses5  O elseD O ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+C O # x15*x23*x35)-x13s*x25s-x15s*x23s-l& O # x35sD O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+C O # x16*x23*x36)-x13s*x26s-x16s*x23s-c& O # x36sD O ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+C O # x16*x25*x56)-x15s*x26s-x16s*x25s- & O # x56sD O ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*A O # x56+x15*x16*x35*x36)-x13s*x56s- O 5 O # x15s*x36s-x16s*x35s D O ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*A O # x56+x25*x26*x35*x36)-x23s*x56s-c5 O # x25s*x36s-x26s*x35sfG O * A O e(1)= x13*x14*x23*x25+x13*x15*x23*x24+tE O # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- B O # x14*x15*x23s+x14*x23*x35+x15*x23*9 O # x34-x13s*x24*x25-x34*x35 O A O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+pE O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-aB O # x14*x16*x23s+x14*x23*x36+x16*x23*9 O # x34-x13s*x24*x26-x34*x362B O e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+D O # x13*(-x25*x46+x26*x45)+x14*x15*x23*F O # x26-x14*x16*x23*x25+x14*(x25*x36-x26*F O # x35)+x15*(-x23*x46+x24*x36)+x16*(x23*= O # x45-x24*x35)+x35*x46-x36*x45 O C O e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15*#E O # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ D O # x25*x34)+x13*(x35*x46-x36*x45)-x14*E O # x15*x23*x36+x14*x16*x23*x35+x15*x34*.D O # x36-x16*x34*x35+x13s*(-x25*x46+x26*% O # x45)bG O e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25*.D O # x36-x24*x26*x35)+x15*(-x23*x24*x36-D O # x23*x26*x34+x46*x23s)+x16*(x23*x24*C O # x35+x23*x25*x34-x45*x23s)-x23*x35* E O # x46+x23*x36*x45-x25*x34*x36+x26*x34* O $ O # x35 O * " O ises= 0# O do i=1,5,8 O if(abs(e(i)).lt.zrm) then. O ises= ises+18 O else if(e(i).gt.zrm) then/ O sg(i)= 0.25d0 O 9 O else if(e(i).lt.-zrm) then 0 O sg(i)= -0.25d0$ O endif5 O if(ee(i).lt.0.d0) then . O ises= ises+1$ O endif O enddo- O if(ises.eq.0) thens5 O ses1= sg(1)*sqrt(ee(1))f5 O ses2= sg(2)*sqrt(ee(2)) 5 O ses3= sg(3)*sqrt(ee(3))=5 O ses4= sg(4)*sqrt(ee(4))r5 O ses5= sg(5)*sqrt(ee(5))i, O s1= -ses1-ses2& O s2= ses1& O s3= ses2, O s4= -ses1+ses3, O s5= -ses2-ses3& O s6= ses3, O s7= -ses1+ses4, O s8= -ses2-ses4& O s9= ses4, O s10= ses3-ses4, O s11= ses1+ses5, O s12= ses2-ses5' O s13= ses5 O - O s14= -ses3-ses5 - O s15= -ses4-ses5  O else # O iz= 0-0 O ifz(39)= ifz(39)+1% O go to 4 O endif O endif1 O endif O * ( O tgn(1)= x14/x25/x36) O tgn(2)= x14*x25*x36 O ) O tgn(3)= x24/x15/x36 ) O tgn(4)= x15*x24*x36 1 O tgn(5)= x14/x24/x34/x45*x46 1 O tgn(6)= x14/x24/x34*x45/x46(1 O tgn(7)= x14/x24*x34/x45*x46=1 O tgn(8)= x14/x24*x34*x45/x46 1 O tgn(9)= x14*x24/x34/x45*x46t2 O tgn(10)= x14*x24/x34*x45/x462 O tgn(11)= x45*x46/x15/x25/x342 O tgn(12)= x45/x15/x25/x34/x462 O tgn(13)= x34*x45/x15/x25/x462 O tgn(14)= x25*x46/x15/x34/x452 O tgn(15)= x25*x45/x15/x34/x462 O tgn(16)= x15/x25/x34*x45/x462 O tgn(17)= x25/x15/x34*x45*x462 O tgn(18)= x25*x34*x45/x46/x152 O tgn(19)= x15/x25/x34*x45*x462 O tgn(20)= x15/x25*x34*x45/x462 O tgn(21)= x15*x25*x34/x45*x461 O tgn(22)= x34/x15/x25/x45/x46.1 O tgn(23)= x15/x25*x34/x45*x46 1 O tgn(24)= x34/x14/x24*x45/x46 1 O tgn(25)= x14/x24*x34/x45/x46-1 O tgn(26)= x24/x14*x34*x45/x46 1 O tgn(27)= x14*x24*x34/x45/x46 1 O tgn(28)= x34/x14/x24*x45*x46+) O tgn(29)= x15/x24/x36e. O tgn(30)= 1.d0/x14/x25/x36) O tgn(31)= x14/x25*x36 . O tgn(32)= 1.d0/x15/x24/x362 O tgn(33)= 1.d0/x14/x15/x24/x25. O tgn(34)= 1.d0/x14*x25/x36) O tgn(35)= x15*x24/x36 ) O tgn(36)= x14*x25/x36 O 2 O tgn(37)= 1.d0/x14*x15*x24/x25- O tgn(38)= x14/x15/x24*x25+: O tgn(39)= 1.d0/x24/x25*x34/x36/x45/x465 O tgn(40)= x24/x25*x34/x36/x45/x46d: O tgn(41)= 1.d0/x24*x25*x34/x36/x45*x466 O tgn(42)= 1.d0/x14/x24*x34/x45*x466 O tgn(43)= 1.d0/x14*x24*x34/x45*x46: O tgn(44)= 1.d0/x24/x25*x34/x36*x45/x46) O tgn(45)= x36/x15/x24  O *  O itgn= 0 O do l=1,450 O if(tgn(l).le.0.d0) then( O itgn= itgn+1 O endif O enddo' O if(itgn.ne.0) then  O iz= 0)* O ifz(40)= ifz(40)+1 O go to 4  O endif O *t& O gh1= sqrt(tgn(1))& O gh2= sqrt(tgn(2))& O gh3= sqrt(tgn(3))& O gh4= sqrt(tgn(4))& O gh5= sqrt(tgn(5))& O gh6= sqrt(tgn(6))& O gh7= sqrt(tgn(7))& O gh8= sqrt(tgn(8))& O gh9= sqrt(tgn(9))( O gh10= sqrt(tgn(10))( O gh11= sqrt(tgn(11))( O gh12= sqrt(tgn(12))( O gh13= sqrt(tgn(13))( O gh14= sqrt(tgn(14))( O gh15= sqrt(tgn(15))( O gh16= sqrt(tgn(16))( O gh17= sqrt(tgn(17))( O gh18= sqrt(tgn(18))( O gh19= sqrt(tgn(19))( O gh20= sqrt(tgn(20))( O gh21= sqrt(tgn(21))( O gh22= sqrt(tgn(22))( O gh23= sqrt(tgn(23))( O gh24= sqrt(tgn(24))( O gh25= sqrt(tgn(25))( O gh26= sqrt(tgn(26))( O gh27= sqrt(tgn(27))( O gh28= sqrt(tgn(28))( O gh29= sqrt(tgn(29))( O gh30= sqrt(tgn(30))( O gh31= sqrt(tgn(31))( O gh32= sqrt(tgn(32))( O gh33= sqrt(tgn(33))( O gh34= sqrt(tgn(34))( O gh35= sqrt(tgn(35))( O gh36= sqrt(tgn(36))( O gh37= sqrt(tgn(37))( O gh38= sqrt(tgn(38))( O gh39= sqrt(tgn(39))( O gh40= sqrt(tgn(40))( O gh41= sqrt(tgn(41))( O gh42= sqrt(tgn(42))( O gh43= sqrt(tgn(43))( O gh44= sqrt(tgn(44))( O gh45= sqrt(tgn(45)) O * # O x45i= 1.d0/x45  O *  O *-----Helicity he1-2)  O * # O *-----Higgs Bremsstrahlung diagram:  O * - O hb12r= 4.d0*(gh7*x25+gh26*x16-gh27*x56-x O # gh28)& O hb12i= 16.d0*(-s5*gh24+s14*gh25) O hb1r= 4.d0*hch(7)*hb12r  O hb1i= 4.d0*hch(7)*hb12i  O hb2r= 4.d0*hch(8)*hb12r  O hb2i= -4.d0*hch(8)*hb12i O *  O *-----Higgs Fusion diagram:0 O *14 O hf12cr= 4.d0*(-gh7*x25-gh26*x16+gh27*x56+gh28)' O hf12ci= 16.d0*(s5*gh24-s14*gh25) O ! O hf1r= 0.25d0*ver*ver*hf12cr1! O hf1i= 0.25d0*ver*ver*hf12ci ! O hf2r= 0.25d0*vel*vel*hf12cr3" O hf2i= -0.25d0*vel*vel*hf12ci O *  O *-----Helicity he3-4)1 O *2# O *-----Higgs Bremsstrahlung diagram: G O * (/ O hb34r= 4.d0*(-gh4+gh29*(x23*x46-x26*x34))# O hb34i= -16.d0*s12*gh29 O hb3r= 4.d0*hch(7)*hb34r O  O hb3i= 4.d0*hch(7)*hb34is O hb4r= 4.d0*hch(8)*hb34r( O hb4i= -4.d0*hch(8)*hb34i O *3 O *-----Higgs Fusion diagram:  O * / O hf34r= 4.d0*(gh4+gh29*(-x23*x46+x26*x34))  O hf34i= 16.d0*s12*gh291 O hf3r= 0.25d0*ver*ver*hf34r O hf3i= 0.25d0*ver*ver*hf34i O hf4r= 0.25d0*vel*vel*hf34r! O hf4i= -0.25d0*vel*vel*hf34ix O *x O *-----Helicity he5-6)x O *x# O *-----Higgs Bremsstrahlung diagram: G O * x2 O hb56r= 4.d0*(-gh13*x16*x25+gh22*x14*x25*x56- O # gh23*x25) O hb56i= 16.d0*s10*gh22*x255 O hb5r= 4.d0*hch(5)*hb56rx O hb5i= 4.d0*hch(5)*hb56id O hb6r= 4.d0*hch(6)*hb56r  O hb6i= -4.d0*hch(6)*hb56i O *3 O *-----Helicity he7-8)  O * # O *-----Higgs Bremsstrahlung diagram:-G O * 42 O hb78r= 4.d0* h30*(x13*x25*x46-x16*x25*x34)- O # gh31*x25) O hb78i= 16.d0*s8*gh30*x25 O hb7r= 4.d0*hch(5)*hb78r4 O hb7i= 4.d0*hch(5)*hb78i# O hb8r= 4.d0*hch(6)*hb78rx O hb8i= -4.d0*hch(6)*hb78i O *  O *-----Helicity he9-10) O ** O *-----Higgs Fusion diagram:3G O * _F O hf910r= 2.d0*(gh3*(x13*x56-x16*x35)-gh4+gh29*(-x23*x46+x26*x34)+B O # 2.d0*gh32*x45i*x14*x25*(x34*x56-x35*x46)+gh32*(x13*x25*x46-C O # x13*x26*x45-x14*x23*x56+x14*x26*x35+x16*x23*x45-x16*x25*x34- D O # x34*x56+x35*x46)+2.d0*gh35*x45i*(-x34*x56+x35*x46)+gh45*(x14* O # x25-x45))D O hf910i= 8.d0*(s2*gh32*x46+2.d0*s4*gh32*x45i*(x34*x56-x35*x46)+9 O # s4*gh45+s6*gh32*x34+s8*gh32*x25-s12*gh29-s15*gh32) ! O hf9r= 0.25d0*ver*vel*hf910r ! O hf9i= 0.25d0*ver*vel*hf910i." O hf10r= 0.25d0*ver*vel*hf910r# O hf10i= -0.25d0*ver*vel*hf910it O *d O *-----Helicity he11-12)  O *  O *-----Higgs Fusion diagram: G O * 7 O hf1112r= 4.d0*(gh7*x25-gh8*x26+gh26*x16-gh43*x15)1& O hf1112i= 16.d0*(s4*gh42-s5*gh24)! O hf11r= 0.25*ver*vel*hf1112r ! O hf11i= 0.25*ver*vel*hf1112i)! O hf12r= 0.25*ver*vel*hf1112rg" O hf12i= -0.25*ver*vel*hf1112i O * ' O *-----compensating single Z propagator  O *  O wpcfr= sp-rzm2/vv  O wpcfi= sp*szg2 O *  O *-----extra propagators  O *s O vrzm2= rzm2/vv O x25z= x25+vrzm2  O x16z= x16+vrzm2  O *1 O *-----complete diagrams: O * $ O hbcf= sqrt(rbqm2/vv)/8.d0/cth4. O hfcf= sqrt(rbqm2/vv)/cth4/8.d0/x16z/x25z O if(omssm.eq.'y') then & O hbcf= -hbcf*sbma*salpha/cbeta& O hfcf= -hfcf*sbma*salpha/cbeta# O alpha1= -salpha/cbeta*sbma1" O alpha2= calpha/cbeta*cbma O alpha21= alpha2/alpha1 8 O propm= (sm-rbhm2/vv)*(sm-rbhm2/vv)+(sm*sbhg)**2@ O addmr= 1.d0+alpha21/propm*((sm-rshm2/vv)*(sm-rbhm2/vv)+ O # sm*sm*sbhg*sshg)H O addmi= alpha21/propm*sm*((sm-rshm2/vv)*sbhg-(sm-rbhm2/vv)*sshg) O else if(omssm.eq.'n') then O addmr= 1.d0 O addmi= 0.d0 O endif  O *  O chb1r= hbcf*rsz*hb1r O chb1re= -hbcf*aisz*hb1i " O chb1ie= hbcf*rsz*hb1i  O chb1i= hbcf*aisz*hb1r  O *  O chb2r= hbcf*rsz*hb2r O chb2re= -hbcf*aisz*hb2i " O chb2ie= hbcf*rsz*hb2i  O chb2i= hbcf*aisz*hb2rp O *  O chb3r= hbcf*rsz*hb3r O chb3re= -hbcf*aisz*hb3is" O chb3ie= hbcf*rsz*hb3i  O chb3i= hbcf*aisz*hb3r  O *  O chb4r= hbcf*rsz*hb4r O chb4re= -hbcf*aisz*hb4i " O chb4ie= hbcf*rsz*hb4i  O chb4i= hbcf*aisz*hb4r  O *# O chb5r= hbcf*rsz*hb5r O chb5re= -hbcf*aisz*hb5i " O chb5ie= hbcf*rsz*hb5i  O chb5i= hbcf*aisz*hb5r1 O *2 O chb6r= hbcf*rsz*hb6r O chb6re= -hbcf*aisz*hb6i4" O chb6ie= hbcf*rsz*hb6i  O chb6i= hbcf*aisz*hb6r3 O *6 O chb7r= hbcf*rsz*hb7r O chb7re= -hbcf*aisz*hb7ix" O chb7ie= hbcf*rsz*hb7i  O chb7i= hbcf*aisz*hb7r4 O *1 O chb8r= hbcf*rsz*hb8r O chb8re= -hbcf*aisz*hb8i1" O chb8ie= hbcf*rsz*hb8i  O chb8i= hbcf*aisz*hb8r- O ** O chf1r= hfcf*wpcfr*hf1r O chf1re= -hfcf*wpcfi*hf1i$ O chf1ie= hfcf*wpcfr*hf1i  O chf1i= hfcf*wpcfi*hf1r O *# O chf2r= hfcf*wpcfr*hf2r O chf2re= -hfcf*wpcfi*hf2i$ O chf2ie= hfcf*wpcfr*hf2i  O chf2i= hfcf*wpcfi*hf2r O *  O chf3r= hfcf*wpcfr*hf3r O chf3re= -hfcf*wpcfi*hf3i$ O chf3ie= hfcf*wpcfr*hf3i  O chf3i= hfcf*wpcfi*hf3r O *  O chf4r= hfcf*wpcfr*hf4r O chf4re= -hfcf*wpcfi*hf4i$ O chf4ie= hfcf*wpcfr*hf4i  O chf4i= hfcf*wpcfi*hf4r O *  O chf9r= hfcf*wpcfr*hf9r O chf9re= -hfcf*wpcfi*hf9i$ O chf9ie= hfcf*wpcfr*hf9i  O chf9i= hfcf*wpcfi*hf9r O *  O chf10r= hfcf*wpcfr*hf10r O chf10re= -hfcf*wpcfi*hf10i& O chf10ie= hfcf*wpcfr*hf10i  O chf10i= hfcf*wpcfi*hf10r O *5 O chf11r= hfcf*wpcfr*hf11r O chf11re= -hf O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O 1,* O # vvl2,vvl3,ul,omul,sumlF O common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6),A O # ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4), ? O # sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24, = O # cg24,sg34,cg34,sct120,sct130,sct140,sct230, / O # sct240,sct340,sgam(4),cgam(4) D O common/wtmssm/ams,shm,shms,bhm,bhms,sbeta,cbeta,salpha,calpha,? O # sbma,cbma,rshm,rshm2,rshg,rshmg,sshg,sshgs, E O # opsshgs,rbhm,rbhm2,rbhg,rbhmg,sbhg,sbhgs,opsbhgs,n5 O # ram,ram2,rag,ramg,sag,sags,opsags  O *  O dimension hb(4)) O dimension tgn(50)6 O dimension x(ndim)  O dimension bt1(2),bt2(2)  O dimension rru1(2),rru2(2)8 O dimension sfur(2),sflr(2)t O dimension ret1(2),ret2(2)1 O dimension ee(5),e(5),sg(5)% O dimension rrr(6),rrl(6),srrl(6) ( O dimension bl(4),xbl(4),ss(4),cs(4)) O dimension dpxs(2,2),cpxs(2),bpxs(2) 9 O dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2)g O *54 O data ec2/-0.4999999963d0/,ec4/0.0416666418d0/,4 O # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, O # ec10/-0.0000002605d0/ O * # O external c02ajf,s09aaf,s07aaf  O external s21bbf,s21caf O * " O *-----the order of integration is:5 O * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1  O * 6 O * m_{+/-}^2 transformed for the resonating peaks6 O * M_0^2,m_0^2 transformed for the resonating peaks4 O * m^2 and t_1 transformed for the jacobian peaks O *g O s0h= rhm2/opshgs O if(omssm.eq.'y') theng O s0sh= rshm2/opsshgs O endif( O *) O do ix=1,2  O do it=1,2! O dpxs(ix,it)= 0.d0( O enddo O enddo  O do it=1,2  O cpxs(it)= 0.d0( O bpxs(it)= 0.d0 O enddo( O *( O if(ndim.eq.6) then O smx= x(1) O sux= x(2) O sdx= x(3) O sfx= x(4) O twx= x(5) O t1x= x(6) O else if(ndim.eq.7) then  O smx= x(1) O spx= x(2) O sux= x(3) O sdx= x(4) O sfx= x(5) O twx= x(6) O t1x= x(7) O else if(ndim.eq.8) then  O uvx= x(1) O vvx= x(2) O smx= x(3) O sux= x(4) O sdx= x(5) O sfx= x(6) O twx= x(7) O t1x= x(8) O else if(ndim.eq.9) then O  O uvx= x(1) O vvx= x(2) O smx= x(3) O spx= x(4) O sux= x(5) O sdx= x(6) O sfx= x(7) O twx= x(8) O t1x= x(9) O endif  O *0 O ik= ik+1 rs= ars0 O one= 1.d0  O * ( O *-----if a point is not allowed then the O * result is set to zerof O *r O iz= 1x O *g% O if(ndim.eq.6.or.ndim.eq.7) then6 O ueps= 0.d0) O uv= 1.d05 O uvs= uv*uv  O ujc= 1.d0 O veps= 0.d0f O vv= 1.d0h O vjc= 1.d0* O else if(ndim.eq.8.or.ndim.eq.9) then O *4, O *-----independent invariants are initialized O * first u and v variable O *  O if(itc.eq.3) then? O omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm)) # O omul= dmin1(omul,omuld)  O endif O if(uvx.gt.1.d0) then4 O iz= 00 O ifz(1)= ifz(1)+1 O go to 1 O  O endif% O ueps= omul*(1.d0-uvx)**hbeti4 O uv= 1.d0-ueps O ujc= omul**hbet O uvs= uv*uv. O *0 O *-----limits for v O *f O *-----from equal cuts on SA  O *f+ O if(iac(3).eq.1.and.isab.eq.1) then*' O vvl4= ombsa(1)/opbsa(1)*uvsx+ O vvl= dmax1(vvl1,vvl2,vvl3,vvl4) else & O vvl= dmax1(vvl1,vvl2,vvl3) O endif O * O *-----from E O *h O vve= uv*(2.d0*suml-uv)  O vvll= dmax1(vvl,vve)= O *. O if(itc.eq.3) then: O vvlld= (dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm))# O vvll= dmax1(vvll,vvlld)  O endif O * O  O vvu1= uvh+ O if(iac(3).eq.1.and.isaa.eq.1) thenm' O vvu2= omasa(1)/opasa(1)*uvs ! O vvu= dmin1(vvu1,vvu2) O elsed O vvu= uvx O endif O uvl= uv-vvll  O *  O vkf= (uv-vvu)/uvl O if(vkf.lt.0.d0) then  O iz= 05 O ifz(1)= ifz(1)+1 O go to 1i" O else if(vkf.eq.0.d0) then O if(vvx.gt.1.d0) then O iz= 0 O ifz(1)= ifz(1)+1  O go to 1% O else if(vvx.eq.1.d0) then6 O veps= 0.d06 O else) O veps= uvl*(1.d0-vvx)**hbetih O endif  O avkf= 1.d0 else58 O veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti O avkf= 1.d0-vkf**hbet O endif O vv= uv-veps O vjc0= 1.d0-vvll/uv2 O if(vjc0.le.0.d0) then O iz= 04 O ifz(1)= ifz(1)+1 O go to 10 else O vjc= vjc0**hbet*avkf O endif O endife O *f O if(vv.lt.0.d0) thenv O iz= 0 O ifz(1)= ifz(1)+1  O go to 1 O endifm O svv= sqrt(vv)  O vzmg= rzmg*vv  O vhmg= rhmg*vv  O vshmg= rshmg*vv2 O vvs= vv*vv O xm= uv O xp= vv/uv  O xmop= xm/xpg% O if(ndim.eq.7.or.ndim.eq.6) then* O xdf= 0.d0 O else( O xdf= (ueps*(1.d0-ueps)-veps)/uv O endif  O xdfs= xdf*xdfh O sh= vv*s O *o O *-----Z parameters O *p O rszm2= zm*zm/shf O *s1 O *-----Z propagator (real part and imaginary part)r O *g O dsz0= 1.d0-rszm2 O dsz= dsz0*dsz0+rszw2 O rsz= dsz0/dsz+ O aisz= -rszw/dsze O *dC O *-----Reduced structure functions are computed with arguments xp,xmr O *2 O opxp= 1.d0+xp2 O opxm= 1.d0+xm. O omxp= veps/uvh O omxm= ueps O if(isf.eq.0) then= O stfp= 1.d0e O stfm= 1.d0- O else if(isf.gt.0) then O if(omxp.eq.0) then  O stfp= d0gl elsep" O rcpx= 0.25d0*opxp*opxp O rcpy= xp O iflp= 1o( O rclp= s21baf(rcpx,rcpy,iflp)3 O stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+p- O # feta*(-4.d0*opxp*log(omxp)+ 7 O # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp))  O endif O if(omxm.eq.0) then1 O stfm= d0gl elsei" O rcmx= 0.25d0*opxm*opxm O rcmy= xm O iflm= 1 O ( O rclm= s21baf(rcmx,rcmy,iflm)3 O stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+ O - O # feta*(-4.d0*opxm*log(omxm)+h7 O # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm))e O endif O endif  O *3 O stf= stfp*stfm O * I O *-----if there is no upper cut on some FS IM, then the maximum is allowedf O *z O do j=1,6 O if(rr(j).eq.1.d0) then O rrr(j)= rr(j) O else O rrr(j)= rr(j)/vvf O endif O  O rrl(j)= rl(j)/vv O srrl(j)= srl(j)/svvr O enddoe O *h& O *-----cuts become special near xp = xm O * ! O if(abs(xdf).gt.1.d-15) then3 O ieq= 1=( O bxe= vv/(ueps*(1.d0-ueps)-veps) O if(xdf.gt.0.d0) then7 O enc= 1.d0h" O else if(xdf.lt.0.d0) then O enc= xmope O endif O else O ieq= 08 O bxe= 1.d0 O endifh% O if(ieq.eq.0.and.xm.le.teq) then O  O iz= 0 O ifz(1)= ifz(1)+1e O go to 1 O endif  O *17 O if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then  O sct12= sct120/vv O  O sct13= sct130/vv2 O sct14= sct140/vv* O sct23= sct230/vv= O sct24= sct240/vv3 O sct34= sct340/vv O else O sct12= 0.d0 O sct13= 0.d0 O sct14= 0.d0 O sct23= 0.d0 O sct24= 0.d0 O sct34= 0.d0 O endif O *  O *-----cuts on E* O *r O do j=1,4 O if(ieq.eq.1) then9# O bl(j)= 2.d0*rae(j)/xdff# O xbl(j)= 2.d0*rae(j)/xpc O else if(ieq.eq.0) then" O bl(j)= 2.d0*rae(j)/xm O endif O enddoc O *p O *-----cuts on SA O *  O if(iac(3).ne.0) then O do j=1,4f% O if(sgam(j).eq.1.d0) thenc O ss(j)= 0.d0* O else O 7 O ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmopc! O ss(j)= 1.d0/ss(j)i O endif% O if(cgam(j).eq.0.d0) theni O cs(j)= 1.d0  O elsea7 O cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop ! O cs(j)= 1.d0/cs(j)  O endif O enddo O endif2 O *a" O *-----initialization of sm = m_-^2 O *d O zma1= dsmc O zma2= vv*sct12 O zmb1= usmi! O zmb2= (svv-sdsp)*(svv-sdsp)a4 O zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) O if(ieq.eq.0) thend$ O zma3= vv*(bl(1)+bl(2)-1.d0)- O zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))*c) O # (1.d0-0.5d0*(bl(3)+bl(4))) O  O zmb5= vv*(1.d0-bl(3)) O zmb6= vv*(1.d0-bl(4)) O else if(ieq.eq.1) then& O zma3= vv*(-enc+xbl(1)+xbl(2))2 O zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))*' O # (1.d0+enc-xbl(3)-xbl(4))e O zmb5= vv*(enc-xbl(3)) O zmb6= vv*(enc-xbl(4)) O endifr! O xzma= dmax1(zma1,zma2,zma3)h0 O xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) O *cC O *-----limits on sm from cuts on SA. Here for maximum security. Rarer O *d O if(iac(3).eq.0) then O zma= xzma O zmb= xzmb O else d4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) then  O szma= xzmai O szmb= xzmbm( O else if(ss(3).gt.ss(1)) then O szmb= xzmbh O adsp= dsp/vv O ( O axszma= dmax1(adsp,sct34)5 O axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/a% O # (ss(3)-ss(1)))d' O szma= dmax1(axszma,xzma)*( O else if(ss(3).lt.ss(1)) then& O if(ss(3).lt.0.5d0) then O szma= xzma= O axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2f* O szmb= dmin1(axszmb,xzmb) O elser O iz= 0 " O ifz(2)= ifz(2)+1 O go to 1i O endif O endifi else  O szma= xzma O szmb= xzmb O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) then  O zma= szma O zmb= szmb( O else if(cs(3).gt.cs(1)) then& O if(cs(3).gt.0.5d0) then O zma= szmae= O axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2*) O zmb= dmin1(axczmb,szmb)c O else O  O iz= 01" O ifz(3)= ifz(3)+1 O go to 1  O endif( O else if(cs(3).lt.cs(1)) then O zmb= szmbi O adsp= dsp/vv+ O axczma= dmax1(adsp,sct34) O 8 O axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/( O # (cs(3)-cs(1)))) O zma= dmax1(axczma,szma) O  O endifd elsef O zma= szma* O zmb= szmb* O endif O endif  O if(itc.eq.3) then0* O dzmb= (svv-dist/rs)*(svv-dist/rs) O zmb= dmin1(zmb,dzmb)i O endiff O *) O *-----test on sm O *2 O if(zmb.le.zma) then  O iz= 0 O ifz(4)= ifz(4)+1i O go to 1 O endifi O *(! O if(ih.eq.1.or.ih.eq.3) theni O if(omssm.eq.'n') then O rmm2= rhm2 O rmmg= rhmg O smgs= shgs O vmmg= vhmg O smg= shg O s0m= s0h# O else if(omssm.eq.'y') then) O rmm2= rshm2d O rmmg= rshmg O  O smgs= sshgsr O vmmg= vshmg  O smg= sshg) O s0m= s0sh  O endif& O else if(ih.eq.2.or.ih.eq.4) then O rmm2= rzm28 O rmmg= rzmgf O smgs= szgsf O vmmg= vzmgd O smg= szg2 O s0m= s0z O endifi O zmas= zma-rmm2 O zmbs= zmb-rmm2 O atma= (zmas+smgs*zma)/rmmg O atmb= (zmbs+smgs*zmb)/rmmg, O if(atma.gt.1.d0.and.atmb.gt.1.d0) then O atma= 1.d0/atma O atma= atan(atma) O  O zmat= (pih-atma)/vmmg O atmb= 1.d0/atmb O atmb= atan(atmb) O  O zmbt= (pih-atmb)/vmmg! O smjc0= (-atmb+atma)/vmmg.2 O else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then O atma= 1.d0/atma O atma= atan(atma)  O zmat= (pih-atma)/vmmg O atmb= -1.d0/atmbc O atmb= atan(atmb)  O zmbt= (-pih+atmb)/vmmg $ O smjc0= (-pi+atmb+atma)/vmmg6 O else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then O atma= 1.d0/atma O atma= atan(atma)d O zmat= (pih-atma)/vmmg O atmb= atan(atmb)( O zmbt= atmb/vmmg% O smjc0= (-pih+atmb+atma)/vmmg.2 O else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then O atma= -1.d0/atma  O atma= atan(atma)d O zmat= (-pih+atma)/vmmg O  O atmb= 1.d0/atmb O atmb= atan(atmb)  O zmbt= (pih-atmb)/vmmg# O smjc0= (pi-atmb-atma)/vmmg 3 O else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) thenf O atma= -1.d0/atma  O atma= atan(atma)  O zmat= (-pih+atma)/vmmg  O atmb= -1.d0/atmbi O atmb= atan(atmb)' O zmbt= (-pih+atmb)/vmmgi O smjc0= (atmb-atma)/vmmg7 O else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then  O atma= -1.d0/atma O  O atma= atan(atma)m O zmat= (-pih+atma)/vmmgq O atmb= atan(atmb)d O zmbt= atmb/vmmg$ O smjc0= (pih+atmb-atma)/vmmg6 O else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then O atma= atan(atma)d O zmat= atma/vmmg O atmb= 1.d0/atmb O atmb= atan(atmb) O  O zmbt= (pih-atmb)/vmmg$ O smjc0= (pih-atmb-atma)/vmmg7 O else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) thenm O atma= atan(atma)4 O zmat= atma/vmmg O atmb= -1.d0 tmbh O atmb= atan(atmb)  O zmbt= (-pih+atmb)/vmmgx% O smjc0= (-pih+atmb-atma)/vmmg ; O else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then) O atma= atan(atma) O  O zmat= atma/vmmg O atmb= atan(atmb)x O zmbt= atmb/vmmg O smjc0= (atmb-atma)/vmmg O endif  O * O  O zmv= smjc0*smx+zmat iftn= 1  O atnm= vmmg*zmv- O sm= s0m/vv*(1.d0+smg*s07aaf(atnm,iftn))- O if(iftn.ne.0) print 300- O if(sm.lt.0.d0) then O  O iz= 0 O ifz(4)= ifz(4)+1  O go to 1 O endif  O ssm= sqrt(sm)m O smjc= vv*smjc0 O * - O 300 format(/' Unsuccesful call to S07AAF '), O *s" O *-----initialization of sp = m_+^2 O *i O zpa1= dspm O zpb1= usp $ O zpb2= vv*(1.d0-ssm)*(1.d0-ssm) O *sC O *-----limits on sp from cuts on SA. Here for maximum security. Rarei O *s O if(iac(3).eq.0) then O zpb= dmin1(zpb1,zpb2) O zpa= zpa1 O else m4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) thent% O azpb= dmin1(zpb1,zpb2)o O azpa= zpa1o( O else if(ss(3).gt.ss(1)) then= O zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1)))s* O azpb= dmin1(zpb1,zpb2,zpb3) O azpa= zpa1 ( O else if(ss(3).lt.ss(1)) then% O azpb= dmin1(zpb1,zpb2) = O zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1)))n% O azpa= dmax1(zpa1,zpa2)w O endif, else O  O azpa= zpa1" O azpb= dmin1(zpb1,zpb2) O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) then  O zpa= azpa O zpb= azpb( O else if(cs(3).gt.cs(1)) then O zpb= azpb= O bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))),$ O zpa= dmax1(azpa,bzpa)( O else if(cs(3).lt.cs(1)) then O zpa= azpa= O bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1)))t$ O zpb= dmin1(azpb,bzpb) O endif, else, O zpa= azpa O  O zpb= azpb0 O endif O endif, O *, O if(ieq.eq.0) then)' O zpen= vv*(1.d0-bl(1)-bl(2)+sm)2( O zmen= vv*(-1.d0+bl(3)+bl(4)+sm) O zpa= dmax1(zpa,zmen), O zpb= dmin1(zpb,zpen)  O else if(ieq.eq.1) then( O zpel= vv*(sm-enc+xbl(3)+xbl(4))) O zpeu1= vv*(sm+enc-xbl(1)-xbl(2))4 O zpeu2= vv*(enc-xbl(1))g O zpeu3= vv*(enc-xbl(2)) O  O zpa= dmax1(zpa,zpel),* O zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) O endifm O zpap= vv*sct34 O zpa= dmax1(zpa,zpap) O *a O *-----test on sp O *, O if(zpb.le.zpa) then  O iz= 0 O ifz(5)= ifz(5)+1b O go to 1 O endif  O *  O if(itc.eq.3) then, O bdistl= dist*dist/s-zpa O bdistu= zpb-dist*dist/s2 O if(bdistl.le.0.d0.or.bdistu.le.0.d0) then O iz= 0o O ifz(5)= ifz(5)+1 O go to 1t O endif O endif2 O *1! O if(ih.eq.2.or.ih.eq.4) then O  O if(omssm.eq.'n') then O rpm2= rhm2 O rpmg= rhmg O spgs= shgs O vpmg= vhmg O spg= shg O s0p= s0h# O else if(omssm.eq.'y') then9 O rpm2= rshm24 O rpmg= rshmg. O spgs= sshgs4 O vpmg= vshmg/ O spg= sshg  O s0p= s0sha O endif& O else if(ih.eq.1.or.ih.eq.3) then O rpm2= rzm2i O rpmg= rzmg, O spgs= szgs  O vpmg= vzmg  O spg= szg  O s0p= s0z O endifa O if(itc.eq.3) thenn O sp= (dist/rs/svv)**2s, O spjc= 2.d0*dist/s/((vv*sp-rpm2)**2+ O # (vv*sp*spg)**2)h O else O zpas= zpa-rpm2  O zpbs= zpb-rpm2 O # O atpa= (zpas+spgs*zpa)/rpmg # O atpb= (zpbs+spgs*zpb)/rpmgp/ O if(atpa.gt.1.d0.and.atpb.gt.1.d0) then  O atpa= 1.d0/atpa  O atpa= atan(atpa)! O zpat= (pih-atpa)/vpmg( O atpb= 1.d0/atpb  O atpb= atan(atpb)! O zpbt= (pih-atpb)/vpmg $ O spjc0= (-atpb+atpa)/vpmg5 O else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) thens O atpa= 1.d0/atpa O  O atpa= atan(atpa)! O zpat= (pih-atpa)/vpmg  O atpb= -1.d0/atpb O atpb= atan(atpb)" O zpbt= (-pih+atpb)/vpmg' O spjc0= (-pi+atpb+atpa)/vpmgx9 O else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) thenx O atpa= 1.d0/atpa  O atpa= atan(atpa)! O zpat= (pih-atpa)/vpmg( O atpb= atan(atpb) O zpbt= atpb/vpmg(( O spjc0= (-pih+atpb+atpa)/vpmg5 O else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then O  O atpa= -1.d0/atpa O atpa= atan(atpa)" O zpat= (-pih+atpa)/vpmg O atpb= 1.d0/atpbr O atpb= atan(atpb)! O zpbt= (pih-atpb)/vpmg O & O spjc0= (pi-atpb-atpa)/vpmg6 O else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then O atpa= -1.d0/atpa O atpa= atan(atpa)" O zpat= (-pih+atpa)/vpmg O atpb= -1.d0/atpb O atpb= atan(atpb)" O zpbt= (-pih+atpb)/vpmg# O spjc0= (atpb-atpa)/vpmg-: O else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then O atpa= -1.d0/atpa O atpa= atan(atpa)" O zpat= (-pih+atpa)/vpmg O atpb= atan(atpb) O zpbt= atpb/vpmg O ' O spjc0= (pih+atpb-atpa)/vpmg 9 O else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) thens O atpa= atan(atpa) O zpat= atpa/vpmg  O atpb= 1.d0/atpb) O atpb= atan(atpb)! O zpbt= (pih-atpb)/vpmgv' O spjc0= (pih-atpb-atpa)/vpmg,: O else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then O atpa= atan(atpa) O zpat= atpa/vpmg( O atpb= -1.d0/atpb O atpb= atan(atpb)" O zpbt= (-pih+atpb)/vpmg( O spjc0= (-pih+atpb-atpa)/vpmg> O else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then O atpa= atan(atpa) O zpat= atpa/vpmgm O atpb= atan(atpb) O zpbt= atpb/vpmg=# O spjc0= (atpb-atpa)/vpmg  O endif O * O  O zpv= spjc0*spx+zpat O iftn= 1 O atnp= vpmg*zpv 0 O sp= s0p/vv*(1.d0+spg*s07aaf(atnp,iftn)) O if(iftn.ne.0) print 300 O spjc= vv*spjc0 O endife O *. O if(sp.lt.0.d0) thenx O iz= 0 O ifz(5)= ifz(5)+1  O go to 1 O endif  O ssp= sqrt(sp)  O spmm= sp-smv O smmp= sm-sp  O *  O cbw= -1.d0+sp-sm ifcr= 0 O * O call c02ajf(one,cbw,sm,bt1,bt2,ifcr) O if(bt1(2).ne.0.d0) then  O iz= 0 O ifz(6)= ifz(6)+1s O go to 1 O endifx O *h O smtp= sm*spv O ssmpp= ssm+ssp O ssmmp= ssm-ssp O asup= 1.d0-ssmpp*ssmpp O asum= 1.d0-ssmmp*ssmmp+ O if(asup.lt.0.d0.or.asum.lt.0.d0) then  O iz= 0 O ifz(7)= ifz(7)+1  O go to 1 O endifv O rasup= sqrt(asup)e O rasum= sqrt(asum)  O * " O *-----initialization of su = M_0^2 O * % O *-----limits on su from cuts on FS IMo O * O  O sulim= rrl(4)v O suuim1= rrr(4)5 O suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) v! O suuim= dmin1(suuim1,suuim2) O  O * @ O *-----limits on su from Delta_- > 0 (as derived from consistency O * on sd limits)f O *./ O suud1= 0.25d0*(rasup+rasum)*(rasup+rasum)e- O suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup)  O *h O sul= sulim O sul= dmax1(sul,sct23)= O if(ieq.eq.0) thenr O sul1= bl(2)+bl(3)-1.d0  O suu1= 1.d0-sp-bl(1) O suu2= 1.d0-sm-bl(4)* O suu3= (1.d0-0.5d0*(bl(1)+bl(4)))** O # (1.d0-0.5d0*(bl(1)+bl(4))) O else if(ieq.eq.1) then* O sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc O suu1= enc-sp-xbl(1) O suu2= enc-sm-xbl(4)+ O suu3= (enc-0.5d0*(xbl(1)+xbl(4)))* * O # (enc-0.5d0*(xbl(1)+xbl(4))) O endifm O sul= dmax1(sul,sul1)2 O suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) O *x O *-----test on su O *c O if(suu.le.sul) theno O iz= 0 O ifz(8)= ifz(8)+1 O  O go to 1 O endif* O *h! O if(ih.eq.1.or.ih.eq.4) then  O if(omssm.eq.'n') then O rum2= rhm2 O rumg= rhmg O sugs= shgs O vumg= vhmg O sug= shg O s0u= s0h# O else if(omssm.eq.'y') then O  O rum2= rshm2  O rumg= rshmg  O sugs= sshgsy O vumg= vshmg  O sug= sshg. O s0u= s0sh  O endif& O else if(ih.eq.2.or.ih.eq.3) then O rum2= rzm2r O rumg= rzmg  O sugs= szgs  O vumg= vzmg* O sug= szgt O s0u= s0zt O endifM O zuas= vv*sul-rum2o O zubs= vv*suu-rum2 O # O atua= (zuas+vv*sugs*sul)/rumg # O atub= (zubs+vv*sugs*suu)/rumge, O if(atua.gt.1.d0.and.atub.gt.1.d0) then O atua= 1.d0/atua O atua= atan(atua)s O zuat= (pih-atua)/vumg O atub= 1.d0/atub O atub= atan(atub)s O zubt= (pih-atub)/vumg! O sujc0= (-atub+atua)/vumg.2 O else if(atua.gt.1.d0.and.atub.lt.-1.d0) then O atua= 1.d0/atua O atua= atan(atua)n O zuat= (pih-atua)/vumg O atub= -1.d0/atub  O atub= atan(atub). O zubt= (-pih+atub)/vumg.$ O sujc0= (-pi+atub+atua)/vumg6 O else if(atua.gt.1.d0.and.abs(atub).lt.1.d0) then O atua= 1.d0/atua O atua= atan(atua)) O zuat= (pih-atua)/vumg O atub= atan(atub)c O zubt= atub/vumg% O sujc0= (-pih+atub+atua)/vumg O 2 O else if(atua.lt.-1.d0.and.atub.gt.1.d0) then O atua= -1.d0/atuat O atua= atan(atua). O zuat= (-pih+atua)/vumg  O atub= 1.d0/atub O atub= atan(atub). O zubt= (pih-atub)/vumg# O sujc0= (pi-atub-atua)/vumg O 3 O else if(atua.lt.-1.d0.and.atub.lt.-1.d0) then0 O atua= -1.d0/atuax O atua= atan(atua)  O zuat= (-pih+atua)/vumg  O atub= -1.d0/atub/ O atub= atan(atub)  O zubt= (-pih+atub)/vumg O O sujc0= (atub-atua)/vumg7 O else if(atua.lt.-1.d0.and.abs(atub).lt.1.d0) then  O atua= -1.d0/atua  O atua= atan(atua)  O zuat= (-pih+atua)/vumgg O atub= atan(atub)  O zubt= atub/vumg$ O sujc0= (pih+atub-atua)/vumg6 O else if(abs(atua).lt.1.d0.and.atub.gt.1.d0) then O atua= atan(atua)  O zuat= atua/vumg O atub= 1.d0/atub O atub= atan(atub)  O zubt= (pih-atub)/vumg$ O sujc0= (pih-atub-atua)/vumg7 O else if(abs(atua).lt.1.d0.and.atub.lt.-1.d0) thent O atua= atan(atua)  O zuat= atua/vumg O atub= -1.d0/atubr O atub= atan(atub)) O zubt= (-pih+atub)/vumg % O sujc0= (-pih+atub-atua)/vumg ; O else if(abs(atua).lt.1.d0.and.abs(atub).lt.1.d0) then0 O atua= atan(atua)  O zuat= atua/vumg O atub= atan(atub)4 O zubt= atub/vumg O sujc0= (atub-atua)/vumg O endif O  O *  O zuv= sujc0*sux+zuate iftn= 1) O atnu= vumg*zuv- O su= s0u/vv*(1.d0+sug*s07aaf(atnu,iftn))x O if(iftn.ne.0) print 300x O *4 O sujc= vv*sujc0 O if(su.lt.0.d0) then3 O iz= 0 O ifz(8)= ifz(8)+1m O go to 1 O endifm O ssu= sqrt(su)e O *r" O *-----initialization of sd = m_0^2 O *i% O *-----limits on sd from cuts on FS IM  O *  O sdlim1= rrl(3)) O sdlim2= 1.d0-rrr(2)-rrr(5)-sm-sp-sue! O sdlim= dmax1(sdlim1,sdlim2)) O sduim1= rrr(3)# O sduim2= (1.d0-ssu)*(1.d0-ssu) ) O sduim3= 1.d0-rrl(2)-rrl(5)-sm-sp-sus( O sduim= dmin1(sduim1,sduim2,sduim3) O * # O *-----limits on sd from Delta_- > 0  O *s O if(ssu.gt.rasup) then & O sdld= (ssu-rasup)*(ssu-rasup) O else O sdld= sdlim O endifd$ O sdud1= (ssu+rasup)*(ssu+rasup)& O sdud2= (-ssu+rasum)*(-ssu+rasum) O sdud= dmin1(sdud1,sdud2) O *0C O *-----limits on sd from cuts on SA. Here for maximum security. Rarev O *sA O if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then b O if(ss(2).eq.ss(1)) then# O asdu= dmin1(sduim,sdud) # O asdl= dmax1(sdlim,sdld) % O else if(ss(1).gt.ss(2)) then 6 O sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))) O asdu= dmin1(sduim,sdud,sdusa) # O asdl= dmax1(sdlim,sdld))% O else if(ss(1).lt.ss(2)) thent# O asdu= dmin1(sduim,sdud) 6 O sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))) O asdl= dmax1(sdlim,sdld,sdlsa)n O endif O else O asdu= dmin1(sduim,sdud) O asdl= dmax1(sdlim,sdld) O endif A O if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then O if(cs(2).eq.cs(1)) then O sdl= asdl  O sdu= asdu % O else if(cs(1).gt.cs(2)) then. O sdu= asdu 6 O sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))" O sdl= dmax1(asdl,sdlsb)% O else if(cs(1).lt.cs(2)) thenx O sdl= asdl/6 O sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))" O sdu= dmin1(asdu,sdusb) O endif O else O sdl= asdl O sdu= asdu O endif  O *  O if(ieq.eq.0) then $ O sdenl= -1.d0+bl(1)+bl(4)+su O sdenu1= 1.d0-sp-bl(2) O sdenu2= 1.d0-sm-bl(3)$ O sdenu3= 1.d0-bl(2)-bl(3)+su O else if(ieq.eq.1) then. O sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4) O sdenu1= enc-sp-xbl(2) O sdenu2= enc-sm-xbl(3)/ O sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3)2 O endif  O sdl= dmax1(sdl,sdenl) * O sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3) O sdl= dmax1(sdl,sct14)= O *h O *-----test on sd O *s O if(sdu.le.sdl) then  O iz= 0 O ifz(9)= ifz(9)+1  O go to 1 O endif  O * ! O if(ih.eq.2.or.ih.eq.3) then) O if(omssm.eq.'n') then O rdm2= rhm2 O rdmg= rhmg O sdgs= shgs O vdmg= vhmg O sdg= shg O s0d= s0h# O else if(omssm.eq.'y') then O  O rdm2= rshm2  O rdmg= rshmg- O sdgs= sshgsm O vdmg= vshmg  O sdg= sshg  O s0d= s0sh. O endif& O else if(ih.eq.1.or.ih.eq.4) then O rdm2= rzm2  O rdmg= rzmg/ O sdgs= szgs1 O vdmg= vzmgm O sdg= szg  O s0d= s0zb O endif  O zdas= vv*sdl-rdm2m O zdbs= vv*sdu-rdm2.# O atda= (zdas+vv*sdgs*sdl)/rdmg # O atdb= (zdbs+vv*sdgs*sdu)/rdmg(, O if(atda.gt.1.d0.and.atdb.gt.1.d0) then O atda= 1.d0/atda O atda= atan(atda)  O zdat= (pih-atda)/vdmg O atdb= 1.d0/atdb O atdb= atan(atdb)a O zdbt= (pih-atdb)/vdmg! O sdjc0= (-atdb+atda)/vdmg 2 O else if(atda.gt.1.d0.and.atdb.lt.-1.d0) then O atda= 1.d0/atda O atda= atan(atda)m O zdat= (pih-atda)/vdmg O atdb= -1.d0/atdbt O atdb= atan(atdb)0 O zdbt= (-pih+atdb)/vdmg $ O sdjc0= (-pi+atdb+atda)/vdmg6 O else if(atda.gt.1.d0.and.abs(atdb).lt.1.d0) then O atda= 1.d0/atda O atda= atan(atda)g O zdat= (pih-atda)/vdmg O atdb= atan(atdb)l O zdbt= atdb/vdmg% O sdjc0= (-pih+atdb+atda)/vdmg 2 O else if(atda.lt.-1.d0.and.atdb.gt.1.d0) then O atda= -1.d0/atdaa O atda= atan(atda)t O zdat= (-pih+atda)/vdmgv O atdb= 1.d0/atdb O atdb= atan(atdb)( O zdbt= (pih-atdb)/vdmg# O sdjc0= (pi-atdb-atda)/vdmg O 3 O else if(atda.lt.-1.d0.and.atdb.lt.-1.d0) thenm O atda= -1.d0/atdaa O atda= atan(atda)m O zdat= (-pih+atda)/vdmg- O atdb= -1.d0/atdbb O atdb= atan(atdb). O zdbt= (-pih+atdb)/vdmgt O sdjc0= (atdb-atda)/vdmg7 O else if(atda.lt.-1.d0.and.abs(atdb).lt.1.d0) then  O atda= -1.d0/atda  O atda= atan(atda)a O zdat= (-pih+atda)/vdmgt O atdb= atan(atdb)e O zdbt= atdb/vdmg$ O sdjc0= (pih+atdb-atda)/vdmg6 O else if(abs(atda).lt.1.d0.and.atdb.gt.1.d0) then O atda= atan(atda) O  O zdat= atda/vdmg O atdb= 1.d0/atdb O atdb= atan(atdb)( O zdbt= (pih-atdb)/vdmg$ O sdjc0= (pih-atdb-atda)/vdmg7 O else if(abs(atda).lt.1.d0.and.atdb.lt.-1.d0) theng O atda= atan(atda)a O zdat= atda/vdmg O atdb= -1.d0/atdb O  O atdb= atan(atdb)  O zdbt= (-pih+atdb)/vdmgs% O sdjc0= (-pih+atdb-atda)/vdmge; O else if(abs(atda).lt.1.d0.and.abs(atdb).lt.1.d0) then  O atda= atan(atda)  O zdat= atda/vdmg O atdb= atan(atdb)  O zdbt= atdb/vdmg O sdjc0= (atdb-atda)/vdmg O endifs O *- O zdv= sdjc0*sdx+zdatm iftn= 1  O atnd= vdmg*zdv- O sd= s0d/vv*(1.d0+sdg*s07aaf(atnd,iftn))s O if(iftn.ne.0) print 300o O sdjc= vv*sdjc0 O *c O if(sd.lt.0.d0) theni O iz= 0 O ifz(9)= ifz(9)+1z O go to 1 O endif  O ssd= sqrt(sd)s O sdmu= sd-su($ O sdmus= (1.d0+sdmu)*(1.d0+sdmu) O *e O *-----initialization of sf = m^2 O *d% O *-----limits on sf from cuts on FS IMz O *o O sflim1= rrl(2) O sfuim1= rrr(2) O bsg= sm+sp+su+sd O ombsg= 1.d0-bsg( O sflim2= ombsg-rrr(5) O sfuim2= ombsg-rrl(5)! O sflim= dmax1(sflim1,sflim2) ! O sfuim= dmin1(sfuim1,sfuim2)n O * " O *-----limits on sf from cuts on SA O * $ O tcuts= ss(1)-ss(2)+ss(3)-ss(4)$ O tcutc= cs(1)-cs(2)+cs(3)-cs(4)> O if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then1 O if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) thenz6 O sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc b6 O sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-s+ O # (ss(1)-ss(4))*sm)/tcuts a$ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa)6 O else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then6 O sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-a+ O # (ss(1)-ss(4))*sm)/tcuts O 6 O sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-b+ O # (cs(1)-cs(4))*sm)/tcutc ,* O asfu= dmin1(sfuim,sfusa,sfusb)# O asfl= sflim *6 O else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp- O + O # (ss(1)-ss(4))*sm)/tcuts 6 O sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-e+ O # (cs(1)-cs(4))*sm)/tcutc b* O asfl= dmax1(sflim,sflsa,sflsb)# O asfu= sfuim d6 O else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-t+ O # (ss(1)-ss(4))*sm)/tcuts 6 O sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc O $ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa) O endif O else O asfl= sflim O asfu= sfuim O endif  O *  O if(ieq.eq.0) then  O asfenl1= bl(1)-sm-sd0 O asfenl2= bl(3)-sp-su " O asfenu1= 1.d0-bl(2)-sp-sd" O asfenu2= 1.d0-bl(4)-sm-su O else if(ieq.eq.1) then' O asfenl1= 1.d0-enc-sm-sd+xbl(1) ' O asfenl2= 1.d0-enc-sp-su+xbl(3)i" O asfenu1= enc-sp-sd-xbl(2)" O asfenu2= enc-sm-su-xbl(4) O endifm' O asfl= dmax1(asfl,asfenl1,asfenl2) O ' O asfu= dmin1(asfu,asfenu1,asfenu2) # O aasfu= 1.d0-sm-sp-su-sd-sct24( O asfl= dmax1(asfl,sct13)a O asfu= dmin1(asfu,aasfu)  O *  O if(iac(3).ne.0) then O if(ss(4).ne.ss(3)) then O if(ss(4).gt.ss(3)) thenn5 O asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+ 7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) # O asfl= dmax1(asfl,asfltw) % O else if (ss(4).lt.ss(3)) then 5 O asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+t7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3)) # O asfu= dmin1(asfu,asfutw)t endif O O endif O if(cs(1).ne.cs(2)) then O if(cs(1).gt.cs(2)) thenp9 O bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+n. O # cs(2)-bt1(1))/(cs(1)-cs(2))# O asfl= dmax1(asfl,bsfltw))$ O else if(cs(1).lt.cs(2)) then9 O bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ O / O # cs(2)-bt1(1))/(cs(1)-cs(2)) # O asfu= dmin1(asfu,bsfutw)d endif O endif O if(cs(4).ne.cs(3)) then O if(cs(4).gt.cs(3)) thent; O csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm-n0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfu= dmin1(asfu,csfutw) $ O else if(cs(4).lt.cs(3)) then; O csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- 0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfl= dmax1(asfl,csfltw) endifp O endif O if(ss(1).ne.ss(2)) then O if(ss(1).gt.ss(2)) then 6 O dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfu= dmin1(asfu,dsfutw)t$ O else if(ss(1).lt.ss(2)) then6 O dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfl= dmax1(asfl,dsfltw) endifp O endif O endifv O *  O *-----positivity of R^2a O *) O scp= ssmpp*ssmpp  O scm= ssmmp*ssmmp $ O snp= (ssu+ssd)*(ssu+ssd) $ O snm= (ssu-ssd)*(ssu-ssd)  O rlp= ssu*ssd+ssp*ssm O rlm= ssu*ssd-ssp*ssm O bsgmo= bsg-1.d0t O ombsg2= ombsg*ombsgt O rlps= rlp*rlp  O rlms= rlm*rlm) O edelp= ombsg2-4.d0*rlps/ O edelm= ombsg2-4.d0*rlmsa" O edeld= 16.d0*ssu*ssd*ssp*ssm O *p7 O *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2  O * then Delta_+ > 0 O *t *-----control  O *  O cnt1= scp+snm) O cnt2= scm+snpt+ O if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then  O iz= 0 O ifz(10)= ifz(10)+1+ O go to 1 O endif  O if(edelm.le.0.d0) then O etest= edeld+edelp, O if(etest.gt.0.d0) theni O edelm= etest elsen O iz= 0s O ifz(11)= ifz(11)+1 O go to 1z O endif O endif  O sedm= sqrt(edelm)( ifcr= 0m. O call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) O if(rr1(2).ne.0.d0) then  O iz= 0 O ifz(12)= ifz(12)+1f O go to 1 O endif ifcr= 0 . O call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) O * O  O cnt3= scp+snpv O cnt4= scm+snmp O cbru= -1.d0s O ccru= 0.5d0*bsgm O *s< O *-----R^2 has two real roots and two complex conjugate roots O *.+ O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then7 O if(bsg.gt.0.5d0) then O iel= 1 O sflr(1)= rr1(1)u O sfur(1)= rr2(1)t O sflr(2)= rr1(1) O  O sfur(2)= rr2(1)o else  O iel= 2 O ifcr= 0 O 5 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) O O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1)i O sflr(2)= ru2 O sfur(1)= ru1 O sfur(2)= rr2(1)e O endif O *d O *-----R^2 has four real rootsh O * 1 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then  O if(bsg.gt.0.5d0) then O sflr(1)= rr1(1)  O sflr(2)= rs2(1)  O sfur(1)= rs1(1)  O sfur(2)= rr2(1)4 else  O ifcr= 0(5 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr)= O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1) & O sfur(1)= dmin1(rs1(1),ru1)& O sflr(2)= dmax1(rs2(1),ru2) O sfur(2)= rr2(1)a O endif O endif1 O *u. O *-----the loop for transforming sf starts here O *u O if(om.eq.'g') then O itmn= it0 O itmx= it0 O else O itmn= 1 O itmx= 2 O endifq O do it=itmn,itmx $ O if(sflr(it).ge.asfl) then O sfl= sflr(it)u O e  O sfl= asfl  O endif$ O if(sfur(it).le.asfu) then O sfu= sfur(it)y O else  O sfu= asfu  O endif O *  O *-----test on sf O * O  O if(sfu.le.sfl) then O iz= 0 O ifz(13)= ifz(13)+1 O go to 2. O endif O * F O *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 O *=0 O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then O er= rs1(1) O es= abs(rs1(2))r O er1= rr1(1)s O er2= rr2(1)  O ek2= edelm/edeld O ek= sqrt(ek2).$ O dog= -2.d0/sqrt(edeld)) O ecpl= (ombsg-2.d0*sfl)/sedmi) O ecpu= (ombsg-2.d0*sfu)/sedm  O eql= ecpl*ecpl O equ= ecpu*ecpu) O omecpl= 2.d0*(sfl-er1)/sedmi) O es2pl= omecpl*(2.d0-omecpl) ! O erl= 1.d0-ek2*es2pl= O espl= sqrt(es2pl)-) O opecpu= 2.d0*(er2-sfu)/sedm ) O es2pu= opecpu*(2.d0-opecpu)h O espu= sqrt(es2pu)i! O eru= 1.d0-ek2*es2pua O if(eql.eq.1) thenh O sflt= 0.d0 O  O else O ifel= 19 O sflt= -dog*espl*s21bbf(eql,erl,one,ifel)u# O if(ifel.ne.0) thenu O iz= 0a& O ifz(14)= ifz(14)+1 O go to 2  O endif O endif)" O if(equ.eq.1.d0) then O sfut= 0.d0  O else O ifel= 19 O sfut= -dog*espu*s21bbf(equ,eru,one,ifel).# O if(ifel.ne.0) thenu O iz= 0a& O ifz(15)= ifz(15)+1 O go to 2  O endif O endifa O if(iel.eq.1) then-# O if(sfu.le.er) thend O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,u( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,4( O # twusa5,twusa6) O elses O atwl= twlp O atwu= twup O endif O *# O *-----limits on tw from Es O *c O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2)s" O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1))% O atwle2= bxe*e2-bl(2)-* O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2) 1 O twue= dmin1(atwle,atwue1,atwue2)s O endif)$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *  O *-----natural limits on tw O * O # O atwl= dmax1(atwl,bt1(1))f# O atwu= dmin1(atwu,bt2(1))  O *3 O *-----test on tw O *f O if(atwu.le.atwl) then O iz= 0- O ifz(29)= ifz(29)+1 O go to 2e O endif O *  O twjc= atwu-atwl O tw= twjc*twx+atwl O pn= tw+sp-1.d0f O omtw= 1.d0-tw O *  O *-----initialization of t1 O *a% O *-----limits on t1 from positivity+SAu O *f O t1lp1= 0.d0 O t1lp2= pn+sdpf( O t1up1= tw O t1up2= sm+sdpfn# O t1lp= dmax1(t1lp1,t1lp2)e# O t1up= dmin1(t1up1,t1up2)h O * O " O *-----limits on t1 from cuts on SA O *  O if(iac(3).ne.0) then) O t1lc1= ss(1)*e1 O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) 5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)*/ O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3s4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1 O O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))t5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3f4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else  O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E  O *  O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1))" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif($ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O **4 O *-----positivity of (R')^2 / reality of roots for t3 O *s! O rp0= e1p2*e1p2-4.d0*sms O if(rp0.lt.0.d0) thens O iz= 0 O ifz(30)= ifz(30)+1 O go to 2  O endif O srp0= sqrt(rp0) O rp0e= -rp0l, O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1 & O rp2= -(e1*tw-sm)*(e1*tw-sm) O if(rp0e.eq.0.d0) then O iz= 0+ O ifz(31)= ifz(31)+1 O go to 2l O endif O ifct= 0 O if(rp0e.ne.0.d0) then7 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct)l/ O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1))% O else if(rp0e.eq.0.d0) then  O sret1= -rp2/rp1e# O if(rp1e.gt.0.d0) then+' O t1l= dmax1(at1l,sret1). O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1) O  O endif+ O endif O *t O *-----test on t1 O *  O if(t1u.le.t1l) then O iz= 0z O ifz(31)= ifz(31)+1 O go to 2z O endif O * ! O *-----transformation for jacobian O  O * O if(rp0e.eq.0.d0) then0 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)0 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-tauli9 O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e2 O endif" O if(ret1(1).eq.t1l) then O at1tl= -pih/srp0 O else O 0 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) O ifas= 1f- O at1tl= -s09aaf(bt1tl,ifas)/srp0i% O if(ifas.ne.0) print 2001 O endif" O if(ret2(1).eq.t1u) then O at1tu= pih/srp01 O else 1 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)2 O ifas= 1 O - O at1tu= -s09aaf(bt1tu,ifas)/srp0,% O if(ifas.ne.0) print 200) O endif) O if((at1tl+at1tu).eq.0.d0) then1# O if(t1x.lt.1.d-3) then  O arc= pi*t1x O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc/ O else if((1.d0-t1x).lt.1.d-3) then1# O arc= pi*(1.d0-t1x)  O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc O else" O carc= cos(pi*t1x)- O t1= 0.5d0*(ret1(1)+ret2(1))+11 O # 0.5d0*(ret1(1)-ret2(1))*carcp O endifs O t1jc= pi/srp0q O else & O t1tl= dmin1(at1tl,at1tu)& O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tln O t1t= t1jc*t1x+t1tl. O t1= (rp1+rpds*sin(srp0*t1t))/rp0 O endif O t1s= t1*t1  O * 1 O 200 format(' Unsuccesful call to S09AAF ')  O *  O *-----test on t1 from FS A O * / O if(ieq.eq.1.and.iac(4).ne.0.d0) thenf/ O cnlct1= xp*(xm*sm-ep12*cg12)+xdf*s7 O # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1-z+ O # xdf*tw)+xdfs*cg12*t1sd/ O cnlst1= xp*(ep12*sg12-xm*sm)-xdf*D7 O # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+.+ O # xdf*tw)-xdfs*sg12*t1ss% O if(cnlct1.lt.0.d0) then  O iz= 0# O ifz(32)= ifz(32)+1  O go to 2* O else if(cnlst1.lt.0.d0) then O iz= 0# O ifz(33)= ifz(33)+1d O go to 2 O endif O  O endif O *p O *-----some vector components O *c O t2= tw-t1c O *  O *-----equation for xi is solved  O *s O e1s= e1*e1  O e2s= e2*e2- O e3s= e3*e3  O e12= e1t2-2.d0*sm O e13= e1t3-2.d0*sf O e23= e2t3-2.d0*su O e12s= e12*e12 O e13s= e13*e13 O e23s= e23*e23 O xia= e1s*e2s-e12s= O xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- < O # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ O # e2*e12*e13= O xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* > O # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0*< O # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1*> O # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s*< O # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*; O # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23  O xib= 2.d0*xib! O if(xia.eq.0.d0) then $ O if(xib.eq.0.d0) then O iz= 0% O ifz(34)= ifz(34)+1e O go to 2 O endif O rtm(1)= -xic/xib O rtp(1)= rtm(1) O rtm(2)= 0.d0 O rtp(2)= 0.d0 O ixia= 0  O elses O ixia= 1u O ifc0= 0i5 O call c02ajf(xia,xib,xic,rtm,rtp,ifc0)  O endif$ O if(rtm(2).ne.0.d0) then O iz= 0 " O ifz(35)= ifz(35)+1 O go to 2 O  O endif O *c O *-----xi^+ and xi^- are computed O * # O xip= 0.5d0*(e3-rtp(1)) # O xim= 0.5d0*(e3-rtm(1))  O * . O *-----each integral becomes a sum of two terms O *l O *-----loop over ix starts here O */ O if(om.eq.'g') then O ixmn= ix0 O ixmx= ix0 O else O ixmn= 1 O ixmx= 2 O endif  O do ix=ixmn,ixmx  O * ) O *-----q_3 is compared and x15 is selected  O *n" O if(ix.eq.1) then O t3= xip' O else if(ix.eq.2) then  O t3= xim O endif  O * % O *-----The two integrands are computed  O *r" O *-----further auxiliary quantities O *m O edn1= ep1-xdf*t1* O edn2= ep2-xdf*t2  O edn3= ep3-xdf*t3 O  O t4= omtw-t3 O edn4= ep4-xdf*t4  O *(% O *-----collections of all limits on t3 O  O * % O *-----from energy (or natural limits)  O * O if(ieq.eq.1) then* O at3l1= omtw-bxe*e4+bl(4)% O at3u1= bxe*e3-bl(3) & O if(xdf.gt.0.d0) then O t3l1= at3l1 O t3u1= at3u1+ O else if(xdf.lt.0.d0) then O t3l1= at3u1 O t3u1= at3l1 O endif  O elsee O t3l1= 0.d0 O t3u1= e3 O endif O *j O *-----natural limits O * . O t3l2= -t1+0.5d0*(e1p3-skl2). O t3u2= -t1+0.5d0*(e1p3+skl2) O * 7 O t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3)d7 O t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)e O *i O *-----from positivity on SAi O *f O t3l4= 0.d0 $ O t3l5= sm+su+sf-tw! O t3u4= sp+su+sf  O t3u5= omtw  O * *-----from SAd O * O ' O if(iac(3).ne.0) thene# O t3l6= ss(3)*e3=# O t3u6= cs(3)*e3 ( O t3l7= omtw-cs(4)*e4( O t3u7= omtw-ss(4)*e44 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,/ O # t3l5,t3l6,t3l7) O 4 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,/ O # t3u5,t3u6,t3u7)e O else 9 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) 9 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)  O endif O * O  O *-----limits on t3 are imposed O * , O tlimt3= (t3u-t3)*(t3-t3l)& O if(t3u.lt.t3l) then O iz= 0 ( O ifz(36)= ifz(36)+1 O go to 4e/ O else if(tlimt3.lt.0.d0) then  O iz= 0e( O ifz(36)= ifz(36)+1 O go to 4  O endif O * , O *-----non linear limits on t3,t4 are imposed O * 4 O if(iac(4).ne.0.and.ieq.eq.1) then3 O tnl13c= -cg13*edn1*edn3+vv*sf 2 O tnl13s= sg13*edn1*edn3-vv*sf3 O tnl23c= -cg23*edn2*edn3+vv*su.2 O tnl23s= sg23*edn2*edn3-vv*su3 O tnl14c= -cg14*edn1*edn4+vv*sdz2 O tnl14s= sg14*edn1*edn4-vv*sd* O sres= 1.d0-e1-e3+sf 5 O tnl24c= -cg24*edn2*edn4+vv*sres 4 O tnl24s= sg24*edn2*edn4-vv*sres3 O tnl34c= -cg34*edn3*edn4+vv*spe2 O tnl34s= sg34*edn3*edn4-vv*sp= O if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. = O # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or.k= O # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. = O # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. ? O # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then O  O iz= 0+ O ifz(37)= ifz(37)+1e O go to 4+ O endif . O endif O *u: O *-----non linear constraints from FS A in the case xp = xm O * 7 O if(iac(4).ne.0.d0.and.ieq.eq.0) then . O smr= 1.d0-sm-sp-su-sd-sf; O spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm)l; O spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf)#; O spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) ; O spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) = O spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr)o; O spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) M O if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. N O # spc14.lt.0.d0.or.spc23.lt.0.d0.or. = O # spc24.lt.0.d0.or.spc34.lt.0.d0) then  O iz= 0+ O ifz(38)= ifz(38)+1 O go to 4 O endif  O endif O *  O *-----all invariants O *  O x13= t1 O x14= t2 O x15= t3 O x16= t4 O x23= e1-t1- O x24= e2-t2i O x25= e3-t3d O x26= e4-t4  O x34= sm O x35= sf O x36= sd O x45= su' O x46= 1.d0-e1-e3+sf( O x56= sp O *  O *-----computes cross-section O *fB O *-----born matrix element is calculated at the reduced c.m. energy O *l, O *-----The epsilons are computed in the order9 O * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4),s9 O * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), 9 O * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4),i9 O * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4),=8 O * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) O *d" O x13s= x13*x13" O x14s= x14*x14" O x15s= x15*x15" O x16s= x16*x16" O x23s= x23*x23" O x24s= x24*x24" O x25s= x25*x25" O x26s= x26*x26" O x34s= x34*x34" O x35s= x35*x35" O x36s= x36*x36" O x45s= x45*x45" O x46s= x46*x46" O x56s= x56*x56G O * > O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+A O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s > O ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+A O # x15*x23*x35)-x13s*x25s-x15s*x23s-x35ss> O ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+A O # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s B O ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+A O # x14*x15*x34*x35)-x13s*x45s-x14s*x35s-o% O # x15s*x34s(B O ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+A O # x24*x25*x34*x35)-x23s*x45s-x24s*x35s-d% O # x25s*x34s1G O *  O e(1)= 1.d0 F O e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*E O # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14*4C O # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35sE O e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-2F O # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-D O # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45F O e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*G O # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14*sF O # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 G O e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* C O # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* D O # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+$ O # x25*x34s O *  O *-----sign of eps_1*eps_ib O *) O ises= 0" O sg(1)= 0.25d0+ O if(ee(1).lt.0.d0) thena$ O ises= ises+1 O endif O do i=2,5w2 O if(abs(e(i)).lt.zrm) then( O ises= ises+12 O else if(e(i).gt.zrm) then) O sg(i)= 0.25d0,3 O else if(e(i).lt.-zrm) thent* O sg(i)= -0.25d0 O endif/ O if(ee(i).lt.0.d0) then ( O ises= ises+1 O endif O enddo O *)' O if(ises.eq.0) theni/ O ses1= sg(1)*sqrt(ee(1)) / O ses2= sg(2)*sqrt(ee(2))e/ O ses3= sg(3)*sqrt(ee(3))l/ O ses4= sg(4)*sqrt(ee(4))+/ O ses5= sg(5)*sqrt(ee(5))t O s1= ses1 O s2= ses2& O s3= -ses1-ses2 O s4= ses3% O s5= ses1-ses3l% O s6= ses2+ses3= O s7= ses4% O s8= ses1-ses4 % O s9= ses2+ses4 & O s10= ses3-ses4! O s11= ses5(' O s12= -ses1-ses5 ' O s13= -ses2+ses5m' O s14= -ses3-ses53' O s15= -ses4-ses55 O else4A O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ O D O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sA O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+=D O # x16*x23*x36)-x13s*x26s-x16s*x23s-x36sA O ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+cD O # x16*x24*x46)-x14s*x26s-x16s*x24s-x46sE O ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+pD O # x14*x16*x34*x36)-x13s*x46s-x14s*x36s-( O # x16s*x34sE O ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+tE O # x24*x26*x34*x36)-x23s*x46s-x24s*x36s-f) O # x26s*x34se" O e(1)= 1.d0> O e(2)= x13*x14*x23*x26+x13*x16*x23*x2 B O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-C O # x14*x16*x23s+x14*x23*x36+x16*x23*x34--2 O # x13s*x24*x26-x34*x36@ O e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*@ O # x24*x46-x14*x16*x23*x24+x14*(-x23*@ O # x46+2.d0*x24*x36-x26*x34)-x16*x24*6 O # x34+x14s*x23*x26+x34*x46@ O e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*? O # x34)+x13*x16*x24*x34+x13*x34*x46+ > O # x14*x16*x23*x34+x14*x34*x36-x16*= O # x34s-x13s*x24*x46-x14s*x23*x36 @ O e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*> O # x24s)+x14*(-x23*x24*x36-x23*x26*A O # x34+x46*x23s)+x16*2.d0*x23*x24*x34- > O # x23*x34*x46-x24*x34*x36+x26*x34s O ises= 0)% O sg(1)= 0.25d0l. O if(ee(1).lt.0.d0) then' O ises= ises+1  O endif O do i=2,55 O if(abs(e(i)).lt.zrm) then O + O ises= ises+1 5 O else if(e(i).gt.zrm) then , O sg(i)= 0.25d06 O else if(e(i).lt.-zrm) then- O sg(i)= -0.25d0*! O endifr2 O if(ee(i).lt.0.d0) then+ O ises= ises+1a! O endif O  O enddoh* O if(ises.eq.0) then2 O ses1= sg(1)*sqrt(ee(1))2 O ses2= sg(2)*sqrt(ee(2))2 O ses3= sg(3)*sqrt(ee(3))2 O ses4= sg(4)*sqrt(ee(4))2 O ses5= sg(5)*sqrt(ee(5))# O s1= ses1-) O s2= -ses1-ses2 # O s3= ses2f) O s4= -ses1-ses3e# O s5= ses3 ) O s6= -ses2-ses3 ( O s7= ses1-ses4# O s8= ses4 ) O s9= -ses2-ses4(* O s10= -ses3+ses4* O s11= -ses1-ses5$ O s12= ses5) O s13= ses2-ses5.) O s14= ses3+ses5t) O s15= ses4+ses5  O elseD O ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+C O # x15*x23*x35)-x13s*x25s-x15s*x23s-l& O # x35sD O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+C O # x16*x23*x36)-x13s*x26s-x16s*x23s-c& O # x36sD O ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+C O # x16*x25*x56)-x15s*x26s-x16s*x25s- & O # x56sD O ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*A O # x56+x15*x16*x35*x36)-x13s*x56s- O 5 O # x15s*x36s-x16s*x35s D O ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*A O # x56+x25*x26*x35*x36)-x23s*x56s-c5 O # x25s*x36s-x26s*x35sfG O * A O e(1)= x13*x14*x23*x25+x13*x15*x23*x24+tE O # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- B O # x14*x15*x23s+x14*x23*x35+x15*x23*9 O # x34-x13s*x24*x25-x34*x35 O A O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+pE O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-aB O # x14*x16*x23s+x14*x23*x36+x16*x23*9 O # x34-x13s*x24*x26-x34*x362B O e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+D O # x13*(-x25*x46+x26*x45)+x14*x15*x23*F O # x26-x14*x16*x23*x25+x14*(x25*x36-x26*F O # x35)+x15*(-x23*x46+x24*x36)+x16*(x23*= O # x45-x24*x35)+x35*x46-x36*x45 O C O e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15*#E O # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ D O # x25*x34)+x13*(x35*x46-x36*x45)-x14*E O # x15*x23*x36+x14*x16*x23*x35+x15*x34*.D O # x36-x16*x34*x35+x13s*(-x25*x46+x26*% O # x45)bG O e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25*.D O # x36-x24*x26*x35)+x15*(-x23*x24*x36-D O # x23*x26*x34+x46*x23s)+x16*(x23*x24*C O # x35+x23*x25*x34-x45*x23s)-x23*x35* E O # x46+x23*x36*x45-x25*x34*x36+x26*x34* O $ O # x35 O * " O ises= 0# O do i=1,5,8 O if(abs(e(i)).lt.zrm) then. O ises= ises+18 O else if(e(i).gt.zrm) then/ O sg(i)= 0.25d0 O 9 O else if(e(i).lt.-zrm) then 0 O sg(i)= -0.25d0$ O endif5 O if(ee(i).lt.0.d0) then . O ises= ises+1$ O endif O enddo- O if(ises.eq.0) thens5 O ses1= sg(1)*sqrt(ee(1))f5 O ses2= sg(2)*sqrt(ee(2)) 5 O ses3= sg(3)*sqrt(ee(3))=5 O ses4= sg(4)*sqrt(ee(4))r5 O ses5= sg(5)*sqrt(ee(5))i, O s1= -ses1-ses2& O s2= ses1& O s3= ses2, O s4= -ses1+ses3, O s5= -ses2-ses3& O s6= ses3, O s7= -ses1+ses4, O s8= -ses2-ses4& O s9= ses4, O s10= ses3-ses4, O s11= ses1+ses5, O s12= ses2-ses5' O s13= ses5 O - O s14= -ses3-ses5 - O s15= -ses4-ses5  O else # O iz= 0-0 O ifz(39)= ifz(39)+1% O go to 4 O endif O endif1 O endif O * ( O tgn(1)= x14/x25/x36) O tgn(2)= x14*x25*x36 O ) O tgn(3)= x24/x15/x36 ) O tgn(4)= x15*x24*x36 1 O tgn(5)= x14/x24/x34/x45*x46 1 O tgn(6)= x14/x24/x34*x45/x46(1 O tgn(7)= x14/x24*x34/x45*x46=1 O tgn(8)= x14/x24*x34*x45/x46 1 O tgn(9)= x14*x24/x34/x45*x46t2 O tgn(10)= x14*x24/x34*x45/x462 O tgn(11)= x45*x46/x15/x25/x342 O tgn(12)= x45/x15/x25/x34/x462 O tgn(13)= x34*x45/x15/x25/x462 O tgn(14)= x25*x46/x15/x34/x452 O tgn(15)= x25*x45/x15/x34/x462 O tgn(16)= x15/x25/x34*x45/x462 O tgn(17)= x25/x15/x34*x45*x462 O tgn(18)= x25*x34*x45/x46/x152 O tgn(19)= x15/x25/x34*x45*x462 O tgn(20)= x15/x25*x34*x45/x462 O tgn(21)= x15*x25*x34/x45*x461 O tgn(22)= x34/x15/x25/x45/x46.1 O tgn(23)= x15/x25*x34/x45*x46 1 O tgn(24)= x34/x14/x24*x45/x46 1 O tgn(25)= x14/x24*x34/x45/x46-1 O tgn(26)= x24/x14*x34*x45/x46 1 O tgn(27)= x14*x24*x34/x45/x46 1 O tgn(28)= x34/x14/x24*x45*x46+) O tgn(29)= x15/x24/x36e. O tgn(30)= 1.d0/x14/x25/x36) O tgn(31)= x14/x25*x36 . O tgn(32)= 1.d0/x15/x24/x362 O tgn(33)= 1.d0/x14/x15/x24/x25. O tgn(34)= 1.d0/x14*x25/x36) O tgn(35)= x15*x24/x36 ) O tgn(36)= x14*x25/x36 O 2 O tgn(37)= 1.d0/x14*x15*x24/x25- O tgn(38)= x14/x15/x24*x25+: O tgn(39)= 1.d0/x24/x25*x34/x36/x45/x465 O tgn(40)= x24/x25*x34/x36/x45/x46d: O tgn(41)= 1.d0/x24*x25*x34/x36/x45*x466 O tgn(42)= 1.d0/x14/x24*x34/x45*x466 O tgn(43)= 1.d0/x14*x24*x34/x45*x46: O tgn(44)= 1.d0/x24/x25*x34/x36*x45/x46) O tgn(45)= x36/x15/x24 1 O tgn(46)= x45*x46/x14/x24/x3431 O tgn(47)= x45*x46/x14*x24/x34 1 O tgn(48)= x25*x34/x15/x45/x46 1 O tgn(49)= x24*x45/x14/x34/x46f1 O tgn(50)= x14*x45*x46/x24/x34  O *( O itgn= 0 O do l=1,500 O if(tgn(l).le.0.d0) then( O itgn= itgn+1 O endif O enddo' O if(itgn.ne.0) theng O iz= 0 * O ifz(40)= ifz(40)+1 O go to 42 O endif O * & O gh1= sqrt(tgn(1))& O gh2= sqrt(tgn(2))& O gh3= sqrt(tgn(3))& O gh4= sqrt(tgn(4))& O gh5= sqrt(tgn(5))& O gh6= sqrt(tgn(6))& O gh7= sqrt(tgn(7))& O gh8= sqrt(tgn(8))& O gh9= sqrt(tgn(9))( O gh10= sqrt(tgn(10))( O gh11= sqrt(tgn(11))( O gh12= sqrt(tgn(12))( O gh13= sqrt(tgn(13))( O gh14= sqrt(tgn(14))( O gh15= sqrt(tgn(15))( O gh16= sqrt(tgn(16))( O gh17= sqrt(tgn(17))( O gh18= sqrt(tgn(18))( O gh19= sqrt(tgn(19))( O gh20= sqrt(tgn(20))( O gh21= sqrt(tgn(21))( O gh22= sqrt(tgn( ))( O gh23= sqrt(tgn(23))( O gh24= sqrt(tgn(24))( O gh25= sqrt(tgn(25))( O gh26= sqrt(tgn(26))( O gh27= sqrt(tgn(27))( O gh28= sqrt(tgn(28))( O gh29= sqrt(tgn(29))( O gh30= sqrt(tgn(30))( O gh31= sqrt(tgn(31))( O gh32= sqrt(tgn(32))( O gh33= sqrt(tgn(33))( O gh34= sqrt(tgn(34))( O gh35= sqrt(tgn(35))( O gh36= sqrt(tgn(36))( O gh37= sqrt(tgn(37))( O gh38= sqrt(tgn(38))( O gh39= sqrt(tgn(39))( O gh40= sqrt(tgn(40))( O gh41= sqrt(tgn(41))( O gh42= sqrt(tgn(42))( O gh43= sqrt(tgn(43))( O gh44= sqrt(tgn(44))( O gh45= sqrt(tgn(45))( O gh46= sqrt(tgn(46))( O gh47= sqrt(tgn(47))( O gh48= sqrt(tgn(48))( O gh49= sqrt(tgn(49))( O gh50= sqrt(tgn(50)) O ** O vj= sqrt(vv**3)  O hb(1)= vj*ver*vfr* O hb(2)= vj*ver*vfl O  O hb(3)= vj*vel*vfr  O hb(4)= vj*vel*vflx O ** O *-----Compensating propagators O *( O hpmcfr= sm-rhm2/vv O hpmcfi= sm*shg O zpmcfr= sm-rzm2/vv O zpmcfi= sm*szg O hppcfr= sp-rhm2/vv O hppcfi= sp*shg O zppcfr= sp-rzm2/vv O zppcfi= sp*szg O hpucfr= su-rhm2/vv O hpucfi= su*shg O zpucfr= su-rzm2/vv O zpucfi= su*szg O hpdcfr= sd-rhm2/vv O hpdcfi= sd*shg O zpdcfr= sd-rzm2/vv O zpdcfi= sd*szg O if(omssm.eq.'n') then3 O addmr= 1.d0 O addmi= 0.d0 O addpr= 1.d0 O addpi= 0.d0 O addur= 1.d0 O addui= 0.d0 O adddr= 1.d0 O adddi= 0.d0 O else if(omssm.eq.'y') then# O alpha1= -salpha/cbeta*sbma " O alpha2= calpha/cbeta*cbma O alpha21= alpha2/alpha1 8 O propm= (sm-rbhm2/vv)*(sm-rbhm2/vv)+(sm*sbhg)**28 O propu= (su-rbhm2/vv)*(su-rbhm2/vv)+(su*sbhg)**28 O propd= (sd-rbhm2/vv)*(sd-rbhm2/vv)+(sd*sbhg)**28 O propp= (sp-rbhm2/vv)*(sp-rbhm2/vv)+(sp*sbhg)**2@ O addmr= 1.d0+alpha21/propm*((sm-rshm2/vv)*(sm-rbhm2/vv)+ O # sm*sm*sbhg*sshg)H O addmi= alpha21/propm*sm*((sm-rshm2/vv)*sbhg-(sm-rbhm2/vv)*sshg)@ O addpr= 1.d0+alpha21/propp*((sp-rshm2/vv)*(sp-rbhm2/vv)+ O # sp*sp*sbhg*sshg)H O addpi= alpha21/propp*sp*((sp-rshm2/vv)*sbhg-(sp-rbhm2/vv)*sshg)@ O addur= 1.d0+alpha21/propu*((su-rshm2/vv)*(su-rbhm2/vv)+ O # su*su*sbhg*sshg)H O addui= alpha21/propu*su*((su-rshm2/vv)*sbhg-(su-rbhm2/vv)*sshg)@ O adddr= 1.d0+alpha21/propd*((sd-rshm2/vv)*(sd-rbhm2/vv)+ O # sd*sd*sbhg*sshg)H O adddi= alpha21/propd*sd*((sd-rshm2/vv)*sbhg-(sd-rbhm2/vv)*sshg) O endife O *f# O *-----Higgs Bremsstrahlung diagram:  O *  O dth= 0.d0iG O * % O *-----Integrals d1-d2 helicity h1-2)  O *n O if(ih.eq.1) then O * 0 O h1b12r= 4.d0*(-gh18*x16-gh21+gh48*x14*x56) O h1b12i= 16.d0*s10*gh48@ O h2b12r= 2.d0*(gh11*x35+gh12*(-x13*x24*x56+x13*x26*x45+x14*? O # x23*x56-x14*x26*x35-x16*x23*x45+x16*x24*x35-x36*x45)+ > O # gh13*x56+gh15*x14*x36+gh16*x24*x36-gh17*x13-gh18*x16- O # gh19*x23-gh20*x26) B O h2b12i= 8.d0*(-s1*gh12*x56+s6*gh13-s9*gh12*x24+s10*gh12*x23-# O # s11*gh12*x16-s12*gh16) O h1b1r= 0.25d0*hb(2)*h1b12r O h1b1i= 0.25d0*hb(2)*h1b12i O h1b2r= 0.25d0*hb(3)*h1b12r! O h1b2i= -0.25d0*hb(3)*h1b12i O h2b1r= 0.25d0*hb(2)*h2b12r O h2b1i= 0.25d0*hb(2)*h2b12i O h2b2r= 0.25d0*hb(3)*h2b12r! O h2b2i= -0.25d0*hb(3)*h2b12i  O *  O d1b1r= rsz*h1b1r O d1b1re= -aisz*h1b1i  O d1b1ie= rsz*h1b1i1 O d1b1i= aisz*h1b1r  O d1b2r= rsz*h1b2r O d1b2re= -aisz*h1b2ie O d1b2ie= rsz*h1b2i  O d1b2i= aisz*h1b2r  O d2b1r= rsz*h2b1r O d2b1re= -aisz*h2b1i  O d2b1ie= rsz*h2b1i  O d2b1i= aisz*h2b1rs O d2b2r= rsz*h2b2r O d2b2re= -aisz*h2b2i  O d2b2ie= rsz*h2b2ie O d2b2i= aisz*h2b2r  O * 1 O cd1b1r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b1r-3 O cd1b1re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b1i 2 O cd1b1ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b1i1 O cd1b1i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b1rx1 O cd1b2r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b2r23 O cd1b2re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b2i 2 O cd1b2ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b2i1 O cd1b2i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b2r61 O cd2b1r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b1rx3 O cd2b1re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b1i 2 O cd2b1ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b1i1 O cd2b1i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b1rs1 O cd2b2r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b2r63 O cd2b2re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b2ix2 O cd2b2ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b2i1 O cd2b2i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b2r# O * ' O bd1b1r= addmr*cd1b1r-addmi*cd1b1i * O bd1b1re= addmr*cd1b1re-addmi*cd1b1ie* O bd1b1ie= addmr*cd1b1ie+addmi*cd1b1re' O bd1b1i= addmr*cd1b1i+addmi*cd1b1r.' O bd1b2r= addmr*cd1b2r-addmi*cd1b2i * O bd1b2re= addmr*cd1b2re-addmi*cd1b2ie* O bd1b2ie= addmr*cd1b2ie+addmi*cd1b2re' O bd1b2i= addmr*cd1b2i+addmi*cd1b2r ' O bd2b1r= addur*cd2b1r-addui*cd2b1i1* O bd2b1re= addur*cd2b1re-addui*cd2b1ie* O bd2b1ie= addur*cd2b1ie+addui*cd2b1re' O bd2b1i= addur*cd2b1i+addui*cd2b1r*' O bd2b2r= addur*cd2b2r-addui*cd2b2i1* O bd2b2re= addur*cd2b2re-addui*cd2b2ie* O bd2b2ie= addur*cd2b2ie+addui*cd2b2re' O bd2b2i= addur*cd2b2i+addui*cd2b2rxG O * 3 O *-----helicity h3-4) O * 3 O h1b34r= 4.d0*(gh7*x25+gh26*x16-gh27*x56-gh28) ' O h1b34i= 16.d0*(-s5*gh24+s14*gh25)45 O h2b34r= 4.d0*(-gh10*x36+gh26*x16-gh28+gh50*x23)+% O h2b34i= 16.d0*(s1*gh46-s8*gh49) O h1b3r= 0.25d0*hb(1)*h1b34r O h1b3i= 0.25d0*hb(1)*h1b34i O h1b4r= 0.25d0*hb(4)*h1b34r! O h1b4i= -0.25d0*hb(4)*h1b34i O h2b3r= 0.25d0*hb(1)*h2b34r O h2b3i= 0.25d0*hb(1)*h2b34i O h2b4r= 0.25d0*hb(4)*h2b34r! O h2b4i= -0.25d0*hb(4)*h2b34ii O *+ O d1b3r= rsz*h1b3r O d1b3re= -aisz*h1b3i  O d1b3ie= rsz*h1b3i  O d1b3i= aisz*h1b3rs O d1b4r= rsz*h1b4r O d1b4re= -aisz*h1b4i  O d1b4ie= rsz*h1b4i  O d1b4i= aisz*h1b4r( O d2b3r= rsz*h2b3r O d2b3re= -aisz*h2b3is O d2b3ie= rsz*h2b3i  O d2b3i= aisz*h2b3r( O d2b4r= rsz*h2b4r O d2b4re= -aisz*h2b4i( O d2b4ie= rsz*h2b4i  O d2b4i= aisz*h2b4r  O * 1 O cd1b3r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b3r 3 O cd1b3re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b3i 2 O cd1b3ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b3i1 O cd1b3i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b3r 1 O cd1b4r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b4r 3 O cd1b4re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b4i 2 O cd1b4ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d1b4i1 O cd1b4i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d1b4r 1 O cd2b3r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b3r 3 O cd2b3re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b3i 2 O cd2b3ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b3i1 O cd2b3i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b3r 1 O cd2b4r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b4r 3 O cd2b4re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b4i 2 O cd2b4ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d2b4i1 O cd2b4i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d2b4r  O * ' O bd1b3r= addmr*cd1b3r-addmi*cd1b3i * O bd1b3re= addmr*cd1b3re-addmi*cd1b3ie* O bd1b3ie= addmr*cd1b3ie+addmi*cd1b3re' O bd1b3i= addmr*cd1b3i+addmi*cd1b3r ' O bd1b4r= addmr*cd1b4r-addmi*cd1b4i * O bd1b4re= addmr*cd1b4re-addmi*cd1b4ie* O bd1b4ie= addmr*cd1b4ie+addmi*cd1b4re' O bd1b4i= addmr*cd1b4i+addmi*cd1b4r3' O bd2b3r= addur*cd2b3r-addui*cd2b3i** O bd2b3re= addur*cd2b3re-addui*cd2b3ie* O bd2b3ie= addur*cd2b3ie+addui*cd2b3re' O bd2b3i= addur*cd2b3i+addui*cd2b3r1' O bd2b4r= addur*cd2b4r-addui*cd2b4i * O bd2b4re= addur*cd2b4re-addui*cd2b4ie* O bd2b4ie= addur*cd2b4ie+addui*cd2b4re' O bd2b4i= addur*cd2b4i+addui*cd2b4r2 O *20 O dth= 9.d0*(bd1b1r+bd2b1r)*(bd1b1r+bd2b1r)- O # 6.d0*bd1b1r*bd2b1r+4 O # 9.d0*(bd1b1re+bd2b1re)*(bd1b1re+bd2b1re)- O # 6.d0*bd1b1re*bd2b1re+4 O # 9.d0*(bd1b1ie+bd2b1ie)*(bd1b1ie+bd2b1ie)- O # 6.d0*bd1b1ie*bd2b1ie+0 O # 9.d0*(bd1b1i+bd2b1i)*(bd1b1i+bd2b1i)- O # 6.d0*bd1b1i*bd2b1i+0 O # 9.d0*(bd1b2r+bd2b2r)*(bd1b2r+bd2b2r)- O # 6.d0*bd1b2r*bd2b2r+4 O # 9.d0*(bd1b2re+bd2b2re)*(bd1b2re+bd2b2re)- O # 6.d0*bd1b2re*bd2b2re+4 O # 9.d0*(bd1b2ie+bd2b2ie)*(bd1b2ie+bd2b2ie)- O # 6.d0*bd1b2ie*bd2b2ie+0 O # 9.d0*(bd1b2i+bd2b2i)*(bd1b2i+bd2b2i)- O # 6.d0*bd1b2i*bd2b2i+0 O # 9.d0*(bd1b3r+bd2b3r)*(bd1b3r+bd2b3r)- O # 6.d0*bd1b3r*bd2b3r+4 O # 9.d0*(bd1b3re+bd2b3re)*(bd1b3re+bd2b3re)- O # 6.d0*bd1b3re*bd2b3re+4 O # 9.d0*(bd1b3ie+bd2b3ie)*(bd1b3ie+bd2b3ie)- O # 6.d0*bd1b3ie*bd2b3ie+0 O # 9.d0*(bd1b3i+bd2b3i)*(bd1b3i+bd2b3i)- O # 6.d0*bd1b3i*bd2b3i+0 O # 9.d0*(bd1b4r+bd2b4r)*(bd1b4r+bd2b4r)- O # 6.d0*bd1b4r*bd2b4r+4 O # 9.d0*(bd1b4re+bd2b4re)*(bd1b4re+bd2b4re)- O # 6.d0*bd1b4re*bd2b4re+4 O # 9.d0*(bd1b4ie+bd2b4ie)*(bd1b4ie+bd2b4ie)- O # 6.d0*bd1b4ie*bd2b4ie+0 O # 9.d0*(bd1b4i+bd2b4i)*(bd1b4i+bd2b4i)- O # 6.d0*bd1b4i*bd2b4i G O * % O *-----Integrals d3-d4 helicity h5-6)  O *  O else if(ih.eq.2) thenx O *( O h3b56r= -8.d0*gh2# O h3b56i= 0.d0/ O h4b56r= 4.d0*(gh1*(-x23*x56+x26*x35)-gh2)5 O h4b56i= 16.d0*s13*gh1 O h3b5r= 0.25d0*hb(2)*h3b56r O h3b5i= 0.25d0*hb(2)*h3b56i O h3b6r= 0.25d0*hb(3)*h3b56r! O h3b6i= -0.25d0*hb(3)*h3b56i O h4b5r= 0.25d0*hb(2)*h4b56r O h4b5i= 0.25d0*hb(2)*h4b56i O h4b6r= 0.25d0*hb(3)*h4b56r! O h4b6i= -0.25d0*hb(3)*h4b56i6 O *3 O d3b5r= rsz*h3b5r O d3b5re= -aisz*h3b5i  O d3b5ie= rsz*h3b5i2 O d3b5i= aisz*h3b5r  O d3b6r= rsz*h3b6r O d3b6re= -aisz*h3 O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O 0i+adddi*cd3b10rF O *  O *-----helicity h11-h12)m O **2 O h1b1112r= 4.d0*(-gh2+gh34*(x13*x46-x16*x34)) O h1b1112i= 16.d0*s8*gh34) O h3b1112r= -8.d0*gh2a O h3b1112i= 0.d0# O h1b11r= 0.25d0*hb(2)*h1b1112rs# O h1b11i= 0.25d0*hb(2)*h1b1112i/# O h1b12r= 0.25d0*hb(3)*h1b1112r2$ O h1b12i= -0.25d0*hb(3)*h1b1112i# O h3b11r= 0.25d0*hb(2)*h3b1112r+# O h3b11i= 0.25d0*hb(2)*h3b1112i # O h3b12r= 0.25d0*hb(3)*h3b1112rs$ O h3b12i= -0.25d0*hb(3)*h3b1112iF O *  O d1b11r= rsz*h1b11r O d1b11re= -aisz*h1b11id O d1b11ie= rsz*h1b11ih O d1b11i= aisz*h1b11r O  O d1b12r= rsz*h1b12r O d1b12re= -aisz*h1b12i= O d1b12ie= rsz*h1b12i  O d1b12i= aisz*h1b12r  O d3b11r= rsz*h3b11r O d3b11re= -aisz*h3b11it O d3b11ie= rsz*h3b11iq O d3b11i= aisz*h3b11r  O d3b12r= rsz*h3b12r O d3b12re= -aisz*h3b12i* O d3b12ie= rsz*h3b12i0 O d3b12i= aisz*h3b12r5 O *13 O cd1b11r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b11r*5 O cd1b11re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b11ix4 O cd1b11ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b11i3 O cd1b11i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b11rs3 O cd1b12r= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b12r15 O cd1b12re= -(hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b12i=4 O cd1b12ie= (hpdcfr*zpucfr-hpdcfi*zpucfi)*d1b12i3 O cd1b12i= (hpdcfr*zpucfi+hpdcfi*zpucfr)*d1b12r23 O cd3b11r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b11r 5 O cd3b11re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b11i(4 O cd3b11ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b11i3 O cd3b11i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b11ra3 O cd3b12r= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b12rs5 O cd3b12re= -(hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b12i14 O cd3b12ie= (hpmcfr*zppcfr-hpmcfi*zppcfi)*d3b12i3 O cd3b12i= (hpmcfr*zppcfi+hpmcfi*zppcfr)*d3b12rs O * * O bd1b11r= addmr*cd1b11r-addmi*cd1b11i- O bd1b11re= addmr*cd1b11re-addmi*cd1b11ies- O bd1b11ie= addmr*cd1b11ie+addmi*cd1b11ref* O bd1b11i= addmr*cd1b11i+addmi*cd1b11r* O bd1b12r= addmr*cd1b12r-addmi*cd1b12i- O bd1b12re= addmr*cd1b12re-addmi*cd1b12iei- O bd1b12ie= addmr*cd1b12ie+addmi*cd1b12red* O bd1b12i= addmr*cd1b12i+addmi*cd1b12r* O bd3b11r= adddr*cd3b11r-adddi*cd3b11i- O bd3b11re= adddr*cd3b11re-adddi*cd3b11iez- O bd3b11ie= adddr*cd3b11ie+adddi*cd3b11ref* O bd3b11i= adddr*cd3b11i+adddi*cd3b11r* O bd3b12r= adddr*cd3b12r-adddi*cd3b12i- O bd3b12re= adddr*cd3b12re-adddi*cd3b12iei- O bd3b12ie= adddr*cd3b12ie+adddi*cd3b12red* O bd3b12i= adddr*cd3b12i+adddi*cd3b12r O * 0 O dth= 9.d0*(bd1b9r+bd3b9r)*(bd1b9r+bd3b9r)- O # 6.d0*bd1b9r*bd3b9r+4 O # 9.d0*(bd1b9re+bd3b9re)*(bd1b9re+bd3b9re)- O # 6.d0*bd1b9re*bd3b9re+4 O # 9.d0*(bd1b9ie+bd3b9ie)*(bd1b9ie+bd3b9ie)- O # 6.d0*bd1b9ie*bd3b9ie+0 O # 9.d0*(bd1b9i+bd3b9i)*(bd1b9i+bd3b9i)- O # 6.d0*bd1b9i*bd3b9i+4 O # 9.d0*(bd1b10r+bd3b10r)*(bd1b10r+bd3b10r)- O # 6.d0*bd1b10r*bd3b10r+8 O # 9.d0*(bd1b10re+bd3b10re)*(bd1b10re+bd3b10re)-" O # 6.d0*bd1b10re*bd3b10re+8 O # 9.d0*(bd1b10ie+bd3b10ie)*(bd1b10ie+bd3b10ie)-" O # 6.d0*bd1b10ie*bd3b10ie+4 O # 9.d0*(bd1b10i+bd3b10i)*(bd1b10i+bd3b10i)- O # 6.d0*bd1b10i*bd3b10i+4 O # 9.d0*(bd1b11r+bd3b11r)*(bd1b11r+bd3b11r)- O # 6.d0*bd1b11r*bd3b11r+8 O # 9.d0*(bd1b11re+bd3b11re)*(bd1b11re+bd3b11re)-" O # 6.d0*bd1b11re*bd3b11re+8 O # 9.d0*(bd1b11ie+bd3b11ie)*(bd1b11ie+bd3b11ie)-" O # 6.d0*bd1b11ie*bd3b11ie+4 O # 9.d0*(bd1b11i+bd3b11i)*(bd1b11i+bd3b11i)- O # 6.d0*bd1b11i*bd3b11i+4 O # 9.d0*(bd1b12r+bd3b12r)*(bd1b12r+bd3b12r)- O # 6.d0*bd1b12r*bd3b12r+8 O # 9.d0*(bd1b12re+bd3b12re)*(bd1b12re+bd3b12re)-" O # 6.d0*bd1b12re*bd3b12re+8 O # 9.d0*(bd1b12ie+bd3b12ie)*(bd1b12ie+bd3b12ie)-" O # 6.d0*bd1b12ie*bd3b12ie+4 O # 9.d0*(bd1b12i+bd3b12i)*(bd1b12i+bd3b12i)- O # 6.d0*bd1b12i*bd3b12i G O * e( O *-----Integrals d2-d4 helicity h13-h14) O *  O else if(ih.eq.4) then1 O *=6 O h2b1314r= 4.d0*(-gh8*x26+gh10*x36+gh28-gh47*x13)( O h2b1314i= -16.d0*(s1*gh46+s12*gh6)7 O h4b1314r= 4.d0*(gh7*x25-gh8*x26-gh9*x35+gh10*x36)e' O h4b1314i= 16.d0*(s11*gh5-s12*gh6) # O h2b13r= 0.25d0*hb(2)*h2b1314ra# O h2b13i= 0.25d0*hb(2)*h2b1314i O # O h2b14r= 0.25d0*hb(3)*h2b1314rd$ O h2b14i= -0.25d0*hb(3)*h2b1314i# O h4b13r= 0.25d0*hb(2)*h4b1314rh# O h4b13i= 0.25d0*hb(2)*h4b1314i(# O h4b14r= 0.25d0*hb(3)*h4b1314r $ O h4b14i= -0.25d0*hb(3)*h4b1314i O ** O d2b13r= rsz*h2b13r O d2b13re= -aisz*h2b13i4 O d2b13ie= rsz*h2b13i* O d2b13i= aisz*h2b13r  O d2b14r= rsz*h2b14r O d2b14re= -aisz*h2b14i  O d2b14ie= rsz*h2b14ih O d2b14i= aisz*h2b14r  O d4b13r= rsz*h4b13r O d4b13re= -aisz*h4b13ib O d4b13ie= rsz*h4b13i* O d4b13i= aisz*h4b13ri O d4b14r= rsz*h4b14r O d4b14re= -aisz*h4b14ih O d4b14ie= rsz*h4b14i* O d4b14i= aisz*h4b14rf O *p3 O cd2b13r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b13rp5 O cd2b13re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b13if4 O cd2b13ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b13i3 O cd2b13i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b13ra3 O cd2b14r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b14r35 O cd2b14re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b14id4 O cd2b14ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b14i3 O cd2b14i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b14rd3 O cd4b13r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b13re5 O cd4b13re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b13ir4 O cd4b13ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b13i3 O cd4b13i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b13ri3 O cd4b14r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b14r 5 O cd4b14re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b14ia4 O cd4b14ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b14i3 O cd4b14i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b14r2 O *2* O bd2b13r= addur*cd2b13r-addui*cd2b13i- O bd2b13re= addur*cd2b13re-addui*cd2b13ie - O bd2b13ie= addur*cd2b13ie+addui*cd2b13re-* O bd2b13i= addur*cd2b13i+addui*cd2b13r* O bd2b14r= addur*cd2b14r-addui*cd2b14i- O bd2b14re= addur*cd2b14re-addui*cd2b14ie9- O bd2b14ie= addur*cd2b14ie+addui*cd2b14re * O bd2b14i= addur*cd2b14i+addui*cd2b14r* O bd4b13r= addpr*cd4b13r-addpi*cd4b13i- O bd4b13re= addpr*cd4b13re-addpi*cd4b13iee- O bd4b13ie= addpr*cd4b13ie+addpi*cd4b13red* O bd4b13i= addpr*cd4b13i+addpi*cd4b14r* O bd4b14r= addpr*cd4b14r-addpi*cd4b14i- O bd4b14re= addpr*cd4b14re-addpi*cd4b14ie+- O bd4b14ie= addpr*cd4b14ie+addpi*cd4b14re#* O bd4b14i= addpr*cd4b14i+addpi*cd4b14rF O *  O *-----helicity h15-h16)6 O **C O h2b1516r= 2.d0*(-gh11*x35+gh12*(-x13*x24*x56+x13*x26*x45+x14*-> O # x23*x56-x14*x26*x35-x16*x23*x45+x16*x24*x35+x36*x45)-> O # gh13*x56-gh15*x14*x36-gh16*x24*x36+gh17*x13+gh18*x16+ O # gh19*x23+gh20*x26)+> O h2b1516i= 8.d0*(s1*gh12*x56-s6*gh13-s7*gh12*x26-s8*gh15-' O # s13*gh12*x14+s14*gh12*x13) C O h4b1516r= 2.d0*(-gh11*x35+gh12*(-x13*x24*x56+x13*x26*x45+x14*2> O # x23*x56-x14*x26*x35-x16*x23*x45+x16*x24*x35+x36*x45)-> O # gh13*x56+2.d0*gh14*x14*x35-gh15*x14*x36-gh16*x24*x36-7 O # gh17*x13+gh18*x16+gh19*x23+gh20*x26-2.d0*gh21) ? O h4b1516i= 8.d0*(s2*gh11-s4*gh12*x36-s6*gh13+2.d0*s7*gh14-e* O # s8*gh15-s12*gh16+s15*gh12)# O h2b15r= 0.25d0*hb(1)*h2b1516rr# O h2b15i= 0.25d0*hb(1)*h2b1516i O # O h2b16r= 0.25d0*hb(4)*h2b1516r3$ O h2b16i= -0.25d0*hb(4)*h2b1516i# O h4b15r= 0.25d0*hb(1)*h4b1516r2# O h4b15i= 0.25d0*hb(1)*h4b1516i0# O h4b16r= 0.25d0*hb(4)*h4b1516rb$ O h4b16i= -0.25d0*hb(4)*h4b1516i O *5 O d2b15r= rsz*h2b15r O d2b15re= -aisz*h2b15i5 O d2b15ie= rsz*h2b15i  O d2b15i= aisz*h2b15r5 O d2b16r= rsz*h2b16r O d2b16re= -aisz*h2b16i= O d2b16ie= rsz*h2b16ir O d2b16i= aisz*h2b16rs O d4b15r= rsz*h4b15r O d4b15re= -aisz*h4b15i3 O d4b15ie= rsz*h4b15ir O d4b15i= aisz*h4b15r  O d4b16r= rsz*h4b16r O d4b16re= -aisz*h4b16i  O d4b16ie= rsz*h4b16i  O d4b16i= aisz*h4b16r  O *63 O cd2b15r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b15rd5 O cd2b15re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b15ir4 O cd2b15ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b15i3 O cd2b15i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b15r 3 O cd2b16r= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b16rh5 O cd2b16re= -(hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b16ip4 O cd2b16ie= (hppcfr*zpmcfr-hppcfi*zpmcfi)*d2b16i3 O cd2b16i= (hppcfr*zpmcfi+hppcfi*zpmcfr)*d2b16r*3 O cd4b15r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b15rp5 O cd4b15re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b15ic4 O cd4b15ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b15i3 O cd4b15i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b15rh3 O cd4b16r= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b16rd5 O cd4b16re= -(hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b16if4 O cd4b16ie= (hpucfr*zpdcfr-hpucfi*zpdcfi)*d4b16i3 O cd4b16i= (hpucfr*zpdcfi+hpucfi*zpdcfr)*d4b16rp O *r* O bd2b15r= addur*cd2b15r-addui*cd2b15i- O bd2b15re= addur*cd2b15re-addui*cd2b15iec- O bd2b15ie= addur*cd2b15ie+addui*cd2b15re5* O bd2b15i= addur*cd2b15i+addui*cd2b15r* O bd2b16r= addur*cd2b16r-addui*cd2b16i- O bd2b16re= addur*cd2b16re-addui*cd2b16ie - O bd2b16ie= addur*cd2b16ie+addui*cd2b16red* O bd2b16i= addur*cd2b16i+addui*cd2b16r* O bd4b15r= addpr*cd4b15r-addpi*cd4b15i- O bd4b15re= addpr*cd4b15re-addpi*cd4b15iea- O bd4b15ie= addpr*cd4b15ie+addpi*cd4b15re** O bd4b15i= addpr*cd4b13i+addpi*cd4b16r* O bd4b16r= addpr*cd4b16r-addpi*cd4b16i- O bd4b16re= addpr*cd4b16re-addpi*cd4b16iee- O bd4b16ie= addpr*cd4b16ie+addpi*cd4b16rei* O bd4b16i= addpr*cd4b16i+addpi*cd4b16r O * 4 O dth= 9.d0*(bd2b13r+bd4b13r)*(bd2b13r+bd4b13r)- O # 6.d0*bd2b13r*bd4b13r+8 O # 9.d0*(bd2b13re+bd4b13re)*(bd2b13re+bd4b13re)-" O # 6.d0*bd2b13re*bd4b13re+8 O # 9.d0*(bd2b13ie+bd4b13ie)*(bd2b13ie+bd4b13ie)-" O # 6.d0*bd2b13ie*bd4b13ie+4 O # 9.d0*(bd2b13i+bd4b13i)*(bd2b13i+bd4b13i)- O # 6.d0*bd2b13i*bd4b13i+4 O # 9.d0*(bd2b14r+bd4b14r)*(bd2b14r+bd4b14r)- O # 6.d0*bd2b14r*bd4b14r+8 O # 9.d0*(bd2b14re+bd4b14re)*(bd2b14re+bd4b14re)-" O # 6.d0*bd2b14re*bd4b14re+8 O # 9.d0*(bd2b14ie+bd4b14ie)*(bd2b14ie+bd4b14ie)-" O # 6.d0*bd2b14ie*bd4b14ie+4 O # 9.d0*(bd2b14i+bd4b14i)*(bd2b14i+bd4b14i)- O # 6.d0*bd2b14i*bd4b14i+4 O # 9.d0*(bd2b15r+bd4b15r)*(bd2b15r+bd4b15r)- O # 6.d0*bd2b15r*bd4b15r+8 O # 9.d0*(bd2b15re+bd4b15re)*(bd2b15re+bd4b15re)-" O # 6.d0*bd2b15re*bd4b15re+8 O # 9.d0*(bd2b15ie+bd4b15ie)*(bd2b15ie+bd4b15ie)-" O # 6.d0*bd2b15ie*bd4b15ie+4 O # 9.d0*(bd2b15i+bd4b15i)*(bd2b15i+bd4b15i)- O # 6.d0*bd2b15i*bd4b15i+4 O # 9.d0*(bd2b16r+bd4b16r)*(bd2b16r+bd4b16r)- O # 6.d0*bd2b16r*bd4b16r+8 O # 9.d0*(bd2b16re+bd4b16re)*(bd2b16re+bd4b16re)-" O # 6.d0*bd2b16re*bd4b16re+8 O # 9.d0*(bd2b16ie+bd4b16ie)*(bd2b16ie+bd4b16ie)-" O # 6.d0*bd2b16ie*bd4b16ie+4 O # 9.d0*(bd2b16i+bd4b16i)*(bd2b16i+bd4b16i)- O # 6.d0*bd2b16i*bd4b16i) O *b O endifb O * O *-----Totali O *d O if(omssm.eq.'n') thenb O hcfs= 1.d0d O else if(omssm.eq.'y') then% O hcfs= (sbma*salpha/cbeta)**2 O O endif=& O hcf= rbqm2/vv/64.d0/cth4**2*hcfs O dth= hcf*dth O *c% O 4 if(iz.eq.0) thenb) O dpxs(ix,it)= 0.d0r O iz= 1 O  O elsee: O tjac= ujc*vjc*smjc*spjc*sujc*sdjc*, O # sfjc*twjc*t1jc: O dpxs(ix,it)= 0.25d0*tjac*stf*dth/s O endif O *b O *-----end of ix loop O *  O enddo O * O 0 O cpxs(it)= dpxs(1,it)+dpxs(2,it) O *b O 2 if(iz.eq.0) then O O bpxs(it)= 0.d0 O iz= 1p O else6$ O bpxs(it)= cpxs(it) O endif O *d O *-----end on it loop O * O  O enddop O *d O 1 if(iz.eq.0) then O apxs= 0.d0r O iz= 1 O else" O apxs= bpxs(1)+bpxs(2) O endif3 O *e O if(apxs.lt.0.d0) thend O ifz(41)= ifz(41)+1d O resf= 0.d0b O else O resf= apxs* O endifi O * O  O if(oqcd.eq.'y') then O nf= 5' O alsh= wtoralphas(wm,hm,als,nf) D O fqcd= 1.d0+alsh/pi*(17.d0/3.d0+(35.94d0-1.36d0*nf)*alsh/pi)4 O fqcd= fqcd*(1.d0+0.5d0*alsz/pi*(fcdn-1.d0)) O else O fqcd= 1.d0d O endif# O * % O wtoxsh64= tfact*resf*bfact*fqcde O * O  O if(om.eq.'g') then O if(osm.eq.'n') then O jp= iwtopos(ndim,x)#! O if(ostop.eq.'s') then  O ifp= ifl(jp)+8 O if(wtoxsh64.ne.0.d0.and.ifp.lt.5000) then( O stry(jp,ifp)= wtoxsh640 O if(wtoxsh64.gt.xshmx(jp)) then( O xshmx(jp)= wtoxsh64 O endif O $ O ifl(jp)= ifl(jp)+1= O else if(wtoxsh64.ne.0.d0.and.ifp.gt.5000) then30 O if(wtoxsh64.gt.xshmx(jp)) then+ O stry(jp,ifp)= wtoxsh64*' O ifl(jp)= ifl(jp)+1r O endifd O endif O else- O if(wtoxsh64.gt.xshmx(jp)) thend% O xshmx(jp)= wtoxsh64  O do l=1,9& O xmxh(jp,l)= x(l) O enddo  O endif O endif9 O endif O xaph(1)= xm O xaph(2)= xp O xaph(3)= sm O xaph(4)= sp O xaph(5)= su O xaph(6)= sd O xaph(7)= sf O xaph(8)= tw O xaph(9)= t1 O xaph(10)= t31 O endif  O * O return O end1 * i O *0G O *-----WTOXSA64---------------------------------------------------------2 O **& O real*8 function wtoxsa64(ndim,x) O implicit real*8 (a-h,o-z)*) O character*1 om,osm,ostop,oqcd,omssm O  O character*4 otype  O * - O parameter(ninv=10,npos=512,ifmax=10000)  O *  O common/wtihl/ih O  O common/wtmod/omb O common/wtmp/zrmz O common/wtqcd/als O common/wthiggs/hm= O common/wtsmod/osm  O common/wtim/ostope O common/wtkount/ik= O common/wtdis/distr O common/wtqcdz/alsz O common/wtaqcd/oqcd O common/wtbme/bfact O common/wtistrf/isf O common/wtsf/ix0,it0r O common/wtchi/hch(36) O common/wtipt/ifz(44) O common/wtmssmo/omssm O common/wtnf/ifl(npos)i O common/wticuts/iac(4)  O common/wtisa/isaa,isab O common/wtochannel/otypez O common/wthx/xshmx(npos)  O common/wtparh/xaph(ninv)F O common/wttc/itc,itcc,itcn O common/wtpmxh/xmxh(npos,9)$ O common/wtstor/stry(npos,ifmax)/ O common/wtmssmi/am,tbeta,rmu,scalm,bat,babr2 O common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr3 O common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdni6 O common/wthapar/rhm,rhm2,rhg,rhmg,shg,shgs,opshgs? O common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwip> O common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmyD O common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw,) O # eta,feta,beta,g2,tfacth9F O common/wtapar/ars,s,rwm,rwm2,rwg,rwmg,swg,swgs,opswgs,sth2,cth2,E O # hsth2,tsth2,scth2,asth2,tth2,rzm,rzm2,rzg,rzmg,szg,bC O # szgs,opszgs,sth4,cth4,ve,vf,vfp,rbqm2,rszw,rszw2,i O # s0w,s0z H O common/wtsubreg/dsm,usm,dsp,usp,rl(6),rr(6),srl(6),sdsm,sdsp,vvl1,* O # vvl2,vvl3,ul,omul,sumlF O common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6),A O # ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4),b? O # sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24,a= O # cg24,sg34,cg34,sct120,sct130,sct140,sct230, O / O # sct240,sct340,sgam(4),cgam(4) D O common/wtmssm/ams,shm,shms,bhm,bhms,sbeta,cbeta,salpha,calpha,? O # sbma,cbma,rshm,rshm2,rshg,rshmg,sshg,sshgs,6E O # opsshgs,rbhm,rbhm2,rbhg,rbhmg,sbhg,sbhgs,opsbhgs, O 5 O # ram,ram2,rag,ramg,sag,sags,opsags2 O * O  O dimension hb(4)( O dimension tgn(58)r O dimension x(ndim) O  O dimension bt1(2),bt2(2)1 O dimension rru1(2),rru2(2)h O dimension sfur(2),sflr(2)( O dimension ret1(2),ret2(2)0 O dimension ee(5),e(5),sg(5)% O dimension rrr(6),rrl(6),srrl(6) ( O dimension bl(4),xbl(4),ss(4),cs(4)) O dimension dpxs(2,2),cpxs(2),bpxs(2) 5 O dimension dthr(12),dthre(12),dthie(12),dthi(12) 5 O dimension d1hr(12),d1hre(12),d1hie(12),d1hi(12) 5 O dimension d2hr(12),d2hre(12),d2hie(12),d2hi(12) 5 O dimension d3hr(12),d3hre(12),d3hie(12),d3hi(12) 5 O dimension d4hr(12),d4hre(12),d4hie(12),d4hi(12) 9 O dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2)19 O dimension cd1hr(12),cd1hre(12),cd1hie(12),cd1hi(12)i9 O dimension cd2hr(12),cd2hre(12),cd2hie(12),cd2hi(12)u9 O dimension cd3hr(12),cd3hre(12),cd3hie(12),cd3hi(12))9 O dimension cd4hr(12),cd4hre(12),cd4hie(12),cd4hi(12)19 O dimension bd1hr(12),bd1hre(12),bd1hie(12),bd1hi(12) 9 O dimension bd2hr(12),bd2hre(12),bd2hie(12),bd2hi(12)d9 O dimension bd3hr(12),bd3hre(12),bd3hie(12),bd3hi(12)29 O dimension bd4hr(12),bd4hre(12),bd4hie(12),bd4hi(12)p9 O dimension ad1hr(12),ad1hre(12),ad1hie(12),ad1hi(12)z9 O dimension ad2hr(12),ad2hre(12),ad2hie(12),ad2hi(12)f9 O dimension ad3hr(12),ad3hre(12),ad3hie(12),ad3hi(12)m9 O dimension ad4hr(12),ad4hre(12),ad4hie(12),ad4hi(12)p O *)4 O data ec2/-0.4999999963d0/,ec4/0.0416666418d0/,4 O # ec6/-0.0013888397d0/,ec8/0.0000247609d0/, O # ec10/-0.0000002605d0/ O *p# O external c02ajf,s09aaf,s07aafb O external s21bbf,s21caf O *)" O *-----the order of integration is:5 O * u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1d O * 16 O * m_{+/-}^2 transformed for the resonating peaks6 O * M_0^2,m_0^2 transformed for the resonating peaks4 O * m^2 and t_1 transformed for the jacobian peaks O *2 O s0sh= rshm2/opsshgsd O s0a= ram2/opsags O *i O do ix=1,2  O do it=1,2! O dpxs(ix,it)= 0.d0r O enddo O enddo  O do it=1,2a O cpxs(it)= 0.d01 O bpxs(it)= 0.d03 O enddo  O *b O if(ndim.eq.6) then O smx= x(1) O sux= x(2) O sdx= x(3) O sfx= x(4) O twx= x(5) O t1x= x(6) O else if(ndim.eq.7) then  O smx= x(1) O spx= x(2) O sux= x(3) O sdx= x(4) O sfx= x(5) O twx= x(6) O t1x= x(7) O else if(ndim.eq.8) then3 O uvx= x(1) O vvx= x(2) O smx= x(3) O sux= x(4) O sdx= x(5) O sfx= x(6) O twx= x(7) O t1x= x(8) O else if(ndim.eq.9) then6 O uvx= x(1) O vvx= x(2) O smx= x(3) O spx= x(4) O sux= x(5) O sdx= x(6) O sfx= x(7) O twx= x(8) O t1x= x(9) O endif3 O *r O ik= ik+1 rs= arsd O one= 1.d0+ O wm2= wm*wm O * ( O *-----if a point is not allowed then the O * result is set to zero3 O *i O iz= 1  O *d% O if(ndim.eq.6.or.ndim.eq.7) then1 O ueps= 0.d0r O uv= 1.d0  O uvs= uv*uv1 O ujc= 1.d0 O veps= 0.d0b O vv= 1.d0 O  O vjc= 1.d0* O else if(ndim.eq.8.or.ndim.eq.9) then O *1, O *-----independent invariants are initialized O * first u and v variable O *b O if(itc.eq.3) then? O omuld= 1.d0-(dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm))r# O omul= dmin1(omul,omuld)  O endif O if(uvx.gt.1.d0) then1 O iz= 01 O ifz(1)= ifz(1)+1 O go to 1 O  O endif% O ueps= omul*(1.d0-uvx)**hbeti- O uv= 1.d0-ueps O ujc= omul**hbet O uvs= uv*uv* O *1 O *-----limits for v O *  O *-----from equal cuts on SA  O * + O if(iac(3).eq.1.and.isab.eq.1) then ' O vvl4= ombsa(1)/opbsa(1)*uvs + O vvl= dmax1(vvl1,vvl2,vvl3,vvl4)) else & O vvl= dmax1(vvl1,vvl2,vvl3) O endif O *2 O *-----from E O *1 O vve= uv*(2.d0*suml-uv). O vvll= dmax1(vvl,vve)0 O *6 O if(itc.eq.3) then: O vvlld= dist/rs+sqrt(dsm))*(dist/rs+sqrt(dsm))# O vvll= dmax1(vvll,vvlld)  O endif O *( O vvu1= uv + O if(iac(3).eq.1.and.isaa.eq.1) then ' O vvu2= omasa(1)/opasa(1)*uvs5! O vvu= dmin1(vvu1,vvu2). else3 O vvu= uv0 O endif O uvl= uv-vvll  O ** O vkf= (uv-vvu)/uvl O if(vkf.lt.0.d0) thenb O iz= 0  O ifz(1)= ifz(1)+1 O go to 1r" O else if(vkf.eq.0.d0) then O if(vvx.gt.1.d0) then O iz= 0 O ifz(1)= ifz(1)+13 O go to 1% O else if(vvx.eq.1.d0) then  O veps= 0.d0  O else) O veps= uvl*(1.d0-vvx)**hbeti1 O endifp O avkf= 1.d0 elsez8 O veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti O avkf= 1.d0-vkf**hbet O endif O vv= uv-veps O vjc0= 1.d0-vvll/uvc O if(vjc0.le.0.d0) then O iz= 0p O ifz(1)= ifz(1)+1 O go to 1f else) O vjc= vjc0**hbet*avkf O endif O endif O  O *  O if(vv.lt.0.d0) thenp O iz= 0 O ifz(1)= ifz(1)+1r O go to 1 O endif O  O svv= sqrt(vv)c O vamg= ramg*vvf O vshmg= rshmg*vv3 O vbhmg= rbhmg*vvf O vvs= vv*vv O xm= uv O xp= vv/uv c O xmop= xm/xp O % O if(ndim.eq.7.or.ndim.eq.6) thend O xdf= 0.d0 O else( O xdf= (ueps*(1.d0-ueps)-veps)/uv O endifh O xdfs= xdf*xdfp O sh= vv*s O *  O *-----Z parameters O *+ O rszm2= zm*zm/sh O  O * O 1 O *-----Z propagator (real part and imaginary part)d O *3 O dsz0= 1.d0-rszm2 O dsz= dsz0*dsz0+rszw2 O rsz= dsz0/dszc O aisz= -rszw/dsz= O *dC O *-----Reduced structure functions are computed with arguments xp,xm O  O *  O opxp= 1.d0+xpb O opxm= 1.d0+xm O  O omxp= veps/uv* O omxm= ueps O if(isf.eq.0) thend O stfp= 1.d01 O stfm= 1.d0d O else if(isf.gt.0) then O if(omxp.eq.0) thend O stfp= d0gl elseb" O rcpx= 0.25d0*opxp*opxp O rcpy= xp O iflp= 1=( O rclp= s21baf(rcpx,rcpy,iflp)3 O stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+d- O # feta*(-4.d0*opxp*log(omxp)+d7 O # 3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp))  O endif O if(omxm.eq.0) then- O stfm= d0gl else " O rcmx= 0.25d0*opxm*opxm O rcmy= xm O iflm= 1x( O rclm= s21baf(rcmx,rcmy,iflm)3 O stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+*- O # feta*(-4.d0*opxm*log(omxm)+17 O # 3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm))# O endif O endifx O *  O stf= stfp*stfm O *gI O *-----if there is no upper cut on some FS IM, then the maximum is allowedx O *x O do j=1,6 O if(rr(j).eq.1.d0) then O rrr(j)= rr(j) O else O rrr(j)= rr(j)/vv* O endif* O rrl(j)= rl(j)/vv O srrl(j)= srl(j)/svv. O enddo O  O * & O *-----cuts become special near xp = xm O * ! O if(abs(xdf).gt.1.d-15) then  O ieq= 10( O bxe= vv/(ueps*(1.d0-ueps)-veps) O if(xdf.gt.0.d0) then2 O enc= 1.d0 " O else if(xdf.lt.0.d0) then O enc= xmop) O endif O else O ieq= 06 O bxe= 1.d0 O endif4% O if(ieq.eq.0.and.xm.le.teq) then  O iz= 0 O ifz(1)= ifz(1)+1r O go to 1 O endifh O *57 O if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then= O sct12= sct120/vvr O sct13= sct130/vvs O sct14= sct140/vv O  O sct23= sct230/vv3 O sct24= sct240/vvr O sct34= sct340/vv O else O sct12= 0.d0 O sct13= 0.d0 O sct14= 0.d0 O sct23= 0.d0 O sct24= 0.d0 O sct34= 0.d0 O endifm O * O  O *-----cuts on E( O *c O do j=1,4 O if(ieq.eq.1) then5# O bl(j)= 2.d0*rae(j)/xdf1# O xbl(j)= 2.d0*rae(j)/xpc O else if(ieq.eq.0) then" O bl(j)= 2.d0*rae(j)/xm O endife O enddom O *+ O *-----cuts on SA O *p O if(iac(3).ne.0) then O do j=1,4*% O if(sgam(j).eq.1.d0) thenp O ss(j)= 0.d0d O elsef7 O ss(j)= 1.d0+sgam(j)/(1.d0-sgam(j))*xmop+! O ss(j)= 1.d0/ss(j)5 O endif% O if(cgam(j).eq.0.d0) thenp O cs(j)= 1.d0b O else=7 O cs(j)= 1.d0+cgam(j)/(1.d0-cgam(j))*xmop(! O cs(j)= 1.d0/cs(j)f O endif O enddo O endif4 O *i" O *-----initialization of sm = m_-^2 O *z O zma1= dsmr O zma2= vv*sct12 O zmb1= usm2! O zmb2= (svv-sdsp)*(svv-sdsp)e4 O zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34)) O if(ieq.eq.0) then=$ O zma3= vv*(bl(1)+bl(2)-1.d0)- O zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))*6) O # (1.d0-0.5d0*(bl(3)+bl(4)))d O zmb5= vv*(1.d0-bl(3)) O zmb6= vv*(1.d0-bl(4)) O else if(ieq.eq.1) then& O zma3= vv*(-enc+xbl(1)+xbl(2))2 O zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))*' O # (1.d0+enc-xbl(3)-xbl(4))  O zmb5= vv*(enc-xbl(3)) O zmb6= vv*(enc-xbl(4)) O endif4! O xzma= dmax1(zma1,zma2,zma3)e0 O xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6) O *iC O *-----limits on sm from cuts on SA. Here for maximum security. Rare= O *d O if(iac(3).eq.0) then O zma= xzma O zmb= xzmb O else 4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) then# O szma= xzmae O szmb= xzmb ( O else if(ss(3).gt.ss(1)) then O szmb= xzmb2 O adsp= dsp/vvd( O axszma= dmax1(adsp,sct34)5 O axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/*% O # (ss(3)-ss(1)))b' O szma= dmax1(axszma,xzma)d( O else if(ss(3).lt.ss(1)) then& O if(ss(3).lt.0.5d0) then O szma= xzma= O axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2#* O szmb= dmin1(axszmb,xzmb) O else2 O iz= 0 " O ifz(2)= ifz(2)+1 O go to 12 O endif O endife else  O szma= xzma O szmb= xzmb O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) then6 O zma= szma O zmb= szmb( O else if(cs(3).gt.cs(1)) then& O if(cs(3).gt.0.5d0) then O zma= szmae= O axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2i) O zmb= dmin1(axczmb,szmb)  O elsei O iz= 01" O ifz(3)= ifz(3)+1 O go to 1) O endif( O else if(cs(3).lt.cs(1)) then O zmb= szmb O  O adsp= dsp/vv+ O axczma= dmax1(adsp,sct34) 8 O axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/( O # (cs(3)-cs(1)))) O zma= dmax1(axczma,szma)i O endif else  O zma= szma  O zmb= szmb  O endif O endifm O if(itc.eq.3) then#* O dzmb= (svv-dist/rs)*(svv-dist/rs) O zmb= dmin1(zmb,dzmb)= O endifs O *d O *-----test on sm O *  O if(zmb.le.zma) thenf O iz= 0 O ifz(4)= ifz(4)+1  O go to 1 O endif  O *c! O if(ih.eq.1.or.ih.eq.2) then O  O rmm2= ram2e O rmmg= ramg  O smgs= sags0 O vmmg= vamgz O smg= sag  O s0m= s0a & O else if(ih.eq.3.or.ih.eq.4) then O rmm2= rshm2 O rmmg= rshmg O smgs= sshgs O vmmg= vshmg O smg= sshg O s0m= s0sh O endif  O zmas= zma-rmm2 O zmbs= zmb-rmm2 O atma= (zmas+smgs*zma)/rmmg O atmb= (zmbs+smgs*zmb)/rmmg, O if(atma.gt.1.d0.and.atmb.gt.1.d0) then O atma= 1.d0/atma O atma= atan(atma)c O zmat= (pih-atma)/vmmg O atmb= 1.d0/atmb O atmb= atan(atmb)c O zmbt= (pih-atmb)/vmmg! O smjc0= (-atmb+atma)/vmmgf2 O else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then O atma= 1.d0/atma O atma= atan(atma)x O zmat= (pih-atma)/vmmg O atmb= -1.d0/atmb O  O atmb= atan(atmb)n O zmbt= (-pih+atmb)/vmmg#$ O smjc0= (-pi+atmb+atma)/vmmg6 O else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then O atma= 1.d0/atma O atma= atan(atma)y O zmat= (pih-atma)/vmmg O atmb= atan(atmb)j O zmbt= atmb/vmmg% O smjc0= (-pih+atmb+atma)/vmmg 2 O else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then O atma= -1.d0/atma6 O atma= atan(atma)t O zmat= (-pih+atma)/vmmg6 O atmb= 1.d0/atmb O atmb= atan(atmb)p O zmbt= (pih-atmb)/vmmg# O smjc0= (pi-atmb-atma)/vmmg 3 O else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then  O atma= -1.d0/atma. O atma= atan(atma)  O zmat= (-pih+atma)/vmmg  O atmb= -1.d0/atmb  O atmb= atan(atmb)) O zmbt= (-pih+atmb)/vmmg O O smjc0= (atmb-atma)/vmmg7 O else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) thenp O atma= -1.d0/atma  O atma= atan(atma)  O zmat= (-pih+atma)/vmmg( O atmb= atan(atmb)f O zmbt= atmb/vmmg$ O smjc0= (pih+atmb-atma)/vmmg6 O else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then O atma= atan(atma)4 O zmat= atma/vmmg O atmb= 1.d0/atmb O atmb= atan(atmb)n O zmbt= (pih-atmb)/vmmg$ O smjc0= (pih-atmb-atma)/vmmg7 O else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then O  O atma= atan(atma), O zmat= atma/vmmg O atmb= -1.d0/atmb  O atmb= atan(atmb)  O zmbt= (-pih+atmb)/vmmgq% O smjc0= (-pih+atmb-atma)/vmmg ; O else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) thenk O atma= atan(atma)s O zmat= atma/vmmg O a b= atan(atmb)/ O zmbt= atmb/vmmg O smjc0= (atmb-atma)/vmmg O endifs O *x O zmv= smjc0*smx+zmath iftn= 1o O atnm= vmmg*zmv- O sm= s0m/vv*(1.d0+smg*s07aaf(atnm,iftn))( O if(iftn.ne.0) print 300c O if(sm.lt.0.d0) thena O iz= 0 O ifz(4)= ifz(4)+1  O go to 1 O endif  O ssm= sqrt(sm)n O smjc= vv*smjc0 O *t- O 300 format(/' Unsuccesful call to S07AAF ')  O * O " O *-----initialization of sp = m_+^2 O *  O zpa1= dspy O zpb1= usp $ O zpb2= vv*(1.d0-ssm)*(1.d0-ssm) O *aC O *-----limits on sp from cuts on SA. Here for maximum security. Rarew O *h O if(iac(3).eq.0) then O zpb= dmin1(zpb1,zpb2) O zpa= zpa1 O else 4 O if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then # O if(ss(3).eq.ss(1)) then,% O azpb= dmin1(zpb1,zpb2)  O azpa= zpa1h( O else if(ss(3).gt.ss(1)) then= O zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))),* O azpb= dmin1(zpb1,zpb2,zpb3) O azpa= zpa1,( O else if(ss(3).lt.ss(1)) then% O azpb= dmin1(zpb1,zpb2)4= O zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1))) O % O azpa= dmax1(zpa1,zpa2)l O endifs else  O azpa= zpa1" O azpb= dmin1(zpb1,zpb2) O endif4 O if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then # O if(cs(3).eq.cs(1)) then4 O zpa= azpa O zpb= azpb( O else if(cs(3).gt.cs(1)) then O zpb= azpb= O bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1))),$ O zpa= dmax1(azpa,bzpa)( O else if(cs(3).lt.cs(1)) then O zpa= azpa= O bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1)))s$ O zpb= dmin1(azpb,bzpb) O endif elsea O zpa= azpas O zpb= azpbo O endif O endif( O *r O if(ieq.eq.0) then O ' O zpen= vv*(1.d0-bl(1)-bl(2)+sm)i( O zmen= vv*(-1.d0+bl(3)+bl(4)+sm) O zpa= dmax1(zpa,zmen)o O zpb= dmin1(zpb,zpen)s O else if(ieq.eq.1) then( O zpel= vv*(sm-enc+xbl(3)+xbl(4))) O zpeu1= vv*(sm+enc-xbl(1)-xbl(2))s O zpeu2= vv*(enc-xbl(1))  O zpeu3= vv*(enc-xbl(2))d O zpa= dmax1(zpa,zpel)s* O zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3) O endifo O zpap= vv*sct34 O zpa= dmax1(zpa,zpap) O *s O *-----test on sp O *) O if(zpb.le.zpa) then  O iz= 0 O ifz(5)= ifz(5)+1( O go to 1 O endif2 O *, O if(itc.eq.3) then2 O bdistl= dist*dist/s-zpa O bdistu= zpb-dist*dist/s2 O if(bdistl.le.0.d0.or.bdistu.le.0.d0) then O iz= 0  O ifz(5)= ifz(5)+1 O go to 1i O endif O endifc O *i! O if(ih.eq.1.or.ih.eq.2) thend O rpm2= rshm2 O rpmg= rshmg O spgs= sshgs O vpmg= vshmg O spg= sshg O s0p= s0sh& O else if(ih.eq.3.or.ih.eq.4) then O rpm2= ram2d O rpmg= ramgd O spgs= sagss O vpmg= vamg1 O spg= sag( O s0p= s0ao O endifd O if(itc.eq.3) then( O sp= (dist/rs/svv)**2,, O spjc= 2.d0*dist/s/((vv*sp-rpm2)**2+ O # (vv*sp*spg)**2)2 O else O zpas= zpa-rpm29 O zpbs= zpb-rpm24# O atpa= (zpas+spgs*zpa)/rpmg0# O atpb= (zpbs+spgs*zpb)/rpmg1/ O if(atpa.gt.1.d0.and.atpb.gt.1.d0) thena O atpa= 1.d0/atpa1 O atpa= atan(atpa)! O zpat= (pih-atpa)/vpmg_ O atpb= 1.d0/atpb, O atpb= atan(atpb)! O zpbt= (pih-atpb)/vpmgi$ O spjc0= (-atpb+atpa)/vpmg5 O else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) thene O atpa= 1.d0/atpa O  O atpa= atan(atpa)! O zpat= (pih-atpa)/vpmgi O atpb= -1.d0/atpb O atpb= atan(atpb)" O zpbt= (-pih+atpb)/vpmg' O spjc0= (-pi+atpb+atpa)/vpmg(9 O else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then  O atpa= 1.d0/atpa  O atpa= atan(atpa)! O zpat= (pih-atpa)/vpmgx O atpb= atan(atpb) O zpbt= atpb/vpmgi( O spjc0= (-pih+atpb+atpa)/vpmg5 O else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then) O atpa= -1.d0/atpa O atpa= atan(atpa)" O zpat= (-pih+atpa)/vpmg O atpb= 1.d0/atpbx O atpb= atan(atpb)! O zpbt= (pih-atpb)/vpmg)& O spjc0= (pi-atpb-atpa)/vpmg6 O else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then O atpa= -1.d0/atpa O atpa= atan(atpa)" O zpat= (-pih+atpa)/vpmg O atpb= -1.d0/atpb O atpb= atan(atpb)" O zpbt= (-pih+atpb)/vpmg# O spjc0= (atpb-atpa)/vpmg : O else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then O atpa= -1.d0/atpa O atpa= atan(atpa)" O zpat= (-pih+atpa)/vpmg O atpb= atan(atpb) O zpbt= atpb/vpmg ' O spjc0= (pih+atpb-atpa)/vpmg 9 O else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then O  O atpa= atan(atpa) O zpat= atpa/vpmge O atpb= 1.d0/atpbz O atpb= atan(atpb)! O zpbt= (pih-atpb)/vpmg O ' O spjc0= (pih-atpb-atpa)/vpmg): O else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then O atpa= atan(atpa) O zpat= atpa/vpmg  O atpb= -1.d0/atpb O atpb= atan(atpb)" O zpbt= (-pih+atpb)/vpmg( O spjc0= (-pih+atpb-atpa)/vpmg> O else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then O atpa= atan(atpa) O zpat= atpa/vpmgi O atpb= atan(atpb) O zpbt= atpb/vpmg(# O spjc0= (atpb-atpa)/vpmga O endif O *v O zpv= spjc0*spx+zpat O iftn= 1 O atnp= vpmg*zpvd0 O sp= s0p/vv*(1.d0+spg*s07aaf(atnp,iftn)) O if(iftn.ne.0) print 300 O spjc= vv*spjc0t O endif O  O *  O if(sp.lt.0.d0) thent O iz= 0 O ifz(5)= ifz(5)+1l O go to 1 O endife O ssp= sqrt(sp)u O spmm= sp-sm( O smmp= sm-spa O *. O cbw= -1.d0+sp-sm ifcr= 0a* O call c02ajf(one,cbw,sm,bt1,bt2,ifcr) O if(bt1(2).ne.0.d0) then  O iz= 0 O ifz(6)= ifz(6)+1v O go to 1 O endif) O *l O smtp= sm*spt O ssmpp= ssm+ssp O ssmmp= ssm-ssp O asup= 1.d0-ssmpp*ssmpp O asum= 1.d0-ssmmp*ssmmp+ O if(asup.lt.0.d0.or.asum.lt.0.d0) then  O iz= 0 O ifz(7)= ifz(7)+1i O go to 1 O endif  O rasup= sqrt(asup)e O rasum= sqrt(asum)  O * " O *-----initialization of su = M_0^2 O * O % O *-----limits on su from cuts on FS IMt O * O  O sulim= rrl(4)  O suuim1= rrr(4)5 O suuim2= (1.d0-srrl(3))*(1.d0-srrl(3)) h! O suuim= dmin1(suuim1,suuim2)  O *0@ O *-----limits on su from Delta_- > 0 (as derived from consistency O * on sd limits)  O *(/ O suud1= 0.25d0*(rasup+rasum)*(rasup+rasum) - O suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup)  O *e O sul= sulim O sul= dmax1(sul,sct23)  O if(ieq.eq.0) then O  O sul1= bl(2)+bl(3)-1.d0  O suu1= 1.d0-sp-bl(1) O suu2= 1.d0-sm-bl(4)* O suu3= (1.d0-0.5d0*(bl(1)+bl(4)))** O # (1.d0-0.5d0*(bl(1)+bl(4))) O else if(ieq.eq.1) then* O sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc O suu1= enc-sp-xbl(1) O suu2= enc-sm-xbl(4)+ O suu3= (enc-0.5d0*(xbl(1)+xbl(4)))*1* O # (enc-0.5d0*(xbl(1)+xbl(4))) O endif  O sul= dmax1(sul,sul1)2 O suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3) O *g O *-----test on su O *m O if(suu.le.sul) thens O iz= 0 O ifz(8)= ifz(8)+1 O  O go to 1 O endifz O *r! O if(ih.eq.1.or.ih.eq.3) thenr O rum2= rshm2 O rumg= rshmg O sugs= sshgs O vumg= vshmg O sug= sshg O s0u= s0sh& O else if(ih.eq.2.or.ih.eq.4) then O rum2= ram2  O rumg= ramg  O sugs= sagsn O vumg= vamg. O sug= sag  O s0u= s0a O endif  O zuas= vv*sul-rum2* O zubs= vv*suu-rum2p# O atua= (zuas+vv*sugs*sul)/rumgc# O atub= (zubs+vv*sugs*suu)/rumg , O if(atua.gt.1.d0.and.atub.gt.1.d0) then O atua= 1.d0/atua O atua= atan(atua)  O zuat= (pih-atua)/vumg O atub= 1.d0/atub O atub= atan(atub). O zubt= (pih-atub)/vumg! O sujc0= (-atub+atua)/vumg 2 O else if(atua.gt.1.d0.and.atub.lt.-1.d0) then O atua= 1.d0/atua O atua= atan(atua)  O zuat= (pih-atua)/vumg O atub= -1.d0/atub  O atub= atan(atub)l O zubt= (-pih+atub)/vumg0$ O sujc0= (-pi+atub+atua)/vumg6 O else if(atua.gt.1.d0.and.abs(atub).lt.1.d0) then O atua= 1.d0/atua O atua= atan(atua)t O zuat= (pih-atua)/vumg O atub= atan(atub)( O zubt= atub/vumg% O sujc0= (-pih+atub+atua)/vumg 2 O else if(atua.lt.-1.d0.and.atub.gt.1.d0) then O atua= -1.d0/atua  O atua= atan(atua)  O zuat= (-pih+atua)/vumg  O atub= 1.d0/atub O atub= atan(atub)) O zubt= (pih-atub)/vumg# O sujc0= (pi-atub-atua)/vumg 3 O else if(atua.lt.-1.d0.and.atub.lt.-1.d0) then O  O atua= -1.d0/atua0 O atua= atan(atua)o O zuat= (-pih+atua)/vumg  O atub= -1.d0/atube O atub= atan(atub)  O zubt= (-pih+atub)/vumg O O sujc0= (atub-atua)/vumg7 O else if(atua.lt.-1.d0.and.abs(atub).lt.1.d0) thenq O atua= -1.d0/atuaa O atua= atan(atua)s O zuat= (-pih+atua)/vumg  O atu O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O (ss(1)-ss(4))*sm)/tcuts 6 O sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-p+ O # (cs(1)-cs(4))*sm)/tcutc O * O asfl= dmax1(sflim,sflsa,sflsb)# O asfu= sfuim 6 O else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then6 O sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-5 O # (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-b+ O # (ss(1)-ss(4))*sm)/tcuts o6 O sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-5 O # (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp- + O # (cs(1)-cs(4))*sm)/tcutc $ O asfl= dmax1(sflim,sflsa)$ O asfu= dmin1(sfuim,sfusa) O endif O else O asfl= sflim O asfu= sfuim O endif  O *s O if(ieq.eq.0) thena O asfenl1= bl(1)-sm-sd) O asfenl2= bl(3)-sp-su " O asfenu1= 1.d0-bl(2)-sp-sd" O asfenu2= 1.d0-bl(4)-sm-su O else if(ieq.eq.1) then' O asfenl1= 1.d0-enc-sm-sd+xbl(1) ' O asfenl2= 1.d0-enc-sp-su+xbl(3)d" O asfenu1= enc-sp-sd-xbl(2)" O asfenu2= enc-sm-su-xbl(4) O endif1' O asfl= dmax1(asfl,asfenl1,asfenl2) ' O asfu= dmin1(asfu,asfenu1,asfenu2).# O aasfu= 1.d0-sm-sp-su-sd-sct24  O asfl= dmax1(asfl,sct13)s O asfu= dmin1(asfu,aasfu)  O *  O if(iac(3).ne.0) then O if(ss(4).ne.ss(3)) then O if(ss(4).gt.ss(3)) then O 5 O asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+m7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3))n# O asfl= dmax1(asfl,asfltw) % O else if (ss(4).lt.ss(3)) then=5 O asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+s7 O # ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3))z# O asfu= dmin1(asfu,asfutw)s endif O O endif O if(cs(1).ne.cs(2)) then O if(cs(1).gt.cs(2)) then)9 O bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+n. O # cs(2)-bt1(1))/(cs(1)-cs(2))# O asfl= dmax1(asfl,bsfltw) $ O else if(cs(1).lt.cs(2)) then9 O bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+ / O # cs(2)-bt1(1))/(cs(1)-cs(2)) O # O asfu= dmin1(asfu,bsfutw) endifa O endif O if(cs(4).ne.cs(3)) then O if(cs(4).gt.cs(3)) then ; O csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm- 0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfu= dmin1(asfu,csfutw)d$ O else if(cs(4).lt.cs(3)) then; O csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm-v0 O # cs(4)*su+cs(4))/(cs(4)-cs(3))# O asfl= dmax1(asfl,csfltw)p endifp O endif O if(ss(1).ne.ss(2)) then O if(ss(1).gt.ss(2)) then16 O dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfu= dmin1(asfu,dsfutw) $ O else if(ss(1).lt.ss(2)) then6 O dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+0 O # ss(2)*sd-ss(2))/(ss(1)-ss(2))# O asfl= dmax1(asfl,dsfltw)) endifp O endif O endif  O *  O *-----positivity of R^2  O *  O scp= ssmpp*ssmpp  O scm= ssmmp*ssmmp $ O snp= (ssu+ssd)*(ssu+ssd) $ O snm= (ssu-ssd)*(ssu-ssd)  O rlp= ssu*ssd+ssp*ssm O rlm= ssu*ssd-ssp*ssm O bsgmo= bsg-1.d0  O ombsg2= ombsg*ombsg/ O rlps= rlp*rlpb O rlms= rlm*rlm  O edelp= ombsg2-4.d0*rlps  O edelm= ombsg2-4.d0*rlms O " O edeld= 16.d0*ssu*ssd*ssp*ssm O *a7 O *-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2  O * then Delta_+ > 0 O * *-----control0 O *p O cnt1= scp+snm  O cnt2= scm+snp + O if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then( O iz= 0 O ifz(10)= ifz(10)+1p O go to 1 O endifh O if(edelm.le.0.d0) then O etest= edeld+edelpm O if(etest.gt.0.d0) then O  O edelm= etest else  O iz= 0p O ifz(11)= ifz(11)+1 O go to 1  O endif O endifd O sedm= sqrt(edelm) O ifcr= 0a. O call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr) O if(rr1(2).ne.0.d0) then  O iz= 0 O ifz(12)= ifz(12)+1t O go to 1 O endif O ifcr= 0v. O call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr) O *v O cnt3= scp+snp= O cnt4= scm+snma O cbru= -1.d0  O ccru= 0.5d0*bsgt O *0< O *-----R^2 has two real roots and two complex conjugate roots O *)+ O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then5 O if(bsg.gt.0.5d0) then O iel= 1 O sflr(1)= rr1(1)  O sfur(1)= rr2(1)b O sflr(2)= rr1(1)a O sfur(2)= rr2(1)m else O  O iel= 2 O ifcr= 0i5 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1)m O sflr(2)= ru2 O sfur(1)= ru1 O sfur(2)= rr2(1)e O endif O * O  O *-----R^2 has four real roots  O * 1 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then  O if(bsg.gt.0.5d0) then O sflr(1)= rr1(1)2 O sflr(2)= rs2(1)  O sfur(1)= rs1(1)i O sfur(2)= rr2(1)( else2 O ifcr= 005 O call c02ajf(one,cbru,ccru,rru1,rru2,ifcr) O ru1= rru1(1)*rru1(1) O ru2= rru2(1)*rru2(1) O sflr(1)= rr1(1) O & O sfur(1)= dmin1(rs1(1),ru1)& O sflr(2)= dmax1(rs2(1),ru2) O sfur(2)= rr2(1)u O endif O endifl O *t. O *-----the loop for transforming sf starts here O *) O if(om.eq.'g') then O itmn= it0 O itmx= it0 O else O itmn= 1 O itmx= 2 O endif  O do it=itmn,itmx)$ O if(sflr(it).ge.asfl) then O sfl= sflr(it)) O else  O sfl= asfl) O endif$ O if(sfur(it).le.asfu) then O sfu= sfur(it)  O else* O sfu= asfun O endif O *1 O *-----test on sf O *= O if(sfu.le.sfl) then O iz= 0e O ifz(13)= ifz(13)+1 O go to 2 O  O endif O *8F O *-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0 O *r0 O if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then O er= rs1(1) O es= abs(rs1(2))g O er1= rr1(1)  O er2= rr2(1)  O ek2= edelm/edeld O ek= sqrt(ek2)g$ O dog= -2.d0/sqrt(edeld)) O ecpl= (ombsg-2.d0*sfl)/sedmi) O ecpu= (ombsg-2.d0*sfu)/sedmv O eql= ecpl*ecpl O equ= ecpu*ecpu) O omecpl= 2.d0*(sfl-er1)/sedmt) O es2pl= omecpl*(2.d0-omecpl)=! O erl= 1.d0-ek2*es2pla O espl= sqrt(es2pl)g) O opecpu= 2.d0*(er2-sfu)/sedma) O es2pu= opecpu*(2.d0-opecpu) O  O espu= sqrt(es2pu) ! O eru= 1.d0-ek2*es2puu O if(eql.eq.1) then1 O sflt= 0.d0( O else O ifel= 19 O sflt= -dog*espl*s21bbf(eql,erl,one,ifel)z# O if(ifel.ne.0) then0 O iz= 0 & O ifz(14)= ifz(14)+1 O go to 2d O endif O endifz" O if(equ.eq.1.d0) then O sfut= 0.d0a O else O ifel= 19 O sfut= -dog*espu*s21bbf(equ,eru,one,ifel) # O if(ifel.ne.0) then= O iz= 0=& O ifz(15)= ifz(15)+1 O go to 2b O endif O endifs O if(iel.eq.1) then # O if(sfu.le.er) thend O efac= 0.5d0u- O sft= (sfut-sflt)*sfx+sflt( O ifel= 1u! O asf= -sft/dog(; O call s21caf(asf,ek2,elsn,elcn,edn,ifel)u& O if(ifel.ne.0) then O iz= 0) O ifz(16)= ifz(16)+1= O go to 2 O endifu/ O sf= 0.5d0*(ombsg-sedm*elcn) * O sfjc= efac*(sfut-sflt)) O else if(sfl.ge.er) then  O efac= 0.5d0 - O sft= (sflt-sfut)*sfx+sfut  O ifel= 1 ! O asf= -sft/dogs; O call s21caf(asf,ek2,elsn,elcn,edn,ifel)n& O if(ifel.ne.0) then O iz= 0) O ifz(17)= ifz(17)+1  O go to 2 O endif / O sf= 0.5d0*(ombsg+sedm*elcn)b* O sfjc= efac*(sflt-sfut) O else O efac= 1.d0 O qbar= 0.d0" O rbar= 1.d0-ek2 O ifel= 1i: O sfbar= -dog*s21bbf(qbar,rbar,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(18)= ifz(18)+1s O go to 2 O endifi$ O if(it.eq.1) then1 O sft= (sfbar-sflt)*sfx+sflti O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) then  O iz= 0d, O ifz(19)= ifz(19)+1! O go to 21 O endif2 O sf= 0.5d0*(ombsg-sedm*elcn). O sfjc= efac*(sfbar-sflt)* O else if(it.eq.2) then1 O sft= (sfbar-sfut)*sfx+sfut O  O ifel= 1$ O asf= -sft/dog> O call s21caf(asf,ek2,elsn,elcn,edn,ifel)) O if(ifel.ne.0) then( O iz 0h, O ifz(20)= ifz(20)+1! O go to 2  O endif2 O sf= 0.5d0*(ombsg+sedm*elcn). O sfjc= efac*(sfbar-sfut) O endif O endif $ O else if(iel.eq.2) then O efac= 1.d0" O if(it.eq.1) then. O sft= (sfut-sflt)*sfx+sflt O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) then  O iz= 01* O ifz(21)= ifz(21)+1 O go to 2d O endif0 O sf= 0.5d0*(ombsg-sedm*elcn)+ O sfjc= efac*(sfut-sflt)d' O else if(it.eq.2) then . O sft= (sflt-sfut)*sfx+sfut O ifel= 1" O asf= -sft/dog< O call s21caf(asf,ek2,elsn,elcn,edn,ifel)' O if(ifel.ne.0) thens O iz= 0 * O ifz(22)= ifz(22)+1 O go to 2u O endif0 O sf= 0.5d0*(ombsg+sedm*elcn)+ O sfjc= efac*(sflt-sfut)q O endif  O endif16 O else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then$ O if(edelp.le.0.d0) then O iz= 0# O ifz(23)= ifz(23)+1s O go to 2 O endifs O sedp= sqrt(edelp)4 O efac= 1.d0 O es1= rs1(1)e O es2= rs2(1)  O er1= rr1(1)  O er2= rr2(1) O  O ssed= sedm+sedpe" O ek= (sedm-sedp)/ssed O ek2= ek*ek O dog= 2.d0/ssed O if(it.eq.1) then. O es2pl= (er1-sfl)/(sfl-er2)/ek. O es2pu= (er1-sfu)/(sfu-er2)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu# O else if(it.eq.2) thenh. O es2pl= (sfl-es2)/(sfl-es1)/ek. O es2pu= (sfu-es2)/(sfu-es1)/ek O eql= 1.d0-es2pl O equ= 1.d0-es2pu$ O erl= 1.d0-ek2*es2pl$ O eru= 1.d0-ek2*es2pu O endif % O if(eql.eq.1.d0) thenl O sflt= 0.d0 O elsed O ifel= 1a/ O sflt= 2.d0*dog*sqrt(es2pl)* 2 O # s21bbf(eql,erl,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(24)= ifz(24)+1. O go to 2 O endift O endif% O if(equ.eq.1.d0) thent O sfut= 0.d0 O elsea O ifel= 1a? O if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then O equ= 0.d0 O endif / O sfut= 2.d0*dog*sqrt(es2pu)* O 2 O # s21bbf(equ,eru,one,ifel)& O if(ifel.ne.0) then O iz= 0) O ifz(25)= ifz(25)+1= O go to 2 O endifd O endif* O sft= (sfut-sflt)*sfx+sflt O ifel= 1# O asf= 0.5d0/dog*sftl8 O call s21caf(asf,ek2,elsn,elcn,edn,ifel)! O elsn2= elsn*elsn O # O if(ifel.ne.0) then  O iz= 0 & O ifz(26)= ifz(26)+1 O go to 2e O endif! O if(it.eq.1) then=: O sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)& O else if(it.eq.2) then: O sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2) O endif' O sfjc= efac*(sfut-sflt)  O endif O *= O *-----auxiliary quantities  O *  O sdpf= sd+sf O e3= sp+su+sf O  O e4= 1.d0+spmm-e3m O e3p4= 1.d0+spmm O e1= sm+sdpf O e2= 1.d0+smmp-e1b( O e1p2= 1.d0+smmp $ O e1p3= e1+e3 0 O e1m2= 2.d0*e1-1.d0+spmm  O ep12= xp*e1*e2a O ep1= xp*e1  O ep2= xp*e2z O ep3= xp*e3  O ep4= xp*e4  O e1t2= e1*e2 O e1t3= e1*e3 O e1t4= e1*e4 O e2t3= e2*e3 O e2t4= e2*e4 O e3t4= e3*e4/ O if((e1p3*e1p3-4.d0*sf).lt.0.d0) then  O iz= 0! O ifz(27)= ifz(27)+1  O go to 2 O endif( O skl2= sqrt(e1p3*e1p3-4.d0*sf)+ O if((sdmus-4.d0*sd).lt.0.d0) theni O iz= 0! O ifz(28)= ifz(28)+1 O  O go to 2 O endif O skl3= sdmus-4.d0*sd O skl3= sqrt(skl3)m O *f O *-----initialization of t_wu O *,) O *-----limits on tw from positivity and SAo O *A O twlp1= 0.d0 O twlp2= smmp O twlp3= spmm-1.d0() O twlp= dmax1(twlp1,twlp2,twlp3)a O twup= 1.d0 O  O * " O *-----limits on tw from cuts on SA O *) O if(iac(3).ne.0) thenc& O skl2m= 0.5d0*(e1p3-skl2)& O skl2p= 0.5d0*(e1p3+skl2), O skl3p= -0.5d0*(1.d0+sdmu-skl3), O skl3m= -0.5d0*(1.d0+sdmu+skl3), O twlsa1= 1.d0-cs(3)*e3-cs(4)*e4' O twlsa2= ss(1)*e1+ss(2)*e2 8 O twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m4 O twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m4 O twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p8 O twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m, O twusa1= 1.d0-ss(3)*e3-ss(4)*e4' O twusa2= cs(1)*e1+cs(2)*e2t8 O twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m4 O twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m4 O twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p8 O twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m; O atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,u( O # twlsa5,twlsa6); O atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,4( O # twusa5,twusa6) O elses O atwl= twlp O atwu= twup O endif O *# O *-----limits on tw from Es O *c O if(ieq.eq.1) then. O atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)) O atwue= bxe*e1p2-bl(1)-bl(2)s" O if(xdf.gt.0.d0) then O twle= atwle O twue= atwue' O else if(xdf.lt.0.d0) then % O atwle1= bxe*e1-bl(1))% O atwle2= bxe*e2-bl(2)-* O atwue1= 1.d0-bxe*e3+bl(3)* O atwue2= 1.d0-bxe*e4+bl(4)1 O twle= dmax1(atwue,atwle1,atwle2) 1 O twue= dmin1(atwle,atwue1,atwue2)s O endif)$ O atwl= dmax1(atwl,twle)$ O atwu= dmin1(atwu,twue) O endif O *  O *-----natural limits on tw O * O # O atwl= dmax1(atwl,bt1(1))f# O atwu= dmin1(atwu,bt2(1))  O *3 O *-----test on tw O *f O if(atwu.le.atwl) then O iz= 0- O ifz(29)= ifz(29)+1 O go to 2e O endif O *  O twjc= atwu-atwl O tw= twjc*twx+atwl O pn= tw+sp-1.d0f O omtw= 1.d0-tw O *  O *-----initialization of t1 O *a% O *-----limits on t1 from positivity+SAu O *f O t1lp1= 0.d0 O t1lp2= pn+sdpf  O t1up1= tw O t1up2= sm+sdpfn# O t1lp= dmax1(t1lp1,t1lp2)e# O t1up= dmin1(t1up1,t1up2)h O * O " O *-----limits on t1 from cuts on SA O *  O if(iac(3).ne.0) then) O t1lc1= ss(1)*e1 O t1lc2= tw-cs(2)*e2; O t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3)) 5 O t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)*/ O t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3s4 O t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4 O t1uc1= cs(1)*e1 O O t1uc2= tw-ss(2)*e2; O t1uc3= cs(3)*e3-( w-0.5d0*(1.d0+sdmu+skl3))t5 O t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3) / O t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3f4 O t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4> O t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)> O t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)$ O at1l= dmax1(t1lp,t1lc)$ O at1u= dmin1(t1up,t1uc) O else  O at1l= t1lp O at1u= t1up O endif O *( O *-----limits on t1 from E  O *  O if(ieq.eq.1) then$ O at1le= tw-bxe*e2+bl(2)! O at1ue= bxe*e1-bl(1))" O if(xdf.gt.0.d0) then O t1le= at1le O t1ue= at1ue O else O t1le= at1ue O t1ue= at1le O endif($ O at1l= dmax1(at1l,t1le)$ O at1u= dmin1(at1u,t1ue) O endif O **4 O *-----positivity of (R')^2 / reality of roots for t3 O *s! O rp0= e1p2*e1p2-4.d0*sms O if(rp0.lt.0.d0) thens O iz= 0 O ifz(30)= ifz(30)+1 O go to 2  O endif O srp0= sqrt(rp0) O rp0e= -rp0l, O rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2 O rp1e= 2.d0*rp1 & O rp2= -(e1*tw-sm)*(e1*tw-sm) O if(rp0e.eq.0.d0) then O iz= 0+ O ifz(31)= ifz(31)+1 O go to 2l O endif O ifct= 0 O if(rp0e.ne.0.d0) then7 O call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct)l/ O rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) & O t1l= dmax1(at1l,ret1(1))& O t1u= dmin1(at1u,ret2(1))% O else if(rp0e.eq.0.d0) then  O sret1= -rp2/rp1e# O if(rp1e.gt.0.d0) then+' O t1l= dmax1(at1l,sret1). O t1u= at1u( O else if(rp1e.lt.0.d0) then O t1l= at1l' O t1u= dmin1(at1u,sret1) O  O endif+ O endif O *t O *-----test on t1 O *  O if(t1u.le.t1l) then O iz= 0z O ifz(31)= ifz(31)+1 O go to 2  O endif O * ! O *-----transformation for jacobian O  O * O if(rp0e.eq.0.d0) then0 O taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)0 O taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2) O t1jc= taut-tauli9 O t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e2 O endif" O if(ret1(1).eq.t1l) then O at1tl= -pih/srp0 O else O 0 O bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l) O ifas= 1f- O at1tl= -s09aaf(bt1tl,ifas)/srp0i% O if(ifas.ne.0) print 2001 O endif" O if(ret2(1).eq.t1u) then O at1tu= pih/srp01 O else 1 O bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)2 O ifas= 1 O - O at1tu= -s09aaf(bt1tu,ifas)/srp0,% O if(ifas.ne.0) print 200) O endif) O if((at1tl+at1tu).eq.0.d0) then1# O if(t1x.lt.1.d-3) then  O arc= pi*t1x O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc/ O else if((1.d0-t1x).lt.1.d-3) then1# O arc= pi*(1.d0-t1x)  O arc2= arc*arc4 O exc= arc2*(ec2+arc2*(ec4+arc2*(ec6+- O # arc2*(ec8+arc2*ec10)))) 8 O t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc O else" O carc= cos(pi*t1x)- O t1= 0.5d0*(ret1(1)+ret2(1))+11 O # 0.5d0*(ret1(1)-ret2(1))*carcp O endifs O t1jc= pi/srp0q O else & O t1tl= dmin1(at1tl,at1tu)& O t1tu= dmax1(at1tl,at1tu) O t1jc= t1tu-t1tln O t1t= t1jc*t1x+t1tl. O t1= (rp1+rpds*sin(srp0*t1t))/rp0 O endif O t1s= t1*t1  O * 1 O 200 format(' Unsuccesful call to S09AAF ')  O *  O *-----test on t1 from FS A O * / O if(ieq.eq.1.and.iac(4).ne.0.d0) thenf/ O cnlct1= xp*(xm*sm-ep12*cg12)+xdf*s7 O # ep1*cg12*tw+xdf*cg12*t1*(ep2-ep1-z+ O # xdf*tw)+xdfs*cg12*t1sd/ O cnlst1= xp*(ep12*sg12-xm*sm)-xdf*D7 O # ep1*sg12*tw+xdf*sg12*t1*(ep1-ep2+.+ O # xdf*tw)-xdfs*sg12*t1ss% O if(cnlct1.lt.0.d0) then  O iz= 0# O ifz(32)= ifz(32)+1  O go to 2* O else if(cnlst1.lt.0.d0) then O iz= 0# O ifz(33)= ifz(33)+1d O go to 2 O endif O  O endif O *p O *-----some vector components O *c O t2= tw-t1c O *  O *-----equation for xi is solved  O *s O e1s= e1*e1= O e2s= e2*e2- O e3s= e3*e3  O e12= e1t2-2.d0*sm O e13= e1t3-2.d0*sf O e23= e2t3-2.d0*su O e12s= e12*e12 O e13s= e13*e13 O e23s= e23*e23 O xia= e1s*e2s-e12s= O xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23- < O # e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+ O # e2*e12*e13= O xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1* > O # e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0*< O # t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1*> O # e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s*< O # e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*; O # e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23  O xib= 2.d0*xib! O if(xia.eq.0.d0) then $ O if(xib.eq.0.d0) then O iz= 0% O ifz(34)= ifz(34)+1e O go to 2 O endif O rtm(1)= -xic/xib O rtp(1)= rtm(1) O rtm(2)= 0.d0 O rtp(2)= 0.d0 O ixia= 0  O elses O ixia= 1u O ifc0= 0i5 O call c02ajf(xia,xib,xic,rtm,rtp,ifc0)  O endif$ O if(rtm(2).ne.0.d0) then O iz= 0 " O ifz(35)= ifz(35)+1 O go to 2 O  O endif O *c O *-----xi^+ and xi^- are computed O * # O xip= 0.5d0*(e3-rtp(1)) # O xim= 0.5d0*(e3-rtm(1))  O * . O *-----each integral becomes a sum of two terms O *l O *-----loop over ix starts here O */ O if(om.eq.'g') then O ixmn= ix0 O ixmx= ix0 O else O ixmn= 1 O ixmx= 2 O endif  O do ix=ixmn,ixmx  O * ) O *-----q_3 is compared and x15 is selected  O *n" O if(ix.eq.1) then O t3= xip' O else if(ix.eq.2) then  O t3= xim O endif  O * % O *-----The two integrands are computed  O *r" O *-----further auxiliary quantities O *i O edn1= ep1-xdf*t1* O edn2= ep2-xdf*t2  O edn3= ep3-xdf*t3 O  O t4= omtw-t3 O edn4= ep4-xdf*t4  O *(% O *-----collections of all limits on t3 O  O * % O *-----from energy (or natural limits)  O * O if(ieq.eq.1) then* O at3l1= omtw-bxe*e4+bl(4)% O at3u1= bxe*e3-bl(3) & O if(xdf.gt.0.d0) then O t3l1= at3l1 O t3u1= at3u1+ O else if(xdf.lt.0.d0) then O t3l1= at3u1 O t3u1= at3l1 O endif  O elsee O t3l1= 0.d0 O t3u1= e3 O endif O *j O *-----natural limits O * . O t3l2= -t1+0.5d0*(e1p3-skl2). O t3u2= -t1+0.5d0*(e1p3+skl2) O * 7 O t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3)d7 O t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)e O *i O *-----from positivity on SAi O *f O t3l4= 0.d0 $ O t3l5= sm+su+sf-tw! O t3u4= sp+su+sf  O t3u5= omtw  O * *-----from SAd O * O ' O if(iac(3).ne.0) thene# O t3l6= ss(3)*e3=# O t3u6= cs(3)*e3 ( O t3l7= omtw-cs(4)*e4( O t3u7= omtw-ss(4)*e44 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,/ O # t3l5,t3l6,t3l7) O 4 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,/ O # t3u5,t3u6,t3u7)e O else 9 O t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5) 9 O t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)  O endif O * O  O *-----limits on t3 are imposed O * , O tlimt3= (t3u-t3)*(t3-t3l)& O if(t3u.lt.t3l) then O iz= 0 ( O ifz(36)= ifz(36)+1 O go to 4e/ O else if(tlimt3.lt.0.d0) then  O iz= 0e( O ifz(36)= ifz(36)+1 O go to 4  O endif O * , O *-----non linear limits on t3,t4 are imposed O * 4 O if(iac(4).ne.0.and.ieq.eq.1) then3 O tnl13c= -cg13*edn1*edn3+vv*sf 2 O tnl13s= sg13*edn1*edn3-vv*sf3 O tnl23c= -cg23*edn2*edn3+vv*su.2 O tnl23s= sg23*edn2*edn3-vv*su3 O tnl14c= -cg14*edn1*edn4+vv*sdz2 O tnl14s= sg14*edn1*edn4-vv*sd* O sres= 1.d0-e1-e3+sf 5 O tnl24c= -cg24*edn2*edn4+vv*srese4 O tnl24s= sg24*edn2*edn4-vv*sres3 O tnl34c= -cg34*edn3*edn4+vv*spe2 O tnl34s= sg34*edn3*edn4-vv*sp= O if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or. = O # tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or.k= O # tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or. = O # tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or. ? O # tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then O  O iz= 0+ O ifz(37)= ifz(37)+1e O go to 4+ O endif . O endif O *u: O *-----non linear constraints from FS A in the case xp = xm O * 7 O if(iac(4).ne.0.d0.and.ieq.eq.0) then . O smr= 1.d0-sm-sp-su-sd-sf; O spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm)l; O spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf)#; O spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd) ; O spc23= (-cg23*e2t3+su)*(sg23*e2t3-su) = O spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr)o; O spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp) M O if(spc12.lt.0.d0.or.spc13.lt.0.d0.or. N O # spc14.lt.0.d0.or.spc23.lt.0.d0.or. = O # spc24.lt.0.d0.or.spc34.lt.0.d0) then  O iz= 0+ O ifz(38)= ifz(38)+1 O go to 4 O endif  O endif O *  O *-----all invariants O *  O x13= t1 O x14= t2 O x15= t3 O x16= t4 O x23= e1-t1- O x24= e2-t2i O x25= e3-t3d O x26= e4-t4  O x34= sm O x35= sf O x36= sd O x45= su' O x46= 1.d0-e1-e3+sf( O x56= sp O *  O *-----computes cross-section O *fB O *-----born matrix element is calculated at the reduced c.m. energy O *l, O *-----The epsilons are computed in the order9 O * epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4),s9 O * epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4), 9 O * epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4),i9 O * epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4),=8 O * epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4) O *d" O x13s= x13*x13" O x14s= x14*x14" O x15s= x15*x15" O x16s= x16*x16" O x23s= x23*x23" O x24s= x24*x24" O x25s= x25*x25" O x26s= x26*x26" O x34s= x34*x34" O x35s= x35*x35" O x36s= x36*x36" O x45s= x45*x45" O x46s= x46*x46" O x56s= x56*x56G O * > O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+A O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34s > O ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+A O # x15*x23*x35)-x13s*x25s-x15s*x23s-x35ss> O ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+A O # x15*x24*x45)-x14s*x25s-x15s*x24s-x45s B O ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+A O # x14*x15*x34*x35)-x13s*x45s-x14s*x35s-o% O # x15s*x34s(B O ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+A O # x24*x25*x34*x35)-x23s*x45s-x24s*x35s-d% O # x25s*x34s1G O *  O e(1)= 1.d0 F O e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*E O # x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14*4C O # x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35sE O e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-2F O # x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-D O # x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45F O e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*G O # x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14*sF O # x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 G O e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14* C O # (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15* D O # 2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+$ O # x25*x34s O *  O *-----sign of eps_1*eps_ib O *) O ises= 0" O sg(1)= 0.25d0+ O if(ee(1).lt.0.d0) thena$ O ises= ises+1 O endif O do i=2,5w2 O if(abs(e(i)).lt.zrm) then( O ises= ises+12 O else if(e(i).gt.zrm) then) O sg(i)= 0.25d0,3 O else if(e(i).lt.-zrm) thent* O sg(i)= -0.25d0 O endif/ O if(ee(i).lt.0.d0) then ( O ises= ises+1 O endif O enddo O *)' O if(ises.eq.0) theni/ O ses1= sg(1)*sqrt(ee(1)) / O ses2= sg(2)*sqrt(ee(2))e/ O ses3= sg(3)*sqrt(ee(3))l/ O ses4= sg(4)*sqrt(ee(4))+/ O ses5= sg(5)*sqrt(ee(5))t O s1= ses1 O s2= ses2& O s3= -ses1-ses2 O s4= ses3% O s5= ses1-ses3l% O s6= ses2+ses3= O s7= ses4% O s8= ses1-ses4 % O s9= ses2+ses4 & O s10= ses3-ses4! O s11= ses5(' O s12= -ses1-ses5 ' O s13= -ses2+ses5m' O s14= -ses3-ses53' O s15= -ses4-ses55 O else4A O ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+ O D O # x14*x23*x34)-x13s*x24s-x14s*x23s-x34sA O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+=D O # x16*x23*x36)-x13s*x26s-x16s*x23s-x36sA O ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+cD O # x16*x24*x46)-x14s*x26s-x16s*x24s-x46sE O ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+pD O # x14*x16*x34*x36)-x13s*x46s-x14s*x36s-( O # x16s*x34sE O ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+tE O # x24*x26*x34*x36)-x23s*x46s-x24s*x36s-f) O # x26s*x34se" O e(1)= 1.d0> O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+B O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-C O # x14*x16*x23s+x14*x23*x36+x16*x23*x34--2 O # x13s*x24*x26-x34*x36@ O e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*@ O # x24*x46-x14*x16*x23*x24+x14*(-x23*@ O # x46+2.d0*x24*x36-x26*x34)-x16*x24*6 O # x34+x14s*x23*x26+x34*x46@ O e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*? O # x34)+x13*x16*x24*x34+x13*x34*x46+ > O # x14*x16*x23*x34+x14*x34*x36-x16*= O # x34s-x13s*x24*x46-x14s*x23*x36 @ O e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*> O # x24s)+x14*(-x23*x24*x36-x23*x26*A O # x34+x46*x23s)+x16*2.d0*x23*x24*x34- > O # x23*x34*x46-x24*x34*x36+x26*x34s O ises= 0)% O sg(1)= 0.25d0l. O if(ee(1).lt.0.d0) then' O ises= ises+1  O endif O do i=2,55 O if(abs(e(i)).lt.zrm) then O + O ises= ises+1 5 O else if(e(i).gt.zrm) then , O sg(i)= 0.25d06 O else if(e(i).lt.-zrm) then- O sg(i)= -0.25d0*! O endifr2 O if(ee(i).lt.0.d0) then+ O ises= ises+1a! O endif O  O enddoh* O if(ises.eq.0) then2 O ses1= sg(1)*sqrt(ee(1))2 O ses2= sg(2)*sqrt(ee(2))2 O ses3= sg(3)*sqrt(ee(3))2 O ses4= sg(4)*sqrt(ee(4))2 O ses5= sg(5)*sqrt(ee(5))# O s1= ses1-) O s2= -ses1-ses2 # O s3= ses2f) O s4= -ses1-ses3e# O s5= ses3 ) O s6= -ses2-ses3 ( O s7= ses1-ses4# O s8= ses4 ) O s9= -ses2-ses4(* O s10= -ses3+ses4* O s11= -ses1-ses5$ O s12= ses5) O s13= ses2-ses5.) O s14= ses3+ses5t) O s15= ses4+ses5  O elseD O ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+C O # x15*x23*x35)-x13s*x25s-x15s*x23s-l& O # x35sD O ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+C O # x16*x23*x36)-x13s*x26s-x16s*x23s-c& O # x36sD O ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+C O # x16*x25*x56)-x15s*x26s-x16s*x25s- & O # x56sD O ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*A O # x56+x15*x16*x35*x36)-x13s*x56s- O 5 O # x15s*x36s-x16s*x35s D O ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*A O # x56+x25*x26*x35*x36)-x23s*x56s-c5 O # x25s*x36s-x26s*x35sfG O * A O e(1)= x13*x14*x23*x25+x13*x15*x23*x24+tE O # x13*(-2.d0*x23*x45+x24*x35+x25*x34)- B O # x14*x15*x23s+x14*x23*x35+x15*x23*9 O # x34-x13s*x24*x25-x34*x35 O A O e(2)= x13*x14*x23*x26+x13*x16*x23*x24+pE O # x13*(-2.d0*x23*x46+x24*x36+x26*x34)-aB O # x14*x16*x23s+x14*x23*x36+x16*x23*9 O # x34-x13s*x24*x26-x34*x362B O e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+D O # x13*(-x25*x46+x26*x45)+x14*x15*x23*F O # x26-x14*x16*x23*x25+x14*(x25*x36-x26*F O # x35)+x15*(-x23*x46+x24*x36)+x16*(x23*= O # x45-x24*x35)+x35*x46-x36*x45 O C O e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15*#E O # (x23*x46-x26*x34)+x13*x16*(-x23*x45+ D O # x25*x34)+x13*(x35*x46-x36*x45)-x14*E O # x15*x23*x36+x14*x16*x23*x35+x15*x34*.D O # x36-x16*x34*x35+x13s*(-x25*x46+x26*% O # x45)bG O e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25*.D O # x36-x24*x26*x35)+x15*(-x23*x24*x36-D O # x23*x26*x34+x46*x23s)+x16*(x23*x24*C O # x35+x23*x25*x34-x45*x23s)-x23*x35* E O # x46+x23*x36*x45-x25*x34*x36+x26*x34* O $ O # x35 O * " O ises= 0# O do i=1,5,8 O if(abs(e(i)).lt.zrm) then. O ises= is O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O 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*xe O O