******************************************************************************* * * * WPHACT: a Monte Carlo program for four-fermion final state processes * * at e+ e- colliders * * Authors: E. Accomando and A. Ballestrero * * version 1.3 * ******************************************************************************* * 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 some other lines * 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. * The FUNCTION fxn contains now the COMMON/abinpu/ so that variables like * rmw, rmz etc can now be used in abdis.dis. * version 1.2 * CC have costant width also in t channel * There are now two scales for higgs processes: * alfas_nc in data which correspond to the mass of the Z * alfas_h in read statement which should correspond to alfas at Higgs mass * * rmb_run must now be given in a read statement * version 1.3 * A bug introduced only in version 1.2 which implied a wrong determination of * the width of the higgs in presence of naive qcd corrections has been fixed. * There is now an exact naive qcd correction to susy higgs signal hA (which * in previous versions was corrected as HZ). ******************************************************************************* 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,icut,igwcomp,igzcomp,ighcomp,iswgcomp 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 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,nestrmax=51,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) COMMON/abdist/distr_estrinf(ndismax,nestrmax),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) 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/abibea/ibeam COMMON/abxbea/x1beam,x2beam 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/1.278d-03/, & gf/1.1663892199930875d-05/, alfainv/128.07d0/, & alfas_cc/0.1255d0/, alfas_nc/0.1230d0/, & s2w/0.231030912451068d0/, rms/1000.d0/ & ,x1beam/1.d0/,x2beam/1.d0/ 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/ 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*,rmb_run ! quark b 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 READ*,rmh ! Higgs mass (GeV) ELSE READ*,rma ! Higgs 'A' mass (GeV) READ*,tgb ! tan(beta) 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 cuts READ*,thbeam_max! 4 particle-beam angle upper cuts READ*,thsep_min ! 6 particle-particle angle lower cuts READ*,thsep_max ! 6 particle-particle angle upper 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 DO i=1,ndistr READ*,nsubint(i) ! number of sub-intervals with different binning 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 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 READ*,ibeam !yes/no beamstrahlung READ*,acc ! integration accuracy READ*,iterm ! yes/no thermalization READ*,ncall_term ! thermalization calls per iteration READ*,itmx_term ! thermalization iterations READ*,ncall ! integration calls per iteration READ*,itmx ! integration iterations (2 for flat event generation) if (ibeam.eq.1) then call circes (0.d0,0.d0,500.d0,2,1,1996 09 02,0) endif IF(iflat.EQ.1.AND.itmx.NE.2)THEN PRINT*,'ERROR' PRINT*,'Flat events generation needs ITMX =2' stop ENDIF s_col=e_cm**2 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 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)) 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) 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))) rmh=sqrt(rmh2) 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 fel=-1.d0 fer=-1.d0 zer=(+1.d0*s2w)/rcw/sw zel=(-.5d0+1.d0*s2w)/rcw/sw zvr=0.d0 zvl=.5d0/rcw/sw fqul=2.d0/3.d0 fqur=fqul zqur=(-2.d0/3.d0*s2w)/rcw/sw zqul=(.5d0-2.d0/3.d0*s2w)/rcw/sw fqdl=-1.d0/3.d0 fqdr=fqdl zqdr=(1.d0/3.d0*s2w)/rcw/sw zqdl=(-.5d0+1.d0/3.d0*s2w)/rcw/sw wcl=1.d0/sw/sqrt(2.d0) IF(iproc.GE.33.AND.isusy.EQ.0.AND.icch.NE.2)THEN rhzz=rmb_run/(s2w*rc2w*2.d0) rhww=rmb_run/(s2w*2.d0) rhbb=rmb_run**2/(4.d0*rmw**2*s2w) ELSE IF(iproc.GE.33.AND.isusy.EQ.1.AND.icch.NE.2)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) 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) 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 ENDIF IF(ighcomp.EQ.1.AND.iproc.GE.33.AND.icch.NE.2.AND.isusy.EQ.1)THEN IF(rmb.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)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)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 ENDIF IF(iproc.GE.33.AND.icch.NE.2)THEN gh=gamh/rmh IF(iproc.EQ.39.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 xm(3)=rmb xm(4)=rmb xm(5)=0.d0 xm(6)=0.d0 ENDIF 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.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.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.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) IF(isr.EQ.0)THEN ndim=7 ELSE ndim=9 ENDIF DO i=1,ndim region(i)=0.d0 region(ndim+i)=1.d0 ENDDO !i IF(iterm.EQ.1.AND.irepeat.EQ.0)THEN init=0 PRINT*,' ' PRINT*,'Thermalization' IF (iccnc.EQ.1.OR.iccnc.EQ.3) THEN 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 ips=ips_cc rmx1=rmw gamx1=gamw gx1=gw rmx2=rmx1 gamx2=gamx1 gx2=gx1 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).OR. & (isusy.EQ.1.AND.iproc.EQ.39.AND.(rma+rmh).GT.e_cm))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.AND.(rma+rmh).LE.e_cm)THEN 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 ELSE imix=-1 icc=0 ips=ips_nc rmx1=rmz gamx1=gamz gx1=gz rmx2=rmz gamx2=gamz gx2=gz ENDIF 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 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 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 IF(iflat.EQ.1)THEN iseed=19753179 novermax=0 nevent=0 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 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 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).OR. & (isusy.EQ.1.AND.iproc.EQ.39.AND.(rma+rmh).GT.e_cm))THEN PRINT*,' ' PRINT*,'Higgs signal' 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.AND.(rma+rmh).LE.e_cm)THEN PRINT*,' ' PRINT*,'hA + hZ signal' 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 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) if(irepeat.GT.1) nprn=-1 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 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 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 ips=ips_cc IF(iccnc.EQ.3)THEN PRINT*,' ' IF(interf.EQ.0)THEN PRINT*,'CC process' ELSE PRINT*,'CC process + CC-NC interference' ENDIF 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).OR.(isusy. & EQ.1.AND.iproc.EQ.39.AND.(rma+rmh).GT.e_cm))THEN PRINT*,' ' PRINT*,'Higgs signal' rmx1=rmh gamx1=gamh gx1=gh rmx2=rmz gamx2=gamz gx2=gz ELSE IF(isusy.EQ.1.AND.iproc.EQ.39.AND. & (rma+rmh).LE.e_cm)THEN PRINT*,' ' PRINT*,'hA + hZ signal' 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 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) if(irepeat.GT.1) nprn=-1 ENDIF CALL vegas(region,ndim,fxn,init,ncall,nit,nprn,avgi1, & sd1,rchi2a,acc,y1,it1,ndo1,si1,swgt1,schi1) if (irepeat.GE.1) PRINT 205,NEVENT 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 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*,' ' IF(interf.EQ.0)THEN PRINT*,'NC process + CC-NC interference' ELSE PRINT*,'NC process' ENDIF 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 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 if(irepeat.GT.1) nprn=-1 ENDIF CALL vegas(region,ndim,fxn,init,ncall,nit,nprn,avgi2, & sd2,rchi2a,acc,y2,it2,ndo2,si2,swgt2,schi2) if (irepeat.GE.1) PRINT 205,nevent-nflevts1 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 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('TSigma = ',d13.7,' +/-',d10.3,' (pb)') IF(iflat.EQ.1)THEN PRINT*,'Informations about flat events generation:' PRINT*,' ---------------------- ' IF(irepeat.EQ.0)THEN PRINT 203,rmaxfxn_1it 203 FORMAT('TMaximum after first VEGAS iteration = ',d9.3) ENDIF if (irepeat.ne.2) then PRINT 204,rmaxfxn_2it 204 FORMAT('TMaximum after second VEGAS iteration = ',d9.3) else PRINT*,'Maximum = ',rmaxfxn_2it endif PRINT 205,NEVENT 205 FORMAT('TFlat events number = ',i9) PRINT 206,novermax 206 FORMAT('Tnumber of function values over maximum = ',i9) ENDIF 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,icut,igwcomp,igzcomp,ighcomp,iswgcomp 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/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/absusy/rma,rma2,rzha 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,nestrmax=51,nbinmax=500, & nitmax=10) DIMENSION distr_var(ndismax) COMMON/abdist/distr_estrinf(ndismax,nestrmax),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/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) common/abibea/ibeam common/abxbea/x1beam,x2beam external random EXTERNAL ee_4f,ee_bbvv,ee_bbmumu,ee_bbbb,ee_bbee DATA ncall_eff/0/ el=e_cm/2.d0 IF(ibeam.EQ.1) CALL gircee(x1beam,x2beam,random) 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 IF(x1.EQ.1.d0)THEN dx1=rlim ELSE dx1=rlim+(1.d0-x1)**(1.d0-beta/2.d0)*(-beta*(1.d0+x1)/4.d0 & +(beta**2/32.d0)*(-4.d0*(1.d0+x1)*log(1.d0-x1)+3.d0* & (1.d0+x1)*log(x1)-4.d0*log(x1)/(1.d0-x1)-5.d0-x1)) ENDIF IF(x2.EQ.1.d0)THEN dx2=rlim ELSE dx2=rlim+(1.d0-x2)**(1.d0-beta/2.d0)*(-beta*(1.d0+x2)/4.d0 & +(beta**2/32.d0)*(-4.d0*(1.d0+x2)*log(1.d0-x2)+3.d0* & (1.d0+x2)*log(x2)-4.d0*log(x2)/(1.d0-x2)-5.d0-x2)) ENDIF str_fun=dx1*dx2*4.d0/beta/beta IF(str_fun.LE.0.d0)THEN fxn=0.d0 RETURN ENDIF if (ibeam.eq.1) then x1=x1*x1beam x2=x2*x2beam endif s=x1*x2*s_col IF(s.LT.smin)THEN fxn=0.d0 RETURN ENDIF bcm=(x1-x2)/(x1+x2) gcm=(x1+x2)/(2.d0*sqrt(x1*x2)) 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 s=x1beam*x2beam*s_col bcm=(x1beam-x2beam)/(x1beam+x2beam) gcm=(x1beam+x2beam)/(2.d0*sqrt(x1beam*x2beam)) 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 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 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.AND.isusy.EQ.1.AND.(rmh+rma).LE.e_cm)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) 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,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) 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) 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) 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) IF(isr.EQ.1.or.ibeam.eq.1)THEN p3(0)=gcm*(p3(0)+bcm*p3(3)) p3(1)=p3(1) p3(2)=p3(2) p3(3)=p3(3)/gcm+bcm*p3(0) p4(0)=gcm*(p4(0)+bcm*p4(3)) p4(1)=p4(1) p4(2)=p4(2) p4(3)=p4(3)/gcm+bcm*p4(0) p5(0)=gcm*(p5(0)+bcm*p5(3)) p5(1)=p5(1) p5(2)=p5(2) p5(3)=p5(3)/gcm+bcm*p5(0) p6(0)=gcm*(p6(0)+bcm*p6(3)) p6(1)=p6(1) p6(2)=p6(2) p6(3)=p6(3)/gcm+bcm*p6(0) ENDIF 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 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) 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 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 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 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 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 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' 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) IF(isr.EQ.1)THEN 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) THEN fxn=fxn*ee_bbvv(p1,p2,p3,p4,p5,p6) ELSE IF(iproc.EQ.35.OR.iproc.EQ.36.OR.iproc.EQ.38)THEN fxn=fxn*ee_bbmumu(p1,p2,p3,p4,p5,p6) ELSE IF(iproc.EQ.37)THEN fxn=fxn*ee_bbee(p1,p2,p3,p4,p5,p6) ELSE IF(iproc.EQ.39) THEN 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) 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 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(3,5)=phep(4,5) phep(4,6)=(1.d0-x2)*el phep(3,6)=-phep(4,6) endif IF(iJetset.EQ.1)THEN 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 ncall_eff=ncall_eff+1 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)-1 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 IF(j.EQ.1)THEN nbin=int((distr_var(i)-distr_estrinf(i,j))/ & bin_width(i,j))+1 ELSE nbin=int((distr_var(i)-distr_estrinf(i,j))/ & bin_width(i,j))+(1+nbin_sum(i,j)) 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 j=nsubint(i) nbin_sum(i,j)=nbin_sum(i,j-1)+nbin_number(i,j-1) IF(nbin_number(i,j).NE.0.AND.distr_var(i).LE.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(nbin.EQ.(nbin_sum(i,j)+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 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 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,icut,igwcomp,igzcomp,ighcomp,iswgcomp 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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(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 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 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,icut,igwcomp,igzcomp,ighcomp,iswgcomp 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 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/abibea/ibeam 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) THEN PRINT*,'Higgs signal' ELSE IF (icch.EQ.3) THEN PRINT*,'Higgs signal + 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('Tcm 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('THiggs mass = ',d13.7,' GeV') ELSE PRINT 207,rma 207 FORMAT('TCP odd Higgs mass = ',d13.7,' GeV') PRINT 208,tgb 208 FORMAT('TTan(beta) = ',d13.7,' GeV') ENDIF PRINT 301,rmb 301 FORMAT('Tb mass = ',d13.7,' GeV') ELSE IF (iccnc.EQ.4.AND.icch.EQ.2) THEN PRINT 401,rmb 401 FORMAT('Tb mass = ',d13.7,' GeV') ENDIF PRINT*,' ' PRINT*,'DATA' PRINT 411,rmz 411 FORMAT('TZ mass = ',d13.7,' GeV') PRINT 421,rmw 421 FORMAT('TW mass = ',d13.7,' GeV') IF (iccnc.EQ.4)THEN PRINT 423,rmc 423 FORMAT('Tc mass = ',d13.7,' GeV') PRINT 425,rmtau 425 FORMAT('Ttau mass = ',d13.7,' GeV') ENDIF IF(igwcomp.EQ.0)THEN PRINT 431,gamw 431 FORMAT('TW width = ',d13.7,' GeV') ENDIF IF(igzcomp.EQ.0)THEN PRINT 441,gamz 441 FORMAT('TZ 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('THiggs width = ',d13.7,' GeV') ENDIF PRINT 461,gf 461 FORMAT('TGf = ',d13.7,' GeV-2') IF(iswgcomp.EQ.0)THEN PRINT 471,s2w 471 FORMAT('Ts2w = ',d13.7) PRINT 481,alfainv 481 FORMAT('T1/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('Talfas_cc = ',d13.7) ELSE IF(icc.EQ.0)THEN PRINT 486,alfas_nc 486 FORMAT('Talfas_nc = ',d13.7) ELSE IF(icc.EQ.-1)THEN PRINT 487,alfas_cc 487 FORMAT('Talfas_cc = ',d13.7) PRINT 488,alfas_nc 488 FORMAT('Talfas_nc = ',d13.7) ENDIF ENDIF IF(igwcomp.EQ.1.OR.igzcomp.EQ.1.OR.ighcomp.EQ.1.OR. & iswgcomp.EQ.1)THEN PRINT*,' ' PRINT*,'DERIVED QUANTITIES' IF(isusy.EQ.1)THEN PRINT 489,rmh 489 FORMAT('THiggs mass = ',d13.7,' GeV') ENDIF IF(igwcomp.EQ.1)THEN PRINT 491,gamw 491 FORMAT('TW width = ',d13.7,' GeV') ENDIF IF(igzcomp.EQ.1)THEN PRINT 492,gamz 492 FORMAT('TZ 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('THiggs width = ',d13.7,' GeV') ENDIF IF(isusy.EQ.1.AND.iproc.EQ.39)THEN PRINT 452,gama 452 FORMAT('TCP odd Higgs width = ',d13.7,' GeV') ENDIF IF(iswgcomp.EQ.1)THEN PRINT 494,s2w 494 FORMAT('Ts2w = ',d13.7) PRINT 495,alfainv 495 FORMAT('T1/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 IF (ibeam.EQ.1) THEN PRINT*,'Beamstrahlung with Circe' ENDIF 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('TENERGY_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('TENERGY_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('TMASS_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('TMASS_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('TPT_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('TPT_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('TTHBEAM_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('TTHBEAM_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('TCOSBEAM_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('TCOSBEAM_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('TTHSEP_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('TTHSEP_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('TCOSSEP_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('TCOSSEP_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*,' ' 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('TMaximum 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 RETURN END double precision FUNCTION ee_4f(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 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) 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)) p1k0=p1(0)-p1(1) p2k0=p2(0)-p2(1) p3k0=p3(0)-p3(1) p4k0=p4(0)-p4(1) p5k0=p5(0)-p5(1) p6k0=p6(0)-p6(1) 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 p123k0=p123(0)-p123(1) p123q=p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p123 & (3)*p123(3) p125k0=p125(0)-p125(1) p125q=p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p125 & (3)*p125(3) p134k0=p134(0)-p134(1) p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) p145k0=p145(0)-p145(1) p145q=p145(0)*p145(0)-p145(1)*p145(1)-p145(2)*p145(2)-p145 & (3)*p145(3) p156k0=p156(0)-p156(1) p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) p235k0=p235(0)-p235(1) p235q=p235(0)*p235(0)-p235(1)*p235(1)-p235(2)*p235(2)-p235 & (3)*p235(3) p136k0=p136(0)-p136(1) p136q=p136(0)*p136(0)-p136(1)*p136(1)-p136(2)*p136(2)-p136 & (3)*p136(3) p345k0=p345(0)-p345(1) p345q=p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p345 & (3)*p345(3) p356k0=p356(0)-p356(1) p356q=p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p356 & (3)*p356(3) 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=p1p2 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 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) auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_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) 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 c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO IF (icc.NE.0) THEN 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) 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) auxa=-quqd+p5k0*p4(1)+p4k0*p5(1) c54w.e(1)=cfaw*(auxa-ceps_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) 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) c54w.ek0=c54w.e(0)-c54w.e(1) 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) 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) auxa=-quqd+p3k0*p6(1)+p6k0*p3(1) c36w.e(1)=cfaw*(auxa-ceps_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) 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) c36w.ek0=c36w.e(0)-c36w.e(1) 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 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 DO i=1,2 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 c36w.v=c36w.e(0)*vwm(0)-c36w.e(1)*vwm(1)-c36w.e(2)*vwm(2)- & c36w.e(3)*vwm(3) c54w.v=c54w.e(0)*vwp(0)-c54w.e(1)*vwp(1)-c54w.e(2)*vwp(2)- & c54w.e(3)*vwp(3) DO i=1,2 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 DO i=1,2 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 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 IF (ianc.NE.0) THEN cemp0=c36w.e(0)*p12(0)-c36w.e(1)*p12(1)-c36w.e(2)*p12(2)-c & 36w.e(3)*p12(3) 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 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 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 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 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 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 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 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) cempp=c36w.e(0)*p45(0)-c36w.e(1)*p45(1)-c36w.e(2)*p45(2)-c & 36w.e(3)*p45(3) ceppm=c54w.e(0)*p36(0)-c54w.e(1)*p36(1)-c54w.e(2)*p36(2)-c & 54w.e(3)*p36(3) p0pm=p12(0)*p36(0)-p12(1)*p36(1)-p12(2)*p36(2)-p12(3)*p36( & 3) p0pp=p12(0)*p45(0)-p12(1)*p45(1)-p12(2)*p45(2)-p12(3)*p45( & 3) 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 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 quqd=p1(0)*p145(0)-p1(1)*p145(1)-p1(2)*p145(2)-p1(3)*p145( & 3) 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=p145(0)*p2(0)-p145(1)*p2(1)-p145(2)*p2(2)-p145(3)*p2( & 3) 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) 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 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 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 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 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 c12fz4(i).ek0=c12fz4(i).e(0)-c12fz4(i).e(1) END DO quqd=p5(0)*p356(0)-p5(1)*p356(1)-p5(2)*p356(2)-p5(3)*p356( & 3) 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=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 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=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 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=p125(0)*p4(0)-p125(1)*p4(1)-p125(2)*p4(2)-p125(3)*p4( & 3) 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 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 quqd=p3(0)*p345(0)-p3(1)*p345(1)-p3(2)*p345(2)-p3(3)*p345( & 3) 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=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 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 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=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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=p123(0)*p6(0)-p123(1)*p6(1)-p123(2)*p6(2)-p123(3)*p6( & 3) 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 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=p2(0)*p3(0)-p2(1)*p3(1)-p2(2)*p3(2)-p2(3)*p3(3) 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 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) auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23f(1).e(1)=fac1*(auxa+ceps_0) c23f(2).e(1)=fac2*(auxa-ceps_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) 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 c23z(i).ek0=c23z(i).e(0)-c23z(i).e(1) END DO DO i=1,2 c23fz5(i).ek0=c23fz5(i).e(0)-c23fz5(i).e(1) END DO DO i=1,2 c23fz4(i).ek0=c23fz4(i).e(0)-c23fz4(i).e(1) END DO DO i=1,2 c23fz1(i).ek0=c23fz1(i).e(0)-c23fz1(i).e(1) END DO quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) ccl=wcl/(2.d0*quqd+rmw2-ccw) 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) auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16w.e(1)=ccl*(auxa-ceps_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) 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) c16w.ek0=c16w.e(0)-c16w.e(1) 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 DO i=1,2 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 c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) c54w.v=c54w.e(0)*vwp(0)-c54w.e(1)*vwp(1)-c54w.e(2)*vwp(2)- & c54w.e(3)*vwp(3) DO i=1,2 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 DO i=1,2 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 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 IF (ianc.NE.0) THEN cemp0=c16w.e(0)*p23(0)-c16w.e(1)*p23(1)-c16w.e(2)*p23(2)-c & 16w.e(3)*p23(3) 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 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 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 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 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 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 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 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) cempp=c16w.e(0)*p45(0)-c16w.e(1)*p45(1)-c16w.e(2)*p45(2) & -c & 16w.e(3)*p45(3) ceppm=c54w.e(0)*p16(0)-c54w.e(1)*p16(1)-c54w.e(2)*p16(2) & -c & 54w.e(3)*p16(3) p0pm=p23(0)*p16(0)-p23(1)*p16(1)-p23(2)*p16(2)-p23(3) & *p16( & 3) p0pp=p23(0)*p45(0)-p23(1)*p45(1)-p23(2)*p45(2)-p23(3) & *p45( & 3) 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 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 quqd=p145(0)*p6(0)-p145(1)*p6(1)-p145(2)*p6(2)-p145(3)*p6( & 3) DO i=1,2 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 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 quqd=p1(0)*p123(0)-p1(1)*p123(1)-p1(2)*p123(2)-p1(3)*p123( & 3) DO i=1,2 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 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 quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) 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) cc10(2)=( l3_54w.c(2)*p345q*r2_16w.b(1)+l3_54w.a(2)*r2_16w & .a(2) )/(p345q*p345k0) quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) 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=p156(0)*p4(0)-p156(1)*p4(1)-p156(2)*p4(2)-p156(3)*p4( & 3) DO i=1,2 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 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 quqd=p5(0)*p235(0)-p5(1)*p235(1)-p5(2)*p235(2)-p5(3)*p235( & 3) DO i=1,2 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=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) 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 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 ENDIF IF (i4e.EQ.1) THEN quqd=p4(0)*p1(0)-p4(1)*p1(1)-p4(2)*p1(2)-p4(3)*p1(3) 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 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) auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c41f(1).e(1)=fac1*(auxa+ceps_0) c41f(2).e(1)=fac2*(auxa-ceps_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) 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 c41z(i).ek0=c41z(i).e(0)-c41z(i).e(1) END DO DO i=1,2 c41fz3(i).ek0=c41fz3(i).e(0)-c41fz3(i).e(1) END DO DO i=1,2 c41fz6(i).ek0=c41fz6(i).e(0)-c41fz6(i).e(1) END DO DO i=1,2 c41fz2(i).ek0=c41fz2(i).e(0)-c41fz2(i).e(1) END DO quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) ccl=wcl/(2.d0*quqd+rmw2-ccw) 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) auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c52w.e(1)=ccl*(auxa-ceps_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) 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) c52w.ek0=c52w.e(0)-c52w.e(1) 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 DO i=1,2 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 c36w.v=c36w.e(0)*vwm(0)-c36w.e(1)*vwm(1)-c36w.e(2)*vwm(2)- & c36w.e(3)*vwm(3) c52w.v=c52w.e(0)*vwp(0)-c52w.e(1)*vwp(1)-c52w.e(2)*vwp(2)- & c52w.e(3)*vwp(3) DO i=1,2 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 DO i=1,2 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 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 IF (ianc.NE.0) THEN cemp0=c36w.e(0)*p14(0)-c36w.e(1)*p14(1)-c36w.e(2)*p14(2)-c & 36w.e(3)*p14(3) 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 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 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 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 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 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 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 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) cempp=c36w.e(0)*p25(0)-c36w.e(1)*p25(1)-c36w.e(2)*p25(2) & -c & 36w.e(3)*p25(3) ceppm=c52w.e(0)*p36(0)-c52w.e(1)*p36(1)-c52w.e(2)*p36(2) & -c & 52w.e(3)*p36(3) p0pm=p14(0)*p36(0)-p14(1)*p36(1)-p14(2)*p36(2)-p14(3) & *p36( & 3) p0pp=p14(0)*p25(0)-p14(1)*p25(1)-p14(2)*p25(2)-p14(3) & *p25( & 3) 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 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 quqd=p356(0)*p2(0)-p356(1)*p2(1)-p356(2)*p2(2)-p356(3)*p2( & 3) DO i=1,2 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 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 quqd=p5(0)*p145(0)-p5(1)*p145(1)-p5(2)*p145(2)-p5(3)*p145( & 3) DO i=1,2 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 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 quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) 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) cc16(2)=( l1_25w.c(2)*p125q*r4_36w.b(1)+l1_25w.a(2)*r4_36w & .a(2) )/(p125q*p125k0) quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) 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=p235(0)*p6(0)-p235(1)*p6(1)-p235(2)*p6(2)-p235(3)*p6( & 3) DO i=1,2 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 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 quqd=p3(0)*p134(0)-p3(1)*p134(1)-p3(2)*p134(2)-p3(3)*p134( & 3) DO i=1,2 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=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) 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 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 ENDIF ENDIF ENDIF IF (icc.NE.1) THEN DO ide=0,iid IF (ide.EQ.1) THEN 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=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) 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) auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56f(1).e(1)=fac1*(auxa+ceps_0) c56f(2).e(1)=fac2*(auxa-ceps_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) 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) 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) auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56z(1).e(1)=cfac1z*(auxa+ceps_0) c56z(2).e(1)=cfac2z*(auxa-ceps_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) 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 c56f(i).ek0=c56f(i).e(0)-c56f(i).e(1) END DO DO i=1,2 c56z(i).ek0=c56z(i).e(0)-c56z(i).e(1) END DO 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) 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) auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) c34f(1).e(1)=fac1*(auxa+ceps_0) c34f(2).e(1)=fac2*(auxa-ceps_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) 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) 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) auxa=-quqd+p3k0*p4(1)+p4k0*p3(1) c34z(1).e(1)=cfac1z*(auxa+ceps_0) c34z(2).e(1)=cfac2z*(auxa-ceps_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) 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 c34f(i).ek0=c34f(i).e(0)-c34f(i).e(1) END DO DO i=1,2 c34z(i).ek0=c34z(i).e(0)-c34z(i).e(1) END DO quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i1=1,2 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 DO i1=1,2 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 quqd=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i1=1,2 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 DO i1=1,2 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 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i1=1,2 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 DO i1=1,2 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 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i1=1,2 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 DO i1=1,2 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 quqd=p5(0)*p345(0)-p5(1)*p345(1)-p5(2)*p345(2)-p5(3)*p345( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p125(0)*p6(0)-p125(1)*p6(1)-p125(2)*p6(2)-p125(3)*p6( & 3) DO i=1,2 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 DO i=1,2 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 DO i3=1,2 DO i5=1,2 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 DO i3=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i3=1,2 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 DO i1=1,2 DO i3=1,2 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 r3r5=f3r*f5r DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i3=1,2 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 DO i1=1,2 DO i3=1,2 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 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 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) auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23f(1).e(1)=rcr*(auxa+ceps_0) c23f(2).e(1)=rcl*(auxa-ceps_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) 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 c23f(i).ek0=c23f(i).e(0)-c23f(i).e(1) END DO rcr=zer/dz rcl=zel/dz 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) auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23z(1).e(1)=rcr*(auxa+ceps_0) c23z(2).e(1)=rcl*(auxa-ceps_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) 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 c23z(i).ek0=c23z(i).e(0)-c23z(i).e(1) END DO 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 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) auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c14f(1).e(1)=rcr*(auxa+ceps_0) c14f(2).e(1)=rcl*(auxa-ceps_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) 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 c14f(i).ek0=c14f(i).e(0)-c14f(i).e(1) END DO rcr=zer/dz rcl=zel/dz 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) auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c14z(1).e(1)=rcr*(auxa+ceps_0) c14z(2).e(1)=rcl*(auxa-ceps_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) 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 c14z(i).ek0=c14z(i).e(0)-c14z(i).e(1) END DO quqd=p156(0)*p4(0)-p156(1)*p4(1)-p156(2)*p4(2)-p156(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p356(0)*p2(0)-p356(1)*p2(1)-p356(2)*p2(2)-p356(3)*p2( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p1(0)*p123(0)-p1(1)*p123(1)-p1(2)*p123(2)-p1(3)*p123( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p3(0)*p134(0)-p3(1)*p134(1)-p3(2)*p134(2)-p3(3)*p134( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p5(0)*p145(0)-p5(1)*p145(1)-p5(2)*p145(2)-p5(3)*p145( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p5(0)*p235(0)-p5(1)*p235(1)-p5(2)*p235(2)-p5(3)*p235( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p145(0)*p6(0)-p145(1)*p6(1)-p145(2)*p6(2)-p145(3)*p6( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p235(0)*p6(0)-p235(1)*p6(1)-p235(2)*p6(2)-p235(3)*p6( & 3) DO i=1,2 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 DO i=1,2 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 DO i2=1,2 DO i5=1,2 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 DO i2=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) ccl=wcl/(2.d0*quqd+rmw2) 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) auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16w.e(1)=ccl*(auxa-ceps_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) 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) c16w.ek0=c16w.e(0)-c16w.e(1) quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) ccl=wcl/(2.d0*quqd+rmw2) 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) auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c25w.e(1)=ccl*(auxa-ceps_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) 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) 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 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 DO i=1,2 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 c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) c25w.v=c25w.e(0)*vwp(0)-c25w.e(1)*vwp(1)-c25w.e(2)*vwp(2)- & c25w.e(3)*vwp(3) DO i=1,2 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 DO i=1,2 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 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 IF (ianc.NE.0) THEN cemp0=c16w.e(0)*p34(0)-c16w.e(1)*p34(1)-c16w.e(2)*p34(2)-c & 16w.e(3)*p34(3) 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 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 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 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 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 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 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 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) cempp=c16w.e(0)*p25(0)-c16w.e(1)*p25(1)-c16w.e(2)*p25(2) & -c & 16w.e(3)*p25(3) ceppm=c25w.e(0)*p16(0)-c25w.e(1)*p16(1)-c25w.e(2)*p16(2) & -c & 25w.e(3)*p16(3) p0pm=p34(0)*p16(0)-p34(1)*p16(1)-p34(2)*p16(2)-p34(3) & *p16( & 3) p0pp=p34(0)*p25(0)-p34(1)*p25(1)-p34(2)*p25(2)-p34(3) & *p25( & 3) 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 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 quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) 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=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) 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) IF (f3l.LT.0.d0) THEN quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) 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=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) 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=p136(0)*p4(0)-p136(1)*p4(1)-p136(2)*p4(2)-p136(3)*p4( & 3) 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=p3(0)*p136(0)-p3(1)*p136(1)-p3(2)*p136(2)-p3(3)*p136( & 3) 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=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) 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=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) 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) DO i3=1,2 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 DO i3=1,2 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 DO i3=1,2 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 DO i3=1,2 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 IF (f3l.LT.0.d0) THEN 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 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 quqd=p1(0)*p4(0)-p1(1)*p4(1)-p1(2)*p4(2)-p1(3)*p4(3) ccl=wcl/(2.d0*quqd+rmw2) 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) auxa=-quqd+p1k0*p4(1)+p4k0*p1(1) c14w.e(1)=ccl*(auxa-ceps_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) 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) c14w.ek0=c14w.e(0)-c14w.e(1) quqd=p3(0)*p2(0)-p3(1)*p2(1)-p3(2)*p2(2)-p3(3)*p2(3) ccl=wcl/(2.d0*quqd+rmw2) 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) auxa=-quqd+p3k0*p2(1)+p2k0*p3(1) c23w.e(1)=ccl*(auxa-ceps_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) 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) 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 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 DO i=1,2 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 c14w.v=c14w.e(0)*vwm(0)-c14w.e(1)*vwm(1)-c14w.e(2)*vwm(2)- & c14w.e(3)*vwm(3) c23w.v=c23w.e(0)*vwp(0)-c23w.e(1)*vwp(1)-c23w.e(2)*vwp(2)- & c23w.e(3)*vwp(3) DO i=1,2 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 DO i=1,2 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 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 IF (ianc.NE.0) THEN cemp0=c14w.e(0)*p56(0)-c14w.e(1)*p56(1)-c14w.e(2)*p56(2) & -c & 14w.e(3)*p56(3) 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 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 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 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 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 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 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 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) cempp=c14w.e(0)*p23(0)-c14w.e(1)*p23(1)-c14w.e(2) & *p23(2)-c & 14w.e(3)*p23(3) ceppm=c23w.e(0)*p14(0)-c23w.e(1)*p14(1)-c23w.e(2) & *p14(2)-c & 23w.e(3)*p14(3) p0pm=p56(0)*p14(0)-p56(1)*p14(1)-p56(2)*p14(2)-p56(3) & *p14( & 3) p0pp=p56(0)*p23(0)-p56(1)*p23(1)-p56(2)*p23(2)-p56(3) & *p23( & 3) 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 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 quqd=p156(0)*p4(0)-p156(1)*p4(1)-p156(2)*p4(2)-p156(3)*p4( & 3) 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=p356(0)*p2(0)-p356(1)*p2(1)-p356(2)*p2(2)-p356(3)*p2( & 3) 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) IF (f5l.LT.0.d0) THEN quqd=p235(0)*p6(0)-p235(1)*p6(1)-p235(2)*p6(2)-p235(3) & *p6( & 3) 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=p5(0)*p235(0)-p5(1)*p235(1)-p5(2)*p235(2)-p5(3) & *p235( & 3) 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=p145(0)*p6(0)-p145(1)*p6(1)-p145(2)*p6(2)-p145(3) & *p6( & 3) 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=p5(0)*p145(0)-p5(1)*p145(1)-p5(2)*p145(2)-p5(3) & *p145( & 3) 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=p1(0)*p123(0)-p1(1)*p123(1)-p1(2)*p123(2)-p1(3)*p123( & 3) 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=p3(0)*p134(0)-p3(1)*p134(1)-p3(2)*p134(2)-p3(3)*p134( & 3) 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) DO i5=1,2 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 DO i5=1,2 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 DO i5=1,2 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 DO i5=1,2 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 IF (f5l.LT.0.d0) THEN 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 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 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 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) auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c25f(1).e(1)=rcr*(auxa+ceps_0) c25f(2).e(1)=rcl*(auxa-ceps_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) 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 c25f(i).ek0=c25f(i).e(0)-c25f(i).e(1) END DO rcr=zer/dz rcl=zel/dz 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) auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c25z(1).e(1)=rcr*(auxa+ceps_0) c25z(2).e(1)=rcl*(auxa-ceps_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) 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 c25z(i).ek0=c25z(i).e(0)-c25z(i).e(1) END DO 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 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) auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16f(1).e(1)=rcr*(auxa+ceps_0) c16f(2).e(1)=rcl*(auxa-ceps_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) 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 c16f(i).ek0=c16f(i).e(0)-c16f(i).e(1) END DO rcr=zer/dz rcl=zel/dz 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) auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16z(1).e(1)=rcr*(auxa+ceps_0) c16z(2).e(1)=rcl*(auxa-ceps_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) 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 c16z(i).ek0=c16z(i).e(0)-c16z(i).e(1) END DO quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p3(0)*p136(0)-p3(1)*p136(1)-p3(2)*p136(2)-p3(3)*p136( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p136(0)*p4(0)-p136(1)*p4(1)-p136(2)*p4(2)-p136(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 DO i2=1,2 DO i5=1,2 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 DO i2=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 ENDIF 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) DIMENSION vfz(0:3),vwm(0:3),vwp(0:3) DIMENSION cres1(2,2),cres2(2,2),cres3(2,2),cres4(2,2,2), & cres5(2,2,2),cres6(2,2),cres7(2,2),cres9(2,2,2),cres37(2,2), & cres10(2,2,2),cres11(2,2),cres12(2,2),cres13(2,2),c34h(2,2), & cres14(2,2,2),cres15(2,2,2),cres16(2,2,2),cres17(2,2,2), & cres18(2,2),cres20(2,2,2),cres21(2,2,2),cres36(2,2,2) STRUCTURE/polcom/ double COMPLEX e(0:3),ek0,v END STRUCTURE RECORD/polcom/c12f(2),c12z(2),c16w,c52w,c34f(2,2),c34z(2,2),c56z STRUCTURE/tu0/ double COMPLEX a(2),c(2) END STRUCTURE RECORD/tu0/l1_34f(2,2),l1_34z(2,2),l5_12(2),l5_34(2,2),l1_56, & l5_16,l1_52 STRUCTURE/td0/ double COMPLEX a(2),b(2) END STRUCTURE RECORD/td0/r2_34f(2,2),r2_34z(2,2),r6_12(2),r6_34(2,2),r2_56, & r2_16,r6_52 STRUCTURE/t/ double COMPLEX a(2,2),b(2,2),c(2,2),d(2,2) END STRUCTURE RECORD/t/v3_4f(0:3),v3_4z(0:3),u3_12f(2),u3_12z(2),u3_56,u3_52, & d4_12f(2),d4_12z(2),d4_56,d4_16,v3_4h,dia15(2),dia16(2), & dia1,dia14(2),dia17(2) COMMON/abhigg/rmb,rmb2,rmh,rmh2,gamh,rhzz,rhww,rhbb COMMON/abparb/rmw2,gamw,rmz2,rmt2,rcotw,pi,alfa_me,qcdcoupl, & qcdcor_cc,qcdcor_nc,qcdcor_h COMMON/abparc/czipr,ccz,cwipr,ccw,chipr,cch,caipr,cca COMMON/abcoup/fer,fel,zer,zel,f3l,f4l,f5l,f6l,z3l,z4l,z5l,z6l, & f3r,f4r,f5r,f6r,z3r,z4r,z5r,z6r,wcl,delz,xf,xz,yf,yz,zz COMMON/abcopl/zvl,zvr,fqdl,fqdr,zqdl,zqdr,fqul,fqur,zqul,zqur COMMON/abflag/icc,icc3,i3e,i4e,i3q,i5q,iqu,i34e,i56ve,ibbveve,iid, & imix,icoul,istrcor,idownl,idownr,ianc PARAMETER (cim=(0.d0,1.d0)) data ifirst /1/ 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 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) 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) 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) 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 c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO p3k0=p3(0)-p3(1) p4k0=p4(0)-p4(1) p5k0=p5(0)-p5(1) p6k0=p6(0)-p6(1) 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 p123k0=p123(0)-p123(1) p123q=p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p123 & (3)*p123(3) p125k0=p125(0)-p125(1) p125q=p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p125 & (3)*p125(3) p134k0=p134(0)-p134(1) p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) p156k0=p156(0)-p156(1) p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) p235k0=p235(0)-p235(1) p235q=p235(0)*p235(0)-p235(1)*p235(1)-p235(2)*p235(2)-p235 & (3)*p235(3) p345k0=p345(0)-p345(1) p345q=p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p345 & (3)*p345(3) p356k0=p356(0)-p356(1) p356q=p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p356 & (3)*p356(3) IF (i56ve.EQ.1) THEN quqd=p1(0)*p6(0)-p1(1)*p6(1)-p1(2)*p6(2)-p1(3)*p6(3) rcl=wcl/(2.d0*quqd+rmw2) 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) auxa=-quqd+p1k0*p6(1)+p6k0*p1(1) c16w.e(1)=rcl*(auxa-ceps_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) 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) c16w.ek0=c16w.e(0)-c16w.e(1) quqd=p5(0)*p2(0)-p5(1)*p2(1)-p5(2)*p2(2)-p5(3)*p2(3) rcl=wcl/(2.d0*quqd+rmw2) 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) auxa=-quqd+p5k0*p2(1)+p2k0*p5(1) c52w.e(1)=rcl*(auxa-ceps_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) 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) c52w.ek0=c52w.e(0)-c52w.e(1) ENDIF IF (imix.EQ.-1.or.imix.eq.-2) then 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) 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 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 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 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 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 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 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 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 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 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 c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO DO i1=1,2 DO i2=1,2 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 c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO ENDIF !(c34z e c34f) 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 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) auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56z.e(1)=ccl*(auxa-ceps_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) 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) c56z.ek0=c56z.e(0)-c56z.e(1) IF (imix.EQ.-1.or.imix.eq.-2) then quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 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 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 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 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 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 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 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 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 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 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) 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 quqd=p3(0)*p235(0)-p3(1)*p235(1)-p3(2)*p235(2)-p3(3)*p235( & 3) 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 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) 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 quqd=p235(0)*p4(0)-p235(1)*p4(1)-p235(2)*p4(2)-p235(3)*p4( & 3) 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 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 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 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 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 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) 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) quqd=p5(0)*p156(0)-p5(1)*p156(1)-p5(2)*p156(2)-p5(3)*p156( & 3) 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) quqd=p1(0)*p125(0)-p1(1)*p125(1)-p1(2)*p125(2)-p1(3)*p125( & 3) 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) quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 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 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 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 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) 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) quqd=p345(0)*p2(0)-p345(1)*p2(1)-p345(2)*p2(2)-p345(3)*p2( & 3) 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) quqd=p134(0)*p6(0)-p134(1)*p6(1)-p134(2)*p6(2)-p134(3)*p6( & 3) 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) DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 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 DO i1=1,2 DO i2=1,2 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 c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) c52w.v=c52w.e(0)*vwp(0)-c52w.e(1)*vwp(1)-c52w.e(2)*vwp(2)- & c52w.e(3)*vwp(3) DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 DO i=1,2 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 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 DO i=1,2 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 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 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 DO i1=1,2 DO i2=1,2 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 c16w.v=c16w.e(0)*vwm(0)-c16w.e(1)*vwm(1)-c16w.e(2)*vwm(2)- & c16w.e(3)*vwm(3) c52w.v=c52w.e(0)*vwp(0)-c52w.e(1)*vwp(1)-c52w.e(2)*vwp(2)- & c52w.e(3)*vwp(3) DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 DO i=1,2 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 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 DO i=1,2 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 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 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) 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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) IF (imix.EQ.1.OR.imix.EQ.-2) then 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) 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) 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) if (ifirst.eq.1) then IF(istrcor.EQ.1)THEN qcdcor=qcdcor_nc fatcor_hh=(1.d0+qcdcor_h)/(1.d0+qcdcor) fatcor_hz=sqrt((1.d0+qcdcor)*(1.d0+qcdcor_h))/(1.d0+qcdcor) ELSE fatcor_hh=1.d0 fatcor_hz=1.d0 ENDIF ifirst=0 endif res=0.d0 cres=(0.d0,0.d0) DO k=1,2 DO i=1,2 DO j=1,2 IF (imix.EQ.-1.or.imix.eq.-2) then cres=+cres4(k,i,j)+cres5(k,i,j)+cres9(k,i,j)+cres10(k,i,j) & +cres14(k,i,j)+cres15(k,i,j)+cres16(k,i,j) & +cres17(k,i,j)+cres20(k,i,j)+cres21(k,i,j) IF (k.EQ.2.AND.i56ve.EQ.1) THEN cres=cres-cres1(i,j)-cres2(i,j)-cres3(i,j)-cres6(i,j) & -rcotw*cres7(i,j)-cres11(i,j)-cres12(i,j) & -cres13(i,j)-cres18(i,j) ENDIF res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=cres36(k,i,j) IF (k.EQ.2.AND.i56ve.EQ.1) THEN cresh=cresh-cres37(i,j) ENDIF IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres))*fatcor_hz ENDIF ENDIF ENDDO !j ENDDO !i ENDDO !k ee_bbvv=3.d0*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/4.d0 IF (istrcor.EQ.1) 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 PARAMETER (czero=(0.d0,0.d0),cuno=(1.d0,0.d0),cim=(0.d0,1.d0)) data ifirst/1/ 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 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) 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) 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) 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 c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO p3k0=p3(0)-p3(1) p4k0=p4(0)-p4(1) p5k0=p5(0)-p5(1) p6k0=p6(0)-p6(1) 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 p123k0=p123(0)-p123(1) p123q=p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p123 & (3)*p123(3) p125k0=p125(0)-p125(1) p125q=p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p125 & (3)*p125(3) p134k0=p134(0)-p134(1) p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) p156k0=p156(0)-p156(1) p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) p235k0=p235(0)-p235(1) p235q=p235(0)*p235(0)-p235(1)*p235(1)-p235(2)*p235(2)-p235 & (3)*p235(3) p345k0=p345(0)-p345(1) p345q=p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p345 & (3)*p345(3) p356k0=p356(0)-p356(1) 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=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) 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 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 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 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 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 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 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 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 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 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 c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO DO i1=1,2 DO i2=1,2 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 c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO ENDIF !(c34f e c34z) 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 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) auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56z(1).e(1)=ccr*(auxa+ceps_0) c56z(2).e(1)=ccl*(auxa-ceps_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) 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 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 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) auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56f(1).e(1)=rcr*(auxa+ceps_0) c56f(2).e(1)=rcl*(auxa-ceps_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) 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 c56f(i).ek0=c56f(i).e(0)-c56f(i).e(1) END DO quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 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 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 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 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 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 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 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 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 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 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 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 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 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 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 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 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 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 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 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 quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 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 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 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 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 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 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i=1,2 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 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i=1,2 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 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 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 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 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 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 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 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 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 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i=1,2 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 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i=1,2 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 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 DO i3=1,2 DO i=1,2 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 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i=1,2 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 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 DO i3=1,2 DO i=1,2 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 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i=1,2 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 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 DO i3=1,2 DO i=1,2 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 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i1=1,2 DO i2=1,2 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 DO i3=1,2 DO i=1,2 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 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 DO i3=1,2 DO i=1,2 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 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 DO i1=1,2 DO i2=1,2 DO i3=1,2 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 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) 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) 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 if (ifirst.eq.1) then IF(istrcor.EQ.1)THEN qcdcor=qcdcor_nc IF((i3q.EQ.1.AND.i5q.EQ.0).OR.(i3q.EQ.0.AND.i5q.EQ.1))THEN fatcor_qcd=1.d0/(1.d0+qcdcor) fatcor_hh=(1.d0+qcdcor_h)/(1.d0+qcdcor) fatcor_hz=sqrt((1.d0+qcdcor)*(1.d0+qcdcor_h))/(1.d0+qcdcor) ELSE IF(i3q.EQ.1.AND.i5q.EQ.1)THEN fatcor_qcd=1.d0/(1.d0+qcdcor)**2 fatcor_hh=(1.d0+qcdcor)*(1.d0+qcdcor_h)/ & (1.d0+qcdcor)**2 fatcor_hz=(1.d0+qcdcor)*sqrt((1.d0+qcdcor)*(1.d0+qcdcor_h)) & /(1.d0+qcdcor)**2 ENDIF ELSE fatcor_qcd=1.d0 fatcor_hh=1.d0 fatcor_hz=1.d0 ENDIF ifirst=0 endif res=0.d0 DO l=1,2 DO k=1,2 DO i=1,2 DO j=1,2 IF (imix.EQ.-1.or.imix.eq.-2) then cres=+cres4(l,k,i,j)+cres5(l,k,i,j)+cres9(l,k,i,j) & +cres10(l,k,i,j)+cres14(l,k,i,j)+cres15(l,k,i,j) & +cres16(l,k,i,j)+cres17(l,k,i,j)+cres20(l,k,i,j) & +cres21(l,k,i,j)+cres22(l,k,i,j)+cres23(l,k,i,j) & +cres24(l,k,i,j)+cres25(l,k,i,j)+cres26(l,k,i,j) & +cres27(l,k,i,j)+cres28(l,k,i,j)+cres29(l,k,i,j) & +cres30(l,k,i,j)+cres31(l,k,i,j)+cres32(l,k,i,j) & +cres33(l,k,i,j)+cres34(l,k,i,j)+cres35(l,k,i,j) res=res+dreal(cres)**2+dimag(cres)**2 ENDIF IF (imix.EQ.1.OR.imix.EQ.-2) then cresh=cres36(l,k,i,j) IF (imix.EQ.1) THEN res=res+(dreal(cresh)**2+dimag(cresh)**2)*fatcor_hh ELSE IF (imix.EQ.-2) then res=res+(cres*conjg(cresh)+cresh*conjg(cres)) & *fatcor_hz ENDIF ENDIF IF (iqu.EQ.1.AND.(imix.EQ.-1.or.imix.eq.-2)) then rc=2.d0/9.d0 cres=(cres14(l,k,i,j)+cres16(l,k,i,j)+cres17(l,k,i,j)+ & cres20(l,k,i,j)+cres21(l,k,i,j)+cres27(l,k,i,j)+ & cres30(l,k,i,j)+cres33(l,k,i,j))/(f5l*fqdl) res=res+rc*(qcdcoupl**2)*(dreal(cres)**2+dimag(cres)**2) & * & fatcor_qcd ENDIF ENDDO !j ENDDO !i ENDDO !k ENDDO !l IF (i3q.EQ.1.AND.i5q.EQ.1) THEN rc=9.d0 ELSE rc=3.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) 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 PARAMETER (czero=(0.d0,0.d0),cuno=(1.d0,0.d0),cim=(0.d0,1.d0)) data ifirst /1/ 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 p1k0=p1(0)-p1(1) p2k0=p2(0)-p2(1) p3k0=p3(0)-p3(1) p4k0=p4(0)-p4(1) p5k0=p5(0)-p5(1) p6k0=p6(0)-p6(1) 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 p123k0=p123(0)-p123(1) p123q=(p123(0)*p123(0)-p123(1)*p123(1)-p123(2)*p123(2)-p12 & 3(3)*p123(3)) p125k0=p125(0)-p125(1) p125q=(p125(0)*p125(0)-p125(1)*p125(1)-p125(2)*p125(2)-p12 & 5(3)*p125(3)) p134k0=p134(0)-p134(1) p134q=(p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p13 & 4(3)*p134(3)) p156k0=p156(0)-p156(1) p156q=(p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p15 & 6(3)*p156(3)) p345k0=p345(0)-p345(1) p345q=(p345(0)*p345(0)-p345(1)*p345(1)-p345(2)*p345(2)-p34 & 5(3)*p345(3)) p356k0=p356(0)-p356(1) p356q=(p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p35 & 6(3)*p356(3)) p12q=(p12(0)*p12(0)-p12(1)*p12(1)-p12(2)*p12(2)-p12(3)*p12 & (3)) p34q=(p34(0)*p34(0)-p34(1)*p34(1)-p34(2)*p34(2)-p34(3)*p34 & (3)) p56q=(p56(0)*p56(0)-p56(1)*p56(1)-p56(2)*p56(2)-p56(3)*p56 & (3)) quqd=p12q/2.d0 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 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) auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_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) 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 c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO DO i=1,2 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 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) auxa=-quqd+p5k0*p6(1)+p6k0*p5(1) c56f(1).e(1)=fac1*(auxa+ceps_0) c56f(2).e(1)=fac2*(auxa-ceps_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) 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 c56f(i).ek0=c56f(i).e(0)-c56f(i).e(1) END DO DO i=1,2 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) 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 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 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 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 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 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 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 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 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 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 c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO DO i1=1,2 DO i2=1,2 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 c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO quqd=p5(0)*p125(0)-p5(1)*p125(1)-p5(2)*p125(2)-p5(3)*p125( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p345(0)*p6(0)-p345(1)*p6(1)-p345(2)*p6(2)-p345(3)*p6( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i1=1,2 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 DO i1=1,2 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 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 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 DO i1=1,2 DO i2=1,2 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 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 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 DO i1=1,2 DO i2=1,2 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 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 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 DO i1=1,2 DO i2=1,2 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 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 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 DO i1=1,2 DO i2=1,2 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 quqd=p3(0)*p123(0)-p3(1)*p123(1)-p3(2)*p123(2)-p3(3)*p123( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p356(0)*p4(0)-p356(1)*p4(1)-p356(2)*p4(2)-p356(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p3(0)*p356(0)-p3(1)*p356(1)-p3(2)*p356(2)-p3(3)*p356( & 3) DO i=1,2 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 DO i=1,2 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 quqd=p123(0)*p4(0)-p123(1)*p4(1)-p123(2)*p4(2)-p123(3)*p4( & 3) DO i=1,2 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 DO i=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 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 DO i1=1,2 DO i5=1,2 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 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 DO i1=1,2 DO i5=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i4=1,2 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 DO i1=1,2 DO i3=1,2 DO i4=1,2 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 IF (imix.EQ.1.OR.imix.EQ.-2) then 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) 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) 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 if (ifirst.eq.1) then IF(istrcor.EQ.1)THEN fatcor_hh=(1.d0+qcdcor_h)/(1.d0+qcdcor_nc) fatcor_hz=sqrt((1.d0+qcdcor_nc)*(1.d0+qcdcor_h)) & /(1.d0+qcdcor_nc) ELSE fatcor_hh=1.d0 fatcor_hz=1.d0 ENDIF ifirst=0 endif 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 rc=3.d0 ee_bbee=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/rden IF (istrcor.EQ.1) THEN ee_bbee=ee_bbee*(1.d0+qcdcor_nc) ENDIF RETURN END 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 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 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 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) COMMON/abopzi/isr,ipr,ips,iccnc,iproc,ich,ichcj,ips_cc,ips_nc, & icos,icch,isusy,icut,igwcomp,igzcomp,ighcomp,iswgcomp 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 PARAMETER (czero=(0.d0,0.d0),cuno=(1.d0,0.d0),cim=(0.d0,1.d0)) data ifirst /1/ 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) p3k0=p3(0)-p3(1) p4k0=p4(0)-p4(1) p5k0=p5(0)-p5(1) p6k0=p6(0)-p6(1) 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 p154k0=p154(0)-p154(1) p154q=p154(0)*p154(0)-p154(1)*p154(1)-p154(2)*p154(2)-p154 & (3)*p154(3) p136k0=p136(0)-p136(1) p136q=p136(0)*p136(0)-p136(1)*p136(1)-p136(2)*p136(2)-p136 & (3)*p136(3) p156k0=p156(0)-p156(1) p156q=p156(0)*p156(0)-p156(1)*p156(1)-p156(2)*p156(2)-p156 & (3)*p156(3) p134k0=p134(0)-p134(1) p134q=p134(0)*p134(0)-p134(1)*p134(1)-p134(2)*p134(2)-p134 & (3)*p134(3) p536k0=p536(0)-p536(1) p536q=p536(0)*p536(0)-p536(1)*p536(1)-p536(2)*p536(2)-p536 & (3)*p536(3) p356k0=p356(0)-p356(1) p356q=p356(0)*p356(0)-p356(1)*p356(1)-p356(2)*p356(2)-p356 & (3)*p356(3) p312k0=p312(0)-p312(1) p312q=p312(0)*p312(0)-p312(1)*p312(1)-p312(2)*p312(2)-p312 & (3)*p312(3) p534k0=p534(0)-p534(1) p534q=p534(0)*p534(0)-p534(1)*p534(1)-p534(2)*p534(2)-p534 & (3)*p534(3) p354k0=p354(0)-p354(1) p354q=p354(0)*p354(0)-p354(1)*p354(1)-p354(2)*p354(2)-p354 & (3)*p354(3) p512k0=p512(0)-p512(1) p512q=p512(0)*p512(0)-p512(1)*p512(1)-p512(2)*p512(2)-p512 & (3)*p512(3) quqd=p1(0)*p2(0)-p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3) 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) auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12z(1).e(1)=cfac1z*(auxa+ceps_0) c12z(2).e(1)=cfac2z*(auxa-ceps_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) 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 c12z(i).ek0=c12z(i).e(0)-c12z(i).e(1) END DO 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) auxa=-quqd+p1k0*p2(1)+p2k0*p1(1) c12f(1).e(1)=fac1*(auxa+ceps_0) c12f(2).e(1)=fac2*(auxa-ceps_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) 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 c12f(i).ek0=c12f(i).e(0)-c12f(i).e(1) END DO 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) 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 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 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 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 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 DO i1=1,2 DO i2=1,2 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 c56z(i1,i2).ek0=c56z(i1,i2).e(0)-c56z(i1,i2).e(1) END DO END DO 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) 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 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 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 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 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 DO i1=1,2 DO i2=1,2 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 c34z(i1,i2).ek0=c34z(i1,i2).e(0)-c34z(i1,i2).e(1) END DO END DO 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) 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 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 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 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 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 DO i1=1,2 DO i2=1,2 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 c36z(i1,i2).ek0=c36z(i1,i2).e(0)-c36z(i1,i2).e(1) END DO END DO 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) 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 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 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 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 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 DO i1=1,2 DO i2=1,2 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 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 quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) rdf=-2.d0*(quqd+rmb2) 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 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 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 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 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 c56f(i1,i2).ek0=c56f(i1,i2).e(0)-c56f(i1,i2).e(1) END DO END DO quqd=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) rdf=-2.d0*(quqd+rmb2) 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 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 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 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 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 c34f(i1,i2).ek0=c34f(i1,i2).e(0)-c34f(i1,i2).e(1) END DO END DO quqd=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) rdf=-2.d0*(quqd+rmb2) 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 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 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 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 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 c36f(i1,i2).ek0=c36f(i1,i2).e(0)-c36f(i1,i2).e(1) END DO END DO quqd=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) rdf=-2.d0*(quqd+rmb2) 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 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 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 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 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 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 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) 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) 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=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) 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) 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=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) 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) 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=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) cdh=-(2.d0*(quqd+rmb2)*chipr-rmh2+cch) 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) 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.iproc.EQ.39)THEN quqd=p5(0)*p6(0)-p5(1)*p6(1)-p5(2)*p6(2)-p5(3)*p6(3) cda=-(2.d0*quqd*caipr-rma2+cca) 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 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=p5(0)*p4(0)-p5(1)*p4(1)-p5(2)*p4(2)-p5(3)*p4(3) cda=-(2.d0*quqd*caipr-rma2+cca) 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 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=p3(0)*p6(0)-p3(1)*p6(1)-p3(2)*p6(2)-p3(3)*p6(3) cda=-(2.d0*quqd*caipr-rma2+cca) 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 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=p3(0)*p4(0)-p3(1)*p4(1)-p3(2)*p4(2)-p3(3)*p4(3) cda=-(2.d0*quqd*caipr-rma2+cca) 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 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, iproc=39) ENDIF ! (imix=1,-2) IF (imix.EQ.-1.or.imix.eq.-2) then 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 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=p154(0)*p2(0)-p154(1)*p2(1)-p154(2)*p2(2)-p154(3)*p2( & 3) DO i3=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p136(0)-p1(1)*p136(1)-p1(2)*p136(2)-p1(3)*p136( & 3) DO i3=1,2 DO i6=1,2 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=p136(0)*p2(0)-p136(1)*p2(1)-p136(2)*p2(2)-p136(3)*p2( & 3) DO i5=1,2 DO i4=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i5=1,2 DO i6=1,2 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=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i3=1,2 DO i4=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i3=1,2 DO i4=1,2 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=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p154(0)-p1(1)*p154(1)-p1(2)*p154(2)-p1(3)*p154( & 3) DO i5=1,2 DO i4=1,2 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=p154(0)*p2(0)-p154(1)*p2(1)-p154(2)*p2(2)-p154(3)*p2( & 3) DO i3=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p136(0)-p1(1)*p136(1)-p1(2)*p136(2)-p1(3)*p136( & 3) DO i3=1,2 DO i6=1,2 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=p136(0)*p2(0)-p136(1)*p2(1)-p136(2)*p2(2)-p136(3)*p2( & 3) DO i5=1,2 DO i4=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p156(0)-p1(1)*p156(1)-p1(2)*p156(2)-p1(3)*p156( & 3) DO i5=1,2 DO i6=1,2 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=p156(0)*p2(0)-p156(1)*p2(1)-p156(2)*p2(2)-p156(3)*p2( & 3) DO i3=1,2 DO i4=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p1(0)*p134(0)-p1(1)*p134(1)-p1(2)*p134(2)-p1(3)*p134( & 3) DO i3=1,2 DO i4=1,2 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=p134(0)*p2(0)-p134(1)*p2(1)-p134(2)*p2(2)-p134(3)*p2( & 3) DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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 DO i3=1,2 DO i4=1,2 DO i5=1,2 DO i6=1,2 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=p5(0)*p536(0)-p5(1)*p536(1)-p5(2)*p536(2)-p5(3)*p536( & 3) DO i3=1,2 DO i6=1,2 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=p5(0)*p534(0)-p5(1)*p534(1)-p5(2)*p534(2)-p5(3)*p534( & 3) DO i3=1,2 DO i4=1,2 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=p3(0)*p534(0)-p3(1)*p534(1)-p3(2)*p534(2)-p3(3)*p534( & 3) DO i5=1,2 DO i4=1,2 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=p3(0)*p536(0)-p3(1)*p536(1)-p3(2)*p536(2)-p3(3)*p536( & 3) DO i5=1,2 DO i6=1,2 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=p536(0)*p4(0)-p536(1)*p4(1)-p536(2)*p4(2)-p536(3)*p4( & 3) DO i1=1,2 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 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=p534(0)*p6(0)-p534(1)*p6(1)-p534(2)*p6(2)-p534(3)*p6( & 3) DO i1=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i4=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i4=1,2 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 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=p5(0)*p512(0)-p5(1)*p512(1)-p5(2)*p512(2)-p5(3)*p512( & 3) DO i1=1,2 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 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=p3(0)*p312(0)-p3(1)*p312(1)-p3(2)*p312(2)-p3(3)*p312( & 3) DO i1=1,2 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 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=p512(0)*p4(0)-p512(1)*p4(1)-p512(2)*p4(2)-p512(3)*p4( & 3) DO i3=1,2 DO i6=1,2 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=p512(0)*p4(0)-p512(1)*p4(1)-p512(2)*p4(2)-p512(3)*p4( & 3) DO i3=1,2 DO i6=1,2 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=p312(0)*p4(0)-p312(1)*p4(1)-p312(2)*p4(2)-p312(3)*p4( & 3) DO i5=1,2 DO i6=1,2 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=p312(0)*p4(0)-p312(1)*p4(1)-p312(2)*p4(2)-p312(3)*p4( & 3) DO i5=1,2 DO i6=1,2 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=p312(0)*p6(0)-p312(1)*p6(1)-p312(2)*p6(2)-p312(3)*p6( & 3) DO i5=1,2 DO i4=1,2 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=p312(0)*p6(0)-p312(1)*p6(1)-p312(2)*p6(2)-p312(3)*p6( & 3) DO i5=1,2 DO i4=1,2 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=p512(0)*p6(0)-p512(1)*p6(1)-p512(2)*p6(2)-p512(3)*p6( & 3) DO i3=1,2 DO i4=1,2 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=p512(0)*p6(0)-p512(1)*p6(1)-p512(2)*p6(2)-p512(3)*p6( & 3) DO i3=1,2 DO i4=1,2 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 DO i1=1,2 DO i3=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i4=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i4=1,2 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 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.imix.EQ.-2) then 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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 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 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 DO i1=1,2 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.or.imix.eq.-2) then 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 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=p5(0)*p534(0)-p5(1)*p534(1)-p5(2)*p534(2)-p5(3)*p534( & 3) DO i3=1,2 DO i4=1,2 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=p3(0)*p534(0)-p3(1)*p534(1)-p3(2)*p534(2)-p3(3)*p534( & 3) DO i5=1,2 DO i4=1,2 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=p3(0)*p536(0)-p3(1)*p536(1)-p3(2)*p536(2)-p3(3)*p536( & 3) DO i5=1,2 DO i6=1,2 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 DO i1=1,2 DO i3=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i4=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i4=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i5=1,2 DO i4=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i6=1,2 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 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 DO i1=1,2 DO i3=1,2 DO i4=1,2 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 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.OR.imix.EQ.-2) then 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 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 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 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)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)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 ((icch.EQ.3.AND.imix.EQ.1).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).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 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/3.d0)) 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)))/3.d0 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)))/3.d0 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 ENDIF ENDIF ENDIF IF (imix.EQ.1) THEN IF (icch.EQ.1.AND.(isusy.EQ.0.OR. & (isusy.EQ.1.AND.iproc.NE.39))) 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)/3.d0) ELSE IF(icch.EQ.1.AND.isusy.EQ.1.AND.iproc.EQ.39)THEN cresa=cres36(i1,i3,i4,i5,i6)+cresha1(i1,i3,i4,i5,i6) & *fatcor_ampha cresb=cres35(i1,i3,i4,i5,i6)+cresha4(i1,i3,i4,i5,i6) & *fatcor_ampha cresc=cres33(i1,i3,i4,i5,i6)+cres34(i1,i3,i4,i5,i6) & +(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)/3.d0) ELSE IF(icch.EQ.3.AND.(isusy.EQ.0.OR. & (isusy.EQ.1.AND.iproc.NE.39))) 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)/3.d0)*fatcor_hh ELSE IF(icch.EQ.3.AND.isusy.EQ.1.AND.iproc.EQ.39)THEN cresa=cres36(i1,i3,i4,i5,i6)+cresha1(i1,i3,i4,i5,i6) & *fatcor_ampha & -cres20(i1,i3,i4,i5,i6)-cres24(i1,i3,i4,i5,i6) cresb=cres35(i1,i3,i4,i5,i6)+cresha4(i1,i3,i4,i5,i6) & *fatcor_ampha & -cres18(i1,i3,i4,i5,i6)-cres21(i1,i3,i4,i5,i6) cresc=cres33(i1,i3,i4,i5,i6)+cresha3(i1,i3,i4,i5,i6) & *fatcor_ampha & +cresha4(i1,i3,i4,i5,i6)*fatcor_ampha & -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)/3.d0)*fatcor_hh 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 rc=9.d0 ee_bbbb=rc*res/p1k0/p2k0/p3k0/p4k0/p5k0/p6k0/16.d0 IF (istrcor.EQ.1) 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) 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) EXTERNAL fxn 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 it=1 DO 11 j=1,ndim xi(1,j)=1. 11 CONTINUE ENDIF IF (init.LE.1)THEN si=0. swgt=0. schi=0. it=1 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 IF(it.GE.2.AND.acc*abs(tgral).ge.sd) RETURN 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 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 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 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 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 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 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