c======================================================================= c If you copy this code, please send a message to c RIDOLFI@VXCERN.CERN.CH c or to c MLM@VXCERN.CERN.CH c so that we can keep you informed of upgrades or modifications. c======================================================================= implicit real*8 (a-h,o-z) parameter(sin2w=.232d0,xmz=91.188d0,gz=2.5d0,xmw=80.2) common/prcpar/xmsnu,iproc,ich,jch common/beams/s,sthr common/susy/u(2,2),v(2,2),xmc(2),tb common/bveg1/xl(10),xu(10),acc,ndim,ncall,itmx,nprn character*4 ipro(3) data ipro/'c1c1','c2c2','c1c2'/ 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 c pi=acos(-1.d0) cos2w=1-sin2w cw=sqrt(cos2w) sw=sqrt(sin2w) 1 write(*,*)' Enter sqrt(s), M, mu, tan(beta), m(snu), Iproc', + ' (1=chi1-chi1, 2=chi2-chi2, 3=chi1-chi2)' read (*,*)sr,rm,rmu,tb,xmsnu,iproc if(sr.lt.0) stop s=sr**2 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 if(iproc.le.2) sthr=4*xmc(ich)**2 if(iproc.eq.3) sthr=( abs(xmc(1))+abs(xmc(2)) )**2 if(sthr.gt.s)then write(*,*)' unaccessible channel' goto 1 endif c no isr xsect0=sig(s) c with isr call vegas(radsig,xsect1,sd,chisq) c output write(*,101) rm,rmu,tb,xmsnu write(*,102) xmc(l1),xmc(l2) write(*,*)' ',ipro(iproc),' xsec no isr =',xsect0,'pb' write(*,*)' ',ipro(iproc),' xsec with isr =',xsect1,'pb' if(sr.ne.srold) then write(1,100) sr srold=sr endif par=(1+rm+rm**2)*(2+rmu+rmu**2)*(1+abs(tb))*(1+xmsnu**2) if(par.ne.parold) then write(1,101) rm,rmu,tb,xmsnu parold=par endif write(1,102) xmc(l1),xmc(l2) write(1,103) ipro(iproc),xsect0 write(1,104) ipro(iproc),xsect1 goto 1 100 format(' Ecm = ',g10.4,'GeV') 101 format(' M = ',g10.4,' mu = ',g10.4,' tan-beta =',g10.4, + ' m(snu) =',g10.4) 102 format(' m(chi1) = ',g10.4,'GeV',' m(chi2) = ',g10.4,'GeV') 103 format(' ',A4,' xsec no isr (pb) =',g10.4) 104 format(' ',A4,' xsec with isr (pb) =',g10.4) goto 1 end c--------------------------------------------------------- c Cross section for chargino pair production in e+e- collisions c Z. Phys. C30(1986)441 function sig(s) c GeV to microbarn conversion factor: sigma (pb) = hc2 * sigma (GeV^-2) c--------------------------------------------------------- implicit real*8 (a-h,o-z) parameter(sin2w=.232d0,xmz=91.188d0,gz=2.5d0,xmw=80.2) parameter(hc2=3.8937966d8) common/prcpar/xmsnu,iproc,ich,jch common/susy/u(2,2),v(2,2),xmc(2),tb dimension o1l(2,2),o1r(2,2) cos2w=1-sin2w cw=sqrt(cos2w) sw=sqrt(sin2w) pi=acos(-1.d0) aem=alfa(s) g=sqrt(4*pi*aem/sin2w) e=sqrt(4*pi*aem) ell=-.5d0+sin2w elr=sin2w q=sqrt(s**2+xmc(ich)**4+xmc(jch)**4 -2* # (xmc(ich)**2*xmc(jch)**2+s*xmc(ich)**2+s*xmc(jch)**2)) # /(2*sqrt(s)) ei=sqrt(q**2+xmc(ich)**2) ej=sqrt(q**2+xmc(jch)**2) al=(2*xmsnu**2+s-xmc(ich)**2-xmc(jch)**2)/(2*xmsnu**2) bl=q*sqrt(s)/xmsnu**2 h=2*q*sqrt(s)-2*q**2*al/bl+(ei*ej+(q*al/bl)**2-q*sqrt(s)*al/bl) # *log(abs((al+bl)/(al-bl))) o1l(ich,jch)=-v(ich,1)*v(jch,1)-.5*v(ich,2)*v(jch,2) o1r(ich,jch)=-u(ich,1)*u(jch,1)-.5*u(ich,2)*u(jch,2) if(ich.eq.jch)then o1l(ich,jch)=o1l(ich,jch)+sin2w o1r(ich,jch)=o1r(ich,jch)+sin2w endif dzq=1.d0/((s-xmz**2)**2+(gz*xmz)**2) redz=(s-xmz**2)*dzq c Total cross section: if(ich.eq.jch)then sigp=e**4/(2*pi)*q*sqrt(s)/s**3*(ei*ej+q**2/3 # +abs(xmc(ich)*xmc(jch))) sigpz=(e*g)**2/(4*pi*cos2w)*q*sqrt(s)/s**2*redz*(ell+elr)* # (o1l(ich,jch)+o1r(ich,jch))* # (ei*ej+q**2/3+abs(xmc(ich)*xmc(jch))) sigpn=-(e*g)**2*v(ich,1)**2/(16*pi*s**2)* # (h+abs(xmc(ich)*xmc(jch))*log(abs((al+bl)/(al-bl))) ) else sigp=0 sigpz=0 sigpn=0 endif sigz=g**4/(8*pi*cos2w**2)*q/sqrt(s)*dzq*( # (o1l(ich,jch)**2+o1r(ich,jch)**2)*(ell**2+elr**2)*(ei*ej+q**2/3) # +2*(ell**2+elr**2)*o1l(ich,jch)*o1r(ich,jch)*xmc(ich)*xmc(jch) ) sign=g**4*v(ich,1)**2*v(jch,1)**2/(32*pi*xmsnu**4)*q/sqrt(s)*( # (ei*ej+q**2-q*sqrt(s)*al/bl)/(al**2-bl**2)+2*(q/bl)**2 # +(q*sqrt(s)-2*q**2*al/bl)/(2*bl**2)* # log(abs((al+bl)/(al-bl))) ) sigzn=-g**4*v(ich,1)*v(jch,1)*redz*ell/(16*pi*cos2w*s)* # (h*o1l(ich,jch) # +o1r(ich,jch)*xmc(ich)*xmc(jch)*log(abs((al+bl)/(al-bl))) ) sig=(sigp+sigz+sign+sigpz+sigpn+sigzn)*hc2 if(iproc.eq.3) sig=2*sig end