c======================================================================= c sneutrino.for c If you copy this code, please send a message to VXCERN::RIDOLFI or to c VXCERN::MLM, so that we can keep you informed of upgrade or modifications. c======================================================================= implicit real*8 (a-h,o-z) parameter(sin2w=.232d0,xmz=91.188d0,gz=2.5d0,xmw=80.2) common/prcpar/xmsn common/beams/s,sthr common/bveg1/xl(10),xu(10),acc,ndim,ncall,itmx,nprn common/susy/u(2,2),v(2,2),xmc(2),tb external radsig c c Initialize parameters for Vegas do j=1,10 xl(j) = 0 xu(j) = 1 enddo acc = -1 ndim = 1 ncall = 10000 itmx = 4 pi=acos(-1.d0) cos2w=1-sin2w cw=sqrt(cos2w) sw=sqrt(sin2w) 1 write(*,*)'Enter sqrt(s), M, mu, tan(beta), msnu' read (*,*)sr,rm,rmu,tb,xmsn if(sr.lt.0) stop s=sr**2 sthr=4*xmsn**2 c cb=1.d0/sqrt(1.d0+tb**2) sb=tb/sqrt(1.d0+tb**2) c2b=cb**2-sb**2 s2b=2*cb*sb c Charginos: diagonalization matrices as in Z. Phys. C30(1986)441 ddd=rmu*cb+rm*sb ccc=rmu*sb+rm*cb if(tb.eq.1)then phim=pi/4.-.5*atan((rm-rmu)/(2.*xmw)) phip=phim else if (abs(ccc).lt.1.e-5) then phim=0. phip=atan(sqrt(2.)*xmw*sb/rm) else if (abs(ddd).lt.1.e-5) then phip=0. phim=atan(sqrt(2.)*xmw*cb/rm) else rad=sqrt((rm**2-rmu**2)**2+4.*xmw**4*c2b**2 # +4*xmw**2*(rm**2+rmu**2+2.*rm*rmu*s2b)) phip=atan((rad-(rm**2-rmu**2+2.*xmw**2*c2b)) # /(2.*sqrt(2.)*xmw*(rmu*cb+rm*sb))) phim=atan((rad-(rm**2-rmu**2-2.*xmw**2*c2b)) # /(2.*sqrt(2.)*xmw*(rmu*sb+rm*cb))) endif cp=cos(phip) sp=sin(phip) cm=cos(phim) sm=sin(phim) u(1,1)=cm u(1,2)=sm u(2,1)=-u(1,2) u(2,2)=u(1,1) v(1,1)=cp v(1,2)=sp v(2,1)=-v(1,2) v(2,2)=v(1,1) c c Chargino masses (WITH THEIR SIGN!) xmc(1)=rm*cp*cm+rmu*sp*sm+sqrt(2.d0)*xmw*(sp*cm*sb+cp*sm*cb) xmc(2)=rm*sp*sm+rmu*cp*cm-sqrt(2.d0)*xmw*(cp*sm*sb+sp*cm*cb) l1=1 if(abs(xmc(1)).gt.abs(xmc(2)))l1=2 l2=mod(l1,2)+1 if(iproc.eq.1) then ich=l1 jch=l1 elseif(iproc.eq.2) then ich=l2 jch=l2 elseif(iproc.eq.3) then ich=l1 jch=l2 endif c test of barger's results c xmc(1)=2*xmsn c xmc(2)=1d4 c v(1,1)=1 c v(2,1)=0 c v(2,2)=1 c v(1,2)=0 c no isr xsect0=sig(s) c with isr call vegas(radsig,xsect1,sd,chisq) c output write(*,101) rm,rmu,tb write(*,*) xmsn,xsect0,xsect1 if(sr.ne.srold) then write(1,100) sr srold=sr endif par=(1+rm+rm**2)*(2+rmu+rmu**2)*(1+abs(tb)) if(par.ne.parold) then write(1,101) rm,rmu,tb parold=par endif write(1,102) xmsn goto 1 100 format(' Ecm = ',g10.4,'GeV') 101 format(' M = ',g10.4,' mu = ',g10.4,' tan-beta =',g10.4) 102 format(' m(snu) = ',g10.4,'GeV') goto 1 end c------------------------------------------------------------------------- function sig(s) c Cross section for sneutrino production in e+e- collisions c Barger Keung and Phillips, phys lett B364 (1995) 27 c GeV to microbarn conversion factor: sigma (pb) = hc2 * sigma (GeV^-2) c------------------------------------------------------------------------- implicit real*8 (a-h,o-z) parameter(hc2=3.8937966d8) parameter(sin2w=.232d0,xmz=91.188d0,gz=2.5d0) dimension fl(2),fr(2),ffdd(2,2),dd(2,2),ffd(2),xlog(2) common/prcpar/xmsn common/susy/u(2,2),v(2,2),xmc(2),tb cos2w=1-sin2w sw=sqrt(sin2w) cw=sqrt(cos2w) pi=acos(-1.d0) aem=alfa(s) g=sqrt(4*pi*aem/sin2w) ell=-.5d0+sin2w elr=sin2w dzq=1.d0/((s-xmz**2)**2+(gz*xmz)**2) redz=(s-xmz**2)*dzq c----------------------------------------------------------- xm1=xmsn xm2=xm1 del=1+(xm1**2-xm2**2)/s beta1=sqrt(1-4*xm1**2/(s*del**2)) q=sqrt(s)*beta1*del/2.d0 tmin=xm1**2-s*del/2.-s*del/2.*beta1 tmax=xm1**2-s*del/2.+s*del/2.*beta1 c ff is the integral of (u*t-m1**2*m2**2) over the t range c ffdd(i,j) is the integral of c (u*t-m1**2*m2**2)/((t-m(i)**2)*(t-m(j)**2)) c ffd(i) is the integral of (u*t-m1**2*m2**2)/(t-m(i)**2) ff=(beta1*s*del)**3/6. do i=1,2 xlog(i)=log((tmax-xmc(i)**2)/(tmin-xmc(i)**2)) ffd(i)=beta1*s*del*(xm1**2-xmc(i)**2-s*del/2.) # -((xm1*xm2)**2+xmc(i)**4-xmc(i)**2*(2*xm1**2-s*del))*xlog(i) dd(i,i)=-1.d0/(tmax-xmc(i)**2)+1.d0/(tmin-xmc(i)**2) ffdd(i,i)=-beta1*s*del-dd(i,i)* # ((xm1*xm2)**2+xmc(i)**4-xmc(i)**2*(2*xm1**2-s*del)) # +2*xlog(i)*(xm1**2-xmc(i)**2-s*del/2.d0) enddo do i=1,2 do j=1,2 if(i.ne.j)then ffdd(i,j)=(ffd(i)-ffd(j))/(xmc(i)**2-xmc(j)**2) endif enddo enddo c----------------------------------------------------------- sigz=g**4/(16*pi*s**2*cos2w**2)*ff*dzq # *(0.5)**2*(ell**2+elr**2) tmp1=0 tmp2=0 tmp3=0 do i=1,2 tmp2=tmp2+ffd(i)*ell*v(i,1)**2 do j=1,2 tmp3=tmp3+ffdd(i,j)*v(i,1)**2*v(j,1)**2 enddo enddo sigchiz=g**4/(32*pi*s**2*cos2w)*redz*tmp2 sigchi=g**4/(64*pi*s**2)*tmp3 c sig=(sigz+sigchi+sigchiz)*hc2 end From MLM@vxcern.cern.ch Fri Jun 13 15:03 MET 1997 Received: from ccpntc5.in2p3.fr (ccpntc5.in2p3.fr [134.158.69.177]) by lapphp0.in2p3.fr (8.8.4/8.8.4) with ESMTP id PAA02287 for ; Fri, 13 Jun 1997 15:03:50 +0200 (METDST) Received: from lapphp.in2p3.fr (lapphp.in2p3.fr [192.70.68.21]) by ccpntc5.in2p3.fr (8.8.4/8.8.4) with ESMTP id OAA21935 for ; Fri, 13 Jun 1997 14:57:42 +0200 Received: from dxmint.cern.ch (dxmint.cern.ch [137.138.26.76]) by lapphp.in2p3.fr (8.8.5/8.8.5) with ESMTP id OAA10315 for ; Fri, 13 Jun 1997 14:54:59 +0200 (METDST) Received: from vscrna.cern.ch (vscrna.cern.ch [137.138.28.123]) by dxmint.cern.ch with SMTP id OAA00092 for ; Fri, 13 Jun 1997 14:57:11 +0200 (MET DST) Date: Fri, 13 Jun 1997 14:57:07 +0200 From: Michelangelo MANGANO To: BOUDJEMA@lapp.in2p3.fr CC: MLM@vxcern.cern.ch Message-Id: <970613145707.21a1941b@vxcern.cern.ch> Subject: sneutrino.for X-Mozilla-Status: 0001 Content-Length: 5780 c======================================================================= c If you copy this code, please send a message to VXCERN::RIDOLFI or to c VXCERN::MLM, so that we can keep you informed of upgrade or modifications. c======================================================================= implicit real*8 (a-h,o-z) parameter(sin2w=.232d0,xmz=91.188d0,gz=2.5d0,xmw=80.2) common/prcpar/xmsn common/beams/s,sthr common/bveg1/xl(10),xu(10),acc,ndim,ncall,itmx,nprn common/susy/u(2,2),v(2,2),xmc(2),tb external radsig c c Initialize parameters for Vegas do j=1,10 xl(j) = 0 xu(j) = 1 enddo acc = -1 ndim = 1 ncall = 10000 itmx = 4 pi=acos(-1.d0) cos2w=1-sin2w cw=sqrt(cos2w) sw=sqrt(sin2w) 1 write(*,*)'Enter sqrt(s), M, mu, tan(beta), msnu' read (*,*)sr,rm,rmu,tb,xmsn if(sr.lt.0) stop s=sr**2 sthr=4*xmsn**2 c cb=1.d0/sqrt(1.d0+tb**2) sb=tb/sqrt(1.d0+tb**2) c2b=cb**2-sb**2 s2b=2*cb*sb c Charginos: diagonalization matrices as in Z. Phys. C30(1986)441 ddd=rmu*cb+rm*sb ccc=rmu*sb+rm*cb if(tb.eq.1)then phim=pi/4.-.5*atan((rm-rmu)/(2.*xmw)) phip=phim else if (abs(ccc).lt.1.e-5) then phim=0. phip=atan(sqrt(2.)*xmw*sb/rm) else if (abs(ddd).lt.1.e-5) then phip=0. phim=atan(sqrt(2.)*xmw*cb/rm) else rad=sqrt((rm**2-rmu**2)**2+4.*xmw**4*c2b**2 # +4*xmw**2*(rm**2+rmu**2+2.*rm*rmu*s2b)) phip=atan((rad-(rm**2-rmu**2+2.*xmw**2*c2b)) # /(2.*sqrt(2.)*xmw*(rmu*cb+rm*sb))) phim=atan((rad-(rm**2-rmu**2-2.*xmw**2*c2b)) # /(2.*sqrt(2.)*xmw*(rmu*sb+rm*cb))) endif cp=cos(phip) sp=sin(phip) cm=cos(phim) sm=sin(phim) u(1,1)=cm u(1,2)=sm u(2,1)=-u(1,2) u(2,2)=u(1,1) v(1,1)=cp v(1,2)=sp v(2,1)=-v(1,2) v(2,2)=v(1,1) c c Chargino masses (WITH THEIR SIGN!) xmc(1)=rm*cp*cm+rmu*sp*sm+sqrt(2.d0)*xmw*(sp*cm*sb+cp*sm*cb) xmc(2)=rm*sp*sm+rmu*cp*cm-sqrt(2.d0)*xmw*(cp*sm*sb+sp*cm*cb) l1=1 if(abs(xmc(1)).gt.abs(xmc(2)))l1=2 l2=mod(l1,2)+1 if(iproc.eq.1) then ich=l1 jch=l1 elseif(iproc.eq.2) then ich=l2 jch=l2 elseif(iproc.eq.3) then ich=l1 jch=l2 endif c test of barger's results c xmc(1)=2*xmsn c xmc(2)=1d4 c v(1,1)=1 c v(2,1)=0 c v(2,2)=1 c v(1,2)=0 c no isr xsect0=sig(s) c with isr call vegas(radsig,xsect1,sd,chisq) c output write(*,101) rm,rmu,tb write(*,*) xmsn,xsect0,xsect1 if(sr.ne.srold) then write(1,100) sr srold=sr endif par=(1+rm+rm**2)*(2+rmu+rmu**2)*(1+abs(tb)) if(par.ne.parold) then write(1,101) rm,rmu,tb parold=par endif write(1,102) xmsn goto 1 100 format(' Ecm = ',g10.4,'GeV') 101 format(' M = ',g10.4,' mu = ',g10.4,' tan-beta =',g10.4) 102 format(' m(snu) = ',g10.4,'GeV') goto 1 end c------------------------------------------------------------------------- function sig(s) c Cross section for sneutrino production in e+e- collisions c Barger Keung and Phillips, phys lett B364 (1995) 27 c GeV to microbarn conversion factor: sigma (pb) = hc2 * sigma (GeV^-2) c------------------------------------------------------------------------- implicit real*8 (a-h,o-z) parameter(hc2=3.8937966d8) parameter(sin2w=.232d0,xmz=91.188d0,gz=2.5d0) dimension fl(2),fr(2),ffdd(2,2),dd(2,2),ffd(2),xlog(2) common/prcpar/xmsn common/susy/u(2,2),v(2,2),xmc(2),tb cos2w=1-sin2w sw=sqrt(sin2w) cw=sqrt(cos2w) pi=acos(-1.d0) aem=alfa(s) g=sqrt(4*pi*aem/sin2w) ell=-.5d0+sin2w elr=sin2w dzq=1.d0/((s-xmz**2)**2+(gz*xmz)**2) redz=(s-xmz**2)*dzq c----------------------------------------------------------- xm1=xmsn xm2=xm1 del=1+(xm1**2-xm2**2)/s beta1=sqrt(1-4*xm1**2/(s*del**2)) q=sqrt(s)*beta1*del/2.d0 tmin=xm1**2-s*del/2.-s*del/2.*beta1 tmax=xm1**2-s*del/2.+s*del/2.*beta1 c ff is the integral of (u*t-m1**2*m2**2) over the t range c ffdd(i,j) is the integral of c (u*t-m1**2*m2**2)/((t-m(i)**2)*(t-m(j)**2)) c ffd(i) is the integral of (u*t-m1**2*m2**2)/(t-m(i)**2) ff=(beta1*s*del)**3/6. do i=1,2 xlog(i)=log((tmax-xmc(i)**2)/(tmin-xmc(i)**2)) ffd(i)=beta1*s*del*(xm1**2-xmc(i)**2-s*del/2.) # -((xm1*xm2)**2+xmc(i)**4-xmc(i)**2*(2*xm1**2-s*del))*xlog(i) dd(i,i)=-1.d0/(tmax-xmc(i)**2)+1.d0/(tmin-xmc(i)**2) ffdd(i,i)=-beta1*s*del-dd(i,i)* # ((xm1*xm2)**2+xmc(i)**4-xmc(i)**2*(2*xm1**2-s*del)) # +2*xlog(i)*(xm1**2-xmc(i)**2-s*del/2.d0) enddo do i=1,2 do j=1,2 if(i.ne.j)then ffdd(i,j)=(ffd(i)-ffd(j))/(xmc(i)**2-xmc(j)**2) endif enddo enddo c----------------------------------------------------------- sigz=g**4/(16*pi*s**2*cos2w**2)*ff*dzq # *(0.5)**2*(ell**2+elr**2) tmp1=0 tmp2=0 tmp3=0 do i=1,2 tmp2=tmp2+ffd(i)*ell*v(i,1)**2 do j=1,2 tmp3=tmp3+ffdd(i,j)*v(i,1)**2*v(j,1)**2 enddo enddo sigchiz=g**4/(32*pi*s**2*cos2w)*redz*tmp2 sigchi=g**4/(64*pi*s**2)*tmp3 c sig=(sigz+sigchi+sigchiz)*hc2 end