subroutine wtjetset_ini implicit real*4(a-h,o-z) * common/lujets/n,k,p,v common/ludat1/mstu,paru,mstj,parj * save /lujets/ save /ludat1/ * dimension k(4000,5) dimension p(4000,5),v(4000,5) dimension mstu(200),mstj(200) dimension paru(200),parj(200) * return end * *----------------------------------------------------------------------- * subroutine wtosopt(oflag,val) implicit real*8(a-h,o-z) character*(*) oflag * common/wtmssmi/am,tbeta,rmu,scalm,bat,bab * if(oflag.eq.'am') then am= val else if(oflag.eq.'tbeta') then tbeta= val else if(oflag.eq.'rmu') then rmu= val else if(oflag.eq.'scalm') then scalm= val else if(oflag.eq.'bat') then bat= val else if(oflag.eq.'bab') then bab= val endif * return end * *----------------------------------------------------------------------- * subroutine wtoacopt(oflag,val) implicit real*8(a-h,o-z) character*(*) oflag * common/wtbac/dg1z,dkg,rlg common/wtacc/acg1g,aclg,ackg,acg4g,acktg,acltg,acg5g,acg1z,aclz, # ackz,acg4z,acktz,acltz,acg5z * if(oflag.eq.'dg1z') then dg1z= val else if(oflag.eq.'dkg') then dkg= val else if(oflag.eq.'rlg') then rlg= val else if(oflag.eq.'acg1g') then acg1g= val else if(oflag.eq.'aclg') then aclg= val else if(oflag.eq.'ackg') then ackg= val else if(oflag.eq.'acg4g') then acg4g= val else if(oflag.eq.'acktg') then acktg= val else if(oflag.eq.'acltg') then acltg= val else if(oflag.eq.'acg5g') then acg5g= val else if(oflag.eq.'acg1z') then acg1z= val else if(oflag.eq.'aclz') then aclz= val else if(oflag.eq.'ackz') then ackz= val else if(oflag.eq.'acg4z') then acg4z= val else if(oflag.eq.'acktz') then acktz= val else if(oflag.eq.'acltz') then acltz= val else if(oflag.eq.'acg5z') then acg5z= val endif * return end * *----------------------------------------------------------------------- * subroutine wtocopt(oflag,ival) implicit real*8(a-h,o-z) character*(*) oflag * common/wttopt/ios,iosf common/wtpoints/ipm,irm * if(oflag.eq.'ios') then ios= ival else if(oflag.eq.'iosf') then iosf= ival else if(oflag.eq.'ipm') then ipm= ival else if(oflag.eq.'irm') then irm= ival endif * return end * *----------------------------------------------------------------------- * subroutine wtomultid(rs,oflag,oval,arrmom) implicit real*8(a-h,o-z) * character*(*) oflag,oval character*1 omdist character*2 rlabs(4) character*1 clabs(4) * common/wtomd/omdist common/wtmd/arrinv(10) * dimension arrmom(4,4) * data rlabs/'qx', 'qy', 'qz', 'E'/ data clabs/'1', '2', '3', '4'/ * if(oflag.eq.'omdist') then omdist= oval endif if(omdist.eq.'y') then s= rs*rs arrinv(1)= 0.d0 do i=1,3 arrinv(1)= arrinv(1)-arrmom(i,1)*arrmom(i,2) enddo arrinv(1)= (arrinv(1)+arrmom(4,1)*arrmom(4,2))/s arrinv(2)= 0.d0 do i=1,3 arrinv(2)= arrinv(2)-arrmom(i,3)*arrmom(i,4) enddo arrinv(2)= (arrinv(2)+arrmom(4,3)*arrmom(4,4))/s arrinv(3)= 0.d0 do i=1,3 arrinv(3)= arrinv(3)-arrmom(i,2)*arrmom(i,3) enddo arrinv(3)= (arrinv(3)+arrmom(4,2)*arrmom(4,3))/s arrinv(4)= 0.d0 do i=1,3 arrinv(4)= arrinv(4)-arrmom(i,1)*arrmom(i,4) enddo arrinv(4)= (arrinv(4)+arrmom(4,1)*arrmom(4,4))/s arrinv(5)= 0.d0 do i=1,3 arrinv(5)= arrinv(1)-arrmom(i,1)*arrmom(i,3) enddo arrinv(5)= (arrinv(5)+arrmom(4,1)*arrmom(4,3))/s arrinv(6)= 0.d0 do i=1,3 arrinv(6)= arrinv(6)-arrmom(i,2)*arrmom(i,4) enddo arrinv(6)= (arrinv(6)+arrmom(4,2)*arrmom(4,4))/s arrinv(7)= -0.5d0*(arrmom(3,1)-arrmom(4,1))/rs arrinv(8)= -0.5d0*(arrmom(3,2)-arrmom(4,2))/rs arrinv(9)= -0.5d0*(arrmom(3,3)-arrmom(4,3))/rs arrinv(10)= -0.5d0*(arrmom(3,4)-arrmom(4,4))/rs * ncols= 80 indent= 0 ifail= 0 * call x04cbf('g','n',4,4,arrmom,4,' ',' 1-4 FS momenta are:', # 'c',rlabs,'c',clabs,ncols,indent,ifail) call x04abf(1,6) * print 3 do j=1,7 print 4,j,arrinv(j) enddo endif 3 format(/' 1-7 invariants are: ',//) 4 format(1x,i1,1x,e20.5) * return end * *----------------------------------------------------------------------- * subroutine wtosmass(oflag,oval,afsm) implicit real*8(a-h,o-z) * character*(*) oflag,oval character*1 osmass * common/wtfsm/fsm(4) common/wopstm/osmass * dimension afsm(4) * if(oflag.eq.'osmass') then osmass= oval endif if(osmass.eq.'y') then do i=1,4 fsm(i)= afsm(i) enddo endif * return end * *----------------------------------------------------------------------- * subroutine wtockm(avckm) implicit real*8(a-h,o-z) * common/wtvckm/vckm(3,3) * dimension avckm(3,3) * do i=1,3 do j=1,3 vckm(i,j)= avckm(i,j) enddo enddo * return end * *----------------------------------------------------------------------- * subroutine wtocflag(rs,oflag,oval,ival,jval,xval,yval) implicit real*8(a-h,o-z) * character*(*) oflag,oval character*1,oprt,otop,omh,ocoul,oqcd,oglu,opeak,ofl,ofsr,oral, # obin,opeakn,om,osm,oww,ozz,opeaka,ostop,rio,oanom, # ostore,omssm,ockm,opglu,oint,oseed,oxcm,osinw,oprint character*4,otype * common/wtcw/oww common/wtcz/ozz common/wtmod/om common/wtai/rio common/wtoi/oint common/wtfls/ofl common/wtgg/oglu common/wtcb/obin common/wtps/opeak common/wtsmod/osm common/wtfsr/ofsr common/wtim/ostop common/wtprt/oprt common/wtdis/dist common/wtckm/ockm common/wtsw/osinw common/wtickm/ickm common/wtgnum/itmx common/wtap/opeaka common/wtcqcd/iqcd common/wtaqcd/oqcd common/wtoral/oral common/wthiggo/omh common/wtcac/oanom common/wtio/oprint common/wopst/ostore common/wtpsn/opeakn common/wtcoul/ocoul common/wttopop/otop common/wtpqcd/opglu common/wtseed/oseed common/wtmssmo/omssm common/wtcurrent/oxcm common/wtnpr/ipr,ipr0 common/wtochannel/otype common/wtdis2/distm,distp common/wttc/itc,itcc,itcn common/wtlb/abp,bbp,abm,bbm common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi * if(oflag.eq.'ocoul') then ocoul= oval else if(oflag.eq.'oqcd') then oqcd= oval else if(oflag.eq.'oglu') then oglu= oval else if(oflag.eq.'opeak') then opeak= oval else if(oflag.eq.'ofl') then ofl= oval else if(oflag.eq.'oral') then oral= oval else if(oflag.eq.'opeakn') then opeakn= oval else if(oflag.eq.'om') then om= oval else if(oflag.eq.'osm') then osm= oval else if(oflag.eq.'oww') then oww= oval else if(oflag.eq.'ozz') then ozz= oval else if(oflag.eq.'opeaka') then opeaka= oval else if(oflag.eq.'ostop') then ostop= oval else if(oflag.eq.'rio') then rio= oval else if(oflag.eq.'oanom') then oanom= oval else if(oflag.eq.'otop') then otop= oval else if(oflag.eq.'omh') then omh= oval else if(oflag.eq.'oprt') then oprt= oval else if(oflag.eq.'ostore') then ostore= oval else if(oflag.eq.'omssm') then omssm= oval else if(oflag.eq.'ockm') then ockm= oval else if(oflag.eq.'opglu') then opglu= oval else if(oflag.eq.'oint') then oint= oval else if(oflag.eq.'oseed') then oseed= oval else if(oflag.eq.'osinw') then osinw= oval else if(oflag.eq.'oprint') then oprint= oval endif * if(oflag.eq.'oral'.and.oral.eq.'f'.and.xval.gt.0.d0) then alwi= xval endif if(oflag.eq.'osm'.and.om.eq.'g'.and.osm.eq.'g'.and.ival.gt.0) then itmx= ival endif if(oflag.eq.'oqcd'.and.oqcd.eq.'y'.and.ival.ge.0) then iqcd= ival endif if(oflag.eq.'ockm'.and.ockm.eq.'y'.and.ival.gt.0) then ickm= ival endif * if(oflag.eq.'cc03') then ipr0= 0 otype= 'cc03' endif * if(oflag.eq.'dist') then if(oxcm.eq.'c'.and.ival.ge.0) then itc= ival if(itc.eq.7) then itcc= jval else if(itc.ge.1.and.itc.le.6) then itcn= jval else if(itc.ge.7.and.itc.lt.9) then dist= xval else if(itc.eq.9) then dist= xval else if(itc.eq.10) then dist= xval dist= 180.d0-dist dist= cos(dist/180.d0*pi) else if(itc.eq.11) then distm= xval distp= yval else if(itc.eq.12) then dist= xval endif if(obin.eq.'p') then abp= xval bbp= yval abp= abp/rs bbp= bbp/rs else if(obin.eq.'m') then abm= xval bbm= yval abm= abm/rs bbm= bbm/rs endif endif * if(oxcm.eq.'n'.or.oxcm.eq.'m') then if(otype.eq.'nc25'.or.otype.eq.'nc33'.and.ival.ge.0) then itc= ival else if(otype.eq.'nc21'.or.otype.eq.'nc50'. # and.ival.ge.0) then itc= ival else if(ival.gt.0) then itc= ival endif if(itc.eq.1) then itcc= jval endif if(itc.gt.0) then dist= xval endif endif endif * return end * *------------------------------------------------------------------------- * subroutine wtooutput(ipr) implicit real*8 (a-h,o-z) * character*1,oxcm,ocoul,oqcd,opeak,ofl,ofsr,om,oww,ozz,opeaka, # rio,omssm,oanom,opglu,omdist,ockm,osinw character*4,otype character*7 rlabs(3) character*7 clabs1(4),clabs2(4),clabs3(4),clabs4(4), # clabs5(4),clabs6(4),clabs7(4),clabs8(4), # clabs9(4),clabs10(4),clabs11(4),clabs12(4), # clabs13(4),clabs14(4),clabs15(4),clabs16(4), # clabs17(4),clabs18(4),clabs19(4),clabs20(4), # clabs21(4),clabs22(4),clabs23(4),clabs24(4), # clabs25(4),clabs26(4),clabs27(4),clabs28(4), # clabs29(4),clabs30(4),clabs31(4),clabs32(4), # clabs33(4),clabs34(4),clabs35(4),clabs36(4), # clabs37(4),clabs38(4),clabs39(4),clabs0(4) * data rlabs/'E_th', 'theta_M', 'theta_m'/ data clabs1/'mu-', 'nu_mu~', 'nu_tau', 'tau+'/ data clabs2/'mu-', 'nu_mu~', 'u', 'd~'/ data clabs3/'d', 'u~', 'c', 's~'/ data clabs4/'e-', 'nu_e~', 'nu_mu', 'mu+'/ data clabs5/'e-', 'nu_e~', 'u', 'd~'/ data clabs6/'mu-', 'mu+', 'nu_tau', 'nu_tau~'/ data clabs7/'d', 'd~', 'nu_mu', 'nu_mu~'/ data clabs8/'u', 'u~', 'nu_mu', 'nu_mu~'/ data clabs9/'mu-', 'mu+', 'tau-', 'tau+'/ data clabs10/'mu-', 'mu+', 'd', 'd~'/ data clabs11/'mu-', 'mu+', 'u', 'u~'/ data clabs12/'nu_mu', 'nu_mu~', 'nu_tau', 'nu_tau~'/ data clabs13/'u', 'u~', 's', 's~'/ data clabs14/'d', 'd~', 's', 's~'/ data clabs15/'u', 'u~', 'c', 'c~'/ data clabs16/'nu_mu', 'nu_mu~', 'nu_e', 'nu_e~'/ data clabs17/'mu-', 'mu+', 'nu_e', 'nu_e~'/ data clabs18/'u', 'u~', 'nu_e', 'nu_e~'/ data clabs19/'d', 'd~', 'nu_e', 'nu_e~'/ data clabs20/'mu-', 'nu_mu~', 'nu_mu', 'mu+'/ data clabs21/'d', 'u~', 'u', 'd~'/ data clabs22/'mu-', 'mu+', 'e-', 'e+'/ data clabs23/'nu_mu', 'nu_mu~', 'e-', 'e+'/ data clabs24/'u', 'u~', 'e-', 'e+'/ data clabs25/'d', 'd~', 'e-', 'e+'/ data clabs26/'mu-', 'mu+', 'mu-', 'mu+'/ data clabs27/'nu_mu', 'nu_mu~', 'nu_mu', 'nu_mu~'/ data clabs28/'u', 'u~', 'u', 'u~'/ data clabs29/'d', 'd~', 'd', 'd~'/ data clabs30/'b', 'b~', 'nu_mu', 'nu_mu~'/ data clabs31/'mu-', 'mu+', 'b', 'b~'/ data clabs32/'b', 'b~', 'nu_e', 'nu_e~'/ data clabs33/'b', 'b~', 'e-', 'e+'/ data clabs34/'u', 'u~', 'b', 'b~'/ data clabs35/'d', 'd~', 'b', 'b~'/ data clabs36/'b', 'b~', 'b', 'b~'/ data clabs37/'tau-', 'tau+', 'b', 'b~'/ data clabs38/'tau-', 'nu_tau~', 'c', 's~'/ data clabs39/'e-', 'nu_e~', 'nu_tau', 'tau+'/ * common/wtcw/oww common/wtcz/ozz common/wtmp/zrm common/wtmod/om common/wtai/rio common/wtfls/ofl common/wtqcd/als common/wtdis/dist common/wtps/opeak common/wtfsr/ofsr common/wthiggs/hm common/wtckm/ockm common/wtsw/osinw common/wtickm/ickm common/wtcac/oanom common/wtaqcd/oqcd common/wtap/opeaka common/wtqcdz/alsz common/wthqcd/alsh common/wtcoul/ocoul common/wtpqcd/opglu common/wtomd/omdist common/wtmssmo/omssm common/wtcurrent/oxcm common/wtrm/rbm2,rcm2 common/wttopt/ios,iosf common/wtochannel/otype common/wtpoints/ipm,irm common/wtdis2/distm,distp common/wttc/itc,itcc,itcn common/wtbac/dg1z,dkg,rlg common/wtmssmi/am,tbeta,rmu,scalm,bat,bab common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtcchannel/chu,chup,chd,chdp,fcuc,fcdc common/wthapar/rhm,rhm2,rhg,rhmg,shg,shgs,opshgs common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmy common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw, # eta,feta,beta,g2,tfacth common/wtacc/acg1g,aclg,ackg,acg4g,acktg,acltg,acg5g,acg1z,aclz, # ackz,acg4z,acktz,acltz,acg5z 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/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,rchn,rchms,rchg,rchmg,schg,schgs,opschgs * dimension cuts1(3,4),cuts2(4,4),cuts3(4,4),cuts4(4,4),cuts5(4,4) * print 888,zrm 888 format(1x,' Machine precision is = ',e20.5,//) print 700,ipm,irm 700 format(/' This run is with: ',// # ' NPTS = ',i2,' (number of points)',/ # ' NRAND = ',i2,' (random starts)',//) print 937 937 format(/' INPUT & derived parameters ------------------- ',/) print 1,ars,beta,sth2,rwm*ars,rzm*ars,rwg*ars,rzg*ars 1 format(//' E_cm (GeV) = ',e20.5,/ # ' beta = ',e20.5,' sin^2 = ',e20.5,/ # ' M_W (GeV) = ',e20.5,' M_Z (GeV) = ',e20.5,/ # ' G_W (GeV) = ',e20.5,' G_Z (GeV) = ',e20.5///) if(als.ne.0.d0) then print 928,als else print 929 endif if(alsz.ne.0.d0) then print 930,alsz endif 928 format(/' alpha_s(M_W) = ',e20.5) 929 format(/' QCD is not needed or not requested') 930 format(/' alpha_s(M_Z) = ',e20.5) if((otype.eq.'nc21'.or.otype.eq.'nc25'.or. # otype.eq.'nc33'.or.otype.eq.'nc50'.or. # otype.eq.'nc68').and.omssm.eq.'n') then print 93,hm,1.d3*rhg*ars print 94,sqrt(rbm2),sqrt(rcm2),alsh endif 93 format(/' M_H (GeV) = ',e20.5,' G_H (MeV) = ',e20.5) 94 format(/' m_b(M_H) (GeV) = ',e20.5, # /' m_c(M_H) (GeV) = ',e20.5, # /' alpha_s(M_H) = ',e20.5,/) if(omssm.eq.'y') then print 1006 print*,' SS parameters are: ' print 1001,am,tbeta,1.d-3*rmu,1.d-3*scalm,1.d-3*bat,1.d-3*bab print 1002,shm,bhm,chm print 1003,salpha/calpha print 1004,rshg*ars,rbhg*ars,rag*ars,rchg*ars if(am.gt.tqm) then print 1005 endif 1006 format(/' MSSM is included ----------------------------',/) 1001 format(/' M_A (GeV) = ',e20.5, # /' tn(beta) = ',e20.5, # /' mu (TeV) = ',e20.5, # /' M_s (TeV) = ',e20.5, # /' A_t (TeV) = ',e20.5, # /' A_b (TeV) = ',e20.5,/) 1002 format(/' M_h (GeV) = ',e20.5, # /' M_H (GeV) = ',e20.5, # /' M_H+ (GeV) = ',e20.5,/) 1003 format(/' tn(alpha) = ',e20.5,/) 1004 format(/' G_h (GeV) = ',e20.5, # /' G_H (GeV) = ',e20.5, # /' G_A (GeV) = ',e20.5, # /' G_H+ (GeV) = ',e20.5,/) 1005 format(/' tn(beta) is evoluted at m_t',/) endif if(oxcm.eq.'c') then if(itc.eq.7) then print 670,dist else if(itc.eq.8) then print 660,dist else if(itc.eq.9) then print 680,dist else if(itc.eq.10) then ifas= 0 adist= 180.d0-s09abf(dist,ifas)/pi*180.d0 print 690,adist else if(itc.eq.11) then print 691,distm,distp else if(itc.eq.12) then print 681,dist endif else if(oxcm.eq.'n'.or.oxcm.eq.'m') then if(itc.eq.1) then print 670,dist else if(itc.eq.2) then print 660,dist else if((otype.eq.'nc25'.or.otype.eq.'nc33').and. # (itc.eq.3.or.itc.eq.4)) then print 695,dist else if((otype.eq.'nc21'.or.otype.eq.'nc50').and. # itc.eq.4) then print 695,dist endif endif 670 format(/' M1+M2 (GeV) = ',e20.5,/) 660 format(/' M1-M2 (GeV) = ',e20.5,/) 680 format(/' M+ (GeV) = ',e20.5,/) 681 format(/' M- (GeV) = ',e20.5,/) 695 format(/' M_bb (GeV) = ',e20.5,/) 690 format(/' theta (deg) = ',e20.5,/) 691 format(/' M1,M2 (GeV) = ',e20.5,1x,e20.5,/) print 897 897 format(/' Theoretical and algorithmic setup ----------',//) if(ios.eq.1) then print 890 else if(ios.eq.2) then print 891 else if(ios.eq.3) then print 892 endif if(iosf.eq.0) then print 89 else if(iosf.eq.1) then print 90 else if(iosf.eq.2) then print 91 else if(iosf.eq.3) then print 92 endif if(opeak.eq.'y') then print 895 else print 896 endif if(otype.eq.'cc03'.or.otype.eq.'cc11'.or.otype.eq.'cc20'.or. # otype.eq.'mx43') then if(ocoul.eq.'n') then print 453 else if(ocoul.eq.'y') then print 454 endif endif if(otype.eq.'cc03'.or.otype.eq.'cc11') then if(ofsr.eq.'n') then print 455 else if(ofsr.eq.'y') then print 456 endif endif if(otype.eq.'cc20'.and.ofl.eq.'n') then if(oww.eq.'f') then print 417 else print 405 endif else if(otype.eq.'cc20'.and.ofl.eq.'c') then if(rio.eq.'a') then print 436 else if(rio.eq.'i') then print 437 endif else if(otype.eq.'cc20'.and.ofl.eq.'y') then print 406 else if(otype.eq.'cc20'.and.ofl.eq.'e') then print 416 endif if(otype.eq.'cc20'.and.osinw.eq.'y') then print 419 endif if(opeaka.eq.'y') then print 418 endif if(oqcd.eq.'n') then print 457 else if(oqcd.eq.'y') then print 458 endif if((otype.eq.'cc03'.or.otype.eq.'cc11').and.ofl.eq.'n') then if(oww.eq.'f') then print 417 else print 405 endif else if(otype.eq.'cc03'.or.otype.eq.'cc11'.and.ofl.eq.'c') then if(rio.eq.'a') then print 436 else if(rio.eq.'i') then print 437 endif endif if(otype.eq.'cc03'.or.otype.eq.'cc11'. # or.otype.eq.'cc20') then if(ozz.eq.'f') then print 446 else if(ofl.eq.'n') then print 447 endif endif endif if(opglu.eq.'n') then print 474 endif * 405 format(/' Running W width, No restoration of GI') 436 format(/' FLoop2 (R+I) scheme applied ') 437 format(/' FLoop2 (I) scheme applied ') 406 format(/' FLoop1 scheme applied for LEP 2 energies') 416 format(/' Eff. FLoop1 scheme applied') 417 format(/' Fixed W width') 418 format(/' Mapping of t-channel photon ') 419 format(/' Single W configuration ') 446 format(/' Fixed Z width ') 447 format(/' Running Z width, No restoration of GI') 895 format(/' Atan mapping applied ') 896 format(/' Atan mapping not applied ') 89 format(/' No QED Radiation ') 90 format(/' O(alpha^2) beta StruFunctions ') 91 format(/' O(alpha^2) eta StruFunctions ') 92 format(/' O(alpha^2) BKP StruFunctions ') 890 format(/' alpha RenScheme ') 891 format(/' G_F RenScheme ') 892 format(/' LEP1 RenScheme ') 453 format(/' CSing not included ') 454 format(/' CSing included ') 455 format(/' FSRad not included ') 456 format(/' FSRad included ') 457 format(/' NaiveQCD not included ') 458 format(/' NaiveQCD included ') 95 format(/' XL Gdet ',i10) 474 format(/' Diagrams with internal gluons are suppressed ') * if(ofl.eq.'a') then print 704 if(oanom.eq.'r') then print 705,dg1z,dkg,rlg else print 706,acg1g,aclg,ackg,acg4g,acktg,acltg, # acg5g,acg1z,aclz,ackz,acg4z,acktz, # acltz,acg5z endif endif * 704 format(/' AC with parameters:',/) 705 format(' dg1z = ',e20.5,/ # ' dkg = ',e20.5,/ # ' rlg = ',e20.5) 706 format(' acg1g = ',e20.5,/ # ' aclg = ',e20.5,/ # ' ackg = ',e20.5,/ # ' acg4g = ',e20.5,/ # ' acktg = ',e20.5,/ # ' acltg = ',e20.5,/ # ' acg5g = ',e20.5,/ # ' acg1z = ',e20.5,/ # ' aclz = ',e20.5,/ # ' ackz = ',e20.5,/ # ' acg4z = ',e20.5,/ # ' acktz = ',e20.5,/ # ' acltz = ',e20.5,/ # ' acg5z = ',e20.5) * if((otype.eq.'cc03'.or.otype.eq.'cc11').and.om.eq.'g') then print 407 endif if((otype.eq.'nc21'.or.otype.eq.'nc25'.or.otype.eq.'nc50'.or. # otype.eq.'nc33'.or.otype.eq.'nc68'.or.otype.eq.'nc24'.or. # otype.eq.'nc19'.or.otype.eq.'nc48'.or.otype.eq.'nc64'.or. # otype.eq.'cc11'.or.otype.eq.'cc20').and. # om.eq.'g') then print 407 endif 407 format(/' Generation of events',/) * ifas= 0 do i=1,4 cuts1(1,i)= ae(i) cuts1(2,i)= (1.d0-s09abf(bsa(i),ifas)/pi)*180.d0 cuts1(3,i)= (1.d0-s09abf(asa(i),ifas)/pi)*180.d0 enddo do i=1,4 do j=1,4 cuts2(i,j)= 0.d0 enddo enddo cuts2(1,2)= aim(1)*ars cuts2(1,3)= aim(2)*ars cuts2(1,4)= aim(3)*ars cuts2(2,3)= aim(4)*ars cuts2(2,4)= aim(5)*ars cuts2(3,4)= aim(6)*ars * do i=1,4 do j=1,4 cuts3(i,j)= 0.d0 enddo enddo cuts3(1,2)= bim(1)*ars cuts3(1,3)= bim(2)*ars cuts3(1,4)= bim(3)*ars cuts3(2,3)= bim(4)*ars cuts3(2,4)= bim(5)*ars cuts3(3,4)= bim(6)*ars * do i=1,4 do j=1,4 cuts4(i,j)= 0.d0 enddo enddo ifas= 0 cuts4(1,2)= s09abf(afsa(1),ifas)/pi*180.d0 cuts4(1,3)= s09abf(afsa(2),ifas)/pi*180.d0 cuts4(1,4)= s09abf(afsa(3),ifas)/pi*180.d0 cuts4(2,3)= s09abf(afsa(4),ifas)/pi*180.d0 cuts4(2,4)= s09abf(afsa(5),ifas)/pi*180.d0 cuts4(3,4)= s09abf(afsa(6),ifas)/pi*180.d0 * do i=1,4 do j=1,4 cuts5(i,j)= 0.d0 enddo enddo cuts5(1,2)= s09abf(bfsa(1),ifas)/pi*180.d0 cuts5(1,3)= s09abf(bfsa(2),ifas)/pi*180.d0 cuts5(1,4)= s09abf(bfsa(3),ifas)/pi*180.d0 cuts5(2,3)= s09abf(bfsa(4),ifas)/pi*180.d0 cuts5(2,4)= s09abf(bfsa(5),ifas)/pi*180.d0 cuts5(3,4)= s09abf(bfsa(6),ifas)/pi*180.d0 * if(ipr.eq.1) then do i=1,4 clabs0(i)= clabs1(i) enddo else if(ipr.eq.2) then do i=1,4 clabs0(i)= clabs2(i) enddo else if(ipr.eq.3) then do i=1,4 clabs0(i)= clabs3(i) enddo else if(ipr.eq.4) then do i=1,4 clabs0(i)= clabs4(i) enddo else if(ipr.eq.5) then do i=1,4 clabs0(i)= clabs5(i) enddo else if(ipr.eq.6) then do i=1,4 clabs0(i)= clabs6(i) enddo else if(ipr.eq.7) then do i=1,4 clabs0(i)= clabs7(i) enddo else if(ipr.eq.8) then do i=1,4 clabs0(i)= clabs8(i) enddo else if(ipr.eq.9) then do i=1,4 clabs0(i)= clabs9(i) enddo else if(ipr.eq.10) then do i=1,4 clabs0(i)= clabs10(i) enddo else if(ipr.eq.11) then do i=1,4 clabs0(i)= clabs11(i) enddo else if(ipr.eq.12) then do i=1,4 clabs0(i)= clabs12(i) enddo else if(ipr.eq.13) then do i=1,4 clabs0(i)= clabs13(i) enddo else if(ipr.eq.14) then do i=1,4 clabs0(i)= clabs14(i) enddo else if(ipr.eq.15) then do i=1,4 clabs0(i)= clabs15(i) enddo else if(ipr.eq.16) then do i=1,4 clabs0(i)= clabs16(i) enddo else if(ipr.eq.17) then do i=1,4 clabs0(i)= clabs17(i) enddo else if(ipr.eq.18) then do i=1,4 clabs0(i)= clabs18(i) enddo else if(ipr.eq.19) then do i=1,4 clabs0(i)= clabs19(i) enddo else if(ipr.eq.20) then do i=1,4 clabs0(i)= clabs20(i) enddo else if(ipr.eq.21) then do i=1,4 clabs0(i)= clabs21(i) enddo else if(ipr.eq.22) then do i=1,4 clabs0(i)= clabs22(i) enddo else if(ipr.eq.23) then do i=1,4 clabs0(i)= clabs23(i) enddo else if(ipr.eq.24) then do i=1,4 clabs0(i)= clabs24(i) enddo else if(ipr.eq.25) then do i=1,4 clabs0(i)= clabs25(i) enddo else if(ipr.eq.26) then do i=1,4 clabs0(i)= clabs26(i) enddo else if(ipr.eq.27) then do i=1,4 clabs0(i)= clabs27(i) enddo else if(ipr.eq.28) then do i=1,4 clabs0(i)= clabs28(i) enddo else if(ipr.eq.29) then do i=1,4 clabs0(i)= clabs29(i) enddo else if(ipr.eq.30) then do i=1,4 clabs0(i)= clabs30(i) enddo else if(ipr.eq.31) then do i=1,4 clabs0(i)= clabs31(i) enddo else if(ipr.eq.32) then do i=1,4 clabs0(i)= clabs32(i) enddo else if(ipr.eq.33) then do i=1,4 clabs0(i)= clabs33(i) enddo else if(ipr.eq.34) then do i=1,4 clabs0(i)= clabs34(i) enddo else if(ipr.eq.35) then do i=1,4 clabs0(i)= clabs35(i) enddo else if(ipr.eq.36) then do i=1,4 clabs0(i)= clabs36(i) enddo else if(ipr.eq.37) then do i=1,4 clabs0(i)= clabs37(i) enddo else if(ipr.eq.38) then do i=1,4 clabs0(i)= clabs38(i) enddo else if(ipr.eq.39) then do i=1,4 clabs0(i)= clabs39(i) enddo endif * print 1009 1009 format(/'----------- PROCESS SPECIFICATIONS ARE --------',//) print 1000,(clabs0(i),i=1,4) 1000 format(/' Process is e+ e- -> ',a7,1x,a7,1x,a7,1x,a7, # /' with the following cuts [wrt e^- beam axis]',///) * if(ockm.eq.'y') then print 1044 1044 format(/' CKM is active, FS are: ',/) if(ipr.eq.2) then if(ickm.eq.1) then print*,'mu- , nu_mu~ , u , d~ ' else if(ickm.eq.2) then print*,'mu- , nu_mu~ , u , s~ ' else if(ickm.eq.3) then print*,'mu- , nu_mu~ , u , b~ ' else if(ickm.eq.3) then print*,'mu- , nu_mu~ , c , d~ ' else if(ickm.eq.4) then print*,'mu- , nu_mu~ , c , s~ ' else if(ickm.eq.5) then print*,'mu- , nu_mu~ , c , b~ ' endif else if(ipr.eq.5) then if(ickm.eq.1) then print*,'e- , nu_e~ , u , d~ ' else if(ickm.eq.2) then print*,'e- , nu_e~ , u , s~ ' else if(ickm.eq.3) then print*,'e- , nu_e~ , u , b~ ' else if(ickm.eq.3) then print*,'e- , nu_e~ , c , d~ ' else if(ickm.eq.4) then print*,'e- , nu_e~ , c , s~ ' else if(ickm.eq.5) then print*,'e- , nu_e~ , c , b~ ' endif else if(ipr.eq.3) then if(ickm.eq.1) then print*,'d , u~ , c , s~ ' else if(ickm.eq.2) then print*,'d , u~ , c , d~ ' else if(ickm.eq.3) then print*,'d , u~ , c , b~ ' else if(ickm.eq.4) then print*,'s , u~ , c , s~ ' else if(ickm.eq.5) then print*,'s , u~ , c , d~ ' else if(ickm.eq.6) then print*,'s , u~ , c , b~ ' else if(ickm.eq.7) then print*,'b , u~ , c , s~ ' else if(ickm.eq.8) then print*,'b , u~ , c , d~ ' else if(ickm.eq.9) then print*,'b , u~ , c , b~ ' else if(ickm.eq.10) then print*,'d , u~ , u , s~ ' else if(ickm.eq.11) then print*,'d , u~ , u , b~ ' else if(ickm.eq.12) then print*,'s , u~ , u , b~ ' else if(ickm.eq.13) then print*,'d , c~ , c , s~ ' else if(ickm.eq.14) then print*,'d , c~ , c , b~ ' else if(ickm.eq.15) then print*,'s , c~ , c , b~ ' endif else if(ipr.eq.21) then if(ickm.eq.1) then print*,'d , u~ , u , d~ ' else if(ickm.eq.2) then print*,'s , u~ , u , s~ ' else if(ickm.eq.3) then print*,'b , u~ , u , b~ ' else if(ickm.eq.4) then print*,'d , c~ , c , d~ ' else if(ickm.eq.5) then print*,'s , c~ , c , s~ ' else if(ickm.eq.6) then print*,'b , c~ , c , b~ ' endif endif print 1045 1045 format(//) endif * ncols= 80 indent= 0 ifail= 0 * call x04cbf('g','n',3,4,cuts1,3,' ',' E(GeV), SA(deg) cuts', # 'c',rlabs,'c',clabs0,ncols,indent,ifail) call x04abf(1,6) print 555 * ncols= 80 indent= 0 ifail= 0 * call x04cbf('u','b',4,4,cuts2,4,' ',' lower IM cuts (GeV)', # 'c',clabs0,'c',clabs0,ncols,indent,ifail) call x04abf(1,6) print 555 * ncols= 80 indent= 0 ifail= 0 * call x04cbf('u','b',4,4,cuts3,4,' ',' upper IM cuts (GeV)', # 'c',clabs0,'c',clabs0,ncols,indent,ifail) call x04abf(1,6) print 555 * ncols= 80 indent= 0 ifail= 0 * call x04cbf('u','b',4,4,cuts4,4,' ',' max FS angle(deg) cuts', # 'c',clabs0,'c',clabs0,ncols,indent,ifail) call x04abf(1,6) print 555 * ncols= 80 indent= 0 ifail= 0 * call x04cbf('u','b',4,4,cuts5,4,' ',' min FS angle(deg) cuts', # 'c',clabs0,'c',clabs0,ncols,indent,ifail) call x04abf(1,6) print 555 * 555 format(///) if(oxcm.eq.'c') then print 301,otype,chd,-chu,chup,-chdp else if(oxcm.eq.'n'.or.oxcm.eq.'m') then print 310,otype,chf,chfp,tif,tifp endif * 301 format(/' ',a4,'-diagrams : charges ',4f10.4) 310 format(/' ',a4,'-diagrams : ',/ # /' charges ',2f10.4,/ # /' isospin ',2f10.4) * if(omdist.eq.'y') then print 365 else if(itc.eq.0) then print 302 else if(oxcm.eq.'c') then if(itc.eq.1) then print 303 print 304,itcn else if(itc.eq.2) then print 305 else if(itc.eq.3) then print 306 else if(itc.eq.4) then print 307 else if(itc.eq.5) then print 308 else if(itc.eq.6) then print 309 else if(itc.eq.7) then print 311 else if(itc.eq.8) then print 312 else if(itc.eq.9) then print 313 else if(itc.eq.10) then print 314 else if(itc.eq.11) then print 364 else if(itc.eq.12) then print 366 endif else if(oxcm.eq.'n'.or.oxcm.eq.'m') then if(itc.eq.1) then print 311 else if(itc.eq.2) then print 312 endif endif endif endif * 302 format(/' Type of Observable: Cross-Section ',//) 303 format(/' Type of Observable: Momenta for E_gamma ',//) 304 format(/' order of moment = ',i2,' type = ',a1) 305 format(/' Type of Observable: Momenta for E_mu ',//) 306 format(/' Type of Observable: T_n[cos(theta_mu)] ',//) 307 format(/' Type of Observable: T_n[cos(theta_Wm)] ',//) 308 format(/' Type of Observable: T_n[cos(theta_Wp)] ',//) 309 format(/' Type of Observable: W virtuality ',//) 311 format(/' Type of Observable: M1+M2 distribution ',//) 312 format(/' Type of Observable: M1-M2 distribution ',//) 313 format(/' Type of Observable: M+ distribution ',//) 314 format(/' Type of Observable: cos(theta,//) distribution ',//) 364 format(/' Type of Observable: M1,M2 double distribution ',//) 365 format(/' Multi-differential distribution ',//) 366 format(/' Type of Observable: M- distribution ',//) * return end * *----------------------------------------------------------------------- * subroutine wtoinit(ipro,oxc,rs,wmi,zmi) implicit real*8 (a-h,o-z) * character*1,oprt,otop,omh,oxc,oint,oseed character*1,oxcm,ocoul,oud,oqcd,oglu,opeak,ofl,ofsr,oral,obin, # opeakn,om,osm,oww,ozz,opeaka,ostop,rio,oanom,ostore, # omssm,ockm,omdist,opglu,osmass,osinw,oprint character*2,ofs,oev character*4,otype * common/wtud/oud common/wtmp/zrm common/wtfb/oev common/wtcw/oww common/wtcz/ozz common/wtmod/om common/wtai/rio common/wtfs/ofs common/wtfls/ofl common/wtgg/oglu common/wtcb/obin common/wtoi/oint common/wtthr/sthq common/wtsw/osinw common/wtps/opeak common/wtsmod/osm common/wthiggs/hm common/wtdis/dist common/wtfsr/ofsr common/wtim/ostop common/wtopa/delc common/wtprt/oprt common/wtckm/ockm common/wtio/oprint common/wtickm/ickm common/wtgnum/itmx common/wtcqcd/iqcd common/wtap/opeaka common/wtaqcd/oqcd common/wtoral/oral common/wthiggo/omh common/wtcac/oanom common/wtfsm/fsm(4) common/wtseed/oseed common/wopst/ostore common/wtpsn/opeakn common/wtcoul/ocoul common/wttopop/otop common/wtpqcd/opglu common/wtomd/omdist common/wtmssmo/omssm common/wopstm/osmass common/wtnpr/ipr,ipr0 common/wticuts/iac(4) common/wtcurrent/oxcm common/wttopt/ios,iosf common/wtpoints/ipm,irm common/wtochannel/otype common/wtmatx/colf(8,8) common/wtvckm/vckm(3,3) common/wttc/itc,itcc,itcn common/wtdis2/distm,distp common/wtparam/eps,ddelta common/wtlb/abp,bbp,abm,bbm common/wtqparam/qpi,qpis,qeps,qdelta common/wtmssmi/am,tbeta,rmu,scalm,bat,bab common/wtcchannel/chu,chup,chd,chdp,fcuc,fcdc common/wtnchannel/chf,chfp,tif,tifp,fcun,fcdn common/wtsasw/separa,asccsw,sthqsw,eusw,edsw,alsw common/wtee/qch,qch2,vqr,vql,hbe(24),hbo(24),hmp(24) common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmy common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi common/wtacchannel/omchu,opchu,omchup,opchup,omchdp,opchdp, # omchd,opchd,hchup,hchu,hchdp,hchd 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/wtacc/acg1g,aclg,ackg,acg4g,acktg,acltg,acg5g,acg1z,aclz, # ackz,acg4z,acktz,acltz,acg5z 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 * *-----Official set of data input * ipr= ipro oxcm= oxc cfct= 0.38937966d9 fcnt= 81.d0 gf= 1.16639d-5/sqrt(2.d0) * gf= 8.2476172696d-6 em= 0.51099906d-3 pi= 3.141592653589793238462643d0 qpi= pi qpis= qpi*qpi ge= 0.5772156649d0 tm= 1.7771d0 bqm= 4.7d0 cqm= 1.55d0 alphai= 137.0359895d0 rmm= 0.10565839d0 * uqm= 0.041d0 * dqm= 0.041d0 uqm= 0.005d0 dqm= 0.010d0 sqm= 0.15d0 rnm= 1.d-20 dmy= 0.d0 eps= 1.d-37 qeps= 1.d-37 ddelta= 0.d0 qdelta= 0.d0 oprt= 'y' omssm= 'n' am= 90.d0 tbeta= 20.d0 rmu= -1.d3 scalm= 1.d3 bat= 1.d3 bab= 1.d3 * *-----NPTS, IRAND * ipm= 4 irm= 4 * oprint= 'n' * if(ipro.le.3) then ipr0= 1 else ipr0= 0 endif oww= 'r' ozz= 'r' if(ipro.gt.5.and.ipro.ne.37) then if(oww.ne.'r'.and.ozz.ne.'r') then print*,' forbidden input parameter set ' stop endif endif opeaka= 'n' if(ipro.ne.4.and.ipro.ne.5.and.ipro.ne.39) then if(opeaka.eq.'y') then print*,' forbidden input parameter set ' stop endif endif * ockm= 'n' ickm= 0 opglu= 'y' omdist= 'n' oint= 'n' om= 'e' osinw= 'n' if(om.eq.'g'.and.(ipro.eq.20.or.ipro.eq.21)) then print*,' forbidden input parameter set ' stop endif if(ockm.eq.'y') then if(ipro.ne.3.or.ipro.ne.21) then print*,' forbidden input parameter set ' stop endif endif * osm= 'n' if(om.eq.'e'.and.osm.eq.'g') then print*,' forbidden input parameter set ' stop endif itmx= 100000 ostop= 's' ostore= 'i' oseed= 'y' do i=1,4 fsm(i)= 0.d0 enddo * *-----CKM matrix elements * vckm(1,1)= 0.9753d0 vckm(1,3)= 0.0035d0 vckm(1,2)= sqrt(1.d0-(vckm(1,1)*vckm(1,1)+vckm(1,3)*vckm(1,3))) vckm(2,2)= 0.9745d0 vckm(2,3)= 0.040d0 vckm(2,1)= sqrt(1.d0-(vckm(2,2)*vckm(2,2)+vckm(2,3)*vckm(2,3))) vckm(3,3)= 0.99915 vckm(3,1)= 0.0095d0 vckm(3,2)= sqrt(1.d0-(vckm(3,3)*vckm(3,3)+vckm(3,1)*vckm(3,1))) * otop= 'd' omh= 'n' * chf= 0.d0 chfp= 0.d0 tif= 0.d0 tifp= 0.d0 fcd= 0.d0 fcu= 0.d0 chd= 0.d0 chu= 0.d0 chup= 0.d0 chdp= 0.d0 zrm= x02ajf() if(ipro.eq.1) then if(ipr0.eq.0) then otype= 'cc03' else if(ipr0.eq.1) then otype= 'cc11' endif chd= -1.d0 chu= 0.d0 chup= 0.d0 chdp= -1.d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.2) then if(ipr0.eq.0) then otype= 'cc03' else if(ipr0.eq.1) then otype= 'cc11' endif chd= -1.d0 chu= 0.d0 chup= 2.d0/3.d0 chdp= -1.d0/3.d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.3) then if(ipr0.eq.0) then otype= 'cc03' else if(ipr0.eq.1) then otype= 'cc11' endif chd= -1.d0/3.d0 chu= 2.d0/3.d0 chup= 2.d0/3.d0 chdp= -1.d0/3.d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.4) then otype= 'cc20' chd= -1.d0 chu= 0.d0 chup= 0.d0 chdp= -1.d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.5) then otype= 'cc20' chd= -1.d0 chu= 0.d0 chup= 2.d0/3.d0 chdp= -1.d0/3.d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.6) then otype= 'nc24' chf= -1.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.7) then otype= 'nc24' chf= -1.d0/3.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.8) then otype= 'nc24' chf= 2.d0/3.d0 chfp= 0.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.9) then otype= 'nc24' chf= -1.d0 chfp= -1.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.10) then otype= 'nc24' chf= -1.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.11) then otype= 'nc24' chf= -1.d0 chfp= 2.d0/3.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.12) then otype= 'nc24' chf= 0.d0 chfp= 0.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.13) then otype= 'nc32' chf= 2.d0/3.d0 chfp= 1.d0/3.d0 tif= 0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.14) then otype= 'nc32' chf= -1.d0/3.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.15) then otype= 'nc32' chf= 2.d0/3.d0 chfp= 2.d0/3.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.16) then otype= 'nc19' chf= 0.d0 chfp= 0.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.17) then otype= 'nc19' chf= -1.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.18) then otype= 'nc19' chf= 2.d0/3.d0 chfp= 0.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.19) then otype= 'nc19' chf= -1.d0/3.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.20) then otype= 'mx43' ofs= 'll' chf= -1.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 1.d0 chd= chf chu= chfp chup= chfp chdp= chf else if(ipro.eq.21) then otype= 'mx43' ofs= 'qq' chf= -1.d0/3.d0 chfp= 2.d0/3.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 3.d0 chd= chf chu= chfp chup= chfp chdp= chf else if(ipro.eq.22) then otype= 'nc48' chf= -1.d0 chfp= -1.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.23) then otype= 'nc48' chf= 0.d0 chfp= -1.d0 tif= 0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.24) then otype= 'nc48' chf= 2.d0/3.d0 chfp= -1.d0 tif= 0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.25) then otype= 'nc48' chf= -1.d0/3.d0 chfp= -1.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.26) then otype= 'nc64' ofs= 'll' chf= -1.d0 chfp= -1.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.27) then otype= 'nc64' ofs= 'll' chf= 0.d0 chfp= 0.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 1.d0 fcu= 1.d0 else if(ipro.eq.28) then otype= 'nc64' ofs= 'qq' chf= 2.d0/3.d0 chfp= 2.d0/3.d0 tif= 0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.29) then otype= 'nc64' ofs= 'qq' chf= -1.d0/3.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.30) then otype= 'nc25' oud= 'n' chf= -1.d0/3.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.31) then otype= 'nc25' oud= 'l' chf= -1.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.32) then otype= 'nc21' oud= 'l' chf= -1.d0/3.d0 chfp= 0.d0 tif= -0.5d0 tifp= 0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.33) then otype= 'nc50' oud= 'l' chf= -1.d0/3.d0 chfp= -1.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 1.d0 else if(ipro.eq.34) then otype= 'nc33' oud= 'l' chf= 2.d0/3.d0 chfp= -1.d0/3.d0 tif= 0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.35) then otype= 'nc33' oud= 'l' chf= -1.d0/3.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.36) then otype= 'nc68' ofs= 'qq' oev= 'a2' chf= -1.d0/3.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 3.d0 fcu= 3.d0 else if(ipro.eq.37) then otype= 'nc26' oud= 'l' chf= -1.d0 chfp= -1.d0/3.d0 tif= -0.5d0 tifp= -0.5d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.38) then ipr0= 1 otype= 'cc12' chd= -1.d0 chu= 0.d0 chup= 2.d0/3.d0 chdp= -1.d0/3.d0 fcd= 1.d0 fcu= 3.d0 else if(ipro.eq.39) then otype= 'cc20' chd= -1.d0 chu= 0.d0 chup= 0.d0 chdp= -1.d0 fcd= 1.d0 fcu= 1.d0 endif fcuc= fcu fcdc= fcd fcun= fcu fcdn= fcd * opeak= 'y' opeakn= 'n' if(otype.ne.'mx43'.and.opeakn.eq.'y') then print*,' forbidden input parmeter set ' stop endif * oqcd= 'n' iqcd= 1 if(oqcd.eq.'y') then if(otype.eq.'nc21'.or.otype.eq.'nc25'.or. # otype.eq.'nc33'.or.otype.eq.'nc50'.or. # otype.eq.'nc68') then if(iqcd.ne.1) then print*,' forbidden input parmeter set ' stop endif endif endif * ofl= 'n' rio= 'a' * if(ofl.ne.'n') then if(oww.ne.'r'.and.ozz.ne.'r') then print*,' Widths must be running ' stop endif endif * oanom= 'r' acg1g= 0.d0 aclg= 0.d0 ackg= 0.d0 acg4g= 0.d0 acktg= 0.d0 acltg= 0.d0 acg5g= 0.d0 acg1z= 0.d0 aclz= 0.d0 ackz= 0.d0 acg4z= 0.d0 acktz= 0.d0 acltz= 0.d0 acg5z= 0.d0 dg1z= 0.d0 dkg= 0.d0 rlg= 0.d0 * oglu= 'y' * if(otype.eq.'nc48'.or.otype.eq.'nc50') then qch= chf qch2= qch*qch else qch= 0.d0 qch2= 0.d0 endif do i=1,8 do j=1,8 colf(i,j)= 0.d0 enddo enddo * if((otype.eq.'nc64'.or.otype.eq.'nc68'). # and.ofs.eq.'qq') then colf(1,1)= 9.d0 colf(1,3)= 3.d0 colf(1,4)= 16.d0 colf(1,5)= 3.d0 colf(1,6)= 16.d0 colf(1,7)= 9.d0 colf(2,2)= 32.d0 colf(2,3)= 16.d0 colf(2,4)= -0.10667d+02 colf(2,5)= 16.d0 colf(2,6)= -0.10667d+02 colf(2,8)= 32.d0 colf(3,3)= 9.d0 colf(3,5)= 9.d0 colf(3,7)= 3.d0 colf(3,8)= 16.d0 colf(4,4)= 32.d0 colf(4,6)= 32.d0 colf(4,7)= 16.d0 colf(4,8)= -0.10667d+02 colf(5,5)= 9.d0 colf(5,7)= 3.d0 colf(5,8)= 16.d0 colf(6,6)= 32.d0 colf(6,7)= 16.d0 colf(6,8)= -0.10667d+02 colf(7,7)= 9.d0 colf(8,8)= 32.d0 do j=1,8 do i=j+1,8 colf(i,j)= colf(j,i) enddo enddo endif * dist= 0.d0 distm= 0.d0 distp= 0.d0 itc= 0 itcc= 0 itcn= 0 if(itc.eq.10) then dist= 180.d0-dist dist= cos(dist/180.d0*pi) endif obin= 'n' abp= 0.d0 bbp= 1.d0 abm= 0.d0 bbm= 1.d0 ofsr= 'n' delc= 0.d0 * oral= 'f' alwi= 128.07d0 if(oral.eq.'r') then sm= -rs*rs call wtohadr5(rs,derh,ederh) call wtopself(sm,pggf) derl= 0.25d0/alphai/pi*pggf der= derl+derh alwi= (1.d0-der)*alphai endif * ocoul= 'n' ios= 2 iosf= 1 * fsc= cos(pi/36.d0) scc= cos(pi/18.d0) sccp= cos(pi/12.d0) * sthq= 5.d0/rs sthq= 45.d0/rs bcut= 30.d0 ascc= cos(pi/18.d0) asccsw= 0.997d0 escc= 1.d0 separa= 0.1d0 alsw= 0.95d0 eusw= 15.d0 edsw= 15.d0 * if(ipro.eq.1) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 ae(1)= 1.d0 ae(4)= 1.d0 do i=2,3 ae(i)= 0.d0 enddo iac(3)= 1 asa(1)= -scc bsa(1)= scc asa(4)= -scc bsa(4)= scc do i=2,3 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(3)= -1.d0 bfsa(3)= fsc afsa(1)= -1.d0 bfsa(1)= +1.d0 afsa(2)= -1.d0 bfsa(2)= +1.d0 afsa(4)= -1.d0 bfsa(4)= +1.d0 afsa(5)= -1.d0 bfsa(5)= +1.d0 afsa(6)= -1.d0 bfsa(6)= +1.d0 isaa= 0 isab= 0 else if(ipro.eq.2.or.ipro.eq.38) then * iac(1)= 1 * do i=1,5 * aim(i)= 0.d0 * bim(i)= 1.d0 * enddo * aim(6)= sthq * bim(6)= 1.d0 * iac(2)= 1 * ae(1)= 1.d0 * ae(2)= 0.d0 * ae(3)= 3.d0 * ae(4)= 3.d0 * iac(3)= 1 * asa(1)= -scc * bsa(1)= scc * do i=2,4 * asa(i)= -1.d0 * bsa(i)= +1.d0 * enddo * iac(4)= 1 * afsa(1)= -1.d0 * bfsa(1)= +1.d0 * afsa(2)= -1.d0 * bfsa(2)= fsc * afsa(3)= -1.d0 * bfsa(3)= fsc * afsa(4)= -1.d0 * bfsa(4)= +1.d0 * afsa(5)= -1.d0 * bfsa(5)= +1.d0 * afsa(6)= -1.d0 * bfsa(6)= +1.d0 * isaa= 0 * isab= 0 iac(1)= 1 do i=1,5 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(6)= sthq bim(6)= 1.d0 iac(2)= 0 ae(1)= 0.d0 ae(2)= 0.d0 ae(3)= 0.d0 ae(4)= 0.d0 iac(3)= 1 asa(1)= -1.d0 bsa(1)= +1.d0 asa(2)= -1.d0 bsa(2)= +1.d0 do i=3,4 asa(i)= -cos(pi/18.d0) bsa(i)= +cos(pi/18.d0) enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.3) then iac(1)= 1 if(itcc.eq.0) then do i=1,6 aim(i)= sthq bim(i)= 1.d0 enddo else if(itcc.eq.1) then do i=2,5 aim(i)= sthq bim(i)= 1.d0 enddo aim(1)= (wmi-10.d0)/rs bim(1)= (wmi+10.d0)/rs aim(6)= (wmi-10.d0)/rs bim(6)= (wmi+10.d0)/rs else if(itcc.eq.2) then do i=1,2 aim(i)= sthq bim(i)= 1.d0 enddo do i=5,6 aim(i)= sthq bim(i)= 1.d0 enddo aim(3)= (wmi-10.d0)/rs bim(3)= (wmi+10.d0)/rs aim(4)= (wmi-10.d0)/rs bim(4)= (wmi+10.d0)/rs else if(itcc.eq.3) then aim(1)= sthq bim(1)= 1.d0 aim(6)= sthq bim(6)= 1.d0 do i=3,4 aim(i)= sthq bim(i)= 1.d0 enddo aim(2)= (wmi-10.d0)/rs bim(2)= (wmi+10.d0)/rs aim(5)= (wmi-10.d0)/rs bim(5)= (wmi+10.d0)/rs endif iac(2)= 1 do i=1,4 ae(i)= 3.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 afsa(1)= -1.d0 bfsa(1)= +1.d0 afsa(2)= -1.d0 bfsa(2)= +1.d0 afsa(3)= -1.d0 bfsa(3)= +1.d0 afsa(4)= -1.d0 bfsa(4)= +1.d0 afsa(5)= -1.d0 bfsa(5)= +1.d0 afsa(6)= -1.d0 bfsa(6)= +1.d0 isaa= 0 isab= 0 else if(ipro.eq.4.or.ipro.eq.39) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 ae(1)= 1.d0 ae(2)= 0.d0 ae(3)= 0.d0 ae(4)= 1.d0 iac(3)= 1 asa(1)= -scc bsa(1)= scc asa(4)= -scc bsa(4)= scc do i=2,3 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(3)= -1.d0 bfsa(3)= fsc do i=1,2 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo do i=4,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.5) then if(osinw.eq.'y') then iac(1)= 1 do i=1,5 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(6)= sthq bim(6)= 1.d0 iac(2)= 0 ae(1)= 0.d0 ae(2)= 0.d0 ae(3)= 0.d0 ae(4)= 0.d0 iac(3)= 1 asa(1)= -asccsw bsa(1)= +1.d0 do i=2,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else iac(1)= 1 do i=1,5 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(6)= sthq bim(6)= 1.d0 iac(2)= 1 ae(1)= escc ae(2)= 0.d0 ae(3)= 3.d0 ae(4)= 3.d0 iac(3)= 1 asa(1)= -ascc bsa(1)= ascc do i=2,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(1)= -1.d0 bfsa(1)= +1.d0 afsa(2)= -1.d0 bfsa(2)= fsc afsa(3)= -1.d0 bfsa(3)= fsc do i=4,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 endif else if(ipro.eq.6) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 ae(1)= 1.d0 ae(2)= 1.d0 ae(3)= 0.d0 ae(4)= 0.d0 iac(3)= 1 asa(1)= -scc bsa(1)= scc asa(2)= -scc bsa(2)= scc do i=3,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(1)= -1.d0 bfsa(1)= fsc do i=2,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.7.or.ipro.eq.8) then iac(1)= 1 aim(1)= sthq bim(1)= 1.d0 do i=2,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 ae(1)= 3.d0 ae(2)= 3.d0 ae(3)= 0.d0 ae(4)= 0.d0 iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.9.or.ipro.eq.22) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 do i=1,4 ae(i)= 1.d0 enddo iac(3)= 1 do i=1,4 asa(i)= -scc bsa(i)= scc enddo iac(4)= 1 do i=1,6 afsa(i)= -1.d0 bfsa(i)= fsc enddo isaa= 1 isab= 1 else if(ipro.eq.10.or.ipro.eq.11) then iac(1)= 1 do i=1,5 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(6)= sthq bim(6)= 1.d0 iac(2)= 1 do i=1,2 ae(i)= 1.d0 enddo do i=3,4 ae(i)= 3.d0 enddo iac(3)= 1 do i=1,2 asa(i)= -scc bsa(i)= scc enddo do i=3,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(6)= -1.d0 bfsa(6)= +1.d0 do i=1,5 afsa(i)= -1.d0 bfsa(i)= fsc enddo isaa= 0 isab= 0 else if(ipro.eq.13.or.ipro.eq.14.or.ipro.eq.15) then iac(1)= 1 if(itcc.eq.0) then do i=1,6 aim(i)= sthq bim(i)= 1.d0 enddo else if(itcc.eq.1) then do i=2,5 aim(i)= sthq bim(i)= 1.d0 enddo aim(1)= (wmi-10.d0)/rs bim(1)= (wmi+10.d0)/rs aim(6)= (wmi-10.d0)/rs bim(6)= (wmi+10.d0)/rs else if(itcc.eq.2) then do i=1,2 aim(i)= sthq bim(i)= 1.d0 enddo do i=5,6 aim(i)= sthq bim(i)= 1.d0 enddo aim(3)= (wmi-10.d0)/rs bim(3)= (wmi+10.d0)/rs aim(4)= (wmi-10.d0)/rs bim(4)= (wmi+10.d0)/rs else if(itcc.eq.3) then aim(1)= sthq bim(1)= 1.d0 aim(6)= sthq bim(6)= 1.d0 do i=3,4 aim(i)= sthq bim(i)= 1.d0 enddo aim(2)= (wmi-10.d0)/rs bim(2)= (wmi+10.d0)/rs aim(5)= (wmi-10.d0)/rs bim(5)= (wmi+10.d0)/rs endif iac(2)= 1 do i=1,4 ae(i)= 3.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.12.or.ipro.eq.16) then do i=1,4 iac(i)= 0 ae(i)= 0.d0 asa(i)= -1.d0 bsa(i)= +1.d0 enddo do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.17) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 do i=1,2 ae(i)= 1.d0 enddo do i=3,4 ae(i)= 0.d0 enddo iac(3)= 1 do i=1,2 asa(i)= -scc bsa(i)= +scc enddo do i=3,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(1)= -1.d0 bfsa(1)= +fsc do i=2,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.18.or.ipro.eq.19) then iac(1)= 1 aim(1)= sthq bim(1)= 1.d0 do i=2,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 do i=1,2 ae(i)= 3.d0 enddo do i=3,4 ae(i)= 0.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.20) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 ae(1)= 1.d0 ae(4)= 1.d0 do i=2,3 ae(i)= 0.d0 enddo iac(3)= 1 asa(1)= -scc bsa(1)= scc asa(4)= -scc bsa(4)= scc do i=2,3 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 1 afsa(3)= -1.d0 bfsa(3)= fsc do i=1,2 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo do i=4,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.21) then iac(1)= 1 if(itcc.eq.0) then do i=1,6 aim(i)= sthq bim(i)= 1.d0 enddo else if(itcc.eq.1) then do i=2,5 aim(i)= sthq bim(i)= 1.d0 enddo aim(1)= (wmi-10.d0)/rs bim(1)= (wmi+10.d0)/rs aim(6)= (wmi-10.d0)/rs bim(6)= (wmi+10.d0)/rs else if(itcc.eq.2) then do i=1,2 aim(i)= sthq bim(i)= 1.d0 enddo do i=5,6 aim(i)= sthq bim(i)= 1.d0 enddo aim(3)= (wmi-10.d0)/rs bim(3)= (wmi+10.d0)/rs aim(4)= (wmi-10.d0)/rs bim(4)= (wmi+10.d0)/rs else if(itcc.eq.3) then aim(1)= sthq bim(1)= 1.d0 aim(6)= sthq bim(6)= 1.d0 do i=3,4 aim(i)= sthq bim(i)= 1.d0 enddo aim(2)= (wmi-10.d0)/rs bim(2)= (wmi+10.d0)/rs aim(5)= (wmi-10.d0)/rs bim(5)= (wmi+10.d0)/rs endif iac(2)= 1 do i=1,4 ae(i)= 3.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.26) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 do i=1,4 ae(i)= 1.d0 enddo iac(3)= 1 do i=1,4 asa(i)= -scc bsa(i)= +scc enddo iac(4)= 1 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +fsc enddo isaa= 0 isab= 0 else if(ipro.eq.27) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 0 do i=1,4 ae(i)= 0.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.23) then iac(1)= 0 do i=1,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo iac(2)= 1 ae(1)= 0.d0 ae(2)= 0.d0 ae(3)= 1.d0 ae(4)= 1.d0 iac(3)= 1 do i=1,2 asa(i)= -1.d0 bsa(i)= +1.d0 enddo do i=3,4 asa(i)= -scc bsa(i)= scc enddo iac(4)= 1 afsa(6)= -1.d0 bfsa(6)= fsc do i=1,5 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.24.or.ipro.eq.25) then iac(1)= 1 do i=2,6 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(1)= sthq bim(1)= 1.d0 iac(2)= 1 do i=1,2 ae(i)= 3.d0 enddo do i=3,4 ae(i)= 1.d0 enddo iac(3)= 1 do i=1,2 asa(i)= -1.d0 bsa(i)= +1.d0 enddo do i=3,4 asa(i)= -scc bsa(i)= scc enddo iac(4)= 1 afsa(1)= -1.d0 bfsa(1)= +1.d0 do i=2,6 afsa(i)= -1.d0 bfsa(i)= fsc enddo isaa= 0 isab= 0 else if(ipro.eq.28.or.ipro.eq.29) then iac(1)= 1 if(itcc.eq.0) then do i=1,6 aim(i)= sthq bim(i)= 1.d0 enddo else if(itcc.eq.1) then do i=2,5 aim(i)= sthq bim(i)= 1.d0 enddo aim(1)= (wmi-10.d0)/rs bim(1)= (wmi+10.d0)/rs aim(6)= (wmi-10.d0)/rs bim(6)= (wmi+10.d0)/rs else if(itcc.eq.2) then do i=1,2 aim(i)= sthq bim(i)= 1.d0 enddo do i=5,6 aim(i)= sthq bim(i)= 1.d0 enddo aim(3)= (wmi-10.d0)/rs bim(3)= (wmi+10.d0)/rs aim(4)= (wmi-10.d0)/rs bim(4)= (wmi+10.d0)/rs else if(itcc.eq.3) then aim(1)= sthq bim(1)= 1.d0 aim(6)= sthq bim(6)= 1.d0 do i=3,4 aim(i)= sthq bim(i)= 1.d0 enddo aim(2)= (wmi-10.d0)/rs bim(2)= (wmi+10.d0)/rs aim(5)= (wmi-10.d0)/rs bim(5)= (wmi+10.d0)/rs endif iac(2)= 1 do i=1,4 ae(i)= 3.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.30.or.ipro.eq.32) then iac(1)= 1 do i=2,5 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(1)= bcut/rs bim(1)= 1.d0 aim(6)= (zmi-25.d0)/rs bim(6)= (zmi+25.d0)/rs iac(2)= 0 do i=1,4 ae(i)= 0.d0 enddo iac(3)= 1 asa(1)= -scc bsa(1)= scc asa(2)= -scc bsa(2)= scc do i=3,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.31.or.ipro.eq.34.or.ipro.eq.35.or. # ipro.eq.37) then iac(1)= 1 do i=2,5 aim(i)= 0.d0 bim(i)= 1.d0 enddo aim(1)= (zmi-15.d0)/rs bim(1)= (zmi+15.d0)/rs aim(6)= bcut/rs bim(6)= 1.d0 iac(2)= 1 do i=3,4 ae(i)= 0.d0 enddo ae(1)= 10.d0 ae(2)= 10.d0 iac(3)= 1 asa(1)= -sccp bsa(1)= sccp asa(2)= -sccp bsa(2)= sccp do i=3,4 asa(i)= -1.d0 bsa(i)= +1.d0 enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 else if(ipro.eq.36) then iac(1)= 1 do i=1,6 aim(i)= bcut/rs bim(i)= 1.d0 enddo iac(2)= 1 do i=1,4 ae(i)= 3.d0 enddo iac(3)= 0 do i=1,4 asa(i)= -scc bsa(i)= +scc enddo iac(4)= 0 do i=1,6 afsa(i)= -1.d0 bfsa(i)= +1.d0 enddo isaa= 0 isab= 0 endif * do i=1,4 ombsa(i)= 1.d0-bsa(i) omasa(i)= 1.d0-asa(i) opbsa(i)= 1.d0+bsa(i) opasa(i)= 1.d0+asa(i) enddo do j=1,4 sgam(j)= 0.5d0*omasa(j) cgam(j)= 0.5d0*ombsa(j) enddo sg12= 0.5d0*(1.d0-afsa(1)) cg12= 0.5d0*(1.d0-bfsa(1)) sg13= 0.5d0*(1.d0-afsa(2)) cg13= 0.5d0*(1.d0-bfsa(2)) sg14= 0.5d0*(1.d0-afsa(3)) cg14= 0.5d0*(1.d0-bfsa(3)) sg23= 0.5d0*(1.d0-afsa(4)) cg23= 0.5d0*(1.d0-bfsa(4)) sg24= 0.5d0*(1.d0-afsa(5)) cg24= 0.5d0*(1.d0-bfsa(5)) sg34= 0.5d0*(1.d0-afsa(6)) cg34= 0.5d0*(1.d0-bfsa(6)) * omchup= 1.d0-chup opchup= 1.d0+chup omchu= 1.d0-chu opchu= 1.d0+chu omchdp= 1.d0-chdp opchdp= 1.d0+chdp omchd= 1.d0-chd opchd= 1.d0+chd * return end * *------------------------------------------------------------------- * subroutine wtoswcutset(oasccsw,osthqsw,oeusw,oedsw,oalsw) implicit real*8(a-h,o-z) * common/wtsasw/separa,asccsw,sthqsw,eusw,edsw,alsw * if(oasccsw.ge.0.d0) then asccsw= oasccsw endif if(osthqsw.ge.0.d0) then sthqsw= osthqsw endif if(oeusw.ge.0.d0) then eusw= oeusw endif if(oedsw.ge.0.d0) then edsw= oedsw endif if(oalsw.ge.0.d0) then alsw= oalsw endif * return end * *------------------------------------------------------------------- * subroutine wtocutset(iim,xaim,xbim,ie,xae,ics,xasa,xbsa, # icf,xafsa,xbfsa) implicit real*8(a-h,o-z) * common/wticuts/iac(4) 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) * if(iim.gt.0) then aim(iim)= xaim bim(iim)= xbim endif ki= 0 do i=1,6 if(aim(i).ne.0.d0) then ki= ki+1 endif enddo do i=1,6 if(bim(i).ne.1.d0) then ki= ki+1 endif enddo if(ki.eq.0) then iac(1)= 0 else iac(1)= 1 endif * if(ie.gt.0) then ae(ie)= xae endif rkae= 0.d0 do i=1,4 rkae= rkae+ae(i) enddo if(rkae.ne.0.d0) then iac(2)= 1 else iac(2)= 0 endif * if(ics.gt.0) then asa(ics)= xasa bsa(ics)= xbsa endif ksa= 0 do i=1,4 if(asa(i).ne.-1.d0) then ksa= ksa+1 endif enddo do i=1,4 if(bsa(i).ne.1.d0) then ksa= ksa+1 endif enddo if(ksa.eq.0) then iac(3)= 0 else iac(3)= 1 endif * if(icf.gt.0) then afsa(icf)= xafsa bfsa(icf)= xbfsa endif kfsa= 0 do i=1,6 if(afsa(i).ne.-1.d0) then kfsa= kfsa+1 endif enddo do i=1,6 if(bfsa(i).ne.1.d0) then kfsa= kfsa+1 endif enddo if(kfsa.eq.0) then iac(4)= 0 else iac(4)= 1 endif * do i=1,4 ombsa(i)= 1.d0-bsa(i) omasa(i)= 1.d0-asa(i) opbsa(i)= 1.d0+bsa(i) opasa(i)= 1.d0+asa(i) enddo do j=1,4 sgam(j)= 0.5d0*omasa(j) cgam(j)= 0.5d0*ombsa(j) enddo sg12= 0.5d0*(1.d0-afsa(1)) cg12= 0.5d0*(1.d0-bfsa(1)) sg13= 0.5d0*(1.d0-afsa(2)) cg13= 0.5d0*(1.d0-bfsa(2)) sg14= 0.5d0*(1.d0-afsa(3)) cg14= 0.5d0*(1.d0-bfsa(3)) sg23= 0.5d0*(1.d0-afsa(4)) cg23= 0.5d0*(1.d0-bfsa(4)) sg24= 0.5d0*(1.d0-afsa(5)) cg24= 0.5d0*(1.d0-bfsa(5)) sg34= 0.5d0*(1.d0-afsa(6)) cg34= 0.5d0*(1.d0-bfsa(6)) * return end * *---------------------------------------------------------------------- * subroutine wtohelp() * parameter(nout=21) * open(nout,file='wto_help',status='new') * write(nout,fmt=*) ' ++++++++++++++++++++++++++++++++++++++++++ ' write(nout,fmt=*) ' + + ' write(nout,fmt=*) ' + Emergency kit for WTO 2.0 + ' write(nout,fmt=*) ' + = WTO 1.0 plus + ' write(nout,fmt=*) ' + Event generation + ' write(nout,fmt=*) ' + Interface with JETSET 7.4 + ' write(nout,fmt=*) ' + Fermion loop + ' write(nout,fmt=*) ' + Basic MSSM + ' write(nout,fmt=*) ' + TGC + ' write(nout,fmt=*) ' + CKM + ' write(nout,fmt=*) ' + + ' write(nout,fmt=*) ' ++++++++++++++++++++++++++++++++++++++++++ ' write(nout,fmt=*) ' Structure of the code is: ' write(nout,fmt=*) ' 1) call wtoinit(ipr,oxc,rs,wm,zm) ' write(nout,fmt=*) ' for initialization ' write(nout,fmt=*) ' 2) call wtocopt(oflag,ival) ' write(nout,fmt=*) ' to reset IOS, IOSF, IPM, IRM ' write(nout,fmt=*) ' 3) call wtocflag(***) ' write(nout,fmt=*) ' to reset character*(*) parameters ' write(nout,fmt=*) ' 4) call wtosopt(oflag,val) ' write(nout,fmt=*) ' to reset MSSM parameters ' write(nout,fmt=*) ' 5) call wtocutset(***) ' write(nout,fmt=*) ' to reset cuts ' write(nout,fmt=*) ' 6) call wtoacopt(***) ' write(nout,fmt=*) ' to set AC ' write(nout,fmt=*) ' 7) call WTO(***) ' write(nout,fmt=*) ' to run the code ' write(nout,fmt=*) ' 8) call wtooutput(ipr) ' write(nout,fmt=*) ' for printout ' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' About the input parameters: ' write(nout,fmt=*) ' rs - root(s) cm energy ' write(nout,fmt=*) ' wm - M_W W mass ' write(nout,fmt=*) ' zm - M_Z Z mass ' write(nout,fmt=*) ' zg - G_Z Z width ' write(nout,fmt=*) ' tqm - m_top top mass ' write(nout,fmt=*) ' hm - M_H Higgs mass ' write(nout,fmt=*) ' alsz - alpha_s(M_Z) ' write(nout,fmt=*) ' are arguments of WTO ' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' IPR,OXC,RS are arguments of WTOINIT ' write(nout,fmt=*) ' IPR and OXC as it follows ' write(nout,fmt=*) ' Available processes are : ' write(nout,fmt=*) ' ------------------------------------------ ' write(nout,fmt=*) ' Note the ordering of particles ' write(nout,fmt=*) ' ------------------------------------------ ' write(nout,fmt=*) ' IPR= 1 mu- , nu_mu~ , nu_tau , tau+ ' write(nout,fmt=*) ' IPR= 2 mu- , nu_mu~ , u , d~ ' write(nout,fmt=*) ' IPR= 3 d , u~ , c , s~ **' write(nout,fmt=*) ' IPR= 4 e- , nu_e~ , nu_mu , mu+ ' write(nout,fmt=*) ' IPR= 5 e- , nu_e~ , u , d~ ' write(nout,fmt=*) ' IPR = 1-5 -> OXC = C ' write(nout,fmt=*) ' IPR= 6 mu- , mu+ , nu_tau , nu_tau~ ' write(nout,fmt=*) ' IPR= 7 d , d~ , nu_mu , nu_mu~ ' write(nout,fmt=*) ' IPR= 8 u , u~ , nu_mu , nu_mu~ ' write(nout,fmt=*) ' IPR= 9 mu- , mu+ , tau- , tau+ ' write(nout,fmt=*) ' IPR= 10 mu- , mu+ , d , d~ ' write(nout,fmt=*) ' IPR= 11 mu- , mu+ , u , u~ ' write(nout,fmt=*) ' IPR= 12 nu_mu , nu_mu~ , nu_tau , nu_tau~ ' write(nout,fmt=*) ' IPR= 13 s , s~ , u , u~ ' write(nout,fmt=*) ' IPR= 14 d , d~ , s , s~ ' write(nout,fmt=*) ' IPR= 15 u , u~ , c , c~ ' write(nout,fmt=*) ' IPR= 16 nu_mu , nu_mu~ , nu_e , nu_e~ ' write(nout,fmt=*) ' IPR= 17 mu- , mu+ , nu_e , nu_e~ ' write(nout,fmt=*) ' IPR= 18 u , u~ , nu_e , nu_e~ ' write(nout,fmt=*) ' IPR= 19 d , d~ , nu_e , nu_e~ ' write(nout,fmt=*) ' IPR = 6-19 -> OXC = N ' write(nout,fmt=*) ' IPR= 20 mu- , nu_mu~ , nu_mu , mu+ ' write(nout,fmt=*) ' IPR= 21 d , u~ , u , d~ **' write(nout,fmt=*) ' IPR = 20-21 -> OXC = M ' write(nout,fmt=*) ' IPR= 22 mu- , mu+ , e- , e+ ' write(nout,fmt=*) ' IPR= 23 nu_mu , nu_mu~ , e- , e+ ' write(nout,fmt=*) ' IPR= 24 u , u~ , e- , e+ ' write(nout,fmt=*) ' IPR= 25 d , d~ , e- , e+ ' write(nout,fmt=*) ' IPR= 26 mu- , mu+ , mu- , mu+ ' write(nout,fmt=*) ' IPR= 27 nu_mu , nu_mu~ , nu_mu , nu_mu~ ' write(nout,fmt=*) ' IPR= 28 u , u~ , u , u~ ' write(nout,fmt=*) ' IPR= 29 d , d~ , d , d~ ' write(nout,fmt=*) ' IPR= 30 b , b~ , nu_mu , nu_mu~ * ' write(nout,fmt=*) ' IPR= 31 mu- , mu+ , b , b~ * ' write(nout,fmt=*) ' IPR= 32 b , b~ , nu_e , nu_e~ * ' write(nout,fmt=*) ' IPR= 33 b , b~ , e- , e+ * ' write(nout,fmt=*) ' IPR= 34 u , u~ , b , b~ ' write(nout,fmt=*) ' IPR= 35 d , d~ , b , b~ ' write(nout,fmt=*) ' IPR= 36 b , b~ , b , b~ * ' write(nout,fmt=*) ' IPR= 37 tau- , tau+ , b , b~ * ' write(nout,fmt=*) ' IPR= 22-37 -> OXC = N ' write(nout,fmt=*) ' IPR= 38 tau- , nu_tau~ , c , s~ * ' write(nout,fmt=*) ' IPR= 38 -> OXC = C ' write(nout,fmt=*) ' IPR= 39 e- , nu_e~ , nu_tau , tau+ ' write(nout,fmt=*) ' IPR= 39 -> OXC = C ' write(nout,fmt=*) ' ------------------------------------------ ' write(nout,fmt=*) ' * are processes in MSSM ' write(nout,fmt=*) ' With IPR.LE.3 and IPR0 = 0(DEFAULT 1) ' write(nout,fmt=*) ' the CC03 processes are selected ' write(nout,fmt=*) ' ------------------------------------------ ' write(nout,fmt=*) ' NEW ' write(nout,fmt=*) ' For CKM one should set OCKM = Y through ' write(nout,fmt=*) ' WTOCFLAG(***) and ' write(nout,fmt=*) ' call WTOCKM(VCKM) to initialize the ' write(nout,fmt=*) ' matrix elements VCKM(3,3) ' write(nout,fmt=*) ' with CKM, processes are specified by ICKM ' write(nout,fmt=*) ' Calling sequence is therefore: ' write(nout,fmt=*) ' OF = OCKM ' write(nout,fmt=*) ' OV = Y ' write(nout,fmt=*) ' call wtocflag(rs,of,ov,ickm,-1,-1.d0,-1.d0)' write(nout,fmt=*) ' Allowed processes are: ' write(nout,fmt=*) ' IPR = 2: ' write(nout,fmt=*) ' ICKM = 1 mu- , nu_mu~ , u , d~ ' write(nout,fmt=*) ' ICKM = 2 mu- , nu_mu~ , u , s~ ' write(nout,fmt=*) ' ICKM = 3 mu- , nu_mu~ , u , b~ ' write(nout,fmt=*) ' ICKM = 4 mu- , nu_mu~ , c , d~ ' write(nout,fmt=*) ' ICKM = 5 mu- , nu_mu~ , c , s~ ' write(nout,fmt=*) ' ICKM = 6 mu- , nu_mu~ , c , b~ ' write(nout,fmt=*) ' IPR = 3: ' write(nout,fmt=*) ' ICKM = 1 d , u~ , c , s~ ' write(nout,fmt=*) ' ICKM = 2 d , u~ , c , d~ ' write(nout,fmt=*) ' ICKM = 3 d , u~ , c , b~ ' write(nout,fmt=*) ' ICKM = 4 s , u~ , c , s~ ' write(nout,fmt=*) ' ICKM = 5 s , u~ , c , d~ ' write(nout,fmt=*) ' ICKM = 6 s , u~ , c , b~ ' write(nout,fmt=*) ' ICKM = 7 b , u~ , c , s~ ' write(nout,fmt=*) ' ICKM = 8 b , u~ , c , d~ ' write(nout,fmt=*) ' ICKM = 9 b , u~ , c , b~ ' write(nout,fmt=*) ' ICKM = 10 d , u~ , u , s~ ' write(nout,fmt=*) ' ICKM = 11 d , u~ , u , b~ ' write(nout,fmt=*) ' ICKM = 12 s , u~ , u , b~ ' write(nout,fmt=*) ' ICKM = 13 d , c~ , c , s~ ' write(nout,fmt=*) ' ICKM = 14 d , c~ , c , b~ ' write(nout,fmt=*) ' ICKM = 15 s , c~ , c , b~ ' write(nout,fmt=*) ' IPR = 5: ' write(nout,fmt=*) ' ICKM = 1 e- , nu_e~ , u , d~ ' write(nout,fmt=*) ' ICKM = 2 e- , nu_e~ , u , s~ ' write(nout,fmt=*) ' ICKM = 3 e- , nu_e~ , u , b~ ' write(nout,fmt=*) ' ICKM = 4 e- , nu_e~ , c , d~ ' write(nout,fmt=*) ' ICKM = 5 e- , nu_e~ , c , s~ ' write(nout,fmt=*) ' ICKM = 6 e- , nu_e~ , c , b~ ' write(nout,fmt=*) ' IPR = 21: ' write(nout,fmt=*) ' ICKM = 1 d , u~ , u , d~ ' write(nout,fmt=*) ' ICKM = 2 s , u~ , u , s~ ' write(nout,fmt=*) ' ICKM = 3 b , u~ , u , b~ ' write(nout,fmt=*) ' ICKM = 4 d , c~ , c , d~ ' write(nout,fmt=*) ' ICKM = 5 s , c~ , c , s~ ' write(nout,fmt=*) ' ICKM = 6 b , c~ , c , b~ ' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' IPM,IRM Number of points and of iterations' write(nout,fmt=*) ' for the integration. My favorite choices are' write(nout,fmt=*) ' 7,6/8,6/9,6 which means increasing' write(nout,fmt=*) ' precision and increasing CPU time.' * write(nout,fmt=*) ' OWW,OZZ allows you to have fixed W,Z width,' write(nout,fmt=*) ' choices are : ' write(nout,fmt=*) ' R(unning) DEFAULT ' write(nout,fmt=*) ' F(ixed) ' write(nout,fmt=*) ' I(mproved) ' write(nout,fmt=*) ' Last two are theorist madness, ' write(nout,fmt=*) ' do not use them unless you want a ' write(nout,fmt=*) ' safe estimate at small scattering ' write(nout,fmt=*) ' angles in CC20 or at high energy ' write(nout,fmt=*) ' in CC11/CC20. ' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' OPEAKA allows you for a special treatment of' write(nout,fmt=*) ' some diagrams at very small scattering' write(nout,fmt=*) ' angles, is a theorist madness,' write(nout,fmt=*) ' do not use it.' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' OPGLU= N(Y = DEFAULT) allows to switch off ' write(nout,fmt=*) ' all diagrams with internal gluons ' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' OM = E evaluation versus ' write(nout,fmt=*) ' G generation of events' write(nout,fmt=*) ' OSM, if you generate events then you first' write(nout,fmt=*) ' set OSM = N, and call WTO which' write(nout,fmt=*) ' computes the cross sections and the maxima.' write(nout,fmt=*) ' A file DUMMY.DAT is created where they are ' write(nout,fmt=*) ' stored. ' write(nout,fmt=*) ' OSTOP = S(DEFAULT) or I. If = I an improved' write(nout,fmt=*) ' calculation of maxima is performed.' write(nout,fmt=*) ' Next you really generate, calling again ' write(nout,fmt=*) ' WTO with OSM= G. ' write(nout,fmt=*) ' ITMX, you generate ITMX events.' write(nout,fmt=*) ' OSEED = Y(DEFAULT), you do not always get ' write(nout,fmt=*) ' the same ITMX events for every run. ' write(nout,fmt=*) ' -------------------------------------------' write(nout,fmt=*) ' Calling procedure is therefore: ' write(nout,fmt=*) ' call wtoinit(***) ' write(nout,fmt=*) ' oflag= om ' write(nout,fmt=*) ' oval= y ' write(nout,fmt=*) ' call wtocflag(***) ' write(nout,fmt=*) ' call wto(***) ' write(nout,fmt=*) ' oflag= osm ' write(nout,fmt=*) ' oval= g ' write(nout,fmt=*) ' call wtocflag(***) ' write(nout,fmt=*) ' call wto(***) ' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' STORAGING :' write(nout,fmt=*) ' OSTORE = I(DEFAULT). Invariants are stored in' write(nout,fmt=*) ' INV.DAT ' write(nout,fmt=*) ' NEW ' write(nout,fmt=*) ' OSTORE = M. Momenta are stored in MOM.DAT ' write(nout,fmt=*) ' with the squared amplitude for the event. ' write(nout,fmt=*) ' For Mix43 (IPR = 21) and ' write(nout,fmt=*) ' For NC64 (IPR = 28-29) and ' write(nout,fmt=*) ' OINT = Y(DEFAULT = N) stored are: ' write(nout,fmt=*) ' AMPS, AMPS1, AMPS2 ' write(nout,fmt=*) ' corresponding to: ' write(nout,fmt=*) ' ATOTSQ, A1SQ, A2SQ of LU4FRM. ' write(nout,fmt=*) ' In this case gluons should be switched off. ' write(nout,fmt=*) ' For all processes but the previous ones ' write(nout,fmt=*) ' one must set ISTRAT = 0 ' write(nout,fmt=*) ' So far this represents a problem for ' write(nout,fmt=*) ' 4b due to diagrams with Higgses ' write(nout,fmt=*) ' THUS: Do NOT generate 4b + ' write(nout,fmt=*) ' interface with LU4FRM. ' write(nout,fmt=*) ' If OSTORE = M and OSMASS = Y then ' write(nout,fmt=*) ' FS masses must be supplied (in WTO ordering) ' write(nout,fmt=*) ' and momenta are scaled. ' write(nout,fmt=*) ' OSTORE = D. Built-in configurations are ' write(nout,fmt=*) ' stored in XXX.DAT ' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' NEW ' write(nout,fmt=*) ' When OSTORE = M is set then ' write(nout,fmt=*) ' a call to WTOCALLJS is performed. ' write(nout,fmt=*) ' It reads all relevant variables from MOM.DAT ' write(nout,fmt=*) ' and a call is performed to LU4FRM. ' write(nout,fmt=*) ' In WTO_20_IO_T the is a subroutine ' write(nout,fmt=*) ' WTJETSET_INI ' write(nout,fmt=*) ' The user may set his own switches to JETSET ' write(nout,fmt=*) ' ////////////////////////////////////////// ' write(nout,fmt=*) ' OPEAK mapping of the resonating peaks, to be' write(nout,fmt=*) ' used when the resonating diagrams dominate.' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' OQCD final state naive QCD corrections.' write(nout,fmt=*) ' IQCD for most of the processes you are' write(nout,fmt=*) ' allowed to have 3 choices: ' write(nout,fmt=*) ' IQCD = 0, alpha_s fixed and' write(nout,fmt=*) ' corrections applied only to double resonating' write(nout,fmt=*) ' IQCD= 1(DEFAULT) alpha_s fixed and all ' write(nout,fmt=*) ' diagrams, ' write(nout,fmt=*) ' IQCD = 2 alpha_s running at the scale fixed ' write(nout,fmt=*) ' by the invariant mass of that qq pair.' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' OFL gauge restoring (Fermion Loop)' write(nout,fmt=*) ' corrections in CC11/CC20 at small scattering' write(nout,fmt=*) ' angles and/or high energies' write(nout,fmt=*) ' (very CPU time consuming).' write(nout,fmt=*) ' DEFAULT (no corrections) is N. Otherwise' write(nout,fmt=*) ' there are many different implementations.' write(nout,fmt=*) ' User is strongly invited to avoid' write(nout,fmt=*) ' intermediate steps' write(nout,fmt=*) ' and to run (eventually) the complete' write(nout,fmt=*) ' corrections OFL = C with only two options:' write(nout,fmt=*) ' RIO = A (all corrections)' write(nout,fmt=*) ' RIO = I (imaginary parts only)' write(nout,fmt=*) ' Additionally one has to specify:' write(nout,fmt=*) ' OTOP = F, fixed top mass to be entered' write(nout,fmt=*) ' OTOP = D, derived from a consistency' write(nout,fmt=*) ' relation by the code.' write(nout,fmt=*) ' Any chain but OFL = N requires OWW,OZZ= R.' write(nout,fmt=*) ' To summarize:' write(nout,fmt=*) ' OFL = N -- DEFAULT, no corrections' write(nout,fmt=*) ' OFL = E -- effective and quick gauge' write(nout,fmt=*) ' restoring for CC20 at small scattering angle' write(nout,fmt=*) ' OFL = C, RIO = A,I -- full(imaginary)' write(nout,fmt=*) ' corrections' write(nout,fmt=*) ' Anomalous couplings are obtainable with' write(nout,fmt=*) ' OFL = A with the further specification of' write(nout,fmt=*) ' OANOM = F(ull),R(estricted)' write(nout,fmt=*) ' Full set of AC is: ' write(nout,fmt=*) ' ACG1G g_1^{gamma} ' write(nout,fmt=*) ' ACLG lambda_{gamma} ' write(nout,fmt=*) ' ACKG kappa_{gamma} ' write(nout,fmt=*) ' ACG4G g_4^{gamma} ' write(nout,fmt=*) ' ACKTG tilde{kappa}_{gamma} ' write(nout,fmt=*) ' ACLTG tilde{lambda}_{gamma} ' write(nout,fmt=*) ' ACG5G g_5^{gamma} ' write(nout,fmt=*) ' ACG1Z g_1^{Z} ' write(nout,fmt=*) ' ACLZ lambda_{Z} ' write(nout,fmt=*) ' ACKZ kappa_{Z} ' write(nout,fmt=*) ' ACG4Z g_4^{Z} ' write(nout,fmt=*) ' ACKTZ tilde{kappa}_{Z} ' write(nout,fmt=*) ' ACLTZ tilde{lambda}_{Z} ' write(nout,fmt=*) ' ACG5Z g_5^{Z} ' write(nout,fmt=*) ' Restricted set of AC is: ' write(nout,fmt=*) ' DG1Z Delta(g_1^Z) ' write(nout,fmt=*) ' DKG Delta(kappa_{gamma}) ' write(nout,fmt=*) ' RLG lambda_{gamma} ' write(nout,fmt=*) ' AC ONLY for CC-family and ' write(nout,fmt=*) ' -NEW- for MIX-family ' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' IOS renormalization scheme, i.e. choice of' write(nout,fmt=*) ' input parameters. Options are:' write(nout,fmt=*) ' IOS = 1, alpha scheme -- coupling constant in' write(nout,fmt=*) ' terms of alpha(scale), you may choose alpha' write(nout,fmt=*) ' ORAL = F, ALWI = 1/alpha_QED' write(nout,fmt=*) ' or let it run at scale = E_cm. ORAL = R' write(nout,fmt=*) ' IOS = 2. G_F scheme (DEFAULT).' write(nout,fmt=*) ' IOS = 3. LEP 1 scheme -- almost as alpha' write(nout,fmt=*) ' scheme but for internal photons alpha will' write(nout,fmt=*) ' be evaluated at the corresponding scale' write(nout,fmt=*) ' (useful if photons dominate). General usage' write(nout,fmt=*) ' should be avoided.' write(nout,fmt=*) ' IOSF , 0 = Born, > 0 includes IS QED' write(nout,fmt=*) ' radiation in different schemes' write(nout,fmt=*) ' IOSF = 1 = beta-scheme (DEFAULT).' write(nout,fmt=*) ' IOSF = 2 = eta-scheme' write(nout,fmt=*) ' IOSF = 3 = mixed-scheme' write(nout,fmt=*) ' OCOUL = Y(N DEFAULT) sets the Coulomb term ' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' ITC 0 is the DEFAULT for computing the cross' write(nout,fmt=*) ' section. Other values select particular' write(nout,fmt=*) ' distributions.' write(nout,fmt=*) ' OBIN DEFAULT = N. It could be used for' write(nout,fmt=*) ' producing differential distributions.' write(nout,fmt=*) ' NEW ' write(nout,fmt=*) ' OMDIST = Y(N = DEFAULT) ' write(nout,fmt=*) ' allows the following: ' write(nout,fmt=*) ' FS four-momenta must be supplied and ' write(nout,fmt=*) ' the code returns the multi-distribution ' write(nout,fmt=*) ' for the configuration integrated over ISR. ' write(nout,fmt=*) ' Calling procedure will be: ' write(nout,fmt=*) ' The matrix ARRMOM(4,4) has to be ' write(nout,fmt=*) ' supplied; first index is Lorentz ' write(nout,fmt=*) ' second " labels final state. ' write(nout,fmt=*) ' BEWARE of metric: q^2 = q_i*q_i-q_4^2 ' write(nout,fmt=*) ' Then: ' write(nout,fmt=*) ' OFLAG = OMDIST ' write(nout,fmt=*) ' OVAL = y ' write(nout,fmt=*) ' CALL WTOMULTID(RS,OFLAG,OVAL,ARRMOM) ' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' For processes which include the Higgs:' write(nout,fmt=*) ' OMH fermions are taken to be massless (a part' write(nout,fmt=*) ' from couplings).' write(nout,fmt=*) ' However since here the narrow width' write(nout,fmt=*) ' approximation would be not too far from' write(nout,fmt=*) ' reality fermion masses can be included in' write(nout,fmt=*) ' some effective way.' write(nout,fmt=*) ' OGLU=Y(DEFAULT)/N, G_H will include the mode ' write(nout,fmt=*) ' H -> gg' write(nout,fmt=*) ' ////////////////////////////////////////// ' * write(nout,fmt=*) ' OMSSM = N(DEFAULT)/Y includes the MSSM ' write(nout,fmt=*) ' AM,TBETA,RMU,SCALM,BAT,BAB ' write(nout,fmt=*) ' can be changed if OMSSM = Y, they are: ' write(nout,fmt=*) ' ------------------------------------------ ' write(nout,fmt=*) ' AM -> M_A DEFAULT = 90 GeV' write(nout,fmt=*) ' TBETA -> tn(beta) DEFAULT = 20' write(nout,fmt=*) ' RMU -> mu DEFAULT = - M_s' write(nout,fmt=*) ' SCALM -> M_s DEFAULT = 1.d3 GeV ' write(nout,fmt=*) ' BAT -> A_t DEFAULT = M_s' write(nout,fmt=*) ' BAB -> A_b DEFAULT = M_s' * write(nout,fmt=*) ' To use WTOCUTSET ' write(nout,fmt=*) ' Arguments are integer1,arrayl1,arrayu1 ' write(nout,fmt=*) ' integer2,array2 ' write(nout,fmt=*) ' integer3,arrayl3,arrayu3 ' write(nout,fmt=*) ' integer4,arrayl4,arrayu4 ' write(nout,fmt=*) ' Setting is as follows ' write(nout,fmt=*) ' arrayl1 < inv mass(integer1) < arrayu1 ' write(nout,fmt=*) ' arrayl1 < energy(integer2) ' write(nout,fmt=*) ' arrayl3 < scatt. ang.(integer3) < arrayu3 ' write(nout,fmt=*) ' arrayl4 < FS ang.(integer4) < arrayu4 ' write(nout,fmt=*) ' invariant masses/ FS ngles ij are stored as ' write(nout,fmt=*) ' a vector(k) k = 1-2/1-3/1-4/2-3/2-4/3-4 ' * close(nout) return end