************************************************************************ * * * WPHACT: a Monte Carlo program for four-fermion final state processes * * at e+ e- colliders * * * * Authors: Elena Accomando, Alessandro Ballestrero, Ezio Maina * * * * version 1.9 * * * ************************************************************************ * * This version contains several completely new features. * In particular, it is the first official version with completely * massive matrix elements. The user can now choose among fully massive * calculations, massless ones and processes in which only b's * (or taus, or c's) masses are exactly accounted for. * The last two choices were present in older versions of WPHACT. * They are much faster than the fully massive one and the difference * for most processes and cuts is of the order of the per mille. * * The use of massive ME is however unavoidable for single W, single Z, * gamma gamma studies and in general for configurations with * very low separation angles and invariant masses. * * For single W studies it is also possible to use the Im. fermion loop * calculations * ************************************************************************ * * This program, its steering file, explanations and examples, as * well as other versions of WPHACT can be found with a link to * http://www.to.infn.it/~ballestr/wphact * and its subdirectories * * For questions, comments, remarks and requests, send a mail to * ballestrero@to.infn.it * ************************************************************************ ************************************************************************ IMPLICIT REAL*8 (a-b,d-h,o-z) IMPLICIT double COMPLEX (c) CHARACTER*60 string DIMENSION region(18),y1(50,10),y2(50,10),iv(32),iv1(32),iv2(32) * em2 COMMON/abpara/rmx1,gamx1,gx1,rmx2,gamx2,gx2,beta,rlim,s_col, & x1_min,x2_min,smin,emcoupl,estrinf1,estrinf2,estrmed2, & rmx3,gamx3,gx3,sepmass1low,sepmass1high, & sepmass2low,sepmass2high COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp,imass,ismallangle,ism34,ism56 * endem2 COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abparc/czipr,ccz,cwipr,ccw,chipr,cch,caipr,cca COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc * el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch * endel2 COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/absusy/rma,rma2,rzha,rabb COMMON/abcuts/e_min(3:6),e_max(3:6),thbeam_min(3:6), & thbeam_max(3:6),thsep_min(6),thsep_max(6),rm_min(6),rm_max(6), & beamcut_min(3:6),beamcut_max(3:6),sepcut_min(6),sepcut_max(6), & rm_min2(6),rm_max2(6),pt_min(3:6),pt_max(3:6),e_cm COMMON/abinpu/rmw,rmz,rmb_run,rmc,rmc_run,rmtau,gamz,gf,s2w, & alfainv,alfas_cc,alfas_nc,alfas_h,gauwidth COMMON /abrann/ idum COMMON/absalv/iv,iy,idum2 * sa2 added rmt COMMON/abmass/ rme,rmmu,rmu,rmd,rms,rmt,xm(6),xmp5,xmp * sa2end * * sa1 nella successiva riga ho messo nintmax a 10 invece che 50 PARAMETER (ndismax=50,nintmax=10,nbinmax=500,nitmax=10) * sa1end DIMENSION test(ndismax),test_mix(ndismax),devbin(ndismax,nbinmax) DIMENSION devbin_mix(ndismax,nbinmax),resl_nc(nitmax) DIMENSION resl_cc(nitmax),rnorm(ndismax,nbinmax,nitmax) DIMENSION rnorm_mix(ndismax,nbinmax,nitmax),nbintot(ndismax), & nbintest(ndismax) COMMON/abdist/distr_estrinf(ndismax,nintmax+1),bin_width(ndismax, & nintmax),distr_local(ndismax,nbinmax,nitmax),distr_loc_mix & (ndismax,nbinmax,nitmax),dev_local(ndismax,nbinmax,nitmax), & dev_loc_mix(ndismax,nbinmax,nitmax),tail_local(ndismax,nitmax), & tail_loc_mix(ndismax,nitmax) COMMON/abidis/ncallbin(ndismax,nbinmax,nitmax), & ncallbin_mix(ndismax,nbinmax,nitmax),nbin_number(ndismax, & nintmax),nbin_sum(ndismax,nintmax),nsubint(ndismax),ndistr, & idistr,it1,it2,init COMMON/abcdis/string(ndismax) COMMON/abresl/resl(10),standdevl(10) *agg COMMON/abflat/rmaxfxn,rmaxfxn_1it,rmaxfxn_2it,rmaxfxn_cc_1it, & rmaxfxn_cc_2it,rmaxfxn_nc_1it,rmaxfxn_nc_2it,scalemax COMMON/abifla/itmx,novermax,iflat,iseed,istorvegas,istormom,iterm, & ijetset,interf COMMON/abfla2/irepeat,nevent,nflevts *aggend c beam COMMON/abibea/ibeam COMMON/abxbea/x1beam,x2beam c beam * em:esponenti * em2 COMMON/rexp/rexp5,rexp6,rexpsm * endem2 * em:end * sa1 c for new reading system character*80 pluto character*1 charint1 character*2 charint2 character*3 charint3 common/abread/pluto dimension auread(nintmax+1) dimension iauread(nintmax) cqedps DOUBLE PRECISION ainmas * Mass of the electron, used by QEDPS PARAMETER (ainmas=0.51099907d-3) DOUBLE PRECISION PLPTN INTEGER NLPTN,NPTCL * QEDPS Common Block COMMON/QPLIST/PLPTN(10,1000),NLPTN(10,1000),NPTCL * sa1end EXTERNAL fxn,gammln DATA rmw/80.350d0/, rmz/91.1867d0/, rmt/175.d0/, rmc/1.35d0/, & rmtau/1.78d0/, rmb_run/2.7d0/, rmu/0.005d0/, rmd/0.01d0/, & rme/0.51099906d-3/, rms/0.15d0/, rmmu/0.105d0/, rmb/4.7d0/, & gamw/0.2042774d+01/, gamz/0.2440851d+01/, gamh/1.278d-03/, & gf/1.16637d-05/, alfainv/128.07d0/, & alfas_cc/0.1255d0/, alfas_nc/0.1230d0/, & s2w/0.231030912451068d0/,rmsus/1000.d0/ c beam & ,x1beam/1.d0/,x2beam/1.d0/ c beam * em2 DATA rexp5/0.7d0/,rexp6/0.7d0/,rexpsm/1.7d0/ & ,sepmass1low/30.d0/,sepmass1high/60.d0/ & ,sepmass2low/30.d0/,sepmass2high/60.d0/ * endem2 DATA i3e/0/, i4e/0/, i3q/0/, i5q/0/, iqu/0/, i34e/0/, i56ve/0/, & ibbveve/0/, iid/0/, pi/3.141592653589793238462643d0/, & r/0.2d0/, irepeat/0/, interf/0/, isusy/0/, ichcj/0/, iha/0/ * sa2 & , ireadinput/0/ c ireadinput 1= read normali, 0 file di input & , ips_cc/1/, ips_nc/1/ c ips_cc ! CC (or Higgs signal) phase space : c ! 1=double resonant, 2=single resonant (34), c ! 3=single resonant (56), 4=non resonant c ips_nc ! NC phase space: c ! 1=double resonant, 2=single resonant (34), c ! 3=single resonant (56), 4=non resonant & , iqu/0/ c iqu ! yes/no QCD diagrams for 4-quarks NC & , ifloop/0/ * sa2end *begin{EZ} COMMON/abfloop/ifloop *end{EZ} **** * imix=2 CC+interf.NC (only if interf.=1), =1 CC (or Higgs), * =0 interf., =-1 NC, =-2 NC + interf. CC(or Higgs) * iccnc 1=CC only, 2=NC only, 3= CC+NC +interf (not only for mixed * processes where there is a read, but also defined in initialize * for all proc, and =4 for b proc. * icc =1 calcola solo CC, =0 solo NC, =-1 CC+NC (in ME calcul.) **** * sa1 if (ireadinput.eq.0) then print*, 'name of the input file ?' read (*,'(a)') pluto ! name of input file print*, ' INPUT FROM FILE '//pluto call rread('e_cm',e_cm,1) ! centre of mass energy (GeV) call iread('iproc',iproc,1) !selects the kind of process (see subr. INITIALIZE) call iread('ich',ich,1) ! selects the channel (see subroutine INITIALIZE) call iread('imass',imass,1) !imass=0 massless, imass=1 massive call iread('icc3',icc3,1) ! yes/no CC3 only IF (iproc.GE.6.AND.iproc.LE.8) THEN !in mixed processes: call iread('iccnc',iccnc,1) ! 1=CC only, 2=NC only, 3= CC+NC +interf ENDIF call iread('izz',izz,1) !selects: 1=NC02, 0=all, -1=all-NC02 call iread('izg',izg,1) !selects: 1=zeta-gamma, 0=all, -1=all-(zeta-gamma) call iread('izg34',izg34,1) !selects: 1=zeta56-gamma34, 0=all,-1=all-(Z56-gam34) call iread('izg56',izg56,1) !selects: 1=zeta34-gamma56, 0=all,-1=all-(Z34-gam56) call iread('inc08',inc08,1) !selects: 1=NC08, 0=all, -1=all-NC08 call iread('igamgam',igamgam,1) !selects: 1=gamma-gamma, 0=all, -1=all-(gamma-gamma) call iread('itch',itch,1) !selects: 1=t-channel, 0=all call iread('ismallangle',ismallangle,1) ! 0=no small angle, 1=e- near the beam (180 degrees) ! 2= e- near 180 degrees, e+ near 0 degrees call iread('isr',isr,1) ! yes/no ISR call iread('ibeam',ibeam,1) !yes/no beamstrahlung call iread('icoul',icoul,1) ! yes/no Coulomb corrections call iread('istrcor',istrcor,1) ! yes/no 'naive' QCD corrections (also for widths) call iread('ianc',ianc,1) ! yes/no anomalous couplings IF(ianc.EQ.1)THEN call rread('delz',delz,1) call rread('xf',xf,1) call rread('xz',xz,1) call rread('yf',yf,1) call rread('yz',yz,1) call rread('zz',zz,1) !anomalous couplings parameters ENDIF * sa2 if (iproc.eq.2.or.iproc.eq.4.or. & (iproc.eq.7.and.iccnc.ne.2)) then *sa2end call iread('ifloop',ifloop,1) * sa2 endif *sa2end call iread('ipr',ipr,1) ! widths: 0/1 Z,W fixed/running 2 Z fi, W run call iread('iswgcomp',iswgcomp,1) ! yes/no s2w and g computed (0= DATA value) call iread('igwcomp',igwcomp,1) call iread('igzcomp',igzcomp,1) call iread('ighcomp',ighcomp,1) ! yes/no W,Z,H width computed (0= DATA val.) call iread('icut',icut,1) ! yes/no cuts IF(icut.EQ.1)THEN call rread('e_min',e_min,4) ! 4 energy lower cuts (GeV) call rread('e_max',e_max,4) ! 4 energy upper cuts (GeV) call rread('rm_min',rm_min,6) ! 6 invariant mass lower limits (GeV) ! (34, 35, 36, 45, 46, 56) call rread('rm_max',rm_max,6) ! 6 invariant mass upper limits (GeV) call rread('pt_min',pt_min,4) ! 4 transverse momenta lower cuts (GeV) call rread('pt_max',pt_max,4) ! 4 transverse momenta upper cuts (GeV) call iread('icos',icos,1) ! angular cuts in deg (0) or cos (1) call rread('thbeam_min',thbeam_min,4) ! 4 particle-beam angle lower (in degrees) cuts call rread('thbeam_max',thbeam_max,4) ! 4 particle-beam angle upper (in degrees) cuts call rread('thsep_min',thsep_min,6) ! 6 particl-particl angle lower(in degrees) cuts call rread('thsep_max',thsep_max,6) ! 6 particl-particl angle upper(in degrees) cuts ENDIF call iread('idistr',idistr,1) ! yes/no distributions IF(idistr.EQ.1)THEN call iread('ndistr',ndistr,1) ! number of distributions IF(ndistr.GT.ndismax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Number of distributions cannot exceed' PRINT*,'NDISMAX given as parameter' PRINT*,' ' STOP ENDIF DO i=1,ndistr call convert(i,charint1,charint2,charint3) if (i.le.9) then call iread('nsubint('//charint1//')',nsubint(i),1) elseif (i.le.99) then call iread('nsubint('//charint2//')',nsubint(i),1) elseif (i.le.999) then call iread('nsubint('//charint3//')',nsubint(i),1) endif !number of sub-intervals with ! different binning IF(nsubint(i).GT.nintmax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Number of sub-intervals cannot exceed' PRINT*,'NINTMAX given as parameter' PRINT*,' ' STOP ENDIF if (i.le.9) then call rread('distr_estrinf('//charint1//')', & auread,nsubint(i)+1) elseif (i.le.99) then call rread('distr_estrinf('//charint2//')', & auread,nsubint(i)+1) elseif (i.le.999) then call rread('distr_estrinf('//charint3//')', & auread,nsubint(i)+1) endif do j=1,nsubint(i)+1 distr_estrinf(i,j)=auread(j) enddo !lower limits of each !subint (which coincide with the upper limit of the ! previous one) + upper limit of the last subint if (i.le.9) then call iread('nbin_number('//charint1//')', & iauread,nsubint(i)) elseif (i.le.99) then call iread('nbin_number('//charint2//')', & iauread,nsubint(i)) elseif (i.le.999) then call iread('nbin_number('//charint3//')', & iauread,nsubint(i)) endif do j=1,nsubint(i) nbin_number(i,j)=iauread(j) enddo !number of bins in each subint DO j=1,nsubint(i) nbintest(i)=nbintest(i)+nbin_number(i,j) ENDDO !j IF(nbintest(i).GT.nbinmax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'total number of bins cannot exceed' PRINT*,'NBINMAX given as parameter' PRINT*,' ' STOP ENDIF ENDDO !i ENDIF call iread('iflat',iflat,1) ! yes/no flat event generation IF(iflat.EQ.1)THEN call rread('scalemax',scalemax,1) ! scale factor for the maximum call iread('istorvegas',istorvegas,1) ! yes/no VEGAS data stored call iread('irepeat',irepeat,1) ! 0=normal;1=repeat 2nd only;2=rep. ! with nflevts fixed ! 1=repeat only second iteration using vegas ! data stored in previous run, ! 2=repeat, generating an exact number nflevts ! of flatevents using vegas data stored ! in previous run IF(irepeat.eq.2)THEN call iread('nflevts',nflevts,1) ! number of events to be generated as ! described above END IF call iread('istormom',istormom,1) ! yes/no momenta of flat events written in .dat files call iread('ijetset',ijetset,1) ! yes/no call to Jetset IF(iproc.GE.6.AND.iproc.LE.8)THEN call iread('interf',interf,1) ! 0= mix. interference added to NC; ! 1= added to CC ENDIF ENDIF * em2 * call rread('rexp5',rexp5,1) * call rread('rexp6',rexp6,1) * PRINT *,'rexp5=',rexp5,' rexp6=',rexp6 * call rread('ism34',ism34,1) * call rread('ism56',ism56,1) * PRINT *,'ism34 =',ism34,' ism56 =',ism56 * endem2 call rread('acc',acc,1) ! integration accuracy call iread('iterm',iterm,1) ! yes/no thermalization call iread('ncall_term',ncall_term,1) ! thermalization calls per iteration call iread('itmx_term',itmx_term,1) ! thermalization iterations call iread('ncall',ncall,1) ! integration calls per iteration call iread('itmx',itmx,1) ! integration iterations (2 for flat event generation) IF(iproc.GE.33)THEN call rread('rmb',rmb,1) ! quark b mass (GeV) * el1 call rread('rmc',rmc,1) ! quark c mass (GeV) call rread('rmtau',rmtau,1) ! tau mass (GeV) * call rread('rmb_run',rmb_run,1) ! quark b mass running(GeV) call rread('rmc_run',rmc_run,1) ! quark c mass running(GeV) * endel1 call rread('gamh',gamh,1) ! higgs width call rread('alfas_h',alfas_h,1) ! alfas at Higgs mass call iread('icch',icch,1) ! 1=Higgs signal, 2=Background, 3=Higgs+Backg+interf IF(icch.NE.2)THEN call iread('isusy',isusy,1) IF(isusy.EQ.0)THEN * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & icch.EQ.1)THEN * endel1 call iread('iha',iha,1) ! 1=all, 2=hZ ENDIF call rread('rmh',rmh,1) ! Higgs mass (GeV) ELSE * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & icch.EQ.1)THEN * endel1 call iread('iha',iha,1) ! 1=all, 2=h, 3=A, 4=h-stralhung, 5=A-strahlung ENDIF call iread('irmhcomp',irmhcomp,1) ! yes/no rmh computed IF(irmhcomp.EQ.1)THEN call rread('rma',rma,1) ! Higgs 'A' mass (GeV) call rread('tgb',tgb,1) ! tan(beta) call iread('iloop',iloop,1) ! 1=1-loop, 2=Carena et al. corrections IF(iloop.EQ.2)THEN call iread('imixing',imixing,1) !1=no, 2=maximal, 3=typical, 4=other IF(imixing.EQ.4)THEN call rread('At',At,1) call rread('Ab',Ab,1) * el1 call rread('rmyou',rmyou,1) * endel1 ENDIF ENDIF ELSE call rread('rmh',rmh,1) call rread('rma',rma,1) call rread('tgb',tgb,1) ENDIF ENDIF ENDIF ENDIF else * sa1end READ*,e_cm ! centre of mass energy (GeV) READ*,iproc !selects the kind of process (see subr. INITIALIZE) READ*,ich ! selects the channel (see subroutine INITIALIZE) READ*,imass !imass=0 massless, imass=1 massive READ*,icc3 ! yes/no CC3 only IF (iproc.GE.6.AND.iproc.LE.8) THEN !in mixed processes: READ*,iccnc ! 1=CC only, 2=NC only, 3= CC+NC +interf ENDIF READ*,izz !1=ZZ, 0=all, -1=all-ZZ READ*,izg !1=ZG, 0=all, -1=all-ZG READ*,izg34 !1=Z56-G34, 0=all, -1=all-(Z56-G34) READ*,izg56 !1=Z34-G56, 0=all, -1=all-(Z34-G56) READ*,inc08 !1=NC08, 0=all, -1=all-NC08 READ*,igamgam !1=gamma-gamma, 0=all, -1=all-GG READ*,itch !1=t-channel, 0=all READ*,ismallangle ! 0=no small angle, ! 1=e- near the beam (180 degrees) ! 2= e- near 180 degrees, e+ near 0 degrees READ*,isr ! yes/no ISR READ*,ibeam !yes/no beamstrahlung READ*,icoul ! yes/no Coulomb corrections READ*,istrcor ! yes/no 'naive' QCD corrections (also for widths) READ*,ianc ! yes/no anomalous couplings IF(ianc.EQ.1)THEN READ*, delz,xf,xz,yf,yz,zz !anomalous couplings parameters ENDIF * sa2 if (iproc.eq.2.or.iproc.eq.4.or. & (iproc.eq.7.and.iccnc.ne.2)) then *sa2end READ*,ifloop * sa2 endif *sa2end READ*,ipr ! widths: 0/1 Z,W fixed/running 2 Z fi, W run READ*,iswgcomp ! yes/no s2w and g computed (0= DATA value) READ*,igwcomp,igzcomp,ighcomp ! yes/no W,Z,H width computed (0= DATA val.) READ*,icut ! yes/no cuts IF(icut.EQ.1)THEN READ*,e_min ! 4 energy lower cuts (GeV) READ*,e_max ! 4 energy upper cuts (GeV) READ*,rm_min ! 6 invariant mass lower limits (GeV) ! (34, 35, 36, 45, 46, 56) READ*,rm_max ! 6 invariant mass upper limits (GeV) READ*,pt_min ! 4 transverse momenta lower cuts (GeV) READ*,pt_max ! 4 transverse momenta upper cuts (GeV) READ*,icos ! angular cuts in deg (0) or cos (1) READ*,thbeam_min! 4 particle-beam angle lower (in degrees) cuts READ*,thbeam_max! 4 particle-beam angle upper (in degrees) cuts READ*,thsep_min ! 6 particl-particl angle lower(in degrees) cuts READ*,thsep_max ! 6 particl-particl angle upper(in degrees) cuts ENDIF READ*,idistr ! yes/no distributions IF(idistr.EQ.1)THEN READ*,ndistr ! number of distributions IF(ndistr.GT.ndismax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Number of distributions cannot exceed' PRINT*,'NDISMAX given as parameter' PRINT*,' ' STOP ENDIF DO i=1,ndistr READ*,nsubint(i) !number of sub-intervals with ! different binning IF(nsubint(i).GT.nintmax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Number of sub-intervals cannot exceed' PRINT*,'NINTMAX given as parameter' PRINT*,' ' STOP ENDIF READ*,(distr_estrinf(i,j),j=1,nsubint(i)+1) !lower limits of each ! subint (which coincide with the upper limit of the ! previous one) + upper limit of the last subint READ*,(nbin_number(i,j),j=1,nsubint(i)) !number of bins in each * subint DO j=1,nsubint(i) nbintest(i)=nbintest(i)+nbin_number(i,j) ENDDO !j IF(nbintest(i).GT.nbinmax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'total number of bins cannot exceed' PRINT*,'NBINMAX given as parameter' PRINT*,' ' STOP ENDIF ENDDO !i ENDIF READ*,iflat ! yes/no flat event generation IF(iflat.EQ.1)THEN READ*,scalemax ! scale factor for the maximum READ*,istorvegas ! yes/no VEGAS data stored READ*,irepeat ! 0=normal;1=repeat 2nd only;2=rep. ! with nflevts fixed ! 1=repeat only second iteration using vegas ! data stored in previous run, ! 2=repeat, generating an exact number nflevts ! of flatevents using vegas data stored ! in previous run IF(irepeat.eq.2)THEN READ*, nflevts ! number of events to be generated as ! described above END IF READ*,istormom ! yes/no momenta of flat events written in ! .dat files READ*,ijetset ! yes/no call to Jetset IF(iproc.GE.6.AND.iproc.LE.8)THEN READ*,interf ! 0= mix. interference added to NC; ! 1= added to CC ENDIF ENDIF READ*,acc ! integration accuracy READ*,iterm ! yes/no thermalization READ*,ncall_term ! thermalization calls per iteration READ*,itmx_term ! thermalization iterations READ*,ncall ! integration calls per iteration READ*,itmx ! integration iterations (2 for flat event generation) IF(iproc.GE.33)THEN READ*,rmb ! quark b mass (GeV) * el1 READ*,rmc ! quark c mass (GeV) READ*,rmtau ! tau mass (GeV) * READ*,rmb_run ! quark b mass running(GeV) READ*,rmc_run ! quark c mass running(GeV) * endel1 READ*,gamh ! higgs width READ*,alfas_h ! alfas at Higgs mass READ*,icch ! 1=Higgs signal, 2=Background, 3=Higgs+Backg+interf IF(icch.NE.2)THEN READ*,isusy IF(isusy.EQ.0)THEN * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & icch.EQ.1)THEN * endel1 READ*,iha ! 1=all, 2=hZ ENDIF READ*,rmh ! Higgs mass (GeV) ELSE * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & icch.EQ.1)THEN * endel1 READ*,iha ! 1=all, 2=h, 3=A, 4=h-stralhung, 5=A-strahlung ENDIF READ*,irmhcomp ! yes/no rmh computed IF(irmhcomp.EQ.1)THEN READ*,rma ! Higgs 'A' mass (GeV) READ*,tgb ! tan(beta) READ*,iloop ! 1=1-loop, 2=Carena et al. corrections IF(iloop.EQ.2)THEN READ*,imixing !1=no, 2=maximal, 3=typical, 4=other IF(imixing.EQ.4)THEN READ*,At READ*,Ab * el1 READ*,rmyou * endel1 ENDIF ENDIF ELSE READ*,rmh READ*,rma READ*,tgb ENDIF ENDIF ENDIF ENDIF WRITE (*,*) 'ifloop = ',ifloop * sa1 c fine dei read normali endif * sa1end ** input check * sa2 IF(itmx_term.GT.nitmax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Number of thermalization iterations cannot exceed' PRINT*,'NITMAX given as parameter' PRINT*,' ' STOP ENDIF * sa2end IF(itmx.GT.nitmax)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Number of integration iterations cannot exceed' PRINT*,'NITMAX given as parameter' PRINT*,' ' STOP ENDIF * el1 IF(e_cm.NE.360.d0.AND.e_cm.NE.500.d0.AND.e_cm.NE.800.d0. & AND.ibeam.EQ.1)THEN PRINT*,'The beamstrahlung via CIRCE is available only' PRINT*,'for e_cm=(360, 500, 800) GeV' STOP ENDIF * endel1 * em2 IF((ismallangle.GT.0).AND.(iproc.NE.2).AND.(iproc.NE.4) & .AND.(iproc.NE.7).AND.(iproc.NE.21).AND.(iproc.NE.26) & .AND.(iproc.NE.28).AND.(iproc.NE.30))THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Small angle phase space requires an electron' PRINT*,'or positron in the final state.' PRINT*,'iproc=',iproc,' ismallangle=', ismallangle PRINT*,' ' STOP ENDIF IF((ismallangle.GT.0).AND.(imass.EQ.0))THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Small angle phase space requires fully' PRINT*,'massive matrix elements (imass=1).' PRINT*,' ' STOP ENDIF * endem2 IF((imass.EQ.1).AND.(iproc.GT.32))THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'The matrix element for the selected process is not' PRINT*,' fully massive: only b quarks, taus and virtual tops' PRINT*,' masses are included.' PRINT*,' If fully massive computations are required, ' PRINT*,' processes 1 to 32 have to be selected' PRINT*,' Otherwise imass must be set to 0' PRINT*,' ' STOP ENDIF IF((izz.EQ.1.OR.izg.EQ.1.OR.izg34.EQ.1.OR.izg56.EQ.1.OR. & inc08.EQ.1.OR.igamgam.EQ.1).AND.(iproc.LE.5.OR.imass.EQ.0))THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'The options izz,izg,izg34,izg56,inc08,igamgam are' PRINT*,'available only for Mixed and NC massive processes' PRINT*,' ' STOP ENDIF * sa2 IF((izz.EQ.1.OR.izg.EQ.1.OR.izg34.EQ.1.OR.izg56.EQ.1.OR. & inc08.EQ.1.OR.igamgam.EQ.1).AND.(iproc.GT.5.AND.iproc.LT.9). & AND.iccnc.NE.2)THEN PRINT*,' ' PRINT*,' ************* WARNING: **************' PRINT*,'The options izz,izg,izg34,izg56,inc08,igamgam require' PRINT*,' the evaluation of NC diagrams only.' PRINT*,' iccnc =2 is therefore required for Mixed processes' PRINT*,' ' PRINT*,' iccnc changed to 2 ' iccnc=2 PRINT*,' ' ENDIF IF(iflat.EQ.1.AND.itmx.NE.2)THEN PRINT*,' ' PRINT*,' ************* ERROR: **************' PRINT*,'Flat events generation needs ITMX =2' PRINT*,' ' stop ENDIF IF (ifloop.eq.1.and.ipr.ne.2) then PRINT*,' ' PRINT*,' ************* WARNING: **************' PRINT*,' ifloop=1 requires ipr=2. ipr changed to 2' ipr=2 PRINT*,' ' ENDIF * endsa2 ** input check end c beam * el1 IF(ibeam.EQ.1)THEN IF(e_cm.EQ.360.d0)THEN CALL circes (0.d0,0.d0,360.d0,2,1,1996 09 02,0) ELSE IF(e_cm.EQ.500.d0)THEN CALL circes (0.d0,0.d0,500.d0,2,1,1996 09 02,0) ELSE IF(e_cm.EQ.800.d0)THEN CALL circes (0.d0,0.d0,800.d0,2,1,1996 09 02,0) ENDIF ENDIF * endel1 c beam * sa1 cqedps IF ( ISR .EQ.2) THEN * Intialize QEDPS Q2MAX=E_CM**2 CALL QPINIT(Q2MAX,ainmas,IRANSEED) ENDIF cqedpsend * sa1end s_col=e_cm**2 * el1 * rmc_run=rmc * endel1 rmw2=rmw**2 rmz2=rmz**2 rmt2=rmt**2 rmb2=rmb**2 rmh2=rmh**2 IF(iswgcomp.EQ.1)THEN s2w=1.d0-rmw2/rmz2 g2=4.d0*sqrt(2.d0)*gf*rmw2 alfainv=4.d0*pi/(s2w*g2) ENDIF sw=sqrt(s2w) rc2w=1.d0-s2w rcw=sqrt(rc2w) rcotw=rcw/sw IF(isusy.EQ.1)THEN rma2=rma**2 rmsus2=rmsus**2 bet=atand(tgb) rcb=cosd(bet) sb=sind(bet) s2b=sind(2.d0*bet) rc2b=cosd(2.d0*bet) tg2b=tand(2.d0*bet) IF(irmhcomp.EQ.1)THEN alfa_t=alfas_nc/(1+23.d0*alfas_nc*log(rmt2/rmz2)/(12.d0*pi)) rmt_run=rmt/(1.d0+4.d0*alfa_t/(3.d0*pi)) IF(iloop.EQ.1)THEN epsi=3.d0*rmt_run**4*log(1.d0+rmsus2/rmt2)/ & (2.d0*pi*s2w*rmw2*sb**2*alfainv) rmh2=0.5d0*(rmz2+rma2+epsi-sqrt((rmz2+rma2+epsi)**2-4.d0* & (rma2*(rmz2*rc2b**2+epsi*sb**2)+epsi*rmz2*rcb**2))) ELSE IF(iloop.EQ.2)THEN * Neutral CP-even Higgs corrections (Carena et al.): * Tutte le variabile sono alla scala Mt IF(imixing.EQ.1)THEN At=0.d0 Ab=0.d0 * el1 rmyou=0.d0 * endel1 ELSE IF(imixing.EQ.2)THEN At=sqrt(6.d0)*rmsus Ab=At * el1 rmyou=0.d0 * endel1 ELSE IF(imixing.EQ.3)THEN At=rmsus Ab=At * el1 rmyou=-rmsus * endel1 ENDIF fourpi=4.d0*pi fourpi2=fourpi**2 * el1 rmyouq=rmyou**2 * endel1 rmtau2=rmtau**2 rmt2_run=rmt_run**2 rmb2_run=rmb_run**2 sb2=sb**2 rcb2=rcb**2 g1=5.d0*fourpi/(3.d0*(1.d0-s2w)*alfainv) g1=g1/(1.d0+53.d0*g1*log(rmz/rmt)/(120.d0*pi**2)) g2=fourpi/(s2w*alfainv) g2=g2/(1.d0-11.d0*g2*log(rmz/rmt)/(24.d0*pi**2)) g3=fourpi*alfa_t v2=4.d0*rmw2/g2 htq=2.d0*rmt2_run/(v2*sb2) hbq=2.d0*rmb2_run/(v2*rcb2) htauq=2.d0*rmtau2/(v2*rcb2) t=2.d0*log(rmsus/rmt) Xt=2.d0*At**2*(1.d0-At**2/(12.d0*rmsus2))/rmsus2 Xb=2.d0*Ab**2*(1.d0-Ab**2/(12.d0*rmsus2))/rmsus2 * el1 Atb=(-6.d0*rmyouq/rmsus2-(rmyouq-Ab*At)**2/(rmsus2**2)+ & 3.d0*(At+Ab)**2/rmsus2)/6.d0 * endel1 IF(rma.GT.rmt)THEN tgb=tgb*(1.d0+3.d0*(htq-hbq)*log(rma/rmt)/fourpi2) sb=sin(atan(tgb)) sb2=sb**2 rcb=cos(atan(tgb)) rcb2=rcb**2 s2b=sin(2.d0*atan(tgb)) rc2b=cos(2.d0*atan(tgb)) bet=atand(tgb) tg2b=tand(2.d0*bet) htq=2.d0*rmt2_run/(v2*sb2) hbq=2.d0*rmb2_run/(v2*rcb2) htauq=2.d0*rmtau2/(v2*rcb2) ENDIF * el1: rmu -> rmyou rl1=0.25d0*(g1+g2)*(1.d0-6.d0*hbq*t/fourpi2)+ & 6.d0*hbq**2*(t+Xb*0.5d0+(1.5d0*hbq+0.5d0*htq-8.d0*g3)* & (Xb*t+t**2)/fourpi2)/fourpi2-3.d0*htq**2*rmyouq**2 & *(1.d0+(9.d0*htq-5.d0*hbq-16.d0*g3)*t/fourpi2)/ & (96.d0*pi**2*rmsus2**2) rl2=0.25d0*(g1+g2)*(1.d0-6.d0*htq*t/fourpi2)+ & 6.d0*htq**2*(t+Xt*0.5d0+(1.5d0*htq+0.5d0*hbq-8.d0*g3)* & (Xt*t+t**2)/fourpi2)/fourpi2-3.d0*hbq**2*rmyouq**2 & *(1.d0+(9.d0*hbq-5.d0*htq-16.d0*g3)*t/fourpi2)/ & (96.d0*pi**2*rmsus2**2) rl3=0.25d0*(g2-g1)*(1.d0-3.d0*(htq+hbq)*t/fourpi2)+ & 6.d0*htq*hbq*(t+Atb*0.5d0+(htq+hbq-8.d0*g3)*(Atb*t+t**2) & /fourpi2)/fourpi2+3.d0*htq**2*(3.d0*rmyouq/rmsus2- & rmyouq*At**2/(rmsus2**2))*(1.d0+(6.d0*htq-2.d0*hbq-16.d0* & g3)*t/fourpi2)/(96.d0*pi**2)+3.d0*hbq**2*(3.d0*rmyouq/ & rmsus2-rmyouq*Ab**2/(rmsus2**2))*(1.d0+(6.d0*hbq-2.d0* & htq-16.d0*g3)*t/fourpi2)/(96.d0*pi**2) rl4=-0.5d0*g2*(1.d0-3.d0*(htq+hbq)*t/fourpi2)- & 6.d0*htq*hbq*(t+Atb*0.5d0+(htq+hbq-8.d0*g3)*(Atb*t+t**2) & /fourpi2)/fourpi2+3.d0*htq**2*(3.d0*rmyouq/rmsus2- & rmyouq*At**2/(rmsus2**2))*(1.d0+(6.d0*htq-2.d0*hbq-16.d0* & g3)*t/fourpi2)/(96.d0*pi**2)+3.d0*hbq**2*(3.d0*rmyouq/ & rmsus2-rmyouq*Ab**2/(rmsus2**2))*(1.d0+(6.d0*hbq-2.d0* & htq-16.d0*g3)*t/fourpi2)/(96.d0*pi**2) rl5=-3.d0*htq**2*rmyouq*At**2*(1.d0-(2.d0*hbq-6.d0*htq+16.d0 & *g3)*t/fourpi2)/(96.d0*pi**2*rmsus2**2)-3.d0*hbq**2*rmyouq & *Ab**2*(1.d0-(2.d0*htq-6.d0*hbq+16.d0*g3)*t/fourpi2)/ & (96.d0*pi**2*rmsus2**2) rl6=3.d0*htq**2*rmyou**3*At*(1.d0-(3.5d0*hbq-7.5d0*htq+16.d0 & *g3)*t/fourpi2)/(96.d0*pi**2*rmsus2**2)+3.d0*hbq**2*rmyou* & (Ab**3/(rmsus**3)-6.d0*Ab/rmsus)*(1.d0-(0.5d0*htq-4.5d0*hbq & +16.d0*g3)*t/fourpi2)/(96.d0*pi**2*rmsus) rl7=3.d0*hbq**2*rmyou**3*Ab*(1.d0-(3.5d0*htq-7.5d0*hbq+16.d0 & *g3)*t/fourpi2)/(96.d0*pi**2*rmsus2**2)+3.d0*htq**2*rmyou* & (At**3/(rmsus**3)-6.d0*At/rmsus)*(1.d0-(0.5d0*hbq-4.5d0*htq & +16.d0*g3)*t/fourpi2)/(96.d0*pi**2*rmsus) * endel1 rm12=v2*(sb*rcb*(rl3+rl4)+rl6*rcb2+rl7*sb2)-rma2*sb*rcb rm11=v2*(rl1*rcb2+2.d0*rl6*rcb*sb+rl5*sb2)+rma2*sb2 rm22=v2*(rl2*sb2+2.d0*rl7*rcb*sb+rl5*rcb2)+rma2*rcb2 Trm=rm11+rm22 Detm=rm11*rm22-rm12**2 rmh2=0.5d0*(Trm-sqrt(Trm**2-4.d0*Detm)) ENDIF !iloop rmh=sqrt(rmh2) ENDIF !irmhcomp * determinazione di Dabelstein e del libro arancione tga=-tgb*(rma2+rmz2)/(rmz2+rma2*tgb**2-rmh2*(1.d0+tgb**2)) IF(tga.LT.0.d0)THEN alf=atand(tga) ELSE alf=atand(tga)-180.d0 ENDIF sa=sind(alf) rca=cosd(alf) ENDIF ** cr and cl couplings ** photon-electron left and right fel=-1.d0 fer=-1.d0 ** Zeta-electron left e right zer=(+1.d0*s2w)/rcw/sw zel=(-.5d0+1.d0*s2w)/rcw/sw zvr=0.d0 zvl=.5d0/rcw/sw ** Zeta-quarkup left e right fqul=2.d0/3.d0 fqur=fqul zqur=(-2.d0/3.d0*s2w)/rcw/sw zqul=(.5d0-2.d0/3.d0*s2w)/rcw/sw ** Zeta-quarkdown left e right fqdl=-1.d0/3.d0 fqdr=fqdl zqdr=(1.d0/3.d0*s2w)/rcw/sw zqdl=(-.5d0+1.d0/3.d0*s2w)/rcw/sw ** W left (right=0) wcl=1.d0/sw/sqrt(2.d0) * el1 ** Higgs-ZZ * Higgs-bb coupling IF(iproc.GE.33.AND.isusy.EQ.0.AND.icch.NE.2)THEN IF(iproc.LE.39)THEN rhzz=rmb_run/(s2w*rc2w*2.d0) ** Higgs-WW * Higgs-bb coupling rhww=rmb_run/(s2w*2.d0) rhbb=rmb_run**2/(4.d0*rmw**2*s2w) ELSE IF(iproc.GT.39.AND.iproc.LE.46)THEN rhzz=rmc_run/(s2w*rc2w*2.d0) ** Higgs-WW * Higgs-bb coupling rhww=rmc_run/(s2w*2.d0) rhbb=rmc_run**2/(4.d0*rmw**2*s2w) ELSE IF(iproc.GT.46.AND.iproc.LE.53)THEN rhzz=rmtau/(s2w*rc2w*2.d0) ** Higgs-WW * Higgs-bb coupling rhww=rmtau/(s2w*2.d0) rhbb=rmtau**2/(4.d0*rmw**2*s2w) ENDIF ELSE IF(iproc.GE.33.AND.isusy.EQ.1.AND.icch.NE.2)THEN IF(iproc.LE.39)THEN rhzz=-rmb_run*sa*(sind(bet-alf))/(rcb*s2w*rc2w*2.d0) rhww=-rmb_run*sa*(sind(bet-alf))/(2.d0*s2w*rcb) rhbb=rmb_run**2*sa**2/(4.d0*rmw**2*s2w*rcb**2) IF(iproc.EQ.39.AND.isusy.EQ.1)THEN rzha=rmb_run**2*rmz*sa*sb*(cosd(bet-alf))/ & (8.d0*sw**3*rcb**2*rmw**3) rabb=-rmb_run**2*tgb**2/(4.d0*rmw**2*s2w) ENDIF ELSE IF(iproc.GT.39.AND.iproc.LE.46)THEN rhzz=rmc_run*rca*(sind(bet-alf))/(sb*s2w*rc2w*2.d0) rhww=rmc_run*rca*(sind(bet-alf))/(2.d0*s2w*sb) rhbb=rmc_run**2*rca**2/(4.d0*rmw**2*s2w*sb**2) IF(iproc.EQ.43.AND.isusy.EQ.1)THEN rzha=-rmc_run**2*rmz*rca*rcb*(cosd(bet-alf))/ & (8.d0*sw**3*sb**2*rmw**3) rabb=-rmc_run**2*rcb**2/(4.d0*rmw**2*s2w*sb**2) ENDIF ELSE IF(iproc.GT.46.AND.iproc.LE.53)THEN rhzz=-rmtau*sa*(sind(bet-alf))/(rcb*s2w*rc2w*2.d0) rhww=-rmtau*sa*(sind(bet-alf))/(2.d0*s2w*rcb) rhbb=rmtau**2*sa**2/(4.d0*rmw**2*s2w*rcb**2) IF(iproc.EQ.51.AND.isusy.EQ.1)THEN rzha=rmtau**2*rmz*sa*sb*(cosd(bet-alf))/ & (8.d0*sw**3*rcb**2*rmw**3) rabb=-rmtau**2*tgb**2/(4.d0*rmw**2*s2w) ENDIF * fine ENDIF ENDIF * endel1 emcoupl=(1.d0/pi/alfainv)**4 qcdcoupl=alfas_nc*alfainv qcdcor_nc=alfas_nc/pi qcdcor_cc=alfas_cc/pi qcdcor_h=alfas_h/pi*(5.67d0+42.74d0*alfas_h/pi) CALL initialize rmeisr=rme * el1 IF(imass.EQ.0.AND.iproc.LE.32)THEN * endel1 DO i=3,6 xm(i)=0.d0 ENDDO !i xmp=0.d0 rme=0.d0 ENDIF IF(igwcomp.EQ.1)THEN gamw=3.d0*rmw/(4.d0*s2w*alfainv) IF(i3q.EQ.1.OR.i5q.EQ.1)THEN gamw=gamw+istrcor*rmw/(2.d0*s2w*alfainv)*qcdcor_cc ELSE gamw=gamw+rmw/(2.d0*s2w*alfainv)*qcdcor_cc ENDIF ENDIF IF(igzcomp.EQ.1)THEN * el1 IF (rmb.EQ.0.d0.OR.(iproc.LE.32.AND.imass.EQ.0))THEN * endel1 gamz=21.d0-40.d0*s2w+160.d0*s2w**2/3.d0+(2.77d0/rmz)**4* & (24.d0*s2w-16.d0*s2w**2)-9.d0*(2.77d0/rmz)**2 IF(i3q.EQ.1.OR.i5q.EQ.1)THEN gamz=gamz+istrcor*qcdcor_nc*(15.d0-28.d0*s2w+88.d0*s2w**2/ & 3.d0+9.d0*(2.77d0/rmz)**2*(2.d0*(-1.d0+4.d0*s2w/3.d0) & **2-3.667d0)+(2.77d0/rmz)**4*(15.d0-33.d0*(-1.d0+4.d0* & s2w/3.d0)**2)) ELSE gamz=gamz+qcdcor_nc*(15.d0-28.d0*s2w+88.d0*s2w**2/3.d0+9.d0* & (2.77d0/rmz)**2*(2.d0*(-1.d0+4.d0*s2w/3.d0)**2-3.667d0)+ & (2.77d0/rmz)**4*(15.d0-33.d0*(-1.d0+4.d0*s2w/3.d0)**2)) ENDIF gamz=gamz*rmz/(24.d0*s2w*rc2w*alfainv) * el1 ELSE IF(rmb.NE.0.d0.AND.(iproc.GE.33.OR.(iproc.LE.32.AND. & imass.EQ.1)))THEN * endel1 gamz=21.d0-40.d0*s2w+160.d0*s2w**2/3.d0+(rmb/rmz)**4* & (24.d0*s2w-16.d0*s2w**2)-9.d0*(rmb/rmz)**2+istrcor* & qcdcor_nc*(15.d0-28.d0*s2w+88.d0*s2w**2/3.d0+9.d0* & (rmb/rmz)**2*(2.d0*(-1.d0+4.d0*s2w/3.d0)**2-3.667d0)+ & (rmb/rmz)**4*(15.d0-33.d0*(-1.d0+4.d0*s2w/3.d0)**2)) gamz=gamz*rmz/(24.d0*s2w*rc2w*alfainv) ENDIF ENDIF gw=gamw/rmw gz=gamz/rmz IF(ighcomp.EQ.1.AND.iproc.GE.33.AND.icch.NE.2.AND.isusy.EQ.0)THEN * el1 IF (rmb.EQ.0.d0.and.rmc.eq.0.d0.and.rmtau.eq.0.d0) THEN * endel1 gamh=rmh*(3.d0*(rmb_run**2+rmc_run**2)*(1.d0+ & qcdcor_h*istrcor)+rmtau**2+(rmh*alfas_h/(3.d0*pi))**2) & /(8.d0*rmw2*s2w*alfainv) ELSE gamh=rmh*(3.d0*(rmb_run**2*(1.d0-4.d0*(rmb/rmh)**2)**(1.5)+ & rmc_run**2*(1.d0-4.d0*(rmc/rmh)**2)**(1.5))*(1.d0+ & qcdcor_h*istrcor)+rmtau**2*(1.d0-4.d0*(rmtau/rmh)**2)** & (1.5)+(rmh*alfas_h/(3.d0*pi))**2) & /(8.d0*rmw2*s2w*alfainv) ENDIF ENDIF IF(ighcomp.EQ.1.AND.iproc.GE.33.AND.icch.NE.2.AND.isusy.EQ.1)THEN * el1 IF(rmb.EQ.0.d0.and.rmc.eq.0.d0.and.rmtau.eq.0.d0)THEN * endel1 gamh=(rmtau*sa/rcb)**2+3.d0*((rmb_run*sa/rcb)**2+ & (rmc_run*rca/sb)**2)*(1.d0+qcdcor_h*istrcor) gamh=gamh*rmh/(8.d0*rmw2*s2w*alfainv) * el1 IF(iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51)THEN * endel1 gama=(rmtau*sb/rcb)**2+3.d0*((rmb_run*sb/rcb)**2+ & (rmc_run*rcb/sb)**2)*(1.d0+qcdcor_h*istrcor) gama=gama*rma/(8.d0*rmw2*s2w*alfainv) ENDIF ELSE gamh=rmtau**2*(1.d0-(2.d0*rmtau/rmh)**2)**(1.5)*(sa/rcb)**2+ & 3.d0*(rmb_run**2*(1.d0-(2.d0*rmb/rmh)**2)**(1.5)* & (sa/rcb)**2+rmc_run**2*(1.d0-(2.d0*rmc/rmh)**2)**(1.5)* & (rca/sb)**2)*(1.d0+qcdcor_h*istrcor) gamh=gamh*rmh/(8.d0*rmw2*s2w*alfainv) * el1 IF(iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51)THEN * endel1 gama=rmtau**2*sqrt(1.d0-(2.d0*rmtau/rma)**2)*(sb/rcb)**2+ & 3.d0*(rmb_run**2*sqrt(1.d0-(2.d0*rmb/rma)**2)* & (sb/rcb)**2+rmc_run**2*sqrt(1.d0-(2.d0*rmc/rma)**2)* & (rcb/sb)**2)*(1.d0+qcdcor_h*istrcor) gama=gama*rma/(8.d0*rmw2*s2w*alfainv) ENDIF ENDIF ENDIF IF(iproc.GE.33.AND.icch.NE.2)THEN gh=gamh/rmh * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & isusy.EQ.1)THEN * endel1 ga=gama/rma ENDIF ENDIF IF (icut.EQ.1) THEN DO i=3,6 IF(icos.EQ.1)THEN beamcut_min(i)=thbeam_min(i) beamcut_max(i)=thbeam_max(i) ELSE IF(icos.EQ.0)THEN beamcut_min(i)=cos(thbeam_min(i)*pi/180.d0) beamcut_max(i)=cos(thbeam_max(i)*pi/180.d0) ENDIF ENDDO !i DO i=1,6 IF(icos.EQ.1)THEN sepcut_min(i)=thsep_min(i) sepcut_max(i)=thsep_max(i) ELSE IF(icos.EQ.0)THEN sepcut_min(i)=cos(thsep_min(i)*pi/180.d0) sepcut_max(i)=cos(thsep_max(i)*pi/180.d0) ENDIF rm_min2(i)=rm_min(i)**2 rm_max2(i)=rm_max(i)**2 ENDDO !i ENDIF IF(ianc.EQ.1)THEN yf=yf/rmw2 yz=yz/rmw2 zz=zz/rmw2 ENDIF * Estremi di integrazione sulle masse m34 ed m56: IF(icut.EQ.0.OR.rm_min(1).EQ.0.d0)THEN estrinf_34=xm(3)+xm(4) ELSE IF(icut.EQ.1.AND.rm_min(1).NE.0.d0)THEN estrinf_34=rm_min(1) ENDIF IF(icut.EQ.0.OR.rm_min(3).EQ.0.d0)THEN estrinf_36=xm(3)+xm(6) ELSE IF(icut.EQ.1.AND.rm_min(3).NE.0.d0)THEN estrinf_36=rm_min(3) ENDIF IF(icut.EQ.0.OR.rm_min(6).EQ.0.d0)THEN estrinf_56=xm(5)+xm(6) ELSE IF(icut.EQ.1.AND.rm_min(6).NE.0.d0)THEN estrinf_56=rm_min(6) ENDIF IF(icut.EQ.0.OR.rm_min(4).EQ.0.d0)THEN estrinf_54=xm(4)+xm(5) ELSE IF(icut.EQ.1.AND.rm_min(4).NE.0.d0)THEN estrinf_54=rm_min(4) ENDIF * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & icch.NE.2.AND.isusy.EQ.1)THEN * endel1 estrmed2=0.5d0*(rma+rmz) ENDIF cim=(0.d0,1.d0) IF(isr.EQ.1)THEN rl=log(s_col/rmeisr/rmeisr) alfa_me=1.d0/137.0359895d0 beta=2.d0*alfa_me*(rl-1.d0)/pi gamma=exp(gammln(1.d0+beta/2.d0)) ge=0.5772156649d0 rlim=exp(beta*(0.75d0-ge)/2.d0)*(beta/2.d0)/gamma ENDIF IF(ipr.EQ.0)THEN czipr=(1.d0,0.d0) ccz=cim*gamz*rmz cwipr=(1.d0,0.d0) ccw=cim*gamw*rmw IF(iproc.GE.33.AND.icch.NE.2)THEN chipr=(1.d0,0.d0) cch=cim*gamh*rmh * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1)THEN * endel1 caipr=(1.d0,0.d0) cca=cim*gama*rma ENDIF ENDIF ELSE IF(ipr.EQ.1)THEN czipr=1.d0+cim*gamz/rmz ccz=(0.d0,0.d0) cwipr=1.d0+cim*gamw/rmw ccw=(0.d0,0.d0) IF(iproc.GE.33.AND.icch.NE.2)THEN chipr=1.d0+cim*gamh/rmh cch=(0.d0,0.d0) * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & isusy.EQ.1)THEN * endel1 caipr=1.d0+cim*gama/rma cca=(0.d0,0.d0) ENDIF ENDIF ELSE IF(ipr.EQ.2)THEN czipr=(1.d0,0.d0) ccz=cim*gamz*rmz cwipr=1.d0+cim*gamw/rmw ccw=(0.d0,0.d0) IF(iproc.GE.33.AND.icch.NE.2)THEN chipr=1.d0+cim*gamh/rmh cch=(0.d0,0.d0) * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & isusy.EQ.1)THEN * endel1 caipr=1.d0+cim*gama/rma cca=(0.d0,0.d0) ENDIF ENDIF ENDIF *begin{EZ} test di compatibilita' fra ipr e ifloop IF((ifloop.EQ.1).AND.(ipr.NE.2)) THEN PRINT*,'ERROR:' PRINT*,'ifloop.EQ.1 and ipr.NE.2' STOP ENDIF IF((ifloop.NE.1).AND.(ipr.EQ.2)) THEN PRINT*,'ERROR:' PRINT*,'ipr.EQ.2 and ifloop.NE.1' STOP ENDIF *end{EZ} CALL printer(rmh,gamh,rma,gama,tgb,rmb) * el1 * ridefinisco la massa per i nuovi processi con Higgs IF(iproc.GE.40.AND.iproc.LE.46)THEN rmb=rmc rmb2=rmc**2 rmb_run=rmc_run rmt2=0.d0 !assuming the s quark to be massless ELSE IF(iproc.GE.47.AND.iproc.LE.53)THEN rmb=rmtau rmb2=rmtau**2 rmb_run=rmtau rmt2=0.d0 ENDIF * endel1 * Routine Vegas parameter: * sa1 cqedps c IF(isr.EQ.0)THEN c ndim=7 c ELSE c ndim=9 c ENDIF IF(isr.EQ.0.or.isr.eq.2)THEN ndim=7 elseif (isr.eq.1) then ndim=9 else print*, 'ERROR: isr value not admitted' stop ENDIF cqedpsend * sa1end * Integration limits: DO i=1,ndim region(i)=0.d0 region(ndim+i)=1.d0 ENDDO !i * Thermalization: IF(iterm.EQ.1.AND.irepeat.EQ.0)THEN init=0 PRINT*,' ' PRINT*,'Thermalization' * CC thermalization IF (iccnc.EQ.1.OR.iccnc.EQ.3) THEN *agg IF(iccnc.EQ.3.AND.interf.EQ.1)THEN imix=2 icc=-1 ELSE IF(iccnc.EQ.1.OR.(iccnc.EQ.3.AND.interf.EQ.0))THEN imix=1 icc=1 ENDIF *aggend ips=ips_cc rmx1=rmw gamx1=gamw gx1=gw rmx2=rmx1 gamx2=gamx1 gx2=gx1 * Higgs thermalization * el1 ELSE IF(iccnc.EQ.4.AND.(icch.EQ.1.OR.icch.EQ.3))THEN IF(isusy.EQ.0.OR.(isusy.EQ.1.AND.(iproc.NE.39.AND.iproc. & NE.43.AND.iproc.NE.51)).OR.(isusy.EQ.1.AND. & (iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & ((rma+rmh).GT.e_cm.OR.iha.EQ.2.OR.iha.EQ.4)))THEN * endel1 imix=1 ips=ips_cc rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz * el1 ELSE IF(isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.43.OR. & iproc.EQ.51).AND.(rma+rmh).LE.e_cm.AND.iha.NE. & 2.AND.iha.NE.4)THEN * endel1 * hA + hZ thermalization imix=1 ips=ips_cc rmx1=rmh gamx1=gamh gx1=gh rmx2=min(rma,rmz) IF(rma.LT.rmz)THEN gamx2=gama gx2=ga ELSE gamx2=gamz gx2=gz ENDIF rmx3=max(rma,rmz) IF(rma.GT.rmz)THEN gamx3=gama gx3=ga ELSE gamx3=gamz gx3=gz ENDIF ENDIF * NC thermalization ELSE imix=-1 icc=0 ips=ips_nc rmx1=rmz gamx1=gamz gx1=gz rmx2=rmz gamx2=gamz gx2=gz ENDIF * estremi di integrazione sulle due masse invarianti IF(iproc.GE.6.AND.iproc.LE.8.AND.(iccnc.EQ.1.OR.iccnc.EQ.3))THEN estrinf1=estrinf_36 estrinf2=estrinf_54 ELSE IF((iproc.EQ.4.or.iproc.eq.2.or.iproc.eq.7.or.iproc.eq.21) & .AND.ismallangle.EQ.1)THEN estrinf1=xm(4)+xm(5)+xm(6) estrinf2=xm(5)+xm(4) ELSE estrinf1=estrinf_34 estrinf2=estrinf_56 ENDIF c smin=(estrinf1+estrinf2)**2 smin=(xm(3)+xm(4)+xm(5)+xm(6))**2 IF(ipr.EQ.0)THEN x1_min=atan((estrinf1**2-rmx1**2)/(gamx1*rmx1)) x2_min=atan((estrinf2**2-rmx2**2)/(gamx2*rmx2)) ELSE x1_min=atan(((1.d0+gx1**2)*estrinf1**2-rmx1**2)/(gx1*rmx1**2)) x2_min=atan(((1.d0+gx2**2)*estrinf2**2-rmx2**2)/(gx2*rmx2**2)) ENDIF IF(ism34.NE.-1) THEN IF(imix.LT.0)THEN ism34=1 ELSE ism34=0 ENDIF ENDIF IF(ism56.NE.-1) THEN IF(imix.LT.0)THEN ism56=1 ELSE ism56=0 ENDIF ENDIF IF(iproc.EQ.7)THEN IF(imix.GT.0)THEN rexp5=0.0d0 rexp6=0.7d0 ELSE rexp5=0.0d0 rexp6=0.0d0 ENDIF ENDIF CALL vegas(region,ndim,fxn,init,ncall_term,itmx_term,nprn, & avgi1,sd1,rchi2a,acc,y1,it1,ndo1,si1,swgt1,schi1) IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN iseed1=idum iy1=iy idum21=idum2 DO n=1,32 iv1(n)=iv(n) ENDDO !n init=0 idum=0 idum2=123456789 iy=0 DO n=1,32 iv(n)=0 ENDDO !n *agg IF(iccnc.EQ.3.AND.interf.EQ.1)THEN imix=-1 icc=0 ELSE IF((iccnc.EQ.3.AND.interf.EQ.0).OR. & (iccnc.EQ.4.AND.icch.EQ.3))THEN imix=-2 icc=-1 ENDIF *aggend ips=ips_nc rmx1=rmz gamx1=gamz gx1=gz rmx2=rmz gamx2=gamz gx2=gz estrinf1=estrinf_34 estrinf2=estrinf_56 smin=(estrinf1+estrinf2)**2 IF(ipr.EQ.0)THEN x1_min=atan((estrinf1**2-rmx1**2)/(gamx1*rmx1)) x2_min=atan((estrinf2**2-rmx2**2)/(gamx2*rmx2)) ELSE x1_min=atan(((1.d0+gx1**2)*estrinf1**2-rmx1**2) & /(gx1*rmx1**2)) x2_min=atan(((1.d0+gx2**2)*estrinf2**2-rmx2**2) & /(gx2*rmx2**2)) ENDIF IF(ism34.NE.-1) THEN IF(imix.LT.0)THEN ism34=1 ELSE ism34=0 ENDIF ENDIF IF(ism56.NE.-1) THEN IF(imix.LT.0)THEN ism56=1 ELSE ism56=0 ENDIF ENDIF IF(iproc.EQ.7)THEN IF(imix.GT.0)THEN rexp5=0.0d0 rexp6=0.7d0 ELSE rexp5=0.0d0 rexp6=0.0d0 ENDIF ENDIF CALL vegas(region,ndim,fxn,init,ncall_term,itmx_term,nprn, & avgi2,sd2,rchi2a,acc,y2,it2,ndo2,si2,swgt2,schi2) iseed2=idum iy2=iy idum22=idum2 DO n=1,32 iv2(n)=iv(n) ENDDO !n ENDIF ENDIF !thermalization *agg * initialization of the variables used if IFLAT=1 IF(iflat.EQ.1)THEN * n. random generato con RAN(ISEED) iseed=19753179 * numero di punti che eccedono il massimo fissato novermax=0 * n. di momenti generati nevent=0 * maximum function value at first and second vegas iteration rmaxfxn=0.d0 rmaxfxn_1it=0.d0 rmaxfxn_2it=0.d0 rmaxfxn_cc_1it=0.d0 rmaxfxn_nc_1it=0.d0 rmaxfxn_cc_2it=0.d0 rmaxfxn_nc_2it=0.d0 IF(istormom.EQ.1)THEN IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN OPEN(unit=21,file='ABMOM_SIGN.DAT',status='new') OPEN(unit=23,file='ABMOM_BACK.DAT',status='new') ELSE OPEN(unit=23,file='ABMOM.DAT',status='new') ENDIF ENDIF ENDIF *aggend * inizializzazione di variabili usate se IDISTR=1 IF(idistr.EQ.1)THEN DO m=1,ndistr test(m)=0.d0 IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN test_mix(m)=0.d0 ENDIF DO i=1,nbinmax DO j=1,nitmax distr_local(m,i,j)=0.d0 dev_local(m,i,j)=0.d0 ncallbin(m,i,j)=0 IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN distr_loc_mix(m,i,j)=0.d0 dev_loc_mix(m,i,j)=0.d0 ncallbin_mix(m,i,j)=0 ENDIF ENDDO !j ENDDO !i ENDDO !m DO m=1,ndistr DO i=1,nitmax tail_local(m,i)=0.d0 IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN tail_loc_mix(m,i)=0.d0 ENDIF ENDDO !i ENDDO !m DO m=1,ndistr DO i=1,nintmax nbin_sum(m,i)=0 ENDDO !i ENDDO !m DO m=1,ndistr DO i=1,nsubint(m) bin_width(m,i)=(distr_estrinf(m,i+1)-distr_estrinf(m,i))/ & nbin_number(m,i) ENDDO !i ENDDO !m ENDIF * integration loop IF(iterm.EQ.1)THEN init=1 ELSE init=0 ENDIF IF(iccnc.EQ.1.OR.iccnc.EQ.2.OR.(iccnc.EQ.4.AND.icch.NE.3))THEN IF(iccnc.EQ.1)THEN PRINT*,' ' PRINT*,'CC process' imix=1 icc=1 ips=ips_cc rmx1=rmw gamx1=gamw gx1=gw rmx2=rmw gamx2=gamw gx2=gw ELSE IF(iccnc.EQ.2.OR.(iccnc.EQ.4.AND.icch.EQ.2))THEN IF (iccnc.EQ.2) THEN PRINT*,' ' PRINT*,'NC process' ELSE PRINT*,' ' PRINT*,'Higgs background' ENDIF imix=-1 icc=0 ips=ips_nc rmx1=rmz gamx1=gamz gx1=gz rmx2=rmz gamx2=gamz gx2=gz ELSE IF (iccnc.EQ.4.AND.icch.EQ.1) THEN * el1 IF(isusy.EQ.0.OR.(isusy.EQ.1.AND.iproc.NE.39.AND. & iproc.NE.43.AND.iproc.NE.51).OR.(isusy.EQ.1.AND. & (iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND. & ((rma+rmh).GT.e_cm.OR.iha.EQ.2.OR.iha.EQ.4)))THEN PRINT*,' ' IF(iproc.NE.39.AND.iproc.NE.43.AND.iproc.NE.51)THEN PRINT*,'Higgs signal' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.0.AND.iha.EQ.1)THEN PRINT*,'Complete h contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.0.AND.iha.EQ.2)THEN PRINT*,'only hZ contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1.AND.iha.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1.AND.iha.EQ.2)THEN PRINT*,'Complete h contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1.AND.iha.EQ.3)THEN PRINT*,'Complete A contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1.AND.iha.EQ.4)THEN PRINT*,'only hZ contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1.AND.iha.EQ.5)THEN PRINT*,'Only hA contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1.AND.iha.EQ.6)THEN PRINT*,'Only hZ+hA contribution' ENDIF * endel1 imix=1 ips=ips_cc rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz * el1 ELSE IF(isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.43.OR. & iproc.EQ.51).AND.(rma+rmh).LE.e_cm.AND. & iha.NE.2.AND.iha.NE.4)THEN PRINT*,' ' IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.3)THEN PRINT*,'Complete A contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.5)THEN PRINT*,'only hA contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.6)THEN PRINT*,'only hZ+hA contribution' ENDIF * endel1 imix=1 ips=ips_cc rmx1=rmh gamx1=gamh gx1=gh rmx2=min(rma,rmz) IF(rma.LT.rmz)THEN gamx2=gama gx2=ga ELSE gamx2=gamz gx2=gz ENDIF rmx3=max(rma,rmz) IF(rma.GT.rmz)THEN gamx3=gama gx3=ga ELSE gamx3=gamz gx3=gz ENDIF ENDIF ENDIF IF(iproc.GE.6.AND.iproc.LE.8.AND.iccnc.EQ.1)THEN estrinf1=estrinf_36 estrinf2=estrinf_54 ELSE estrinf1=estrinf_34 estrinf2=estrinf_56 ENDIF smin=(estrinf1+estrinf2)**2 IF(ipr.EQ.0)THEN x1_min=atan((estrinf1**2-rmx1**2)/(gamx1*rmx1)) x2_min=atan((estrinf2**2-rmx2**2)/(gamx2*rmx2)) ELSE x1_min=atan(((1.d0+gx1**2)*estrinf1**2-rmx1**2)/(gx1*rmx1**2)) x2_min=atan(((1.d0+gx2**2)*estrinf2**2-rmx2**2)/(gx2*rmx2**2)) ENDIF *agg IF(iflat.EQ.0)THEN IF(ism34.NE.-1) THEN IF(imix.LT.0)THEN ism34=1 ELSE ism34=0 ENDIF ENDIF IF(ism56.NE.-1) THEN IF(imix.LT.0)THEN ism56=1 ELSE ism56=0 ENDIF ENDIF IF(iproc.EQ.7)THEN IF(imix.GT.0)THEN rexp5=0.0d0 rexp6=0.7d0 ELSE rexp5=0.0d0 rexp6=0.0d0 ENDIF ENDIF CALL vegas(region,ndim,fxn,init,ncall,itmx,nprn,avgi1, & sd1,rchi2a,acc,y1,it1,ndo1,si1,swgt1,schi1) ELSE IF(iflat.EQ.1)THEN acc=0.d0 DO nit=1,2 IF(nit.EQ.2)init=2 IF((nit.EQ.1.AND.irepeat.EQ.0).OR.(nit.EQ.2))THEN IF(irepeat.GE.1)THEN it1=2 OPEN(unit=24,file='abvegas.dat',status='old') READ(24,*)idum,idum2,iy DO i=1,32 READ(24,*)iv(i) ENDDO !i READ(24,*)avgi1,sd1,rchi2a DO i=1,50 DO j=1,10 READ(24,*)y1(i,j) ENDDO !j ENDDO !i READ(24,*)ndo1,si1,swgt1,schi1 READ(24,*)rmaxfxn READ(24,*),avgi_tot,sd_tot CLOSE(24) c26 if(irepeat.GT.1) nprn=-1 c26 ENDIF IF(ism34.NE.-1) THEN IF(imix.LT.0)THEN ism34=1 ELSE ism34=0 ENDIF ENDIF IF(ism56.NE.-1) THEN IF(imix.LT.0)THEN ism56=1 ELSE ism56=0 ENDIF ENDIF IF(iproc.EQ.7)THEN IF(imix.GT.0)THEN rexp5=0.0d0 rexp6=0.7d0 ELSE rexp5=0.0d0 rexp6=0.0d0 ENDIF ENDIF CALL vegas(region,ndim,fxn,init,ncall,nit,nprn,avgi1, & sd1,rchi2a,acc,y1,it1,ndo1,si1,swgt1,schi1) IF(nit.EQ.1)THEN rmaxfxn_1it=rmaxfxn ENDIF IF(istorvegas.EQ.1.AND.nit.EQ.1)THEN OPEN(unit=24,file='abvegas.dat',status='new') WRITE(24,*)idum,idum2,iy DO i=1,32 WRITE(24,*)iv(i) ENDDO !i WRITE(24,*)avgi1,sd1,rchi2a DO i=1,50 DO j=1,10 WRITE(24,*)y1(i,j) ENDDO !j ENDDO !i WRITE(24,*)ndo1,si1,swgt1,schi1 ENDIF IF(istorvegas.EQ.1.AND.nit.EQ.2)THEN rmaxfxn=rmaxfxn_2it WRITE(24,*)rmaxfxn WRITE(24,*)avgi1,sd1 CLOSE(24) ENDIF ENDIF ENDDO !nit ENDIF *aggend if (irepeat.ne.2) then avgi_tot=avgi1 sd_tot=sd1 endif it=it1-1 ELSE IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN IF(iflat.EQ.1)acc=0.d0 DO nit=1,itmx IF(nit.GE.2)init=2 ncont_cc=0 DO irip=1,2 IF((irip.EQ.1.AND.((nit.EQ.1.AND.irepeat.EQ.0).OR. & (iflat.EQ.1.AND.nit.EQ.2).OR.(sd_tot.GT.acc*avgi_tot.AND. & sd1.GT.r*acc*avgi_tot.AND.sd1*avgi2.GT.sd2*avgi1.AND. & irepeat.EQ.0))).OR.(irip.EQ.2.AND.ncont_cc.EQ.0.AND. & sd_tot.GT.acc*avgi_tot.AND.sd1.GT.r*acc*avgi_tot))THEN ncont_cc=1 idum=iseed1 iy=iy1 idum2=idum21 DO n=1,32 iv(n)=iv1(n) ENDDO !n *agg IF(iccnc.EQ.3.AND.interf.EQ.1)THEN imix=2 icc=-1 ELSE IF((iccnc.EQ.3.AND.interf.EQ.0).OR. & (iccnc.EQ.4.AND.icch.EQ.3))THEN imix=1 icc=1 ENDIF *aggend ips=ips_cc IF(iccnc.EQ.3)THEN PRINT*,' ' *agg IF(interf.EQ.0)THEN PRINT*,'CC process' ELSE PRINT*,'CC process + CC-NC interference' ENDIF *aggend rmx1=rmw gamx1=gamw gx1=gw rmx2=rmw gamx2=gamw gx2=gw ELSE * el1 IF(isusy.EQ.0.OR.(isusy.EQ.1.AND.(iproc.NE.39. & AND.iproc.NE.43.AND.iproc.NE.51)).OR.(isusy. & EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.(rma+rmh).GT.e_cm))THEN PRINT*,' ' IF(iproc.NE.39.AND.iproc.NE.43.AND.iproc.NE.51)THEN PRINT*,'Higgs signal' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.0)THEN PRINT*,'Complete higgs contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.isusy.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ENDIF * endel1 rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz * el1 ELSE IF(isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.43.OR. & iproc.EQ.51).AND.(rma+rmh).LE.e_cm)THEN * endel1 PRINT*,' ' PRINT*,'Complete h and A higgs contribution' rmx1=rmh gamx1=gamh gx1=gh rmx2=min(rma,rmz) IF(rma.LT.rmz)THEN gamx2=gama gx2=ga ELSE gamx2=gamz gx2=gz ENDIF rmx3=max(rma,rmz) IF(rma.GT.rmz)THEN gamx3=gama gx3=ga ELSE gamx3=gamz gx3=gz ENDIF ENDIF ENDIF IF(iccnc.EQ.3)THEN estrinf1=estrinf_36 estrinf2=estrinf_54 ELSE estrinf1=estrinf_34 estrinf2=estrinf_56 ENDIF smin=(estrinf1+estrinf2)**2 IF(ipr.EQ.0)THEN x1_min=atan((estrinf1**2-rmx1**2)/(gamx1*rmx1)) x2_min=atan((estrinf2**2-rmx2**2)/(gamx2*rmx2)) ELSE x1_min=atan(((1.d0+gx1**2)*estrinf1**2-rmx1**2) & /(gx1*rmx1**2)) x2_min=atan(((1.d0+gx2**2)*estrinf2**2-rmx2**2) & /(gx2*rmx2**2)) ENDIF *agg IF(nit.EQ.2.AND.irepeat.GE.1)THEN it1=2 OPEN(unit=24,file='abvegas_cc.dat',status='old') READ(24,*)idum,idum2,iy DO i=1,32 READ(24,*)iv(i) ENDDO !i READ(24,*)avgi1,sd1,rchi2a DO i=1,50 DO j=1,10 READ(24,*)y1(i,j) ENDDO !j ENDDO !i READ(24,*)ndo1,si1,swgt1,schi1 READ(24,*)rmaxfxn IF(irepeat.EQ.2)then READ(24,*)sigma1,sdfin1 READ(24,*)sigma2,sdfin2 nflevts1=nflevts*sigma1/(sigma1+sigma2) nflevtstot=nflevts nflevts=nflevts1 endif CLOSE(24) c26 if(irepeat.GT.1) nprn=-1 c26 ENDIF *aggend IF(ism34.NE.-1) THEN IF(imix.LT.0)THEN ism34=1 ELSE ism34=0 ENDIF ENDIF IF(ism56.NE.-1) THEN IF(imix.LT.0)THEN ism56=1 ELSE ism56=0 ENDIF ENDIF IF(iproc.EQ.7)THEN IF(imix.GT.0)THEN rexp5=0.0d0 rexp6=0.7d0 ELSE rexp5=0.0d0 rexp6=0.0d0 ENDIF ENDIF CALL vegas(region,ndim,fxn,init,ncall,nit,nprn,avgi1, & sd1,rchi2a,acc,y1,it1,ndo1,si1,swgt1,schi1) if (irepeat.GE.1) PRINT 205,NEVENT *agg IF(nit.EQ.1.AND.istorvegas.EQ.1)THEN OPEN(unit=24,file='abvegas_cc.dat',status='new') WRITE(24,*)idum,idum2,iy DO i=1,32 WRITE(24,*)iv(i) ENDDO !i WRITE(24,*)avgi1,sd1,rchi2a DO i=1,50 DO j=1,10 WRITE(24,*)y1(i,j) ENDDO !j ENDDO !i WRITE(24,*)ndo1,si1,swgt1,schi1 ENDIF IF(nit.EQ.2.AND.istorvegas.EQ.1)THEN sigma1=avgi1 ENDIF *aggend resl_cc(it1-1)=resl(it1-1) iseed1=idum iy1=iy idum21=idum2 DO n=1,32 iv1(n)=iv(n) ENDDO !n avgi_tot=avgi1+avgi2 sd_tot=sqrt(sd1**2+sd2**2) ENDIF IF(irip.EQ.1.AND.((nit.EQ.1.AND.irepeat.EQ.0).OR. & (iflat.EQ.1.AND.nit.EQ.2).OR.(sd_tot.GT.acc*avgi_tot.AND. & sd2.GT.r*acc*avgi_tot.AND.irepeat.EQ.0)))THEN idum=iseed2 iy=iy2 idum2=idum22 DO n=1,32 iv(n)=iv2(n) ENDDO !n IF(iccnc.EQ.3.AND.interf.EQ.1)THEN imix=-1 icc=0 ELSE IF((iccnc.EQ.3.AND.interf.EQ.0).OR. & (iccnc.EQ.4.AND.icch.EQ.3))THEN imix=-2 icc=-1 ENDIF ips=ips_nc IF (iccnc.EQ.3) THEN PRINT*,' ' *agg IF(interf.EQ.0)THEN PRINT*,'NC process + CC-NC interference' ELSE PRINT*,'NC process' ENDIF *aggend ELSE PRINT*,' ' PRINT*,'Higgs backg + Higgs sign-backg intereference' ENDIF rmx1=rmz gamx1=gamz gx1=gz rmx2=rmz gamx2=gamz gx2=gz estrinf1=estrinf_34 estrinf2=estrinf_56 smin=(estrinf1+estrinf2)**2 IF(ipr.EQ.0)THEN x1_min=atan((estrinf1**2-rmx1**2)/(gamx1*rmx1)) x2_min=atan((estrinf2**2-rmx2**2)/(gamx2*rmx2)) ELSE x1_min=atan(((1.d0+gx1**2)*estrinf1**2-rmx1**2) & /(gx1*rmx1**2)) x2_min=atan(((1.d0+gx2**2)*estrinf2**2-rmx2**2) & /(gx2*rmx2**2)) ENDIF *agg IF(nit.EQ.2.AND.irepeat.GE.1)THEN it2=2 OPEN(unit=25,file='abvegas_nc.dat',status='old') READ(25,*)idum,idum2,iy DO i=1,32 READ(25,*)iv(i) ENDDO !i READ(25,*)avgi2,sd2,rchi2a DO i=1,50 DO j=1,10 READ(25,*)y2(i,j) ENDDO !j ENDDO !i READ(25,*)ndo2,si2,swgt2,schi2 READ(25,*)rmaxfxn CLOSE(25) IF(irepeat.EQ.2)then nflevts=nflevtstot endif c26 if(irepeat.GT.1) nprn=-1 c26 ENDIF IF(ism34.NE.-1) THEN IF(imix.LT.0)THEN ism34=1 ELSE ism34=0 ENDIF ENDIF IF(ism56.NE.-1) THEN IF(imix.LT.0)THEN ism56=1 ELSE ism56=0 ENDIF ENDIF IF(iproc.EQ.7)THEN IF(imix.GT.0)THEN rexp5=0.0d0 rexp6=0.7d0 ELSE rexp5=0.0d0 rexp6=0.0d0 ENDIF ENDIF CALL vegas(region,ndim,fxn,init,ncall,nit,nprn,avgi2, & sd2,rchi2a,acc,y2,it2,ndo2,si2,swgt2,schi2) c26 if (irepeat.GE.1) PRINT 205,nevent-nflevts1 c26 IF(nit.EQ.1)THEN rmaxfxn_1it=rmaxfxn ENDIF IF(nit.EQ.1.AND.istorvegas.EQ.1)THEN OPEN(unit=25,file='abvegas_nc.dat',status='new') WRITE(25,*)idum,idum2,iy DO i=1,32 WRITE(25,*)iv(i) ENDDO !i WRITE(25,*)avgi2,sd2,rchi2a DO i=1,50 DO j=1,10 WRITE(25,*)y2(i,j) ENDDO !j ENDDO !i WRITE(25,*)ndo2,si2,swgt2,schi2 ENDIF IF(nit.EQ.2.AND.istorvegas.EQ.1)THEN rmaxfxn=rmaxfxn_2it WRITE(25,*)rmaxfxn CLOSE(25) WRITE(24,*)rmaxfxn WRITE(24,*)avgi1,sd1 WRITE(24,*)avgi2,sd2 CLOSE(24) ENDIF *aggend resl_nc(it2-1)=resl(it2-1) iseed2=idum iy2=iy idum22=idum2 DO n=1,32 iv2(n)=iv(n) ENDDO !n avgi_tot=avgi1+avgi2 sd_tot=sqrt(sd1**2+sd2**2) IF (irepeat.eq.2) then avgi_tot=sigma1+sigma2 sd_tot=sqrt(sdfin1**2+sdfin2**2) ENDIF ENDIF ENDDO !irip ENDDO !nit ENDIF PRINT*,' ' * em2 c PRINT *,'ism34 =',ism34,' ism56 =',ism56 c PRINT *,'rexp5 =',rexp5,' rexp6 =',rexp6 * endem2 PRINT 151 151 FORMAT('------------------------------------------------------') PRINT*,' ' PRINT 201,avgi_tot,sd_tot 201 FORMAT(' Sigma = ',d13.7,' +/-',d10.3,' (pb)') *agg IF(iflat.EQ.1)THEN PRINT*,'Informations about flat events generation:' PRINT*,' ---------------------- ' IF(irepeat.EQ.0)THEN PRINT 203,rmaxfxn_1it 203 FORMAT(' Maximum after first VEGAS iteration = ',d9.3) ENDIF if (irepeat.ne.2) then PRINT 204,rmaxfxn_2it 204 FORMAT(' Maximum after second VEGAS iteration = ',d9.3) else PRINT*,'Maximum = ',rmaxfxn_2it endif PRINT 205,NEVENT 205 FORMAT(' Flat events number = ',i9) PRINT 206,novermax 206 FORMAT(' number of function values over maximum = ',i9) ENDIF *aggend * Distributions: IF(idistr.EQ.1)THEN OPEN(unit=22,file='ABDIS.DAT',status='new') IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN WRITE(22,*)'N_iteration_CC=',it1-1 WRITE(22,*)'N_iteration_NC=',it2-1 ELSE WRITE(22,*)'N_iteration=',it1-1 ENDIF WRITE(22,*)'cross-section:',avgi_tot,'+/-',sd_tot,' (pb) ' WRITE(22,*) it1=it1-1 it2=it2-1 DO m=1,ndistr WRITE(22,*)string(m) DO n=1,nsubint(m) nbintot(m)=nbintot(m)+nbin_number(m,n) ENDDO !n DO i=1,nbintot(m) DO j=1,it1 IF(ncallbin(m,i,j).ge.2)THEN dev_local(m,i,j)=(ncallbin(m,i,j)*dev_local(m,i,j)- & distr_local(m,i,j)**2)/(ncallbin(m,i,j)-1) ENDIF ENDDO !j IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN DO j=1,it2 IF(ncallbin_mix(m,i,j).ge.2)THEN dev_loc_mix(m,i,j)=(ncallbin_mix(m,i,j)*dev_loc_mix(m, & i,j)-distr_loc_mix(m,i,j)**2)/(ncallbin_mix(m,i,j)-1) ENDIF ENDDO !j ENDIF ENDDO !i DO i=1,nbinmax devbin(m,i)=0.d0 IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN devbin_mix(m,i)=0.d0 ENDIF ENDDO !i DO i=1,nbintot(m) DO j=1,it1 IF(dev_local(m,i,j).ne.0.d0)THEN devbin(m,i)=devbin(m,i)+1.d0/dev_local(m,i,j) ENDIF ENDDO !j IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN DO j=1,it2 IF(dev_loc_mix(m,i,j).NE.0.d0)THEN devbin_mix(m,i)=devbin_mix(m,i)+1.d0/ & dev_loc_mix(m,i,j) ENDIF ENDDO !j ENDIF ENDDO !i DO i=1,nbintot(m) DO j=1,it1 rnorm(m,i,j)=dev_local(m,i,j)*devbin(m,i) ENDDO !j IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN DO j=1,it2 rnorm_mix(m,i,j)=dev_loc_mix(m,i,j)*devbin_mix(m,i) ENDDO !j ENDIF ENDDO !i DO i=1,nbintot(m) IF(devbin(m,i).gt.0.d0)THEN devbin(m,i)=1.d0/sqrt(devbin(m,i)) ENDIF IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN IF(devbin_mix(m,i).GT.0.d0)THEN devbin_mix(m,i)=1.d0/sqrt(devbin_mix(m,i)) ENDIF ENDIF ENDDO !i DO i=1,nbintot(m) IF(rnorm(m,i,it1).NE.0.d0)THEN test(m)=test(m)+distr_local(m,i,it1) distr_local(m,i,it1)=distr_local(m,i,it1)/rnorm(m,i,it1) ENDIF IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN IF(rnorm_mix(m,i,it2).NE.0.d0)THEN test_mix(m)=test_mix(m)+distr_loc_mix(m,i,it2) distr_loc_mix(m,i,it2)=distr_loc_mix(m,i,it2)/ & rnorm_mix(m,i,it2) ENDIF ENDIF ENDDO !i DO i=1,nbintot(m) DO j=1,it1-1 IF(rnorm(m,i,j).NE.0.d0)THEN distr_local(m,i,it1)=distr_local(m,i,it1)+ & distr_local(m,i,j)/rnorm(m,i,j) ENDIF ENDDO !j IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN DO j=1,it2-1 IF(rnorm_mix(m,i,j).NE.0.d0)THEN distr_loc_mix(m,i,it2)=distr_loc_mix(m,i,it2)+ & distr_loc_mix(m,i,j)/rnorm_mix(m,i,j) ENDIF ENDDO !j ENDIF ENDDO !i IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN DO i=1,nbintot(m) distr_local(m,i,it1)=distr_local(m,i,it1)+ & distr_loc_mix(m,i,it2) devbin(m,i)=devbin(m,i)+devbin_mix(m,i) ENDDO !i tail_local(m,it1)=tail_local(m,it1)+tail_loc_mix(m,it2) test(m)=test(m)+test_mix(m) ENDIF k=0 DO i=1,nsubint(m) delrm=bin_width(m,i) rmed=distr_estrinf(m,i)-delrm/2.d0 IF(i.eq.1)THEN k=1 ELSE k=k+nbin_number(m,i-1) ENDIF DO j=k,nbin_number(m,i)+k-1 rmed=rmed+delrm write(22,*)rmed,distr_local(m,j,it1)/bin_width(m,i), & devbin(m,j)/bin_width(m,i) ENDDO !j ENDDO !i WRITE(22,*)'test(m)=',test(m) WRITE(22,*)'tail_local(m,it1)=',tail_local(m,it1) IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN WRITE(22,*)'test=',test(m)+tail_local(m,it1)- & resl_cc(it1)-resl_nc(it2) ELSE WRITE(22,*)'test=',test(m)+tail_local(m,it1)-resl(it1) ENDIF ENDDO !m CLOSE(22) ENDIF STOP END REAL*8 FUNCTION fxn(x0,wgt) IMPLICIT REAL*8 (a-h,o-z) REAL*8 qua_app CHARACTER*60 string REAL*4 singlep(0:3) DIMENSION p1(0:3),p2(0:3),p3(0:3),p4(0:3),p5(0:3),p6(0:3) DIMENSION q3(0:3),q4(0:3),q5(0:3),q6(0:3) * sa1 DIMENSION pboost(0:3),pboostbeam(0:3) *sa1end DIMENSION paus(0:3),p(0:3,6),x(9),x0(9),p1_456(0:3) DIMENSION cc(3:6,3:6),y(3:6,3:6),rmod(3:6),cosbeam(3:6),pt(3:6) * em2 COMMON/abpara/rmx1,gamx1,gx1,rmx2,gamx2,gx2,beta,rlim,s_col, & x1_min,x2_min,smin,emcoupl,estrinf1,estrinf2,estrmed2, & rmx3,gamx3,gx3,sepmass1low,sepmass1high, & sepmass2low,sepmass2high COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp,imass,ismallangle,ism34,ism56 * endem2 COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h * sa2 added rmt COMMON/abmass/ rme,rmmu,rmu,rmd,rms,rmt,xm(6),xmp5,xmp * sa2end * COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz * el1 COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur * endel1 COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc * el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch * endel2 COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/absusy/rma,rma2,rzha,rabb COMMON/abcuts/e_min(3:6),e_max(3:6),thbeam_min(3:6), & thbeam_max(3:6),thsep_min(6),thsep_max(6),rm_min(6),rm_max(6), & beamcut_min(3:6),beamcut_max(3:6),sepcut_min(6),sepcut_max(6), & rm_min2(6),rm_max2(6),pt_min(3:6),pt_max(3:6),e_cm COMMON/abinpu/rmw,rmz,rmb_run,rmc,rmc_run,rmtau,gamz,gf,s2w, & alfainv,alfas_cc,alfas_nc,alfas_h,gauwidth COMMON/abstat/ncall_eff * sa1 nella successiva riga ho messo nintmax a 10 invece che 50 PARAMETER (ndismax=50,nintmax=10,nbinmax=500,nitmax=10) * sa1end DIMENSION distr_var(ndismax) COMMON/abdist/distr_estrinf(ndismax,nintmax+1),bin_width(ndismax, & nintmax),distr_local(ndismax,nbinmax,nitmax),distr_loc_mix & (ndismax,nbinmax,nitmax),dev_local(ndismax,nbinmax,nitmax), & dev_loc_mix(ndismax,nbinmax,nitmax),tail_local(ndismax,nitmax), & tail_loc_mix(ndismax,nitmax) COMMON/abidis/ncallbin(ndismax,nbinmax,nitmax), & ncallbin_mix(ndismax,nbinmax,nitmax),nbin_number(ndismax, & nintmax),nbin_sum(ndismax,nintmax),nsubint(ndismax),ndistr, & idistr,it1,it2,init COMMON/abcdis/string(ndismax) *agg COMMON/abflat/rmaxfxn,rmaxfxn_1it,rmaxfxn_2it,rmaxfxn_cc_1it, & rmaxfxn_cc_2it,rmaxfxn_nc_1it,rmaxfxn_nc_2it,scalemax COMMON/abifla/itmx,novermax,iflat,iseed,istorvegas,istormom,iterm, & ijetset,interf COMMON/abfla2/irepeat,nevent,nflevts COMMON /abrann/ idum * sa1 cqedps DOUBLE PRECISION PLPTN INTEGER NLPTN,NPTCL * QEDPS Common Block COMMON/QPLIST/PLPTN(10,1000),NLPTN(10,1000),NPTCL cqedpsend * sa1end PARAMETER(NMXHEP=2000) COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) * sa1 integer istsav(nmxhep) * sa1end *aggend * em:esponenti COMMON/rexp/rexp5,rexp6,rexpsm * em:end c beam common/abibea/ibeam common/abxbea/x1beam,x2beam external random c beam EXTERNAL ee_4f,ee_bbvv,ee_bbmumu,ee_bbbb,ee_bbee,ee_4fm DATA ncall_eff/0/ *sa1 s= e_cm**2 *sa1end el=e_cm/2.d0 IF(isr.EQ.1)THEN x(1)=x0(1) x(2)=x0(2) x(8)=x0(3) x(9)=x0(4) x(3)=x0(5) x(4)=x0(6) x(5)=x0(7) x(6)=x0(8) x(7)=x0(9) ELSE DO i=1,7 x(i)=x0(i) ENDDO ENDIF c beam IF(ibeam.EQ.1) CALL gircee(x1beam,x2beam,random) c beam IF(isr.EQ.1)THEN x1=1.d0-x(8)**(2.d0/beta) x2=1.d0-x(9)**(2.d0/beta) IF(x1.LE.0.d0.OR.x2.LE.0.d0.OR.x1.GT.1.d0.OR.x2.GT.1.d0)THEN fxn=0.d0 RETURN ENDIF IF(x1.EQ.1.d0)THEN dx1=rlim ELSE dx1=rlim+(1.d0-x1)**(1.d0-beta/2.d0)*(-beta*(1.d0+x1)/4.d0 & +(beta**2/32.d0)*(-4.d0*(1.d0+x1)*log(1.d0-x1)+3.d0* & (1.d0+x1)*log(x1)-4.d0*log(x1)/(1.d0-x1)-5.d0-x1)) ENDIF IF(x2.EQ.1.d0)THEN dx2=rlim ELSE dx2=rlim+(1.d0-x2)**(1.d0-beta/2.d0)*(-beta*(1.d0+x2)/4.d0 & +(beta**2/32.d0)*(-4.d0*(1.d0+x2)*log(1.d0-x2)+3.d0* & (1.d0+x2)*log(x2)-4.d0*log(x2)/(1.d0-x2)-5.d0-x2)) ENDIF str_fun=dx1*dx2*4.d0/beta/beta IF(str_fun.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF if (ibeam.eq.1) then x1=x1*x1beam x2=x2*x2beam endif p1(0)=x1*el p1(1)=0.d0 p1(2)=0.d0 p2(0)=x2*el p2(1)=0.d0 p2(2)=0.d0 * sa1 IF(min(p1(0),p2(0)).LE.rme)THEN fxn=0.d0 RETURN ENDIF p1(3)=sqrt((p1(0)+rme)*(p1(0)-rme)) p2(3)=-sqrt((p2(0)+rme)*(p2(0)-rme)) do i=0,3 pboost(i)=p1(i)+p2(i) enddo s=pboost(0)**2-pboost(1)**2-pboost(2)**2-pboost(3)**2 * sa1end ELSE * sa2 if (ibeam.ne.0.or.(ibeam.eq.0.and.ncall_eff.eq.0)) then * sa2end p1(0)=x1beam*el p1(1)=0.d0 p2(0)=x2beam*el p2(1)=0.d0 p2(2)=0.d0 * sa1 IF(min(p1(0),p2(0)).LE.rme)THEN fxn=0.d0 RETURN ENDIF p1(3)=sqrt((p1(0)+rme)*(p1(0)-rme)) p2(3)=-sqrt((p2(0)+rme)*(p2(0)-rme)) do i=0,3 pboostbeam(i)=p1(i)+p2(i) enddo s=pboostbeam(0)**2-pboostbeam(1)**2-pboostbeam(2)**2 & -pboostbeam(3)**2 * sa2 endif *sa2end * sa1end * sa1 cqedps if (isr.eq.2) then *** pt isr (QEDPS) required * Q2MAX = s CALL QPGEN(Q2MAX,Q2OUT) s=q2out pboost(0)=plptn(7,nptcl) pboost(1)=plptn(4,nptcl) pboost(2)=plptn(5,nptcl) pboost(3)=plptn(6,nptcl) endif cqedpsend * sa1end ENDIF IF(x(1).GE.1.d0.OR.x(1).LE.0.d0.OR.x(2).GE. & 1.d0.OR.x(2).LE.0.d0.OR.s.LE.smin)THEN fxn=0.d0 RETURN ENDIF C Inizio if su ismallangle IF(ismallangle.EQ.0)THEN ! e+e- at large angles wrt the beam IF(iproc.GE.6.AND.iproc.LE.8 & .AND.(imix.EQ.1.OR.imix.EQ.2))THEN IF(icut.EQ.0.OR.rm_max(3).GE.e_cm)THEN estrsup1=sqrt(s)-estrinf2 IF(estrsup1.LE.estrinf1)THEN fxn=0.d0 RETURN ENDIF ELSE IF(icut.EQ.1.AND.rm_max(3).LT.e_cm)THEN IF(rm_max(3).GT.(sqrt(s)-estrinf2))THEN estrsup1=sqrt(s)-estrinf2 IF(estrsup1.LE.estrinf1)THEN fxn=0.d0 RETURN ENDIF ELSE estrsup1=rm_max(3) ENDIF ENDIF ELSE IF(icut.EQ.0.OR.rm_max(1).GE.e_cm)THEN estrsup1=sqrt(s)-estrinf2 IF(estrsup1.LE.estrinf1)THEN fxn=0.d0 RETURN ENDIF ELSE IF(icut.EQ.1.AND.rm_max(1).LT.e_cm)THEN IF(rm_max(1).GT.(sqrt(s)-estrinf2))THEN estrsup1=sqrt(s)-estrinf2 IF(estrsup1.LE.estrinf1)THEN fxn=0.d0 RETURN ENDIF ELSE estrsup1=rm_max(1) ENDIF ENDIF ENDIF C (34) and (56) moments in the lab frame: IF(ips.EQ.1.OR.ips.EQ.2)THEN ! Non trivial mapping on 34 mass CALL PHSP_INI(estrsup1,estrinf1,sepmass1low,sepmass1high, & ism34,rexpsm,rmx1,gamx1,gx1,ipr, & alfa1,alfa2,auxalfa2, & xg1_max,xg1_min,xf1_max,xf1_min,xw1_max,xw1_min) ELSE ! mass 34 flat alfa2=1.d0 auxalfa2=alfa2 alfa1=0.d0 xf1_max=estrsup1 xf1_min=estrinf1 ENDIF IF(x(1).LE.alfa1)THEN app=( & (xg1_max-xg1_min)*x(1)/alfa1+xg1_min)**(1.d0/(1.d0-rexpsm)) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(1)=sqrt(app) rj34=(xg1_max-xg1_min)/(1.d0-rexpsm)*(xm(1)**2)**rexpsm & /(2.d0*xm(1)) rj34=rj34/alfa1 ELSEIF(x(1).LE.alfa2)THEN rj34=xf1_max-xf1_min xm(1)=(x(1)-alfa1)/(1.d0-alfa1)/auxalfa2*rj34+xf1_min rj34=rj34/(1.d0-alfa1)/auxalfa2 ELSE IF(ipr.eq.0)THEN ! Fixed width app=(gamx1*rmx1*tan((xw1_max-xw1_min)*(x(1)-alfa2)/ & (1.d0-alfa1)/(1.d0-auxalfa2)+xw1_min)+rmx1**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(1)=sqrt(app) rj34=(xw1_max-xw1_min)*((xm(1)**2-rmx1**2)**2+ & (gamx1*rmx1)**2)/(2.d0*xm(1)*gamx1*rmx1) ELSE ! Running width app=(1.d0+gx1*tan((xw1_max-xw1_min)*(x(1)-alfa2)/ & (1.d0-alfa1)/(1.d0-auxalfa2)+xw1_min))/(1.d0+gx1**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(1)=rmx1*sqrt(app) rj34=(xw1_max-xw1_min)*((xm(1)**2-rmx1**2)**2 & +xm(1)**4*gx1**2)/(2.d0*xm(1)*rmx1**2*gx1) ENDIF rj34=rj34/(1.d0-alfa1)/(1.d0-auxalfa2) ENDIF C (56) mass IF(iproc.GE.6.AND.iproc.LE.8.AND.(imix.EQ.1.OR.imix.EQ.2))THEN IF(icut.EQ.0.OR.rm_max(4).GE.e_cm)THEN estrsup2=sqrt(s)-xm(1) ELSE IF(icut.EQ.1.AND.rm_max(4).LT.e_cm)THEN IF(rm_max(4).GT.(sqrt(s)-xm(1)))THEN estrsup2=sqrt(s)-xm(1) ELSE estrsup2=rm_max(4) ENDIF ENDIF ELSE IF(icut.EQ.0.OR.rm_max(6).GE.e_cm)THEN estrsup2=sqrt(s)-xm(1) ELSE IF(icut.EQ.1.AND.rm_max(6).LT.e_cm)THEN IF(rm_max(6).GT.(sqrt(s)-xm(1)))THEN estrsup2=sqrt(s)-xm(1) ELSE estrsup2=rm_max(6) ENDIF ENDIF ENDIF * el1 IF((iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51).AND.isusy.EQ.1 & .AND.(rmh+rma).LE.e_cm.AND.iha.NE.2.AND.iha.NE.4)THEN * endel1 IF((ips.EQ.1).OR.(ips.EQ.3))THEN IF(ipr.EQ.0)THEN x2_med1=atan((estrmed2**2-rmx2**2)/(gamx2*rmx2)) x2_med2=atan((estrmed2**2-rmx3**2)/(gamx3*rmx3)) x2_max=atan((estrsup2**2-rmx3**2)/(gamx3*rmx3)) rkappa=(x2_med1-x2_min)*((estrmed2**2-rmx2**2)**2+ & (gamx2*rmx2)**2)*rmx3*gamx3/((x2_max-x2_med2)* & rmx2*gamx2*((estrmed2**2-rmx3**2)**2+(gamx3*rmx3) & **2)) alfa=rkappa/(rkappa+1.d0) IF(x(2).LT.alfa)THEN app=(gamx2*rmx2*tan((x2_med1-x2_min)*x(2)/ & alfa+x2_min)+rmx2**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=sqrt(app) IF(xm(2).EQ.0.d0)THEN fxn=0.d0 RETURN ENDIF rj56=(x2_med1-x2_min)*((xm(2)**2-rmx2**2)**2+ & (gamx2*rmx2)**2)/(2.d0*xm(2)*gamx2*rmx2*alfa) ELSE app=(gamx3*rmx3*tan((x2_max-x2_med2)*(x(2)-alfa)/ & (1.d0-alfa)+x2_med2)+rmx3**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=sqrt(app) IF(xm(2).EQ.0.d0)THEN fxn=0.d0 RETURN ENDIF rj56=(x2_max-x2_med2)*((xm(2)**2-rmx3**2)**2+ & (gamx3*rmx3)**2)/(2.d0*xm(2)*gamx3*rmx3*(1.d0-alfa)) ENDIF ELSE x2_med1=atan(((1.d0+gx2**2)*estrmed2**2-rmx2**2) & /(gx2*rmx2**2)) x2_med2=atan(((1.d0+gx3**2)*estrmed2**2-rmx3**2) & /(gx3*rmx3**2)) x2_max=atan(((1.d0+gx3**2)*estrsup2**2-rmx3**2) & /(gx3*rmx3**2)) rkappa=(x2_med1-x2_min)*((estrmed2**2-rmx2**2)**2+ & (gx2*rmx2**2)**2)*rmx3**2*gx3/((x2_max-x2_med2)* & rmx2**2*gx2*((estrmed2**2-rmx3**2)**2+ & (gx3*rmx3**2)**2)) alfa=rkappa/(rkappa+1.d0) IF(x(2).LT.alfa)THEN app=(1.d0+gx2*tan((x2_med1-x2_min)*x(2)/alfa+x2_min))/ & (1.d0+gx2**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=rmx2*sqrt(app) rj56=(x2_med1-x2_min)*((xm(2)**2-rmx2**2)**2+xm(2)**4 & *gx2**2)/(2.d0*xm(2)*rmx2**2*gx2*alfa) ELSE app=(1.d0+gx3*tan((x2_max-x2_med2)*(x(2)-alfa)/ & (1.d0-alfa)+x2_med2))/(1.d0+gx3**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=rmx3*sqrt(app) rj56=(x2_max-x2_med2)*((xm(2)**2-rmx3**2)**2+xm(2)**4* & gx3**2)/(2.d0*xm(2)*rmx3**2*gx3*(1.d0-alfa)) ENDIF ENDIF !ipr ELSE rj56=estrsup2-estrinf2 xm(2)=rj56*x(2)+estrinf2 ENDIF !ips ELSE ! on if(iproc.EQ.39.... From here normal non-SUSY case IF((ips.EQ.1).OR.(ips.EQ.3))THEN ! Non trivial mapping on 56 mass CALL PHSP_INI(estrsup2,estrinf2,sepmass2low,sepmass2high, & ism56,rexpsm,rmx2,gamx2,gx2,ipr, & alfa1,alfa2,auxalfa2, & xg1_max,xg1_min,xf1_max,xf1_min,xw1_max,xw1_min) ELSE ! mass 56 flat alfa2=1.d0 auxalfa2=alfa2 alfa1=0.d0 xf1_max=estrsup2 xf1_min=estrinf2 ENDIF IF(x(2).LT.alfa1)THEN app=( & (xg1_max-xg1_min)*x(2)/alfa1+xg1_min)**(1.d0/(1.d0-rexpsm)) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=sqrt(app) rj56=(xg1_max-xg1_min)/(1.d0-rexpsm)*(xm(2)**2)**rexpsm & /(2.d0*xm(2)) rj56=rj56/alfa1 ELSEIF(x(2).LE.alfa2)THEN rj56=xf1_max-xf1_min xm(2)=(x(2)-alfa1)/(1.d0-alfa1)/auxalfa2*rj56+xf1_min rj56=rj56/(1.d0-alfa1)/auxalfa2 ELSE IF(ipr.eq.0)THEN ! Fixed width app=(gamx2*rmx2*tan((xw1_max-xw1_min)*(x(2)-alfa2)/ & (1.d0-alfa1)/(1.d0-auxalfa2)+xw1_min)+rmx2**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=sqrt(app) rj56=(xw1_max-xw1_min)*((xm(2)**2-rmx2**2)**2+ & (gamx2*rmx2)**2)/(2.d0*xm(2)*gamx2*rmx2) ELSE ! Running width app=(1.d0+gx2*tan((xw1_max-xw1_min)*(x(2)-alfa2)/ & (1.d0-alfa1)/(1.d0-auxalfa2)+xw1_min))/(1.d0+gx2**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=rmx2*sqrt(app) rj56=(xw1_max-xw1_min)*((xm(2)**2-rmx2**2)**2 & +xm(2)**4*gx2**2)/(2.d0*xm(2)*rmx2**2*gx2) ENDIF rj56=rj56/(1.d0-alfa1)/(1.d0-auxalfa2) ENDIF ENDIF app=((s-xm(1)**2-xm(2)**2)**2-4.d0*xm(1)**2*xm(2)**2)/(4.d0*s) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p34_cm=sqrt(app) c34=x(3)*2.d0-1.d0 c3=x(4)*2.d0-1.d0 ph3=x(5)*2.d0*pi c5=x(6)*2.d0-1.d0 ph5=x(7)*2.d0*pi app=(1.d0-c34)*(1.d0+c34) IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s34=sqrt(app) p(0,1)=sqrt(p34_cm**2+xm(1)**2) p(1,1)=p34_cm*s34 * el1 p(2,1)=0.d0 * endel1 p(3,1)=p34_cm*c34 p(0,2)=sqrt(p34_cm**2+xm(2)**2) p(1,2)=-p(1,1) * el1 p(2,2)=0.d0 * endel1 p(3,2)=-p(3,1) * (3) and (4) moment in the (34) frame: app=(xm(1)**2-xm(3)**2-xm(4)**2)**2-4.d0*(xm(3)*xm(4))**2 IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p3_34=sqrt(app)/(2.d0*xm(1)) app=(1.d0-c3)*(1.d0+c3) IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s3=sqrt(app) p(0,3)=sqrt(p3_34**2+xm(3)**2) p(1,3)=p3_34*s3*cos(ph3) p(2,3)=p3_34*s3*sin(ph3) p(3,3)=p3_34*c3 p(0,4)=sqrt(p3_34**2+xm(4)**2) p(1,4)=-p(1,3) p(2,4)=-p(2,3) p(3,4)=-p(3,3) * boost in the lab frame: p3(0)=(p(0,1)*p(0,3)+p(1,1)*p(1,3)+p(2,1)*p(2,3) & +p(3,1)*p(3,3))/xm(1) trasf=(p(0,3)+p3(0))/(xm(1)+p(0,1)) p3(1)=p(1,3)+trasf*p(1,1) p3(2)=p(2,3)+trasf*p(2,1) p3(3)=p(3,3)+trasf*p(3,1) p4(0)=(p(0,1)*p(0,4)+p(1,1)*p(1,4)+p(2,1)*p(2,4) & +p(3,1)*p(3,4))/xm(1) trasf=(p(0,4)+p4(0))/(xm(1)+p(0,1)) p4(1)=p(1,4)+trasf*p(1,1) p4(2)=p(2,4)+trasf*p(2,1) p4(3)=p(3,4)+trasf*p(3,1) * (5) and (6) moments in the (56) frame: app=(xm(2)**2-xm(5)**2-xm(6)**2)**2-4.d0*(xm(5)*xm(6))**2 IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p5_56=sqrt(app)/(2.d0*xm(2)) app=(1.d0-c5)*(1.d0+c5) IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s5=sqrt(app) p(0,5)=sqrt(p5_56**2+xm(5)**2) p(1,5)=p5_56*s5*cos(ph5) p(2,5)=p5_56*s5*sin(ph5) p(3,5)=p5_56*c5 p(0,6)=sqrt(p5_56**2+xm(6)**2) p(1,6)=-p(1,5) p(2,6)=-p(2,5) p(3,6)=-p(3,5) * (5) and (6) moments in the lab frame: p5(0)=(p(0,2)*p(0,5)+p(1,2)*p(1,5)+p(2,2)*p(2,5) & +p(3,2)*p(3,5))/xm(2) trasf=(p(0,5)+p5(0))/(xm(2)+p(0,2)) p5(1)=p(1,5)+trasf*p(1,2) p5(2)=p(2,5)+trasf*p(2,2) p5(3)=p(3,5)+trasf*p(3,2) p6(0)=(p(0,2)*p(0,6)+p(1,2)*p(1,6)+p(2,2)*p(2,6) & +p(3,2)*p(3,6))/xm(2) trasf=(p(0,6)+p6(0))/(xm(2)+p(0,2)) p6(1)=p(1,6)+trasf*p(1,2) p6(2)=p(2,6)+trasf*p(2,2) p6(3)=p(3,6)+trasf*p(3,2) fxn=4.d0*p3_34*p5_56*p34_cm*(pi)**3*rj34*rj56/sqrt(s) ELSE ! at least e- at small angle wrt the beam cee IF (iproc.Eq.7.AND.(imix.EQ.1.OR.imix.EQ.2))THEN xm(6)=rme * el1 xm(4)=0.d0 * endel1 ELSEIF (iproc.eq.7.and.(imix.lt.0)) then * el1 xm(6)=0.d0 * endel1 xm(4)=rme ENDIF ceeend estrsup1=sqrt(s)-xm(3) estrinf1=xm(4)+xm(5)+xm(6) IF(estrsup1.LE.estrinf1)THEN fxn=0.d0 RETURN ENDIF C (3) and (456) moments in the lab frame: rj456=estrsup1-estrinf1 xm(1)=x(1)*rj456+estrinf1 estrsup2=xm(1)-xm(4) estrinf2=xm(5)+xm(6) IF(ips.EQ.3)THEN ! Non trivial mapping on 56 mass CALL PHSP_INI(estrsup2,estrinf2,sepmass2low,sepmass2high, & ism56,rexpsm,rmx2,gamx2,gx2,ipr, & alfa1,alfa2,auxalfa2, & xg1_max,xg1_min,xf1_max,xf1_min,xw1_max,xw1_min) ELSE ! mass 56 flat alfa2=1.d0 auxalfa2=alfa2 alfa1=0.d0 xf1_max=estrsup2 xf1_min=estrinf2 ENDIF IF(x(2).LT.alfa1)THEN app=( & (xg1_max-xg1_min)*x(2)/alfa1+xg1_min)**(1.d0/(1.d0-rexpsm)) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=sqrt(app) rj56=(xg1_max-xg1_min)/(1.d0-rexpsm)*(xm(2)**2)**rexpsm & /(2.d0*xm(2)) rj56=rj56/alfa1 ELSEIF(x(2).LE.alfa2)THEN rj56=xf1_max-xf1_min xm(2)=(x(2)-alfa1)/(1.d0-alfa1)/auxalfa2*rj56+xf1_min rj56=rj56/(1.d0-alfa1)/auxalfa2 ELSE IF(ipr.eq.0)THEN ! Fixed width app=(gamx2*rmx2*tan((xw1_max-xw1_min)*(x(2)-alfa2)/ & (1.d0-alfa1)/(1.d0-auxalfa2)+xw1_min)+rmx2**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=sqrt(app) rj56=(xw1_max-xw1_min)*((xm(2)**2-rmx2**2)**2+ & (gamx2*rmx2)**2)/(2.d0*xm(2)*gamx2*rmx2) ELSE ! Running width app=(1.d0+gx2*tan((xw1_max-xw1_min)*(x(2)-alfa2)/ & (1.d0-alfa1)/(1.d0-auxalfa2)+xw1_min))/(1.d0+gx2**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(2)=rmx2*sqrt(app) rj56=(xw1_max-xw1_min)*((xm(2)**2-rmx2**2)**2 & +xm(2)**4*gx2**2)/(2.d0*xm(2)*rmx2**2*gx2) ENDIF rj56=rj56/(1.d0-alfa1)/(1.d0-auxalfa2) ENDIF * * IF(ips.EQ.2)THEN * IF(ipr.EQ.0)THEN * x2_min=atan((estrinf2**2-rmx2**2)/(gamx2*rmx2)) * x2_max=atan((estrsup2**2-rmx2**2)/(gamx2*rmx2)) * app=(gamx2*rmx2*tan((x2_max-x2_min)*x(2)+x2_min)+rmx2**2) * IF(app.LE.0.d0)THEN * fxn=0.d0 * RETURN * ENDIF * xm(2)=sqrt(app) * IF(xm(2).EQ.0.d0)THEN * fxn=0.d0 * RETURN * ENDIF * rj56=(x2_max-x2_min)*((xm(2)**2-rmx2**2)**2+ * & (gamx2*rmx2)**2)/(2.d0*xm(2)*gamx2*rmx2) * ELSE * x2_min=atan(((1.d0+gx2**2)*estrinf2**2-rmx2**2) * & /(gx2*rmx2**2)) * x2_max=atan(((1.d0+gx2**2)*estrsup2**2-rmx2**2) * & /(gx2*rmx2**2)) * app=(1.d0+gx2*tan((x2_max-x2_min)*x(2)+x2_min))/ * & (1.d0+gx2**2) * IF(app.LE.0.d0)THEN * fxn=0.d0 * RETURN * ENDIF * xm(2)=rmx2*sqrt(app) * rj56=(x2_max-x2_min)*((xm(2)**2-rmx2**2)**2+xm(2)**4*gx2**2) * & /(2.d0*xm(2)*rmx2**2*gx2) * ENDIF * ELSE * rj56=estrsup2-estrinf2 * xm(2)=rj56*x(2)+estrinf2 * ENDIF * app=(s**2+2.d0*rme**4-4.d0*s*rme**2-2.d0*rme**4) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF rlsab=sqrt(app) app=(s**2+xm(1)**4+xm(3)**4-2.d0*s*(xm(1)**2+xm(3)**2)- & 2.d0*xm(1)**2*xm(3)**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF rls34=sqrt(app) app=app/(4.d0*s) p456_cm=sqrt(app) C Uso t3 = (p3-p2)^2 al posto di cos3 e passo al logaritmo t3m=rme**2+xm(1)**2-(1.d0/(2.d0*s))*(s*(s+xm(1)**2-xm(3)**2)+ & rlsab*rls34) IF(t3m.EQ.0.d0)THEN fxn=0.d0 RETURN ENDIF t3p=(rme**2-xm(1)**2)*(rme**2-xm(3)**2)+(1.d0/s)*(xm(1)**2- & xm(3)**2)*(xm(1)**2*rme**2-rme**2*xm(3)**2) t3p=t3p/t3m IF((t3m.ge.0.d0).or.(t3p.ge.0.d0))THEN fxn=0.d0 RETURN ENDIF t456_log=log((-t3m)/(-t3p))*x(3)-log(-t3m) t456=-exp(-t456_log) c456=t456-rme**2-xm(1)**2+sqrt(s)*sqrt(p456_cm**2+xm(1)**2) c456=c456/(sqrt(s-4.d0*rme**2)*p456_cm) IF(c456.LT.-1.d0.OR.c456.GT.1.d0)THEN fxn=0.d0 RETURN ENDIF rjc456=((-t456)/(sqrt(s-4.d0*rme**2)*p456_cm))* & log((-t3m)/(-t3p)) C posso costruire p3 3 p456 nel cm app=(1.d0-c456)*(1.d0+c456) IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s456=sqrt(app) p(0,1)=sqrt(p456_cm**2+xm(1)**2) p(1,1)=p456_cm*s456 p(2,1)=0.d0 p(3,1)=p456_cm*c456 p3(0)=sqrt(p456_cm**2+xm(3)**2) p3(1)=-p(1,1) p3(2)=-p(2,1) p3(3)=-p(3,1) IF(ismallangle.EQ.1)THEN ! only e- at small angle wrt the beam C costruisco p4 nel cm 456 ph4=x(5)*2.d0*pi c4=2.d0*x(4)-1.d0 rjc4=2.d0 app=(1.d0-c4)*(1.d0+c4) IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s4=sqrt(app) app=((xm(1)**2-xm(2)**2-xm(4)**2)**2-4.d0*xm(2)**2*xm(4)**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p4_456=sqrt(app)/(2.d0*xm(1)) e4_456=(xm(1)**2-xm(2)**2+xm(4)**2)/xm(1)/2.d0 p4_456x=p4_456*s4*cos(ph4) p4_456y=p4_456*s4*sin(ph4) p4_456z=p4_456*c4 C Porto p4_456 nel cm: messo in p4(i) esave=e4_456 p4(0)=(esave*p(0,1)+p4_456x*p(1,1)+p4_456y*p(2,1) & +p4_456z*p(3,1))/xm(1) trasf=(esave+p4(0))/(xm(1)+p(0,1)) p4(1)=p4_456x+trasf*p(1,1) p4(2)=p4_456y+trasf*p(2,1) p4(3)=p4_456z+trasf*p(3,1) C Costruisco p56=p456-p4 DO i=0,3 p(i,2)=p(i,1)-p4(i) ENDDO C Calcolo (p1-p4)^2. NON USO p1(i) i=0,3 che contiene ISR se presente * el1 elcm = sqrt(s/4.d0) p1cm = sqrt(s/4.d0-rme**2) t14=rme*rme+xm(4)*xm(4)-2.d0*elcm *p4(0) & +2.d0*p1cm*p4(3) * endel1 C Porto p2-p3 nel cm di 56 ed estraggo angoli: messo in p(i,3) C NON USO p2(i) i=0,3 che contiene ISR se presente esave=(elcm-p3(0)) p(0,3)=(esave*p(0,2)-(-p3(1))*p(1,2) & -(-p3(2))*p(2,2)-(-p1cm-p3(3))*p(3,2))/xm(2) trasf=(esave+p(0,3))/(xm(2)+p(0,2)) p(1,3)=(-p3(1))-trasf*p(1,2) p(2,3)=(-p3(2))-trasf*p(2,2) p(3,3)=(-p1cm-p3(3))-trasf*p(3,2) p23_56mod= sqrt(p(1,3)*p(1,3)+p(2,3)*p(2,3)+p(3,3)*p(3,3)) crot=p(3,3)/p23_56mod srot=sqrt((1.d0-crot)*(1.d0+crot)) C check C test_t456=p(0,3)*p(0,3)-p(1,3)*p(1,3)-p(2,3)*p(2,3)-p(3,3)*p(3,3) C write(6,*) 't456_56=',test_t456 C endcheck IF(srot.gt.0.d0)THEN cphrot=p(1,3)/srot/p23_56mod IF(cphrot.GT.1.d0) THEN cphrot=1.d0 sphrot=0.d0 ELSEIF(cphrot.LT.-1.d0) THEN cphrot=-1.d0 sphrot=0.d0 ELSE qua_app=cphrot qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) sphrot=qua_app IF(p(2,3).LT.0.d0)THEN sphrot=-sphrot ENDIF ENDIF ELSE cphrot=1.d0 sphrot=0.d0 ENDIF app=((xm(2)**2-xm(5)**2-xm(6)**2)**2-4.d0*xm(5)**2*xm(6)**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p5_56=sqrt(app)/(2.d0*xm(2)) p(0,5)=(xm(2)*xm(2)+xm(5)*xm(5)-xm(6)*xm(6))/2.d0/xm(2) p(0,6)=xm(2)-p(0,5) C C NB: t puo' essere >0 !!!!!!! C IF(x(6).GT.0.5d0)THEN C Assumo che c5_56 sia >0, uso (p2-p3-p5)^2-m5^2 come variabile t5app=t456+xm(5)**2-2.d0*(p(0,3)*p(0,5)+p23_56mod*p5_56) C t5p=t5(cos5=1) t5p=((t456-xm(5)**2)*(t14-xm(6)**2) & +(xm(5)**2-t456+t14-xm(6)**2)*(xm(5)**2*t14-t456*xm(6)**2) & /xm(2)**2)/t5app-xm(5)**2 C t5m=t5(cos5=0) t5m=t456-2.d0*p(0,3)*p(0,5) realx=2.d0*x(6)-1.d0 * el1 IF((t5p.GT.0.d0).OR.(t5m.GT.0.d0).OR.(rexp5.EQ.0.d0))THEN * endel1 t5=-(realx*(-t5p)+(1.d0-realx)*(-t5m)) rjc5=-((-t5p)-(-t5m))/p23_56mod/p5_56 ELSEIF(rexp5.EQ.1.d0)THEN t5=-EXP(realx*LOG(-t5p)+(1.d0-realx)*LOG(-t5m)) rjc5=-(LOG(-t5p)-LOG(-t5m))/p23_56mod/p5_56 rjc5=rjc5*(-t5) ELSE t5=-(realx*(-t5p)**(1.d0-rexp5) & +(1.d0-realx)*(-t5m)**(1.d0-rexp5))**(1.d0/(1.d0-rexp5)) rjc5=-((-t5p)**(1.d0-rexp5) & -(-t5m)**(1.d0-rexp5))/(1.d0-rexp5)/p23_56mod/p5_56 rjc5=rjc5*(-t5)**rexp5 ENDIF c5= (t5-t456+2.d0*p(0,3)*p(0,5))/p23_56mod/p5_56/2.d0 * el1 IF(abs(c5).GT.1.d0)THEN * endel1 fxn=0.d0 RETURN ENDIF s5=sqrt((1.d0-c5)*(1.d0+c5)) ELSE C Assumo che c5_56 sia <0, uso (p2-p3-p6)^2-m6^2 come variabile t6app=t456+xm(6)**2-2.d0*(p(0,3)*p(0,6)+p23_56mod*p5_56) C t6p=t6(cos5=-1) t6p=((t456-xm(6)**2)*(t14-xm(5)**2) & +(xm(6)**2-t456+t14-xm(5)**2)*(xm(6)**2*t14-t456*xm(5)**2) & /xm(2)**2)/t6app-xm(6)**2 C t6m=t6(cos5=0) t6m=t456-2.d0*p(0,3)*p(0,6) realx=2.d0*x(6) IF((t6p.GT.0.d0).OR.(t6m.GT.0.d0).OR.(rexp6.EQ.0.d0))THEN t6=-(realx*(-t6p)+(1.d0-realx)*(-t6m)) rjc5=-((-t6p)-(-t6m))/p23_56mod/p5_56 ELSEIF(rexp6.EQ.1.d0)THEN t6=-EXP(realx*LOG(-t6p)+(1.d0-realx)*LOG(-t6m)) rjc5=-(LOG(-t6p)-LOG(-t6m))/p23_56mod/p5_56 rjc5=rjc5*(-t6) ELSE t6=-(realx*(-t6p)**(1.d0-rexp6) & +(1.d0-realx)*(-t6m)**(1.d0-rexp6))**(1.d0/(1.d0-rexp6)) rjc5=-((-t6p)**(1.d0-rexp6) & -(-t6m)**(1.d0-rexp6))/(1.d0-rexp6)/p23_56mod/p5_56 rjc5=rjc5*(-t6)**rexp6 ENDIF c5= -(t6-t456+2.d0*p(0,3)*p(0,6))/p23_56mod/p5_56/2.d0 * el1 IF(abs(c5).GT.1.d0)THEN * endel1 fxn=0.d0 RETURN ENDIF s5=sqrt((1.d0-c5)*(1.d0+c5)) ENDIF C genero p5 ph5=x(7)*2.d0*pi p(1,5)=p5_56*s5*cos(ph5) p(2,5)=p5_56*s5*sin(ph5) p(3,5)=p5_56*c5 C Ruoto p5 p5(1)=cphrot*crot*p(1,5)-sphrot*p(2,5) & +cphrot*srot*p(3,5) p5(2)=sphrot*crot*p(1,5)+cphrot*p(2,5) & +sphrot*srot*p(3,5) p5(3)=-srot*p(1,5)+crot*p(3,5) C Porto p5 nel cm esave=p(0,5) p5(0)=(esave*p(0,2)+p5(1)*p(1,2)+p5(2)*p(2,2) & +p5(3)*p(3,2))/xm(2) trasf=(esave+p5(0))/(xm(2)+p(0,2)) p5(1)=p5(1)+trasf*p(1,2) p5(2)=p5(2)+trasf*p(2,2) p5(3)=p5(3)+trasf*p(3,2) DO i=0,3 p6(i)=p(i,2)-p5(i) ENDDO ELSE ! both e+e- at small angles wrt the beam C Porto p1 nel cm456: messo in p1_456(i) * el1 elcm = sqrt(s/4.d0) p1cm = sqrt(s/4.d0-rme**2) * endel1 esave=elcm p1_456(0)=(esave*p(0,1)-p1cm*p(3,1))/xm(1) trasf=(esave+p1_456(0))/(xm(1)+p(0,1)) p1_456(1)=-trasf*p(1,1) p1_456(2)=-trasf*p(2,1) p1_456(3)=p1cm-trasf*p(3,1) C estraggo angoli C Per come abbiamo definito p(i,1) sphrot=0 e cphrot=-1 p1_456mod=sqrt(p1_456(1)*p1_456(1) & +p1_456(2)*p1_456(2) +p1_456(3)*p1_456(3)) crot4=p1_456(3)/p1_456mod IF(crot4.gt.1.d0) crot4=1.d0 IF(crot4.lt.-1.d0) crot4=-1.d0 qua_app=crot4 qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) srot4=qua_app app=((xm(1)**2-xm(2)**2-xm(4)**2)**2-4.d0*xm(2)**2*xm(4)**2) C Modulo impulso ed energia di p4 in cm 456 IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p4_456=sqrt(app)/(2.d0*xm(1)) e4_456=(xm(1)*xm(1)+xm(4)*xm(4)-xm(2)*xm(2))/xm(1)/2.d0 * el1 t14m=rme**2+xm(4)**2-2.d0*(e4_456*p1_456(0) & +p4_456*p1_456mod) * endel1 t14p=((rme**2-xm(4)**2)*(t456-xm(2)**2) & +(xm(4)**2-rme**2+t456-xm(2)**2)* & (xm(4)**2*t456-rme**2*xm(2)**2)/xm(1)**2)/t14m t14=-EXP(x(4)*LOG(-t14p)+(1.d0-x(4))*LOG(-t14m)) rjc4=-(LOG(-t14p)-LOG(-t14m))/p1_456mod/p4_456/2.d0 rjc4=rjc4*(-t14) C costruisco p4 * el1 c4=(t14-rme**2-xm(4)**2+2.d0*e4_456*p1_456(0)) & /p1_456mod/p4_456/2.d0 * endel1 app=(1.d0-c4)*(1.d0+c4) IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF qua_app=c4 qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) s4=qua_app ph4=x(5)*2.d0*pi p4_456x=p4_456*s4*cos(ph4) p4_456y=p4_456*s4*sin(ph4) p4_456z=p4_456*c4 C Ruoto p4_456 C Per come abbiamo definito p(i,1) sphrot4=0 e cphrot4=-1 p4(1)=-crot4*p4_456x-srot4*p4_456z p4(2)=-p4_456y p4(3)=-srot4*p4_456x+crot4*p4_456z C Porto p4_456 nel cm: messo in p4(i) esave=e4_456 p4(0)=(esave*p(0,1)+p4(1)*p(1,1)+p4(2)*p(2,1) & +p4(3)*p(3,1))/xm(1) trasf=(esave+p4(0))/(xm(1)+p(0,1)) p4(1)=p4(1)+trasf*p(1,1) p4(2)=p4(2)+trasf*p(2,1) p4(3)=p4(3)+trasf*p(3,1) C Costruisco p56=p456-p4 DO i=0,3 p(i,2)=p(i,1)-p4(i) ENDDO IF(t456.GT.t14)THEN C Porto p2-p3 nel cm di 56 ed estraggo angoli: messo in p(i,3) C NON USO p2(i) i=0,3 che contiene ISR se presente esave=(elcm-p3(0)) p(0,3)=(esave*p(0,2)-(-p3(1))*p(1,2) & -(-p3(2))*p(2,2)-(-p1cm-p3(3))*p(3,2))/xm(2) trasf=(esave+p(0,3))/(xm(2)+p(0,2)) p(1,3)=(-p3(1))-trasf*p(1,2) p(2,3)=(-p3(2))-trasf*p(2,2) p(3,3)=(-p1cm-p3(3))-trasf*p(3,2) p23_56mod= sqrt(p(1,3)*p(1,3)+p(2,3)*p(2,3)+p(3,3)*p(3,3)) crot=p(3,3)/p23_56mod IF(crot.gt.1.d0) crot=1.d0 IF(crot.lt.-1.d0) crot=-1.d0 qua_app=crot qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) srot=qua_app IF(srot.gt.0.d0)THEN cphrot=p(1,3)/srot/p23_56mod IF(cphrot.GT.1.d0) THEN cphrot=1.d0 sphrot=0.d0 ELSEIF(cphrot.LT.-1.d0) THEN cphrot=-1.d0 sphrot=0.d0 ELSE qua_app=cphrot qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) sphrot=qua_app IF(p(2,3).LT.0.d0)THEN sphrot=-sphrot ENDIF ENDIF ELSE cphrot=1.d0 sphrot=0.d0 ENDIF app=((xm(2)**2-xm(5)**2-xm(6)**2)**2 & -4.d0*xm(5)**2*xm(6)**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p5_56=sqrt(app)/(2.d0*xm(2)) p(0,5)=(xm(2)*xm(2)+xm(5)*xm(5)-xm(6)*xm(6))/2.d0/xm(2) p(0,6)=xm(2)-p(0,5) C C NB: t puo' essere >0 !!!!!!! C IF(x(6).GT.0.5d0)THEN C Assumo che c5_56 sia >0, uso (p2-p3-p5)^2-m5^2 come variabile t5app=t456+xm(5)**2-2.d0*(p(0,3)*p(0,5)+p23_56mod*p5_56) C t5p=t5(cos5=1) t5p=((t456-xm(5)**2)*(t14-xm(6)**2) & +(xm(5)**2-t456+t14-xm(6)**2)*(xm(5)**2*t14 & -t456*xm(6)**2)/xm(2)**2)/t5app-xm(5)**2 realx=2.d0*x(6)-1.d0 * el1 IF((t5p.GT.0.d0).OR.(t5m.GT.0.d0).OR.(rexp5.EQ.0.d0)) & THEN * endel1 t5=-(realx*(-t5p)+(1.d0-realx)*(-t5m)) rjc5=-((-t5p)-(-t5m))/p23_56mod/p5_56 ELSEIF(rexp5.EQ.1.d0)THEN t5=-EXP(realx*LOG(-t5p)+(1.d0-realx)*LOG(-t5m)) rjc5=-(LOG(-t5p)-LOG(-t5m))/p23_56mod/p5_56 rjc5=rjc5*(-t5) ELSE t5=-(realx*(-t5p)**(1.d0-rexp5) & +(1.d0-realx)*(-t5m)**(1.d0-rexp5)) & **(1.d0/(1.d0-rexp5)) rjc5=-((-t5p)**(1.d0-rexp5) & -(-t5m)**(1.d0-rexp5))/(1.d0-rexp5)/p23_56mod/p5_56 rjc5=rjc5*(-t5)**rexp5 ENDIF c5= (t5-t456+2.d0*p(0,3)*p(0,5))/p23_56mod/p5_56/2.d0 * el1 IF(abs(c5).GT.1.d0)THEN * endel1 fxn=0.d0 RETURN ENDIF s5=sqrt((1.d0-c5)*(1.d0+c5)) ELSE C Assumo che c5_56 sia <0, uso (p2-p3-p6)^2-m6^2 come variabile t6app=t456+xm(6)**2-2.d0*(p(0,3)*p(0,6)+p23_56mod*p5_56) C t6p=t6(cos5=-1) t6p=((t456-xm(6)**2)*(t14-xm(5)**2) & +(xm(6)**2-t456+t14-xm(5)**2)*(xm(6)**2*t14 & -t456*xm(5)**2)/xm(2)**2)/t6app-xm(6)**2 C t6m=t6(cos5=0) t6m=t456-2.d0*p(0,3)*p(0,6) realx=2.d0*x(6) * el1 IF((t6p.GT.0.d0).OR.(t6m.GT.0.d0).OR.(rexp6.EQ.0.d0)) & THEN * endel1 t6=-(realx*(-t6p)+(1.d0-realx)*(-t6m)) rjc5=-((-t6p)-(-t6m))/p23_56mod/p5_56 ELSEIF(rexp6.EQ.1.d0)THEN t6=-EXP(realx*LOG(-t6p)+(1.d0-realx)*LOG(-t6m)) rjc5=-(LOG(-t6p)-LOG(-t6m))/p23_56mod/p5_56 rjc5=rjc5*(-t6) ELSE t6=-(realx*(-t6p)**(1.d0-rexp6) & +(1.d0-realx)*(-t6m)**(1.d0-rexp6)) & **(1.d0/(1.d0-rexp6)) rjc5=-((-t6p)**(1.d0-rexp6) & -(-t6m)**(1.d0-rexp6))/(1.d0-rexp6)/p23_56mod/p5_56 rjc5=rjc5*(-t6)**rexp6 ENDIF c5= -(t6-t456+2.d0*p(0,3)*p(0,6))/p23_56mod/p5_56/2.d0 * el1 IF(abs(c5).GT.1.d0)THEN * endel1 fxn=0.d0 RETURN ENDIF s5=sqrt((1.d0-c5)*(1.d0+c5)) ENDIF ELSE ! t14 > t456 uso (p1-p4) come asse C Porto p1-p4 nel cm di 56 ed estraggo angoli: messo in p(i,4) C NON USO p1(i) i=0,3 che contiene ISR se presente esave=(elcm-p4(0)) p(0,4)=(esave*p(0,2)-(-p4(1))*p(1,2) & -(-p4(2))*p(2,2)-(p1cm-p4(3))*p(3,2))/xm(2) trasf=(esave+p(0,4))/(xm(2)+p(0,2)) p(1,4)=(-p4(1))-trasf*p(1,2) p(2,4)=(-p4(2))-trasf*p(2,2) p(3,4)=(p1cm-p4(3))-trasf*p(3,2) p14_56mod= sqrt(p(1,4)*p(1,4)+p(2,4)*p(2,4)+p(3,4)*p(3,4)) crot=p(3,4)/p14_56mod C delcrot=1+crot IF(crot.gt.1.d0) crot=1.d0 IF(crot.lt.-1.d0) crot=-1.d0 qua_app=crot qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) srot=qua_app IF(srot.gt.0.d0)THEN cphrot=p(1,4)/srot/p14_56mod IF(cphrot.GT.1.d0) THEN cphrot=1.d0 sphrot=0.d0 ELSEIF(cphrot.LT.-1.d0) THEN cphrot=-1.d0 sphrot=0.d0 ELSE qua_app=cphrot qua_app=sqrt((1.d0-qua_app)*(1.d0+qua_app)) sphrot=qua_app IF(p(2,3).LT.0.d0)THEN sphrot=-sphrot ENDIF ENDIF ELSE cphrot=1.d0 sphrot=0.d0 ENDIF app=((xm(2)**2-xm(5)**2-xm(6)**2)**2 & -4.d0*xm(5)**2*xm(6)**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF p5_56=sqrt(app)/(2.d0*xm(2)) p(0,5)=(xm(2)*xm(2)+xm(5)*xm(5)-xm(6)*xm(6))/2.d0/xm(2) p(0,6)=xm(2)-p(0,5) C C NB: t puo' essere >0 !!!!!!! C IF(x(6).GT.0.5d0)THEN C Assumo che c5_56 sia >0, uso (p1-p4-p5)^2-m5^2 come variabile t5app=t14+xm(5)**2-2.d0*(p(0,4)*p(0,5)+p14_56mod*p5_56) C t5p=t5(cos5=1) t5p=((t14-xm(5)**2)*(t456-xm(6)**2) & +(xm(5)**2-t14+t456-xm(6)**2) & *(xm(5)**2*t456-t14*xm(6)**2) & /xm(2)**2)/t5app-xm(5)**2 C t5m=t5(cos5=0) t5m=t14-2.d0*p(0,4)*p(0,5) realx=2.d0*x(6)-1.d0 * el1 IF((t5p.GT.0.d0).OR.(t5m.GT.0.d0) & .OR.(rexp5.EQ.0.d0))THEN * endel1 t5=-(realx*(-t5p)+(1.d0-realx)*(-t5m)) rjc5=-((-t5p)-(-t5m))/p14_56mod/p5_56 ELSEIF(rexp5.EQ.1.d0)THEN t5=-EXP(realx*LOG(-t5p)+(1.d0-realx)*LOG(-t5m)) rjc5=-(LOG(-t5p)-LOG(-t5m))/p14_56mod/p5_56 rjc5=rjc5*(-t5) ELSE t5=-(realx*(-t5p)**(1.d0-rexp5) & +(1.d0-realx)*(-t5m)**(1.d0-rexp5)) & **(1.d0/(1.d0-rexp5)) rjc5=-((-t5p)**(1.d0-rexp5) & -(-t5m)**(1.d0-rexp5))/(1.d0-rexp5)/p14_56mod/p5_56 rjc5=rjc5*(-t5)**rexp5 ENDIF c5= (t5-t14+2.d0*p(0,4)*p(0,5))/p14_56mod/p5_56/2.d0 * el1 IF(abs(c5).GT.1.d0)THEN * endel1 fxn=0.d0 RETURN ENDIF s5=sqrt((1.d0-c5)*(1.d0+c5)) ELSE C Assumo che c5_56 sia <0, uso (p2-p3-p6)^2-m6^2 come variabile t6app=t14+xm(6)**2-2.d0*(p(0,4)*p(0,6)+p14_56mod*p5_56) C t6p=t6(cos5=-1) t6p=((t14-xm(6)**2)*(t456-xm(5)**2) & +(xm(6)**2-t14+t456-xm(5)**2) & *(xm(6)**2*t456-t14*xm(5)**2) & /xm(2)**2)/t6app-xm(6)**2 C t6m=t6(cos5=0) t6m=t14-2.d0*p(0,4)*p(0,6) realx=2.d0*x(6) * el1 IF((t6p.GT.0.d0).OR.(t6m.GT.0.d0) & .OR.(rexp6.EQ.0.d0))THEN * endel1 t6=-(realx*(-t6p)+(1.d0-realx)*(-t6m)) rjc5=-((-t6p)-(-t6m))/p14_56mod/p5_56 ELSEIF(rexp6.EQ.1.d0)THEN t6=-EXP(realx*LOG(-t6p)+(1.d0-realx)*LOG(-t6m)) rjc5=-(LOG(-t6p)-LOG(-t6m))/p14_56mod/p5_56 rjc5=rjc5*(-t6) ELSE t6=-(realx*(-t6p)**(1.d0-rexp6) & +(1.d0-realx)*(-t6m)**(1.d0-rexp6)) & **(1.d0/(1.d0-rexp6)) rjc5=-((-t6p)**(1.d0-rexp6) & -(-t6m)**(1.d0-rexp6))/(1.d0-rexp6)/p14_56mod/p5_56 rjc5=rjc5*(-t6)**rexp6 ENDIF c5= -(t6-t14+2.d0*p(0,4)*p(0,6))/p14_56mod/p5_56/2.d0 * el1 IF(abs(c5).GT.1.d0)THEN * endel1 fxn=0.d0 RETURN ENDIF s5=sqrt((1.d0-c5)*(1.d0+c5)) ENDIF ENDIF ! Fine if su t456 < t14 C genero p5 ph5=x(7)*2.d0*pi p(1,5)=p5_56*s5*cos(ph5) p(2,5)=p5_56*s5*sin(ph5) p(3,5)=p5_56*c5 C Ruoto p5 p5(1)=cphrot*crot*p(1,5)-sphrot*p(2,5) & +cphrot*srot*p(3,5) p5(2)=sphrot*crot*p(1,5)+cphrot*p(2,5) & +sphrot*srot*p(3,5) p5(3)=-srot*p(1,5)+crot*p(3,5) C Porto p5 nel cm esave=p(0,5) p5(0)=(esave*p(0,2)+p5(1)*p(1,2)+p5(2)*p(2,2) & +p5(3)*p(3,2))/xm(2) trasf=(esave+p5(0))/(xm(2)+p(0,2)) p5(1)=p5(1)+trasf*p(1,2) p5(2)=p5(2)+trasf*p(2,2) p5(3)=p5(3)+trasf*p(3,2) DO i=0,3 p6(i)=p(i,2)-p5(i) ENDDO ENDIF ! Fine if su ismallangle =1 o 2 fxn=4.d0*p4_456*p5_56*p456_cm*(pi)**3*rj456*rj56/sqrt(s) fxn=fxn*rjc456*rjc4*rjc5/8.d0 ENDIF ! Fine if su ismallangle >0 * sa1 c c* boost to collider frame c cc beam cc IF(isr.EQ.1)THEN c IF(isr.EQ.1.or.ibeam.eq.1)THEN cc beam c p3(0)=gcm*(p3(0)+bcm*p3(3)) c p3(1)=p3(1) c p3(2)=p3(2) c p3(3)=p3(3)/gcm+bcm*p3(0) c p4(0)=gcm*(p4(0)+bcm*p4(3)) c p4(1)=p4(1) c p4(2)=p4(2) c p4(3)=p4(3)/gcm+bcm*p4(0) c p5(0)=gcm*(p5(0)+bcm*p5(3)) c p5(1)=p5(1) c p5(2)=p5(2) c p5(3)=p5(3)/gcm+bcm*p5(0) c p6(0)=gcm*(p6(0)+bcm*p6(3)) c p6(1)=p6(1) c p6(2)=p6(2) c p6(3)=p6(3)/gcm+bcm*p6(0) c ENDIF * rotazioni per dare un angolo fi (solo per distribuzioni,generazione eventi..) fi=ran(iseed)*2.d0*pi aux=p3(1)*cos(fi)-p3(2)*sin(fi) p3(2)=p3(1)*sin(fi)+p3(2)*cos(fi) p3(1)=aux aux=p4(1)*cos(fi)-p4(2)*sin(fi) p4(2)=p4(1)*sin(fi)+p4(2)*cos(fi) p4(1)=aux aux=p5(1)*cos(fi)-p5(2)*sin(fi) p5(2)=p5(1)*sin(fi)+p5(2)*cos(fi) p5(1)=aux aux=p6(1)*cos(fi)-p6(2)*sin(fi) p6(2)=p6(1)*sin(fi)+p6(2)*cos(fi) p6(1)=aux * boost to collider frame cqedps IF(isr.ge.1.or.ibeam.eq.1)THEN if (isr.eq.2) then p1(0)=sqrt(s)/2.d0 p1(1)=0.d0 p1(2)=0.d0 IF(p1(0).LE.rme)THEN fxn=0.d0 RETURN ENDIF p1(3)=sqrt((p1(0)+rme)*(p1(0)-rme)) p2(0)=p1(0) p2(1)=0.d0 p2(2)=0.d0 p2(3)=-p1(0) call boost(p1,pboost,p1) call boost(p2,pboost,p2) endif cqedpsend if (isr.eq.1.or.isr.eq.2) then call boost(p3,pboost,p3) call boost(p4,pboost,p4) call boost(p5,pboost,p5) call boost(p6,pboost,p6) endif if (ibeam.eq.1.and.isr.ne.1) then call boost(p3,pboostbeam,p3) call boost(p4,pboostbeam,p4) call boost(p5,pboostbeam,p5) call boost(p6,pboostbeam,p6) endif ENDIF cqedpsend * sa1end * Cuts: IF (icut.EQ.1) THEN IF (iproc.GE.6.AND.iproc.LE.8.AND.(imix.EQ.1.OR.imix.EQ.2))THEN DO i=0,3 paus(i)=p4(i) p4(i)=p6(i) p6(i)=paus(i) ENDDO !i ENDIF rmod(3)=sqrt(p3(1)**2+p3(2)**2+p3(3)**2) rmod(4)=sqrt(p4(1)**2+p4(2)**2+p4(3)**2) rmod(5)=sqrt(p5(1)**2+p5(2)**2+p5(3)**2) rmod(6)=sqrt(p6(1)**2+p6(2)**2+p6(3)**2) * Energy cuts: IF(p3(0).LE.e_min(3).OR.p4(0).LE.e_min(4).OR.p5(0).LE. & e_min(5).OR.p6(0).LE.e_min(6).OR.p3(0).GE.e_max(3).OR. & p4(0).GE.e_max(4).OR.p5(0).GE.e_max(5).OR.p6(0).GE. & e_max(6))THEN fxn=0.d0 RETURN ENDIF * beam-angle cuts: IF(beamcut_min(3).NE.1.d0.OR.beamcut_min(4).NE.1.d0.OR. & beamcut_min(5).NE.1.d0.OR.beamcut_min(6).NE.1.d0.OR. & beamcut_max(3).NE.-1.d0.OR.beamcut_max(4).NE.-1.d0.OR. & beamcut_max(5).NE.-1.d0.OR.beamcut_max(6).NE.-1.d0)THEN cosbeam(3)=p3(3)/rmod(3) cosbeam(4)=p4(3)/rmod(4) cosbeam(5)=p5(3)/rmod(5) cosbeam(6)=p6(3)/rmod(6) IF(cosbeam(3).GE.beamcut_min(3).OR.cosbeam(4).GE. & beamcut_min(4).OR.cosbeam(5).GE.beamcut_min(5).OR. & cosbeam(6).GE.beamcut_min(6).OR.cosbeam(3).LE. & beamcut_max(3).OR.cosbeam(4).LE.beamcut_max(4).OR. & cosbeam(5).LE.beamcut_max(5).OR.cosbeam(6).LE. & beamcut_max(6))THEN fxn=0.d0 RETURN ENDIF ENDIF * angular separation cuts: IF(sepcut_min(1).NE.1.d0.OR.sepcut_min(2).NE.1.d0.OR. & sepcut_min(3).NE.1.d0.OR.sepcut_min(4).NE.1.d0.OR. & sepcut_min(5).NE.1.d0.OR.sepcut_min(6).NE.1.d0.OR. & sepcut_max(1).NE.-1.d0.OR.sepcut_max(2).NE.-1.d0.OR. & sepcut_max(3).NE.-1.d0.OR.sepcut_max(4).NE.-1.d0.OR. & sepcut_max(5).NE.-1.d0.OR.sepcut_max(6).NE.-1.d0)THEN cc(3,4)=(p3(1)*p4(1)+p3(2)*p4(2)+p3(3)*p4(3))/rmod(3)/rmod(4) cc(3,5)=(p3(1)*p5(1)+p3(2)*p5(2)+p3(3)*p5(3))/rmod(3)/rmod(5) cc(3,6)=(p3(1)*p6(1)+p3(2)*p6(2)+p3(3)*p6(3))/rmod(3)/rmod(6) cc(4,5)=(p4(1)*p5(1)+p4(2)*p5(2)+p4(3)*p5(3))/rmod(4)/rmod(5) cc(4,6)=(p4(1)*p6(1)+p4(2)*p6(2)+p4(3)*p6(3))/rmod(4)/rmod(6) cc(5,6)=(p5(1)*p6(1)+p5(2)*p6(2)+p5(3)*p6(3))/rmod(5)/rmod(6) IF(cc(3,4).GE.sepcut_min(1).OR.cc(3,5).GE.sepcut_min(2).OR. & cc(3,6).GE.sepcut_min(3).OR.cc(4,5).GE.sepcut_min(4).OR. & cc(4,6).GE.sepcut_min(5).OR.cc(5,6).GE.sepcut_min(6).OR. & cc(3,4).LE.sepcut_max(1).OR.cc(3,5).LE.sepcut_max(2).OR. & cc(3,6).LE.sepcut_max(3).OR.cc(4,5).LE.sepcut_max(4).OR. & cc(4,6).LE.sepcut_max(5).OR.cc(5,6).LE.sepcut_max(6))THEN fxn=0.d0 RETURN ENDIF ENDIF * invariant mass cuts: IF(rm_min(1).GT.0.d0.OR.rm_min(2).GT.0.d0.OR.rm_min(3).GT. & 0.d0.OR.rm_min(4).GT.0.d0.OR.rm_min(5).GT.0.d0.OR. & rm_min(6).GT.0.d0.OR.rm_max(1).LT.e_cm.OR.rm_max(2).LT. & e_cm.OR.rm_max(3).LT.e_cm.OR.rm_max(4).LT.e_cm.OR. & rm_max(5).LT.e_cm.OR.rm_max(6).LT.e_cm)THEN y(3,4)=xm(3)**2+xm(4)**2+2.d0*(p3(0)*p4(0)- & p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3)) y(3,5)=xm(3)**2+xm(5)**2+2.d0*(p3(0)*p5(0)- & p3(1)*p5(1)-p3(2)*p5(2)-p3(3)*p5(3)) y(3,6)=xm(3)**2+xm(6)**2+2.d0*(p3(0)*p6(0)- & p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3)) y(4,5)=xm(4)**2+xm(5)**2+2.d0*(p4(0)*p5(0)- & p4(1)*p5(1)-p4(2)*p5(2)-p4(3)*p5(3)) y(4,6)=xm(4)**2+xm(6)**2+2.d0*(p4(0)*p6(0)- & p4(1)*p6(1)-p4(2)*p6(2)-p4(3)*p6(3)) y(5,6)=xm(5)**2+xm(6)**2+2.d0*(p5(0)*p6(0)- & p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3)) IF(y(3,4).LE.rm_min2(1).OR.y(3,5).LE.rm_min2(2).OR.y(3,6). & LE.rm_min2(3).OR.y(4,5).LE.rm_min2(4).OR.y(4,6).LE. & rm_min2(5).OR.y(5,6).LE.rm_min2(6).OR.y(3,4).GE. & rm_max2(1).OR.y(3,5).GE.rm_max2(2).OR.y(3,6).GE. & rm_max2(3).OR.y(4,5).GE.rm_max2(4).OR.y(4,6).GE. & rm_max2(5).OR.y(5,6).GE.rm_max2(6))THEN fxn=0.d0 RETURN ENDIF ENDIF * Pt cuts: IF(pt_min(3).GT.0.d0.OR.pt_min(4).GT.0.d0.OR.pt_min(5).GT. & 0.d0.OR.pt_min(6).GT.0.d0.OR.pt_max(3).LT.e_cm.OR.pt_max(4). & LT.e_cm.OR.pt_max(5).LT.e_cm.OR.pt_max(6).LT.e_cm)THEN pt(3)=sqrt(p3(1)**2+p3(2)**2) pt(4)=sqrt(p4(1)**2+p4(2)**2) pt(5)=sqrt(p5(1)**2+p5(2)**2) pt(6)=sqrt(p6(1)**2+p6(2)**2) IF(pt(3).LE.pt_min(3).OR.pt(4).LE.pt_min(4).OR.pt(5).LE. & pt_min(5).OR.pt(6).LE.pt_min(6).OR.pt(3).GE.pt_max(3).OR. & pt(4).GE.pt_max(4).OR.pt(5).GE.pt_max(5).OR.pt(6).GE. & pt_max(6))THEN fxn=0.d0 RETURN ENDIF ENDIF IF (iproc.GE.6.AND.iproc.LE.8.AND.(imix.EQ.1.OR.imix.EQ.2))THEN DO i=0,3 paus(i)=p4(i) p4(i)=p6(i) p6(i)=paus(i) ENDDO !i ENDIF ENDIF !icut * weighted distributions and additional cuts : * for mixed processes exchange particles in some case IF (iproc.GE.6.AND.iproc.LE.8.AND.(imix.EQ.1.OR.imix.EQ.2))THEN DO i=0,3 paus(i)=p4(i) p4(i)=p6(i) p6(i)=paus(i) ENDDO !i ENDIF * here define additional cuts c rmod3=sqrt(p3(1)**2+p3(2)**2+p3(3)**2) c rc3=p3(3)/rmod3 c if(abs(rc3).lt.0.997d0)then c fxn=0.d0 c return c endif * here define eventual weighted distributions (or use the include file) * include 'abdis.dis' c string(1)='Distribution theta(3)' c rmod3=sqrt(p3(1)**2+p3(2)**2+p3(3)**2) c theta3= acosd(p3(3)/rmod3) c distr_var(1)=theta3 c string(2)='Distribution theta(3) fine' c distr_var(2)=theta3 c string(3)='Distribution m(ud)' c rmud2=(p5(0)+p6(0))**2-(p5(1)+p6(1))**2- c & (p5(2)+p6(2))**2-(p5(3)+p6(3))**2 c if (rmud2.lt.0.d0) then c distr_var(3)=0.d0 c else c distr_var(3)=sqrt(rmud2) c endif c string(4)='Distribution E(6)' c distr_var(4)=p6(0) * fine abdis * end weighted distributions * reexchange particles in some case IF (iproc.GE.6.AND.iproc.LE.8.AND.(imix.EQ.1.OR.imix.EQ.2))THEN DO i=0,3 paus(i)=p4(i) p4(i)=p6(i) p6(i)=paus(i) ENDDO !i ENDIF * end weighted distributions and additional cuts * ISR introduction: IF(isr.EQ.1)THEN fxn=fxn*str_fun ENDIF IF (iccnc.LE.3) THEN IF(imix.EQ.-2.or.imix.eq.-1)then if(imass.eq.0)then fxn=fxn*ee_4f(p1,p2,p3,p4,p5,p6) else fxn=fxn*ee_4fm(p1,p2,p3,p4,p5,p6) endif ELSE IF(imix.EQ.1.OR.imix.EQ.2)THEN IF(ichcj.EQ.0)THEN if(imass.eq.0)then fxn=fxn*ee_4f(p1,p2,p3,p6,p5,p4) else xmau=xm(6) xm(6)=xm(4) xm(4)=xmau fxn=fxn*ee_4fm(p1,p2,p3,p6,p5,p4) endif ELSE q3(0)=p3(0) q4(0)=p4(0) q5(0)=p5(0) q6(0)=p6(0) DO m=1,3 q3(m)=-p3(m) q4(m)=-p4(m) q5(m)=-p5(m) q6(m)=-p6(m) ENDDO !m if(imass.eq.0)then fxn=fxn*ee_4f(p1,p2,q3,q6,q5,q4) else xmau=xm(6) xm(6)=xm(4) xm(4)=xmau fxn=fxn*ee_4fm(p1,p2,q3,q6,q5,q4) endif ENDIF IF (iproc.lt.6.or.iproc.gt.8)THEN xmau=xm(4) xm(4)=xm(6) xm(6)=xmau endif ENDIF ELSE IF (iccnc.EQ.4) THEN * el1 IF (iproc.EQ.33.OR.iproc.EQ.34.OR.iproc.EQ.40.OR. & iproc.EQ.41.OR.iproc.EQ.47.OR.iproc.EQ.48) THEN IF(iproc.EQ.40.OR.iproc.EQ.41.OR.iproc.EQ.47. & OR.iproc.EQ.48)THEN fqdr=f3r fqdl=f3l zqdr=z3r zqdl=z3l ENDIF fxn=fxn*ee_bbvv(p1,p2,p3,p4,p5,p6) ELSE IF(iproc.EQ.35.OR.iproc.EQ.36.OR.iproc.EQ.38.OR. & iproc.EQ.42.OR.iproc.EQ.49.OR.iproc.EQ.44.OR. & iproc.EQ.46.OR.iproc.EQ.50.OR.iproc.EQ.53)THEN IF(iproc.EQ.42.OR.iproc.EQ.49.OR.iproc.EQ.44.OR. & iproc.EQ.46.OR.iproc.EQ.50.OR.iproc.EQ.53)THEN fqdr=f3r fqdl=f3l zqdr=z3r zqdl=z3l ENDIF fxn=fxn*ee_bbmumu(p1,p2,p3,p4,p5,p6) ELSE IF(iproc.EQ.37.OR.iproc.EQ.45.OR.iproc.EQ.52)THEN IF(iproc.EQ.45.OR.iproc.EQ.52)THEN fqdr=f3r fqdl=f3l zqdr=z3r zqdl=z3l ENDIF fxn=fxn*ee_bbee(p1,p2,p3,p4,p5,p6) ELSE IF(iproc.EQ.39.OR.iproc.EQ.43.OR.iproc.EQ.51) THEN IF(iproc.EQ.43.OR.iproc.EQ.51) THEN fqdr=f3r fqdl=f3l zqdr=z3r zqdl=z3l ENDIF fxn=fxn*ee_bbbb(p1,p2,p3,p4,p5,p6) ENDIF ENDIF * endel1 fxn=fxn*emcoupl/s/2.d0 fxn=fxn*0.38937966d+9 !sigma(pb) *agg IF(iflat.EQ.1)THEN IF((iterm.EQ.0).OR.(iterm.EQ.1.AND.init.GE.1))THEN IF(interf.EQ.0.AND.(imix.EQ.1.OR.imix.EQ.-1))THEN iter=it1 ELSE IF(interf.EQ.0.AND.imix.EQ.-2)THEN iter=it2 ELSE IF(interf.EQ.1.AND.imix.EQ.2)THEN iter=it1 ELSE IF(interf.EQ.1.AND.imix.EQ.-1)THEN iter=it2 ENDIF ENDIF IF(iter.EQ.1.AND. & ((iterm.EQ.0).OR.(iterm.EQ.1.AND.init.GE.1)))THEN rmaxfxn=max(rmaxfxn,fxn*wgt) ENDIF IF(iter.EQ.2.AND. & ((iterm.EQ.0).OR.(iterm.EQ.1.AND.init.GE.1)))THEN rmaxfxn_2it=max(rmaxfxn_2it,fxn*wgt) ENDIF IF(iter.EQ.2.AND. & ((iterm.EQ.0).OR.(iterm.EQ.1.AND.init.GE.1)))THEN IF(fxn*wgt.GT.rmaxfxn*scalemax)THEN novermax=novermax+1 ENDIF ry=scalemax*rmaxfxn*ran(iseed) IF(ry.LE.fxn*wgt)THEN * numero di eventi generati NEVHEP=NEVHEP+1 NEVENT=NEVHEP IF(iccnc.EQ.1.OR.(iccnc.EQ.3.AND. & (imix.EQ.1.OR.imix.EQ.2)))THEN IF(ichcj.EQ.0)THEN DO i=0,3 IF(i.EQ.0)j=4 IF(i.NE.0)j=i phep(j,1)=p5(i) phep(j,2)=p6(i) phep(j,3)=p3(i) phep(j,4)=p4(i) ENDDO !i phep(5,1)=xm(5) phep(5,2)=xm(6) phep(5,3)=xm(3) phep(5,4)=xm(4) ELSE DO i=0,3 IF(i.EQ.0)j=4 IF(i.NE.0)j=i phep(j,1)=p4(i) phep(j,2)=p3(i) phep(j,3)=p6(i) phep(j,4)=p5(i) ENDDO !i phep(5,1)=xm(4) phep(5,2)=xm(3) phep(5,3)=xm(6) phep(5,4)=xm(5) ENDIF ELSE IF(iccnc.EQ.3.AND.(imix.EQ.-2.OR.imix.EQ.-1))THEN DO i=0,3 IF(i.EQ.0)j=4 IF(i.NE.0)j=i phep(j,1)=p5(i) phep(j,2)=p4(i) phep(j,3)=p3(i) phep(j,4)=p6(i) ENDDO !i phep(5,1)=xm(5) phep(5,2)=xm(4) phep(5,3)=xm(3) phep(5,4)=xm(6) ELSE IF(iccnc.EQ.2.OR.iccnc.EQ.4)THEN DO i=0,3 IF(i.EQ.0)j=4 IF(i.NE.0)j=i phep(j,1)=p3(i) phep(j,2)=p4(i) phep(j,3)=p5(i) phep(j,4)=p6(i) ENDDO !i phep(5,1)=xm(3) phep(5,2)=xm(4) phep(5,3)=xm(5) phep(5,4)=xm(6) ENDIF if (isr.eq.1) then phep(4,5)=(1.d0-x1)*el * phep(1,5)=0.d0 * phep(2,5)=0.d0 phep(3,5)=phep(4,5) phep(4,6)=(1.d0-x2)*el * phep(1,6)=0.d0 * phep(2,6)=0.d0 phep(3,6)=-phep(4,6) endif *sa1 if (isr.eq.2) then l=4 do k=3,nptcl-1 c find the photons in qedps if (nlptn(1,k).eq.22) then c number the particles l=l+1 c give the momenta to hepevt common do j=1,4 phep(j,l)=plptn(3+j,k) enddo c fix particle identity and statuts code for heptv idhep(l)=22 ISTHEP(l)=1 endif enddo c give to heptv the total number of incoming particles nhep=l endif * sa1end IF(iJetset.EQ.1)THEN * JETSET partial amplitudes selected IF(iccnc.EQ.1.OR.(iccnc.EQ.3.AND. & (imix.EQ.1.OR.imix.EQ.2)))ichar=1 IF(((iccnc.EQ.2.OR.iccnc.EQ.4).AND.iid.EQ.0).OR. & (iccnc.EQ.3.AND.(imix.EQ.-2.OR.imix.EQ.-1)))ichar=0 IF((iccnc.EQ.2.OR.iccnc.EQ.4).AND.iid.EQ.1)THEN rjetset=ran(iseed) IF(rjetset.LE.0.5d0)THEN ichar=0 ELSE ichar=1 ENDIF ENDIF * sa1 c CALL AB_LU4FRM(ichar,IRAD,ITAU,IERR) NEVSTO=NEVHEP NHEPSAV = NHEP do i=1, nhep istsav(i) = isthep(i) enddo CALL AB_LU4FRM(ichar,IRAD,ITAU,IERR) IF (IERR.NE.0) THEN PRINT *,' ERROR CODE:',IERR,' FROM LU4FRM' ENDIF ctest if (nevent.lt.2) then call lulist(1) endif ctestend * * LUHEPC clobbers NEVHEP. Restore it * NEVHEP=NEVSTO NHEP = NHEPSAV do i=1, nhep isthep(i) = istsav(i) enddo * sa1 ENDIF IF(istormom.EQ.1)THEN IF(iproc.GE.6.AND.iproc.LE.8.AND. & (imix.EQ.1.OR.imix.EQ.2))THEN DO m=0,3 paus(m)=p4(m) p4(m)=p6(m) p6(m)=paus(m) ENDDO !m ENDIF IF((iccnc.EQ.3.AND.(imix.EQ.1.OR.imix.EQ.2)).OR. & (iccnc.EQ.4.AND.icch.EQ.3.AND.imix.EQ.1))THEN nout=21 ELSE nout=23 ENDIF DO m=0,3 singlep(m)=p3(m) ENDDO !m WRITE(nout,*)singlep DO m=0,3 singlep(m)=p4(m) ENDDO !m WRITE(nout,*)singlep DO m=0,3 singlep(m)=p5(m) ENDDO !m WRITE(nout,*)singlep DO m=0,3 singlep(m)=p6(m) ENDDO !m WRITE(nout,*)singlep IF(iproc.GE.6.AND.iproc.LE.8.AND. & (imix.EQ.1.OR.imix.EQ.2))THEN DO m=0,3 paus(m)=p4(m) p4(m)=p6(m) p6(m)=paus(m) ENDDO !m ENDIF ENDIF ENDIF ENDIF ENDIF *aggend * numero di chiamate effettive dopo avere superato i tagli ncall_eff=ncall_eff+1 * distribuzioni pesate IF(idistr.EQ.1.AND.((iterm.EQ.1.AND.init.NE.0).OR.iterm.EQ.0))THEN delhist=fxn*wgt devhist=delhist**2 DO i=1,ndistr DO j=1,nsubint(i) IF(j.GE.2)THEN nbin_sum(i,j)=nbin_sum(i,j-1)+nbin_number(i,j-1) ENDIF IF(nbin_number(i,j).NE.0.AND.distr_var(i).LT.distr_estrinf & (i,j+1).AND.distr_var(i).GE.distr_estrinf(i,j))THEN nbin=int((distr_var(i)-distr_estrinf(i,j))/ & bin_width(i,j))+(1+nbin_sum(i,j)) IF(j.EQ.nsubint(i).AND.nbin.EQ.(nbin_number(i,j)+1))THEN nbin=nbin-1 ENDIF IF((interf.EQ.0.AND.(imix.EQ.1.OR.imix.EQ.-1)).OR. & (interf.EQ.1.AND.imix.EQ.2))THEN distr_local(i,nbin,it1)=distr_local(i,nbin,it1)+delhist dev_local(i,nbin,it1)=dev_local(i,nbin,it1)+devhist ncallbin(i,nbin,it1)=ncallbin(i,nbin,it1)+1 ELSE IF((interf.EQ.0.AND.imix.EQ.-2).OR. & (interf.EQ.1.AND.imix.EQ.-1))THEN distr_loc_mix(i,nbin,it2)=distr_loc_mix(i,nbin,it2)+ & delhist dev_loc_mix(i,nbin,it2)=dev_loc_mix(i,nbin,it2)+devhist ncallbin_mix(i,nbin,it2)=ncallbin_mix(i,nbin,it2)+1 ENDIF ENDIF ENDDO !j IF(distr_var(i).GT.distr_estrinf(i,nsubint(i)+1).OR. & distr_var(i).LT.distr_estrinf(i,1))THEN IF((interf.EQ.0.AND.(imix.EQ.1.OR.imix.EQ.-1)).OR. & (interf.EQ.1.AND.imix.EQ.2))THEN tail_local(i,it1)=tail_local(i,it1)+delhist ELSE IF((interf.EQ.0.AND.imix.eq.-2).OR. & (interf.EQ.1.AND.imix.EQ.-1))THEN tail_loc_mix(i,it2)=tail_loc_mix(i,it2)+delhist ENDIF ENDIF ENDDO !i ENDIF RETURN END SUBROUTINE PHSP_INI(estrsup1,estrinf1,sepmass1low,sepmass1high, & ism34,rexpsm,rmx1,gamx1,gx1,ipr, & alfa1,alfa2,auxalfa2, & xg1_max,xg1_min,xf1_max,xf1_min,xw1_max,xw1_min) IMPLICIT REAL*8(a-h,o-z) IF(estrsup1.LE.sepmass1low)THEN ! no W/Z alfa2=1.d0 IF(ism34.LT.1) THEN ! flat alfa1=0.d0 auxalfa2=alfa2 xf1_max=estrsup1 xf1_min=estrinf1 ELSE ! gamma map alfa1=1.d0 xg1_max=estrsup1**(2.d0*(1.d0-rexpsm)) xg1_min=estrinf1**(2.d0*(1.d0-rexpsm)) ENDIF ELSEIF(estrsup1.LE.sepmass1high)THEN ! no W/Z alfa2=1.d0 auxalfa2=alfa2 IF((estrinf1.GE.sepmass1low).OR.(ism34.LT.1))THEN ! flat alfa1=0.d0 xf1_max=estrsup1 xf1_min=estrinf1 ELSE ! gamma map + flat xg1_max=sepmass1low**(2.d0*(1.d0-rexpsm)) xg1_min=estrinf1**(2.d0*(1.d0-rexpsm)) rkappag=(xg1_max-xg1_min)/(1.d0-rexpsm)* & sepmass1low**(2.d0*rexpsm)/(2.d0*sepmass1low) xf1_max=estrsup1 xf1_min=sepmass1low rkappaf=(xf1_max-xf1_min) rkappa=rkappag/rkappaf alfa1=rkappa/(rkappa+1.d0) ENDIF ELSE ! estrsup1.GT.sepmass1high IF(estrinf1.GE.sepmass1high)THEN ! W/Z alfa1=0.d0 alfa2=0.d0 auxalfa2=alfa2 IF(ipr.EQ.0)THEN ! Fixed width xw1_max=atan((estrsup1**2-rmx1**2)/(gamx1*rmx1)) xw1_min=atan((estrinf1**2-rmx1**2)/(gamx1*rmx1)) ELSE ! Running width xw1_max=atan(((1.d0+gx1**2)*estrsup1**2-rmx1**2) & /(gx1*rmx1**2)) xw1_min=atan(((1.d0+gx1**2)*estrinf1**2-rmx1**2) & /(gx1*rmx1**2)) ENDIF ELSEIF((estrinf1.GE.sepmass1low).OR.(ism34.LT.1))THEN ! flat + W/Z alfa1=0.d0 xf1_max=sepmass1high xf1_min=estrinf1 rkappaf=(xf1_max-xf1_min) IF(ipr.EQ.0)THEN ! Fixed width xw1_max=atan((estrsup1**2-rmx1**2)/(gamx1*rmx1)) xw1_min=atan((sepmass1high**2-rmx1**2)/(gamx1*rmx1)) rkappaw=(xw1_max-xw1_min)* & ((sepmass1high**2-rmx1**2)**2+(gamx1*rmx1)**2) & /(gamx1*rmx1)/(2.d0*sepmass1high) ELSE ! Running width xw1_max=atan(((1.d0+gx1**2)*estrsup1**2-rmx1**2) & /(gx1*rmx1**2)) xw1_min=atan(((1.d0+gx1**2)*sepmass1high**2-rmx1**2) & /(gx1*rmx1**2)) rkappaw=(xw1_max-xw1_min)* & ((sepmass1high**2-rmx1**2)**2+sepmass1high**4*gx1**2) & /(rmx1**2*gx1)/(2.d0*sepmass1high) ENDIF rkappa=rkappaf/rkappaw alfa2=rkappa/(rkappa+1.d0) auxalfa2=alfa2 ELSE ! gamma map + flat + W/Z xg1_max=sepmass1low**(2.d0*(1.d0-rexpsm)) xg1_min=estrinf1**(2.d0*(1.d0-rexpsm)) rkappag=(xg1_max-xg1_min)/(1.d0-rexpsm)* & sepmass1low**(2.d0*rexpsm)/(2.d0*sepmass1low) xf1_max=sepmass1high xf1_min=sepmass1low rkappaf=(xf1_max-xf1_min) IF(ipr.EQ.0)THEN ! Fixed width xw1_max=atan((estrsup1**2-rmx1**2)/(gamx1*rmx1)) xw1_min=atan((sepmass1high**2-rmx1**2)/(gamx1*rmx1)) rkappaw=(xw1_max-xw1_min)* & ((sepmass1high**2-rmx1**2)**2+(gamx1*rmx1)**2) & /(gamx1*rmx1)/(2.d0*sepmass1high) ELSE ! Running width xw1_max=atan(((1.d0+gx1**2)*estrsup1**2-rmx1**2) & /(gx1*rmx1**2)) xw1_min=atan(((1.d0+gx1**2)*sepmass1high**2-rmx1**2) & /(gx1*rmx1**2)) rkappaw=(xw1_max-xw1_min)* & ((sepmass1high**2-rmx1**2)**2+sepmass1high**4*gx1**2) & /(rmx1**2*gx1)/(2.d0*sepmass1high) ENDIF rkappa2=rkappaf/rkappaw auxalfa2=rkappa2/(rkappa2+1.d0) rkappa=rkappag/rkappaf*auxalfa2 alfa1=rkappa/(rkappa+1.d0) alfa2=auxalfa2*(1.d0-alfa1)+alfa1 ENDIF ENDIF RETURN END REAL*8 FUNCTION gammln(xx) IMPLICIT NONE REAL*8 xx INTEGER j REAL*8 ser,stp,tmp,xa,y,cof(6) SAVE cof,stp DATA cof,stp/76.18009172947146d0,-86.50532032941677d0, *24.01409824083091d0,-1.231739572450155d0,.1208650973866179d-2, *-.5395239384953d-5,2.5066282746310005d0/ xa=xx y=xa tmp=xa+5.5d0 tmp=(xa+0.5d0)*log(tmp)-tmp ser=1.000000000190015d0 DO 11 j=1,6 y=y+1.d0 ser=ser+cof(j)/y 11 CONTINUE gammln=tmp+log(stp*ser/xa) RETURN END C (C) Copr. 1986-92 Numerical Recipes Software #>,1')5c). SUBROUTINE initialize IMPLICIT REAL*8 (a-h,o-z) COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc *el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch *endel2 COMMON/abflat/rmaxfxn,rmaxfxn_1it,rmaxfxn_2it,rmaxfxn_cc_1it, & rmaxfxn_cc_2it,rmaxfxn_nc_1it,rmaxfxn_nc_2it,scalemax COMMON/abifla/itmx,novermax,iflat,iseed,istorvegas,istormom,iterm, & ijetset,interf COMMON/abfla2/irepeat,nevent,nflevts COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp,imass,ismallangle,ism34,ism56 COMMON/abinpu/rmw,rmz,rmb_run,rmc,rmc_run,rmtau,gamz,gf,s2w, & alfainv,alfas_cc,alfas_nc,alfas_h,gauwidth COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb * sa2 added rmt COMMON/abmass/ rme,rmmu,rmu,rmd,rms,rmt,xm(6),xmp5,xmp * sa2end * el1 COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h * endel1 * em2 COMMON/rexp/rexp5,rexp6,rexpsm * endem2 PARAMETER(NMXHEP=2000) COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) PRINT*,' ' PRINT 251 251 FORMAT('------------------------------------------------------') PRINT*,' ' IF (iproc.GE.1.AND.iproc.LE.5) THEN idownl=1 idownr=0 icc=1 iccnc=1 iqu=0 IF(iproc.EQ.1.AND.ich.EQ.1)THEN PRINT*,'CC9 ) mu-(p3) vm~(p4) vt(p5) tau+(p6)' xm(3)=rmmu xm(4)=0.d0 xm(5)=0.d0 xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=16 IDHEP(2)=-15 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.1.AND.ich.EQ.2)THEN ichcj=1 PRINT*,'CC9 ) mu+(p3) vm(p4) vt~(p5) tau-(p6)' xm(3)=rmmu xm(4)=0.d0 xm(5)=0.d0 xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=15 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.2.AND.ich.EQ.1)THEN i3e=1 PRINT*,'CC18 ) e-(p3) ve~(p4) vm(p5) mu+(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=0.d0 xm(6)=rmmu IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=11 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.2.AND.ich.EQ.2)THEN i3e=1 PRINT*,'CC18 ) e-(p3) ve~(p4) vt(p5) tau+(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=0.d0 xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=16 IDHEP(2)=-15 IDHEP(3)=11 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.2.AND.ich.EQ.3)THEN i3e=1 ichcj=1 PRINT*,'CC18 ) e+(p3) ve(p4) vm~(p5) mu-(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=0.d0 xm(6)=rmmu IF(ijetset.EQ.1)THEN IDHEP(1)=12 IDHEP(2)=-11 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.2.AND.ich.EQ.4)THEN i3e=1 ichcj=1 PRINT*,'CC18 ) e+(p3) ve(p4) vt~(p5) tau-(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=0.d0 xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=12 IDHEP(2)=-11 IDHEP(3)=15 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.1)THEN i5q=1 PRINT*,'CC10 ) mu-(p3) vm~(p4) u(p5) d~(p6)' xm(3)=rmmu xm(4)=0.d0 xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-1 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.2)THEN i5q=1 PRINT*,'CC10 ) mu-(p3) vm~(p4) c(p5) s~(p6)' xm(3)=rmmu xm(4)=0.d0 xm(5)=rmc xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-3 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.3)THEN i5q=1 ichcj=1 PRINT*,'CC10 ) mu+(p3) vm(p4) u~(p5) d(p6)' xm(3)=rmmu xm(4)=0.d0 xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=1 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.4)THEN i5q=1 ichcj=1 PRINT*,'CC10 ) mu+(p3) vm(p4) c~(p5) s(p6)' xm(3)=rmmu xm(4)=0.d0 xm(5)=rmc xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=3 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.5)THEN i5q=1 PRINT*,'CC10 ) tau-(p3) vt~(p4) u(p5) d~(p6)' xm(3)=rmtau xm(4)=0.d0 xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-1 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.6)THEN i5q=1 PRINT*,'CC10 ) tau-(p3) vt~(p4) c(p5) s~(p6)' xm(3)=rmtau xm(4)=0.d0 xm(5)=rmc xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-3 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.7)THEN i5q=1 ichcj=1 PRINT*,'CC10 ) tau+(p3) vt(p4) u~(p5) d(p6)' xm(3)=rmtau xm(4)=0.d0 xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=1 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.3.AND.ich.EQ.8)THEN i5q=1 ichcj=1 PRINT*,'CC10 ) tau+(p3) vt(p4) c~(p5) s(p6)' xm(3)=rmtau xm(4)=0.d0 xm(5)=rmc xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=3 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.4.AND.ich.EQ.1)THEN i3e=1 i5q=1 PRINT*,'CC20 ) e-(p3) ve~(p4) u(p5) d~(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-1 IDHEP(3)=11 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.4.AND.ich.EQ.2)THEN i3e=1 i5q=1 PRINT*,'CC20 ) e-(p3) ve~(p4) c(p5) s~(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=rmc xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-3 IDHEP(3)=11 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.4.AND.ich.EQ.3)THEN i3e=1 i5q=1 ichcj=1 PRINT*,'CC20 ) e+(p3) ve(p4) u~(p5) d(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=12 IDHEP(2)=-11 IDHEP(3)=1 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.4.AND.ich.EQ.4)THEN i3e=1 i5q=1 ichcj=1 PRINT*,'CC20 ) e+(p3) ve(p4) c~(p5) s(p6)' xm(3)=rme xm(4)=0.d0 xm(5)=rmc xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=12 IDHEP(2)=-11 IDHEP(3)=3 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.5.AND.ich.EQ.1)THEN i3q=1 i5q=1 PRINT*,'CC11 ) s(p3) c~(p4) u(p5) d~(p6)' xm(3)=rms xm(4)=rmc xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-1 IDHEP(3)=3 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.5.AND.ich.EQ.2)THEN i3q=1 i5q=1 ichcj=1 PRINT*,'CC11 ) s~(p3) c(p4) u~(p5) d(p6)' xm(3)=rms xm(4)=rmc xm(5)=rmu xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-3 IDHEP(3)=1 IDHEP(4)=-2 ENDIF ENDIF ENDIF IF (iproc.GE.6.AND.iproc.LE.8) THEN idownl=1 idownr=0 icc=-1 ism56=-1 IF(iproc.EQ.6.AND.ich.EQ.1)THEN iqu=0 PRINT*,'Mix19 ) mu-(p3) mu+(p4) vm(p5) vm~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-13 IDHEP(3)=13 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.6.AND.ich.EQ.2)THEN iqu=0 PRINT*,'Mix19 ) tau-(p3) tau+(p4) vt(p5) vt~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=16 IDHEP(2)=-15 IDHEP(3)=15 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.7.AND.ich.EQ.1)THEN i3e=1 i4e=1 i34e=1 i56ve=1 iqu=0 PRINT*,'Mix56 ) e-(p3) e+(p4) ve(p5) ve~(p6)' xm(3)=rme xm(4)=rme xm(5)=0.d0 xm(6)=0.d0 xmp=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=12 IDHEP(2)=-11 IDHEP(3)=11 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.8.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'Mix43 ) d(p3) d~(p4) u(p5) u~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-1 IDHEP(3)=1 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.8.AND.ich.EQ.2)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'Mix43 ) s(p3) s~(p4) c(p5) c~(p6)' xm(3)=rms xm(4)=rms xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-3 IDHEP(3)=3 IDHEP(4)=-4 ENDIF ENDIF ENDIF IF(iproc.GE.9.AND.iproc.LE.12)THEN ism34=-1 ism56=-1 ENDIF IF(iproc.GE.13.AND.iproc.LE.14)THEN ism56=-1 ENDIF IF(iproc.GE.9.AND.iproc.LE.16)THEN idownl=0 idownr=0 icc=0 iccnc=2 IF(iproc.EQ.9.AND.ich.EQ.1)THEN iqu=0 PRINT*,'NC6 ) vm(p3) vm~(p4) vt(p5) vt~(p6)' xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-14 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.10.AND.ich.EQ.1)THEN i56ve=1 iqu=0 PRINT*,'NC12 ) vm(p3) vm~(p4) ve(p5) ve~(p6)' xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 xmp=rmmu IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-14 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.10.AND.ich.EQ.2)THEN i56ve=1 iqu=0 PRINT*,'NC12 ) vt(p3) vt~(p4) ve(p5) ve~(p6)' xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 xmp=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=16 IDHEP(2)=-16 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.11.AND.ich.EQ.1)THEN iid=1 iqu=0 PRINT*,'NC12 ) vm(p3) vm~(p4) vm(p5) vm~(p6)' xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=14 IDHEP(2)=-14 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.11.AND.ich.EQ.2)THEN iid=1 iqu=0 PRINT*,'NC12 ) vt(p3) vt~(p4) vt(p5) vt~(p6)' xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=16 IDHEP(2)=-16 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.12.AND.ich.EQ.1)THEN i56ve=1 iid=1 iqu=0 PRINT*,'NC36 ) ve(p3) ve~(p4) ve(p5) ve~(p6)' xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 xmp=rme IF(ijetset.EQ.1)THEN IDHEP(1)=12 IDHEP(2)=-12 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.13.AND.ich.EQ.1)THEN i3q=1 iqu=0 PRINT*,'NC10 ) u(p3) u~(p4) vm(p5) vm~(p6)' xm(3)=rmu xm(4)=rmu xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-2 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.13.AND.ich.EQ.2)THEN i3q=1 iqu=0 PRINT*,'NC10 ) u(p3) u~(p4) vt(p5) vt~(p6)' xm(3)=rmu xm(4)=rmu xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-2 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.13.AND.ich.EQ.3)THEN i3q=1 iqu=0 PRINT*,'NC10 ) c(p3) c~(p4) vm(p5) vm~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.13.AND.ich.EQ.4)THEN i3q=1 iqu=0 PRINT*,'NC10 ) c(p3) c~(p4) vt(p5) vt~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.14.AND.ich.EQ.1)THEN i56ve=1 i3q=1 iqu=0 PRINT*,'NC19 ) u(p3) u~(p4) ve(p5) ve~(p6)' xm(3)=rmu xm(4)=rmu xm(5)=0.d0 xm(6)=0.d0 xmp=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-2 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.14.AND.ich.EQ.2)THEN i56ve=1 i3q=1 iqu=0 PRINT*,'NC19 ) c(p3) c~(p4) ve(p5) ve~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 xmp=rms IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.15.AND.ich.EQ.1)THEN i3q=1 i5q=1 iid=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC64 ) u(p3) u~(p4) u(p5) u~(p6)' xm(3)=rmu xm(4)=rmu xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-2 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.15.AND.ich.EQ.2)THEN i3q=1 i5q=1 iid=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC64 ) c(p3) c~(p4) c(p5) c~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.16.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) u(p3) u~(p4) c(p5) c~(p6)' xm(3)=rmu xm(4)=rmu xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=2 IDHEP(2)=-2 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF ENDIF IF(iproc.GE.17.AND.iproc.LE.24)THEN IF(iproc.LE.19.OR.iproc.EQ.22.OR.iproc.EQ.23) ism56=-1 idownl=1 idownr=0 icc=0 iccnc=2 IF(iproc.EQ.17.AND.ich.EQ.1)THEN iqu=0 PRINT*,'NC10 ) mu-(p3) mu+(p4) vt(p5) vt~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.17.AND.ich.EQ.2)THEN iqu=0 PRINT*,'NC10 ) tau-(p3) tau+(p4) vm(p5) vm~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.18.AND.ich.EQ.1)THEN i3e=1 i4e=1 i34e=1 iqu=0 PRINT*,'NC20 ) e-(p3) e+(p4) vm(p5) vm~(p6)' xm(3)=rme xm(4)=rme xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.18.AND.ich.EQ.2)THEN i3e=1 i4e=1 i34e=1 iqu=0 PRINT*,'NC20 ) e-(p3) e+(p4) vt(p5) vt~(p6)' xm(3)=rme xm(4)=rme xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.19.AND.ich.EQ.1)THEN i56ve=1 iqu=0 PRINT*,'NC19 ) mu-(p3) mu+(p4) ve(p5) ve~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=0.d0 xm(6)=0.d0 xmp=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.19.AND.ich.EQ.2)THEN i56ve=1 iqu=0 PRINT*,'NC19 ) tau-(p3) tau+(p4) ve(p5) ve~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 xmp=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.20.AND.ich.EQ.1)THEN i5q=1 iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) u(p5) u~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.20.AND.ich.EQ.2)THEN i5q=1 iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) c(p5) c~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.20.AND.ich.EQ.3)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) u(p5) u~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.20.AND.ich.EQ.4)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) c(p5) c~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.21.AND.ich.EQ.1)THEN i34e=1 i5q=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) u(p5) u~(p6)' xm(3)=rme xm(4)=rme xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.21.AND.ich.EQ.2)THEN i34e=1 i5q=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) c(p5) c~(p6)' xm(3)=rme xm(4)=rme xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ELSE IF(iproc.EQ.22.AND.ich.EQ.1)THEN i56ve=1 i3q=1 iqu=0 PRINT*,'NC19 ) d(p3) d~(p4) ve(p5) ve~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=0.d0 xm(6)=0.d0 xmp=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.22.AND.ich.EQ.2)THEN i56ve=1 i3q=1 iqu=0 PRINT*,'NC19 ) s(p3) s~(p4) ve(p5) ve~(p6)' xm(3)=rms xm(4)=rms xm(5)=0.d0 xm(6)=0.d0 xmp=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=12 IDHEP(4)=-12 ENDIF * el1 ELSE IF(iproc.EQ.22.AND.ich.EQ.3)THEN i56ve=1 i3q=1 iqu=0 PRINT*,'NC19 ) b(p3) b~(p4) ve(p5) ve~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 xmp=sqrt(rmt2) IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=12 IDHEP(4)=-12 ENDIF * endel1 ELSE IF(iproc.EQ.23.AND.ich.EQ.1)THEN i3q=1 iqu=0 PRINT*,'NC10 ) d(p3) d~(p4) vm(p5) vm~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.23.AND.ich.EQ.2)THEN i3q=1 iqu=0 PRINT*,'NC10 ) s(p3) s~(p4) vm(p5) vm~(p6)' xm(3)=rms xm(4)=rms xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=14 IDHEP(4)=-14 ENDIF * el1 ELSE IF(iproc.EQ.23.AND.ich.EQ.3)THEN i3q=1 iqu=0 PRINT*,'NC10 ) b(p3) b~(p4) vm(p5) vm~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.23.AND.ich.EQ.4)THEN i3q=1 iqu=0 PRINT*,'NC10 ) d(p3) d~(p4) vt(p5) vt~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.23.AND.ich.EQ.5)THEN i3q=1 iqu=0 PRINT*,'NC10 ) s(p3) s~(p4) vt(p5) vt~(p6)' xm(3)=rms xm(4)=rms xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.23.AND.ich.EQ.6)THEN i3q=1 iqu=0 PRINT*,'NC10 ) b(p3) b~(p4) vt(p5) vt~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=16 IDHEP(4)=-16 ENDIF * endel1 ELSE IF(iproc.EQ.24.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) s(p3) s~(p4) u(p5) u~(p6)' xm(3)=rms xm(4)=rms xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.24.AND.ich.EQ.2)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) d(p3) d~(p4) c(p5) c~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=4 IDHEP(4)=-4 ENDIF * el1 ELSE IF(iproc.EQ.24.AND.ich.EQ.3)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) b(p3) b~(p4) u(p5) u~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=rmu xm(6)=rmu IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.24.AND.ich.EQ.4)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) b(p3) b~(p4) c(p5) c~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF ENDIF * endel1 IF (iproc.GE.25.AND.iproc.LE.32)THEN idownl=1 idownr=1 icc=0 iccnc=2 IF(iproc.EQ.25.AND.ich.EQ.1)THEN iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) tau-(p5) tau+(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rmtau xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ELSE IF(iproc.EQ.26.AND.ich.EQ.1)THEN i34e=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) mu-(p5) mu+(p6)' xm(3)=rme xm(4)=rme xm(5)=rmmu xm(6)=rmmu IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.26.AND.ich.EQ.2)THEN i34e=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) tau-(p5) tau+(p6)' xm(3)=rme xm(4)=rme xm(5)=rmtau xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ELSE IF(iproc.EQ.27.AND.ich.EQ.1)THEN iid=1 iqu=0 PRINT*,'NC48 ) mu-(p3) mu+(p4) mu-(p5) mu+(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rmmu xm(6)=rmmu IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.27.AND.ich.EQ.2)THEN iid=1 iqu=0 PRINT*,'NC48 ) tau-(p3) tau+(p4) tau-(p5) tau+(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rmtau xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ELSE IF(iproc.EQ.28.AND.ich.EQ.1)THEN i34e=1 iid=1 iqu=0 PRINT*,'NC144 ) e-(p3) e+(p4) e-(p5) e+(p6)' xm(3)=rme xm(4)=rme xm(5)=rme xm(6)=rme IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=11 IDHEP(4)=-11 ENDIF ELSE IF(iproc.EQ.29.AND.ich.EQ.1)THEN i3q=1 i5q=1 iid=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC64 ) d(p3) d~(p4) d(p5) d~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=rmd xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.29.AND.ich.EQ.2)THEN i3q=1 i5q=1 iid=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC64 ) s(p3) s~(p4) s(p5) s~(p6)' xm(3)=rms xm(4)=rms xm(5)=rms xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=3 IDHEP(4)=-3 ENDIF * el1 ELSE IF(iproc.EQ.29.AND.ich.EQ.3)THEN i3q=1 i5q=1 iid=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC64 ) b(p3) b~(p4) b(p5) b~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=5 IDHEP(4)=-5 ENDIF * endel1 ELSE IF(iproc.EQ.30.AND.ich.EQ.1)THEN i34e=1 i5q=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) d(p5) d~(p6)' xm(3)=rme xm(4)=rme xm(5)=rmd xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.30.AND.ich.EQ.2)THEN i34e=1 i5q=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) s(p5) s~(p6)' xm(3)=rme xm(4)=rme xm(5)=rms xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=3 IDHEP(4)=-3 ENDIF * el1 ELSE IF(iproc.EQ.30.AND.ich.EQ.3)THEN i34e=1 i5q=1 iqu=0 PRINT*,'NC48 ) e-(p3) e+(p4) b(p5) b~(p6)' xm(3)=rme xm(4)=rme xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=5 IDHEP(4)=-5 ENDIF * endel1 ELSE IF(iproc.EQ.31.AND.ich.EQ.1)THEN i5q=1 iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) d(p5) d~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rmd xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.31.AND.ich.EQ.2)THEN i5q=1 iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) s(p5) s~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rms xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=3 IDHEP(4)=-3 ENDIF * el1 ELSE IF(iproc.EQ.31.AND.ich.EQ.3)THEN i5q=1 iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) b(p5) b~(p6)' xm(3)=rmmu xm(4)=rmmu xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ELSE IF(iproc.EQ.31.AND.ich.EQ.4)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) d(p5) d~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rmd xm(6)=rmd IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.31.AND.ich.EQ.5)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) s(p5) s~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rms xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.31.AND.ich.EQ.6)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) b(p5) b~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=5 IDHEP(4)=-5 ENDIF * endel1 ELSE IF(iproc.EQ.32.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) d(p3) d~(p4) s(p5) s~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=rms xm(6)=rms IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=3 IDHEP(4)=-3 ENDIF * el1 ELSE IF(iproc.EQ.32.AND.ich.EQ.2)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) d(p3) d~(p4) b(p5) b~(p6)' xm(3)=rmd xm(4)=rmd xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ELSE IF(iproc.EQ.32.AND.ich.EQ.3)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC32 ) s(p3) s~(p4) b(p5) b~(p6)' xm(3)=rms xm(4)=rms xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=5 IDHEP(4)=-5 ENDIF * endel1 ENDIF ENDIF IF (iproc.GE.33.AND.iproc.LE.35)THEN IF (iproc.LE.34) ism56=-1 idownl=1 idownr=0 icc=0 iccnc=4 IF(iproc.EQ.33.AND.ich.EQ.1)THEN ibbveve=1 i3q=1 i56ve=1 iqu=0 PRINT*,'NC21 ) b(p3) b~(p4) ve(p5) ve~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.34.AND.ich.EQ.1)THEN i3q=1 iqu=0 PRINT*,'NC11 ) b(p3) b~(p4) vm(p5) vm~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.34.AND.ich.EQ.2)THEN i3q=1 iqu=0 PRINT*,'NC11 ) b(p3) b~(p4) vt(p5) vt~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.35.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC33 ) b(p3) b~(p4) u(p5) u~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.35.AND.ich.EQ.2)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC33 ) b(p3) b~(p4) c(p5) c~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF ENDIF IF(iproc.GE.36.AND.iproc.LE.39)THEN idownl=1 idownr=1 icc=0 iccnc=4 IF(iproc.EQ.36.OR.iproc.EQ.37)THEN i3q=1 iqu=0 IF(iproc.EQ.36.AND.ich.EQ.1)THEN PRINT*,'NC25 ) b(p3) b~(p4) mu-(p5) mu+(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.36.AND.ich.EQ.2)THEN PRINT*,'NC25 ) b(p3) b~(p4) tau-(p5) tau+(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ELSE IF(iproc.EQ.37.AND.ich.EQ.1)THEN PRINT*,'NC50 ) b(p3) b~(p4) e-(p5) e+(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=11 IDHEP(4)=-11 ENDIF ENDIF ELSE IF(iproc.EQ.38.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! lho messo nel read PRINT*,'NC33 ) b(p3) b~(p4) d(p5) d~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.38.AND.ich.EQ.2)THEN i3q=1 i5q=1 * iqu=1 ! lho messo nel read PRINT*,'NC33 ) b(p3) b~(p4) s(p5) s~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.39.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read iid=1 PRINT*,'NC84 ) b(p3) b~(p4) b(p5) b~(p6)' xm(3)=rmb xm(4)=rmb xm(5)=rmb xm(6)=rmb IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ENDIF ENDIF * el1 IF (iproc.GE.40.AND.iproc.LE.42)THEN IF (iproc.LE.41) ism56=-1 idownl=0 idownr=0 icc=0 iccnc=4 IF(iproc.EQ.40.AND.ich.EQ.1)THEN ibbveve=1 i3q=1 i56ve=1 iqu=0 PRINT*,'NC21 ) c(p3) c~(p4) ve(p5) ve~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.41.AND.ich.EQ.1)THEN i3q=1 iqu=0 PRINT*,'NC11 ) c(p3) c~(p4) vm(p5) vm~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.41.AND.ich.EQ.2)THEN i3q=1 iqu=0 PRINT*,'NC11 ) c(p3) c~(p4) vt(p5) vt~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.42.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read PRINT*,'NC33 ) c(p3) c~(p4) u(p5) u~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ENDIF ENDIF IF(iproc.EQ.43.AND.ich.EQ.1)THEN idownl=0 idownr=0 icc=0 iccnc=4 i3q=1 i5q=1 * iqu=1 ! l'ho messo nel read iid=1 PRINT*,'NC84 ) c(p3) c~(p4) c(p5) c~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=rmc xm(6)=rmc IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF IF(iproc.GE.44.AND.iproc.LE.46)THEN idownl=0 idownr=1 icc=0 iccnc=4 IF(iproc.EQ.44.OR.iproc.EQ.45)THEN i3q=1 iqu=0 IF(iproc.EQ.44.AND.ich.EQ.1)THEN PRINT*,'NC25 ) c(p3) c~(p4) mu-(p5) mu+(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.44.AND.ich.EQ.2)THEN PRINT*,'NC25 ) c(p3) c~(p4) tau-(p5) tau+(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ELSE IF(iproc.EQ.45.AND.ich.EQ.1)THEN PRINT*,'NC50 ) c(p3) c~(p4) e-(p5) e+(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=11 IDHEP(4)=-11 ENDIF ENDIF ELSE IF(iproc.EQ.46.AND.ich.EQ.1)THEN i3q=1 i5q=1 * iqu=1 ! lho messo nel read PRINT*,'NC33 ) c(p3) c~(p4) d(p5) d~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.46.AND.ich.EQ.2)THEN i3q=1 i5q=1 * iqu=1 ! lho messo nel read PRINT*,'Mix44 ) c(p3) c~(p4) s(p5) s~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.46.AND.ich.EQ.3)THEN i3q=1 i5q=1 * iqu=1 ! lho messo nel read PRINT*,'NC33 ) c(p3) c~(p4) b(p5) b~(p6)' xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ENDIF ENDIF IF(iproc.GE.47.AND.iproc.LE.49)THEN IF(iproc.LE.48) ism56=-1 idownl=1 idownr=0 icc=0 iccnc=4 IF(iproc.EQ.47.AND.ich.EQ.1)THEN ibbveve=1 i3q=0 i56ve=1 iqu=0 PRINT*,'NC21 ) tau-(p3) tau+(p4) ve(p5) ve~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.48.AND.ich.EQ.1)THEN i3q=0 iqu=0 PRINT*,'NC11 ) tau-(p3) tau+(p4) vm(p5) vm~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.48.AND.ich.EQ.2)THEN i3q=0 iqu=0 PRINT*,'Mix20 ) tau-(p3) tau+(p4) vt(p5) vt~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.49.AND.ich.EQ.1)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) u(p5) u~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.49.AND.ich.EQ.2)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) c(p5) c~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF ENDIF IF(iproc.EQ.50.OR.(iproc.GE.52.AND.iproc.LE.53))THEN idownl=1 idownr=1 icc=0 iccnc=4 IF(iproc.EQ.50.OR.iproc.EQ.52)THEN i3q=0 iqu=0 IF(iproc.EQ.50.AND.ich.EQ.1)THEN PRINT*,'NC25 ) tau-(p3) tau+(p4) mu-(p5) mu+(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.52.AND.ich.EQ.1)THEN PRINT*,'NC49 ) tau-(p3) tau+(p4) e-(p5) e+(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=11 IDHEP(4)=-11 ENDIF ENDIF ELSE IF(iproc.EQ.53.AND.ich.EQ.1)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) d(p5) d~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.53.AND.ich.EQ.2)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) s(p5) s~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.53.AND.ich.EQ.3)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) b(p5) b~(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ENDIF ENDIF IF(iproc.EQ.51.AND.ich.EQ.1)THEN idownl=1 idownr=1 icc=0 iccnc=4 i3q=0 i5q=0 iqu=0 iid=1 PRINT*,'NC68 ) tau-(p3) tau+(p4) tau-(p5) tau+(p6)' xm(3)=rmtau xm(4)=rmtau xm(5)=rmtau xm(6)=rmtau IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ENDIF * endel1 IF(icc.EQ.1.AND.i5q.EQ.1.AND.i3q.EQ.0)THEN f4l=fqdl f5l=fqul z4l=zqdl z5l=zqul f4r=fqdr f5r=fqur z4r=zqdr z5r=zqur f3l=fel f3r=fer z3l=zel z3r=zer f6l=0.d0 f6r=0.d0 z6l=zvl z6r=zvr ELSE IF(i3q.EQ.1)THEN IF(idownl.EQ.0)THEN f3l=fqul f3r=fqur z3l=zqul z3r=zqur f4l=fqul f4r=fqur z4l=zqul z4r=zqur ELSE f3l=fqdl f3r=fqdr z3l=zqdl z3r=zqdr f4l=fqdl f4r=fqdr z4l=zqdl z4r=zqdr ENDIF ELSE IF(i3q.EQ.0)THEN IF(idownl.EQ.0)THEN f3l=0.d0 f3r=0.d0 z3l=zvl z3r=zvr f4l=0.d0 f4r=0.d0 z4l=zvl z4r=zvr ELSE f3l=fel f3r=fer z3l=zel z3r=zer f4l=fel f4r=fer z4l=zel z4r=zer ENDIF ENDIF IF(i5q.EQ.1)THEN IF(idownr.EQ.0)THEN f5l=fqul f5r=fqur z5l=zqul z5r=zqur f6l=fqul f6r=fqur z6l=zqul z6r=zqur ELSE f5l=fqdl f5r=fqdr z5l=zqdl z5r=zqdr f6l=fqdl f6r=fqdr z6l=zqdl z6r=zqdr ENDIF ELSE IF(i5q.EQ.0)THEN IF(idownr.EQ.0)THEN f5l=0.d0 f5r=0.d0 z5l=zvl z5r=zvr f6l=0.d0 f6r=0.d0 z6l=zvl z6r=zvr ELSE f5l=fel f5r=fer z5l=zel z5r=zer f6l=fel f6r=fer z6l=zel z6r=zer ENDIF ENDIF ENDIF * em2 IF(iproc.EQ.2) rexp5 = 0.d0 * em3 IF (izz.eq.1) THEN ism34=-1 ism56=-1 ENDIF IF(izg34.eq.1)ism56=-1 IF(izg56.eq.1)ism34=-1 * endem3 *agg IF(ijetset.EQ.1)THEN * sa1 c IF(isr.EQ.0) THEN IF(isr.EQ.0.or.isr.eq.2) THEN cqed2end NHEP=4 DO i=1,4 ISTHEP(i)=1 ENDDO !i * sa1 c ELSE ELSEIF (isr.eq.1) then * sa1end idhep(5)=22 idhep(6)=22 NHEP=6 DO i=1,6 ISTHEP(i)=1 ENDDO !i ENDIF ENDIF *aggend RETURN END SUBROUTINE printer(rmh,gamh,rma,gama,tgb,rmb) IMPLICIT REAL*8 (a-h,o-z) COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp,imass,ismallangle,ism34,ism56 COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc *el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch *endel2 * sa2 added rmt COMMON/abmass/ rme,rmmu,rmu,rmd,rms,rmt,xm(6),xmp5,xmp * sa2end COMMON/abcuts/e_min(3:6),e_max(3:6),thbeam_min(3:6), & thbeam_max(3:6),thsep_min(6),thsep_max(6),rm_min(6),rm_max(6), & beamcut_min(3:6),beamcut_max(3:6),sepcut_min(6),sepcut_max(6), & rm_min2(6),rm_max2(6),pt_min(3:6),pt_max(3:6),e_cm COMMON/abinpu/rmw,rmz,rmb_run,rmc,rmc_run,rmtau,gamz,gf,s2w, & alfainv,alfas_cc,alfas_nc,alfas_h,gauwidth *agg COMMON/abflat/rmaxfxn,rmaxfxn_1it,rmaxfxn_2it,rmaxfxn_cc_1it, & rmaxfxn_cc_2it,rmaxfxn_nc_1it,rmaxfxn_nc_2it,scalemax COMMON/abifla/itmx,novermax,iflat,iseed,istorvegas,istormom,iterm, & ijetset,interf COMMON/abfla2/irepeat,nevent,nflevts *aggend c beam COMMON/abibea/ibeam c beam IF (icc.EQ.1.AND.icc3.EQ.1) THEN PRINT*,'WW signal' ELSE IF (icc.EQ.1.AND.icc3.EQ.0) THEN PRINT*,'WW signal + background' ENDIF IF (iccnc.EQ.4.AND.(icch.EQ.1.OR.icch.EQ.3)) THEN IF(isusy.EQ.1)THEN PRINT*,'Minimal Supersymmetric Higgs sector' ENDIF * el1 IF (icch.EQ.1.AND.(iproc.NE.39.AND.iproc.NE.43.AND. & iproc.NE.51)) THEN PRINT*,'Higgs signal' ELSE IF (icch.EQ.1.AND.isusy.EQ.0.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.1)THEN PRINT*,'Complete higgs contribution' ELSE IF (icch.EQ.1.AND.isusy.EQ.0.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.2)THEN PRINT*,'only hZ contribution' ELSE IF (icch.EQ.1.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ELSE IF (icch.EQ.1.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.2)THEN PRINT*,'Complete h higgs contribution' ELSE IF (icch.EQ.1.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.3)THEN PRINT*,'Complete A higgs contribution' ELSE IF (icch.EQ.1.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.4)THEN PRINT*,'only hZ contribution' ELSE IF (icch.EQ.1.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51). & AND.iha.EQ.5)THEN PRINT*,'only hA contribution' ELSE IF (icch.EQ.3.AND.iproc.NE.39.AND.iproc.NE.43. & AND.iproc.NE.51) THEN PRINT*,'Higgs signal + background' ELSE IF (icch.EQ.3.AND.isusy.EQ.0.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51))THEN PRINT*,'Complete Higgs contribution + background' ELSE IF (icch.EQ.3.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51))THEN PRINT*,'Complete h and A higgs contribution + background' ENDIF * endel1 ELSE IF (iccnc.EQ.4.AND.icch.EQ.2) THEN PRINT*,'Higgs background' ENDIF IF(iqu.EQ.1)THEN PRINT*,'QCD diagrams included' ENDIF PRINT*,' ' PRINT*,'INPUT' PRINT 101,e_cm 101 FORMAT(' cm energy = ',d13.7,' GeV') IF (iccnc.EQ.4.AND.(icch.EQ.1.OR.icch.EQ.3)) THEN IF(isusy.EQ.0)THEN PRINT 201,rmh 201 FORMAT(' Higgs mass = ',d13.7,' GeV') ELSE IF(irmhcomp.EQ.0)THEN PRINT 2061,rmh 2061 FORMAT(' Higgs mass = ',d13.7,' GeV') ENDIF PRINT 207,rma 207 FORMAT(' CP odd Higgs mass = ',d13.7,' GeV') PRINT 208,tgb 208 FORMAT(' Tan(beta) = ',d13.7,' GeV') ENDIF PRINT 301,rmb 301 FORMAT(' b mass = ',d13.7,' GeV') ELSE IF (iccnc.EQ.4.AND.icch.EQ.2) THEN PRINT 401,rmb 401 FORMAT(' b mass = ',d13.7,' GeV') ENDIF PRINT*,' ' PRINT*,'DATA' PRINT 411,rmz 411 FORMAT(' Z mass = ',d13.7,' GeV') PRINT 421,rmw 421 FORMAT(' W mass = ',d13.7,' GeV') * sa2 if (imass.eq.1) then PRINT 4211, rme 4211 FORMAT(' electron mass = ',d13.7,' GeV') PRINT 4212, rmmu 4212 FORMAT(' mu mass = ',d13.7,' GeV') PRINT 4213, rmtau 4213 FORMAT(' tau mass = ',d13.7,' GeV') PRINT 4214, rmu 4214 FORMAT(' up mass = ',d13.7,' GeV') PRINT 4215, rmd 4215 FORMAT(' down mass = ',d13.7,' GeV') PRINT 4216, rmc 4216 FORMAT(' charm mass = ',d13.7,' GeV') PRINT 4217, rms 4217 FORMAT(' strange mass = ',d13.7,' GeV') PRINT 4218, rmt 4218 FORMAT(' top mass = ',d13.7,' GeV') PRINT 4219, rmb 4219 FORMAT(' bottom mass = ',d13.7,' GeV') endif * sa2end IF (iccnc.EQ.4)THEN PRINT 423,rmc 423 FORMAT(' c mass = ',d13.7,' GeV') PRINT 425,rmtau 425 FORMAT(' tau mass = ',d13.7,' GeV') ENDIF IF(igwcomp.EQ.0)THEN PRINT 431,gamw 431 FORMAT(' W width = ',d13.7,' GeV') ENDIF IF(igzcomp.EQ.0)THEN PRINT 441,gamz 441 FORMAT(' Z width = ',d13.7,' GeV') ENDIF IF(ighcomp.EQ.0.AND.iccnc.EQ.4.AND.(icch.EQ.1.OR.icch.EQ.3))THEN PRINT 451,gamh 451 FORMAT(' Higgs width = ',d13.7,' GeV') ENDIF PRINT 461,gf 461 FORMAT(' Gf = ',d13.7,' GeV-2') IF(iswgcomp.EQ.0)THEN PRINT 471,s2w 471 FORMAT(' s2w = ',d13.7) PRINT 481,alfainv 481 FORMAT(' 1/alfa_em = ',d13.7) ENDIF IF(iqu.EQ.1.OR.istrcor.EQ.1)THEN IF(icc.EQ.1)THEN PRINT 485,alfas_cc 485 FORMAT(' alfas_cc = ',d13.7) ELSE IF(icc.EQ.0)THEN PRINT 486,alfas_nc 486 FORMAT(' alfas_nc = ',d13.7) ELSE IF(icc.EQ.-1)THEN PRINT 487,alfas_cc 487 FORMAT(' alfas_cc = ',d13.7) PRINT 488,alfas_nc 488 FORMAT(' alfas_nc = ',d13.7) ENDIF ENDIF IF(igwcomp.EQ.1.OR.igzcomp.EQ.1.OR.ighcomp.EQ.1.OR. & iswgcomp.EQ.1.OR.irmhcomp.EQ.1)THEN PRINT*,' ' PRINT*,'DERIVED QUANTITIES' IF(isusy.EQ.1.AND.irmhcomp.EQ.1)THEN PRINT 489,rmh 489 FORMAT(' Higgs mass = ',d13.7,' GeV') ENDIF IF(igwcomp.EQ.1)THEN PRINT 491,gamw 491 FORMAT(' W width = ',d13.7,' GeV') ENDIF IF(igzcomp.EQ.1)THEN PRINT 492,gamz 492 FORMAT(' Z width = ',d13.7,' GeV') ENDIF IF(ighcomp.EQ.1.AND.iccnc.EQ.4.AND. & (icch.EQ.1.OR.icch.EQ.3))THEN PRINT 493,gamh 493 FORMAT(' Higgs width = ',d13.7,' GeV') ENDIF * el1 IF(isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.43.OR.iproc.EQ.51))THEN * endel1 PRINT 452,gama 452 FORMAT(' CP odd Higgs width = ',d13.7,' GeV') ENDIF IF(iswgcomp.EQ.1)THEN PRINT 494,s2w 494 FORMAT(' s2w = ',d13.7) PRINT 495,alfainv 495 FORMAT(' 1/alfa_em = ',d13.7) ENDIF ENDIF PRINT*,' ' PRINT*,'OPTIONS' IF (iccnc.EQ.4) THEN IF (icch.EQ.1.OR.icch.EQ.3) THEN IF (ipr.EQ.0) THEN PRINT*,'both Z and H boson constant width' ELSE IF (ipr.EQ.1) THEN PRINT*,'both Z and H boson s-dependent width' ENDIF ELSE IF(icch.EQ.2) THEN IF (ipr.EQ.0) THEN PRINT*,'Z boson constant width' ELSE IF (ipr.EQ.1) THEN PRINT*,'Z s-dependent width' ENDIF ENDIF ELSE IF (icc.EQ.1.OR.icc.EQ.-1) then IF (ipr.EQ.0) THEN PRINT*,'both Z and W boson constant width' ELSE IF (ipr.EQ.1) THEN PRINT*,'both Z and W boson s-dependent width' * el1 ELSE IF (ipr.EQ.1) THEN PRINT*,'Z constant width and W boson s-dependent width' * endel1 ENDIF ELSE IF (icc.EQ.0) THEN IF (ipr.EQ.0) THEN PRINT*,'Z constant width' ELSE IF (ipr.EQ.1) THEN PRINT*,'Z s-dependent width' ENDIF ENDIF ENDIF c beam IF (ibeam.EQ.1) THEN PRINT*,'Beamstrahlung with Circe' ENDIF c beam IF (isr.EQ.1) THEN PRINT*,'Born + QED' ELSE PRINT*,'Born only' ENDIF IF (icoul.EQ.1) THEN PRINT*,'Coulomb corrections included' ENDIF IF (istrcor.EQ.1) THEN PRINT*,'Naive QCD corrections included' ENDIF IF (iccnc.EQ.1.OR.iccnc.EQ.3) THEN IF (ips_cc.EQ.1) THEN PRINT*,'Double resonant "CC" phase space' ELSE IF (ips_cc.EQ.2) THEN PRINT*,'Single resonant (34)"CC" phase space' ELSE IF (ips_cc.EQ.3) THEN PRINT*,'Single resonant (56)"CC" phase space' ELSE IF (ips_cc.EQ.4) THEN PRINT*,'Non resonant "CC" phase space' ENDIF ENDIF IF (iccnc.EQ.2.OR.iccnc.EQ.3) THEN IF (ips_nc.EQ.1) THEN PRINT*,'Double resonant "NC" phase space' ELSE IF (ips_nc.EQ.2) THEN PRINT*,'Single resonant (34)"NC" phase space' ELSE IF (ips_nc.EQ.3) THEN PRINT*,'Single resonant (56)"NC" phase space' ELSE IF (ips_nc.EQ.4) THEN PRINT*,'Non resonant "NC" phase space' ENDIF ENDIF IF (iccnc.EQ.4.AND.(icch.EQ.1.OR.icch.EQ.3)) THEN IF (ips_cc.EQ.1) THEN PRINT*,'Double resonant "Higgs signal" phase space' ELSE IF (ips_cc.EQ.2) THEN PRINT*,'Single resonant (34)"Higgs signal" phase space' ELSE IF (ips_cc.EQ.3) THEN PRINT*,'Single resonant (56)"Higgs signal" phase space' ELSE IF (ips_cc.EQ.4) THEN PRINT*,'Non resonant "Higgs signal" phase space' ENDIF ENDIF IF (iccnc.EQ.4.AND.(icch.EQ.0.OR.icch.EQ.3)) THEN IF (ips_nc.EQ.1) THEN PRINT*,'Double resonant "Higgs background" phase space' ELSE IF (ips_nc.EQ.2) THEN PRINT*,'Single resonant (34)"Higgs background" phase space' ELSE IF (ips_nc.EQ.3) THEN PRINT*,'Single resonant (56)"Higgs background" phase space' ELSE IF (ips_nc.EQ.4) THEN PRINT*,'Non resonant "Higgs background" phase space' ENDIF ENDIF IF (ianc.NE.0) THEN PRINT*,' ' PRINT*,'Anomalous coupling parameters:' PRINT*,'-----------------------------' PRINT 500,delz,xf,xz,yf*rmw2,yz*rmw2,zz*rmw2 500 FORMAT(' delz =',f9.5,' xf =',f9.5/' xz =',f9.5, & ' yf =',f9.5/' yz =',f9.5,' zz =',f9.5/' ') ENDIF IF (icut.EQ.1) THEN PRINT*,'Cuts :' PRINT*,'-----------------' PRINT 501,e_min(3),e_min(4),e_min(5),e_min(6) 501 FORMAT(' ENERGY_MIN(3,4,5,6) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,' ) GeV') PRINT 511,e_max(3),e_max(4),e_max(5),e_max(6) 511 FORMAT(' ENERGY_MAX(3,4,5,6) =( ',f7.2, & ',',f7.2,',',f7.2,',',f7.2,' ) GeV') PRINT 801,rm_min(1),rm_min(2),rm_min(3),rm_min(4),rm_min(5), & rm_min(6) 801 FORMAT(' MASS_MIN(34,35,36,45,46,56) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,',',f6.2,',',f6.2,' ) GeV') PRINT 851,rm_max(1),rm_max(2),rm_max(3),rm_max(4),rm_max(5), & rm_max(6) 851 FORMAT(' MASS_MAX(34,35,36,45,46,56) =( ',f7.2, & ',',f7.2,',',f7.2,',',f7.2,',',f7.2,',',f7.2,' ) GeV') PRINT 901,pt_min(3),pt_min(4),pt_min(5),pt_min(6) 901 FORMAT(' PT_MIN(3,4,5,6) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,' ) GeV') PRINT 911,pt_max(3),pt_max(4),pt_max(5),pt_max(6) 911 FORMAT(' PT_MAX(3,4,5,6) =( ',f7.2, & ',',f7.2,',',f7.2,',',f7.2,' ) GeV') IF (icos.EQ.0)THEN PRINT 701,thbeam_min(3),thbeam_min(4),thbeam_min(5), & thbeam_min(6) 701 FORMAT(' THBEAM_MIN(3,4,5,6) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,' ) deg') PRINT 702,thbeam_max(3),thbeam_max(4),thbeam_max(5), & thbeam_max(6) 702 FORMAT(' THBEAM_MAX(3,4,5,6) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,' ) deg') ELSE IF(icos.EQ.1)THEN PRINT 711,thbeam_min(3),thbeam_min(4),thbeam_min(5), & thbeam_min(6) 711 FORMAT(' COSBEAM_MAX(3,4,5,6) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,' )') PRINT 712,thbeam_max(3),thbeam_max(4),thbeam_max(5), & thbeam_max(6) 712 FORMAT(' COSBEAM_MIN(3,4,5,6) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,' )') ENDIF IF(icos.EQ.0)THEN PRINT 601,thsep_min(1),thsep_min(2),thsep_min(3),thsep_min(4), & thsep_min(5),thsep_min(6) 601 FORMAT(' THSEP_MIN(34,35,36,45,46,56) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,',',f6.2,',',f6.2,' ) deg') PRINT 602,thsep_max(1),thsep_max(2),thsep_max(3),thsep_max(4), & thsep_max(5),thsep_max(6) 602 FORMAT(' THSEP_MAX(34,35,36,45,46,56) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,',',f6.2,',',f6.2,' ) deg') ELSE IF(icos.EQ.1)THEN PRINT 611,thsep_min(1),thsep_min(2),thsep_min(3),thsep_min(4), & thsep_min(5),thsep_min(6) 611 FORMAT(' COSSEP_MAX(34,35,36,45,46,56) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,',',f6.2,',',f6.2,' )') PRINT 612,thsep_max(1),thsep_max(2),thsep_max(3),thsep_max(4), & thsep_max(5),thsep_max(6) 612 FORMAT(' COSSEP_MIN(34,35,36,45,46,56) =( ',f6.2, & ',',f6.2,',',f6.2,',',f6.2,',',f6.2,',',f6.2,' )') ENDIF ENDIF PRINT 951 951 FORMAT('------------------------------------------------------') PRINT*,' ' *agg IF(iflat.EQ.1)THEN PRINT*,'Flat events generation' IF(istorvegas.EQ.1)THEN IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN PRINT*,'VEGAS data stored in ABVEGAS_CC(NC).DAT' ELSE PRINT*,'VEGAS data stored in ABVEGAS.DAT' ENDIF ENDIF IF(irepeat.EQ.1)THEN PRINT*,'second VEGAS iteration repeated' ENDIF PRINT 952,scalemax 952 FORMAT(' Maximum scale factor = ',d9.3) IF(istormom.EQ.1)THEN IF(iccnc.EQ.3.OR.(iccnc.EQ.4.AND.icch.EQ.3))THEN PRINT*,'Flat events stored in ABMOM_SIGN.DAT' PRINT*,'Flat events stored in ABMOM_BACK.DAT' ELSE PRINT*,'Flat events stored in ABMOM.DAT' ENDIF ENDIF IF(ijetset.EQ.1)THEN PRINT*,'with calls to Jetset' ENDIF ENDIF *aggend RETURN END REAL*8 FUNCTION ee_4f(p1,p2,p3,p4,p5,p6) * impulsi p1(0:3),p2(0:3),p3(0:3),p4(0:3),p5(0:3),p6(0:3) * prima particelle uscenti di tipo down, poi di tipo up * 1 e+, 2 e-, 3 s, 4 d~, 5 u, 6 c~ * impulso w+ pwp=p5+p4 impulso w- pwm=p3+p6 * 1 e+, 2 e-, 3 e, 4 e~, 5 v, 6 v~ * Se c'e' una sola coppia di elettroni deve andare in posizione 34 * Se c'e' una sola coppia di neutrini elet. deve andare in posizone 56 * 1 e+, 2 e-, 3 u, 4 d~, 5 e-, 6 ve~ * prendo per canale t tutti propagatori senza massa immaginaria * * flags: * common/iflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,iid, * & imix,icoul,istrcor * icc =1 solo CC, 0 solo NC , -1 entrambi * se icc diverso da 0 * icc3 =1 solo CC3, 0 altrimenti * i3e =1 3 e' elettrone, 0 altrimenti * i4e =1 4 e' e+, 0 altrimenti * i3q =1 3 e' quark, 0 altrimenti * i5q =1 3 e' quark, 0 altrimenti * se icc diverso da 1 * iqu =1 entrambi coppie di NC sono quark, 0 altrimenti * i34e =1 coppia 3 e 4 sono elettroni, 0 altrimenti * i56ve =1 coppia 56 sono neutrini elettrone , 0 altrimenti * iid =1 particelle identiche nello stato finale, 0 altrimenti * * imix= 2 somma cc +interferenza con nc, 1 solo cc, 0 solo interferenza tra * cc e nc, -1 solo nc, -2 nc + interferenza con cc * ibbveve =1 se processo e' quello indicato, 0 altrimenti * serve per tener conto di massa del top a quadrato nel denominatore del * propagatore di cn28 * * struttura del programma: **** vettori di polarizzazione ee gamma , eezeta **** inizio CC * if (icc.ne.0) then **** diagrammi cc3 * if (icc3.ne.1) then **** altri diagrammi per completare cc11 * if (i3e.eq.1) then **** diagrammi con elettrone uscente di cc * endif * if (i4e.eq.1) then **** diagrammi con positrone uscente di cc * endif * endif * endif **** fine CC **** inizio NC * if (icc.ne.1) then * definizione vettori vet.k0 etc. * do ide=0,iid * if (iid.eq.1) then * p3<->p5 * per rifare tutti i diagrammi con questo scambio per particelle id. * endif **** 24 diagrammi base di corrente neutra (6 per gamma e Z insieme) * if (iqu.eq.1) then **** 8 diagrammi di qcd (4) * endif * if (i34e.eq.1) then **** 24 con coppia 34 elettrone (6) * endif * if (i56ve.eq.1) then **** diagrammi per correnti neutre con scambi di w (6) * if (i56ve.eq.1.and.iid.eq.1) then **** diagrammi per correnti neutre con scambi di w (6) ottenuti da **** quelli precedenti scambiando 56 con 34, necessari per 4 ve finali * endif * endif * if (iid.eq.1.and.i34e.eq.1) !anche 56 sono elettroni * !anche 56 sono elettroni **** 24 con coppia 56 elet.(come a i34.eq.1 con scambio coppie 35<->56) * endif * enddo * endif **** fine NC * * Nomenclatura per anomalous couplings * e0 corrisponde a vettore di polarizzazione di gamma + zeta con coeff * opportuni, em a vettore di polarizzaz W-, ep a quello di W+ * p0 e' impulso uscente di gamma + zeta, pm quello di W-, pp quello di W+. * Corrispondentemente ce0em e' prodotto scalare tra e0 e em, ce0pp e' prodotto * scalare tra e0 e pp etc IMPLICIT REAL*8 (a-b,d-h,o-z) IMPLICIT double COMPLEX (c) DIMENSION p1(0:3),p2(0:3),p3(0:3),p4(0:3),p5(0:3),p6(0:3) DIMENSION pau(0:3),p12(0:3),p14(0:3),p16(0:3),p23(0:3),p25(0:3), & p34(0:3),p36(0:3),p45(0:3),p56(0:3), & p123(0:3),p125(0:3),p134(0:3),p136(0:3),p145(0:3),p156(0:3), & p235(0:3),p345(0:3),p356(0:3) DIMENSION vfz(0:3),vwm(0:3),vwp(0:3) DIMENSION cc1(2),cc2(2),cc3(2),cc4(2),cc5(2),cc6(2) DIMENSION cc7(2),cc8(2),cc9(2),cc10(2),cc11(2),cc12(2) DIMENSION cc13(2),cc14(2),cc15(2),cc16(2),cc17(2),cc18(2) DIMENSION cc_3e(2),cc_4e(2) * anomalous DIMENSION cau(2),ce0ep(2),ce0em(2),ce0pp(2),ce0pm(2) DIMENSION cpau(0:3) * STRUCTURE/res/ double COMPLEX id(0:1) END STRUCTURE RECORD/res/cn1(2,2,2),cn2(2,2,2),cn3(2,2,2),cn4(2,2,2),cn5(2,2,2), & cn6(2,2,2),cn7(2,2,2),cn8(2,2,2),cn9(2,2,2),cn10(2,2,2), & cn11(2,2,2),cn12(2,2,2),cn13(2,2,2),cn14(2,2,2),cn15(2,2,2), & cn16(2,2,2),cn17(2,2,2),cn18(2,2,2),cn19(2,2,2),cn20(2,2,2), & cn21(2,2,2),cn22(2,2,2), & cn23(2),cn24(2),cn25(2),cn26(2),cn27(2),cn28, & cn29(2),cn30(2),cn31(2),cn32(2),cn33(2),cn34, & cn_4f(2,2,2),cn_34e(2,2,2),cn_56e(2,2,2),cn_34v(2),cn_56v(2), & cn_qcd(2,2,2) STRUCTURE/polcom/ double COMPLEX e(0:3),ek0,v END STRUCTURE RECORD/polcom/c12f(2),c12z(2),c12fz(2),c12fz3(2),c12fz4(2), & c12fz5(2),c12fz6(2),c14f(2),c14z(2),c14w,c16f(2),c16z(2),c16w, & c23w,c23f(2),c23z(2),c23fz(2),c23fz1(2),c23fz4(2),c23fz5(2), & c25w,c25f(2),c25z(2),c34f(2),c34z(2),c34fz(2), & c36w,c41f(2),c41z(2),c41fz(2),c41fz2(2),c41fz3(2),c41fz6(2), & c52w,c54w,c56f(2),c56z(2),c56fz(2) STRUCTURE/tu/ double COMPLEX a(2),c(2) END STRUCTURE RECORD/tu/l1_23w,l1_23(2),l1_23fz(2),l1_25w,l1_25fz(2),l1_34fz(2), & l1_54w,l1_56fz(2),l3_12(2),l3_12fz(2),l3_14w,l3_14(2), & l3_14fz(2), & l3_16w,l3_16fz(2),l3_25w,l3_25fz(2),l3_54w,l3_56f(2), & l3_56fz(2),l5_12(2),l5_12fz(2),l5_14(2),l5_14w,l5_14fz(2), & l5_16w, & l5_16fz(2),l5_23w,l5_23(2),l5_23fz(2),l5_34f(2),l5_34fz(2), & l5_36w STRUCTURE/td/ double COMPLEX a(2),b(2) END STRUCTURE RECORD/td/ r2_14w,r2_14(2),r2_14fz(2),r2_16w,r2_16fz(2), & r2_34fz(2),r2_36w,r2_56fz(2),r4_12(2),r4_12fz(2),r4_16w, & r4_16fz(2),r4_23w,r4_23(2),r4_23fz(2),r4_25w,r4_25fz(2), & r4_36w,r4_56f(2),r4_56fz(2),r6_12(2),r6_12fz(2),r6_14w, & r6_14(2),r6_14fz(2),r6_23w,r6_23(2),r6_23fz(2),r6_25w, & r6_25fz(2),r6_34f(2),r6_34fz(2),r6_54w COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abparc/czipr,ccz,cwipr,ccw,chipr,cch,caipr,cca COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc *el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch *endel2 PARAMETER (czero=(0.d0,0.d0),cuno=(1.d0,0.d0),cim=(0.d0,1.d0)) * pk0 -- p=p1 p1k0=p1(0)-p1(1) * pk0 -- p=p2 p2k0=p2(0)-p2(1) * pk0 -- p=p3 p3k0=p3(0)-p3(1) * pk0 -- p=p4 p4k0=p4(0)-p4(1) * pk0 -- p=p5 p5k0=p5(0)-p5(1) * pk0 -- p=p6 p6k0=p6(0)-p6(1) * Impulsi dei propagatori DO m=0,3 p12(m)=-p1(m)-p2(m) p14(m)=-p1(m)+p4(m) p16(m)=-p1(m)+p6(m) p23(m)=-p2(m)+p3(m) p25(m)=-p2(m)+p5(m) p34(m)=p3(m)+p4(m) p36(m)=p3(m)+p6(m) p45(m)=p5(m)+p4(m) p56(m)=p5(m)+p6(m) p123(m)=p12(m)+p3(m) p125(m)=-p1(m)+p25(m) p134(m)=-p1(m)+p34(m) p136(m)=p16(m)+p3(m) p145(m)=-p1(m)+p45(m) p156(m)=p5(m)+p16(m) p235(m)=p25(m)+p3(m) p345(m)=p34(m)+p5(m) p356(m)=p36(m)+p5(m) END DO * pk0 -- p=p123 p123k0=p123(0)-p123(1) * p.q -- p.q=p123q,p=p123,q=p123 p123q=p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p123 & (3)*p123(3) * pk0 -- p=p125 p125k0=p125(0)-p125(1) * p.q -- p.q=p125q,p=p125,q=p125 p125q=p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p125 & (3)*p125(3) * pk0 -- p=p134 p134k0=p134(0)-p134(1) * p.q -- p.q=p134q,p=p134,q=p134 p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) * pk0 -- p=p145 p145k0=p145(0)-p145(1) * p.q -- p.q=p145q,p=p145,q=p145 p145q=p145(0)*p145(0)-p145(1)*p145(1)-p145(2)*p145(2)-p145 & (3)*p145(3) * pk0 -- p=p156 p156k0=p156(0)-p156(1) * p.q -- p.q=p156q,p=p156,q=p156 p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) * pk0 -- p=p235 p235k0=p235(0)-p235(1) * p.q -- p.q=p235q,p=p235,q=p235 p235q=p235(0)*p235(0)-p235(1)*p235(1)-p235(2)*p235(2)-p235 & (3)*p235(3) * pk0 -- p=p136 p136k0=p136(0)-p136(1) * p.q -- p.q=p136q,p=p136,q=p136 p136q=p136(0)*p136(0)-p136(1)*p136(1)-p136(2)*p136(2)-p136 & (3)*p136(3) * pk0 -- p=p345 p345k0=p345(0)-p345(1) * p.q -- p.q=p345q,p=p345,q=p345 p345q=p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p345 & (3)*p345(3) * pk0 -- p=p356 p356k0=p356(0)-p356(1) * p.q -- p.q=p356q,p=p356,q=p356 p356q=p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p356 & (3)*p356(3) * p.q -- p.q=p1p2,p=p1,q=p2 p1p2=p1(0)*p2(0)-p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3) s=2.d0*p1p2 ss=sqrt(s) E=ss/2.d0 * vettori di polarizzazione e+e- quqd=p1p2 * il - qui e in cdw e' perche' i propagatori bosonici portano un segno - * rispetto a quelli fermionici cdz=-1.d0/(s*czipr-rmz2+ccz) df=-1.d0/s fac1=(df*fer) fac2=(df*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p1,qd=p2,v=0,a=c12f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p1(2)*p2(3)+p2(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p2(0)+p2k0*p1(0) c12f(1).e(0)=fac1*(auxa+ceps_0) c12f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=1,a=c12f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=2,a=c12f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p1k0*p2(3)+p2k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p2(2)+p2k0*p1(2) c12f(1).e(2)=fac1*(auxa+ceps_0) c12f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=3,a=c12f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p1k0*p2(2)-p2k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p2(3)+p2k0*p1(3) c12f(1).e(3)=fac1*(auxa+ceps_0) c12f(2).e(3)=fac2*(auxa-ceps_0) DO mu=0,3 c12z(1).e(mu)=cfac1z*c12f(1).e(mu) c12z(2).e(mu)=cfac2z*c12f(2).e(mu) END DO DO i=1,2 * pk0 -- p=c12f(i).e c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 * pk0 -- p=c12z(i).e c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO **** inizio CC IF (icc.NE.0) THEN * vettori di polarizzazione wp: w+ -> 5 4 * quqd -- p=p5,q=p4 quqd=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) s54=2.d0*quqd cdw=-1.d0/(s54*cwipr-rmw2+ccw) cfaw=(cdw*wcl) * p5 non puo' che avere la polarizzazione 2, percio' non si somma sulle polariz * zazioni dei quark * TW10 -- qu=p5,qd=p4,v=0,a=c54w.e(0),cl=cfaw,nsum=0 eps_0=-p5(2)*p4(3)+p4(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p4(0)+p4k0*p5(0) c54w.e(0)=cfaw*(auxa-ceps_0) * TW10 -- qu=p5,qd=p4,v=1,a=c54w.e(1),cl=cfaw,nsum=0 auxa=-quqd+p5k0*p4(1)+p4k0*p5(1) c54w.e(1)=cfaw*(auxa-ceps_0) * TW10 -- qu=p5,qd=p4,v=2,a=c54w.e(2),cl=cfaw,nsum=0 eps_0=-p5k0*p4(3)+p4k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p4(2)+p4k0*p5(2) c54w.e(2)=cfaw*(auxa-ceps_0) * TW10 -- qu=p5,qd=p4,v=3,a=c54w.e(3),cl=cfaw,nsum=0 eps_0=p5k0*p4(2)-p4k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p4(3)+p4k0*p5(3) c54w.e(3)=cfaw*(auxa-ceps_0) * pk0 -- p=c54w.e c54w.ek0=c54w.e(0)-c54w.e(1) * vettori di polarizzazione ewm: w- -> 3 6 * quqd -- p=p3,q=p6 quqd=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) s36=2.d0*quqd cdw=-1.d0/(s36*cwipr-rmw2+ccw) cfaw=(cdw*wcl) * p3 non puo' che avere la polarizzazione 2, percio' non si somma sulle polariz * zazioni dei quark * TW10 -- qu=p3,qd=p6,v=0,a=c36w.e(0),cl=cfaw,nsum=0 eps_0=-p3(2)*p6(3)+p6(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p6(0)+p6k0*p3(0) c36w.e(0)=cfaw*(auxa-ceps_0) * TW10 -- qu=p3,qd=p6,v=1,a=c36w.e(1),cl=cfaw,nsum=0 auxa=-quqd+p3k0*p6(1)+p6k0*p3(1) c36w.e(1)=cfaw*(auxa-ceps_0) * TW10 -- qu=p3,qd=p6,v=2,a=c36w.e(2),cl=cfaw,nsum=0 eps_0=-p3k0*p6(3)+p6k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p6(2)+p6k0*p3(2) c36w.e(2)=cfaw*(auxa-ceps_0) * TW10 -- qu=p3,qd=p6,v=3,a=c36w.e(3),cl=cfaw,nsum=0 eps_0=p3k0*p6(2)-p6k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p6(3)+p6k0*p3(3) c36w.e(3)=cfaw*(auxa-ceps_0) * pk0 -- p=c36w.e c36w.ek0=c36w.e(0)-c36w.e(1) * diagrammi con triplo vertice IF (ianc.EQ.0) THEN DO i=1,2 DO mu=0,3 c12fz(i).e(mu)=c12f(i).e(mu)+rcotw*c12z(i).e(mu) END DO END DO ELSE DO i=1,2 DO mu=0,3 c12fz(i).e(mu)=c12f(i).e(mu)+(rcotw+delz)*c12z(i).e(mu) END DO END DO ENDIF *** triple vertex -- pfz(mu)=p12(mu),pwm(mu)=p36(mu),pwp(mu)=p45(mu),efz=c1 * 2fz(i),ewm=c36w,ewp=c54w,res=cc1(i?) DO mu=0,3 vfz(mu)=p36(mu)-p45(mu) vwm(mu)=p45(mu)-p12(mu) vwp(mu)=p12(mu)-p36(mu) END DO !mu * vfz.efz DO i=1,2 * p.q -- p.q=c12fz(i).v,p=c12fz(i).e,q=vfz c12fz(i).v=c12fz(i).e(0)*vfz(0)-c12fz(i).e(1)*vfz(1)-c12fz & (i).e(2)*vfz(2)-c12fz(i).e(3)*vfz(3) END DO * vwm.ewm * p.q -- p.q=c36w.v,p=c36w.e,q=vwm c36w.v=c36w.e(0)*vwm(0)-c36w.e(1)*vwm(1)-c36w.e(2)*vwm(2)- & c36w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c54w.v,p=c54w.e,q=vwp c54w.v=c54w.e(0)*vwp(0)-c54w.e(1)*vwp(1)-c54w.e(2)*vwp(2)- & c54w.e(3)*vwp(3) * efz.ewm DO i=1,2 * p.q -- p.q=caux,p=c12fz(i).e,q=c36w.e caux=c12fz(i).e(0)*c36w.e(0)-c12fz(i).e(1)*c36w.e(1)-c12fz & (i).e(2)*c36w.e(2)-c12fz(i).e(3)*c36w.e(3) cc1(i)=c54w.v*caux END DO * efz.ewp DO i=1,2 * p.q -- p.q=caux,p=c12fz(i).e,q=c54w.e caux=c12fz(i).e(0)*c54w.e(0)-c12fz(i).e(1)*c54w.e(1)-c12fz & (i).e(2)*c54w.e(2)-c12fz(i).e(3)*c54w.e(3) cc1(i)=cc1(i)+c36w.v*caux END DO * ewm.ewp * p.q -- p.q=caux,p=c36w.e,q=c54w.e caux=c36w.e(0)*c54w.e(0)-c36w.e(1)*c54w.e(1)-c36w.e(2)*c54 & w.e(2)-c36w.e(3)*c54w.e(3) DO i=1,2 cc1(i)=cc1(i)+c12fz(i).v*caux END DO * anomalous couplings IF (ianc.NE.0) THEN * p.q -- p.q=cemp0,p=c36w.e,q=p12 cemp0=c36w.e(0)*p12(0)-c36w.e(1)*p12(1)-c36w.e(2)*p12(2)-c & 36w.e(3)*p12(3) * p.q -- p.q=cepp0,p=c54w.e,q=p12 cepp0=c54w.e(0)*p12(0)-c54w.e(1)*p12(1)-c54w.e(2)*p12(2)-c & 54w.e(3)*p12(3) IF (xf.NE.0.d0.OR.xz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c12fz(i).e(mu)=xf*c12f(i).e(mu)+xz*c12z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c12fz(i).e,q=c36w.e ce0em(i)=c12fz(i).e(0)*c36w.e(0)-c12fz(i).e(1)*c36w.e(1)-c & 12fz(i).e(2)*c36w.e(2)-c12fz(i).e(3)*c36w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c12fz(i).e,q=c54w.e ce0ep(i)=c12fz(i).e(0)*c54w.e(0)-c12fz(i).e(1)*c54w.e(1)-c & 12fz(i).e(2)*c54w.e(2)-c12fz(i).e(3)*c54w.e(3) END DO DO i=1,2 cc1(i)=cc1(i)+ce0em(i)*cepp0-ce0ep(i)*cemp0 END DO ENDIF IF (yf.NE.0.d0.OR.yz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c12fz(i).e(mu)=yf*c12f(i).e(mu)+yz*c12z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c12fz(i).e,q=c36w.e ce0em(i)=c12fz(i).e(0)*c36w.e(0)-c12fz(i).e(1)*c36w.e(1)-c & 12fz(i).e(2)*c36w.e(2)-c12fz(i).e(3)*c36w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c12fz(i).e,q=c54w.e ce0ep(i)=c12fz(i).e(0)*c54w.e(0)-c12fz(i).e(1)*c54w.e(1)-c & 12fz(i).e(2)*c54w.e(2)-c12fz(i).e(3)*c54w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0pm(i),p=c12fz(i).e,q=p36 ce0pm(i)=c12fz(i).e(0)*p36(0)-c12fz(i).e(1)*p36(1)-c12fz(i & ).e(2)*p36(2)-c12fz(i).e(3)*p36(3) END DO DO i=1,2 * p.q -- p.q=ce0pp(i),p=c12fz(i).e,q=p45 ce0pp(i)=c12fz(i).e(0)*p45(0)-c12fz(i).e(1)*p45(1)-c12fz(i & ).e(2)*p45(2)-c12fz(i).e(3)*p45(3) END DO * p.q -- p.q=cemep,p=c36w.e,q=c54w.e cemep=c36w.e(0)*c54w.e(0)-c36w.e(1)*c54w.e(1)-c36w.e(2)*c5 & 4w.e(2)-c36w.e(3)*c54w.e(3) * p.q -- p.q=cempp,p=c36w.e,q=p45 cempp=c36w.e(0)*p45(0)-c36w.e(1)*p45(1)-c36w.e(2)*p45(2)-c & 36w.e(3)*p45(3) * p.q -- p.q=ceppm,p=c54w.e,q=p36 ceppm=c54w.e(0)*p36(0)-c54w.e(1)*p36(1)-c54w.e(2)*p36(2)-c & 54w.e(3)*p36(3) * p.q -- p.q=p0pm,p=p12,q=p36 p0pm=p12(0)*p36(0)-p12(1)*p36(1)-p12(2)*p36(2)-p12(3)*p36( & 3) * p.q -- p.q=p0pp,p=p12,q=p45 p0pp=p12(0)*p45(0)-p12(1)*p45(1)-p12(2)*p45(2)-p12(3)*p45( & 3) * p.q -- p.q=pmpp,p=p36,q=p45 pmpp=p36(0)*p45(0)-p36(1)*p45(1)-p36(2)*p45(2)-p36(3)*p45( & 3) DO i=1,2 cc1(i)=cc1(i)+ce0pm(i)*cepp0*cempp-ce0pp(i)*ceppm*cemp0+ & p0pp*(ce0em(i)*ceppm-cemep*ce0pm(i))+ & p0pm*(cemep*ce0pp(i)-ce0ep(i)*cempp)+ & pmpp*(ce0ep(i)*cemp0-ce0em(i)*cepp0) END DO ENDIF IF (zz.NE.0.d0) THEN DO m=0,3 cpau(m)=cepp0*c36w.e(m)-cemp0*c54w.e(m) pau(m)=p45(m)-p36(m) ENDDO DO i=1,2 * eps -- eps=cau(i),p=c12z(i).e,q=cpau,r=p12,s=pau cau(i)=c12z(i).e(0)*(cpau(1)*(p12(2)*pau(3)-p12(3)*pau(2)) & +cpau(2)*(p12(3)*pau(1)-p12(1)*pau(3))+cpau(3)*(p12(1) & *pa & u(2)-p12(2)*pau(1))) cau(i)=cau(i)-c12z(i).e(1)*(cpau(2)*(p12(3)*pau(0)-p12(0)* & pau(3))+cpau(3)*(p12(0)*pau(2)-p12(2)*pau(0))+cpau(0) & *(p1 & 2(2)*pau(3)-p12(3)*pau(2))) cau(i)=cau(i)+c12z(i).e(2)*(cpau(3)*(p12(0)*pau(1)-p12(1)* & pau(0))+cpau(0)*(p12(1)*pau(3)-p12(3)*pau(1))+cpau(1) & *(p1 & 2(3)*pau(0)-p12(0)*pau(3))) cau(i)=cau(i)-c12z(i).e(3)*(cpau(0)*(p12(1)*pau(2)-p12(2)* & pau(1))+cpau(1)*(p12(2)*pau(0)-p12(0)*pau(2))+cpau(2) & *(p1 & 2(0)*pau(1)-p12(1)*pau(0))) END DO DO i=1,2 cc1(i)=cc1(i)+cim*zz*cau(i) ENDDO ENDIF ENDIF * end anomalous couplings * diagramma con neutrino * quqd -- p=p1,q=p145 quqd=p1(0)*p145(0)-p1(1)*p145(1)-p1(2)*p145(2)-p1(3)*p145( & 3) * TWL0 -- qu=p1,qd=p145,v=c54w.e,a=l1_54w.a,c=l1_54w.c,cl=wcl,nsum=0 ceps_0=-c54w.ek0*(p1(2)*p145(3)-p145(2)*p1(3))+p1k0*(c54w. & e(2)*p145(3)-p145(2)*c54w.e(3))-p145k0*(c54w.e(2)*p1(3)-p & 1(2)*c54w.e(3)) ceps_0=ceps_0*cim ceps_1=-c54w.e(3)*p1k0+p1(3)*c54w.ek0 ceps_1=ceps_1*cim cvqu=c54w.e(0)*p1(0)-c54w.e(1)*p1(1)-c54w.e(2)*p1(2)-c54w. & e(3)*p1(3) cvqd=c54w.e(0)*p145(0)-c54w.e(1)*p145(1)-c54w.e(2)*p145(2) & -c54w.e(3)*p145(3) cauxa=-c54w.ek0*quqd+p1k0*cvqd+p145k0*cvqu cauxc=+c54w.ek0*p1(2)-p1k0*c54w.e(2) l1_54w.a(2)=wcl*(cauxa-ceps_0) l1_54w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p145,q=p2 quqd=p145(0)*p2(0)-p145(1)*p2(1)-p145(2)*p2(2)-p145(3)*p2( & 3) * TWR0 -- qu=p145,qd=p2,v=c36w.e,a=r2_36w.a,b=r2_36w.b,cl=wcl,nsum=0 ceps_0=-c36w.ek0*(p145(2)*p2(3)-p2(2)*p145(3))+p145k0*(c36 & w.e(2)*p2(3)-p2(2)*c36w.e(3))-p2k0*(c36w.e(2)*p145(3)-p14 & 5(2)*c36w.e(3)) ceps_0=ceps_0*cim ceps_2=-c36w.e(3)*p2k0+p2(3)*c36w.ek0 ceps_2=ceps_2*cim cvqu=c36w.e(0)*p145(0)-c36w.e(1)*p145(1)-c36w.e(2)*p145(2) & -c36w.e(3)*p145(3) cvqd=c36w.e(0)*p2(0)-c36w.e(1)*p2(1)-c36w.e(2)*p2(2)-c36w. & e(3)*p2(3) cauxa=-c36w.ek0*quqd+p145k0*cvqd+p2k0*cvqu cauxb=-c36w.ek0*p2(2)+p2k0*c36w.e(2) r2_36w.a(2)=wcl*(cauxa-ceps_0) r2_36w.b(1)=wcl*(cauxb-ceps_2) * TLTR0_W -- aa=cc2(&),a1=l1_54w.a,c1=l1_54w.c,a2=r2_36w.a,b2=r2_36w.b,prq= * p145q,den=(p145q*p145k0),nsum=0 cc2(2)=( l1_54w.c(2)*p145q*r2_36w.b(1)+l1_54w.a(2)*r2_36w. & a(2) )/(p145q*p145k0) IF (icc3.NE.1) THEN **** altri diagrammi per CC11 * polarizzazioni per attaccamenti solo left di f e Z a fermioni DO i=1,2 DO mu=0,3 c12fz5(i).e(mu)=c12f(i).e(mu)*f5l & +c12z(i).e(mu)*z5l END DO END DO DO i=1,2 * pk0 -- p=c12fz5(i).e c12fz5(i).ek0=c12fz5(i).e(0)-c12fz5(i).e(1) END DO DO i=1,2 DO mu=0,3 c12fz3(i).e(mu)=c12f(i).e(mu)*f3l & +c12z(i).e(mu)*z3l END DO END DO DO i=1,2 * pk0 -- p=c12fz3(i).e c12fz3(i).ek0=c12fz3(i).e(0)-c12fz3(i).e(1) END DO DO i=1,2 DO mu=0,3 c12fz6(i).e(mu)=c12f(i).e(mu)*f6l & +c12z(i).e(mu)*z6l END DO END DO DO i=1,2 * pk0 -- p=c12fz6(i).e c12fz6(i).ek0=c12fz6(i).e(0)-c12fz6(i).e(1) END DO DO i=1,2 DO mu=0,3 c12fz4(i).e(mu)=c12f(i).e(mu)*f4l & +c12z(i).e(mu)*z4l END DO END DO DO i=1,2 * pk0 -- p=c12fz4(i).e c12fz4(i).ek0=c12fz4(i).e(0)-c12fz4(i).e(1) END DO * *******diagrammi con solo w- risonante********* * * vengono usate le routine twr0 e twl0 anche per fotone perche' quando * c'e' una linea che si attacca con w non sono piu' necessari attaccamenti * right handed * quqd -- p=p5,q=p356 quqd=p5(0)*p356(0)-p5(1)*p356(1)-p5(2)*p356(2)-p5(3)*p356( & 3) * TWL0 -- qu=p5,qd=p356,v=c36w.e,a=l5_36w.a,c=l5_36w.c,cl=wcl,nsum=0 ceps_0=-c36w.ek0*(p5(2)*p356(3)-p356(2)*p5(3))+p5k0*(c36w. & e(2)*p356(3)-p356(2)*c36w.e(3))-p356k0*(c36w.e(2)*p5(3)-p & 5(2)*c36w.e(3)) ceps_0=ceps_0*cim ceps_1=-c36w.e(3)*p5k0+p5(3)*c36w.ek0 ceps_1=ceps_1*cim cvqu=c36w.e(0)*p5(0)-c36w.e(1)*p5(1)-c36w.e(2)*p5(2)-c36w. & e(3)*p5(3) cvqd=c36w.e(0)*p356(0)-c36w.e(1)*p356(1)-c36w.e(2)*p356(2) & -c36w.e(3)*p356(3) cauxa=-c36w.ek0*quqd+p5k0*cvqd+p356k0*cvqu cauxc=+c36w.ek0*p5(2)-p5k0*c36w.e(2) l5_36w.a(2)=wcl*(cauxa-ceps_0) l5_36w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * TWR0 -- qu=p356,qd=p4,v=c12fz4(i).e,a=r4_12(i).a,b=r4_12(i).b,cl=1.d0,nsu * m=0 ceps_0=-c12fz4(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0 & *(c12fz4(i).e(2)*p4(3)-p4(2)*c12fz4(i).e(3))-p4k0*(c12fz4 & (i).e(2)*p356(3)-p356(2)*c12fz4(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12fz4(i).e(3)*p4k0+p4(3)*c12fz4(i).ek0 ceps_2=ceps_2*cim cvqu=c12fz4(i).e(0)*p356(0)-c12fz4(i).e(1)*p356(1)-c12fz4( & i).e(2)*p356(2)-c12fz4(i).e(3)*p356(3) cvqd=c12fz4(i).e(0)*p4(0)-c12fz4(i).e(1)*p4(1)-c12fz4(i).e & (2)*p4(2)-c12fz4(i).e(3)*p4(3) cauxa=-c12fz4(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12fz4(i).ek0*p4(2)+p4k0*c12fz4(i).e(2) r4_12(i).a(2)=1.d0*(cauxa-ceps_0) r4_12(i).b(1)=1.d0*(cauxb-ceps_2) END DO DO i=1,2 * TLTR0_W -- aa=cc3(i),a1=l5_36w.a,c1=l5_36w.c,a2=r4_12(i).a,b2=r4_12(i).b, * prq=p356q,den=(p356q*p356k0),nsum=0 cc3(i)=( l5_36w.c(2)*p356q*r4_12(i).b(1)+l5_36w.a(2)*r4_12 & (i).a(2) )/(p356q*p356k0) END DO * quqd -- p=p5,q=p125 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 * TWL0 -- qu=p5,qd=p125,v=c12fz5(i).e,a=l5_12(i).a,c=l5_12(i).c,cl=1.d0,nsu * m=0 ceps_0=-c12fz5(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*( & c12fz5(i).e(2)*p125(3)-p125(2)*c12fz5(i).e(3))-p125k0*(c1 & 2fz5(i).e(2)*p5(3)-p5(2)*c12fz5(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12fz5(i).e(3)*p5k0+p5(3)*c12fz5(i).ek0 ceps_1=ceps_1*cim cvqu=c12fz5(i).e(0)*p5(0)-c12fz5(i).e(1)*p5(1)-c12fz5(i).e & (2)*p5(2)-c12fz5(i).e(3)*p5(3) cvqd=c12fz5(i).e(0)*p125(0)-c12fz5(i).e(1)*p125(1)-c12fz5( & i).e(2)*p125(2)-c12fz5(i).e(3)*p125(3) cauxa=-c12fz5(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12fz5(i).ek0*p5(2)-p5k0*c12fz5(i).e(2) l5_12(i).a(2)=1.d0*(cauxa-ceps_0) l5_12(i).c(2)=1.d0*(-cauxc+ceps_1) END DO * quqd -- p=p125,q=p4 quqd=p125(0)*p4(0)-p125(1)*p4(1)-p125(2)*p4(2)-p125(3)*p4( & 3) * TWR0 -- qu=p125,qd=p4,v=c36w.e,a=r4_36w.a,b=r4_36w.b,cl=wcl,nsum=0 ceps_0=-c36w.ek0*(p125(2)*p4(3)-p4(2)*p125(3))+p125k0*(c36 & w.e(2)*p4(3)-p4(2)*c36w.e(3))-p4k0*(c36w.e(2)*p125(3)-p12 & 5(2)*c36w.e(3)) ceps_0=ceps_0*cim ceps_2=-c36w.e(3)*p4k0+p4(3)*c36w.ek0 ceps_2=ceps_2*cim cvqu=c36w.e(0)*p125(0)-c36w.e(1)*p125(1)-c36w.e(2)*p125(2) & -c36w.e(3)*p125(3) cvqd=c36w.e(0)*p4(0)-c36w.e(1)*p4(1)-c36w.e(2)*p4(2)-c36w. & e(3)*p4(3) cauxa=-c36w.ek0*quqd+p125k0*cvqd+p4k0*cvqu cauxb=-c36w.ek0*p4(2)+p4k0*c36w.e(2) r4_36w.a(2)=wcl*(cauxa-ceps_0) r4_36w.b(1)=wcl*(cauxb-ceps_2) DO i=1,2 * TLTR0_W -- aa=cc4(i),a1=l5_12(i).a,c1=l5_12(i).c,a2=r4_36w.a,b2=r4_36w.b, * prq=p125q,den=(p125q*p125k0),nsum=0 cc4(i)=( l5_12(i).c(2)*p125q*r4_36w.b(1)+l5_12(i).a(2)*r4_ & 36w.a(2) )/(p125q*p125k0) END DO * *******diagrammi con solo w+ risonante********* * * vengono usate le routine twr0 e twl0 anche per fotone perche' quando * c'e' una linea che si attacca con w non sono piu' necessari attaccamenti * right handed * quqd -- p=p3,q=p345 quqd=p3(0)*p345(0)-p3(1)*p345(1)-p3(2)*p345(2)-p3(3)*p345( & 3) * TWL0 -- qu=p3,qd=p345,v=c54w.e,a=l3_54w.a,c=l3_54w.c,cl=wcl,nsum=0 ceps_0=-c54w.ek0*(p3(2)*p345(3)-p345(2)*p3(3))+p3k0*(c54w. & e(2)*p345(3)-p345(2)*c54w.e(3))-p345k0*(c54w.e(2)*p3(3)-p & 3(2)*c54w.e(3)) ceps_0=ceps_0*cim ceps_1=-c54w.e(3)*p3k0+p3(3)*c54w.ek0 ceps_1=ceps_1*cim cvqu=c54w.e(0)*p3(0)-c54w.e(1)*p3(1)-c54w.e(2)*p3(2)-c54w. & e(3)*p3(3) cvqd=c54w.e(0)*p345(0)-c54w.e(1)*p345(1)-c54w.e(2)*p345(2) & -c54w.e(3)*p345(3) cauxa=-c54w.ek0*quqd+p3k0*cvqd+p345k0*cvqu cauxc=+c54w.ek0*p3(2)-p3k0*c54w.e(2) l3_54w.a(2)=wcl*(cauxa-ceps_0) l3_54w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p345,q=p6 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 * TWR0 -- qu=p345,qd=p6,v=c12fz6(i).e,a=r6_12(i).a,b=r6_12(i).b,cl=1.d0,nsu * m=0 ceps_0=-c12fz6(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0 & *(c12fz6(i).e(2)*p6(3)-p6(2)*c12fz6(i).e(3))-p6k0*(c12fz6 & (i).e(2)*p345(3)-p345(2)*c12fz6(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12fz6(i).e(3)*p6k0+p6(3)*c12fz6(i).ek0 ceps_2=ceps_2*cim cvqu=c12fz6(i).e(0)*p345(0)-c12fz6(i).e(1)*p345(1)-c12fz6( & i).e(2)*p345(2)-c12fz6(i).e(3)*p345(3) cvqd=c12fz6(i).e(0)*p6(0)-c12fz6(i).e(1)*p6(1)-c12fz6(i).e & (2)*p6(2)-c12fz6(i).e(3)*p6(3) cauxa=-c12fz6(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12fz6(i).ek0*p6(2)+p6k0*c12fz6(i).e(2) r6_12(i).a(2)=1.d0*(cauxa-ceps_0) r6_12(i).b(1)=1.d0*(cauxb-ceps_2) END DO DO i=1,2 * TLTR0_W -- aa=cc5(i),a1=l3_54w.a,c1=l3_54w.c,a2=r6_12(i).a,b2=r6_12(i).b, * prq=p345q,den=(p345q*p345k0),nsum=0 cc5(i)=( l3_54w.c(2)*p345q*r6_12(i).b(1)+l3_54w.a(2)*r6_12 & (i).a(2) )/(p345q*p345k0) END DO * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * TWL0 -- qu=p3,qd=p123,v=c12fz3(i).e,a=l3_12(i).a,c=l3_12(i).c,cl=1.d0,nsu * m=0 ceps_0=-c12fz3(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*( & c12fz3(i).e(2)*p123(3)-p123(2)*c12fz3(i).e(3))-p123k0*(c1 & 2fz3(i).e(2)*p3(3)-p3(2)*c12fz3(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12fz3(i).e(3)*p3k0+p3(3)*c12fz3(i).ek0 ceps_1=ceps_1*cim cvqu=c12fz3(i).e(0)*p3(0)-c12fz3(i).e(1)*p3(1)-c12fz3(i).e & (2)*p3(2)-c12fz3(i).e(3)*p3(3) cvqd=c12fz3(i).e(0)*p123(0)-c12fz3(i).e(1)*p123(1)-c12fz3( & i).e(2)*p123(2)-c12fz3(i).e(3)*p123(3) cauxa=-c12fz3(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxc=+c12fz3(i).ek0*p3(2)-p3k0*c12fz3(i).e(2) l3_12(i).a(2)=1.d0*(cauxa-ceps_0) l3_12(i).c(2)=1.d0*(-cauxc+ceps_1) END DO * quqd -- p=p123,q=p6 quqd=p123(0)*p6(0)-p123(1)*p6(1)-p123(2)*p6(2)-p123(3)*p6( & 3) * TWR0 -- qu=p123,qd=p6,v=c54w.e,a=r6_54w.a,b=r6_54w.b,cl=wcl,nsum=0 ceps_0=-c54w.ek0*(p123(2)*p6(3)-p6(2)*p123(3))+p123k0*(c54 & w.e(2)*p6(3)-p6(2)*c54w.e(3))-p6k0*(c54w.e(2)*p123(3)-p12 & 3(2)*c54w.e(3)) ceps_0=ceps_0*cim ceps_2=-c54w.e(3)*p6k0+p6(3)*c54w.ek0 ceps_2=ceps_2*cim cvqu=c54w.e(0)*p123(0)-c54w.e(1)*p123(1)-c54w.e(2)*p123(2) & -c54w.e(3)*p123(3) cvqd=c54w.e(0)*p6(0)-c54w.e(1)*p6(1)-c54w.e(2)*p6(2)-c54w. & e(3)*p6(3) cauxa=-c54w.ek0*quqd+p123k0*cvqd+p6k0*cvqu cauxb=-c54w.ek0*p6(2)+p6k0*c54w.e(2) r6_54w.a(2)=wcl*(cauxa-ceps_0) r6_54w.b(1)=wcl*(cauxb-ceps_2) DO i=1,2 * TLTR0_W -- aa=cc6(i),a1=l3_12(i).a,c1=l3_12(i).c,a2=r6_54w.a,b2=r6_54w.b, * prq=p123q,den=(p123q*p123k0),nsum=0 cc6(i)=( l3_12(i).c(2)*p123q*r6_54w.b(1)+l3_12(i).a(2)*r6_ & 54w.a(2) )/(p123q*p123k0) END DO IF (i3e.EQ.1) THEN * quqd -- p=p2,q=p3 quqd=p2(0)*p3(0)-p2(1)*p3(1)-p2(2)*p3(2)-p2(3)*p3(3) * il - qui e in cdw e' perche' i propagatori bosonici portano un segno * - rispetto a quelli fermionici cdz=-1.d0/(-2.d0*quqd-rmz2+ccz) df=-1.d0/(-2.d0*quqd) c df=-1.d0/(2.d0*(0.0005d0**2)-2.d0*quqd+2.d0*p2(0)*p3(0)* c & (0.0005d0)**2*(1/(2.d0*p3(0)**2)+2.d0/s)) fac1=(df*fer) fac2=(df*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p3,qd=p2,v=0,a=c23f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p3(2)*p2(3)+p2(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p2(0)+p2k0*p3(0) c23f(1).e(0)=fac1*(auxa+ceps_0) c23f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=1,a=c23f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23f(1).e(1)=fac1*(auxa+ceps_0) c23f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=2,a=c23f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p3k0*p2(3)+p2k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p2(2)+p2k0*p3(2) c23f(1).e(2)=fac1*(auxa+ceps_0) c23f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=3,a=c23f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p3k0*p2(2)-p2k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p2(3)+p2k0*p3(3) c23f(1).e(3)=fac1*(auxa+ceps_0) c23f(2).e(3)=fac2*(auxa-ceps_0) DO m=0,3 c23z(1).e(m)=cfac1z*c23f(1).e(m) c23z(2).e(m)=cfac2z*c23f(2).e(m) END DO IF (ianc.EQ.0) THEN DO i=1,2 DO mu=0,3 c23fz(i).e(mu)=c23f(i).e(mu)+rcotw*c23z(i).e(mu) END DO END DO ELSE DO i=1,2 DO mu=0,3 c23fz(i).e(mu)=c23f(i).e(mu)+(rcotw+delz)*c23z(i). & e(mu) END DO END DO ENDIF DO i=1,2 DO mu=0,3 c23fz5(i).e(mu)=c23f(i).e(mu)*f5l & +c23z(i).e(mu)*z5l c23fz4(i).e(mu)=c23f(i).e(mu)*f4l & +c23z(i).e(mu)*z4l c23fz1(i).e(mu)=c23f(i).e(mu)*fel & +c23z(i).e(mu)*zel END DO END DO DO i=1,2 * pk0 -- p=c23z(i).e c23z(i).ek0=c23z(i).e(0)-c23z(i).e(1) END DO DO i=1,2 * pk0 -- p=c23fz5(i).e c23fz5(i).ek0=c23fz5(i).e(0)-c23fz5(i).e(1) END DO DO i=1,2 * pk0 -- p=c23fz4(i).e c23fz4(i).ek0=c23fz4(i).e(0)-c23fz4(i).e(1) END DO DO i=1,2 * pk0 -- p=c23fz1(i).e c23fz1(i).ek0=c23fz1(i).e(0)-c23fz1(i).e(1) END DO * quqd -- p=p1,q=p6 quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) ccl=wcl/(2.d0*quqd+rmw2-ccw) * TW10 -- qu=p1,qd=p6,v=0,a=c16w.e(0),cl=ccl,nsum=0 eps_0=-p1(2)*p6(3)+p6(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p6(0)+p6k0*p1(0) c16w.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=1,a=c16w.e(1),cl=ccl,nsum=0 auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16w.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=2,a=c16w.e(2),cl=ccl,nsum=0 eps_0=-p1k0*p6(3)+p6k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p6(2)+p6k0*p1(2) c16w.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=3,a=c16w.e(3),cl=ccl,nsum=0 eps_0=p1k0*p6(2)-p6k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p6(3)+p6k0*p1(3) c16w.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c16w.e c16w.ek0=c16w.e(0)-c16w.e(1) * * diagramma triplo 20 cc7 * *** triple vertex -- pfz(mu)=p23(mu),pwm(mu)=p16(mu),pwp(mu)=p45(mu),efz=c2 * 3fz(i),ewm=c16w,ewp=c54w,res=cc7(i?) DO mu=0,3 vfz(mu)=p16(mu)-p45(mu) vwm(mu)=p45(mu)-p23(mu) vwp(mu)=p23(mu)-p16(mu) END DO !mu * vfz.efz DO i=1,2 * p.q -- p.q=c23fz(i).v,p=c23fz(i).e,q=vfz c23fz(i).v=c23fz(i).e(0)*vfz(0)-c23fz(i).e(1)*vfz(1)-c23fz & (i).e(2)*vfz(2)-c23fz(i).e(3)*vfz(3) END DO * vwm.ewm * p.q -- p.q=c16w.v,p=c16w.e,q=vwm c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c54w.v,p=c54w.e,q=vwp c54w.v=c54w.e(0)*vwp(0)-c54w.e(1)*vwp(1)-c54w.e(2)*vwp(2)- & c54w.e(3)*vwp(3) * efz.ewm DO i=1,2 * p.q -- p.q=caux,p=c23fz(i).e,q=c16w.e caux=c23fz(i).e(0)*c16w.e(0)-c23fz(i).e(1)*c16w.e(1)-c23fz & (i).e(2)*c16w.e(2)-c23fz(i).e(3)*c16w.e(3) cc7(i)=c54w.v*caux END DO * efz.ewp DO i=1,2 * p.q -- p.q=caux,p=c23fz(i).e,q=c54w.e caux=c23fz(i).e(0)*c54w.e(0)-c23fz(i).e(1)*c54w.e(1)-c23fz & (i).e(2)*c54w.e(2)-c23fz(i).e(3)*c54w.e(3) cc7(i)=cc7(i)+c16w.v*caux END DO * ewm.ewp * p.q -- p.q=caux,p=c16w.e,q=c54w.e caux=c16w.e(0)*c54w.e(0)-c16w.e(1)*c54w.e(1)-c16w.e(2)*c54 & w.e(2)-c16w.e(3)*c54w.e(3) DO i=1,2 cc7(i)=cc7(i)+c23fz(i).v*caux END DO * anomalous couplings IF (ianc.NE.0) THEN * p.q -- p.q=cemp0,p=c16w.e,q=p23 cemp0=c16w.e(0)*p23(0)-c16w.e(1)*p23(1)-c16w.e(2)*p23(2)-c & 16w.e(3)*p23(3) * p.q -- p.q=cepp0,p=c54w.e,q=p23 cepp0=c54w.e(0)*p23(0)-c54w.e(1)*p23(1)-c54w.e(2)*p23(2)-c & 54w.e(3)*p23(3) IF (xf.NE.0.d0.OR.xz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c23fz(i).e(mu)=xf*c23f(i).e(mu)+xz*c23z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c23fz(i).e,q=c16w.e ce0em(i)=c23fz(i).e(0)*c16w.e(0)-c23fz(i).e(1)*c16w. & e(1)-c & 23fz(i).e(2)*c16w.e(2)-c23fz(i).e(3)*c16w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c23fz(i).e,q=c54w.e ce0ep(i)=c23fz(i).e(0)*c54w.e(0)-c23fz(i).e(1)*c54w. & e(1)-c & 23fz(i).e(2)*c54w.e(2)-c23fz(i).e(3)*c54w.e(3) END DO DO i=1,2 cc7(i)=cc7(i)+ce0em(i)*cepp0-ce0ep(i)*cemp0 END DO ENDIF IF (yf.NE.0.d0.OR.yz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c23fz(i).e(mu)=yf*c23f(i).e(mu)+yz*c23z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c23fz(i).e,q=c16w.e ce0em(i)=c23fz(i).e(0)*c16w.e(0)-c23fz(i).e(1)*c16w. & e(1)-c & 23fz(i).e(2)*c16w.e(2)-c23fz(i).e(3)*c16w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c23fz(i).e,q=c54w.e ce0ep(i)=c23fz(i).e(0)*c54w.e(0)-c23fz(i).e(1)*c54w. & e(1)-c & 23fz(i).e(2)*c54w.e(2)-c23fz(i).e(3)*c54w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0pm(i),p=c23fz(i).e,q=p16 ce0pm(i)=c23fz(i).e(0)*p16(0)-c23fz(i).e(1)*p16(1) & -c23fz(i & ).e(2)*p16(2)-c23fz(i).e(3)*p16(3) END DO DO i=1,2 * p.q -- p.q=ce0pp(i),p=c23fz(i).e,q=p45 ce0pp(i)=c23fz(i).e(0)*p45(0)-c23fz(i).e(1)*p45(1) & -c23fz(i & ).e(2)*p45(2)-c23fz(i).e(3)*p45(3) END DO * p.q -- p.q=cemep,p=c16w.e,q=c54w.e cemep=c16w.e(0)*c54w.e(0)-c16w.e(1)*c54w.e(1)-c16w.e(2) & *c5 & 4w.e(2)-c16w.e(3)*c54w.e(3) * p.q -- p.q=cempp,p=c16w.e,q=p45 cempp=c16w.e(0)*p45(0)-c16w.e(1)*p45(1)-c16w.e(2)*p45(2) & -c & 16w.e(3)*p45(3) * p.q -- p.q=ceppm,p=c54w.e,q=p16 ceppm=c54w.e(0)*p16(0)-c54w.e(1)*p16(1)-c54w.e(2)*p16(2) & -c & 54w.e(3)*p16(3) * p.q -- p.q=p0pm,p=p23,q=p16 p0pm=p23(0)*p16(0)-p23(1)*p16(1)-p23(2)*p16(2)-p23(3) & *p16( & 3) * p.q -- p.q=p0pp,p=p23,q=p45 p0pp=p23(0)*p45(0)-p23(1)*p45(1)-p23(2)*p45(2)-p23(3) & *p45( & 3) * p.q -- p.q=pmpp,p=p16,q=p45 pmpp=p16(0)*p45(0)-p16(1)*p45(1)-p16(2)*p45(2)-p16(3) & *p45( & 3) DO i=1,2 cc7(i)=cc7(i)+ce0pm(i)*cepp0*cempp-ce0pp(i) & *ceppm*cemp0+ & p0pp*(ce0em(i)*ceppm-cemep*ce0pm(i))+ & p0pm*(cemep*ce0pp(i)-ce0ep(i)*cempp)+ & pmpp*(ce0ep(i)*cemp0-ce0em(i)*cepp0) END DO ENDIF IF (zz.NE.0.d0) THEN DO m=0,3 cpau(m)=cepp0*c16w.e(m)-cemp0*c54w.e(m) pau(m)=p45(m)-p16(m) ENDDO DO i=1,2 * eps -- eps=cau(i),p=c23z(i).e,q=cpau,r=p23,s=pau cau(i)=c23z(i).e(0)*(cpau(1)*(p23(2)*pau(3)-p23(3) & *pau(2)) & +cpau(2)*(p23(3)*pau(1)-p23(1)*pau(3))+cpau(3) & *(p23(1)*pa & u(2)-p23(2)*pau(1))) cau(i)=cau(i)-c23z(i).e(1)*(cpau(2)*(p23(3)*pau(0) & -p23(0)* & pau(3))+cpau(3)*(p23(0)*pau(2)-p23(2)*pau(0)) & +cpau(0)*(p2 & 3(2)*pau(3)-p23(3)*pau(2))) cau(i)=cau(i)+c23z(i).e(2)*(cpau(3)*(p23(0)*pau(1) & -p23(1)* & pau(0))+cpau(0)*(p23(1)*pau(3)-p23(3)*pau(1)) & +cpau(1)*(p2 & 3(3)*pau(0)-p23(0)*pau(3))) cau(i)=cau(i)-c23z(i).e(3)*(cpau(0)*(p23(1)*pau(2) & -p23(2)* & pau(1))+cpau(1)*(p23(2)*pau(0)-p23(0)*pau(2)) & +cpau(2)*(p2 & 3(0)*pau(1)-p23(1)*pau(0))) END DO DO i=1,2 cc7(i)=cc7(i)+cim*zz*cau(i) ENDDO ENDIF ENDIF * end anomalous couplings * * diagramma cc8 * * quqd -- p=p145,q=p6 quqd=p145(0)*p6(0)-p145(1)*p6(1)-p145(2)*p6(2)-p145(3)*p6( & 3) DO i=1,2 * TWR0 -- qu=p145,qd=p6,v=c23z(i).e,a=r6_23(i).a,b=r6_23(i).b,cl=z6l,nsum=0 ceps_0=-c23z(i).ek0*(p145(2)*p6(3)-p6(2)*p145(3))+p145k0*( & c23z(i).e(2)*p6(3)-p6(2)*c23z(i).e(3))-p6k0*(c23z(i). & e(2) & *p145(3)-p145(2)*c23z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c23z(i).e(3)*p6k0+p6(3)*c23z(i).ek0 ceps_2=ceps_2*cim cvqu=c23z(i).e(0)*p145(0)-c23z(i).e(1)*p145(1)-c23z(i).e(2 & )*p145(2)-c23z(i).e(3)*p145(3) cvqd=c23z(i).e(0)*p6(0)-c23z(i).e(1)*p6(1)-c23z(i).e(2)*p6 & (2)-c23z(i).e(3)*p6(3) cauxa=-c23z(i).ek0*quqd+p145k0*cvqd+p6k0*cvqu cauxb=-c23z(i).ek0*p6(2)+p6k0*c23z(i).e(2) r6_23(i).a(2)=z6l*(cauxa-ceps_0) r6_23(i).b(1)=z6l*(cauxb-ceps_2) END DO DO i=1,2 * TLTR0_W -- aa=cc8(i),a1=l1_54w.a,c1=l1_54w.c,a2=r6_23(i).a,b2=r6_23(i).b, * prq=p145q,den=(p145q*p145k0),nsum=0 cc8(i)=( l1_54w.c(2)*p145q*r6_23(i).b(1)+l1_54w.a(2)*r6_23 & (i).a(2) )/(p145q*p145k0) END DO * * diagramma cc9 * * quqd -- p=p1,q=p123 quqd=p1(0)*p123(0)-p1(1)*p123(1)-p1(2)*p123(2)-p1(3)*p123( & 3) DO i=1,2 * TWL0 -- qu=p1,qd=p123,v=c23fz1(i).e,a=l1_23(i).a,c=l1_23(i).c,cl=1.d0,nsu * m=0 ceps_0=-c23fz1(i).ek0*(p1(2)*p123(3)-p123(2)*p1(3))+p1k0*( & c23fz1(i).e(2)*p123(3)-p123(2)*c23fz1(i).e(3)) & -p123k0*(c2 & 3fz1(i).e(2)*p1(3)-p1(2)*c23fz1(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c23fz1(i).e(3)*p1k0+p1(3)*c23fz1(i).ek0 ceps_1=ceps_1*cim cvqu=c23fz1(i).e(0)*p1(0)-c23fz1(i).e(1)*p1(1)-c23fz1(i).e & (2)*p1(2)-c23fz1(i).e(3)*p1(3) cvqd=c23fz1(i).e(0)*p123(0)-c23fz1(i).e(1)*p123(1)-c23fz1( & i).e(2)*p123(2)-c23fz1(i).e(3)*p123(3) cauxa=-c23fz1(i).ek0*quqd+p1k0*cvqd+p123k0*cvqu cauxc=+c23fz1(i).ek0*p1(2)-p1k0*c23fz1(i).e(2) l1_23(i).a(2)=1.d0*(cauxa-ceps_0) l1_23(i).c(2)=1.d0*(-cauxc+ceps_1) END DO DO i=1,2 * TLTR0_W -- aa=cc9(i),a1=l1_23(i).a,c1=l1_23(i).c,a2=r6_54w.a,b2=r6_54w.b, * prq=p123q,den=(p123q*p123k0),nsum=0 cc9(i)=( l1_23(i).c(2)*p123q*r6_54w.b(1)+l1_23(i).a(2)*r6_ & 54w.a(2) )/(p123q*p123k0) END DO * * diagramma cc10 * * quqd -- p=p345,q=p2 quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) * TWR0 -- qu=p345,qd=p2,v=c16w.e,a=r2_16w.a,b=r2_16w.b,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p345(2)*p2(3)-p2(2)*p345(3))+p345k0*(c16 & w.e(2)*p2(3)-p2(2)*c16w.e(3))-p2k0*(c16w.e(2)*p345(3)-p34 & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_2=-c16w.e(3)*p2k0+p2(3)*c16w.ek0 ceps_2=ceps_2*cim cvqu=c16w.e(0)*p345(0)-c16w.e(1)*p345(1)-c16w.e(2)*p345(2) & -c16w.e(3)*p345(3) cvqd=c16w.e(0)*p2(0)-c16w.e(1)*p2(1)-c16w.e(2)*p2(2)-c16w. & e(3)*p2(3) cauxa=-c16w.ek0*quqd+p345k0*cvqd+p2k0*cvqu cauxb=-c16w.ek0*p2(2)+p2k0*c16w.e(2) r2_16w.a(2)=wcl*(cauxa-ceps_0) r2_16w.b(1)=wcl*(cauxb-ceps_2) * TLTR0_W -- aa=cc10(&),a1=l3_54w.a,c1=l3_54w.c,a2=r2_16w.a,b2=r2_16w.b,prq * =p345q,den=(p345q*p345k0),nsum=0 cc10(2)=( l3_54w.c(2)*p345q*r2_16w.b(1)+l3_54w.a(2)*r2_16w & .a(2) )/(p345q*p345k0) * * diagramma cc11 * * quqd -- p=p5,q=p156 quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) * TWL0 -- qu=p5,qd=p156,v=c16w.e,a=l5_16w.a,c=l5_16w.c,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p5(2)*p156(3)-p156(2)*p5(3))+p5k0*(c16w. & e(2)*p156(3)-p156(2)*c16w.e(3))-p156k0*(c16w.e(2)*p5(3)-p & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_1=-c16w.e(3)*p5k0+p5(3)*c16w.ek0 ceps_1=ceps_1*cim cvqu=c16w.e(0)*p5(0)-c16w.e(1)*p5(1)-c16w.e(2)*p5(2)-c16w. & e(3)*p5(3) cvqd=c16w.e(0)*p156(0)-c16w.e(1)*p156(1)-c16w.e(2)*p156(2) & -c16w.e(3)*p156(3) cauxa=-c16w.ek0*quqd+p5k0*cvqd+p156k0*cvqu cauxc=+c16w.ek0*p5(2)-p5k0*c16w.e(2) l5_16w.a(2)=wcl*(cauxa-ceps_0) l5_16w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p156,q=p4 quqd=p156(0)*p4(0)-p156(1)*p4(1)-p156(2)*p4(2)-p156(3)*p4( & 3) DO i=1,2 * TWR0 -- qu=p156,qd=p4,v=c23fz4(i).e,a=r4_23(i).a,b=r4_23(i).b,cl=1.d0,nsu * m=0 ceps_0=-c23fz4(i).ek0*(p156(2)*p4(3)-p4(2)*p156(3))+p156k0 & *(c23fz4(i).e(2)*p4(3)-p4(2)*c23fz4(i).e(3)) & -p4k0*(c23fz4 & (i).e(2)*p156(3)-p156(2)*c23fz4(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c23fz4(i).e(3)*p4k0+p4(3)*c23fz4(i).ek0 ceps_2=ceps_2*cim cvqu=c23fz4(i).e(0)*p156(0)-c23fz4(i).e(1)*p156(1)-c23fz4( & i).e(2)*p156(2)-c23fz4(i).e(3)*p156(3) cvqd=c23fz4(i).e(0)*p4(0)-c23fz4(i).e(1)*p4(1)-c23fz4(i).e & (2)*p4(2)-c23fz4(i).e(3)*p4(3) cauxa=-c23fz4(i).ek0*quqd+p156k0*cvqd+p4k0*cvqu cauxb=-c23fz4(i).ek0*p4(2)+p4k0*c23fz4(i).e(2) r4_23(i).a(2)=1.d0*(cauxa-ceps_0) r4_23(i).b(1)=1.d0*(cauxb-ceps_2) END DO DO i=1,2 * TLTR0_W -- aa=cc11(i),a1=l5_16w.a,c1=l5_16w.c,a2=r4_23(i).a,b2=r4_23(i).b * ,prq=p156q,den=(p156q*p156k0),nsum=0 cc11(i)=( l5_16w.c(2)*p156q*r4_23(i).b(1)+l5_16w.a(2)*r4_2 & 3(i).a(2) )/(p156q*p156k0) END DO * * diagramma cc12 * * quqd -- p=p5,q=p235 quqd=p5(0)*p235(0)-p5(1)*p235(1)-p5(2)*p235(2)-p5(3)*p235( & 3) DO i=1,2 * TWL0 -- qu=p5,qd=p235,v=c23fz5(i).e,a=l5_23(i).a,c=l5_23(i).c,cl=1.d0,nsu * m=0 ceps_0=-c23fz5(i).ek0*(p5(2)*p235(3)-p235(2)*p5(3))+p5k0*( & c23fz5(i).e(2)*p235(3)-p235(2)*c23fz5(i).e(3)) & -p235k0*(c2 & 3fz5(i).e(2)*p5(3)-p5(2)*c23fz5(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c23fz5(i).e(3)*p5k0+p5(3)*c23fz5(i).ek0 ceps_1=ceps_1*cim cvqu=c23fz5(i).e(0)*p5(0)-c23fz5(i).e(1)*p5(1)-c23fz5(i).e & (2)*p5(2)-c23fz5(i).e(3)*p5(3) cvqd=c23fz5(i).e(0)*p235(0)-c23fz5(i).e(1)*p235(1)-c23fz5( & i).e(2)*p235(2)-c23fz5(i).e(3)*p235(3) cauxa=-c23fz5(i).ek0*quqd+p5k0*cvqd+p235k0*cvqu cauxc=+c23fz5(i).ek0*p5(2)-p5k0*c23fz5(i).e(2) l5_23(i).a(2)=1.d0*(cauxa-ceps_0) l5_23(i).c(2)=1.d0*(-cauxc+ceps_1) END DO * quqd -- p=p235,q=p4 quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) * TWR0 -- qu=p235,qd=p4,v=c16w.e,a=r4_16w.a,b=r4_16w.b,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p235(2)*p4(3)-p4(2)*p235(3))+p235k0*(c16 & w.e(2)*p4(3)-p4(2)*c16w.e(3))-p4k0*(c16w.e(2)*p235(3)-p23 & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_2=-c16w.e(3)*p4k0+p4(3)*c16w.ek0 ceps_2=ceps_2*cim cvqu=c16w.e(0)*p235(0)-c16w.e(1)*p235(1)-c16w.e(2)*p235(2) & -c16w.e(3)*p235(3) cvqd=c16w.e(0)*p4(0)-c16w.e(1)*p4(1)-c16w.e(2)*p4(2)-c16w. & e(3)*p4(3) cauxa=-c16w.ek0*quqd+p235k0*cvqd+p4k0*cvqu cauxb=-c16w.ek0*p4(2)+p4k0*c16w.e(2) r4_16w.a(2)=wcl*(cauxa-ceps_0) r4_16w.b(1)=wcl*(cauxb-ceps_2) DO i=1,2 * TLTR0_W -- aa=cc12(i),a1=l5_23(i).a,c1=l5_23(i).c,a2=r4_16w.a,b2=r4_16w.b * ,prq=p235q,den=(p235q*p235k0),nsum=0 cc12(i)=( l5_23(i).c(2)*p235q*r4_16w.b(1)+l5_23(i).a(2)*r4 & _16w.a(2) )/(p235q*p235k0) END DO **** fine i3e ENDIF IF (i4e.EQ.1) THEN * quqd -- p=p4,q=p1 quqd=p4(0)*p1(0)-p4(1)*p1(1)-p4(2)*p1(2)-p4(3)*p1(3) * il - qui e in cdw e' perche' i propagatori bosonici portano un segno * - rispetto a quelli fermionici cdz=-1.d0/(-2.d0*quqd-rmz2+ccz) df=-1.d0/(-2.d0*quqd) fac1=(df*fer) fac2=(df*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p1,qd=p4,v=0,a=c41f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p1(2)*p4(3)+p4(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p4(0)+p4k0*p1(0) c41f(1).e(0)=fac1*(auxa+ceps_0) c41f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=1,a=c41f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c41f(1).e(1)=fac1*(auxa+ceps_0) c41f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=2,a=c41f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p1k0*p4(3)+p4k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p4(2)+p4k0*p1(2) c41f(1).e(2)=fac1*(auxa+ceps_0) c41f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=3,a=c41f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p1k0*p4(2)-p4k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p4(3)+p4k0*p1(3) c41f(1).e(3)=fac1*(auxa+ceps_0) c41f(2).e(3)=fac2*(auxa-ceps_0) DO m=0,3 c41z(1).e(m)=cfac1z*c41f(1).e(m) c41z(2).e(m)=cfac2z*c41f(2).e(m) END DO IF (ianc.EQ.0) THEN DO i=1,2 DO mu=0,3 c41fz(i).e(mu)=c41f(i).e(mu)+rcotw*c41z(i).e(mu) END DO END DO ELSE DO i=1,2 DO mu=0,3 c41fz(i).e(mu)=c41f(i).e(mu)+(rcotw+delz)*c41z(i). & e(mu) END DO END DO ENDIF DO i=1,2 DO mu=0,3 c41fz3(i).e(mu)=c41f(i).e(mu)*f3l & +c41z(i).e(mu)*z3l c41fz6(i).e(mu)=c41f(i).e(mu)*f6l & +c41z(i).e(mu)*z6l c41fz2(i).e(mu)=c41f(i).e(mu)*fel & +c41z(i).e(mu)*zel END DO END DO DO i=1,2 * pk0 -- p=c41z(i).e c41z(i).ek0=c41z(i).e(0)-c41z(i).e(1) END DO DO i=1,2 * pk0 -- p=c41fz3(i).e c41fz3(i).ek0=c41fz3(i).e(0)-c41fz3(i).e(1) END DO DO i=1,2 * pk0 -- p=c41fz6(i).e c41fz6(i).ek0=c41fz6(i).e(0)-c41fz6(i).e(1) END DO DO i=1,2 * pk0 -- p=c41fz2(i).e c41fz2(i).ek0=c41fz2(i).e(0)-c41fz2(i).e(1) END DO * quqd -- p=p5,q=p2 quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) ccl=wcl/(2.d0*quqd+rmw2-ccw) * TW10 -- qu=p5,qd=p2,v=0,a=c52w.e(0),cl=ccl,nsum=0 eps_0=-p5(2)*p2(3)+p2(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p2(0)+p2k0*p5(0) c52w.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=1,a=c52w.e(1),cl=ccl,nsum=0 auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c52w.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=2,a=c52w.e(2),cl=ccl,nsum=0 eps_0=-p5k0*p2(3)+p2k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p2(2)+p2k0*p5(2) c52w.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=3,a=c52w.e(3),cl=ccl,nsum=0 eps_0=p5k0*p2(2)-p2k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p2(3)+p2k0*p5(3) c52w.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c52w.e c52w.ek0=c52w.e(0)-c52w.e(1) * * diagramma triplo 20 cc13 * *** triple vertex -- pfz(mu)=p14(mu),pwm(mu)=p36(mu),pwp(mu)=p25(mu),efz=c4 * 1fz(i),ewm=c36w,ewp=c52w,res=cc13(i?) DO mu=0,3 vfz(mu)=p36(mu)-p25(mu) vwm(mu)=p25(mu)-p14(mu) vwp(mu)=p14(mu)-p36(mu) END DO !mu * vfz.efz DO i=1,2 * p.q -- p.q=c41fz(i).v,p=c41fz(i).e,q=vfz c41fz(i).v=c41fz(i).e(0)*vfz(0)-c41fz(i).e(1)*vfz(1)-c41fz & (i).e(2)*vfz(2)-c41fz(i).e(3)*vfz(3) END DO * vwm.ewm * p.q -- p.q=c36w.v,p=c36w.e,q=vwm c36w.v=c36w.e(0)*vwm(0)-c36w.e(1)*vwm(1)-c36w.e(2)*vwm(2)- & c36w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c52w.v,p=c52w.e,q=vwp c52w.v=c52w.e(0)*vwp(0)-c52w.e(1)*vwp(1)-c52w.e(2)*vwp(2)- & c52w.e(3)*vwp(3) * efz.ewm DO i=1,2 * p.q -- p.q=caux,p=c41fz(i).e,q=c36w.e caux=c41fz(i).e(0)*c36w.e(0)-c41fz(i).e(1)*c36w.e(1)-c41fz & (i).e(2)*c36w.e(2)-c41fz(i).e(3)*c36w.e(3) cc13(i)=c52w.v*caux END DO * efz.ewp DO i=1,2 * p.q -- p.q=caux,p=c41fz(i).e,q=c52w.e caux=c41fz(i).e(0)*c52w.e(0)-c41fz(i).e(1)*c52w.e(1)-c41fz & (i).e(2)*c52w.e(2)-c41fz(i).e(3)*c52w.e(3) cc13(i)=cc13(i)+c36w.v*caux END DO * ewm.ewp * p.q -- p.q=caux,p=c36w.e,q=c52w.e caux=c36w.e(0)*c52w.e(0)-c36w.e(1)*c52w.e(1)-c36w.e(2)*c52 & w.e(2)-c36w.e(3)*c52w.e(3) DO i=1,2 cc13(i)=cc13(i)+c41fz(i).v*caux END DO * anomalous couplings IF (ianc.NE.0) THEN * p.q -- p.q=cemp0,p=c36w.e,q=p14 cemp0=c36w.e(0)*p14(0)-c36w.e(1)*p14(1)-c36w.e(2)*p14(2)-c & 36w.e(3)*p14(3) * p.q -- p.q=cepp0,p=c52w.e,q=p14 cepp0=c52w.e(0)*p14(0)-c52w.e(1)*p14(1)-c52w.e(2)*p14(2)-c & 52w.e(3)*p14(3) IF (xf.NE.0.d0.OR.xz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c41fz(i).e(mu)=xf*c41f(i).e(mu)+xz*c41z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c41fz(i).e,q=c36w.e ce0em(i)=c41fz(i).e(0)*c36w.e(0)-c41fz(i).e(1)*c36w. & e(1)-c & 41fz(i).e(2)*c36w.e(2)-c41fz(i).e(3)*c36w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c41fz(i).e,q=c52w.e ce0ep(i)=c41fz(i).e(0)*c52w.e(0)-c41fz(i).e(1)*c52w. & e(1)-c & 41fz(i).e(2)*c52w.e(2)-c41fz(i).e(3)*c52w.e(3) END DO DO i=1,2 cc13(i)=cc13(i)+ce0em(i)*cepp0-ce0ep(i)*cemp0 END DO ENDIF IF (yf.NE.0.d0.OR.yz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c41fz(i).e(mu)=yf*c41f(i).e(mu)+yz*c41z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c41fz(i).e,q=c36w.e ce0em(i)=c41fz(i).e(0)*c36w.e(0)-c41fz(i).e(1)*c36w. & e(1)-c & 41fz(i).e(2)*c36w.e(2)-c41fz(i).e(3)*c36w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c41fz(i).e,q=c52w.e ce0ep(i)=c41fz(i).e(0)*c52w.e(0)-c41fz(i).e(1)*c52w. & e(1)-c & 41fz(i).e(2)*c52w.e(2)-c41fz(i).e(3)*c52w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0pm(i),p=c41fz(i).e,q=p36 ce0pm(i)=c41fz(i).e(0)*p36(0)-c41fz(i).e(1)*p36(1) & -c41fz(i & ).e(2)*p36(2)-c41fz(i).e(3)*p36(3) END DO DO i=1,2 * p.q -- p.q=ce0pp(i),p=c41fz(i).e,q=p25 ce0pp(i)=c41fz(i).e(0)*p25(0)-c41fz(i).e(1)*p25(1) & -c41fz(i & ).e(2)*p25(2)-c41fz(i).e(3)*p25(3) END DO * p.q -- p.q=cemep,p=c36w.e,q=c52w.e cemep=c36w.e(0)*c52w.e(0)-c36w.e(1)*c52w.e(1)-c36w.e(2) & *c5 & 2w.e(2)-c36w.e(3)*c52w.e(3) * p.q -- p.q=cempp,p=c36w.e,q=p25 cempp=c36w.e(0)*p25(0)-c36w.e(1)*p25(1)-c36w.e(2)*p25(2) & -c & 36w.e(3)*p25(3) * p.q -- p.q=ceppm,p=c52w.e,q=p36 ceppm=c52w.e(0)*p36(0)-c52w.e(1)*p36(1)-c52w.e(2)*p36(2) & -c & 52w.e(3)*p36(3) * p.q -- p.q=p0pm,p=p14,q=p36 p0pm=p14(0)*p36(0)-p14(1)*p36(1)-p14(2)*p36(2)-p14(3) & *p36( & 3) * p.q -- p.q=p0pp,p=p14,q=p25 p0pp=p14(0)*p25(0)-p14(1)*p25(1)-p14(2)*p25(2)-p14(3) & *p25( & 3) * p.q -- p.q=pmpp,p=p36,q=p25 pmpp=p36(0)*p25(0)-p36(1)*p25(1)-p36(2)*p25(2)-p36(3) & *p25( & 3) DO i=1,2 cc13(i)=cc13(i)+ce0pm(i)*cepp0*cempp-ce0pp(i) & *ceppm*cemp0+ & p0pp*(ce0em(i)*ceppm-cemep*ce0pm(i))+ & p0pm*(cemep*ce0pp(i)-ce0ep(i)*cempp)+ & pmpp*(ce0ep(i)*cemp0-ce0em(i)*cepp0) END DO ENDIF IF (zz.NE.0.d0) THEN DO m=0,3 cpau(m)=cepp0*c36w.e(m)-cemp0*c52w.e(m) pau(m)=p25(m)-p36(m) ENDDO DO i=1,2 * eps -- eps=cau(i),p=c41z(i).e,q=cpau,r=p14,s=pau cau(i)=c41z(i).e(0)*(cpau(1)*(p14(2)*pau(3)-p14(3) & *pau(2)) & +cpau(2)*(p14(3)*pau(1)-p14(1)*pau(3))+cpau(3) & *(p14(1)*pa & u(2)-p14(2)*pau(1))) cau(i)=cau(i)-c41z(i).e(1)*(cpau(2)*(p14(3)*pau(0) & -p14(0)* & pau(3))+cpau(3)*(p14(0)*pau(2)-p14(2)*pau(0)) & +cpau(0)*(p1 & 4(2)*pau(3)-p14(3)*pau(2))) cau(i)=cau(i)+c41z(i).e(2)*(cpau(3)*(p14(0)*pau(1) & -p14(1)* & pau(0))+cpau(0)*(p14(1)*pau(3)-p14(3)*pau(1)) & +cpau(1)*(p1 & 4(3)*pau(0)-p14(0)*pau(3))) cau(i)=cau(i)-c41z(i).e(3)*(cpau(0)*(p14(1)*pau(2) & -p14(2)* & pau(1))+cpau(1)*(p14(2)*pau(0)-p14(0)*pau(2)) & +cpau(2)*(p1 & 4(0)*pau(1)-p14(1)*pau(0))) END DO DO i=1,2 cc13(i)=cc13(i)+cim*zz*cau(i) ENDDO ENDIF ENDIF * end anomalous couplings * * diagramma cc14 * * quqd -- p=p356,q=p2 quqd=p356(0)*p2(0)-p356(1)*p2(1)-p356(2)*p2(2)-p356(3)*p2( & 3) DO i=1,2 * TWR0 -- qu=p356,qd=p2,v=c41fz2(i).e,a=r2_14(i).a,b=r2_14(i).b,cl=1.d0,nsu * m=0 ceps_0=-c41fz2(i).ek0*(p356(2)*p2(3)-p2(2)*p356(3))+p356k0 & *(c41fz2(i).e(2)*p2(3)-p2(2)*c41fz2(i).e(3)) & -p2k0*(c41fz2 & (i).e(2)*p356(3)-p356(2)*c41fz2(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c41fz2(i).e(3)*p2k0+p2(3)*c41fz2(i).ek0 ceps_2=ceps_2*cim cvqu=c41fz2(i).e(0)*p356(0)-c41fz2(i).e(1)*p356(1)-c41fz2( & i).e(2)*p356(2)-c41fz2(i).e(3)*p356(3) cvqd=c41fz2(i).e(0)*p2(0)-c41fz2(i).e(1)*p2(1)-c41fz2(i).e & (2)*p2(2)-c41fz2(i).e(3)*p2(3) cauxa=-c41fz2(i).ek0*quqd+p356k0*cvqd+p2k0*cvqu cauxb=-c41fz2(i).ek0*p2(2)+p2k0*c41fz2(i).e(2) r2_14(i).a(2)=1.d0*(cauxa-ceps_0) r2_14(i).b(1)=1.d0*(cauxb-ceps_2) END DO DO i=1,2 * TLTR0_W -- aa=cc14(i),a1=l5_36w.a,c1=l5_36w.c,a2=r2_14(i).a,b2=r2_14(i).b * ,prq=p356q,den=(p356q*p356k0),nsum=0 cc14(i)=( l5_36w.c(2)*p356q*r2_14(i).b(1)+l5_36w.a(2)*r2_1 & 4(i).a(2) )/(p356q*p356k0) END DO * * diagramma cc15 * * quqd -- p=p5,q=p145 quqd=p5(0)*p145(0)-p5(1)*p145(1)-p5(2)*p145(2)-p5(3)*p145( & 3) DO i=1,2 * TWL0 -- qu=p5,qd=p145,v=c41z(i).e,a=l5_14(i).a,c=l5_14(i).c,cl=z5l,nsum=0 ceps_0=-c41z(i).ek0*(p5(2)*p145(3)-p145(2)*p5(3))+p5k0*(c4 & 1z(i).e(2)*p145(3)-p145(2)*c41z(i).e(3)) & -p145k0*(c41z(i). & e(2)*p5(3)-p5(2)*c41z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c41z(i).e(3)*p5k0+p5(3)*c41z(i).ek0 ceps_1=ceps_1*cim cvqu=c41z(i).e(0)*p5(0)-c41z(i).e(1)*p5(1)-c41z(i).e(2)*p5 & (2)-c41z(i).e(3)*p5(3) cvqd=c41z(i).e(0)*p145(0)-c41z(i).e(1)*p145(1)-c41z(i).e(2 & )*p145(2)-c41z(i).e(3)*p145(3) cauxa=-c41z(i).ek0*quqd+p5k0*cvqd+p145k0*cvqu cauxc=+c41z(i).ek0*p5(2)-p5k0*c41z(i).e(2) l5_14(i).a(2)=z5l*(cauxa-ceps_0) l5_14(i).c(2)=z5l*(-cauxc+ceps_1) END DO DO i=1,2 * TLTR0_W -- aa=cc15(i),a1=l5_14(i).a,c1=l5_14(i).c,a2=r2_36w.a,b2=r2_36w.b * ,prq=p145q,den=(p145q*p145k0),nsum=0 cc15(i)=( l5_14(i).c(2)*p145q*r2_36w.b(1)+l5_14(i).a(2)*r2 & _36w.a(2) )/(p145q*p145k0) END DO * * diagramma cc16 * * quqd -- p=p1,q=p125 quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) * TWL0 -- qu=p1,qd=p125,v=c52w.e,a=l1_25w.a,c=l1_25w.c,cl=wcl,nsum=0 ceps_0=-c52w.ek0*(p1(2)*p125(3)-p125(2)*p1(3))+p1k0*(c52w. & e(2)*p125(3)-p125(2)*c52w.e(3))-p125k0*(c52w.e(2)*p1(3)-p & 1(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_1=-c52w.e(3)*p1k0+p1(3)*c52w.ek0 ceps_1=ceps_1*cim cvqu=c52w.e(0)*p1(0)-c52w.e(1)*p1(1)-c52w.e(2)*p1(2)-c52w. & e(3)*p1(3) cvqd=c52w.e(0)*p125(0)-c52w.e(1)*p125(1)-c52w.e(2)*p125(2) & -c52w.e(3)*p125(3) cauxa=-c52w.ek0*quqd+p1k0*cvqd+p125k0*cvqu cauxc=+c52w.ek0*p1(2)-p1k0*c52w.e(2) l1_25w.a(2)=wcl*(cauxa-ceps_0) l1_25w.c(2)=wcl*(-cauxc+ceps_1) * TLTR0_W -- aa=cc16(&),a1=l1_25w.a,c1=l1_25w.c,a2=r4_36w.a,b2=r4_36w.b,prq * =p125q,den=(p125q*p125k0),nsum=0 cc16(2)=( l1_25w.c(2)*p125q*r4_36w.b(1)+l1_25w.a(2)*r4_36w & .a(2) )/(p125q*p125k0) * * diagramma cc17 * * quqd -- p=p3,q=p235 quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) * TWL0 -- qu=p3,qd=p235,v=c52w.e,a=l3_25w.a,c=l3_25w.c,cl=wcl,nsum=0 ceps_0=-c52w.ek0*(p3(2)*p235(3)-p235(2)*p3(3))+p3k0*(c52w. & e(2)*p235(3)-p235(2)*c52w.e(3))-p235k0*(c52w.e(2)*p3(3)-p & 3(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_1=-c52w.e(3)*p3k0+p3(3)*c52w.ek0 ceps_1=ceps_1*cim cvqu=c52w.e(0)*p3(0)-c52w.e(1)*p3(1)-c52w.e(2)*p3(2)-c52w. & e(3)*p3(3) cvqd=c52w.e(0)*p235(0)-c52w.e(1)*p235(1)-c52w.e(2)*p235(2) & -c52w.e(3)*p235(3) cauxa=-c52w.ek0*quqd+p3k0*cvqd+p235k0*cvqu cauxc=+c52w.ek0*p3(2)-p3k0*c52w.e(2) l3_25w.a(2)=wcl*(cauxa-ceps_0) l3_25w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p235,q=p6 quqd=p235(0)*p6(0)-p235(1)*p6(1)-p235(2)*p6(2)-p235(3)*p6( & 3) DO i=1,2 * TWR0 -- qu=p235,qd=p6,v=c41fz6(i).e,a=r6_14(i).a,b=r6_14(i).b,cl=1.d0,nsu * m=0 ceps_0=-c41fz6(i).ek0*(p235(2)*p6(3)-p6(2)*p235(3))+p235k0 & *(c41fz6(i).e(2)*p6(3)-p6(2)*c41fz6(i).e(3)) & -p6k0*(c41fz6 & (i).e(2)*p235(3)-p235(2)*c41fz6(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c41fz6(i).e(3)*p6k0+p6(3)*c41fz6(i).ek0 ceps_2=ceps_2*cim cvqu=c41fz6(i).e(0)*p235(0)-c41fz6(i).e(1)*p235(1)-c41fz6( & i).e(2)*p235(2)-c41fz6(i).e(3)*p235(3) cvqd=c41fz6(i).e(0)*p6(0)-c41fz6(i).e(1)*p6(1)-c41fz6(i).e & (2)*p6(2)-c41fz6(i).e(3)*p6(3) cauxa=-c41fz6(i).ek0*quqd+p235k0*cvqd+p6k0*cvqu cauxb=-c41fz6(i).ek0*p6(2)+p6k0*c41fz6(i).e(2) r6_14(i).a(2)=1.d0*(cauxa-ceps_0) r6_14(i).b(1)=1.d0*(cauxb-ceps_2) END DO DO i=1,2 * TLTR0_W -- aa=cc17(i),a1=l3_25w.a,c1=l3_25w.c,a2=r6_14(i).a,b2=r6_14(i).b * ,prq=p235q,den=(p235q*p235k0),nsum=0 cc17(i)=( l3_25w.c(2)*p235q*r6_14(i).b(1)+l3_25w.a(2)*r6_1 & 4(i).a(2) )/(p235q*p235k0) END DO * * diagramma cc18 * * quqd -- p=p3,q=p134 quqd=p3(0)*p134(0)-p3(1)*p134(1)-p3(2)*p134(2)-p3(3)*p134( & 3) DO i=1,2 * TWL0 -- qu=p3,qd=p134,v=c41fz3(i).e,a=l3_14(i).a,c=l3_14(i).c,cl=1.d0,nsu * m=0 ceps_0=-c41fz3(i).ek0*(p3(2)*p134(3)-p134(2)*p3(3))+p3k0*( & c41fz3(i).e(2)*p134(3)-p134(2)*c41fz3(i).e(3)) & -p134k0*(c4 & 1fz3(i).e(2)*p3(3)-p3(2)*c41fz3(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c41fz3(i).e(3)*p3k0+p3(3)*c41fz3(i).ek0 ceps_1=ceps_1*cim cvqu=c41fz3(i).e(0)*p3(0)-c41fz3(i).e(1)*p3(1)-c41fz3(i).e & (2)*p3(2)-c41fz3(i).e(3)*p3(3) cvqd=c41fz3(i).e(0)*p134(0)-c41fz3(i).e(1)*p134(1)-c41fz3( & i).e(2)*p134(2)-c41fz3(i).e(3)*p134(3) cauxa=-c41fz3(i).ek0*quqd+p3k0*cvqd+p134k0*cvqu cauxc=+c41fz3(i).ek0*p3(2)-p3k0*c41fz3(i).e(2) l3_14(i).a(2)=1.d0*(cauxa-ceps_0) l3_14(i).c(2)=1.d0*(-cauxc+ceps_1) END DO * quqd -- p=p134,q=p6 quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) * TWR0 -- qu=p134,qd=p6,v=c52w.e,a=r6_25w.a,b=r6_25w.b,cl=wcl,nsum=0 ceps_0=-c52w.ek0*(p134(2)*p6(3)-p6(2)*p134(3))+p134k0*(c52 & w.e(2)*p6(3)-p6(2)*c52w.e(3))-p6k0*(c52w.e(2)*p134(3)-p13 & 4(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_2=-c52w.e(3)*p6k0+p6(3)*c52w.ek0 ceps_2=ceps_2*cim cvqu=c52w.e(0)*p134(0)-c52w.e(1)*p134(1)-c52w.e(2)*p134(2) & -c52w.e(3)*p134(3) cvqd=c52w.e(0)*p6(0)-c52w.e(1)*p6(1)-c52w.e(2)*p6(2)-c52w. & e(3)*p6(3) cauxa=-c52w.ek0*quqd+p134k0*cvqd+p6k0*cvqu cauxb=-c52w.ek0*p6(2)+p6k0*c52w.e(2) r6_25w.a(2)=wcl*(cauxa-ceps_0) r6_25w.b(1)=wcl*(cauxb-ceps_2) DO i=1,2 * TLTR0_W -- aa=cc18(i),a1=l3_14(i).a,c1=l3_14(i).c,a2=r6_25w.a,b2=r6_25w.b * ,prq=p134q,den=(p134q*p134k0),nsum=0 cc18(i)=( l3_14(i).c(2)*p134q*r6_25w.b(1)+l3_14(i).a(2)*r6 & _25w.a(2) )/(p134q*p134k0) END DO **** fine i4e ENDIF **** fine icc3=/ 1 ENDIF **** fine CC ENDIF **** inizio NC IF (icc.NE.1) THEN DO ide=0,iid IF (ide.EQ.1) THEN * p3<->p5 per rifare tutti i diagrammi con questo scambio per particelle id. DO mu=0,3 pau(mu)=p3(mu) p3(mu)=p5(mu) p5(mu)=pau(mu) pau(mu)=p25(mu) p25(mu)=p23(mu) p23(mu)=pau(mu) pau(mu)=p34(mu) p34(mu)=p45(mu) p45(mu)=pau(mu) pau(mu)=p36(mu) p36(mu)=p56(mu) p56(mu)=pau(mu) pau(mu)=p123(mu) p123(mu)=p125(mu) p125(mu)=pau(mu) pau(mu)=p134(mu) p134(mu)=p145(mu) p145(mu)=pau(mu) pau(mu)=p156(mu) p156(mu)=p136(mu) p136(mu)=pau(mu) END DO pkau=p3k0 p3k0=p5k0 p5k0=pkau pkau=p3q p3q=p5q p5q=pkau pkau=p123k0 p123k0=p125k0 p125k0=pkau pkau=p123q p123q=p125q p125q=pkau pkau=p134k0 p134k0=p145k0 p145k0=pkau pkau=p134q p134q=p145q p145q=pkau pkau=p156k0 p156k0=p136k0 p136k0=pkau pkau=p156q p156q=p136q p136q=pkau ENDIF * quqd -- p=p5,q=p6 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) df=-1.d0/(2.d0*quqd) cdz=-1.d0/(2.d0*quqd*czipr-rmz2+ccz) fac1=(df*f5r) fac2=(df*f5l) cfac1z=(cdz*z5r) cfac2z=(cdz*z5l) * T10 -- qu=p5,qd=p6,v=0,a=c56f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) c56f(1).e(0)=fac1*(auxa+ceps_0) c56f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=1,a=c56f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56f(1).e(1)=fac1*(auxa+ceps_0) c56f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=2,a=c56f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) c56f(1).e(2)=fac1*(auxa+ceps_0) c56f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=3,a=c56f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p6(3)+p6k0*p5(3) c56f(1).e(3)=fac1*(auxa+ceps_0) c56f(2).e(3)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=0,a=c56z(&).e(0),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) c56z(1).e(0)=cfac1z*(auxa+ceps_0) c56z(2).e(0)=cfac2z*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=1,a=c56z(&).e(1),cr=cfac1z,cl=cfac2z,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56z(1).e(1)=cfac1z*(auxa+ceps_0) c56z(2).e(1)=cfac2z*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=2,a=c56z(&).e(2),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) c56z(1).e(2)=cfac1z*(auxa+ceps_0) c56z(2).e(2)=cfac2z*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=3,a=c56z(&).e(3),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p6(3)+p6k0*p5(3) c56z(1).e(3)=cfac1z*(auxa+ceps_0) c56z(2).e(3)=cfac2z*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c56f(i).e c56f(i).ek0=c56f(i).e(0)-c56f(i).e(1) END DO DO i=1,2 * pk0 -- p=c56z(i).e c56z(i).ek0=c56z(i).e(0)-c56z(i).e(1) END DO * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) df=-1.d0/(2.d0*quqd) cdz=-1.d0/(2.d0*quqd*czipr-rmz2+ccz) fac1=(df*f3r) fac2=(df*f3l) cfac1z=(cdz*z3r) cfac2z=(cdz*z3l) * T10 -- qu=p3,qd=p4,v=0,a=c34f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) c34f(1).e(0)=fac1*(auxa+ceps_0) c34f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=1,a=c34f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) c34f(1).e(1)=fac1*(auxa+ceps_0) c34f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=2,a=c34f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) c34f(1).e(2)=fac1*(auxa+ceps_0) c34f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=3,a=c34f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p4(3)+p4k0*p3(3) c34f(1).e(3)=fac1*(auxa+ceps_0) c34f(2).e(3)=fac2*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=0,a=c34z(&).e(0),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) c34z(1).e(0)=cfac1z*(auxa+ceps_0) c34z(2).e(0)=cfac2z*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=1,a=c34z(&).e(1),cr=cfac1z,cl=cfac2z,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) c34z(1).e(1)=cfac1z*(auxa+ceps_0) c34z(2).e(1)=cfac2z*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=2,a=c34z(&).e(2),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) c34z(1).e(2)=cfac1z*(auxa+ceps_0) c34z(2).e(2)=cfac2z*(auxa-ceps_0) * T10 -- qu=p3,qd=p4,v=3,a=c34z(&).e(3),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p4(3)+p4k0*p3(3) c34z(1).e(3)=cfac1z*(auxa+ceps_0) c34z(2).e(3)=cfac2z*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c34f(i).e c34f(i).ek0=c34f(i).e(0)-c34f(i).e(1) END DO DO i=1,2 * pk0 -- p=c34z(i).e c34z(i).ek0=c34z(i).e(0)-c34z(i).e(1) END DO *****attaccamento di c12f(2) a 3 * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * TL0 -- qu=p3,qd=p123,v=c12f(i).e,a=l3_12fz(i).a,c=l3_12fz(i).c,cr=f3r,cl= * f3l,nsum=0 ceps_0=-c12f(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2f(i).e(2)*p123(3)-p123(2)*c12f(i).e(3))-p123k0*(c12f(i). & e(2)*p3(3)-p3(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p3k0+p3(3)*c12f(i).ek0 ceps_1=ceps_1*cim cvqu=c12f(i).e(0)*p3(0)-c12f(i).e(1)*p3(1)-c12f(i).e(2)*p3 & (2)-c12f(i).e(3)*p3(3) cvqd=c12f(i).e(0)*p123(0)-c12f(i).e(1)*p123(1)-c12f(i).e(2 & )*p123(2)-c12f(i).e(3)*p123(3) cauxa=-c12f(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxc=+c12f(i).ek0*p3(2)-p3k0*c12f(i).e(2) l3_12fz(i).a(1)=f3r*(cauxa+ceps_0) l3_12fz(i).a(2)=f3l*(cauxa-ceps_0) l3_12fz(i).c(1)=f3r*(cauxc+ceps_1) l3_12fz(i).c(2)=f3l*(-cauxc+ceps_1) END DO *****attaccamento di c12z(2) a 3 DO i=1,2 * TL0 -- qu=p3,qd=p123,v=c12z(i).e,a=l3_12fz(i).a,c=l3_12fz(i).c,cr=z3r,cl= * z3l,nsum=1 ceps_0=-c12z(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2z(i).e(2)*p123(3)-p123(2)*c12z(i).e(3))-p123k0*(c12z(i). & e(2)*p3(3)-p3(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p3k0+p3(3)*c12z(i).ek0 ceps_1=ceps_1*cim cvqu=c12z(i).e(0)*p3(0)-c12z(i).e(1)*p3(1)-c12z(i).e(2)*p3 & (2)-c12z(i).e(3)*p3(3) cvqd=c12z(i).e(0)*p123(0)-c12z(i).e(1)*p123(1)-c12z(i).e(2 & )*p123(2)-c12z(i).e(3)*p123(3) cauxa=-c12z(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxc=+c12z(i).ek0*p3(2)-p3k0*c12z(i).e(2) l3_12fz(i).a(1)=l3_12fz(i).a(1)+z3r*(cauxa+ceps_0) l3_12fz(i).a(2)=l3_12fz(i).a(2)+z3l*(cauxa-ceps_0) l3_12fz(i).c(1)=l3_12fz(i).c(1)+z3r*(cauxc+ceps_1) l3_12fz(i).c(2)=l3_12fz(i).c(2)+z3l*(-cauxc+ceps_1) END DO *****attaccamento di c12f(2) a 4 * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * TR0 -- qu=p356,qd=p4,v=c12f(i).e,a=r4_12fz(i).a,b=r4_12fz(i).b,cr=f4r,cl= * f4l,nsum=0 ceps_0=-c12f(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12f(i).e(2)*p4(3)-p4(2)*c12f(i).e(3))-p4k0*(c12f(i).e(2) & *p356(3)-p356(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12f(i).e(3)*p4k0+p4(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p356(0)-c12f(i).e(1)*p356(1)-c12f(i).e(2 & )*p356(2)-c12f(i).e(3)*p356(3) cvqd=c12f(i).e(0)*p4(0)-c12f(i).e(1)*p4(1)-c12f(i).e(2)*p4 & (2)-c12f(i).e(3)*p4(3) cauxa=-c12f(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12f(i).ek0*p4(2)+p4k0*c12f(i).e(2) r4_12fz(i).a(1)=f4r*(cauxa+ceps_0) r4_12fz(i).a(2)=f4l*(cauxa-ceps_0) r4_12fz(i).b(1)=f4l*(cauxb-ceps_2) r4_12fz(i).b(2)=f4r*(-cauxb-ceps_2) END DO *****attaccamento di c12z(2) a 4 DO i=1,2 * TR0 -- qu=p356,qd=p4,v=c12z(i).e,a=r4_12fz(i).a,b=r4_12fz(i).b,cr=z4r,cl= * z4l,nsum=1 ceps_0=-c12z(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12z(i).e(2)*p4(3)-p4(2)*c12z(i).e(3))-p4k0*(c12z(i).e(2) & *p356(3)-p356(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12z(i).e(3)*p4k0+p4(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p356(0)-c12z(i).e(1)*p356(1)-c12z(i).e(2 & )*p356(2)-c12z(i).e(3)*p356(3) cvqd=c12z(i).e(0)*p4(0)-c12z(i).e(1)*p4(1)-c12z(i).e(2)*p4 & (2)-c12z(i).e(3)*p4(3) cauxa=-c12z(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12z(i).ek0*p4(2)+p4k0*c12z(i).e(2) r4_12fz(i).a(1)=r4_12fz(i).a(1)+z4r*(cauxa+ceps_0) r4_12fz(i).a(2)=r4_12fz(i).a(2)+z4l*(cauxa-ceps_0) r4_12fz(i).b(1)=r4_12fz(i).b(1)+z4l*(cauxb-ceps_2) r4_12fz(i).b(2)=r4_12fz(i).b(2)+z4r*(-cauxb-ceps_2) END DO *****attaccamento di c34f(2) a 1 (e+) * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 * TL0 -- qu=p1,qd=p134,v=c34f(i1).e,a=l1_34fz(i1).a,c=l1_34fz(i1).c,cr=fer, * cl=fel,nsum=0 ceps_0=-c34f(i1).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0*(c & 34f(i1).e(2)*p134(3)-p134(2)*c34f(i1).e(3))-p134k0*(c34f( & i1).e(2)*p1(3)-p1(2)*c34f(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i1).e(3)*p1k0+p1(3)*c34f(i1).ek0 ceps_1=ceps_1*cim cvqu=c34f(i1).e(0)*p1(0)-c34f(i1).e(1)*p1(1)-c34f(i1).e(2) & *p1(2)-c34f(i1).e(3)*p1(3) cvqd=c34f(i1).e(0)*p134(0)-c34f(i1).e(1)*p134(1)-c34f(i1). & e(2)*p134(2)-c34f(i1).e(3)*p134(3) cauxa=-c34f(i1).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34f(i1).ek0*p1(2)-p1k0*c34f(i1).e(2) l1_34fz(i1).a(1)=fer*(cauxa+ceps_0) l1_34fz(i1).a(2)=fel*(cauxa-ceps_0) l1_34fz(i1).c(1)=fer*(cauxc+ceps_1) l1_34fz(i1).c(2)=fel*(-cauxc+ceps_1) END DO *****attaccamento di c34z(2) a 1 (e+) DO i1=1,2 * TL0 -- qu=p1,qd=p134,v=c34z(i1).e,a=l1_34fz(i1).a,c=l1_34fz(i1).c,cr=zer, * cl=zel,nsum=1 ceps_0=-c34z(i1).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0*(c & 34z(i1).e(2)*p134(3)-p134(2)*c34z(i1).e(3))-p134k0*(c34z( & i1).e(2)*p1(3)-p1(2)*c34z(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1).e(3)*p1k0+p1(3)*c34z(i1).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1).e(0)*p1(0)-c34z(i1).e(1)*p1(1)-c34z(i1).e(2) & *p1(2)-c34z(i1).e(3)*p1(3) cvqd=c34z(i1).e(0)*p134(0)-c34z(i1).e(1)*p134(1)-c34z(i1). & e(2)*p134(2)-c34z(i1).e(3)*p134(3) cauxa=-c34z(i1).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34z(i1).ek0*p1(2)-p1k0*c34z(i1).e(2) l1_34fz(i1).a(1)=l1_34fz(i1).a(1)+zer*(cauxa+ceps_0) l1_34fz(i1).a(2)=l1_34fz(i1).a(2)+zel*(cauxa-ceps_0) l1_34fz(i1).c(1)=l1_34fz(i1).c(1)+zer*(cauxc+ceps_1) l1_34fz(i1).c(2)=l1_34fz(i1).c(2)+zel*(-cauxc+ceps_1) END DO *****attaccamento di c34f(2) a 2 (e-) * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 * TR0 -- qu=p156,qd=p2,v=c34f(i1).e,a=r2_34fz(i1).a,b=r2_34fz(i1).b,cr=fer, * cl=fel,nsum=0 ceps_0=-c34f(i1).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156k0* & (c34f(i1).e(2)*p2(3)-p2(2)*c34f(i1).e(3))-p2k0*(c34f(i1). & e(2)*p156(3)-p156(2)*c34f(i1).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i1).e(3)*p2k0+p2(3)*c34f(i1).ek0 ceps_2=ceps_2*cim cvqu=c34f(i1).e(0)*p156(0)-c34f(i1).e(1)*p156(1)-c34f(i1). & e(2)*p156(2)-c34f(i1).e(3)*p156(3) cvqd=c34f(i1).e(0)*p2(0)-c34f(i1).e(1)*p2(1)-c34f(i1).e(2) & *p2(2)-c34f(i1).e(3)*p2(3) cauxa=-c34f(i1).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34f(i1).ek0*p2(2)+p2k0*c34f(i1).e(2) r2_34fz(i1).a(1)=fer*(cauxa+ceps_0) r2_34fz(i1).a(2)=fel*(cauxa-ceps_0) r2_34fz(i1).b(1)=fel*(cauxb-ceps_2) r2_34fz(i1).b(2)=fer*(-cauxb-ceps_2) END DO *****attaccamento di c34z(2) a 2 (e-) DO i1=1,2 * TR0 -- qu=p156,qd=p2,v=c34z(i1).e,a=r2_34fz(i1).a,b=r2_34fz(i1).b,cr=zer, * cl=zel,nsum=1 ceps_0=-c34z(i1).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156k0* & (c34z(i1).e(2)*p2(3)-p2(2)*c34z(i1).e(3))-p2k0*(c34z(i1). & e(2)*p156(3)-p156(2)*c34z(i1).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1).e(3)*p2k0+p2(3)*c34z(i1).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1).e(0)*p156(0)-c34z(i1).e(1)*p156(1)-c34z(i1). & e(2)*p156(2)-c34z(i1).e(3)*p156(3) cvqd=c34z(i1).e(0)*p2(0)-c34z(i1).e(1)*p2(1)-c34z(i1).e(2) & *p2(2)-c34z(i1).e(3)*p2(3) cauxa=-c34z(i1).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34z(i1).ek0*p2(2)+p2k0*c34z(i1).e(2) r2_34fz(i1).a(1)=r2_34fz(i1).a(1)+zer*(cauxa+ceps_0) r2_34fz(i1).a(2)=r2_34fz(i1).a(2)+zel*(cauxa-ceps_0) r2_34fz(i1).b(1)=r2_34fz(i1).b(1)+zel*(cauxb-ceps_2) r2_34fz(i1).b(2)=r2_34fz(i1).b(2)+zer*(-cauxb-ceps_2) END DO *****attaccamento di c56f a 3 * quqd -- p=p3,q=p356 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 * TL0 -- qu=p3,qd=p356,v=c56f(i).e,a=l3_56f(i).a,c=l3_56f(i).c,cr=f3r,cl=f3 * l,nsum=0 ceps_0=-c56f(i).ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c5 & 6f(i).e(2)*p356(3)-p356(2)*c56f(i).e(3))-p356k0*(c56f(i). & e(2)*p3(3)-p3(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p3k0+p3(3)*c56f(i).ek0 ceps_1=ceps_1*cim cvqu=c56f(i).e(0)*p3(0)-c56f(i).e(1)*p3(1)-c56f(i).e(2)*p3 & (2)-c56f(i).e(3)*p3(3) cvqd=c56f(i).e(0)*p356(0)-c56f(i).e(1)*p356(1)-c56f(i).e(2 & )*p356(2)-c56f(i).e(3)*p356(3) cauxa=-c56f(i).ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxc=+c56f(i).ek0*p3(2)-p3k0*c56f(i).e(2) l3_56f(i).a(1)=f3r*(cauxa+ceps_0) l3_56f(i).a(2)=f3l*(cauxa-ceps_0) l3_56f(i).c(1)=f3r*(cauxc+ceps_1) l3_56f(i).c(2)=f3l*(-cauxc+ceps_1) END DO *****attaccamento di c56z a 3 DO i=1,2 * TL0 -- qu=p3,qd=p356,v=c56z(i).e,a=l3_56fz(i).a,c=l3_56fz(i).c,cr=z3r,cl= * z3l,nsum=0 ceps_0=-c56z(i).ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c5 & 6z(i).e(2)*p356(3)-p356(2)*c56z(i).e(3))-p356k0*(c56z(i). & e(2)*p3(3)-p3(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p3k0+p3(3)*c56z(i).ek0 ceps_1=ceps_1*cim cvqu=c56z(i).e(0)*p3(0)-c56z(i).e(1)*p3(1)-c56z(i).e(2)*p3 & (2)-c56z(i).e(3)*p3(3) cvqd=c56z(i).e(0)*p356(0)-c56z(i).e(1)*p356(1)-c56z(i).e(2 & )*p356(2)-c56z(i).e(3)*p356(3) cauxa=-c56z(i).ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxc=+c56z(i).ek0*p3(2)-p3k0*c56z(i).e(2) l3_56fz(i).a(1)=z3r*(cauxa+ceps_0) l3_56fz(i).a(2)=z3l*(cauxa-ceps_0) l3_56fz(i).c(1)=z3r*(cauxc+ceps_1) l3_56fz(i).c(2)=z3l*(-cauxc+ceps_1) END DO DO i=1,2 DO ii=1,2 l3_56fz(i).a(ii)=l3_56fz(i).a(ii)+l3_56f(i).a(ii) l3_56fz(i).c(ii)=l3_56fz(i).c(ii)+l3_56f(i).c(ii) END DO END DO *****attaccamento di c56f a 4 * quqd -- p=p123,q=p4 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 * TR0 -- qu=p123,qd=p4,v=c56f(i).e,a=r4_56f(i).a,b=r4_56f(i).b,cr=f4r,cl=f4 * l,nsum=0 ceps_0=-c56f(i).ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*( & c56f(i).e(2)*p4(3)-p4(2)*c56f(i).e(3))-p4k0*(c56f(i).e(2) & *p123(3)-p123(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c56f(i).e(3)*p4k0+p4(3)*c56f(i).ek0 ceps_2=ceps_2*cim cvqu=c56f(i).e(0)*p123(0)-c56f(i).e(1)*p123(1)-c56f(i).e(2 & )*p123(2)-c56f(i).e(3)*p123(3) cvqd=c56f(i).e(0)*p4(0)-c56f(i).e(1)*p4(1)-c56f(i).e(2)*p4 & (2)-c56f(i).e(3)*p4(3) cauxa=-c56f(i).ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56f(i).ek0*p4(2)+p4k0*c56f(i).e(2) r4_56f(i).a(1)=f4r*(cauxa+ceps_0) r4_56f(i).a(2)=f4l*(cauxa-ceps_0) r4_56f(i).b(1)=f4l*(cauxb-ceps_2) r4_56f(i).b(2)=f4r*(-cauxb-ceps_2) END DO *****attaccamento di c56z a 4 DO i=1,2 * TR0 -- qu=p123,qd=p4,v=c56z(i).e,a=r4_56fz(i).a,b=r4_56fz(i).b,cr=z4r,cl= * z4l,nsum=0 ceps_0=-c56z(i).ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*( & c56z(i).e(2)*p4(3)-p4(2)*c56z(i).e(3))-p4k0*(c56z(i).e(2) & *p123(3)-p123(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c56z(i).e(3)*p4k0+p4(3)*c56z(i).ek0 ceps_2=ceps_2*cim cvqu=c56z(i).e(0)*p123(0)-c56z(i).e(1)*p123(1)-c56z(i).e(2 & )*p123(2)-c56z(i).e(3)*p123(3) cvqd=c56z(i).e(0)*p4(0)-c56z(i).e(1)*p4(1)-c56z(i).e(2)*p4 & (2)-c56z(i).e(3)*p4(3) cauxa=-c56z(i).ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56z(i).ek0*p4(2)+p4k0*c56z(i).e(2) r4_56fz(i).a(1)=z4r*(cauxa+ceps_0) r4_56fz(i).a(2)=z4l*(cauxa-ceps_0) r4_56fz(i).b(1)=z4l*(cauxb-ceps_2) r4_56fz(i).b(2)=z4r*(-cauxb-ceps_2) END DO DO i=1,2 DO ii=1,2 r4_56fz(i).a(ii)=r4_56fz(i).a(ii)+r4_56f(i).a(ii) r4_56fz(i).b(ii)=r4_56fz(i).b(ii)+r4_56f(i).b(ii) END DO END DO *****attaccamento di c12f(2) a 5 * quqd -- p=p5,q=p125 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p125,v=c12f(i).e,a=l5_12fz(i).a,c=l5_12fz(i).c,cr=f5r,cl= * f5l,nsum=0 ceps_0=-c12f(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2f(i).e(2)*p125(3)-p125(2)*c12f(i).e(3))-p125k0*(c12f(i). & e(2)*p5(3)-p5(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p5k0+p5(3)*c12f(i).ek0 ceps_1=ceps_1*cim cvqu=c12f(i).e(0)*p5(0)-c12f(i).e(1)*p5(1)-c12f(i).e(2)*p5 & (2)-c12f(i).e(3)*p5(3) cvqd=c12f(i).e(0)*p125(0)-c12f(i).e(1)*p125(1)-c12f(i).e(2 & )*p125(2)-c12f(i).e(3)*p125(3) cauxa=-c12f(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12f(i).ek0*p5(2)-p5k0*c12f(i).e(2) l5_12fz(i).a(1)=f5r*(cauxa+ceps_0) l5_12fz(i).a(2)=f5l*(cauxa-ceps_0) l5_12fz(i).c(1)=f5r*(cauxc+ceps_1) l5_12fz(i).c(2)=f5l*(-cauxc+ceps_1) END DO *****attaccamento di c12z(2) a 5 DO i=1,2 * TL0 -- qu=p5,qd=p125,v=c12z(i).e,a=l5_12fz(i).a,c=l5_12fz(i).c,cr=z5r,cl= * z5l,nsum=1 ceps_0=-c12z(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2z(i).e(2)*p125(3)-p125(2)*c12z(i).e(3))-p125k0*(c12z(i). & e(2)*p5(3)-p5(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p5k0+p5(3)*c12z(i).ek0 ceps_1=ceps_1*cim cvqu=c12z(i).e(0)*p5(0)-c12z(i).e(1)*p5(1)-c12z(i).e(2)*p5 & (2)-c12z(i).e(3)*p5(3) cvqd=c12z(i).e(0)*p125(0)-c12z(i).e(1)*p125(1)-c12z(i).e(2 & )*p125(2)-c12z(i).e(3)*p125(3) cauxa=-c12z(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12z(i).ek0*p5(2)-p5k0*c12z(i).e(2) l5_12fz(i).a(1)=l5_12fz(i).a(1)+z5r*(cauxa+ceps_0) l5_12fz(i).a(2)=l5_12fz(i).a(2)+z5l*(cauxa-ceps_0) l5_12fz(i).c(1)=l5_12fz(i).c(1)+z5r*(cauxc+ceps_1) l5_12fz(i).c(2)=l5_12fz(i).c(2)+z5l*(-cauxc+ceps_1) END DO *****attaccamento di c12f(2) a 6 * quqd -- p=p345,q=p6 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p345,qd=p6,v=c12f(i).e,a=r6_12fz(i).a,b=r6_12fz(i).b,cr=f6r,cl= * f6l,nsum=0 ceps_0=-c12f(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12f(i).e(2)*p6(3)-p6(2)*c12f(i).e(3))-p6k0*(c12f(i).e(2) & *p345(3)-p345(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12f(i).e(3)*p6k0+p6(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p345(0)-c12f(i).e(1)*p345(1)-c12f(i).e(2 & )*p345(2)-c12f(i).e(3)*p345(3) cvqd=c12f(i).e(0)*p6(0)-c12f(i).e(1)*p6(1)-c12f(i).e(2)*p6 & (2)-c12f(i).e(3)*p6(3) cauxa=-c12f(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12f(i).ek0*p6(2)+p6k0*c12f(i).e(2) r6_12fz(i).a(1)=f6r*(cauxa+ceps_0) r6_12fz(i).a(2)=f6l*(cauxa-ceps_0) r6_12fz(i).b(1)=f6l*(cauxb-ceps_2) r6_12fz(i).b(2)=f6r*(-cauxb-ceps_2) END DO *****attaccamento di c12z(2) a 6 DO i=1,2 * TR0 -- qu=p345,qd=p6,v=c12z(i).e,a=r6_12fz(i).a,b=r6_12fz(i).b,cr=z6r,cl= * z6l,nsum=1 ceps_0=-c12z(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12z(i).e(2)*p6(3)-p6(2)*c12z(i).e(3))-p6k0*(c12z(i).e(2) & *p345(3)-p345(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12z(i).e(3)*p6k0+p6(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p345(0)-c12z(i).e(1)*p345(1)-c12z(i).e(2 & )*p345(2)-c12z(i).e(3)*p345(3) cvqd=c12z(i).e(0)*p6(0)-c12z(i).e(1)*p6(1)-c12z(i).e(2)*p6 & (2)-c12z(i).e(3)*p6(3) cauxa=-c12z(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12z(i).ek0*p6(2)+p6k0*c12z(i).e(2) r6_12fz(i).a(1)=r6_12fz(i).a(1)+z6r*(cauxa+ceps_0) r6_12fz(i).a(2)=r6_12fz(i).a(2)+z6l*(cauxa-ceps_0) r6_12fz(i).b(1)=r6_12fz(i).b(1)+z6l*(cauxb-ceps_2) r6_12fz(i).b(2)=r6_12fz(i).b(2)+z6r*(-cauxb-ceps_2) END DO *****attaccamento di c56f(2) a 1 (e+) * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i1=1,2 * TL0 -- qu=p1,qd=p156,v=c56f(i1).e,a=l1_56fz(i1).a,c=l1_56fz(i1).c,cr=fer, * cl=fel,nsum=0 ceps_0=-c56f(i1).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c & 56f(i1).e(2)*p156(3)-p156(2)*c56f(i1).e(3))-p156k0*(c56f( & i1).e(2)*p1(3)-p1(2)*c56f(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i1).e(3)*p1k0+p1(3)*c56f(i1).ek0 ceps_1=ceps_1*cim cvqu=c56f(i1).e(0)*p1(0)-c56f(i1).e(1)*p1(1)-c56f(i1).e(2) & *p1(2)-c56f(i1).e(3)*p1(3) cvqd=c56f(i1).e(0)*p156(0)-c56f(i1).e(1)*p156(1)-c56f(i1). & e(2)*p156(2)-c56f(i1).e(3)*p156(3) cauxa=-c56f(i1).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56f(i1).ek0*p1(2)-p1k0*c56f(i1).e(2) l1_56fz(i1).a(1)=fer*(cauxa+ceps_0) l1_56fz(i1).a(2)=fel*(cauxa-ceps_0) l1_56fz(i1).c(1)=fer*(cauxc+ceps_1) l1_56fz(i1).c(2)=fel*(-cauxc+ceps_1) END DO *****attaccamento di c56z(2) a 1 (e+) DO i1=1,2 * TL0 -- qu=p1,qd=p156,v=c56z(i1).e,a=l1_56fz(i1).a,c=l1_56fz(i1).c,cr=zer, * cl=zel,nsum=1 ceps_0=-c56z(i1).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c & 56z(i1).e(2)*p156(3)-p156(2)*c56z(i1).e(3))-p156k0*(c56z( & i1).e(2)*p1(3)-p1(2)*c56z(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i1).e(3)*p1k0+p1(3)*c56z(i1).ek0 ceps_1=ceps_1*cim cvqu=c56z(i1).e(0)*p1(0)-c56z(i1).e(1)*p1(1)-c56z(i1).e(2) & *p1(2)-c56z(i1).e(3)*p1(3) cvqd=c56z(i1).e(0)*p156(0)-c56z(i1).e(1)*p156(1)-c56z(i1). & e(2)*p156(2)-c56z(i1).e(3)*p156(3) cauxa=-c56z(i1).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56z(i1).ek0*p1(2)-p1k0*c56z(i1).e(2) l1_56fz(i1).a(1)=l1_56fz(i1).a(1)+zer*(cauxa+ceps_0) l1_56fz(i1).a(2)=l1_56fz(i1).a(2)+zel*(cauxa-ceps_0) l1_56fz(i1).c(1)=l1_56fz(i1).c(1)+zer*(cauxc+ceps_1) l1_56fz(i1).c(2)=l1_56fz(i1).c(2)+zel*(-cauxc+ceps_1) END DO *****attaccamento di c56f(2) a 2 (e-) * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i1=1,2 * TR0 -- qu=p134,qd=p2,v=c56f(i1).e,a=r2_56fz(i1).a,b=r2_56fz(i1).b,cr=fer, * cl=fel,nsum=0 ceps_0=-c56f(i1).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0* & (c56f(i1).e(2)*p2(3)-p2(2)*c56f(i1).e(3))-p2k0*(c56f(i1). & e(2)*p134(3)-p134(2)*c56f(i1).e(3)) ceps_0=ceps_0*cim ceps_2=-c56f(i1).e(3)*p2k0+p2(3)*c56f(i1).ek0 ceps_2=ceps_2*cim cvqu=c56f(i1).e(0)*p134(0)-c56f(i1).e(1)*p134(1)-c56f(i1). & e(2)*p134(2)-c56f(i1).e(3)*p134(3) cvqd=c56f(i1).e(0)*p2(0)-c56f(i1).e(1)*p2(1)-c56f(i1).e(2) & *p2(2)-c56f(i1).e(3)*p2(3) cauxa=-c56f(i1).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56f(i1).ek0*p2(2)+p2k0*c56f(i1).e(2) r2_56fz(i1).a(1)=fer*(cauxa+ceps_0) r2_56fz(i1).a(2)=fel*(cauxa-ceps_0) r2_56fz(i1).b(1)=fel*(cauxb-ceps_2) r2_56fz(i1).b(2)=fer*(-cauxb-ceps_2) END DO *****attaccamento di c56z(2) a 2 (e-) DO i1=1,2 * TR0 -- qu=p134,qd=p2,v=c56z(i1).e,a=r2_56fz(i1).a,b=r2_56fz(i1).b,cr=zer, * cl=zel,nsum=1 ceps_0=-c56z(i1).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0* & (c56z(i1).e(2)*p2(3)-p2(2)*c56z(i1).e(3))-p2k0*(c56z(i1). & e(2)*p134(3)-p134(2)*c56z(i1).e(3)) ceps_0=ceps_0*cim ceps_2=-c56z(i1).e(3)*p2k0+p2(3)*c56z(i1).ek0 ceps_2=ceps_2*cim cvqu=c56z(i1).e(0)*p134(0)-c56z(i1).e(1)*p134(1)-c56z(i1). & e(2)*p134(2)-c56z(i1).e(3)*p134(3) cvqd=c56z(i1).e(0)*p2(0)-c56z(i1).e(1)*p2(1)-c56z(i1).e(2) & *p2(2)-c56z(i1).e(3)*p2(3) cauxa=-c56z(i1).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56z(i1).ek0*p2(2)+p2k0*c56z(i1).e(2) r2_56fz(i1).a(1)=r2_56fz(i1).a(1)+zer*(cauxa+ceps_0) r2_56fz(i1).a(2)=r2_56fz(i1).a(2)+zel*(cauxa-ceps_0) r2_56fz(i1).b(1)=r2_56fz(i1).b(1)+zel*(cauxb-ceps_2) r2_56fz(i1).b(2)=r2_56fz(i1).b(2)+zer*(-cauxb-ceps_2) END DO *****attaccamento di c34f a 5 * quqd -- p=p5,q=p345 quqd=p5(0)*p345(0)-p5(1)*p345(1)-p5(2)*p345(2)-p5(3)*p345( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p345,v=c34f(i).e,a=l5_34f(i).a,c=l5_34f(i).c,cr=f5r,cl=f5 * l,nsum=0 ceps_0=-c34f(i).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0*(c3 & 4f(i).e(2)*p345(3)-p345(2)*c34f(i).e(3))-p345k0*(c34f(i). & e(2)*p5(3)-p5(2)*c34f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i).e(3)*p5k0+p5(3)*c34f(i).ek0 ceps_1=ceps_1*cim cvqu=c34f(i).e(0)*p5(0)-c34f(i).e(1)*p5(1)-c34f(i).e(2)*p5 & (2)-c34f(i).e(3)*p5(3) cvqd=c34f(i).e(0)*p345(0)-c34f(i).e(1)*p345(1)-c34f(i).e(2 & )*p345(2)-c34f(i).e(3)*p345(3) cauxa=-c34f(i).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34f(i).ek0*p5(2)-p5k0*c34f(i).e(2) l5_34f(i).a(1)=f5r*(cauxa+ceps_0) l5_34f(i).a(2)=f5l*(cauxa-ceps_0) l5_34f(i).c(1)=f5r*(cauxc+ceps_1) l5_34f(i).c(2)=f5l*(-cauxc+ceps_1) END DO *****attaccamento di c34z a 5 DO i=1,2 * TL0 -- qu=p5,qd=p345,v=c34z(i).e,a=l5_34fz(i).a,c=l5_34fz(i).c,cr=z5r,cl= * z5l,nsum=0 ceps_0=-c34z(i).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0*(c3 & 4z(i).e(2)*p345(3)-p345(2)*c34z(i).e(3))-p345k0*(c34z(i). & e(2)*p5(3)-p5(2)*c34z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i).e(3)*p5k0+p5(3)*c34z(i).ek0 ceps_1=ceps_1*cim cvqu=c34z(i).e(0)*p5(0)-c34z(i).e(1)*p5(1)-c34z(i).e(2)*p5 & (2)-c34z(i).e(3)*p5(3) cvqd=c34z(i).e(0)*p345(0)-c34z(i).e(1)*p345(1)-c34z(i).e(2 & )*p345(2)-c34z(i).e(3)*p345(3) cauxa=-c34z(i).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34z(i).ek0*p5(2)-p5k0*c34z(i).e(2) l5_34fz(i).a(1)=z5r*(cauxa+ceps_0) l5_34fz(i).a(2)=z5l*(cauxa-ceps_0) l5_34fz(i).c(1)=z5r*(cauxc+ceps_1) l5_34fz(i).c(2)=z5l*(-cauxc+ceps_1) END DO DO i=1,2 DO ii=1,2 l5_34fz(i).a(ii)=l5_34fz(i).a(ii)+l5_34f(i).a(ii) l5_34fz(i).c(ii)=l5_34fz(i).c(ii)+l5_34f(i).c(ii) END DO END DO *****attaccamento di c34f a 6 * quqd -- p=p125,q=p6 quqd=p125(0)*p6(0)-p125(1)*p6(1)-p125(2)*p6(2)-p125(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p125,qd=p6,v=c34f(i).e,a=r6_34f(i).a,b=r6_34f(i).b,cr=f6r,cl=f6 * l,nsum=0 ceps_0=-c34f(i).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125k0*( & c34f(i).e(2)*p6(3)-p6(2)*c34f(i).e(3))-p6k0*(c34f(i).e(2) & *p125(3)-p125(2)*c34f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i).e(3)*p6k0+p6(3)*c34f(i).ek0 ceps_2=ceps_2*cim cvqu=c34f(i).e(0)*p125(0)-c34f(i).e(1)*p125(1)-c34f(i).e(2 & )*p125(2)-c34f(i).e(3)*p125(3) cvqd=c34f(i).e(0)*p6(0)-c34f(i).e(1)*p6(1)-c34f(i).e(2)*p6 & (2)-c34f(i).e(3)*p6(3) cauxa=-c34f(i).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34f(i).ek0*p6(2)+p6k0*c34f(i).e(2) r6_34f(i).a(1)=f6r*(cauxa+ceps_0) r6_34f(i).a(2)=f6l*(cauxa-ceps_0) r6_34f(i).b(1)=f6l*(cauxb-ceps_2) r6_34f(i).b(2)=f6r*(-cauxb-ceps_2) END DO *****attaccamento di c34z a 6 DO i=1,2 * TR0 -- qu=p125,qd=p6,v=c34z(i).e,a=r6_34fz(i).a,b=r6_34fz(i).b,cr=z6r,cl= * z6l,nsum=0 ceps_0=-c34z(i).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125k0*( & c34z(i).e(2)*p6(3)-p6(2)*c34z(i).e(3))-p6k0*(c34z(i).e(2) & *p125(3)-p125(2)*c34z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i).e(3)*p6k0+p6(3)*c34z(i).ek0 ceps_2=ceps_2*cim cvqu=c34z(i).e(0)*p125(0)-c34z(i).e(1)*p125(1)-c34z(i).e(2 & )*p125(2)-c34z(i).e(3)*p125(3) cvqd=c34z(i).e(0)*p6(0)-c34z(i).e(1)*p6(1)-c34z(i).e(2)*p6 & (2)-c34z(i).e(3)*p6(3) cauxa=-c34z(i).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34z(i).ek0*p6(2)+p6k0*c34z(i).e(2) r6_34fz(i).a(1)=z6r*(cauxa+ceps_0) r6_34fz(i).a(2)=z6l*(cauxa-ceps_0) r6_34fz(i).b(1)=z6l*(cauxb-ceps_2) r6_34fz(i).b(2)=z6r*(-cauxb-ceps_2) END DO DO i=1,2 DO ii=1,2 r6_34fz(i).a(ii)=r6_34fz(i).a(ii)+r6_34f(i).a(ii) r6_34fz(i).b(ii)=r6_34fz(i).b(ii)+r6_34f(i).b(ii) END DO END DO **** Diagramma CN1 **** DO i3=1,2 DO i5=1,2 * TLTR0 -- aa=cn1(&,i3,i5).id(ide),a1=l1_34fz(i3).a,c1=l1_34fz(i3).c,a2=r2_ * 56fz(i5).a,b2=r2_56fz(i5).b,prq=p134q,den=(p134q*p134k0),nsum=0 cn1(1,i3,i5).id(ide)=( l1_34fz(i3).a(1)*r2_56fz(i5).a(1)+l & 1_34fz(i3).c(1)*p134q*r2_56fz(i5).b(2) )/(p134q*p134k0) cn1(2,i3,i5).id(ide)=( l1_34fz(i3).c(2)*p134q*r2_56fz(i5). & b(1)+l1_34fz(i3).a(2)*r2_56fz(i5).a(2) )/(p134q*p134k0) END DO END DO **** Diagramma CN2 **** DO i3=1,2 DO i5=1,2 * TLTR0 -- aa=cn2(&,i3,i5).id(ide),a1=l1_56fz(i5).a,c1=l1_56fz(i5).c,a2=r2_ * 34fz(i3).a,b2=r2_34fz(i3).b,prq=p156q,den=(p156q*p156k0),nsum=0 cn2(1,i3,i5).id(ide)=( l1_56fz(i5).a(1)*r2_34fz(i3).a(1)+l & 1_56fz(i5).c(1)*p156q*r2_34fz(i3).b(2) )/(p156q*p156k0) cn2(2,i3,i5).id(ide)=( l1_56fz(i5).c(2)*p156q*r2_34fz(i3). & b(1)+l1_56fz(i5).a(2)*r2_34fz(i3).a(2) )/(p156q*p156k0) END DO END DO **** Diagramma CN3 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn3(i1,&,i5).id(ide),a1=l3_56fz(i5).a,c1=l3_56fz(i5).c,a2=r4_ * 12fz(i1).a,b2=r4_12fz(i1).b,prq=p356q,den=(p356q*p356k0),nsum=0 cn3(i1,1,i5).id(ide)=( l3_56fz(i5).a(1)*r4_12fz(i1).a(1)+l & 3_56fz(i5).c(1)*p356q*r4_12fz(i1).b(2) )/(p356q*p356k0) cn3(i1,2,i5).id(ide)=( l3_56fz(i5).c(2)*p356q*r4_12fz(i1). & b(1)+l3_56fz(i5).a(2)*r4_12fz(i1).a(2) )/(p356q*p356k0) END DO END DO **** Diagramma CN4 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn4(i1,&,i5).id(ide),a1=l3_12fz(i1).a,c1=l3_12fz(i1).c,a2=r4_ * 56fz(i5).a,b2=r4_56fz(i5).b,prq=p123q,den=(p123q*p123k0),nsum=0 cn4(i1,1,i5).id(ide)=( l3_12fz(i1).a(1)*r4_56fz(i5).a(1)+l & 3_12fz(i1).c(1)*p123q*r4_56fz(i5).b(2) )/(p123q*p123k0) cn4(i1,2,i5).id(ide)=( l3_12fz(i1).c(2)*p123q*r4_56fz(i5). & b(1)+l3_12fz(i1).a(2)*r4_56fz(i5).a(2) )/(p123q*p123k0) END DO END DO **** Diagramma CN5 **** DO i1=1,2 DO i3=1,2 * TLTR0 -- aa=cn5(i1,i3,&).id(ide),a1=l5_34fz(i3).a,c1=l5_34fz(i3).c,a2=r6_ * 12fz(i1).a,b2=r6_12fz(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cn5(i1,i3,1).id(ide)=( l5_34fz(i3).a(1)*r6_12fz(i1).a(1)+l & 5_34fz(i3).c(1)*p345q*r6_12fz(i1).b(2) )/(p345q*p345k0) cn5(i1,i3,2).id(ide)=( l5_34fz(i3).c(2)*p345q*r6_12fz(i1). & b(1)+l5_34fz(i3).a(2)*r6_12fz(i1).a(2) )/(p345q*p345k0) END DO END DO **** Diagramma CN6 **** DO i1=1,2 DO i3=1,2 * TLTR0 -- aa=cn6(i1,i3,&).id(ide),a1=l5_12fz(i1).a,c1=l5_12fz(i1).c,a2=r6_ * 34fz(i3).a,b2=r6_34fz(i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cn6(i1,i3,1).id(ide)=( l5_12fz(i1).a(1)*r6_34fz(i3).a(1)+l & 5_12fz(i1).c(1)*p125q*r6_34fz(i3).b(2) )/(p125q*p125k0) cn6(i1,i3,2).id(ide)=( l5_12fz(i1).c(2)*p125q*r6_34fz(i3). & b(1)+l5_12fz(i1).a(2)*r6_34fz(i3).a(2) )/(p125q*p125k0) END DO END DO IF (iqu.EQ.1) THEN **** 8 diagrammi di qcd (4) * accoppiamenti right e left con fotone sono gli stessi r3r5=f3r*f5r **** Diagramma CN7 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn7(i1,&,i5).id(ide),a1=l3_56f(i5).a,c1=l3_56f(i5).c,a2=r4_12 * fz(i1).a,b2=r4_12fz(i1).b,prq=p356q,den=(p356q*p356k0*r3r5),nsum=0 cn7(i1,1,i5).id(ide)=( l3_56f(i5).a(1)*r4_12fz(i1).a(1) & +l3 & _56f(i5).c(1)*p356q*r4_12fz(i1).b(2) ) & /(p356q*p356k0*r3r5 & ) cn7(i1,2,i5).id(ide)=( l3_56f(i5).c(2) & *p356q*r4_12fz(i1).b & (1)+l3_56f(i5).a(2)*r4_12fz(i1).a(2) ) & /(p356q*p356k0*r3r5 & ) END DO END DO **** Diagramma CN8 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn8(i1,&,i5).id(ide),a1=l3_12fz(i1).a,c1=l3_12fz(i1).c,a2=r4_ * 56f(i5).a,b2=r4_56f(i5).b,prq=p123q,den=(p123q*p123k0*r3r5),nsum=0 cn8(i1,1,i5).id(ide)=( l3_12fz(i1).a(1)*r4_56f(i5).a(1) & +l3 & _12fz(i1).c(1)*p123q*r4_56f(i5).b(2) ) & /(p123q*p123k0*r3r5 & ) cn8(i1,2,i5).id(ide)=( l3_12fz(i1).c(2) & *p123q*r4_56f(i5).b & (1)+l3_12fz(i1).a(2)*r4_56f(i5).a(2) ) & /(p123q*p123k0*r3r5 & ) END DO END DO **** Diagramma CN9 **** DO i1=1,2 DO i3=1,2 * TLTR0 -- aa=cn9(i1,i3,&).id(ide),a1=l5_34f(i3).a,c1=l5_34f(i3).c,a2=r6_12 * fz(i1).a,b2=r6_12fz(i1).b,prq=p345q,den=(p345q*p345k0*r3r5),nsum=0 cn9(i1,i3,1).id(ide)=( l5_34f(i3).a(1)*r6_12fz(i1).a(1) & +l5 & _34f(i3).c(1)*p345q*r6_12fz(i1).b(2) ) & /(p345q*p345k0*r3r5 & ) cn9(i1,i3,2).id(ide)=( l5_34f(i3).c(2) & *p345q*r6_12fz(i1).b & (1)+l5_34f(i3).a(2)*r6_12fz(i1).a(2) ) & /(p345q*p345k0*r3r5 & ) END DO END DO **** Diagramma CN10 **** DO i1=1,2 DO i3=1,2 * TLTR0 -- aa=cn10(i1,i3,&).id(ide),a1=l5_12fz(i1).a,c1=l5_12fz(i1).c,a2=r6 * _34f(i3).a,b2=r6_34f(i3).b,prq=p125q,den=(p125q*p125k0*r3r5),nsum=0 cn10(i1,i3,1).id(ide)=( l5_12fz(i1).a(1)*r6_34f(i3).a(1) & +l & 5_12fz(i1).c(1)*p125q*r6_34f(i3).b(2) ) & /(p125q*p125k0*r3r & 5) cn10(i1,i3,2).id(ide)=( l5_12fz(i1).c(2) & *p125q*r6_34f(i3). & b(1)+l5_12fz(i1).a(2)*r6_34f(i3).a(2) ) & /(p125q*p125k0*r3r & 5) END DO END DO ENDIF !iqu IF (i34e.EQ.1) THEN **** 24 con coppia 34 elettrone (6) *******il programma entro il prossimo dotab e' ripetuto in * if (iid.eq.1.and.i34e.eq.1) * quqd -- p=p3,q=p2 quqd=p3(0)*p2(0)-p3(1)*p2(1)-p3(2)*p2(2)-p3(3)*p2(3) df=2.d0*quqd dz=2.d0*quqd+rmz2 rcr=fer/df rcl=fel/df * T10 -- qu=p3,qd=p2,v=0,a=c23f(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p3(2)*p2(3)+p2(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p2(0)+p2k0*p3(0) c23f(1).e(0)=rcr*(auxa+ceps_0) c23f(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=1,a=c23f(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23f(1).e(1)=rcr*(auxa+ceps_0) c23f(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=2,a=c23f(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p3k0*p2(3)+p2k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p2(2)+p2k0*p3(2) c23f(1).e(2)=rcr*(auxa+ceps_0) c23f(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=3,a=c23f(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p3k0*p2(2)-p2k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p2(3)+p2k0*p3(3) c23f(1).e(3)=rcr*(auxa+ceps_0) c23f(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c23f(i).e c23f(i).ek0=c23f(i).e(0)-c23f(i).e(1) END DO rcr=zer/dz rcl=zel/dz * T10 -- qu=p3,qd=p2,v=0,a=c23z(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p3(2)*p2(3)+p2(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p2(0)+p2k0*p3(0) c23z(1).e(0)=rcr*(auxa+ceps_0) c23z(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=1,a=c23z(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23z(1).e(1)=rcr*(auxa+ceps_0) c23z(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=2,a=c23z(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p3k0*p2(3)+p2k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p2(2)+p2k0*p3(2) c23z(1).e(2)=rcr*(auxa+ceps_0) c23z(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p3,qd=p2,v=3,a=c23z(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p3k0*p2(2)-p2k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p2(3)+p2k0*p3(3) c23z(1).e(3)=rcr*(auxa+ceps_0) c23z(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c23z(i).e c23z(i).ek0=c23z(i).e(0)-c23z(i).e(1) END DO * quqd -- p=p1,q=p4 quqd=p1(0)*p4(0)-p1(1)*p4(1)-p1(2)*p4(2)-p1(3)*p4(3) df=2.d0*quqd dz=2.d0*quqd+rmz2 rcr=fer/df rcl=fel/df * T10 -- qu=p1,qd=p4,v=0,a=c14f(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p1(2)*p4(3)+p4(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p4(0)+p4k0*p1(0) c14f(1).e(0)=rcr*(auxa+ceps_0) c14f(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=1,a=c14f(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c14f(1).e(1)=rcr*(auxa+ceps_0) c14f(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=2,a=c14f(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p1k0*p4(3)+p4k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p4(2)+p4k0*p1(2) c14f(1).e(2)=rcr*(auxa+ceps_0) c14f(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=3,a=c14f(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p1k0*p4(2)-p4k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p4(3)+p4k0*p1(3) c14f(1).e(3)=rcr*(auxa+ceps_0) c14f(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c14f(i).e c14f(i).ek0=c14f(i).e(0)-c14f(i).e(1) END DO rcr=zer/dz rcl=zel/dz * T10 -- qu=p1,qd=p4,v=0,a=c14z(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p1(2)*p4(3)+p4(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p4(0)+p4k0*p1(0) c14z(1).e(0)=rcr*(auxa+ceps_0) c14z(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=1,a=c14z(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c14z(1).e(1)=rcr*(auxa+ceps_0) c14z(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=2,a=c14z(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p1k0*p4(3)+p4k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p4(2)+p4k0*p1(2) c14z(1).e(2)=rcr*(auxa+ceps_0) c14z(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p4,v=3,a=c14z(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p1k0*p4(2)-p4k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p4(3)+p4k0*p1(3) c14z(1).e(3)=rcr*(auxa+ceps_0) c14z(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c14z(i).e c14z(i).ek0=c14z(i).e(0)-c14z(i).e(1) END DO **** attaccamento di c23f(2) a 4 * quqd -- p=p156,q=p4 quqd=p156(0)*p4(0)-p156(1)*p4(1)-p156(2)*p4(2)-p156(3)*p4( & 3) DO i=1,2 * TR0 -- qu=p156,qd=p4,v=c23f(i).e,a=r4_23fz(i).a,b=r4_23fz(i).b,cr=fer,cl= * fel,nsum=0 ceps_0=-c23f(i).ek0*(p156(2)*p4(3)-p4(2)*p156(3))+p156k0*( & c23f(i).e(2)*p4(3)-p4(2)*c23f(i).e(3))-p4k0*(c23f(i). & e(2) & *p156(3)-p156(2)*c23f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c23f(i).e(3)*p4k0+p4(3)*c23f(i).ek0 ceps_2=ceps_2*cim cvqu=c23f(i).e(0)*p156(0)-c23f(i).e(1)*p156(1)-c23f(i).e(2 & )*p156(2)-c23f(i).e(3)*p156(3) cvqd=c23f(i).e(0)*p4(0)-c23f(i).e(1)*p4(1)-c23f(i).e(2)*p4 & (2)-c23f(i).e(3)*p4(3) cauxa=-c23f(i).ek0*quqd+p156k0*cvqd+p4k0*cvqu cauxb=-c23f(i).ek0*p4(2)+p4k0*c23f(i).e(2) r4_23fz(i).a(1)=fer*(cauxa+ceps_0) r4_23fz(i).a(2)=fel*(cauxa-ceps_0) r4_23fz(i).b(1)=fel*(cauxb-ceps_2) r4_23fz(i).b(2)=fer*(-cauxb-ceps_2) END DO **** attaccamento di c23z(2) a 4 DO i=1,2 * TR0 -- qu=p156,qd=p4,v=c23z(i).e,a=r4_23fz(i).a,b=r4_23fz(i).b,cr=zer,cl= * zel,nsum=1 ceps_0=-c23z(i).ek0*(p156(2)*p4(3)-p4(2)*p156(3))+p156k0*( & c23z(i).e(2)*p4(3)-p4(2)*c23z(i).e(3))-p4k0*(c23z(i). & e(2) & *p156(3)-p156(2)*c23z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c23z(i).e(3)*p4k0+p4(3)*c23z(i).ek0 ceps_2=ceps_2*cim cvqu=c23z(i).e(0)*p156(0)-c23z(i).e(1)*p156(1)-c23z(i).e(2 & )*p156(2)-c23z(i).e(3)*p156(3) cvqd=c23z(i).e(0)*p4(0)-c23z(i).e(1)*p4(1)-c23z(i).e(2)*p4 & (2)-c23z(i).e(3)*p4(3) cauxa=-c23z(i).ek0*quqd+p156k0*cvqd+p4k0*cvqu cauxb=-c23z(i).ek0*p4(2)+p4k0*c23z(i).e(2) r4_23fz(i).a(1)=r4_23fz(i).a(1)+zer*(cauxa+ceps_0) r4_23fz(i).a(2)=r4_23fz(i).a(2)+zel*(cauxa-ceps_0) r4_23fz(i).b(1)=r4_23fz(i).b(1)+zel*(cauxb-ceps_2) r4_23fz(i).b(2)=r4_23fz(i).b(2)+zer*(-cauxb-ceps_2) END DO **** attaccamento di c14f(2) a 2 * quqd -- p=p356,q=p2 quqd=p356(0)*p2(0)-p356(1)*p2(1)-p356(2)*p2(2)-p356(3)*p2( & 3) DO i=1,2 * TR0 -- qu=p356,qd=p2,v=c14f(i).e,a=r2_14fz(i).a,b=r2_14fz(i).b,cr=fer,cl= * fel,nsum=0 ceps_0=-c14f(i).ek0*(p356(2)*p2(3)-p2(2)*p356(3))+p356k0*( & c14f(i).e(2)*p2(3)-p2(2)*c14f(i).e(3))-p2k0*(c14f(i). & e(2) & *p356(3)-p356(2)*c14f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c14f(i).e(3)*p2k0+p2(3)*c14f(i).ek0 ceps_2=ceps_2*cim cvqu=c14f(i).e(0)*p356(0)-c14f(i).e(1)*p356(1)-c14f(i).e(2 & )*p356(2)-c14f(i).e(3)*p356(3) cvqd=c14f(i).e(0)*p2(0)-c14f(i).e(1)*p2(1)-c14f(i).e(2)*p2 & (2)-c14f(i).e(3)*p2(3) cauxa=-c14f(i).ek0*quqd+p356k0*cvqd+p2k0*cvqu cauxb=-c14f(i).ek0*p2(2)+p2k0*c14f(i).e(2) r2_14fz(i).a(1)=fer*(cauxa+ceps_0) r2_14fz(i).a(2)=fel*(cauxa-ceps_0) r2_14fz(i).b(1)=fel*(cauxb-ceps_2) r2_14fz(i).b(2)=fer*(-cauxb-ceps_2) END DO **** attaccamento di c14z(2) a 2 DO i=1,2 * TR0 -- qu=p356,qd=p2,v=c14z(i).e,a=r2_14fz(i).a,b=r2_14fz(i).b,cr=zer,cl= * zel,nsum=1 ceps_0=-c14z(i).ek0*(p356(2)*p2(3)-p2(2)*p356(3))+p356k0*( & c14z(i).e(2)*p2(3)-p2(2)*c14z(i).e(3))-p2k0*(c14z(i). & e(2) & *p356(3)-p356(2)*c14z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c14z(i).e(3)*p2k0+p2(3)*c14z(i).ek0 ceps_2=ceps_2*cim cvqu=c14z(i).e(0)*p356(0)-c14z(i).e(1)*p356(1)-c14z(i).e(2 & )*p356(2)-c14z(i).e(3)*p356(3) cvqd=c14z(i).e(0)*p2(0)-c14z(i).e(1)*p2(1)-c14z(i).e(2)*p2 & (2)-c14z(i).e(3)*p2(3) cauxa=-c14z(i).ek0*quqd+p356k0*cvqd+p2k0*cvqu cauxb=-c14z(i).ek0*p2(2)+p2k0*c14z(i).e(2) r2_14fz(i).a(1)=r2_14fz(i).a(1)+zer*(cauxa+ceps_0) r2_14fz(i).a(2)=r2_14fz(i).a(2)+zel*(cauxa-ceps_0) r2_14fz(i).b(1)=r2_14fz(i).b(1)+zel*(cauxb-ceps_2) r2_14fz(i).b(2)=r2_14fz(i).b(2)+zer*(-cauxb-ceps_2) END DO **** attaccamento di c23f(2) a 1 * quqd -- p=p1,q=p123 quqd=p1(0)*p123(0)-p1(1)*p123(1)-p1(2)*p123(2)-p1(3)*p123( & 3) DO i=1,2 * TL0 -- qu=p1,qd=p123,v=c23f(i).e,a=l1_23fz(i).a,c=l1_23fz(i).c,cr=fer,cl= * fel,nsum=0 ceps_0=-c23f(i).ek0*(p1(2)*p123(3)-p123(2)*p1(3))+p1k0*(c2 & 3f(i).e(2)*p123(3)-p123(2)*c23f(i).e(3)) & -p123k0*(c23f(i). & e(2)*p1(3)-p1(2)*c23f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c23f(i).e(3)*p1k0+p1(3)*c23f(i).ek0 ceps_1=ceps_1*cim cvqu=c23f(i).e(0)*p1(0)-c23f(i).e(1)*p1(1)-c23f(i).e(2)*p1 & (2)-c23f(i).e(3)*p1(3) cvqd=c23f(i).e(0)*p123(0)-c23f(i).e(1)*p123(1)-c23f(i).e(2 & )*p123(2)-c23f(i).e(3)*p123(3) cauxa=-c23f(i).ek0*quqd+p1k0*cvqd+p123k0*cvqu cauxc=+c23f(i).ek0*p1(2)-p1k0*c23f(i).e(2) l1_23fz(i).a(1)=fer*(cauxa+ceps_0) l1_23fz(i).a(2)=fel*(cauxa-ceps_0) l1_23fz(i).c(1)=fer*(cauxc+ceps_1) l1_23fz(i).c(2)=fel*(-cauxc+ceps_1) END DO **** attaccamento di c23z(2) a 1 DO i=1,2 * TL0 -- qu=p1,qd=p123,v=c23z(i).e,a=l1_23fz(i).a,c=l1_23fz(i).c,cr=zer,cl= * zel,nsum=1 ceps_0=-c23z(i).ek0*(p1(2)*p123(3)-p123(2)*p1(3))+p1k0*(c2 & 3z(i).e(2)*p123(3)-p123(2)*c23z(i).e(3)) & -p123k0*(c23z(i). & e(2)*p1(3)-p1(2)*c23z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c23z(i).e(3)*p1k0+p1(3)*c23z(i).ek0 ceps_1=ceps_1*cim cvqu=c23z(i).e(0)*p1(0)-c23z(i).e(1)*p1(1)-c23z(i).e(2)*p1 & (2)-c23z(i).e(3)*p1(3) cvqd=c23z(i).e(0)*p123(0)-c23z(i).e(1)*p123(1)-c23z(i).e(2 & )*p123(2)-c23z(i).e(3)*p123(3) cauxa=-c23z(i).ek0*quqd+p1k0*cvqd+p123k0*cvqu cauxc=+c23z(i).ek0*p1(2)-p1k0*c23z(i).e(2) l1_23fz(i).a(1)=l1_23fz(i).a(1)+zer*(cauxa+ceps_0) l1_23fz(i).a(2)=l1_23fz(i).a(2)+zel*(cauxa-ceps_0) l1_23fz(i).c(1)=l1_23fz(i).c(1)+zer*(cauxc+ceps_1) l1_23fz(i).c(2)=l1_23fz(i).c(2)+zel*(-cauxc+ceps_1) END DO **** attaccamento di c14f(2) a 3 * quqd -- p=p3,q=p134 quqd=p3(0)*p134(0)-p3(1)*p134(1)-p3(2)*p134(2)-p3(3)*p134( & 3) DO i=1,2 * TL0 -- qu=p3,qd=p134,v=c14f(i).e,a=l3_14fz(i).a,c=l3_14fz(i).c,cr=fer,cl= * fel,nsum=0 ceps_0=-c14f(i).ek0*(p3(2)*p134(3)-p134(2)*p3(3))+p3k0*(c1 & 4f(i).e(2)*p134(3)-p134(2)*c14f(i).e(3)) & -p134k0*(c14f(i). & e(2)*p3(3)-p3(2)*c14f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c14f(i).e(3)*p3k0+p3(3)*c14f(i).ek0 ceps_1=ceps_1*cim cvqu=c14f(i).e(0)*p3(0)-c14f(i).e(1)*p3(1)-c14f(i).e(2)*p3 & (2)-c14f(i).e(3)*p3(3) cvqd=c14f(i).e(0)*p134(0)-c14f(i).e(1)*p134(1)-c14f(i).e(2 & )*p134(2)-c14f(i).e(3)*p134(3) cauxa=-c14f(i).ek0*quqd+p3k0*cvqd+p134k0*cvqu cauxc=+c14f(i).ek0*p3(2)-p3k0*c14f(i).e(2) l3_14fz(i).a(1)=fer*(cauxa+ceps_0) l3_14fz(i).a(2)=fel*(cauxa-ceps_0) l3_14fz(i).c(1)=fer*(cauxc+ceps_1) l3_14fz(i).c(2)=fel*(-cauxc+ceps_1) END DO **** attaccamento di c14z(2) a 3 DO i=1,2 * TL0 -- qu=p3,qd=p134,v=c14z(i).e,a=l3_14fz(i).a,c=l3_14fz(i).c,cr=zer,cl= * zel,nsum=1 ceps_0=-c14z(i).ek0*(p3(2)*p134(3)-p134(2)*p3(3))+p3k0*(c1 & 4z(i).e(2)*p134(3)-p134(2)*c14z(i).e(3)) & -p134k0*(c14z(i). & e(2)*p3(3)-p3(2)*c14z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c14z(i).e(3)*p3k0+p3(3)*c14z(i).ek0 ceps_1=ceps_1*cim cvqu=c14z(i).e(0)*p3(0)-c14z(i).e(1)*p3(1)-c14z(i).e(2)*p3 & (2)-c14z(i).e(3)*p3(3) cvqd=c14z(i).e(0)*p134(0)-c14z(i).e(1)*p134(1)-c14z(i).e(2 & )*p134(2)-c14z(i).e(3)*p134(3) cauxa=-c14z(i).ek0*quqd+p3k0*cvqd+p134k0*cvqu cauxc=+c14z(i).ek0*p3(2)-p3k0*c14z(i).e(2) l3_14fz(i).a(1)=l3_14fz(i).a(1)+zer*(cauxa+ceps_0) l3_14fz(i).a(2)=l3_14fz(i).a(2)+zel*(cauxa-ceps_0) l3_14fz(i).c(1)=l3_14fz(i).c(1)+zer*(cauxc+ceps_1) l3_14fz(i).c(2)=l3_14fz(i).c(2)+zel*(-cauxc+ceps_1) END DO **** attaccamento di c14f(2) a 5 * quqd -- p=p5,q=p145 quqd=p5(0)*p145(0)-p5(1)*p145(1)-p5(2)*p145(2)-p5(3)*p145( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p145,v=c14f(i).e,a=l5_14fz(i).a,c=l5_14fz(i).c,cr=f5r,cl= * f5l,nsum=0 ceps_0=-c14f(i).ek0*(p5(2)*p145(3)-p145(2)*p5(3))+p5k0*(c1 & 4f(i).e(2)*p145(3)-p145(2)*c14f(i).e(3)) & -p145k0*(c14f(i). & e(2)*p5(3)-p5(2)*c14f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c14f(i).e(3)*p5k0+p5(3)*c14f(i).ek0 ceps_1=ceps_1*cim cvqu=c14f(i).e(0)*p5(0)-c14f(i).e(1)*p5(1)-c14f(i).e(2)*p5 & (2)-c14f(i).e(3)*p5(3) cvqd=c14f(i).e(0)*p145(0)-c14f(i).e(1)*p145(1)-c14f(i).e(2 & )*p145(2)-c14f(i).e(3)*p145(3) cauxa=-c14f(i).ek0*quqd+p5k0*cvqd+p145k0*cvqu cauxc=+c14f(i).ek0*p5(2)-p5k0*c14f(i).e(2) l5_14fz(i).a(1)=f5r*(cauxa+ceps_0) l5_14fz(i).a(2)=f5l*(cauxa-ceps_0) l5_14fz(i).c(1)=f5r*(cauxc+ceps_1) l5_14fz(i).c(2)=f5l*(-cauxc+ceps_1) END DO **** attaccamento di c14z(2) a 5 DO i=1,2 * TL0 -- qu=p5,qd=p145,v=c14z(i).e,a=l5_14fz(i).a,c=l5_14fz(i).c,cr=z5r,cl= * z5l,nsum=1 ceps_0=-c14z(i).ek0*(p5(2)*p145(3)-p145(2)*p5(3))+p5k0*(c1 & 4z(i).e(2)*p145(3)-p145(2)*c14z(i).e(3)) & -p145k0*(c14z(i). & e(2)*p5(3)-p5(2)*c14z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c14z(i).e(3)*p5k0+p5(3)*c14z(i).ek0 ceps_1=ceps_1*cim cvqu=c14z(i).e(0)*p5(0)-c14z(i).e(1)*p5(1)-c14z(i).e(2)*p5 & (2)-c14z(i).e(3)*p5(3) cvqd=c14z(i).e(0)*p145(0)-c14z(i).e(1)*p145(1)-c14z(i).e(2 & )*p145(2)-c14z(i).e(3)*p145(3) cauxa=-c14z(i).ek0*quqd+p5k0*cvqd+p145k0*cvqu cauxc=+c14z(i).ek0*p5(2)-p5k0*c14z(i).e(2) l5_14fz(i).a(1)=l5_14fz(i).a(1)+z5r*(cauxa+ceps_0) l5_14fz(i).a(2)=l5_14fz(i).a(2)+z5l*(cauxa-ceps_0) l5_14fz(i).c(1)=l5_14fz(i).c(1)+z5r*(cauxc+ceps_1) l5_14fz(i).c(2)=l5_14fz(i).c(2)+z5l*(-cauxc+ceps_1) END DO **** attaccamento di c23f(2) a 5 * quqd -- p=p5,q=p235 quqd=p5(0)*p235(0)-p5(1)*p235(1)-p5(2)*p235(2)-p5(3)*p235( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p235,v=c23f(i).e,a=l5_23fz(i).a,c=l5_23fz(i).c,cr=f5r,cl= * f5l,nsum=0 ceps_0=-c23f(i).ek0*(p5(2)*p235(3)-p235(2)*p5(3))+p5k0*(c2 & 3f(i).e(2)*p235(3)-p235(2)*c23f(i).e(3)) & -p235k0*(c23f(i). & e(2)*p5(3)-p5(2)*c23f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c23f(i).e(3)*p5k0+p5(3)*c23f(i).ek0 ceps_1=ceps_1*cim cvqu=c23f(i).e(0)*p5(0)-c23f(i).e(1)*p5(1)-c23f(i).e(2)*p5 & (2)-c23f(i).e(3)*p5(3) cvqd=c23f(i).e(0)*p235(0)-c23f(i).e(1)*p235(1)-c23f(i).e(2 & )*p235(2)-c23f(i).e(3)*p235(3) cauxa=-c23f(i).ek0*quqd+p5k0*cvqd+p235k0*cvqu cauxc=+c23f(i).ek0*p5(2)-p5k0*c23f(i).e(2) l5_23fz(i).a(1)=f5r*(cauxa+ceps_0) l5_23fz(i).a(2)=f5l*(cauxa-ceps_0) l5_23fz(i).c(1)=f5r*(cauxc+ceps_1) l5_23fz(i).c(2)=f5l*(-cauxc+ceps_1) END DO **** attaccamento di c23z(2) a 5 DO i=1,2 * TL0 -- qu=p5,qd=p235,v=c23z(i).e,a=l5_23fz(i).a,c=l5_23fz(i).c,cr=z5r,cl= * z5l,nsum=1 ceps_0=-c23z(i).ek0*(p5(2)*p235(3)-p235(2)*p5(3))+p5k0*(c2 & 3z(i).e(2)*p235(3)-p235(2)*c23z(i).e(3)) & -p235k0*(c23z(i). & e(2)*p5(3)-p5(2)*c23z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c23z(i).e(3)*p5k0+p5(3)*c23z(i).ek0 ceps_1=ceps_1*cim cvqu=c23z(i).e(0)*p5(0)-c23z(i).e(1)*p5(1)-c23z(i).e(2)*p5 & (2)-c23z(i).e(3)*p5(3) cvqd=c23z(i).e(0)*p235(0)-c23z(i).e(1)*p235(1)-c23z(i).e(2 & )*p235(2)-c23z(i).e(3)*p235(3) cauxa=-c23z(i).ek0*quqd+p5k0*cvqd+p235k0*cvqu cauxc=+c23z(i).ek0*p5(2)-p5k0*c23z(i).e(2) l5_23fz(i).a(1)=l5_23fz(i).a(1)+z5r*(cauxa+ceps_0) l5_23fz(i).a(2)=l5_23fz(i).a(2)+z5l*(cauxa-ceps_0) l5_23fz(i).c(1)=l5_23fz(i).c(1)+z5r*(cauxc+ceps_1) l5_23fz(i).c(2)=l5_23fz(i).c(2)+z5l*(-cauxc+ceps_1) END DO **** attaccamento di c23f(2) a 6 * quqd -- p=p145,q=p6 quqd=p145(0)*p6(0)-p145(1)*p6(1)-p145(2)*p6(2)-p145(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p145,qd=p6,v=c23f(i).e,a=r6_23fz(i).a,b=r6_23fz(i).b,cr=f5r,cl= * f5l,nsum=0 ceps_0=-c23f(i).ek0*(p145(2)*p6(3)-p6(2)*p145(3))+p145k0*( & c23f(i).e(2)*p6(3)-p6(2)*c23f(i).e(3))-p6k0*(c23f(i). & e(2) & *p145(3)-p145(2)*c23f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c23f(i).e(3)*p6k0+p6(3)*c23f(i).ek0 ceps_2=ceps_2*cim cvqu=c23f(i).e(0)*p145(0)-c23f(i).e(1)*p145(1)-c23f(i).e(2 & )*p145(2)-c23f(i).e(3)*p145(3) cvqd=c23f(i).e(0)*p6(0)-c23f(i).e(1)*p6(1)-c23f(i).e(2)*p6 & (2)-c23f(i).e(3)*p6(3) cauxa=-c23f(i).ek0*quqd+p145k0*cvqd+p6k0*cvqu cauxb=-c23f(i).ek0*p6(2)+p6k0*c23f(i).e(2) r6_23fz(i).a(1)=f5r*(cauxa+ceps_0) r6_23fz(i).a(2)=f5l*(cauxa-ceps_0) r6_23fz(i).b(1)=f5l*(cauxb-ceps_2) r6_23fz(i).b(2)=f5r*(-cauxb-ceps_2) END DO **** attaccamento di c23z(2) a 6 DO i=1,2 * TR0 -- qu=p145,qd=p6,v=c23z(i).e,a=r6_23fz(i).a,b=r6_23fz(i).b,cr=z5r,cl= * z5l,nsum=1 ceps_0=-c23z(i).ek0*(p145(2)*p6(3)-p6(2)*p145(3))+p145k0*( & c23z(i).e(2)*p6(3)-p6(2)*c23z(i).e(3))-p6k0*(c23z(i). & e(2) & *p145(3)-p145(2)*c23z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c23z(i).e(3)*p6k0+p6(3)*c23z(i).ek0 ceps_2=ceps_2*cim cvqu=c23z(i).e(0)*p145(0)-c23z(i).e(1)*p145(1)-c23z(i).e(2 & )*p145(2)-c23z(i).e(3)*p145(3) cvqd=c23z(i).e(0)*p6(0)-c23z(i).e(1)*p6(1)-c23z(i).e(2)*p6 & (2)-c23z(i).e(3)*p6(3) cauxa=-c23z(i).ek0*quqd+p145k0*cvqd+p6k0*cvqu cauxb=-c23z(i).ek0*p6(2)+p6k0*c23z(i).e(2) r6_23fz(i).a(1)=r6_23fz(i).a(1)+z5r*(cauxa+ceps_0) r6_23fz(i).a(2)=r6_23fz(i).a(2)+z5l*(cauxa-ceps_0) r6_23fz(i).b(1)=r6_23fz(i).b(1)+z5l*(cauxb-ceps_2) r6_23fz(i).b(2)=r6_23fz(i).b(2)+z5r*(-cauxb-ceps_2) END DO **** attaccamento di c14f(2) a 6 * quqd -- p=p235,q=p6 quqd=p235(0)*p6(0)-p235(1)*p6(1)-p235(2)*p6(2)-p235(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p235,qd=p6,v=c14f(i).e,a=r6_14fz(i).a,b=r6_14fz(i).b,cr=f5r,cl= * f5l,nsum=0 ceps_0=-c14f(i).ek0*(p235(2)*p6(3)-p6(2)*p235(3))+p235k0*( & c14f(i).e(2)*p6(3)-p6(2)*c14f(i).e(3))-p6k0*(c14f(i). & e(2) & *p235(3)-p235(2)*c14f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c14f(i).e(3)*p6k0+p6(3)*c14f(i).ek0 ceps_2=ceps_2*cim cvqu=c14f(i).e(0)*p235(0)-c14f(i).e(1)*p235(1)-c14f(i).e(2 & )*p235(2)-c14f(i).e(3)*p235(3) cvqd=c14f(i).e(0)*p6(0)-c14f(i).e(1)*p6(1)-c14f(i).e(2)*p6 & (2)-c14f(i).e(3)*p6(3) cauxa=-c14f(i).ek0*quqd+p235k0*cvqd+p6k0*cvqu cauxb=-c14f(i).ek0*p6(2)+p6k0*c14f(i).e(2) r6_14fz(i).a(1)=f5r*(cauxa+ceps_0) r6_14fz(i).a(2)=f5l*(cauxa-ceps_0) r6_14fz(i).b(1)=f5l*(cauxb-ceps_2) r6_14fz(i).b(2)=f5r*(-cauxb-ceps_2) END DO **** attaccamento di c14z(2) a 6 DO i=1,2 * TR0 -- qu=p235,qd=p6,v=c14z(i).e,a=r6_14fz(i).a,b=r6_14fz(i).b,cr=z5r,cl= * z5l,nsum=1 ceps_0=-c14z(i).ek0*(p235(2)*p6(3)-p6(2)*p235(3))+p235k0*( & c14z(i).e(2)*p6(3)-p6(2)*c14z(i).e(3))-p6k0*(c14z(i). & e(2) & *p235(3)-p235(2)*c14z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c14z(i).e(3)*p6k0+p6(3)*c14z(i).ek0 ceps_2=ceps_2*cim cvqu=c14z(i).e(0)*p235(0)-c14z(i).e(1)*p235(1)-c14z(i).e(2 & )*p235(2)-c14z(i).e(3)*p235(3) cvqd=c14z(i).e(0)*p6(0)-c14z(i).e(1)*p6(1)-c14z(i).e(2)*p6 & (2)-c14z(i).e(3)*p6(3) cauxa=-c14z(i).ek0*quqd+p235k0*cvqd+p6k0*cvqu cauxb=-c14z(i).ek0*p6(2)+p6k0*c14z(i).e(2) r6_14fz(i).a(1)=r6_14fz(i).a(1)+z5r*(cauxa+ceps_0) r6_14fz(i).a(2)=r6_14fz(i).a(2)+z5l*(cauxa-ceps_0) r6_14fz(i).b(1)=r6_14fz(i).b(1)+z5l*(cauxb-ceps_2) r6_14fz(i).b(2)=r6_14fz(i).b(2)+z5r*(-cauxb-ceps_2) END DO **** Diagramma CN11 **** DO i2=1,2 DO i5=1,2 * TLTR0 -- aa=cn11(&,i2,i5).id(ide),a1=l1_56fz(i5).a,c1=l1_56fz(i5).c,a2=r4 * _23fz(i2).a,b2=r4_23fz(i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cn11(1,i2,i5).id(ide)=( l1_56fz(i5).a(1)*r4_23fz(i2). & a(1)+ & l1_56fz(i5).c(1)*p156q*r4_23fz(i2).b(2) ) & /(p156q*p156k0) cn11(2,i2,i5).id(ide)=( l1_56fz(i5).c(2) & *p156q*r4_23fz(i2) & .b(1)+l1_56fz(i5).a(2)*r4_23fz(i2).a(2) ) & /(p156q*p156k0) END DO END DO **** Diagramma CN12 **** DO i2=1,2 DO i5=1,2 * TLTR0 -- aa=cn12(&,i2,i5).id(ide),a1=l1_23fz(i2).a,c1=l1_23fz(i2).c,a2=r4 * _56fz(i5).a,b2=r4_56fz(i5).b,prq=p123q,den=(p123q*p123k0),nsum=0 cn12(1,i2,i5).id(ide)=( l1_23fz(i2).a(1)*r4_56fz(i5). & a(1)+ & l1_23fz(i2).c(1)*p123q*r4_56fz(i5).b(2) ) & /(p123q*p123k0) cn12(2,i2,i5).id(ide)=( l1_23fz(i2).c(2) & *p123q*r4_56fz(i5) & .b(1)+l1_23fz(i2).a(2)*r4_56fz(i5).a(2) ) & /(p123q*p123k0) END DO END DO **** Diagramma CN13 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn13(i1,&,i5).id(ide),a1=l3_14fz(i1).a,c1=l3_14fz(i1).c,a2=r2 * _56fz(i5).a,b2=r2_56fz(i5).b,prq=p134q,den=(p134q*p134k0),nsum=0 cn13(i1,1,i5).id(ide)=( l3_14fz(i1).a(1)*r2_56fz(i5). & a(1)+ & l3_14fz(i1).c(1)*p134q*r2_56fz(i5).b(2) ) & /(p134q*p134k0) cn13(i1,2,i5).id(ide)=( l3_14fz(i1).c(2) & *p134q*r2_56fz(i5) & .b(1)+l3_14fz(i1).a(2)*r2_56fz(i5).a(2) ) & /(p134q*p134k0) END DO END DO **** Diagramma CN14 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn14(i1,&,i5).id(ide),a1=l3_56fz(i5).a,c1=l3_56fz(i5).c,a2=r2 * _14fz(i1).a,b2=r2_14fz(i1).b,prq=p356q,den=(p356q*p356k0),nsum=0 cn14(i1,1,i5).id(ide)=( l3_56fz(i5).a(1)*r2_14fz(i1). & a(1)+ & l3_56fz(i5).c(1)*p356q*r2_14fz(i1).b(2) ) & /(p356q*p356k0) cn14(i1,2,i5).id(ide)=( l3_56fz(i5).c(2) & *p356q*r2_14fz(i1) & .b(1)+l3_56fz(i5).a(2)*r2_14fz(i1).a(2) ) & /(p356q*p356k0) END DO END DO **** Diagramma CN15 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cn15(i1,i2,&).id(ide),a1=l5_14fz(i1).a,c1=l5_14fz(i1).c,a2=r6 * _23fz(i2).a,b2=r6_23fz(i2).b,prq=p145q,den=(p145q*p145k0),nsum=0 cn15(i1,i2,1).id(ide)=( l5_14fz(i1).a(1)*r6_23fz(i2). & a(1)+ & l5_14fz(i1).c(1)*p145q*r6_23fz(i2).b(2) ) & /(p145q*p145k0) cn15(i1,i2,2).id(ide)=( l5_14fz(i1).c(2) & *p145q*r6_23fz(i2) & .b(1)+l5_14fz(i1).a(2)*r6_23fz(i2).a(2) ) & /(p145q*p145k0) END DO END DO **** Diagramma CN16 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cn16(i1,i2,&).id(ide),a1=l5_23fz(i2).a,c1=l5_23fz(i2).c,a2=r6 * _14fz(i1).a,b2=r6_14fz(i1).b,prq=p235q,den=(p235q*p235k0),nsum= cn16(i1,i2,1).id(ide)=( l5_23fz(i2).a(1)*r6_14fz(i1). & a(1)+ & l5_23fz(i2).c(1)*p235q*r6_14fz(i1).b(2) ) & /(p235q*p235k0) cn16(i1,i2,2).id(ide)=( l5_23fz(i2).c(2) & *p235q*r6_14fz(i1) & .b(1)+l5_23fz(i2).a(2)*r6_14fz(i1).a(2) ) & /(p235q*p235k0) END DO END DO ENDIF !i34e IF (i56ve.EQ.1) THEN **** diagrammi per correnti neutre con scambi di w (6) * quqd -- p=p1,q=p6 quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) ccl=wcl/(2.d0*quqd+rmw2) * TW10 -- qu=p1,qd=p6,v=0,a=c16w.e(0),cl=ccl,nsum=0 eps_0=-p1(2)*p6(3)+p6(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p6(0)+p6k0*p1(0) c16w.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=1,a=c16w.e(1),cl=ccl,nsum=0 auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16w.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=2,a=c16w.e(2),cl=ccl,nsum=0 eps_0=-p1k0*p6(3)+p6k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p6(2)+p6k0*p1(2) c16w.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=3,a=c16w.e(3),cl=ccl,nsum=0 eps_0=p1k0*p6(2)-p6k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p6(3)+p6k0*p1(3) c16w.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c16w.e c16w.ek0=c16w.e(0)-c16w.e(1) * quqd -- p=p5,q=p2 quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) ccl=wcl/(2.d0*quqd+rmw2) * TW10 -- qu=p5,qd=p2,v=0,a=c25w.e(0),cl=ccl,nsum=0 eps_0=-p5(2)*p2(3)+p2(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p2(0)+p2k0*p5(0) c25w.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=1,a=c25w.e(1),cl=ccl,nsum=0 auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c25w.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=2,a=c25w.e(2),cl=ccl,nsum=0 eps_0=-p5k0*p2(3)+p2k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p2(2)+p2k0*p5(2) c25w.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=3,a=c25w.e(3),cl=ccl,nsum=0 eps_0=p5k0*p2(2)-p2k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p2(3)+p2k0*p5(3) c25w.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c25w.e c25w.ek0=c25w.e(0)-c25w.e(1) IF (ianc.EQ.0) THEN DO i=1,2 DO mu=0,3 c34fz(i).e(mu)=c34f(i).e(mu)+rcotw*c34z(i).e(mu) END DO END DO ELSE DO i=1,2 DO mu=0,3 c34fz(i).e(mu)=c34f(i).e(mu)+(rcotw+delz)*c34z(i). & e(mu) END DO END DO ENDIF * * diagramma triplo cn23 * *** triple vertex -- pfz(mu)=p34(mu),pwm(mu)=p16(mu),pwp(mu)=p25(mu),efz=c3 * 4fz(i),ewm=c16w,ewp=c25w,res=cn23(i?).id(ide) DO mu=0,3 vfz(mu)=p16(mu)-p25(mu) vwm(mu)=p25(mu)-p34(mu) vwp(mu)=p34(mu)-p16(mu) END DO !mu * vfz.efz DO i=1,2 * p.q -- p.q=c34fz(i).v,p=c34fz(i).e,q=vfz c34fz(i).v=c34fz(i).e(0)*vfz(0)-c34fz(i).e(1)*vfz(1)-c34fz & (i).e(2)*vfz(2)-c34fz(i).e(3)*vfz(3) END DO * vwm.ewm * p.q -- p.q=c16w.v,p=c16w.e,q=vwm c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c25w.v,p=c25w.e,q=vwp c25w.v=c25w.e(0)*vwp(0)-c25w.e(1)*vwp(1)-c25w.e(2)*vwp(2)- & c25w.e(3)*vwp(3) * efz.ewm DO i=1,2 * p.q -- p.q=caux,p=c34fz(i).e,q=c16w.e caux=c34fz(i).e(0)*c16w.e(0)-c34fz(i).e(1)*c16w.e(1)-c34fz & (i).e(2)*c16w.e(2)-c34fz(i).e(3)*c16w.e(3) cn23(i).id(ide)=c25w.v*caux END DO * efz.ewp DO i=1,2 * p.q -- p.q=caux,p=c34fz(i).e,q=c25w.e caux=c34fz(i).e(0)*c25w.e(0)-c34fz(i).e(1)*c25w.e(1)-c34fz & (i).e(2)*c25w.e(2)-c34fz(i).e(3)*c25w.e(3) cn23(i).id(ide)=cn23(i).id(ide)+c16w.v*caux END DO * ewm.ewp * p.q -- p.q=caux,p=c16w.e,q=c25w.e caux=c16w.e(0)*c25w.e(0)-c16w.e(1)*c25w.e(1)-c16w.e(2)*c25 & w.e(2)-c16w.e(3)*c25w.e(3) DO i=1,2 cn23(i).id(ide)=cn23(i).id(ide)+c34fz(i).v*caux END DO * anomalous couplings IF (ianc.NE.0) THEN * p.q -- p.q=cemp0,p=c16w.e,q=p34 cemp0=c16w.e(0)*p34(0)-c16w.e(1)*p34(1)-c16w.e(2)*p34(2)-c & 16w.e(3)*p34(3) * p.q -- p.q=cepp0,p=c25w.e,q=p34 cepp0=c25w.e(0)*p34(0)-c25w.e(1)*p34(1)-c25w.e(2)*p34(2)-c & 25w.e(3)*p34(3) IF (xf.NE.0.d0.OR.xz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c34fz(i).e(mu)=xf*c34f(i).e(mu)+xz*c34z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c34fz(i).e,q=c16w.e ce0em(i)=c34fz(i).e(0)*c16w.e(0)-c34fz(i).e(1)*c16w. & e(1)-c & 34fz(i).e(2)*c16w.e(2)-c34fz(i).e(3)*c16w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c34fz(i).e,q=c25w.e ce0ep(i)=c34fz(i).e(0)*c25w.e(0)-c34fz(i).e(1)*c25w. & e(1)-c & 34fz(i).e(2)*c25w.e(2)-c34fz(i).e(3)*c25w.e(3) END DO DO i=1,2 cn23(i).id(ide)=cn23(i).id(ide)+ce0em(i)*cepp0- & ce0ep(i)*cemp0 END DO ENDIF IF (yf.NE.0.d0.OR.yz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c34fz(i).e(mu)=yf*c34f(i).e(mu)+yz*c34z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c34fz(i).e,q=c16w.e ce0em(i)=c34fz(i).e(0)*c16w.e(0)-c34fz(i).e(1)*c16w. & e(1)-c & 34fz(i).e(2)*c16w.e(2)-c34fz(i).e(3)*c16w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c34fz(i).e,q=c25w.e ce0ep(i)=c34fz(i).e(0)*c25w.e(0)-c34fz(i).e(1)*c25w. & e(1)-c & 34fz(i).e(2)*c25w.e(2)-c34fz(i).e(3)*c25w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0pm(i),p=c34fz(i).e,q=p16 ce0pm(i)=c34fz(i).e(0)*p16(0)-c34fz(i).e(1)*p16(1) & -c34fz(i & ).e(2)*p16(2)-c34fz(i).e(3)*p16(3) END DO DO i=1,2 * p.q -- p.q=ce0pp(i),p=c34fz(i).e,q=p25 ce0pp(i)=c34fz(i).e(0)*p25(0)-c34fz(i).e(1)*p25(1) & -c34fz(i & ).e(2)*p25(2)-c34fz(i).e(3)*p25(3) END DO * p.q -- p.q=cemep,p=c16w.e,q=c25w.e cemep=c16w.e(0)*c25w.e(0)-c16w.e(1)*c25w.e(1)-c16w.e(2) & *c2 & 5w.e(2)-c16w.e(3)*c25w.e(3) * p.q -- p.q=cempp,p=c16w.e,q=p25 cempp=c16w.e(0)*p25(0)-c16w.e(1)*p25(1)-c16w.e(2)*p25(2) & -c & 16w.e(3)*p25(3) * p.q -- p.q=ceppm,p=c25w.e,q=p16 ceppm=c25w.e(0)*p16(0)-c25w.e(1)*p16(1)-c25w.e(2)*p16(2) & -c & 25w.e(3)*p16(3) * p.q -- p.q=p0pm,p=p34,q=p16 p0pm=p34(0)*p16(0)-p34(1)*p16(1)-p34(2)*p16(2)-p34(3) & *p16( & 3) * p.q -- p.q=p0pp,p=p34,q=p25 p0pp=p34(0)*p25(0)-p34(1)*p25(1)-p34(2)*p25(2)-p34(3) & *p25( & 3) * p.q -- p.q=pmpp,p=p16,q=p25 pmpp=p16(0)*p25(0)-p16(1)*p25(1)-p16(2)*p25(2)-p16(3) & *p25( & 3) DO i=1,2 cn23(i).id(ide)=cn23(i).id(ide)+ce0pm(i)*cepp0*cempp- & ce0pp(i)*ceppm*cemp0+ & p0pp*(ce0em(i)*ceppm-cemep*ce0pm(i))+ & p0pm*(cemep*ce0pp(i)-ce0ep(i)*cempp)+ & pmpp*(ce0ep(i)*cemp0-ce0em(i)*cepp0) END DO ENDIF IF (zz.NE.0.d0) THEN DO m=0,3 cpau(m)=cepp0*c16w.e(m)-cemp0*c25w.e(m) pau(m)=p25(m)-p16(m) ENDDO DO i=1,2 * eps -- eps=cau(i),p=c34z(i).e,q=cpau,r=p34,s=pau cau(i)=c34z(i).e(0)*(cpau(1)*(p34(2)*pau(3)-p34(3) & *pau(2)) & +cpau(2)*(p34(3)*pau(1)-p34(1)*pau(3))+cpau(3) & *(p34(1)*pa & u(2)-p34(2)*pau(1))) cau(i)=cau(i)-c34z(i).e(1)*(cpau(2)*(p34(3)*pau(0) & -p34(0)* & pau(3))+cpau(3)*(p34(0)*pau(2)-p34(2)*pau(0)) & +cpau(0)*(p3 & 4(2)*pau(3)-p34(3)*pau(2))) cau(i)=cau(i)+c34z(i).e(2)*(cpau(3)*(p34(0)*pau(1) & -p34(1)* & pau(0))+cpau(0)*(p34(1)*pau(3)-p34(3)*pau(1)) & +cpau(1)*(p3 & 4(3)*pau(0)-p34(0)*pau(3))) cau(i)=cau(i)-c34z(i).e(3)*(cpau(0)*(p34(1)*pau(2) & -p34(2)* & pau(1))+cpau(1)*(p34(2)*pau(0)-p34(0)*pau(2)) & +cpau(2)*(p3 & 4(0)*pau(1)-p34(1)*pau(0))) END DO DO i=1,2 cn23(i).id(ide)=cn23(i).id(ide)+cim*zz*cau(i) ENDDO ENDIF ENDIF * end anomalous couplings * quqd -- p=p134,q=p6 quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) * TWR0 -- qu=p134,qd=p6,v=c25w.e,a=r6_25w.a,b=r6_25w.b,cl=wcl,nsum=0 ceps_0=-c25w.ek0*(p134(2)*p6(3)-p6(2)*p134(3))+p134k0*(c25 & w.e(2)*p6(3)-p6(2)*c25w.e(3))-p6k0*(c25w.e(2)*p134(3)-p13 & 4(2)*c25w.e(3)) ceps_0=ceps_0*cim ceps_2=-c25w.e(3)*p6k0+p6(3)*c25w.ek0 ceps_2=ceps_2*cim cvqu=c25w.e(0)*p134(0)-c25w.e(1)*p134(1)-c25w.e(2)*p134(2) & -c25w.e(3)*p134(3) cvqd=c25w.e(0)*p6(0)-c25w.e(1)*p6(1)-c25w.e(2)*p6(2)-c25w. & e(3)*p6(3) cauxa=-c25w.ek0*quqd+p134k0*cvqd+p6k0*cvqu cauxb=-c25w.ek0*p6(2)+p6k0*c25w.e(2) r6_25w.a(2)=wcl*(cauxa-ceps_0) r6_25w.b(1)=wcl*(cauxb-ceps_2) * quqd -- p=p345,q=p2 quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) * TWR0 -- qu=p345,qd=p2,v=c16w.e,a=r2_16w.a,b=r2_16w.b,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p345(2)*p2(3)-p2(2)*p345(3))+p345k0*(c16 & w.e(2)*p2(3)-p2(2)*c16w.e(3))-p2k0*(c16w.e(2)*p345(3)-p34 & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_2=-c16w.e(3)*p2k0+p2(3)*c16w.ek0 ceps_2=ceps_2*cim cvqu=c16w.e(0)*p345(0)-c16w.e(1)*p345(1)-c16w.e(2)*p345(2) & -c16w.e(3)*p345(3) cvqd=c16w.e(0)*p2(0)-c16w.e(1)*p2(1)-c16w.e(2)*p2(2)-c16w. & e(3)*p2(3) cauxa=-c16w.ek0*quqd+p345k0*cvqd+p2k0*cvqu cauxb=-c16w.ek0*p2(2)+p2k0*c16w.e(2) r2_16w.a(2)=wcl*(cauxa-ceps_0) r2_16w.b(1)=wcl*(cauxb-ceps_2) *** per diagramma cn28 IF (f3l.LT.0.d0) THEN * quqd -- p=p235,q=p4 quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) * TWR0 -- qu=p235,qd=p4,v=c16w.e,a=r4_16w.a,b=r4_16w.b,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p235(2)*p4(3)-p4(2)*p235(3))+p235k0*(c16 & w.e(2)*p4(3)-p4(2)*c16w.e(3))-p4k0*(c16w.e(2)*p235(3) & -p23 & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_2=-c16w.e(3)*p4k0+p4(3)*c16w.ek0 ceps_2=ceps_2*cim cvqu=c16w.e(0)*p235(0)-c16w.e(1)*p235(1)-c16w.e(2)*p235(2) & -c16w.e(3)*p235(3) cvqd=c16w.e(0)*p4(0)-c16w.e(1)*p4(1)-c16w.e(2)*p4(2)-c16w. & e(3)*p4(3) cauxa=-c16w.ek0*quqd+p235k0*cvqd+p4k0*cvqu cauxb=-c16w.ek0*p4(2)+p4k0*c16w.e(2) r4_16w.a(2)=wcl*(cauxa-ceps_0) r4_16w.b(1)=wcl*(cauxb-ceps_2) * quqd -- p=p3,q=p235 quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) * TWL0 -- qu=p3,qd=p235,v=c25w.e,a=l3_25w.a,c=l3_25w.c,cl=wcl,nsum=0 ceps_0=-c25w.ek0*(p3(2)*p235(3)-p235(2)*p3(3))+p3k0*(c25w. & e(2)*p235(3)-p235(2)*c25w.e(3))-p235k0*(c25w.e(2)*p3(3) & -p & 3(2)*c25w.e(3)) ceps_0=ceps_0*cim ceps_1=-c25w.e(3)*p3k0+p3(3)*c25w.ek0 ceps_1=ceps_1*cim cvqu=c25w.e(0)*p3(0)-c25w.e(1)*p3(1)-c25w.e(2)*p3(2)-c25w. & e(3)*p3(3) cvqd=c25w.e(0)*p235(0)-c25w.e(1)*p235(1)-c25w.e(2)*p235(2) & -c25w.e(3)*p235(3) cauxa=-c25w.ek0*quqd+p3k0*cvqd+p235k0*cvqu cauxc=+c25w.ek0*p3(2)-p3k0*c25w.e(2) l3_25w.a(2)=wcl*(cauxa-ceps_0) l3_25w.c(2)=wcl*(-cauxc+ceps_1) ELSE * quqd -- p=p136,q=p4 quqd=p136(0)*p4(0)-p136(1)*p4(1)-p136(2)*p4(2)-p136(3)*p4( & 3) * TWR0 -- qu=p136,qd=p4,v=c25w.e,a=r4_25w.a,b=r4_25w.b,cl=wcl,nsum=0 ceps_0=-c25w.ek0*(p136(2)*p4(3)-p4(2)*p136(3))+p136k0*(c25 & w.e(2)*p4(3)-p4(2)*c25w.e(3))-p4k0*(c25w.e(2)*p136(3) & -p13 & 6(2)*c25w.e(3)) ceps_0=ceps_0*cim ceps_2=-c25w.e(3)*p4k0+p4(3)*c25w.ek0 ceps_2=ceps_2*cim cvqu=c25w.e(0)*p136(0)-c25w.e(1)*p136(1)-c25w.e(2)*p136(2) & -c25w.e(3)*p136(3) cvqd=c25w.e(0)*p4(0)-c25w.e(1)*p4(1)-c25w.e(2)*p4(2)-c25w. & e(3)*p4(3) cauxa=-c25w.ek0*quqd+p136k0*cvqd+p4k0*cvqu cauxb=-c25w.ek0*p4(2)+p4k0*c25w.e(2) r4_25w.a(2)=wcl*(cauxa-ceps_0) r4_25w.b(1)=wcl*(cauxb-ceps_2) * quqd -- p=p3,q=p136 quqd=p3(0)*p136(0)-p3(1)*p136(1)-p3(2)*p136(2)-p3(3)*p136( & 3) * TWL0 -- qu=p3,qd=p136,v=c16w.e,a=l3_16w.a,c=l3_16w.c,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p3(2)*p136(3)-p136(2)*p3(3))+p3k0*(c16w. & e(2)*p136(3)-p136(2)*c16w.e(3))-p136k0*(c16w.e(2)*p3(3) & -p & 3(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_1=-c16w.e(3)*p3k0+p3(3)*c16w.ek0 ceps_1=ceps_1*cim cvqu=c16w.e(0)*p3(0)-c16w.e(1)*p3(1)-c16w.e(2)*p3(2)-c16w. & e(3)*p3(3) cvqd=c16w.e(0)*p136(0)-c16w.e(1)*p136(1)-c16w.e(2)*p136(2) & -c16w.e(3)*p136(3) cauxa=-c16w.ek0*quqd+p3k0*cvqd+p136k0*cvqu cauxc=+c16w.ek0*p3(2)-p3k0*c16w.e(2) l3_16w.a(2)=wcl*(cauxa-ceps_0) l3_16w.c(2)=wcl*(-cauxc+ceps_1) ENDIF **** * quqd -- p=p1,q=p125 quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) * TWL0 -- qu=p1,qd=p125,v=c25w.e,a=l1_25w.a,c=l1_25w.c,cl=wcl,nsum=0 ceps_0=-c25w.ek0*(p1(2)*p125(3)-p125(2)*p1(3))+p1k0*(c25w. & e(2)*p125(3)-p125(2)*c25w.e(3))-p125k0*(c25w.e(2)*p1(3)-p & 1(2)*c25w.e(3)) ceps_0=ceps_0*cim ceps_1=-c25w.e(3)*p1k0+p1(3)*c25w.ek0 ceps_1=ceps_1*cim cvqu=c25w.e(0)*p1(0)-c25w.e(1)*p1(1)-c25w.e(2)*p1(2)-c25w. & e(3)*p1(3) cvqd=c25w.e(0)*p125(0)-c25w.e(1)*p125(1)-c25w.e(2)*p125(2) & -c25w.e(3)*p125(3) cauxa=-c25w.ek0*quqd+p1k0*cvqd+p125k0*cvqu cauxc=+c25w.ek0*p1(2)-p1k0*c25w.e(2) l1_25w.a(2)=wcl*(cauxa-ceps_0) l1_25w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p5,q=p156 quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) * TWL0 -- qu=p5,qd=p156,v=c16w.e,a=l5_16w.a,c=l5_16w.c,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p5(2)*p156(3)-p156(2)*p5(3))+p5k0*(c16w. & e(2)*p156(3)-p156(2)*c16w.e(3))-p156k0*(c16w.e(2)*p5(3)-p & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_1=-c16w.e(3)*p5k0+p5(3)*c16w.ek0 ceps_1=ceps_1*cim cvqu=c16w.e(0)*p5(0)-c16w.e(1)*p5(1)-c16w.e(2)*p5(2)-c16w. & e(3)*p5(3) cvqd=c16w.e(0)*p156(0)-c16w.e(1)*p156(1)-c16w.e(2)*p156(2) & -c16w.e(3)*p156(3) cauxa=-c16w.ek0*quqd+p5k0*cvqd+p156k0*cvqu cauxc=+c16w.ek0*p5(2)-p5k0*c16w.e(2) l5_16w.a(2)=wcl*(cauxa-ceps_0) l5_16w.c(2)=wcl*(-cauxc+ceps_1) **** diagramma CN24 DO i3=1,2 * TLTR0_W -- aa=cn24(i3).id(ide),a1=l1_34fz(i3).a,c1=l1_34fz(i3).c,a2=r6_25 * w.a,b2=r6_25w.b,prq=p134q,den=(p134q*p134k0),nsum=0 cn24(i3).id(ide)=( l1_34fz(i3).c(2)*p134q*r6_25w.b(1)+l1_3 & 4fz(i3).a(2)*r6_25w.a(2) )/(p134q*p134k0) END DO **** diagramma CN25 DO i3=1,2 * TLTR0_W -- aa=cn25(i3).id(ide),a1=l5_16w.a,c1=l5_16w.c,a2=r2_34fz(i3).a,b * 2=r2_34fz(i3).b,prq=p156q,den=(p156q*p156k0),nsum=0 cn25(i3).id(ide)=( l5_16w.c(2)*p156q*r2_34fz(i3).b(1)+l5_1 & 6w.a(2)*r2_34fz(i3).a(2) )/(p156q*p156k0) END DO **** diagramma CN26 DO i3=1,2 * TLTR0_W -- aa=cn26(i3).id(ide),a1=l1_25w.a,c1=l1_25w.c,a2=r6_34fz(i3).a,b * 2=r6_34fz(i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cn26(i3).id(ide)=( l1_25w.c(2)*p125q*r6_34fz(i3).b(1)+l1_2 & 5w.a(2)*r6_34fz(i3).a(2) )/(p125q*p125k0) END DO **** diagramma CN27 DO i3=1,2 * TLTR0_W -- aa=cn27(i3).id(ide),a1=l5_34fz(i3).a,c1=l5_34fz(i3).c,a2=r2_16 * w.a,b2=r2_16w.b,prq=p345q,den=(p345q*p345k0),nsum=0 cn27(i3).id(ide)=( l5_34fz(i3).c(2)*p345q*r2_16w.b(1)+l5_3 & 4fz(i3).a(2)*r2_16w.a(2) )/(p345q*p345k0) END DO **** diagramma CN28 IF (f3l.LT.0.d0) THEN * TLTR0_W -- aa=cn28.id(ide),a1=l3_25w.a,c1=l3_25w.c,a2=r4_16w.a,b2=r4_16w. * b,prq=p235q,den=((p235q-ibbveve*rmt2)*p235k0),nsum=0 cn28.id(ide)=( l3_25w.c(2)*p235q*r4_16w.b(1)+l3_25w.a(2)*r & 4_16w.a(2) )/((p235q-ibbveve*rmt2)*p235k0) ELSE * TLTR0_W -- aa=cn28.id(ide),a1=l3_16w.a,c1=l3_16w.c,a2=r4_25w.a,b2=r4_25w. * b,prq=p136q,den=(p136q*p136k0),nsum=0 cn28.id(ide)=( l3_16w.c(2)*p136q*r4_25w.b(1)+l3_16w.a(2)*r & 4_25w.a(2) )/(p136q*p136k0) ENDIF IF (i56ve.EQ.1.AND.iid.EQ.1) THEN **** diagrammi per correnti neutre con scambi di w (6) * quqd -- p=p1,q=p4 quqd=p1(0)*p4(0)-p1(1)*p4(1)-p1(2)*p4(2)-p1(3)*p4(3) ccl=wcl/(2.d0*quqd+rmw2) * TW10 -- qu=p1,qd=p4,v=0,a=c14w.e(0),cl=ccl,nsum=0 eps_0=-p1(2)*p4(3)+p4(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p4(0)+p4k0*p1(0) c14w.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p4,v=1,a=c14w.e(1),cl=ccl,nsum=0 auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c14w.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p4,v=2,a=c14w.e(2),cl=ccl,nsum=0 eps_0=-p1k0*p4(3)+p4k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p4(2)+p4k0*p1(2) c14w.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p4,v=3,a=c14w.e(3),cl=ccl,nsum=0 eps_0=p1k0*p4(2)-p4k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p4(3)+p4k0*p1(3) c14w.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c14w.e c14w.ek0=c14w.e(0)-c14w.e(1) * quqd -- p=p3,q=p2 quqd=p3(0)*p2(0)-p3(1)*p2(1)-p3(2)*p2(2)-p3(3)*p2(3) ccl=wcl/(2.d0*quqd+rmw2) * TW10 -- qu=p3,qd=p2,v=0,a=c23w.e(0),cl=ccl,nsum=0 eps_0=-p3(2)*p2(3)+p2(2)*p3(3) ceps_0=eps_0*cim auxa=-quqd+p3k0*p2(0)+p2k0*p3(0) c23w.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p3,qd=p2,v=1,a=c23w.e(1),cl=ccl,nsum=0 auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23w.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p3,qd=p2,v=2,a=c23w.e(2),cl=ccl,nsum=0 eps_0=-p3k0*p2(3)+p2k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p2(2)+p2k0*p3(2) c23w.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p3,qd=p2,v=3,a=c23w.e(3),cl=ccl,nsum=0 eps_0=p3k0*p2(2)-p2k0*p3(2) ceps_0=eps_0*cim auxa=p3k0*p2(3)+p2k0*p3(3) c23w.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c23w.e c23w.ek0=c23w.e(0)-c23w.e(1) IF (ianc.EQ.0) THEN DO i=1,2 DO mu=0,3 c56fz(i).e(mu)=c56f(i).e(mu)+rcotw*c56z(i).e(mu) END DO END DO ELSE DO i=1,2 DO mu=0,3 c56fz(i).e(mu)=c56f(i).e(mu)+(rcotw+delz)*c56z(i). & e(mu) END DO END DO ENDIF * * diagramma triplo cn29 * *** triple vertex -- pfz(mu)=p56(mu),pwm(mu)=p14(mu),pwp(mu)=p23(mu),efz=c5 * 6fz(i),ewm=c14w,ewp=c23w,res=cn29(i?).id(ide) DO mu=0,3 vfz(mu)=p14(mu)-p23(mu) vwm(mu)=p23(mu)-p56(mu) vwp(mu)=p56(mu)-p14(mu) END DO !mu * vfz.efz DO i=1,2 * p.q -- p.q=c56fz(i).v,p=c56fz(i).e,q=vfz c56fz(i).v=c56fz(i).e(0)*vfz(0)-c56fz(i).e(1)*vfz(1) & -c56fz & (i).e(2)*vfz(2)-c56fz(i).e(3)*vfz(3) END DO * vwm.ewm * p.q -- p.q=c14w.v,p=c14w.e,q=vwm c14w.v=c14w.e(0)*vwm(0)-c14w.e(1)*vwm(1)-c14w.e(2)*vwm(2)- & c14w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c23w.v,p=c23w.e,q=vwp c23w.v=c23w.e(0)*vwp(0)-c23w.e(1)*vwp(1)-c23w.e(2)*vwp(2)- & c23w.e(3)*vwp(3) * efz.ewm DO i=1,2 * p.q -- p.q=caux,p=c56fz(i).e,q=c14w.e caux=c56fz(i).e(0)*c14w.e(0)-c56fz(i).e(1)*c14w.e(1) & -c56fz & (i).e(2)*c14w.e(2)-c56fz(i).e(3)*c14w.e(3) cn29(i).id(ide)=c23w.v*caux END DO * efz.ewp DO i=1,2 * p.q -- p.q=caux,p=c56fz(i).e,q=c23w.e caux=c56fz(i).e(0)*c23w.e(0)-c56fz(i).e(1)*c23w.e(1) & -c56fz & (i).e(2)*c23w.e(2)-c56fz(i).e(3)*c23w.e(3) cn29(i).id(ide)=cn29(i).id(ide)+c14w.v*caux END DO * ewm.ewp * p.q -- p.q=caux,p=c14w.e,q=c23w.e caux=c14w.e(0)*c23w.e(0)-c14w.e(1)*c23w.e(1)-c14w.e(2)*c23 & w.e(2)-c14w.e(3)*c23w.e(3) DO i=1,2 cn29(i).id(ide)=cn29(i).id(ide)+c56fz(i).v*caux END DO * anomalous couplings IF (ianc.NE.0) THEN * p.q -- p.q=cemp0,p=c14w.e,q=p56 cemp0=c14w.e(0)*p56(0)-c14w.e(1)*p56(1)-c14w.e(2)*p56(2) & -c & 14w.e(3)*p56(3) * p.q -- p.q=cepp0,p=c23w.e,q=p56 cepp0=c23w.e(0)*p56(0)-c23w.e(1)*p56(1)-c23w.e(2)*p56(2) & -c & 23w.e(3)*p56(3) IF (xf.NE.0.d0.OR.xz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c56fz(i).e(mu)=xf*c56f(i).e(mu)+xz*c56z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c56fz(i).e,q=c14w.e ce0em(i)=c56fz(i).e(0)*c14w.e(0)-c56fz(i).e(1)*c14w. & e(1)-c & 56fz(i).e(2)*c14w.e(2)-c56fz(i).e(3)*c14w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c56fz(i).e,q=c23w.e ce0ep(i)=c56fz(i).e(0)*c23w.e(0)-c56fz(i).e(1)*c23w. & e(1)-c & 56fz(i).e(2)*c23w.e(2)-c56fz(i).e(3)*c23w.e(3) END DO DO i=1,2 cn29(i).id(ide)=cn29(i).id(ide)+ce0em(i)*cepp0 & -ce0ep(i)*cemp0 END DO ENDIF IF (yf.NE.0.d0.OR.yz.NE.0.d0) THEN DO i=1,2 DO mu=0,3 c56fz(i).e(mu)=yf*c56f(i).e(mu)+yz*c56z(i).e(mu) END DO END DO DO i=1,2 * p.q -- p.q=ce0em(i),p=c56fz(i).e,q=c14w.e ce0em(i)=c56fz(i).e(0)*c14w.e(0)-c56fz(i).e(1)*c14w. & e(1)-c & 56fz(i).e(2)*c14w.e(2)-c56fz(i).e(3)*c14w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0ep(i),p=c56fz(i).e,q=c23w.e ce0ep(i)=c56fz(i).e(0)*c23w.e(0)-c56fz(i).e(1)*c23w. & e(1)-c & 56fz(i).e(2)*c23w.e(2)-c56fz(i).e(3)*c23w.e(3) END DO DO i=1,2 * p.q -- p.q=ce0pm(i),p=c56fz(i).e,q=p14 ce0pm(i)=c56fz(i).e(0)*p14(0)-c56fz(i).e(1)*p14(1) & -c56fz(i & ).e(2)*p14(2)-c56fz(i).e(3)*p14(3) END DO DO i=1,2 * p.q -- p.q=ce0pp(i),p=c56fz(i).e,q=p23 ce0pp(i)=c56fz(i).e(0)*p23(0)-c56fz(i).e(1)*p23(1) & -c56fz(i & ).e(2)*p23(2)-c56fz(i).e(3)*p23(3) END DO * p.q -- p.q=cemep,p=c14w.e,q=c23w.e cemep=c14w.e(0)*c23w.e(0)-c14w.e(1)*c23w.e(1)-c14w. & e(2)*c2 & 3w.e(2)-c14w.e(3)*c23w.e(3) * p.q -- p.q=cempp,p=c14w.e,q=p23 cempp=c14w.e(0)*p23(0)-c14w.e(1)*p23(1)-c14w.e(2) & *p23(2)-c & 14w.e(3)*p23(3) * p.q -- p.q=ceppm,p=c23w.e,q=p14 ceppm=c23w.e(0)*p14(0)-c23w.e(1)*p14(1)-c23w.e(2) & *p14(2)-c & 23w.e(3)*p14(3) * p.q -- p.q=p0pm,p=p56,q=p14 p0pm=p56(0)*p14(0)-p56(1)*p14(1)-p56(2)*p14(2)-p56(3) & *p14( & 3) * p.q -- p.q=p0pp,p=p56,q=p23 p0pp=p56(0)*p23(0)-p56(1)*p23(1)-p56(2)*p23(2)-p56(3) & *p23( & 3) * p.q -- p.q=pmpp,p=p14,q=p23 pmpp=p14(0)*p23(0)-p14(1)*p23(1)-p14(2)*p23(2)-p14(3) & *p23( & 3) DO i=1,2 cn29(i).id(ide)=cn29(i).id(ide)+ce0pm(i) & *cepp0*cempp- & ce0pp(i)*ceppm*cemp0+ & p0pp*(ce0em(i)*ceppm-cemep*ce0pm(i))+ & p0pm*(cemep*ce0pp(i)-ce0ep(i)*cempp)+ & pmpp*(ce0ep(i)*cemp0-ce0em(i)*cepp0) END DO ENDIF IF (zz.NE.0.d0) THEN DO m=0,3 cpau(m)=cepp0*c14w.e(m)-cemp0*c23w.e(m) pau(m)=p23(m)-p14(m) ENDDO DO i=1,2 * eps -- eps=cau(i),p=c56z(i).e,q=cpau,r=p56,s=pau cau(i)=c56z(i).e(0)*(cpau(1)*(p56(2)*pau(3)-p56(3) & *pau(2)) & +cpau(2)*(p56(3)*pau(1)-p56(1)*pau(3))+cpau(3) & *(p56(1)*pa & u(2)-p56(2)*pau(1))) cau(i)=cau(i)-c56z(i).e(1)*(cpau(2)*(p56(3)*pau(0) & -p56(0)* & pau(3))+cpau(3)*(p56(0)*pau(2)-p56(2)*pau(0)) & +cpau(0)*(p5 & 6(2)*pau(3)-p56(3)*pau(2))) cau(i)=cau(i)+c56z(i).e(2)*(cpau(3)*(p56(0)*pau(1) & -p56(1)* & pau(0))+cpau(0)*(p56(1)*pau(3)-p56(3)*pau(1)) & +cpau(1)*(p5 & 6(3)*pau(0)-p56(0)*pau(3))) cau(i)=cau(i)-c56z(i).e(3)*(cpau(0)*(p56(1)*pau(2) & -p56(2)* & pau(1))+cpau(1)*(p56(2)*pau(0)-p56(0)*pau(2)) & +cpau(2)*(p5 & 6(0)*pau(1)-p56(1)*pau(0))) END DO DO i=1,2 cn29(i).id(ide)=cn29(i).id(ide)+cim*zz*cau(i) ENDDO ENDIF ENDIF * end anomalous couplings * quqd -- p=p156,q=p4 quqd=p156(0)*p4(0)-p156(1)*p4(1)-p156(2)*p4(2)-p156(3)*p4( & 3) * TWR0 -- qu=p156,qd=p4,v=c23w.e,a=r4_23w.a,b=r4_23w.b,cl=wcl,nsum=0 ceps_0=-c23w.ek0*(p156(2)*p4(3)-p4(2)*p156(3))+p156k0*(c23 & w.e(2)*p4(3)-p4(2)*c23w.e(3))-p4k0*(c23w.e(2)*p156(3) & -p15 & 6(2)*c23w.e(3)) ceps_0=ceps_0*cim ceps_2=-c23w.e(3)*p4k0+p4(3)*c23w.ek0 ceps_2=ceps_2*cim cvqu=c23w.e(0)*p156(0)-c23w.e(1)*p156(1)-c23w.e(2)*p156(2) & -c23w.e(3)*p156(3) cvqd=c23w.e(0)*p4(0)-c23w.e(1)*p4(1)-c23w.e(2)*p4(2)-c23w. & e(3)*p4(3) cauxa=-c23w.ek0*quqd+p156k0*cvqd+p4k0*cvqu cauxb=-c23w.ek0*p4(2)+p4k0*c23w.e(2) r4_23w.a(2)=wcl*(cauxa-ceps_0) r4_23w.b(1)=wcl*(cauxb-ceps_2) * quqd -- p=p356,q=p2 quqd=p356(0)*p2(0)-p356(1)*p2(1)-p356(2)*p2(2)-p356(3)*p2( & 3) * TWR0 -- qu=p356,qd=p2,v=c14w.e,a=r2_14w.a,b=r2_14w.b,cl=wcl,nsum=0 ceps_0=-c14w.ek0*(p356(2)*p2(3)-p2(2)*p356(3))+p356k0*(c14 & w.e(2)*p2(3)-p2(2)*c14w.e(3))-p2k0*(c14w.e(2)*p356(3) & -p35 & 6(2)*c14w.e(3)) ceps_0=ceps_0*cim ceps_2=-c14w.e(3)*p2k0+p2(3)*c14w.ek0 ceps_2=ceps_2*cim cvqu=c14w.e(0)*p356(0)-c14w.e(1)*p356(1)-c14w.e(2)*p356(2) & -c14w.e(3)*p356(3) cvqd=c14w.e(0)*p2(0)-c14w.e(1)*p2(1)-c14w.e(2)*p2(2)-c14w. & e(3)*p2(3) cauxa=-c14w.ek0*quqd+p356k0*cvqd+p2k0*cvqu cauxb=-c14w.ek0*p2(2)+p2k0*c14w.e(2) r2_14w.a(2)=wcl*(cauxa-ceps_0) r2_14w.b(1)=wcl*(cauxb-ceps_2) *** per diagramma cn34 IF (f5l.LT.0.d0) THEN * quqd -- p=p235,q=p6 quqd=p235(0)*p6(0)-p235(1)*p6(1)-p235(2)*p6(2)-p235(3) & *p6( & 3) * TWR0 -- qu=p235,qd=p6,v=c14w.e,a=r6_14w.a,b=r6_14w.b,cl=wcl,nsum=0 ceps_0=-c14w.ek0*(p235(2)*p6(3)-p6(2)*p235(3)) & +p235k0*(c14 & w.e(2)*p6(3)-p6(2)*c14w.e(3))-p6k0*(c14w.e(2)*p235(3) & -p23 & 5(2)*c14w.e(3)) ceps_0=ceps_0*cim ceps_2=-c14w.e(3)*p6k0+p6(3)*c14w.ek0 ceps_2=ceps_2*cim cvqu=c14w.e(0)*p235(0)-c14w.e(1)*p235(1)-c14w.e(2) & *p235(2) & -c14w.e(3)*p235(3) cvqd=c14w.e(0)*p6(0)-c14w.e(1)*p6(1)-c14w.e(2)*p6(2) & -c14w. & e(3)*p6(3) cauxa=-c14w.ek0*quqd+p235k0*cvqd+p6k0*cvqu cauxb=-c14w.ek0*p6(2)+p6k0*c14w.e(2) r6_14w.a(2)=wcl*(cauxa-ceps_0) r6_14w.b(1)=wcl*(cauxb-ceps_2) * quqd -- p=p5,q=p235 quqd=p5(0)*p235(0)-p5(1)*p235(1)-p5(2)*p235(2)-p5(3) & *p235( & 3) * TWL0 -- qu=p5,qd=p235,v=c23w.e,a=l5_23w.a,c=l5_23w.c,cl=wcl,nsum=0 ceps_0=-c23w.ek0*(p5(2)*p235(3)-p235(2)*p5(3)) & +p5k0*(c23w. & e(2)*p235(3)-p235(2)*c23w.e(3))-p235k0*(c23w.e(2) & *p5(3)-p & 5(2)*c23w.e(3)) ceps_0=ceps_0*cim ceps_1=-c23w.e(3)*p5k0+p5(3)*c23w.ek0 ceps_1=ceps_1*cim cvqu=c23w.e(0)*p5(0)-c23w.e(1)*p5(1)-c23w.e(2)*p5(2) & -c23w. & e(3)*p5(3) cvqd=c23w.e(0)*p235(0)-c23w.e(1)*p235(1)-c23w.e(2) & *p235(2) & -c23w.e(3)*p235(3) cauxa=-c23w.ek0*quqd+p5k0*cvqd+p235k0*cvqu cauxc=+c23w.ek0*p5(2)-p5k0*c23w.e(2) l5_23w.a(2)=wcl*(cauxa-ceps_0) l5_23w.c(2)=wcl*(-cauxc+ceps_1) ELSE * quqd -- p=p145,q=p6 quqd=p145(0)*p6(0)-p145(1)*p6(1)-p145(2)*p6(2)-p145(3) & *p6( & 3) * TWR0 -- qu=p145,qd=p6,v=c23w.e,a=r6_23w.a,b=r6_23w.b,cl=wcl,nsum=0 ceps_0=-c23w.ek0*(p145(2)*p6(3)-p6(2)*p145(3)) & +p145k0*(c23 & w.e(2)*p6(3)-p6(2)*c23w.e(3))-p6k0*(c23w.e(2)*p145(3) & -p14 & 5(2)*c23w.e(3)) ceps_0=ceps_0*cim ceps_2=-c23w.e(3)*p6k0+p6(3)*c23w.ek0 ceps_2=ceps_2*cim cvqu=c23w.e(0)*p145(0)-c23w.e(1)*p145(1)-c23w.e(2) & *p145(2) & -c23w.e(3)*p145(3) cvqd=c23w.e(0)*p6(0)-c23w.e(1)*p6(1)-c23w.e(2)*p6(2) & -c23w. & e(3)*p6(3) cauxa=-c23w.ek0*quqd+p145k0*cvqd+p6k0*cvqu cauxb=-c23w.ek0*p6(2)+p6k0*c23w.e(2) r6_23w.a(2)=wcl*(cauxa-ceps_0) r6_23w.b(1)=wcl*(cauxb-ceps_2) * quqd -- p=p5,q=p145 quqd=p5(0)*p145(0)-p5(1)*p145(1)-p5(2)*p145(2)-p5(3) & *p145( & 3) * TWL0 -- qu=p5,qd=p145,v=c14w.e,a=l5_14w.a,c=l5_14w.c,cl=wcl,nsum=0 ceps_0=-c14w.ek0*(p5(2)*p145(3)-p145(2)*p5(3)) & +p5k0*(c14w. & e(2)*p145(3)-p145(2)*c14w.e(3))-p145k0*(c14w.e(2) & *p5(3)-p & 5(2)*c14w.e(3)) ceps_0=ceps_0*cim ceps_1=-c14w.e(3)*p5k0+p5(3)*c14w.ek0 ceps_1=ceps_1*cim cvqu=c14w.e(0)*p5(0)-c14w.e(1)*p5(1)-c14w.e(2)*p5(2) & -c14w. & e(3)*p5(3) cvqd=c14w.e(0)*p145(0)-c14w.e(1)*p145(1)-c14w.e(2) & *p145(2) & -c14w.e(3)*p145(3) cauxa=-c14w.ek0*quqd+p5k0*cvqd+p145k0*cvqu cauxc=+c14w.ek0*p5(2)-p5k0*c14w.e(2) l5_14w.a(2)=wcl*(cauxa-ceps_0) l5_14w.c(2)=wcl*(-cauxc+ceps_1) ENDIF **** * quqd -- p=p1,q=p123 quqd=p1(0)*p123(0)-p1(1)*p123(1)-p1(2)*p123(2)-p1(3)*p123( & 3) * TWL0 -- qu=p1,qd=p123,v=c23w.e,a=l1_23w.a,c=l1_23w.c,cl=wcl,nsum=0 ceps_0=-c23w.ek0*(p1(2)*p123(3)-p123(2)*p1(3))+p1k0*(c23w. & e(2)*p123(3)-p123(2)*c23w.e(3))-p123k0*(c23w.e(2)*p1(3) & -p & 1(2)*c23w.e(3)) ceps_0=ceps_0*cim ceps_1=-c23w.e(3)*p1k0+p1(3)*c23w.ek0 ceps_1=ceps_1*cim cvqu=c23w.e(0)*p1(0)-c23w.e(1)*p1(1)-c23w.e(2)*p1(2)-c23w. & e(3)*p1(3) cvqd=c23w.e(0)*p123(0)-c23w.e(1)*p123(1)-c23w.e(2)*p123(2) & -c23w.e(3)*p123(3) cauxa=-c23w.ek0*quqd+p1k0*cvqd+p123k0*cvqu cauxc=+c23w.ek0*p1(2)-p1k0*c23w.e(2) l1_23w.a(2)=wcl*(cauxa-ceps_0) l1_23w.c(2)=wcl*(-cauxc+ceps_1) * quqd -- p=p3,q=p134 quqd=p3(0)*p134(0)-p3(1)*p134(1)-p3(2)*p134(2)-p3(3)*p134( & 3) * TWL0 -- qu=p3,qd=p134,v=c14w.e,a=l3_14w.a,c=l3_14w.c,cl=wcl,nsum=0 ceps_0=-c14w.ek0*(p3(2)*p134(3)-p134(2)*p3(3))+p3k0*(c14w. & e(2)*p134(3)-p134(2)*c14w.e(3))-p134k0*(c14w.e(2)*p3(3) & -p & 3(2)*c14w.e(3)) ceps_0=ceps_0*cim ceps_1=-c14w.e(3)*p3k0+p3(3)*c14w.ek0 ceps_1=ceps_1*cim cvqu=c14w.e(0)*p3(0)-c14w.e(1)*p3(1)-c14w.e(2)*p3(2)-c14w. & e(3)*p3(3) cvqd=c14w.e(0)*p134(0)-c14w.e(1)*p134(1)-c14w.e(2)*p134(2) & -c14w.e(3)*p134(3) cauxa=-c14w.ek0*quqd+p3k0*cvqd+p134k0*cvqu cauxc=+c14w.ek0*p3(2)-p3k0*c14w.e(2) l3_14w.a(2)=wcl*(cauxa-ceps_0) l3_14w.c(2)=wcl*(-cauxc+ceps_1) **** diagramma CN30 DO i5=1,2 * TLTR0_W -- aa=cn30(i5).id(ide),a1=l1_56fz(i5).a,c1=l1_56fz(i5).c,a2=r4_23 * w.a,b2=r4_23w.b,prq=p156q,den=(p156q*p156k0),nsum=0 cn30(i5).id(ide)=( l1_56fz(i5).c(2)*p156q*r4_23w.b(1) & +l1_5 & 6fz(i5).a(2)*r4_23w.a(2) )/(p156q*p156k0) END DO **** diagramma CN31 DO i5=1,2 * TLTR0_W -- aa=cn31(i5).id(ide),a1=l3_14w.a,c1=l3_14w.c,a2=r2_56fz(i5).a,b * 2=r2_56fz(i5).b,prq=p134q,den=(p134q*p134k0),nsum=0 cn31(i5).id(ide)=( l3_14w.c(2)*p134q*r2_56fz(i5).b(1) & +l3_1 & 4w.a(2)*r2_56fz(i5).a(2) )/(p134q*p134k0) END DO **** diagramma CN32 DO i5=1,2 * TLTR0_W -- aa=cn32(i5).id(ide),a1=l1_23w.a,c1=l1_23w.c,a2=r4_56fz(i5).a,b * 2=r4_56fz(i5).b,prq=p123q,den=(p123q*p123k0),nsum=0 cn32(i5).id(ide)=( l1_23w.c(2)*p123q*r4_56fz(i5).b(1) & +l1_2 & 3w.a(2)*r4_56fz(i5).a(2) )/(p123q*p123k0) END DO **** diagramma CN33 DO i5=1,2 * TLTR0_W -- aa=cn33(i5).id(ide),a1=l3_56fz(i5).a,c1=l3_56fz(i5).c,a2=r2_14 * w.a,b2=r2_14w.b,prq=p356q,den=(p356q*p356k0),nsum=0 cn33(i5).id(ide)=( l3_56fz(i5).c(2)*p356q*r2_14w.b(1) & +l3_5 & 6fz(i5).a(2)*r2_14w.a(2) )/(p356q*p356k0) END DO **** diagramma CN34 IF (f5l.LT.0.d0) THEN * TLTR0_W -- aa=cn34.id(ide),a1=l5_23w.a,c1=l5_23w.c,a2=r6_14w.a,b2=r6_14w. * b,prq=p235q,den=((p235q-ibbveve*rmt2)*p235k0),nsum=0 cn34.id(ide)=( l5_23w.c(2)*p235q*r6_14w.b(1)+l5_23w.a(2) & *r & 6_14w.a(2) )/((p235q-ibbveve*rmt2)*p235k0) ELSE * TLTR0_W -- aa=cn34.id(ide),a1=l5_14w.a,c1=l5_14w.c,a2=r6_23w.a,b2=r6_23w. * b,prq=p145q,den=(p145q*p145k0),nsum=0 cn34.id(ide)=( l5_14w.c(2)*p145q*r6_23w.b(1)+l5_14w.a(2) & *r & 6_23w.a(2) )/(p145q*p145k0) ENDIF ENDIF !i56ve.and.iid ENDIF !i56ve IF (iid.EQ.1.AND.i34e.EQ.1) THEN !anche 56 sono elettroni **** 24 con coppia 56 elet., come a i34.eq.1 con scambio **** coppie 35<->56, dove programma entro prossimo dotab e' lo stesso * quqd -- p=p5,q=p2 quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) df=2.d0*quqd dz=2.d0*quqd+rmz2 rcr=fer/df rcl=fel/df * T10 -- qu=p5,qd=p2,v=0,a=c25f(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p5(2)*p2(3)+p2(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p2(0)+p2k0*p5(0) c25f(1).e(0)=rcr*(auxa+ceps_0) c25f(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p2,v=1,a=c25f(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c25f(1).e(1)=rcr*(auxa+ceps_0) c25f(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p2,v=2,a=c25f(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p5k0*p2(3)+p2k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p2(2)+p2k0*p5(2) c25f(1).e(2)=rcr*(auxa+ceps_0) c25f(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p2,v=3,a=c25f(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p5k0*p2(2)-p2k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p2(3)+p2k0*p5(3) c25f(1).e(3)=rcr*(auxa+ceps_0) c25f(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c25f(i).e c25f(i).ek0=c25f(i).e(0)-c25f(i).e(1) END DO rcr=zer/dz rcl=zel/dz * T10 -- qu=p5,qd=p2,v=0,a=c25z(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p5(2)*p2(3)+p2(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p2(0)+p2k0*p5(0) c25z(1).e(0)=rcr*(auxa+ceps_0) c25z(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p2,v=1,a=c25z(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c25z(1).e(1)=rcr*(auxa+ceps_0) c25z(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p2,v=2,a=c25z(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p5k0*p2(3)+p2k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p2(2)+p2k0*p5(2) c25z(1).e(2)=rcr*(auxa+ceps_0) c25z(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p2,v=3,a=c25z(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p5k0*p2(2)-p2k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p2(3)+p2k0*p5(3) c25z(1).e(3)=rcr*(auxa+ceps_0) c25z(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c25z(i).e c25z(i).ek0=c25z(i).e(0)-c25z(i).e(1) END DO * quqd -- p=p1,q=p6 quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) df=2.d0*quqd dz=2.d0*quqd+rmz2 rcr=fer/df rcl=fel/df * T10 -- qu=p1,qd=p6,v=0,a=c16f(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p1(2)*p6(3)+p6(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p6(0)+p6k0*p1(0) c16f(1).e(0)=rcr*(auxa+ceps_0) c16f(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p6,v=1,a=c16f(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16f(1).e(1)=rcr*(auxa+ceps_0) c16f(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p6,v=2,a=c16f(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p1k0*p6(3)+p6k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p6(2)+p6k0*p1(2) c16f(1).e(2)=rcr*(auxa+ceps_0) c16f(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p6,v=3,a=c16f(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p1k0*p6(2)-p6k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p6(3)+p6k0*p1(3) c16f(1).e(3)=rcr*(auxa+ceps_0) c16f(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c16f(i).e c16f(i).ek0=c16f(i).e(0)-c16f(i).e(1) END DO rcr=zer/dz rcl=zel/dz * T10 -- qu=p1,qd=p6,v=0,a=c16z(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p1(2)*p6(3)+p6(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p6(0)+p6k0*p1(0) c16z(1).e(0)=rcr*(auxa+ceps_0) c16z(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p6,v=1,a=c16z(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16z(1).e(1)=rcr*(auxa+ceps_0) c16z(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p6,v=2,a=c16z(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p1k0*p6(3)+p6k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p6(2)+p6k0*p1(2) c16z(1).e(2)=rcr*(auxa+ceps_0) c16z(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p1,qd=p6,v=3,a=c16z(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p1k0*p6(2)-p6k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p6(3)+p6k0*p1(3) c16z(1).e(3)=rcr*(auxa+ceps_0) c16z(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c16z(i).e c16z(i).ek0=c16z(i).e(0)-c16z(i).e(1) END DO **** attaccamento di c25f(2) a 6 * quqd -- p=p134,q=p6 quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p134,qd=p6,v=c25f(i).e,a=r6_25fz(i).a,b=r6_25fz(i).b,cr=fer,cl= * fel,nsum=0 ceps_0=-c25f(i).ek0*(p134(2)*p6(3)-p6(2)*p134(3))+p134k0*( & c25f(i).e(2)*p6(3)-p6(2)*c25f(i).e(3))-p6k0*(c25f(i). & e(2) & *p134(3)-p134(2)*c25f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c25f(i).e(3)*p6k0+p6(3)*c25f(i).ek0 ceps_2=ceps_2*cim cvqu=c25f(i).e(0)*p134(0)-c25f(i).e(1)*p134(1)-c25f(i).e(2 & )*p134(2)-c25f(i).e(3)*p134(3) cvqd=c25f(i).e(0)*p6(0)-c25f(i).e(1)*p6(1)-c25f(i).e(2)*p6 & (2)-c25f(i).e(3)*p6(3) cauxa=-c25f(i).ek0*quqd+p134k0*cvqd+p6k0*cvqu cauxb=-c25f(i).ek0*p6(2)+p6k0*c25f(i).e(2) r6_25fz(i).a(1)=fer*(cauxa+ceps_0) r6_25fz(i).a(2)=fel*(cauxa-ceps_0) r6_25fz(i).b(1)=fel*(cauxb-ceps_2) r6_25fz(i).b(2)=fer*(-cauxb-ceps_2) END DO **** attaccamento di c25z(2) a 6 DO i=1,2 * TR0 -- qu=p134,qd=p6,v=c25z(i).e,a=r6_25fz(i).a,b=r6_25fz(i).b,cr=zer,cl= * zel,nsum=1 ceps_0=-c25z(i).ek0*(p134(2)*p6(3)-p6(2)*p134(3))+p134k0*( & c25z(i).e(2)*p6(3)-p6(2)*c25z(i).e(3))-p6k0*(c25z(i). & e(2) & *p134(3)-p134(2)*c25z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c25z(i).e(3)*p6k0+p6(3)*c25z(i).ek0 ceps_2=ceps_2*cim cvqu=c25z(i).e(0)*p134(0)-c25z(i).e(1)*p134(1)-c25z(i).e(2 & )*p134(2)-c25z(i).e(3)*p134(3) cvqd=c25z(i).e(0)*p6(0)-c25z(i).e(1)*p6(1)-c25z(i).e(2)*p6 & (2)-c25z(i).e(3)*p6(3) cauxa=-c25z(i).ek0*quqd+p134k0*cvqd+p6k0*cvqu cauxb=-c25z(i).ek0*p6(2)+p6k0*c25z(i).e(2) r6_25fz(i).a(1)=r6_25fz(i).a(1)+zer*(cauxa+ceps_0) r6_25fz(i).a(2)=r6_25fz(i).a(2)+zel*(cauxa-ceps_0) r6_25fz(i).b(1)=r6_25fz(i).b(1)+zel*(cauxb-ceps_2) r6_25fz(i).b(2)=r6_25fz(i).b(2)+zer*(-cauxb-ceps_2) END DO **** attaccamento di c16f(2) a 2 * quqd -- p=p345,q=p2 quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) DO i=1,2 * TR0 -- qu=p345,qd=p2,v=c16f(i).e,a=r2_16fz(i).a,b=r2_16fz(i).b,cr=fer,cl= * fel,nsum=0 ceps_0=-c16f(i).ek0*(p345(2)*p2(3)-p2(2)*p345(3))+p345k0*( & c16f(i).e(2)*p2(3)-p2(2)*c16f(i).e(3))-p2k0*(c16f(i). & e(2) & *p345(3)-p345(2)*c16f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c16f(i).e(3)*p2k0+p2(3)*c16f(i).ek0 ceps_2=ceps_2*cim cvqu=c16f(i).e(0)*p345(0)-c16f(i).e(1)*p345(1)-c16f(i).e(2 & )*p345(2)-c16f(i).e(3)*p345(3) cvqd=c16f(i).e(0)*p2(0)-c16f(i).e(1)*p2(1)-c16f(i).e(2)*p2 & (2)-c16f(i).e(3)*p2(3) cauxa=-c16f(i).ek0*quqd+p345k0*cvqd+p2k0*cvqu cauxb=-c16f(i).ek0*p2(2)+p2k0*c16f(i).e(2) r2_16fz(i).a(1)=fer*(cauxa+ceps_0) r2_16fz(i).a(2)=fel*(cauxa-ceps_0) r2_16fz(i).b(1)=fel*(cauxb-ceps_2) r2_16fz(i).b(2)=fer*(-cauxb-ceps_2) END DO **** attaccamento di c16z(2) a 2 DO i=1,2 * TR0 -- qu=p345,qd=p2,v=c16z(i).e,a=r2_16fz(i).a,b=r2_16fz(i).b,cr=zer,cl= * zel,nsum=1 ceps_0=-c16z(i).ek0*(p345(2)*p2(3)-p2(2)*p345(3))+p345k0*( & c16z(i).e(2)*p2(3)-p2(2)*c16z(i).e(3))-p2k0*(c16z(i). & e(2) & *p345(3)-p345(2)*c16z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c16z(i).e(3)*p2k0+p2(3)*c16z(i).ek0 ceps_2=ceps_2*cim cvqu=c16z(i).e(0)*p345(0)-c16z(i).e(1)*p345(1)-c16z(i).e(2 & )*p345(2)-c16z(i).e(3)*p345(3) cvqd=c16z(i).e(0)*p2(0)-c16z(i).e(1)*p2(1)-c16z(i).e(2)*p2 & (2)-c16z(i).e(3)*p2(3) cauxa=-c16z(i).ek0*quqd+p345k0*cvqd+p2k0*cvqu cauxb=-c16z(i).ek0*p2(2)+p2k0*c16z(i).e(2) r2_16fz(i).a(1)=r2_16fz(i).a(1)+zer*(cauxa+ceps_0) r2_16fz(i).a(2)=r2_16fz(i).a(2)+zel*(cauxa-ceps_0) r2_16fz(i).b(1)=r2_16fz(i).b(1)+zel*(cauxb-ceps_2) r2_16fz(i).b(2)=r2_16fz(i).b(2)+zer*(-cauxb-ceps_2) END DO **** attaccamento di c25f(2) a 1 * quqd -- p=p1,q=p125 quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) DO i=1,2 * TL0 -- qu=p1,qd=p125,v=c25f(i).e,a=l1_25fz(i).a,c=l1_25fz(i).c,cr=fer,cl= * fel,nsum=0 ceps_0=-c25f(i).ek0*(p1(2)*p125(3)-p125(2)*p1(3))+p1k0*(c2 & 5f(i).e(2)*p125(3)-p125(2)*c25f(i).e(3)) & -p125k0*(c25f(i). & e(2)*p1(3)-p1(2)*c25f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c25f(i).e(3)*p1k0+p1(3)*c25f(i).ek0 ceps_1=ceps_1*cim cvqu=c25f(i).e(0)*p1(0)-c25f(i).e(1)*p1(1)-c25f(i).e(2)*p1 & (2)-c25f(i).e(3)*p1(3) cvqd=c25f(i).e(0)*p125(0)-c25f(i).e(1)*p125(1)-c25f(i).e(2 & )*p125(2)-c25f(i).e(3)*p125(3) cauxa=-c25f(i).ek0*quqd+p1k0*cvqd+p125k0*cvqu cauxc=+c25f(i).ek0*p1(2)-p1k0*c25f(i).e(2) l1_25fz(i).a(1)=fer*(cauxa+ceps_0) l1_25fz(i).a(2)=fel*(cauxa-ceps_0) l1_25fz(i).c(1)=fer*(cauxc+ceps_1) l1_25fz(i).c(2)=fel*(-cauxc+ceps_1) END DO **** attaccamento di c25z(2) a 1 DO i=1,2 * TL0 -- qu=p1,qd=p125,v=c25z(i).e,a=l1_25fz(i).a,c=l1_25fz(i).c,cr=zer,cl= * zel,nsum=1 ceps_0=-c25z(i).ek0*(p1(2)*p125(3)-p125(2)*p1(3))+p1k0*(c2 & 5z(i).e(2)*p125(3)-p125(2)*c25z(i).e(3)) & -p125k0*(c25z(i). & e(2)*p1(3)-p1(2)*c25z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c25z(i).e(3)*p1k0+p1(3)*c25z(i).ek0 ceps_1=ceps_1*cim cvqu=c25z(i).e(0)*p1(0)-c25z(i).e(1)*p1(1)-c25z(i).e(2)*p1 & (2)-c25z(i).e(3)*p1(3) cvqd=c25z(i).e(0)*p125(0)-c25z(i).e(1)*p125(1)-c25z(i).e(2 & )*p125(2)-c25z(i).e(3)*p125(3) cauxa=-c25z(i).ek0*quqd+p1k0*cvqd+p125k0*cvqu cauxc=+c25z(i).ek0*p1(2)-p1k0*c25z(i).e(2) l1_25fz(i).a(1)=l1_25fz(i).a(1)+zer*(cauxa+ceps_0) l1_25fz(i).a(2)=l1_25fz(i).a(2)+zel*(cauxa-ceps_0) l1_25fz(i).c(1)=l1_25fz(i).c(1)+zer*(cauxc+ceps_1) l1_25fz(i).c(2)=l1_25fz(i).c(2)+zel*(-cauxc+ceps_1) END DO **** attaccamento di c16f(2) a 5 * quqd -- p=p5,q=p156 quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p156,v=c16f(i).e,a=l5_16fz(i).a,c=l5_16fz(i).c,cr=fer,cl= * fel,nsum=0 ceps_0=-c16f(i).ek0*(p5(2)*p156(3)-p156(2)*p5(3))+p5k0*(c1 & 6f(i).e(2)*p156(3)-p156(2)*c16f(i).e(3)) & -p156k0*(c16f(i). & e(2)*p5(3)-p5(2)*c16f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c16f(i).e(3)*p5k0+p5(3)*c16f(i).ek0 ceps_1=ceps_1*cim cvqu=c16f(i).e(0)*p5(0)-c16f(i).e(1)*p5(1)-c16f(i).e(2)*p5 & (2)-c16f(i).e(3)*p5(3) cvqd=c16f(i).e(0)*p156(0)-c16f(i).e(1)*p156(1)-c16f(i).e(2 & )*p156(2)-c16f(i).e(3)*p156(3) cauxa=-c16f(i).ek0*quqd+p5k0*cvqd+p156k0*cvqu cauxc=+c16f(i).ek0*p5(2)-p5k0*c16f(i).e(2) l5_16fz(i).a(1)=fer*(cauxa+ceps_0) l5_16fz(i).a(2)=fel*(cauxa-ceps_0) l5_16fz(i).c(1)=fer*(cauxc+ceps_1) l5_16fz(i).c(2)=fel*(-cauxc+ceps_1) END DO **** attaccamento di c16z(2) a 5 DO i=1,2 * TL0 -- qu=p5,qd=p156,v=c16z(i).e,a=l5_16fz(i).a,c=l5_16fz(i).c,cr=zer,cl= * zel,nsum=1 ceps_0=-c16z(i).ek0*(p5(2)*p156(3)-p156(2)*p5(3))+p5k0*(c1 & 6z(i).e(2)*p156(3)-p156(2)*c16z(i).e(3)) & -p156k0*(c16z(i). & e(2)*p5(3)-p5(2)*c16z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c16z(i).e(3)*p5k0+p5(3)*c16z(i).ek0 ceps_1=ceps_1*cim cvqu=c16z(i).e(0)*p5(0)-c16z(i).e(1)*p5(1)-c16z(i).e(2)*p5 & (2)-c16z(i).e(3)*p5(3) cvqd=c16z(i).e(0)*p156(0)-c16z(i).e(1)*p156(1)-c16z(i).e(2 & )*p156(2)-c16z(i).e(3)*p156(3) cauxa=-c16z(i).ek0*quqd+p5k0*cvqd+p156k0*cvqu cauxc=+c16z(i).ek0*p5(2)-p5k0*c16z(i).e(2) l5_16fz(i).a(1)=l5_16fz(i).a(1)+zer*(cauxa+ceps_0) l5_16fz(i).a(2)=l5_16fz(i).a(2)+zel*(cauxa-ceps_0) l5_16fz(i).c(1)=l5_16fz(i).c(1)+zer*(cauxc+ceps_1) l5_16fz(i).c(2)=l5_16fz(i).c(2)+zel*(-cauxc+ceps_1) END DO **** attaccamento di c16f(2) a 3 * quqd -- p=p3,q=p136 quqd=p3(0)*p136(0)-p3(1)*p136(1)-p3(2)*p136(2)-p3(3)*p136( & 3) DO i=1,2 * TL0 -- qu=p3,qd=p136,v=c16f(i).e,a=l3_16fz(i).a,c=l3_16fz(i).c,cr=f3r,cl= * f3l,nsum=0 ceps_0=-c16f(i).ek0*(p3(2)*p136(3)-p136(2)*p3(3))+p3k0*(c1 & 6f(i).e(2)*p136(3)-p136(2)*c16f(i).e(3)) & -p136k0*(c16f(i). & e(2)*p3(3)-p3(2)*c16f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c16f(i).e(3)*p3k0+p3(3)*c16f(i).ek0 ceps_1=ceps_1*cim cvqu=c16f(i).e(0)*p3(0)-c16f(i).e(1)*p3(1)-c16f(i).e(2)*p3 & (2)-c16f(i).e(3)*p3(3) cvqd=c16f(i).e(0)*p136(0)-c16f(i).e(1)*p136(1)-c16f(i).e(2 & )*p136(2)-c16f(i).e(3)*p136(3) cauxa=-c16f(i).ek0*quqd+p3k0*cvqd+p136k0*cvqu cauxc=+c16f(i).ek0*p3(2)-p3k0*c16f(i).e(2) l3_16fz(i).a(1)=f3r*(cauxa+ceps_0) l3_16fz(i).a(2)=f3l*(cauxa-ceps_0) l3_16fz(i).c(1)=f3r*(cauxc+ceps_1) l3_16fz(i).c(2)=f3l*(-cauxc+ceps_1) END DO **** attaccamento di c16z(2) a 3 DO i=1,2 * TL0 -- qu=p3,qd=p136,v=c16z(i).e,a=l3_16fz(i).a,c=l3_16fz(i).c,cr=z3r,cl= * z3l,nsum=1 ceps_0=-c16z(i).ek0*(p3(2)*p136(3)-p136(2)*p3(3))+p3k0*(c1 & 6z(i).e(2)*p136(3)-p136(2)*c16z(i).e(3)) & -p136k0*(c16z(i). & e(2)*p3(3)-p3(2)*c16z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c16z(i).e(3)*p3k0+p3(3)*c16z(i).ek0 ceps_1=ceps_1*cim cvqu=c16z(i).e(0)*p3(0)-c16z(i).e(1)*p3(1)-c16z(i).e(2)*p3 & (2)-c16z(i).e(3)*p3(3) cvqd=c16z(i).e(0)*p136(0)-c16z(i).e(1)*p136(1)-c16z(i).e(2 & )*p136(2)-c16z(i).e(3)*p136(3) cauxa=-c16z(i).ek0*quqd+p3k0*cvqd+p136k0*cvqu cauxc=+c16z(i).ek0*p3(2)-p3k0*c16z(i).e(2) l3_16fz(i).a(1)=l3_16fz(i).a(1)+z3r*(cauxa+ceps_0) l3_16fz(i).a(2)=l3_16fz(i).a(2)+z3l*(cauxa-ceps_0) l3_16fz(i).c(1)=l3_16fz(i).c(1)+z3r*(cauxc+ceps_1) l3_16fz(i).c(2)=l3_16fz(i).c(2)+z3l*(-cauxc+ceps_1) END DO **** attaccamento di c25f(2) a 3 * quqd -- p=p3,q=p235 quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) DO i=1,2 * TL0 -- qu=p3,qd=p235,v=c25f(i).e,a=l3_25fz(i).a,c=l3_25fz(i).c,cr=f3r,cl= * f3l,nsum=0 ceps_0=-c25f(i).ek0*(p3(2)*p235(3)-p235(2)*p3(3))+p3k0*(c2 & 5f(i).e(2)*p235(3)-p235(2)*c25f(i).e(3)) & -p235k0*(c25f(i). & e(2)*p3(3)-p3(2)*c25f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c25f(i).e(3)*p3k0+p3(3)*c25f(i).ek0 ceps_1=ceps_1*cim cvqu=c25f(i).e(0)*p3(0)-c25f(i).e(1)*p3(1)-c25f(i).e(2)*p3 & (2)-c25f(i).e(3)*p3(3) cvqd=c25f(i).e(0)*p235(0)-c25f(i).e(1)*p235(1)-c25f(i).e(2 & )*p235(2)-c25f(i).e(3)*p235(3) cauxa=-c25f(i).ek0*quqd+p3k0*cvqd+p235k0*cvqu cauxc=+c25f(i).ek0*p3(2)-p3k0*c25f(i).e(2) l3_25fz(i).a(1)=f3r*(cauxa+ceps_0) l3_25fz(i).a(2)=f3l*(cauxa-ceps_0) l3_25fz(i).c(1)=f3r*(cauxc+ceps_1) l3_25fz(i).c(2)=f3l*(-cauxc+ceps_1) END DO **** attaccamento di c25z(2) a 3 DO i=1,2 * TL0 -- qu=p3,qd=p235,v=c25z(i).e,a=l3_25fz(i).a,c=l3_25fz(i).c,cr=z3r,cl= * z3l,nsum=1 ceps_0=-c25z(i).ek0*(p3(2)*p235(3)-p235(2)*p3(3))+p3k0*(c2 & 5z(i).e(2)*p235(3)-p235(2)*c25z(i).e(3)) & -p235k0*(c25z(i). & e(2)*p3(3)-p3(2)*c25z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c25z(i).e(3)*p3k0+p3(3)*c25z(i).ek0 ceps_1=ceps_1*cim cvqu=c25z(i).e(0)*p3(0)-c25z(i).e(1)*p3(1)-c25z(i).e(2)*p3 & (2)-c25z(i).e(3)*p3(3) cvqd=c25z(i).e(0)*p235(0)-c25z(i).e(1)*p235(1)-c25z(i).e(2 & )*p235(2)-c25z(i).e(3)*p235(3) cauxa=-c25z(i).ek0*quqd+p3k0*cvqd+p235k0*cvqu cauxc=+c25z(i).ek0*p3(2)-p3k0*c25z(i).e(2) l3_25fz(i).a(1)=l3_25fz(i).a(1)+z3r*(cauxa+ceps_0) l3_25fz(i).a(2)=l3_25fz(i).a(2)+z3l*(cauxa-ceps_0) l3_25fz(i).c(1)=l3_25fz(i).c(1)+z3r*(cauxc+ceps_1) l3_25fz(i).c(2)=l3_25fz(i).c(2)+z3l*(-cauxc+ceps_1) END DO **** attaccamento di c25f(2) a 4 * quqd -- p=p136,q=p4 quqd=p136(0)*p4(0)-p136(1)*p4(1)-p136(2)*p4(2)-p136(3)*p4( & 3) DO i=1,2 * TR0 -- qu=p136,qd=p4,v=c25f(i).e,a=r4_25fz(i).a,b=r4_25fz(i).b,cr=f3r,cl= * f3l,nsum=0 ceps_0=-c25f(i).ek0*(p136(2)*p4(3)-p4(2)*p136(3))+p136k0*( & c25f(i).e(2)*p4(3)-p4(2)*c25f(i).e(3))-p4k0*(c25f(i). & e(2) & *p136(3)-p136(2)*c25f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c25f(i).e(3)*p4k0+p4(3)*c25f(i).ek0 ceps_2=ceps_2*cim cvqu=c25f(i).e(0)*p136(0)-c25f(i).e(1)*p136(1)-c25f(i).e(2 & )*p136(2)-c25f(i).e(3)*p136(3) cvqd=c25f(i).e(0)*p4(0)-c25f(i).e(1)*p4(1)-c25f(i).e(2)*p4 & (2)-c25f(i).e(3)*p4(3) cauxa=-c25f(i).ek0*quqd+p136k0*cvqd+p4k0*cvqu cauxb=-c25f(i).ek0*p4(2)+p4k0*c25f(i).e(2) r4_25fz(i).a(1)=f3r*(cauxa+ceps_0) r4_25fz(i).a(2)=f3l*(cauxa-ceps_0) r4_25fz(i).b(1)=f3l*(cauxb-ceps_2) r4_25fz(i).b(2)=f3r*(-cauxb-ceps_2) END DO **** attaccamento di c25z(2) a 4 DO i=1,2 * TR0 -- qu=p136,qd=p4,v=c25z(i).e,a=r4_25fz(i).a,b=r4_25fz(i).b,cr=z3r,cl= * z3l,nsum=1 ceps_0=-c25z(i).ek0*(p136(2)*p4(3)-p4(2)*p136(3))+p136k0*( & c25z(i).e(2)*p4(3)-p4(2)*c25z(i).e(3))-p4k0*(c25z(i). & e(2) & *p136(3)-p136(2)*c25z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c25z(i).e(3)*p4k0+p4(3)*c25z(i).ek0 ceps_2=ceps_2*cim cvqu=c25z(i).e(0)*p136(0)-c25z(i).e(1)*p136(1)-c25z(i).e(2 & )*p136(2)-c25z(i).e(3)*p136(3) cvqd=c25z(i).e(0)*p4(0)-c25z(i).e(1)*p4(1)-c25z(i).e(2)*p4 & (2)-c25z(i).e(3)*p4(3) cauxa=-c25z(i).ek0*quqd+p136k0*cvqd+p4k0*cvqu cauxb=-c25z(i).ek0*p4(2)+p4k0*c25z(i).e(2) r4_25fz(i).a(1)=r4_25fz(i).a(1)+z3r*(cauxa+ceps_0) r4_25fz(i).a(2)=r4_25fz(i).a(2)+z3l*(cauxa-ceps_0) r4_25fz(i).b(1)=r4_25fz(i).b(1)+z3l*(cauxb-ceps_2) r4_25fz(i).b(2)=r4_25fz(i).b(2)+z3r*(-cauxb-ceps_2) END DO **** attaccamento di c16f(2) a 4 * quqd -- p=p235,q=p4 quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) DO i=1,2 * TR0 -- qu=p235,qd=p4,v=c16f(i).e,a=r4_16fz(i).a,b=r4_16fz(i).b,cr=f3r,cl= * f3l,nsum=0 ceps_0=-c16f(i).ek0*(p235(2)*p4(3)-p4(2)*p235(3))+p235k0*( & c16f(i).e(2)*p4(3)-p4(2)*c16f(i).e(3))-p4k0*(c16f(i). & e(2) & *p235(3)-p235(2)*c16f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c16f(i).e(3)*p4k0+p4(3)*c16f(i).ek0 ceps_2=ceps_2*cim cvqu=c16f(i).e(0)*p235(0)-c16f(i).e(1)*p235(1)-c16f(i).e(2 & )*p235(2)-c16f(i).e(3)*p235(3) cvqd=c16f(i).e(0)*p4(0)-c16f(i).e(1)*p4(1)-c16f(i).e(2)*p4 & (2)-c16f(i).e(3)*p4(3) cauxa=-c16f(i).ek0*quqd+p235k0*cvqd+p4k0*cvqu cauxb=-c16f(i).ek0*p4(2)+p4k0*c16f(i).e(2) r4_16fz(i).a(1)=f3r*(cauxa+ceps_0) r4_16fz(i).a(2)=f3l*(cauxa-ceps_0) r4_16fz(i).b(1)=f3l*(cauxb-ceps_2) r4_16fz(i).b(2)=f3r*(-cauxb-ceps_2) END DO **** attaccamento di c16z(2) a 4 DO i=1,2 * TR0 -- qu=p235,qd=p4,v=c16z(i).e,a=r4_16fz(i).a,b=r4_16fz(i).b,cr=z3r,cl= * z3l,nsum=1 ceps_0=-c16z(i).ek0*(p235(2)*p4(3)-p4(2)*p235(3))+p235k0*( & c16z(i).e(2)*p4(3)-p4(2)*c16z(i).e(3))-p4k0*(c16z(i). & e(2) & *p235(3)-p235(2)*c16z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c16z(i).e(3)*p4k0+p4(3)*c16z(i).ek0 ceps_2=ceps_2*cim cvqu=c16z(i).e(0)*p235(0)-c16z(i).e(1)*p235(1)-c16z(i).e(2 & )*p235(2)-c16z(i).e(3)*p235(3) cvqd=c16z(i).e(0)*p4(0)-c16z(i).e(1)*p4(1)-c16z(i).e(2)*p4 & (2)-c16z(i).e(3)*p4(3) cauxa=-c16z(i).ek0*quqd+p235k0*cvqd+p4k0*cvqu cauxb=-c16z(i).ek0*p4(2)+p4k0*c16z(i).e(2) r4_16fz(i).a(1)=r4_16fz(i).a(1)+z3r*(cauxa+ceps_0) r4_16fz(i).a(2)=r4_16fz(i).a(2)+z3l*(cauxa-ceps_0) r4_16fz(i).b(1)=r4_16fz(i).b(1)+z3l*(cauxb-ceps_2) r4_16fz(i).b(2)=r4_16fz(i).b(2)+z3r*(-cauxb-ceps_2) END DO **** Diagramma CN17 **** DO i2=1,2 DO i5=1,2 * TLTR0 -- aa=cn17(&,i2,i5).id(ide),a1=l1_34fz(i5).a,c1=l1_34fz(i5).c,a2=r6 * _25fz(i2).a,b2=r6_25fz(i2).b,prq=p134q,den=(p134q*p134k0),nsum=0 cn17(1,i2,i5).id(ide)=( l1_34fz(i5).a(1)*r6_25fz(i2). & a(1)+ & l1_34fz(i5).c(1)*p134q*r6_25fz(i2).b(2) ) & /(p134q*p134k0) cn17(2,i2,i5).id(ide)=( l1_34fz(i5).c(2) & *p134q*r6_25fz(i2) & .b(1)+l1_34fz(i5).a(2)*r6_25fz(i2).a(2) ) & /(p134q*p134k0) END DO END DO **** Diagramma CN18 **** DO i2=1,2 DO i5=1,2 * TLTR0 -- aa=cn18(&,i2,i5).id(ide),a1=l1_25fz(i2).a,c1=l1_25fz(i2).c,a2=r6 * _34fz(i5).a,b2=r6_34fz(i5).b,prq=p125q,den=(p125q*p125k0),nsum=0 cn18(1,i2,i5).id(ide)=( l1_25fz(i2).a(1)*r6_34fz(i5). & a(1)+ & l1_25fz(i2).c(1)*p125q*r6_34fz(i5).b(2) ) & /(p125q*p125k0) cn18(2,i2,i5).id(ide)=( l1_25fz(i2).c(2) & *p125q*r6_34fz(i5) & .b(1)+l1_25fz(i2).a(2)*r6_34fz(i5).a(2) ) & /(p125q*p125k0) END DO END DO **** Diagramma CN19 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn19(i1,&,i5).id(ide),a1=l5_16fz(i1).a,c1=l5_16fz(i1).c,a2=r2 * _34fz(i5).a,b2=r2_34fz(i5).b,prq=p156q,den=(p156q*p156k0),nsum=0 cn19(i1,1,i5).id(ide)=( l5_16fz(i1).a(1)*r2_34fz(i5). & a(1)+ & l5_16fz(i1).c(1)*p156q*r2_34fz(i5).b(2) ) & /(p156q*p156k0) cn19(i1,2,i5).id(ide)=( l5_16fz(i1).c(2) & *p156q*r2_34fz(i5) & .b(1)+l5_16fz(i1).a(2)*r2_34fz(i5).a(2) ) & /(p156q*p156k0) END DO END DO **** Diagramma CN20 **** DO i1=1,2 DO i5=1,2 * TLTR0 -- aa=cn20(i1,&,i5).id(ide),a1=l5_34fz(i5).a,c1=l5_34fz(i5).c,a2=r2 * _16fz(i1).a,b2=r2_16fz(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cn20(i1,1,i5).id(ide)=( l5_34fz(i5).a(1)*r2_16fz(i1). & a(1)+ & l5_34fz(i5).c(1)*p345q*r2_16fz(i1).b(2) ) & /(p345q*p345k0) cn20(i1,2,i5).id(ide)=( l5_34fz(i5).c(2) & *p345q*r2_16fz(i1) & .b(1)+l5_34fz(i5).a(2)*r2_16fz(i1).a(2) ) & /(p345q*p345k0) END DO END DO **** Diagramma CN21 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cn21(i1,i2,&).id(ide),a1=l3_16fz(i1).a,c1=l3_16fz(i1).c,a2=r4 * _25fz(i2).a,b2=r4_25fz(i2).b,prq=p136q,den=(p136q*p136k0),nsum=0 cn21(i1,i2,1).id(ide)=( l3_16fz(i1).a(1)*r4_25fz(i2). & a(1)+ & l3_16fz(i1).c(1)*p136q*r4_25fz(i2).b(2) ) & /(p136q*p136k0) cn21(i1,i2,2).id(ide)=( l3_16fz(i1).c(2) & *p136q*r4_25fz(i2) & .b(1)+l3_16fz(i1).a(2)*r4_25fz(i2).a(2) ) & /(p136q*p136k0) END DO END DO **** Diagramma CN22 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cn22(i1,i2,&).id(ide),a1=l3_25fz(i2).a,c1=l3_25fz(i2).c,a2=r4 * _16fz(i1).a,b2=r4_16fz(i1).b,prq=p235q,den=(p235q*p235k0),nsum= cn22(i1,i2,1).id(ide)=( l3_25fz(i2).a(1)*r4_16fz(i1). & a(1)+ & l3_25fz(i2).c(1)*p235q*r4_16fz(i1).b(2) ) & /(p235q*p235k0) cn22(i1,i2,2).id(ide)=( l3_25fz(i2).c(2) & *p235q*r4_16fz(i1) & .b(1)+l3_25fz(i2).a(2)*r4_16fz(i1).a(2) ) & /(p235q*p235k0) END DO END DO ENDIF !iid.eq.1.and.i34e.eq.1 END DO !fine del do che prende tutte nc per particelle identiche **** fine NC ENDIF ******************qui mettere le somme dei diagrammi******************** IF(icoul.EQ.1.AND.(imix.EQ.1.OR.imix.EQ.2)) THEN app=(s-(sqrt(s36)-sqrt(s54))**2)*(s-(sqrt(s36)+sqrt(s54))**2) IF (app.LE.0.d0) THEN ee_4f=0.d0 RETURN ENDIF betac=sqrt(app)/s delta=abs(s36-s54)/s app=(1.d0-4.d0*rmw2/s)**2+16.d0*rmw2*gamw**2/(s**2) IF (app.LT.0.d0) THEN ee_4f=0.d0 RETURN ENDIF rk2=1.d0-4.d0*rmw2/s+sqrt(app) IF (rk2.LE.0.d0) THEN ee_4f=0.d0 RETURN ENDIF rk2=sqrt(rmw2*rk2/2.d0) rk1=-1.d0+4.d0*rmw2/s+sqrt(app) IF (rk1.LE.0.d0) THEN ee_4f=0.d0 RETURN ENDIF rk1=sqrt(rmw2*rk1/2.d0) cbetam=(rk2+cim*rk1)/sqrt(rmw2) fcoul=((cbetam+delta)*conjg(cbetam+delta)-betac**2)/ & (2.d0*betac*rk1/sqrt(rmw2)) fcoul=(pi-2.d0*atan(fcoul))/(2.d0*betac*128.07d0) ENDIF IF (istrcor.EQ.1) THEN IF(i3q.EQ.1.AND.i5q.EQ.1)THEN fatcor_cc=(1.d0+2.d0*qcdcor_cc)/(1.d0+2.d0*qcdcor_nc) fatcor_nc=1.d0/(1.d0+2.d0*qcdcor_nc) fatcor_ccnc=(1.d0+qcdcor_cc+qcdcor_nc)/(1.d0+2.d0*qcdcor_nc) ELSE IF((i3q.EQ.1.AND.i5q.EQ.0).OR.(i3q.EQ.0.AND.i5q.EQ.1))THEN fatcor_cc=(1.d0+qcdcor_cc)/(1.d0+qcdcor_nc) fatcor_nc=1.d0/(1.d0+qcdcor_nc) fatcor_ccnc=(1.d0+0.5d0*(qcdcor_cc+qcdcor_nc)) & /(1.d0+qcdcor_nc) ELSE fatcor_cc=1.d0 fatcor_nc=1.d0 fatcor_ccnc=1.d0 ENDIF ELSE fatcor_cc=1.d0 fatcor_nc=1.d0 fatcor_ccnc=1.d0 ENDIF res=0.d0 DO i1=1,2 IF (i3e.EQ.1.AND.(icc.EQ.1.OR.icc.EQ.-1)) then cc_3e(i1)=-cc7(i1)-cc8(i1)-cc9(i1)-cc10(i1) & -cc11(i1)-cc12(i1) ENDIF IF (i4e.EQ.1.AND.(icc.EQ.1.OR.icc.EQ.-1)) then cc_4e(i1)=-cc13(i1)-cc14(i1)-cc15(i1)-cc16(i1) & -cc17(i1)-cc18(i1) ENDIF IF (icc.EQ.0.OR.icc.EQ.-1) then DO i3=1,2 DO i5=1,2 DO ide=0,iid cn_4f(i1,i3,i5).id(ide)=cn1(i1,i3,i5).id(ide) & +cn2(i1,i3,i5).id(ide) & +cn3(i1,i3,i5).id(ide)+cn4(i1,i3,i5).id(ide) & +cn5(i1,i3,i5).id(ide)+cn6(i1,i3,i5).id(ide) IF (i34e.EQ.1) THEN cn_34e(i1,i3,i5).id(ide)=cn11(i1,i3,i5).id(ide) & +cn12(i1,i3,i5).id(ide) & +cn13(i1,i3,i5).id(ide)+cn14(i1,i3,i5).id(ide) & +cn15(i1,i3,i5).id(ide)+cn16(i1,i3,i5).id(ide) IF (iid.EQ.1) THEN cn_56e(i1,i3,i5).id(ide)=cn17(i1,i5,i3).id(ide) & +cn18(i1,i5,i3).id(ide)+cn19(i1,i5,i3).id(ide) & +cn20(i1,i5,i3).id(ide)+cn21(i1,i5,i3).id(ide) & +cn22(i1,i5,i3).id(ide) ENDIF ENDIF IF (i56ve.EQ.1.AND.i1.EQ.2.AND.i5.EQ.2) THEN cn_56v(i3).id(ide)=cn23(i3).id(ide)+cn24(i3).id(ide) & +cn25(i3).id(ide)+cn26(i3).id(ide) & +cn27(i3).id(ide) IF (i3.EQ.2) THEN cn_56v(i3).id(ide)=cn_56v(i3).id(ide)+cn28.id(ide) ENDIF IF (iid.EQ.1) THEN cn_34v(i3).id(ide)=cn29(i3).id(ide) & +cn30(i3).id(ide)+cn31(i3).id(ide) & +cn32(i3).id(ide)+cn33(i3).id(ide) IF (i3.EQ.2) THEN cn_34v(i3).id(ide)=cn_34v(i3).id(ide) & +cn34.id(ide) ENDIF ENDIF !i56ve e iid ENDIF !i56ve IF (iqu.EQ.1) THEN cn_qcd(i1,i3,i5).id(ide)=cn7(i1,i3,i5).id(ide) & +cn8(i1,i3,i5).id(ide)+cn9(i1,i3,i5).id(ide) & +cn10(i1,i3,i5).id(ide) ENDIF ENDDO !ide ENDDO !i5 ENDDO !i3 ENDIF ENDDO !i1 DO i1=1,2 DO i3=1,2 DO i5=1,2 IF ((icc.EQ.1.OR.icc.EQ.-1).and.(i3.eq.2.and.i5.eq.2)) then cres=cc1(i1) IF (i1.EQ.2) THEN cres=cres+cc2(2) ENDIF IF (icoul.EQ.1.AND.(imix.EQ.1.OR.imix.EQ.2)) THEN res=res+fcoul*(dreal(cres)**2+dimag(cres)**2)*fatcor_cc ENDIF IF (icc3.EQ.0) THEN cres=cres+cc3(i1)+cc4(i1)+cc5(i1)+cc6(i1) ENDIF IF (i3e.EQ.1.AND.i1.EQ.2) THEN cres=cres+cc_3e(2) ENDIF IF (i4e.EQ.1.AND.i1.EQ.2) THEN cres=cres+cc_4e(2) ENDIF IF (imix.EQ.1.OR.imix.EQ.2) THEN res=res+(dreal(cres)**2+dimag(cres)**2)*fatcor_cc IF (i1.EQ.1.AND.i3e.EQ.1) THEN res=res+cc_3e(1)*conjg(cc_3e(1))*fatcor_cc ENDIF IF (i1.EQ.1.AND.i4e.EQ.1) THEN res=res+cc_4e(1)*conjg(cc_4e(1))*fatcor_cc ENDIF ENDIF !imix=1-2 ENDIF !( solo CC ) IF (icc.EQ.0.OR.icc.EQ.-1) then cres1=-cn_4f(i1,i3,i5).id(0) IF (i34e.EQ.1.AND.i1.EQ.i3) THEN cres1=cres1+cn_34e(i1,i3,i5).id(0) ENDIF IF (i56ve.EQ.1.AND.i1.EQ.2.AND.i5.EQ.2) THEN IF ((icc.EQ.0).OR.(icc.EQ.-1.and.i3.eq.2)) then cres1=cres1+cn_56v(i3).id(0) IF (iid.EQ.1) THEN cres1=cres1+cn_34v(i3).id(0) ENDIF ENDIF ENDIF !i56ve IF (i34e.EQ.1.AND.iid.EQ.1.AND.i1.EQ.i5) THEN cres1=cres1+cn_56e(i1,i3,i5).id(0) ENDIF IF (imix.EQ.-1.and.iid.eq.1)then res=res+2.d0*dreal(cres1)**2+2.d0*dimag(cres1)**2 ELSE IF (imix.EQ.-2.or.imix.eq.-1) then res=res+dreal(cres1)**2+dimag(cres1)**2 ENDIF IF (iqu.EQ.1) THEN rc=2.d0/9.d0 IF (iid.EQ.1.AND.imix.EQ.-1) then res=res+2.d0*rc*(qcdcoupl**2)*cn_qcd(i1,i3,i5).id(0) & *conjg(cn_qcd(i1,i3,i5).id(0))*fatcor_nc ELSE IF (imix.EQ.-2.or.imix.eq.-1) then res=res+rc*(qcdcoupl**2)*cn_qcd(i1,i3,i5).id(0) & *conjg(cn_qcd(i1,i3,i5).id(0))*fatcor_nc ENDIF ENDIF IF (i34e.EQ.1.AND.i1.NE.i3) THEN IF (iid.EQ.1.AND.imix.EQ.-1) then res=res+2.d0*cn_34e(i1,i3,i5).id(0) & *conjg(cn_34e(i1,i3,i5).id(0)) ELSE IF (imix.EQ.-2.or.imix.eq.-1) then res=res+cn_34e(i1,i3,i5).id(0) & *conjg(cn_34e(i1,i3,i5).id(0)) ENDIF ENDIF IF (icc.EQ.0.AND.iid.EQ.1.AND.i34e.EQ.1.AND.i1.NE.i5) THEN res=res+2.d0*cn_56e(i1,i3,i5).id(0) & *conjg(cn_56e(i1,i3,i5).id(0)) ENDIF IF (icc.EQ.-1) then IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=1.d0/3.d0 ELSE rc=1.d0 ENDIF IF (i56ve.EQ.1.AND.i1.EQ.2.AND.i3.EQ.1.AND.i5.EQ.2) THEN IF (iid.EQ.1.AND.imix.EQ.-1) then res=res-2.d0*(cn_4f(i1,i3,i5).id(0) & *conjg(cn_56v(i3).id(0))+cn_56v(i3).id(0) & *conjg(cn_4f(i1,i3,i5).id(0)) & -cn_56v(i3).id(0)*conjg(cn_56v(i3).id(0))) ELSE IF (imix.EQ.-2.or.imix.eq.-1) then res=res-cn_4f(i1,i3,i5).id(0)*conjg(cn_56v(i3). & id(0)) & -cn_56v(i3).id(0)*conjg(cn_4f(i1,i3,i5).id(0)) & +cn_56v(i3).id(0)*conjg(cn_56v(i3).id(0)) ENDIF ENDIF ENDIF !( fine NC ) IF (imix.EQ.2.OR.imix.EQ.0.OR.imix.EQ.-2) then IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=1.d0/3.d0 ELSE rc=1.d0 ENDIF IF (i3.EQ.2.AND.i5.EQ.2) THEN res=res+rc*(cres*conjg(cres1)+cres1*conjg(cres)) & *fatcor_ccnc ENDIF IF (iqu.EQ.1.AND.i3.EQ.2.AND.i5.EQ.2) THEN rc1=4.d0/9.d0 res=res-rc1*qcdcoupl*(cres*conjg(cn_qcd(i1,i3,i5). & id(0))+cn_qcd(i1,i3,i5).id(0)*conjg(cres))*fatcor_nc ENDIF IF (i1.EQ.2.AND.i3.EQ.1.AND.i5.EQ.2. & AND.i3e.EQ.1.AND.i34e.EQ.1) THEN res=res+(cn_34e(i1,i3,i5).id(0)*conjg(cc_3e(i3)) & +cc_3e(i3)*conjg(cn_34e(i1,i3,i5).id(0)))* & *fatcor_ccnc ENDIF IF (i1.EQ.1.AND.i3.EQ.2.AND.i5.EQ.2. & AND.i34e.EQ.1.AND.i4e.EQ.1) THEN res=res+(cn_34e(i1,i3,i5).id(0)*conjg(cc_4e(i1)) & +cc_4e(i1)*conjg(cn_34e(i1,i3,i5).id(0)))* & fatcor_ccnc ENDIF ENDIF ! fine interferenze NC+CC IF (icc.EQ.0.AND.iid.EQ.1) THEN IF (i3.EQ.i5) THEN IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=1.d0/3.d0 ELSE rc=1.d0 ENDIF res=res-rc*(cn_4f(i1,i3,i5).id(0) & *conjg(cn_4f(i1,i3,i5).id(1))+cn_4f(i1,i3,i5). & id(1)*conjg(cn_4f(i1,i3,i5).id(0))) IF (iqu.EQ.1) THEN rc1=2.d0/27.d0 rc2=4.d0/9.d0 res=res+(qcdcoupl**2)*rc1*(cn_qcd(i1,i3,i5).id(0) & *conjg(cn_qcd(i1,i3,i5).id(1))+cn_qcd(i1,i3,i5). & id(1)*conjg(cn_qcd(i1,i3,i5).id(0)))-rc2*qcdcoupl & *(cn_qcd(i1,i3,i5).id(0)*conjg(cn_4f(i1,i3,i5). & id(1))+cn_4f(i1,i3,i5).id(1) & *conjg(cn_qcd(i1,i3,i5).id(0)))*fatcor_nc ENDIF IF (i34e.EQ.1) THEN res=res-cn_34e(i1,i3,i5).id(0)* & conjg(cn_34e(i1,i3,i5).id(1))-cn_34e(i1,i3,i5). & id(1)*conjg(cn_34e(i1,i3,i5).id(0)) & -cn_56e(i1,i3,i5).id(0)*conjg(cn_56e(i1,i3,i5). & id(1))-cn_56e(i1,i3,i5).id(1)* & conjg(cn_56e(i1,i3,i5).id(0)) ENDIF ENDIF IF (i34e.EQ.1.AND.i1.EQ.i5) THEN res=res-2.d0*cn_34e(i1,i3,i5).id(0) & *conjg(cn_56e(i1,i5,i3).id(1))-2.d0*cn_56e & (i1,i5,i3).id(1)*conjg(cn_34e(i1,i3,i5).id(0)) ENDIF IF (i34e.EQ.1.AND.i1.EQ.i3.AND.i1.EQ.i5) THEN res=res+2.d0*cn_4f(i1,i3,i5).id(0) & *conjg(cn_34e(i1,i3,i5).id(1)) & +2.d0*cn_34e(i1,i3,i5).id(1) & *conjg(cn_4f(i1,i3,i5).id(0)) & +2.d0*cn_4f(i1,i3,i5).id(0) & *conjg(cn_56e(i1,i3,i5).id(1)) & +2.d0*cn_56e(i1,i3,i5).id(1) & *conjg(cn_4f(i1,i3,i5).id(0)) ENDIF IF (i56ve.EQ.1.AND.i1.EQ.2.AND.i3.EQ.2.AND.i5.EQ.2) THEN res=res-cn_56v(2).id(1)*conjg(cn_56v(2).id(0)) & -cn_56v(2).id(0)*conjg(cn_56v(2).id(1)) & -cn_34v(2).id(1)*conjg(cn_34v(2).id(0)) & -cn_34v(2).id(0)*conjg(cn_34v(2).id(1)) & -2.d0*cn_56v(2).id(0)*conjg(cn_34v(2).id(1)) & -2.d0*cn_34v(2).id(1)*conjg(cn_56v(2).id(0)) & +2.d0*cn_4f(2,2,2).id(0)*conjg(cn_56v(2).id(1)) & +2.d0*cn_4f(2,2,2).id(0)*conjg(cn_34v(2).id(1)) & +2.d0*cn_56v(2).id(1)*conjg(cn_4f(2,2,2).id(0)) & +2.d0*cn_34v(2).id(1)*conjg(cn_4f(2,2,2).id(0)) ENDIF !i56ve ENDIF !iid=1 ENDIF ! fine CC + NC ENDDO !i5 ENDDO !i3 ENDDO !i1 IF (iid.EQ.1) THEN rden=16.d0 ELSE rden=4.d0 ENDIF IF (i3q.EQ.0.AND.i5q.EQ.0) THEN rc=1.d0 ELSE IF ((i3q.EQ.1.AND.i5q.EQ.0).OR. & (i3q.EQ.0.AND.i5q.EQ.1)) THEN rc=3.d0 ELSE IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=9.d0 ENDIF ee_4f=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/rden IF (istrcor.EQ.1) THEN IF ((i3q.EQ.1.AND.i5q.EQ.0).OR.(i3q.EQ.0.AND.i5q.EQ.1)) THEN ee_4f=ee_4f*(1.d0+qcdcor_nc) ELSE IF (i3q.EQ.1.AND.i5q.EQ.1) THEN ee_4f=ee_4f*(1.d0+2.d0*qcdcor_nc) ENDIF ENDIF RETURN END REAL*8 FUNCTION ee_bbvv(p1,p2,p3,p4,p5,p6) IMPLICIT REAL*8 (a-b,d-h,o-z) IMPLICIT double COMPLEX (c) DIMENSION p1(0:3),p2(0:3),p3(0:3),p4(0:3),p5(0:3),p6(0:3) DIMENSION p34(0:3),p16(0:3),p25(0:3),p123(0:3),p125(0:3), & p134(0:3),p156(0:3),p235(0:3),p345(0:3),p356(0:3) DIMENSION vfz(0:3),vwm(0:3),vwp(0:3) DIMENSION cres1(2,2),cres2(2,2),cres3(2,2),cres4(2,2,2), & cres5(2,2,2),cres6(2,2),cres7(2,2),cres9(2,2,2),cres37(2,2), & cres10(2,2,2),cres11(2,2),cres12(2,2),cres13(2,2),c34h(2,2), & cres14(2,2,2),cres15(2,2,2),cres16(2,2,2),cres17(2,2,2), & cres18(2,2),cres20(2,2,2),cres21(2,2,2),cres36(2,2,2) STRUCTURE/polcom/ double COMPLEX e(0:3),ek0,v END STRUCTURE RECORD/polcom/c12f(2),c12z(2),c16w,c52w,c34f(2,2),c34z(2,2),c56z STRUCTURE/tu0/ double COMPLEX a(2),c(2) END STRUCTURE RECORD/tu0/l1_34f(2,2),l1_34z(2,2),l5_12(2),l5_34(2,2),l1_56, & l5_16,l1_52 STRUCTURE/td0/ double COMPLEX a(2),b(2) END STRUCTURE RECORD/td0/r2_34f(2,2),r2_34z(2,2),r6_12(2),r6_34(2,2),r2_56, & r2_16,r6_52 STRUCTURE/t/ double COMPLEX a(2,2),b(2,2),c(2,2),d(2,2) END STRUCTURE RECORD/t/v3_4f(0:3),v3_4z(0:3),u3_12f(2),u3_12z(2),u3_56,u3_52, & d4_12f(2),d4_12z(2),d4_56,d4_16,v3_4h,dia15(2),dia16(2), & dia1,dia14(2),dia17(2) COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abparc/czipr,ccz,cwipr,ccw,chipr,cch,caipr,cca COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc *el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch *endel2 PARAMETER (cim=(0.d0,1.d0)) data ifirst /1/ * p_q -- p_q=p1p2,p=p1,q=p2 p1p2=p1(0)*p2(0)-p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3) s=2.d0*p1p2 ss=sqrt(s) e=ss/2.d0 quqd=s/2.d0 p1k0=p1(0)-p1(1) p2k0=p2(0)-p2(1) cdz=-1.d0/(s*czipr-rmz2+ccz) dph=-1.d0/s fac1=(dph*fer) fac2=(dph*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p1,qd=p2,v=0,a=c12f,cr=fac1,cl=fac2,nsum=0 eps_0=-p1(2)*p2(3)+p2(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p2(0)+p2k0*p1(0) c12f(1).e(0)=fac1*(auxa+ceps_0) c12f(2).e(0)=fac2*(auxa-ceps_0) c12z(1).e(0)=cfac1z*c12f(1).e(0) c12z(2).e(0)=cfac2z*c12f(2).e(0) * T10 -- qu=p1,qd=p2,v=1,a=c12f,cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_0) c12z(1).e(1)=cfac1z*c12f(1).e(1) c12z(2).e(1)=cfac2z*c12f(2).e(1) * T10 -- qu=p1,qd=p2,v=2,a=c12f,cr=fac1,cl=fac2,nsum=0 eps_0=-p1k0*p2(3)+p2k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p2(2)+p2k0*p1(2) c12f(1).e(2)=fac1*(auxa+ceps_0) c12f(2).e(2)=fac2*(auxa-ceps_0) c12z(1).e(2)=cfac1z*c12f(1).e(2) c12z(2).e(2)=cfac2z*c12f(2).e(2) * T10 -- qu=p1,qd=p2,v=3,a=c12f,cr=fac1,cl=fac2,nsum=0 eps_0=p1k0*p2(2)-p2k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p2(3)+p2k0*p1(3) c12f(1).e(3)=fac1*(auxa+ceps_0) c12f(2).e(3)=fac2*(auxa-ceps_0) c12z(1).e(3)=cfac1z*c12f(1).e(3) c12z(2).e(3)=cfac2z*c12f(2).e(3) DO i=1,2 * pk0 -- p=c12f(i).e c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 * pk0 -- p=c12z(i).e c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO *********************AUTOM************************ * * pk0 -- p=p3 p3k0=p3(0)-p3(1) * pk0 -- p=p4 p4k0=p4(0)-p4(1) * pk0 -- p=p5 p5k0=p5(0)-p5(1) * pk0 -- p=p6 p6k0=p6(0)-p6(1) * Impulsi dei propagatori DO m=0,3 p34(m)=p3(m)+p4(m) p16(m)=-p1(m)+p6(m) p25(m)=-p2(m)+p5(m) p123(m)=-p1(m)-p2(m)+p3(m) p125(m)=-p1(m)+p25(m) p134(m)=-p1(m)+p34(m) p156(m)=p5(m)+p16(m) p235(m)=p25(m)+p3(m) p345(m)=p34(m)+p5(m) p356(m)=p3(m)+p5(m)+p6(m) END DO * pk0 -- p=p123 p123k0=p123(0)-p123(1) * p.q -- p.q=p123q,p=p123,q=p123 p123q=p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p123 & (3)*p123(3) * pk0 -- p=p125 p125k0=p125(0)-p125(1) * p.q -- p.q=p125q,p=p125,q=p125 p125q=p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p125 & (3)*p125(3) * pk0 -- p=p134 p134k0=p134(0)-p134(1) * p.q -- p.q=p134q,p=p134,q=p134 p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) * pk0 -- p=p156 p156k0=p156(0)-p156(1) * p.q -- p.q=p156q,p=p156,q=p156 p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) * pk0 -- p=p235 p235k0=p235(0)-p235(1) * p.q -- p.q=p235q,p=p235,q=p235 p235q=p235(0)*p235(0)-p235(1)*p235(1)-p235(2)*p235(2)-p235 & (3)*p235(3) * pk0 -- p=p345 p345k0=p345(0)-p345(1) * p.q -- p.q=p345q,p=p345,q=p345 p345q=p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p345 & (3)*p345(3) * pk0 -- p=p356 p356k0=p356(0)-p356(1) * p.q -- p.q=p356q,p=p356,q=p356 p356q=p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p356 & (3)*p356(3) IF (i56ve.EQ.1) THEN *** polarizzazioni complesse * quqd -- p=p1,q=p6 quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) rcl=wcl/(2.d0*quqd+rmw2) * TW10 -- qu=p1,qd=p6,v=0,a=c16w.e(0),cl=rcl,nsum=0 eps_0=-p1(2)*p6(3)+p6(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p6(0)+p6k0*p1(0) c16w.e(0)=rcl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=1,a=c16w.e(1),cl=rcl,nsum=0 auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16w.e(1)=rcl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=2,a=c16w.e(2),cl=rcl,nsum=0 eps_0=-p1k0*p6(3)+p6k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p6(2)+p6k0*p1(2) c16w.e(2)=rcl*(auxa-ceps_0) * TW10 -- qu=p1,qd=p6,v=3,a=c16w.e(3),cl=rcl,nsum=0 eps_0=p1k0*p6(2)-p6k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p6(3)+p6k0*p1(3) c16w.e(3)=rcl*(auxa-ceps_0) * pk0 -- p=c16w.e c16w.ek0=c16w.e(0)-c16w.e(1) * quqd -- p=p5,q=p2 quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) rcl=wcl/(2.d0*quqd+rmw2) * TW10 -- qu=p5,qd=p2,v=0,a=c52w.e(0),cl=rcl,nsum=0 eps_0=-p5(2)*p2(3)+p2(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p2(0)+p2k0*p5(0) c52w.e(0)=rcl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=1,a=c52w.e(1),cl=rcl,nsum=0 auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c52w.e(1)=rcl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=2,a=c52w.e(2),cl=rcl,nsum=0 eps_0=-p5k0*p2(3)+p2k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p2(2)+p2k0*p5(2) c52w.e(2)=rcl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p2,v=3,a=c52w.e(3),cl=rcl,nsum=0 eps_0=p5k0*p2(2)-p2k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p2(3)+p2k0*p5(3) c52w.e(3)=rcl*(auxa-ceps_0) * pk0 -- p=c52w.e c52w.ek0=c52w.e(0)-c52w.e(1) ENDIF IF (imix.EQ.-1.or.imix.eq.-2) then * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) df=-2.d0*(quqd+rmb2) cdz=-(2.d0*(quqd+rmb2)*czipr-rmz2+ccz) * T -- qu=p3,qd=p4,v=0,a=v3_4f(0).a,b=v3_4f(0).b,c=v3_4f(0).c,d=v3_4f(0).d, * cr=fqdr,cl=fqdl,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) v3_4f(0).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(0).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(0).b(1,2)=-fqdl*(p4(2)+ceps_2) v3_4f(0).b(2,1)=fqdr*(p4(2)-ceps_2) v3_4f(0).c(1,2)=fqdr*(p3(2)+ceps_1) v3_4f(0).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_4f(0).d(1,1)=fqdl v3_4f(0).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=1,a=v3_4f(1).a,b=v3_4f(1).b,c=v3_4f(1).c,d=v3_4f(1).d, * cr=fqdr,cl=fqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v3_4f(1).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(1).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(1).b(1,2)=-fqdl*(p4(2)+ceps_2) v3_4f(1).b(2,1)=fqdr*(p4(2)-ceps_2) v3_4f(1).c(1,2)=fqdr*(p3(2)+ceps_1) v3_4f(1).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_4f(1).d(1,1)=fqdl v3_4f(1).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=2,a=v3_4f(2).a,b=v3_4f(2).b,c=v3_4f(2).c,d=v3_4f(2).d, * cr=fqdr,cl=fqdl,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) v3_4f(2).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(2).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(2).b(1,2)=-fqdl*p4k0 v3_4f(2).b(2,1)=fqdr*p4k0 v3_4f(2).c(1,2)=fqdr*p3k0 v3_4f(2).c(2,1)=-fqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v3_4f(3).a,b=v3_4f(3).b,c=v3_4f(3).c,d=v3_4f(3).d, * cr=fqdr,cl=fqdl,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p4k0*cim auxa=+p3k0*p4(3)+p4k0*p3(3) v3_4f(3).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(3).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(3).b(1,2)=-fqdl*ceps_2 v3_4f(3).b(2,1)=-fqdr*ceps_2 v3_4f(3).c(1,2)=fqdr*ceps_1 v3_4f(3).c(2,1)=fqdl*ceps_1 DO m=0,3 * mline -- res=c34f(&).e(m),abcd=v3_4f(m).,m1=rmb,m2=(-rmb),den=df DO iut=1,2 DO jut=1,2 c34f(iut,jut).e(m)=(v3_4f(m).a(iut,jut)+rmb*v3_4f(m).b(iut & ,jut)+(-rmb)*v3_4f(m).c(iut,jut)+rmb*(-rmb)*v3_4f(m). & d(iu & t,jut))/df ENDDO ENDDO END DO * T -- qu=p3,qd=p4,v=0,a=v3_4z(0).a,b=v3_4z(0).b,c=v3_4z(0).c,d=v3_4z(0).d, * cr=zqdr,cl=zqdl,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) v3_4z(0).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(0).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(0).b(1,2)=-zqdl*(p4(2)+ceps_2) v3_4z(0).b(2,1)=zqdr*(p4(2)-ceps_2) v3_4z(0).c(1,2)=zqdr*(p3(2)+ceps_1) v3_4z(0).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_4z(0).d(1,1)=zqdl v3_4z(0).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=1,a=v3_4z(1).a,b=v3_4z(1).b,c=v3_4z(1).c,d=v3_4z(1).d, * cr=zqdr,cl=zqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v3_4z(1).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(1).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(1).b(1,2)=-zqdl*(p4(2)+ceps_2) v3_4z(1).b(2,1)=zqdr*(p4(2)-ceps_2) v3_4z(1).c(1,2)=zqdr*(p3(2)+ceps_1) v3_4z(1).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_4z(1).d(1,1)=zqdl v3_4z(1).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=2,a=v3_4z(2).a,b=v3_4z(2).b,c=v3_4z(2).c,d=v3_4z(2).d, * cr=zqdr,cl=zqdl,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) v3_4z(2).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(2).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(2).b(1,2)=-zqdl*p4k0 v3_4z(2).b(2,1)=zqdr*p4k0 v3_4z(2).c(1,2)=zqdr*p3k0 v3_4z(2).c(2,1)=-zqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v3_4z(3).a,b=v3_4z(3).b,c=v3_4z(3).c,d=v3_4z(3).d, * cr=zqdr,cl=zqdl,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p4k0*cim auxa=+p3k0*p4(3)+p4k0*p3(3) v3_4z(3).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(3).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(3).b(1,2)=-zqdl*ceps_2 v3_4z(3).b(2,1)=-zqdr*ceps_2 v3_4z(3).c(1,2)=zqdr*ceps_1 v3_4z(3).c(2,1)=zqdl*ceps_1 DO m=0,3 * mline -- res=c34z(&).e(m),abcd=v3_4z(m).,m1=rmb,m2=(-rmb),den=cdz DO iut=1,2 DO jut=1,2 c34z(iut,jut).e(m)=(v3_4z(m).a(iut,jut)+rmb*v3_4z(m).b(iut & ,jut)+(-rmb)*v3_4z(m).c(iut,jut)+rmb*(-rmb)*v3_4z(m). & d(iu & t,jut))/cdz ENDDO ENDDO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c34f(i1,i2).e c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO * aggiungo al propagatore della zeta pezzo prop. a k(mu)*k(nu) DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34z(i1,i2).e,q=p34 caux=c34z(i1,i2).e(0)*p34(0)-c34z(i1,i2).e(1)*p34(1)-c34z( & i1,i2).e(2)*p34(2)-c34z(i1,i2).e(3)*p34(3) DO m=0,3 c34z(i1,i2).e(m)=c34z(i1,i2).e(m)-caux*p34(m)/rmz2 END DO END DO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c34z(i1,i2).e c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO ENDIF !(c34z e c34f) * quqd -- p=p5,q=p6 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) cdz=-(2.d0*quqd*czipr-rmz2+ccz) ccl=zvl/cdz * TW10 -- qu=p5,qd=p6,v=0,a=c56z.e(0),cl=ccl,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) c56z.e(0)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p6,v=1,a=c56z.e(1),cl=ccl,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56z.e(1)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p6,v=2,a=c56z.e(2),cl=ccl,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) c56z.e(2)=ccl*(auxa-ceps_0) * TW10 -- qu=p5,qd=p6,v=3,a=c56z.e(3),cl=ccl,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p6(3)+p6k0*p5(3) c56z.e(3)=ccl*(auxa-ceps_0) * pk0 -- p=c56z.e c56z.ek0=c56z.e(0)-c56z.e(1) IF (imix.EQ.-1.or.imix.eq.-2) then *****attaccamento di c12f(2) a 3 (b) * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * T -- qu=p3,qd=p123,v=c12f(i).e,a=u3_12f(i).a,b=u3_12f(i).b,c=u3_12f(i).c, * d=u3_12f(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2f(i).e(2)*p123(3)-p123(2)*c12f(i).e(3))-p123k0*(c12f(i). & e(2)*p3(3)-p3(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p3k0+p3(3)*c12f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i).e(3)*p123k0+p123(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p3(0)-c12f(i).e(1)*p3(1)-c12f(i).e(2)*p3 & (2)-c12f(i).e(3)*p3(3) cvqd=c12f(i).e(0)*p123(0)-c12f(i).e(1)*p123(1)-c12f(i).e(2 & )*p123(2)-c12f(i).e(3)*p123(3) cauxa=-c12f(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxb=-c12f(i).ek0*p123(2)+p123k0*c12f(i).e(2) cauxc=+c12f(i).ek0*p3(2)-p3k0*c12f(i).e(2) u3_12f(i).a(1,1)=fqdr*(cauxa+ceps_0) u3_12f(i).a(2,2)=fqdl*(cauxa-ceps_0) u3_12f(i).b(1,2)=fqdl*(cauxb-ceps_2) u3_12f(i).b(2,1)=fqdr*(-cauxb-ceps_2) u3_12f(i).c(1,2)=fqdr*(cauxc+ceps_1) u3_12f(i).c(2,1)=fqdl*(-cauxc+ceps_1) u3_12f(i).d(1,1)=fqdl*c12f(i).ek0 u3_12f(i).d(2,2)=fqdr*c12f(i).ek0 END DO *****attaccamento di c12f(2) a 4 (bbar) * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * T -- qu=p356,qd=p4,v=c12f(i).e,a=d4_12f(i).a,b=d4_12f(i).b,c=d4_12f(i).c, * d=d4_12f(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12f(i).e(2)*p4(3)-p4(2)*c12f(i).e(3))-p4k0*(c12f(i).e(2) & *p356(3)-p356(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p356k0+p356(3)*c12f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i).e(3)*p4k0+p4(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p356(0)-c12f(i).e(1)*p356(1)-c12f(i).e(2 & )*p356(2)-c12f(i).e(3)*p356(3) cvqd=c12f(i).e(0)*p4(0)-c12f(i).e(1)*p4(1)-c12f(i).e(2)*p4 & (2)-c12f(i).e(3)*p4(3) cauxa=-c12f(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12f(i).ek0*p4(2)+p4k0*c12f(i).e(2) cauxc=+c12f(i).ek0*p356(2)-p356k0*c12f(i).e(2) d4_12f(i).a(1,1)=fqdr*(cauxa+ceps_0) d4_12f(i).a(2,2)=fqdl*(cauxa-ceps_0) d4_12f(i).b(1,2)=fqdl*(cauxb-ceps_2) d4_12f(i).b(2,1)=fqdr*(-cauxb-ceps_2) d4_12f(i).c(1,2)=fqdr*(cauxc+ceps_1) d4_12f(i).c(2,1)=fqdl*(-cauxc+ceps_1) d4_12f(i).d(1,1)=fqdl*c12f(i).ek0 d4_12f(i).d(2,2)=fqdr*c12f(i).ek0 END DO *****attaccamento di c34f(2,2) a 1 (e+) * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p1,qd=p134,v=c34f(i1,i2).e,a=l1_34f(i1,i2).a,c=l1_34f(i1,i2).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34f(i1,i2).e(2)*p134(3)-p134(2)*c34f(i1,i2).e(3))-p134 & k0*(c34f(i1,i2).e(2)*p1(3)-p1(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i1,i2).e(3)*p1k0+p1(3)*c34f(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34f(i1,i2).e(0)*p1(0)-c34f(i1,i2).e(1)*p1(1)-c34f(i1 & ,i2).e(2)*p1(2)-c34f(i1,i2).e(3)*p1(3) cvqd=c34f(i1,i2).e(0)*p134(0)-c34f(i1,i2).e(1)*p134(1)-c34 & f(i1,i2).e(2)*p134(2)-c34f(i1,i2).e(3)*p134(3) cauxa=-c34f(i1,i2).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34f(i1,i2).ek0*p1(2)-p1k0*c34f(i1,i2).e(2) l1_34f(i1,i2).a(1)=fer*(cauxa+ceps_0) l1_34f(i1,i2).a(2)=fel*(cauxa-ceps_0) l1_34f(i1,i2).c(1)=fer*(cauxc+ceps_1) l1_34f(i1,i2).c(2)=fel*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34f(2,2) a 2 (e-) * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p156,qd=p2,v=c34f(i1,i2).e,a=r2_34f(i1,i2).a,b=r2_34f(i1,i2).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34f(i1,i2).e(2)*p2(3)-p2(2)*c34f(i1,i2).e(3))-p2k0*( & c34f(i1,i2).e(2)*p156(3)-p156(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i1,i2).e(3)*p2k0+p2(3)*c34f(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34f(i1,i2).e(0)*p156(0)-c34f(i1,i2).e(1)*p156(1)-c34 & f(i1,i2).e(2)*p156(2)-c34f(i1,i2).e(3)*p156(3) cvqd=c34f(i1,i2).e(0)*p2(0)-c34f(i1,i2).e(1)*p2(1)-c34f(i1 & ,i2).e(2)*p2(2)-c34f(i1,i2).e(3)*p2(3) cauxa=-c34f(i1,i2).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34f(i1,i2).ek0*p2(2)+p2k0*c34f(i1,i2).e(2) r2_34f(i1,i2).a(1)=fer*(cauxa+ceps_0) r2_34f(i1,i2).a(2)=fel*(cauxa-ceps_0) r2_34f(i1,i2).b(1)=fel*(cauxb-ceps_2) r2_34f(i1,i2).b(2)=fer*(-cauxb-ceps_2) END DO END DO *****attaccamento di c12z(2) a 3 (b) * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * T -- qu=p3,qd=p123,v=c12z(i).e,a=u3_12z(i).a,b=u3_12z(i).b,c=u3_12z(i).c, * d=u3_12z(i).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2z(i).e(2)*p123(3)-p123(2)*c12z(i).e(3))-p123k0*(c12z(i). & e(2)*p3(3)-p3(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p3k0+p3(3)*c12z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i).e(3)*p123k0+p123(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p3(0)-c12z(i).e(1)*p3(1)-c12z(i).e(2)*p3 & (2)-c12z(i).e(3)*p3(3) cvqd=c12z(i).e(0)*p123(0)-c12z(i).e(1)*p123(1)-c12z(i).e(2 & )*p123(2)-c12z(i).e(3)*p123(3) cauxa=-c12z(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxb=-c12z(i).ek0*p123(2)+p123k0*c12z(i).e(2) cauxc=+c12z(i).ek0*p3(2)-p3k0*c12z(i).e(2) u3_12z(i).a(1,1)=zqdr*(cauxa+ceps_0) u3_12z(i).a(2,2)=zqdl*(cauxa-ceps_0) u3_12z(i).b(1,2)=zqdl*(cauxb-ceps_2) u3_12z(i).b(2,1)=zqdr*(-cauxb-ceps_2) u3_12z(i).c(1,2)=zqdr*(cauxc+ceps_1) u3_12z(i).c(2,1)=zqdl*(-cauxc+ceps_1) u3_12z(i).d(1,1)=zqdl*c12z(i).ek0 u3_12z(i).d(2,2)=zqdr*c12z(i).ek0 END DO *****attaccamento di c12z(2) a 4 (bbar) * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * T -- qu=p356,qd=p4,v=c12z(i).e,a=d4_12z(i).a,b=d4_12z(i).b,c=d4_12z(i).c, * d=d4_12z(i).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12z(i).e(2)*p4(3)-p4(2)*c12z(i).e(3))-p4k0*(c12z(i).e(2) & *p356(3)-p356(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p356k0+p356(3)*c12z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i).e(3)*p4k0+p4(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p356(0)-c12z(i).e(1)*p356(1)-c12z(i).e(2 & )*p356(2)-c12z(i).e(3)*p356(3) cvqd=c12z(i).e(0)*p4(0)-c12z(i).e(1)*p4(1)-c12z(i).e(2)*p4 & (2)-c12z(i).e(3)*p4(3) cauxa=-c12z(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12z(i).ek0*p4(2)+p4k0*c12z(i).e(2) cauxc=+c12z(i).ek0*p356(2)-p356k0*c12z(i).e(2) d4_12z(i).a(1,1)=zqdr*(cauxa+ceps_0) d4_12z(i).a(2,2)=zqdl*(cauxa-ceps_0) d4_12z(i).b(1,2)=zqdl*(cauxb-ceps_2) d4_12z(i).b(2,1)=zqdr*(-cauxb-ceps_2) d4_12z(i).c(1,2)=zqdr*(cauxc+ceps_1) d4_12z(i).c(2,1)=zqdl*(-cauxc+ceps_1) d4_12z(i).d(1,1)=zqdl*c12z(i).ek0 d4_12z(i).d(2,2)=zqdr*c12z(i).ek0 END DO *****attaccamento di c34z(2,2) a 1 (e+) * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p1,qd=p134,v=c34z(i1,i2).e,a=l1_34z(i1,i2).a,c=l1_34z(i1,i2).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34z(i1,i2).e(2)*p134(3)-p134(2)*c34z(i1,i2).e(3))-p134 & k0*(c34z(i1,i2).e(2)*p1(3)-p1(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1,i2).e(3)*p1k0+p1(3)*c34z(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1,i2).e(0)*p1(0)-c34z(i1,i2).e(1)*p1(1)-c34z(i1 & ,i2).e(2)*p1(2)-c34z(i1,i2).e(3)*p1(3) cvqd=c34z(i1,i2).e(0)*p134(0)-c34z(i1,i2).e(1)*p134(1)-c34 & z(i1,i2).e(2)*p134(2)-c34z(i1,i2).e(3)*p134(3) cauxa=-c34z(i1,i2).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34z(i1,i2).ek0*p1(2)-p1k0*c34z(i1,i2).e(2) l1_34z(i1,i2).a(1)=zer*(cauxa+ceps_0) l1_34z(i1,i2).a(2)=zel*(cauxa-ceps_0) l1_34z(i1,i2).c(1)=zer*(cauxc+ceps_1) l1_34z(i1,i2).c(2)=zel*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34z(2,2) a 2 (e-) * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p156,qd=p2,v=c34z(i1,i2).e,a=r2_34z(i1,i2).a,b=r2_34z(i1,i2).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34z(i1,i2).e(2)*p2(3)-p2(2)*c34z(i1,i2).e(3))-p2k0*( & c34z(i1,i2).e(2)*p156(3)-p156(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1,i2).e(3)*p2k0+p2(3)*c34z(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1,i2).e(0)*p156(0)-c34z(i1,i2).e(1)*p156(1)-c34 & z(i1,i2).e(2)*p156(2)-c34z(i1,i2).e(3)*p156(3) cvqd=c34z(i1,i2).e(0)*p2(0)-c34z(i1,i2).e(1)*p2(1)-c34z(i1 & ,i2).e(2)*p2(2)-c34z(i1,i2).e(3)*p2(3) cauxa=-c34z(i1,i2).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34z(i1,i2).ek0*p2(2)+p2k0*c34z(i1,i2).e(2) r2_34z(i1,i2).a(1)=zer*(cauxa+ceps_0) r2_34z(i1,i2).a(2)=zel*(cauxa-ceps_0) r2_34z(i1,i2).b(1)=zel*(cauxb-ceps_2) r2_34z(i1,i2).b(2)=zer*(-cauxb-ceps_2) END DO END DO *****attaccamento di c56z a 3 (b) * quqd -- p=p3,q=p356 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) * T -- qu=p3,qd=p356,v=c56z.e,a=u3_56.a,b=u3_56.b,c=u3_56.c,d=u3_56.d,cr=zq * dr,cl=zqdl,nsum=0 ceps_0=-c56z.ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c56z. & e(2)*p356(3)-p356(2)*c56z.e(3))-p356k0*(c56z.e(2)*p3(3)-p & 3(2)*c56z.e(3)) ceps_0=ceps_0*cim ceps_1=-c56z.e(3)*p3k0+p3(3)*c56z.ek0 ceps_1=ceps_1*cim ceps_2=-c56z.e(3)*p356k0+p356(3)*c56z.ek0 ceps_2=ceps_2*cim cvqu=c56z.e(0)*p3(0)-c56z.e(1)*p3(1)-c56z.e(2)*p3(2)-c56z. & e(3)*p3(3) cvqd=c56z.e(0)*p356(0)-c56z.e(1)*p356(1)-c56z.e(2)*p356(2) & -c56z.e(3)*p356(3) cauxa=-c56z.ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxb=-c56z.ek0*p356(2)+p356k0*c56z.e(2) cauxc=+c56z.ek0*p3(2)-p3k0*c56z.e(2) u3_56.a(1,1)=zqdr*(cauxa+ceps_0) u3_56.a(2,2)=zqdl*(cauxa-ceps_0) u3_56.b(1,2)=zqdl*(cauxb-ceps_2) u3_56.b(2,1)=zqdr*(-cauxb-ceps_2) u3_56.c(1,2)=zqdr*(cauxc+ceps_1) u3_56.c(2,1)=zqdl*(-cauxc+ceps_1) u3_56.d(1,1)=zqdl*c56z.ek0 u3_56.d(2,2)=zqdr*c56z.ek0 *****attaccamento di c52w a 3 (b) * quqd -- p=p3,q=p235 quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) * TW -- qu=p3,qd=p235,v=c52w.e,a=u3_52.a,b=u3_52.b,c=u3_52.c,d=u3_52.d,cl=w * cl,nsum=0 ceps_0=-c52w.ek0*(p3(2)*p235(3)-p235(2)*p3(3))+p3k0*(c52w. & e(2)*p235(3)-p235(2)*c52w.e(3))-p235k0*(c52w.e(2)*p3(3)-p & 3(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_1=-c52w.e(3)*p3k0+p3(3)*c52w.ek0 ceps_1=ceps_1*cim ceps_2=-c52w.e(3)*p235k0+p235(3)*c52w.ek0 ceps_2=ceps_2*cim cvqu=c52w.e(0)*p3(0)-c52w.e(1)*p3(1)-c52w.e(2)*p3(2)-c52w. & e(3)*p3(3) cvqd=c52w.e(0)*p235(0)-c52w.e(1)*p235(1)-c52w.e(2)*p235(2) & -c52w.e(3)*p235(3) cauxa=-c52w.ek0*quqd+p3k0*cvqd+p235k0*cvqu cauxb=-c52w.ek0*p235(2)+p235k0*c52w.e(2) cauxc=+c52w.ek0*p3(2)-p3k0*c52w.e(2) u3_52.a(2,2)=wcl*(cauxa-ceps_0) u3_52.b(1,2)=wcl*(cauxb-ceps_2) u3_52.c(2,1)=wcl*(-cauxc+ceps_1) u3_52.d(1,1)=wcl*c52w.ek0 *****attaccamento di c56z a 4 (bbar) * quqd -- p=p123,q=p4 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) * T -- qu=p123,qd=p4,v=c56z.e,a=d4_56.a,b=d4_56.b,c=d4_56.c,d=d4_56.d,cr=zq * dr,cl=zqdl,nsum=0 ceps_0=-c56z.ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*(c56 & z.e(2)*p4(3)-p4(2)*c56z.e(3))-p4k0*(c56z.e(2)*p123(3)-p12 & 3(2)*c56z.e(3)) ceps_0=ceps_0*cim ceps_1=-c56z.e(3)*p123k0+p123(3)*c56z.ek0 ceps_1=ceps_1*cim ceps_2=-c56z.e(3)*p4k0+p4(3)*c56z.ek0 ceps_2=ceps_2*cim cvqu=c56z.e(0)*p123(0)-c56z.e(1)*p123(1)-c56z.e(2)*p123(2) & -c56z.e(3)*p123(3) cvqd=c56z.e(0)*p4(0)-c56z.e(1)*p4(1)-c56z.e(2)*p4(2)-c56z. & e(3)*p4(3) cauxa=-c56z.ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56z.ek0*p4(2)+p4k0*c56z.e(2) cauxc=+c56z.ek0*p123(2)-p123k0*c56z.e(2) d4_56.a(1,1)=zqdr*(cauxa+ceps_0) d4_56.a(2,2)=zqdl*(cauxa-ceps_0) d4_56.b(1,2)=zqdl*(cauxb-ceps_2) d4_56.b(2,1)=zqdr*(-cauxb-ceps_2) d4_56.c(1,2)=zqdr*(cauxc+ceps_1) d4_56.c(2,1)=zqdl*(-cauxc+ceps_1) d4_56.d(1,1)=zqdl*c56z.ek0 d4_56.d(2,2)=zqdr*c56z.ek0 *****attaccamento di c16w a 4 (bbar) * quqd -- p=p235,q=p4 quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) * TW -- qu=p235,qd=p4,v=c16w.e,a=d4_16.a,b=d4_16.b,c=d4_16.c,d=d4_16.d,cl=w * cl,nsum=0 ceps_0=-c16w.ek0*(p235(2)*p4(3)-p4(2)*p235(3))+p235k0*(c16 & w.e(2)*p4(3)-p4(2)*c16w.e(3))-p4k0*(c16w.e(2)*p235(3)-p23 & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_1=-c16w.e(3)*p235k0+p235(3)*c16w.ek0 ceps_1=ceps_1*cim ceps_2=-c16w.e(3)*p4k0+p4(3)*c16w.ek0 ceps_2=ceps_2*cim cvqu=c16w.e(0)*p235(0)-c16w.e(1)*p235(1)-c16w.e(2)*p235(2) & -c16w.e(3)*p235(3) cvqd=c16w.e(0)*p4(0)-c16w.e(1)*p4(1)-c16w.e(2)*p4(2)-c16w. & e(3)*p4(3) cauxa=-c16w.ek0*quqd+p235k0*cvqd+p4k0*cvqu cauxb=-c16w.ek0*p4(2)+p4k0*c16w.e(2) cauxc=+c16w.ek0*p235(2)-p235k0*c16w.e(2) d4_16.a(2,2)=wcl*(cauxa-ceps_0) d4_16.b(1,2)=wcl*(cauxb-ceps_2) d4_16.c(2,1)=wcl*(-cauxc+ceps_1) d4_16.d(1,1)=wcl*c16w.ek0 *****attaccamento di c12z(2) a 5 (v) * quqd -- p=p5,q=p125 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 * TWL0 -- qu=p5,qd=p125,v=c12z(i).e,a=l5_12(i).a,c=l5_12(i).c,cl=zvl,nsum=0 ceps_0=-c12z(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2z(i).e(2)*p125(3)-p125(2)*c12z(i).e(3))-p125k0*(c12z(i). & e(2)*p5(3)-p5(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p5k0+p5(3)*c12z(i).ek0 ceps_1=ceps_1*cim cvqu=c12z(i).e(0)*p5(0)-c12z(i).e(1)*p5(1)-c12z(i).e(2)*p5 & (2)-c12z(i).e(3)*p5(3) cvqd=c12z(i).e(0)*p125(0)-c12z(i).e(1)*p125(1)-c12z(i).e(2 & )*p125(2)-c12z(i).e(3)*p125(3) cauxa=-c12z(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12z(i).ek0*p5(2)-p5k0*c12z(i).e(2) l5_12(i).a(2)=zvl*(cauxa-ceps_0) l5_12(i).c(2)=zvl*(-cauxc+ceps_1) END DO *****attaccamento di c34z(2,2) a 5 (v) * quqd -- p=p5,q=p345 quqd=p5(0)*p345(0)-p5(1)*p345(1)-p5(2)*p345(2)-p5(3)*p345( & 3) DO i1=1,2 DO i2=1,2 * TWL0 -- qu=p5,qd=p345,v=c34z(i1,i2).e,a=l5_34(i1,i2).a,c=l5_34(i1,i2).c,c * l=zvl,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0 & *(c34z(i1,i2).e(2)*p345(3)-p345(2)*c34z(i1,i2).e(3))-p345 & k0*(c34z(i1,i2).e(2)*p5(3)-p5(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1,i2).e(3)*p5k0+p5(3)*c34z(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1,i2).e(0)*p5(0)-c34z(i1,i2).e(1)*p5(1)-c34z(i1 & ,i2).e(2)*p5(2)-c34z(i1,i2).e(3)*p5(3) cvqd=c34z(i1,i2).e(0)*p345(0)-c34z(i1,i2).e(1)*p345(1)-c34 & z(i1,i2).e(2)*p345(2)-c34z(i1,i2).e(3)*p345(3) cauxa=-c34z(i1,i2).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34z(i1,i2).ek0*p5(2)-p5k0*c34z(i1,i2).e(2) l5_34(i1,i2).a(2)=zvl*(cauxa-ceps_0) l5_34(i1,i2).c(2)=zvl*(-cauxc+ceps_1) END DO END DO *****attaccamento di c56z a 1 (e+) * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) * TL0 -- qu=p1,qd=p156,v=c56z.e,a=l1_56.a,c=l1_56.c,cr=zer,cl=zel,nsum=0 ceps_0=-c56z.ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c56z. & e(2)*p156(3)-p156(2)*c56z.e(3))-p156k0*(c56z.e(2)*p1(3)-p & 1(2)*c56z.e(3)) ceps_0=ceps_0*cim ceps_1=-c56z.e(3)*p1k0+p1(3)*c56z.ek0 ceps_1=ceps_1*cim cvqu=c56z.e(0)*p1(0)-c56z.e(1)*p1(1)-c56z.e(2)*p1(2)-c56z. & e(3)*p1(3) cvqd=c56z.e(0)*p156(0)-c56z.e(1)*p156(1)-c56z.e(2)*p156(2) & -c56z.e(3)*p156(3) cauxa=-c56z.ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56z.ek0*p1(2)-p1k0*c56z.e(2) l1_56.a(1)=zer*(cauxa+ceps_0) l1_56.a(2)=zel*(cauxa-ceps_0) l1_56.c(1)=zer*(cauxc+ceps_1) l1_56.c(2)=zel*(-cauxc+ceps_1) *****attaccamento di c16w a 5 (v) * quqd -- p=p5,q=p156 quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) * TWL0 -- qu=p5,qd=p156,v=c16w.e,a=l5_16.a,c=l5_16.c,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p5(2)*p156(3)-p156(2)*p5(3))+p5k0*(c16w. & e(2)*p156(3)-p156(2)*c16w.e(3))-p156k0*(c16w.e(2)*p5(3)-p & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_1=-c16w.e(3)*p5k0+p5(3)*c16w.ek0 ceps_1=ceps_1*cim cvqu=c16w.e(0)*p5(0)-c16w.e(1)*p5(1)-c16w.e(2)*p5(2)-c16w. & e(3)*p5(3) cvqd=c16w.e(0)*p156(0)-c16w.e(1)*p156(1)-c16w.e(2)*p156(2) & -c16w.e(3)*p156(3) cauxa=-c16w.ek0*quqd+p5k0*cvqd+p156k0*cvqu cauxc=+c16w.ek0*p5(2)-p5k0*c16w.e(2) l5_16.a(2)=wcl*(cauxa-ceps_0) l5_16.c(2)=wcl*(-cauxc+ceps_1) *****attaccamento di c52w a 1 (e+) * quqd -- p=p1,q=p125 quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) * TWL0 -- qu=p1,qd=p125,v=c52w.e,a=l1_52.a,c=l1_52.c,cl=wcl,nsum=0 ceps_0=-c52w.ek0*(p1(2)*p125(3)-p125(2)*p1(3))+p1k0*(c52w. & e(2)*p125(3)-p125(2)*c52w.e(3))-p125k0*(c52w.e(2)*p1(3)-p & 1(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_1=-c52w.e(3)*p1k0+p1(3)*c52w.ek0 ceps_1=ceps_1*cim cvqu=c52w.e(0)*p1(0)-c52w.e(1)*p1(1)-c52w.e(2)*p1(2)-c52w. & e(3)*p1(3) cvqd=c52w.e(0)*p125(0)-c52w.e(1)*p125(1)-c52w.e(2)*p125(2) & -c52w.e(3)*p125(3) cauxa=-c52w.ek0*quqd+p1k0*cvqd+p125k0*cvqu cauxc=+c52w.ek0*p1(2)-p1k0*c52w.e(2) l1_52.a(2)=wcl*(cauxa-ceps_0) l1_52.c(2)=wcl*(-cauxc+ceps_1) *****attaccamento di c12z(2) a 6 (vbar) * quqd -- p=p345,q=p6 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 * TWR0 -- qu=p345,qd=p6,v=c12z(i).e,a=r6_12(i).a,b=r6_12(i).b,cl=zvl,nsum=0 ceps_0=-c12z(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12z(i).e(2)*p6(3)-p6(2)*c12z(i).e(3))-p6k0*(c12z(i).e(2) & *p345(3)-p345(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12z(i).e(3)*p6k0+p6(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p345(0)-c12z(i).e(1)*p345(1)-c12z(i).e(2 & )*p345(2)-c12z(i).e(3)*p345(3) cvqd=c12z(i).e(0)*p6(0)-c12z(i).e(1)*p6(1)-c12z(i).e(2)*p6 & (2)-c12z(i).e(3)*p6(3) cauxa=-c12z(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12z(i).ek0*p6(2)+p6k0*c12z(i).e(2) r6_12(i).a(2)=zvl*(cauxa-ceps_0) r6_12(i).b(1)=zvl*(cauxb-ceps_2) END DO *****attaccamento di c34z(2,2) a 6 (vbar) * quqd -- p=p125,q=p6 quqd=p125(0)*p6(0)-p125(1)*p6(1)-p125(2)*p6(2)-p125(3)*p6( & 3) DO i1=1,2 DO i2=1,2 * TWR0 -- qu=p125,qd=p6,v=c34z(i1,i2).e,a=r6_34(i1,i2).a,b=r6_34(i1,i2).b,c * l=zvl,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125 & k0*(c34z(i1,i2).e(2)*p6(3)-p6(2)*c34z(i1,i2).e(3))-p6k0*( & c34z(i1,i2).e(2)*p125(3)-p125(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1,i2).e(3)*p6k0+p6(3)*c34z(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1,i2).e(0)*p125(0)-c34z(i1,i2).e(1)*p125(1)-c34 & z(i1,i2).e(2)*p125(2)-c34z(i1,i2).e(3)*p125(3) cvqd=c34z(i1,i2).e(0)*p6(0)-c34z(i1,i2).e(1)*p6(1)-c34z(i1 & ,i2).e(2)*p6(2)-c34z(i1,i2).e(3)*p6(3) cauxa=-c34z(i1,i2).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34z(i1,i2).ek0*p6(2)+p6k0*c34z(i1,i2).e(2) r6_34(i1,i2).a(2)=zvl*(cauxa-ceps_0) r6_34(i1,i2).b(1)=zvl*(cauxb-ceps_2) END DO END DO *****attaccamento di c56z a 2 (e-) * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) * TR0 -- qu=p134,qd=p2,v=c56z.e,a=r2_56.a,b=r2_56.b,cr=zer,cl=zel,nsum=0 ceps_0=-c56z.ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0*(c56 & z.e(2)*p2(3)-p2(2)*c56z.e(3))-p2k0*(c56z.e(2)*p134(3)-p13 & 4(2)*c56z.e(3)) ceps_0=ceps_0*cim ceps_2=-c56z.e(3)*p2k0+p2(3)*c56z.ek0 ceps_2=ceps_2*cim cvqu=c56z.e(0)*p134(0)-c56z.e(1)*p134(1)-c56z.e(2)*p134(2) & -c56z.e(3)*p134(3) cvqd=c56z.e(0)*p2(0)-c56z.e(1)*p2(1)-c56z.e(2)*p2(2)-c56z. & e(3)*p2(3) cauxa=-c56z.ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56z.ek0*p2(2)+p2k0*c56z.e(2) r2_56.a(1)=zer*(cauxa+ceps_0) r2_56.a(2)=zel*(cauxa-ceps_0) r2_56.b(1)=zel*(cauxb-ceps_2) r2_56.b(2)=zer*(-cauxb-ceps_2) *****attaccamento di c16w a 2 (e-) * quqd -- p=p345,q=p2 quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) * TWR0 -- qu=p345,qd=p2,v=c16w.e,a=r2_16.a,b=r2_16.b,cl=wcl,nsum=0 ceps_0=-c16w.ek0*(p345(2)*p2(3)-p2(2)*p345(3))+p345k0*(c16 & w.e(2)*p2(3)-p2(2)*c16w.e(3))-p2k0*(c16w.e(2)*p345(3)-p34 & 5(2)*c16w.e(3)) ceps_0=ceps_0*cim ceps_2=-c16w.e(3)*p2k0+p2(3)*c16w.ek0 ceps_2=ceps_2*cim cvqu=c16w.e(0)*p345(0)-c16w.e(1)*p345(1)-c16w.e(2)*p345(2) & -c16w.e(3)*p345(3) cvqd=c16w.e(0)*p2(0)-c16w.e(1)*p2(1)-c16w.e(2)*p2(2)-c16w. & e(3)*p2(3) cauxa=-c16w.ek0*quqd+p345k0*cvqd+p2k0*cvqu cauxb=-c16w.ek0*p2(2)+p2k0*c16w.e(2) r2_16.a(2)=wcl*(cauxa-ceps_0) r2_16.b(1)=wcl*(cauxb-ceps_2) *****attaccamento di c52w a 6 (vbar) * quqd -- p=p134,q=p6 quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) * TWR0 -- qu=p134,qd=p6,v=c52w.e,a=r6_52.a,b=r6_52.b,cl=wcl,nsum=0 ceps_0=-c52w.ek0*(p134(2)*p6(3)-p6(2)*p134(3))+p134k0*(c52 & w.e(2)*p6(3)-p6(2)*c52w.e(3))-p6k0*(c52w.e(2)*p134(3)-p13 & 4(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_2=-c52w.e(3)*p6k0+p6(3)*c52w.ek0 ceps_2=ceps_2*cim cvqu=c52w.e(0)*p134(0)-c52w.e(1)*p134(1)-c52w.e(2)*p134(2) & -c52w.e(3)*p134(3) cvqd=c52w.e(0)*p6(0)-c52w.e(1)*p6(1)-c52w.e(2)*p6(2)-c52w. & e(3)*p6(3) cauxa=-c52w.ek0*quqd+p134k0*cvqd+p6k0*cvqu cauxb=-c52w.ek0*p6(2)+p6k0*c52w.e(2) r6_52.a(2)=wcl*(cauxa-ceps_0) r6_52.b(1)=wcl*(cauxb-ceps_2) **** Diagramma 2 **** DO i1=1,2 DO i2=1,2 * TLTR0_W -- aa=cres2(i1,i2),a1=l5_16.a,c1=l5_16.c,a2=r2_34f(i1,i2).a,b2=r2 * _34f(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres2(i1,i2)=( l5_16.c(2)*p156q*r2_34f(i1,i2).b(1)+l5_16.a & (2)*r2_34f(i1,i2).a(2) )/(p156q*p156k0) END DO END DO **** Diagramma 4 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres4(&,i1,i2),a1=l1_56.a,c1=l1_56.c,a2=r2_34f(i1,i2).a,b2=r2 * _34f(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres4(1,i1,i2)=( l1_56.a(1)*r2_34f(i1,i2).a(1)+l1_56.c(1)* & p156q*r2_34f(i1,i2).b(2) )/(p156q*p156k0) cres4(2,i1,i2)=( l1_56.c(2)*p156q*r2_34f(i1,i2).b(1)+l1_56 & .a(2)*r2_34f(i1,i2).a(2) )/(p156q*p156k0) END DO END DO **** Diagramma 6 **** *** triple vertex -- pfz(mu)=p34(mu),pwm(mu)=p16(mu),pwp(mu)=p25(mu),efz=c3 * 4f(i1,i2),ewm=c16w,ewp=c52w,res=cres6(i1?,i2?) DO mu=0,3 vfz(mu)=p16(mu)-p25(mu) vwm(mu)=p25(mu)-p34(mu) vwp(mu)=p34(mu)-p16(mu) END DO !mu * vfz.efz DO i1=1,2 DO i2=1,2 * p.q -- p.q=c34f(i1,i2).v,p=c34f(i1,i2).e,q=vfz c34f(i1,i2).v=c34f(i1,i2).e(0)*vfz(0)-c34f(i1,i2).e(1)*vfz & (1)-c34f(i1,i2).e(2)*vfz(2)-c34f(i1,i2).e(3)*vfz(3) END DO END DO * vwm.ewm * p.q -- p.q=c16w.v,p=c16w.e,q=vwm c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c52w.v,p=c52w.e,q=vwp c52w.v=c52w.e(0)*vwp(0)-c52w.e(1)*vwp(1)-c52w.e(2)*vwp(2)- & c52w.e(3)*vwp(3) * efz.ewm DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34f(i1,i2).e,q=c16w.e caux=c34f(i1,i2).e(0)*c16w.e(0)-c34f(i1,i2).e(1)*c16w.e(1) & -c34f(i1,i2).e(2)*c16w.e(2)-c34f(i1,i2).e(3)*c16w.e(3) cres6(i1,i2)=c52w.v*caux END DO END DO * efz.ewp DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34f(i1,i2).e,q=c52w.e caux=c34f(i1,i2).e(0)*c52w.e(0)-c34f(i1,i2).e(1)*c52w.e(1) & -c34f(i1,i2).e(2)*c52w.e(2)-c34f(i1,i2).e(3)*c52w.e(3) cres6(i1,i2)=cres6(i1,i2)+c16w.v*caux END DO END DO * ewm.ewp * p.q -- p.q=caux,p=c16w.e,q=c52w.e caux=c16w.e(0)*c52w.e(0)-c16w.e(1)*c52w.e(1)-c16w.e(2)*c52 & w.e(2)-c16w.e(3)*c52w.e(3) DO i1=1,2 DO i2=1,2 cres6(i1,i2)=cres6(i1,i2)+c34f(i1,i2).v*caux END DO END DO **** Diagramma 9 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres9(&,i1,i2),a1=l1_34f(i1,i2).a,c1=l1_34f(i1,i2).c,a2=r2_56 * .a,b2=r2_56.b,prq=p134q,den=(p134q*p134k0),nsum=0 cres9(1,i1,i2)=( l1_34f(i1,i2).a(1)*r2_56.a(1)+l1_34f(i1,i & 2).c(1)*p134q*r2_56.b(2) )/(p134q*p134k0) cres9(2,i1,i2)=( l1_34f(i1,i2).c(2)*p134q*r2_56.b(1)+l1_34 & f(i1,i2).a(2)*r2_56.a(2) )/(p134q*p134k0) END DO END DO **** Diagramma 12 **** DO i1=1,2 DO i2=1,2 * TLTR0_W -- aa=cres12(i1,i2),a1=l1_34f(i1,i2).a,c1=l1_34f(i1,i2).c,a2=r6_5 * 2.a,b2=r6_52.b,prq=p134q,den=(p134q*p134k0),nsum=0 cres12(i1,i2)=( l1_34f(i1,i2).c(2)*p134q*r6_52.b(1)+l1_34f & (i1,i2).a(2)*r6_52.a(2) )/(p134q*p134k0) END DO END DO **** Diagramma 14 **** DO i=1,2 * TT -- aa=dia14(i).a,bb=dia14(i).b,cc=dia14(i).c,dd=dia14(i).d,a1=u3_56.a, * b1=u3_56.b,c1=u3_56.c,d1=u3_56.d,a2=d4_12f(i).a,b2=d4_12f(i).b,c2=d4_12f(i * ).c,d2=d4_12f(i).d,prq=p356q,m=rmb dia14(i).a(1,1)=u3_56.a(1,1)*d4_12f(i).a(1,1)+u3_56.c(1,2) & *p356q*d4_12f(i).b(2,1) dia14(i).b(1,1)=rmb*(u3_56.d(1,1)*d4_12f(i).a(1,1)+u3_56.b & (1,2)*d4_12f(i).b(2,1)) dia14(i).c(1,1)=rmb*(u3_56.a(1,1)*d4_12f(i).d(1,1)+u3_56.c & (1,2)*d4_12f(i).c(2,1)) dia14(i).d(1,1)=u3_56.d(1,1)*p356q*d4_12f(i).d(1,1)+u3_56. & b(1,2)*d4_12f(i).c(2,1) dia14(i).a(1,2)=rmb*(u3_56.a(1,1)*d4_12f(i).b(1,2)+u3_56.c & (1,2)*d4_12f(i).a(2,2)) dia14(i).b(1,2)=u3_56.d(1,1)*p356q*d4_12f(i).b(1,2)+u3_56. & b(1,2)*d4_12f(i).a(2,2) dia14(i).c(1,2)=u3_56.a(1,1)*d4_12f(i).c(1,2)+u3_56.c(1,2) & *p356q*d4_12f(i).d(2,2) dia14(i).d(1,2)=rmb*(u3_56.d(1,1)*d4_12f(i).c(1,2)+u3_56.b & (1,2)*d4_12f(i).d(2,2)) dia14(i).a(2,1)=rmb*(u3_56.c(2,1)*d4_12f(i).a(1,1)+u3_56.a & (2,2)*d4_12f(i).b(2,1)) dia14(i).b(2,1)=u3_56.b(2,1)*d4_12f(i).a(1,1)+u3_56.d(2,2) & *p356q*d4_12f(i).b(2,1) dia14(i).c(2,1)=u3_56.c(2,1)*p356q*d4_12f(i).d(1,1)+u3_56. & a(2,2)*d4_12f(i).c(2,1) dia14(i).d(2,1)=rmb*(u3_56.b(2,1)*d4_12f(i).d(1,1)+u3_56.d & (2,2)*d4_12f(i).c(2,1)) dia14(i).a(2,2)=u3_56.c(2,1)*p356q*d4_12f(i).b(1,2)+u3_56. & a(2,2)*d4_12f(i).a(2,2) dia14(i).b(2,2)=rmb*(u3_56.b(2,1)*d4_12f(i).b(1,2)+u3_56.d & (2,2)*d4_12f(i).a(2,2)) dia14(i).c(2,2)=rmb*(u3_56.c(2,1)*d4_12f(i).c(1,2)+u3_56.a & (2,2)*d4_12f(i).d(2,2)) dia14(i).d(2,2)=u3_56.b(2,1)*d4_12f(i).c(1,2)+u3_56.d(2,2) & *p356q*d4_12f(i).d(2,2) END DO DO i=1,2 * mline -- res=cres14(i,&),abcd=dia14(i).,m1=rmb,m2=(-rmb),den=((p356q-rmb2 * )*p356k0) DO iut=1,2 DO jut=1,2 cres14(i,iut,jut)=(dia14(i).a(iut,jut)+rmb*dia14(i).b(iut, & jut)+(-rmb)*dia14(i).c(iut,jut)+rmb*(-rmb)*dia14(i). & d(iut & ,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO **** Diagramma 16 **** DO i=1,2 * TT -- aa=dia16(i).a,bb=dia16(i).b,cc=dia16(i).c,dd=dia16(i).d,a1=u3_12f(i * ).a,b1=u3_12f(i).b,c1=u3_12f(i).c,d1=u3_12f(i).d,a2=d4_56.a,b2=d4_56.b,c2= * d4_56.c,d2=d4_56.d,prq=p123q,m=rmb dia16(i).a(1,1)=u3_12f(i).a(1,1)*d4_56.a(1,1)+u3_12f(i).c( & 1,2)*p123q*d4_56.b(2,1) dia16(i).b(1,1)=rmb*(u3_12f(i).d(1,1)*d4_56.a(1,1)+u3_12f( & i).b(1,2)*d4_56.b(2,1)) dia16(i).c(1,1)=rmb*(u3_12f(i).a(1,1)*d4_56.d(1,1)+u3_12f( & i).c(1,2)*d4_56.c(2,1)) dia16(i).d(1,1)=u3_12f(i).d(1,1)*p123q*d4_56.d(1,1)+u3_12f & (i).b(1,2)*d4_56.c(2,1) dia16(i).a(1,2)=rmb*(u3_12f(i).a(1,1)*d4_56.b(1,2)+u3_12f( & i).c(1,2)*d4_56.a(2,2)) dia16(i).b(1,2)=u3_12f(i).d(1,1)*p123q*d4_56.b(1,2)+u3_12f & (i).b(1,2)*d4_56.a(2,2) dia16(i).c(1,2)=u3_12f(i).a(1,1)*d4_56.c(1,2)+u3_12f(i).c( & 1,2)*p123q*d4_56.d(2,2) dia16(i).d(1,2)=rmb*(u3_12f(i).d(1,1)*d4_56.c(1,2)+u3_12f( & i).b(1,2)*d4_56.d(2,2)) dia16(i).a(2,1)=rmb*(u3_12f(i).c(2,1)*d4_56.a(1,1)+u3_12f( & i).a(2,2)*d4_56.b(2,1)) dia16(i).b(2,1)=u3_12f(i).b(2,1)*d4_56.a(1,1)+u3_12f(i).d( & 2,2)*p123q*d4_56.b(2,1) dia16(i).c(2,1)=u3_12f(i).c(2,1)*p123q*d4_56.d(1,1)+u3_12f & (i).a(2,2)*d4_56.c(2,1) dia16(i).d(2,1)=rmb*(u3_12f(i).b(2,1)*d4_56.d(1,1)+u3_12f( & i).d(2,2)*d4_56.c(2,1)) dia16(i).a(2,2)=u3_12f(i).c(2,1)*p123q*d4_56.b(1,2)+u3_12f & (i).a(2,2)*d4_56.a(2,2) dia16(i).b(2,2)=rmb*(u3_12f(i).b(2,1)*d4_56.b(1,2)+u3_12f( & i).d(2,2)*d4_56.a(2,2)) dia16(i).c(2,2)=rmb*(u3_12f(i).c(2,1)*d4_56.c(1,2)+u3_12f( & i).a(2,2)*d4_56.d(2,2)) dia16(i).d(2,2)=u3_12f(i).b(2,1)*d4_56.c(1,2)+u3_12f(i).d( & 2,2)*p123q*d4_56.d(2,2) END DO DO i=1,2 * mline -- res=cres16(i,&),abcd=dia16(i).,m1=rmb,m2=(-rmb),den=((p123q-rmb2 * )*p123k0) DO iut=1,2 DO jut=1,2 cres16(i,iut,jut)=(dia16(i).a(iut,jut)+rmb*dia16(i).b(iut, & jut)+(-rmb)*dia16(i).c(iut,jut)+rmb*(-rmb)*dia16(i). & d(iut & ,jut))/((p123q-rmb2)*p123k0) ENDDO ENDDO END DO **** Diagramma 3 **** DO i1=1,2 DO i2=1,2 * TLTR0_W -- aa=cres3(i1,i2),a1=l5_16.a,c1=l5_16.c,a2=r2_34z(i1,i2).a,b2=r2 * _34z(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres3(i1,i2)=( l5_16.c(2)*p156q*r2_34z(i1,i2).b(1)+l5_16.a & (2)*r2_34z(i1,i2).a(2) )/(p156q*p156k0) END DO END DO **** Diagramma 5 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres5(&,i1,i2),a1=l1_56.a,c1=l1_56.c,a2=r2_34z(i1,i2).a,b2=r2 * _34z(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres5(1,i1,i2)=( l1_56.a(1)*r2_34z(i1,i2).a(1)+l1_56.c(1)* & p156q*r2_34z(i1,i2).b(2) )/(p156q*p156k0) cres5(2,i1,i2)=( l1_56.c(2)*p156q*r2_34z(i1,i2).b(1)+l1_56 & .a(2)*r2_34z(i1,i2).a(2) )/(p156q*p156k0) END DO END DO **** Diagramma 7 **** *** triple vertex -- pfz(mu)=p34(mu),pwm(mu)=p16(mu),pwp(mu)=p25(mu),efz=c3 * 4z(i1,i2),ewm=c16w,ewp=c52w,res=cres7(i1?,i2?) DO mu=0,3 vfz(mu)=p16(mu)-p25(mu) vwm(mu)=p25(mu)-p34(mu) vwp(mu)=p34(mu)-p16(mu) END DO !mu * vfz.efz DO i1=1,2 DO i2=1,2 * p.q -- p.q=c34z(i1,i2).v,p=c34z(i1,i2).e,q=vfz c34z(i1,i2).v=c34z(i1,i2).e(0)*vfz(0)-c34z(i1,i2).e(1)*vfz & (1)-c34z(i1,i2).e(2)*vfz(2)-c34z(i1,i2).e(3)*vfz(3) END DO END DO * vwm.ewm * p.q -- p.q=c16w.v,p=c16w.e,q=vwm c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) * vwp.ewp * p.q -- p.q=c52w.v,p=c52w.e,q=vwp c52w.v=c52w.e(0)*vwp(0)-c52w.e(1)*vwp(1)-c52w.e(2)*vwp(2)- & c52w.e(3)*vwp(3) * efz.ewm DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34z(i1,i2).e,q=c16w.e caux=c34z(i1,i2).e(0)*c16w.e(0)-c34z(i1,i2).e(1)*c16w.e(1) & -c34z(i1,i2).e(2)*c16w.e(2)-c34z(i1,i2).e(3)*c16w.e(3) cres7(i1,i2)=c52w.v*caux END DO END DO * efz.ewp DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34z(i1,i2).e,q=c52w.e caux=c34z(i1,i2).e(0)*c52w.e(0)-c34z(i1,i2).e(1)*c52w.e(1) & -c34z(i1,i2).e(2)*c52w.e(2)-c34z(i1,i2).e(3)*c52w.e(3) cres7(i1,i2)=cres7(i1,i2)+c16w.v*caux END DO END DO * ewm.ewp * p.q -- p.q=caux,p=c16w.e,q=c52w.e caux=c16w.e(0)*c52w.e(0)-c16w.e(1)*c52w.e(1)-c16w.e(2)*c52 & w.e(2)-c16w.e(3)*c52w.e(3) DO i1=1,2 DO i2=1,2 cres7(i1,i2)=cres7(i1,i2)+c34z(i1,i2).v*caux END DO END DO **** Diagramma 10 **** DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres10(&,i1,i2),a1=l1_34z(i1,i2).a,c1=l1_34z(i1,i2).c,a2=r2_5 * 6.a,b2=r2_56.b,prq=p134q,den=(p134q*p134k0),nsum=0 cres10(1,i1,i2)=( l1_34z(i1,i2).a(1)*r2_56.a(1)+l1_34z(i1, & i2).c(1)*p134q*r2_56.b(2) )/(p134q*p134k0) cres10(2,i1,i2)=( l1_34z(i1,i2).c(2)*p134q*r2_56.b(1)+l1_3 & 4z(i1,i2).a(2)*r2_56.a(2) )/(p134q*p134k0) END DO END DO **** Diagramma 13 **** DO i1=1,2 DO i2=1,2 * TLTR0_W -- aa=cres13(i1,i2),a1=l1_34z(i1,i2).a,c1=l1_34z(i1,i2).c,a2=r6_5 * 2.a,b2=r6_52.b,prq=p134q,den=(p134q*p134k0),nsum=0 cres13(i1,i2)=( l1_34z(i1,i2).c(2)*p134q*r6_52.b(1)+l1_34z & (i1,i2).a(2)*r6_52.a(2) )/(p134q*p134k0) END DO END DO **** Diagramma 15 **** DO i=1,2 * TT -- aa=dia15(i).a,bb=dia15(i).b,cc=dia15(i).c,dd=dia15(i).d,a1=u3_56.a, * b1=u3_56.b,c1=u3_56.c,d1=u3_56.d,a2=d4_12z(i).a,b2=d4_12z(i).b,c2=d4_12z(i * ).c,d2=d4_12z(i).d,prq=p356q,m=rmb dia15(i).a(1,1)=u3_56.a(1,1)*d4_12z(i).a(1,1)+u3_56.c(1,2) & *p356q*d4_12z(i).b(2,1) dia15(i).b(1,1)=rmb*(u3_56.d(1,1)*d4_12z(i).a(1,1)+u3_56.b & (1,2)*d4_12z(i).b(2,1)) dia15(i).c(1,1)=rmb*(u3_56.a(1,1)*d4_12z(i).d(1,1)+u3_56.c & (1,2)*d4_12z(i).c(2,1)) dia15(i).d(1,1)=u3_56.d(1,1)*p356q*d4_12z(i).d(1,1)+u3_56. & b(1,2)*d4_12z(i).c(2,1) dia15(i).a(1,2)=rmb*(u3_56.a(1,1)*d4_12z(i).b(1,2)+u3_56.c & (1,2)*d4_12z(i).a(2,2)) dia15(i).b(1,2)=u3_56.d(1,1)*p356q*d4_12z(i).b(1,2)+u3_56. & b(1,2)*d4_12z(i).a(2,2) dia15(i).c(1,2)=u3_56.a(1,1)*d4_12z(i).c(1,2)+u3_56.c(1,2) & *p356q*d4_12z(i).d(2,2) dia15(i).d(1,2)=rmb*(u3_56.d(1,1)*d4_12z(i).c(1,2)+u3_56.b & (1,2)*d4_12z(i).d(2,2)) dia15(i).a(2,1)=rmb*(u3_56.c(2,1)*d4_12z(i).a(1,1)+u3_56.a & (2,2)*d4_12z(i).b(2,1)) dia15(i).b(2,1)=u3_56.b(2,1)*d4_12z(i).a(1,1)+u3_56.d(2,2) & *p356q*d4_12z(i).b(2,1) dia15(i).c(2,1)=u3_56.c(2,1)*p356q*d4_12z(i).d(1,1)+u3_56. & a(2,2)*d4_12z(i).c(2,1) dia15(i).d(2,1)=rmb*(u3_56.b(2,1)*d4_12z(i).d(1,1)+u3_56.d & (2,2)*d4_12z(i).c(2,1)) dia15(i).a(2,2)=u3_56.c(2,1)*p356q*d4_12z(i).b(1,2)+u3_56. & a(2,2)*d4_12z(i).a(2,2) dia15(i).b(2,2)=rmb*(u3_56.b(2,1)*d4_12z(i).b(1,2)+u3_56.d & (2,2)*d4_12z(i).a(2,2)) dia15(i).c(2,2)=rmb*(u3_56.c(2,1)*d4_12z(i).c(1,2)+u3_56.a & (2,2)*d4_12z(i).d(2,2)) dia15(i).d(2,2)=u3_56.b(2,1)*d4_12z(i).c(1,2)+u3_56.d(2,2) & *p356q*d4_12z(i).d(2,2) END DO DO i=1,2 * mline -- res=cres15(i,&),abcd=dia15(i).,m1=rmb,m2=(-rmb),den=((p356q-rmb2 * )*p356k0) DO iut=1,2 DO jut=1,2 cres15(i,iut,jut)=(dia15(i).a(iut,jut)+rmb*dia15(i).b(iut, & jut)+(-rmb)*dia15(i).c(iut,jut)+rmb*(-rmb)*dia15(i). & d(iut & ,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO **** Diagramma 17 **** DO i=1,2 * TT -- aa=dia17(i).a,bb=dia17(i).b,cc=dia17(i).c,dd=dia17(i).d,a1=u3_12z(i * ).a,b1=u3_12z(i).b,c1=u3_12z(i).c,d1=u3_12z(i).d,a2=d4_56.a,b2=d4_56.b,c2= * d4_56.c,d2=d4_56.d,prq=p123q,m=rmb dia17(i).a(1,1)=u3_12z(i).a(1,1)*d4_56.a(1,1)+u3_12z(i).c( & 1,2)*p123q*d4_56.b(2,1) dia17(i).b(1,1)=rmb*(u3_12z(i).d(1,1)*d4_56.a(1,1)+u3_12z( & i).b(1,2)*d4_56.b(2,1)) dia17(i).c(1,1)=rmb*(u3_12z(i).a(1,1)*d4_56.d(1,1)+u3_12z( & i).c(1,2)*d4_56.c(2,1)) dia17(i).d(1,1)=u3_12z(i).d(1,1)*p123q*d4_56.d(1,1)+u3_12z & (i).b(1,2)*d4_56.c(2,1) dia17(i).a(1,2)=rmb*(u3_12z(i).a(1,1)*d4_56.b(1,2)+u3_12z( & i).c(1,2)*d4_56.a(2,2)) dia17(i).b(1,2)=u3_12z(i).d(1,1)*p123q*d4_56.b(1,2)+u3_12z & (i).b(1,2)*d4_56.a(2,2) dia17(i).c(1,2)=u3_12z(i).a(1,1)*d4_56.c(1,2)+u3_12z(i).c( & 1,2)*p123q*d4_56.d(2,2) dia17(i).d(1,2)=rmb*(u3_12z(i).d(1,1)*d4_56.c(1,2)+u3_12z( & i).b(1,2)*d4_56.d(2,2)) dia17(i).a(2,1)=rmb*(u3_12z(i).c(2,1)*d4_56.a(1,1)+u3_12z( & i).a(2,2)*d4_56.b(2,1)) dia17(i).b(2,1)=u3_12z(i).b(2,1)*d4_56.a(1,1)+u3_12z(i).d( & 2,2)*p123q*d4_56.b(2,1) dia17(i).c(2,1)=u3_12z(i).c(2,1)*p123q*d4_56.d(1,1)+u3_12z & (i).a(2,2)*d4_56.c(2,1) dia17(i).d(2,1)=rmb*(u3_12z(i).b(2,1)*d4_56.d(1,1)+u3_12z( & i).d(2,2)*d4_56.c(2,1)) dia17(i).a(2,2)=u3_12z(i).c(2,1)*p123q*d4_56.b(1,2)+u3_12z & (i).a(2,2)*d4_56.a(2,2) dia17(i).b(2,2)=rmb*(u3_12z(i).b(2,1)*d4_56.b(1,2)+u3_12z( & i).d(2,2)*d4_56.a(2,2)) dia17(i).c(2,2)=rmb*(u3_12z(i).c(2,1)*d4_56.c(1,2)+u3_12z( & i).a(2,2)*d4_56.d(2,2)) dia17(i).d(2,2)=u3_12z(i).b(2,1)*d4_56.c(1,2)+u3_12z(i).d( & 2,2)*p123q*d4_56.d(2,2) END DO DO i=1,2 * mline -- res=cres17(i,&),abcd=dia17(i).,m1=rmb,m2=(-rmb),den=((p123q-rmb2 * )*p123k0) DO iut=1,2 DO jut=1,2 cres17(i,iut,jut)=(dia17(i).a(iut,jut)+rmb*dia17(i).b(iut, & jut)+(-rmb)*dia17(i).c(iut,jut)+rmb*(-rmb)*dia17(i). & d(iut & ,jut))/((p123q-rmb2)*p123k0) ENDDO ENDDO END DO **** Diagramma 1**** * TWTW -- aa=dia1.a,bb=dia1.b,cc=dia1.c,dd=dia1.d,a1=u3_52.a,b1=u3_52.b,c1= * u3_52.c,d1=u3_52.d,a2=d4_16.a,b2=d4_16.b,c2=d4_16.c,d2=d4_16.d,prq=p235q dia1.d(1,1)=u3_52.d(1,1)*p235q*d4_16.d(1,1)+u3_52.b(1,2)*d & 4_16.c(2,1) dia1.b(1,2)=u3_52.d(1,1)*p235q*d4_16.b(1,2)+u3_52.b(1,2)*d & 4_16.a(2,2) dia1.c(2,1)=u3_52.c(2,1)*p235q*d4_16.d(1,1)+u3_52.a(2,2)*d & 4_16.c(2,1) dia1.a(2,2)=u3_52.c(2,1)*p235q*d4_16.b(1,2)+u3_52.a(2,2)*d & 4_16.a(2,2) * mline -- res=cres1(&),abcd=dia1.,m1=rmb,m2=(-rmb),den=((p235q-rmt2)*p235k * 0) DO iut=1,2 DO jut=1,2 cres1(iut,jut)=(dia1.a(iut,jut)+rmb*dia1.b(iut,jut)+(-rmb) & *dia1.c(iut,jut)+rmb*(-rmb)*dia1.d(iut,jut))/((p235q-rmt2 & )*p235k0) ENDDO ENDDO **** Diagramma 11**** DO i1=1,2 DO i2=1,2 * TLTR0_W -- aa=cres11(i1,i2),a1=l1_52.a,c1=l1_52.c,a2=r6_34(i1,i2).a,b2=r6 * _34(i1,i2).b,prq=p125q,den=(p125q*p125k0),nsum=0 cres11(i1,i2)=( l1_52.c(2)*p125q*r6_34(i1,i2).b(1)+l1_52.a & (2)*r6_34(i1,i2).a(2) )/(p125q*p125k0) END DO END DO **** Diagramma 18**** DO i1=1,2 DO i2=1,2 * TLTR0_W -- aa=cres18(i1,i2),a1=l5_34(i1,i2).a,c1=l5_34(i1,i2).c,a2=r2_16. * a,b2=r2_16.b,prq=p345q,den=(p345q*p345k0),nsum=0 cres18(i1,i2)=( l5_34(i1,i2).c(2)*p345q*r2_16.b(1)+l5_34(i & 1,i2).a(2)*r2_16.a(2) )/(p345q*p345k0) END DO END DO **** Diagramma 20 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0_W -- aa=cres20(i1,i2,i3),a1=l5_12(i1).a,c1=l5_12(i1).c,a2=r6_34(i2, * i3).a,b2=r6_34(i2,i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cres20(i1,i2,i3)=( l5_12(i1).c(2)*p125q*r6_34(i2,i3).b(1)+ & l5_12(i1).a(2)*r6_34(i2,i3).a(2) )/(p125q*p125k0) END DO END DO END DO **** Diagramma 21 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0_W -- aa=cres21(i1,i2,i3),a1=l5_34(i2,i3).a,c1=l5_34(i2,i3).c,a2=r6_ * 12(i1).a,b2=r6_12(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cres21(i1,i2,i3)=( l5_34(i2,i3).c(2)*p345q*r6_12(i1).b(1)+ & l5_34(i2,i3).a(2)*r6_12(i1).a(2) )/(p345q*p345k0) END DO END DO END DO ENDIF !(fondo) * Introduco l' Higgs IF (imix.EQ.1.OR.imix.EQ.-2) then * Diagramma (36) segnale di Higgs * Vertice b b~ H ( quarks massivi ) * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) * TH -- qu=p3,qd=p4,a=v3_4h.a,b=v3_4h.b,c=v3_4h.c v3_4h.a(1,2)=-p3k0*p4(2)+p4k0*p3(2)-cim*(p4(3)*p3k0-p3(3)* & p4k0) v3_4h.a(2,1)=-conjg(v3_4h.a(1,2)) v3_4h.b(1,1)=p4k0 v3_4h.b(2,2)=v3_4h.b(1,1) v3_4h.c(1,1)=p3k0 v3_4h.c(2,2)=v3_4h.c(1,1) * mline -- res=c34h(&),abcd=v3_4h.,m1=rmb,m2=(-rmb),den=cdh DO iut=1,2 DO jut=1,2 c34h(iut,jut)=(v3_4h.a(iut,jut)+rmb*v3_4h.b(iut,jut)+(-rmb & )*v3_4h.c(iut,jut)+rmb*(-rmb)*v3_4h.d(iut,jut))/cdh ENDDO ENDDO DO i1=1,2 DO i3=1,2 DO i4=1,2 cres36(i1,i3,i4)=rhzz*(c56z.e(0)*c12z(i1).e(0)- & c56z.e(1)*c12z(i1).e(1)-c56z.e(2)*c12z(i1).e(2)- & c56z.e(3)*c12z(i1).e(3))*c34h(i3,i4) IF (i1.EQ.2.AND.i56ve.EQ.1) THEN cres37(i3,i4)=rhww*(c16w.e(0)*c52w.e(0)- & c16w.e(1)*c52w.e(1)-c16w.e(2)*c52w.e(2)- & c16w.e(3)*c52w.e(3))*c34h(i3,i4) ENDIF ENDDO !i4 ENDDO !i3 ENDDO !i1 ENDIF !(imix=1) ******************************AUTOMEND******************************* if (ifirst.eq.1) then IF(istrcor.EQ.1)THEN qcdcor=qcdcor_nc fatcor_hh=(1.d0+qcdcor_h)/(1.d0+qcdcor) fatcor_hz=sqrt((1.d0+qcdcor)*(1.d0+qcdcor_h))/(1.d0+qcdcor) ELSE fatcor_hh=1.d0 fatcor_hz=1.d0 ENDIF ifirst=0 endif res=0.d0 cres=(0.d0,0.d0) DO k=1,2 DO i=1,2 DO j=1,2 IF (imix.EQ.-1.or.imix.eq.-2) then cres=+cres4(k,i,j)+cres5(k,i,j)+cres9(k,i,j)+cres10(k,i,j) & +cres14(k,i,j)+cres15(k,i,j)+cres16(k,i,j) & +cres17(k,i,j)+cres20(k,i,j)+cres21(k,i,j) IF (k.EQ.2.AND.i56ve.EQ.1) THEN cres=cres-cres1(i,j)-cres2(i,j)-cres3(i,j)-cres6(i,j) & -rcotw*cres7(i,j)-cres11(i,j)-cres12(i,j) & -cres13(i,j)-cres18(i,j) ENDIF res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=cres36(k,i,j) IF (k.EQ.2.AND.i56ve.EQ.1) THEN cresh=cresh-cres37(i,j) ENDIF IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres))*fatcor_hz ENDIF ENDIF ENDDO !j ENDDO !i ENDDO !k * el1 IF(i3q.EQ.1)THEN rc=3.d0 ELSE rc=1.d0 ENDIF ee_bbvv=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/4.d0 * endel1 IF (istrcor.EQ.1) THEN ee_bbvv=ee_bbvv*(1.d0+qcdcor) ENDIF RETURN END REAL*8 FUNCTION ee_bbmumu(p1,p2,p3,p4,p5,p6) IMPLICIT REAL*8 (a-b,d-h,o-z) IMPLICIT double COMPLEX (c) DIMENSION p1(0:3),p2(0:3),p3(0:3),p4(0:3),p5(0:3),p6(0:3) DIMENSION p34(0:3),p16(0:3),p25(0:3),p123(0:3),p125(0:3), & p134(0:3),p156(0:3),p235(0:3),p345(0:3),p356(0:3) DIMENSION cres4(2,2,2,2),cres5(2,2,2,2),cres9(2,2,2,2), & cres10(2,2,2,2),cres14(2,2,2,2),cres15(2,2,2,2),cres16(2,2,2,2), & cres20(2,2,2,2),cres21(2,2,2,2),cres22(2,2,2,2),cres23(2,2,2,2), & cres24(2,2,2,2),cres25(2,2,2,2),cres26(2,2,2,2),cres27(2,2,2,2), & cres28(2,2,2,2),cres29(2,2,2,2),cres30(2,2,2,2),cres31(2,2,2,2), & cres32(2,2,2,2),cres33(2,2,2,2),cres34(2,2,2,2),cres35(2,2,2,2), & cres36(2,2,2,2),c34h(2,2),cres17(2,2,2,2) STRUCTURE/polcom/ double COMPLEX e(0:3),ek0,v END STRUCTURE RECORD/polcom/c12f(2),c12z(2),c34f(2,2),c34z(2,2), & c56z(2),c56f(2) STRUCTURE/tu0/ double COMPLEX a(2),c(2) END STRUCTURE RECORD/tu0/l1_34f(2,2),l1_34z(2,2),l5_12z(2),l5_34z(2,2),l1_56z(2) & ,l5_12f(2),l5_34f(2,2),l1_56f(2) STRUCTURE/td0/ double COMPLEX a(2),b(2) END STRUCTURE RECORD/td0/r2_34f(2,2),r2_34z(2,2),r6_12z(2),r6_34z(2,2),r2_56z(2) & ,r6_12f(2),r6_34f(2,2),r2_56f(2) STRUCTURE/t/ double COMPLEX a(2,2),b(2,2),c(2,2),d(2,2) END STRUCTURE RECORD/t/v3_4f(0:3),v3_4z(0:3),u3_12f(2),u3_12z(2),u3_56z(2), & d4_12f(2),d4_12z(2),d4_56f(2),d4_56z(2),u3_56f(2),v3_4h, & dia14(2,2),dia15(2,2),dia16(2,2),dia17(2,2),dia26(2,2), & dia27(2,2),dia28(2,2),dia29(2,2) COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abparc/czipr,ccz,cwipr,ccw,chipr,cch,caipr,cca COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc *el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch *endel2 PARAMETER (czero=(0.d0,0.d0),cuno=(1.d0,0.d0),cim=(0.d0,1.d0)) data ifirst/1/ * p_q -- p_q=p1p2,p=p1,q=p2 p1p2=p1(0)*p2(0)-p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3) s=2.d0*p1p2 ss=sqrt(s) e=ss/2.d0 quqd=s/2.d0 p1k0=p1(0)-p1(1) p2k0=p2(0)-p2(1) cdz=-1.d0/(s*czipr-rmz2+ccz) dph=-1.d0/s fac1=(dph*fer) fac2=(dph*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p1,qd=p2,v=0,a=c12f,cr=fac1,cl=fac2,nsum=0 eps_0=-p1(2)*p2(3)+p2(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p2(0)+p2k0*p1(0) c12f(1).e(0)=fac1*(auxa+ceps_0) c12f(2).e(0)=fac2*(auxa-ceps_0) c12z(1).e(0)=cfac1z*c12f(1).e(0) c12z(2).e(0)=cfac2z*c12f(2).e(0) * T10 -- qu=p1,qd=p2,v=1,a=c12f,cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_0) c12z(1).e(1)=cfac1z*c12f(1).e(1) c12z(2).e(1)=cfac2z*c12f(2).e(1) * T10 -- qu=p1,qd=p2,v=2,a=c12f,cr=fac1,cl=fac2,nsum=0 eps_0=-p1k0*p2(3)+p2k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p2(2)+p2k0*p1(2) c12f(1).e(2)=fac1*(auxa+ceps_0) c12f(2).e(2)=fac2*(auxa-ceps_0) c12z(1).e(2)=cfac1z*c12f(1).e(2) c12z(2).e(2)=cfac2z*c12f(2).e(2) * T10 -- qu=p1,qd=p2,v=3,a=c12f,cr=fac1,cl=fac2,nsum=0 eps_0=p1k0*p2(2)-p2k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p2(3)+p2k0*p1(3) c12f(1).e(3)=fac1*(auxa+ceps_0) c12f(2).e(3)=fac2*(auxa-ceps_0) c12z(1).e(3)=cfac1z*c12f(1).e(3) c12z(2).e(3)=cfac2z*c12f(2).e(3) DO i=1,2 * pk0 -- p=c12f(i).e c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 * pk0 -- p=c12z(i).e c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO *********************AUTOM*********************************************** * * pk0 -- p=p3 p3k0=p3(0)-p3(1) * pk0 -- p=p4 p4k0=p4(0)-p4(1) * pk0 -- p=p5 p5k0=p5(0)-p5(1) * pk0 -- p=p6 p6k0=p6(0)-p6(1) * Impulsi dei propagatori DO m=0,3 p34(m)=p3(m)+p4(m) p16(m)=-p1(m)+p6(m) p25(m)=-p2(m)+p5(m) p123(m)=-p1(m)-p2(m)+p3(m) p125(m)=-p1(m)+p25(m) p134(m)=-p1(m)+p34(m) p156(m)=p5(m)+p16(m) p235(m)=p25(m)+p3(m) p345(m)=p34(m)+p5(m) p356(m)=p3(m)+p5(m)+p6(m) END DO * pk0 -- p=p123 p123k0=p123(0)-p123(1) * p.q -- p.q=p123q,p=p123,q=p123 p123q=p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p123 & (3)*p123(3) * pk0 -- p=p125 p125k0=p125(0)-p125(1) * p.q -- p.q=p125q,p=p125,q=p125 p125q=p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p125 & (3)*p125(3) * pk0 -- p=p134 p134k0=p134(0)-p134(1) * p.q -- p.q=p134q,p=p134,q=p134 p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) * pk0 -- p=p156 p156k0=p156(0)-p156(1) * p.q -- p.q=p156q,p=p156,q=p156 p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) * pk0 -- p=p235 p235k0=p235(0)-p235(1) * p.q -- p.q=p235q,p=p235,q=p235 p235q=p235(0)*p235(0)-p235(1)*p235(1)-p235(2)*p235(2)-p235 & (3)*p235(3) * pk0 -- p=p345 p345k0=p345(0)-p345(1) * p.q -- p.q=p345q,p=p345,q=p345 p345q=p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p345 & (3)*p345(3) * pk0 -- p=p356 p356k0=p356(0)-p356(1) * p.q -- p.q=p356q,p=p356,q=p356 p356q=p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p356 & (3)*p356(3) IF (imix.EQ.-1.or.imix.eq.-2) then * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) df=-2.d0*(quqd+rmb2) cdz=-(2.d0*(quqd+rmb2)*czipr-rmz2+ccz) * T -- qu=p3,qd=p4,v=0,a=v3_4f(0).a,b=v3_4f(0).b,c=v3_4f(0).c,d=v3_4f(0).d * cr=fqdr,cl=fqdl,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) v3_4f(0).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(0).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(0).b(1,2)=-fqdl*(p4(2)+ceps_2) v3_4f(0).b(2,1)=fqdr*(p4(2)-ceps_2) v3_4f(0).c(1,2)=fqdr*(p3(2)+ceps_1) v3_4f(0).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_4f(0).d(1,1)=fqdl v3_4f(0).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=1,a=v3_4f(1).a,b=v3_4f(1).b,c=v3_4f(1).c,d=v3_4f(1).d, * cr=fqdr,cl=fqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v3_4f(1).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(1).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(1).b(1,2)=-fqdl*(p4(2)+ceps_2) v3_4f(1).b(2,1)=fqdr*(p4(2)-ceps_2) v3_4f(1).c(1,2)=fqdr*(p3(2)+ceps_1) v3_4f(1).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_4f(1).d(1,1)=fqdl v3_4f(1).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=2,a=v3_4f(2).a,b=v3_4f(2).b,c=v3_4f(2).c,d=v3_4f(2).d, * cr=fqdr,cl=fqdl,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) v3_4f(2).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(2).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(2).b(1,2)=-fqdl*p4k0 v3_4f(2).b(2,1)=fqdr*p4k0 v3_4f(2).c(1,2)=fqdr*p3k0 v3_4f(2).c(2,1)=-fqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v3_4f(3).a,b=v3_4f(3).b,c=v3_4f(3).c,d=v3_4f(3).d, * cr=fqdr,cl=fqdl,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p4k0*cim auxa=+p3k0*p4(3)+p4k0*p3(3) v3_4f(3).a(1,1)=fqdr*(auxa+ceps_0) v3_4f(3).a(2,2)=fqdl*(auxa-ceps_0) v3_4f(3).b(1,2)=-fqdl*ceps_2 v3_4f(3).b(2,1)=-fqdr*ceps_2 v3_4f(3).c(1,2)=fqdr*ceps_1 v3_4f(3).c(2,1)=fqdl*ceps_1 DO m=0,3 * mline -- res=c34f(&).e(m),abcd=v3_4f(m).,m1=rmb,m2=(-rmb),den=df DO iut=1,2 DO jut=1,2 c34f(iut,jut).e(m)=(v3_4f(m).a(iut,jut)+rmb*v3_4f(m).b(iut & ,jut)+(-rmb)*v3_4f(m).c(iut,jut)+rmb*(-rmb)*v3_4f(m). & d(iu & t,jut))/df ENDDO ENDDO END DO * T -- qu=p3,qd=p4,v=0,a=v3_4z(0).a,b=v3_4z(0).b,c=v3_4z(0).c,d=v3_4z(0).d, * cr=zqdr,cl=zqdl,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) v3_4z(0).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(0).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(0).b(1,2)=-zqdl*(p4(2)+ceps_2) v3_4z(0).b(2,1)=zqdr*(p4(2)-ceps_2) v3_4z(0).c(1,2)=zqdr*(p3(2)+ceps_1) v3_4z(0).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_4z(0).d(1,1)=zqdl v3_4z(0).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=1,a=v3_4z(1).a,b=v3_4z(1).b,c=v3_4z(1).c,d=v3_4z(1).d, * cr=zqdr,cl=zqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v3_4z(1).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(1).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(1).b(1,2)=-zqdl*(p4(2)+ceps_2) v3_4z(1).b(2,1)=zqdr*(p4(2)-ceps_2) v3_4z(1).c(1,2)=zqdr*(p3(2)+ceps_1) v3_4z(1).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_4z(1).d(1,1)=zqdl v3_4z(1).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=2,a=v3_4z(2).a,b=v3_4z(2).b,c=v3_4z(2).c,d=v3_4z(2).d, * cr=zqdr,cl=zqdl,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) v3_4z(2).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(2).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(2).b(1,2)=-zqdl*p4k0 v3_4z(2).b(2,1)=zqdr*p4k0 v3_4z(2).c(1,2)=zqdr*p3k0 v3_4z(2).c(2,1)=-zqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v3_4z(3).a,b=v3_4z(3).b,c=v3_4z(3).c,d=v3_4z(3).d, * cr=zqdr,cl=zqdl,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p4k0*cim auxa=+p3k0*p4(3)+p4k0*p3(3) v3_4z(3).a(1,1)=zqdr*(auxa+ceps_0) v3_4z(3).a(2,2)=zqdl*(auxa-ceps_0) v3_4z(3).b(1,2)=-zqdl*ceps_2 v3_4z(3).b(2,1)=-zqdr*ceps_2 v3_4z(3).c(1,2)=zqdr*ceps_1 v3_4z(3).c(2,1)=zqdl*ceps_1 DO m=0,3 * mline -- res=c34z(&).e(m),abcd=v3_4z(m).,m1=rmb,m2=(-rmb),den=cdz DO iut=1,2 DO jut=1,2 c34z(iut,jut).e(m)=(v3_4z(m).a(iut,jut)+rmb*v3_4z(m).b(iut & ,jut)+(-rmb)*v3_4z(m).c(iut,jut)+rmb*(-rmb)*v3_4z(m). & d(iu & t,jut))/cdz ENDDO ENDDO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c34f(i1,i2).e c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO * aggiungo al propagatore della zeta pezzo prop. a k(mu)*k(nu) DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34z(i1,i2).e,q=p34 caux=c34z(i1,i2).e(0)*p34(0)-c34z(i1,i2).e(1)*p34(1)-c34z( & i1,i2).e(2)*p34(2)-c34z(i1,i2).e(3)*p34(3) DO m=0,3 c34z(i1,i2).e(m)=c34z(i1,i2).e(m)-caux*p34(m)/rmz2 END DO END DO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c34z(i1,i2).e c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO ENDIF !(c34f e c34z) * quqd -- p=p5,q=p6 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) cdz=-(2.d0*quqd*czipr-rmz2+ccz) df=-2.d0*quqd ccr=z5r/cdz ccl=z5l/cdz * T10 -- qu=p5,qd=p6,v=0,a=c56z(&).e(0),cr=ccr,cl=ccl,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) c56z(1).e(0)=ccr*(auxa+ceps_0) c56z(2).e(0)=ccl*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=1,a=c56z(&).e(1),cr=ccr,cl=ccl,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56z(1).e(1)=ccr*(auxa+ceps_0) c56z(2).e(1)=ccl*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=2,a=c56z(&).e(2),cr=ccr,cl=ccl,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) c56z(1).e(2)=ccr*(auxa+ceps_0) c56z(2).e(2)=ccl*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=3,a=c56z(&).e(3),cr=ccr,cl=ccl,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p6(3)+p6k0*p5(3) c56z(1).e(3)=ccr*(auxa+ceps_0) c56z(2).e(3)=ccl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c56z(i).e c56z(i).ek0=c56z(i).e(0)-c56z(i).e(1) END DO IF (imix.EQ.-1.or.imix.eq.-2) then rcr=f5r/df rcl=f5l/df * T10 -- qu=p5,qd=p6,v=0,a=c56f(&).e(0),cr=rcr,cl=rcl,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) c56f(1).e(0)=rcr*(auxa+ceps_0) c56f(2).e(0)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=1,a=c56f(&).e(1),cr=rcr,cl=rcl,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56f(1).e(1)=rcr*(auxa+ceps_0) c56f(2).e(1)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=2,a=c56f(&).e(2),cr=rcr,cl=rcl,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) c56f(1).e(2)=rcr*(auxa+ceps_0) c56f(2).e(2)=rcl*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=3,a=c56f(&).e(3),cr=rcr,cl=rcl,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p6(3)+p6k0*p5(3) c56f(1).e(3)=rcr*(auxa+ceps_0) c56f(2).e(3)=rcl*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c56f(i).e c56f(i).ek0=c56f(i).e(0)-c56f(i).e(1) END DO *****attaccamento di c12f(2) a 3 (b) * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * T -- qu=p3,qd=p123,v=c12f(i).e,a=u3_12f(i).a,b=u3_12f(i).b,c=u3_12f(i).c, * d=u3_12f(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2f(i).e(2)*p123(3)-p123(2)*c12f(i).e(3))-p123k0*(c12f(i). & e(2)*p3(3)-p3(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p3k0+p3(3)*c12f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i).e(3)*p123k0+p123(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p3(0)-c12f(i).e(1)*p3(1)-c12f(i).e(2)*p3 & (2)-c12f(i).e(3)*p3(3) cvqd=c12f(i).e(0)*p123(0)-c12f(i).e(1)*p123(1)-c12f(i).e(2 & )*p123(2)-c12f(i).e(3)*p123(3) cauxa=-c12f(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxb=-c12f(i).ek0*p123(2)+p123k0*c12f(i).e(2) cauxc=+c12f(i).ek0*p3(2)-p3k0*c12f(i).e(2) u3_12f(i).a(1,1)=fqdr*(cauxa+ceps_0) u3_12f(i).a(2,2)=fqdl*(cauxa-ceps_0) u3_12f(i).b(1,2)=fqdl*(cauxb-ceps_2) u3_12f(i).b(2,1)=fqdr*(-cauxb-ceps_2) u3_12f(i).c(1,2)=fqdr*(cauxc+ceps_1) u3_12f(i).c(2,1)=fqdl*(-cauxc+ceps_1) u3_12f(i).d(1,1)=fqdl*c12f(i).ek0 u3_12f(i).d(2,2)=fqdr*c12f(i).ek0 END DO *****attaccamento di c12f(2) a 4 (bbar) * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * T -- qu=p356,qd=p4,v=c12f(i).e,a=d4_12f(i).a,b=d4_12f(i).b,c=d4_12f(i).c, * d=d4_12f(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12f(i).e(2)*p4(3)-p4(2)*c12f(i).e(3))-p4k0*(c12f(i).e(2) & *p356(3)-p356(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p356k0+p356(3)*c12f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i).e(3)*p4k0+p4(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p356(0)-c12f(i).e(1)*p356(1)-c12f(i).e(2 & )*p356(2)-c12f(i).e(3)*p356(3) cvqd=c12f(i).e(0)*p4(0)-c12f(i).e(1)*p4(1)-c12f(i).e(2)*p4 & (2)-c12f(i).e(3)*p4(3) cauxa=-c12f(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12f(i).ek0*p4(2)+p4k0*c12f(i).e(2) cauxc=+c12f(i).ek0*p356(2)-p356k0*c12f(i).e(2) d4_12f(i).a(1,1)=fqdr*(cauxa+ceps_0) d4_12f(i).a(2,2)=fqdl*(cauxa-ceps_0) d4_12f(i).b(1,2)=fqdl*(cauxb-ceps_2) d4_12f(i).b(2,1)=fqdr*(-cauxb-ceps_2) d4_12f(i).c(1,2)=fqdr*(cauxc+ceps_1) d4_12f(i).c(2,1)=fqdl*(-cauxc+ceps_1) d4_12f(i).d(1,1)=fqdl*c12f(i).ek0 d4_12f(i).d(2,2)=fqdr*c12f(i).ek0 END DO *****attaccamento di c34f(2,2) a 1 (e+) * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p1,qd=p134,v=c34f(i1,i2).e,a=l1_34f(i1,i2).a,c=l1_34f(i1,i2).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34f(i1,i2).e(2)*p134(3)-p134(2)*c34f(i1,i2).e(3))-p134 & k0*(c34f(i1,i2).e(2)*p1(3)-p1(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i1,i2).e(3)*p1k0+p1(3)*c34f(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34f(i1,i2).e(0)*p1(0)-c34f(i1,i2).e(1)*p1(1)-c34f(i1 & ,i2).e(2)*p1(2)-c34f(i1,i2).e(3)*p1(3) cvqd=c34f(i1,i2).e(0)*p134(0)-c34f(i1,i2).e(1)*p134(1)-c34 & f(i1,i2).e(2)*p134(2)-c34f(i1,i2).e(3)*p134(3) cauxa=-c34f(i1,i2).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34f(i1,i2).ek0*p1(2)-p1k0*c34f(i1,i2).e(2) l1_34f(i1,i2).a(1)=fer*(cauxa+ceps_0) l1_34f(i1,i2).a(2)=fel*(cauxa-ceps_0) l1_34f(i1,i2).c(1)=fer*(cauxc+ceps_1) l1_34f(i1,i2).c(2)=fel*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34f(2,2) a 2 (e-) * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p156,qd=p2,v=c34f(i1,i2).e,a=r2_34f(i1,i2).a,b=r2_34f(i1,i2).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34f(i1,i2).e(2)*p2(3)-p2(2)*c34f(i1,i2).e(3))-p2k0*( & c34f(i1,i2).e(2)*p156(3)-p156(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i1,i2).e(3)*p2k0+p2(3)*c34f(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34f(i1,i2).e(0)*p156(0)-c34f(i1,i2).e(1)*p156(1)-c34 & f(i1,i2).e(2)*p156(2)-c34f(i1,i2).e(3)*p156(3) cvqd=c34f(i1,i2).e(0)*p2(0)-c34f(i1,i2).e(1)*p2(1)-c34f(i1 & ,i2).e(2)*p2(2)-c34f(i1,i2).e(3)*p2(3) cauxa=-c34f(i1,i2).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34f(i1,i2).ek0*p2(2)+p2k0*c34f(i1,i2).e(2) r2_34f(i1,i2).a(1)=fer*(cauxa+ceps_0) r2_34f(i1,i2).a(2)=fel*(cauxa-ceps_0) r2_34f(i1,i2).b(1)=fel*(cauxb-ceps_2) r2_34f(i1,i2).b(2)=fer*(-cauxb-ceps_2) END DO END DO *****attaccamento di c12z(2) a 3 (b) * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * T -- qu=p3,qd=p123,v=c12z(i).e,a=u3_12z(i).a,b=u3_12z(i).b,c=u3_12z(i).c, * d=u3_12z(i).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2z(i).e(2)*p123(3)-p123(2)*c12z(i).e(3))-p123k0*(c12z(i). & e(2)*p3(3)-p3(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p3k0+p3(3)*c12z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i).e(3)*p123k0+p123(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p3(0)-c12z(i).e(1)*p3(1)-c12z(i).e(2)*p3 & (2)-c12z(i).e(3)*p3(3) cvqd=c12z(i).e(0)*p123(0)-c12z(i).e(1)*p123(1)-c12z(i).e(2 & )*p123(2)-c12z(i).e(3)*p123(3) cauxa=-c12z(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxb=-c12z(i).ek0*p123(2)+p123k0*c12z(i).e(2) cauxc=+c12z(i).ek0*p3(2)-p3k0*c12z(i).e(2) u3_12z(i).a(1,1)=zqdr*(cauxa+ceps_0) u3_12z(i).a(2,2)=zqdl*(cauxa-ceps_0) u3_12z(i).b(1,2)=zqdl*(cauxb-ceps_2) u3_12z(i).b(2,1)=zqdr*(-cauxb-ceps_2) u3_12z(i).c(1,2)=zqdr*(cauxc+ceps_1) u3_12z(i).c(2,1)=zqdl*(-cauxc+ceps_1) u3_12z(i).d(1,1)=zqdl*c12z(i).ek0 u3_12z(i).d(2,2)=zqdr*c12z(i).ek0 END DO *****attaccamento di c12z(2) a 4 (bbar) * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * T -- qu=p356,qd=p4,v=c12z(i).e,a=d4_12z(i).a,b=d4_12z(i).b,c=d4_12z(i).c, * d=d4_12z(i).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12z(i).e(2)*p4(3)-p4(2)*c12z(i).e(3))-p4k0*(c12z(i).e(2) & *p356(3)-p356(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p356k0+p356(3)*c12z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i).e(3)*p4k0+p4(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p356(0)-c12z(i).e(1)*p356(1)-c12z(i).e(2 & )*p356(2)-c12z(i).e(3)*p356(3) cvqd=c12z(i).e(0)*p4(0)-c12z(i).e(1)*p4(1)-c12z(i).e(2)*p4 & (2)-c12z(i).e(3)*p4(3) cauxa=-c12z(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12z(i).ek0*p4(2)+p4k0*c12z(i).e(2) cauxc=+c12z(i).ek0*p356(2)-p356k0*c12z(i).e(2) d4_12z(i).a(1,1)=zqdr*(cauxa+ceps_0) d4_12z(i).a(2,2)=zqdl*(cauxa-ceps_0) d4_12z(i).b(1,2)=zqdl*(cauxb-ceps_2) d4_12z(i).b(2,1)=zqdr*(-cauxb-ceps_2) d4_12z(i).c(1,2)=zqdr*(cauxc+ceps_1) d4_12z(i).c(2,1)=zqdl*(-cauxc+ceps_1) d4_12z(i).d(1,1)=zqdl*c12z(i).ek0 d4_12z(i).d(2,2)=zqdr*c12z(i).ek0 END DO *****attaccamento di c34z(2,2) a 1 (e+) * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p1,qd=p134,v=c34z(i1,i2).e,a=l1_34z(i1,i2).a,c=l1_34z(i1,i2).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34z(i1,i2).e(2)*p134(3)-p134(2)*c34z(i1,i2).e(3))-p134 & k0*(c34z(i1,i2).e(2)*p1(3)-p1(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1,i2).e(3)*p1k0+p1(3)*c34z(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1,i2).e(0)*p1(0)-c34z(i1,i2).e(1)*p1(1)-c34z(i1 & ,i2).e(2)*p1(2)-c34z(i1,i2).e(3)*p1(3) cvqd=c34z(i1,i2).e(0)*p134(0)-c34z(i1,i2).e(1)*p134(1)-c34 & z(i1,i2).e(2)*p134(2)-c34z(i1,i2).e(3)*p134(3) cauxa=-c34z(i1,i2).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34z(i1,i2).ek0*p1(2)-p1k0*c34z(i1,i2).e(2) l1_34z(i1,i2).a(1)=zer*(cauxa+ceps_0) l1_34z(i1,i2).a(2)=zel*(cauxa-ceps_0) l1_34z(i1,i2).c(1)=zer*(cauxc+ceps_1) l1_34z(i1,i2).c(2)=zel*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34z(2,2) a 2 (e-) * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p156,qd=p2,v=c34z(i1,i2).e,a=r2_34z(i1,i2).a,b=r2_34z(i1,i2).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34z(i1,i2).e(2)*p2(3)-p2(2)*c34z(i1,i2).e(3))-p2k0*( & c34z(i1,i2).e(2)*p156(3)-p156(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1,i2).e(3)*p2k0+p2(3)*c34z(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1,i2).e(0)*p156(0)-c34z(i1,i2).e(1)*p156(1)-c34 & z(i1,i2).e(2)*p156(2)-c34z(i1,i2).e(3)*p156(3) cvqd=c34z(i1,i2).e(0)*p2(0)-c34z(i1,i2).e(1)*p2(1)-c34z(i1 & ,i2).e(2)*p2(2)-c34z(i1,i2).e(3)*p2(3) cauxa=-c34z(i1,i2).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34z(i1,i2).ek0*p2(2)+p2k0*c34z(i1,i2).e(2) r2_34z(i1,i2).a(1)=zer*(cauxa+ceps_0) r2_34z(i1,i2).a(2)=zel*(cauxa-ceps_0) r2_34z(i1,i2).b(1)=zel*(cauxb-ceps_2) r2_34z(i1,i2).b(2)=zer*(-cauxb-ceps_2) END DO END DO *****attaccamento di c56z a 3 (b) * quqd -- p=p3,q=p356 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 * T -- qu=p3,qd=p356,v=c56z(i).e,a=u3_56z(i).a,b=u3_56z(i).b,c=u3_56z(i).c, * d=u3_56z(i).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c56z(i).ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c5 & 6z(i).e(2)*p356(3)-p356(2)*c56z(i).e(3))-p356k0*(c56z(i). & e(2)*p3(3)-p3(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p3k0+p3(3)*c56z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56z(i).e(3)*p356k0+p356(3)*c56z(i).ek0 ceps_2=ceps_2*cim cvqu=c56z(i).e(0)*p3(0)-c56z(i).e(1)*p3(1)-c56z(i).e(2)*p3 & (2)-c56z(i).e(3)*p3(3) cvqd=c56z(i).e(0)*p356(0)-c56z(i).e(1)*p356(1)-c56z(i).e(2 & )*p356(2)-c56z(i).e(3)*p356(3) cauxa=-c56z(i).ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxb=-c56z(i).ek0*p356(2)+p356k0*c56z(i).e(2) cauxc=+c56z(i).ek0*p3(2)-p3k0*c56z(i).e(2) u3_56z(i).a(1,1)=zqdr*(cauxa+ceps_0) u3_56z(i).a(2,2)=zqdl*(cauxa-ceps_0) u3_56z(i).b(1,2)=zqdl*(cauxb-ceps_2) u3_56z(i).b(2,1)=zqdr*(-cauxb-ceps_2) u3_56z(i).c(1,2)=zqdr*(cauxc+ceps_1) u3_56z(i).c(2,1)=zqdl*(-cauxc+ceps_1) u3_56z(i).d(1,1)=zqdl*c56z(i).ek0 u3_56z(i).d(2,2)=zqdr*c56z(i).ek0 END DO *****attaccamento di c56f a 3 (b) * quqd -- p=p3,q=p356 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 * T -- qu=p3,qd=p356,v=c56f(i).e,a=u3_56f(i).a,b=u3_56f(i).b,c=u3_56f(i).c, * d=u3_56f(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c56f(i).ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c5 & 6f(i).e(2)*p356(3)-p356(2)*c56f(i).e(3))-p356k0*(c56f(i). & e(2)*p3(3)-p3(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p3k0+p3(3)*c56f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56f(i).e(3)*p356k0+p356(3)*c56f(i).ek0 ceps_2=ceps_2*cim cvqu=c56f(i).e(0)*p3(0)-c56f(i).e(1)*p3(1)-c56f(i).e(2)*p3 & (2)-c56f(i).e(3)*p3(3) cvqd=c56f(i).e(0)*p356(0)-c56f(i).e(1)*p356(1)-c56f(i).e(2 & )*p356(2)-c56f(i).e(3)*p356(3) cauxa=-c56f(i).ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxb=-c56f(i).ek0*p356(2)+p356k0*c56f(i).e(2) cauxc=+c56f(i).ek0*p3(2)-p3k0*c56f(i).e(2) u3_56f(i).a(1,1)=fqdr*(cauxa+ceps_0) u3_56f(i).a(2,2)=fqdl*(cauxa-ceps_0) u3_56f(i).b(1,2)=fqdl*(cauxb-ceps_2) u3_56f(i).b(2,1)=fqdr*(-cauxb-ceps_2) u3_56f(i).c(1,2)=fqdr*(cauxc+ceps_1) u3_56f(i).c(2,1)=fqdl*(-cauxc+ceps_1) u3_56f(i).d(1,1)=fqdl*c56f(i).ek0 u3_56f(i).d(2,2)=fqdr*c56f(i).ek0 END DO *****attaccamento di c56z a 4 (bbar) * quqd -- p=p123,q=p4 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 * T -- qu=p123,qd=p4,v=c56z(i).e,a=d4_56z(i).a,b=d4_56z(i).b,c=d4_56z(i).c, * d=d4_56z(i).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c56z(i).ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*( & c56z(i).e(2)*p4(3)-p4(2)*c56z(i).e(3))-p4k0*(c56z(i).e(2) & *p123(3)-p123(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p123k0+p123(3)*c56z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56z(i).e(3)*p4k0+p4(3)*c56z(i).ek0 ceps_2=ceps_2*cim cvqu=c56z(i).e(0)*p123(0)-c56z(i).e(1)*p123(1)-c56z(i).e(2 & )*p123(2)-c56z(i).e(3)*p123(3) cvqd=c56z(i).e(0)*p4(0)-c56z(i).e(1)*p4(1)-c56z(i).e(2)*p4 & (2)-c56z(i).e(3)*p4(3) cauxa=-c56z(i).ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56z(i).ek0*p4(2)+p4k0*c56z(i).e(2) cauxc=+c56z(i).ek0*p123(2)-p123k0*c56z(i).e(2) d4_56z(i).a(1,1)=zqdr*(cauxa+ceps_0) d4_56z(i).a(2,2)=zqdl*(cauxa-ceps_0) d4_56z(i).b(1,2)=zqdl*(cauxb-ceps_2) d4_56z(i).b(2,1)=zqdr*(-cauxb-ceps_2) d4_56z(i).c(1,2)=zqdr*(cauxc+ceps_1) d4_56z(i).c(2,1)=zqdl*(-cauxc+ceps_1) d4_56z(i).d(1,1)=zqdl*c56z(i).ek0 d4_56z(i).d(2,2)=zqdr*c56z(i).ek0 END DO *****attaccamento di c56f a 4 (bbar) * quqd -- p=p123,q=p4 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 * T -- qu=p123,qd=p4,v=c56f(i).e,a=d4_56f(i).a,b=d4_56f(i).b,c=d4_56f(i).c, * d=d4_56f(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c56f(i).ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*( & c56f(i).e(2)*p4(3)-p4(2)*c56f(i).e(3))-p4k0*(c56f(i).e(2) & *p123(3)-p123(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p123k0+p123(3)*c56f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56f(i).e(3)*p4k0+p4(3)*c56f(i).ek0 ceps_2=ceps_2*cim cvqu=c56f(i).e(0)*p123(0)-c56f(i).e(1)*p123(1)-c56f(i).e(2 & )*p123(2)-c56f(i).e(3)*p123(3) cvqd=c56f(i).e(0)*p4(0)-c56f(i).e(1)*p4(1)-c56f(i).e(2)*p4 & (2)-c56f(i).e(3)*p4(3) cauxa=-c56f(i).ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56f(i).ek0*p4(2)+p4k0*c56f(i).e(2) cauxc=+c56f(i).ek0*p123(2)-p123k0*c56f(i).e(2) d4_56f(i).a(1,1)=fqdr*(cauxa+ceps_0) d4_56f(i).a(2,2)=fqdl*(cauxa-ceps_0) d4_56f(i).b(1,2)=fqdl*(cauxb-ceps_2) d4_56f(i).b(2,1)=fqdr*(-cauxb-ceps_2) d4_56f(i).c(1,2)=fqdr*(cauxc+ceps_1) d4_56f(i).c(2,1)=fqdl*(-cauxc+ceps_1) d4_56f(i).d(1,1)=fqdl*c56f(i).ek0 d4_56f(i).d(2,2)=fqdr*c56f(i).ek0 END DO *****attaccamento di c12z(2) a 5 (v) * quqd -- p=p5,q=p125 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p125,v=c12z(i).e,a=l5_12z(i).a,c=l5_12z(i).c,cr=zer,cl=ze * l,nsum=0 ceps_0=-c12z(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2z(i).e(2)*p125(3)-p125(2)*c12z(i).e(3))-p125k0*(c12z(i). & e(2)*p5(3)-p5(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p5k0+p5(3)*c12z(i).ek0 ceps_1=ceps_1*cim cvqu=c12z(i).e(0)*p5(0)-c12z(i).e(1)*p5(1)-c12z(i).e(2)*p5 & (2)-c12z(i).e(3)*p5(3) cvqd=c12z(i).e(0)*p125(0)-c12z(i).e(1)*p125(1)-c12z(i).e(2 & )*p125(2)-c12z(i).e(3)*p125(3) cauxa=-c12z(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12z(i).ek0*p5(2)-p5k0*c12z(i).e(2) l5_12z(i).a(1)=z5r*(cauxa+ceps_0) l5_12z(i).a(2)=z5l*(cauxa-ceps_0) l5_12z(i).c(1)=z5r*(cauxc+ceps_1) l5_12z(i).c(2)=z5l*(-cauxc+ceps_1) END DO *****attaccamento di c12f(2) a 5 (v) * quqd -- p=p5,q=p125 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p125,v=c12f(i).e,a=l5_12f(i).a,c=l5_12f(i).c,cr=fer,cl=fe * l,nsum=0 ceps_0=-c12f(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2f(i).e(2)*p125(3)-p125(2)*c12f(i).e(3))-p125k0*(c12f(i). & e(2)*p5(3)-p5(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p5k0+p5(3)*c12f(i).ek0 ceps_1=ceps_1*cim cvqu=c12f(i).e(0)*p5(0)-c12f(i).e(1)*p5(1)-c12f(i).e(2)*p5 & (2)-c12f(i).e(3)*p5(3) cvqd=c12f(i).e(0)*p125(0)-c12f(i).e(1)*p125(1)-c12f(i).e(2 & )*p125(2)-c12f(i).e(3)*p125(3) cauxa=-c12f(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12f(i).ek0*p5(2)-p5k0*c12f(i).e(2) l5_12f(i).a(1)=f5r*(cauxa+ceps_0) l5_12f(i).a(2)=f5l*(cauxa-ceps_0) l5_12f(i).c(1)=f5r*(cauxc+ceps_1) l5_12f(i).c(2)=f5l*(-cauxc+ceps_1) END DO *****attaccamento di c34z(2,2) a 5 (v) * quqd -- p=p5,q=p345 quqd=p5(0)*p345(0)-p5(1)*p345(1)-p5(2)*p345(2)-p5(3)*p345( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p5,qd=p345,v=c34z(i1,i2).e,a=l5_34z(i1,i2).a,c=l5_34z(i1,i2).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0 & *(c34z(i1,i2).e(2)*p345(3)-p345(2)*c34z(i1,i2).e(3))-p345 & k0*(c34z(i1,i2).e(2)*p5(3)-p5(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1,i2).e(3)*p5k0+p5(3)*c34z(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1,i2).e(0)*p5(0)-c34z(i1,i2).e(1)*p5(1)-c34z(i1 & ,i2).e(2)*p5(2)-c34z(i1,i2).e(3)*p5(3) cvqd=c34z(i1,i2).e(0)*p345(0)-c34z(i1,i2).e(1)*p345(1)-c34 & z(i1,i2).e(2)*p345(2)-c34z(i1,i2).e(3)*p345(3) cauxa=-c34z(i1,i2).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34z(i1,i2).ek0*p5(2)-p5k0*c34z(i1,i2).e(2) l5_34z(i1,i2).a(1)=z5r*(cauxa+ceps_0) l5_34z(i1,i2).a(2)=z5l*(cauxa-ceps_0) l5_34z(i1,i2).c(1)=z5r*(cauxc+ceps_1) l5_34z(i1,i2).c(2)=z5l*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34f(2,2) a 5 (v) * quqd -- p=p5,q=p345 quqd=p5(0)*p345(0)-p5(1)*p345(1)-p5(2)*p345(2)-p5(3)*p345( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p5,qd=p345,v=c34f(i1,i2).e,a=l5_34f(i1,i2).a,c=l5_34f(i1,i2).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0 & *(c34f(i1,i2).e(2)*p345(3)-p345(2)*c34f(i1,i2).e(3))-p345 & k0*(c34f(i1,i2).e(2)*p5(3)-p5(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i1,i2).e(3)*p5k0+p5(3)*c34f(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34f(i1,i2).e(0)*p5(0)-c34f(i1,i2).e(1)*p5(1)-c34f(i1 & ,i2).e(2)*p5(2)-c34f(i1,i2).e(3)*p5(3) cvqd=c34f(i1,i2).e(0)*p345(0)-c34f(i1,i2).e(1)*p345(1)-c34 & f(i1,i2).e(2)*p345(2)-c34f(i1,i2).e(3)*p345(3) cauxa=-c34f(i1,i2).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34f(i1,i2).ek0*p5(2)-p5k0*c34f(i1,i2).e(2) l5_34f(i1,i2).a(1)=f5r*(cauxa+ceps_0) l5_34f(i1,i2).a(2)=f5l*(cauxa-ceps_0) l5_34f(i1,i2).c(1)=f5r*(cauxc+ceps_1) l5_34f(i1,i2).c(2)=f5l*(-cauxc+ceps_1) END DO END DO *****attaccamento di c56z a 1 (e+) * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i=1,2 * TL0 -- qu=p1,qd=p156,v=c56z(i).e,a=l1_56z(i).a,c=l1_56z(i).c,cr=zer,cl=ze * l,nsum=0 ceps_0=-c56z(i).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c5 & 6z(i).e(2)*p156(3)-p156(2)*c56z(i).e(3))-p156k0*(c56z(i). & e(2)*p1(3)-p1(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p1k0+p1(3)*c56z(i).ek0 ceps_1=ceps_1*cim cvqu=c56z(i).e(0)*p1(0)-c56z(i).e(1)*p1(1)-c56z(i).e(2)*p1 & (2)-c56z(i).e(3)*p1(3) cvqd=c56z(i).e(0)*p156(0)-c56z(i).e(1)*p156(1)-c56z(i).e(2 & )*p156(2)-c56z(i).e(3)*p156(3) cauxa=-c56z(i).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56z(i).ek0*p1(2)-p1k0*c56z(i).e(2) l1_56z(i).a(1)=zer*(cauxa+ceps_0) l1_56z(i).a(2)=zel*(cauxa-ceps_0) l1_56z(i).c(1)=zer*(cauxc+ceps_1) l1_56z(i).c(2)=zel*(-cauxc+ceps_1) END DO *****attaccamento di c56f a 1 (e+) * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i=1,2 * TL0 -- qu=p1,qd=p156,v=c56f(i).e,a=l1_56f(i).a,c=l1_56f(i).c,cr=fer,cl=fe * l,nsum=0 ceps_0=-c56f(i).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c5 & 6f(i).e(2)*p156(3)-p156(2)*c56f(i).e(3))-p156k0*(c56f(i). & e(2)*p1(3)-p1(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p1k0+p1(3)*c56f(i).ek0 ceps_1=ceps_1*cim cvqu=c56f(i).e(0)*p1(0)-c56f(i).e(1)*p1(1)-c56f(i).e(2)*p1 & (2)-c56f(i).e(3)*p1(3) cvqd=c56f(i).e(0)*p156(0)-c56f(i).e(1)*p156(1)-c56f(i).e(2 & )*p156(2)-c56f(i).e(3)*p156(3) cauxa=-c56f(i).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56f(i).ek0*p1(2)-p1k0*c56f(i).e(2) l1_56f(i).a(1)=fer*(cauxa+ceps_0) l1_56f(i).a(2)=fel*(cauxa-ceps_0) l1_56f(i).c(1)=fer*(cauxc+ceps_1) l1_56f(i).c(2)=fel*(-cauxc+ceps_1) END DO *****attaccamento di c12z(2) a 6 (vbar) * quqd -- p=p345,q=p6 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p345,qd=p6,v=c12z(i).e,a=r6_12z(i).a,b=r6_12z(i).b,cr=zer,cl=ze * l,nsum=0 ceps_0=-c12z(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12z(i).e(2)*p6(3)-p6(2)*c12z(i).e(3))-p6k0*(c12z(i).e(2) & *p345(3)-p345(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12z(i).e(3)*p6k0+p6(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p345(0)-c12z(i).e(1)*p345(1)-c12z(i).e(2 & )*p345(2)-c12z(i).e(3)*p345(3) cvqd=c12z(i).e(0)*p6(0)-c12z(i).e(1)*p6(1)-c12z(i).e(2)*p6 & (2)-c12z(i).e(3)*p6(3) cauxa=-c12z(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12z(i).ek0*p6(2)+p6k0*c12z(i).e(2) r6_12z(i).a(1)=z6r*(cauxa+ceps_0) r6_12z(i).a(2)=z6l*(cauxa-ceps_0) r6_12z(i).b(1)=z6l*(cauxb-ceps_2) r6_12z(i).b(2)=z6r*(-cauxb-ceps_2) END DO *****attaccamento di c12f(2) a 6 (vbar) * quqd -- p=p345,q=p6 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p345,qd=p6,v=c12f(i).e,a=r6_12f(i).a,b=r6_12f(i).b,cr=fer,cl=fe * l,nsum=0 ceps_0=-c12f(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12f(i).e(2)*p6(3)-p6(2)*c12f(i).e(3))-p6k0*(c12f(i).e(2) & *p345(3)-p345(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12f(i).e(3)*p6k0+p6(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p345(0)-c12f(i).e(1)*p345(1)-c12f(i).e(2 & )*p345(2)-c12f(i).e(3)*p345(3) cvqd=c12f(i).e(0)*p6(0)-c12f(i).e(1)*p6(1)-c12f(i).e(2)*p6 & (2)-c12f(i).e(3)*p6(3) cauxa=-c12f(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12f(i).ek0*p6(2)+p6k0*c12f(i).e(2) r6_12f(i).a(1)=f6r*(cauxa+ceps_0) r6_12f(i).a(2)=f6l*(cauxa-ceps_0) r6_12f(i).b(1)=f6l*(cauxb-ceps_2) r6_12f(i).b(2)=f6r*(-cauxb-ceps_2) END DO *****attaccamento di c34z(2,2) a 6 (vbar) * quqd -- p=p125,q=p6 quqd=p125(0)*p6(0)-p125(1)*p6(1)-p125(2)*p6(2)-p125(3)*p6( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p125,qd=p6,v=c34z(i1,i2).e,a=r6_34z(i1,i2).a,b=r6_34z(i1,i2).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i1,i2).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125 & k0*(c34z(i1,i2).e(2)*p6(3)-p6(2)*c34z(i1,i2).e(3))-p6k0*( & c34z(i1,i2).e(2)*p125(3)-p125(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1,i2).e(3)*p6k0+p6(3)*c34z(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1,i2).e(0)*p125(0)-c34z(i1,i2).e(1)*p125(1)-c34 & z(i1,i2).e(2)*p125(2)-c34z(i1,i2).e(3)*p125(3) cvqd=c34z(i1,i2).e(0)*p6(0)-c34z(i1,i2).e(1)*p6(1)-c34z(i1 & ,i2).e(2)*p6(2)-c34z(i1,i2).e(3)*p6(3) cauxa=-c34z(i1,i2).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34z(i1,i2).ek0*p6(2)+p6k0*c34z(i1,i2).e(2) r6_34z(i1,i2).a(1)=z6r*(cauxa+ceps_0) r6_34z(i1,i2).a(2)=z6l*(cauxa-ceps_0) r6_34z(i1,i2).b(1)=z6l*(cauxb-ceps_2) r6_34z(i1,i2).b(2)=z6r*(-cauxb-ceps_2) END DO END DO *****attaccamento di c34f(2,2) a 6 (vbar) * quqd -- p=p125,q=p6 quqd=p125(0)*p6(0)-p125(1)*p6(1)-p125(2)*p6(2)-p125(3)*p6( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p125,qd=p6,v=c34f(i1,i2).e,a=r6_34f(i1,i2).a,b=r6_34f(i1,i2).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125 & k0*(c34f(i1,i2).e(2)*p6(3)-p6(2)*c34f(i1,i2).e(3))-p6k0*( & c34f(i1,i2).e(2)*p125(3)-p125(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i1,i2).e(3)*p6k0+p6(3)*c34f(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34f(i1,i2).e(0)*p125(0)-c34f(i1,i2).e(1)*p125(1)-c34 & f(i1,i2).e(2)*p125(2)-c34f(i1,i2).e(3)*p125(3) cvqd=c34f(i1,i2).e(0)*p6(0)-c34f(i1,i2).e(1)*p6(1)-c34f(i1 & ,i2).e(2)*p6(2)-c34f(i1,i2).e(3)*p6(3) cauxa=-c34f(i1,i2).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34f(i1,i2).ek0*p6(2)+p6k0*c34f(i1,i2).e(2) r6_34f(i1,i2).a(1)=f6r*(cauxa+ceps_0) r6_34f(i1,i2).a(2)=f6l*(cauxa-ceps_0) r6_34f(i1,i2).b(1)=f6l*(cauxb-ceps_2) r6_34f(i1,i2).b(2)=f6r*(-cauxb-ceps_2) END DO END DO *****attaccamento di c56z a 2 (e-) * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i=1,2 * TR0 -- qu=p134,qd=p2,v=c56z(i).e,a=r2_56z(i).a,b=r2_56z(i).b,cr=zer,cl=ze * l,nsum=0 ceps_0=-c56z(i).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0*( & c56z(i).e(2)*p2(3)-p2(2)*c56z(i).e(3))-p2k0*(c56z(i).e(2) & *p134(3)-p134(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c56z(i).e(3)*p2k0+p2(3)*c56z(i).ek0 ceps_2=ceps_2*cim cvqu=c56z(i).e(0)*p134(0)-c56z(i).e(1)*p134(1)-c56z(i).e(2 & )*p134(2)-c56z(i).e(3)*p134(3) cvqd=c56z(i).e(0)*p2(0)-c56z(i).e(1)*p2(1)-c56z(i).e(2)*p2 & (2)-c56z(i).e(3)*p2(3) cauxa=-c56z(i).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56z(i).ek0*p2(2)+p2k0*c56z(i).e(2) r2_56z(i).a(1)=zer*(cauxa+ceps_0) r2_56z(i).a(2)=zel*(cauxa-ceps_0) r2_56z(i).b(1)=zel*(cauxb-ceps_2) r2_56z(i).b(2)=zer*(-cauxb-ceps_2) END DO *****attaccamento di c56f a 2 (e-) * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i=1,2 * TR0 -- qu=p134,qd=p2,v=c56f(i).e,a=r2_56f(i).a,b=r2_56f(i).b,cr=fer,cl=fe * l,nsum=0 ceps_0=-c56f(i).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0*( & c56f(i).e(2)*p2(3)-p2(2)*c56f(i).e(3))-p2k0*(c56f(i).e(2) & *p134(3)-p134(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c56f(i).e(3)*p2k0+p2(3)*c56f(i).ek0 ceps_2=ceps_2*cim cvqu=c56f(i).e(0)*p134(0)-c56f(i).e(1)*p134(1)-c56f(i).e(2 & )*p134(2)-c56f(i).e(3)*p134(3) cvqd=c56f(i).e(0)*p2(0)-c56f(i).e(1)*p2(1)-c56f(i).e(2)*p2 & (2)-c56f(i).e(3)*p2(3) cauxa=-c56f(i).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56f(i).ek0*p2(2)+p2k0*c56f(i).e(2) r2_56f(i).a(1)=fer*(cauxa+ceps_0) r2_56f(i).a(2)=fel*(cauxa-ceps_0) r2_56f(i).b(1)=fel*(cauxb-ceps_2) r2_56f(i).b(2)=fer*(-cauxb-ceps_2) END DO **** Diagramma 4 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres4(i3,&,i1,i2),a1=l1_56f(i3).a,c1=l1_56f(i3).c,a2=r2_34f(i * 1,i2).a,b2=r2_34f(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres4(i3,1,i1,i2)=( l1_56f(i3).a(1)*r2_34f(i1,i2).a(1)+l1_ & 56f(i3).c(1)*p156q*r2_34f(i1,i2).b(2) )/(p156q*p156k0) cres4(i3,2,i1,i2)=( l1_56f(i3).c(2)*p156q*r2_34f(i1,i2).b( & 1)+l1_56f(i3).a(2)*r2_34f(i1,i2).a(2) )/(p156q*p156k0) END DO END DO END DO **** Diagramma 9 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres9(i3,&,i1,i2),a1=l1_34f(i1,i2).a,c1=l1_34f(i1,i2).c,a2=r2 * _56f(i3).a,b2=r2_56f(i3).b,prq=p134q,den=(p134q*p134k0),nsum=0 cres9(i3,1,i1,i2)=( l1_34f(i1,i2).a(1)*r2_56f(i3).a(1)+l1_ & 34f(i1,i2).c(1)*p134q*r2_56f(i3).b(2) )/(p134q*p134k0) cres9(i3,2,i1,i2)=( l1_34f(i1,i2).c(2)*p134q*r2_56f(i3).b( & 1)+l1_34f(i1,i2).a(2)*r2_56f(i3).a(2) )/(p134q*p134k0) END DO END DO END DO **** Diagramma 14 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia14(i3,i).a,bb=dia14(i3,i).b,cc=dia14(i3,i).c,dd=dia14(i3,i).d * ,a1=u3_56f(i3).a,b1=u3_56f(i3).b,c1=u3_56f(i3).c,d1=u3_56f(i3).d,a2=d4_12f * (i).a,b2=d4_12f(i).b,c2=d4_12f(i).c,d2=d4_12f(i).d,prq=p356q,m=rmb dia14(i3,i).a(1,1)=u3_56f(i3).a(1,1)*d4_12f(i).a(1,1)+u3_5 & 6f(i3).c(1,2)*p356q*d4_12f(i).b(2,1) dia14(i3,i).b(1,1)=rmb*(u3_56f(i3).d(1,1)*d4_12f(i).a(1,1) & +u3_56f(i3).b(1,2)*d4_12f(i).b(2,1)) dia14(i3,i).c(1,1)=rmb*(u3_56f(i3).a(1,1)*d4_12f(i).d(1,1) & +u3_56f(i3).c(1,2)*d4_12f(i).c(2,1)) dia14(i3,i).d(1,1)=u3_56f(i3).d(1,1)*p356q*d4_12f(i).d(1,1 & )+u3_56f(i3).b(1,2)*d4_12f(i).c(2,1) dia14(i3,i).a(1,2)=rmb*(u3_56f(i3).a(1,1)*d4_12f(i).b(1,2) & +u3_56f(i3).c(1,2)*d4_12f(i).a(2,2)) dia14(i3,i).b(1,2)=u3_56f(i3).d(1,1)*p356q*d4_12f(i).b(1,2 & )+u3_56f(i3).b(1,2)*d4_12f(i).a(2,2) dia14(i3,i).c(1,2)=u3_56f(i3).a(1,1)*d4_12f(i).c(1,2)+u3_5 & 6f(i3).c(1,2)*p356q*d4_12f(i).d(2,2) dia14(i3,i).d(1,2)=rmb*(u3_56f(i3).d(1,1)*d4_12f(i).c(1,2) & +u3_56f(i3).b(1,2)*d4_12f(i).d(2,2)) dia14(i3,i).a(2,1)=rmb*(u3_56f(i3).c(2,1)*d4_12f(i).a(1,1) & +u3_56f(i3).a(2,2)*d4_12f(i).b(2,1)) dia14(i3,i).b(2,1)=u3_56f(i3).b(2,1)*d4_12f(i).a(1,1)+u3_5 & 6f(i3).d(2,2)*p356q*d4_12f(i).b(2,1) dia14(i3,i).c(2,1)=u3_56f(i3).c(2,1)*p356q*d4_12f(i).d(1,1 & )+u3_56f(i3).a(2,2)*d4_12f(i).c(2,1) dia14(i3,i).d(2,1)=rmb*(u3_56f(i3).b(2,1)*d4_12f(i).d(1,1) & +u3_56f(i3).d(2,2)*d4_12f(i).c(2,1)) dia14(i3,i).a(2,2)=u3_56f(i3).c(2,1)*p356q*d4_12f(i).b(1,2 & )+u3_56f(i3).a(2,2)*d4_12f(i).a(2,2) dia14(i3,i).b(2,2)=rmb*(u3_56f(i3).b(2,1)*d4_12f(i).b(1,2) & +u3_56f(i3).d(2,2)*d4_12f(i).a(2,2)) dia14(i3,i).c(2,2)=rmb*(u3_56f(i3).c(2,1)*d4_12f(i).c(1,2) & +u3_56f(i3).a(2,2)*d4_12f(i).d(2,2)) dia14(i3,i).d(2,2)=u3_56f(i3).b(2,1)*d4_12f(i).c(1,2)+u3_5 & 6f(i3).d(2,2)*p356q*d4_12f(i).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres14(i3,i,&),abcd=dia14(i3,i).,m1=rmb,m2=(-rmb),den=((p356 * q-rmb2)*p356k0) DO iut=1,2 DO jut=1,2 cres14(i3,i,iut,jut)=(dia14(i3,i).a(iut,jut) & +rmb*dia14(i3, & i).b(iut,jut)+(-rmb)*dia14(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a14(i3,i).d(iut,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO END DO **** Diagramma 16 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia16(i3,i).a,bb=dia16(i3,i).b,cc=dia16(i3,i).c,dd=dia16(i3,i).d * ,a1=u3_12f(i).a,b1=u3_12f(i).b,c1=u3_12f(i).c,d1=u3_12f(i).d,a2=d4_56f(i3) * .a,b2=d4_56f(i3).b,c2=d4_56f(i3).c,d2=d4_56f(i3).d,prq=p123q,m=rmb dia16(i3,i).a(1,1)=u3_12f(i).a(1,1)*d4_56f(i3).a(1,1)+u3_1 & 2f(i).c(1,2)*p123q*d4_56f(i3).b(2,1) dia16(i3,i).b(1,1)=rmb*(u3_12f(i).d(1,1)*d4_56f(i3).a(1,1) & +u3_12f(i).b(1,2)*d4_56f(i3).b(2,1)) dia16(i3,i).c(1,1)=rmb*(u3_12f(i).a(1,1)*d4_56f(i3).d(1,1) & +u3_12f(i).c(1,2)*d4_56f(i3).c(2,1)) dia16(i3,i).d(1,1)=u3_12f(i).d(1,1)*p123q*d4_56f(i3).d(1,1 & )+u3_12f(i).b(1,2)*d4_56f(i3).c(2,1) dia16(i3,i).a(1,2)=rmb*(u3_12f(i).a(1,1)*d4_56f(i3).b(1,2) & +u3_12f(i).c(1,2)*d4_56f(i3).a(2,2)) dia16(i3,i).b(1,2)=u3_12f(i).d(1,1)*p123q*d4_56f(i3).b(1,2 & )+u3_12f(i).b(1,2)*d4_56f(i3).a(2,2) dia16(i3,i).c(1,2)=u3_12f(i).a(1,1)*d4_56f(i3).c(1,2)+u3_1 & 2f(i).c(1,2)*p123q*d4_56f(i3).d(2,2) dia16(i3,i).d(1,2)=rmb*(u3_12f(i).d(1,1)*d4_56f(i3).c(1,2) & +u3_12f(i).b(1,2)*d4_56f(i3).d(2,2)) dia16(i3,i).a(2,1)=rmb*(u3_12f(i).c(2,1)*d4_56f(i3).a(1,1) & +u3_12f(i).a(2,2)*d4_56f(i3).b(2,1)) dia16(i3,i).b(2,1)=u3_12f(i).b(2,1)*d4_56f(i3).a(1,1)+u3_1 & 2f(i).d(2,2)*p123q*d4_56f(i3).b(2,1) dia16(i3,i).c(2,1)=u3_12f(i).c(2,1)*p123q*d4_56f(i3).d(1,1 & )+u3_12f(i).a(2,2)*d4_56f(i3).c(2,1) dia16(i3,i).d(2,1)=rmb*(u3_12f(i).b(2,1)*d4_56f(i3).d(1,1) & +u3_12f(i).d(2,2)*d4_56f(i3).c(2,1)) dia16(i3,i).a(2,2)=u3_12f(i).c(2,1)*p123q*d4_56f(i3).b(1,2 & )+u3_12f(i).a(2,2)*d4_56f(i3).a(2,2) dia16(i3,i).b(2,2)=rmb*(u3_12f(i).b(2,1)*d4_56f(i3).b(1,2) & +u3_12f(i).d(2,2)*d4_56f(i3).a(2,2)) dia16(i3,i).c(2,2)=rmb*(u3_12f(i).c(2,1)*d4_56f(i3).c(1,2) & +u3_12f(i).a(2,2)*d4_56f(i3).d(2,2)) dia16(i3,i).d(2,2)=u3_12f(i).b(2,1)*d4_56f(i3).c(1,2)+u3_1 & 2f(i).d(2,2)*p123q*d4_56f(i3).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres16(i3,i,&),abcd=dia16(i3,i).,m1=rmb,m2=(-rmb),den=((p123 * q-rmb2)*p123k0) DO iut=1,2 DO jut=1,2 cres16(i3,i,iut,jut)=(dia16(i3,i).a(iut,jut) & +rmb*dia16(i3, & i).b(iut,jut)+(-rmb)*dia16(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a16(i3,i).d(iut,jut))/((p123q-rmb2)*p123k0) ENDDO ENDDO END DO END DO **** Diagramma 20 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres20(&,i1,i2,i3),a1=l5_12f(i1).a,c1=l5_12f(i1).c,a2=r6_34f( * i2,i3).a,b2=r6_34f(i2,i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cres20(1,i1,i2,i3)=( l5_12f(i1).a(1)*r6_34f(i2,i3).a(1)+l5 & _12f(i1).c(1)*p125q*r6_34f(i2,i3).b(2) )/(p125q*p125k0) cres20(2,i1,i2,i3)=( l5_12f(i1).c(2)*p125q*r6_34f(i2,i3).b & (1)+l5_12f(i1).a(2)*r6_34f(i2,i3).a(2) )/(p125q*p125k0) END DO END DO END DO **** Diagramma 33 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres33(&,i1,i2,i3),a1=l5_34f(i2,i3).a,c1=l5_34f(i2,i3).c,a2=r * 6_12f(i1).a,b2=r6_12f(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cres33(1,i1,i2,i3)=( l5_34f(i2,i3).a(1)*r6_12f(i1).a(1)+l5 & _34f(i2,i3).c(1)*p345q*r6_12f(i1).b(2) )/(p345q*p345k0) cres33(2,i1,i2,i3)=( l5_34f(i2,i3).c(2)*p345q*r6_12f(i1).b & (1)+l5_34f(i2,i3).a(2)*r6_12f(i1).a(2) )/(p345q*p345k0) END DO END DO END DO **** Diagramma 5 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres5(i3,&,i1,i2),a1=l1_56z(i3).a,c1=l1_56z(i3).c,a2=r2_34f(i * 1,i2).a,b2=r2_34f(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres5(i3,1,i1,i2)=( l1_56z(i3).a(1)*r2_34f(i1,i2).a(1)+l1_ & 56z(i3).c(1)*p156q*r2_34f(i1,i2).b(2) )/(p156q*p156k0) cres5(i3,2,i1,i2)=( l1_56z(i3).c(2)*p156q*r2_34f(i1,i2).b( & 1)+l1_56z(i3).a(2)*r2_34f(i1,i2).a(2) )/(p156q*p156k0) END DO END DO END DO **** Diagramma 10 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres10(i3,&,i1,i2),a1=l1_34z(i1,i2).a,c1=l1_34z(i1,i2).c,a2=r * 2_56f(i3).a,b2=r2_56f(i3).b,prq=p134q,den=(p134q*p134k0),nsum=0 cres10(i3,1,i1,i2)=( l1_34z(i1,i2).a(1)*r2_56f(i3).a(1)+l1 & _34z(i1,i2).c(1)*p134q*r2_56f(i3).b(2) )/(p134q*p134k0) cres10(i3,2,i1,i2)=( l1_34z(i1,i2).c(2)*p134q*r2_56f(i3).b & (1)+l1_34z(i1,i2).a(2)*r2_56f(i3).a(2) )/(p134q*p134k0) END DO END DO END DO **** Diagramma 15 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia15(i3,i).a,bb=dia15(i3,i).b,cc=dia15(i3,i).c,dd=dia15(i3,i).d * ,a1=u3_56z(i3).a,b1=u3_56z(i3).b,c1=u3_56z(i3).c,d1=u3_56z(i3).d,a2=d4_12f * (i).a,b2=d4_12f(i).b,c2=d4_12f(i).c,d2=d4_12f(i).d,prq=p356q,m=rmb dia15(i3,i).a(1,1)=u3_56z(i3).a(1,1)*d4_12f(i).a(1,1)+u3_5 & 6z(i3).c(1,2)*p356q*d4_12f(i).b(2,1) dia15(i3,i).b(1,1)=rmb*(u3_56z(i3).d(1,1)*d4_12f(i).a(1,1) & +u3_56z(i3).b(1,2)*d4_12f(i).b(2,1)) dia15(i3,i).c(1,1)=rmb*(u3_56z(i3).a(1,1)*d4_12f(i).d(1,1) & +u3_56z(i3).c(1,2)*d4_12f(i).c(2,1)) dia15(i3,i).d(1,1)=u3_56z(i3).d(1,1)*p356q*d4_12f(i).d(1,1 & )+u3_56z(i3).b(1,2)*d4_12f(i).c(2,1) dia15(i3,i).a(1,2)=rmb*(u3_56z(i3).a(1,1)*d4_12f(i).b(1,2) & +u3_56z(i3).c(1,2)*d4_12f(i).a(2,2)) dia15(i3,i).b(1,2)=u3_56z(i3).d(1,1)*p356q*d4_12f(i).b(1,2 & )+u3_56z(i3).b(1,2)*d4_12f(i).a(2,2) dia15(i3,i).c(1,2)=u3_56z(i3).a(1,1)*d4_12f(i).c(1,2)+u3_5 & 6z(i3).c(1,2)*p356q*d4_12f(i).d(2,2) dia15(i3,i).d(1,2)=rmb*(u3_56z(i3).d(1,1)*d4_12f(i).c(1,2) & +u3_56z(i3).b(1,2)*d4_12f(i).d(2,2)) dia15(i3,i).a(2,1)=rmb*(u3_56z(i3).c(2,1)*d4_12f(i).a(1,1) & +u3_56z(i3).a(2,2)*d4_12f(i).b(2,1)) dia15(i3,i).b(2,1)=u3_56z(i3).b(2,1)*d4_12f(i).a(1,1)+u3_5 & 6z(i3).d(2,2)*p356q*d4_12f(i).b(2,1) dia15(i3,i).c(2,1)=u3_56z(i3).c(2,1)*p356q*d4_12f(i).d(1,1 & )+u3_56z(i3).a(2,2)*d4_12f(i).c(2,1) dia15(i3,i).d(2,1)=rmb*(u3_56z(i3).b(2,1)*d4_12f(i).d(1,1) & +u3_56z(i3).d(2,2)*d4_12f(i).c(2,1)) dia15(i3,i).a(2,2)=u3_56z(i3).c(2,1)*p356q*d4_12f(i).b(1,2 & )+u3_56z(i3).a(2,2)*d4_12f(i).a(2,2) dia15(i3,i).b(2,2)=rmb*(u3_56z(i3).b(2,1)*d4_12f(i).b(1,2) & +u3_56z(i3).d(2,2)*d4_12f(i).a(2,2)) dia15(i3,i).c(2,2)=rmb*(u3_56z(i3).c(2,1)*d4_12f(i).c(1,2) & +u3_56z(i3).a(2,2)*d4_12f(i).d(2,2)) dia15(i3,i).d(2,2)=u3_56z(i3).b(2,1)*d4_12f(i).c(1,2)+u3_5 & 6z(i3).d(2,2)*p356q*d4_12f(i).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres15(i3,i,&),abcd=dia15(i3,i).,m1=rmb,m2=(-rmb),den=((p356 * q-rmb2)*p356k0) DO iut=1,2 DO jut=1,2 cres15(i3,i,iut,jut)=(dia15(i3,i).a(iut,jut) & +rmb*dia15(i3, & i).b(iut,jut)+(-rmb)*dia15(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a15(i3,i).d(iut,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO END DO **** Diagramma 17 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia17(i3,i).a,bb=dia17(i3,i).b,cc=dia17(i3,i).c,dd=dia17(i3,i).d * ,a1=u3_12z(i).a,b1=u3_12z(i).b,c1=u3_12z(i).c,d1=u3_12z(i).d,a2=d4_56f(i3) * .a,b2=d4_56f(i3).b,c2=d4_56f(i3).c,d2=d4_56f(i3).d,prq=p123q,m=rmb dia17(i3,i).a(1,1)=u3_12z(i).a(1,1)*d4_56f(i3).a(1,1)+u3_1 & 2z(i).c(1,2)*p123q*d4_56f(i3).b(2,1) dia17(i3,i).b(1,1)=rmb*(u3_12z(i).d(1,1)*d4_56f(i3).a(1,1) & +u3_12z(i).b(1,2)*d4_56f(i3).b(2,1)) dia17(i3,i).c(1,1)=rmb*(u3_12z(i).a(1,1)*d4_56f(i3).d(1,1) & +u3_12z(i).c(1,2)*d4_56f(i3).c(2,1)) dia17(i3,i).d(1,1)=u3_12z(i).d(1,1)*p123q*d4_56f(i3).d(1,1 & )+u3_12z(i).b(1,2)*d4_56f(i3).c(2,1) dia17(i3,i).a(1,2)=rmb*(u3_12z(i).a(1,1)*d4_56f(i3).b(1,2) & +u3_12z(i).c(1,2)*d4_56f(i3).a(2,2)) dia17(i3,i).b(1,2)=u3_12z(i).d(1,1)*p123q*d4_56f(i3).b(1,2 & )+u3_12z(i).b(1,2)*d4_56f(i3).a(2,2) dia17(i3,i).c(1,2)=u3_12z(i).a(1,1)*d4_56f(i3).c(1,2)+u3_1 & 2z(i).c(1,2)*p123q*d4_56f(i3).d(2,2) dia17(i3,i).d(1,2)=rmb*(u3_12z(i).d(1,1)*d4_56f(i3).c(1,2) & +u3_12z(i).b(1,2)*d4_56f(i3).d(2,2)) dia17(i3,i).a(2,1)=rmb*(u3_12z(i).c(2,1)*d4_56f(i3).a(1,1) & +u3_12z(i).a(2,2)*d4_56f(i3).b(2,1)) dia17(i3,i).b(2,1)=u3_12z(i).b(2,1)*d4_56f(i3).a(1,1)+u3_1 & 2z(i).d(2,2)*p123q*d4_56f(i3).b(2,1) dia17(i3,i).c(2,1)=u3_12z(i).c(2,1)*p123q*d4_56f(i3).d(1,1 & )+u3_12z(i).a(2,2)*d4_56f(i3).c(2,1) dia17(i3,i).d(2,1)=rmb*(u3_12z(i).b(2,1)*d4_56f(i3).d(1,1) & +u3_12z(i).d(2,2)*d4_56f(i3).c(2,1)) dia17(i3,i).a(2,2)=u3_12z(i).c(2,1)*p123q*d4_56f(i3).b(1,2 & )+u3_12z(i).a(2,2)*d4_56f(i3).a(2,2) dia17(i3,i).b(2,2)=rmb*(u3_12z(i).b(2,1)*d4_56f(i3).b(1,2) & +u3_12z(i).d(2,2)*d4_56f(i3).a(2,2)) dia17(i3,i).c(2,2)=rmb*(u3_12z(i).c(2,1)*d4_56f(i3).c(1,2) & +u3_12z(i).a(2,2)*d4_56f(i3).d(2,2)) dia17(i3,i).d(2,2)=u3_12z(i).b(2,1)*d4_56f(i3).c(1,2)+u3_1 & 2z(i).d(2,2)*p123q*d4_56f(i3).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres17(i3,i,&),abcd=dia17(i3,i).,m1=rmb,m2=(-rmb),den=((p123 * q-rmb2)*p123k0) DO iut=1,2 DO jut=1,2 cres17(i3,i,iut,jut)=(dia17(i3,i).a(iut,jut) & +rmb*dia17(i3, & i).b(iut,jut)+(-rmb)*dia17(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a17(i3,i).d(iut,jut))/((p123q-rmb2)*p123k0) ENDDO ENDDO END DO END DO **** Diagramma 30 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres30(&,i1,i2,i3),a1=l5_12z(i1).a,c1=l5_12z(i1).c,a2=r6_34f( * i2,i3).a,b2=r6_34f(i2,i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cres30(1,i1,i2,i3)=( l5_12z(i1).a(1)*r6_34f(i2,i3).a(1)+l5 & _12z(i1).c(1)*p125q*r6_34f(i2,i3).b(2) )/(p125q*p125k0) cres30(2,i1,i2,i3)=( l5_12z(i1).c(2)*p125q*r6_34f(i2,i3).b & (1)+l5_12z(i1).a(2)*r6_34f(i2,i3).a(2) )/(p125q*p125k0) END DO END DO END DO **** Diagramma 34 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres34(&,i1,i2,i3),a1=l5_34z(i2,i3).a,c1=l5_34z(i2,i3).c,a2=r * 6_12f(i1).a,b2=r6_12f(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cres34(1,i1,i2,i3)=( l5_34z(i2,i3).a(1)*r6_12f(i1).a(1)+l5 & _34z(i2,i3).c(1)*p345q*r6_12f(i1).b(2) )/(p345q*p345k0) cres34(2,i1,i2,i3)=( l5_34z(i2,i3).c(2)*p345q*r6_12f(i1).b & (1)+l5_34z(i2,i3).a(2)*r6_12f(i1).a(2) )/(p345q*p345k0) END DO END DO END DO **** Diagramma 22 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres22(i3,&,i1,i2),a1=l1_56z(i3).a,c1=l1_56z(i3).c,a2=r2_34z( * i1,i2).a,b2=r2_34z(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres22(i3,1,i1,i2)=( l1_56z(i3).a(1)*r2_34z(i1,i2).a(1)+l1 & _56z(i3).c(1)*p156q*r2_34z(i1,i2).b(2) )/(p156q*p156k0) cres22(i3,2,i1,i2)=( l1_56z(i3).c(2)*p156q*r2_34z(i1,i2).b & (1)+l1_56z(i3).a(2)*r2_34z(i1,i2).a(2) )/(p156q*p156k0) END DO END DO END DO **** Diagramma 24 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres24(i3,&,i1,i2),a1=l1_34z(i1,i2).a,c1=l1_34z(i1,i2).c,a2=r * 2_56z(i3).a,b2=r2_56z(i3).b,prq=p134q,den=(p134q*p134k0),nsum=0 cres24(i3,1,i1,i2)=( l1_34z(i1,i2).a(1)*r2_56z(i3).a(1)+l1 & _34z(i1,i2).c(1)*p134q*r2_56z(i3).b(2) )/(p134q*p134k0) cres24(i3,2,i1,i2)=( l1_34z(i1,i2).c(2)*p134q*r2_56z(i3).b & (1)+l1_34z(i1,i2).a(2)*r2_56z(i3).a(2) )/(p134q*p134k0) END DO END DO END DO **** Diagramma 26 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia26(i3,i).a,bb=dia26(i3,i).b,cc=dia26(i3,i).c,dd=dia26(i3,i).d * ,a1=u3_56z(i3).a,b1=u3_56z(i3).b,c1=u3_56z(i3).c,d1=u3_56z(i3).d,a2=d4_12z * (i).a,b2=d4_12z(i).b,c2=d4_12z(i).c,d2=d4_12z(i).d,prq=p356q,m=rmb dia26(i3,i).a(1,1)=u3_56z(i3).a(1,1)*d4_12z(i).a(1,1)+u3_5 & 6z(i3).c(1,2)*p356q*d4_12z(i).b(2,1) dia26(i3,i).b(1,1)=rmb*(u3_56z(i3).d(1,1)*d4_12z(i).a(1,1) & +u3_56z(i3).b(1,2)*d4_12z(i).b(2,1)) dia26(i3,i).c(1,1)=rmb*(u3_56z(i3).a(1,1)*d4_12z(i).d(1,1) & +u3_56z(i3).c(1,2)*d4_12z(i).c(2,1)) dia26(i3,i).d(1,1)=u3_56z(i3).d(1,1)*p356q*d4_12z(i).d(1,1 & )+u3_56z(i3).b(1,2)*d4_12z(i).c(2,1) dia26(i3,i).a(1,2)=rmb*(u3_56z(i3).a(1,1)*d4_12z(i).b(1,2) & +u3_56z(i3).c(1,2)*d4_12z(i).a(2,2)) dia26(i3,i).b(1,2)=u3_56z(i3).d(1,1)*p356q*d4_12z(i).b(1,2 & )+u3_56z(i3).b(1,2)*d4_12z(i).a(2,2) dia26(i3,i).c(1,2)=u3_56z(i3).a(1,1)*d4_12z(i).c(1,2)+u3_5 & 6z(i3).c(1,2)*p356q*d4_12z(i).d(2,2) dia26(i3,i).d(1,2)=rmb*(u3_56z(i3).d(1,1)*d4_12z(i).c(1,2) & +u3_56z(i3).b(1,2)*d4_12z(i).d(2,2)) dia26(i3,i).a(2,1)=rmb*(u3_56z(i3).c(2,1)*d4_12z(i).a(1,1) & +u3_56z(i3).a(2,2)*d4_12z(i).b(2,1)) dia26(i3,i).b(2,1)=u3_56z(i3).b(2,1)*d4_12z(i).a(1,1)+u3_5 & 6z(i3).d(2,2)*p356q*d4_12z(i).b(2,1) dia26(i3,i).c(2,1)=u3_56z(i3).c(2,1)*p356q*d4_12z(i).d(1,1 & )+u3_56z(i3).a(2,2)*d4_12z(i).c(2,1) dia26(i3,i).d(2,1)=rmb*(u3_56z(i3).b(2,1)*d4_12z(i).d(1,1) & +u3_56z(i3).d(2,2)*d4_12z(i).c(2,1)) dia26(i3,i).a(2,2)=u3_56z(i3).c(2,1)*p356q*d4_12z(i).b(1,2 & )+u3_56z(i3).a(2,2)*d4_12z(i).a(2,2) dia26(i3,i).b(2,2)=rmb*(u3_56z(i3).b(2,1)*d4_12z(i).b(1,2) & +u3_56z(i3).d(2,2)*d4_12z(i).a(2,2)) dia26(i3,i).c(2,2)=rmb*(u3_56z(i3).c(2,1)*d4_12z(i).c(1,2) & +u3_56z(i3).a(2,2)*d4_12z(i).d(2,2)) dia26(i3,i).d(2,2)=u3_56z(i3).b(2,1)*d4_12z(i).c(1,2)+u3_5 & 6z(i3).d(2,2)*p356q*d4_12z(i).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres26(i3,i,&),abcd=dia26(i3,i).,m1=rmb,m2=(-rmb),den=((p356 * q-rmb2)*p356k0) DO iut=1,2 DO jut=1,2 cres26(i3,i,iut,jut)=(dia26(i3,i).a(iut,jut) & +rmb*dia26(i3, & i).b(iut,jut)+(-rmb)*dia26(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a26(i3,i).d(iut,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO END DO **** Diagramma 28 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia28(i3,i).a,bb=dia28(i3,i).b,cc=dia28(i3,i).c,dd=dia28(i3,i).d * ,a1=u3_12z(i).a,b1=u3_12z(i).b,c1=u3_12z(i).c,d1=u3_12z(i).d,a2=d4_56z(i3) * .a,b2=d4_56z(i3).b,c2=d4_56z(i3).c,d2=d4_56z(i3).d,prq=p123q,m=rmb dia28(i3,i).a(1,1)=u3_12z(i).a(1,1)*d4_56z(i3).a(1,1)+u3_1 & 2z(i).c(1,2)*p123q*d4_56z(i3).b(2,1) dia28(i3,i).b(1,1)=rmb*(u3_12z(i).d(1,1)*d4_56z(i3).a(1,1) & +u3_12z(i).b(1,2)*d4_56z(i3).b(2,1)) dia28(i3,i).c(1,1)=rmb*(u3_12z(i).a(1,1)*d4_56z(i3).d(1,1) & +u3_12z(i).c(1,2)*d4_56z(i3).c(2,1)) dia28(i3,i).d(1,1)=u3_12z(i).d(1,1)*p123q*d4_56z(i3).d(1,1 & )+u3_12z(i).b(1,2)*d4_56z(i3).c(2,1) dia28(i3,i).a(1,2)=rmb*(u3_12z(i).a(1,1)*d4_56z(i3).b(1,2) & +u3_12z(i).c(1,2)*d4_56z(i3).a(2,2)) dia28(i3,i).b(1,2)=u3_12z(i).d(1,1)*p123q*d4_56z(i3).b(1,2 & )+u3_12z(i).b(1,2)*d4_56z(i3).a(2,2) dia28(i3,i).c(1,2)=u3_12z(i).a(1,1)*d4_56z(i3).c(1,2)+u3_1 & 2z(i).c(1,2)*p123q*d4_56z(i3).d(2,2) dia28(i3,i).d(1,2)=rmb*(u3_12z(i).d(1,1)*d4_56z(i3).c(1,2) & +u3_12z(i).b(1,2)*d4_56z(i3).d(2,2)) dia28(i3,i).a(2,1)=rmb*(u3_12z(i).c(2,1)*d4_56z(i3).a(1,1) & +u3_12z(i).a(2,2)*d4_56z(i3).b(2,1)) dia28(i3,i).b(2,1)=u3_12z(i).b(2,1)*d4_56z(i3).a(1,1)+u3_1 & 2z(i).d(2,2)*p123q*d4_56z(i3).b(2,1) dia28(i3,i).c(2,1)=u3_12z(i).c(2,1)*p123q*d4_56z(i3).d(1,1 & )+u3_12z(i).a(2,2)*d4_56z(i3).c(2,1) dia28(i3,i).d(2,1)=rmb*(u3_12z(i).b(2,1)*d4_56z(i3).d(1,1) & +u3_12z(i).d(2,2)*d4_56z(i3).c(2,1)) dia28(i3,i).a(2,2)=u3_12z(i).c(2,1)*p123q*d4_56z(i3).b(1,2 & )+u3_12z(i).a(2,2)*d4_56z(i3).a(2,2) dia28(i3,i).b(2,2)=rmb*(u3_12z(i).b(2,1)*d4_56z(i3).b(1,2) & +u3_12z(i).d(2,2)*d4_56z(i3).a(2,2)) dia28(i3,i).c(2,2)=rmb*(u3_12z(i).c(2,1)*d4_56z(i3).c(1,2) & +u3_12z(i).a(2,2)*d4_56z(i3).d(2,2)) dia28(i3,i).d(2,2)=u3_12z(i).b(2,1)*d4_56z(i3).c(1,2)+u3_1 & 2z(i).d(2,2)*p123q*d4_56z(i3).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres28(i3,i,&),abcd=dia28(i3,i).,m1=rmb,m2=(-rmb),den=((p123 * q-rmb2)*p123k0) DO iut=1,2 DO jut=1,2 cres28(i3,i,iut,jut)=(dia28(i3,i).a(iut,jut) & +rmb*dia28(i3, & i).b(iut,jut)+(-rmb)*dia28(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a28(i3,i).d(iut,jut))/((p123q-rmb2)*p123k0) ENDDO ENDDO END DO END DO **** Diagramma 31 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres31(&,i1,i2,i3),a1=l5_12z(i1).a,c1=l5_12z(i1).c,a2=r6_34z( * i2,i3).a,b2=r6_34z(i2,i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cres31(1,i1,i2,i3)=( l5_12z(i1).a(1)*r6_34z(i2,i3).a(1)+l5 & _12z(i1).c(1)*p125q*r6_34z(i2,i3).b(2) )/(p125q*p125k0) cres31(2,i1,i2,i3)=( l5_12z(i1).c(2)*p125q*r6_34z(i2,i3).b & (1)+l5_12z(i1).a(2)*r6_34z(i2,i3).a(2) )/(p125q*p125k0) END DO END DO END DO **** Diagramma 35 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres35(&,i1,i2,i3),a1=l5_34z(i2,i3).a,c1=l5_34z(i2,i3).c,a2=r * 6_12z(i1).a,b2=r6_12z(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cres35(1,i1,i2,i3)=( l5_34z(i2,i3).a(1)*r6_12z(i1).a(1)+l5 & _34z(i2,i3).c(1)*p345q*r6_12z(i1).b(2) )/(p345q*p345k0) cres35(2,i1,i2,i3)=( l5_34z(i2,i3).c(2)*p345q*r6_12z(i1).b & (1)+l5_34z(i2,i3).a(2)*r6_12z(i1).a(2) )/(p345q*p345k0) END DO END DO END DO **** Diagramma 23 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres23(i3,&,i1,i2),a1=l1_56f(i3).a,c1=l1_56f(i3).c,a2=r2_34z( * i1,i2).a,b2=r2_34z(i1,i2).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres23(i3,1,i1,i2)=( l1_56f(i3).a(1)*r2_34z(i1,i2).a(1)+l1 & _56f(i3).c(1)*p156q*r2_34z(i1,i2).b(2) )/(p156q*p156k0) cres23(i3,2,i1,i2)=( l1_56f(i3).c(2)*p156q*r2_34z(i1,i2).b & (1)+l1_56f(i3).a(2)*r2_34z(i1,i2).a(2) )/(p156q*p156k0) END DO END DO END DO **** Diagramma 25 **** DO i3=1,2 DO i1=1,2 DO i2=1,2 * TLTR0 -- aa=cres25(i3,&,i1,i2),a1=l1_34f(i1,i2).a,c1=l1_34f(i1,i2).c,a2=r * 2_56z(i3).a,b2=r2_56z(i3).b,prq=p134q,den=(p134q*p134k0),nsum=0 cres25(i3,1,i1,i2)=( l1_34f(i1,i2).a(1)*r2_56z(i3).a(1)+l1 & _34f(i1,i2).c(1)*p134q*r2_56z(i3).b(2) )/(p134q*p134k0) cres25(i3,2,i1,i2)=( l1_34f(i1,i2).c(2)*p134q*r2_56z(i3).b & (1)+l1_34f(i1,i2).a(2)*r2_56z(i3).a(2) )/(p134q*p134k0) END DO END DO END DO **** Diagramma 27 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia27(i3,i).a,bb=dia27(i3,i).b,cc=dia27(i3,i).c,dd=dia27(i3,i).d * ,a1=u3_56f(i3).a,b1=u3_56f(i3).b,c1=u3_56f(i3).c,d1=u3_56f(i3).d,a2=d4_12z * (i).a,b2=d4_12z(i).b,c2=d4_12z(i).c,d2=d4_12z(i).d,prq=p356q,m=rmb dia27(i3,i).a(1,1)=u3_56f(i3).a(1,1)*d4_12z(i).a(1,1)+u3_5 & 6f(i3).c(1,2)*p356q*d4_12z(i).b(2,1) dia27(i3,i).b(1,1)=rmb*(u3_56f(i3).d(1,1)*d4_12z(i).a(1,1) & +u3_56f(i3).b(1,2)*d4_12z(i).b(2,1)) dia27(i3,i).c(1,1)=rmb*(u3_56f(i3).a(1,1)*d4_12z(i).d(1,1) & +u3_56f(i3).c(1,2)*d4_12z(i).c(2,1)) dia27(i3,i).d(1,1)=u3_56f(i3).d(1,1)*p356q*d4_12z(i).d(1,1 & )+u3_56f(i3).b(1,2)*d4_12z(i).c(2,1) dia27(i3,i).a(1,2)=rmb*(u3_56f(i3).a(1,1)*d4_12z(i).b(1,2) & +u3_56f(i3).c(1,2)*d4_12z(i).a(2,2)) dia27(i3,i).b(1,2)=u3_56f(i3).d(1,1)*p356q*d4_12z(i).b(1,2 & )+u3_56f(i3).b(1,2)*d4_12z(i).a(2,2) dia27(i3,i).c(1,2)=u3_56f(i3).a(1,1)*d4_12z(i).c(1,2)+u3_5 & 6f(i3).c(1,2)*p356q*d4_12z(i).d(2,2) dia27(i3,i).d(1,2)=rmb*(u3_56f(i3).d(1,1)*d4_12z(i).c(1,2) & +u3_56f(i3).b(1,2)*d4_12z(i).d(2,2)) dia27(i3,i).a(2,1)=rmb*(u3_56f(i3).c(2,1)*d4_12z(i).a(1,1) & +u3_56f(i3).a(2,2)*d4_12z(i).b(2,1)) dia27(i3,i).b(2,1)=u3_56f(i3).b(2,1)*d4_12z(i).a(1,1)+u3_5 & 6f(i3).d(2,2)*p356q*d4_12z(i).b(2,1) dia27(i3,i).c(2,1)=u3_56f(i3).c(2,1)*p356q*d4_12z(i).d(1,1 & )+u3_56f(i3).a(2,2)*d4_12z(i).c(2,1) dia27(i3,i).d(2,1)=rmb*(u3_56f(i3).b(2,1)*d4_12z(i).d(1,1) & +u3_56f(i3).d(2,2)*d4_12z(i).c(2,1)) dia27(i3,i).a(2,2)=u3_56f(i3).c(2,1)*p356q*d4_12z(i).b(1,2 & )+u3_56f(i3).a(2,2)*d4_12z(i).a(2,2) dia27(i3,i).b(2,2)=rmb*(u3_56f(i3).b(2,1)*d4_12z(i).b(1,2) & +u3_56f(i3).d(2,2)*d4_12z(i).a(2,2)) dia27(i3,i).c(2,2)=rmb*(u3_56f(i3).c(2,1)*d4_12z(i).c(1,2) & +u3_56f(i3).a(2,2)*d4_12z(i).d(2,2)) dia27(i3,i).d(2,2)=u3_56f(i3).b(2,1)*d4_12z(i).c(1,2)+u3_5 & 6f(i3).d(2,2)*p356q*d4_12z(i).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres27(i3,i,&),abcd=dia27(i3,i).,m1=rmb,m2=(-rmb),den=((p356 * q-rmb2)*p356k0) DO iut=1,2 DO jut=1,2 cres27(i3,i,iut,jut)=(dia27(i3,i).a(iut,jut) & +rmb*dia27(i3, & i).b(iut,jut)+(-rmb)*dia27(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a27(i3,i).d(iut,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO END DO **** Diagramma 29 **** DO i3=1,2 DO i=1,2 * TT -- aa=dia29(i3,i).a,bb=dia29(i3,i).b,cc=dia29(i3,i).c,dd=dia29(i3,i).d * ,a1=u3_12f(i).a,b1=u3_12f(i).b,c1=u3_12f(i).c,d1=u3_12f(i).d,a2=d4_56z(i3) * .a,b2=d4_56z(i3).b,c2=d4_56z(i3).c,d2=d4_56z(i3).d,prq=p123q,m=rmb dia29(i3,i).a(1,1)=u3_12f(i).a(1,1)*d4_56z(i3).a(1,1)+u3_1 & 2f(i).c(1,2)*p123q*d4_56z(i3).b(2,1) dia29(i3,i).b(1,1)=rmb*(u3_12f(i).d(1,1)*d4_56z(i3).a(1,1) & +u3_12f(i).b(1,2)*d4_56z(i3).b(2,1)) dia29(i3,i).c(1,1)=rmb*(u3_12f(i).a(1,1)*d4_56z(i3).d(1,1) & +u3_12f(i).c(1,2)*d4_56z(i3).c(2,1)) dia29(i3,i).d(1,1)=u3_12f(i).d(1,1)*p123q*d4_56z(i3).d(1,1 & )+u3_12f(i).b(1,2)*d4_56z(i3).c(2,1) dia29(i3,i).a(1,2)=rmb*(u3_12f(i).a(1,1)*d4_56z(i3).b(1,2) & +u3_12f(i).c(1,2)*d4_56z(i3).a(2,2)) dia29(i3,i).b(1,2)=u3_12f(i).d(1,1)*p123q*d4_56z(i3).b(1,2 & )+u3_12f(i).b(1,2)*d4_56z(i3).a(2,2) dia29(i3,i).c(1,2)=u3_12f(i).a(1,1)*d4_56z(i3).c(1,2)+u3_1 & 2f(i).c(1,2)*p123q*d4_56z(i3).d(2,2) dia29(i3,i).d(1,2)=rmb*(u3_12f(i).d(1,1)*d4_56z(i3).c(1,2) & +u3_12f(i).b(1,2)*d4_56z(i3).d(2,2)) dia29(i3,i).a(2,1)=rmb*(u3_12f(i).c(2,1)*d4_56z(i3).a(1,1) & +u3_12f(i).a(2,2)*d4_56z(i3).b(2,1)) dia29(i3,i).b(2,1)=u3_12f(i).b(2,1)*d4_56z(i3).a(1,1)+u3_1 & 2f(i).d(2,2)*p123q*d4_56z(i3).b(2,1) dia29(i3,i).c(2,1)=u3_12f(i).c(2,1)*p123q*d4_56z(i3).d(1,1 & )+u3_12f(i).a(2,2)*d4_56z(i3).c(2,1) dia29(i3,i).d(2,1)=rmb*(u3_12f(i).b(2,1)*d4_56z(i3).d(1,1) & +u3_12f(i).d(2,2)*d4_56z(i3).c(2,1)) dia29(i3,i).a(2,2)=u3_12f(i).c(2,1)*p123q*d4_56z(i3).b(1,2 & )+u3_12f(i).a(2,2)*d4_56z(i3).a(2,2) dia29(i3,i).b(2,2)=rmb*(u3_12f(i).b(2,1)*d4_56z(i3).b(1,2) & +u3_12f(i).d(2,2)*d4_56z(i3).a(2,2)) dia29(i3,i).c(2,2)=rmb*(u3_12f(i).c(2,1)*d4_56z(i3).c(1,2) & +u3_12f(i).a(2,2)*d4_56z(i3).d(2,2)) dia29(i3,i).d(2,2)=u3_12f(i).b(2,1)*d4_56z(i3).c(1,2)+u3_1 & 2f(i).d(2,2)*p123q*d4_56z(i3).d(2,2) END DO END DO DO i3=1,2 DO i=1,2 * mline -- res=cres29(i3,i,&),abcd=dia29(i3,i).,m1=rmb,m2=(-rmb),den=((p123 * q-rmb2)*p123k0) DO iut=1,2 DO jut=1,2 cres29(i3,i,iut,jut)=(dia29(i3,i).a(iut,jut) & +rmb*dia29(i3, & i).b(iut,jut)+(-rmb)*dia29(i3,i).c(iut,jut)+rmb*(-rmb) & *di & a29(i3,i).d(iut,jut))/((p123q-rmb2)*p123k0) ENDDO ENDDO END DO END DO **** Diagramma 32 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres32(&,i1,i2,i3),a1=l5_12f(i1).a,c1=l5_12f(i1).c,a2=r6_34z( * i2,i3).a,b2=r6_34z(i2,i3).b,prq=p125q,den=(p125q*p125k0),nsum=0 cres32(1,i1,i2,i3)=( l5_12f(i1).a(1)*r6_34z(i2,i3).a(1)+l5 & _12f(i1).c(1)*p125q*r6_34z(i2,i3).b(2) )/(p125q*p125k0) cres32(2,i1,i2,i3)=( l5_12f(i1).c(2)*p125q*r6_34z(i2,i3).b & (1)+l5_12f(i1).a(2)*r6_34z(i2,i3).a(2) )/(p125q*p125k0) END DO END DO END DO **** Diagramma 21 **** DO i1=1,2 DO i2=1,2 DO i3=1,2 * TLTR0 -- aa=cres21(&,i1,i2,i3),a1=l5_34f(i2,i3).a,c1=l5_34f(i2,i3).c,a2=r * 6_12z(i1).a,b2=r6_12z(i1).b,prq=p345q,den=(p345q*p345k0),nsum=0 cres21(1,i1,i2,i3)=( l5_34f(i2,i3).a(1)*r6_12z(i1).a(1)+l5 & _34f(i2,i3).c(1)*p345q*r6_12z(i1).b(2) )/(p345q*p345k0) cres21(2,i1,i2,i3)=( l5_34f(i2,i3).c(2)*p345q*r6_12z(i1).b & (1)+l5_34f(i2,i3).a(2)*r6_12z(i1).a(2) )/(p345q*p345k0) END DO END DO END DO ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then * Diagramma (17) segnale di Higgs * Vertice b b~ H ( quarks massivi ) * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) * TH -- qu=p3,qd=p4,a=v3_4h.a,b=v3_4h.b,c=v3_4h.c v3_4h.a(1,2)=-p3k0*p4(2)+p4k0*p3(2)-cim*(p4(3)*p3k0-p3(3)* & p4k0) v3_4h.a(2,1)=-conjg(v3_4h.a(1,2)) v3_4h.b(1,1)=p4k0 v3_4h.b(2,2)=v3_4h.b(1,1) v3_4h.c(1,1)=p3k0 v3_4h.c(2,2)=v3_4h.c(1,1) * mline -- res=c34h(&),abcd=v3_4h.,m1=rmb,m2=(-rmb),den=cdh DO iut=1,2 DO jut=1,2 c34h(iut,jut)=(v3_4h.a(iut,jut)+rmb*v3_4h.b(iut,jut)+(-rmb & )*v3_4h.c(iut,jut)+rmb*(-rmb)*v3_4h.d(iut,jut))/cdh ENDDO ENDDO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 cres36(i5,i1,i3,i4)=rhzz*(c56z(i5).e(0)*c12z(i1).e(0)- & c56z(i5).e(1)*c12z(i1).e(1)-c56z(i5).e(2)* & c12z(i1).e(2)-c56z(i5).e(3)*c12z(i1).e(3))*c34h(i3,i4) ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 ENDIF ******************************AUTOMEND******************************* if (ifirst.eq.1) then IF(istrcor.EQ.1)THEN qcdcor=qcdcor_nc IF((i3q.EQ.1.AND.i5q.EQ.0).OR.(i3q.EQ.0.AND.i5q.EQ.1))THEN fatcor_qcd=1.d0/(1.d0+qcdcor) fatcor_hh=(1.d0+qcdcor_h)/(1.d0+qcdcor) fatcor_hz=sqrt((1.d0+qcdcor)*(1.d0+qcdcor_h))/(1.d0+qcdcor) ELSE IF(i3q.EQ.1.AND.i5q.EQ.1)THEN fatcor_qcd=1.d0/(1.d0+qcdcor)**2 fatcor_hh=(1.d0+qcdcor)*(1.d0+qcdcor_h)/ & (1.d0+qcdcor)**2 fatcor_hz=(1.d0+qcdcor)*sqrt((1.d0+qcdcor)*(1.d0+qcdcor_h)) & /(1.d0+qcdcor)**2 ENDIF ELSE fatcor_qcd=1.d0 fatcor_hh=1.d0 fatcor_hz=1.d0 ENDIF ifirst=0 endif res=0.d0 DO l=1,2 DO k=1,2 DO i=1,2 DO j=1,2 IF (imix.EQ.-1.or.imix.eq.-2) then cres=+cres4(l,k,i,j)+cres5(l,k,i,j)+cres9(l,k,i,j) & +cres10(l,k,i,j)+cres14(l,k,i,j)+cres15(l,k,i,j) & +cres16(l,k,i,j)+cres17(l,k,i,j)+cres20(l,k,i,j) & +cres21(l,k,i,j)+cres22(l,k,i,j)+cres23(l,k,i,j) & +cres24(l,k,i,j)+cres25(l,k,i,j)+cres26(l,k,i,j) & +cres27(l,k,i,j)+cres28(l,k,i,j)+cres29(l,k,i,j) & +cres30(l,k,i,j)+cres31(l,k,i,j)+cres32(l,k,i,j) & +cres33(l,k,i,j)+cres34(l,k,i,j)+cres35(l,k,i,j) res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=cres36(l,k,i,j) IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres)) & *fatcor_hz ENDIF ENDIF IF (iqu.EQ.1.AND.(imix.EQ.-1.or.imix.eq.-2)) then rc=2.d0/9.d0 cres=(cres14(l,k,i,j)+cres16(l,k,i,j)+cres17(l,k,i,j)+ & cres20(l,k,i,j)+cres21(l,k,i,j)+cres27(l,k,i,j)+ & cres30(l,k,i,j)+cres33(l,k,i,j))/(f5l*fqdl) res=res+rc*(qcdcoupl**2)*(dreal(cres)**2+dimag(cres)**2) & * & fatcor_qcd ENDIF ENDDO !j ENDDO !i ENDDO !k ENDDO !l * el1 IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=9.d0 ELSE IF ((i3q.EQ.1.AND.i5q.EQ.0).OR.(i5q.EQ.1.AND.i3q.EQ.0))THEN rc=3.d0 ELSE rc=1.d0 ENDIF * endel1 ee_bbmumu=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/4.d0 IF (istrcor.EQ.1) THEN IF ((i3q.EQ.1.AND.i5q.EQ.0).OR.(i3q.EQ.0.AND.i5q.EQ.1))THEN ee_bbmumu=ee_bbmumu*(1.d0+qcdcor) ELSE IF (i3q.EQ.1.AND.i5q.EQ.1) THEN ee_bbmumu=ee_bbmumu*(1.d0+qcdcor)**2 ENDIF ENDIF RETURN END REAL*8 FUNCTION ee_bbee(q1,q2,q3,q4,q5,q6) * impulsi q1(0:3),q2(0:3),q3(0:3),q4(0:3),q5(0:3),q6(0:3) * 1 e+, 2 e-, 3 b, 4 b~, 5 e-, 6 e~ * prendo per canale t tutti propagatori senza massa immaginaria * * flags: * common/iflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,iid, * & imix,icoul,istrcor * icc =1 solo CC, 0 solo NC , -1 entrambi * se icc diverso da 0 * icc3 =1 solo CC3, 0 altrimenti * i3e =1 3 e' elettrone, 0 altrimenti * i4e =1 4 e' e+, 0 altrimenti * i3q =1 3 e' quark, 0 altrimenti * i5q =1 3 e' quark, 0 altrimenti * se icc diverso da 1 * iqu =1 entrambi coppie di NC sono quark, 0 altrimenti * i34e =1 coppia 3 e 4 sono elettroni, 0 altrimenti * i56ve =1 coppia 56 sono neutrini elettrone , 0 altrimenti * iid =1 particelle identiche nello stato finale, 0 altrimenti * * imix= 2 somma cc +interferenza con nc, 1 solo cc (o Higgs), 0 solo * interferenza tra cc e nc, -1 solo nc, -2 nc + interferenza con cc (o Higgs) * ibbveve =1 se processo e' quello indicato, 0 altrimenti * serve per tener conto di massa del top a quadrato nel denominatore del * propagatore di cn28 * * struttura del programma: **** vettori di polarizzazione ee gamma , eezeta **** inizio NC * definizione vettori vet.k0 etc. * do ide=0,iid * if (iid.eq.1) then * p3<->p5 * per rifare tutti i diagrammi con questo scambio per particelle id. * endif **** 24 diagrammi base di corrente neutra (6 per gamma e Z insieme) * if (iqu.eq.1) then **** 8 diagrammi di qcd (4) * endif * if (i34e.eq.1) then **** 24 con coppia 34 elettrone (6) * endif * if (i56ve.eq.1) then **** diagrammi per correnti neutre con scambi di w (6) * if (i56ve.eq.1.and.iid.eq.1) then **** diagrammi per correnti neutre con scambi di w (6) ottenuti da **** quelli precedenti scambiando 56 con 34, necessari per 4 ve finali * endif * endif * if (iid.eq.1.and.i34e.eq.1) !anche 56 sono elettroni * !anche 56 sono elettroni **** 24 con coppia 56 elet.(come a i34.eq.1 con scambio coppie 35<->56) * endif * enddo * endif **** fine NC * * Nomenclatura per anomalous couplings * e0 corrisponde a vettore di polarizzazione di gamma + zeta con coeff * opportuni, em a vettore di polarizzaz W-, ep a quello di W+ * p0 e' impulso uscente di gamma + zeta, pm quello di W-, pp quello di W+. * Corrispondentemente ce0em e' prodotto scalare tra e0 e em, ce0pp e' prodotto * scalare tra e0 e pp etc IMPLICIT REAL*8 (a-b,d-h,o-z) IMPLICIT double COMPLEX (c) DIMENSION q1(0:3),q2(0:3),q3(0:3),q4(0:3),q5(0:3),q6(0:3) DIMENSION p1(0:3),p2(0:3),p3(0:3),p4(0:3),p5(0:3),p6(0:3) DIMENSION pau(0:3),p12(0:3),p34(0:3),p56(0:3), p123(0:3), & p125(0:3),p134(0:3),p156(0:3),p345(0:3),p356(0:3) DIMENSION c34h(2,2) STRUCTURE/diag/ double COMPLEX i(2) END STRUCTURE RECORD/diag/cn1(2,2,2,2,2,2),cn2(2,2,2,2,2,2),cn3(2,2,2,2,2,2), & cn4(2,2,2,2,2,2),cn5(2,2,2,2,2,2),cn6(2,2,2,2,2,2) & ,ch(2,2,2,2,2,2) STRUCTURE/polcom/ double COMPLEX e(0:3),ek0,v END STRUCTURE RECORD/polcom/ & c12f(2),c12z(2),c34f(2,2),c34z(2,2),c56f(2),c56z(2) STRUCTURE/tu/ double COMPLEX a(2),c(2) END STRUCTURE RECORD/tu/ & l1_34fz(2,2),l1_56fz(2),l5_12fz(2),l5_34fz(2,2) STRUCTURE/td/ double COMPLEX a(2),b(2) END STRUCTURE RECORD/td/ & r2_34fz(2,2),r2_56fz(2),r6_12fz(2),r6_34fz(2,2) STRUCTURE/t/ double COMPLEX a(2,2),b(2,2),c(2,2),d(2,2) END STRUCTURE RECORD/t/v34f(0:3),v34z(0:3),v34h,u3_12fz(2),u3_56fz(2), & d4_56fz(2),d4_12fz(2),dia3(2,2),dia4(2,2) COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abparc/czipr,ccz,cwipr,ccw,chipr,cch,caipr,cca COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc *el2 & ,izz,izg,izg34,izg56,inc08,igamgam,itch *endel2 PARAMETER (czero=(0.d0,0.d0),cuno=(1.d0,0.d0),cim=(0.d0,1.d0)) data ifirst /1/ * iset=1 grafici da 1 a 6 e segnale di higgs, iset=2 grafici da 17 a 22 * e grafico di higgs corispondente. * I grafici del secondo set sono ottenuti dal primo tramite 1<->5 * impulsi p tutti uscenti, inoltre si passa tutti q a p per far scambi senza * danno DO m=0,3 p1(m)=-q1(m) p2(m)=-q2(m) p3(m)=q3(m) p4(m)=q4(m) p5(m)=q5(m) p6(m)=q6(m) END DO DO iset=1,2 IF (iset.EQ.2) THEN DO m=0,3 pau(m)=p1(m) p1(m)=p5(m) p5(m)=pau(m) END DO ENDIF * pk0 -- p=p1 p1k0=p1(0)-p1(1) * pk0 -- p=p2 p2k0=p2(0)-p2(1) * pk0 -- p=p3 p3k0=p3(0)-p3(1) * pk0 -- p=p4 p4k0=p4(0)-p4(1) * pk0 -- p=p5 p5k0=p5(0)-p5(1) * pk0 -- p=p6 p6k0=p6(0)-p6(1) * Impulsi dei propagatori DO m=0,3 p12(m)=p1(m)+p2(m) p34(m)=p3(m)+p4(m) p56(m)=p5(m)+p6(m) p123(m)=p12(m)+p3(m) p125(m)=p12(m)+p5(m) p134(m)=p1(m)+p34(m) p156(m)=p1(m)+p56(m) p345(m)=p34(m)+p5(m) p356(m)=p3(m)+p56(m) END DO * pk0 -- p=p123 p123k0=p123(0)-p123(1) * p.q -- p.q=p123q,p=p123,q=p123,bef=,aft= p123q=(p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p12 & 3(3)*p123(3)) * pk0 -- p=p125 p125k0=p125(0)-p125(1) * p.q -- p.q=p125q,p=p125,q=p125,bef=,aft= p125q=(p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p12 & 5(3)*p125(3)) * pk0 -- p=p134 p134k0=p134(0)-p134(1) * p.q -- p.q=p134q,p=p134,q=p134,bef=,aft= p134q=(p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p13 & 4(3)*p134(3)) * pk0 -- p=p156 p156k0=p156(0)-p156(1) * p.q -- p.q=p156q,p=p156,q=p156,bef=,aft= p156q=(p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p15 & 6(3)*p156(3)) * pk0 -- p=p345 p345k0=p345(0)-p345(1) * p.q -- p.q=p345q,p=p345,q=p345,bef=,aft= p345q=(p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p34 & 5(3)*p345(3)) * pk0 -- p=p356 p356k0=p356(0)-p356(1) * p.q -- p.q=p356q,p=p356,q=p356,bef=,aft= p356q=(p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p35 & 6(3)*p356(3)) * p.q -- p.q=p12q,p=p12,q=p12,bef=,aft= p12q=(p12(0)*p12(0)-p12(1)*p12(1)-p12(2)*p12(2)-p12(3)*p12 & (3)) * p.q -- p.q=p34q,p=p34,q=p34,bef=,aft= p34q=(p34(0)*p34(0)-p34(1)*p34(1)-p34(2)*p34(2)-p34(3)*p34 & (3)) * p.q -- p.q=p56q,p=p56,q=p56,bef=,aft= p56q=(p56(0)*p56(0)-p56(1)*p56(1)-p56(2)*p56(2)-p56(3)*p56 & (3)) * vettori di polarizzazione e+e- quqd=p12q/2.d0 * il - qui e in cdw e' perche' i propagatori bosonici portano un segno - * rispetto a quelli fermionici IF (iset.EQ.1)THEN cdz=-1.d0/(p12q*czipr-rmz2+ccz) ELSE cdz=-1.d0/(p12q-rmz2) ENDIF df=-1.d0/p12q fac1=(df*fer) fac2=(df*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p1,qd=p2,v=0,a=c12f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p1(2)*p2(3)+p2(2)*p1(3) ceps_0=eps_0*cim auxa=-quqd+p1k0*p2(0)+p2k0*p1(0) c12f(1).e(0)=fac1*(auxa+ceps_0) c12f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=1,a=c12f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=2,a=c12f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p1k0*p2(3)+p2k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p2(2)+p2k0*p1(2) c12f(1).e(2)=fac1*(auxa+ceps_0) c12f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=3,a=c12f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p1k0*p2(2)-p2k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p2(3)+p2k0*p1(3) c12f(1).e(3)=fac1*(auxa+ceps_0) c12f(2).e(3)=fac2*(auxa-ceps_0) DO mu=0,3 c12z(1).e(mu)=cfac1z*c12f(1).e(mu) c12z(2).e(mu)=cfac2z*c12f(2).e(mu) END DO DO i=1,2 * pk0 -- p=c12f(i).e c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 * pk0 -- p=c12z(i).e c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO quqd=p56q/2.d0 df=-1.d0/p56q IF (iset.EQ.1)THEN cdz=-1.d0/(p56q*czipr-rmz2+ccz) ELSE cdz=-1.d0/(p56q-rmz2) ENDIF fac1=(df*fer) fac2=(df*fel) cfac1z=(cdz*zer)/fac1 cfac2z=(cdz*zel)/fac2 * T10 -- qu=p5,qd=p6,v=0,a=c56f(&).e(0),cr=fac1,cl=fac2,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) c56f(1).e(0)=fac1*(auxa+ceps_0) c56f(2).e(0)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=1,a=c56f(&).e(1),cr=fac1,cl=fac2,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56f(1).e(1)=fac1*(auxa+ceps_0) c56f(2).e(1)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=2,a=c56f(&).e(2),cr=fac1,cl=fac2,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) c56f(1).e(2)=fac1*(auxa+ceps_0) c56f(2).e(2)=fac2*(auxa-ceps_0) * T10 -- qu=p5,qd=p6,v=3,a=c56f(&).e(3),cr=fac1,cl=fac2,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim auxa=p5k0*p6(3)+p6k0*p5(3) c56f(1).e(3)=fac1*(auxa+ceps_0) c56f(2).e(3)=fac2*(auxa-ceps_0) DO mu=0,3 c56z(1).e(mu)=cfac1z*c56f(1).e(mu) c56z(2).e(mu)=cfac2z*c56f(2).e(mu) END DO DO i=1,2 * pk0 -- p=c56f(i).e c56f(i).ek0=c56f(i).e(0)-c56f(i).e(1) END DO DO i=1,2 * pk0 -- p=c56z(i).e c56z(i).ek0=c56z(i).e(0)-c56z(i).e(1) END DO quqd=p34q/2.d0-rmb2 df=-p34q cdz=-(p34q*czipr-rmz2+ccz) * T -- qu=p3,qd=p4,v=0,a=v34f(0).a,b=v34f(0).b,c=v34f(0).c,d=v34f(0).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) v34f(0).a(1,1)=fqdr*(auxa+ceps_0) v34f(0).a(2,2)=fqdl*(auxa-ceps_0) v34f(0).b(1,2)=-fqdl*(p4(2)+ceps_2) v34f(0).b(2,1)=fqdr*(p4(2)-ceps_2) v34f(0).c(1,2)=fqdr*(p3(2)+ceps_1) v34f(0).c(2,1)=fqdl*(-p3(2)+ceps_1) v34f(0).d(1,1)=fqdl v34f(0).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=1,a=v34f(1).a,b=v34f(1).b,c=v34f(1).c,d=v34f(1).d,cr=f * qdr,cl=fqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v34f(1).a(1,1)=fqdr*(auxa+ceps_0) v34f(1).a(2,2)=fqdl*(auxa-ceps_0) v34f(1).b(1,2)=-fqdl*(p4(2)+ceps_2) v34f(1).b(2,1)=fqdr*(p4(2)-ceps_2) v34f(1).c(1,2)=fqdr*(p3(2)+ceps_1) v34f(1).c(2,1)=fqdl*(-p3(2)+ceps_1) v34f(1).d(1,1)=fqdl v34f(1).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=2,a=v34f(2).a,b=v34f(2).b,c=v34f(2).c,d=v34f(2).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) v34f(2).a(1,1)=fqdr*(auxa+ceps_0) v34f(2).a(2,2)=fqdl*(auxa-ceps_0) v34f(2).b(1,2)=-fqdl*p4k0 v34f(2).b(2,1)=fqdr*p4k0 v34f(2).c(1,2)=fqdr*p3k0 v34f(2).c(2,1)=-fqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v34f(3).a,b=v34f(3).b,c=v34f(3).c,d=v34f(3).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p4k0*cim auxa=+p3k0*p4(3)+p4k0*p3(3) v34f(3).a(1,1)=fqdr*(auxa+ceps_0) v34f(3).a(2,2)=fqdl*(auxa-ceps_0) v34f(3).b(1,2)=-fqdl*ceps_2 v34f(3).b(2,1)=-fqdr*ceps_2 v34f(3).c(1,2)=fqdr*ceps_1 v34f(3).c(2,1)=fqdl*ceps_1 DO m=0,3 * mline -- res=c34f(&1,&2).e(m),abcd=v34f(m).,m1=rmb,m2=(-rmb),den=df,nsum= * 0 DO iut=1,2 DO jut=1,2 c34f(iut,jut).e(m)=(v34f(m).a(iut,jut)+rmb*v34f(m).b(iut,j & ut)+(-rmb)*v34f(m).c(iut,jut)+rmb*(-rmb)*v34f(m).d(iut, & ju & t))/df ENDDO ENDDO END DO * T -- qu=p3,qd=p4,v=0,a=v34z(0).a,b=v34z(0).b,c=v34z(0).c,d=v34z(0).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p3(2)*p4(3)+p4(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p3k0*p4(0)+p4k0*p3(0) v34z(0).a(1,1)=zqdr*(auxa+ceps_0) v34z(0).a(2,2)=zqdl*(auxa-ceps_0) v34z(0).b(1,2)=-zqdl*(p4(2)+ceps_2) v34z(0).b(2,1)=zqdr*(p4(2)-ceps_2) v34z(0).c(1,2)=zqdr*(p3(2)+ceps_1) v34z(0).c(2,1)=zqdl*(-p3(2)+ceps_1) v34z(0).d(1,1)=zqdl v34z(0).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=1,a=v34z(1).a,b=v34z(1).b,c=v34z(1).c,d=v34z(1).d,cr=z * qdr,cl=zqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v34z(1).a(1,1)=zqdr*(auxa+ceps_0) v34z(1).a(2,2)=zqdl*(auxa-ceps_0) v34z(1).b(1,2)=-zqdl*(p4(2)+ceps_2) v34z(1).b(2,1)=zqdr*(p4(2)-ceps_2) v34z(1).c(1,2)=zqdr*(p3(2)+ceps_1) v34z(1).c(2,1)=zqdl*(-p3(2)+ceps_1) v34z(1).d(1,1)=zqdl v34z(1).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=2,a=v34z(2).a,b=v34z(2).b,c=v34z(2).c,d=v34z(2).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p3k0*p4(3)+p4k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p4(2)+p4k0*p3(2) v34z(2).a(1,1)=zqdr*(auxa+ceps_0) v34z(2).a(2,2)=zqdl*(auxa-ceps_0) v34z(2).b(1,2)=-zqdl*p4k0 v34z(2).b(2,1)=zqdr*p4k0 v34z(2).c(1,2)=zqdr*p3k0 v34z(2).c(2,1)=-zqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v34z(3).a,b=v34z(3).b,c=v34z(3).c,d=v34z(3).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=p3k0*p4(2)-p4k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p4k0*cim auxa=+p3k0*p4(3)+p4k0*p3(3) v34z(3).a(1,1)=zqdr*(auxa+ceps_0) v34z(3).a(2,2)=zqdl*(auxa-ceps_0) v34z(3).b(1,2)=-zqdl*ceps_2 v34z(3).b(2,1)=-zqdr*ceps_2 v34z(3).c(1,2)=zqdr*ceps_1 v34z(3).c(2,1)=zqdl*ceps_1 DO m=0,3 * mline -- res=c34z(&1,&2).e(m),abcd=v34z(m).,m1=rmb,m2=(-rmb),den=cdz,nsum * =0 DO iut=1,2 DO jut=1,2 c34z(iut,jut).e(m)=(v34z(m).a(iut,jut)+rmb*v34z(m).b(iut,j & ut)+(-rmb)*v34z(m).c(iut,jut)+rmb*(-rmb)*v34z(m).d(iut, & ju & t))/cdz ENDDO ENDDO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c34f(i1,i2).e c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO * aggiungo al propagatore della zeta pezzo prop. a k(mu)*k(nu) DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c34z(i1,i2).e,q=p34,bef=,aft= caux=(c34z(i1,i2).e(0)*p34(0)-c34z(i1,i2).e(1)*p34(1)-c34z & (i1,i2).e(2)*p34(2)-c34z(i1,i2).e(3)*p34(3)) DO m=0,3 c34z(i1,i2).e(m)=c34z(i1,i2).e(m)-caux*p34(m)/rmz2 END DO END DO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c34z(i1,i2).e c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO *****attaccamento di c12f(2) a 5 * quqd -- p=p5,q=p125 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 * TL0 -- qu=p5,qd=p125,v=c12f(i).e,a=l5_12fz(i).a,c=l5_12fz(i).c,cr=fer,cl= * fel,nsum=0 ceps_0=-c12f(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2f(i).e(2)*p125(3)-p125(2)*c12f(i).e(3))-p125k0*(c12f(i). & e(2)*p5(3)-p5(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p5k0+p5(3)*c12f(i).ek0 ceps_1=ceps_1*cim cvqu=c12f(i).e(0)*p5(0)-c12f(i).e(1)*p5(1)-c12f(i).e(2)*p5 & (2)-c12f(i).e(3)*p5(3) cvqd=c12f(i).e(0)*p125(0)-c12f(i).e(1)*p125(1)-c12f(i).e(2 & )*p125(2)-c12f(i).e(3)*p125(3) cauxa=-c12f(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12f(i).ek0*p5(2)-p5k0*c12f(i).e(2) l5_12fz(i).a(1)=fer*(cauxa+ceps_0) l5_12fz(i).a(2)=fel*(cauxa-ceps_0) l5_12fz(i).c(1)=fer*(cauxc+ceps_1) l5_12fz(i).c(2)=fel*(-cauxc+ceps_1) END DO *****attaccamento di c12z(2) a 5 DO i=1,2 * TL0 -- qu=p5,qd=p125,v=c12z(i).e,a=l5_12fz(i).a,c=l5_12fz(i).c,cr=zer,cl= * zel,nsum=1 ceps_0=-c12z(i).ek0*(p5(2)*p125(3)-p125(2)*p5(3))+p5k0*(c1 & 2z(i).e(2)*p125(3)-p125(2)*c12z(i).e(3))-p125k0*(c12z(i). & e(2)*p5(3)-p5(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p5k0+p5(3)*c12z(i).ek0 ceps_1=ceps_1*cim cvqu=c12z(i).e(0)*p5(0)-c12z(i).e(1)*p5(1)-c12z(i).e(2)*p5 & (2)-c12z(i).e(3)*p5(3) cvqd=c12z(i).e(0)*p125(0)-c12z(i).e(1)*p125(1)-c12z(i).e(2 & )*p125(2)-c12z(i).e(3)*p125(3) cauxa=-c12z(i).ek0*quqd+p5k0*cvqd+p125k0*cvqu cauxc=+c12z(i).ek0*p5(2)-p5k0*c12z(i).e(2) l5_12fz(i).a(1)=l5_12fz(i).a(1)+zer*(cauxa+ceps_0) l5_12fz(i).a(2)=l5_12fz(i).a(2)+zel*(cauxa-ceps_0) l5_12fz(i).c(1)=l5_12fz(i).c(1)+zer*(cauxc+ceps_1) l5_12fz(i).c(2)=l5_12fz(i).c(2)+zel*(-cauxc+ceps_1) END DO *****attaccamento di c12f(2) a 6 * quqd -- p=p345,q=p6 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 * TR0 -- qu=p345,qd=p6,v=c12f(i).e,a=r6_12fz(i).a,b=r6_12fz(i).b,cr=fer,cl= * fel,nsum=0 ceps_0=-c12f(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12f(i).e(2)*p6(3)-p6(2)*c12f(i).e(3))-p6k0*(c12f(i).e(2) & *p345(3)-p345(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12f(i).e(3)*p6k0+p6(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p345(0)-c12f(i).e(1)*p345(1)-c12f(i).e(2 & )*p345(2)-c12f(i).e(3)*p345(3) cvqd=c12f(i).e(0)*p6(0)-c12f(i).e(1)*p6(1)-c12f(i).e(2)*p6 & (2)-c12f(i).e(3)*p6(3) cauxa=-c12f(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12f(i).ek0*p6(2)+p6k0*c12f(i).e(2) r6_12fz(i).a(1)=fer*(cauxa+ceps_0) r6_12fz(i).a(2)=fel*(cauxa-ceps_0) r6_12fz(i).b(1)=fel*(cauxb-ceps_2) r6_12fz(i).b(2)=fer*(-cauxb-ceps_2) END DO *****attaccamento di c12z(2) a 6 DO i=1,2 * TR0 -- qu=p345,qd=p6,v=c12z(i).e,a=r6_12fz(i).a,b=r6_12fz(i).b,cr=zer,cl= * zel,nsum=1 ceps_0=-c12z(i).ek0*(p345(2)*p6(3)-p6(2)*p345(3))+p345k0*( & c12z(i).e(2)*p6(3)-p6(2)*c12z(i).e(3))-p6k0*(c12z(i).e(2) & *p345(3)-p345(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_2=-c12z(i).e(3)*p6k0+p6(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p345(0)-c12z(i).e(1)*p345(1)-c12z(i).e(2 & )*p345(2)-c12z(i).e(3)*p345(3) cvqd=c12z(i).e(0)*p6(0)-c12z(i).e(1)*p6(1)-c12z(i).e(2)*p6 & (2)-c12z(i).e(3)*p6(3) cauxa=-c12z(i).ek0*quqd+p345k0*cvqd+p6k0*cvqu cauxb=-c12z(i).ek0*p6(2)+p6k0*c12z(i).e(2) r6_12fz(i).a(1)=r6_12fz(i).a(1)+zer*(cauxa+ceps_0) r6_12fz(i).a(2)=r6_12fz(i).a(2)+zel*(cauxa-ceps_0) r6_12fz(i).b(1)=r6_12fz(i).b(1)+zel*(cauxb-ceps_2) r6_12fz(i).b(2)=r6_12fz(i).b(2)+zer*(-cauxb-ceps_2) END DO *****attaccamento di c56f(2) a 1 (e+) * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i=1,2 * TL0 -- qu=p1,qd=p156,v=c56f(i).e,a=l1_56fz(i).a,c=l1_56fz(i).c,cr=fer,cl= * fel,nsum=0 ceps_0=-c56f(i).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c5 & 6f(i).e(2)*p156(3)-p156(2)*c56f(i).e(3))-p156k0*(c56f(i). & e(2)*p1(3)-p1(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p1k0+p1(3)*c56f(i).ek0 ceps_1=ceps_1*cim cvqu=c56f(i).e(0)*p1(0)-c56f(i).e(1)*p1(1)-c56f(i).e(2)*p1 & (2)-c56f(i).e(3)*p1(3) cvqd=c56f(i).e(0)*p156(0)-c56f(i).e(1)*p156(1)-c56f(i).e(2 & )*p156(2)-c56f(i).e(3)*p156(3) cauxa=-c56f(i).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56f(i).ek0*p1(2)-p1k0*c56f(i).e(2) l1_56fz(i).a(1)=fer*(cauxa+ceps_0) l1_56fz(i).a(2)=fel*(cauxa-ceps_0) l1_56fz(i).c(1)=fer*(cauxc+ceps_1) l1_56fz(i).c(2)=fel*(-cauxc+ceps_1) END DO *****attaccamento di c56z(2) a 1 (e+) DO i=1,2 * TL0 -- qu=p1,qd=p156,v=c56z(i).e,a=l1_56fz(i).a,c=l1_56fz(i).c,cr=zer,cl= * zel,nsum=1 ceps_0=-c56z(i).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0*(c5 & 6z(i).e(2)*p156(3)-p156(2)*c56z(i).e(3))-p156k0*(c56z(i). & e(2)*p1(3)-p1(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p1k0+p1(3)*c56z(i).ek0 ceps_1=ceps_1*cim cvqu=c56z(i).e(0)*p1(0)-c56z(i).e(1)*p1(1)-c56z(i).e(2)*p1 & (2)-c56z(i).e(3)*p1(3) cvqd=c56z(i).e(0)*p156(0)-c56z(i).e(1)*p156(1)-c56z(i).e(2 & )*p156(2)-c56z(i).e(3)*p156(3) cauxa=-c56z(i).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56z(i).ek0*p1(2)-p1k0*c56z(i).e(2) l1_56fz(i).a(1)=l1_56fz(i).a(1)+zer*(cauxa+ceps_0) l1_56fz(i).a(2)=l1_56fz(i).a(2)+zel*(cauxa-ceps_0) l1_56fz(i).c(1)=l1_56fz(i).c(1)+zer*(cauxc+ceps_1) l1_56fz(i).c(2)=l1_56fz(i).c(2)+zel*(-cauxc+ceps_1) END DO *****attaccamento di c56f(2) a 2 (e-) * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i1=1,2 * TR0 -- qu=p134,qd=p2,v=c56f(i1).e,a=r2_56fz(i1).a,b=r2_56fz(i1).b,cr=fer, * cl=fel,nsum=0 ceps_0=-c56f(i1).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0* & (c56f(i1).e(2)*p2(3)-p2(2)*c56f(i1).e(3))-p2k0*(c56f(i1). & e(2)*p134(3)-p134(2)*c56f(i1).e(3)) ceps_0=ceps_0*cim ceps_2=-c56f(i1).e(3)*p2k0+p2(3)*c56f(i1).ek0 ceps_2=ceps_2*cim cvqu=c56f(i1).e(0)*p134(0)-c56f(i1).e(1)*p134(1)-c56f(i1). & e(2)*p134(2)-c56f(i1).e(3)*p134(3) cvqd=c56f(i1).e(0)*p2(0)-c56f(i1).e(1)*p2(1)-c56f(i1).e(2) & *p2(2)-c56f(i1).e(3)*p2(3) cauxa=-c56f(i1).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56f(i1).ek0*p2(2)+p2k0*c56f(i1).e(2) r2_56fz(i1).a(1)=fer*(cauxa+ceps_0) r2_56fz(i1).a(2)=fel*(cauxa-ceps_0) r2_56fz(i1).b(1)=fel*(cauxb-ceps_2) r2_56fz(i1).b(2)=fer*(-cauxb-ceps_2) END DO *****attaccamento di c56z(2) a 2 (e-) DO i1=1,2 * TR0 -- qu=p134,qd=p2,v=c56z(i1).e,a=r2_56fz(i1).a,b=r2_56fz(i1).b,cr=zer, * cl=zel,nsum=1 ceps_0=-c56z(i1).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134k0* & (c56z(i1).e(2)*p2(3)-p2(2)*c56z(i1).e(3))-p2k0*(c56z(i1). & e(2)*p134(3)-p134(2)*c56z(i1).e(3)) ceps_0=ceps_0*cim ceps_2=-c56z(i1).e(3)*p2k0+p2(3)*c56z(i1).ek0 ceps_2=ceps_2*cim cvqu=c56z(i1).e(0)*p134(0)-c56z(i1).e(1)*p134(1)-c56z(i1). & e(2)*p134(2)-c56z(i1).e(3)*p134(3) cvqd=c56z(i1).e(0)*p2(0)-c56z(i1).e(1)*p2(1)-c56z(i1).e(2) & *p2(2)-c56z(i1).e(3)*p2(3) cauxa=-c56z(i1).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56z(i1).ek0*p2(2)+p2k0*c56z(i1).e(2) r2_56fz(i1).a(1)=r2_56fz(i1).a(1)+zer*(cauxa+ceps_0) r2_56fz(i1).a(2)=r2_56fz(i1).a(2)+zel*(cauxa-ceps_0) r2_56fz(i1).b(1)=r2_56fz(i1).b(1)+zel*(cauxb-ceps_2) r2_56fz(i1).b(2)=r2_56fz(i1).b(2)+zer*(-cauxb-ceps_2) END DO *****attaccamento di c34f(2,2) a 1 (e+) * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p1,qd=p134,v=c34f(i1,i2).e,a=l1_34fz(i1,i2).a,c=l1_34fz(i1,i2). * c,cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34f(i1,i2).e(2)*p134(3)-p134(2)*c34f(i1,i2).e(3))-p134 & k0*(c34f(i1,i2).e(2)*p1(3)-p1(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i1,i2).e(3)*p1k0+p1(3)*c34f(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34f(i1,i2).e(0)*p1(0)-c34f(i1,i2).e(1)*p1(1)-c34f(i1 & ,i2).e(2)*p1(2)-c34f(i1,i2).e(3)*p1(3) cvqd=c34f(i1,i2).e(0)*p134(0)-c34f(i1,i2).e(1)*p134(1)-c34 & f(i1,i2).e(2)*p134(2)-c34f(i1,i2).e(3)*p134(3) cauxa=-c34f(i1,i2).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34f(i1,i2).ek0*p1(2)-p1k0*c34f(i1,i2).e(2) l1_34fz(i1,i2).a(1)=fer*(cauxa+ceps_0) l1_34fz(i1,i2).a(2)=fel*(cauxa-ceps_0) l1_34fz(i1,i2).c(1)=fer*(cauxc+ceps_1) l1_34fz(i1,i2).c(2)=fel*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34z(2,2) a 1 (e+) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p1,qd=p134,v=c34z(i1,i2).e,a=l1_34fz(i1,i2).a,c=l1_34fz(i1,i2). * c,cr=zer,cl=zel,nsum=1 ceps_0=-c34z(i1,i2).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34z(i1,i2).e(2)*p134(3)-p134(2)*c34z(i1,i2).e(3))-p134 & k0*(c34z(i1,i2).e(2)*p1(3)-p1(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1,i2).e(3)*p1k0+p1(3)*c34z(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1,i2).e(0)*p1(0)-c34z(i1,i2).e(1)*p1(1)-c34z(i1 & ,i2).e(2)*p1(2)-c34z(i1,i2).e(3)*p1(3) cvqd=c34z(i1,i2).e(0)*p134(0)-c34z(i1,i2).e(1)*p134(1)-c34 & z(i1,i2).e(2)*p134(2)-c34z(i1,i2).e(3)*p134(3) cauxa=-c34z(i1,i2).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34z(i1,i2).ek0*p1(2)-p1k0*c34z(i1,i2).e(2) l1_34fz(i1,i2).a(1)=l1_34fz(i1,i2).a(1)+zer*(cauxa+ceps_0) l1_34fz(i1,i2).a(2)=l1_34fz(i1,i2).a(2)+zel*(cauxa-ceps_0) l1_34fz(i1,i2).c(1)=l1_34fz(i1,i2).c(1)+zer*(cauxc+ceps_1) l1_34fz(i1,i2).c(2)=l1_34fz(i1,i2).c(2)+zel*(-cauxc+ceps_1 & ) END DO END DO *****attaccamento di c34f(2) a 2 (e-) * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p156,qd=p2,v=c34f(i1,i2).e,a=r2_34fz(i1,i2).a,b=r2_34fz(i1,i2). * b,cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34f(i1,i2).e(2)*p2(3)-p2(2)*c34f(i1,i2).e(3))-p2k0*( & c34f(i1,i2).e(2)*p156(3)-p156(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i1,i2).e(3)*p2k0+p2(3)*c34f(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34f(i1,i2).e(0)*p156(0)-c34f(i1,i2).e(1)*p156(1)-c34 & f(i1,i2).e(2)*p156(2)-c34f(i1,i2).e(3)*p156(3) cvqd=c34f(i1,i2).e(0)*p2(0)-c34f(i1,i2).e(1)*p2(1)-c34f(i1 & ,i2).e(2)*p2(2)-c34f(i1,i2).e(3)*p2(3) cauxa=-c34f(i1,i2).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34f(i1,i2).ek0*p2(2)+p2k0*c34f(i1,i2).e(2) r2_34fz(i1,i2).a(1)=fer*(cauxa+ceps_0) r2_34fz(i1,i2).a(2)=fel*(cauxa-ceps_0) r2_34fz(i1,i2).b(1)=fel*(cauxb-ceps_2) r2_34fz(i1,i2).b(2)=fer*(-cauxb-ceps_2) END DO END DO *****attaccamento di c34z(2) a 2 (e-) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p156,qd=p2,v=c34z(i1,i2).e,a=r2_34fz(i1,i2).a,b=r2_34fz(i1,i2). * b,cr=zer,cl=zel,nsum=1 ceps_0=-c34z(i1,i2).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34z(i1,i2).e(2)*p2(3)-p2(2)*c34z(i1,i2).e(3))-p2k0*( & c34z(i1,i2).e(2)*p156(3)-p156(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1,i2).e(3)*p2k0+p2(3)*c34z(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1,i2).e(0)*p156(0)-c34z(i1,i2).e(1)*p156(1)-c34 & z(i1,i2).e(2)*p156(2)-c34z(i1,i2).e(3)*p156(3) cvqd=c34z(i1,i2).e(0)*p2(0)-c34z(i1,i2).e(1)*p2(1)-c34z(i1 & ,i2).e(2)*p2(2)-c34z(i1,i2).e(3)*p2(3) cauxa=-c34z(i1,i2).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34z(i1,i2).ek0*p2(2)+p2k0*c34z(i1,i2).e(2) r2_34fz(i1,i2).a(1)=r2_34fz(i1,i2).a(1)+zer*(cauxa+ceps_0) r2_34fz(i1,i2).a(2)=r2_34fz(i1,i2).a(2)+zel*(cauxa-ceps_0) r2_34fz(i1,i2).b(1)=r2_34fz(i1,i2).b(1)+zel*(cauxb-ceps_2) r2_34fz(i1,i2).b(2)=r2_34fz(i1,i2).b(2)+zer*(-cauxb-ceps_2 & ) END DO END DO *****attaccamento di c34f a 5 * quqd -- p=p5,q=p345 quqd=p5(0)*p345(0)-p5(1)*p345(1)-p5(2)*p345(2)-p5(3)*p345( & 3) DO i1=1,2 DO i2=1,2 * TL0 -- qu=p5,qd=p345,v=c34f(i1,i2).e,a=l5_34fz(i1,i2).a,c=l5_34fz(i1,i2). * c,cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0 & *(c34f(i1,i2).e(2)*p345(3)-p345(2)*c34f(i1,i2).e(3))-p345 & k0*(c34f(i1,i2).e(2)*p5(3)-p5(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i1,i2).e(3)*p5k0+p5(3)*c34f(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34f(i1,i2).e(0)*p5(0)-c34f(i1,i2).e(1)*p5(1)-c34f(i1 & ,i2).e(2)*p5(2)-c34f(i1,i2).e(3)*p5(3) cvqd=c34f(i1,i2).e(0)*p345(0)-c34f(i1,i2).e(1)*p345(1)-c34 & f(i1,i2).e(2)*p345(2)-c34f(i1,i2).e(3)*p345(3) cauxa=-c34f(i1,i2).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34f(i1,i2).ek0*p5(2)-p5k0*c34f(i1,i2).e(2) l5_34fz(i1,i2).a(1)=fer*(cauxa+ceps_0) l5_34fz(i1,i2).a(2)=fel*(cauxa-ceps_0) l5_34fz(i1,i2).c(1)=fer*(cauxc+ceps_1) l5_34fz(i1,i2).c(2)=fel*(-cauxc+ceps_1) END DO END DO *****attaccamento di c34z a 5 DO i1=1,2 DO i2=1,2 * TL0 -- qu=p5,qd=p345,v=c34z(i1,i2).e,a=l5_34fz(i1,i2).a,c=l5_34fz(i1,i2). * c,cr=zer,cl=zel,nsum=1 ceps_0=-c34z(i1,i2).ek0*(p5(2)*p345(3)-p345(2)*p5(3))+p5k0 & *(c34z(i1,i2).e(2)*p345(3)-p345(2)*c34z(i1,i2).e(3))-p345 & k0*(c34z(i1,i2).e(2)*p5(3)-p5(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i1,i2).e(3)*p5k0+p5(3)*c34z(i1,i2).ek0 ceps_1=ceps_1*cim cvqu=c34z(i1,i2).e(0)*p5(0)-c34z(i1,i2).e(1)*p5(1)-c34z(i1 & ,i2).e(2)*p5(2)-c34z(i1,i2).e(3)*p5(3) cvqd=c34z(i1,i2).e(0)*p345(0)-c34z(i1,i2).e(1)*p345(1)-c34 & z(i1,i2).e(2)*p345(2)-c34z(i1,i2).e(3)*p345(3) cauxa=-c34z(i1,i2).ek0*quqd+p5k0*cvqd+p345k0*cvqu cauxc=+c34z(i1,i2).ek0*p5(2)-p5k0*c34z(i1,i2).e(2) l5_34fz(i1,i2).a(1)=l5_34fz(i1,i2).a(1)+zer*(cauxa+ceps_0) l5_34fz(i1,i2).a(2)=l5_34fz(i1,i2).a(2)+zel*(cauxa-ceps_0) l5_34fz(i1,i2).c(1)=l5_34fz(i1,i2).c(1)+zer*(cauxc+ceps_1) l5_34fz(i1,i2).c(2)=l5_34fz(i1,i2).c(2)+zel*(-cauxc+ceps_1 & ) END DO END DO *****attaccamento di c34f a 6 * quqd -- p=p125,q=p6 quqd=p125(0)*p6(0)-p125(1)*p6(1)-p125(2)*p6(2)-p125(3)*p6( & 3) DO i1=1,2 DO i2=1,2 * TR0 -- qu=p125,qd=p6,v=c34f(i1,i2).e,a=r6_34fz(i1,i2).a,b=r6_34fz(i1,i2). * b,cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i1,i2).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125 & k0*(c34f(i1,i2).e(2)*p6(3)-p6(2)*c34f(i1,i2).e(3))-p6k0*( & c34f(i1,i2).e(2)*p125(3)-p125(2)*c34f(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i1,i2).e(3)*p6k0+p6(3)*c34f(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34f(i1,i2).e(0)*p125(0)-c34f(i1,i2).e(1)*p125(1)-c34 & f(i1,i2).e(2)*p125(2)-c34f(i1,i2).e(3)*p125(3) cvqd=c34f(i1,i2).e(0)*p6(0)-c34f(i1,i2).e(1)*p6(1)-c34f(i1 & ,i2).e(2)*p6(2)-c34f(i1,i2).e(3)*p6(3) cauxa=-c34f(i1,i2).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34f(i1,i2).ek0*p6(2)+p6k0*c34f(i1,i2).e(2) r6_34fz(i1,i2).a(1)=fer*(cauxa+ceps_0) r6_34fz(i1,i2).a(2)=fel*(cauxa-ceps_0) r6_34fz(i1,i2).b(1)=fel*(cauxb-ceps_2) r6_34fz(i1,i2).b(2)=fer*(-cauxb-ceps_2) END DO END DO *****attaccamento di c34z a 6 DO i1=1,2 DO i2=1,2 * TR0 -- qu=p125,qd=p6,v=c34z(i1,i2).e,a=r6_34fz(i1,i2).a,b=r6_34fz(i1,i2). * b,cr=zer,cl=zel,nsum=1 ceps_0=-c34z(i1,i2).ek0*(p125(2)*p6(3)-p6(2)*p125(3))+p125 & k0*(c34z(i1,i2).e(2)*p6(3)-p6(2)*c34z(i1,i2).e(3))-p6k0*( & c34z(i1,i2).e(2)*p125(3)-p125(2)*c34z(i1,i2).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i1,i2).e(3)*p6k0+p6(3)*c34z(i1,i2).ek0 ceps_2=ceps_2*cim cvqu=c34z(i1,i2).e(0)*p125(0)-c34z(i1,i2).e(1)*p125(1)-c34 & z(i1,i2).e(2)*p125(2)-c34z(i1,i2).e(3)*p125(3) cvqd=c34z(i1,i2).e(0)*p6(0)-c34z(i1,i2).e(1)*p6(1)-c34z(i1 & ,i2).e(2)*p6(2)-c34z(i1,i2).e(3)*p6(3) cauxa=-c34z(i1,i2).ek0*quqd+p125k0*cvqd+p6k0*cvqu cauxb=-c34z(i1,i2).ek0*p6(2)+p6k0*c34z(i1,i2).e(2) r6_34fz(i1,i2).a(1)=r6_34fz(i1,i2).a(1)+zer*(cauxa+ceps_0) r6_34fz(i1,i2).a(2)=r6_34fz(i1,i2).a(2)+zel*(cauxa-ceps_0) r6_34fz(i1,i2).b(1)=r6_34fz(i1,i2).b(1)+zel*(cauxb-ceps_2) r6_34fz(i1,i2).b(2)=r6_34fz(i1,i2).b(2)+zer*(-cauxb-ceps_2 & ) END DO END DO *****attaccamento di c12f(2) a 3 (b) * quqd -- p=p3,q=p123 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 * T -- qu=p3,qd=p123,v=c12f(i).e,a=u3_12fz(i).a,b=u3_12fz(i).b,c=u3_12fz(i) * .c,d=u3_12fz(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2f(i).e(2)*p123(3)-p123(2)*c12f(i).e(3))-p123k0*(c12f(i). & e(2)*p3(3)-p3(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p3k0+p3(3)*c12f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i).e(3)*p123k0+p123(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p3(0)-c12f(i).e(1)*p3(1)-c12f(i).e(2)*p3 & (2)-c12f(i).e(3)*p3(3) cvqd=c12f(i).e(0)*p123(0)-c12f(i).e(1)*p123(1)-c12f(i).e(2 & )*p123(2)-c12f(i).e(3)*p123(3) cauxa=-c12f(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxb=-c12f(i).ek0*p123(2)+p123k0*c12f(i).e(2) cauxc=+c12f(i).ek0*p3(2)-p3k0*c12f(i).e(2) u3_12fz(i).a(1,1)=fqdr*(cauxa+ceps_0) u3_12fz(i).a(2,2)=fqdl*(cauxa-ceps_0) u3_12fz(i).b(1,2)=fqdl*(cauxb-ceps_2) u3_12fz(i).b(2,1)=fqdr*(-cauxb-ceps_2) u3_12fz(i).c(1,2)=fqdr*(cauxc+ceps_1) u3_12fz(i).c(2,1)=fqdl*(-cauxc+ceps_1) u3_12fz(i).d(1,1)=fqdl*c12f(i).ek0 u3_12fz(i).d(2,2)=fqdr*c12f(i).ek0 END DO *****attaccamento di c12z(2) a 3 (b) DO i=1,2 * T -- qu=p3,qd=p123,v=c12z(i).e,a=u3_12fz(i).a,b=u3_12fz(i).b,c=u3_12fz(i) * .c,d=u3_12fz(i).d,cr=zqdr,cl=zqdl,nsum=1 ceps_0=-c12z(i).ek0*(p3(2)*p123(3)-p123(2)*p3(3))+p3k0*(c1 & 2z(i).e(2)*p123(3)-p123(2)*c12z(i).e(3))-p123k0*(c12z(i). & e(2)*p3(3)-p3(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p3k0+p3(3)*c12z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i).e(3)*p123k0+p123(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p3(0)-c12z(i).e(1)*p3(1)-c12z(i).e(2)*p3 & (2)-c12z(i).e(3)*p3(3) cvqd=c12z(i).e(0)*p123(0)-c12z(i).e(1)*p123(1)-c12z(i).e(2 & )*p123(2)-c12z(i).e(3)*p123(3) cauxa=-c12z(i).ek0*quqd+p3k0*cvqd+p123k0*cvqu cauxb=-c12z(i).ek0*p123(2)+p123k0*c12z(i).e(2) cauxc=+c12z(i).ek0*p3(2)-p3k0*c12z(i).e(2) u3_12fz(i).a(1,1)=u3_12fz(i).a(1,1)+zqdr*(cauxa+ceps_0) u3_12fz(i).a(2,2)=u3_12fz(i).a(2,2)+zqdl*(cauxa-ceps_0) u3_12fz(i).b(1,2)=u3_12fz(i).b(1,2)+zqdl*(cauxb-ceps_2) u3_12fz(i).b(2,1)=u3_12fz(i).b(2,1)+zqdr*(-cauxb-ceps_2) u3_12fz(i).c(1,2)=u3_12fz(i).c(1,2)+zqdr*(cauxc+ceps_1) u3_12fz(i).c(2,1)=u3_12fz(i).c(2,1)+zqdl*(-cauxc+ceps_1) u3_12fz(i).d(1,1)=u3_12fz(i).d(1,1)+zqdl*c12z(i).ek0 u3_12fz(i).d(2,2)=u3_12fz(i).d(2,2)+zqdr*c12z(i).ek0 END DO *****attaccamento di c12f(2) a 4 (bbar) * quqd -- p=p356,q=p4 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 * T -- qu=p356,qd=p4,v=c12f(i).e,a=d4_12fz(i).a,b=d4_12fz(i).b,c=d4_12fz(i) * .c,d=d4_12fz(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12f(i).e(2)*p4(3)-p4(2)*c12f(i).e(3))-p4k0*(c12f(i).e(2) & *p356(3)-p356(2)*c12f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i).e(3)*p356k0+p356(3)*c12f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i).e(3)*p4k0+p4(3)*c12f(i).ek0 ceps_2=ceps_2*cim cvqu=c12f(i).e(0)*p356(0)-c12f(i).e(1)*p356(1)-c12f(i).e(2 & )*p356(2)-c12f(i).e(3)*p356(3) cvqd=c12f(i).e(0)*p4(0)-c12f(i).e(1)*p4(1)-c12f(i).e(2)*p4 & (2)-c12f(i).e(3)*p4(3) cauxa=-c12f(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12f(i).ek0*p4(2)+p4k0*c12f(i).e(2) cauxc=+c12f(i).ek0*p356(2)-p356k0*c12f(i).e(2) d4_12fz(i).a(1,1)=fqdr*(cauxa+ceps_0) d4_12fz(i).a(2,2)=fqdl*(cauxa-ceps_0) d4_12fz(i).b(1,2)=fqdl*(cauxb-ceps_2) d4_12fz(i).b(2,1)=fqdr*(-cauxb-ceps_2) d4_12fz(i).c(1,2)=fqdr*(cauxc+ceps_1) d4_12fz(i).c(2,1)=fqdl*(-cauxc+ceps_1) d4_12fz(i).d(1,1)=fqdl*c12f(i).ek0 d4_12fz(i).d(2,2)=fqdr*c12f(i).ek0 END DO *****attaccamento di c12z(2) a 4 (bbar) DO i=1,2 * T -- qu=p356,qd=p4,v=c12z(i).e,a=d4_12fz(i).a,b=d4_12fz(i).b,c=d4_12fz(i) * .c,d=d4_12fz(i).d,cr=zqdr,cl=zqdl,nsum=1 ceps_0=-c12z(i).ek0*(p356(2)*p4(3)-p4(2)*p356(3))+p356k0*( & c12z(i).e(2)*p4(3)-p4(2)*c12z(i).e(3))-p4k0*(c12z(i).e(2) & *p356(3)-p356(2)*c12z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i).e(3)*p356k0+p356(3)*c12z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i).e(3)*p4k0+p4(3)*c12z(i).ek0 ceps_2=ceps_2*cim cvqu=c12z(i).e(0)*p356(0)-c12z(i).e(1)*p356(1)-c12z(i).e(2 & )*p356(2)-c12z(i).e(3)*p356(3) cvqd=c12z(i).e(0)*p4(0)-c12z(i).e(1)*p4(1)-c12z(i).e(2)*p4 & (2)-c12z(i).e(3)*p4(3) cauxa=-c12z(i).ek0*quqd+p356k0*cvqd+p4k0*cvqu cauxb=-c12z(i).ek0*p4(2)+p4k0*c12z(i).e(2) cauxc=+c12z(i).ek0*p356(2)-p356k0*c12z(i).e(2) d4_12fz(i).a(1,1)=d4_12fz(i).a(1,1)+zqdr*(cauxa+ceps_0) d4_12fz(i).a(2,2)=d4_12fz(i).a(2,2)+zqdl*(cauxa-ceps_0) d4_12fz(i).b(1,2)=d4_12fz(i).b(1,2)+zqdl*(cauxb-ceps_2) d4_12fz(i).b(2,1)=d4_12fz(i).b(2,1)+zqdr*(-cauxb-ceps_2) d4_12fz(i).c(1,2)=d4_12fz(i).c(1,2)+zqdr*(cauxc+ceps_1) d4_12fz(i).c(2,1)=d4_12fz(i).c(2,1)+zqdl*(-cauxc+ceps_1) d4_12fz(i).d(1,1)=d4_12fz(i).d(1,1)+zqdl*c12z(i).ek0 d4_12fz(i).d(2,2)=d4_12fz(i).d(2,2)+zqdr*c12z(i).ek0 END DO *****attaccamento di c56f a 3 * quqd -- p=p3,q=p356 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 * T -- qu=p3,qd=p356,v=c56f(i).e,a=u3_56fz(i).a,b=u3_56fz(i).b,c=u3_56fz(i) * .c,d=u3_56fz(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c56f(i).ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c5 & 6f(i).e(2)*p356(3)-p356(2)*c56f(i).e(3))-p356k0*(c56f(i). & e(2)*p3(3)-p3(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p3k0+p3(3)*c56f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56f(i).e(3)*p356k0+p356(3)*c56f(i).ek0 ceps_2=ceps_2*cim cvqu=c56f(i).e(0)*p3(0)-c56f(i).e(1)*p3(1)-c56f(i).e(2)*p3 & (2)-c56f(i).e(3)*p3(3) cvqd=c56f(i).e(0)*p356(0)-c56f(i).e(1)*p356(1)-c56f(i).e(2 & )*p356(2)-c56f(i).e(3)*p356(3) cauxa=-c56f(i).ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxb=-c56f(i).ek0*p356(2)+p356k0*c56f(i).e(2) cauxc=+c56f(i).ek0*p3(2)-p3k0*c56f(i).e(2) u3_56fz(i).a(1,1)=fqdr*(cauxa+ceps_0) u3_56fz(i).a(2,2)=fqdl*(cauxa-ceps_0) u3_56fz(i).b(1,2)=fqdl*(cauxb-ceps_2) u3_56fz(i).b(2,1)=fqdr*(-cauxb-ceps_2) u3_56fz(i).c(1,2)=fqdr*(cauxc+ceps_1) u3_56fz(i).c(2,1)=fqdl*(-cauxc+ceps_1) u3_56fz(i).d(1,1)=fqdl*c56f(i).ek0 u3_56fz(i).d(2,2)=fqdr*c56f(i).ek0 END DO *****attaccamento di c56z a 3 DO i=1,2 * T -- qu=p3,qd=p356,v=c56z(i).e,a=u3_56fz(i).a,b=u3_56fz(i).b,c=u3_56fz(i) * .c,d=u3_56fz(i).d,cr=zqdr,cl=zqdl,nsum=1 ceps_0=-c56z(i).ek0*(p3(2)*p356(3)-p356(2)*p3(3))+p3k0*(c5 & 6z(i).e(2)*p356(3)-p356(2)*c56z(i).e(3))-p356k0*(c56z(i). & e(2)*p3(3)-p3(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p3k0+p3(3)*c56z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56z(i).e(3)*p356k0+p356(3)*c56z(i).ek0 ceps_2=ceps_2*cim cvqu=c56z(i).e(0)*p3(0)-c56z(i).e(1)*p3(1)-c56z(i).e(2)*p3 & (2)-c56z(i).e(3)*p3(3) cvqd=c56z(i).e(0)*p356(0)-c56z(i).e(1)*p356(1)-c56z(i).e(2 & )*p356(2)-c56z(i).e(3)*p356(3) cauxa=-c56z(i).ek0*quqd+p3k0*cvqd+p356k0*cvqu cauxb=-c56z(i).ek0*p356(2)+p356k0*c56z(i).e(2) cauxc=+c56z(i).ek0*p3(2)-p3k0*c56z(i).e(2) u3_56fz(i).a(1,1)=u3_56fz(i).a(1,1)+zqdr*(cauxa+ceps_0) u3_56fz(i).a(2,2)=u3_56fz(i).a(2,2)+zqdl*(cauxa-ceps_0) u3_56fz(i).b(1,2)=u3_56fz(i).b(1,2)+zqdl*(cauxb-ceps_2) u3_56fz(i).b(2,1)=u3_56fz(i).b(2,1)+zqdr*(-cauxb-ceps_2) u3_56fz(i).c(1,2)=u3_56fz(i).c(1,2)+zqdr*(cauxc+ceps_1) u3_56fz(i).c(2,1)=u3_56fz(i).c(2,1)+zqdl*(-cauxc+ceps_1) u3_56fz(i).d(1,1)=u3_56fz(i).d(1,1)+zqdl*c56z(i).ek0 u3_56fz(i).d(2,2)=u3_56fz(i).d(2,2)+zqdr*c56z(i).ek0 END DO *****attaccamento di c56f a 4 * quqd -- p=p123,q=p4 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 * T -- qu=p123,qd=p4,v=c56f(i).e,a=d4_56fz(i).a,b=d4_56fz(i).b,c=d4_56fz(i) * .c,d=d4_56fz(i).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c56f(i).ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*( & c56f(i).e(2)*p4(3)-p4(2)*c56f(i).e(3))-p4k0*(c56f(i).e(2) & *p123(3)-p123(2)*c56f(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i).e(3)*p123k0+p123(3)*c56f(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56f(i).e(3)*p4k0+p4(3)*c56f(i).ek0 ceps_2=ceps_2*cim cvqu=c56f(i).e(0)*p123(0)-c56f(i).e(1)*p123(1)-c56f(i).e(2 & )*p123(2)-c56f(i).e(3)*p123(3) cvqd=c56f(i).e(0)*p4(0)-c56f(i).e(1)*p4(1)-c56f(i).e(2)*p4 & (2)-c56f(i).e(3)*p4(3) cauxa=-c56f(i).ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56f(i).ek0*p4(2)+p4k0*c56f(i).e(2) cauxc=+c56f(i).ek0*p123(2)-p123k0*c56f(i).e(2) d4_56fz(i).a(1,1)=fqdr*(cauxa+ceps_0) d4_56fz(i).a(2,2)=fqdl*(cauxa-ceps_0) d4_56fz(i).b(1,2)=fqdl*(cauxb-ceps_2) d4_56fz(i).b(2,1)=fqdr*(-cauxb-ceps_2) d4_56fz(i).c(1,2)=fqdr*(cauxc+ceps_1) d4_56fz(i).c(2,1)=fqdl*(-cauxc+ceps_1) d4_56fz(i).d(1,1)=fqdl*c56f(i).ek0 d4_56fz(i).d(2,2)=fqdr*c56f(i).ek0 END DO *****attaccamento di c56z a 4 DO i=1,2 * T -- qu=p123,qd=p4,v=c56z(i).e,a=d4_56fz(i).a,b=d4_56fz(i).b,c=d4_56fz(i) * .c,d=d4_56fz(i).d,cr=zqdr,cl=zqdl,nsum=1 ceps_0=-c56z(i).ek0*(p123(2)*p4(3)-p4(2)*p123(3))+p123k0*( & c56z(i).e(2)*p4(3)-p4(2)*c56z(i).e(3))-p4k0*(c56z(i).e(2) & *p123(3)-p123(2)*c56z(i).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i).e(3)*p123k0+p123(3)*c56z(i).ek0 ceps_1=ceps_1*cim ceps_2=-c56z(i).e(3)*p4k0+p4(3)*c56z(i).ek0 ceps_2=ceps_2*cim cvqu=c56z(i).e(0)*p123(0)-c56z(i).e(1)*p123(1)-c56z(i).e(2 & )*p123(2)-c56z(i).e(3)*p123(3) cvqd=c56z(i).e(0)*p4(0)-c56z(i).e(1)*p4(1)-c56z(i).e(2)*p4 & (2)-c56z(i).e(3)*p4(3) cauxa=-c56z(i).ek0*quqd+p123k0*cvqd+p4k0*cvqu cauxb=-c56z(i).ek0*p4(2)+p4k0*c56z(i).e(2) cauxc=+c56z(i).ek0*p123(2)-p123k0*c56z(i).e(2) d4_56fz(i).a(1,1)=d4_56fz(i).a(1,1)+zqdr*(cauxa+ceps_0) d4_56fz(i).a(2,2)=d4_56fz(i).a(2,2)+zqdl*(cauxa-ceps_0) d4_56fz(i).b(1,2)=d4_56fz(i).b(1,2)+zqdl*(cauxb-ceps_2) d4_56fz(i).b(2,1)=d4_56fz(i).b(2,1)+zqdr*(-cauxb-ceps_2) d4_56fz(i).c(1,2)=d4_56fz(i).c(1,2)+zqdr*(cauxc+ceps_1) d4_56fz(i).c(2,1)=d4_56fz(i).c(2,1)+zqdl*(-cauxc+ceps_1) d4_56fz(i).d(1,1)=d4_56fz(i).d(1,1)+zqdl*c56z(i).ek0 d4_56fz(i).d(2,2)=d4_56fz(i).d(2,2)+zqdr*c56z(i).ek0 END DO **************arrivato qui bisogna decidere quanti indici usare **** Diagramma CN1 **** DO i3=1,2 DO i4=1,2 DO i5=1,2 * TLTR0 -- aa=cn1(&,&,i3,i4,i5,i5).i(iset),a1=l1_34fz(i3,i4).a,c1=l1_34fz(i * 3,i4).c,a2=r2_56fz(i5).a,b2=r2_56fz(i5).b,prq=p134q,bef=,aft=/(p134q*p134k * 0) cn1(1,1,i3,i4,i5,i5).i(iset)=(l1_34fz(i3,i4).a(1)*r2_56fz( & i5).a(1)+l1_34fz(i3,i4).c(1)*p134q*r2_56fz(i5).b(2)) & /(p13 & 4q*p134k0) cn1(2,2,i3,i4,i5,i5).i(iset)=(l1_34fz(i3,i4).c(2)*p134q*r2 & _56fz(i5).b(1)+l1_34fz(i3,i4).a(2)*r2_56fz(i5).a(2)) & /(p13 & 4q*p134k0) END DO END DO END DO **** Diagramma CN2 **** DO i3=1,2 DO i4=1,2 DO i5=1,2 * TLTR0 -- aa=cn2(&,&,i3,i4,i5,i5).i(iset),a1=l1_56fz(i5).a,c1=l1_56fz(i5). * c,a2=r2_34fz(i3,i4).a,b2=r2_34fz(i3,i4).b,prq=p156q,bef=,aft=/(p156q*p156k * 0) cn2(1,1,i3,i4,i5,i5).i(iset)=(l1_56fz(i5).a(1)*r2_34fz(i3, & i4).a(1)+l1_56fz(i5).c(1)*p156q*r2_34fz(i3,i4).b(2)) & /(p15 & 6q*p156k0) cn2(2,2,i3,i4,i5,i5).i(iset)=(l1_56fz(i5).c(2)*p156q*r2_34 & fz(i3,i4).b(1)+l1_56fz(i5).a(2)*r2_34fz(i3,i4).a(2)) & /(p15 & 6q*p156k0) END DO END DO END DO **** Diagramma CN3 **** DO i1=1,2 DO i5=1,2 * TT -- aa=dia3(i1,i5).a,bb=dia3(i1,i5).b,cc=dia3(i1,i5).c,dd=dia3(i1,i5).d * ,a1=u3_56fz(i5).a,b1=u3_56fz(i5).b,c1=u3_56fz(i5).c,d1=u3_56fz(i5).d,a2=d4 * _12fz(i1).a,b2=d4_12fz(i1).b,c2=d4_12fz(i1).c,d2=d4_12fz(i1).d,prq=p356q,m * =rmb,nsum=0 dia3(i1,i5).a(1,1)=u3_56fz(i5).a(1,1)*d4_12fz(i1).a(1,1)+u & 3_56fz(i5).c(1,2)*p356q*d4_12fz(i1).b(2,1) dia3(i1,i5).b(1,1)=rmb*(u3_56fz(i5).d(1,1)*d4_12fz(i1).a(1 & ,1)+u3_56fz(i5).b(1,2)*d4_12fz(i1).b(2,1)) dia3(i1,i5).c(1,1)=rmb*(u3_56fz(i5).a(1,1)*d4_12fz(i1).d(1 & ,1)+u3_56fz(i5).c(1,2)*d4_12fz(i1).c(2,1)) dia3(i1,i5).d(1,1)=u3_56fz(i5).d(1,1)*p356q*d4_12fz(i1).d( & 1,1)+u3_56fz(i5).b(1,2)*d4_12fz(i1).c(2,1) dia3(i1,i5).a(1,2)=rmb*(u3_56fz(i5).a(1,1)*d4_12fz(i1).b(1 & ,2)+u3_56fz(i5).c(1,2)*d4_12fz(i1).a(2,2)) dia3(i1,i5).b(1,2)=u3_56fz(i5).d(1,1)*p356q*d4_12fz(i1).b( & 1,2)+u3_56fz(i5).b(1,2)*d4_12fz(i1).a(2,2) dia3(i1,i5).c(1,2)=u3_56fz(i5).a(1,1)*d4_12fz(i1).c(1,2)+u & 3_56fz(i5).c(1,2)*p356q*d4_12fz(i1).d(2,2) dia3(i1,i5).d(1,2)=rmb*(u3_56fz(i5).d(1,1)*d4_12fz(i1).c(1 & ,2)+u3_56fz(i5).b(1,2)*d4_12fz(i1).d(2,2)) dia3(i1,i5).a(2,1)=rmb*(u3_56fz(i5).c(2,1)*d4_12fz(i1).a(1 & ,1)+u3_56fz(i5).a(2,2)*d4_12fz(i1).b(2,1)) dia3(i1,i5).b(2,1)=u3_56fz(i5).b(2,1)*d4_12fz(i1).a(1,1)+u & 3_56fz(i5).d(2,2)*p356q*d4_12fz(i1).b(2,1) dia3(i1,i5).c(2,1)=u3_56fz(i5).c(2,1)*p356q*d4_12fz(i1).d( & 1,1)+u3_56fz(i5).a(2,2)*d4_12fz(i1).c(2,1) dia3(i1,i5).d(2,1)=rmb*(u3_56fz(i5).b(2,1)*d4_12fz(i1).d(1 & ,1)+u3_56fz(i5).d(2,2)*d4_12fz(i1).c(2,1)) dia3(i1,i5).a(2,2)=u3_56fz(i5).c(2,1)*p356q*d4_12fz(i1).b( & 1,2)+u3_56fz(i5).a(2,2)*d4_12fz(i1).a(2,2) dia3(i1,i5).b(2,2)=rmb*(u3_56fz(i5).b(2,1)*d4_12fz(i1).b(1 & ,2)+u3_56fz(i5).d(2,2)*d4_12fz(i1).a(2,2)) dia3(i1,i5).c(2,2)=rmb*(u3_56fz(i5).c(2,1)*d4_12fz(i1).c(1 & ,2)+u3_56fz(i5).a(2,2)*d4_12fz(i1).d(2,2)) dia3(i1,i5).d(2,2)=u3_56fz(i5).b(2,1)*d4_12fz(i1).c(1,2)+u & 3_56fz(i5).d(2,2)*p356q*d4_12fz(i1).d(2,2) END DO END DO DO i1=1,2 DO i5=1,2 * mline -- res=cn3(i1,i1,&1,&2,i5,i5).i(iset),abcd=dia3(i1,i5).,m1=rmb,m2=( * -rmb),den=((p356q-rmb2)*p356k0),nsum=0 DO iut=1,2 DO jut=1,2 cn3(i1,i1,iut,jut,i5,i5).i(iset)=(dia3(i1,i5).a(iut,jut) & +r & mb*dia3(i1,i5).b(iut,jut)+(-rmb)*dia3(i1,i5).c(iut, & jut)+r & mb*(-rmb)*dia3(i1,i5).d(iut,jut))/((p356q-rmb2) & *p356k0) ENDDO ENDDO END DO END DO **** Diagramma CN4 **** DO i1=1,2 DO i5=1,2 * TT -- aa=dia4(i1,i5).a,bb=dia4(i1,i5).b,cc=dia4(i1,i5).c,dd=dia4(i1,i5).d * ,a1=u3_12fz(i1).a,b1=u3_12fz(i1).b,c1=u3_12fz(i1).c,d1=u3_12fz(i1).d,a2=d4 * _56fz(i5).a,b2=d4_56fz(i5).b,c2=d4_56fz(i5).c,d2=d4_56fz(i5).d,prq=p123q,m * =rmb,nsum=0 dia4(i1,i5).a(1,1)=u3_12fz(i1).a(1,1)*d4_56fz(i5).a(1,1)+u & 3_12fz(i1).c(1,2)*p123q*d4_56fz(i5).b(2,1) dia4(i1,i5).b(1,1)=rmb*(u3_12fz(i1).d(1,1)*d4_56fz(i5).a(1 & ,1)+u3_12fz(i1).b(1,2)*d4_56fz(i5).b(2,1)) dia4(i1,i5).c(1,1)=rmb*(u3_12fz(i1).a(1,1)*d4_56fz(i5).d(1 & ,1)+u3_12fz(i1).c(1,2)*d4_56fz(i5).c(2,1)) dia4(i1,i5).d(1,1)=u3_12fz(i1).d(1,1)*p123q*d4_56fz(i5).d( & 1,1)+u3_12fz(i1).b(1,2)*d4_56fz(i5).c(2,1) dia4(i1,i5).a(1,2)=rmb*(u3_12fz(i1).a(1,1)*d4_56fz(i5).b(1 & ,2)+u3_12fz(i1).c(1,2)*d4_56fz(i5).a(2,2)) dia4(i1,i5).b(1,2)=u3_12fz(i1).d(1,1)*p123q*d4_56fz(i5).b( & 1,2)+u3_12fz(i1).b(1,2)*d4_56fz(i5).a(2,2) dia4(i1,i5).c(1,2)=u3_12fz(i1).a(1,1)*d4_56fz(i5).c(1,2)+u & 3_12fz(i1).c(1,2)*p123q*d4_56fz(i5).d(2,2) dia4(i1,i5).d(1,2)=rmb*(u3_12fz(i1).d(1,1)*d4_56fz(i5).c(1 & ,2)+u3_12fz(i1).b(1,2)*d4_56fz(i5).d(2,2)) dia4(i1,i5).a(2,1)=rmb*(u3_12fz(i1).c(2,1)*d4_56fz(i5).a(1 & ,1)+u3_12fz(i1).a(2,2)*d4_56fz(i5).b(2,1)) dia4(i1,i5).b(2,1)=u3_12fz(i1).b(2,1)*d4_56fz(i5).a(1,1)+u & 3_12fz(i1).d(2,2)*p123q*d4_56fz(i5).b(2,1) dia4(i1,i5).c(2,1)=u3_12fz(i1).c(2,1)*p123q*d4_56fz(i5).d( & 1,1)+u3_12fz(i1).a(2,2)*d4_56fz(i5).c(2,1) dia4(i1,i5).d(2,1)=rmb*(u3_12fz(i1).b(2,1)*d4_56fz(i5).d(1 & ,1)+u3_12fz(i1).d(2,2)*d4_56fz(i5).c(2,1)) dia4(i1,i5).a(2,2)=u3_12fz(i1).c(2,1)*p123q*d4_56fz(i5).b( & 1,2)+u3_12fz(i1).a(2,2)*d4_56fz(i5).a(2,2) dia4(i1,i5).b(2,2)=rmb*(u3_12fz(i1).b(2,1)*d4_56fz(i5).b(1 & ,2)+u3_12fz(i1).d(2,2)*d4_56fz(i5).a(2,2)) dia4(i1,i5).c(2,2)=rmb*(u3_12fz(i1).c(2,1)*d4_56fz(i5).c(1 & ,2)+u3_12fz(i1).a(2,2)*d4_56fz(i5).d(2,2)) dia4(i1,i5).d(2,2)=u3_12fz(i1).b(2,1)*d4_56fz(i5).c(1,2)+u & 3_12fz(i1).d(2,2)*p123q*d4_56fz(i5).d(2,2) END DO END DO DO i1=1,2 DO i5=1,2 * mline -- res=cn4(i1,i1,&1,&2,i5,i5).i(iset),abcd=dia4(i1,i5).,m1=rmb,m2=( * -rmb),den=((p123q-rmb2)*p123k0),nsum=0 DO iut=1,2 DO jut=1,2 cn4(i1,i1,iut,jut,i5,i5).i(iset)=(dia4(i1,i5).a(iut,jut) & +r & mb*dia4(i1,i5).b(iut,jut)+(-rmb)*dia4(i1,i5).c(iut, & jut)+r & mb*(-rmb)*dia4(i1,i5).d(iut,jut))/((p123q-rmb2) & *p123k0) ENDDO ENDDO END DO END DO **** Diagramma CN5 **** DO i1=1,2 DO i3=1,2 DO i4=1,2 * TLTR0 -- aa=cn5(i1,i1,i3,i4,&,&).i(iset),a1=l5_34fz(i3,i4).a,c1=l5_34fz(i * 3,i4).c,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,prq=p345q,bef=,aft=/(p345q*p345k * 0) cn5(i1,i1,i3,i4,1,1).i(iset)=(l5_34fz(i3,i4).a(1)*r6_12fz( & i1).a(1)+l5_34fz(i3,i4).c(1)*p345q*r6_12fz(i1).b(2)) & /(p34 & 5q*p345k0) cn5(i1,i1,i3,i4,2,2).i(iset)=(l5_34fz(i3,i4).c(2)*p345q*r6 & _12fz(i1).b(1)+l5_34fz(i3,i4).a(2)*r6_12fz(i1).a(2)) & /(p34 & 5q*p345k0) END DO END DO END DO **** Diagramma CN6 **** DO i1=1,2 DO i3=1,2 DO i4=1,2 * TLTR0 -- aa=cn6(i1,i1,i3,i4,&,&).i(iset),a1=l5_12fz(i1).a,c1=l5_12fz(i1). * c,a2=r6_34fz(i3,i4).a,b2=r6_34fz(i3,i4).b,prq=p125q,bef=,aft=/(p125q*p125k * 0) cn6(i1,i1,i3,i4,1,1).i(iset)=(l5_12fz(i1).a(1)*r6_34fz(i3, & i4).a(1)+l5_12fz(i1).c(1)*p125q*r6_34fz(i3,i4).b(2)) & /(p12 & 5q*p125k0) cn6(i1,i1,i3,i4,2,2).i(iset)=(l5_12fz(i1).c(2)*p125q*r6_34 & fz(i3,i4).b(1)+l5_12fz(i1).a(2)*r6_34fz(i3,i4).a(2)) & /(p12 & 5q*p125k0) END DO END DO END DO * Introduco l' Higgs IF (imix.EQ.1.OR.imix.EQ.-2) then * Diagramma segnale di Higgs * Vertice b b~ H ( quarks massivi ) * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) * TH -- qu=p3,qd=p4,a=v34h.a,b=v34h.b,c=v34h.c v34h.a(1,2)=-p3k0*p4(2)+p4k0*p3(2)-cim*(p4(3)*p3k0-p3(3)*p & 4k0) v34h.a(2,1)=-conjg(v34h.a(1,2)) v34h.b(1,1)=p4k0 v34h.b(2,2)=v34h.b(1,1) v34h.c(1,1)=p3k0 v34h.c(2,2)=v34h.c(1,1) * mline -- res=c34h(&1,&2),abcd=v34h.,m1=rmb,m2=(-rmb),den=cdh,nsum=0 DO iut=1,2 DO jut=1,2 c34h(iut,jut)=(v34h.a(iut,jut)+rmb*v34h.b(iut,jut)+(-rmb)* & v34h.c(iut,jut)+rmb*(-rmb)*v34h.d(iut,jut))/cdh ENDDO ENDDO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 ch(i1,i1,i3,i4,i5,i5).i(iset)=rhzz* & (c56z(i5).e(0)*c12z(i1).e(0)- & c56z(i5).e(1)*c12z(i1).e(1)-c56z(i5).e(2)* & c12z(i1).e(2)-c56z(i5).e(3)*c12z(i1).e(3))*c34h(i3, & i4) ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 ENDIF END DO !iset **************************somma grafici***************************** if (ifirst.eq.1) then IF(istrcor.EQ.1)THEN fatcor_hh=(1.d0+qcdcor_h)/(1.d0+qcdcor_nc) fatcor_hz=sqrt((1.d0+qcdcor_nc)*(1.d0+qcdcor_h)) & /(1.d0+qcdcor_nc) ELSE fatcor_hh=1.d0 fatcor_hz=1.d0 ENDIF ifirst=0 endif * gli indici del primo set sono 1 2 3 4 5 6 * quelli del secondo 5 2 3 4 1 6 res=0.d0 DO i=1,2 DO i3=1,2 DO i4=1,2 IF (imix.EQ.-1.or.imix.eq.-2) then cres=cn1(i,i,i3,i4,i,i).i(1)+cn2(i,i,i3,i4,i,i).i(1)+ & cn3(i,i,i3,i4,i,i).i(1)+cn4(i,i,i3,i4,i,i).i(1)+ & cn5(i,i,i3,i4,i,i).i(1)+cn6(i,i,i3,i4,i,i).i(1) & -cn1(i,i,i3,i4,i,i).i(2)-cn2(i,i,i3,i4,i,i).i(2)- & cn3(i,i,i3,i4,i,i).i(2)-cn4(i,i,i3,i4,i,i).i(2)- & cn5(i,i,i3,i4,i,i).i(2)-cn6(i,i,i3,i4,i,i).i(2) res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=ch(i,i,i3,i4,i,i).i(1)-ch(i,i,i3,i4,i,i).i(2) IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres)) & *fatcor_hz ENDIF ENDIF END DO END DO END DO DO i=1,2 j=mod(i,2)+1 DO i3=1,2 DO i4=1,2 IF (imix.EQ.-1.or.imix.eq.-2) then cres=cn1(i,i,i3,i4,j,j).i(1)+cn2(i,i,i3,i4,j,j).i(1)+ & cn3(i,i,i3,i4,j,j).i(1)+cn4(i,i,i3,i4,j,j).i(1)+ & cn5(i,i,i3,i4,j,j).i(1)+cn6(i,i,i3,i4,j,j).i(1) res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=ch(i,i,i3,i4,j,j).i(1) IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres)) & *fatcor_hz ENDIF ENDIF IF (imix.EQ.-1.or.imix.eq.-2) then cres=-cn1(i,i,i3,i4,j,j).i(2)-cn2(i,i,i3,i4,j,j).i(2)- & cn3(i,i,i3,i4,j,j).i(2)-cn4(i,i,i3,i4,j,j).i(2)- & cn5(i,i,i3,i4,j,j).i(2)-cn6(i,i,i3,i4,j,j).i(2) res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=-ch(i,i,i3,i4,j,j).i(2) IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres)) & *fatcor_hz ENDIF ENDIF END DO END DO END DO rden=4.d0 * el1 IF(i3q.EQ.1)THEN rc=3.d0 ELSE rc=1.d0 ENDIF * endel1 ee_bbee=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/rden IF (istrcor.EQ.1) THEN ee_bbee=ee_bbee*(1.d0+qcdcor_nc) ENDIF RETURN END SUBROUTINE vegas(region,ndim,fxn,init,ncall,itmx,nprn,tgral,sd, * chi2a,acc,xi,it,ndo,si,swgt,schi) Cc ho aggiunto acc INTEGER init,itmx,ncall,ndim,nprn,ndmx,mxdim,ncall_eff REAL*8 tgral,chi2a,sd,acc,region(2*ndim),fxn,alph,tiny PARAMETER (alph=1.5,ndmx=50,mxdim=10,tiny=1.e-30) C PARAMETER (ALPH=1.5,NDMX=100,MXDIM=10,TINY=1.e-30) EXTERNAL fxn CU USES fxn,ran2,rebin INTEGER i,idum,it,j,k,mds,nd,ndo,ng,npg,ia(mxdim),kg(mxdim) REAL*8 calls,dv2g,dxg,f,f2,f2b,fb,rc,ti,tsi,wgt,xjac,xn,xnd,xo, *d(ndmx,mxdim),di(ndmx,mxdim),dt(mxdim),dx(mxdim),r(ndmx),x(mxdim), *xi(ndmx,mxdim),xin(ndmx),ran2 REAL*8 schi,si,swgt,resl,standdevl COMMON/abresl/resl(10),standdevl(10) COMMON /abrann/ idum COMMON/abchia/calls COMMON/abstat/ncall_eff COMMON/abfla2/irepeat,nevent,nflevts DATA mds/1/ SAVE IF(init.LE.0)THEN mds=1 ndo=1 C** it=1 C** DO 11 j=1,ndim xi(1,j)=1. 11 CONTINUE ENDIF IF (init.LE.1)THEN si=0. swgt=0. schi=0. C** it=1 C** ENDIF IF (init.LE.2)THEN nd=ndmx ng=1 IF(mds.NE.0)THEN ng=(ncall/2.+0.25)**(1./ndim) mds=1 IF((2*ng-ndmx).ge.0)then mds=-1 npg=ng/ndmx+1 nd=ng/npg ng=npg*nd ENDIF ENDIF k=ng**ndim npg=max(ncall/k,2) calls=npg*k dxg=1./ng dv2g=(calls*dxg**ndim)**2/npg/npg/(npg-1.) xnd=nd dxg=dxg*xnd xjac=1./calls DO 12 j=1,ndim dx(j)=region(j+ndim)-region(j) xjac=xjac*dx(j) 12 CONTINUE IF(nd.NE.ndo)THEN DO 13 i=1,nd r(i)=1. 13 CONTINUE DO 14 j=1,ndim CALL rebin(ndo/xnd,nd,r,xin,xi(1,j)) 14 CONTINUE ndo=nd ENDIF IF(nprn.GE.0) WRITE(*,200) ndim,calls,it,itmx ENDIF DO 28 it=it,itmx C** IF(it.GE.2.AND.acc*abs(tgral).ge.sd) RETURN C** ti=0. tsi=0. DO 16 j=1,ndim kg(j)=1 DO 15 i=1,nd d(i,j)=0. di(i,j)=0. 15 CONTINUE 16 CONTINUE 10 CONTINUE c aggiunta per far scegliere a caso cella in cui valutare funzione c per generazione piatta con numero determinato di eventi nflevts IF (irepeat.EQ.2) THEN DO WHILE (nevent.LT.nflevts) wgt=xjac DO j=1,ndim kg(j)=ran2(idum)*ng+1 xn=(kg(j)-ran2(idum))*dxg+1. ia(j)=max(min(int(xn),ndmx),1) IF(ia(j).GT.1)THEN xo=xi(ia(j),j)-xi(ia(j)-1,j) rc=xi(ia(j)-1,j)+(xn-ia(j))*xo ELSE xo=xi(ia(j),j) rc=(xn-ia(j))*xo ENDIF x(j)=region(j)+rc*dx(j) wgt=wgt*xo*xnd END DO f=wgt*fxn(x,wgt) END DO RETURN ENDIF fb=0. f2b=0. DO 19 k=1,npg wgt=xjac DO 17 j=1,ndim xn=(kg(j)-ran2(idum))*dxg+1. ia(j)=max(min(int(xn),ndmx),1) IF(ia(j).GT.1)THEN xo=xi(ia(j),j)-xi(ia(j)-1,j) rc=xi(ia(j)-1,j)+(xn-ia(j))*xo ELSE xo=xi(ia(j),j) rc=(xn-ia(j))*xo ENDIF x(j)=region(j)+rc*dx(j) wgt=wgt*xo*xnd 17 CONTINUE f=wgt*fxn(x,wgt) f2=f*f fb=fb+f f2b=f2b+f2 DO 18 j=1,ndim di(ia(j),j)=di(ia(j),j)+f IF(mds.GE.0) d(ia(j),j)=d(ia(j),j)+f2 18 CONTINUE 19 CONTINUE f2b=sqrt(f2b*npg) f2b=(f2b-fb)*(f2b+fb) IF (f2b.LE.0.) f2b=tiny ti=ti+fb tsi=tsi+f2b IF(mds.LT.0)THEN DO 21 j=1,ndim d(ia(j),j)=d(ia(j),j)+f2b 21 CONTINUE ENDIF DO 22 k=ndim,1,-1 kg(k)=mod(kg(k),ng)+1 IF(kg(k).NE.1) GOTO 10 22 CONTINUE tsi=tsi*dv2g wgt=1./tsi si=si+dble(wgt)*dble(ti) schi=schi+dble(wgt)*dble(ti)**2 swgt=swgt+dble(wgt) tgral=si/swgt chi2a=max((schi-si*tgral)/(it-.99d0),0.d0) sd=sqrt(1./swgt) tsi=sqrt(tsi) IF(nprn.GE.0)THEN C** aggiunta di ncall_eff e sua inizializzazione dopo ogni iterazione C** ho modificato anche il FORMAT 201 WRITE(*,201) it,ncall_eff,it,ti,tsi,tgral,sd,chi2a ncall_eff=0 resl(it)=ti standdevl(it)=tsi IF(nprn.NE.0)THEN DO 23 j=1,ndim WRITE(*,202) j,(xi(i,j),di(i,j),i=1+nprn/2,nd,nprn) 23 CONTINUE ENDIF ENDIF c** era qui l'aggiunta DO 25 j=1,ndim xo=d(1,j) xn=d(2,j) d(1,j)=(xo+xn)/2. dt(j)=d(1,j) DO 24 i=2,nd-1 rc=xo+xn xo=xn xn=d(i+1,j) d(i,j)=(rc+xn)/3. dt(j)=dt(j)+d(i,j) 24 CONTINUE d(nd,j)=(xo+xn)/2. dt(j)=dt(j)+d(nd,j) 25 CONTINUE DO 27 j=1,ndim rc=0. DO 26 i=1,nd IF(d(i,j).lt.tiny) d(i,j)=tiny r(i)=((1.-d(i,j)/dt(j))/(log(dt(j))-log(d(i,j))))**alph rc=rc+r(i) 26 CONTINUE CALL rebin(rc/xnd,nd,r,xin,xi(1,j)) 27 CONTINUE 28 CONTINUE RETURN 200 FORMAT(/' input parameters for vegas: ndim=',i3,' ncall=', *f12.0/28x,' it=',i5,' itmx=',i5) 201 FORMAT(/' iteration no.',i3,':',12x,'effective ncall=',i11/ *' iteration no.',i3,': ','integral =',g14.7,'+/- ',g9.2/ *' all iterations: integral =',g14.7,'+/- ',g9.3,' chi**2/it' *'n =',g9.2) 202 FORMAT(/' data for axis ',i2/' X delta i ', *' x delta i ',' x delta i ',/(1x, *f7.5,1x,g11.4,5x,f7.5,1x,g11.4,5x,f7.5,1x,g11.4)) END C (C) Copr. 1986-92 Numerical Recipes Software #>,1')5c). FUNCTION ran2(idum) INTEGER idum,im1,im2,imm1,ia1,ia2,iq1,iq2,ir1,ir2,ntab,ndiv REAL*8 ran2,am,eps,rnmx PARAMETER (im1=2147483563,im2=2147483399,am=1./im1,imm1=im1-1, *ia1=40014,ia2=40692,iq1=53668,iq2=52774,ir1=12211,ir2=3791, *ntab=32,ndiv=1+imm1/ntab,eps=1.2e-7,rnmx=1.-eps) INTEGER idum2,j,k,iv(ntab),iy COMMON/absalv/iv,iy,idum2 DATA idum2/123456789/, iv/ntab*0/, iy/0/ IF (idum.LE.0) THEN idum=max(-idum,1) idum2=idum DO 11 j=ntab+8,1,-1 k=idum/iq1 idum=ia1*(idum-k*iq1)-k*ir1 IF (idum.LT.0) idum=idum+im1 IF (j.LE.ntab) iv(j)=idum 11 CONTINUE iy=iv(1) ENDIF k=idum/iq1 idum=ia1*(idum-k*iq1)-k*ir1 IF (idum.LT.0) idum=idum+im1 k=idum2/iq2 idum2=ia2*(idum2-k*iq2)-k*ir2 IF (idum2.LT.0) idum2=idum2+im2 j=1+iy/ndiv iy=iv(j)-idum2 iv(j)=idum IF(iy.LT.1)iy=iy+imm1 ran2=min(am*iy,rnmx) RETURN END C (C) Copr. 1986-92 Numerical Recipes Software #>,1')5c). SUBROUTINE rebin(rc,nd,r,xin,xi) INTEGER nd REAL*8 rc,r(*),xi(*),xin(*) INTEGER i,k REAL*8 dr,xn,xo k=0 xn=0. dr=0. DO 11 i=1,nd-1 1 IF(rc.GT.dr)THEN k=k+1 dr=dr+r(k) xo=xn xn=xi(k) GOTO 1 ENDIF dr=dr-rc xin(i)=xn-(xn-xo)*dr/r(k) 11 CONTINUE DO 12 i=1,nd-1 xi(i)=xin(i) 12 CONTINUE xi(nd)=1. RETURN END C (C) Copr. 1986-92 Numerical Recipes Software #>,1')5c). C Subroutine AB_LU4FRM C C The following subroutine is a modification of the generic interface C LU4FRM.FOR (by T. Sjostrand) for a 4-fermion code to Jetset. C It is intended for use in connection with WPHACT. C...An electroweak generator is supposed to C...have produced two fermions, two antifermions and an arbitrary C...number of photons. These particles are stored in the HEPEVT C...common block. The allowed order is specified by a standard. C...In brief, the final fermions should appear in the order C...fermion (1) - antifermion (2) - fermion (3) - antifermion (4). C...The flavour pairs should be arranged so that, if possible, the C...first two could come from a W+ and the second two from a W-; C...else each pair should have flavours consistent with a Z0. C...The subroutine LU4FRM is supposed to read the configuration, C...and call JETSET to do parton showers and fragmentation. C The colour flow need not be unique. C WPHACT however generates events in which the color structure is well C defined (with probability corresponding to the relative contribution if C both structures are) C and indicated by the integer input ichar: C ICHAR=0 corresponds to the color structure characteristic of neutral C currents (NC) with no identical particles in the final state, C i.e. (1) (2) and (3) (4) are color singlets. C ICHAR=1 corresponds to the color structure characteristic of charged C currents (CC), in which (1) (4) and (2) (3) are color singlets. C When both color structures are possible, one is chosen with probability C proportional to its contribution to the cross section. A flag C of WPHACT determines wether the interference is added to CC or NC. C...Final-state QED radiation may be allowed or inhibited: C...IRAD = 0 : no final-state photon radiation. C... = 1 : photon radiation inside each final fermion pair. C... C...tau lepton decay may be handled by QCD generator or not. C...ITAU = 0 : taus are considered stable by QCD generator. C... = 1 : taus are allowed to decay by QCD generator. C... C...IERR is an error flag, used both as input and output. C...At input, 0 means leave routine in case of error, C... nonzero means stop program execution. C...At output, 0 means acceptable fermion configuration, C... nonzero means treatment aborted for some reason. C...It is up to the writer of the main program to pick error strategy, C...i.e. to let the program crash or try to fix errors. SUBROUTINE AB_LU4FRM(ichar,IRAD,ITAU,IERR) COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) DIMENSION IJOIN(2) C...Call LUHEPC to convert from HEPEVT to LUJETS common. INERR=0 MSTU(28)=0 CALL LUHEPC(2) IF(MSTU(28).EQ.8) INERR=1 C...Loop through entries and pick up all final fermions/antifermions. I1=0 I2=0 I3=0 I4=0 DO 100 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 KFA=IABS(K(I,2)) IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN IF(K(I,2).GT.0) THEN IF(I1.EQ.0) THEN I1=I ELSEIF(I3.EQ.0) THEN I3=I ELSE INERR=2 CALL LUERRM(6,'(LU4FRM:) more than two fermions') ENDIF ELSE IF(I2.EQ.0) THEN I2=I ELSEIF(I4.EQ.0) THEN I4=I ELSE INERR=3 CALL LUERRM(6,'(LU4FRM:) more than two antifermions') ENDIF ENDIF ENDIF 100 CONTINUE C...Check that event is arranged according to conventions. IF(I1.EQ.0.OR.I2.EQ.0.OR.I3.EQ.0.OR.I4.EQ.0) THEN INERR=4 CALL LUERRM(6,'(LU4FRM:) event contains too few fermions') ENDIF IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN INERR=5 CALL LUERRM(6,'(LU4FRM:) fermions arranged in wrong order') ENDIF C...Check which fermion pairs are quarks and which leptons. IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN IQL12=1 ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN IQL12=2 ELSE INERR=6 CALL LUERRM(6,'(LU4FRM:) first fermion pair inconsistent') ENDIF IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN IQL34=1 ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN IQL34=2 ELSE INERR=7 CALL LUERRM(6,'(LU4FRM:) second fermion pair inconsistent') ENDIF C...Return or stop program in case of problems. IF(INERR.EQ.0) THEN IERR=0 ELSEIF(IERR.EQ.0) THEN IERR=INERR RETURN ELSE WRITE(6,*) ' ERROR: listing of faulty event follows:' CALL LULIST(2) WRITE(6,*) ' Fermions found in lines ',I1,I2,I3,I4 WRITE(6,*) ' Error type in event above is ',INERR WRITE(6,*) ' Program execution will be stopped now' WRITE(6,*) ' since main program does not correct errors!' STOP ENDIF C...Decide whether to allow or not photon radiation in showers. MSTJ(41)=2 IF(IRAD.EQ.0) MSTJ(41)=1 C...Decide on colour pairing. IF(IQL12.EQ.2.AND.IQL34.EQ.2) THEN NPAIR=0 ELSEIF(IQL12.EQ.1.AND.IQL34.EQ.2) THEN NPAIR=1 IP1=I1 IP2=I2 ELSEIF(IQL12.EQ.2.AND.IQL34.EQ.1) THEN NPAIR=1 IP1=I3 IP2=I4 ELSE NPAIR=2 IP1=I1 IP3=I3 IF(ichar.EQ.0) THEN IP2=I2 IP4=I4 ELSE IP2=I4 IP4=I2 ENDIF ENDIF C...Do colour joining and parton showers. IF(NPAIR.GE.1) THEN IJOIN(1)=IP1 IJOIN(2)=IP2 CALL LUJOIN(2,IJOIN) PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 CALL LUSHOW(IP1,IP2,SQRT(MAX(0.,PM12S))) ENDIF IF(NPAIR.EQ.2) THEN IJOIN(1)=IP3 IJOIN(2)=IP4 CALL LUJOIN(2,IJOIN) PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 CALL LUSHOW(IP3,IP4,SQRT(MAX(0.,PM34S))) ENDIF C...Do fragmentation and decays. Possibly except tau decay. IF(ITAU.EQ.0) THEN IF(IABS(K(I1,2)).EQ.15) K(I1,1)=11 IF(IABS(K(I2,2)).EQ.15) K(I2,1)=11 IF(IABS(K(I3,2)).EQ.15) K(I3,1)=11 IF(IABS(K(I4,2)).EQ.15) K(I4,1)=11 ENDIF CALL LUEXEC IF(ITAU.EQ.0) THEN IF(IABS(K(I1,2)).EQ.15) K(I1,1)=1 IF(IABS(K(I2,2)).EQ.15) K(I2,1)=1 IF(IABS(K(I3,2)).EQ.15) K(I3,1)=1 IF(IABS(K(I4,2)).EQ.15) K(I4,1)=1 ENDIF END c beam SUBROUTINE random (r) IMPLICIT NONE REAL*8 r INTEGER m, a, c PARAMETER (M = 259200, A = 7141, C = 54773) INTEGER n SAVE n DATA n /0/ n = mod(n*a+c,m) r = dble (n) / dble (m) END c beam * sa1 subroutine convert(ii,charint1,charint2,charint3) character*1 charint1 character*2 charint2 character*3 charint3 if (ii.le.9) then write (charint1,'(i1)') ii elseif (ii.le.99) then write (charint2,'(i2)') ii elseif (ii.le.999) then write (charint3,'(i3)') ii endif return end subroutine rread(name,var,num) implicit real*8 (a-h, o-z) character *(*) name character *81 line character *80 pluto dimension var(num) common/abread/pluto open (unit=20,file=pluto, status='old') le=len(name) 1 read (20,'(a)',end=100) line if (line(1:40).ne.' '.or. & line(41:80).ne.' ') & then if (line(1:1).ne.'C'.and.line(1:1).ne.'*') then i=0 do while (line(i+1:i+1).eq.' '.and.(i+le).lt.80) i=i+1 end do if (line(i+1:i+le).eq.name.and.line(i+le+1:i+le+1).eq.' ') & then n=0 l=i+le 2 do while (l.lt.80.and.n.lt.num) do while (line(l+1:l+1).eq.' '.and.l.lt.81) l=l+1 enddo if (l.le.80) then n=n+1 read (line(l:), *,end=200,err=300) var(n) endif do while (line(l+1:l+1).ne.' '.and.l.le.79) l=l+1 enddo 200 continue enddo if (n.lt.num) then read (20,'(a)',end=100) line l=1 goto 2 endif close (unit=20) print*, name//' = ', var return endif endif endif goto 1 100 close (unit=20) return 300 print*, ' ' print*, ' ' print*, '!!!!! INPUT ERROR AT THE VARIABLE '//name//' !!!!!!' print*, ' ' print*, ' ' stop end subroutine iread(name,ivar,num) implicit real*8 (a-h, o-z) character *(*) name character *81 line character *80 pluto dimension ivar(num) common/abread/pluto open (unit=20,file=pluto, status='old') le=len(name) 1 read (20,'(a)',end=100) line if (line(1:40).ne.' '.or. & line(41:80).ne.' ') & then if (line(1:1).ne.'C'.and.line(1:1).ne.'*') then i=0 do while (line(i+1:i+1).eq.' '.and.(i+le).lt.80) i=i+1 end do if (line(i+1:i+le).eq.name.and.line(i+le+1:i+le+1).eq.' ') & then n=0 l=i+le 2 do while (l.lt.80.and.n.lt.num) do while (line(l+1:l+1).eq.' '.and.l.lt.81) l=l+1 enddo if (l.le.80) then n=n+1 read (line(l:), *,end=200,err=300) ivar(n) endif do while (line(l+1:l+1).ne.' '.and.l.le.79) l=l+1 enddo 200 continue enddo if (n.lt.num) then read (20,'(a)',end=100) line l=1 goto 2 endif close (unit=20) print*, name//' = ', ivar return endif endif endif goto 1 100 close (unit=20) return 300 print*, ' ' print*, ' ' print*, '!!!!! INPUT ERROR AT THE VARIABLE '//name//' !!!!!!' print*, ' ' print*, ' ' stop end subroutine boost(q,pboost,qprime) implicit real*8 (a-h,o-z) c this subroutine performs the boost according to the vector pboost of c the fourvector q to the fourvector qprime. The vector q and the resulting c qprime might also have the same name in the call dimension q(0:4), pboost(0:4), qprime (0:4) rmboost=pboost(0)**2-pboost(1)**2-pboost(2)**2-pboost(3)**2 rmboost=sqrt(max(rmboost,0.d0)) aux=(q(0)*pboost(0)+q(1)*pboost(1)+q(2)*pboost(2)+q(3)*pboost(3)) & /rmboost aaux=(aux+q(0))/(pboost(0)+rmboost) qprime(0)=aux qprime(1)=q(1)+aaux*pboost(1) qprime(2)=q(2)+aaux*pboost(2) qprime(3)=q(3)+aaux*pboost(3) return end * sa1end