******************************************************************************* * * * WPHACT: a Monte Carlo program for four-fermion final state processes * * at e+ e- colliders * * Authors: E. Accomando and A. Ballestrero * * version 1.4 * ******************************************************************************* * VARIATIONS WITH RESPECT TO VERSION 1.0: * It is now possible to call Circe to simulate beamstrahlung. A corresponding * READ statement has been added. * The statement include 'abdis.dis' together with the lines here shown * have been moved before the call to the amplitudes in order to allow to * define additional cuts by means of if statements in the include file. * IF(idistr.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 * include 'abdis.dis' * ENDIF * the following lines have also been added berore this last 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 * The FUNCTION fxn contains now the COMMON/abinpu/ so that variables like * rmw, rmz etc can now be used in abdis.dis. * Charged current diagrams have constant width also in t channel. * Two scales are now available for higgs processes: alfas_nc for background * (alfas_nc in data normally set at Z mass) and alfas_h evaluated at * higgs mass for the corresponding vertex * Corrispondingly there are two factors qcdcor_nc e qcdcor_h. * The latter is evaluated at second order. * * To use Higgs decay at second order in alfa_s, NQCD of higgs processes * has been implemented multiplying by * (1+alfas_nc/pi)*(1+K*alfas_h/pi) * (instead than by 1+alfas_nc/pi+K*alfas_h/pi), when 4 quarks are present. * 2 flags have been added for higgs processes: * The first, iha, is used only for processes with four quarks and in the * case in which one requires to compute higgs contribution only (icch=1); * its default setting is iha=1 for complete process calculation (icch=3). * iha can get 2 values in standard case: * iha=1 --> hZ + single resonant h * iha=2 --> hZ * and 6 values in the supersymmetric one: * iha=1 --> hZ + hA + single resonant h + single resonant A * iha=2 --> hZ + single resonant h * iha=3 --> hA + single resonant A * iha=4 --> hZ * iha=5 --> hA * iha=6 --> hZ + hA * The second flag, irmhcomp, refers only to the supersimmetric case and * allows to cpmpute the mass mh. * If irmhcomp=1, one has to give in input ma e tgb, otherwise the three * values mh, ma, tgb have to be specified. * * nestrmax has been replaced by nintmax+1 * 4 warnings have been introduced to check input values for ndismax, nbinmax, * nintmax, nitmax. * * * Distribution implementation has been modified to avoid the compilation * error when using /check=bounds. * * * Lightest susy higgs mass rmh computation has been modified. * (M.Carena, J.R.Espinosa, M.Quiros and C.E.M. Wagner, hep-ph/9504316 or * Phys.Lett. B355 (1995)209.) * 5 READ have been introduced: * READ*,iloop (1= 1-loop of older versions, 2=Carena et al. corrections) * IF(iloop.EQ.2)THEN * READ*,imixing (1=no mixing, 2=maximal mixing, 3=typical mixing, 4=other) * IF(imixing.EQ.4)THEN * READ*,At (in this case one specifies the values for these 3 * READ*,Ab (parameters, while for the other 3 values of imixing, * READ*,rmyou (the values are automatically set by the program * ENDIF (according to the 3 possibili scenarios) * ENDIF * The processes with massive particles and higgs production * have been extendend to massive c's and tau's (before only b's available). * * Correspondingly the following READ have been added * READ*,rmc ! quark c mass (GeV) * READ*,rmc_run ! quark c mass running(GeV) * Funcions ee_bbvv,ee_bbmumu,ee_bbee,ee_bbbb have been modified * ee_bbvv contains one new diagram when used for c quark * In ee_bbbb interference terms between id(0) and id(1) have been modified * to account for 4 tau's in the final state and no color factor. * In the above 4 functions color factor rc has been modified * PRINT and IF statement modified to account for new processes. * INITIALIZE includes now the new processes (from iproc= 40 to iproc= 53) * SM higgs in main modified. * * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * WARNING: WARNING: WARNING: WARNING: WARNING: WARNING: WARNING: WARNING: * The new processes are only neutral current. For the two mixed processes * cc~ss~ e tau-tau+ vtvt~ the higgs signal is correctly computed but * the non higgs contribution has to be evaluated with the corresponding * massless processes. * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * * The new processes are those from 40 to 53 included: * * Massive C's (higgs decay to C's): * * iproc=40 * ich=1 NC21 ) c(p3) c~(p4) ve(p5) ve~(p6) * * iproc=41 * ich=1 NC11 ) c(p3) c~(p4) vm(p5) vm~(p6) * ich=2 NC11 ) c(p3) c~(p4) vt(p5) vt~(p6) * * iproc=42 * ich=1 NC33 ) c(p3) c~(p4) u(p5) u~(p6) * * iproc=46 * ich=1 NC25 ) c(p3) c~(p4) mu-(p5) mu+(p6) * ich=2 NC25 ) c(p3) c~(p4) tau-(p5) tau+(p6) * * iproc=47 * ich=1 NC50 ) c(p3) c~(p4) e-(p5) e+(p6) * * iproc=48 * ich=1 NC33 ) c(p3) c~(p4) d(p5) d~(p6) * ich=2 Mix44 ) c(p3) c~(p4) s(p5) s~(p6) * ich=3 NC33 ) c(p3) c~(p4) b(p5) b~(p6) * * iproc=52 * ich=1 NC84 ) c(p3) c~(p4) c(p5) c~(p6) * * * * Massive Tau's (higgs decay to Tau's) : * * iproc=43 * ich=1 NC21 ) tau-(p3) tau+(p4) ve(p5) ve~(p6) * * iproc=44 * ich=1 NC11 ) tau-(p3) tau+(p4) vm(p5) vm~(p6) * ich=2 Mix20 ) tau-(p3) tau+(p4) vt(p5) vt~(p6) * * iproc=45 * ich=1 NC25 ) tau-(p3) tau+(p4) u(p5) u~(p6) * ich=2 NC25 ) tau-(p3) tau+(p4) c(p5) c~(p6) * * iproc=49 * ich=1 NC25 ) tau-(p3) tau+(p4) mu-(p5) mu+(p6) * * iproc=50 * ich=1 NC49 ) tau-(p3) tau+(p4) e-(p5) e+(p6) * * iproc=51 * ich=1 NC25 ) tau-(p3) tau+(p4) d(p5) d~(p6) * ich=2 NC25 ) tau-(p3) tau+(p4) s(p5) s~(p6) * ich=3 NC25 ) tau-(p3) tau+(p4) b(p5) b~(p6) * * iproc=53 * ich=1 NC68 ) tau-(p3) tau+(p4) tau-(p5) tau+(p6) ******************************************************************************* ******************************************************************************* ******************************************************************************* C imix=2 CC+interf.NC (computed only if interf.=1), =1 CC (or Higgs), C =0 interf., =-1 NC, =-2 NC + interf. CC(or Higgs) C iccnc 1=CC only, 2=NC only, 3= CC+NC +interf not onnly for mixed processes C which have a read: it is defined in initialize for all proc and C =4 for those with b C icc only for subr. ee_4f =1 computes CC only, =0 NC only, =-1 CC+NC ******************************************************************************* 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) DIMENSION xm(6) COMMON/abpara/rmx1,gamx1,gx1,rmx2,gamx2,gx2,beta,rlim,s_col, & x1_min,x2_min,xm,smin,emcoupl,estrinf1,estrinf2,estrmed2, & rmx3,gamx3,gx3 COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp 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 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 PARAMETER (ndismax=50,nintmax=50,nbinmax=500,nitmax=10) 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 EXTERNAL fxn,gammln DATA rmw/80.356d0/, rmz/91.1884d0/, rmt/175.d0/, rmc/0.75d0/, & rmtau/1.78d0/, rmb_run/2.7d0/, & gamw/2.08d0/, gamz/2.4974d0/, gamh/2.8d-03/, & gf/1.1663892199930875d-05/, alfainv/128.07d0/, & alfas_cc/0.1255d0/, alfas_nc/0.1230d0/, & s2w/0.231030912451068d0/, rms/1000.d0/ c beam & ,x1beam/1.d0/,x2beam/1.d0/ c beam *agg 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/ *aggend c READ*,rmw ! W mass (GeV) READ*,e_cm ! centre of mass energy (GeV) READ*,iproc ! selects the kind of process (see subroutine INITIALIZE) READ*,ich ! selects the channel (see subroutine INITIALIZE) IF(iproc.GE.33)THEN READ*,rmb ! quark b mass (GeV) READ*,rmc ! quark c mass (GeV) READ*,rmb_run ! quark b mass running(GeV) READ*,rmc_run ! quark c mass running(GeV) 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 IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53).AND. & icch.EQ.1)THEN READ*,iha ! 1=all, 2=hZ ENDIF READ*,rmh ! Higgs mass (GeV) ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53).AND. & icch.EQ.1)THEN READ*,iha ! 1=all, 2=h, 3=A, 4=h-stralhung, 5=A-strahlung, ! 6= hZ + hA 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 READ*,rmyou ENDIF ENDIF ELSE READ*,rmh READ*,rma READ*,tgb ENDIF ENDIF ENDIF ENDIF 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*,ips_cc ! CC (or Higgs signal) phase space : ! 1=double resonant, 2=single resonant, 3=non resonant READ*,ips_nc ! NC phase space: ! 1=double resonant, 2=single resonant, 3=non resonant READ*,icc3 ! yes/no CC3 only READ*,isr ! yes/no ISR READ*,ipr ! yes/no running widths 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*,icoul ! yes/no Coulomb corrections READ*,istrcor ! yes/no 'naive' QCD corrections (also for width comp.) READ*,iqu ! yes/no QCD diagrams for 4-quarks NC 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 particle-particle angle lower (in degrees) cuts READ*,thsep_max ! 6 particle-particle angle upper (in degrees) cuts ENDIF READ*,ianc ! yes/no anomalous couplings IF(ianc.EQ.1)THEN READ*, delz,xf,xz,yf,yz,zz !anomalous couplings parameters ENDIF READ*,idistr ! yes/no distributions IF(idistr.EQ.1)THEN READ*,ndistr ! number of distributions IF(ndistr.GT.ndismax)THEN PRINT*,'ERROR:' PRINT*,'Number of distributions cannot exceed' PRINT*,'NDISMAX given as parameter' STOP ENDIF DO i=1,ndistr READ*,nsubint(i) ! number of sub-intervals with different binning IF(nsubint(i).GT.nintmax)THEN PRINT*,'ERROR:' PRINT*,'Number of sub-intervals cannot exceed' PRINT*,'NINTMAX given as parameter' 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*,'ERROR:' PRINT*,'total number of bins cannot exceed' PRINT*,'NBINMAX given as parameter' 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 flat ! events 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 c beam READ*,ibeam !yes/no beamstrahlung c beam READ*,acc ! integration accuracy READ*,iterm ! yes/no thermalization READ*,ncall_term ! thermalization calls per iteration READ*,itmx_term ! thermalization iterations IF(itmx_term.GT.nitmax)THEN PRINT*,'ERROR:' PRINT*,'Number of thermalization iterations cannot exceed' PRINT*,'NITMAX given as parameter' STOP ENDIF READ*,ncall ! integration calls per iteration READ*,itmx ! integration iterations (2 for flat event generation) IF(itmx.GT.nitmax)THEN PRINT*,'ERROR:' PRINT*,'Number of integration iterations cannot exceed' PRINT*,'NITMAX given as parameter' STOP ENDIF c beam if (ibeam.eq.1) then call circes (0.d0,0.d0,500.d0,2,1,1996 09 02,0) endif c beam *agg IF(iflat.EQ.1.AND.itmx.NE.2)THEN PRINT*,'ERROR' PRINT*,'Flat events generation needs ITMX =2' stop ENDIF IF((iproc.EQ.44.OR.iproc.EQ.48).AND.ich.EQ.2. & AND.icch.NE.1)THEN PRINT*,'ERROR' PRINT*,'Only the Higgs signal is available for this channel' PRINT*,'For the background you can use the massless channel' STOP ENDIF *aggend s_col=e_cm**2 c rmc_run=rmc 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 rms2=rms**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+rms2/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 rmyou=0.d0 ELSE IF(imixing.EQ.2)THEN At=sqrt(6.d0)*rms Ab=At rmyou=0.d0 ELSE IF(imixing.EQ.3)THEN At=rms Ab=At rmyou=-rms ENDIF fourpi=4.d0*pi fourpi2=fourpi**2 rmyouq=rmyou**2 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(rms/rmt) Xt=2.d0*At**2*(1.d0-At**2/(12.d0*rms2))/rms2 Xb=2.d0*Ab**2*(1.d0-Ab**2/(12.d0*rms2))/rms2 Atb=(-6.d0*rmyouq/rms2-(rmyouq-Ab*At)**2/(rms2**2)+ & 3.d0*(At+Ab)**2/rms2)/6.d0 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 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*rms2**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*rms2**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/rms2- & rmyouq*At**2/(rms2**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/rms2- & rmyouq*Ab**2/(rms2**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/rms2- & rmyouq*At**2/(rms2**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/rms2- & rmyouq*Ab**2/(rms2**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*rms2**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*rms2**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*rms2**2)+3.d0*hbq**2*rmyou* & (Ab**3/(rms**3)-6.d0*Ab/rms)*(1.d0-(0.5d0*htq-4.5d0*hbq & +16.d0*g3)*t/fourpi2)/(96.d0*pi**2*rms) 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*rms2**2)+3.d0*htq**2*rmyou* & (At**3/(rms**3)-6.d0*At/rms)*(1.d0-(0.5d0*hbq-4.5d0*htq & +16.d0*g3)*t/fourpi2)/(96.d0*pi**2*rms) 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) IF(iproc.GE.33.AND.isusy.EQ.0.AND.icch.NE.2)THEN IF(iproc.LE.39)THEN ** Higgs-ZZ * Higgs-bb coupling 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.GE.40.AND.iproc.LE.42).OR. & (iproc.GE.46.AND.iproc.LE.48).OR.iproc.EQ.52)THEN rhzz=rmc_run/(s2w*rc2w*2.d0) rhww=rmc_run/(s2w*2.d0) rhbb=rmc_run**2/(4.d0*rmw**2*s2w) ELSE IF((iproc.GE.43.AND.iproc.LE.45).OR. & (iproc.GE.49.AND.iproc.LE.51).OR.iproc.EQ.53)THEN rhzz=rmtau/(s2w*rc2w*2.d0) 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.GE.40.AND.iproc.LE.42).OR. & (iproc.GE.46.AND.iproc.LE.48).OR.iproc.EQ.52)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.52.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.GE.43.AND.iproc.LE.45).OR. & (iproc.GE.49.AND.iproc.LE.51).OR.iproc.EQ.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.53.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 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 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 IF (rmb.EQ.0.d0.OR.iproc.LE.32)THEN 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) ELSE IF(rmb.NE.0.d0.AND.iproc.GE.33)THEN 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 IF (rmb.EQ.0.d0.and.rmc.eq.0.d0.and.rmtau.eq.0.d0) THEN 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 IF(rmh.LT.(2.d0*rmw))THEN xx=(rmw/rmh)**2 rxx=acos((3.d0*xx-1.d0)/(2.d0*xx**1.5d0)) rxx=rxx*3.d0*(1.d0-8.d0*xx+20.d0*xx**2)/ & (4.d0*xx-1.d0)**.5d0 rxx=rxx-(2.d0-13.d0*xx+47.d0*xx**2)*(1.d0-xx)/2.d0/xx rxx=rxx-(1.d0-6.d0*xx+4.d0*xx**2)*1.5*log(xx) gamh=gamh+3.d0*gf**2*rmw**4/16/pi**3*rmh*rxx ELSE print*, 'ERROR: WPHACT COMPUTES HIGGS WIDTH' print*, ' ONLY FOR M_h LESS THAN 2*M_W' stop ENDIF ENDIF IF(ighcomp.EQ.1.AND.iproc.GE.33.AND.icch.NE.2.AND.isusy.EQ.1)THEN IF(rmb.EQ.0.d0.and.rmc.eq.0.d0.and.rmtau.eq.0.d0)THEN 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) IF(iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53)THEN 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) IF(iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53)THEN 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 IF(rmh.LT.(2.d0*rmw))THEN xx=(rmw/rmh)**2 rxx=acos((3.d0*xx-1.d0)/(2.d0*xx**1.5d0)) rxx=rxx*3.d0*(1.d0-8.d0*xx+20.d0*xx**2)/ & (4.d0*xx-1.d0)**.5d0 rxx=rxx-(2.d0-13.d0*xx+47.d0*xx**2)*(1.d0-xx)/2.d0/xx rxx=rxx-(1.d0-6.d0*xx+4.d0*xx**2)*1.5*log(xx) gamh=gamh+3.d0*gf**2*rmw**4/16/pi**3*rmh*rxx* & (sind(bet-alf))**2 ELSE print*, 'ERROR: WPHACT COMPUTES HIGGS WIDTH' print*, ' ONLY FOR M_h LESS THAN 2*M_W' stop ENDIF ENDIF IF(iproc.GE.33.AND.icch.NE.2)THEN gh=gamh/rmh IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1)THEN 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 IF (iproc.LE.32) THEN xm(3)=0.d0 xm(4)=0.d0 xm(5)=0.d0 xm(6)=0.d0 ELSE IF (iproc.EQ.39) THEN xm(3)=rmb xm(4)=rmb xm(5)=rmb xm(6)=rmb ELSE IF(iproc.GE.33.AND.iproc.LE.38)THEN xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 ELSE IF((iproc.GE.40.AND.iproc.LE.42).OR. & (iproc.GE.46.AND.iproc.LE.48))THEN xm(3)=rmc xm(4)=rmc xm(5)=0.d0 xm(6)=0.d0 ELSE IF((iproc.GE.43.AND.iproc.LE.45).OR. & (iproc.GE.49.AND.iproc.LE.51))THEN xm(3)=rmtau xm(4)=rmtau xm(5)=0.d0 xm(6)=0.d0 ELSE IF(iproc.EQ.52)THEN xm(3)=rmc xm(4)=rmc xm(5)=rmc xm(6)=rmc ELSE IF(iproc.EQ.53)THEN xm(3)=rmtau xm(4)=rmtau xm(5)=rmtau xm(6)=rmtau 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 IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.icch.NE.2.AND.isusy.EQ.1)THEN estrmed2=0.5d0*(rma+rmz) ENDIF cim=(0.d0,1.d0) IF(isr.EQ.1)THEN rme=0.51099906d-3 rl=log(s_col/rme/rme) 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 IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1)THEN 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) IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1)THEN caipr=1.d0+cim*gama/rma cca=(0.d0,0.d0) ENDIF ENDIF ENDIF CALL printer(rmh,gamh,rma,gama,tgb,rmb) * ridefinisco la massa per i nuovi processi con Higgs IF((iproc.GE.40.AND.iproc.LE.42).OR. & (iproc.GE.46.AND.iproc.LE.48).OR.iproc.EQ.52)THEN rmb=rmc rmb2=rmc**2 rmb_run=rmc_run rmt2=0.d0 !assuming the s quark to be massless ELSE IF((iproc.GE.43.AND.iproc.LE.45).OR. & (iproc.GE.49.AND.iproc.LE.51).OR.iproc.EQ.53)THEN rmb=rmtau rmb2=rmtau**2 rmb_run=rmtau rmt2=0.d0 ENDIF * Routine Vegas parameter: IF(isr.EQ.0)THEN ndim=7 ELSE ndim=9 ENDIF * 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 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.52.AND.iproc.NE.53)).OR.(isusy.EQ.1.AND. & (iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53).AND. & ((rma+rmh).GT.e_cm.OR.iha.EQ.2.OR.iha.EQ.4)))THEN imix=1 ips=ips_cc rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz ELSE IF(isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.52.OR. & iproc.EQ.53).AND.(rma+rmh).LE.e_cm. & AND.iha.NE.2.AND.iha.NE.4)THEN * 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 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 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 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 IF(isusy.EQ.0.OR.(isusy.EQ.1.AND.iproc.NE.39.AND. & iproc.NE.52.AND.iproc.NE.53).OR.(isusy.EQ.1.AND. & (iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53).AND. & ((rma+rmh).GT.e_cm.OR.iha.EQ.2.OR.iha.EQ.4)))THEN PRINT*,' ' IF(iproc.NE.39.AND.iproc.NE.52.AND.iproc.NE.53)THEN PRINT*,'Higgs signal' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.0.AND.iha.EQ.1)THEN PRINT*,'Complete h contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.0.AND.iha.EQ.2)THEN PRINT*,'only hZ contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1.AND.iha.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1.AND.iha.EQ.2)THEN PRINT*,'Complete h contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1.AND.iha.EQ.3)THEN PRINT*,'Complete A contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1.AND.iha.EQ.4)THEN PRINT*,'only hZ contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1.AND.iha.EQ.5)THEN PRINT*,'Only hA contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1.AND.iha.EQ.6)THEN PRINT*,'Only hZ+hA contribution' ENDIF imix=1 ips=ips_cc rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz ELSE IF(isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.52.OR. & iproc.EQ.53).AND.(rma+rmh).LE.e_cm.AND. & iha.NE.2.AND.iha.NE.4)THEN PRINT*,' ' IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.iha.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.iha.EQ.3)THEN PRINT*,'Complete A contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.iha.EQ.5)THEN PRINT*,'only hA contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.iha.EQ.6)THEN PRINT*,'only hZ+hA contribution' ENDIF 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 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 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 IF(isusy.EQ.0.OR.(isusy.EQ.1.AND.(iproc.NE.39. & AND.iproc.NE.52.AND.iproc.NE.53)).OR.(isusy. & EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.(rma+rmh).GT.e_cm))THEN PRINT*,' ' IF((iproc.NE.39.AND.iproc.NE.52.AND.iproc.NE.53))THEN PRINT*,'Higgs signal' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.0)THEN PRINT*,'Complete higgs contribution' ELSE IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53). & AND.isusy.EQ.1)THEN PRINT*,'Complete h and A higgs contribution' ENDIF rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz ELSE IF(isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.52.OR. & iproc.EQ.53).AND.(rma+rmh).LE.e_cm)THEN 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 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 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*,' ' 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 double precision FUNCTION fxn(x,wgt) IMPLICIT REAL*8 (a-h,o-z) 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) DIMENSION paus(0:3),p(4,6),xm(6),x(9) DIMENSION cc(3:6,3:6),y(3:6,3:6),rmod(3:6),cosbeam(3:6),pt(3:6) COMMON/abpara/rmx1,gamx1,gx1,rmx2,gamx2,gx2,beta,rlim,s_col, & x1_min,x2_min,xm,smin,emcoupl,estrinf1,estrinf2,estrmed2, & rmx3,gamx3,gx3 COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp 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 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 PARAMETER (ndismax=50,nintmax=50,nbinmax=500,nitmax=10) 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 PARAMETER(NMXHEP=2000) COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) *aggend c beam common/abibea/ibeam common/abxbea/x1beam,x2beam external random c beam EXTERNAL ee_4f,ee_bbvv,ee_bbmumu,ee_bbbb,ee_bbee DATA ncall_eff/0/ el=e_cm/2.d0 c beam IF(ibeam.EQ.1) CALL gircee(x1beam,x2beam,random) c beam IF(isr.EQ.1)THEN x1=1.d0-x(3)**(2.d0/beta) x2=1.d0-x(4)**(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 c beam 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 c questo primo pezzo e' stato commentato al fondo e riportato qui perche' c subito dopo si ridefinisce x1 e x2 if (ibeam.eq.1) then x1=x1*x1beam x2=x2*x2beam endif c beam s=x1*x2*s_col IF(s.LT.smin)THEN fxn=0.d0 RETURN ENDIF p1(0)=x1*el p1(1)=0.d0 p1(2)=0.d0 p1(3)=p1(0) p2(0)=x2*el p2(1)=0.d0 p2(2)=0.d0 p2(3)=-p2(0) ELSE c beam moltiplicazioni per x1beam, x2beam aggiunte + bcm e gcm s=x1beam*x2beam*s_col p1(0)=x1beam*el p1(1)=0.d0 p1(2)=0.d0 p1(3)=x1beam*el p2(0)=x2beam*el p2(1)=0.d0 p2(2)=0.d0 p2(3)=-x2beam*el c beam ENDIF IF(x(1).EQ.1.d0.OR.x(1).EQ.0.d0.OR.x(2).EQ. & 1.d0.OR.x(2).EQ.0.d0)THEN fxn=0.d0 RETURN ENDIF 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 * (34) and (56) moments in the lab frame: IF(ips.EQ.1.OR.ips.EQ.2)THEN IF(ipr.EQ.0)THEN x1_max=atan((estrsup1**2-rmx1**2)/(gamx1*rmx1)) app=(gamx1*rmx1*tan((x1_max-x1_min)*x(1)+x1_min)+rmx1**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(1)=sqrt(app) rj34=(x1_max-x1_min)*((xm(1)**2-rmx1**2)**2+ & (gamx1*rmx1)**2)/(2.d0*xm(1)*gamx1*rmx1) ELSE x1_max=atan(((1.d0+gx1**2)*estrsup1**2-rmx1**2) & /(gx1*rmx1**2)) app=(1.d0+gx1*tan((x1_max-x1_min)*x(1)+x1_min))/(1.d0+gx1**2) IF(app.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF xm(1)=rmx1*sqrt(app) rj34=(x1_max-x1_min)*((xm(1)**2-rmx1**2)**2+xm(1)**4*gx1**2) & /(2.d0*xm(1)*rmx1**2*gx1) ENDIF ELSE rj34=estrsup1-estrinf1 xm(1)=x(1)*rj34+estrinf1 ENDIF 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 IF((iproc.EQ.39.OR.iproc.EQ.52.OR.iproc.EQ.53).AND.isusy.EQ.1 & .AND.(rmh+rma).LE.e_cm.AND.iha.NE.2.AND.iha.NE.4)THEN IF(ips.EQ.1)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 IF(ips.EQ.1)THEN IF(ipr.EQ.0)THEN 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_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 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) IF(isr.EQ.0)THEN 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 ELSE c34=x(5)*2.d0-1.d0 c3=x(6)*2.d0-1.d0 ph3=x(7)*2.d0*pi c5=x(8)*2.d0-1.d0 ph5=x(9)*2.d0*pi ENDIF app=1.d0-c34**2 IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s34=sqrt(app) p(4,1)=sqrt(p34_cm**2+xm(1)**2) p(1,1)=p34_cm*s34 p(3,1)=p34_cm*c34 p(4,2)=sqrt(p34_cm**2+xm(2)**2) p(1,2)=-p(1,1) p(3,2)=-p(3,1) * (3) and (4) moments 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**2 IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s3=sqrt(app) p(4,3)=sqrt(p3_34**2+xm(3)**2) p(1,3)=p3_34*s3*cos(ph3) p(2,1)=0.d0 p(2,2)=0.d0 p(2,3)=p3_34*s3*sin(ph3) p(3,3)=p3_34*c3 p(4,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(4,1)*p(4,3)+p(1,1)*p(1,3)+p(2,1)*p(2,3) & +p(3,1)*p(3,3))/xm(1) trasf=(p(4,3)+p3(0))/(xm(1)+p(4,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(4,1)*p(4,4)+p(1,1)*p(1,4)+p(2,1)*p(2,4) & +p(3,1)*p(3,4))/xm(1) trasf=(p(4,4)+p4(0))/(xm(1)+p(4,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**2 IF(app.LT.0.d0)THEN fxn=0.d0 RETURN ENDIF s5=sqrt(app) p(4,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(4,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(4,2)*p(4,5)+p(1,2)*p(1,5)+p(2,2)*p(2,5) & +p(3,2)*p(3,5))/xm(2) trasf=(p(4,5)+p5(0))/(xm(2)+p(4,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(4,2)*p(4,6)+p(1,2)*p(1,6)+p(2,2)*p(2,6) & +p(3,2)*p(3,6))/xm(2) trasf=(p(4,6)+p6(0))/(xm(2)+p(4,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) * These rotations were after the boost to cm system. They have been * moved here for the case the boost is not in z direction * rotations of fi (only for distributions, event generation,etc.) 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 c* boost to collider frame IF(isr.eq.1.or.ibeam.eq.1)THEN p0boost=p1(0)+p2(0) p1boost=0.d0 p2boost=0.d0 p3boost=p1(3)+p2(3) rmboost=p0boost**2-p1boost**2-p2boost**2-p3boost**2 if (rmboost.gt.0.d0) then rmboost=sqrt(rmboost) else fxn=0.d0 return endif aux=(p3(0)*p0boost+p3(1)*p1boost+p3(2)*p2boost+p3(3)*p3boost) & /rmboost aaux=(aux+p3(0))/(p0boost+rmboost) p3(0)=aux p3(1)=p3(1)+aaux*p1boost p3(2)=p3(2)+aaux*p2boost p3(3)=p3(3)+aaux*p3boost aux=(p0boost*p4(0)+p4(1)*p1boost+p4(2)*p2boost+p4(3)*p3boost) & /rmboost aaux=(aux+p4(0))/(p0boost+rmboost) p4(0)=aux p4(1)=p4(1)+aaux*p1boost p4(2)=p4(2)+aaux*p2boost p4(3)=p4(3)+aaux*p3boost aux=(p0boost*p5(0)+p5(1)*p1boost+p5(2)*p2boost+p5(3)*p3boost) & /rmboost aaux=(aux+p5(0))/(p0boost+rmboost) p5(0)=aux p5(1)=p5(1)+aaux*p1boost p5(2)=p5(2)+aaux*p2boost p5(3)=p5(3)+aaux*p3boost aux=(p0boost*p6(0)+p6(1)*p1boost+p6(2)*p2boost+p6(3)*p3boost) & /rmboost aaux=(aux+p6(0))/(p0boost+rmboost) p6(0)=aux p6(1)=p6(1)+aaux*p1boost p6(2)=p6(2)+aaux*p2boost p6(3)=p6(3)+aaux*p3boost ENDIF * 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 * distribuzioni pesate e additional cuts IF(idistr.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 * include 'abdis.dis' * fine abdis 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 fxn=4.d0*p3_34*p5_56*p34_cm*(pi)**3*rj34*rj56/sqrt(s) * ISR introduction: IF(isr.EQ.1)THEN c beam c IF(x1.EQ.1.d0)THEN c dx1=rlim c ELSE c dx1=rlim+(1.d0-x1)**(1.d0-beta/2.d0)*(-beta*(1.d0+x1)/4.d0 c & +(beta**2/32.d0)*(-4.d0*(1.d0+x1)*log(1.d0-x1)+3.d0* c & (1.d0+x1)*log(x1)-4.d0*log(x1)/(1.d0-x1)-5.d0-x1)) c ENDIF c IF(x2.EQ.1.d0)THEN c dx2=rlim c ELSE c dx2=rlim+(1.d0-x2)**(1.d0-beta/2.d0)*(-beta*(1.d0+x2)/4.d0 c & +(beta**2/32.d0)*(-4.d0*(1.d0+x2)*log(1.d0-x2)+3.d0* c & (1.d0+x2)*log(x2)-4.d0*log(x2)/(1.d0-x2)-5.d0-x2)) c ENDIF c str_fun=dx1*dx2*4.d0/beta/beta c IF(str_fun.LE.0.d0)THEN c fxn=0.d0 c RETURN c ENDIF c beam fxn=fxn*str_fun ENDIF IF (iccnc.LE.3) THEN IF(imix.EQ.-2.or.imix.eq.-1)then fxn=fxn*ee_4f(p1,p2,p3,p4,p5,p6) ELSE IF(imix.EQ.1.OR.imix.EQ.2)THEN IF(ichcj.EQ.0)THEN fxn=fxn*ee_4f(p1,p2,p3,p6,p5,p4) 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 fxn=fxn*ee_4f(p1,p2,q3,q6,q5,q4) ENDIF ENDIF ELSE IF (iccnc.EQ.4) THEN IF (iproc.EQ.33.OR.iproc.EQ.34.OR.iproc.EQ.40.OR. & iproc.EQ.41.OR.iproc.EQ.43.OR.iproc.EQ.44) THEN IF(iproc.EQ.40.OR.iproc.EQ.41.OR.iproc.EQ.43. & OR.iproc.EQ.44)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.45.OR.iproc.EQ.46.OR. & iproc.EQ.48.OR.iproc.EQ.49.OR.iproc.EQ.51)THEN IF(iproc.EQ.42.OR.iproc.EQ.45.OR.iproc.EQ.46.OR. & iproc.EQ.48.OR.iproc.EQ.49.OR.iproc.EQ.51)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.47.OR.iproc.EQ.50)THEN IF(iproc.EQ.47.OR.iproc.EQ.50)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.52.OR.iproc.EQ.53) THEN IF(iproc.EQ.52.OR.iproc.EQ.53) THEN fqdr=f3r fqdl=f3l zqdr=z3r zqdl=z3l ENDIF fxn=fxn*ee_bbbb(p1,p2,p3,p4,p5,p6) ENDIF ENDIF 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 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 CALL AB_LU4FRM(ichar,IRAD,ITAU,IERR) 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 double precision FUNCTION gammln(xx) IMPLICIT NONE REAL*8 xx INTEGER j double precision 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 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 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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 IF(iproc.EQ.6.AND.ich.EQ.1)THEN iqu=0 PRINT*,'Mix19 ) mu-(p3) mu+(p4) vm(p5) vm~(p6)' 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)' 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)' 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)' 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)' 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.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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.23.AND.ich.EQ.1)THEN i3q=1 iqu=0 PRINT*,'NC10 ) d(p3) d~(p4) vm(p5) vm~(p6)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.23.AND.ich.EQ.3)THEN i3q=1 iqu=0 PRINT*,'NC10 ) d(p3) d~(p4) vt(p5) vt~(p6)' 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.4)THEN i3q=1 iqu=0 PRINT*,'NC10 ) s(p3) s~(p4) vt(p5) vt~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=16 IDHEP(4)=-16 ENDIF 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)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF ENDIF 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=3 IDHEP(2)=-3 IDHEP(3)=3 IDHEP(4)=-3 ENDIF 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)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=11 IDHEP(2)=-11 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.31.AND.ich.EQ.1)THEN i5q=1 iqu=0 PRINT*,'NC24 ) mu-(p3) mu+(p4) d(p5) d~(p6)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=13 IDHEP(2)=-13 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.31.AND.ich.EQ.3)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) d(p5) d~(p6)' 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.4)THEN i5q=1 iqu=0 PRINT*,'NC24 ) tau-(p3) tau+(p4) s(p5) s~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=3 IDHEP(4)=-3 ENDIF 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=1 IDHEP(2)=-1 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ENDIF ENDIF IF (iproc.GE.33.AND.iproc.LE.35)THEN 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=5 IDHEP(2)=-5 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ENDIF ENDIF IF (iproc.GE.40.AND.iproc.LE.42)THEN 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)' 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)' 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)' 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)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ENDIF ENDIF IF(iproc.GE.43.AND.iproc.LE.45)THEN idownl=1 idownr=0 icc=0 iccnc=4 IF(iproc.EQ.43.AND.ich.EQ.1)THEN ibbveve=1 i3q=0 i56ve=1 iqu=0 PRINT*,'NC21 ) tau-(p3) tau+(p4) ve(p5) ve~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=12 IDHEP(4)=-12 ENDIF ELSE IF(iproc.EQ.44.AND.ich.EQ.1)THEN i3q=0 iqu=0 PRINT*,'NC11 ) tau-(p3) tau+(p4) vm(p5) vm~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=14 IDHEP(4)=-14 ENDIF ELSE IF(iproc.EQ.44.AND.ich.EQ.2)THEN i3q=0 iqu=0 PRINT*,'Mix20 ) tau-(p3) tau+(p4) vt(p5) vt~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=16 IDHEP(4)=-16 ENDIF ELSE IF(iproc.EQ.45.AND.ich.EQ.1)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) u(p5) u~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=2 IDHEP(4)=-2 ENDIF ELSE IF(iproc.EQ.45.AND.ich.EQ.2)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) c(p5) c~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF ENDIF IF(iproc.GE.46.AND.iproc.LE.48)THEN idownl=0 idownr=1 icc=0 iccnc=4 IF(iproc.EQ.46.OR.iproc.EQ.47)THEN i3q=1 iqu=0 IF(iproc.EQ.46.AND.ich.EQ.1)THEN PRINT*,'NC25 ) c(p3) c~(p4) mu-(p5) mu+(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.46.AND.ich.EQ.2)THEN PRINT*,'NC25 ) c(p3) c~(p4) tau-(p5) tau+(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ELSE IF(iproc.EQ.47.AND.ich.EQ.1)THEN PRINT*,'NC50 ) c(p3) c~(p4) e-(p5) e+(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=11 IDHEP(4)=-11 ENDIF ENDIF ELSE IF(iproc.EQ.48.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)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.48.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)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.48.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)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ENDIF ENDIF IF(iproc.GE.49.AND.iproc.LE.51)THEN idownl=1 idownr=1 icc=0 iccnc=4 IF(iproc.EQ.49.OR.iproc.EQ.50)THEN i3q=0 iqu=0 IF(iproc.EQ.49.AND.ich.EQ.1)THEN PRINT*,'NC25 ) tau-(p3) tau+(p4) mu-(p5) mu+(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=13 IDHEP(4)=-13 ENDIF ELSE IF(iproc.EQ.50.AND.ich.EQ.1)THEN PRINT*,'NC49 ) tau-(p3) tau+(p4) e-(p5) e+(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=11 IDHEP(4)=-11 ENDIF ENDIF ELSE IF(iproc.EQ.51.AND.ich.EQ.1)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) d(p5) d~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=1 IDHEP(4)=-1 ENDIF ELSE IF(iproc.EQ.51.AND.ich.EQ.2)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) s(p5) s~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=3 IDHEP(4)=-3 ENDIF ELSE IF(iproc.EQ.51.AND.ich.EQ.3)THEN i3q=0 i5q=1 iqu=0 PRINT*,'NC25 ) tau-(p3) tau+(p4) b(p5) b~(p6)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=5 IDHEP(4)=-5 ENDIF ENDIF ENDIF IF(iproc.EQ.52.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)' IF(ijetset.EQ.1)THEN IDHEP(1)=4 IDHEP(2)=-4 IDHEP(3)=4 IDHEP(4)=-4 ENDIF ENDIF IF(iproc.EQ.53.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)' IF(ijetset.EQ.1)THEN IDHEP(1)=15 IDHEP(2)=-15 IDHEP(3)=15 IDHEP(4)=-15 ENDIF ENDIF 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 *agg IF(ijetset.EQ.1)THEN IF(isr.EQ.0) THEN NHEP=4 DO i=1,4 ISTHEP(i)=1 ENDDO !i ELSE 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 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 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 IF (icch.EQ.1.AND.(iproc.NE.39.AND.iproc.NE.52.AND. & iproc.NE.53)) THEN PRINT*,'Higgs signal' ELSE IF (icch.EQ.1.AND.isusy.EQ.0.AND.(iproc.EQ.39. & OR.iproc.EQ.52.OR.iproc.EQ.53). & 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.52.OR.iproc.EQ.53). & 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.52.OR.iproc.EQ.53). & 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.52.OR.iproc.EQ.53). & 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.52.OR.iproc.EQ.53). & 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.52.OR.iproc.EQ.53). & 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.52.OR.iproc.EQ.53). & AND.iha.EQ.5)THEN PRINT*,'only hA contribution' ELSE IF (icch.EQ.3.AND.iproc.NE.39.AND.iproc.NE.52.AND. & iproc.NE.53) THEN PRINT*,'Higgs signal + background' ELSE IF (icch.EQ.3.AND.isusy.EQ.0.AND.(iproc.EQ.39. & OR.iproc.EQ.52.OR.iproc.EQ.53))THEN PRINT*,'Complete Higgs contribution + background' ELSE IF (icch.EQ.3.AND.isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.52.OR.iproc.EQ.53))THEN PRINT*,'Complete h and A higgs contribution + background' ENDIF 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') PRINT 302,rmb_run 302 FORMAT(' b running mass = ',d13.7,' GeV') PRINT 303,rmc 303 FORMAT(' c mass = ',d13.7,' GeV') PRINT 304,rmc_run 304 FORMAT(' c running mass = ',d13.7,' GeV') PRINT 305,rmtau 305 FORMAT(' tau mass = ',d13.7,' GeV') ELSE IF (iccnc.EQ.4.AND.icch.EQ.2) THEN PRINT 401,rmb 401 FORMAT(' b mass = ',d13.7,' GeV') PRINT 402,rmc 402 FORMAT(' c mass = ',d13.7,' GeV') PRINT 403,rmtau 403 FORMAT(' tau 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') 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 IF(isusy.EQ.1.AND.(iproc.EQ.39. & OR.iproc.EQ.52.OR.iproc.EQ.53))THEN 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' 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 "CC" phase space' ELSE IF (ips_cc.EQ.3) 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 "NC" phase space' ELSE IF (ips_nc.EQ.3) 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 "Higgs signal" phase space' ELSE IF (ips_cc.EQ.3) 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 "Higgs background" phase space' ELSE IF (ips_nc.EQ.3) 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 double precision 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 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) 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 double precision 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),p136(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),u3_16,d4_52 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 COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp 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) p136(m)=p16(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=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) 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 c16w a 3 (c) * quqd -- p=p3,q=p136 quqd=p3(0)*p136(0)-p3(1)*p136(1)-p3(2)*p136(2)-p3(3)*p136( & 3) * TW -- qu=p3,qd=p136,v=c16w.e,a=u3_16.a,b=u3_16.b,c=u3_16.c,d=u3_16.d,cl=w * cl,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 ceps_2=-c16w.e(3)*p136k0+p136(3)*c16w.ek0 ceps_2=ceps_2*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 cauxb=-c16w.ek0*p136(2)+p136k0*c16w.e(2) cauxc=+c16w.ek0*p3(2)-p3k0*c16w.e(2) u3_16.a(2,2)=wcl*(cauxa-ceps_0) u3_16.b(1,2)=wcl*(cauxb-ceps_2) u3_16.c(2,1)=wcl*(-cauxc+ceps_1) u3_16.d(1,1)=wcl*c16w.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 c52w a 4 (cbar) * quqd -- p=p136,q=p4 quqd=p136(0)*p4(0)-p136(1)*p4(1)-p136(2)*p4(2)-p136(3)*p4( & 3) * TW -- qu=p136,qd=p4,v=c52w.e,a=d4_52.a,b=d4_52.b,c=d4_52.c,d=d4_52.d,cl=w * cl,nsum=0 ceps_0=-c52w.ek0*(p136(2)*p4(3)-p4(2)*p136(3))+p136k0*(c52 & w.e(2)*p4(3)-p4(2)*c52w.e(3))-p4k0*(c52w.e(2)*p136(3)-p13 & 6(2)*c52w.e(3)) ceps_0=ceps_0*cim ceps_1=-c52w.e(3)*p136k0+p136(3)*c52w.ek0 ceps_1=ceps_1*cim ceps_2=-c52w.e(3)*p4k0+p4(3)*c52w.ek0 ceps_2=ceps_2*cim cvqu=c52w.e(0)*p136(0)-c52w.e(1)*p136(1)-c52w.e(2)*p136(2) & -c52w.e(3)*p136(3) cvqd=c52w.e(0)*p4(0)-c52w.e(1)*p4(1)-c52w.e(2)*p4(2)-c52w. & e(3)*p4(3) cauxa=-c52w.ek0*quqd+p136k0*cvqd+p4k0*cvqu cauxb=-c52w.ek0*p4(2)+p4k0*c52w.e(2) cauxc=+c52w.ek0*p136(2)-p136k0*c52w.e(2) d4_52.a(2,2)=wcl*(cauxa-ceps_0) d4_52.b(1,2)=wcl*(cauxb-ceps_2) d4_52.c(2,1)=wcl*(-cauxc+ceps_1) d4_52.d(1,1)=wcl*c52w.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 IF(fqdl.LT.0.d0)THEN **** 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 ELSE **** Diagramma 1**** * TWTW -- aa=dia1.a,bb=dia1.b,cc=dia1.c,dd=dia1.d,a1=u3_16.a,b1=u3_16.b,c1= * u3_16.c,d1=u3_16.d,a2=d4_52.a,b2=d4_52.b,c2=d4_52.c,d2=d4_52.d,prq=p136q dia1.d(1,1)=u3_16.d(1,1)*p136q*d4_52.d(1,1)+u3_16.b(1,2)*d & 4_52.c(2,1) dia1.b(1,2)=u3_16.d(1,1)*p136q*d4_52.b(1,2)+u3_16.b(1,2)*d & 4_52.a(2,2) dia1.c(2,1)=u3_16.c(2,1)*p136q*d4_52.d(1,1)+u3_16.a(2,2)*d & 4_52.c(2,1) dia1.a(2,2)=u3_16.c(2,1)*p136q*d4_52.b(1,2)+u3_16.a(2,2)*d & 4_52.a(2,2) * mline -- res=cres1(&),abcd=dia1.,m1=rmb,m2=(-rmb),den=((p136q-rmt2)*p136k * 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))/((p136q-rmt2 & )*p136k0) ENDDO ENDDO ENDIF **** 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.and.iproc.ne.43.and.iproc.ne.44)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 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 IF (istrcor.EQ.1.and.iproc.ne.43.and.iproc.ne.44) THEN ee_bbvv=ee_bbvv*(1.d0+qcdcor) ENDIF RETURN END double precision 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 COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp 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 ELSE fatcor_qcd=1.d0 fatcor_hh=1.d0 fatcor_hz=1.d0 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 IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=9.d0 ELSE IF((i3q.EQ.1.AND.i5q.EQ.0).OR.(i3q.EQ.0.AND.i5q.EQ.1))THEN rc=3.d0 ELSE rc=1.d0 ENDIF 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 double precision 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 COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp 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.and.iproc.ne.50)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 IF(i3q.EQ.1)THEN rc=3.d0 ELSE rc=1.d0 ENDIF ee_bbee=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/rden IF (istrcor.EQ.1.and.iproc.ne.50) THEN ee_bbee=ee_bbee*(1.d0+qcdcor_nc) ENDIF RETURN END double precision FUNCTION ee_bbbb(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),p34(0:3) DIMENSION p56(0:3),c34h(2,2),c56h(2,2),p54(0:3),p36(0:3),c36h(2,2) DIMENSION c54h(2,2),p154(0:3),p136(0:3),p536(0:3),p312(0:3) DIMENSION p156(0:3),p134(0:3),p356(0:3),p354(0:3),p534(0:3) DIMENSION p512(0:3) DIMENSION cres1(2,2,2,2,2),cres2(2,2,2,2,2),cres3(2,2,2,2,2) DIMENSION cres4(2,2,2,2,2),cres5(2,2,2,2,2),cres6(2,2,2,2,2) DIMENSION cres7(2,2,2,2,2),cres8(2,2,2,2,2),cres9(2,2,2,2,2) DIMENSION cres10(2,2,2,2,2),cres11(2,2,2,2,2),cres12(2,2,2,2,2) DIMENSION cres13(2,2,2,2,2),cres14(2,2,2,2,2),cres15(2,2,2,2,2) DIMENSION cres16(2,2,2,2,2),cres17(2,2,2,2,2),cres18(2,2,2,2,2) DIMENSION cres19(2,2,2,2,2),cres20(2,2,2,2,2),cres21(2,2,2,2,2) DIMENSION cres22(2,2,2,2,2),cres23(2,2,2,2,2),cres24(2,2,2,2,2) DIMENSION cres25(2,2,2,2,2),cres26(2,2,2,2,2),cres27(2,2,2,2,2) DIMENSION cres28(2,2,2,2,2),cres29(2,2,2,2,2),cres30(2,2,2,2,2) DIMENSION cres31(2,2,2,2,2),cres32(2,2,2,2,2),cres33(2,2,2,2,2) DIMENSION cres34(2,2,2,2,2),cres35(2,2,2,2,2),cres36(2,2,2,2,2) DIMENSION cres17a(2,2,2,2,2),cres18a(2,2,2,2,2), & cres19a(2,2,2,2,2),cres20a(2,2,2,2,2),cres21a(2,2,2,2,2), & cres22a(2,2,2,2,2),cres23a(2,2,2,2,2),cres24a(2,2,2,2,2) DIMENSION cresp1(2,2,2),cresp2(2,2,2),cresp3(2,2,2),cresp4(2,2,2) DIMENSION cresp5(2,2,2),cresp6(2,2,2),cresp7(2,2,2),cresp8(2,2,2) DIMENSION cresp9(2,2,2),cresp10(2,2,2),cresp11(2,2,2) DIMENSION cresp12(2,2,2),cresp13(2,2,2),cresp14(2,2,2) DIMENSION cresp15(2,2,2),cresp16(2,2,2) DIMENSION cresha1(2,2,2,2,2),cresha2(2,2,2,2,2) DIMENSION cresha3(2,2,2,2,2),cresha4(2,2,2,2,2) DIMENSION c34a(2,2),c54a(2,2),c36a(2,2),c56a(2,2) STRUCTURE/polcom/ double COMPLEX e(0:3),ek0 END STRUCTURE RECORD/polcom/c12z(2),c34z(2,2),c56z(2,2),c54z(2,2),c36z(2,2), & c12f(2),c34f(2,2),c56f(2,2),c54f(2,2),c36f(2,2) STRUCTURE/tuz/ double COMPLEX a(2,2),b(2,2),c(2,2),d(2,2) END STRUCTURE RECORD/tuz/v3_4(0:3),v5_6(0:3),v3_4h,v5_6h,v3_6(0:3),v5_36h, & v5_4(0:3),v3_6h,v5_4h,v3_56h,v3_54h,v5_34h,v4_56h,v6_54h,v4_36h, & r4_12f(2),r4_12z(2),l5_12f(2),l5_12z(2),l5_36(2,2),dia1(2), & r4_36f(2,2),v6_34h,l3_12fz(2),l5_12fz(2),l3_56(2,2),l3_54(2,2), & dia(2,2,2),r4_36z(2,2),l5_34(2,2),r4_12fz(2),r6_12fz(2), & r6_12z(2),r6_12f(2),r4_56z(2,2),r6_54z(2,2),r6_34z(2,2), & l3_12z(2),l3_12f(2),r4_56f(2,2),r6_54f(2,2),r6_34f(2,2), & v3_4a,v3_6a,v5_6a,v5_4a, & v3_56a,v3_54a,v5_34a,v4_56a,v6_54a,v4_36a,v6_34a,v5_36a STRUCTURE/toz/ double COMPLEX a(2),b(2),c(2),d(2) END STRUCTURE RECORD/toz/l1_54f(2,2),l1_56f(2,2),l1_34f(2,2),l1_36f(2,2), & r2_54f(2,2),r2_36f(2,2),r2_34f(2,2),r2_56f(2,2),r2_56z(2,2), & l1_54z(2,2),l1_56z(2,2),l1_34z(2,2),l1_36z(2,2),r2_34z(2,2), & r2_54z(2,2),r2_36z(2,2) STRUCTURE/rid/ double COMPLEX id(0:1) END STRUCTURE RECORD/rid/cres_qcd(2,2,2,2,2),cres_nc(2,2,2,2,2), & cres_h(2,2,2,2,2),cres_hz(2,2,2,2,2), & cres_a(2,2,2,2,2),cres_ha(2,2,2,2,2) COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,iha,icut,igwcomp,igzcomp,ighcomp,iswgcomp, & irmhcomp 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 COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/absusy/rma,rma2,rzha,rabb 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) rdf=-1.d0/s fac1=(rdf*fer) fac2=(rdf*fel) cfac1z=(cdz*zer) cfac2z=(cdz*zel) p3k0=p3(0)-p3(1) p4k0=p4(0)-p4(1) p5k0=p5(0)-p5(1) p6k0=p6(0)-p6(1) *********************NUOVO 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) p56(m)=p5(m)+p6(m) p36(m)=p3(m)+p6(m) p54(m)=p5(m)+p4(m) p154(m)=p54(m)-p1(m) p136(m)=p36(m)-p1(m) p156(m)=p56(m)-p1(m) p134(m)=p34(m)-p1(m) p536(m)=p36(m)+p5(m) p356(m)=p536(m) p312(m)=-(p54(m)+p6(m)) p534(m)=p34(m)+p5(m) p354(m)=p534(m) p512(m)=-p36(m)-p4(m) END DO * pk0 -- p=p154 p154k0=p154(0)-p154(1) * p.q -- p.q=p154q,p=p154,q=p154 p154q=p154(0)*p154(0)-p154(1)*p154(1)-p154(2)*p154(2)-p154 & (3)*p154(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=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=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=p536 p536k0=p536(0)-p536(1) * p.q -- p.q=p536q,p=p536,q=p536 p536q=p536(0)*p536(0)-p536(1)*p536(1)-p536(2)*p536(2)-p536 & (3)*p536(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) * pk0 -- p=p312 p312k0=p312(0)-p312(1) * p.q -- p.q=p312q,p=p312,q=p312 p312q=p312(0)*p312(0)-p312(1)*p312(1)-p312(2)*p312(2)-p312 & (3)*p312(3) * pk0 -- p=p534 p534k0=p534(0)-p534(1) * p.q -- p.q=p534q,p=p534,q=p534 p534q=p534(0)*p534(0)-p534(1)*p534(1)-p534(2)*p534(2)-p534 & (3)*p534(3) * pk0 -- p=p354 p354k0=p354(0)-p354(1) * p.q -- p.q=p354q,p=p354,q=p354 p354q=p354(0)*p354(0)-p354(1)*p354(1)-p354(2)*p354(2)-p354 & (3)*p354(3) * pk0 -- p=p512 p512k0=p512(0)-p512(1) * p.q -- p.q=p512q,p=p512,q=p512 p512q=p512(0)*p512(0)-p512(1)*p512(1)-p512(2)*p512(2)-p512 & (3)*p512(3) * Vertici e+ e- Z,A ( leptoni non massivi ) * quqd -- p=p1,q=p2 quqd=p1(0)*p2(0)-p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3) * T10 -- qu=p1,qd=p2,v=0,a=c12z(&).e(0),cr=cfac1z,cl=cfac2z,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) c12z(1).e(0)=cfac1z*(auxa+ceps_0) c12z(2).e(0)=cfac2z*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=1,a=c12z(&).e(1),cr=cfac1z,cl=cfac2z,nsum=0 auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12z(1).e(1)=cfac1z*(auxa+ceps_0) c12z(2).e(1)=cfac2z*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=2,a=c12z(&).e(2),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=-p1k0*p2(3)+p2k0*p1(3) ceps_0=eps_0*cim auxa=p1k0*p2(2)+p2k0*p1(2) c12z(1).e(2)=cfac1z*(auxa+ceps_0) c12z(2).e(2)=cfac2z*(auxa-ceps_0) * T10 -- qu=p1,qd=p2,v=3,a=c12z(&).e(3),cr=cfac1z,cl=cfac2z,nsum=0 eps_0=p1k0*p2(2)-p2k0*p1(2) ceps_0=eps_0*cim auxa=p1k0*p2(3)+p2k0*p1(3) c12z(1).e(3)=cfac1z*(auxa+ceps_0) c12z(2).e(3)=cfac2z*(auxa-ceps_0) DO i=1,2 * pk0 -- p=c12z(i).e c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO * 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 i=1,2 * pk0 -- p=c12f(i).e c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO * Vertice b b~ Z ( quarks massivi ) * 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+rmb2)*czipr-rmz2+ccz) * T -- qu=p5,qd=p6,v=0,a=v5_6(0).a,b=v5_6(0).b,c=v5_6(0).c,d=v5_6(0).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim ceps_1=p5(3)*cim ceps_2=p6(3)*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) v5_6(0).a(1,1)=zqdr*(auxa+ceps_0) v5_6(0).a(2,2)=zqdl*(auxa-ceps_0) v5_6(0).b(1,2)=-zqdl*(p6(2)+ceps_2) v5_6(0).b(2,1)=zqdr*(p6(2)-ceps_2) v5_6(0).c(1,2)=zqdr*(p5(2)+ceps_1) v5_6(0).c(2,1)=zqdl*(-p5(2)+ceps_1) v5_6(0).d(1,1)=zqdl v5_6(0).d(2,2)=zqdr * T -- qu=p5,qd=p6,v=1,a=v5_6(1).a,b=v5_6(1).b,c=v5_6(1).c,d=v5_6(1).d,cr=z * qdr,cl=zqdl,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) v5_6(1).a(1,1)=zqdr*(auxa+ceps_0) v5_6(1).a(2,2)=zqdl*(auxa-ceps_0) v5_6(1).b(1,2)=-zqdl*(p6(2)+ceps_2) v5_6(1).b(2,1)=zqdr*(p6(2)-ceps_2) v5_6(1).c(1,2)=zqdr*(p5(2)+ceps_1) v5_6(1).c(2,1)=zqdl*(-p5(2)+ceps_1) v5_6(1).d(1,1)=zqdl v5_6(1).d(2,2)=zqdr * T -- qu=p5,qd=p6,v=2,a=v5_6(2).a,b=v5_6(2).b,c=v5_6(2).c,d=v5_6(2).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) v5_6(2).a(1,1)=zqdr*(auxa+ceps_0) v5_6(2).a(2,2)=zqdl*(auxa-ceps_0) v5_6(2).b(1,2)=-zqdl*p6k0 v5_6(2).b(2,1)=zqdr*p6k0 v5_6(2).c(1,2)=zqdr*p5k0 v5_6(2).c(2,1)=-zqdl*p5k0 * T -- qu=p5,qd=p6,v=3,a=v5_6(3).a,b=v5_6(3).b,c=v5_6(3).c,d=v5_6(3).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim ceps_1=p5k0*cim ceps_2=p6k0*cim auxa=+p5k0*p6(3)+p6k0*p5(3) v5_6(3).a(1,1)=zqdr*(auxa+ceps_0) v5_6(3).a(2,2)=zqdl*(auxa-ceps_0) v5_6(3).b(1,2)=-zqdl*ceps_2 v5_6(3).b(2,1)=-zqdr*ceps_2 v5_6(3).c(1,2)=zqdr*ceps_1 v5_6(3).c(2,1)=zqdl*ceps_1 DO mu=0,3 * mline -- res=c56z(&).e(mu),abcd=v5_6(mu).,m1=rmb,m2=(-rmb),den=cdz DO iut=1,2 DO jut=1,2 c56z(iut,jut).e(mu)=(v5_6(mu).a(iut,jut)+rmb*v5_6(mu).b(iu & t,jut)+(-rmb)*v5_6(mu).c(iut,jut)+rmb*(-rmb)*v5_6(mu).d(i & ut,jut))/cdz ENDDO ENDDO END DO * Aggiungo al propagatore dello Z il termine prop. a k(mu)*k(nu) DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c56z(i1,i2).e,q=p56 caux=c56z(i1,i2).e(0)*p56(0)-c56z(i1,i2).e(1)*p56(1)-c56z( & i1,i2).e(2)*p56(2)-c56z(i1,i2).e(3)*p56(3) DO m=0,3 c56z(i1,i2).e(m)=c56z(i1,i2).e(m)-caux*p56(m)/rmz2 ENDDO !m ENDDO !i2 ENDDO !i1 DO i1=1,2 DO i2=1,2 * pk0 -- p=c56z(i1,i2).e c56z(i1,i2).ek0=c56z(i1,i2).e(0)-c56z(i1,i2).e(1) END DO END DO * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cdz=-(2.d0*(quqd+rmb2)*czipr-rmz2+ccz) * T -- qu=p3,qd=p4,v=0,a=v3_4(0).a,b=v3_4(0).b,c=v3_4(0).c,d=v3_4(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) v3_4(0).a(1,1)=zqdr*(auxa+ceps_0) v3_4(0).a(2,2)=zqdl*(auxa-ceps_0) v3_4(0).b(1,2)=-zqdl*(p4(2)+ceps_2) v3_4(0).b(2,1)=zqdr*(p4(2)-ceps_2) v3_4(0).c(1,2)=zqdr*(p3(2)+ceps_1) v3_4(0).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_4(0).d(1,1)=zqdl v3_4(0).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=1,a=v3_4(1).a,b=v3_4(1).b,c=v3_4(1).c,d=v3_4(1).d,cr=z * qdr,cl=zqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v3_4(1).a(1,1)=zqdr*(auxa+ceps_0) v3_4(1).a(2,2)=zqdl*(auxa-ceps_0) v3_4(1).b(1,2)=-zqdl*(p4(2)+ceps_2) v3_4(1).b(2,1)=zqdr*(p4(2)-ceps_2) v3_4(1).c(1,2)=zqdr*(p3(2)+ceps_1) v3_4(1).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_4(1).d(1,1)=zqdl v3_4(1).d(2,2)=zqdr * T -- qu=p3,qd=p4,v=2,a=v3_4(2).a,b=v3_4(2).b,c=v3_4(2).c,d=v3_4(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) v3_4(2).a(1,1)=zqdr*(auxa+ceps_0) v3_4(2).a(2,2)=zqdl*(auxa-ceps_0) v3_4(2).b(1,2)=-zqdl*p4k0 v3_4(2).b(2,1)=zqdr*p4k0 v3_4(2).c(1,2)=zqdr*p3k0 v3_4(2).c(2,1)=-zqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v3_4(3).a,b=v3_4(3).b,c=v3_4(3).c,d=v3_4(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) v3_4(3).a(1,1)=zqdr*(auxa+ceps_0) v3_4(3).a(2,2)=zqdl*(auxa-ceps_0) v3_4(3).b(1,2)=-zqdl*ceps_2 v3_4(3).b(2,1)=-zqdr*ceps_2 v3_4(3).c(1,2)=zqdr*ceps_1 v3_4(3).c(2,1)=zqdl*ceps_1 DO mu=0,3 * mline -- res=c34z(&).e(mu),abcd=v3_4(mu).,m1=rmb,m2=(-rmb),den=cdz DO iut=1,2 DO jut=1,2 c34z(iut,jut).e(mu)=(v3_4(mu).a(iut,jut)+rmb*v3_4(mu).b(iu & t,jut)+(-rmb)*v3_4(mu).c(iut,jut)+rmb*(-rmb)*v3_4(mu).d(i & ut,jut))/cdz ENDDO ENDDO END DO * Aggiungo al propagatore dello Z il termine 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 ENDDO !m ENDDO !i2 ENDDO !i1 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 * quqd -- p=p3,q=p6 quqd=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) cdz=-(2.d0*(quqd+rmb2)*czipr-rmz2+ccz) * T -- qu=p3,qd=p6,v=0,a=v3_6(0).a,b=v3_6(0).b,c=v3_6(0).c,d=v3_6(0).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p3(2)*p6(3)+p6(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p6(3)*cim auxa=-quqd+p3k0*p6(0)+p6k0*p3(0) v3_6(0).a(1,1)=zqdr*(auxa+ceps_0) v3_6(0).a(2,2)=zqdl*(auxa-ceps_0) v3_6(0).b(1,2)=-zqdl*(p6(2)+ceps_2) v3_6(0).b(2,1)=zqdr*(p6(2)-ceps_2) v3_6(0).c(1,2)=zqdr*(p3(2)+ceps_1) v3_6(0).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_6(0).d(1,1)=zqdl v3_6(0).d(2,2)=zqdr * T -- qu=p3,qd=p6,v=1,a=v3_6(1).a,b=v3_6(1).b,c=v3_6(1).c,d=v3_6(1).d,cr=z * qdr,cl=zqdl,nsum=0 auxa=-quqd+p3k0*p6(1)+p6k0*p3(1) v3_6(1).a(1,1)=zqdr*(auxa+ceps_0) v3_6(1).a(2,2)=zqdl*(auxa-ceps_0) v3_6(1).b(1,2)=-zqdl*(p6(2)+ceps_2) v3_6(1).b(2,1)=zqdr*(p6(2)-ceps_2) v3_6(1).c(1,2)=zqdr*(p3(2)+ceps_1) v3_6(1).c(2,1)=zqdl*(-p3(2)+ceps_1) v3_6(1).d(1,1)=zqdl v3_6(1).d(2,2)=zqdr * T -- qu=p3,qd=p6,v=2,a=v3_6(2).a,b=v3_6(2).b,c=v3_6(2).c,d=v3_6(2).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p3k0*p6(3)+p6k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p6(2)+p6k0*p3(2) v3_6(2).a(1,1)=zqdr*(auxa+ceps_0) v3_6(2).a(2,2)=zqdl*(auxa-ceps_0) v3_6(2).b(1,2)=-zqdl*p6k0 v3_6(2).b(2,1)=zqdr*p6k0 v3_6(2).c(1,2)=zqdr*p3k0 v3_6(2).c(2,1)=-zqdl*p3k0 * T -- qu=p3,qd=p6,v=3,a=v3_6(3).a,b=v3_6(3).b,c=v3_6(3).c,d=v3_6(3).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=p3k0*p6(2)-p6k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p6k0*cim auxa=+p3k0*p6(3)+p6k0*p3(3) v3_6(3).a(1,1)=zqdr*(auxa+ceps_0) v3_6(3).a(2,2)=zqdl*(auxa-ceps_0) v3_6(3).b(1,2)=-zqdl*ceps_2 v3_6(3).b(2,1)=-zqdr*ceps_2 v3_6(3).c(1,2)=zqdr*ceps_1 v3_6(3).c(2,1)=zqdl*ceps_1 DO mu=0,3 * mline -- res=c36z(&).e(mu),abcd=v3_6(mu).,m1=rmb,m2=(-rmb),den=cdz DO iut=1,2 DO jut=1,2 c36z(iut,jut).e(mu)=(v3_6(mu).a(iut,jut)+rmb*v3_6(mu).b(iu & t,jut)+(-rmb)*v3_6(mu).c(iut,jut)+rmb*(-rmb)*v3_6(mu).d(i & ut,jut))/cdz ENDDO ENDDO END DO * Aggiungo al propagatore dello Z il termine prop. a k(mu)*k(nu) DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c36z(i1,i2).e,q=p36 caux=c36z(i1,i2).e(0)*p36(0)-c36z(i1,i2).e(1)*p36(1)-c36z( & i1,i2).e(2)*p36(2)-c36z(i1,i2).e(3)*p36(3) DO m=0,3 c36z(i1,i2).e(m)=c36z(i1,i2).e(m)-caux*p36(m)/rmz2 ENDDO !m ENDDO !i2 ENDDO !i1 DO i1=1,2 DO i2=1,2 * pk0 -- p=c36z(i1,i2).e c36z(i1,i2).ek0=c36z(i1,i2).e(0)-c36z(i1,i2).e(1) END DO END DO * quqd -- p=p5,q=p4 quqd=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) cdz=-(2.d0*(quqd+rmb2)*czipr-rmz2+ccz) * T -- qu=p5,qd=p4,v=0,a=v5_4(0).a,b=v5_4(0).b,c=v5_4(0).c,d=v5_4(0).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p5(2)*p4(3)+p4(2)*p5(3) ceps_0=eps_0*cim ceps_1=p5(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p5k0*p4(0)+p4k0*p5(0) v5_4(0).a(1,1)=zqdr*(auxa+ceps_0) v5_4(0).a(2,2)=zqdl*(auxa-ceps_0) v5_4(0).b(1,2)=-zqdl*(p4(2)+ceps_2) v5_4(0).b(2,1)=zqdr*(p4(2)-ceps_2) v5_4(0).c(1,2)=zqdr*(p5(2)+ceps_1) v5_4(0).c(2,1)=zqdl*(-p5(2)+ceps_1) v5_4(0).d(1,1)=zqdl v5_4(0).d(2,2)=zqdr * T -- qu=p5,qd=p4,v=1,a=v5_4(1).a,b=v5_4(1).b,c=v5_4(1).c,d=v5_4(1).d,cr=z * qdr,cl=zqdl,nsum=0 auxa=-quqd+p5k0*p4(1)+p4k0*p5(1) v5_4(1).a(1,1)=zqdr*(auxa+ceps_0) v5_4(1).a(2,2)=zqdl*(auxa-ceps_0) v5_4(1).b(1,2)=-zqdl*(p4(2)+ceps_2) v5_4(1).b(2,1)=zqdr*(p4(2)-ceps_2) v5_4(1).c(1,2)=zqdr*(p5(2)+ceps_1) v5_4(1).c(2,1)=zqdl*(-p5(2)+ceps_1) v5_4(1).d(1,1)=zqdl v5_4(1).d(2,2)=zqdr * T -- qu=p5,qd=p4,v=2,a=v5_4(2).a,b=v5_4(2).b,c=v5_4(2).c,d=v5_4(2).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=-p5k0*p4(3)+p4k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p4(2)+p4k0*p5(2) v5_4(2).a(1,1)=zqdr*(auxa+ceps_0) v5_4(2).a(2,2)=zqdl*(auxa-ceps_0) v5_4(2).b(1,2)=-zqdl*p4k0 v5_4(2).b(2,1)=zqdr*p4k0 v5_4(2).c(1,2)=zqdr*p5k0 v5_4(2).c(2,1)=-zqdl*p5k0 * T -- qu=p5,qd=p4,v=3,a=v5_4(3).a,b=v5_4(3).b,c=v5_4(3).c,d=v5_4(3).d,cr=z * qdr,cl=zqdl,nsum=0 eps_0=p5k0*p4(2)-p4k0*p5(2) ceps_0=eps_0*cim ceps_1=p5k0*cim ceps_2=p4k0*cim auxa=+p5k0*p4(3)+p4k0*p5(3) v5_4(3).a(1,1)=zqdr*(auxa+ceps_0) v5_4(3).a(2,2)=zqdl*(auxa-ceps_0) v5_4(3).b(1,2)=-zqdl*ceps_2 v5_4(3).b(2,1)=-zqdr*ceps_2 v5_4(3).c(1,2)=zqdr*ceps_1 v5_4(3).c(2,1)=zqdl*ceps_1 DO mu=0,3 * mline -- res=c54z(&).e(mu),abcd=v5_4(mu).,m1=rmb,m2=(-rmb),den=cdz DO iut=1,2 DO jut=1,2 c54z(iut,jut).e(mu)=(v5_4(mu).a(iut,jut)+rmb*v5_4(mu).b(iu & t,jut)+(-rmb)*v5_4(mu).c(iut,jut)+rmb*(-rmb)*v5_4(mu).d(i & ut,jut))/cdz ENDDO ENDDO END DO * Aggiungo al propagatore dello Z il termine prop. a k(mu)*k(nu) DO i1=1,2 DO i2=1,2 * p.q -- p.q=caux,p=c54z(i1,i2).e,q=p54 caux=c54z(i1,i2).e(0)*p54(0)-c54z(i1,i2).e(1)*p54(1)-c54z( & i1,i2).e(2)*p54(2)-c54z(i1,i2).e(3)*p54(3) DO m=0,3 c54z(i1,i2).e(m)=c54z(i1,i2).e(m)-caux*p54(m)/rmz2 ENDDO !m ENDDO !i2 ENDDO !i1 DO i1=1,2 DO i2=1,2 * pk0 -- p=c54z(i1,i2).e c54z(i1,i2).ek0=c54z(i1,i2).e(0)-c54z(i1,i2).e(1) END DO END DO IF (imix.EQ.-1.or.imix.eq.-2) then * Vertice b b~ A ( quarks massivi ) * quqd -- p=p5,q=p6 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) rdf=-2.d0*(quqd+rmb2) * T -- qu=p5,qd=p6,v=0,a=v5_6(0).a,b=v5_6(0).b,c=v5_6(0).c,d=v5_6(0).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p5(2)*p6(3)+p6(2)*p5(3) ceps_0=eps_0*cim ceps_1=p5(3)*cim ceps_2=p6(3)*cim auxa=-quqd+p5k0*p6(0)+p6k0*p5(0) v5_6(0).a(1,1)=fqdr*(auxa+ceps_0) v5_6(0).a(2,2)=fqdl*(auxa-ceps_0) v5_6(0).b(1,2)=-fqdl*(p6(2)+ceps_2) v5_6(0).b(2,1)=fqdr*(p6(2)-ceps_2) v5_6(0).c(1,2)=fqdr*(p5(2)+ceps_1) v5_6(0).c(2,1)=fqdl*(-p5(2)+ceps_1) v5_6(0).d(1,1)=fqdl v5_6(0).d(2,2)=fqdr * T -- qu=p5,qd=p6,v=1,a=v5_6(1).a,b=v5_6(1).b,c=v5_6(1).c,d=v5_6(1).d,cr=f * qdr,cl=fqdl,nsum=0 auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) v5_6(1).a(1,1)=fqdr*(auxa+ceps_0) v5_6(1).a(2,2)=fqdl*(auxa-ceps_0) v5_6(1).b(1,2)=-fqdl*(p6(2)+ceps_2) v5_6(1).b(2,1)=fqdr*(p6(2)-ceps_2) v5_6(1).c(1,2)=fqdr*(p5(2)+ceps_1) v5_6(1).c(2,1)=fqdl*(-p5(2)+ceps_1) v5_6(1).d(1,1)=fqdl v5_6(1).d(2,2)=fqdr * T -- qu=p5,qd=p6,v=2,a=v5_6(2).a,b=v5_6(2).b,c=v5_6(2).c,d=v5_6(2).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p5k0*p6(3)+p6k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p6(2)+p6k0*p5(2) v5_6(2).a(1,1)=fqdr*(auxa+ceps_0) v5_6(2).a(2,2)=fqdl*(auxa-ceps_0) v5_6(2).b(1,2)=-fqdl*p6k0 v5_6(2).b(2,1)=fqdr*p6k0 v5_6(2).c(1,2)=fqdr*p5k0 v5_6(2).c(2,1)=-fqdl*p5k0 * T -- qu=p5,qd=p6,v=3,a=v5_6(3).a,b=v5_6(3).b,c=v5_6(3).c,d=v5_6(3).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=p5k0*p6(2)-p6k0*p5(2) ceps_0=eps_0*cim ceps_1=p5k0*cim ceps_2=p6k0*cim auxa=+p5k0*p6(3)+p6k0*p5(3) v5_6(3).a(1,1)=fqdr*(auxa+ceps_0) v5_6(3).a(2,2)=fqdl*(auxa-ceps_0) v5_6(3).b(1,2)=-fqdl*ceps_2 v5_6(3).b(2,1)=-fqdr*ceps_2 v5_6(3).c(1,2)=fqdr*ceps_1 v5_6(3).c(2,1)=fqdl*ceps_1 DO mu=0,3 * mline -- res=c56f(&).e(mu),abcd=v5_6(mu).,m1=rmb,m2=(-rmb),den=rdf DO iut=1,2 DO jut=1,2 c56f(iut,jut).e(mu)=(v5_6(mu).a(iut,jut)+rmb*v5_6(mu).b(iu & t,jut)+(-rmb)*v5_6(mu).c(iut,jut)+rmb*(-rmb)*v5_6(mu). & d(i & ut,jut))/rdf ENDDO ENDDO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c56f(i1,i2).e c56f(i1,i2).ek0=c56f(i1,i2).e(0)-c56f(i1,i2).e(1) END DO END DO * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) rdf=-2.d0*(quqd+rmb2) * T -- qu=p3,qd=p4,v=0,a=v3_4(0).a,b=v3_4(0).b,c=v3_4(0).c,d=v3_4(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) v3_4(0).a(1,1)=fqdr*(auxa+ceps_0) v3_4(0).a(2,2)=fqdl*(auxa-ceps_0) v3_4(0).b(1,2)=-fqdl*(p4(2)+ceps_2) v3_4(0).b(2,1)=fqdr*(p4(2)-ceps_2) v3_4(0).c(1,2)=fqdr*(p3(2)+ceps_1) v3_4(0).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_4(0).d(1,1)=fqdl v3_4(0).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=1,a=v3_4(1).a,b=v3_4(1).b,c=v3_4(1).c,d=v3_4(1).d,cr=f * qdr,cl=fqdl,nsum=0 auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) v3_4(1).a(1,1)=fqdr*(auxa+ceps_0) v3_4(1).a(2,2)=fqdl*(auxa-ceps_0) v3_4(1).b(1,2)=-fqdl*(p4(2)+ceps_2) v3_4(1).b(2,1)=fqdr*(p4(2)-ceps_2) v3_4(1).c(1,2)=fqdr*(p3(2)+ceps_1) v3_4(1).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_4(1).d(1,1)=fqdl v3_4(1).d(2,2)=fqdr * T -- qu=p3,qd=p4,v=2,a=v3_4(2).a,b=v3_4(2).b,c=v3_4(2).c,d=v3_4(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) v3_4(2).a(1,1)=fqdr*(auxa+ceps_0) v3_4(2).a(2,2)=fqdl*(auxa-ceps_0) v3_4(2).b(1,2)=-fqdl*p4k0 v3_4(2).b(2,1)=fqdr*p4k0 v3_4(2).c(1,2)=fqdr*p3k0 v3_4(2).c(2,1)=-fqdl*p3k0 * T -- qu=p3,qd=p4,v=3,a=v3_4(3).a,b=v3_4(3).b,c=v3_4(3).c,d=v3_4(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) v3_4(3).a(1,1)=fqdr*(auxa+ceps_0) v3_4(3).a(2,2)=fqdl*(auxa-ceps_0) v3_4(3).b(1,2)=-fqdl*ceps_2 v3_4(3).b(2,1)=-fqdr*ceps_2 v3_4(3).c(1,2)=fqdr*ceps_1 v3_4(3).c(2,1)=fqdl*ceps_1 DO mu=0,3 * mline -- res=c34f(&).e(mu),abcd=v3_4(mu).,m1=rmb,m2=(-rmb),den=rdf DO iut=1,2 DO jut=1,2 c34f(iut,jut).e(mu)=(v3_4(mu).a(iut,jut)+rmb*v3_4(mu).b(iu & t,jut)+(-rmb)*v3_4(mu).c(iut,jut)+rmb*(-rmb)*v3_4(mu). & d(i & ut,jut))/rdf 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 * quqd -- p=p3,q=p6 quqd=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) rdf=-2.d0*(quqd+rmb2) * T -- qu=p3,qd=p6,v=0,a=v3_6(0).a,b=v3_6(0).b,c=v3_6(0).c,d=v3_6(0).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p3(2)*p6(3)+p6(2)*p3(3) ceps_0=eps_0*cim ceps_1=p3(3)*cim ceps_2=p6(3)*cim auxa=-quqd+p3k0*p6(0)+p6k0*p3(0) v3_6(0).a(1,1)=fqdr*(auxa+ceps_0) v3_6(0).a(2,2)=fqdl*(auxa-ceps_0) v3_6(0).b(1,2)=-fqdl*(p6(2)+ceps_2) v3_6(0).b(2,1)=fqdr*(p6(2)-ceps_2) v3_6(0).c(1,2)=fqdr*(p3(2)+ceps_1) v3_6(0).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_6(0).d(1,1)=fqdl v3_6(0).d(2,2)=fqdr * T -- qu=p3,qd=p6,v=1,a=v3_6(1).a,b=v3_6(1).b,c=v3_6(1).c,d=v3_6(1).d,cr=f * qdr,cl=fqdl,nsum=0 auxa=-quqd+p3k0*p6(1)+p6k0*p3(1) v3_6(1).a(1,1)=fqdr*(auxa+ceps_0) v3_6(1).a(2,2)=fqdl*(auxa-ceps_0) v3_6(1).b(1,2)=-fqdl*(p6(2)+ceps_2) v3_6(1).b(2,1)=fqdr*(p6(2)-ceps_2) v3_6(1).c(1,2)=fqdr*(p3(2)+ceps_1) v3_6(1).c(2,1)=fqdl*(-p3(2)+ceps_1) v3_6(1).d(1,1)=fqdl v3_6(1).d(2,2)=fqdr * T -- qu=p3,qd=p6,v=2,a=v3_6(2).a,b=v3_6(2).b,c=v3_6(2).c,d=v3_6(2).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p3k0*p6(3)+p6k0*p3(3) ceps_0=eps_0*cim auxa=p3k0*p6(2)+p6k0*p3(2) v3_6(2).a(1,1)=fqdr*(auxa+ceps_0) v3_6(2).a(2,2)=fqdl*(auxa-ceps_0) v3_6(2).b(1,2)=-fqdl*p6k0 v3_6(2).b(2,1)=fqdr*p6k0 v3_6(2).c(1,2)=fqdr*p3k0 v3_6(2).c(2,1)=-fqdl*p3k0 * T -- qu=p3,qd=p6,v=3,a=v3_6(3).a,b=v3_6(3).b,c=v3_6(3).c,d=v3_6(3).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=p3k0*p6(2)-p6k0*p3(2) ceps_0=eps_0*cim ceps_1=p3k0*cim ceps_2=p6k0*cim auxa=+p3k0*p6(3)+p6k0*p3(3) v3_6(3).a(1,1)=fqdr*(auxa+ceps_0) v3_6(3).a(2,2)=fqdl*(auxa-ceps_0) v3_6(3).b(1,2)=-fqdl*ceps_2 v3_6(3).b(2,1)=-fqdr*ceps_2 v3_6(3).c(1,2)=fqdr*ceps_1 v3_6(3).c(2,1)=fqdl*ceps_1 DO mu=0,3 * mline -- res=c36f(&).e(mu),abcd=v3_6(mu).,m1=rmb,m2=(-rmb),den=rdf DO iut=1,2 DO jut=1,2 c36f(iut,jut).e(mu)=(v3_6(mu).a(iut,jut)+rmb*v3_6(mu).b(iu & t,jut)+(-rmb)*v3_6(mu).c(iut,jut)+rmb*(-rmb)*v3_6(mu). & d(i & ut,jut))/rdf ENDDO ENDDO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c36f(i1,i2).e c36f(i1,i2).ek0=c36f(i1,i2).e(0)-c36f(i1,i2).e(1) END DO END DO * quqd -- p=p5,q=p4 quqd=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) rdf=-2.d0*(quqd+rmb2) * T -- qu=p5,qd=p4,v=0,a=v5_4(0).a,b=v5_4(0).b,c=v5_4(0).c,d=v5_4(0).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p5(2)*p4(3)+p4(2)*p5(3) ceps_0=eps_0*cim ceps_1=p5(3)*cim ceps_2=p4(3)*cim auxa=-quqd+p5k0*p4(0)+p4k0*p5(0) v5_4(0).a(1,1)=fqdr*(auxa+ceps_0) v5_4(0).a(2,2)=fqdl*(auxa-ceps_0) v5_4(0).b(1,2)=-fqdl*(p4(2)+ceps_2) v5_4(0).b(2,1)=fqdr*(p4(2)-ceps_2) v5_4(0).c(1,2)=fqdr*(p5(2)+ceps_1) v5_4(0).c(2,1)=fqdl*(-p5(2)+ceps_1) v5_4(0).d(1,1)=fqdl v5_4(0).d(2,2)=fqdr * T -- qu=p5,qd=p4,v=1,a=v5_4(1).a,b=v5_4(1).b,c=v5_4(1).c,d=v5_4(1).d,cr=f * qdr,cl=fqdl,nsum=0 auxa=-quqd+p5k0*p4(1)+p4k0*p5(1) v5_4(1).a(1,1)=fqdr*(auxa+ceps_0) v5_4(1).a(2,2)=fqdl*(auxa-ceps_0) v5_4(1).b(1,2)=-fqdl*(p4(2)+ceps_2) v5_4(1).b(2,1)=fqdr*(p4(2)-ceps_2) v5_4(1).c(1,2)=fqdr*(p5(2)+ceps_1) v5_4(1).c(2,1)=fqdl*(-p5(2)+ceps_1) v5_4(1).d(1,1)=fqdl v5_4(1).d(2,2)=fqdr * T -- qu=p5,qd=p4,v=2,a=v5_4(2).a,b=v5_4(2).b,c=v5_4(2).c,d=v5_4(2).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=-p5k0*p4(3)+p4k0*p5(3) ceps_0=eps_0*cim auxa=p5k0*p4(2)+p4k0*p5(2) v5_4(2).a(1,1)=fqdr*(auxa+ceps_0) v5_4(2).a(2,2)=fqdl*(auxa-ceps_0) v5_4(2).b(1,2)=-fqdl*p4k0 v5_4(2).b(2,1)=fqdr*p4k0 v5_4(2).c(1,2)=fqdr*p5k0 v5_4(2).c(2,1)=-fqdl*p5k0 * T -- qu=p5,qd=p4,v=3,a=v5_4(3).a,b=v5_4(3).b,c=v5_4(3).c,d=v5_4(3).d,cr=f * qdr,cl=fqdl,nsum=0 eps_0=p5k0*p4(2)-p4k0*p5(2) ceps_0=eps_0*cim ceps_1=p5k0*cim ceps_2=p4k0*cim auxa=+p5k0*p4(3)+p4k0*p5(3) v5_4(3).a(1,1)=fqdr*(auxa+ceps_0) v5_4(3).a(2,2)=fqdl*(auxa-ceps_0) v5_4(3).b(1,2)=-fqdl*ceps_2 v5_4(3).b(2,1)=-fqdr*ceps_2 v5_4(3).c(1,2)=fqdr*ceps_1 v5_4(3).c(2,1)=fqdl*ceps_1 DO mu=0,3 * mline -- res=c54f(&).e(mu),abcd=v5_4(mu).,m1=rmb,m2=(-rmb),den=rdf DO iut=1,2 DO jut=1,2 c54f(iut,jut).e(mu)=(v5_4(mu).a(iut,jut)+rmb*v5_4(mu).b(iu & t,jut)+(-rmb)*v5_4(mu).c(iut,jut)+rmb*(-rmb)*v5_4(mu). & d(i & ut,jut))/rdf ENDDO ENDDO END DO DO i1=1,2 DO i2=1,2 * pk0 -- p=c54f(i1,i2).e c54f(i1,i2).ek0=c54f(i1,i2).e(0)-c54f(i1,i2).e(1) END DO END DO ENDIF IF(imix.EQ.1.OR.imix.EQ.-2)THEN * Vertice b b~ H ( quarks massivi ) * quqd -- p=p5,q=p6 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) * TH -- qu=p5,qd=p6,a=v5_6h.a,b=v5_6h.b,c=v5_6h.c v5_6h.a(1,2)=-p5k0*p6(2)+p6k0*p5(2)-cim*(p6(3)*p5k0-p5(3)* & p6k0) v5_6h.a(2,1)=-conjg(v5_6h.a(1,2)) v5_6h.b(1,1)=p6k0 v5_6h.b(2,2)=v5_6h.b(1,1) v5_6h.c(1,1)=p5k0 v5_6h.c(2,2)=v5_6h.c(1,1) * mline -- res=c56h(&),abcd=v5_6h.,m1=rmb,m2=(-rmb),den=cdh DO iut=1,2 DO jut=1,2 c56h(iut,jut)=(v5_6h.a(iut,jut)+rmb*v5_6h.b(iut,jut)+(-rmb & )*v5_6h.c(iut,jut)+rmb*(-rmb)*v5_6h.d(iut,jut))/cdh ENDDO ENDDO * 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 * quqd -- p=p5,q=p4 quqd=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) * TH -- qu=p5,qd=p4,a=v5_4h.a,b=v5_4h.b,c=v5_4h.c v5_4h.a(1,2)=-p5k0*p4(2)+p4k0*p5(2)-cim*(p4(3)*p5k0-p5(3)* & p4k0) v5_4h.a(2,1)=-conjg(v5_4h.a(1,2)) v5_4h.b(1,1)=p4k0 v5_4h.b(2,2)=v5_4h.b(1,1) v5_4h.c(1,1)=p5k0 v5_4h.c(2,2)=v5_4h.c(1,1) * mline -- res=c54h(&),abcd=v5_4h.,m1=rmb,m2=(-rmb),den=cdh DO iut=1,2 DO jut=1,2 c54h(iut,jut)=(v5_4h.a(iut,jut)+rmb*v5_4h.b(iut,jut)+(-rmb & )*v5_4h.c(iut,jut)+rmb*(-rmb)*v5_4h.d(iut,jut))/cdh ENDDO ENDDO * quqd -- p=p3,q=p6 quqd=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) * TH -- qu=p3,qd=p6,a=v3_6h.a,b=v3_6h.b,c=v3_6h.c v3_6h.a(1,2)=-p3k0*p6(2)+p6k0*p3(2)-cim*(p6(3)*p3k0-p3(3)* & p6k0) v3_6h.a(2,1)=-conjg(v3_6h.a(1,2)) v3_6h.b(1,1)=p6k0 v3_6h.b(2,2)=v3_6h.b(1,1) v3_6h.c(1,1)=p3k0 v3_6h.c(2,2)=v3_6h.c(1,1) * mline -- res=c36h(&),abcd=v3_6h.,m1=rmb,m2=(-rmb),den=cdh DO iut=1,2 DO jut=1,2 c36h(iut,jut)=(v3_6h.a(iut,jut)+rmb*v3_6h.b(iut,jut)+(-rmb & )*v3_6h.c(iut,jut)+rmb*(-rmb)*v3_6h.d(iut,jut))/cdh ENDDO ENDDO IF(isusy.EQ.1.AND.iha.NE.2.AND.iha.NE.4)THEN * quqd -- p=p5,q=p6 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) cda=-(2.d0*(quqd+rmb2)*caipr-rma2+cca) * TSC -- qu=p5,qd=p6,a=v5_6a.a,b=v5_6a.b,c=v5_6a.c,cr=1.d0,cl=-1.d0 auxa=-p5k0*p6(2)+p6k0*p5(2) cauxa=-cim*(p6(3)*p5k0-p5(3)*p6k0) v5_6a.a(1,2)=-1.d0*(auxa+cauxa) v5_6a.a(2,1)=(-auxa+cauxa) v5_6a.b(1,1)=p6k0 v5_6a.b(2,2)=-1.d0*p6k0 v5_6a.c(1,1)=-1.d0*p5k0 v5_6a.c(2,2)=p5k0 * mline -- res=c56a(&),abcd=v5_6a.,m1=rmb,m2=(-rmb),den=cda DO iut=1,2 DO jut=1,2 c56a(iut,jut)=(v5_6a.a(iut,jut)+rmb*v5_6a.b(iut,jut)+(-rmb & )*v5_6a.c(iut,jut)+rmb*(-rmb)*v5_6a.d(iut,jut))/cda ENDDO ENDDO * quqd -- p=p5,q=p4 quqd=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) cda=-(2.d0*(quqd+rmb2)*caipr-rma2+cca) * TSC -- qu=p5,qd=p4,a=v5_4a.a,b=v5_4a.b,c=v5_4a.c,cr=1.d0,cl=-1.d0 auxa=-p5k0*p4(2)+p4k0*p5(2) cauxa=-cim*(p4(3)*p5k0-p5(3)*p4k0) v5_4a.a(1,2)=-1.d0*(auxa+cauxa) v5_4a.a(2,1)=(-auxa+cauxa) v5_4a.b(1,1)=p4k0 v5_4a.b(2,2)=-1.d0*p4k0 v5_4a.c(1,1)=-1.d0*p5k0 v5_4a.c(2,2)=p5k0 * mline -- res=c54a(&),abcd=v5_4a.,m1=rmb,m2=(-rmb),den=cda DO iut=1,2 DO jut=1,2 c54a(iut,jut)=(v5_4a.a(iut,jut)+rmb*v5_4a.b(iut,jut)+(-rmb & )*v5_4a.c(iut,jut)+rmb*(-rmb)*v5_4a.d(iut,jut))/cda ENDDO ENDDO * quqd -- p=p3,q=p6 quqd=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) cda=-(2.d0*(quqd+rmb2)*caipr-rma2+cca) * TSC -- qu=p3,qd=p6,a=v3_6a.a,b=v3_6a.b,c=v3_6a.c,cr=1.d0,cl=-1.d0 auxa=-p3k0*p6(2)+p6k0*p3(2) cauxa=-cim*(p6(3)*p3k0-p3(3)*p6k0) v3_6a.a(1,2)=-1.d0*(auxa+cauxa) v3_6a.a(2,1)=(-auxa+cauxa) v3_6a.b(1,1)=p6k0 v3_6a.b(2,2)=-1.d0*p6k0 v3_6a.c(1,1)=-1.d0*p3k0 v3_6a.c(2,2)=p3k0 * mline -- res=c36a(&),abcd=v3_6a.,m1=rmb,m2=(-rmb),den=cda DO iut=1,2 DO jut=1,2 c36a(iut,jut)=(v3_6a.a(iut,jut)+rmb*v3_6a.b(iut,jut)+(-rmb & )*v3_6a.c(iut,jut)+rmb*(-rmb)*v3_6a.d(iut,jut))/cda ENDDO ENDDO * quqd -- p=p3,q=p4 quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cda=-(2.d0*(quqd+rmb2)*caipr-rma2+cca) * TSC -- qu=p3,qd=p4,a=v3_4a.a,b=v3_4a.b,c=v3_4a.c,cr=1.d0,cl=-1.d0 auxa=-p3k0*p4(2)+p4k0*p3(2) cauxa=-cim*(p4(3)*p3k0-p3(3)*p4k0) v3_4a.a(1,2)=-1.d0*(auxa+cauxa) v3_4a.a(2,1)=(-auxa+cauxa) v3_4a.b(1,1)=p4k0 v3_4a.b(2,2)=-1.d0*p4k0 v3_4a.c(1,1)=-1.d0*p3k0 v3_4a.c(2,2)=p3k0 * mline -- res=c34a(&),abcd=v3_4a.,m1=rmb,m2=(-rmb),den=cda DO iut=1,2 DO jut=1,2 c34a(iut,jut)=(v3_4a.a(iut,jut)+rmb*v3_4a.b(iut,jut)+(-rmb & )*v3_4a.c(iut,jut)+rmb*(-rmb)*v3_4a.d(iut,jut))/cda ENDDO ENDDO ENDIF !(isusy=1, iha=0,1,3,5,6) ENDIF !(imix=1,-2) IF(imix.EQ.-1.OR.imix.EQ.-2)THEN * quqd -- p=p1,q=p154 quqd=p1(0)*p154(0)-p1(1)*p154(1)-p1(2)*p154(2)-p1(3)*p154( & 3) DO i5=1,2 DO i4=1,2 * TL0 -- qu=p1,qd=p154,v=c54z(i5,i4).e,a=l1_54z(i5,i4).a,c=l1_54z(i5,i4).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c54z(i5,i4).ek0*(p1(2)*p154(3)-p154(2)*p1(3))+p1k0 & *(c54z(i5,i4).e(2)*p154(3)-p154(2)*c54z(i5,i4).e(3))-p154 & k0*(c54z(i5,i4).e(2)*p1(3)-p1(2)*c54z(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c54z(i5,i4).e(3)*p1k0+p1(3)*c54z(i5,i4).ek0 ceps_1=ceps_1*cim cvqu=c54z(i5,i4).e(0)*p1(0)-c54z(i5,i4).e(1)*p1(1)-c54z(i5 & ,i4).e(2)*p1(2)-c54z(i5,i4).e(3)*p1(3) cvqd=c54z(i5,i4).e(0)*p154(0)-c54z(i5,i4).e(1)*p154(1)-c54 & z(i5,i4).e(2)*p154(2)-c54z(i5,i4).e(3)*p154(3) cauxa=-c54z(i5,i4).ek0*quqd+p1k0*cvqd+p154k0*cvqu cauxc=+c54z(i5,i4).ek0*p1(2)-p1k0*c54z(i5,i4).e(2) l1_54z(i5,i4).a(1)=zer*(cauxa+ceps_0) l1_54z(i5,i4).a(2)=zel*(cauxa-ceps_0) l1_54z(i5,i4).c(1)=zer*(cauxc+ceps_1) l1_54z(i5,i4).c(2)=zel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p154,q=p2 quqd=p154(0)*p2(0)-p154(1)*p2(1)-p154(2)*p2(2)-p154(3)*p2( & 3) DO i3=1,2 DO i6=1,2 * TR0 -- qu=p154,qd=p2,v=c36z(i3,i6).e,a=r2_36z(i3,i6).a,b=r2_36z(i3,i6).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c36z(i3,i6).ek0*(p154(2)*p2(3)-p2(2)*p154(3))+p154 & k0*(c36z(i3,i6).e(2)*p2(3)-p2(2)*c36z(i3,i6).e(3))-p2k0*( & c36z(i3,i6).e(2)*p154(3)-p154(2)*c36z(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_2=-c36z(i3,i6).e(3)*p2k0+p2(3)*c36z(i3,i6).ek0 ceps_2=ceps_2*cim cvqu=c36z(i3,i6).e(0)*p154(0)-c36z(i3,i6).e(1)*p154(1)-c36 & z(i3,i6).e(2)*p154(2)-c36z(i3,i6).e(3)*p154(3) cvqd=c36z(i3,i6).e(0)*p2(0)-c36z(i3,i6).e(1)*p2(1)-c36z(i3 & ,i6).e(2)*p2(2)-c36z(i3,i6).e(3)*p2(3) cauxa=-c36z(i3,i6).ek0*quqd+p154k0*cvqd+p2k0*cvqu cauxb=-c36z(i3,i6).ek0*p2(2)+p2k0*c36z(i3,i6).e(2) r2_36z(i3,i6).a(1)=zer*(cauxa+ceps_0) r2_36z(i3,i6).a(2)=zel*(cauxa-ceps_0) r2_36z(i3,i6).b(1)=zel*(cauxb-ceps_2) r2_36z(i3,i6).b(2)=zer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 4 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres1(&,i3,i4,i5,i6),a1=l1_54z(i5,i4).a,c1=l1_54z(i5,i4).c,a2 * =r2_36z(i3,i6).a,b2=r2_36z(i3,i6).b,prq=p154q,den=(p154q*p154k0),nsum=0 cres1(1,i3,i4,i5,i6)=( l1_54z(i5,i4).a(1)*r2_36z(i3,i6). & a( & 1)+l1_54z(i5,i4).c(1)*p154q*r2_36z(i3,i6).b(2) ) & /(p154q*p & 154k0) cres1(2,i3,i4,i5,i6)=( l1_54z(i5,i4).c(2) & *p154q*r2_36z(i3, & i6).b(1)+l1_54z(i5,i4).a(2)*r2_36z(i3,i6).a(2) ) & /(p154q*p & 154k0) END DO END DO END DO END DO * quqd -- p=p1,q=p136 quqd=p1(0)*p136(0)-p1(1)*p136(1)-p1(2)*p136(2)-p1(3)*p136( & 3) DO i3=1,2 DO i6=1,2 * TL0 -- qu=p1,qd=p136,v=c36z(i3,i6).e,a=l1_36z(i3,i6).a,c=l1_36z(i3,i6).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c36z(i3,i6).ek0*(p1(2)*p136(3)-p136(2)*p1(3))+p1k0 & *(c36z(i3,i6).e(2)*p136(3)-p136(2)*c36z(i3,i6).e(3))-p136 & k0*(c36z(i3,i6).e(2)*p1(3)-p1(2)*c36z(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c36z(i3,i6).e(3)*p1k0+p1(3)*c36z(i3,i6).ek0 ceps_1=ceps_1*cim cvqu=c36z(i3,i6).e(0)*p1(0)-c36z(i3,i6).e(1)*p1(1)-c36z(i3 & ,i6).e(2)*p1(2)-c36z(i3,i6).e(3)*p1(3) cvqd=c36z(i3,i6).e(0)*p136(0)-c36z(i3,i6).e(1)*p136(1)-c36 & z(i3,i6).e(2)*p136(2)-c36z(i3,i6).e(3)*p136(3) cauxa=-c36z(i3,i6).ek0*quqd+p1k0*cvqd+p136k0*cvqu cauxc=+c36z(i3,i6).ek0*p1(2)-p1k0*c36z(i3,i6).e(2) l1_36z(i3,i6).a(1)=zer*(cauxa+ceps_0) l1_36z(i3,i6).a(2)=zel*(cauxa-ceps_0) l1_36z(i3,i6).c(1)=zer*(cauxc+ceps_1) l1_36z(i3,i6).c(2)=zel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p136,q=p2 quqd=p136(0)*p2(0)-p136(1)*p2(1)-p136(2)*p2(2)-p136(3)*p2( & 3) DO i5=1,2 DO i4=1,2 * TR0 -- qu=p136,qd=p2,v=c54z(i5,i4).e,a=r2_54z(i5,i4).a,b=r2_54z(i5,i4).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c54z(i5,i4).ek0*(p136(2)*p2(3)-p2(2)*p136(3))+p136 & k0*(c54z(i5,i4).e(2)*p2(3)-p2(2)*c54z(i5,i4).e(3))-p2k0*( & c54z(i5,i4).e(2)*p136(3)-p136(2)*c54z(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_2=-c54z(i5,i4).e(3)*p2k0+p2(3)*c54z(i5,i4).ek0 ceps_2=ceps_2*cim cvqu=c54z(i5,i4).e(0)*p136(0)-c54z(i5,i4).e(1)*p136(1)-c54 & z(i5,i4).e(2)*p136(2)-c54z(i5,i4).e(3)*p136(3) cvqd=c54z(i5,i4).e(0)*p2(0)-c54z(i5,i4).e(1)*p2(1)-c54z(i5 & ,i4).e(2)*p2(2)-c54z(i5,i4).e(3)*p2(3) cauxa=-c54z(i5,i4).ek0*quqd+p136k0*cvqd+p2k0*cvqu cauxb=-c54z(i5,i4).ek0*p2(2)+p2k0*c54z(i5,i4).e(2) r2_54z(i5,i4).a(1)=zer*(cauxa+ceps_0) r2_54z(i5,i4).a(2)=zel*(cauxa-ceps_0) r2_54z(i5,i4).b(1)=zel*(cauxb-ceps_2) r2_54z(i5,i4).b(2)=zer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 4+8 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres1(&,i3,i4,i5,i6),a1=l1_36z(i3,i6).a,c1=l1_36z(i3,i6).c,a2 * =r2_54z(i5,i4).a,b2=r2_54z(i5,i4).b,prq=p136q,den=(p136q*p136k0),nsum=1 cres1(1,i3,i4,i5,i6)=cres1(1,i3,i4,i5,i6)+( l1_36z(i3, & i6). & a(1)*r2_54z(i5,i4).a(1)+l1_36z(i3,i6).c(1) & *p136q*r2_54z(i & 5,i4).b(2) )/(p136q*p136k0) cres1(2,i3,i4,i5,i6)=cres1(2,i3,i4,i5,i6)+( l1_36z(i3, & i6). & c(2)*p136q*r2_54z(i5,i4).b(1)+l1_36z(i3,i6).a(2) & *r2_54z(i & 5,i4).a(2) )/(p136q*p136k0) END DO END DO END DO END DO * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i5=1,2 DO i6=1,2 * TL0 -- qu=p1,qd=p156,v=c56z(i5,i6).e,a=l1_56z(i5,i6).a,c=l1_56z(i5,i6).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c56z(i5,i6).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0 & *(c56z(i5,i6).e(2)*p156(3)-p156(2)*c56z(i5,i6).e(3))-p156 & k0*(c56z(i5,i6).e(2)*p1(3)-p1(2)*c56z(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i5,i6).e(3)*p1k0+p1(3)*c56z(i5,i6).ek0 ceps_1=ceps_1*cim cvqu=c56z(i5,i6).e(0)*p1(0)-c56z(i5,i6).e(1)*p1(1)-c56z(i5 & ,i6).e(2)*p1(2)-c56z(i5,i6).e(3)*p1(3) cvqd=c56z(i5,i6).e(0)*p156(0)-c56z(i5,i6).e(1)*p156(1)-c56 & z(i5,i6).e(2)*p156(2)-c56z(i5,i6).e(3)*p156(3) cauxa=-c56z(i5,i6).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56z(i5,i6).ek0*p1(2)-p1k0*c56z(i5,i6).e(2) l1_56z(i5,i6).a(1)=zer*(cauxa+ceps_0) l1_56z(i5,i6).a(2)=zel*(cauxa-ceps_0) l1_56z(i5,i6).c(1)=zer*(cauxc+ceps_1) l1_56z(i5,i6).c(2)=zel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i3=1,2 DO i4=1,2 * TR0 -- qu=p156,qd=p2,v=c34z(i3,i4).e,a=r2_34z(i3,i4).a,b=r2_34z(i3,i4).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i3,i4).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34z(i3,i4).e(2)*p2(3)-p2(2)*c34z(i3,i4).e(3))-p2k0*( & c34z(i3,i4).e(2)*p156(3)-p156(2)*c34z(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_2=-c34z(i3,i4).e(3)*p2k0+p2(3)*c34z(i3,i4).ek0 ceps_2=ceps_2*cim cvqu=c34z(i3,i4).e(0)*p156(0)-c34z(i3,i4).e(1)*p156(1)-c34 & z(i3,i4).e(2)*p156(2)-c34z(i3,i4).e(3)*p156(3) cvqd=c34z(i3,i4).e(0)*p2(0)-c34z(i3,i4).e(1)*p2(1)-c34z(i3 & ,i4).e(2)*p2(2)-c34z(i3,i4).e(3)*p2(3) cauxa=-c34z(i3,i4).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34z(i3,i4).ek0*p2(2)+p2k0*c34z(i3,i4).e(2) r2_34z(i3,i4).a(1)=zer*(cauxa+ceps_0) r2_34z(i3,i4).a(2)=zel*(cauxa-ceps_0) r2_34z(i3,i4).b(1)=zel*(cauxb-ceps_2) r2_34z(i3,i4).b(2)=zer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 12 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres2(&,i3,i4,i5,i6),a1=l1_56z(i5,i6).a,c1=l1_56z(i5,i6).c,a2 * =r2_34z(i3,i4).a,b2=r2_34z(i3,i4).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres2(1,i3,i4,i5,i6)=( l1_56z(i5,i6).a(1)*r2_34z(i3,i4). & a( & 1)+l1_56z(i5,i6).c(1)*p156q*r2_34z(i3,i4).b(2) ) & /(p156q*p & 156k0) cres2(2,i3,i4,i5,i6)=( l1_56z(i5,i6).c(2) & *p156q*r2_34z(i3, & i4).b(1)+l1_56z(i5,i6).a(2)*r2_34z(i3,i4).a(2) ) & /(p156q*p & 156k0) END DO END DO END DO END DO * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i3=1,2 DO i4=1,2 * TL0 -- qu=p1,qd=p134,v=c34z(i3,i4).e,a=l1_34z(i3,i4).a,c=l1_34z(i3,i4).c, * cr=zer,cl=zel,nsum=0 ceps_0=-c34z(i3,i4).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34z(i3,i4).e(2)*p134(3)-p134(2)*c34z(i3,i4).e(3))-p134 & k0*(c34z(i3,i4).e(2)*p1(3)-p1(2)*c34z(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i3,i4).e(3)*p1k0+p1(3)*c34z(i3,i4).ek0 ceps_1=ceps_1*cim cvqu=c34z(i3,i4).e(0)*p1(0)-c34z(i3,i4).e(1)*p1(1)-c34z(i3 & ,i4).e(2)*p1(2)-c34z(i3,i4).e(3)*p1(3) cvqd=c34z(i3,i4).e(0)*p134(0)-c34z(i3,i4).e(1)*p134(1)-c34 & z(i3,i4).e(2)*p134(2)-c34z(i3,i4).e(3)*p134(3) cauxa=-c34z(i3,i4).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34z(i3,i4).ek0*p1(2)-p1k0*c34z(i3,i4).e(2) l1_34z(i3,i4).a(1)=zer*(cauxa+ceps_0) l1_34z(i3,i4).a(2)=zel*(cauxa-ceps_0) l1_34z(i3,i4).c(1)=zer*(cauxc+ceps_1) l1_34z(i3,i4).c(2)=zel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i5=1,2 DO i6=1,2 * TR0 -- qu=p134,qd=p2,v=c56z(i5,i6).e,a=r2_56z(i5,i6).a,b=r2_56z(i5,i6).b, * cr=zer,cl=zel,nsum=0 ceps_0=-c56z(i5,i6).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134 & k0*(c56z(i5,i6).e(2)*p2(3)-p2(2)*c56z(i5,i6).e(3))-p2k0*( & c56z(i5,i6).e(2)*p134(3)-p134(2)*c56z(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_2=-c56z(i5,i6).e(3)*p2k0+p2(3)*c56z(i5,i6).ek0 ceps_2=ceps_2*cim cvqu=c56z(i5,i6).e(0)*p134(0)-c56z(i5,i6).e(1)*p134(1)-c56 & z(i5,i6).e(2)*p134(2)-c56z(i5,i6).e(3)*p134(3) cvqd=c56z(i5,i6).e(0)*p2(0)-c56z(i5,i6).e(1)*p2(1)-c56z(i5 & ,i6).e(2)*p2(2)-c56z(i5,i6).e(3)*p2(3) cauxa=-c56z(i5,i6).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56z(i5,i6).ek0*p2(2)+p2k0*c56z(i5,i6).e(2) r2_56z(i5,i6).a(1)=zer*(cauxa+ceps_0) r2_56z(i5,i6).a(2)=zel*(cauxa-ceps_0) r2_56z(i5,i6).b(1)=zel*(cauxb-ceps_2) r2_56z(i5,i6).b(2)=zer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 12+16 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres2(&,i3,i4,i5,i6),a1=l1_34z(i3,i4).a,c1=l1_34z(i3,i4).c,a2 * =r2_56z(i5,i6).a,b2=r2_56z(i5,i6).b,prq=p134q,den=(p134q*p134k0),nsum=1 cres2(1,i3,i4,i5,i6)=cres2(1,i3,i4,i5,i6)+( l1_34z(i3, & i4). & a(1)*r2_56z(i5,i6).a(1)+l1_34z(i3,i4).c(1) & *p134q*r2_56z(i & 5,i6).b(2) )/(p134q*p134k0) cres2(2,i3,i4,i5,i6)=cres2(2,i3,i4,i5,i6)+( l1_34z(i3, & i4). & c(2)*p134q*r2_56z(i5,i6).b(1)+l1_34z(i3,i4).a(2) & *r2_56z(i & 5,i6).a(2) )/(p134q*p134k0) END DO END DO END DO END DO * quqd -- p=p1,q=p154 quqd=p1(0)*p154(0)-p1(1)*p154(1)-p1(2)*p154(2)-p1(3)*p154( & 3) DO i5=1,2 DO i4=1,2 * TL0 -- qu=p1,qd=p154,v=c54f(i5,i4).e,a=l1_54f(i5,i4).a,c=l1_54f(i5,i4).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c54f(i5,i4).ek0*(p1(2)*p154(3)-p154(2)*p1(3))+p1k0 & *(c54f(i5,i4).e(2)*p154(3)-p154(2)*c54f(i5,i4).e(3))-p154 & k0*(c54f(i5,i4).e(2)*p1(3)-p1(2)*c54f(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c54f(i5,i4).e(3)*p1k0+p1(3)*c54f(i5,i4).ek0 ceps_1=ceps_1*cim cvqu=c54f(i5,i4).e(0)*p1(0)-c54f(i5,i4).e(1)*p1(1)-c54f(i5 & ,i4).e(2)*p1(2)-c54f(i5,i4).e(3)*p1(3) cvqd=c54f(i5,i4).e(0)*p154(0)-c54f(i5,i4).e(1)*p154(1)-c54 & f(i5,i4).e(2)*p154(2)-c54f(i5,i4).e(3)*p154(3) cauxa=-c54f(i5,i4).ek0*quqd+p1k0*cvqd+p154k0*cvqu cauxc=+c54f(i5,i4).ek0*p1(2)-p1k0*c54f(i5,i4).e(2) l1_54f(i5,i4).a(1)=fer*(cauxa+ceps_0) l1_54f(i5,i4).a(2)=fel*(cauxa-ceps_0) l1_54f(i5,i4).c(1)=fer*(cauxc+ceps_1) l1_54f(i5,i4).c(2)=fel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p154,q=p2 quqd=p154(0)*p2(0)-p154(1)*p2(1)-p154(2)*p2(2)-p154(3)*p2( & 3) DO i3=1,2 DO i6=1,2 * TR0 -- qu=p154,qd=p2,v=c36f(i3,i6).e,a=r2_36f(i3,i6).a,b=r2_36f(i3,i6).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c36f(i3,i6).ek0*(p154(2)*p2(3)-p2(2)*p154(3))+p154 & k0*(c36f(i3,i6).e(2)*p2(3)-p2(2)*c36f(i3,i6).e(3))-p2k0*( & c36f(i3,i6).e(2)*p154(3)-p154(2)*c36f(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_2=-c36f(i3,i6).e(3)*p2k0+p2(3)*c36f(i3,i6).ek0 ceps_2=ceps_2*cim cvqu=c36f(i3,i6).e(0)*p154(0)-c36f(i3,i6).e(1)*p154(1)-c36 & f(i3,i6).e(2)*p154(2)-c36f(i3,i6).e(3)*p154(3) cvqd=c36f(i3,i6).e(0)*p2(0)-c36f(i3,i6).e(1)*p2(1)-c36f(i3 & ,i6).e(2)*p2(2)-c36f(i3,i6).e(3)*p2(3) cauxa=-c36f(i3,i6).ek0*quqd+p154k0*cvqd+p2k0*cvqu cauxb=-c36f(i3,i6).ek0*p2(2)+p2k0*c36f(i3,i6).e(2) r2_36f(i3,i6).a(1)=fer*(cauxa+ceps_0) r2_36f(i3,i6).a(2)=fel*(cauxa-ceps_0) r2_36f(i3,i6).b(1)=fel*(cauxb-ceps_2) r2_36f(i3,i6).b(2)=fer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 1 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres3(&,i3,i4,i5,i6),a1=l1_54f(i5,i4).a,c1=l1_54f(i5,i4).c,a2 * =r2_36f(i3,i6).a,b2=r2_36f(i3,i6).b,prq=p154q,den=(p154q*p154k0),nsum=0 cres3(1,i3,i4,i5,i6)=( l1_54f(i5,i4).a(1)*r2_36f(i3,i6). & a( & 1)+l1_54f(i5,i4).c(1)*p154q*r2_36f(i3,i6).b(2) ) & /(p154q*p & 154k0) cres3(2,i3,i4,i5,i6)=( l1_54f(i5,i4).c(2) & *p154q*r2_36f(i3, & i6).b(1)+l1_54f(i5,i4).a(2)*r2_36f(i3,i6).a(2) ) & /(p154q*p & 154k0) END DO END DO END DO END DO * quqd -- p=p1,q=p136 quqd=p1(0)*p136(0)-p1(1)*p136(1)-p1(2)*p136(2)-p1(3)*p136( & 3) DO i3=1,2 DO i6=1,2 * TL0 -- qu=p1,qd=p136,v=c36f(i3,i6).e,a=l1_36f(i3,i6).a,c=l1_36f(i3,i6).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c36f(i3,i6).ek0*(p1(2)*p136(3)-p136(2)*p1(3))+p1k0 & *(c36f(i3,i6).e(2)*p136(3)-p136(2)*c36f(i3,i6).e(3))-p136 & k0*(c36f(i3,i6).e(2)*p1(3)-p1(2)*c36f(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c36f(i3,i6).e(3)*p1k0+p1(3)*c36f(i3,i6).ek0 ceps_1=ceps_1*cim cvqu=c36f(i3,i6).e(0)*p1(0)-c36f(i3,i6).e(1)*p1(1)-c36f(i3 & ,i6).e(2)*p1(2)-c36f(i3,i6).e(3)*p1(3) cvqd=c36f(i3,i6).e(0)*p136(0)-c36f(i3,i6).e(1)*p136(1)-c36 & f(i3,i6).e(2)*p136(2)-c36f(i3,i6).e(3)*p136(3) cauxa=-c36f(i3,i6).ek0*quqd+p1k0*cvqd+p136k0*cvqu cauxc=+c36f(i3,i6).ek0*p1(2)-p1k0*c36f(i3,i6).e(2) l1_36f(i3,i6).a(1)=fer*(cauxa+ceps_0) l1_36f(i3,i6).a(2)=fel*(cauxa-ceps_0) l1_36f(i3,i6).c(1)=fer*(cauxc+ceps_1) l1_36f(i3,i6).c(2)=fel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p136,q=p2 quqd=p136(0)*p2(0)-p136(1)*p2(1)-p136(2)*p2(2)-p136(3)*p2( & 3) DO i5=1,2 DO i4=1,2 * TR0 -- qu=p136,qd=p2,v=c54f(i5,i4).e,a=r2_54f(i5,i4).a,b=r2_54f(i5,i4).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c54f(i5,i4).ek0*(p136(2)*p2(3)-p2(2)*p136(3))+p136 & k0*(c54f(i5,i4).e(2)*p2(3)-p2(2)*c54f(i5,i4).e(3))-p2k0*( & c54f(i5,i4).e(2)*p136(3)-p136(2)*c54f(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_2=-c54f(i5,i4).e(3)*p2k0+p2(3)*c54f(i5,i4).ek0 ceps_2=ceps_2*cim cvqu=c54f(i5,i4).e(0)*p136(0)-c54f(i5,i4).e(1)*p136(1)-c54 & f(i5,i4).e(2)*p136(2)-c54f(i5,i4).e(3)*p136(3) cvqd=c54f(i5,i4).e(0)*p2(0)-c54f(i5,i4).e(1)*p2(1)-c54f(i5 & ,i4).e(2)*p2(2)-c54f(i5,i4).e(3)*p2(3) cauxa=-c54f(i5,i4).ek0*quqd+p136k0*cvqd+p2k0*cvqu cauxb=-c54f(i5,i4).ek0*p2(2)+p2k0*c54f(i5,i4).e(2) r2_54f(i5,i4).a(1)=fer*(cauxa+ceps_0) r2_54f(i5,i4).a(2)=fel*(cauxa-ceps_0) r2_54f(i5,i4).b(1)=fel*(cauxb-ceps_2) r2_54f(i5,i4).b(2)=fer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 1+5 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres3(&,i3,i4,i5,i6),a1=l1_36f(i3,i6).a,c1=l1_36f(i3,i6).c,a2 * =r2_54f(i5,i4).a,b2=r2_54f(i5,i4).b,prq=p136q,den=(p136q*p136k0),nsum=1 cres3(1,i3,i4,i5,i6)=cres3(1,i3,i4,i5,i6)+( l1_36f(i3, & i6). & a(1)*r2_54f(i5,i4).a(1)+l1_36f(i3,i6).c(1) & *p136q*r2_54f(i & 5,i4).b(2) )/(p136q*p136k0) cres3(2,i3,i4,i5,i6)=cres3(2,i3,i4,i5,i6)+( l1_36f(i3, & i6). & c(2)*p136q*r2_54f(i5,i4).b(1)+l1_36f(i3,i6).a(2) & *r2_54f(i & 5,i4).a(2) )/(p136q*p136k0) END DO END DO END DO END DO * quqd -- p=p1,q=p156 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i5=1,2 DO i6=1,2 * TL0 -- qu=p1,qd=p156,v=c56f(i5,i6).e,a=l1_56f(i5,i6).a,c=l1_56f(i5,i6).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c56f(i5,i6).ek0*(p1(2)*p156(3)-p156(2)*p1(3))+p1k0 & *(c56f(i5,i6).e(2)*p156(3)-p156(2)*c56f(i5,i6).e(3))-p156 & k0*(c56f(i5,i6).e(2)*p1(3)-p1(2)*c56f(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i5,i6).e(3)*p1k0+p1(3)*c56f(i5,i6).ek0 ceps_1=ceps_1*cim cvqu=c56f(i5,i6).e(0)*p1(0)-c56f(i5,i6).e(1)*p1(1)-c56f(i5 & ,i6).e(2)*p1(2)-c56f(i5,i6).e(3)*p1(3) cvqd=c56f(i5,i6).e(0)*p156(0)-c56f(i5,i6).e(1)*p156(1)-c56 & f(i5,i6).e(2)*p156(2)-c56f(i5,i6).e(3)*p156(3) cauxa=-c56f(i5,i6).ek0*quqd+p1k0*cvqd+p156k0*cvqu cauxc=+c56f(i5,i6).ek0*p1(2)-p1k0*c56f(i5,i6).e(2) l1_56f(i5,i6).a(1)=fer*(cauxa+ceps_0) l1_56f(i5,i6).a(2)=fel*(cauxa-ceps_0) l1_56f(i5,i6).c(1)=fer*(cauxc+ceps_1) l1_56f(i5,i6).c(2)=fel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p156,q=p2 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i3=1,2 DO i4=1,2 * TR0 -- qu=p156,qd=p2,v=c34f(i3,i4).e,a=r2_34f(i3,i4).a,b=r2_34f(i3,i4).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i3,i4).ek0*(p156(2)*p2(3)-p2(2)*p156(3))+p156 & k0*(c34f(i3,i4).e(2)*p2(3)-p2(2)*c34f(i3,i4).e(3))-p2k0*( & c34f(i3,i4).e(2)*p156(3)-p156(2)*c34f(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_2=-c34f(i3,i4).e(3)*p2k0+p2(3)*c34f(i3,i4).ek0 ceps_2=ceps_2*cim cvqu=c34f(i3,i4).e(0)*p156(0)-c34f(i3,i4).e(1)*p156(1)-c34 & f(i3,i4).e(2)*p156(2)-c34f(i3,i4).e(3)*p156(3) cvqd=c34f(i3,i4).e(0)*p2(0)-c34f(i3,i4).e(1)*p2(1)-c34f(i3 & ,i4).e(2)*p2(2)-c34f(i3,i4).e(3)*p2(3) cauxa=-c34f(i3,i4).ek0*quqd+p156k0*cvqd+p2k0*cvqu cauxb=-c34f(i3,i4).ek0*p2(2)+p2k0*c34f(i3,i4).e(2) r2_34f(i3,i4).a(1)=fer*(cauxa+ceps_0) r2_34f(i3,i4).a(2)=fel*(cauxa-ceps_0) r2_34f(i3,i4).b(1)=fel*(cauxb-ceps_2) r2_34f(i3,i4).b(2)=fer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 9 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres4(&,i3,i4,i5,i6),a1=l1_56f(i5,i6).a,c1=l1_56f(i5,i6).c,a2 * =r2_34f(i3,i4).a,b2=r2_34f(i3,i4).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres4(1,i3,i4,i5,i6)=( l1_56f(i5,i6).a(1)*r2_34f(i3,i4). & a( & 1)+l1_56f(i5,i6).c(1)*p156q*r2_34f(i3,i4).b(2) ) & /(p156q*p & 156k0) cres4(2,i3,i4,i5,i6)=( l1_56f(i5,i6).c(2) & *p156q*r2_34f(i3, & i4).b(1)+l1_56f(i5,i6).a(2)*r2_34f(i3,i4).a(2) ) & /(p156q*p & 156k0) END DO END DO END DO END DO * quqd -- p=p1,q=p134 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i3=1,2 DO i4=1,2 * TL0 -- qu=p1,qd=p134,v=c34f(i3,i4).e,a=l1_34f(i3,i4).a,c=l1_34f(i3,i4).c, * cr=fer,cl=fel,nsum=0 ceps_0=-c34f(i3,i4).ek0*(p1(2)*p134(3)-p134(2)*p1(3))+p1k0 & *(c34f(i3,i4).e(2)*p134(3)-p134(2)*c34f(i3,i4).e(3))-p134 & k0*(c34f(i3,i4).e(2)*p1(3)-p1(2)*c34f(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i3,i4).e(3)*p1k0+p1(3)*c34f(i3,i4).ek0 ceps_1=ceps_1*cim cvqu=c34f(i3,i4).e(0)*p1(0)-c34f(i3,i4).e(1)*p1(1)-c34f(i3 & ,i4).e(2)*p1(2)-c34f(i3,i4).e(3)*p1(3) cvqd=c34f(i3,i4).e(0)*p134(0)-c34f(i3,i4).e(1)*p134(1)-c34 & f(i3,i4).e(2)*p134(2)-c34f(i3,i4).e(3)*p134(3) cauxa=-c34f(i3,i4).ek0*quqd+p1k0*cvqd+p134k0*cvqu cauxc=+c34f(i3,i4).ek0*p1(2)-p1k0*c34f(i3,i4).e(2) l1_34f(i3,i4).a(1)=fer*(cauxa+ceps_0) l1_34f(i3,i4).a(2)=fel*(cauxa-ceps_0) l1_34f(i3,i4).c(1)=fer*(cauxc+ceps_1) l1_34f(i3,i4).c(2)=fel*(-cauxc+ceps_1) END DO END DO * quqd -- p=p134,q=p2 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i5=1,2 DO i6=1,2 * TR0 -- qu=p134,qd=p2,v=c56f(i5,i6).e,a=r2_56f(i5,i6).a,b=r2_56f(i5,i6).b, * cr=fer,cl=fel,nsum=0 ceps_0=-c56f(i5,i6).ek0*(p134(2)*p2(3)-p2(2)*p134(3))+p134 & k0*(c56f(i5,i6).e(2)*p2(3)-p2(2)*c56f(i5,i6).e(3))-p2k0*( & c56f(i5,i6).e(2)*p134(3)-p134(2)*c56f(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_2=-c56f(i5,i6).e(3)*p2k0+p2(3)*c56f(i5,i6).ek0 ceps_2=ceps_2*cim cvqu=c56f(i5,i6).e(0)*p134(0)-c56f(i5,i6).e(1)*p134(1)-c56 & f(i5,i6).e(2)*p134(2)-c56f(i5,i6).e(3)*p134(3) cvqd=c56f(i5,i6).e(0)*p2(0)-c56f(i5,i6).e(1)*p2(1)-c56f(i5 & ,i6).e(2)*p2(2)-c56f(i5,i6).e(3)*p2(3) cauxa=-c56f(i5,i6).ek0*quqd+p134k0*cvqd+p2k0*cvqu cauxb=-c56f(i5,i6).ek0*p2(2)+p2k0*c56f(i5,i6).e(2) r2_56f(i5,i6).a(1)=fer*(cauxa+ceps_0) r2_56f(i5,i6).a(2)=fel*(cauxa-ceps_0) r2_56f(i5,i6).b(1)=fel*(cauxb-ceps_2) r2_56f(i5,i6).b(2)=fer*(-cauxb-ceps_2) END DO END DO * Diagramma ( 9+13 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres4(&,i3,i4,i5,i6),a1=l1_34f(i3,i4).a,c1=l1_34f(i3,i4).c,a2 * =r2_56f(i5,i6).a,b2=r2_56f(i5,i6).b,prq=p134q,den=(p134q*p134k0),nsum=1 cres4(1,i3,i4,i5,i6)=cres4(1,i3,i4,i5,i6)+( l1_34f(i3, & i4). & a(1)*r2_56f(i5,i6).a(1)+l1_34f(i3,i4).c(1) & *p134q*r2_56f(i & 5,i6).b(2) )/(p134q*p134k0) cres4(2,i3,i4,i5,i6)=cres4(2,i3,i4,i5,i6)+( l1_34f(i3, & i4). & c(2)*p134q*r2_56f(i5,i6).b(1)+l1_34f(i3,i4).a(2) & *r2_56f(i & 5,i6).a(2) )/(p134q*p134k0) END DO END DO END DO END DO * Diagramma ( 2 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres5(&,i3,i4,i5,i6),a1=l1_54f(i5,i4).a,c1=l1_54f(i5,i4).c,a2 * =r2_36z(i3,i6).a,b2=r2_36z(i3,i6).b,prq=p154q,den=(p154q*p154k0),nsum=0 cres5(1,i3,i4,i5,i6)=( l1_54f(i5,i4).a(1)*r2_36z(i3,i6). & a( & 1)+l1_54f(i5,i4).c(1)*p154q*r2_36z(i3,i6).b(2) ) & /(p154q*p & 154k0) cres5(2,i3,i4,i5,i6)=( l1_54f(i5,i4).c(2) & *p154q*r2_36z(i3, & i6).b(1)+l1_54f(i5,i4).a(2)*r2_36z(i3,i6).a(2) ) & /(p154q*p & 154k0) END DO END DO END DO END DO * Diagramma ( 2+6 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres5(&,i3,i4,i5,i6),a1=l1_36z(i3,i6).a,c1=l1_36z(i3,i6).c,a2 * =r2_54f(i5,i4).a,b2=r2_54f(i5,i4).b,prq=p136q,den=(p136q*p136k0),nsum=1 cres5(1,i3,i4,i5,i6)=cres5(1,i3,i4,i5,i6)+( l1_36z(i3, & i6). & a(1)*r2_54f(i5,i4).a(1)+l1_36z(i3,i6).c(1) & *p136q*r2_54f(i & 5,i4).b(2) )/(p136q*p136k0) cres5(2,i3,i4,i5,i6)=cres5(2,i3,i4,i5,i6)+( l1_36z(i3, & i6). & c(2)*p136q*r2_54f(i5,i4).b(1)+l1_36z(i3,i6).a(2) & *r2_54f(i & 5,i4).a(2) )/(p136q*p136k0) END DO END DO END DO END DO * Diagramma ( 3 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres6(&,i3,i4,i5,i6),a1=l1_36f(i3,i6).a,c1=l1_36f(i3,i6).c,a2 * =r2_54z(i5,i4).a,b2=r2_54z(i5,i4).b,prq=p136q,den=(p136q*p136k0),nsum=0 cres6(1,i3,i4,i5,i6)=( l1_36f(i3,i6).a(1)*r2_54z(i5,i4). & a( & 1)+l1_36f(i3,i6).c(1)*p136q*r2_54z(i5,i4).b(2) ) & /(p136q*p & 136k0) cres6(2,i3,i4,i5,i6)=( l1_36f(i3,i6).c(2) & *p136q*r2_54z(i5, & i4).b(1)+l1_36f(i3,i6).a(2)*r2_54z(i5,i4).a(2) ) & /(p136q*p & 136k0) END DO END DO END DO END DO * Diagramma ( 3+7 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres6(&,i3,i4,i5,i6),a1=l1_54z(i5,i4).a,c1=l1_54z(i5,i4).c,a2 * =r2_36f(i3,i6).a,b2=r2_36f(i3,i6).b,prq=p154q,den=(p154q*p154k0),nsum=1 cres6(1,i3,i4,i5,i6)=cres6(1,i3,i4,i5,i6)+( l1_54z(i5, & i4). & a(1)*r2_36f(i3,i6).a(1)+l1_54z(i5,i4).c(1) & *p154q*r2_36f(i & 3,i6).b(2) )/(p154q*p154k0) cres6(2,i3,i4,i5,i6)=cres6(2,i3,i4,i5,i6)+( l1_54z(i5, & i4). & c(2)*p154q*r2_36f(i3,i6).b(1)+l1_54z(i5,i4).a(2) & *r2_36f(i & 3,i6).a(2) )/(p154q*p154k0) END DO END DO END DO END DO * Diagramma ( 10 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres7(&,i3,i4,i5,i6),a1=l1_34f(i3,i4).a,c1=l1_34f(i3,i4).c,a2 * =r2_56z(i5,i6).a,b2=r2_56z(i5,i6).b,prq=p134q,den=(p134q*p134k0),nsum=0 cres7(1,i3,i4,i5,i6)=( l1_34f(i3,i4).a(1)*r2_56z(i5,i6). & a( & 1)+l1_34f(i3,i4).c(1)*p134q*r2_56z(i5,i6).b(2) ) & /(p134q*p & 134k0) cres7(2,i3,i4,i5,i6)=( l1_34f(i3,i4).c(2) & *p134q*r2_56z(i5, & i6).b(1)+l1_34f(i3,i4).a(2)*r2_56z(i5,i6).a(2) ) & /(p134q*p & 134k0) END DO END DO END DO END DO * Diagramma ( 10+14 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres7(&,i3,i4,i5,i6),a1=l1_56z(i5,i6).a,c1=l1_56z(i5,i6).c,a2 * =r2_34f(i3,i4).a,b2=r2_34f(i3,i4).b,prq=p156q,den=(p156q*p156k0),nsum=1 cres7(1,i3,i4,i5,i6)=cres7(1,i3,i4,i5,i6)+( l1_56z(i5, & i6). & a(1)*r2_34f(i3,i4).a(1)+l1_56z(i5,i6).c(1) & *p156q*r2_34f(i & 3,i4).b(2) )/(p156q*p156k0) cres7(2,i3,i4,i5,i6)=cres7(2,i3,i4,i5,i6)+( l1_56z(i5, & i6). & c(2)*p156q*r2_34f(i3,i4).b(1)+l1_56z(i5,i6).a(2) & *r2_34f(i & 3,i4).a(2) )/(p156q*p156k0) END DO END DO END DO END DO * Diagramma ( 11 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres8(&,i3,i4,i5,i6),a1=l1_56f(i5,i6).a,c1=l1_56f(i5,i6).c,a2 * =r2_34z(i3,i4).a,b2=r2_34z(i3,i4).b,prq=p156q,den=(p156q*p156k0),nsum=0 cres8(1,i3,i4,i5,i6)=( l1_56f(i5,i6).a(1)*r2_34z(i3,i4). & a( & 1)+l1_56f(i5,i6).c(1)*p156q*r2_34z(i3,i4).b(2) ) & /(p156q*p & 156k0) cres8(2,i3,i4,i5,i6)=( l1_56f(i5,i6).c(2) & *p156q*r2_34z(i3, & i4).b(1)+l1_56f(i5,i6).a(2)*r2_34z(i3,i4).a(2) ) & /(p156q*p & 156k0) END DO END DO END DO END DO * Diagramma ( 11+15 ) DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 * TLTR0 -- aa=cres8(&,i3,i4,i5,i6),a1=l1_34z(i3,i4).a,c1=l1_34z(i3,i4).c,a2 * =r2_56f(i5,i6).a,b2=r2_56f(i5,i6).b,prq=p134q,den=(p134q*p134k0),nsum=1 cres8(1,i3,i4,i5,i6)=cres8(1,i3,i4,i5,i6)+( l1_34z(i3, & i4). & a(1)*r2_56f(i5,i6).a(1)+l1_34z(i3,i4).c(1) & *p134q*r2_56f(i & 5,i6).b(2) )/(p134q*p134k0) cres8(2,i3,i4,i5,i6)=cres8(2,i3,i4,i5,i6)+( l1_34z(i3, & i4). & c(2)*p134q*r2_56f(i5,i6).b(1)+l1_34z(i3,i4).a(2) & *r2_56f(i & 5,i6).a(2) )/(p134q*p134k0) END DO END DO END DO END DO * quqd -- p=p5,q=p536 quqd=p5(0)*p536(0)-p5(1)*p536(1)-p5(2)*p536(2)-p5(3)*p536( & 3) DO i3=1,2 DO i6=1,2 * T -- qu=p5,qd=p536,v=c36z(i3,i6).e,a=l5_36(i3,i6).a,b=l5_36(i3,i6).b,c=l5 * _36(i3,i6).c,d=l5_36(i3,i6).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c36z(i3,i6).ek0*(p5(2)*p536(3)-p536(2)*p5(3))+p5k0 & *(c36z(i3,i6).e(2)*p536(3)-p536(2)*c36z(i3,i6).e(3))-p536 & k0*(c36z(i3,i6).e(2)*p5(3)-p5(2)*c36z(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c36z(i3,i6).e(3)*p5k0+p5(3)*c36z(i3,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c36z(i3,i6).e(3)*p536k0+p536(3)*c36z(i3,i6).ek0 ceps_2=ceps_2*cim cvqu=c36z(i3,i6).e(0)*p5(0)-c36z(i3,i6).e(1)*p5(1)-c36z(i3 & ,i6).e(2)*p5(2)-c36z(i3,i6).e(3)*p5(3) cvqd=c36z(i3,i6).e(0)*p536(0)-c36z(i3,i6).e(1)*p536(1)-c36 & z(i3,i6).e(2)*p536(2)-c36z(i3,i6).e(3)*p536(3) cauxa=-c36z(i3,i6).ek0*quqd+p5k0*cvqd+p536k0*cvqu cauxb=-c36z(i3,i6).ek0*p536(2)+p536k0*c36z(i3,i6).e(2) cauxc=+c36z(i3,i6).ek0*p5(2)-p5k0*c36z(i3,i6).e(2) l5_36(i3,i6).a(1,1)=zqdr*(cauxa+ceps_0) l5_36(i3,i6).a(2,2)=zqdl*(cauxa-ceps_0) l5_36(i3,i6).b(1,2)=zqdl*(cauxb-ceps_2) l5_36(i3,i6).b(2,1)=zqdr*(-cauxb-ceps_2) l5_36(i3,i6).c(1,2)=zqdr*(cauxc+ceps_1) l5_36(i3,i6).c(2,1)=zqdl*(-cauxc+ceps_1) l5_36(i3,i6).d(1,1)=zqdl*c36z(i3,i6).ek0 l5_36(i3,i6).d(2,2)=zqdr*c36z(i3,i6).ek0 END DO END DO * quqd -- p=p5,q=p534 quqd=p5(0)*p534(0)-p5(1)*p534(1)-p5(2)*p534(2)-p5(3)*p534( & 3) DO i3=1,2 DO i4=1,2 * T -- qu=p5,qd=p534,v=c34z(i3,i4).e,a=l5_34(i3,i4).a,b=l5_34(i3,i4).b,c=l5 * _34(i3,i4).c,d=l5_34(i3,i4).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c34z(i3,i4).ek0*(p5(2)*p534(3)-p534(2)*p5(3))+p5k0 & *(c34z(i3,i4).e(2)*p534(3)-p534(2)*c34z(i3,i4).e(3))-p534 & k0*(c34z(i3,i4).e(2)*p5(3)-p5(2)*c34z(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i3,i4).e(3)*p5k0+p5(3)*c34z(i3,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c34z(i3,i4).e(3)*p534k0+p534(3)*c34z(i3,i4).ek0 ceps_2=ceps_2*cim cvqu=c34z(i3,i4).e(0)*p5(0)-c34z(i3,i4).e(1)*p5(1)-c34z(i3 & ,i4).e(2)*p5(2)-c34z(i3,i4).e(3)*p5(3) cvqd=c34z(i3,i4).e(0)*p534(0)-c34z(i3,i4).e(1)*p534(1)-c34 & z(i3,i4).e(2)*p534(2)-c34z(i3,i4).e(3)*p534(3) cauxa=-c34z(i3,i4).ek0*quqd+p5k0*cvqd+p534k0*cvqu cauxb=-c34z(i3,i4).ek0*p534(2)+p534k0*c34z(i3,i4).e(2) cauxc=+c34z(i3,i4).ek0*p5(2)-p5k0*c34z(i3,i4).e(2) l5_34(i3,i4).a(1,1)=zqdr*(cauxa+ceps_0) l5_34(i3,i4).a(2,2)=zqdl*(cauxa-ceps_0) l5_34(i3,i4).b(1,2)=zqdl*(cauxb-ceps_2) l5_34(i3,i4).b(2,1)=zqdr*(-cauxb-ceps_2) l5_34(i3,i4).c(1,2)=zqdr*(cauxc+ceps_1) l5_34(i3,i4).c(2,1)=zqdl*(-cauxc+ceps_1) l5_34(i3,i4).d(1,1)=zqdl*c34z(i3,i4).ek0 l5_34(i3,i4).d(2,2)=zqdr*c34z(i3,i4).ek0 END DO END DO * quqd -- p=p3,q=p534 quqd=p3(0)*p534(0)-p3(1)*p534(1)-p3(2)*p534(2)-p3(3)*p534( & 3) DO i5=1,2 DO i4=1,2 * T -- qu=p3,qd=p534,v=c54z(i5,i4).e,a=l3_54(i5,i4).a,b=l3_54(i5,i4).b,c=l3 * _54(i5,i4).c,d=l3_54(i5,i4).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c54z(i5,i4).ek0*(p3(2)*p534(3)-p534(2)*p3(3))+p3k0 & *(c54z(i5,i4).e(2)*p534(3)-p534(2)*c54z(i5,i4).e(3))-p534 & k0*(c54z(i5,i4).e(2)*p3(3)-p3(2)*c54z(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c54z(i5,i4).e(3)*p3k0+p3(3)*c54z(i5,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c54z(i5,i4).e(3)*p534k0+p534(3)*c54z(i5,i4).ek0 ceps_2=ceps_2*cim cvqu=c54z(i5,i4).e(0)*p3(0)-c54z(i5,i4).e(1)*p3(1)-c54z(i5 & ,i4).e(2)*p3(2)-c54z(i5,i4).e(3)*p3(3) cvqd=c54z(i5,i4).e(0)*p534(0)-c54z(i5,i4).e(1)*p534(1)-c54 & z(i5,i4).e(2)*p534(2)-c54z(i5,i4).e(3)*p534(3) cauxa=-c54z(i5,i4).ek0*quqd+p3k0*cvqd+p534k0*cvqu cauxb=-c54z(i5,i4).ek0*p534(2)+p534k0*c54z(i5,i4).e(2) cauxc=+c54z(i5,i4).ek0*p3(2)-p3k0*c54z(i5,i4).e(2) l3_54(i5,i4).a(1,1)=zqdr*(cauxa+ceps_0) l3_54(i5,i4).a(2,2)=zqdl*(cauxa-ceps_0) l3_54(i5,i4).b(1,2)=zqdl*(cauxb-ceps_2) l3_54(i5,i4).b(2,1)=zqdr*(-cauxb-ceps_2) l3_54(i5,i4).c(1,2)=zqdr*(cauxc+ceps_1) l3_54(i5,i4).c(2,1)=zqdl*(-cauxc+ceps_1) l3_54(i5,i4).d(1,1)=zqdl*c54z(i5,i4).ek0 l3_54(i5,i4).d(2,2)=zqdr*c54z(i5,i4).ek0 END DO END DO * quqd -- p=p3,q=p536 quqd=p3(0)*p536(0)-p3(1)*p536(1)-p3(2)*p536(2)-p3(3)*p536( & 3) DO i5=1,2 DO i6=1,2 * T -- qu=p3,qd=p536,v=c56z(i5,i6).e,a=l3_56(i5,i6).a,b=l3_56(i5,i6).b,c=l3 * _56(i5,i6).c,d=l3_56(i5,i6).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c56z(i5,i6).ek0*(p3(2)*p536(3)-p536(2)*p3(3))+p3k0 & *(c56z(i5,i6).e(2)*p536(3)-p536(2)*c56z(i5,i6).e(3))-p536 & k0*(c56z(i5,i6).e(2)*p3(3)-p3(2)*c56z(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i5,i6).e(3)*p3k0+p3(3)*c56z(i5,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c56z(i5,i6).e(3)*p536k0+p536(3)*c56z(i5,i6).ek0 ceps_2=ceps_2*cim cvqu=c56z(i5,i6).e(0)*p3(0)-c56z(i5,i6).e(1)*p3(1)-c56z(i5 & ,i6).e(2)*p3(2)-c56z(i5,i6).e(3)*p3(3) cvqd=c56z(i5,i6).e(0)*p536(0)-c56z(i5,i6).e(1)*p536(1)-c56 & z(i5,i6).e(2)*p536(2)-c56z(i5,i6).e(3)*p536(3) cauxa=-c56z(i5,i6).ek0*quqd+p3k0*cvqd+p536k0*cvqu cauxb=-c56z(i5,i6).ek0*p536(2)+p536k0*c56z(i5,i6).e(2) cauxc=+c56z(i5,i6).ek0*p3(2)-p3k0*c56z(i5,i6).e(2) l3_56(i5,i6).a(1,1)=zqdr*(cauxa+ceps_0) l3_56(i5,i6).a(2,2)=zqdl*(cauxa-ceps_0) l3_56(i5,i6).b(1,2)=zqdl*(cauxb-ceps_2) l3_56(i5,i6).b(2,1)=zqdr*(-cauxb-ceps_2) l3_56(i5,i6).c(1,2)=zqdr*(cauxc+ceps_1) l3_56(i5,i6).c(2,1)=zqdl*(-cauxc+ceps_1) l3_56(i5,i6).d(1,1)=zqdl*c56z(i5,i6).ek0 l3_56(i5,i6).d(2,2)=zqdr*c56z(i5,i6).ek0 END DO END DO ENDIF * quqd -- p=p536,q=p4 quqd=p536(0)*p4(0)-p536(1)*p4(1)-p536(2)*p4(2)-p536(3)*p4( & 3) DO i1=1,2 * T -- qu=p536,qd=p4,v=c12f(i1).e,a=r4_12f(i1).a,b=r4_12f(i1).b,c=r4_12f(i1 * ).c,d=r4_12f(i1).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i1).ek0*(p536(2)*p4(3)-p4(2)*p536(3))+p536k0* & (c12f(i1).e(2)*p4(3)-p4(2)*c12f(i1).e(3))-p4k0*(c12f(i1). & e(2)*p536(3)-p536(2)*c12f(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i1).e(3)*p536k0+p536(3)*c12f(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i1).e(3)*p4k0+p4(3)*c12f(i1).ek0 ceps_2=ceps_2*cim cvqu=c12f(i1).e(0)*p536(0)-c12f(i1).e(1)*p536(1)-c12f(i1). & e(2)*p536(2)-c12f(i1).e(3)*p536(3) cvqd=c12f(i1).e(0)*p4(0)-c12f(i1).e(1)*p4(1)-c12f(i1).e(2) & *p4(2)-c12f(i1).e(3)*p4(3) cauxa=-c12f(i1).ek0*quqd+p536k0*cvqd+p4k0*cvqu cauxb=-c12f(i1).ek0*p4(2)+p4k0*c12f(i1).e(2) cauxc=+c12f(i1).ek0*p536(2)-p536k0*c12f(i1).e(2) r4_12f(i1).a(1,1)=fqdr*(cauxa+ceps_0) r4_12f(i1).a(2,2)=fqdl*(cauxa-ceps_0) r4_12f(i1).b(1,2)=fqdl*(cauxb-ceps_2) r4_12f(i1).b(2,1)=fqdr*(-cauxb-ceps_2) r4_12f(i1).c(1,2)=fqdr*(cauxc+ceps_1) r4_12f(i1).c(2,1)=fqdl*(-cauxc+ceps_1) r4_12f(i1).d(1,1)=fqdl*c12f(i1).ek0 r4_12f(i1).d(2,2)=fqdr*c12f(i1).ek0 END DO DO i1=1,2 * T -- qu=p536,qd=p4,v=c12z(i1).e,a=r4_12z(i1).a,b=r4_12z(i1).b,c=r4_12z(i1 * ).c,d=r4_12z(i1).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i1).ek0*(p536(2)*p4(3)-p4(2)*p536(3))+p536k0* & (c12z(i1).e(2)*p4(3)-p4(2)*c12z(i1).e(3))-p4k0*(c12z(i1). & e(2)*p536(3)-p536(2)*c12z(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i1).e(3)*p536k0+p536(3)*c12z(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i1).e(3)*p4k0+p4(3)*c12z(i1).ek0 ceps_2=ceps_2*cim cvqu=c12z(i1).e(0)*p536(0)-c12z(i1).e(1)*p536(1)-c12z(i1). & e(2)*p536(2)-c12z(i1).e(3)*p536(3) cvqd=c12z(i1).e(0)*p4(0)-c12z(i1).e(1)*p4(1)-c12z(i1).e(2) & *p4(2)-c12z(i1).e(3)*p4(3) cauxa=-c12z(i1).ek0*quqd+p536k0*cvqd+p4k0*cvqu cauxb=-c12z(i1).ek0*p4(2)+p4k0*c12z(i1).e(2) cauxc=+c12z(i1).ek0*p536(2)-p536k0*c12z(i1).e(2) r4_12z(i1).a(1,1)=zqdr*(cauxa+ceps_0) r4_12z(i1).a(2,2)=zqdl*(cauxa-ceps_0) r4_12z(i1).b(1,2)=zqdl*(cauxb-ceps_2) r4_12z(i1).b(2,1)=zqdr*(-cauxb-ceps_2) r4_12z(i1).c(1,2)=zqdr*(cauxc+ceps_1) r4_12z(i1).c(2,1)=zqdl*(-cauxc+ceps_1) r4_12z(i1).d(1,1)=zqdl*c12z(i1).ek0 r4_12z(i1).d(2,2)=zqdr*c12z(i1).ek0 END DO * quqd -- p=p534,q=p6 quqd=p534(0)*p6(0)-p534(1)*p6(1)-p534(2)*p6(2)-p534(3)*p6( & 3) DO i1=1,2 * T -- qu=p534,qd=p6,v=c12f(i1).e,a=r6_12f(i1).a,b=r6_12f(i1).b,c=r6_12f(i1 * ).c,d=r6_12f(i1).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i1).ek0*(p534(2)*p6(3)-p6(2)*p534(3))+p534k0* & (c12f(i1).e(2)*p6(3)-p6(2)*c12f(i1).e(3))-p6k0*(c12f(i1). & e(2)*p534(3)-p534(2)*c12f(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i1).e(3)*p534k0+p534(3)*c12f(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i1).e(3)*p6k0+p6(3)*c12f(i1).ek0 ceps_2=ceps_2*cim cvqu=c12f(i1).e(0)*p534(0)-c12f(i1).e(1)*p534(1)-c12f(i1). & e(2)*p534(2)-c12f(i1).e(3)*p534(3) cvqd=c12f(i1).e(0)*p6(0)-c12f(i1).e(1)*p6(1)-c12f(i1).e(2) & *p6(2)-c12f(i1).e(3)*p6(3) cauxa=-c12f(i1).ek0*quqd+p534k0*cvqd+p6k0*cvqu cauxb=-c12f(i1).ek0*p6(2)+p6k0*c12f(i1).e(2) cauxc=+c12f(i1).ek0*p534(2)-p534k0*c12f(i1).e(2) r6_12f(i1).a(1,1)=fqdr*(cauxa+ceps_0) r6_12f(i1).a(2,2)=fqdl*(cauxa-ceps_0) r6_12f(i1).b(1,2)=fqdl*(cauxb-ceps_2) r6_12f(i1).b(2,1)=fqdr*(-cauxb-ceps_2) r6_12f(i1).c(1,2)=fqdr*(cauxc+ceps_1) r6_12f(i1).c(2,1)=fqdl*(-cauxc+ceps_1) r6_12f(i1).d(1,1)=fqdl*c12f(i1).ek0 r6_12f(i1).d(2,2)=fqdr*c12f(i1).ek0 END DO DO i1=1,2 * T -- qu=p534,qd=p6,v=c12z(i1).e,a=r6_12z(i1).a,b=r6_12z(i1).b,c=r6_12z(i1 * ).c,d=r6_12z(i1).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i1).ek0*(p534(2)*p6(3)-p6(2)*p534(3))+p534k0* & (c12z(i1).e(2)*p6(3)-p6(2)*c12z(i1).e(3))-p6k0*(c12z(i1). & e(2)*p534(3)-p534(2)*c12z(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i1).e(3)*p534k0+p534(3)*c12z(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i1).e(3)*p6k0+p6(3)*c12z(i1).ek0 ceps_2=ceps_2*cim cvqu=c12z(i1).e(0)*p534(0)-c12z(i1).e(1)*p534(1)-c12z(i1). & e(2)*p534(2)-c12z(i1).e(3)*p534(3) cvqd=c12z(i1).e(0)*p6(0)-c12z(i1).e(1)*p6(1)-c12z(i1).e(2) & *p6(2)-c12z(i1).e(3)*p6(3) cauxa=-c12z(i1).ek0*quqd+p534k0*cvqd+p6k0*cvqu cauxb=-c12z(i1).ek0*p6(2)+p6k0*c12z(i1).e(2) cauxc=+c12z(i1).ek0*p534(2)-p534k0*c12z(i1).e(2) r6_12z(i1).a(1,1)=zqdr*(cauxa+ceps_0) r6_12z(i1).a(2,2)=zqdl*(cauxa-ceps_0) r6_12z(i1).b(1,2)=zqdl*(cauxb-ceps_2) r6_12z(i1).b(2,1)=zqdr*(-cauxb-ceps_2) r6_12z(i1).c(1,2)=zqdr*(cauxc+ceps_1) r6_12z(i1).c(2,1)=zqdl*(-cauxc+ceps_1) r6_12z(i1).d(1,1)=zqdl*c12z(i1).ek0 r6_12z(i1).d(2,2)=zqdr*c12z(i1).ek0 END DO DO i1=1,2 DO iut=1,2 DO jut=1,2 r4_12fz(i1).a(iut,jut)=r4_12f(i1).a(iut,jut)+ 1 r4_12z(i1).a(iut,jut) r4_12fz(i1).b(iut,jut)=r4_12f(i1).b(iut,jut)+ 1 r4_12z(i1).b(iut,jut) r4_12fz(i1).c(iut,jut)=r4_12f(i1).c(iut,jut)+ 1 r4_12z(i1).c(iut,jut) r4_12fz(i1).d(iut,jut)=r4_12f(i1).d(iut,jut)+ 1 r4_12z(i1).d(iut,jut) r6_12fz(i1).a(iut,jut)=r6_12f(i1).a(iut,jut)+ 1 r6_12z(i1).a(iut,jut) r6_12fz(i1).b(iut,jut)=r6_12f(i1).b(iut,jut)+ 1 r6_12z(i1).b(iut,jut) r6_12fz(i1).c(iut,jut)=r6_12f(i1).c(iut,jut)+ 1 r6_12z(i1).c(iut,jut) r6_12fz(i1).d(iut,jut)=r6_12f(i1).d(iut,jut)+ 1 r6_12z(i1).d(iut,jut) ENDDO !i1 ENDDO !iut ENDDO !jut IF (imix.EQ.-1.or.imix.eq.-2) then * Diagramma (18+21) Risonante Z su (36) DO i1=1,2 DO i3=1,2 DO i6=1,2 * TT -- aa=dia(i1,i3,i6).a,bb=dia(i1,i3,i6).b,cc=dia(i1,i3,i6).c,dd=dia(i1, * i3,i6).d,a1=l5_36(i3,i6).a,b1=l5_36(i3,i6).b,c1=l5_36(i3,i6).c,d1=l5_36(i3 * ,i6).d,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1).c,d2=r4_12fz(i1).d * ,prq=p536q,m=rmb dia(i1,i3,i6).a(1,1)=l5_36(i3,i6).a(1,1)*r4_12fz(i1).a(1,1 & )+l5_36(i3,i6).c(1,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i3,i6).b(1,1)=rmb*(l5_36(i3,i6).d(1,1)*r4_12fz(i1). & a(1,1)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).b(2,1)) dia(i1,i3,i6).c(1,1)=rmb*(l5_36(i3,i6).a(1,1)*r4_12fz(i1). & d(1,1)+l5_36(i3,i6).c(1,2)*r4_12fz(i1).c(2,1)) dia(i1,i3,i6).d(1,1)=l5_36(i3,i6).d(1,1)*p536q*r4_12fz(i1) & .d(1,1)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).c(2,1) dia(i1,i3,i6).a(1,2)=rmb*(l5_36(i3,i6).a(1,1)*r4_12fz(i1). & b(1,2)+l5_36(i3,i6).c(1,2)*r4_12fz(i1).a(2,2)) dia(i1,i3,i6).b(1,2)=l5_36(i3,i6).d(1,1)*p536q*r4_12fz(i1) & .b(1,2)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).a(2,2) dia(i1,i3,i6).c(1,2)=l5_36(i3,i6).a(1,1)*r4_12fz(i1).c(1,2 & )+l5_36(i3,i6).c(1,2)*p536q*r4_12fz(i1).d(2,2) dia(i1,i3,i6).d(1,2)=rmb*(l5_36(i3,i6).d(1,1)*r4_12fz(i1). & c(1,2)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).d(2,2)) dia(i1,i3,i6).a(2,1)=rmb*(l5_36(i3,i6).c(2,1)*r4_12fz(i1). & a(1,1)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).b(2,1)) dia(i1,i3,i6).b(2,1)=l5_36(i3,i6).b(2,1)*r4_12fz(i1).a(1,1 & )+l5_36(i3,i6).d(2,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i3,i6).c(2,1)=l5_36(i3,i6).c(2,1)*p536q*r4_12fz(i1) & .d(1,1)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).c(2,1) dia(i1,i3,i6).d(2,1)=rmb*(l5_36(i3,i6).b(2,1)*r4_12fz(i1). & d(1,1)+l5_36(i3,i6).d(2,2)*r4_12fz(i1).c(2,1)) dia(i1,i3,i6).a(2,2)=l5_36(i3,i6).c(2,1)*p536q*r4_12fz(i1) & .b(1,2)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).a(2,2) dia(i1,i3,i6).b(2,2)=rmb*(l5_36(i3,i6).b(2,1)*r4_12fz(i1). & b(1,2)+l5_36(i3,i6).d(2,2)*r4_12fz(i1).a(2,2)) dia(i1,i3,i6).c(2,2)=rmb*(l5_36(i3,i6).c(2,1)*r4_12fz(i1). & c(1,2)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).d(2,2)) dia(i1,i3,i6).d(2,2)=l5_36(i3,i6).b(2,1)*r4_12fz(i1).c(1,2 & )+l5_36(i3,i6).d(2,2)*p536q*r4_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i6=1,2 * mline -- res=cres9(i1,i3,i6,&),abcd=dia(i1,i3,i6).,m1=rmb,m2=(-rmb),den=( * (p536q-rmb2)*p536k0) DO iut=1,2 DO jut=1,2 cres9(i1,i3,i6,iut,jut)=(dia(i1,i3,i6).a(iut,jut) & +rmb*dia( & i1,i3,i6).b(iut,jut)+(-rmb)*dia(i1,i3,i6).c(iut,jut) & +rmb* & (-rmb)*dia(i1,i3,i6).d(iut,jut))/((p536q-rmb2) & *p536k0) ENDDO ENDDO END DO END DO END DO * Diagramma (64+67) Risonante Z su (34) DO i1=1,2 DO i3=1,2 DO i4=1,2 * TT -- aa=dia(i1,i3,i4).a,bb=dia(i1,i3,i4).b,cc=dia(i1,i3,i4).c,dd=dia(i1, * i3,i4).d,a1=l5_34(i3,i4).a,b1=l5_34(i3,i4).b,c1=l5_34(i3,i4).c,d1=l5_34(i3 * ,i4).d,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1).c,d2=r6_12fz(i1).d * ,prq=p534q,m=rmb dia(i1,i3,i4).a(1,1)=l5_34(i3,i4).a(1,1)*r6_12fz(i1).a(1,1 & )+l5_34(i3,i4).c(1,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i3,i4).b(1,1)=rmb*(l5_34(i3,i4).d(1,1)*r6_12fz(i1). & a(1,1)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).b(2,1)) dia(i1,i3,i4).c(1,1)=rmb*(l5_34(i3,i4).a(1,1)*r6_12fz(i1). & d(1,1)+l5_34(i3,i4).c(1,2)*r6_12fz(i1).c(2,1)) dia(i1,i3,i4).d(1,1)=l5_34(i3,i4).d(1,1)*p534q*r6_12fz(i1) & .d(1,1)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).c(2,1) dia(i1,i3,i4).a(1,2)=rmb*(l5_34(i3,i4).a(1,1)*r6_12fz(i1). & b(1,2)+l5_34(i3,i4).c(1,2)*r6_12fz(i1).a(2,2)) dia(i1,i3,i4).b(1,2)=l5_34(i3,i4).d(1,1)*p534q*r6_12fz(i1) & .b(1,2)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).a(2,2) dia(i1,i3,i4).c(1,2)=l5_34(i3,i4).a(1,1)*r6_12fz(i1).c(1,2 & )+l5_34(i3,i4).c(1,2)*p534q*r6_12fz(i1).d(2,2) dia(i1,i3,i4).d(1,2)=rmb*(l5_34(i3,i4).d(1,1)*r6_12fz(i1). & c(1,2)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).d(2,2)) dia(i1,i3,i4).a(2,1)=rmb*(l5_34(i3,i4).c(2,1)*r6_12fz(i1). & a(1,1)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).b(2,1)) dia(i1,i3,i4).b(2,1)=l5_34(i3,i4).b(2,1)*r6_12fz(i1).a(1,1 & )+l5_34(i3,i4).d(2,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i3,i4).c(2,1)=l5_34(i3,i4).c(2,1)*p534q*r6_12fz(i1) & .d(1,1)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).c(2,1) dia(i1,i3,i4).d(2,1)=rmb*(l5_34(i3,i4).b(2,1)*r6_12fz(i1). & d(1,1)+l5_34(i3,i4).d(2,2)*r6_12fz(i1).c(2,1)) dia(i1,i3,i4).a(2,2)=l5_34(i3,i4).c(2,1)*p534q*r6_12fz(i1) & .b(1,2)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).a(2,2) dia(i1,i3,i4).b(2,2)=rmb*(l5_34(i3,i4).b(2,1)*r6_12fz(i1). & b(1,2)+l5_34(i3,i4).d(2,2)*r6_12fz(i1).a(2,2)) dia(i1,i3,i4).c(2,2)=rmb*(l5_34(i3,i4).c(2,1)*r6_12fz(i1). & c(1,2)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).d(2,2)) dia(i1,i3,i4).d(2,2)=l5_34(i3,i4).b(2,1)*r6_12fz(i1).c(1,2 & )+l5_34(i3,i4).d(2,2)*p534q*r6_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 * mline -- res=cres10(i1,i3,i4,&),abcd=dia(i1,i3,i4).,m1=rmb,m2=(-rmb),den= * ((p534q-rmb2)*p534k0) DO iut=1,2 DO jut=1,2 cres10(i1,i3,i4,iut,jut)=(dia(i1,i3,i4).a(iut,jut) & +rmb*dia & (i1,i3,i4).b(iut,jut)+(-rmb)*dia(i1,i3,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i4).d(iut,jut))/((p534q-rmb2) & *p534k0) ENDDO ENDDO END DO END DO END DO * Diagramma (24+27) Risonante Z su (56) DO i1=1,2 DO i5=1,2 DO i6=1,2 * TT -- aa=dia(i1,i5,i6).a,bb=dia(i1,i5,i6).b,cc=dia(i1,i5,i6).c,dd=dia(i1, * i5,i6).d,a1=l3_56(i5,i6).a,b1=l3_56(i5,i6).b,c1=l3_56(i5,i6).c,d1=l3_56(i5 * ,i6).d,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1).c,d2=r4_12fz(i1).d * ,prq=p536q,m=rmb dia(i1,i5,i6).a(1,1)=l3_56(i5,i6).a(1,1)*r4_12fz(i1).a(1,1 & )+l3_56(i5,i6).c(1,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i5,i6).b(1,1)=rmb*(l3_56(i5,i6).d(1,1)*r4_12fz(i1). & a(1,1)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).b(2,1)) dia(i1,i5,i6).c(1,1)=rmb*(l3_56(i5,i6).a(1,1)*r4_12fz(i1). & d(1,1)+l3_56(i5,i6).c(1,2)*r4_12fz(i1).c(2,1)) dia(i1,i5,i6).d(1,1)=l3_56(i5,i6).d(1,1)*p536q*r4_12fz(i1) & .d(1,1)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).c(2,1) dia(i1,i5,i6).a(1,2)=rmb*(l3_56(i5,i6).a(1,1)*r4_12fz(i1). & b(1,2)+l3_56(i5,i6).c(1,2)*r4_12fz(i1).a(2,2)) dia(i1,i5,i6).b(1,2)=l3_56(i5,i6).d(1,1)*p536q*r4_12fz(i1) & .b(1,2)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).a(2,2) dia(i1,i5,i6).c(1,2)=l3_56(i5,i6).a(1,1)*r4_12fz(i1).c(1,2 & )+l3_56(i5,i6).c(1,2)*p536q*r4_12fz(i1).d(2,2) dia(i1,i5,i6).d(1,2)=rmb*(l3_56(i5,i6).d(1,1)*r4_12fz(i1). & c(1,2)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).d(2,2)) dia(i1,i5,i6).a(2,1)=rmb*(l3_56(i5,i6).c(2,1)*r4_12fz(i1). & a(1,1)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).b(2,1)) dia(i1,i5,i6).b(2,1)=l3_56(i5,i6).b(2,1)*r4_12fz(i1).a(1,1 & )+l3_56(i5,i6).d(2,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i5,i6).c(2,1)=l3_56(i5,i6).c(2,1)*p536q*r4_12fz(i1) & .d(1,1)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).c(2,1) dia(i1,i5,i6).d(2,1)=rmb*(l3_56(i5,i6).b(2,1)*r4_12fz(i1). & d(1,1)+l3_56(i5,i6).d(2,2)*r4_12fz(i1).c(2,1)) dia(i1,i5,i6).a(2,2)=l3_56(i5,i6).c(2,1)*p536q*r4_12fz(i1) & .b(1,2)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).a(2,2) dia(i1,i5,i6).b(2,2)=rmb*(l3_56(i5,i6).b(2,1)*r4_12fz(i1). & b(1,2)+l3_56(i5,i6).d(2,2)*r4_12fz(i1).a(2,2)) dia(i1,i5,i6).c(2,2)=rmb*(l3_56(i5,i6).c(2,1)*r4_12fz(i1). & c(1,2)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).d(2,2)) dia(i1,i5,i6).d(2,2)=l3_56(i5,i6).b(2,1)*r4_12fz(i1).c(1,2 & )+l3_56(i5,i6).d(2,2)*p536q*r4_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i6=1,2 * mline -- res=cres11(i1,i5,i6,&),abcd=dia(i1,i5,i6).,m1=rmb,m2=(-rmb),den= * ((p536q-rmb2)*p536k0) DO iut=1,2 DO jut=1,2 cres11(i1,i5,i6,iut,jut)=(dia(i1,i5,i6).a(iut,jut) & +rmb*dia & (i1,i5,i6).b(iut,jut)+(-rmb)*dia(i1,i5,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i6).d(iut,jut))/((p536q-rmb2) & *p536k0) ENDDO ENDDO END DO END DO END DO * Diagramma (38+41) Risonante Z su (54) DO i1=1,2 DO i5=1,2 DO i4=1,2 * TT -- aa=dia(i1,i5,i4).a,bb=dia(i1,i5,i4).b,cc=dia(i1,i5,i4).c,dd=dia(i1, * i5,i4).d,a1=l3_54(i5,i4).a,b1=l3_54(i5,i4).b,c1=l3_54(i5,i4).c,d1=l3_54(i5 * ,i4).d,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1).c,d2=r6_12fz(i1).d * ,prq=p534q,m=rmb dia(i1,i5,i4).a(1,1)=l3_54(i5,i4).a(1,1)*r6_12fz(i1).a(1,1 & )+l3_54(i5,i4).c(1,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i5,i4).b(1,1)=rmb*(l3_54(i5,i4).d(1,1)*r6_12fz(i1). & a(1,1)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).b(2,1)) dia(i1,i5,i4).c(1,1)=rmb*(l3_54(i5,i4).a(1,1)*r6_12fz(i1). & d(1,1)+l3_54(i5,i4).c(1,2)*r6_12fz(i1).c(2,1)) dia(i1,i5,i4).d(1,1)=l3_54(i5,i4).d(1,1)*p534q*r6_12fz(i1) & .d(1,1)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).c(2,1) dia(i1,i5,i4).a(1,2)=rmb*(l3_54(i5,i4).a(1,1)*r6_12fz(i1). & b(1,2)+l3_54(i5,i4).c(1,2)*r6_12fz(i1).a(2,2)) dia(i1,i5,i4).b(1,2)=l3_54(i5,i4).d(1,1)*p534q*r6_12fz(i1) & .b(1,2)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).a(2,2) dia(i1,i5,i4).c(1,2)=l3_54(i5,i4).a(1,1)*r6_12fz(i1).c(1,2 & )+l3_54(i5,i4).c(1,2)*p534q*r6_12fz(i1).d(2,2) dia(i1,i5,i4).d(1,2)=rmb*(l3_54(i5,i4).d(1,1)*r6_12fz(i1). & c(1,2)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).d(2,2)) dia(i1,i5,i4).a(2,1)=rmb*(l3_54(i5,i4).c(2,1)*r6_12fz(i1). & a(1,1)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).b(2,1)) dia(i1,i5,i4).b(2,1)=l3_54(i5,i4).b(2,1)*r6_12fz(i1).a(1,1 & )+l3_54(i5,i4).d(2,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i5,i4).c(2,1)=l3_54(i5,i4).c(2,1)*p534q*r6_12fz(i1) & .d(1,1)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).c(2,1) dia(i1,i5,i4).d(2,1)=rmb*(l3_54(i5,i4).b(2,1)*r6_12fz(i1). & d(1,1)+l3_54(i5,i4).d(2,2)*r6_12fz(i1).c(2,1)) dia(i1,i5,i4).a(2,2)=l3_54(i5,i4).c(2,1)*p534q*r6_12fz(i1) & .b(1,2)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).a(2,2) dia(i1,i5,i4).b(2,2)=rmb*(l3_54(i5,i4).b(2,1)*r6_12fz(i1). & b(1,2)+l3_54(i5,i4).d(2,2)*r6_12fz(i1).a(2,2)) dia(i1,i5,i4).c(2,2)=rmb*(l3_54(i5,i4).c(2,1)*r6_12fz(i1). & c(1,2)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).d(2,2)) dia(i1,i5,i4).d(2,2)=l3_54(i5,i4).b(2,1)*r6_12fz(i1).c(1,2 & )+l3_54(i5,i4).d(2,2)*p534q*r6_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i4=1,2 * mline -- res=cres12(i1,i5,i4,&),abcd=dia(i1,i5,i4).,m1=rmb,m2=(-rmb),den= * ((p534q-rmb2)*p534k0) DO iut=1,2 DO jut=1,2 cres12(i1,i5,i4,iut,jut)=(dia(i1,i5,i4).a(iut,jut) & +rmb*dia & (i1,i5,i4).b(iut,jut)+(-rmb)*dia(i1,i5,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i4).d(iut,jut))/((p534q-rmb2) & *p534k0) ENDDO ENDDO END DO END DO END DO ENDIF * quqd -- p=p5,q=p512 quqd=p5(0)*p512(0)-p5(1)*p512(1)-p5(2)*p512(2)-p5(3)*p512( & 3) DO i1=1,2 * T -- qu=p5,qd=p512,v=c12f(i1).e,a=l5_12f(i1).a,b=l5_12f(i1).b,c=l5_12f(i1 * ).c,d=l5_12f(i1).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i1).ek0*(p5(2)*p512(3)-p512(2)*p5(3))+p5k0*(c & 12f(i1).e(2)*p512(3)-p512(2)*c12f(i1).e(3))-p512k0*(c12f( & i1).e(2)*p5(3)-p5(2)*c12f(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i1).e(3)*p5k0+p5(3)*c12f(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i1).e(3)*p512k0+p512(3)*c12f(i1).ek0 ceps_2=ceps_2*cim cvqu=c12f(i1).e(0)*p5(0)-c12f(i1).e(1)*p5(1)-c12f(i1).e(2) & *p5(2)-c12f(i1).e(3)*p5(3) cvqd=c12f(i1).e(0)*p512(0)-c12f(i1).e(1)*p512(1)-c12f(i1). & e(2)*p512(2)-c12f(i1).e(3)*p512(3) cauxa=-c12f(i1).ek0*quqd+p5k0*cvqd+p512k0*cvqu cauxb=-c12f(i1).ek0*p512(2)+p512k0*c12f(i1).e(2) cauxc=+c12f(i1).ek0*p5(2)-p5k0*c12f(i1).e(2) l5_12f(i1).a(1,1)=fqdr*(cauxa+ceps_0) l5_12f(i1).a(2,2)=fqdl*(cauxa-ceps_0) l5_12f(i1).b(1,2)=fqdl*(cauxb-ceps_2) l5_12f(i1).b(2,1)=fqdr*(-cauxb-ceps_2) l5_12f(i1).c(1,2)=fqdr*(cauxc+ceps_1) l5_12f(i1).c(2,1)=fqdl*(-cauxc+ceps_1) l5_12f(i1).d(1,1)=fqdl*c12f(i1).ek0 l5_12f(i1).d(2,2)=fqdr*c12f(i1).ek0 END DO DO i1=1,2 * T -- qu=p5,qd=p512,v=c12z(i1).e,a=l5_12z(i1).a,b=l5_12z(i1).b,c=l5_12z(i1 * ).c,d=l5_12z(i1).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i1).ek0*(p5(2)*p512(3)-p512(2)*p5(3))+p5k0*(c & 12z(i1).e(2)*p512(3)-p512(2)*c12z(i1).e(3))-p512k0*(c12z( & i1).e(2)*p5(3)-p5(2)*c12z(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i1).e(3)*p5k0+p5(3)*c12z(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i1).e(3)*p512k0+p512(3)*c12z(i1).ek0 ceps_2=ceps_2*cim cvqu=c12z(i1).e(0)*p5(0)-c12z(i1).e(1)*p5(1)-c12z(i1).e(2) & *p5(2)-c12z(i1).e(3)*p5(3) cvqd=c12z(i1).e(0)*p512(0)-c12z(i1).e(1)*p512(1)-c12z(i1). & e(2)*p512(2)-c12z(i1).e(3)*p512(3) cauxa=-c12z(i1).ek0*quqd+p5k0*cvqd+p512k0*cvqu cauxb=-c12z(i1).ek0*p512(2)+p512k0*c12z(i1).e(2) cauxc=+c12z(i1).ek0*p5(2)-p5k0*c12z(i1).e(2) l5_12z(i1).a(1,1)=zqdr*(cauxa+ceps_0) l5_12z(i1).a(2,2)=zqdl*(cauxa-ceps_0) l5_12z(i1).b(1,2)=zqdl*(cauxb-ceps_2) l5_12z(i1).b(2,1)=zqdr*(-cauxb-ceps_2) l5_12z(i1).c(1,2)=zqdr*(cauxc+ceps_1) l5_12z(i1).c(2,1)=zqdl*(-cauxc+ceps_1) l5_12z(i1).d(1,1)=zqdl*c12z(i1).ek0 l5_12z(i1).d(2,2)=zqdr*c12z(i1).ek0 END DO * quqd -- p=p3,q=p312 quqd=p3(0)*p312(0)-p3(1)*p312(1)-p3(2)*p312(2)-p3(3)*p312( & 3) DO i1=1,2 * T -- qu=p3,qd=p312,v=c12f(i1).e,a=l3_12f(i1).a,b=l3_12f(i1).b,c=l3_12f(i1 * ).c,d=l3_12f(i1).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c12f(i1).ek0*(p3(2)*p312(3)-p312(2)*p3(3))+p3k0*(c & 12f(i1).e(2)*p312(3)-p312(2)*c12f(i1).e(3))-p312k0*(c12f( & i1).e(2)*p3(3)-p3(2)*c12f(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12f(i1).e(3)*p3k0+p3(3)*c12f(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12f(i1).e(3)*p312k0+p312(3)*c12f(i1).ek0 ceps_2=ceps_2*cim cvqu=c12f(i1).e(0)*p3(0)-c12f(i1).e(1)*p3(1)-c12f(i1).e(2) & *p3(2)-c12f(i1).e(3)*p3(3) cvqd=c12f(i1).e(0)*p312(0)-c12f(i1).e(1)*p312(1)-c12f(i1). & e(2)*p312(2)-c12f(i1).e(3)*p312(3) cauxa=-c12f(i1).ek0*quqd+p3k0*cvqd+p312k0*cvqu cauxb=-c12f(i1).ek0*p312(2)+p312k0*c12f(i1).e(2) cauxc=+c12f(i1).ek0*p3(2)-p3k0*c12f(i1).e(2) l3_12f(i1).a(1,1)=fqdr*(cauxa+ceps_0) l3_12f(i1).a(2,2)=fqdl*(cauxa-ceps_0) l3_12f(i1).b(1,2)=fqdl*(cauxb-ceps_2) l3_12f(i1).b(2,1)=fqdr*(-cauxb-ceps_2) l3_12f(i1).c(1,2)=fqdr*(cauxc+ceps_1) l3_12f(i1).c(2,1)=fqdl*(-cauxc+ceps_1) l3_12f(i1).d(1,1)=fqdl*c12f(i1).ek0 l3_12f(i1).d(2,2)=fqdr*c12f(i1).ek0 END DO DO i1=1,2 * T -- qu=p3,qd=p312,v=c12z(i1).e,a=l3_12z(i1).a,b=l3_12z(i1).b,c=l3_12z(i1 * ).c,d=l3_12z(i1).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c12z(i1).ek0*(p3(2)*p312(3)-p312(2)*p3(3))+p3k0*(c & 12z(i1).e(2)*p312(3)-p312(2)*c12z(i1).e(3))-p312k0*(c12z( & i1).e(2)*p3(3)-p3(2)*c12z(i1).e(3)) ceps_0=ceps_0*cim ceps_1=-c12z(i1).e(3)*p3k0+p3(3)*c12z(i1).ek0 ceps_1=ceps_1*cim ceps_2=-c12z(i1).e(3)*p312k0+p312(3)*c12z(i1).ek0 ceps_2=ceps_2*cim cvqu=c12z(i1).e(0)*p3(0)-c12z(i1).e(1)*p3(1)-c12z(i1).e(2) & *p3(2)-c12z(i1).e(3)*p3(3) cvqd=c12z(i1).e(0)*p312(0)-c12z(i1).e(1)*p312(1)-c12z(i1). & e(2)*p312(2)-c12z(i1).e(3)*p312(3) cauxa=-c12z(i1).ek0*quqd+p3k0*cvqd+p312k0*cvqu cauxb=-c12z(i1).ek0*p312(2)+p312k0*c12z(i1).e(2) cauxc=+c12z(i1).ek0*p3(2)-p3k0*c12z(i1).e(2) l3_12z(i1).a(1,1)=zqdr*(cauxa+ceps_0) l3_12z(i1).a(2,2)=zqdl*(cauxa-ceps_0) l3_12z(i1).b(1,2)=zqdl*(cauxb-ceps_2) l3_12z(i1).b(2,1)=zqdr*(-cauxb-ceps_2) l3_12z(i1).c(1,2)=zqdr*(cauxc+ceps_1) l3_12z(i1).c(2,1)=zqdl*(-cauxc+ceps_1) l3_12z(i1).d(1,1)=zqdl*c12z(i1).ek0 l3_12z(i1).d(2,2)=zqdr*c12z(i1).ek0 END DO DO i1=1,2 DO iut=1,2 DO jut=1,2 l3_12fz(i1).a(iut,jut)=l3_12f(i1).a(iut,jut)+ 1 l3_12z(i1).a(iut,jut) l3_12fz(i1).b(iut,jut)=l3_12f(i1).b(iut,jut)+ 1 l3_12z(i1).b(iut,jut) l3_12fz(i1).c(iut,jut)=l3_12f(i1).c(iut,jut)+ 1 l3_12z(i1).c(iut,jut) l3_12fz(i1).d(iut,jut)=l3_12f(i1).d(iut,jut)+ 1 l3_12z(i1).d(iut,jut) l5_12fz(i1).a(iut,jut)=l5_12f(i1).a(iut,jut)+ 1 l5_12z(i1).a(iut,jut) l5_12fz(i1).b(iut,jut)=l5_12f(i1).b(iut,jut)+ 1 l5_12z(i1).b(iut,jut) l5_12fz(i1).c(iut,jut)=l5_12f(i1).c(iut,jut)+ 1 l5_12z(i1).c(iut,jut) l5_12fz(i1).d(iut,jut)=l5_12f(i1).d(iut,jut)+ 1 l5_12z(i1).d(iut,jut) ENDDO !i1 ENDDO !jut ENDDO !iut IF (imix.EQ.-1.or.imix.eq.-2) then * quqd -- p=p512,q=p4 quqd=p512(0)*p4(0)-p512(1)*p4(1)-p512(2)*p4(2)-p512(3)*p4( & 3) DO i3=1,2 DO i6=1,2 * T -- qu=p512,qd=p4,v=c36f(i3,i6).e,a=r4_36f(i3,i6).a,b=r4_36f(i3,i6).b,c= * r4_36f(i3,i6).c,d=r4_36f(i3,i6).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c36f(i3,i6).ek0*(p512(2)*p4(3)-p4(2)*p512(3))+p512 & k0*(c36f(i3,i6).e(2)*p4(3)-p4(2)*c36f(i3,i6).e(3))-p4k0*( & c36f(i3,i6).e(2)*p512(3)-p512(2)*c36f(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c36f(i3,i6).e(3)*p512k0+p512(3)*c36f(i3,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c36f(i3,i6).e(3)*p4k0+p4(3)*c36f(i3,i6).ek0 ceps_2=ceps_2*cim cvqu=c36f(i3,i6).e(0)*p512(0)-c36f(i3,i6).e(1)*p512(1)-c36 & f(i3,i6).e(2)*p512(2)-c36f(i3,i6).e(3)*p512(3) cvqd=c36f(i3,i6).e(0)*p4(0)-c36f(i3,i6).e(1)*p4(1)-c36f(i3 & ,i6).e(2)*p4(2)-c36f(i3,i6).e(3)*p4(3) cauxa=-c36f(i3,i6).ek0*quqd+p512k0*cvqd+p4k0*cvqu cauxb=-c36f(i3,i6).ek0*p4(2)+p4k0*c36f(i3,i6).e(2) cauxc=+c36f(i3,i6).ek0*p512(2)-p512k0*c36f(i3,i6).e(2) r4_36f(i3,i6).a(1,1)=fqdr*(cauxa+ceps_0) r4_36f(i3,i6).a(2,2)=fqdl*(cauxa-ceps_0) r4_36f(i3,i6).b(1,2)=fqdl*(cauxb-ceps_2) r4_36f(i3,i6).b(2,1)=fqdr*(-cauxb-ceps_2) r4_36f(i3,i6).c(1,2)=fqdr*(cauxc+ceps_1) r4_36f(i3,i6).c(2,1)=fqdl*(-cauxc+ceps_1) r4_36f(i3,i6).d(1,1)=fqdl*c36f(i3,i6).ek0 r4_36f(i3,i6).d(2,2)=fqdr*c36f(i3,i6).ek0 END DO END DO * quqd -- p=p512,q=p4 quqd=p512(0)*p4(0)-p512(1)*p4(1)-p512(2)*p4(2)-p512(3)*p4( & 3) DO i3=1,2 DO i6=1,2 * T -- qu=p512,qd=p4,v=c36z(i3,i6).e,a=r4_36z(i3,i6).a,b=r4_36z(i3,i6).b,c= * r4_36z(i3,i6).c,d=r4_36z(i3,i6).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c36z(i3,i6).ek0*(p512(2)*p4(3)-p4(2)*p512(3))+p512 & k0*(c36z(i3,i6).e(2)*p4(3)-p4(2)*c36z(i3,i6).e(3))-p4k0*( & c36z(i3,i6).e(2)*p512(3)-p512(2)*c36z(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c36z(i3,i6).e(3)*p512k0+p512(3)*c36z(i3,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c36z(i3,i6).e(3)*p4k0+p4(3)*c36z(i3,i6).ek0 ceps_2=ceps_2*cim cvqu=c36z(i3,i6).e(0)*p512(0)-c36z(i3,i6).e(1)*p512(1)-c36 & z(i3,i6).e(2)*p512(2)-c36z(i3,i6).e(3)*p512(3) cvqd=c36z(i3,i6).e(0)*p4(0)-c36z(i3,i6).e(1)*p4(1)-c36z(i3 & ,i6).e(2)*p4(2)-c36z(i3,i6).e(3)*p4(3) cauxa=-c36z(i3,i6).ek0*quqd+p512k0*cvqd+p4k0*cvqu cauxb=-c36z(i3,i6).ek0*p4(2)+p4k0*c36z(i3,i6).e(2) cauxc=+c36z(i3,i6).ek0*p512(2)-p512k0*c36z(i3,i6).e(2) r4_36z(i3,i6).a(1,1)=zqdr*(cauxa+ceps_0) r4_36z(i3,i6).a(2,2)=zqdl*(cauxa-ceps_0) r4_36z(i3,i6).b(1,2)=zqdl*(cauxb-ceps_2) r4_36z(i3,i6).b(2,1)=zqdr*(-cauxb-ceps_2) r4_36z(i3,i6).c(1,2)=zqdr*(cauxc+ceps_1) r4_36z(i3,i6).c(2,1)=zqdl*(-cauxc+ceps_1) r4_36z(i3,i6).d(1,1)=zqdl*c36z(i3,i6).ek0 r4_36z(i3,i6).d(2,2)=zqdr*c36z(i3,i6).ek0 END DO END DO * quqd -- p=p312,q=p4 quqd=p312(0)*p4(0)-p312(1)*p4(1)-p312(2)*p4(2)-p312(3)*p4( & 3) DO i5=1,2 DO i6=1,2 * T -- qu=p312,qd=p4,v=c56f(i5,i6).e,a=r4_56f(i5,i6).a,b=r4_56f(i5,i6).b,c= * r4_56f(i5,i6).c,d=r4_56f(i5,i6).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c56f(i5,i6).ek0*(p312(2)*p4(3)-p4(2)*p312(3))+p312 & k0*(c56f(i5,i6).e(2)*p4(3)-p4(2)*c56f(i5,i6).e(3))-p4k0*( & c56f(i5,i6).e(2)*p312(3)-p312(2)*c56f(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i5,i6).e(3)*p312k0+p312(3)*c56f(i5,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c56f(i5,i6).e(3)*p4k0+p4(3)*c56f(i5,i6).ek0 ceps_2=ceps_2*cim cvqu=c56f(i5,i6).e(0)*p312(0)-c56f(i5,i6).e(1)*p312(1)-c56 & f(i5,i6).e(2)*p312(2)-c56f(i5,i6).e(3)*p312(3) cvqd=c56f(i5,i6).e(0)*p4(0)-c56f(i5,i6).e(1)*p4(1)-c56f(i5 & ,i6).e(2)*p4(2)-c56f(i5,i6).e(3)*p4(3) cauxa=-c56f(i5,i6).ek0*quqd+p312k0*cvqd+p4k0*cvqu cauxb=-c56f(i5,i6).ek0*p4(2)+p4k0*c56f(i5,i6).e(2) cauxc=+c56f(i5,i6).ek0*p312(2)-p312k0*c56f(i5,i6).e(2) r4_56f(i5,i6).a(1,1)=fqdr*(cauxa+ceps_0) r4_56f(i5,i6).a(2,2)=fqdl*(cauxa-ceps_0) r4_56f(i5,i6).b(1,2)=fqdl*(cauxb-ceps_2) r4_56f(i5,i6).b(2,1)=fqdr*(-cauxb-ceps_2) r4_56f(i5,i6).c(1,2)=fqdr*(cauxc+ceps_1) r4_56f(i5,i6).c(2,1)=fqdl*(-cauxc+ceps_1) r4_56f(i5,i6).d(1,1)=fqdl*c56f(i5,i6).ek0 r4_56f(i5,i6).d(2,2)=fqdr*c56f(i5,i6).ek0 END DO END DO * quqd -- p=p312,q=p4 quqd=p312(0)*p4(0)-p312(1)*p4(1)-p312(2)*p4(2)-p312(3)*p4( & 3) DO i5=1,2 DO i6=1,2 * T -- qu=p312,qd=p4,v=c56z(i5,i6).e,a=r4_56z(i5,i6).a,b=r4_56z(i5,i6).b,c= * r4_56z(i5,i6).c,d=r4_56z(i5,i6).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c56z(i5,i6).ek0*(p312(2)*p4(3)-p4(2)*p312(3))+p312 & k0*(c56z(i5,i6).e(2)*p4(3)-p4(2)*c56z(i5,i6).e(3))-p4k0*( & c56z(i5,i6).e(2)*p312(3)-p312(2)*c56z(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c56z(i5,i6).e(3)*p312k0+p312(3)*c56z(i5,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c56z(i5,i6).e(3)*p4k0+p4(3)*c56z(i5,i6).ek0 ceps_2=ceps_2*cim cvqu=c56z(i5,i6).e(0)*p312(0)-c56z(i5,i6).e(1)*p312(1)-c56 & z(i5,i6).e(2)*p312(2)-c56z(i5,i6).e(3)*p312(3) cvqd=c56z(i5,i6).e(0)*p4(0)-c56z(i5,i6).e(1)*p4(1)-c56z(i5 & ,i6).e(2)*p4(2)-c56z(i5,i6).e(3)*p4(3) cauxa=-c56z(i5,i6).ek0*quqd+p312k0*cvqd+p4k0*cvqu cauxb=-c56z(i5,i6).ek0*p4(2)+p4k0*c56z(i5,i6).e(2) cauxc=+c56z(i5,i6).ek0*p312(2)-p312k0*c56z(i5,i6).e(2) r4_56z(i5,i6).a(1,1)=zqdr*(cauxa+ceps_0) r4_56z(i5,i6).a(2,2)=zqdl*(cauxa-ceps_0) r4_56z(i5,i6).b(1,2)=zqdl*(cauxb-ceps_2) r4_56z(i5,i6).b(2,1)=zqdr*(-cauxb-ceps_2) r4_56z(i5,i6).c(1,2)=zqdr*(cauxc+ceps_1) r4_56z(i5,i6).c(2,1)=zqdl*(-cauxc+ceps_1) r4_56z(i5,i6).d(1,1)=zqdl*c56z(i5,i6).ek0 r4_56z(i5,i6).d(2,2)=zqdr*c56z(i5,i6).ek0 END DO END DO * quqd -- p=p312,q=p6 quqd=p312(0)*p6(0)-p312(1)*p6(1)-p312(2)*p6(2)-p312(3)*p6( & 3) DO i5=1,2 DO i4=1,2 * T -- qu=p312,qd=p6,v=c54f(i5,i4).e,a=r6_54f(i5,i4).a,b=r6_54f(i5,i4).b,c= * r6_54f(i5,i4).c,d=r6_54f(i5,i4).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c54f(i5,i4).ek0*(p312(2)*p6(3)-p6(2)*p312(3))+p312 & k0*(c54f(i5,i4).e(2)*p6(3)-p6(2)*c54f(i5,i4).e(3))-p6k0*( & c54f(i5,i4).e(2)*p312(3)-p312(2)*c54f(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c54f(i5,i4).e(3)*p312k0+p312(3)*c54f(i5,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c54f(i5,i4).e(3)*p6k0+p6(3)*c54f(i5,i4).ek0 ceps_2=ceps_2*cim cvqu=c54f(i5,i4).e(0)*p312(0)-c54f(i5,i4).e(1)*p312(1)-c54 & f(i5,i4).e(2)*p312(2)-c54f(i5,i4).e(3)*p312(3) cvqd=c54f(i5,i4).e(0)*p6(0)-c54f(i5,i4).e(1)*p6(1)-c54f(i5 & ,i4).e(2)*p6(2)-c54f(i5,i4).e(3)*p6(3) cauxa=-c54f(i5,i4).ek0*quqd+p312k0*cvqd+p6k0*cvqu cauxb=-c54f(i5,i4).ek0*p6(2)+p6k0*c54f(i5,i4).e(2) cauxc=+c54f(i5,i4).ek0*p312(2)-p312k0*c54f(i5,i4).e(2) r6_54f(i5,i4).a(1,1)=fqdr*(cauxa+ceps_0) r6_54f(i5,i4).a(2,2)=fqdl*(cauxa-ceps_0) r6_54f(i5,i4).b(1,2)=fqdl*(cauxb-ceps_2) r6_54f(i5,i4).b(2,1)=fqdr*(-cauxb-ceps_2) r6_54f(i5,i4).c(1,2)=fqdr*(cauxc+ceps_1) r6_54f(i5,i4).c(2,1)=fqdl*(-cauxc+ceps_1) r6_54f(i5,i4).d(1,1)=fqdl*c54f(i5,i4).ek0 r6_54f(i5,i4).d(2,2)=fqdr*c54f(i5,i4).ek0 END DO END DO * quqd -- p=p312,q=p6 quqd=p312(0)*p6(0)-p312(1)*p6(1)-p312(2)*p6(2)-p312(3)*p6( & 3) DO i5=1,2 DO i4=1,2 * T -- qu=p312,qd=p6,v=c54z(i5,i4).e,a=r6_54z(i5,i4).a,b=r6_54z(i5,i4).b,c= * r6_54z(i5,i4).c,d=r6_54z(i5,i4).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c54z(i5,i4).ek0*(p312(2)*p6(3)-p6(2)*p312(3))+p312 & k0*(c54z(i5,i4).e(2)*p6(3)-p6(2)*c54z(i5,i4).e(3))-p6k0*( & c54z(i5,i4).e(2)*p312(3)-p312(2)*c54z(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c54z(i5,i4).e(3)*p312k0+p312(3)*c54z(i5,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c54z(i5,i4).e(3)*p6k0+p6(3)*c54z(i5,i4).ek0 ceps_2=ceps_2*cim cvqu=c54z(i5,i4).e(0)*p312(0)-c54z(i5,i4).e(1)*p312(1)-c54 & z(i5,i4).e(2)*p312(2)-c54z(i5,i4).e(3)*p312(3) cvqd=c54z(i5,i4).e(0)*p6(0)-c54z(i5,i4).e(1)*p6(1)-c54z(i5 & ,i4).e(2)*p6(2)-c54z(i5,i4).e(3)*p6(3) cauxa=-c54z(i5,i4).ek0*quqd+p312k0*cvqd+p6k0*cvqu cauxb=-c54z(i5,i4).ek0*p6(2)+p6k0*c54z(i5,i4).e(2) cauxc=+c54z(i5,i4).ek0*p312(2)-p312k0*c54z(i5,i4).e(2) r6_54z(i5,i4).a(1,1)=zqdr*(cauxa+ceps_0) r6_54z(i5,i4).a(2,2)=zqdl*(cauxa-ceps_0) r6_54z(i5,i4).b(1,2)=zqdl*(cauxb-ceps_2) r6_54z(i5,i4).b(2,1)=zqdr*(-cauxb-ceps_2) r6_54z(i5,i4).c(1,2)=zqdr*(cauxc+ceps_1) r6_54z(i5,i4).c(2,1)=zqdl*(-cauxc+ceps_1) r6_54z(i5,i4).d(1,1)=zqdl*c54z(i5,i4).ek0 r6_54z(i5,i4).d(2,2)=zqdr*c54z(i5,i4).ek0 END DO END DO * quqd -- p=p512,q=p6 quqd=p512(0)*p6(0)-p512(1)*p6(1)-p512(2)*p6(2)-p512(3)*p6( & 3) DO i3=1,2 DO i4=1,2 * T -- qu=p512,qd=p6,v=c34f(i3,i4).e,a=r6_34f(i3,i4).a,b=r6_34f(i3,i4).b,c= * r6_34f(i3,i4).c,d=r6_34f(i3,i4).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c34f(i3,i4).ek0*(p512(2)*p6(3)-p6(2)*p512(3))+p512 & k0*(c34f(i3,i4).e(2)*p6(3)-p6(2)*c34f(i3,i4).e(3))-p6k0*( & c34f(i3,i4).e(2)*p512(3)-p512(2)*c34f(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i3,i4).e(3)*p512k0+p512(3)*c34f(i3,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c34f(i3,i4).e(3)*p6k0+p6(3)*c34f(i3,i4).ek0 ceps_2=ceps_2*cim cvqu=c34f(i3,i4).e(0)*p512(0)-c34f(i3,i4).e(1)*p512(1)-c34 & f(i3,i4).e(2)*p512(2)-c34f(i3,i4).e(3)*p512(3) cvqd=c34f(i3,i4).e(0)*p6(0)-c34f(i3,i4).e(1)*p6(1)-c34f(i3 & ,i4).e(2)*p6(2)-c34f(i3,i4).e(3)*p6(3) cauxa=-c34f(i3,i4).ek0*quqd+p512k0*cvqd+p6k0*cvqu cauxb=-c34f(i3,i4).ek0*p6(2)+p6k0*c34f(i3,i4).e(2) cauxc=+c34f(i3,i4).ek0*p512(2)-p512k0*c34f(i3,i4).e(2) r6_34f(i3,i4).a(1,1)=fqdr*(cauxa+ceps_0) r6_34f(i3,i4).a(2,2)=fqdl*(cauxa-ceps_0) r6_34f(i3,i4).b(1,2)=fqdl*(cauxb-ceps_2) r6_34f(i3,i4).b(2,1)=fqdr*(-cauxb-ceps_2) r6_34f(i3,i4).c(1,2)=fqdr*(cauxc+ceps_1) r6_34f(i3,i4).c(2,1)=fqdl*(-cauxc+ceps_1) r6_34f(i3,i4).d(1,1)=fqdl*c34f(i3,i4).ek0 r6_34f(i3,i4).d(2,2)=fqdr*c34f(i3,i4).ek0 END DO END DO * quqd -- p=p512,q=p6 quqd=p512(0)*p6(0)-p512(1)*p6(1)-p512(2)*p6(2)-p512(3)*p6( & 3) DO i3=1,2 DO i4=1,2 * T -- qu=p512,qd=p6,v=c34z(i3,i4).e,a=r6_34z(i3,i4).a,b=r6_34z(i3,i4).b,c= * r6_34z(i3,i4).c,d=r6_34z(i3,i4).d,cr=zqdr,cl=zqdl,nsum=0 ceps_0=-c34z(i3,i4).ek0*(p512(2)*p6(3)-p6(2)*p512(3))+p512 & k0*(c34z(i3,i4).e(2)*p6(3)-p6(2)*c34z(i3,i4).e(3))-p6k0*( & c34z(i3,i4).e(2)*p512(3)-p512(2)*c34z(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c34z(i3,i4).e(3)*p512k0+p512(3)*c34z(i3,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c34z(i3,i4).e(3)*p6k0+p6(3)*c34z(i3,i4).ek0 ceps_2=ceps_2*cim cvqu=c34z(i3,i4).e(0)*p512(0)-c34z(i3,i4).e(1)*p512(1)-c34 & z(i3,i4).e(2)*p512(2)-c34z(i3,i4).e(3)*p512(3) cvqd=c34z(i3,i4).e(0)*p6(0)-c34z(i3,i4).e(1)*p6(1)-c34z(i3 & ,i4).e(2)*p6(2)-c34z(i3,i4).e(3)*p6(3) cauxa=-c34z(i3,i4).ek0*quqd+p512k0*cvqd+p6k0*cvqu cauxb=-c34z(i3,i4).ek0*p6(2)+p6k0*c34z(i3,i4).e(2) cauxc=+c34z(i3,i4).ek0*p512(2)-p512k0*c34z(i3,i4).e(2) r6_34z(i3,i4).a(1,1)=zqdr*(cauxa+ceps_0) r6_34z(i3,i4).a(2,2)=zqdl*(cauxa-ceps_0) r6_34z(i3,i4).b(1,2)=zqdl*(cauxb-ceps_2) r6_34z(i3,i4).b(2,1)=zqdr*(-cauxb-ceps_2) r6_34z(i3,i4).c(1,2)=zqdr*(cauxc+ceps_1) r6_34z(i3,i4).c(2,1)=zqdl*(-cauxc+ceps_1) r6_34z(i3,i4).d(1,1)=zqdl*c34z(i3,i4).ek0 r6_34z(i3,i4).d(2,2)=zqdr*c34z(i3,i4).ek0 END DO END DO * Diagramma ( 50+53 ) Risonante Z su (36) DO i1=1,2 DO i3=1,2 DO i6=1,2 * TT -- aa=dia(i1,i3,i6).a,bb=dia(i1,i3,i6).b,cc=dia(i1,i3,i6).c,dd=dia(i1, * i3,i6).d,a1=l5_12fz(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1) * .d,a2=r4_36z(i3,i6).a,b2=r4_36z(i3,i6).b,c2=r4_36z(i3,i6).c,d2=r4_36z(i3,i * 6).d,prq=p512q,m=rmb dia(i1,i3,i6).a(1,1)=l5_12fz(i1).a(1,1)*r4_36z(i3,i6).a(1, & 1)+l5_12fz(i1).c(1,2)*p512q*r4_36z(i3,i6).b(2,1) dia(i1,i3,i6).b(1,1)=rmb*(l5_12fz(i1).d(1,1)*r4_36z(i3,i6) & .a(1,1)+l5_12fz(i1).b(1,2)*r4_36z(i3,i6).b(2,1)) dia(i1,i3,i6).c(1,1)=rmb*(l5_12fz(i1).a(1,1)*r4_36z(i3,i6) & .d(1,1)+l5_12fz(i1).c(1,2)*r4_36z(i3,i6).c(2,1)) dia(i1,i3,i6).d(1,1)=l5_12fz(i1).d(1,1)*p512q*r4_36z(i3,i6 & ).d(1,1)+l5_12fz(i1).b(1,2)*r4_36z(i3,i6).c(2,1) dia(i1,i3,i6).a(1,2)=rmb*(l5_12fz(i1).a(1,1)*r4_36z(i3,i6) & .b(1,2)+l5_12fz(i1).c(1,2)*r4_36z(i3,i6).a(2,2)) dia(i1,i3,i6).b(1,2)=l5_12fz(i1).d(1,1)*p512q*r4_36z(i3,i6 & ).b(1,2)+l5_12fz(i1).b(1,2)*r4_36z(i3,i6).a(2,2) dia(i1,i3,i6).c(1,2)=l5_12fz(i1).a(1,1)*r4_36z(i3,i6).c(1, & 2)+l5_12fz(i1).c(1,2)*p512q*r4_36z(i3,i6).d(2,2) dia(i1,i3,i6).d(1,2)=rmb*(l5_12fz(i1).d(1,1)*r4_36z(i3,i6) & .c(1,2)+l5_12fz(i1).b(1,2)*r4_36z(i3,i6).d(2,2)) dia(i1,i3,i6).a(2,1)=rmb*(l5_12fz(i1).c(2,1)*r4_36z(i3,i6) & .a(1,1)+l5_12fz(i1).a(2,2)*r4_36z(i3,i6).b(2,1)) dia(i1,i3,i6).b(2,1)=l5_12fz(i1).b(2,1)*r4_36z(i3,i6).a(1, & 1)+l5_12fz(i1).d(2,2)*p512q*r4_36z(i3,i6).b(2,1) dia(i1,i3,i6).c(2,1)=l5_12fz(i1).c(2,1)*p512q*r4_36z(i3,i6 & ).d(1,1)+l5_12fz(i1).a(2,2)*r4_36z(i3,i6).c(2,1) dia(i1,i3,i6).d(2,1)=rmb*(l5_12fz(i1).b(2,1)*r4_36z(i3,i6) & .d(1,1)+l5_12fz(i1).d(2,2)*r4_36z(i3,i6).c(2,1)) dia(i1,i3,i6).a(2,2)=l5_12fz(i1).c(2,1)*p512q*r4_36z(i3,i6 & ).b(1,2)+l5_12fz(i1).a(2,2)*r4_36z(i3,i6).a(2,2) dia(i1,i3,i6).b(2,2)=rmb*(l5_12fz(i1).b(2,1)*r4_36z(i3,i6) & .b(1,2)+l5_12fz(i1).d(2,2)*r4_36z(i3,i6).a(2,2)) dia(i1,i3,i6).c(2,2)=rmb*(l5_12fz(i1).c(2,1)*r4_36z(i3,i6) & .c(1,2)+l5_12fz(i1).a(2,2)*r4_36z(i3,i6).d(2,2)) dia(i1,i3,i6).d(2,2)=l5_12fz(i1).b(2,1)*r4_36z(i3,i6).c(1, & 2)+l5_12fz(i1).d(2,2)*p512q*r4_36z(i3,i6).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i6=1,2 * mline -- res=cres13(i1,i3,i6,&),abcd=dia(i1,i3,i6).,m1=rmb,m2=(-rmb),den= * ((p512q-rmb2)*p512k0) DO iut=1,2 DO jut=1,2 cres13(i1,i3,i6,iut,jut)=(dia(i1,i3,i6).a(iut,jut) & +rmb*dia & (i1,i3,i6).b(iut,jut)+(-rmb)*dia(i1,i3,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i6).d(iut,jut))/((p512q-rmb2) & *p512k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 32+35 ) Risonante Z su (56) DO i1=1,2 DO i5=1,2 DO i6=1,2 * TT -- aa=dia(i1,i5,i6).a,bb=dia(i1,i5,i6).b,cc=dia(i1,i5,i6).c,dd=dia(i1, * i5,i6).d,a1=l3_12fz(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1) * .d,a2=r4_56z(i5,i6).a,b2=r4_56z(i5,i6).b,c2=r4_56z(i5,i6).c,d2=r4_56z(i5,i * 6).d,prq=p312q,m=rmb dia(i1,i5,i6).a(1,1)=l3_12fz(i1).a(1,1)*r4_56z(i5,i6).a(1, & 1)+l3_12fz(i1).c(1,2)*p312q*r4_56z(i5,i6).b(2,1) dia(i1,i5,i6).b(1,1)=rmb*(l3_12fz(i1).d(1,1)*r4_56z(i5,i6) & .a(1,1)+l3_12fz(i1).b(1,2)*r4_56z(i5,i6).b(2,1)) dia(i1,i5,i6).c(1,1)=rmb*(l3_12fz(i1).a(1,1)*r4_56z(i5,i6) & .d(1,1)+l3_12fz(i1).c(1,2)*r4_56z(i5,i6).c(2,1)) dia(i1,i5,i6).d(1,1)=l3_12fz(i1).d(1,1)*p312q*r4_56z(i5,i6 & ).d(1,1)+l3_12fz(i1).b(1,2)*r4_56z(i5,i6).c(2,1) dia(i1,i5,i6).a(1,2)=rmb*(l3_12fz(i1).a(1,1)*r4_56z(i5,i6) & .b(1,2)+l3_12fz(i1).c(1,2)*r4_56z(i5,i6).a(2,2)) dia(i1,i5,i6).b(1,2)=l3_12fz(i1).d(1,1)*p312q*r4_56z(i5,i6 & ).b(1,2)+l3_12fz(i1).b(1,2)*r4_56z(i5,i6).a(2,2) dia(i1,i5,i6).c(1,2)=l3_12fz(i1).a(1,1)*r4_56z(i5,i6).c(1, & 2)+l3_12fz(i1).c(1,2)*p312q*r4_56z(i5,i6).d(2,2) dia(i1,i5,i6).d(1,2)=rmb*(l3_12fz(i1).d(1,1)*r4_56z(i5,i6) & .c(1,2)+l3_12fz(i1).b(1,2)*r4_56z(i5,i6).d(2,2)) dia(i1,i5,i6).a(2,1)=rmb*(l3_12fz(i1).c(2,1)*r4_56z(i5,i6) & .a(1,1)+l3_12fz(i1).a(2,2)*r4_56z(i5,i6).b(2,1)) dia(i1,i5,i6).b(2,1)=l3_12fz(i1).b(2,1)*r4_56z(i5,i6).a(1, & 1)+l3_12fz(i1).d(2,2)*p312q*r4_56z(i5,i6).b(2,1) dia(i1,i5,i6).c(2,1)=l3_12fz(i1).c(2,1)*p312q*r4_56z(i5,i6 & ).d(1,1)+l3_12fz(i1).a(2,2)*r4_56z(i5,i6).c(2,1) dia(i1,i5,i6).d(2,1)=rmb*(l3_12fz(i1).b(2,1)*r4_56z(i5,i6) & .d(1,1)+l3_12fz(i1).d(2,2)*r4_56z(i5,i6).c(2,1)) dia(i1,i5,i6).a(2,2)=l3_12fz(i1).c(2,1)*p312q*r4_56z(i5,i6 & ).b(1,2)+l3_12fz(i1).a(2,2)*r4_56z(i5,i6).a(2,2) dia(i1,i5,i6).b(2,2)=rmb*(l3_12fz(i1).b(2,1)*r4_56z(i5,i6) & .b(1,2)+l3_12fz(i1).d(2,2)*r4_56z(i5,i6).a(2,2)) dia(i1,i5,i6).c(2,2)=rmb*(l3_12fz(i1).c(2,1)*r4_56z(i5,i6) & .c(1,2)+l3_12fz(i1).a(2,2)*r4_56z(i5,i6).d(2,2)) dia(i1,i5,i6).d(2,2)=l3_12fz(i1).b(2,1)*r4_56z(i5,i6).c(1, & 2)+l3_12fz(i1).d(2,2)*p312q*r4_56z(i5,i6).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i6=1,2 * mline -- res=cres14(i1,i5,i6,&),abcd=dia(i1,i5,i6).,m1=rmb,m2=(-rmb),den= * ((p312q-rmb2)*p312k0) DO iut=1,2 DO jut=1,2 cres14(i1,i5,i6,iut,jut)=(dia(i1,i5,i6).a(iut,jut) & +rmb*dia & (i1,i5,i6).b(iut,jut)+(-rmb)*dia(i1,i5,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i6).d(iut,jut))/((p312q-rmb2) & *p312k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 44+47 ) Risonante Z su (54) DO i1=1,2 DO i5=1,2 DO i4=1,2 * TT -- aa=dia(i1,i5,i4).a,bb=dia(i1,i5,i4).b,cc=dia(i1,i5,i4).c,dd=dia(i1, * i5,i4).d,a1=l3_12fz(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1) * .d,a2=r6_54z(i5,i4).a,b2=r6_54z(i5,i4).b,c2=r6_54z(i5,i4).c,d2=r6_54z(i5,i * 4).d,prq=p312q,m=rmb dia(i1,i5,i4).a(1,1)=l3_12fz(i1).a(1,1)*r6_54z(i5,i4).a(1, & 1)+l3_12fz(i1).c(1,2)*p312q*r6_54z(i5,i4).b(2,1) dia(i1,i5,i4).b(1,1)=rmb*(l3_12fz(i1).d(1,1)*r6_54z(i5,i4) & .a(1,1)+l3_12fz(i1).b(1,2)*r6_54z(i5,i4).b(2,1)) dia(i1,i5,i4).c(1,1)=rmb*(l3_12fz(i1).a(1,1)*r6_54z(i5,i4) & .d(1,1)+l3_12fz(i1).c(1,2)*r6_54z(i5,i4).c(2,1)) dia(i1,i5,i4).d(1,1)=l3_12fz(i1).d(1,1)*p312q*r6_54z(i5,i4 & ).d(1,1)+l3_12fz(i1).b(1,2)*r6_54z(i5,i4).c(2,1) dia(i1,i5,i4).a(1,2)=rmb*(l3_12fz(i1).a(1,1)*r6_54z(i5,i4) & .b(1,2)+l3_12fz(i1).c(1,2)*r6_54z(i5,i4).a(2,2)) dia(i1,i5,i4).b(1,2)=l3_12fz(i1).d(1,1)*p312q*r6_54z(i5,i4 & ).b(1,2)+l3_12fz(i1).b(1,2)*r6_54z(i5,i4).a(2,2) dia(i1,i5,i4).c(1,2)=l3_12fz(i1).a(1,1)*r6_54z(i5,i4).c(1, & 2)+l3_12fz(i1).c(1,2)*p312q*r6_54z(i5,i4).d(2,2) dia(i1,i5,i4).d(1,2)=rmb*(l3_12fz(i1).d(1,1)*r6_54z(i5,i4) & .c(1,2)+l3_12fz(i1).b(1,2)*r6_54z(i5,i4).d(2,2)) dia(i1,i5,i4).a(2,1)=rmb*(l3_12fz(i1).c(2,1)*r6_54z(i5,i4) & .a(1,1)+l3_12fz(i1).a(2,2)*r6_54z(i5,i4).b(2,1)) dia(i1,i5,i4).b(2,1)=l3_12fz(i1).b(2,1)*r6_54z(i5,i4).a(1, & 1)+l3_12fz(i1).d(2,2)*p312q*r6_54z(i5,i4).b(2,1) dia(i1,i5,i4).c(2,1)=l3_12fz(i1).c(2,1)*p312q*r6_54z(i5,i4 & ).d(1,1)+l3_12fz(i1).a(2,2)*r6_54z(i5,i4).c(2,1) dia(i1,i5,i4).d(2,1)=rmb*(l3_12fz(i1).b(2,1)*r6_54z(i5,i4) & .d(1,1)+l3_12fz(i1).d(2,2)*r6_54z(i5,i4).c(2,1)) dia(i1,i5,i4).a(2,2)=l3_12fz(i1).c(2,1)*p312q*r6_54z(i5,i4 & ).b(1,2)+l3_12fz(i1).a(2,2)*r6_54z(i5,i4).a(2,2) dia(i1,i5,i4).b(2,2)=rmb*(l3_12fz(i1).b(2,1)*r6_54z(i5,i4) & .b(1,2)+l3_12fz(i1).d(2,2)*r6_54z(i5,i4).a(2,2)) dia(i1,i5,i4).c(2,2)=rmb*(l3_12fz(i1).c(2,1)*r6_54z(i5,i4) & .c(1,2)+l3_12fz(i1).a(2,2)*r6_54z(i5,i4).d(2,2)) dia(i1,i5,i4).d(2,2)=l3_12fz(i1).b(2,1)*r6_54z(i5,i4).c(1, & 2)+l3_12fz(i1).d(2,2)*p312q*r6_54z(i5,i4).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i4=1,2 * mline -- res=cres15(i1,i5,i4,&),abcd=dia(i1,i5,i4).,m1=rmb,m2=(-rmb),den= * ((p312q-rmb2)*p312k0) DO iut=1,2 DO jut=1,2 cres15(i1,i5,i4,iut,jut)=(dia(i1,i5,i4).a(iut,jut) & +rmb*dia & (i1,i5,i4).b(iut,jut)+(-rmb)*dia(i1,i5,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i4).d(iut,jut))/((p312q-rmb2) & *p312k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 58+61 ) Risonante Z su (34) DO i1=1,2 DO i3=1,2 DO i4=1,2 * TT -- aa=dia(i1,i3,i4).a,bb=dia(i1,i3,i4).b,cc=dia(i1,i3,i4).c,dd=dia(i1, * i3,i4).d,a1=l5_12fz(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1) * .d,a2=r6_34z(i3,i4).a,b2=r6_34z(i3,i4).b,c2=r6_34z(i3,i4).c,d2=r6_34z(i3,i * 4).d,prq=p512q,m=rmb dia(i1,i3,i4).a(1,1)=l5_12fz(i1).a(1,1)*r6_34z(i3,i4).a(1, & 1)+l5_12fz(i1).c(1,2)*p512q*r6_34z(i3,i4).b(2,1) dia(i1,i3,i4).b(1,1)=rmb*(l5_12fz(i1).d(1,1)*r6_34z(i3,i4) & .a(1,1)+l5_12fz(i1).b(1,2)*r6_34z(i3,i4).b(2,1)) dia(i1,i3,i4).c(1,1)=rmb*(l5_12fz(i1).a(1,1)*r6_34z(i3,i4) & .d(1,1)+l5_12fz(i1).c(1,2)*r6_34z(i3,i4).c(2,1)) dia(i1,i3,i4).d(1,1)=l5_12fz(i1).d(1,1)*p512q*r6_34z(i3,i4 & ).d(1,1)+l5_12fz(i1).b(1,2)*r6_34z(i3,i4).c(2,1) dia(i1,i3,i4).a(1,2)=rmb*(l5_12fz(i1).a(1,1)*r6_34z(i3,i4) & .b(1,2)+l5_12fz(i1).c(1,2)*r6_34z(i3,i4).a(2,2)) dia(i1,i3,i4).b(1,2)=l5_12fz(i1).d(1,1)*p512q*r6_34z(i3,i4 & ).b(1,2)+l5_12fz(i1).b(1,2)*r6_34z(i3,i4).a(2,2) dia(i1,i3,i4).c(1,2)=l5_12fz(i1).a(1,1)*r6_34z(i3,i4).c(1, & 2)+l5_12fz(i1).c(1,2)*p512q*r6_34z(i3,i4).d(2,2) dia(i1,i3,i4).d(1,2)=rmb*(l5_12fz(i1).d(1,1)*r6_34z(i3,i4) & .c(1,2)+l5_12fz(i1).b(1,2)*r6_34z(i3,i4).d(2,2)) dia(i1,i3,i4).a(2,1)=rmb*(l5_12fz(i1).c(2,1)*r6_34z(i3,i4) & .a(1,1)+l5_12fz(i1).a(2,2)*r6_34z(i3,i4).b(2,1)) dia(i1,i3,i4).b(2,1)=l5_12fz(i1).b(2,1)*r6_34z(i3,i4).a(1, & 1)+l5_12fz(i1).d(2,2)*p512q*r6_34z(i3,i4).b(2,1) dia(i1,i3,i4).c(2,1)=l5_12fz(i1).c(2,1)*p512q*r6_34z(i3,i4 & ).d(1,1)+l5_12fz(i1).a(2,2)*r6_34z(i3,i4).c(2,1) dia(i1,i3,i4).d(2,1)=rmb*(l5_12fz(i1).b(2,1)*r6_34z(i3,i4) & .d(1,1)+l5_12fz(i1).d(2,2)*r6_34z(i3,i4).c(2,1)) dia(i1,i3,i4).a(2,2)=l5_12fz(i1).c(2,1)*p512q*r6_34z(i3,i4 & ).b(1,2)+l5_12fz(i1).a(2,2)*r6_34z(i3,i4).a(2,2) dia(i1,i3,i4).b(2,2)=rmb*(l5_12fz(i1).b(2,1)*r6_34z(i3,i4) & .b(1,2)+l5_12fz(i1).d(2,2)*r6_34z(i3,i4).a(2,2)) dia(i1,i3,i4).c(2,2)=rmb*(l5_12fz(i1).c(2,1)*r6_34z(i3,i4) & .c(1,2)+l5_12fz(i1).a(2,2)*r6_34z(i3,i4).d(2,2)) dia(i1,i3,i4).d(2,2)=l5_12fz(i1).b(2,1)*r6_34z(i3,i4).c(1, & 2)+l5_12fz(i1).d(2,2)*p512q*r6_34z(i3,i4).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 * mline -- res=cres16(i1,i3,i4,&),abcd=dia(i1,i3,i4).,m1=rmb,m2=(-rmb),den= * ((p512q-rmb2)*p512k0) DO iut=1,2 DO jut=1,2 cres16(i1,i3,i4,iut,jut)=(dia(i1,i3,i4).a(iut,jut) & +rmb*dia & (i1,i3,i4).b(iut,jut)+(-rmb)*dia(i1,i3,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i4).d(iut,jut))/((p512q-rmb2) & *p512k0) ENDDO ENDDO END DO END DO END DO ENDIF IF((imix.EQ.1.AND.(icch.EQ.3.OR.(icch.EQ.1.AND.iha.EQ.1). & OR.(icch.EQ.1.AND.isusy.EQ.1.AND.iha.EQ.2))).OR. & imix.EQ.-2)THEN * Vertice b b~ H ( quarks massivi ) * TH -- qu=p5,qd=p536,a=v5_36h.a,b=v5_36h.b,c=v5_36h.c v5_36h.a(1,2)=-p5k0*p536(2)+p536k0*p5(2)-cim*(p536(3)*p5k0 & -p5(3)*p536k0) v5_36h.a(2,1)=-conjg(v5_36h.a(1,2)) v5_36h.b(1,1)=p536k0 v5_36h.b(2,2)=v5_36h.b(1,1) v5_36h.c(1,1)=p5k0 v5_36h.c(2,2)=v5_36h.c(1,1) DO i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v5_36h * .a,b1=v5_36h.b,c1=v5_36h.c,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1 * ).c,d2=r4_12fz(i1).d,prq=p536q,m=rmb dia1(i1).a(2,1)=v5_36h.a(2,1)*r4_12fz(i1).a(1,1)+v5_36h.c( & 2,2)*p536q*r4_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v5_36h.b(2,2)*r4_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v5_36h.a(2,1)*r4_12fz(i1).d(1,1)+v5_3 & 6h.c(2,2)*r4_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v5_36h.b(2,2)*r4_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v5_36h.a(2,1)*r4_12fz(i1).b(1,2)+v5_3 & 6h.c(2,2)*r4_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v5_36h.b(2,2)*r4_12fz(i1).a(2,2) dia1(i1).c(2,2)=v5_36h.a(2,1)*r4_12fz(i1).c(1,2)+v5_36h.c( & 2,2)*p536q*r4_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v5_36h.b(2,2)*r4_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v5_36h.c(1,1)*r4_12fz(i1).a(1,1)+v5_3 & 6h.a(1,2)*r4_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v5_36h.b(1,1)*r4_12fz(i1).a(1,1) dia1(i1).c(1,1)=v5_36h.c(1,1)*p536q*r4_12fz(i1).d(1,1)+v5_ & 36h.a(1,2)*r4_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v5_36h.b(1,1)*r4_12fz(i1).d(1,1) dia1(i1).a(1,2)=v5_36h.c(1,1)*p536q*r4_12fz(i1).b(1,2)+v5_ & 36h.a(1,2)*r4_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v5_36h.b(1,1)*r4_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v5_36h.c(1,1)*r4_12fz(i1).c(1,2)+v5_3 & 6h.a(1,2)*r4_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v5_36h.b(1,1)*r4_12fz(i1).c(1,2) END DO * Diagramma ( 19+22 ) DO i1=1,2 * mline -- res=cresp1(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p536q-rmb * 2)*p536k0) DO iut=1,2 DO jut=1,2 cresp1(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p536q-rmb2)*p536k0) ENDDO ENDDO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres17(i1,i3,i4,i5,i6)=rhbb*cresp1(i1,i5,i4)*c36h(i3, & i6) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * TH -- qu=p3,qd=p356,a=v3_56h.a,b=v3_56h.b,c=v3_56h.c v3_56h.a(1,2)=-p3k0*p356(2)+p356k0*p3(2)-cim*(p356(3)*p3k0 & -p3(3)*p356k0) v3_56h.a(2,1)=-conjg(v3_56h.a(1,2)) v3_56h.b(1,1)=p356k0 v3_56h.b(2,2)=v3_56h.b(1,1) v3_56h.c(1,1)=p3k0 v3_56h.c(2,2)=v3_56h.c(1,1) DO i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v3_56h * .a,b1=v3_56h.b,c1=v3_56h.c,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1 * ).c,d2=r4_12fz(i1).d,prq=p356q,m=rmb dia1(i1).a(2,1)=v3_56h.a(2,1)*r4_12fz(i1).a(1,1)+v3_56h.c( & 2,2)*p356q*r4_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v3_56h.b(2,2)*r4_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v3_56h.a(2,1)*r4_12fz(i1).d(1,1)+v3_5 & 6h.c(2,2)*r4_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v3_56h.b(2,2)*r4_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v3_56h.a(2,1)*r4_12fz(i1).b(1,2)+v3_5 & 6h.c(2,2)*r4_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v3_56h.b(2,2)*r4_12fz(i1).a(2,2) dia1(i1).c(2,2)=v3_56h.a(2,1)*r4_12fz(i1).c(1,2)+v3_56h.c( & 2,2)*p356q*r4_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v3_56h.b(2,2)*r4_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v3_56h.c(1,1)*r4_12fz(i1).a(1,1)+v3_5 & 6h.a(1,2)*r4_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v3_56h.b(1,1)*r4_12fz(i1).a(1,1) dia1(i1).c(1,1)=v3_56h.c(1,1)*p356q*r4_12fz(i1).d(1,1)+v3_ & 56h.a(1,2)*r4_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v3_56h.b(1,1)*r4_12fz(i1).d(1,1) dia1(i1).a(1,2)=v3_56h.c(1,1)*p356q*r4_12fz(i1).b(1,2)+v3_ & 56h.a(1,2)*r4_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v3_56h.b(1,1)*r4_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v3_56h.c(1,1)*r4_12fz(i1).c(1,2)+v3_5 & 6h.a(1,2)*r4_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v3_56h.b(1,1)*r4_12fz(i1).c(1,2) END DO * Diagramma ( 25+28 ) DO i1=1,2 * mline -- res=cresp2(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p356q-rmb * 2)*p356k0) DO iut=1,2 DO jut=1,2 cresp2(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p356q-rmb2)*p356k0) ENDDO ENDDO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres18(i1,i3,i4,i5,i6)=rhbb*cresp2(i1,i3,i4)*c56h(i5, & i6) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * TH -- qu=p3,qd=p354,a=v3_54h.a,b=v3_54h.b,c=v3_54h.c v3_54h.a(1,2)=-p3k0*p354(2)+p354k0*p3(2)-cim*(p354(3)*p3k0 & -p3(3)*p354k0) v3_54h.a(2,1)=-conjg(v3_54h.a(1,2)) v3_54h.b(1,1)=p354k0 v3_54h.b(2,2)=v3_54h.b(1,1) v3_54h.c(1,1)=p3k0 v3_54h.c(2,2)=v3_54h.c(1,1) DO i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v3_54h * .a,b1=v3_54h.b,c1=v3_54h.c,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1 * ).c,d2=r6_12fz(i1).d,prq=p354q,m=rmb dia1(i1).a(2,1)=v3_54h.a(2,1)*r6_12fz(i1).a(1,1)+v3_54h.c( & 2,2)*p354q*r6_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v3_54h.b(2,2)*r6_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v3_54h.a(2,1)*r6_12fz(i1).d(1,1)+v3_5 & 4h.c(2,2)*r6_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v3_54h.b(2,2)*r6_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v3_54h.a(2,1)*r6_12fz(i1).b(1,2)+v3_5 & 4h.c(2,2)*r6_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v3_54h.b(2,2)*r6_12fz(i1).a(2,2) dia1(i1).c(2,2)=v3_54h.a(2,1)*r6_12fz(i1).c(1,2)+v3_54h.c( & 2,2)*p354q*r6_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v3_54h.b(2,2)*r6_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v3_54h.c(1,1)*r6_12fz(i1).a(1,1)+v3_5 & 4h.a(1,2)*r6_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v3_54h.b(1,1)*r6_12fz(i1).a(1,1) dia1(i1).c(1,1)=v3_54h.c(1,1)*p354q*r6_12fz(i1).d(1,1)+v3_ & 54h.a(1,2)*r6_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v3_54h.b(1,1)*r6_12fz(i1).d(1,1) dia1(i1).a(1,2)=v3_54h.c(1,1)*p354q*r6_12fz(i1).b(1,2)+v3_ & 54h.a(1,2)*r6_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v3_54h.b(1,1)*r6_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v3_54h.c(1,1)*r6_12fz(i1).c(1,2)+v3_5 & 4h.a(1,2)*r6_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v3_54h.b(1,1)*r6_12fz(i1).c(1,2) END DO * Diagramma ( 39+42 ) DO i1=1,2 * mline -- res=cresp3(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p354q-rmb * 2)*p354k0) DO iut=1,2 DO jut=1,2 cresp3(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p354q-rmb2)*p354k0) ENDDO ENDDO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres19(i1,i3,i4,i5,i6)=rhbb*cresp3(i1,i3,i6)*c54h(i5, & i4) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * TH -- qu=p5,qd=p534,a=v5_34h.a,b=v5_34h.b,c=v5_34h.c v5_34h.a(1,2)=-p5k0*p534(2)+p534k0*p5(2)-cim*(p534(3)*p5k0 & -p5(3)*p534k0) v5_34h.a(2,1)=-conjg(v5_34h.a(1,2)) v5_34h.b(1,1)=p534k0 v5_34h.b(2,2)=v5_34h.b(1,1) v5_34h.c(1,1)=p5k0 v5_34h.c(2,2)=v5_34h.c(1,1) DO i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v5_34h * .a,b1=v5_34h.b,c1=v5_34h.c,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1 * ).c,d2=r6_12fz(i1).d,prq=p534q,m=rmb dia1(i1).a(2,1)=v5_34h.a(2,1)*r6_12fz(i1).a(1,1)+v5_34h.c( & 2,2)*p534q*r6_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v5_34h.b(2,2)*r6_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v5_34h.a(2,1)*r6_12fz(i1).d(1,1)+v5_3 & 4h.c(2,2)*r6_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v5_34h.b(2,2)*r6_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v5_34h.a(2,1)*r6_12fz(i1).b(1,2)+v5_3 & 4h.c(2,2)*r6_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v5_34h.b(2,2)*r6_12fz(i1).a(2,2) dia1(i1).c(2,2)=v5_34h.a(2,1)*r6_12fz(i1).c(1,2)+v5_34h.c( & 2,2)*p534q*r6_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v5_34h.b(2,2)*r6_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v5_34h.c(1,1)*r6_12fz(i1).a(1,1)+v5_3 & 4h.a(1,2)*r6_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v5_34h.b(1,1)*r6_12fz(i1).a(1,1) dia1(i1).c(1,1)=v5_34h.c(1,1)*p534q*r6_12fz(i1).d(1,1)+v5_ & 34h.a(1,2)*r6_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v5_34h.b(1,1)*r6_12fz(i1).d(1,1) dia1(i1).a(1,2)=v5_34h.c(1,1)*p534q*r6_12fz(i1).b(1,2)+v5_ & 34h.a(1,2)*r6_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v5_34h.b(1,1)*r6_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v5_34h.c(1,1)*r6_12fz(i1).c(1,2)+v5_3 & 4h.a(1,2)*r6_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v5_34h.b(1,1)*r6_12fz(i1).c(1,2) END DO * Diagramma ( 65+68 ) DO i1=1,2 * mline -- res=cresp4(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p534q-rmb * 2)*p534k0) DO iut=1,2 DO jut=1,2 cresp4(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p534q-rmb2)*p534k0) ENDDO ENDDO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres20(i1,i3,i4,i5,i6)=rhbb*cresp4(i1,i5,i6)*c34h(i3, & i4) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * TH -- qu=p312,qd=p4,a=v4_56h.a,b=v4_56h.b,c=v4_56h.c v4_56h.a(1,2)=-p312k0*p4(2)+p4k0*p312(2)-cim*(p4(3)*p312k0 & -p312(3)*p4k0) v4_56h.a(2,1)=-conjg(v4_56h.a(1,2)) v4_56h.b(1,1)=p4k0 v4_56h.b(2,2)=v4_56h.b(1,1) v4_56h.c(1,1)=p312k0 v4_56h.c(2,2)=v4_56h.c(1,1) DO i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l3_12f * z(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1).d,a2=v4_56h.a,b2= * v4_56h.b,c2=v4_56h.c,prq=p312q,m=rmb dia1(i1).a(1,2)=l3_12fz(i1).a(1,1)*v4_56h.a(1,2)+l3_12fz(i & 1).c(1,2)*p312q*v4_56h.b(2,2) dia1(i1).b(1,2)=rmb*(l3_12fz(i1).d(1,1)*v4_56h.a(1,2)+l3_1 & 2fz(i1).b(1,2)*v4_56h.b(2,2)) dia1(i1).c(1,2)=rmb*l3_12fz(i1).c(1,2)*v4_56h.c(2,2) dia1(i1).d(1,2)=l3_12fz(i1).b(1,2)*v4_56h.c(2,2) dia1(i1).a(1,1)=rmb*(l3_12fz(i1).a(1,1)*v4_56h.b(1,1)+l3_1 & 2fz(i1).c(1,2)*v4_56h.a(2,1)) dia1(i1).b(1,1)=l3_12fz(i1).d(1,1)*p312q*v4_56h.b(1,1)+l3_ & 12fz(i1).b(1,2)*v4_56h.a(2,1) dia1(i1).c(1,1)=l3_12fz(i1).a(1,1)*v4_56h.c(1,1) dia1(i1).d(1,1)=rmb*l3_12fz(i1).d(1,1)*v4_56h.c(1,1) dia1(i1).a(2,2)=rmb*(l3_12fz(i1).c(2,1)*v4_56h.a(1,2)+l3_1 & 2fz(i1).a(2,2)*v4_56h.b(2,2)) dia1(i1).b(2,2)=l3_12fz(i1).b(2,1)*v4_56h.a(1,2)+l3_12fz(i & 1).d(2,2)*p312q*v4_56h.b(2,2) dia1(i1).c(2,2)=l3_12fz(i1).a(2,2)*v4_56h.c(2,2) dia1(i1).d(2,2)=rmb*l3_12fz(i1).d(2,2)*v4_56h.c(2,2) dia1(i1).a(2,1)=l3_12fz(i1).c(2,1)*p312q*v4_56h.b(1,1)+l3_ & 12fz(i1).a(2,2)*v4_56h.a(2,1) dia1(i1).b(2,1)=rmb*(l3_12fz(i1).b(2,1)*v4_56h.b(1,1)+l3_1 & 2fz(i1).d(2,2)*v4_56h.a(2,1)) dia1(i1).c(2,1)=rmb*l3_12fz(i1).c(2,1)*v4_56h.c(1,1) dia1(i1).d(2,1)=l3_12fz(i1).b(2,1)*v4_56h.c(1,1) END DO * Diagramma ( 33+36 ) DO i1=1,2 * mline -- res=cresp5(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p312q-rmb * 2)*p312k0) DO iut=1,2 DO jut=1,2 cresp5(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p312q-rmb2)*p312k0) ENDDO ENDDO END DO * TH -- qu=p312,qd=p6,a=v6_54h.a,b=v6_54h.b,c=v6_54h.c v6_54h.a(1,2)=-p312k0*p6(2)+p6k0*p312(2)-cim*(p6(3)*p312k0 & -p312(3)*p6k0) v6_54h.a(2,1)=-conjg(v6_54h.a(1,2)) v6_54h.b(1,1)=p6k0 v6_54h.b(2,2)=v6_54h.b(1,1) v6_54h.c(1,1)=p312k0 v6_54h.c(2,2)=v6_54h.c(1,1) DO i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l3_12f * z(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1).d,a2=v6_54h.a,b2= * v6_54h.b,c2=v6_54h.c,prq=p312q,m=rmb dia1(i1).a(1,2)=l3_12fz(i1).a(1,1)*v6_54h.a(1,2)+l3_12fz(i & 1).c(1,2)*p312q*v6_54h.b(2,2) dia1(i1).b(1,2)=rmb*(l3_12fz(i1).d(1,1)*v6_54h.a(1,2)+l3_1 & 2fz(i1).b(1,2)*v6_54h.b(2,2)) dia1(i1).c(1,2)=rmb*l3_12fz(i1).c(1,2)*v6_54h.c(2,2) dia1(i1).d(1,2)=l3_12fz(i1).b(1,2)*v6_54h.c(2,2) dia1(i1).a(1,1)=rmb*(l3_12fz(i1).a(1,1)*v6_54h.b(1,1)+l3_1 & 2fz(i1).c(1,2)*v6_54h.a(2,1)) dia1(i1).b(1,1)=l3_12fz(i1).d(1,1)*p312q*v6_54h.b(1,1)+l3_ & 12fz(i1).b(1,2)*v6_54h.a(2,1) dia1(i1).c(1,1)=l3_12fz(i1).a(1,1)*v6_54h.c(1,1) dia1(i1).d(1,1)=rmb*l3_12fz(i1).d(1,1)*v6_54h.c(1,1) dia1(i1).a(2,2)=rmb*(l3_12fz(i1).c(2,1)*v6_54h.a(1,2)+l3_1 & 2fz(i1).a(2,2)*v6_54h.b(2,2)) dia1(i1).b(2,2)=l3_12fz(i1).b(2,1)*v6_54h.a(1,2)+l3_12fz(i & 1).d(2,2)*p312q*v6_54h.b(2,2) dia1(i1).c(2,2)=l3_12fz(i1).a(2,2)*v6_54h.c(2,2) dia1(i1).d(2,2)=rmb*l3_12fz(i1).d(2,2)*v6_54h.c(2,2) dia1(i1).a(2,1)=l3_12fz(i1).c(2,1)*p312q*v6_54h.b(1,1)+l3_ & 12fz(i1).a(2,2)*v6_54h.a(2,1) dia1(i1).b(2,1)=rmb*(l3_12fz(i1).b(2,1)*v6_54h.b(1,1)+l3_1 & 2fz(i1).d(2,2)*v6_54h.a(2,1)) dia1(i1).c(2,1)=rmb*l3_12fz(i1).c(2,1)*v6_54h.c(1,1) dia1(i1).d(2,1)=l3_12fz(i1).b(2,1)*v6_54h.c(1,1) END DO * Diagramma ( 45+48 ) DO i1=1,2 * mline -- res=cresp6(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p312q-rmb * 2)*p312k0) DO iut=1,2 DO jut=1,2 cresp6(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p312q-rmb2)*p312k0) ENDDO ENDDO END DO * TH -- qu=p512,qd=p4,a=v4_36h.a,b=v4_36h.b,c=v4_36h.c v4_36h.a(1,2)=-p512k0*p4(2)+p4k0*p512(2)-cim*(p4(3)*p512k0 & -p512(3)*p4k0) v4_36h.a(2,1)=-conjg(v4_36h.a(1,2)) v4_36h.b(1,1)=p4k0 v4_36h.b(2,2)=v4_36h.b(1,1) v4_36h.c(1,1)=p512k0 v4_36h.c(2,2)=v4_36h.c(1,1) DO i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l5_12f * z(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1).d,a2=v4_36h.a,b2= * v4_36h.b,c2=v4_36h.c,prq=p512q,m=rmb dia1(i1).a(1,2)=l5_12fz(i1).a(1,1)*v4_36h.a(1,2)+l5_12fz(i & 1).c(1,2)*p512q*v4_36h.b(2,2) dia1(i1).b(1,2)=rmb*(l5_12fz(i1).d(1,1)*v4_36h.a(1,2)+l5_1 & 2fz(i1).b(1,2)*v4_36h.b(2,2)) dia1(i1).c(1,2)=rmb*l5_12fz(i1).c(1,2)*v4_36h.c(2,2) dia1(i1).d(1,2)=l5_12fz(i1).b(1,2)*v4_36h.c(2,2) dia1(i1).a(1,1)=rmb*(l5_12fz(i1).a(1,1)*v4_36h.b(1,1)+l5_1 & 2fz(i1).c(1,2)*v4_36h.a(2,1)) dia1(i1).b(1,1)=l5_12fz(i1).d(1,1)*p512q*v4_36h.b(1,1)+l5_ & 12fz(i1).b(1,2)*v4_36h.a(2,1) dia1(i1).c(1,1)=l5_12fz(i1).a(1,1)*v4_36h.c(1,1) dia1(i1).d(1,1)=rmb*l5_12fz(i1).d(1,1)*v4_36h.c(1,1) dia1(i1).a(2,2)=rmb*(l5_12fz(i1).c(2,1)*v4_36h.a(1,2)+l5_1 & 2fz(i1).a(2,2)*v4_36h.b(2,2)) dia1(i1).b(2,2)=l5_12fz(i1).b(2,1)*v4_36h.a(1,2)+l5_12fz(i & 1).d(2,2)*p512q*v4_36h.b(2,2) dia1(i1).c(2,2)=l5_12fz(i1).a(2,2)*v4_36h.c(2,2) dia1(i1).d(2,2)=rmb*l5_12fz(i1).d(2,2)*v4_36h.c(2,2) dia1(i1).a(2,1)=l5_12fz(i1).c(2,1)*p512q*v4_36h.b(1,1)+l5_ & 12fz(i1).a(2,2)*v4_36h.a(2,1) dia1(i1).b(2,1)=rmb*(l5_12fz(i1).b(2,1)*v4_36h.b(1,1)+l5_1 & 2fz(i1).d(2,2)*v4_36h.a(2,1)) dia1(i1).c(2,1)=rmb*l5_12fz(i1).c(2,1)*v4_36h.c(1,1) dia1(i1).d(2,1)=l5_12fz(i1).b(2,1)*v4_36h.c(1,1) END DO * Diagramma ( 51+54 ) DO i1=1,2 * mline -- res=cresp7(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p512q-rmb * 2)*p512k0) DO iut=1,2 DO jut=1,2 cresp7(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p512q-rmb2)*p512k0) ENDDO ENDDO END DO * TH -- qu=p512,qd=p6,a=v6_34h.a,b=v6_34h.b,c=v6_34h.c v6_34h.a(1,2)=-p512k0*p6(2)+p6k0*p512(2)-cim*(p6(3)*p512k0 & -p512(3)*p6k0) v6_34h.a(2,1)=-conjg(v6_34h.a(1,2)) v6_34h.b(1,1)=p6k0 v6_34h.b(2,2)=v6_34h.b(1,1) v6_34h.c(1,1)=p512k0 v6_34h.c(2,2)=v6_34h.c(1,1) DO i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l5_12f * z(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1).d,a2=v6_34h.a,b2= * v6_34h.b,c2=v6_34h.c,prq=p512q,m=rmb dia1(i1).a(1,2)=l5_12fz(i1).a(1,1)*v6_34h.a(1,2)+l5_12fz(i & 1).c(1,2)*p512q*v6_34h.b(2,2) dia1(i1).b(1,2)=rmb*(l5_12fz(i1).d(1,1)*v6_34h.a(1,2)+l5_1 & 2fz(i1).b(1,2)*v6_34h.b(2,2)) dia1(i1).c(1,2)=rmb*l5_12fz(i1).c(1,2)*v6_34h.c(2,2) dia1(i1).d(1,2)=l5_12fz(i1).b(1,2)*v6_34h.c(2,2) dia1(i1).a(1,1)=rmb*(l5_12fz(i1).a(1,1)*v6_34h.b(1,1)+l5_1 & 2fz(i1).c(1,2)*v6_34h.a(2,1)) dia1(i1).b(1,1)=l5_12fz(i1).d(1,1)*p512q*v6_34h.b(1,1)+l5_ & 12fz(i1).b(1,2)*v6_34h.a(2,1) dia1(i1).c(1,1)=l5_12fz(i1).a(1,1)*v6_34h.c(1,1) dia1(i1).d(1,1)=rmb*l5_12fz(i1).d(1,1)*v6_34h.c(1,1) dia1(i1).a(2,2)=rmb*(l5_12fz(i1).c(2,1)*v6_34h.a(1,2)+l5_1 & 2fz(i1).a(2,2)*v6_34h.b(2,2)) dia1(i1).b(2,2)=l5_12fz(i1).b(2,1)*v6_34h.a(1,2)+l5_12fz(i & 1).d(2,2)*p512q*v6_34h.b(2,2) dia1(i1).c(2,2)=l5_12fz(i1).a(2,2)*v6_34h.c(2,2) dia1(i1).d(2,2)=rmb*l5_12fz(i1).d(2,2)*v6_34h.c(2,2) dia1(i1).a(2,1)=l5_12fz(i1).c(2,1)*p512q*v6_34h.b(1,1)+l5_ & 12fz(i1).a(2,2)*v6_34h.a(2,1) dia1(i1).b(2,1)=rmb*(l5_12fz(i1).b(2,1)*v6_34h.b(1,1)+l5_1 & 2fz(i1).d(2,2)*v6_34h.a(2,1)) dia1(i1).c(2,1)=rmb*l5_12fz(i1).c(2,1)*v6_34h.c(1,1) dia1(i1).d(2,1)=l5_12fz(i1).b(2,1)*v6_34h.c(1,1) END DO * Diagramma ( 59+62 ) DO i1=1,2 * mline -- res=cresp8(i1,&),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p512q-rmb * 2)*p512k0) DO iut=1,2 DO jut=1,2 cresp8(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1). & d(iu & t,jut))/((p512q-rmb2)*p512k0) ENDDO ENDDO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres21(i1,i3,i4,i5,i6)=rhbb*cresp5(i1,i3,i4)*c56h(i5, & i6) cres22(i1,i3,i4,i5,i6)=rhbb*cresp6(i1,i3,i6)*c54h(i5, & i4) cres23(i1,i3,i4,i5,i6)=rhbb*cresp7(i1,i5,i4)*c36h(i3, & i6) cres24(i1,i3,i4,i5,i6)=rhbb*cresp8(i1,i5,i6)*c34h(i3, & i4) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 ENDIF IF((imix.EQ.1.AND.isusy.EQ.1.AND.(icch.EQ.3.OR.(icch.EQ.1.AND. & (iha.EQ.1.OR.iha.EQ.3)))).OR.(imix.EQ.-2.AND.isusy.EQ.1))THEN * inizio codice phact single_A.ph * TSC -- qu=p5,qd=p536,a=v5_36a.a,b=v5_36a.b,c=v5_36a.c,cr=1.d0,cl=-1.d0 auxa=-p5k0*p536(2)+p536k0*p5(2) cauxa=-cim*(p536(3)*p5k0-p5(3)*p536k0) v5_36a.a(1,2)=-1.d0*(auxa+cauxa) v5_36a.a(2,1)=(-auxa+cauxa) v5_36a.b(1,1)=p536k0 v5_36a.b(2,2)=-1.d0*p536k0 v5_36a.c(1,1)=-1.d0*p5k0 v5_36a.c(2,2)=p5k0 do i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v5_36a * .a,b1=v5_36a.b,c1=v5_36a.c,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1 * ).c,d2=r4_12fz(i1).d,prq=p536q,m=rmb,nsum=0 dia1(i1).a(2,1)=v5_36a.a(2,1)*r4_12fz(i1).a(1,1)+v5_36a.c( & 2,2)*p536q*r4_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v5_36a.b(2,2)*r4_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v5_36a.a(2,1)*r4_12fz(i1).d(1,1)+v5_3 & 6a.c(2,2)*r4_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v5_36a.b(2,2)*r4_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v5_36a.a(2,1)*r4_12fz(i1).b(1,2)+v5_3 & 6a.c(2,2)*r4_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v5_36a.b(2,2)*r4_12fz(i1).a(2,2) dia1(i1).c(2,2)=v5_36a.a(2,1)*r4_12fz(i1).c(1,2)+v5_36a.c( & 2,2)*p536q*r4_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v5_36a.b(2,2)*r4_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v5_36a.c(1,1)*r4_12fz(i1).a(1,1)+v5_3 & 6a.a(1,2)*r4_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v5_36a.b(1,1)*r4_12fz(i1).a(1,1) dia1(i1).c(1,1)=v5_36a.c(1,1)*p536q*r4_12fz(i1).d(1,1)+v5_ & 36a.a(1,2)*r4_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v5_36a.b(1,1)*r4_12fz(i1).d(1,1) dia1(i1).a(1,2)=v5_36a.c(1,1)*p536q*r4_12fz(i1).b(1,2)+v5_ & 36a.a(1,2)*r4_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v5_36a.b(1,1)*r4_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v5_36a.c(1,1)*r4_12fz(i1).c(1,2)+v5_3 & 6a.a(1,2)*r4_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v5_36a.b(1,1)*r4_12fz(i1).c(1,2) end do do i1=1,2 * mline -- res=cresp9(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p536q * -rmb2)*p536k0),nsum=0 do iut=1,2 do jut=1,2 cresp9(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iut & ,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(iu & t,jut))/((p536q-rmb2)*p536k0) enddo enddo end do * TSC -- qu=p3,qd=p356,a=v3_56a.a,b=v3_56a.b,c=v3_56a.c,cr=1.d0,cl=-1.d0 auxa=-p3k0*p356(2)+p356k0*p3(2) cauxa=-cim*(p356(3)*p3k0-p3(3)*p356k0) v3_56a.a(1,2)=-1.d0*(auxa+cauxa) v3_56a.a(2,1)=(-auxa+cauxa) v3_56a.b(1,1)=p356k0 v3_56a.b(2,2)=-1.d0*p356k0 v3_56a.c(1,1)=-1.d0*p3k0 v3_56a.c(2,2)=p3k0 do i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v3_56a * .a,b1=v3_56a.b,c1=v3_56a.c,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1 * ).c,d2=r4_12fz(i1).d,prq=p356q,m=rmb,nsum=0 dia1(i1).a(2,1)=v3_56a.a(2,1)*r4_12fz(i1).a(1,1)+v3_56a.c( & 2,2)*p356q*r4_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v3_56a.b(2,2)*r4_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v3_56a.a(2,1)*r4_12fz(i1).d(1,1)+v3_5 & 6a.c(2,2)*r4_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v3_56a.b(2,2)*r4_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v3_56a.a(2,1)*r4_12fz(i1).b(1,2)+v3_5 & 6a.c(2,2)*r4_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v3_56a.b(2,2)*r4_12fz(i1).a(2,2) dia1(i1).c(2,2)=v3_56a.a(2,1)*r4_12fz(i1).c(1,2)+v3_56a.c( & 2,2)*p356q*r4_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v3_56a.b(2,2)*r4_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v3_56a.c(1,1)*r4_12fz(i1).a(1,1)+v3_5 & 6a.a(1,2)*r4_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v3_56a.b(1,1)*r4_12fz(i1).a(1,1) dia1(i1).c(1,1)=v3_56a.c(1,1)*p356q*r4_12fz(i1).d(1,1)+v3_ & 56a.a(1,2)*r4_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v3_56a.b(1,1)*r4_12fz(i1).d(1,1) dia1(i1).a(1,2)=v3_56a.c(1,1)*p356q*r4_12fz(i1).b(1,2)+v3_ & 56a.a(1,2)*r4_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v3_56a.b(1,1)*r4_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v3_56a.c(1,1)*r4_12fz(i1).c(1,2)+v3_5 & 6a.a(1,2)*r4_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v3_56a.b(1,1)*r4_12fz(i1).c(1,2) end do do i1=1,2 * mline -- res=cresp10(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p356 * q-rmb2)*p356k0),nsum=0 do iut=1,2 do jut=1,2 cresp10(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p356q-rmb2)*p356k0) enddo enddo end do * TSC -- qu=p3,qd=p354,a=v3_54a.a,b=v3_54a.b,c=v3_54a.c,cr=1.d0,cl=-1.d0 auxa=-p3k0*p354(2)+p354k0*p3(2) cauxa=-cim*(p354(3)*p3k0-p3(3)*p354k0) v3_54a.a(1,2)=-1.d0*(auxa+cauxa) v3_54a.a(2,1)=(-auxa+cauxa) v3_54a.b(1,1)=p354k0 v3_54a.b(2,2)=-1.d0*p354k0 v3_54a.c(1,1)=-1.d0*p3k0 v3_54a.c(2,2)=p3k0 do i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v3_54a * .a,b1=v3_54a.b,c1=v3_54a.c,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1 * ).c,d2=r6_12fz(i1).d,prq=p354q,m=rmb,nsum=0 dia1(i1).a(2,1)=v3_54a.a(2,1)*r6_12fz(i1).a(1,1)+v3_54a.c( & 2,2)*p354q*r6_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v3_54a.b(2,2)*r6_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v3_54a.a(2,1)*r6_12fz(i1).d(1,1)+v3_5 & 4a.c(2,2)*r6_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v3_54a.b(2,2)*r6_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v3_54a.a(2,1)*r6_12fz(i1).b(1,2)+v3_5 & 4a.c(2,2)*r6_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v3_54a.b(2,2)*r6_12fz(i1).a(2,2) dia1(i1).c(2,2)=v3_54a.a(2,1)*r6_12fz(i1).c(1,2)+v3_54a.c( & 2,2)*p354q*r6_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v3_54a.b(2,2)*r6_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v3_54a.c(1,1)*r6_12fz(i1).a(1,1)+v3_5 & 4a.a(1,2)*r6_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v3_54a.b(1,1)*r6_12fz(i1).a(1,1) dia1(i1).c(1,1)=v3_54a.c(1,1)*p354q*r6_12fz(i1).d(1,1)+v3_ & 54a.a(1,2)*r6_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v3_54a.b(1,1)*r6_12fz(i1).d(1,1) dia1(i1).a(1,2)=v3_54a.c(1,1)*p354q*r6_12fz(i1).b(1,2)+v3_ & 54a.a(1,2)*r6_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v3_54a.b(1,1)*r6_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v3_54a.c(1,1)*r6_12fz(i1).c(1,2)+v3_5 & 4a.a(1,2)*r6_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v3_54a.b(1,1)*r6_12fz(i1).c(1,2) end do do i1=1,2 * mline -- res=cresp11(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p354 * q-rmb2)*p354k0),nsum=0 do iut=1,2 do jut=1,2 cresp11(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p354q-rmb2)*p354k0) enddo enddo end do * TSC -- qu=p5,qd=p534,a=v5_34a.a,b=v5_34a.b,c=v5_34a.c,cr=1.d0,cl=-1.d0 auxa=-p5k0*p534(2)+p534k0*p5(2) cauxa=-cim*(p534(3)*p5k0-p5(3)*p534k0) v5_34a.a(1,2)=-1.d0*(auxa+cauxa) v5_34a.a(2,1)=(-auxa+cauxa) v5_34a.b(1,1)=p534k0 v5_34a.b(2,2)=-1.d0*p534k0 v5_34a.c(1,1)=-1.d0*p5k0 v5_34a.c(2,2)=p5k0 do i1=1,2 * TSCT -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=v5_34a * .a,b1=v5_34a.b,c1=v5_34a.c,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1 * ).c,d2=r6_12fz(i1).d,prq=p534q,m=rmb,nsum=0 dia1(i1).a(2,1)=v5_34a.a(2,1)*r6_12fz(i1).a(1,1)+v5_34a.c( & 2,2)*p534q*r6_12fz(i1).b(2,1) dia1(i1).b(2,1)=rmb*v5_34a.b(2,2)*r6_12fz(i1).b(2,1) dia1(i1).c(2,1)=rmb*(v5_34a.a(2,1)*r6_12fz(i1).d(1,1)+v5_3 & 4a.c(2,2)*r6_12fz(i1).c(2,1)) dia1(i1).d(2,1)=v5_34a.b(2,2)*r6_12fz(i1).c(2,1) dia1(i1).a(2,2)=rmb*(v5_34a.a(2,1)*r6_12fz(i1).b(1,2)+v5_3 & 4a.c(2,2)*r6_12fz(i1).a(2,2)) dia1(i1).b(2,2)=v5_34a.b(2,2)*r6_12fz(i1).a(2,2) dia1(i1).c(2,2)=v5_34a.a(2,1)*r6_12fz(i1).c(1,2)+v5_34a.c( & 2,2)*p534q*r6_12fz(i1).d(2,2) dia1(i1).d(2,2)=rmb*v5_34a.b(2,2)*r6_12fz(i1).d(2,2) dia1(i1).a(1,1)=rmb*(v5_34a.c(1,1)*r6_12fz(i1).a(1,1)+v5_3 & 4a.a(1,2)*r6_12fz(i1).b(2,1)) dia1(i1).b(1,1)=v5_34a.b(1,1)*r6_12fz(i1).a(1,1) dia1(i1).c(1,1)=v5_34a.c(1,1)*p534q*r6_12fz(i1).d(1,1)+v5_ & 34a.a(1,2)*r6_12fz(i1).c(2,1) dia1(i1).d(1,1)=rmb*v5_34a.b(1,1)*r6_12fz(i1).d(1,1) dia1(i1).a(1,2)=v5_34a.c(1,1)*p534q*r6_12fz(i1).b(1,2)+v5_ & 34a.a(1,2)*r6_12fz(i1).a(2,2) dia1(i1).b(1,2)=rmb*v5_34a.b(1,1)*r6_12fz(i1).b(1,2) dia1(i1).c(1,2)=rmb*(v5_34a.c(1,1)*r6_12fz(i1).c(1,2)+v5_3 & 4a.a(1,2)*r6_12fz(i1).d(2,2)) dia1(i1).d(1,2)=v5_34a.b(1,1)*r6_12fz(i1).c(1,2) end do do i1=1,2 * mline -- res=cresp12(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p534 * q-rmb2)*p534k0),nsum=0 do iut=1,2 do jut=1,2 cresp12(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p534q-rmb2)*p534k0) enddo enddo end do * TSC -- qu=p4,qd=p312,a=v4_56a.a,b=v4_56a.b,c=v4_56a.c,cr=1.d0,cl=-1.d0 auxa=-p4k0*p312(2)+p312k0*p4(2) cauxa=-cim*(p312(3)*p4k0-p4(3)*p312k0) v4_56a.a(1,2)=-1.d0*(auxa+cauxa) v4_56a.a(2,1)=(-auxa+cauxa) v4_56a.b(1,1)=p312k0 v4_56a.b(2,2)=-1.d0*p312k0 v4_56a.c(1,1)=-1.d0*p4k0 v4_56a.c(2,2)=p4k0 do i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l3_12f * z(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1).d,a2=v4_56a.a,b2= * v4_56a.b,c2=v4_56a.c,prq=p312q,m=rmb,nsum=0 dia1(i1).a(1,2)=l3_12fz(i1).a(1,1)*v4_56a.a(1,2)+l3_12fz(i & 1).c(1,2)*p312q*v4_56a.b(2,2) dia1(i1).b(1,2)=rmb*(l3_12fz(i1).d(1,1)*v4_56a.a(1,2)+l3_1 & 2fz(i1).b(1,2)*v4_56a.b(2,2)) dia1(i1).c(1,2)=rmb*l3_12fz(i1).c(1,2)*v4_56a.c(2,2) dia1(i1).d(1,2)=l3_12fz(i1).b(1,2)*v4_56a.c(2,2) dia1(i1).a(1,1)=rmb*(l3_12fz(i1).a(1,1)*v4_56a.b(1,1)+l3_1 & 2fz(i1).c(1,2)*v4_56a.a(2,1)) dia1(i1).b(1,1)=l3_12fz(i1).d(1,1)*p312q*v4_56a.b(1,1)+l3_ & 12fz(i1).b(1,2)*v4_56a.a(2,1) dia1(i1).c(1,1)=l3_12fz(i1).a(1,1)*v4_56a.c(1,1) dia1(i1).d(1,1)=rmb*l3_12fz(i1).d(1,1)*v4_56a.c(1,1) dia1(i1).a(2,2)=rmb*(l3_12fz(i1).c(2,1)*v4_56a.a(1,2)+l3_1 & 2fz(i1).a(2,2)*v4_56a.b(2,2)) dia1(i1).b(2,2)=l3_12fz(i1).b(2,1)*v4_56a.a(1,2)+l3_12fz(i & 1).d(2,2)*p312q*v4_56a.b(2,2) dia1(i1).c(2,2)=l3_12fz(i1).a(2,2)*v4_56a.c(2,2) dia1(i1).d(2,2)=rmb*l3_12fz(i1).d(2,2)*v4_56a.c(2,2) dia1(i1).a(2,1)=l3_12fz(i1).c(2,1)*p312q*v4_56a.b(1,1)+l3_ & 12fz(i1).a(2,2)*v4_56a.a(2,1) dia1(i1).b(2,1)=rmb*(l3_12fz(i1).b(2,1)*v4_56a.b(1,1)+l3_1 & 2fz(i1).d(2,2)*v4_56a.a(2,1)) dia1(i1).c(2,1)=rmb*l3_12fz(i1).c(2,1)*v4_56a.c(1,1) dia1(i1).d(2,1)=l3_12fz(i1).b(2,1)*v4_56a.c(1,1) end do do i1=1,2 * mline -- res=cresp13(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p312 * q-rmb2)*p312k0),nsum=0 do iut=1,2 do jut=1,2 cresp13(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p312q-rmb2)*p312k0) enddo enddo end do * TSC -- qu=p6,qd=p312,a=v6_54a.a,b=v6_54a.b,c=v6_54a.c,cr=1.d0,cl=-1.d0 auxa=-p6k0*p312(2)+p312k0*p6(2) cauxa=-cim*(p312(3)*p6k0-p6(3)*p312k0) v6_54a.a(1,2)=-1.d0*(auxa+cauxa) v6_54a.a(2,1)=(-auxa+cauxa) v6_54a.b(1,1)=p312k0 v6_54a.b(2,2)=-1.d0*p312k0 v6_54a.c(1,1)=-1.d0*p6k0 v6_54a.c(2,2)=p6k0 do i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l3_12f * z(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1).d,a2=v6_54a.a,b2= * v6_54a.b,c2=v6_54a.c,prq=p312q,m=rmb,nsum=0 dia1(i1).a(1,2)=l3_12fz(i1).a(1,1)*v6_54a.a(1,2)+l3_12fz(i & 1).c(1,2)*p312q*v6_54a.b(2,2) dia1(i1).b(1,2)=rmb*(l3_12fz(i1).d(1,1)*v6_54a.a(1,2)+l3_1 & 2fz(i1).b(1,2)*v6_54a.b(2,2)) dia1(i1).c(1,2)=rmb*l3_12fz(i1).c(1,2)*v6_54a.c(2,2) dia1(i1).d(1,2)=l3_12fz(i1).b(1,2)*v6_54a.c(2,2) dia1(i1).a(1,1)=rmb*(l3_12fz(i1).a(1,1)*v6_54a.b(1,1)+l3_1 & 2fz(i1).c(1,2)*v6_54a.a(2,1)) dia1(i1).b(1,1)=l3_12fz(i1).d(1,1)*p312q*v6_54a.b(1,1)+l3_ & 12fz(i1).b(1,2)*v6_54a.a(2,1) dia1(i1).c(1,1)=l3_12fz(i1).a(1,1)*v6_54a.c(1,1) dia1(i1).d(1,1)=rmb*l3_12fz(i1).d(1,1)*v6_54a.c(1,1) dia1(i1).a(2,2)=rmb*(l3_12fz(i1).c(2,1)*v6_54a.a(1,2)+l3_1 & 2fz(i1).a(2,2)*v6_54a.b(2,2)) dia1(i1).b(2,2)=l3_12fz(i1).b(2,1)*v6_54a.a(1,2)+l3_12fz(i & 1).d(2,2)*p312q*v6_54a.b(2,2) dia1(i1).c(2,2)=l3_12fz(i1).a(2,2)*v6_54a.c(2,2) dia1(i1).d(2,2)=rmb*l3_12fz(i1).d(2,2)*v6_54a.c(2,2) dia1(i1).a(2,1)=l3_12fz(i1).c(2,1)*p312q*v6_54a.b(1,1)+l3_ & 12fz(i1).a(2,2)*v6_54a.a(2,1) dia1(i1).b(2,1)=rmb*(l3_12fz(i1).b(2,1)*v6_54a.b(1,1)+l3_1 & 2fz(i1).d(2,2)*v6_54a.a(2,1)) dia1(i1).c(2,1)=rmb*l3_12fz(i1).c(2,1)*v6_54a.c(1,1) dia1(i1).d(2,1)=l3_12fz(i1).b(2,1)*v6_54a.c(1,1) end do do i1=1,2 * mline -- res=cresp14(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p312 * q-rmb2)*p312k0),nsum=0 do iut=1,2 do jut=1,2 cresp14(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p312q-rmb2)*p312k0) enddo enddo end do * TSC -- qu=p4,qd=p512,a=v4_36a.a,b=v4_36a.b,c=v4_36a.c,cr=1.d0,cl=-1.d0 auxa=-p4k0*p512(2)+p512k0*p4(2) cauxa=-cim*(p512(3)*p4k0-p4(3)*p512k0) v4_36a.a(1,2)=-1.d0*(auxa+cauxa) v4_36a.a(2,1)=(-auxa+cauxa) v4_36a.b(1,1)=p512k0 v4_36a.b(2,2)=-1.d0*p512k0 v4_36a.c(1,1)=-1.d0*p4k0 v4_36a.c(2,2)=p4k0 do i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l5_12f * z(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1).d,a2=v4_36a.a,b2= * v4_36a.b,c2=v4_36a.c,prq=p512q,m=rmb,nsum=0 dia1(i1).a(1,2)=l5_12fz(i1).a(1,1)*v4_36a.a(1,2)+l5_12fz(i & 1).c(1,2)*p512q*v4_36a.b(2,2) dia1(i1).b(1,2)=rmb*(l5_12fz(i1).d(1,1)*v4_36a.a(1,2)+l5_1 & 2fz(i1).b(1,2)*v4_36a.b(2,2)) dia1(i1).c(1,2)=rmb*l5_12fz(i1).c(1,2)*v4_36a.c(2,2) dia1(i1).d(1,2)=l5_12fz(i1).b(1,2)*v4_36a.c(2,2) dia1(i1).a(1,1)=rmb*(l5_12fz(i1).a(1,1)*v4_36a.b(1,1)+l5_1 & 2fz(i1).c(1,2)*v4_36a.a(2,1)) dia1(i1).b(1,1)=l5_12fz(i1).d(1,1)*p512q*v4_36a.b(1,1)+l5_ & 12fz(i1).b(1,2)*v4_36a.a(2,1) dia1(i1).c(1,1)=l5_12fz(i1).a(1,1)*v4_36a.c(1,1) dia1(i1).d(1,1)=rmb*l5_12fz(i1).d(1,1)*v4_36a.c(1,1) dia1(i1).a(2,2)=rmb*(l5_12fz(i1).c(2,1)*v4_36a.a(1,2)+l5_1 & 2fz(i1).a(2,2)*v4_36a.b(2,2)) dia1(i1).b(2,2)=l5_12fz(i1).b(2,1)*v4_36a.a(1,2)+l5_12fz(i & 1).d(2,2)*p512q*v4_36a.b(2,2) dia1(i1).c(2,2)=l5_12fz(i1).a(2,2)*v4_36a.c(2,2) dia1(i1).d(2,2)=rmb*l5_12fz(i1).d(2,2)*v4_36a.c(2,2) dia1(i1).a(2,1)=l5_12fz(i1).c(2,1)*p512q*v4_36a.b(1,1)+l5_ & 12fz(i1).a(2,2)*v4_36a.a(2,1) dia1(i1).b(2,1)=rmb*(l5_12fz(i1).b(2,1)*v4_36a.b(1,1)+l5_1 & 2fz(i1).d(2,2)*v4_36a.a(2,1)) dia1(i1).c(2,1)=rmb*l5_12fz(i1).c(2,1)*v4_36a.c(1,1) dia1(i1).d(2,1)=l5_12fz(i1).b(2,1)*v4_36a.c(1,1) end do do i1=1,2 * mline -- res=cresp15(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p512 * q-rmb2)*p512k0),nsum=0 do iut=1,2 do jut=1,2 cresp15(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p512q-rmb2)*p512k0) enddo enddo end do * TSC -- qu=p6,qd=p512,a=v6_34a.a,b=v6_34a.b,c=v6_34a.c,cr=1.d0,cl=-1.d0 auxa=-p6k0*p512(2)+p512k0*p6(2) cauxa=-cim*(p512(3)*p6k0-p6(3)*p512k0) v6_34a.a(1,2)=-1.d0*(auxa+cauxa) v6_34a.a(2,1)=(-auxa+cauxa) v6_34a.b(1,1)=p512k0 v6_34a.b(2,2)=-1.d0*p512k0 v6_34a.c(1,1)=-1.d0*p6k0 v6_34a.c(2,2)=p6k0 do i1=1,2 * TTSC -- aa=dia1(i1).a,bb=dia1(i1).b,cc=dia1(i1).c,dd=dia1(i1).d,a1=l5_12f * z(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1).d,a2=v6_34a.a,b2= * v6_34a.b,c2=v6_34a.c,prq=p512q,m=rmb,nsum=0 dia1(i1).a(1,2)=l5_12fz(i1).a(1,1)*v6_34a.a(1,2)+l5_12fz(i & 1).c(1,2)*p512q*v6_34a.b(2,2) dia1(i1).b(1,2)=rmb*(l5_12fz(i1).d(1,1)*v6_34a.a(1,2)+l5_1 & 2fz(i1).b(1,2)*v6_34a.b(2,2)) dia1(i1).c(1,2)=rmb*l5_12fz(i1).c(1,2)*v6_34a.c(2,2) dia1(i1).d(1,2)=l5_12fz(i1).b(1,2)*v6_34a.c(2,2) dia1(i1).a(1,1)=rmb*(l5_12fz(i1).a(1,1)*v6_34a.b(1,1)+l5_1 & 2fz(i1).c(1,2)*v6_34a.a(2,1)) dia1(i1).b(1,1)=l5_12fz(i1).d(1,1)*p512q*v6_34a.b(1,1)+l5_ & 12fz(i1).b(1,2)*v6_34a.a(2,1) dia1(i1).c(1,1)=l5_12fz(i1).a(1,1)*v6_34a.c(1,1) dia1(i1).d(1,1)=rmb*l5_12fz(i1).d(1,1)*v6_34a.c(1,1) dia1(i1).a(2,2)=rmb*(l5_12fz(i1).c(2,1)*v6_34a.a(1,2)+l5_1 & 2fz(i1).a(2,2)*v6_34a.b(2,2)) dia1(i1).b(2,2)=l5_12fz(i1).b(2,1)*v6_34a.a(1,2)+l5_12fz(i & 1).d(2,2)*p512q*v6_34a.b(2,2) dia1(i1).c(2,2)=l5_12fz(i1).a(2,2)*v6_34a.c(2,2) dia1(i1).d(2,2)=rmb*l5_12fz(i1).d(2,2)*v6_34a.c(2,2) dia1(i1).a(2,1)=l5_12fz(i1).c(2,1)*p512q*v6_34a.b(1,1)+l5_ & 12fz(i1).a(2,2)*v6_34a.a(2,1) dia1(i1).b(2,1)=rmb*(l5_12fz(i1).b(2,1)*v6_34a.b(1,1)+l5_1 & 2fz(i1).d(2,2)*v6_34a.a(2,1)) dia1(i1).c(2,1)=rmb*l5_12fz(i1).c(2,1)*v6_34a.c(1,1) dia1(i1).d(2,1)=l5_12fz(i1).b(2,1)*v6_34a.c(1,1) end do do i1=1,2 * mline -- res=cresp16(i1,&1,&2),abcd=dia1(i1).,m1=rmb,m2=(-rmb),den=((p512 * q-rmb2)*p512k0),nsum=0 do iut=1,2 do jut=1,2 cresp16(i1,iut,jut)=(dia1(i1).a(iut,jut)+rmb*dia1(i1).b(iu & t,jut)+(-rmb)*dia1(i1).c(iut,jut)+rmb*(-rmb)*dia1(i1).d(i & ut,jut))/((p512q-rmb2)*p512k0) enddo enddo end do do i1=1,2 do i3=1,2 do i4=1,2 do i5=1,2 do i6=1,2 cres17a(i1,i3,i4,i5,i6)=rabb*cresp9(i1,i5,i4)*c36a(i3,i6) cres18a(i1,i3,i4,i5,i6)=rabb*cresp10(i1,i3,i4)*c56a(i5,i6) cres19a(i1,i3,i4,i5,i6)=rabb*cresp11(i1,i3,i6)*c54a(i5,i4) cres20a(i1,i3,i4,i5,i6)=rabb*cresp12(i1,i5,i6)*c34a(i3,i4) cres21a(i1,i3,i4,i5,i6)=rabb*cresp13(i1,i3,i4)*c56a(i5,i6) cres22a(i1,i3,i4,i5,i6)=rabb*cresp14(i1,i3,i6)*c54a(i5,i4) cres23a(i1,i3,i4,i5,i6)=rabb*cresp15(i1,i5,i4)*c36a(i3,i6) cres24a(i1,i3,i4,i5,i6)=rabb*cresp16(i1,i5,i6)*c34a(i3,i4) enddo !i6 enddo !i5 enddo !i4 enddo !i3 enddo !i1 ENDIF !(imix=1,-2; isusy=1; iha=1,3) IF(imix.EQ.-1.OR.imix.EQ.-2)THEN * quqd -- p=p5,q=p536 quqd=p5(0)*p536(0)-p5(1)*p536(1)-p5(2)*p536(2)-p5(3)*p536( & 3) DO i3=1,2 DO i6=1,2 * T -- qu=p5,qd=p536,v=c36f(i3,i6).e,a=l5_36(i3,i6).a,b=l5_36(i3,i6).b,c=l5 * _36(i3,i6).c,d=l5_36(i3,i6).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c36f(i3,i6).ek0*(p5(2)*p536(3)-p536(2)*p5(3))+p5k0 & *(c36f(i3,i6).e(2)*p536(3)-p536(2)*c36f(i3,i6).e(3))-p536 & k0*(c36f(i3,i6).e(2)*p5(3)-p5(2)*c36f(i3,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c36f(i3,i6).e(3)*p5k0+p5(3)*c36f(i3,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c36f(i3,i6).e(3)*p536k0+p536(3)*c36f(i3,i6).ek0 ceps_2=ceps_2*cim cvqu=c36f(i3,i6).e(0)*p5(0)-c36f(i3,i6).e(1)*p5(1)-c36f(i3 & ,i6).e(2)*p5(2)-c36f(i3,i6).e(3)*p5(3) cvqd=c36f(i3,i6).e(0)*p536(0)-c36f(i3,i6).e(1)*p536(1)-c36 & f(i3,i6).e(2)*p536(2)-c36f(i3,i6).e(3)*p536(3) cauxa=-c36f(i3,i6).ek0*quqd+p5k0*cvqd+p536k0*cvqu cauxb=-c36f(i3,i6).ek0*p536(2)+p536k0*c36f(i3,i6).e(2) cauxc=+c36f(i3,i6).ek0*p5(2)-p5k0*c36f(i3,i6).e(2) l5_36(i3,i6).a(1,1)=fqdr*(cauxa+ceps_0) l5_36(i3,i6).a(2,2)=fqdl*(cauxa-ceps_0) l5_36(i3,i6).b(1,2)=fqdl*(cauxb-ceps_2) l5_36(i3,i6).b(2,1)=fqdr*(-cauxb-ceps_2) l5_36(i3,i6).c(1,2)=fqdr*(cauxc+ceps_1) l5_36(i3,i6).c(2,1)=fqdl*(-cauxc+ceps_1) l5_36(i3,i6).d(1,1)=fqdl*c36f(i3,i6).ek0 l5_36(i3,i6).d(2,2)=fqdr*c36f(i3,i6).ek0 END DO END DO * quqd -- p=p5,q=p534 quqd=p5(0)*p534(0)-p5(1)*p534(1)-p5(2)*p534(2)-p5(3)*p534( & 3) DO i3=1,2 DO i4=1,2 * T -- qu=p5,qd=p534,v=c34f(i3,i4).e,a=l5_34(i3,i4).a,b=l5_34(i3,i4).b,c=l5 * _34(i3,i4).c,d=l5_34(i3,i4).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c34f(i3,i4).ek0*(p5(2)*p534(3)-p534(2)*p5(3))+p5k0 & *(c34f(i3,i4).e(2)*p534(3)-p534(2)*c34f(i3,i4).e(3))-p534 & k0*(c34f(i3,i4).e(2)*p5(3)-p5(2)*c34f(i3,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c34f(i3,i4).e(3)*p5k0+p5(3)*c34f(i3,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c34f(i3,i4).e(3)*p534k0+p534(3)*c34f(i3,i4).ek0 ceps_2=ceps_2*cim cvqu=c34f(i3,i4).e(0)*p5(0)-c34f(i3,i4).e(1)*p5(1)-c34f(i3 & ,i4).e(2)*p5(2)-c34f(i3,i4).e(3)*p5(3) cvqd=c34f(i3,i4).e(0)*p534(0)-c34f(i3,i4).e(1)*p534(1)-c34 & f(i3,i4).e(2)*p534(2)-c34f(i3,i4).e(3)*p534(3) cauxa=-c34f(i3,i4).ek0*quqd+p5k0*cvqd+p534k0*cvqu cauxb=-c34f(i3,i4).ek0*p534(2)+p534k0*c34f(i3,i4).e(2) cauxc=+c34f(i3,i4).ek0*p5(2)-p5k0*c34f(i3,i4).e(2) l5_34(i3,i4).a(1,1)=fqdr*(cauxa+ceps_0) l5_34(i3,i4).a(2,2)=fqdl*(cauxa-ceps_0) l5_34(i3,i4).b(1,2)=fqdl*(cauxb-ceps_2) l5_34(i3,i4).b(2,1)=fqdr*(-cauxb-ceps_2) l5_34(i3,i4).c(1,2)=fqdr*(cauxc+ceps_1) l5_34(i3,i4).c(2,1)=fqdl*(-cauxc+ceps_1) l5_34(i3,i4).d(1,1)=fqdl*c34f(i3,i4).ek0 l5_34(i3,i4).d(2,2)=fqdr*c34f(i3,i4).ek0 END DO END DO * quqd -- p=p3,q=p534 quqd=p3(0)*p534(0)-p3(1)*p534(1)-p3(2)*p534(2)-p3(3)*p534( & 3) DO i5=1,2 DO i4=1,2 * T -- qu=p3,qd=p534,v=c54f(i5,i4).e,a=l3_54(i5,i4).a,b=l3_54(i5,i4).b,c=l3 * _54(i5,i4).c,d=l3_54(i5,i4).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c54f(i5,i4).ek0*(p3(2)*p534(3)-p534(2)*p3(3))+p3k0 & *(c54f(i5,i4).e(2)*p534(3)-p534(2)*c54f(i5,i4).e(3))-p534 & k0*(c54f(i5,i4).e(2)*p3(3)-p3(2)*c54f(i5,i4).e(3)) ceps_0=ceps_0*cim ceps_1=-c54f(i5,i4).e(3)*p3k0+p3(3)*c54f(i5,i4).ek0 ceps_1=ceps_1*cim ceps_2=-c54f(i5,i4).e(3)*p534k0+p534(3)*c54f(i5,i4).ek0 ceps_2=ceps_2*cim cvqu=c54f(i5,i4).e(0)*p3(0)-c54f(i5,i4).e(1)*p3(1)-c54f(i5 & ,i4).e(2)*p3(2)-c54f(i5,i4).e(3)*p3(3) cvqd=c54f(i5,i4).e(0)*p534(0)-c54f(i5,i4).e(1)*p534(1)-c54 & f(i5,i4).e(2)*p534(2)-c54f(i5,i4).e(3)*p534(3) cauxa=-c54f(i5,i4).ek0*quqd+p3k0*cvqd+p534k0*cvqu cauxb=-c54f(i5,i4).ek0*p534(2)+p534k0*c54f(i5,i4).e(2) cauxc=+c54f(i5,i4).ek0*p3(2)-p3k0*c54f(i5,i4).e(2) l3_54(i5,i4).a(1,1)=fqdr*(cauxa+ceps_0) l3_54(i5,i4).a(2,2)=fqdl*(cauxa-ceps_0) l3_54(i5,i4).b(1,2)=fqdl*(cauxb-ceps_2) l3_54(i5,i4).b(2,1)=fqdr*(-cauxb-ceps_2) l3_54(i5,i4).c(1,2)=fqdr*(cauxc+ceps_1) l3_54(i5,i4).c(2,1)=fqdl*(-cauxc+ceps_1) l3_54(i5,i4).d(1,1)=fqdl*c54f(i5,i4).ek0 l3_54(i5,i4).d(2,2)=fqdr*c54f(i5,i4).ek0 END DO END DO * quqd -- p=p3,q=p536 quqd=p3(0)*p536(0)-p3(1)*p536(1)-p3(2)*p536(2)-p3(3)*p536( & 3) DO i5=1,2 DO i6=1,2 * T -- qu=p3,qd=p536,v=c56f(i5,i6).e,a=l3_56(i5,i6).a,b=l3_56(i5,i6).b,c=l3 * _56(i5,i6).c,d=l3_56(i5,i6).d,cr=fqdr,cl=fqdl,nsum=0 ceps_0=-c56f(i5,i6).ek0*(p3(2)*p536(3)-p536(2)*p3(3))+p3k0 & *(c56f(i5,i6).e(2)*p536(3)-p536(2)*c56f(i5,i6).e(3))-p536 & k0*(c56f(i5,i6).e(2)*p3(3)-p3(2)*c56f(i5,i6).e(3)) ceps_0=ceps_0*cim ceps_1=-c56f(i5,i6).e(3)*p3k0+p3(3)*c56f(i5,i6).ek0 ceps_1=ceps_1*cim ceps_2=-c56f(i5,i6).e(3)*p536k0+p536(3)*c56f(i5,i6).ek0 ceps_2=ceps_2*cim cvqu=c56f(i5,i6).e(0)*p3(0)-c56f(i5,i6).e(1)*p3(1)-c56f(i5 & ,i6).e(2)*p3(2)-c56f(i5,i6).e(3)*p3(3) cvqd=c56f(i5,i6).e(0)*p536(0)-c56f(i5,i6).e(1)*p536(1)-c56 & f(i5,i6).e(2)*p536(2)-c56f(i5,i6).e(3)*p536(3) cauxa=-c56f(i5,i6).ek0*quqd+p3k0*cvqd+p536k0*cvqu cauxb=-c56f(i5,i6).ek0*p536(2)+p536k0*c56f(i5,i6).e(2) cauxc=+c56f(i5,i6).ek0*p3(2)-p3k0*c56f(i5,i6).e(2) l3_56(i5,i6).a(1,1)=fqdr*(cauxa+ceps_0) l3_56(i5,i6).a(2,2)=fqdl*(cauxa-ceps_0) l3_56(i5,i6).b(1,2)=fqdl*(cauxb-ceps_2) l3_56(i5,i6).b(2,1)=fqdr*(-cauxb-ceps_2) l3_56(i5,i6).c(1,2)=fqdr*(cauxc+ceps_1) l3_56(i5,i6).c(2,1)=fqdl*(-cauxc+ceps_1) l3_56(i5,i6).d(1,1)=fqdl*c56f(i5,i6).ek0 l3_56(i5,i6).d(2,2)=fqdr*c56f(i5,i6).ek0 END DO END DO * Diagramma (17+20) non risonante gamma DO i1=1,2 DO i3=1,2 DO i6=1,2 * TT -- aa=dia(i1,i3,i6).a,bb=dia(i1,i3,i6).b,cc=dia(i1,i3,i6).c,dd=dia(i1, * i3,i6).d,a1=l5_36(i3,i6).a,b1=l5_36(i3,i6).b,c1=l5_36(i3,i6).c,d1=l5_36(i3 * ,i6).d,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1).c,d2=r4_12fz(i1).d * ,prq=p536q,m=rmb dia(i1,i3,i6).a(1,1)=l5_36(i3,i6).a(1,1)*r4_12fz(i1).a(1,1 & )+l5_36(i3,i6).c(1,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i3,i6).b(1,1)=rmb*(l5_36(i3,i6).d(1,1)*r4_12fz(i1). & a(1,1)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).b(2,1)) dia(i1,i3,i6).c(1,1)=rmb*(l5_36(i3,i6).a(1,1)*r4_12fz(i1). & d(1,1)+l5_36(i3,i6).c(1,2)*r4_12fz(i1).c(2,1)) dia(i1,i3,i6).d(1,1)=l5_36(i3,i6).d(1,1)*p536q*r4_12fz(i1) & .d(1,1)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).c(2,1) dia(i1,i3,i6).a(1,2)=rmb*(l5_36(i3,i6).a(1,1)*r4_12fz(i1). & b(1,2)+l5_36(i3,i6).c(1,2)*r4_12fz(i1).a(2,2)) dia(i1,i3,i6).b(1,2)=l5_36(i3,i6).d(1,1)*p536q*r4_12fz(i1) & .b(1,2)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).a(2,2) dia(i1,i3,i6).c(1,2)=l5_36(i3,i6).a(1,1)*r4_12fz(i1).c(1,2 & )+l5_36(i3,i6).c(1,2)*p536q*r4_12fz(i1).d(2,2) dia(i1,i3,i6).d(1,2)=rmb*(l5_36(i3,i6).d(1,1)*r4_12fz(i1). & c(1,2)+l5_36(i3,i6).b(1,2)*r4_12fz(i1).d(2,2)) dia(i1,i3,i6).a(2,1)=rmb*(l5_36(i3,i6).c(2,1)*r4_12fz(i1). & a(1,1)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).b(2,1)) dia(i1,i3,i6).b(2,1)=l5_36(i3,i6).b(2,1)*r4_12fz(i1).a(1,1 & )+l5_36(i3,i6).d(2,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i3,i6).c(2,1)=l5_36(i3,i6).c(2,1)*p536q*r4_12fz(i1) & .d(1,1)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).c(2,1) dia(i1,i3,i6).d(2,1)=rmb*(l5_36(i3,i6).b(2,1)*r4_12fz(i1). & d(1,1)+l5_36(i3,i6).d(2,2)*r4_12fz(i1).c(2,1)) dia(i1,i3,i6).a(2,2)=l5_36(i3,i6).c(2,1)*p536q*r4_12fz(i1) & .b(1,2)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).a(2,2) dia(i1,i3,i6).b(2,2)=rmb*(l5_36(i3,i6).b(2,1)*r4_12fz(i1). & b(1,2)+l5_36(i3,i6).d(2,2)*r4_12fz(i1).a(2,2)) dia(i1,i3,i6).c(2,2)=rmb*(l5_36(i3,i6).c(2,1)*r4_12fz(i1). & c(1,2)+l5_36(i3,i6).a(2,2)*r4_12fz(i1).d(2,2)) dia(i1,i3,i6).d(2,2)=l5_36(i3,i6).b(2,1)*r4_12fz(i1).c(1,2 & )+l5_36(i3,i6).d(2,2)*p536q*r4_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i6=1,2 * mline -- res=cres25(i1,i3,i6,&),abcd=dia(i1,i3,i6).,m1=rmb,m2=(-rmb),den= * ((p536q-rmb2)*p536k0) DO iut=1,2 DO jut=1,2 cres25(i1,i3,i6,iut,jut)=(dia(i1,i3,i6).a(iut,jut) & +rmb*dia & (i1,i3,i6).b(iut,jut)+(-rmb)*dia(i1,i3,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i6).d(iut,jut))/((p536q-rmb2) & *p536k0) ENDDO ENDDO END DO END DO END DO * Diagramma (63+66) non risonante gamma DO i1=1,2 DO i3=1,2 DO i4=1,2 * TT -- aa=dia(i1,i3,i4).a,bb=dia(i1,i3,i4).b,cc=dia(i1,i3,i4).c,dd=dia(i1, * i3,i4).d,a1=l5_34(i3,i4).a,b1=l5_34(i3,i4).b,c1=l5_34(i3,i4).c,d1=l5_34(i3 * ,i4).d,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1).c,d2=r6_12fz(i1).d * ,prq=p534q,m=rmb dia(i1,i3,i4).a(1,1)=l5_34(i3,i4).a(1,1)*r6_12fz(i1).a(1,1 & )+l5_34(i3,i4).c(1,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i3,i4).b(1,1)=rmb*(l5_34(i3,i4).d(1,1)*r6_12fz(i1). & a(1,1)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).b(2,1)) dia(i1,i3,i4).c(1,1)=rmb*(l5_34(i3,i4).a(1,1)*r6_12fz(i1). & d(1,1)+l5_34(i3,i4).c(1,2)*r6_12fz(i1).c(2,1)) dia(i1,i3,i4).d(1,1)=l5_34(i3,i4).d(1,1)*p534q*r6_12fz(i1) & .d(1,1)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).c(2,1) dia(i1,i3,i4).a(1,2)=rmb*(l5_34(i3,i4).a(1,1)*r6_12fz(i1). & b(1,2)+l5_34(i3,i4).c(1,2)*r6_12fz(i1).a(2,2)) dia(i1,i3,i4).b(1,2)=l5_34(i3,i4).d(1,1)*p534q*r6_12fz(i1) & .b(1,2)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).a(2,2) dia(i1,i3,i4).c(1,2)=l5_34(i3,i4).a(1,1)*r6_12fz(i1).c(1,2 & )+l5_34(i3,i4).c(1,2)*p534q*r6_12fz(i1).d(2,2) dia(i1,i3,i4).d(1,2)=rmb*(l5_34(i3,i4).d(1,1)*r6_12fz(i1). & c(1,2)+l5_34(i3,i4).b(1,2)*r6_12fz(i1).d(2,2)) dia(i1,i3,i4).a(2,1)=rmb*(l5_34(i3,i4).c(2,1)*r6_12fz(i1). & a(1,1)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).b(2,1)) dia(i1,i3,i4).b(2,1)=l5_34(i3,i4).b(2,1)*r6_12fz(i1).a(1,1 & )+l5_34(i3,i4).d(2,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i3,i4).c(2,1)=l5_34(i3,i4).c(2,1)*p534q*r6_12fz(i1) & .d(1,1)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).c(2,1) dia(i1,i3,i4).d(2,1)=rmb*(l5_34(i3,i4).b(2,1)*r6_12fz(i1). & d(1,1)+l5_34(i3,i4).d(2,2)*r6_12fz(i1).c(2,1)) dia(i1,i3,i4).a(2,2)=l5_34(i3,i4).c(2,1)*p534q*r6_12fz(i1) & .b(1,2)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).a(2,2) dia(i1,i3,i4).b(2,2)=rmb*(l5_34(i3,i4).b(2,1)*r6_12fz(i1). & b(1,2)+l5_34(i3,i4).d(2,2)*r6_12fz(i1).a(2,2)) dia(i1,i3,i4).c(2,2)=rmb*(l5_34(i3,i4).c(2,1)*r6_12fz(i1). & c(1,2)+l5_34(i3,i4).a(2,2)*r6_12fz(i1).d(2,2)) dia(i1,i3,i4).d(2,2)=l5_34(i3,i4).b(2,1)*r6_12fz(i1).c(1,2 & )+l5_34(i3,i4).d(2,2)*p534q*r6_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 * mline -- res=cres26(i1,i3,i4,&),abcd=dia(i1,i3,i4).,m1=rmb,m2=(-rmb),den= * ((p534q-rmb2)*p534k0) DO iut=1,2 DO jut=1,2 cres26(i1,i3,i4,iut,jut)=(dia(i1,i3,i4).a(iut,jut) & +rmb*dia & (i1,i3,i4).b(iut,jut)+(-rmb)*dia(i1,i3,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i4).d(iut,jut))/((p534q-rmb2) & *p534k0) ENDDO ENDDO END DO END DO END DO * Diagramma (23+26) non risonante gamma DO i1=1,2 DO i5=1,2 DO i6=1,2 * TT -- aa=dia(i1,i5,i6).a,bb=dia(i1,i5,i6).b,cc=dia(i1,i5,i6).c,dd=dia(i1, * i5,i6).d,a1=l3_56(i5,i6).a,b1=l3_56(i5,i6).b,c1=l3_56(i5,i6).c,d1=l3_56(i5 * ,i6).d,a2=r4_12fz(i1).a,b2=r4_12fz(i1).b,c2=r4_12fz(i1).c,d2=r4_12fz(i1).d * ,prq=p536q,m=rmb dia(i1,i5,i6).a(1,1)=l3_56(i5,i6).a(1,1)*r4_12fz(i1).a(1,1 & )+l3_56(i5,i6).c(1,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i5,i6).b(1,1)=rmb*(l3_56(i5,i6).d(1,1)*r4_12fz(i1). & a(1,1)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).b(2,1)) dia(i1,i5,i6).c(1,1)=rmb*(l3_56(i5,i6).a(1,1)*r4_12fz(i1). & d(1,1)+l3_56(i5,i6).c(1,2)*r4_12fz(i1).c(2,1)) dia(i1,i5,i6).d(1,1)=l3_56(i5,i6).d(1,1)*p536q*r4_12fz(i1) & .d(1,1)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).c(2,1) dia(i1,i5,i6).a(1,2)=rmb*(l3_56(i5,i6).a(1,1)*r4_12fz(i1). & b(1,2)+l3_56(i5,i6).c(1,2)*r4_12fz(i1).a(2,2)) dia(i1,i5,i6).b(1,2)=l3_56(i5,i6).d(1,1)*p536q*r4_12fz(i1) & .b(1,2)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).a(2,2) dia(i1,i5,i6).c(1,2)=l3_56(i5,i6).a(1,1)*r4_12fz(i1).c(1,2 & )+l3_56(i5,i6).c(1,2)*p536q*r4_12fz(i1).d(2,2) dia(i1,i5,i6).d(1,2)=rmb*(l3_56(i5,i6).d(1,1)*r4_12fz(i1). & c(1,2)+l3_56(i5,i6).b(1,2)*r4_12fz(i1).d(2,2)) dia(i1,i5,i6).a(2,1)=rmb*(l3_56(i5,i6).c(2,1)*r4_12fz(i1). & a(1,1)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).b(2,1)) dia(i1,i5,i6).b(2,1)=l3_56(i5,i6).b(2,1)*r4_12fz(i1).a(1,1 & )+l3_56(i5,i6).d(2,2)*p536q*r4_12fz(i1).b(2,1) dia(i1,i5,i6).c(2,1)=l3_56(i5,i6).c(2,1)*p536q*r4_12fz(i1) & .d(1,1)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).c(2,1) dia(i1,i5,i6).d(2,1)=rmb*(l3_56(i5,i6).b(2,1)*r4_12fz(i1). & d(1,1)+l3_56(i5,i6).d(2,2)*r4_12fz(i1).c(2,1)) dia(i1,i5,i6).a(2,2)=l3_56(i5,i6).c(2,1)*p536q*r4_12fz(i1) & .b(1,2)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).a(2,2) dia(i1,i5,i6).b(2,2)=rmb*(l3_56(i5,i6).b(2,1)*r4_12fz(i1). & b(1,2)+l3_56(i5,i6).d(2,2)*r4_12fz(i1).a(2,2)) dia(i1,i5,i6).c(2,2)=rmb*(l3_56(i5,i6).c(2,1)*r4_12fz(i1). & c(1,2)+l3_56(i5,i6).a(2,2)*r4_12fz(i1).d(2,2)) dia(i1,i5,i6).d(2,2)=l3_56(i5,i6).b(2,1)*r4_12fz(i1).c(1,2 & )+l3_56(i5,i6).d(2,2)*p536q*r4_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i6=1,2 * mline -- res=cres27(i1,i5,i6,&),abcd=dia(i1,i5,i6).,m1=rmb,m2=(-rmb),den= * ((p536q-rmb2)*p536k0) DO iut=1,2 DO jut=1,2 cres27(i1,i5,i6,iut,jut)=(dia(i1,i5,i6).a(iut,jut) & +rmb*dia & (i1,i5,i6).b(iut,jut)+(-rmb)*dia(i1,i5,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i6).d(iut,jut))/((p536q-rmb2) & *p536k0) ENDDO ENDDO END DO END DO END DO * Diagramma (37+40) non risonante gamma DO i1=1,2 DO i5=1,2 DO i4=1,2 * TT -- aa=dia(i1,i5,i4).a,bb=dia(i1,i5,i4).b,cc=dia(i1,i5,i4).c,dd=dia(i1, * i5,i4).d,a1=l3_54(i5,i4).a,b1=l3_54(i5,i4).b,c1=l3_54(i5,i4).c,d1=l3_54(i5 * ,i4).d,a2=r6_12fz(i1).a,b2=r6_12fz(i1).b,c2=r6_12fz(i1).c,d2=r6_12fz(i1).d * ,prq=p534q,m=rmb dia(i1,i5,i4).a(1,1)=l3_54(i5,i4).a(1,1)*r6_12fz(i1).a(1,1 & )+l3_54(i5,i4).c(1,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i5,i4).b(1,1)=rmb*(l3_54(i5,i4).d(1,1)*r6_12fz(i1). & a(1,1)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).b(2,1)) dia(i1,i5,i4).c(1,1)=rmb*(l3_54(i5,i4).a(1,1)*r6_12fz(i1). & d(1,1)+l3_54(i5,i4).c(1,2)*r6_12fz(i1).c(2,1)) dia(i1,i5,i4).d(1,1)=l3_54(i5,i4).d(1,1)*p534q*r6_12fz(i1) & .d(1,1)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).c(2,1) dia(i1,i5,i4).a(1,2)=rmb*(l3_54(i5,i4).a(1,1)*r6_12fz(i1). & b(1,2)+l3_54(i5,i4).c(1,2)*r6_12fz(i1).a(2,2)) dia(i1,i5,i4).b(1,2)=l3_54(i5,i4).d(1,1)*p534q*r6_12fz(i1) & .b(1,2)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).a(2,2) dia(i1,i5,i4).c(1,2)=l3_54(i5,i4).a(1,1)*r6_12fz(i1).c(1,2 & )+l3_54(i5,i4).c(1,2)*p534q*r6_12fz(i1).d(2,2) dia(i1,i5,i4).d(1,2)=rmb*(l3_54(i5,i4).d(1,1)*r6_12fz(i1). & c(1,2)+l3_54(i5,i4).b(1,2)*r6_12fz(i1).d(2,2)) dia(i1,i5,i4).a(2,1)=rmb*(l3_54(i5,i4).c(2,1)*r6_12fz(i1). & a(1,1)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).b(2,1)) dia(i1,i5,i4).b(2,1)=l3_54(i5,i4).b(2,1)*r6_12fz(i1).a(1,1 & )+l3_54(i5,i4).d(2,2)*p534q*r6_12fz(i1).b(2,1) dia(i1,i5,i4).c(2,1)=l3_54(i5,i4).c(2,1)*p534q*r6_12fz(i1) & .d(1,1)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).c(2,1) dia(i1,i5,i4).d(2,1)=rmb*(l3_54(i5,i4).b(2,1)*r6_12fz(i1). & d(1,1)+l3_54(i5,i4).d(2,2)*r6_12fz(i1).c(2,1)) dia(i1,i5,i4).a(2,2)=l3_54(i5,i4).c(2,1)*p534q*r6_12fz(i1) & .b(1,2)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).a(2,2) dia(i1,i5,i4).b(2,2)=rmb*(l3_54(i5,i4).b(2,1)*r6_12fz(i1). & b(1,2)+l3_54(i5,i4).d(2,2)*r6_12fz(i1).a(2,2)) dia(i1,i5,i4).c(2,2)=rmb*(l3_54(i5,i4).c(2,1)*r6_12fz(i1). & c(1,2)+l3_54(i5,i4).a(2,2)*r6_12fz(i1).d(2,2)) dia(i1,i5,i4).d(2,2)=l3_54(i5,i4).b(2,1)*r6_12fz(i1).c(1,2 & )+l3_54(i5,i4).d(2,2)*p534q*r6_12fz(i1).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i4=1,2 * mline -- res=cres28(i1,i5,i4,&),abcd=dia(i1,i5,i4).,m1=rmb,m2=(-rmb),den= * ((p534q-rmb2)*p534k0) DO iut=1,2 DO jut=1,2 cres28(i1,i5,i4,iut,jut)=(dia(i1,i5,i4).a(iut,jut) & +rmb*dia & (i1,i5,i4).b(iut,jut)+(-rmb)*dia(i1,i5,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i4).d(iut,jut))/((p534q-rmb2) & *p534k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 31+34 ) non risonante gamma DO i1=1,2 DO i5=1,2 DO i6=1,2 * TT -- aa=dia(i1,i5,i6).a,bb=dia(i1,i5,i6).b,cc=dia(i1,i5,i6).c,dd=dia(i1, * i5,i6).d,a1=l3_12fz(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1) * .d,a2=r4_56f(i5,i6).a,b2=r4_56f(i5,i6).b,c2=r4_56f(i5,i6).c,d2=r4_56f(i5,i * 6).d,prq=p312q,m=rmb dia(i1,i5,i6).a(1,1)=l3_12fz(i1).a(1,1)*r4_56f(i5,i6).a(1, & 1)+l3_12fz(i1).c(1,2)*p312q*r4_56f(i5,i6).b(2,1) dia(i1,i5,i6).b(1,1)=rmb*(l3_12fz(i1).d(1,1)*r4_56f(i5,i6) & .a(1,1)+l3_12fz(i1).b(1,2)*r4_56f(i5,i6).b(2,1)) dia(i1,i5,i6).c(1,1)=rmb*(l3_12fz(i1).a(1,1)*r4_56f(i5,i6) & .d(1,1)+l3_12fz(i1).c(1,2)*r4_56f(i5,i6).c(2,1)) dia(i1,i5,i6).d(1,1)=l3_12fz(i1).d(1,1)*p312q*r4_56f(i5,i6 & ).d(1,1)+l3_12fz(i1).b(1,2)*r4_56f(i5,i6).c(2,1) dia(i1,i5,i6).a(1,2)=rmb*(l3_12fz(i1).a(1,1)*r4_56f(i5,i6) & .b(1,2)+l3_12fz(i1).c(1,2)*r4_56f(i5,i6).a(2,2)) dia(i1,i5,i6).b(1,2)=l3_12fz(i1).d(1,1)*p312q*r4_56f(i5,i6 & ).b(1,2)+l3_12fz(i1).b(1,2)*r4_56f(i5,i6).a(2,2) dia(i1,i5,i6).c(1,2)=l3_12fz(i1).a(1,1)*r4_56f(i5,i6).c(1, & 2)+l3_12fz(i1).c(1,2)*p312q*r4_56f(i5,i6).d(2,2) dia(i1,i5,i6).d(1,2)=rmb*(l3_12fz(i1).d(1,1)*r4_56f(i5,i6) & .c(1,2)+l3_12fz(i1).b(1,2)*r4_56f(i5,i6).d(2,2)) dia(i1,i5,i6).a(2,1)=rmb*(l3_12fz(i1).c(2,1)*r4_56f(i5,i6) & .a(1,1)+l3_12fz(i1).a(2,2)*r4_56f(i5,i6).b(2,1)) dia(i1,i5,i6).b(2,1)=l3_12fz(i1).b(2,1)*r4_56f(i5,i6).a(1, & 1)+l3_12fz(i1).d(2,2)*p312q*r4_56f(i5,i6).b(2,1) dia(i1,i5,i6).c(2,1)=l3_12fz(i1).c(2,1)*p312q*r4_56f(i5,i6 & ).d(1,1)+l3_12fz(i1).a(2,2)*r4_56f(i5,i6).c(2,1) dia(i1,i5,i6).d(2,1)=rmb*(l3_12fz(i1).b(2,1)*r4_56f(i5,i6) & .d(1,1)+l3_12fz(i1).d(2,2)*r4_56f(i5,i6).c(2,1)) dia(i1,i5,i6).a(2,2)=l3_12fz(i1).c(2,1)*p312q*r4_56f(i5,i6 & ).b(1,2)+l3_12fz(i1).a(2,2)*r4_56f(i5,i6).a(2,2) dia(i1,i5,i6).b(2,2)=rmb*(l3_12fz(i1).b(2,1)*r4_56f(i5,i6) & .b(1,2)+l3_12fz(i1).d(2,2)*r4_56f(i5,i6).a(2,2)) dia(i1,i5,i6).c(2,2)=rmb*(l3_12fz(i1).c(2,1)*r4_56f(i5,i6) & .c(1,2)+l3_12fz(i1).a(2,2)*r4_56f(i5,i6).d(2,2)) dia(i1,i5,i6).d(2,2)=l3_12fz(i1).b(2,1)*r4_56f(i5,i6).c(1, & 2)+l3_12fz(i1).d(2,2)*p312q*r4_56f(i5,i6).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i6=1,2 * mline -- res=cres29(i1,i5,i6,&),abcd=dia(i1,i5,i6).,m1=rmb,m2=(-rmb),den= * ((p312q-rmb2)*p312k0) DO iut=1,2 DO jut=1,2 cres29(i1,i5,i6,iut,jut)=(dia(i1,i5,i6).a(iut,jut) & +rmb*dia & (i1,i5,i6).b(iut,jut)+(-rmb)*dia(i1,i5,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i6).d(iut,jut))/((p312q-rmb2) & *p312k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 43+46 ) non risonante gamma DO i1=1,2 DO i5=1,2 DO i4=1,2 * TT -- aa=dia(i1,i5,i4).a,bb=dia(i1,i5,i4).b,cc=dia(i1,i5,i4).c,dd=dia(i1, * i5,i4).d,a1=l3_12fz(i1).a,b1=l3_12fz(i1).b,c1=l3_12fz(i1).c,d1=l3_12fz(i1) * .d,a2=r6_54f(i5,i4).a,b2=r6_54f(i5,i4).b,c2=r6_54f(i5,i4).c,d2=r6_54f(i5,i * 4).d,prq=p312q,m=rmb dia(i1,i5,i4).a(1,1)=l3_12fz(i1).a(1,1)*r6_54f(i5,i4).a(1, & 1)+l3_12fz(i1).c(1,2)*p312q*r6_54f(i5,i4).b(2,1) dia(i1,i5,i4).b(1,1)=rmb*(l3_12fz(i1).d(1,1)*r6_54f(i5,i4) & .a(1,1)+l3_12fz(i1).b(1,2)*r6_54f(i5,i4).b(2,1)) dia(i1,i5,i4).c(1,1)=rmb*(l3_12fz(i1).a(1,1)*r6_54f(i5,i4) & .d(1,1)+l3_12fz(i1).c(1,2)*r6_54f(i5,i4).c(2,1)) dia(i1,i5,i4).d(1,1)=l3_12fz(i1).d(1,1)*p312q*r6_54f(i5,i4 & ).d(1,1)+l3_12fz(i1).b(1,2)*r6_54f(i5,i4).c(2,1) dia(i1,i5,i4).a(1,2)=rmb*(l3_12fz(i1).a(1,1)*r6_54f(i5,i4) & .b(1,2)+l3_12fz(i1).c(1,2)*r6_54f(i5,i4).a(2,2)) dia(i1,i5,i4).b(1,2)=l3_12fz(i1).d(1,1)*p312q*r6_54f(i5,i4 & ).b(1,2)+l3_12fz(i1).b(1,2)*r6_54f(i5,i4).a(2,2) dia(i1,i5,i4).c(1,2)=l3_12fz(i1).a(1,1)*r6_54f(i5,i4).c(1, & 2)+l3_12fz(i1).c(1,2)*p312q*r6_54f(i5,i4).d(2,2) dia(i1,i5,i4).d(1,2)=rmb*(l3_12fz(i1).d(1,1)*r6_54f(i5,i4) & .c(1,2)+l3_12fz(i1).b(1,2)*r6_54f(i5,i4).d(2,2)) dia(i1,i5,i4).a(2,1)=rmb*(l3_12fz(i1).c(2,1)*r6_54f(i5,i4) & .a(1,1)+l3_12fz(i1).a(2,2)*r6_54f(i5,i4).b(2,1)) dia(i1,i5,i4).b(2,1)=l3_12fz(i1).b(2,1)*r6_54f(i5,i4).a(1, & 1)+l3_12fz(i1).d(2,2)*p312q*r6_54f(i5,i4).b(2,1) dia(i1,i5,i4).c(2,1)=l3_12fz(i1).c(2,1)*p312q*r6_54f(i5,i4 & ).d(1,1)+l3_12fz(i1).a(2,2)*r6_54f(i5,i4).c(2,1) dia(i1,i5,i4).d(2,1)=rmb*(l3_12fz(i1).b(2,1)*r6_54f(i5,i4) & .d(1,1)+l3_12fz(i1).d(2,2)*r6_54f(i5,i4).c(2,1)) dia(i1,i5,i4).a(2,2)=l3_12fz(i1).c(2,1)*p312q*r6_54f(i5,i4 & ).b(1,2)+l3_12fz(i1).a(2,2)*r6_54f(i5,i4).a(2,2) dia(i1,i5,i4).b(2,2)=rmb*(l3_12fz(i1).b(2,1)*r6_54f(i5,i4) & .b(1,2)+l3_12fz(i1).d(2,2)*r6_54f(i5,i4).a(2,2)) dia(i1,i5,i4).c(2,2)=rmb*(l3_12fz(i1).c(2,1)*r6_54f(i5,i4) & .c(1,2)+l3_12fz(i1).a(2,2)*r6_54f(i5,i4).d(2,2)) dia(i1,i5,i4).d(2,2)=l3_12fz(i1).b(2,1)*r6_54f(i5,i4).c(1, & 2)+l3_12fz(i1).d(2,2)*p312q*r6_54f(i5,i4).d(2,2) END DO END DO END DO DO i1=1,2 DO i5=1,2 DO i4=1,2 * mline -- res=cres30(i1,i5,i4,&),abcd=dia(i1,i5,i4).,m1=rmb,m2=(-rmb),den= * ((p312q-rmb2)*p312k0) DO iut=1,2 DO jut=1,2 cres30(i1,i5,i4,iut,jut)=(dia(i1,i5,i4).a(iut,jut) & +rmb*dia & (i1,i5,i4).b(iut,jut)+(-rmb)*dia(i1,i5,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i5,i4).d(iut,jut))/((p312q-rmb2) & *p312k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 49+52 ) non risonante gamma DO i1=1,2 DO i3=1,2 DO i6=1,2 * TT -- aa=dia(i1,i3,i6).a,bb=dia(i1,i3,i6).b,cc=dia(i1,i3,i6).c,dd=dia(i1, * i3,i6).d,a1=l5_12fz(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1) * .d,a2=r4_36f(i3,i6).a,b2=r4_36f(i3,i6).b,c2=r4_36f(i3,i6).c,d2=r4_36f(i3,i * 6).d,prq=p512q,m=rmb dia(i1,i3,i6).a(1,1)=l5_12fz(i1).a(1,1)*r4_36f(i3,i6).a(1, & 1)+l5_12fz(i1).c(1,2)*p512q*r4_36f(i3,i6).b(2,1) dia(i1,i3,i6).b(1,1)=rmb*(l5_12fz(i1).d(1,1)*r4_36f(i3,i6) & .a(1,1)+l5_12fz(i1).b(1,2)*r4_36f(i3,i6).b(2,1)) dia(i1,i3,i6).c(1,1)=rmb*(l5_12fz(i1).a(1,1)*r4_36f(i3,i6) & .d(1,1)+l5_12fz(i1).c(1,2)*r4_36f(i3,i6).c(2,1)) dia(i1,i3,i6).d(1,1)=l5_12fz(i1).d(1,1)*p512q*r4_36f(i3,i6 & ).d(1,1)+l5_12fz(i1).b(1,2)*r4_36f(i3,i6).c(2,1) dia(i1,i3,i6).a(1,2)=rmb*(l5_12fz(i1).a(1,1)*r4_36f(i3,i6) & .b(1,2)+l5_12fz(i1).c(1,2)*r4_36f(i3,i6).a(2,2)) dia(i1,i3,i6).b(1,2)=l5_12fz(i1).d(1,1)*p512q*r4_36f(i3,i6 & ).b(1,2)+l5_12fz(i1).b(1,2)*r4_36f(i3,i6).a(2,2) dia(i1,i3,i6).c(1,2)=l5_12fz(i1).a(1,1)*r4_36f(i3,i6).c(1, & 2)+l5_12fz(i1).c(1,2)*p512q*r4_36f(i3,i6).d(2,2) dia(i1,i3,i6).d(1,2)=rmb*(l5_12fz(i1).d(1,1)*r4_36f(i3,i6) & .c(1,2)+l5_12fz(i1).b(1,2)*r4_36f(i3,i6).d(2,2)) dia(i1,i3,i6).a(2,1)=rmb*(l5_12fz(i1).c(2,1)*r4_36f(i3,i6) & .a(1,1)+l5_12fz(i1).a(2,2)*r4_36f(i3,i6).b(2,1)) dia(i1,i3,i6).b(2,1)=l5_12fz(i1).b(2,1)*r4_36f(i3,i6).a(1, & 1)+l5_12fz(i1).d(2,2)*p512q*r4_36f(i3,i6).b(2,1) dia(i1,i3,i6).c(2,1)=l5_12fz(i1).c(2,1)*p512q*r4_36f(i3,i6 & ).d(1,1)+l5_12fz(i1).a(2,2)*r4_36f(i3,i6).c(2,1) dia(i1,i3,i6).d(2,1)=rmb*(l5_12fz(i1).b(2,1)*r4_36f(i3,i6) & .d(1,1)+l5_12fz(i1).d(2,2)*r4_36f(i3,i6).c(2,1)) dia(i1,i3,i6).a(2,2)=l5_12fz(i1).c(2,1)*p512q*r4_36f(i3,i6 & ).b(1,2)+l5_12fz(i1).a(2,2)*r4_36f(i3,i6).a(2,2) dia(i1,i3,i6).b(2,2)=rmb*(l5_12fz(i1).b(2,1)*r4_36f(i3,i6) & .b(1,2)+l5_12fz(i1).d(2,2)*r4_36f(i3,i6).a(2,2)) dia(i1,i3,i6).c(2,2)=rmb*(l5_12fz(i1).c(2,1)*r4_36f(i3,i6) & .c(1,2)+l5_12fz(i1).a(2,2)*r4_36f(i3,i6).d(2,2)) dia(i1,i3,i6).d(2,2)=l5_12fz(i1).b(2,1)*r4_36f(i3,i6).c(1, & 2)+l5_12fz(i1).d(2,2)*p512q*r4_36f(i3,i6).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i6=1,2 * mline -- res=cres31(i1,i3,i6,&),abcd=dia(i1,i3,i6).,m1=rmb,m2=(-rmb),den= * ((p512q-rmb2)*p512k0) DO iut=1,2 DO jut=1,2 cres31(i1,i3,i6,iut,jut)=(dia(i1,i3,i6).a(iut,jut) & +rmb*dia & (i1,i3,i6).b(iut,jut)+(-rmb)*dia(i1,i3,i6).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i6).d(iut,jut))/((p512q-rmb2) & *p512k0) ENDDO ENDDO END DO END DO END DO * Diagramma ( 57+60 ) non risonante gamma DO i1=1,2 DO i3=1,2 DO i4=1,2 * TT -- aa=dia(i1,i3,i4).a,bb=dia(i1,i3,i4).b,cc=dia(i1,i3,i4).c,dd=dia(i1, * i3,i4).d,a1=l5_12fz(i1).a,b1=l5_12fz(i1).b,c1=l5_12fz(i1).c,d1=l5_12fz(i1) * .d,a2=r6_34f(i3,i4).a,b2=r6_34f(i3,i4).b,c2=r6_34f(i3,i4).c,d2=r6_34f(i3,i * 4).d,prq=p512q,m=rmb dia(i1,i3,i4).a(1,1)=l5_12fz(i1).a(1,1)*r6_34f(i3,i4).a(1, & 1)+l5_12fz(i1).c(1,2)*p512q*r6_34f(i3,i4).b(2,1) dia(i1,i3,i4).b(1,1)=rmb*(l5_12fz(i1).d(1,1)*r6_34f(i3,i4) & .a(1,1)+l5_12fz(i1).b(1,2)*r6_34f(i3,i4).b(2,1)) dia(i1,i3,i4).c(1,1)=rmb*(l5_12fz(i1).a(1,1)*r6_34f(i3,i4) & .d(1,1)+l5_12fz(i1).c(1,2)*r6_34f(i3,i4).c(2,1)) dia(i1,i3,i4).d(1,1)=l5_12fz(i1).d(1,1)*p512q*r6_34f(i3,i4 & ).d(1,1)+l5_12fz(i1).b(1,2)*r6_34f(i3,i4).c(2,1) dia(i1,i3,i4).a(1,2)=rmb*(l5_12fz(i1).a(1,1)*r6_34f(i3,i4) & .b(1,2)+l5_12fz(i1).c(1,2)*r6_34f(i3,i4).a(2,2)) dia(i1,i3,i4).b(1,2)=l5_12fz(i1).d(1,1)*p512q*r6_34f(i3,i4 & ).b(1,2)+l5_12fz(i1).b(1,2)*r6_34f(i3,i4).a(2,2) dia(i1,i3,i4).c(1,2)=l5_12fz(i1).a(1,1)*r6_34f(i3,i4).c(1, & 2)+l5_12fz(i1).c(1,2)*p512q*r6_34f(i3,i4).d(2,2) dia(i1,i3,i4).d(1,2)=rmb*(l5_12fz(i1).d(1,1)*r6_34f(i3,i4) & .c(1,2)+l5_12fz(i1).b(1,2)*r6_34f(i3,i4).d(2,2)) dia(i1,i3,i4).a(2,1)=rmb*(l5_12fz(i1).c(2,1)*r6_34f(i3,i4) & .a(1,1)+l5_12fz(i1).a(2,2)*r6_34f(i3,i4).b(2,1)) dia(i1,i3,i4).b(2,1)=l5_12fz(i1).b(2,1)*r6_34f(i3,i4).a(1, & 1)+l5_12fz(i1).d(2,2)*p512q*r6_34f(i3,i4).b(2,1) dia(i1,i3,i4).c(2,1)=l5_12fz(i1).c(2,1)*p512q*r6_34f(i3,i4 & ).d(1,1)+l5_12fz(i1).a(2,2)*r6_34f(i3,i4).c(2,1) dia(i1,i3,i4).d(2,1)=rmb*(l5_12fz(i1).b(2,1)*r6_34f(i3,i4) & .d(1,1)+l5_12fz(i1).d(2,2)*r6_34f(i3,i4).c(2,1)) dia(i1,i3,i4).a(2,2)=l5_12fz(i1).c(2,1)*p512q*r6_34f(i3,i4 & ).b(1,2)+l5_12fz(i1).a(2,2)*r6_34f(i3,i4).a(2,2) dia(i1,i3,i4).b(2,2)=rmb*(l5_12fz(i1).b(2,1)*r6_34f(i3,i4) & .b(1,2)+l5_12fz(i1).d(2,2)*r6_34f(i3,i4).a(2,2)) dia(i1,i3,i4).c(2,2)=rmb*(l5_12fz(i1).c(2,1)*r6_34f(i3,i4) & .c(1,2)+l5_12fz(i1).a(2,2)*r6_34f(i3,i4).d(2,2)) dia(i1,i3,i4).d(2,2)=l5_12fz(i1).b(2,1)*r6_34f(i3,i4).c(1, & 2)+l5_12fz(i1).d(2,2)*p512q*r6_34f(i3,i4).d(2,2) END DO END DO END DO DO i1=1,2 DO i3=1,2 DO i4=1,2 * mline -- res=cres32(i1,i3,i4,&),abcd=dia(i1,i3,i4).,m1=rmb,m2=(-rmb),den= * ((p512q-rmb2)*p512k0) DO iut=1,2 DO jut=1,2 cres32(i1,i3,i4,iut,jut)=(dia(i1,i3,i4).a(iut,jut) & +rmb*dia & (i1,i3,i4).b(iut,jut)+(-rmb)*dia(i1,i3,i4).c(iut, & jut)+rmb & *(-rmb)*dia(i1,i3,i4).d(iut,jut))/((p512q-rmb2) & *p512k0) ENDDO ENDDO END DO END DO END DO ENDIF IF((imix.EQ.1.AND.iha.NE.3.AND.iha.NE.5).OR.imix.EQ.-2)THEN * Diagramma (29) DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres33(i1,i3,i4,i5,i6)=rhzz*(c54z(i5,i4).e(0)* & c12z(i1).e(0)-c54z(i5,i4).e(1)*c12z(i1).e(1)- & c54z(i5,i4).e(2)*c12z(i1).e(2)-c54z(i5,i4).e(3)* & c12z(i1).e(3))*c36h(i3,i6) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * Diagramma (30) DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres34(i1,i3,i4,i5,i6)=rhzz*(c36z(i3,i6).e(0)* & c12z(i1).e(0)-c36z(i3,i6).e(1)*c12z(i1).e(1)- & c36z(i3,i6).e(2)*c12z(i1).e(2)-c36z(i3,i6).e(3)* & c12z(i1).e(3))*c54h(i5,i4) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * Diagramma (55) DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres35(i1,i3,i4,i5,i6)=rhzz*(c34z(i3,i4).e(0)* & c12z(i1).e(0)-c34z(i3,i4).e(1)*c12z(i1).e(1)- & c34z(i3,i4).e(2)*c12z(i1).e(2)-c34z(i3,i4).e(3)* & c12z(i1).e(3))*c56h(i5,i6) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 * Diagramma (56) DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cres36(i1,i3,i4,i5,i6)=rhzz*(c56z(i5,i6).e(0)* & c12z(i1).e(0)-c56z(i5,i6).e(1)*c12z(i1).e(1)- & c56z(i5,i6).e(2)*c12z(i1).e(2)-c56z(i5,i6).e(3)* & c12z(i1).e(3))*c34h(i3,i4) ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 ENDIF IF((imix.EQ.1.AND.isusy.EQ.1.AND.(iproc.EQ.39.OR.iproc.EQ.52.OR. & iproc.EQ.53).AND.(icch.EQ.3.OR.(icch.EQ.1.AND.iha.NE.2.AND. & iha.NE.4))).OR.(imix.EQ.-2.AND.isusy.EQ.1))THEN DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 cresha1(i1,i3,i4,i5,i6)=rzha*(c12z(i1).e(0)* & (p34(0)-p56(0))- & c12z(i1).e(1)*(p34(1)-p56(1))-c12z(i1).e(2)*(p34(2) & -p56(2))-c12z(i1).e(3)*(p34(3)-p56(3)))*c56a(i5,i6)* & c34h(i3,i4) cresha2(i1,i3,i4,i5,i6)=rzha*(c12z(i1).e(0)* & (p36(0)-p54(0))- & c12z(i1).e(1)*(p36(1)-p54(1))-c12z(i1).e(2)*(p36(2) & -p54(2))-c12z(i1).e(3)*(p36(3)-p54(3)))*c54a(i5,i4)* & c36h(i3,i6) cresha3(i1,i3,i4,i5,i6)=rzha*(c12z(i1).e(0)* & (p54(0)-p36(0))- & c12z(i1).e(1)*(p54(1)-p36(1))-c12z(i1).e(2)*(p54(2) & -p36(2))-c12z(i1).e(3)*(p54(3)-p36(3)))*c36a(i3,i6)* & c54h(i5,i4) cresha4(i1,i3,i4,i5,i6)=rzha*(c12z(i1).e(0)* & (p56(0)-p34(0))- & c12z(i1).e(1)*(p56(1)-p34(1))-c12z(i1).e(2)*(p56(2) & -p34(2))-c12z(i1).e(3)*(p56(3)-p34(3)))*c34a(i3,i4)* & c56h(i5,i6) ENDDO ENDDO ENDDO ENDDO ENDDO ENDIF ************************************************************************ if (ifirst.eq.1) then IF(istrcor.EQ.1.and.iproc.ne.53)THEN qcdcor=qcdcor_nc 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 fatcor_ampha=sqrt((1.d0+qcdcor_h)/(1.d0+qcdcor)) ELSE fatcor_qcd=1.d0 fatcor_hh=1.d0 fatcor_hz=1.d0 fatcor_ampha=1.d0 ENDIF ifirst=0 endif res=0.d0 DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 IF(imix.EQ.-1.OR.imix.EQ.-2)THEN cres_nc(i1,i3,i4,i5,i6).id(0)=cres7(i1,i3,i4,i5,i6)+ & cres8(i1,i3,i4,i5,i6)+cres10(i1,i3,i4,i5,i6)+ & cres11(i1,i5,i6,i3,i4)+cres14(i1,i5,i6,i3,i4)+ & cres16(i1,i3,i4,i5,i6)+cres4(i1,i3,i4,i5,i6)+ & cres26(i1,i3,i4,i5,i6)+cres27(i1,i5,i6,i3,i4)+ & cres29(i1,i5,i6,i3,i4)+cres32(i1,i3,i4,i5,i6)+ & cres2(i1,i3,i4,i5,i6) cres_nc(i1,i3,i4,i5,i6).id(1)=cres5(i1,i3,i4,i5,i6)+ & cres6(i1,i3,i4,i5,i6)+cres9(i1,i3,i6,i5,i4)+ & cres12(i1,i5,i4,i3,i6)+cres13(i1,i3,i6,i5,i4)+ & cres15(i1,i5,i4,i3,i6)+cres3(i1,i3,i4,i5,i6)+ & cres25(i1,i3,i6,i5,i4)+cres28(i1,i5,i4,i3,i6)+ & cres30(i1,i5,i4,i3,i6)+cres31(i1,i3,i6,i5,i4)+ & cres1(i1,i3,i4,i5,i6) IF(iqu.EQ.1)THEN cres_qcd(i1,i3,i4,i5,i6).id(0)=(cres26(i1,i3,i4,i5, & i6)+ & cres27(i1,i5,i6,i3,i4)+cres29(i1,i5,i6,i3,i4)+ & cres32(i1,i3,i4,i5,i6))*qcdcoupl/(fqdl**2) cres_qcd(i1,i3,i4,i5,i6).id(1)=(cres25(i1,i3,i6,i5, & i4)+ & cres28(i1,i5,i4,i3,i6)+cres30(i1,i5,i4,i3,i6)+ & cres31(i1,i3,i6,i5,i4))*qcdcoupl/(fqdl**2) ENDIF ENDIF IF((imix.EQ.1.AND.(icch.EQ.3.OR.(icch.EQ.1.AND.iha.EQ.1) & .OR.(icch.EQ.1.AND.isusy.EQ.1.AND.iha.EQ.2))).OR. & imix.EQ.-2)THEN cres_h(i1,i3,i4,i5,i6).id(0)=cres18(i1,i3,i4,i5,i6)+ & cres20(i1,i3,i4,i5,i6)+cres21(i1,i3,i4,i5,i6)+ & cres24(i1,i3,i4,i5,i6) cres_h(i1,i3,i4,i5,i6).id(1)=cres17(i1,i3,i4,i5,i6)+ & cres19(i1,i3,i4,i5,i6)+cres22(i1,i3,i4,i5,i6)+ & cres23(i1,i3,i4,i5,i6) ENDIF IF((icch.EQ.1.AND.imix.EQ.1.AND.iha.NE.3.AND.iha.NE.5). & OR.imix.EQ.-2)THEN cres_hz(i1,i3,i4,i5,i6).id(0)=cres35(i1,i3,i4,i5,i6)+ & cres36(i1,i3,i4,i5,i6) cres_hz(i1,i3,i4,i5,i6).id(1)=cres33(i1,i3,i4,i5,i6)+ & cres34(i1,i3,i4,i5,i6) ENDIF IF(isusy.EQ.1.AND.((imix.EQ.1.AND.(icch.EQ.3.OR. & (icch.EQ.1.AND.(iha.EQ.1.OR.iha.EQ.3)))).OR. & imix.EQ.-2))THEN cres_a(i1,i3,i4,i5,i6).id(0)=cres18a(i1,i3,i4,i5,i6)+ & cres20a(i1,i3,i4,i5,i6)+cres21a(i1,i3,i4,i5,i6)+ & cres24a(i1,i3,i4,i5,i6) cres_a(i1,i3,i4,i5,i6).id(1)=cres17a(i1,i3,i4,i5,i6)+ & cres19a(i1,i3,i4,i5,i6)+cres22a(i1,i3,i4,i5,i6)+ & cres23a(i1,i3,i4,i5,i6) ENDIF IF(isusy.EQ.1.AND.((imix.EQ.1.AND.(icch.EQ.3.OR. & (icch.EQ.1.AND.iha.NE.2.AND.iha.NE.4))).OR. & imix.EQ.-2))THEN cres_ha(i1,i3,i4,i5,i6).id(0)=cresha1(i1,i3,i4,i5,i6)+ & cresha4(i1,i3,i4,i5,i6) cres_ha(i1,i3,i4,i5,i6).id(1)=cresha2(i1,i3,i4,i5,i6)+ & cresha3(i1,i3,i4,i5,i6) ENDIF ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 DO i1=1,2 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 IF (imix.EQ.-1.OR.imix.EQ.-2) THEN cresa=cres_nc(i1,i3,i4,i5,i6).id(0) cresb=cres_nc(i1,i3,i4,i5,i6).id(1) res=res+2.d0*(cresa*conjg(cresa-cresb/ & (1.d0+2.d0*i3q))) IF (iqu.EQ.1) THEN rc=2.d0/9.d0 cresc=cres_qcd(i1,i3,i4,i5,i6).id(0) cresd=cres_qcd(i1,i3,i4,i5,i6).id(1) res=res+(2.d0*rc*(dreal(cresc)**2+dimag(cresc)**2)+ & rc*(cresc*conjg(cresd)+cresd*conjg(cresc))/3.d0 & -4.d0*rc*(cresa*conjg(cresd)+cresd*conjg(cresa)))* & fatcor_qcd ENDIF IF (imix.EQ.-2) THEN res=res-2.d0*fatcor_hz*(cres_nc(i1,i3,i4,i5,i6). & id(0)* & conjg(cres_h(i1,i3,i4,i5,i6).id(0))+ & cres_h(i1,i3,i4,i5,i6).id(0)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0))) & +2.d0*fatcor_hz*(cres_nc(i1,i3,i4,i5,i6).id(0) & *conjg(cres_h(i1,i3,i4,i5,i6).id(1))+ & cres_h(i1,i3,i4,i5,i6).id(1)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0)))/ & (1.d0+2.d0*i3q) res=res+2.d0*fatcor_hz*(cres_nc(i1,i3,i4,i5,i6). & id(0)*conjg(cres_hz(i1,i3,i4,i5,i6).id(0))+ & cres_hz(i1,i3,i4,i5,i6).id(0)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0))) & -2.d0*fatcor_hz*(cres_nc(i1,i3,i4,i5,i6).id(0) & *conjg(cres_hz(i1,i3,i4,i5,i6).id(1))+ & cres_hz(i1,i3,i4,i5,i6).id(1)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0)))/ & (1.d0+2.d0*i3q) IF(isusy.EQ.1)THEN res=res-2.d0*fatcor_hh*(cres_nc(i1,i3,i4,i5,i6). & id(0)* & conjg(cres_a(i1,i3,i4,i5,i6).id(0))+ & cres_a(i1,i3,i4,i5,i6).id(0)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0))) & +2.d0*fatcor_hz*(cres_nc(i1,i3,i4,i5,i6).id(0) & *conjg(cres_a(i1,i3,i4,i5,i6).id(1))+ & cres_a(i1,i3,i4,i5,i6).id(1)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0)))/ & (1.d0+2.d0*i3q) res=res+2.d0*fatcor_hh*(cres_nc(i1,i3,i4,i5,i6). & id(0)*conjg(cres_ha(i1,i3,i4,i5,i6).id(0))+ & cres_ha(i1,i3,i4,i5,i6).id(0)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0))) & -2.d0*fatcor_hh*(cres_nc(i1,i3,i4,i5,i6).id(0) & *conjg(cres_ha(i1,i3,i4,i5,i6).id(1))+ & cres_ha(i1,i3,i4,i5,i6).id(1)* & conjg(cres_nc(i1,i3,i4,i5,i6).id(0)))/ & (1.d0+2.d0*i3q) ENDIF IF (iqu.EQ.1) THEN rc=4.d0/9.d0 res=res+2.d0*rc*(cres_h(i1,i3,i4,i5,i6).id(0)* & conjg(cres_qcd(i1,i3,i4,i5,i6).id(1))+ & cres_qcd(i1,i3,i4,i5,i6).id(1)* & conjg(cres_h(i1,i3,i4,i5,i6).id(0)))*fatcor_qcd res=res-2.d0*rc*(cres_hz(i1,i3,i4,i5,i6).id(0)* & conjg(cres_qcd(i1,i3,i4,i5,i6).id(1))+ & cres_qcd(i1,i3,i4,i5,i6).id(1)* & conjg(cres_hz(i1,i3,i4,i5,i6).id(0)))*fatcor_qcd IF(isusy.EQ.1)THEN res=res+2.d0*rc*(cres_a(i1,i3,i4,i5,i6).id(0)* & conjg(cres_qcd(i1,i3,i4,i5,i6).id(1))+ & cres_qcd(i1,i3,i4,i5,i6).id(1)* & conjg(cres_a(i1,i3,i4,i5,i6).id(0)))*fatcor_qcd res=res-2.d0*rc*(cres_ha(i1,i3,i4,i5,i6).id(0)* & conjg(cres_qcd(i1,i3,i4,i5,i6).id(1))+ & cres_qcd(i1,i3,i4,i5,i6).id(1)* & conjg(cres_ha(i1,i3,i4,i5,i6).id(0)))*fatcor_qcd ENDIF !isusy ENDIF !iqu ENDIF !imix=-2 ENDIF !imix=-1,-2 IF (imix.EQ.1) THEN IF(icch.EQ.1.AND.((isusy.EQ.0.AND.iha.EQ.2).OR. & (isusy.EQ.1.AND.iha.EQ.4)))THEN cresa=cres36(i1,i3,i4,i5,i6) cresb=cres35(i1,i3,i4,i5,i6) cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6) res=res+4.d0*fatcor_hh*(cresa*conjg(cresa)+ & cresa*conjg(cresb)-cresa*conjg(cresc)/ & (1.d0+2.d0*i3q)) ELSE IF(icch.EQ.1.AND.((isusy.EQ.0.AND.iha.EQ.1).OR. & (isusy.EQ.1.AND.iha.EQ.2)))THEN cresa=cres36(i1,i3,i4,i5,i6)-cres20(i1,i3,i4,i5,i6) & -cres24(i1,i3,i4,i5,i6) cresb=cres35(i1,i3,i4,i5,i6)-cres18(i1,i3,i4,i5,i6) & -cres21(i1,i3,i4,i5,i6) cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6) & -cres_h(i1,i3,i4,i5,i6).id(1) res=res+4.d0*fatcor_hh*(cresa*conjg(cresa)+ & cresa*conjg(cresb)-cresa*conjg(cresc)/ & (1.d0+2.d0*i3q)) * da controllare ELSE IF(icch.EQ.1.AND.isusy.EQ.1.AND.iha.EQ.5)THEN cresa=cresha1(i1,i3,i4,i5,i6)*fatcor_ampha cresb=cresha4(i1,i3,i4,i5,i6)*fatcor_ampha cresc=(cresha2(i1,i3,i4,i5,i6)+ & cresha3(i1,i3,i4,i5,i6))*fatcor_ampha res=res+4.d0*fatcor_hh*(cresa*conjg(cresa)+ & cresa*conjg(cresb)-cresa*conjg(cresc)/ & (1.d0+2.d0*i3q)) ELSE IF(icch.EQ.1.AND.isusy.EQ.1.AND.iha.EQ.3)THEN cresa=fatcor_ampha*(cresha1(i1,i3,i4,i5,i6)- & cres18a(i1,i3,i4,i5,i6)-cres21a(i1,i3,i4,i5,i6)) cresb=fatcor_ampha*(cresha4(i1,i3,i4,i5,i6)- & cres20a(i1,i3,i4,i5,i6)-cres24a(i1,i3,i4,i5,i6)) cresc=fatcor_ampha*(cresha2(i1,i3,i4,i5,i6)+ & cresha3(i1,i3,i4,i5,i6)-cres17a(i1,i3,i4,i5,i6)- & cres19a(i1,i3,i4,i5,i6)-cres22a(i1,i3,i4,i5,i6)- & cres23a(i1,i3,i4,i5,i6)) res=res+4.d0*fatcor_hh*(cresa*conjg(cresa)+ & cresa*conjg(cresb)-cresa*conjg(cresc)/ & (1.d0+2.d0*i3q)) ELSE IF(icch.EQ.1.AND.isusy.EQ.1.AND.iha.EQ.6)THEN cresa=cres36(i1,i3,i4,i5,i6) & +fatcor_ampha*cresha1(i1,i3,i4,i5,i6) cresb=cres35(i1,i3,i4,i5,i6) & +fatcor_ampha*cresha4(i1,i3,i4,i5,i6) cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6) & +fatcor_ampha* & (cresha2(i1,i3,i4,i5,i6)+cresha3(i1,i3,i4,i5,i6)) res=res+4.d0*(cresa*conjg(cresa)+cresa*conjg(cresb)- & cresa*conjg(cresc)/(1.d0+2.d0*i3q))*fatcor_hh ELSE IF(icch.EQ.1.AND.isusy.EQ.1.AND.iha.EQ.1)THEN cresa=cres36(i1,i3,i4,i5,i6)-cres20(i1,i3,i4,i5,i6)- & cres24(i1,i3,i4,i5,i6)+fatcor_ampha* & (cresha1(i1,i3,i4,i5,i6)-cres18a(i1,i3,i4,i5,i6)- & cres21a(i1,i3,i4,i5,i6)) cresb=cres35(i1,i3,i4,i5,i6)-cres18(i1,i3,i4,i5,i6)- & cres21(i1,i3,i4,i5,i6)+fatcor_ampha* & (cresha4(i1,i3,i4,i5,i6)-cres20a(i1,i3,i4,i5,i6)- & cres24a(i1,i3,i4,i5,i6)) cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6) & -cres_h(i1,i3,i4,i5,i6).id(1)+fatcor_ampha* & (cresha2(i1,i3,i4,i5,i6)+cresha3(i1,i3,i4,i5,i6) & -cres17a(i1,i3,i4,i5,i6)-cres19a(i1,i3,i4,i5,i6) & -cres22a(i1,i3,i4,i5,i6)-cres23a(i1,i3,i4,i5,i6)) res=res+4.d0*(cresa*conjg(cresa)+cresa*conjg(cresb)- & cresa*conjg(cresc)/(1.d0+2.d0*i3q))*fatcor_hh ELSE IF(icch.EQ.3.AND.isusy.EQ.0)THEN cresa=cres36(i1,i3,i4,i5,i6)-cres20(i1,i3,i4,i5,i6)- & cres24(i1,i3,i4,i5,i6) cresb=cres35(i1,i3,i4,i5,i6)-cres18(i1,i3,i4,i5,i6)- & cres21(i1,i3,i4,i5,i6) cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6)- & cres_h(i1,i3,i4,i5,i6).id(1) res=res+4.d0*(cresa*conjg(cresa)+cresa*conjg(cresb)- & cresa*conjg(cresc)/(1.d0+2.d0*i3q))*fatcor_hh ELSE IF(icch.EQ.3.AND.isusy.EQ.1)THEN cresa=cres36(i1,i3,i4,i5,i6) & -cres20(i1,i3,i4,i5,i6)-cres24(i1,i3,i4,i5,i6) & +fatcor_ampha*(cresha1(i1,i3,i4,i5,i6)- & cres18a(i1,i3,i4,i5,i6)-cres21a(i1,i3,i4,i5,i6)) cresb=cres35(i1,i3,i4,i5,i6) & -cres18(i1,i3,i4,i5,i6)-cres21(i1,i3,i4,i5,i6) & +fatcor_ampha*(cresha4(i1,i3,i4,i5,i6)- & cres20a(i1,i3,i4,i5,i6)-cres24a(i1,i3,i4,i5,i6)) cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6)- & cres_h(i1,i3,i4,i5,i6).id(1)+fatcor_ampha* & (cresha2(i1,i3,i4,i5,i6)+cresha3(i1,i3,i4,i5,i6)- & cres17a(i1,i3,i4,i5,i6)-cres19a(i1,i3,i4,i5,i6)- & cres22a(i1,i3,i4,i5,i6)-cres23a(i1,i3,i4,i5,i6)) res=res+4.d0*(cresa*conjg(cresa)+cresa*conjg(cresb)- & cresa*conjg(cresc)/(1.d0+2.d0*i3q))*fatcor_hh * fine ENDIF ENDIF c IF(imix.EQ.3)THEN c cresa=cresha1(i1,i3,i4,i5,i6) c cresb=cresha4(i1,i3,i4,i5,i6) c cresc=cresha2(i1,i3,i4,i5,i6)+cresha3(i1,i3,i4,i5,i6) c res=res+4.d0*fatcor_hh*(cresa*conjg(cresa)+ c & cresa*conjg(cresb)-cresa*conjg(cresc)/3.d0) c ENDIF ENDDO !i6 ENDDO !i5 ENDDO !i4 ENDDO !i3 ENDDO !i1 IF(i3q.EQ.1.AND.i5q.EQ.1)THEN rc=9.d0 ELSE rc=1.d0 ENDIF ee_bbbb=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/16.d0 IF (istrcor.EQ.1.and.iproc.ne.53) THEN ee_bbbb=ee_bbbb*(1.d0+qcdcor)**2 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 double precision 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 double precision 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